From 50bc00d6ef071100fcebceefc50fe6150cecfb58 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:10:19 +0000 Subject: [PATCH 01/37] Import Markoff mod p --- LeanPool.lean | 610 ++++++ LeanPool/MarkoffModP.lean | 626 ++++++ LeanPool/MarkoffModP/BGS.lean | 157 ++ .../ClearedLinearFractionalSubstitution.lean | 229 +++ .../BGS/Algebra/DifferentialWronskian.lean | 165 ++ .../Algebra/KummerEigencharacterDescent.lean | 167 ++ .../Algebra/RatFuncLinearFractionalEquiv.lean | 179 ++ .../ConstantOpenGlueData.lean | 165 ++ .../BGS/AlgebraicGeometry/SpecRingEquiv.lean | 70 + .../DivisorExponentCoefficient.lean | 140 ++ .../DivisorExponentSpernerBridge.lean | 36 + .../Combinatorics/ProductOfChainsGrid.lean | 234 +++ .../Combinatorics/ProductOfChainsSperner.lean | 88 + .../Combinatorics/SymmetricChainBasic.lean | 156 ++ .../Combinatorics/SymmetricChainProduct.lean | 185 ++ .../SymmetricChainRectangle.lean | 93 + LeanPool/MarkoffModP/BGS/CorvajaZannier.lean | 97 + .../AbsoluteIrreducibilityBaseChange.lean | 277 +++ .../BGS/CorvajaZannier/AuxiliaryFamily.lean | 323 +++ .../AuxiliaryFamilyIndexing.lean | 117 ++ .../BGS/CorvajaZannier/BivariateGauss.lean | 199 ++ .../CorvajaZannier/BivariateResultant.lean | 514 +++++ .../CompletionLinearDisjointness.lean | 145 ++ .../DedekindAuxiliaryCaseI.lean | 926 +++++++++ .../DedekindAuxiliaryLocalCases.lean | 88 + .../DedekindAuxiliaryWronskian.lean | 428 ++++ .../DedekindCanonicalDifferentScaling.lean | 197 ++ .../DedekindDifferentDivisor.lean | 319 +++ .../DedekindDifferentKaehler.lean | 330 +++ .../DedekindLeadingTermCancellation.lean | 195 ++ .../DedekindLocalDerivationExtension.lean | 264 +++ .../DedekindLocalWronskian.lean | 533 +++++ ...indLocalizationDerivationPreservation.lean | 114 ++ .../DedekindLocalizationOrder.lean | 229 +++ .../DedekindPerfectResidueCaseI.lean | 589 ++++++ .../CorvajaZannier/DedekindPlaceOrder.lean | 357 ++++ .../DedekindRamifiedDerivationScaling.lean | 509 +++++ .../ElementaryFiniteFieldBound.lean | 160 ++ .../CorvajaZannier/EndpointComposition.lean | 480 +++++ ...xtensionCanonicalAuxiliaryFinitePlace.lean | 367 ++++ ...nonicalAuxiliaryFinitePlaceNormalized.lean | 178 ++ ...ensionCanonicalAuxiliaryInfinityPlace.lean | 1185 +++++++++++ ...iteExtensionCanonicalDifferentDivisor.lean | 341 ++++ .../FiniteExtensionCanonicalGcdBound.lean | 87 + ...initeExtensionCanonicalGlobalGcdBound.lean | 151 ++ ...iteExtensionCanonicalGlobalNormalized.lean | 198 ++ ...ionCanonicalGlobalNormalizedAutomatic.lean | 632 ++++++ .../FiniteExtensionCanonicalPlaceSum.lean | 344 ++++ ...iteExtensionCanonicalPlacewiseScaling.lean | 166 ++ .../FiniteExtensionCanonicalWronskian.lean | 483 +++++ ...FiniteExtensionExceptionalPlaceBounds.lean | 188 ++ .../FiniteExtensionExceptionalSupport.lean | 929 +++++++++ ...niteExtensionExhaustiveProductFormula.lean | 355 ++++ .../FiniteExtensionGcdOutsideHeight.lean | 174 ++ .../FiniteExtensionOneSubGcdHeight.lean | 282 +++ .../FiniteExtensionPolynomialHeight.lean | 288 +++ .../FiniteExtensionPositiveDegreePower.lean | 72 + .../FiniteExtensionPrincipalDivisor.lean | 1015 ++++++++++ .../FiniteExtensionProductFormula.lean | 380 ++++ .../FiniteExtensionResidueSurjectivity.lean | 159 ++ .../FiniteFunctionFieldDegree.lean | 172 ++ .../CorvajaZannier/FinitePlaceCompletion.lean | 131 ++ .../BGS/CorvajaZannier/FrobeniusSubfield.lean | 277 +++ .../CorvajaZannier/FrobeniusWronskian.lean | 50 + .../FunctionFieldProductFormula.lean | 180 ++ .../CorvajaZannier/GeneralCorvajaZannier.lean | 122 ++ .../GlobalWronskianPlaceSum.lean | 188 ++ .../GlobalWronskianSummation.lean | 104 + .../GlobalWronskianWeightedPlaceSum.lean | 155 ++ .../CorvajaZannier/InfinityInertiaDegree.lean | 235 +++ .../BGS/CorvajaZannier/InfinityPlace.lean | 289 +++ .../CorvajaZannier/LaurentFrobeniusBasis.lean | 182 ++ .../LaurentFrobeniusPowerBasis.lean | 133 ++ .../CorvajaZannier/LocalAuxiliaryCaseI.lean | 768 +++++++ .../LocalAuxiliaryWronskian.lean | 542 +++++ .../BGS/CorvajaZannier/LocalDerivative.lean | 51 + .../BGS/CorvajaZannier/LocalMonogenicity.lean | 373 ++++ .../LocalReciprocalDiscriminant.lean | 829 ++++++++ .../BGS/CorvajaZannier/LocalWronskian.lean | 187 ++ .../CorvajaZannier/NumericalCorollary.lean | 52 + .../CorvajaZannier/NumericalOptimization.lean | 219 ++ .../CorvajaZannier/ParameterizedBound.lean | 455 +++++ .../BGS/CorvajaZannier/PerfectConstants.lean | 53 + .../PlaneCurveAuxiliaryFinitePlace.lean | 591 ++++++ .../PlaneCurveAuxiliaryFinitePlaceCases.lean | 343 ++++ ...eAuxiliaryFinitePlacePrincipalDivisor.lean | 71 + .../PlaneCurveAuxiliaryIndependence.lean | 553 +++++ .../PlaneCurveBidegreeBridge.lean | 99 + .../PlaneCurveBoundarySupport.lean | 1042 ++++++++++ .../PlaneCurveCanonicalDegreeBound.lean | 237 +++ .../PlaneCurveCanonicalEulerBound.lean | 82 + .../PlaneCurveCanonicalGcdBound.lean | 328 +++ .../PlaneCurveCharacteristicCardinality.lean | 95 + .../PlaneCurveCoordinatePowerHeight.lean | 128 ++ .../PlaneCurveDiagonalStabilizer.lean | 188 ++ .../PlaneCurveDiscriminantBound.lean | 221 ++ .../PlaneCurveExhaustiveGcdEndpoint.lean | 80 + .../PlaneCurveFiniteDifferentBound.lean | 813 ++++++++ .../PlaneCurveFunctionField.lean | 545 +++++ .../PlaneCurveInfinityComplement.lean | 113 ++ .../PlaneCurveInfinityDifferentBound.lean | 240 +++ .../PlaneCurveInfinityDifferentDegree.lean | 429 ++++ ...PlaneCurveLocalReciprocalDiscriminant.lean | 639 ++++++ .../PlaneCurveLogarithmicGauss.lean | 276 +++ .../PlaneCurvePoweredHeightBounds.lean | 353 ++++ .../PlaneCurvePoweredImageDegreeBudget.lean | 83 + .../PlaneCurvePropositionTwoAssembly.lean | 273 +++ .../PlaneCurvePropositionTwoDegreeBridge.lean | 244 +++ .../PlaneCurvePropositionTwoGeometric.lean | 223 ++ .../PlaneCurveRatFuncModel.lean | 274 +++ .../PlaneCurveSeparability.lean | 825 ++++++++ .../PlaneCurveSharedOriginBoundary.lean | 267 +++ .../PlaneCurveSupportDeterminant.lean | 122 ++ .../CorvajaZannier/PlaneCurveSupportRank.lean | 873 ++++++++ .../PoweredCoordinateRelation.lean | 486 +++++ .../CorvajaZannier/PoweredCoordinates.lean | 503 +++++ .../PoweredImageBaseChange.lean | 313 +++ .../BGS/CorvajaZannier/PoweredImageCurve.lean | 919 +++++++++ .../PoweredImageExactSupportIndexBound.lean | 245 +++ .../PoweredImageFrobeniusRelation.lean | 717 +++++++ .../PoweredImageFrobeniusRelationSwapped.lean | 160 ++ .../PoweredImageGaloisBound.lean | 582 ++++++ .../PoweredImageHeightFactor.lean | 77 + .../BGS/CorvajaZannier/PoweredImageIndex.lean | 174 ++ .../PoweredImageIndexBound.lean | 138 ++ .../PropositionTwoDegreeMonotonicity.lean | 241 +++ .../RatFuncExhaustiveProductFormula.lean | 263 +++ .../SeparatingCoordinateNotFrobenius.lean | 220 ++ .../CorvajaZannier/TorsionBidegreeCount.lean | 366 ++++ .../TorsionExhaustiveGcdDivisorBound.lean | 872 ++++++++ .../TorsionGcdDivisorBound.lean | 309 +++ .../TorsionPointNormalization.lean | 418 ++++ .../TorusCharacterKernelBound.lean | 325 +++ .../TranscendentalPowerDegree.lean | 229 +++ .../WronskianChangeParameter.lean | 208 ++ .../BGS/Dynamics/FiniteForwardOrbit.lean | 49 + .../BGS/Dynamics/StrictMeasureEscape.lean | 33 + .../BGS/External/GeneralCurveTheorems.lean | 152 ++ .../BGS/FiniteField/EllipticCharacterSum.lean | 194 ++ .../BGS/FiniteField/HasseFrobenius.lean | 343 ++++ .../BGS/FiniteField/QuadraticCharacter.lean | 185 ++ .../BGS/HasseWeil/AffinePointPlace.lean | 584 ++++++ .../HasseWeil/CechRiemannLinearAlgebra.lean | 161 ++ .../HasseWeil/ClosedPlaceEulerRecurrence.lean | 610 ++++++ .../ConstantExtensionClosedPlaceCount.lean | 420 ++++ ...tExtensionClosedPlaceSplittingFormula.lean | 755 +++++++ .../ConstantExtensionFinitePlaceBridge.lean | 321 +++ .../ConstantExtensionInfinityPlaceBridge.lean | 982 +++++++++ ...tantExtensionInfinityPlaceDegreeTower.lean | 583 ++++++ ...ionInfinityPlaceSplittingMultiplicity.lean | 1382 +++++++++++++ ...ntExtensionPlaceSplittingMultiplicity.lean | 666 ++++++ .../ConstantExtensionRationalPlace.lean | 125 ++ .../HasseWeil/ConstantFieldAutomorphism.lean | 434 ++++ .../HasseWeil/ConstantFieldFinitePlace.lean | 191 ++ .../ConstantFieldFinitePlaceDegree.lean | 209 ++ .../HasseWeil/ConstantFieldInfinityBase.lean | 161 ++ .../ConstantFieldRatFuncCompatibility.lean | 409 ++++ .../BGS/HasseWeil/ConstantTensorResidue.lean | 169 ++ .../BGS/HasseWeil/DVRLocalPoleOrder.lean | 93 + .../DedekindDifferentLocalTrace.lean | 366 ++++ .../BGS/HasseWeil/ExactConstantExtension.lean | 229 +++ .../ExactConstantExtensionAutomorphism.lean | 329 +++ .../ExactConstantExtensionConstants.lean | 174 ++ ...ConstantExtensionDifferentCoefficient.lean | 1045 ++++++++++ ...ExactConstantExtensionFiniteDifferent.lean | 646 ++++++ .../ExactConstantExtensionFinitePlace.lean | 453 +++++ ...tantExtensionFinitePlaceCompatibility.lean | 952 +++++++++ ...tExtensionFinitePlaceFrobeniusAverage.lean | 336 ++++ .../ExactConstantExtensionFrobeniusTwist.lean | 368 ++++ ...ntExtensionFrobeniusTwistBoundedError.lean | 79 + ...stantExtensionFrobeniusTwistConstants.lean | 133 ++ ...ConstantExtensionFrobeniusTwistDegree.lean | 82 + ...nsionFrobeniusTwistFinitePlaceAverage.lean | 848 ++++++++ ...ensionFrobeniusTwistFinitePlaceBridge.lean | 468 +++++ ...onFrobeniusTwistFinitePlaceUnramified.lean | 1063 ++++++++++ ...tConstantExtensionFrobeniusTwistGenus.lean | 97 + ...ionFrobeniusTwistInfinityPlaceDescent.lean | 799 ++++++++ ...robeniusTwistInfinityPlaceEquivalence.lean | 568 ++++++ ...ExtensionFrobeniusTwistMultiplication.lean | 217 ++ ...ionFrobeniusTwistRationalPlaceAverage.lean | 307 +++ ...ntExtensionFrobeniusTwistRiemannLower.lean | 206 ++ ...tExtensionFrobeniusTwistStepanovUpper.lean | 254 +++ .../ExactConstantExtensionGenusDegree.lean | 269 +++ ...ExactConstantExtensionGenusInvariance.lean | 237 +++ ...actConstantExtensionInfinityDifferent.lean | 643 ++++++ ...onstantExtensionInfinityNormalization.lean | 314 +++ ...ntExtensionInfinityPlaceCompatibility.lean | 423 ++++ ...diateFrobeniusTwistFinitePlaceAverage.lean | 1786 +++++++++++++++++ ...nIntermediateFrobeniusTwistHasseBound.lean | 330 +++ ...ateFrobeniusTwistRationalPlaceAverage.lean | 326 +++ ...ctConstantExtensionNormalClosureTower.lean | 1000 +++++++++ .../ExactConstantExtensionQuotient.lean | 259 +++ ...ctConstantExtensionRationalPlaceCount.lean | 77 + .../ExactConstantExtensionRegularity.lean | 187 ++ ...ConstantExtensionTotalDifferentDegree.lean | 218 ++ .../ExactConstantExtensionTower.lean | 542 +++++ .../ExtensionEvenDegreeStepanovBound.lean | 210 ++ .../BGS/HasseWeil/ExtensionPointCount.lean | 189 ++ .../BGS/HasseWeil/FilteredDimension.lean | 97 + .../BGS/HasseWeil/FiniteBranchLocus.lean | 402 ++++ .../FiniteExtensionAffineIdealDegree.lean | 204 ++ .../FiniteExtensionAffineIdealDivisor.lean | 480 +++++ ...nonicalDifferentCanonicalityCriterion.lean | 258 +++ ...iteExtensionCanonicalDifferentCotrace.lean | 1348 +++++++++++++ ...CanonicalDifferentCotraceCanonicality.lean | 113 ++ ...ExtensionCanonicalDifferentGenusBound.lean | 154 ++ ...sionCanonicalDifferentLocalMaximality.lean | 782 ++++++++ .../FiniteExtensionClosedPlaceAlgEquiv.lean | 83 + ...FiniteExtensionCotraceLocalTraceImage.lean | 367 ++++ ...tensionDivisibleErrorFromConstantBase.lean | 163 ++ ...FiniteExtensionDivisorClassRecurrence.lean | 540 +++++ .../FiniteExtensionDivisorDegreeIndex.lean | 322 +++ .../FiniteExtensionEffectiveDivisorSplit.lean | 399 ++++ .../HasseWeil/FiniteExtensionGenusBound.lean | 92 + ...nHasseBoundFromEvenConstantExtensions.lean | 265 +++ .../HasseWeil/FiniteExtensionHasseWeil.lean | 409 ++++ ...FiniteExtensionIndexedZetaRationality.lean | 91 + ...ensionIndexedZetaRationalityAutomatic.lean | 106 + .../FiniteExtensionLocalPoleQuotient.lean | 501 +++++ .../FiniteExtensionLocalPoleSpace.lean | 193 ++ .../FiniteExtensionPlaceAlgEquiv.lean | 428 ++++ .../FiniteExtensionPlaceDegreeFiniteness.lean | 180 ++ .../HasseWeil/FiniteExtensionPlaceTower.lean | 1277 ++++++++++++ .../FiniteExtensionPrincipalParts.lean | 419 ++++ .../FiniteExtensionRiemannEventualGrowth.lean | 124 ++ .../FiniteExtensionRiemannLowerFromGenus.lean | 85 + .../HasseWeil/FiniteExtensionRiemannRoch.lean | 621 ++++++ ...ExtensionRiemannShiftedEventualGrowth.lean | 272 +++ .../FiniteExtensionRiemannSpace.lean | 366 ++++ ...ExtensionRiemannSpaceProjectivization.lean | 362 ++++ ...initeExtensionStandardZetaRationality.lean | 166 ++ ...tensionTotalDifferentEffectiveDivisor.lean | 154 ++ .../FiniteExtensionZeroCounting.lean | 194 ++ ...eExtensionZetaDegreeExtensionIdentity.lean | 68 + .../FiniteExtensionZetaDegreeIndexOne.lean | 236 +++ ...eExtensionZetaDegreeIndexOneAutomatic.lean | 97 + ...ensionZetaDegreeIndexOneFromAllCounts.lean | 69 + ...ExtensionZetaNumeratorNoncancellation.lean | 385 ++++ .../FiniteExtensionZetaSimplePole.lean | 158 ++ .../BGS/HasseWeil/FiniteFieldCompositum.lean | 152 ++ ...teFieldConstantExtensionNormalization.lean | 183 ++ .../FiniteFieldConstantExtensionResidue.lean | 290 +++ .../FiniteFieldDivisibleExtension.lean | 117 ++ .../FiniteFieldInfinityDifferent.lean | 343 ++++ .../FiniteFieldPolynomialDifferent.lean | 136 ++ .../FiniteFieldPolynomialNormalization.lean | 64 + .../BGS/HasseWeil/FiniteFieldSubfield.lean | 87 + .../FiniteLinearIndependenceBound.lean | 62 + .../HasseWeil/FinitePlaceApproximation.lean | 277 +++ .../HasseWeil/FinitePlaceFrobeniusFiber.lean | 233 +++ .../FinitePlaceNormalizationTransport.lean | 266 +++ .../BGS/HasseWeil/FinitePrincipalParts.lean | 424 ++++ .../BGS/HasseWeil/FinsuppWeightedFiber.lean | 98 + .../BGS/HasseWeil/FixedPointAverage.lean | 277 +++ .../FormalZetaConstantExtensionIdentity.lean | 203 ++ .../HasseWeil/FormalZetaDegreeIndexOne.lean | 208 ++ .../FormalZetaDegreeIndexOneIndexed.lean | 198 ++ .../BGS/HasseWeil/FormalZetaEuler.lean | 113 ++ .../BGS/HasseWeil/FormalZetaEulerDegree.lean | 70 + .../BGS/HasseWeil/FormalZetaHasseBound.lean | 75 + .../BGS/HasseWeil/FormalZetaRationality.lean | 179 ++ .../FormalZetaRationalityDegree.lean | 90 + .../BGS/HasseWeil/FormalZetaTrace.lean | 283 +++ .../BGS/HasseWeil/FormalZetaUniqueness.lean | 85 + .../HasseWeil/FrobeniusPlaceCardinality.lean | 204 ++ .../BGS/HasseWeil/FrobeniusRestriction.lean | 271 +++ .../BGS/HasseWeil/FrobeniusTwistGroup.lean | 65 + .../FunctionFieldConstantExtension.lean | 260 +++ .../HasseWeil/FunctionFieldConstantField.lean | 211 ++ .../HasseWeil/FunctionFieldNormalClosure.lean | 82 + ...unctionFieldNormalClosureConstantBase.lean | 162 ++ .../FunctionFieldNormalClosureConstants.lean | 162 ++ ...nFieldNormalClosureOriginalCompositum.lean | 446 ++++ ...nctionFieldNormalClosureOriginalField.lean | 128 ++ ...FunctionFieldNormalClosureRatFuncBase.lean | 192 ++ ...unctionFieldNormalClosureRatFuncEquiv.lean | 89 + .../BGS/HasseWeil/GaloisAverage.lean | 161 ++ .../HasseWeil/GaloisTowerFactorialDegree.lean | 59 + .../GeneralBivariateAffineHasseWeil.lean | 184 ++ .../GeneralFiniteExtensionRiemannLower.lean | 311 +++ .../GeneralSquareFieldStepanovCount.lean | 233 +++ ...eralSquareFieldStepanovCountAutomatic.lean | 65 + .../BGS/HasseWeil/IdealMultiplicityMap.lean | 58 + .../BGS/HasseWeil/LinearFunctionalGluing.lean | 87 + .../LocalPoleCumulativeQuotient.lean | 211 ++ .../BGS/HasseWeil/LocalPoleFiltration.lean | 222 ++ .../BGS/HasseWeil/OnePointBase.lean | 206 ++ .../BGS/HasseWeil/OnePointDivisorSplit.lean | 140 ++ .../BGS/HasseWeil/OnePointHeight.lean | 121 ++ .../BGS/HasseWeil/OnePointIncrement.lean | 134 ++ .../HasseWeil/OnePointLeadingCoefficient.lean | 585 ++++++ .../BGS/HasseWeil/OnePointPoleSemigroup.lean | 292 +++ .../HasseWeil/OnePointSectionSelection.lean | 229 +++ .../HasseWeil/OnePointStepanovBasisGrid.lean | 175 ++ .../OnePointStepanovDegreeTwoAuxiliary.lean | 241 +++ .../BGS/HasseWeil/OnePointStepanovGrid.lean | 292 +++ .../BGS/HasseWeil/OnePointStrictLevels.lean | 231 +++ .../HasseWeil/PlaneAffineCountTransfer.lean | 170 ++ .../BGS/HasseWeil/PlaneAffineFiberBound.lean | 161 ++ .../PlaneAffineHasseWeilFromEvenError.lean | 299 +++ .../PlaneAffineHasseWeilFromZeta.lean | 398 ++++ .../PlaneAffineRationalPlaceComparison.lean | 297 +++ .../BGS/HasseWeil/PlaneConstantField.lean | 371 ++++ .../BGS/HasseWeil/PlaneCoordinatePole.lean | 232 +++ .../PlaneCoordinatePoleAtInfinity.lean | 342 ++++ .../BGS/HasseWeil/PlaneCoordinateShear.lean | 479 +++++ .../PlaneCurveGenusBoundAutomatic.lean | 176 ++ .../PlaneCurveGenusBoundFromCotrace.lean | 155 ++ ...PlaneCurveGenusBoundFromCotraceDegree.lean | 170 ++ .../PlaneFinitePlaceRiemannLower.lean | 454 +++++ .../HasseWeil/PlaneFrobeniusDeflation.lean | 416 ++++ .../HasseWeil/PlaneFrobeniusDegenerate.lean | 219 ++ .../HasseWeil/PlaneFrobeniusReduction.lean | 234 +++ .../HasseWeil/PlaneInfinityRiemannLower.lean | 226 +++ .../BGS/HasseWeil/PlaneMonomialSpace.lean | 496 +++++ .../HasseWeil/PlaneOnePointRiemannLower.lean | 671 +++++++ .../PlaneRationalPlaceAffineComparison.lean | 1661 +++++++++++++++ .../BGS/HasseWeil/PlaneRegularPointCount.lean | 114 ++ .../HasseWeil/PlaneSingularPointBound.lean | 323 +++ .../PlaneSmoothPointNormalization.lean | 1125 +++++++++++ .../PlaneSquareFieldStepanovCount.lean | 274 +++ ...laneSquareFieldStepanovCountAutomatic.lean | 161 ++ .../BGS/HasseWeil/PlaneStepanovAuxiliary.lean | 353 ++++ .../BGS/HasseWeil/PoleDivisor.lean | 153 ++ .../BGS/HasseWeil/PolynomialSpectral.lean | 164 ++ .../BGS/HasseWeil/PolynomialTensorCancel.lean | 382 ++++ .../MarkoffModP/BGS/HasseWeil/PowerSum.lean | 158 ++ .../RatFuncCanonicalInfinityDivisor.lean | 130 ++ .../HasseWeil/RatFuncConstantExtension.lean | 305 +++ .../RatFuncExactConstantExtension.lean | 472 +++++ .../RatFuncInfinityLocalization.lean | 455 +++++ .../BGS/HasseWeil/RatFuncParameterPole.lean | 297 +++ .../BGS/HasseWeil/RationalPlace.lean | 223 ++ .../BGS/HasseWeil/RationalPlaceTower.lean | 92 + .../BGS/HasseWeil/RiemannSpaceConstants.lean | 134 ++ .../RiemannSpaceEffectiveIncrement.lean | 275 +++ .../RiemannSpaceFinitePlaceIncrement.lean | 406 ++++ .../RiemannSpaceInfinityPlaceIncrement.lean | 369 ++++ .../BGS/HasseWeil/SpectralFromAsymptotic.lean | 178 ++ .../SquareExtensionAffinePlaces.lean | 872 ++++++++ .../BGS/HasseWeil/SquareFieldResidue.lean | 81 + .../SquareFieldStepanovAuxiliary.lean | 131 ++ .../SquareFieldStepanovRestriction.lean | 475 +++++ .../SquareFieldStepanovZeroCount.lean | 113 ++ .../BGS/HasseWeil/StepanovLinearAlgebra.lean | 135 ++ .../BGS/HasseWeil/StepanovParameters.lean | 87 + .../HasseWeil/StepanovRestrictionMaps.lean | 316 +++ .../HasseWeil/StepanovSquareVanishing.lean | 383 ++++ .../BGS/HasseWeil/TensorRestriction.lean | 173 ++ .../BGS/HasseWeil/ZetaExtensionTrace.lean | 76 + .../BGS/HasseWeil/ZetaNumeratorSpectral.lean | 207 ++ .../MarkoffModP/BGS/HasseWeil/ZetaTrace.lean | 57 + .../MarkoffModP/BGS/Markoff/Assembly.lean | 20 + .../BGS/Markoff/Assembly/Asymptotics.lean | 85 + .../BGS/Markoff/Assembly/CoarseEndgame.lean | 133 ++ .../Markoff/Assembly/CoarseLinearTail.lean | 161 ++ .../Assembly/CoarseSupportSurjectivity.lean | 157 ++ .../Markoff/Assembly/CoarseSupportTail.lean | 415 ++++ .../Assembly/DivisibleOrbitTransitivity.lean | 123 ++ .../Markoff/Assembly/ElementaryCounts.lean | 365 ++++ .../EulerSevenCoarseSupportFrontier.lean | 86 + ...erSevenNonparabolicComplementFrontier.lean | 252 +++ ...erSevenPairedMaximalDivisorMiddleGame.lean | 137 ++ .../EulerSevenSplitCageCoarseLinearTail.lean | 93 + ...litCageNonparabolicComplementFrontier.lean | 66 + ...rSevenSplitCageSquareEnvelopeFrontier.lean | 83 + ...enSplitCageSquareEnvelopeSurjectivity.lean | 54 + .../EvenSignBaseStableComplement.lean | 86 + .../EvenSignComplementDivisibility.lean | 38 + .../Assembly/EvenSignOrbitDivisibility.lean | 255 +++ .../ExactOrderComplementObstruction.lean | 204 ++ ...tOrderEulerSevenComplementObstruction.lean | 272 +++ .../ExactOrderPuncturedSmallOrderCount.lean | 66 + .../Assembly/ExactOrderRankinEnvelope.lean | 481 +++++ .../Assembly/ExactOrderTraceBudget.lean | 162 ++ .../Assembly/ExceptionalPrimeCount.lean | 114 ++ .../ExplicitPuncturedTransitivity.lean | 328 +++ ...ixedPointFreeMaximalDivisorTraceCount.lean | 210 ++ .../BGS/Markoff/Assembly/GiantOrbit.lean | 323 +++ .../Assembly/JointMaximalDivisorFrontier.lean | 150 ++ .../Assembly/MaximalDivisorLowOrderCount.lean | 133 ++ .../Assembly/MaximalDivisorMiddleGame.lean | 142 ++ .../MaximalDivisorPuncturedTransitivity.lean | 236 +++ .../Assembly/MiddleGameThenEndgame.lean | 369 ++++ .../Assembly/NonparabolicBadComponent.lean | 64 + .../NonparabolicComplementFrontier.lean | 381 ++++ ...nparabolicMaximalDivisorConcreteCount.lean | 138 ++ .../NonparabolicPuncturedSmallOrderCount.lean | 139 ++ .../Markoff/Assembly/NormalizationCount.lean | 126 ++ .../Assembly/NormalizedSmallOrderCount.lean | 123 ++ .../Markoff/Assembly/OrbitDivisibility.lean | 379 ++++ .../PairedMaximalDivisorLowOrderCount.lean | 126 ++ .../PairedMaximalDivisorMiddleGame.lean | 143 ++ .../PairedMaximalDivisorTraceCount.lean | 124 ++ .../Assembly/PuncturedSmallOrderCount.lean | 147 ++ .../Assembly/RankinJointAntichainSperner.lean | 94 + .../Assembly/RankinJointAntichainWidth.lean | 212 ++ .../Markoff/Assembly/RankinWidthEnvelope.lean | 227 +++ .../Assembly/ReductionSurjectivity.lean | 54 + .../Assembly/SplitCageEvenSignBase.lean | 195 ++ ...litCageNonparabolicComplementFrontier.lean | 93 + .../Assembly/TransitivitySurjectivity.lean | 322 +++ .../BGS/Markoff/Assembly/Unconditional.lean | 39 + .../WeightedCoarseSupportSurjectivity.lean | 146 ++ LeanPool/MarkoffModP/BGS/Markoff/Cage.lean | 20 + .../BGS/Markoff/Cage/AxisEquivalence.lean | 292 +++ .../Cage/BiquadraticPrimitiveQuartic.lean | 269 +++ .../BGS/Markoff/Cage/Connectivity.lean | 257 +++ .../BGS/Markoff/Cage/EstimateFromPlane.lean | 328 +++ .../BGS/Markoff/Cage/HasseWeilAssumption.lean | 271 +++ .../BGS/Markoff/Cage/IncidenceGeometry.lean | 229 +++ .../Markoff/Cage/PlaneCountComparison.lean | 763 +++++++ .../BGS/Markoff/Cage/PlaneHasseWeil.lean | 161 ++ .../BGS/Markoff/Cage/PlaneModels.lean | 546 +++++ .../BGS/Markoff/Cage/PowerCover.lean | 275 +++ .../BGS/Markoff/Cage/PulledRadicand.lean | 266 +++ .../Cage/ShiftedTraceCurveIrreducibility.lean | 335 ++++ .../BGS/Markoff/Cage/SmallPrime.lean | 107 + .../BGS/Markoff/Cage/WitnessEquations.lean | 196 ++ LeanPool/MarkoffModP/BGS/Markoff/Core.lean | 20 + .../MarkoffModP/BGS/Markoff/Core/Action.lean | 454 +++++ .../MarkoffModP/BGS/Markoff/Core/Basic.lean | 196 ++ .../Markoff/Core/ConicParametrization.lean | 1173 +++++++++++ .../BGS/Markoff/Core/EvenSignAction.lean | 379 ++++ .../Core/FiniteRotationEigenvalues.lean | 116 ++ .../BGS/Markoff/Core/NatConnectivity.lean | 516 +++++ .../BGS/Markoff/Core/Normalization.lean | 263 +++ .../BGS/Markoff/Core/NormalizedOrbit.lean | 340 ++++ .../BGS/Markoff/Core/ParabolicFibers.lean | 456 +++++ .../Markoff/Core/PuncturedNormalization.lean | 73 + .../BGS/Markoff/Core/Rotation.lean | 107 + .../BGS/Markoff/Core/RotationTorus.lean | 285 +++ .../BGS/Markoff/Core/SemiringFunctor.lean | 301 +++ .../BGS/Markoff/Core/Statements.lean | 87 + .../BGS/Markoff/Core/TraceClassification.lean | 302 +++ .../MarkoffModP/BGS/Markoff/Diophantine.lean | 10 + .../Diophantine/CoordinateCoprimeProduct.lean | 146 ++ .../CoordinateZeroPatternCounts.lean | 110 + .../BGS/Markoff/Diophantine/LocalCounts.lean | 505 +++++ .../BGS/Markoff/Diophantine/PrimewiseCRT.lean | 401 ++++ LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean | 15 + .../Markoff/Endgame/LargeOrderToMaximal.lean | 110 + .../BGS/Markoff/Endgame/Nonsplit.lean | 11 + .../Nonsplit/CayleyParametrization.lean | 299 +++ .../Nonsplit/DescendedIrreducibility.lean | 450 +++++ .../Endgame/Nonsplit/DescendedTraceCurve.lean | 730 +++++++ .../Endgame/Nonsplit/HasseFromGeneral.lean | 109 + .../Markoff/Endgame/Nonsplit/SeededCover.lean | 215 ++ .../BGS/Markoff/Endgame/Parabolic.lean | 216 ++ .../Markoff/Endgame/PowerCoverCounting.lean | 106 + .../Endgame/PrimitiveInclusionExclusion.lean | 933 +++++++++ .../Markoff/Endgame/PrimitiveOrbitWiring.lean | 429 ++++ .../Markoff/Endgame/PrimitiveTraceCount.lean | 215 ++ .../Markoff/Endgame/WeilBoundAssumption.lean | 194 ++ .../Markoff/Endgame/WeilFromGeneralHasse.lean | 227 +++ .../BGS/Markoff/ExplicitEndgame.lean | 339 ++++ .../BGS/Markoff/ExplicitEstimates.lean | 55 + .../Markoff/ExplicitNumericCertificates.lean | 596 ++++++ .../BGS/Markoff/ExplicitNumerics.lean | 401 ++++ .../MarkoffModP/BGS/Markoff/Incidence.lean | 12 + .../BGS/Markoff/Incidence/CoordinateRing.lean | 843 ++++++++ .../Markoff/Incidence/Counterexamples.lean | 56 + .../BGS/Markoff/Incidence/Fibers.lean | 426 ++++ .../BGS/Markoff/Incidence/Geometry.lean | 177 ++ .../Markoff/Incidence/NormalizedGraph.lean | 692 +++++++ .../BGS/Markoff/Incidence/PointCount.lean | 364 ++++ .../MarkoffModP/BGS/Markoff/MiddleGame.lean | 24 + .../MiddleGame/CorvajaZannierEscape.lean | 69 + .../MiddleGame/CorvajaZannierFromGeneral.lean | 133 ++ .../MiddleGame/CorvajaZannierGeometry.lean | 192 ++ .../CorvajaZannierSeparability.lean | 126 ++ .../MiddleGame/CorvajaZannierSourceBound.lean | 116 ++ .../MiddleGame/CorvajaZannierStep.lean | 259 +++ .../MiddleGame/CosetTraceEquation.lean | 124 ++ .../Markoff/MiddleGame/Diagonalization.lean | 151 ++ .../BGS/Markoff/MiddleGame/DivisorRange.lean | 183 ++ .../EulerSevenPairedCorvajaZannierBound.lean | 122 ++ ...redMaximalDivisorCorvajaZannierEscape.lean | 57 + ...airedMaximalDivisorCorvajaZannierStep.lean | 246 +++ ...rSevenPairedMaximalDivisorOrderEscape.lean | 129 ++ .../MaximalDivisorCorvajaZannierEscape.lean | 119 ++ .../MaximalDivisorCorvajaZannierStep.lean | 238 +++ .../MaximalDivisorNonparabolicOrderCover.lean | 62 + .../MiddleGame/MaximalDivisorOrderCover.lean | 102 + .../MiddleGame/MaximalDivisorOrderEscape.lean | 144 ++ .../BGS/Markoff/MiddleGame/MoveWiring.lean | 184 ++ .../MiddleGame/NonparabolicUnionBound.lean | 108 + .../BGS/Markoff/MiddleGame/OrderEscape.lean | 188 ++ .../MiddleGame/PairedCorvajaZannierBound.lean | 143 ++ ...redMaximalDivisorCorvajaZannierEscape.lean | 59 + ...airedMaximalDivisorCorvajaZannierStep.lean | 255 +++ .../PairedMaximalDivisorOrderEscape.lean | 134 ++ .../Markoff/MiddleGame/ParabolicEscape.lean | 120 ++ .../MiddleGame/RightInversionPairing.lean | 163 ++ .../Markoff/MiddleGame/RightSubgroups.lean | 189 ++ .../Markoff/MiddleGame/TraceCurveWeights.lean | 105 + .../BGS/Markoff/MiddleGame/TraceEquation.lean | 140 ++ .../BGS/Markoff/MiddleGame/UnionBound.lean | 248 +++ .../MiddleGame/WeightedTraceBound.lean | 82 + .../MiddleGame/WeightedTraceEquation.lean | 357 ++++ .../MiddleGame/WeightedTraceEulerSeven.lean | 162 ++ .../WeightedTraceEulerSevenBound.lean | 80 + .../WeightedTraceEulerSevenLargeBound.lean | 135 ++ ...WeightedTraceEulerSevenPropositionTwo.lean | 262 +++ .../WeightedTracePoweredImageIndexTwo.lean | 146 ++ LeanPool/MarkoffModP/BGS/Markoff/Opening.lean | 22 + .../Opening/AlgebraicClosureTransport.lean | 288 +++ .../BGS/Markoff/Opening/CompatibleRoots.lean | 44 + .../BGS/Markoff/Opening/CyclotomicBound.lean | 271 +++ .../BGS/Markoff/Opening/CyclotomicDefect.lean | 123 ++ .../BGS/Markoff/Opening/CyclotomicNorm.lean | 204 ++ .../Markoff/Opening/CyclotomicReduction.lean | 217 ++ .../BGS/Markoff/Opening/EveryOrbitLarge.lean | 144 ++ .../BGS/Markoff/Opening/FiniteOrbit.lean | 126 ++ .../BGS/Markoff/Opening/OrbitCardBound.lean | 372 ++++ .../BGS/Markoff/Opening/OrderArithmetic.lean | 50 + .../Markoff/Opening/ParabolicPeriodicity.lean | 92 + .../Markoff/Opening/PeriodicSemisimple.lean | 101 + .../Markoff/Opening/RotationOrbitCard.lean | 69 + .../BGS/Markoff/Opening/TorsionTraces.lean | 71 + .../BGS/Markoff/Opening/TraceOrderBound.lean | 224 +++ .../BGS/Markoff/Opening/UnitCircle.lean | 73 + .../BGS/Markoff/PreliminaryEndgame.lean | 153 ++ .../BGS/Markoff/PreliminaryNumerics.lean | 581 ++++++ .../MarkoffModP/BGS/Markoff/TraceCurve.lean | 39 + .../TraceCurve/AffineNormalization.lean | 129 ++ .../TraceCurve/BiprojectiveClosure.lean | 471 +++++ .../TraceCurve/BiprojectiveScheme.lean | 157 ++ .../BGS/Markoff/TraceCurve/Boundary.lean | 210 ++ .../Markoff/TraceCurve/Characteristic.lean | 71 + .../Markoff/TraceCurve/ChartLocalization.lean | 566 ++++++ .../TraceCurve/CommonKummerIndependence.lean | 172 ++ .../TraceCurve/CommonPrimeKummerTower.lean | 411 ++++ .../BGS/Markoff/TraceCurve/Geometry.lean | 249 +++ .../IrreducibilityObstructions.lean | 147 ++ .../BGS/Markoff/TraceCurve/Kummer.lean | 586 ++++++ .../LaurentComparisonInjectivity.lean | 366 ++++ .../Markoff/TraceCurve/LaurentJacobian.lean | 204 ++ .../TraceCurve/LaurentNormalization.lean | 488 +++++ .../BGS/Markoff/TraceCurve/LaurentSmooth.lean | 426 ++++ .../BGS/Markoff/TraceCurve/Localization.lean | 396 ++++ .../BGS/Markoff/TraceCurve/NormalForm.lean | 156 ++ .../OddCommonPrimeIndependence.lean | 335 ++++ .../TraceCurve/OddCoprimeIrreducibility.lean | 439 ++++ .../PositiveCoprimeIrreducibility.lean | 689 +++++++ .../Markoff/TraceCurve/ProjectiveChart.lean | 34 + .../ProjectiveNormalizationCharts.lean | 263 +++ .../ProjectiveNormalizationMorphism.lean | 469 +++++ .../TraceCurve/ProjectivePointEstimate.lean | 267 +++ .../TraceCurve/SemanticNormalForm.lean | 255 +++ .../SyntacticDivisionCriterion.lean | 232 +++ .../SyntacticDivisionObstruction.lean | 140 ++ .../TraceCurve/SyntacticNormalForm.lean | 392 ++++ .../Markoff/TraceCurve/WeightedBidegree.lean | 79 + .../TraceCurve/WeightedEllipticModel.lean | 101 + .../TraceCurve/WeightedIrreducibility.lean | 332 +++ .../TraceCurve/WeightedNotSubtorus.lean | 254 +++ .../WeightedOddCoprimeIrreducibility.lean | 203 ++ .../BGS/NumberTheory/DivisorBound.lean | 139 ++ .../NumberTheory/ExplicitDivisorBound.lean | 143 ++ .../JointMaximalDivisorCertificate.lean | 66 + .../JointMaximalDivisorCriterion.lean | 71 + .../JointNeighborDivisorBound.lean | 290 +++ .../NumberTheory/MaximalDivisorBounds.lean | 168 ++ .../NonparabolicComplementCriterion.lean | 60 + .../OneSidedPrimitiveWitness.lean | 321 +++ .../NumberTheory/PreliminaryDivisorBound.lean | 384 ++++ .../NumberTheory/PrimePowerFactorization.lean | 130 ++ .../NumberTheory/RankinCanonicalProfile.lean | 297 +++ .../NumberTheory/RankinCutoff1248Data.lean | 83 + .../NumberTheory/RankinCutoff1248Profile.lean | 116 ++ .../RankinCutoff1248Skeleton.lean | 169 ++ .../RankinJointEnvelopeCertificate.lean | 585 ++++++ .../RankinJointEnvelopeCoverage.lean | 214 ++ .../RankinJointEnvelopeSummaryCoverage.lean | 235 +++ .../RankinPositionalCoverage.lean | 313 +++ .../NumberTheory/RankinPositionalProfile.lean | 150 ++ .../RankinPositionalSupportBound.lean | 155 ++ .../RankinProfileCertificate.lean | 295 +++ .../NumberTheory/RankinProfileMatching.lean | 773 +++++++ .../NumberTheory/TruncatedOrderTotient.lean | 82 + .../TruncatedOrderTotientRankin.lean | 170 ++ ...ncatedOrderTotientRankinFactorization.lean | 287 +++ .../NumberTheory/WeightedDivisorMoment.lean | 609 ++++++ .../WeightedNeighborDivisorBound.lean | 256 +++ LeanPool/MarkoffModP/Comparator/Solution.lean | 31 + .../RiemannRoch/AdeleSpace/Basic.lean | 249 +++ .../RiemannRoch/AdeleSpace/FilterChain.lean | 1113 ++++++++++ .../MarkoffModP/RiemannRoch/AxiomCheck.lean | 11 + LeanPool/MarkoffModP/RiemannRoch/Basic.lean | 86 + .../CoordinateFree/AdeleSpace.lean | 246 +++ .../RiemannRoch/CoordinateFree/AlgEquiv.lean | 290 +++ .../RiemannRoch/CoordinateFree/Divisor.lean | 221 ++ .../CoordinateFree/RiemannRoch.lean | 350 ++++ .../CoordinateFree/WeilDifferential.lean | 285 +++ LeanPool/MarkoffModP/RiemannRoch/Divisor.lean | 236 +++ .../RiemannRoch/FunctionField/Divisor.lean | 646 ++++++ .../RiemannRoch/Genus/AdeleQuotient.lean | 203 ++ .../MarkoffModP/RiemannRoch/Genus/Basic.lean | 353 ++++ .../MarkoffModP/RiemannRoch/Genus/Polar.lean | 746 +++++++ .../RiemannRoch/Genus/Ramification.lean | 390 ++++ .../MarkoffModP/RiemannRoch/LinearKneser.lean | 229 +++ .../MarkoffModP/RiemannRoch/LocalResidue.lean | 105 + LeanPool/MarkoffModP/RiemannRoch/Place.lean | 630 ++++++ .../MarkoffModP/RiemannRoch/PlaceEquiv.lean | 467 +++++ .../RiemannRoch/RRspace/Basic.lean | 942 +++++++++ .../RiemannRoch/RiemannRochTheorem/Basic.lean | 38 + .../RiemannRochTheorem/Corollaries.lean | 515 +++++ .../RiemannRoch/SeparableRelNorm.lean | 184 ++ .../RiemannRoch/WeilDifferential.lean | 9 + .../RiemannRoch/WeilDifferential/Basic.lean | 847 ++++++++ LeanPool/projects.yml | 28 + 612 files changed, 173060 insertions(+) create mode 100644 LeanPool/MarkoffModP.lean create mode 100644 LeanPool/MarkoffModP/BGS.lean create mode 100644 LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean create mode 100644 LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean create mode 100644 LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean create mode 100644 LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean create mode 100644 LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean create mode 100644 LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean create mode 100644 LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean create mode 100644 LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean create mode 100644 LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean create mode 100644 LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean create mode 100644 LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean create mode 100644 LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean create mode 100644 LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean create mode 100644 LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean create mode 100644 LeanPool/MarkoffModP/Comparator/Solution.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Basic.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Divisor.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/Place.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean create mode 100644 LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean diff --git a/LeanPool.lean b/LeanPool.lean index 50fa6e5b30..d9f99f2c76 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -3549,6 +3549,616 @@ import LeanPool.MRiscX.Tactics.SpecificationTactics import LeanPool.MRiscX.Tactics.SplitLastSeq import LeanPool.MRiscX.Tactics.TacticUtil import LeanPool.MRiscX.Util.BasicTheorems +import LeanPool.MarkoffModP +import LeanPool.MarkoffModP.BGS +import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution +import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient +import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentSpernerBridge +import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid +import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle +import LeanPool.MarkoffModP.BGS.CorvajaZannier +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalMonogenicity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit +import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius +import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder +import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRegularity +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteLinearIndependenceBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts +import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalField +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap +import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointPoleSemigroup +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing +import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace +import LeanPool.MarkoffModP.BGS.Markoff.Assembly +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Cage +import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime +import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations +import LeanPool.MarkoffModP.BGS.Markoff.Core +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction +import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues +import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor +import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT +import LeanPool.MarkoffModP.BGS.Markoff.Endgame +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics +import LeanPool.MarkoffModP.BGS.Markoff.Incidence +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo +import LeanPool.MarkoffModP.BGS.Markoff.Opening +import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction +import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic +import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion +import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds +import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion +import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization +import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment +import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound +import LeanPool.MarkoffModP.Comparator.Solution +import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.FilterChain +import LeanPool.MarkoffModP.RiemannRoch.AxiomCheck +import LeanPool.MarkoffModP.RiemannRoch.Basic +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AdeleSpace +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.Divisor +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.WeilDifferential +import LeanPool.MarkoffModP.RiemannRoch.Divisor +import LeanPool.MarkoffModP.RiemannRoch.FunctionField.Divisor +import LeanPool.MarkoffModP.RiemannRoch.Genus.AdeleQuotient +import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic +import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar +import LeanPool.MarkoffModP.RiemannRoch.Genus.Ramification +import LeanPool.MarkoffModP.RiemannRoch.LinearKneser +import LeanPool.MarkoffModP.RiemannRoch.LocalResidue +import LeanPool.MarkoffModP.RiemannRoch.Place +import LeanPool.MarkoffModP.RiemannRoch.PlaceEquiv +import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic +import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Basic +import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Corollaries +import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm +import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential +import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic import LeanPool.MassFormula import LeanPool.MassFormula.Convergence import LeanPool.MassFormula.Defs diff --git a/LeanPool/MarkoffModP.lean b/LeanPool/MarkoffModP.lean new file mode 100644 index 0000000000..a9076c74d1 --- /dev/null +++ b/LeanPool/MarkoffModP.lean @@ -0,0 +1,626 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS +import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution +import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient +import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentSpernerBridge +import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid +import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle +import LeanPool.MarkoffModP.BGS.CorvajaZannier +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalMonogenicity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit +import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius +import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder +import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRegularity +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteLinearIndependenceBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts +import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalField +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap +import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointPoleSemigroup +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing +import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace +import LeanPool.MarkoffModP.BGS.Markoff.Assembly +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Cage +import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime +import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations +import LeanPool.MarkoffModP.BGS.Markoff.Core +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction +import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues +import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor +import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT +import LeanPool.MarkoffModP.BGS.Markoff.Endgame +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics +import LeanPool.MarkoffModP.BGS.Markoff.Incidence +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo +import LeanPool.MarkoffModP.BGS.Markoff.Opening +import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction +import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic +import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion +import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds +import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion +import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization +import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment +import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound +import LeanPool.MarkoffModP.Comparator.Solution +import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.FilterChain +import LeanPool.MarkoffModP.RiemannRoch.AxiomCheck +import LeanPool.MarkoffModP.RiemannRoch.Basic +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AdeleSpace +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.Divisor +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.WeilDifferential +import LeanPool.MarkoffModP.RiemannRoch.Divisor +import LeanPool.MarkoffModP.RiemannRoch.FunctionField.Divisor +import LeanPool.MarkoffModP.RiemannRoch.Genus.AdeleQuotient +import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic +import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar +import LeanPool.MarkoffModP.RiemannRoch.Genus.Ramification +import LeanPool.MarkoffModP.RiemannRoch.LinearKneser +import LeanPool.MarkoffModP.RiemannRoch.LocalResidue +import LeanPool.MarkoffModP.RiemannRoch.Place +import LeanPool.MarkoffModP.RiemannRoch.PlaceEquiv +import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic +import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Basic +import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Corollaries +import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm +import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential +import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic + +/-! +# Markoff mod p + +Source: url:https://github.com/yuma-mizuno/markoff-modp +Authors: Yuma Mizuno +Status: verified +Main declarations: `BGS.Markoff.reduction_surjective_of_explicitBound` +Tags: markoff-equation, strong-approximation, finite-fields +MSC: 11D25 +-/ diff --git a/LeanPool/MarkoffModP/BGS.lean b/LeanPool/MarkoffModP/BGS.lean new file mode 100644 index 0000000000..bd344bd45d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv +import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution +import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius +import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +import LeanPool.MarkoffModP.BGS.CorvajaZannier +import LeanPool.MarkoffModP.BGS.Markoff.Core +import LeanPool.MarkoffModP.BGS.Markoff.Opening +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve +import LeanPool.MarkoffModP.BGS.Markoff.Endgame +import LeanPool.MarkoffModP.BGS.Markoff.Cage +import LeanPool.MarkoffModP.BGS.Markoff.Incidence +import LeanPool.MarkoffModP.BGS.Markoff.Assembly +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile diff --git a/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean b/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean new file mode 100644 index 0000000000..9ce2f4d210 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv + +/-! +# Cleared linear-fractional substitution + +For a polynomial `f` of degree `n`, this file studies the polynomial obtained from +`f ((a * X + b) / (c * X + d))` by multiplying by `(c * X + d) ^ n`. + +The degree assumption in the irreducibility theorem is essential: inversion sends the +linear polynomial `X` to the unit polynomial `1` after clearing its denominator. +-/ + +namespace BGS + +open Polynomial +open IntermediateField + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The denominator-cleared substitution +`(cX+d)^deg(f) f((aX+b)/(cX+d))`, written without division. -/ +def clearedLinearFractionalSubstitution (f : K[X]) (a b c d : K) : K[X] := + f.support.sum fun i ↦ C (f.coeff i) * (C a * X + C b) ^ i * + (C c * X + C d) ^ (f.natDegree - i) + +private theorem linearPolynomial_natDegree_le_one (u v : K) : + (C u * X + C v).natDegree ≤ 1 := by + calc + (C u * X + C v).natDegree ≤ max (C u * X).natDegree (C v).natDegree := + natDegree_add_le _ _ + _ ≤ 1 := max_le (natDegree_mul_le.trans (by simp)) (by simp) + +private theorem clearedLinearFractionalSummand_natDegree_le + (f : K[X]) (a b c d : K) {i : ℕ} (hi : i ≤ f.natDegree) : + (C (f.coeff i) * (C a * X + C b) ^ i * + (C c * X + C d) ^ (f.natDegree - i)).natDegree ≤ f.natDegree := by + have outerProductDegree : + (C (f.coeff i) * (C a * X + C b) ^ i * + (C c * X + C d) ^ (f.natDegree - i)).natDegree ≤ + (C (f.coeff i) * (C a * X + C b) ^ i).natDegree + + ((C c * X + C d) ^ (f.natDegree - i)).natDegree := + natDegree_mul_le + have innerProductDegree : + (C (f.coeff i) * (C a * X + C b) ^ i).natDegree ≤ + (C (f.coeff i)).natDegree + ((C a * X + C b) ^ i).natDegree := + natDegree_mul_le + calc + _ ≤ ((C (f.coeff i)).natDegree + ((C a * X + C b) ^ i).natDegree) + + ((C c * X + C d) ^ (f.natDegree - i)).natDegree := + outerProductDegree.trans (add_le_add innerProductDegree (le_refl _)) + _ ≤ (0 + i) + (f.natDegree - i) := by + apply add_le_add + · apply add_le_add + · simp + · exact natDegree_pow_le.trans <| + (Nat.mul_le_mul_left i (linearPolynomial_natDegree_le_one a b)).trans (by simp) + · exact natDegree_pow_le.trans <| + (Nat.mul_le_mul_left (f.natDegree - i) + (linearPolynomial_natDegree_le_one c d)).trans (by simp) + _ = f.natDegree := by omega + +theorem natDegree_clearedLinearFractionalSubstitution_le + (f : K[X]) (a b c d : K) : + (clearedLinearFractionalSubstitution f a b c d).natDegree ≤ f.natDegree := by + exact natDegree_sum_le_of_forall_le f.support _ fun i hi ↦ + clearedLinearFractionalSummand_natDegree_le f a b c d + (le_natDegree_of_ne_zero (mem_support_iff.mp hi)) + +theorem aeval_clearedLinearFractionalSubstitution + {L : Type*} [Field L] [Algebra K L] (f : K[X]) (a b c d : K) (x y : L) + (hrelation : + algebraMap K L a * x + algebraMap K L b = + y * (algebraMap K L c * x + algebraMap K L d)) : + aeval x (clearedLinearFractionalSubstitution f a b c d) = + (algebraMap K L c * x + algebraMap K L d) ^ f.natDegree * aeval y f := by + rw [clearedLinearFractionalSubstitution, map_sum] + simp only [map_mul, map_pow, aeval_def, eval₂_add, eval₂_mul, eval₂_C, eval₂_X] + calc + ∑ i ∈ f.support, + algebraMap K L (f.coeff i) * + (algebraMap K L a * x + algebraMap K L b) ^ i * + (algebraMap K L c * x + algebraMap K L d) ^ (f.natDegree - i) = + (algebraMap K L c * x + algebraMap K L d) ^ f.natDegree * + ∑ i ∈ f.support, algebraMap K L (f.coeff i) * y ^ i := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro i hi + have hiDegree : i ≤ f.natDegree := + le_natDegree_of_ne_zero (mem_support_iff.mp hi) + rw [hrelation, mul_pow] + have hpow : + (algebraMap K L c * x + algebraMap K L d) ^ i * + (algebraMap K L c * x + algebraMap K L d) ^ (f.natDegree - i) = + (algebraMap K L c * x + algebraMap K L d) ^ f.natDegree := by + rw [← pow_add, Nat.add_sub_of_le hiDegree] + rw [← hpow] + ring + _ = (algebraMap K L c * x + algebraMap K L d) ^ f.natDegree * aeval y f := by + rw [aeval_def, eval₂_eq_sum, sum_def] + +/-- An invertible linear-fractional change of variable preserves irreducibility after +clearing denominators at the degree of the polynomial. Degree at least two is necessary: +for the inversion matrix, the cleared transform of `X` is `1`. -/ +theorem irreducible_clearedLinearFractionalSubstitution + {f : K[X]} (hf : Irreducible f) (hfDegree : 2 ≤ f.natDegree) + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + Irreducible (clearedLinearFractionalSubstitution f a b c d) := by + letI : Fact (Irreducible f) := ⟨hf⟩ + let E := AdjoinRoot f + letI : FiniteDimensional K E := by + change FiniteDimensional K (AdjoinRoot f) + exact (AdjoinRoot.powerBasis hf.ne_zero).finite + let α : E := AdjoinRoot.root f + have hfDegreeNeOne : f.natDegree ≠ 1 := by omega + have hroot : aeval α f = 0 := by + change eval₂ (algebraMap K E) (AdjoinRoot.root f) f = 0 + exact AdjoinRoot.eval₂_root f + have hinverseDenominator : + algebraMap K E a - algebraMap K E c * α ≠ 0 := by + by_cases hc : c = 0 + · have ha : a ≠ 0 := by + intro ha + apply hdet + simp [ha, hc] + simp [hc, ha] + · intro hzero + have hcMap : algebraMap K E c ≠ 0 := by + simpa using (algebraMap K E).injective.ne hc + have hα : α = algebraMap K E (a / c) := by + rw [map_div₀ (algebraMap K E) a c] + apply (eq_div_iff hcMap).2 + have := sub_eq_zero.mp hzero + rw [mul_comm] + exact this.symm + exact hf.aeval_ne_zero_of_natDegree_ne_one hfDegreeNeOne + ⟨a / c, hα.symm⟩ hroot + let β : E := + (algebraMap K E d * α - algebraMap K E b) / + (algebraMap K E a - algebraMap K E c * α) + have hforwardDenominatorFormula : + algebraMap K E c * β + algebraMap K E d = + algebraMap K E (a * d - b * c) / + (algebraMap K E a - algebraMap K E c * α) := by + dsimp [β] + apply (eq_div_iff hinverseDenominator).2 + rw [add_mul, mul_assoc, div_mul_cancel₀ _ hinverseDenominator] + simp only [map_sub, map_mul] + ring + have hforwardDenominator : + algebraMap K E c * β + algebraMap K E d ≠ 0 := by + rw [hforwardDenominatorFormula] + exact div_ne_zero (by simpa using (algebraMap K E).injective.ne hdet) + hinverseDenominator + have hforwardNumeratorFormula : + algebraMap K E a * β + algebraMap K E b = + α * algebraMap K E (a * d - b * c) / + (algebraMap K E a - algebraMap K E c * α) := by + dsimp [β] + apply (eq_div_iff hinverseDenominator).2 + rw [add_mul, mul_assoc, div_mul_cancel₀ _ hinverseDenominator] + simp only [map_sub, map_mul] + ring + have hlinearFractionalRelation : + algebraMap K E a * β + algebraMap K E b = + α * (algebraMap K E c * β + algebraMap K E d) := by + rw [hforwardNumeratorFormula, hforwardDenominatorFormula] + ring + have hαFormula : + α = (algebraMap K E a * β + algebraMap K E b) / + (algebraMap K E c * β + algebraMap K E d) := by + apply (eq_div_iff hforwardDenominator).2 + exact hlinearFractionalRelation.symm + have hβGenerates : K⟮β⟯ = (⊤ : IntermediateField K E) := by + apply top_unique + rw [← IntermediateField.adjoin_root_eq_top f] + apply IntermediateField.adjoin_simple_le_iff.mpr + change α ∈ K⟮β⟯ + rw [hαFormula] + exact div_mem + (add_mem (mul_mem (IntermediateField.algebraMap_mem _ a) + (IntermediateField.mem_adjoin_simple_self K β)) + (IntermediateField.algebraMap_mem _ b)) + (add_mem (mul_mem (IntermediateField.algebraMap_mem _ c) + (IntermediateField.mem_adjoin_simple_self K β)) + (IntermediateField.algebraMap_mem _ d)) + have hminpolyDegree : (minpoly K β).natDegree = f.natDegree := by + have hprimitive := (Field.primitive_element_iff_minpoly_natDegree_eq K β).mp hβGenerates + exact hprimitive.trans (AdjoinRoot.powerBasis hf.ne_zero).finrank + have htransformedRoot : + aeval β (clearedLinearFractionalSubstitution f a b c d) = 0 := by + rw [aeval_clearedLinearFractionalSubstitution f a b c d β α + hlinearFractionalRelation, hroot, mul_zero] + have hminpolyDvd : minpoly K β ∣ clearedLinearFractionalSubstitution f a b c d := + minpoly.dvd K β htransformedRoot + have htransformedNonzero : clearedLinearFractionalSubstitution f a b c d ≠ 0 := by + intro hzero + let q := Algebra.ratFuncLinearFractionalValue a b c d + have hden := Algebra.ratFuncLinearFractional_denominator_ne_zero hdet + have hrelation : + RatFunc.C a * RatFunc.X + RatFunc.C b = + q * (RatFunc.C c * RatFunc.X + RatFunc.C d) := by + dsimp [q, Algebra.ratFuncLinearFractionalValue] + exact (div_mul_cancel₀ _ hden).symm + have heval := aeval_clearedLinearFractionalSubstitution f a b c d RatFunc.X q hrelation + rw [hzero, map_zero] at heval + have hqTranscendental : Transcendental K q := + Algebra.ratFuncLinearFractionalValue_transcendental hdet + have hfAtQ : aeval q f ≠ 0 := by + intro hqRoot + exact hf.ne_zero ((transcendental_iff.mp hqTranscendental) f hqRoot) + exact (mul_ne_zero (pow_ne_zero _ hden) hfAtQ) heval.symm + have hassociated : + Associated (minpoly K β) (clearedLinearFractionalSubstitution f a b c d) := by + apply associated_of_dvd_of_natDegree_le hminpolyDvd htransformedNonzero + · rw [hminpolyDegree] + exact natDegree_clearedLinearFractionalSubstitution_le f a b c d + exact hassociated.irreducible_iff.mp (minpoly.irreducible (Algebra.IsIntegral.isIntegral β)) + +end + +end BGS diff --git a/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean b/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean new file mode 100644 index 0000000000..e71b9210bb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.Derivation.Basic +import Mathlib.LinearAlgebra.Matrix.ToLinearEquiv +import Mathlib.LinearAlgebra.Finsupp.LinearCombination +import Mathlib.Tactic.LinearCombination + +/-! +# Ordinary Wronskians over differential fields + +Corvaja--Zannier's positive-characteristic argument uses an ordinary Wronskian over the +subfield of constants of a derivation. This file proves the required algebraic criterion: +a finite family is linearly independent over the exact constant field if and only if its +Wronskian determinant is nonzero. + +The reverse implication is the difficult direction. Its proof normalizes a nonzero kernel +vector, differentiates the resulting row relations, deletes the normalized coordinate, and +applies induction to the smaller Wronskian. +-/ + +namespace BGS.Algebra + +noncomputable section + +open scoped Matrix + +variable {C L : Type*} [Field C] [Field L] [Algebra C L] + +/-- The ordinary Wronskian matrix of a finite family with respect to a derivation. -/ +def derivationWronskian (D : Derivation C L L) {n : ℕ} (f : Fin n → L) : + Matrix (Fin n) (Fin n) L := + fun i j ↦ (D.toLinearMap ^ (i : ℕ)) (f j) + +private lemma derivation_iterate_succ (D : Derivation C L L) (n : ℕ) (x : L) : + D ((D.toLinearMap ^ n) x) = (D.toLinearMap ^ (n + 1)) x := by + rw [pow_succ', Module.End.mul_apply] + rfl + +/-- If every element killed by `D` comes from `C`, then a family linearly independent over +`C` has nonzero ordinary Wronskian. -/ +theorem derivationWronskian_det_ne_zero_of_linearIndependent + (D : Derivation C L L) + (constants : ∀ x : L, D x = 0 → ∃ c : C, algebraMap C L c = x) : + ∀ (n : ℕ) (f : Fin n → L), LinearIndependent C f → + (derivationWronskian D f).det ≠ 0 := by + intro n + induction n with + | zero => + intro f hf + simp + | succ n ih => + intro f hf hdet + let W : Matrix (Fin (n + 1)) (Fin (n + 1)) L := derivationWronskian D f + have hWdet : W.det = 0 := by simpa [W] using hdet + obtain ⟨a, ha_ne, haW⟩ := Matrix.exists_mulVec_eq_zero_iff.mpr hWdet + obtain ⟨k, hak⟩ : ∃ k, a k ≠ 0 := by + simpa [Function.ne_iff] using ha_ne + let c : Fin (n + 1) → L := fun j ↦ (a k)⁻¹ * a j + have hck : c k = 1 := by simp [c, hak] + have hcW : W *ᵥ c = 0 := by + funext i + simp only [Matrix.mulVec, dotProduct, Pi.zero_apply] + calc + ∑ j, W i j * c j = (a k)⁻¹ * ∑ j, W i j * a j := by + simp only [c] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro j hj + ring + _ = 0 := by + rw [show ∑ j, W i j * a j = 0 by + simpa [Matrix.mulVec, dotProduct] using congr_fun haW i, mul_zero] + have hc_relation (i : Fin (n + 1)) : + ∑ j, (D.toLinearMap ^ (i : ℕ)) (f j) * c j = 0 := by + simpa [W, derivationWronskian, Matrix.mulVec, dotProduct] using congr_fun hcW i + have hDck : D (c k) = 0 := by simp [hck] + let g : Fin n → L := fun j ↦ f (k.succAbove j) + have hg : LinearIndependent C g := + hf.comp k.succAbove k.succAbove_right_injective + have hWgdet : (derivationWronskian D g).det ≠ 0 := ih g hg + let b : Fin n → L := fun j ↦ D (c (k.succAbove j)) + have hfull (i : Fin n) : + ∑ j : Fin (n + 1), + (D.toLinearMap ^ (i : ℕ)) (f j) * D (c j) = 0 := by + have hderiv := congrArg D (hc_relation i.castSucc) + have hnext := hc_relation i.succ + simp only [map_zero, map_sum, D.leibniz, smul_eq_mul, + derivation_iterate_succ] at hderiv + have hindex (j : Fin (n + 1)) : + (D.toLinearMap ^ (((i.castSucc : Fin (n + 1)) : ℕ) + 1)) (f j) = + (D.toLinearMap ^ ((i.succ : Fin (n + 1)) : ℕ)) (f j) := by + simp + simp_rw [hindex] at hderiv + have hnext' : + ∑ j : Fin (n + 1), + c j * (D.toLinearMap ^ ((i.succ : Fin (n + 1)) : ℕ)) (f j) = 0 := by + simpa [mul_comm] using hnext + rw [Finset.sum_add_distrib] at hderiv + have hderiv' : + (∑ j : Fin (n + 1), (D.toLinearMap ^ (i : ℕ)) (f j) * D (c j)) + + ∑ j : Fin (n + 1), + c j * (D.toLinearMap ^ ((i.succ : Fin (n + 1)) : ℕ)) (f j) = 0 := by + simpa using hderiv + linear_combination hderiv' - hnext' + have hWgb : derivationWronskian D g *ᵥ b = 0 := by + funext i + simp only [Matrix.mulVec, dotProduct, Pi.zero_apply, b, g, + derivationWronskian] + have hi := hfull i + rw [Fin.sum_univ_succAbove (fun j : Fin (n + 1) ↦ + (D.toLinearMap ^ (i : ℕ)) (f j) * D (c j)) k] at hi + simpa [hDck] using hi + have hbzero : b = 0 := Matrix.eq_zero_of_mulVec_eq_zero hWgdet hWgb + have hDc (j : Fin (n + 1)) : D (c j) = 0 := by + by_cases hj : j = k + · simpa [hj] using hDck + · obtain ⟨r, hr⟩ := Fin.exists_succAbove_eq hj + have := congr_fun hbzero r + simpa [b, hr] using this + choose coeff hcoeff using fun j ↦ constants (c j) (hDc j) + have hcoeff_relation : ∑ j, coeff j • f j = 0 := by + have hzero := hc_relation 0 + simpa [hcoeff, Algebra.smul_def, mul_comm] using hzero + have hcoeff_zero : ∀ j, coeff j = 0 := + (Fintype.linearIndependent_iff.mp hf) coeff hcoeff_relation + have : (1 : L) = 0 := by + rw [← hck, ← hcoeff k, hcoeff_zero k, map_zero] + exact one_ne_zero this + +/-- A nonzero Wronskian determinant implies linear independence over the derivation's +scalar field. -/ +theorem linearIndependent_of_derivationWronskian_det_ne_zero + (D : Derivation C L L) {n : ℕ} (f : Fin n → L) + (hdet : (derivationWronskian D f).det ≠ 0) : + LinearIndependent C f := by + let W := derivationWronskian D f + have hcols : LinearIndependent L W.col := + Matrix.linearIndependent_cols_of_det_ne_zero hdet + rw [Fintype.linearIndependent_iff] + intro g hg j + let gL : Fin n → L := fun i ↦ algebraMap C L (g i) + have hcomb : ∑ i, gL i • W.col i = 0 := by + funext r + have hrow := congrArg (fun x ↦ (D.toLinearMap ^ (r : ℕ)) x) hg + simp only [map_sum, LinearMap.map_smul] at hrow + simpa [W, gL, derivationWronskian, Algebra.smul_def] using hrow + have hgj : gL j = 0 := Fintype.linearIndependent_iff.mp hcols gL hcomb j + exact (algebraMap C L).injective (by simpa [gL] using hgj) + +/-- The ordinary Wronskian criterion when `C` is exactly the field of constants of `D`. -/ +theorem derivationWronskian_det_ne_zero_iff_linearIndependent + (D : Derivation C L L) + (constants : ∀ x : L, D x = 0 → ∃ c : C, algebraMap C L c = x) + {n : ℕ} (f : Fin n → L) : + (derivationWronskian D f).det ≠ 0 ↔ LinearIndependent C f := by + exact ⟨linearIndependent_of_derivationWronskian_det_ne_zero D f, + derivationWronskian_det_ne_zero_of_linearIndependent D constants n f⟩ + +end + +end BGS.Algebra diff --git a/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean b/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean new file mode 100644 index 0000000000..55550ee2b9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean @@ -0,0 +1,167 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.KummerExtension + +/-! +# Eigencharacter descent in a cyclic Kummer extension + +If a prime power of an element in `F(eta)`, with `eta ^ e = v`, lies in the base field and the +base contains a primitive `e`-th root of unity, the element has only one Kummer character. The +proof constructs the root-scaling automorphism and compares coefficients in the canonical power +basis. This is the generic descent needed before applying trace-curve Kummer-class independence +at primes dividing both cover exponents. +-/ + +open Polynomial AdjoinRoot + +noncomputable section + +universe u + +namespace BGS.Algebra + +variable {F : Type u} [Field F] + +lemma kummerPowerBasis_eigenvector_eq_rootMonomial + {e : ℕ} (he : 0 < e) {v ζ : F} + (hζ : IsPrimitiveRoot ζ e) + (T : AdjoinRoot (X ^ e - C v) →ₐ[F] AdjoinRoot (X ^ e - C v)) + (hTroot : T (AdjoinRoot.root (X ^ e - C v)) = + algebraMap F (AdjoinRoot (X ^ e - C v)) ζ * + AdjoinRoot.root (X ^ e - C v)) + (k : Fin (X ^ e - C v).natDegree) (z : AdjoinRoot (X ^ e - C v)) + (hz : T z = algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ (k : ℕ)) * z) : + ∃ c : F, z = algebraMap F (AdjoinRoot (X ^ e - C v)) c * + AdjoinRoot.root (X ^ e - C v) ^ (k : ℕ) := by + let hmonic := monic_X_pow_sub_C v he.ne' + let b := AdjoinRoot.powerBasisAux' hmonic + have hpb (j : Fin (X ^ e - C v).natDegree) : b j = + AdjoinRoot.root (X ^ e - C v) ^ (j : ℕ) := by + change (AdjoinRoot.powerBasis' hmonic).basis j = _ + exact (AdjoinRoot.powerBasis' hmonic).basis_eq_pow j + have hTbasis (j : Fin (X ^ e - C v).natDegree) : + T (b j) = (ζ ^ (j : ℕ)) • b j := by + rw [hpb, map_pow, hTroot, mul_pow, ← map_pow] + simp only [Algebra.smul_def] + have hTcoord (j : Fin (X ^ e - C v).natDegree) : + b.repr (T z) j = ζ ^ (j : ℕ) * b.repr z j := by + conv_lhs => rw [← b.sum_repr z] + simp only [map_sum, map_smul, hTbasis, smul_smul] + classical + rw [Finset.sum_apply'] + change (∑ c, (((b.repr z c * ζ ^ (c : ℕ)) • b.repr (b c)) j)) = _ + rw [Finset.sum_eq_single j] + · simp [mul_comm] + · intro c _ hc + simp [hc] + · simp + have hzcoord (j : Fin (X ^ e - C v).natDegree) : + ζ ^ (j : ℕ) * b.repr z j = + ζ ^ (k : ℕ) * b.repr z j := by + have h := congrArg (fun w ↦ b.repr w j) hz + rw [hTcoord] at h + rw [← Algebra.smul_def] at h + rw [map_smul] at h + simpa using h + let c := b.repr z k + refine ⟨c, ?_⟩ + rw [← hpb] + apply b.repr.injective + ext j + rw [← Algebra.smul_def] + rw [map_smul] + simp only [Finsupp.smul_apply, b.repr_self_apply] + by_cases hjk : j = k + · subst k + simp [c] + · have hpowers : ζ ^ (j : ℕ) ≠ ζ ^ (k : ℕ) := by + intro hp + apply hjk + apply Fin.ext + apply hζ.pow_inj + · exact lt_of_lt_of_eq j.isLt natDegree_X_pow_sub_C + · exact lt_of_lt_of_eq k.isLt natDegree_X_pow_sub_C + · exact hp + have hcoeff : b.repr z j = 0 := by + have hmul : (ζ ^ (j : ℕ) - ζ ^ (k : ℕ)) * b.repr z j = 0 := by + rw [sub_mul, hzcoord j, sub_self] + exact (mul_eq_zero.mp hmul).resolve_left (sub_ne_zero.mpr hpowers) + rw [hcoeff] + simp [Ne.symm hjk] + +/-- If a prime power of an element of a Kummer extension lies in the base field, then the +element occupies one residue character. The exponent `k` satisfies the exact invariance +condition `e ∣ q*k`; no coprimality between `q` and `e` is assumed. -/ +theorem exists_rootMonomial_of_primePower_mem_base + {e q : ℕ} (he : 0 < e) {v ζ a : F} + (hζ : IsPrimitiveRoot ζ e) + (hirr : Irreducible (X ^ e - C v)) + (hq : q.Prime) (hqe : q ∣ e) + (z : AdjoinRoot (X ^ e - C v)) + (hzq : z ^ q = algebraMap F (AdjoinRoot (X ^ e - C v)) a) : + ∃ k < e, e ∣ q * k ∧ ∃ c : F, + z = algebraMap F (AdjoinRoot (X ^ e - C v)) c * + AdjoinRoot.root (X ^ e - C v) ^ k := by + letI : Fact (Irreducible (X ^ e - C v)) := ⟨hirr⟩ + letI : NeZero e := ⟨he.ne'⟩ + let ζe : rootsOfUnity e F := rootsOfUnity.mkOfPowEq ζ hζ.pow_eq_one + let T : AdjoinRoot (X ^ e - C v) →ₐ[F] AdjoinRoot (X ^ e - C v) := + autAdjoinRootXPowSubCHom e v ζe + have hTroot : T (AdjoinRoot.root (X ^ e - C v)) = + algebraMap F (AdjoinRoot (X ^ e - C v)) ζ * + AdjoinRoot.root (X ^ e - C v) := by + dsimp [T, autAdjoinRootXPowSubCHom] + simp [ζe, rootsOfUnity.mkOfPowEq, Algebra.smul_def] + by_cases hz : z = 0 + · refine ⟨0, he, by simp, 0, ?_⟩ + simp [hz] + let s := e / q + have hspos : 0 < s := by + exact Nat.div_pos (Nat.le_of_dvd he hqe) hq.pos + have hfactor : e = s * q := by + exact (Nat.div_mul_cancel hqe).symm + have hζqF : IsPrimitiveRoot (ζ ^ s) q := hζ.pow he hfactor + have hζqL : IsPrimitiveRoot + (algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ s)) q := + hζqF.map_of_injective (algebraMap F (AdjoinRoot (X ^ e - C v))).injective + have hTpow : (T z) ^ q = z ^ q := by + calc + (T z) ^ q = T (z ^ q) := by rw [map_pow] + _ = T (algebraMap F (AdjoinRoot (X ^ e - C v)) a) := by rw [hzq] + _ = algebraMap F (AdjoinRoot (X ^ e - C v)) a := T.commutes a + _ = z ^ q := hzq.symm + have hratioPow : (T z / z) ^ q = 1 := by + rw [div_pow, hTpow, div_self (pow_ne_zero q hz)] + letI : NeZero q := ⟨hq.ne_zero⟩ + obtain ⟨m, hm, hmratio⟩ := hζqL.eq_pow_of_pow_eq_one hratioPow + have hTz : T z = + algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ (s * m)) * z := by + calc + T z = (T z / z) * z := (div_mul_cancel₀ (T z) hz).symm + _ = (algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ s)) ^ m * z := by + rw [hmratio] + _ = algebraMap F (AdjoinRoot (X ^ e - C v)) ((ζ ^ s) ^ m) * z := by + simp only [map_pow] + _ = algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ (s * m)) * z := by + rw [pow_mul] + have hkmLt : s * m < e := by + calc + s * m < s * q := (Nat.mul_lt_mul_left hspos).2 hm + _ = e := hfactor.symm + have hdeg : (X ^ e - C v).natDegree = e := natDegree_X_pow_sub_C + let kfin : Fin (X ^ e - C v).natDegree := ⟨s * m, by simpa [hdeg] using hkmLt⟩ + have hTzFin : T z = + algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ (kfin : ℕ)) * z := hTz + obtain ⟨c, hc⟩ := kummerPowerBasis_eigenvector_eq_rootMonomial + he hζ T hTroot kfin z hTzFin + refine ⟨s * m, hkmLt, ?_, c, hc⟩ + refine ⟨m, ?_⟩ + calc + q * (s * m) = (s * q) * m := by ac_rfl + _ = e * m := by rw [← hfactor] + +end BGS.Algebra diff --git a/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean b/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean new file mode 100644 index 0000000000..342b7dc690 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.RatFunc.IntermediateField + +/-! +# Linear-fractional automorphisms of a rational function field + +An invertible matrix `((a, b), (c, d))` acts on `K(X)` by sending +`X` to `(aX+b)/(cX+d)`. This file constructs that action as a `K`-algebra +equivalence and records its action on `X` and on embedded polynomials. +-/ + +namespace BGS.Algebra + +open IntermediateField Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The value of the linear-fractional substitution associated to +`((a, b), (c, d))` at the rational-function variable. -/ +def ratFuncLinearFractionalValue (a b c d : K) : RatFunc K := + (RatFunc.C a * RatFunc.X + RatFunc.C b) / + (RatFunc.C c * RatFunc.X + RatFunc.C d) + +private lemma linearPolynomial_ne_zero_of_determinant_ne_zero + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + (C c * X + C d : K[X]) ≠ 0 := by + intro h + have hc : c = 0 := by + have hcoeff := congrArg (fun f : K[X] => f.coeff 1) h + simpa using hcoeff + have hd : d = 0 := by + have hcoeff := congrArg (fun f : K[X] => f.coeff 0) h + simpa using hcoeff + apply hdet + simp [hc, hd] + +lemma ratFuncLinearFractional_denominator_ne_zero + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + RatFunc.C c * RatFunc.X + RatFunc.C d ≠ 0 := by + simpa only [map_add, map_mul, RatFunc.algebraMap_X, RatFunc.algebraMap_C] using + RatFunc.algebraMap_ne_zero + (linearPolynomial_ne_zero_of_determinant_ne_zero hdet) + +lemma ratFuncLinearFractionalValue_not_constant + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + ¬ ∃ k : K, ratFuncLinearFractionalValue a b c d = RatFunc.C k := by + rintro ⟨k, hk⟩ + have hden := ratFuncLinearFractional_denominator_ne_zero hdet + have hcross : + RatFunc.C a * RatFunc.X + RatFunc.C b = + RatFunc.C k * (RatFunc.C c * RatFunc.X + RatFunc.C d) := + (div_eq_iff hden).mp hk + have hpoly : + (C a * X + C b : K[X]) = C k * (C c * X + C d) := by + apply RatFunc.algebraMap_injective K + simpa only [map_add, map_mul, RatFunc.algebraMap_X, RatFunc.algebraMap_C] using hcross + have ha : a = k * c := by + have hcoeff := congrArg (fun f : K[X] => f.coeff 1) hpoly + simpa using hcoeff + have hb : b = k * d := by + have hcoeff := congrArg (fun f : K[X] => f.coeff 0) hpoly + simpa using hcoeff + apply hdet + rw [ha, hb] + ring + +lemma ratFuncLinearFractionalValue_transcendental + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + Transcendental K (ratFuncLinearFractionalValue a b c d) := + RatFunc.transcendental_of_ne_C _ + (ratFuncLinearFractionalValue_not_constant hdet) + +lemma ratFuncLinearFractionalValue_inverse_formula + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + RatFunc.X = + (RatFunc.C d * ratFuncLinearFractionalValue a b c d - RatFunc.C b) / + (RatFunc.C a - RatFunc.C c * ratFuncLinearFractionalValue a b c d) := by + have hden := ratFuncLinearFractional_denominator_ne_zero hdet + have hdetRat : RatFunc.C (a * d - b * c) ≠ (0 : RatFunc K) := by + simpa using RatFunc.C_injective.ne hdet + have hvalue_mul_denominator : + ratFuncLinearFractionalValue a b c d * + (RatFunc.C c * RatFunc.X + RatFunc.C d) = + RatFunc.C a * RatFunc.X + RatFunc.C b := by + rw [ratFuncLinearFractionalValue] + exact div_mul_cancel₀ _ hden + have hinverseNumerator : + RatFunc.C d * ratFuncLinearFractionalValue a b c d - RatFunc.C b = + RatFunc.C (a * d - b * c) * RatFunc.X / + (RatFunc.C c * RatFunc.X + RatFunc.C d) := by + apply (eq_div_iff hden).2 + calc + (RatFunc.C d * ratFuncLinearFractionalValue a b c d - RatFunc.C b) * + (RatFunc.C c * RatFunc.X + RatFunc.C d) = + RatFunc.C d * + (ratFuncLinearFractionalValue a b c d * + (RatFunc.C c * RatFunc.X + RatFunc.C d)) - + RatFunc.C b * (RatFunc.C c * RatFunc.X + RatFunc.C d) := by ring + _ = RatFunc.C (a * d - b * c) * RatFunc.X := by + rw [hvalue_mul_denominator] + simp only [map_sub, map_mul] + ring + have hinverseDenominator : + RatFunc.C a - RatFunc.C c * ratFuncLinearFractionalValue a b c d = + RatFunc.C (a * d - b * c) / + (RatFunc.C c * RatFunc.X + RatFunc.C d) := by + apply (eq_div_iff hden).2 + calc + (RatFunc.C a - RatFunc.C c * ratFuncLinearFractionalValue a b c d) * + (RatFunc.C c * RatFunc.X + RatFunc.C d) = + RatFunc.C a * (RatFunc.C c * RatFunc.X + RatFunc.C d) - + RatFunc.C c * + (ratFuncLinearFractionalValue a b c d * + (RatFunc.C c * RatFunc.X + RatFunc.C d)) := by ring + _ = RatFunc.C (a * d - b * c) := by + rw [hvalue_mul_denominator] + simp only [map_sub, map_mul] + ring + rw [hinverseNumerator, hinverseDenominator] + rw [div_div_div_cancel_right₀ hden] + field_simp [hdetRat] + +lemma adjoin_ratFuncLinearFractionalValue_eq_top + {a b c d : K} (hdet : a * d - b * c ≠ 0) : + K⟮ratFuncLinearFractionalValue a b c d⟯ = + (⊤ : IntermediateField K (RatFunc K)) := by + apply top_unique + rw [← RatFunc.adjoin_X] + apply IntermediateField.adjoin_simple_le_iff.mpr + rw [ratFuncLinearFractionalValue_inverse_formula hdet] + exact div_mem + (sub_mem + (mul_mem (IntermediateField.algebraMap_mem _ d) + (IntermediateField.mem_adjoin_simple_self K + (ratFuncLinearFractionalValue a b c d))) + (IntermediateField.algebraMap_mem _ b)) + (sub_mem + (IntermediateField.algebraMap_mem _ a) + (mul_mem (IntermediateField.algebraMap_mem _ c) + (IntermediateField.mem_adjoin_simple_self K + (ratFuncLinearFractionalValue a b c d)))) + +/-- The `K`-algebra automorphism of `K(X)` induced by the invertible matrix +`((a, b), (c, d))`. -/ +def ratFuncLinearFractionalEquiv + (a b c d : K) (hdet : a * d - b * c ≠ 0) : + RatFunc K ≃ₐ[K] RatFunc K := + (RatFunc.algEquivOfTranscendental + (ratFuncLinearFractionalValue a b c d) + (ratFuncLinearFractionalValue_transcendental hdet)).trans + ((IntermediateField.equivOfEq + (adjoin_ratFuncLinearFractionalValue_eq_top hdet)).trans + IntermediateField.topEquiv) + +@[simp] +theorem ratFuncLinearFractionalEquiv_apply_X + (a b c d : K) (hdet : a * d - b * c ≠ 0) : + ratFuncLinearFractionalEquiv a b c d hdet RatFunc.X = + ratFuncLinearFractionalValue a b c d := by + simp [ratFuncLinearFractionalEquiv] + +@[simp] +theorem ratFuncLinearFractionalEquiv_apply_algebraMap + (a b c d : K) (hdet : a * d - b * c ≠ 0) (f : K[X]) : + ratFuncLinearFractionalEquiv a b c d hdet + (algebraMap K[X] (RatFunc K) f) = + Polynomial.aeval (ratFuncLinearFractionalValue a b c d) f := by + simp [ratFuncLinearFractionalEquiv] + +end + +end BGS.Algebra diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean new file mode 100644 index 0000000000..d806fe06ed --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean @@ -0,0 +1,165 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.AlgebraicGeometry.Gluing + +/-! +# Gluing schemes along one common open per chart + +This file packages a frequent special case of `Scheme.GlueData`: every off-diagonal overlap in a +chart is the same open subscheme. The triple-overlap pullbacks are therefore self-pullbacks of an +open immersion. Their projections are isomorphisms because open immersions are monomorphisms, +which makes the required pullback-level cocycle explicit. +-/ + +open CategoryTheory CategoryTheory.Limits + +namespace BGS + +noncomputable section + +universe v + +variable {J : Type v} + +/-- The off-diagonal `GlueData'` for charts that all use one fixed open subscheme per chart. + +The transition maps are required to compose strictly. This is the exact input needed to construct +the pullback transition `t'`; no gluing conclusion is assumed as a structure field. -/ +def constantOpenGlueDataAux + (U V : J → AlgebraicGeometry.Scheme.{v}) + (f : ∀ i, V i ⟶ U i) + [∀ i, AlgebraicGeometry.IsOpenImmersion (f i)] + (t : ∀ i j, V i ⟶ V j) + (t_id : ∀ i, t i i = 𝟙 _) + (t_comp : ∀ i j k, t i j ≫ t j k = t i k) : + CategoryTheory.GlueData' AlgebraicGeometry.Scheme.{v} where + J := J + U := U + V i _ _ := V i + f i _ _ := f i + f_mono := by intros; infer_instance + f_hasPullback := by intros; infer_instance + t i j _ := t i j + t' i j _ _ _ _ := + pullback.fst (f i) (f i) ≫ t i j ≫ inv (pullback.fst (f j) (f j)) + t_fac i j k _ _ _ := by + rw [← fst_eq_snd_of_mono_eq (f j)] + simp + t_inv i j _ := by + rw [t_comp, t_id] + cocycle i j k _ _ _ := by + have hcycle : t i j ≫ (t j k ≫ t k i) = 𝟙 _ := by + rw [← Category.assoc, t_comp i j k, t_comp i k i, t_id] + simpa [Category.assoc] using congrArg + (fun g : V i ⟶ V i ↦ + pullback.fst (f i) (f i) ≫ g ≫ inv (pullback.fst (f i) (f i))) hcycle + +/-- Glue schemes when every chart has one common overlap and the transition maps compose +strictly. -/ +def constantOpenGlueData + (U V : J → AlgebraicGeometry.Scheme.{v}) + (f : ∀ i, V i ⟶ U i) + [∀ i, AlgebraicGeometry.IsOpenImmersion (f i)] + (t : ∀ i j, V i ⟶ V j) + (t_id : ∀ i, t i i = 𝟙 _) + (t_comp : ∀ i j k, t i j ≫ t j k = t i k) : + AlgebraicGeometry.Scheme.GlueData where + toGlueData := CategoryTheory.GlueData.ofGlueData' + (constantOpenGlueDataAux U V f t t_id t_comp) + f_open i j := by + dsimp [CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f'] + split_ifs + · infer_instance + · change AlgebraicGeometry.IsOpenImmersion (eqToHom _ ≫ f i) + infer_instance + +/-- Glue schemes whose overlap in each chart is identified with one common scheme. The transition +from chart `i` to chart `j` is induced by passing through the common target, so identity and +composition are consequences of the isomorphism laws. -/ +def constantOpenGlueDataOfCommonTarget + (U V : J → AlgebraicGeometry.Scheme.{v}) + (f : ∀ i, V i ⟶ U i) + [∀ i, AlgebraicGeometry.IsOpenImmersion (f i)] + (W : AlgebraicGeometry.Scheme.{v}) + (s : ∀ i, V i ≅ W) : + AlgebraicGeometry.Scheme.GlueData := + constantOpenGlueData U V f + (fun i j ↦ (s i).hom ≫ (s j).inv) + (fun i ↦ Iso.hom_inv_id (s i)) + (fun i j k ↦ by simp) + +/-- A compatible family of chart morphisms and a morphism of their common overlaps descends to a +morphism between the glued schemes. The square `h` is the substantive input: it states that each +chart morphism restricts to the specified common-overlap morphism. -/ +def constantOpenGlueDataOfCommonTargetMap + (U V U' V' : J → AlgebraicGeometry.Scheme.{v}) + (f : ∀ i, V i ⟶ U i) [∀ i, AlgebraicGeometry.IsOpenImmersion (f i)] + (f' : ∀ i, V' i ⟶ U' i) [∀ i, AlgebraicGeometry.IsOpenImmersion (f' i)] + (W W' : AlgebraicGeometry.Scheme.{v}) + (s : ∀ i, V i ≅ W) (s' : ∀ i, V' i ≅ W') + (g : ∀ i, U i ⟶ U' i) (q : W ⟶ W') + (h : ∀ i, f i ≫ g i = (s i).hom ≫ q ≫ (s' i).inv ≫ f' i) : + (constantOpenGlueDataOfCommonTarget U V f W s).glued ⟶ + (constantOpenGlueDataOfCommonTarget U' V' f' W' s').glued := by + let D := constantOpenGlueDataOfCommonTarget U V f W s + let E := constantOpenGlueDataOfCommonTarget U' V' f' W' s' + let inc : ∀ i : J, U' i ⟶ E.glued := fun i ↦ E.ι i + have inc_transition (i j : J) (hij : i ≠ j) : + (s' i).hom ≫ (s' j).inv ≫ f' j ≫ inc j = f' i ≫ inc i := by + have hc := E.glue_condition i j + dsimp only [E, constantOpenGlueDataOfCommonTarget, constantOpenGlueData, + CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', + constantOpenGlueDataAux] at hc + simp only [dif_neg hij, dif_neg (Ne.symm hij)] at hc + simp at hc + exact (cancel_epi _).mp hc + fapply Multicoequalizer.desc + · exact fun i ↦ g i ≫ inc i + · rintro ⟨i, j⟩ + simp only [CategoryTheory.GlueData.diagram_fst, CategoryTheory.GlueData.diagram_snd] + change D.f i j ≫ g i ≫ inc i = + (D.t i j ≫ D.f j i) ≫ g j ≫ inc j + change J at i j + by_cases hij : i = j + · subst j + rw [D.t_id] + simp + · dsimp only [D, constantOpenGlueDataOfCommonTarget, constantOpenGlueData, + CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', + constantOpenGlueDataAux] + simp only [dif_neg hij, dif_neg (Ne.symm hij)] + simp + congr 1 + simp only [← Category.assoc] + rw [h i] + rw [Category.assoc ((s i).hom ≫ (s j).inv) (f j) (g j)] + rw [h j] + simp only [Category.assoc, Iso.inv_hom_id_assoc] + rw [← inc_transition i j hij] + simp + +/-- The descended morphism restricts to the prescribed morphism on every chart. -/ +@[reassoc] +theorem constantOpenGlueDataOfCommonTargetMap_chart + (U V U' V' : J → AlgebraicGeometry.Scheme.{v}) + (f : ∀ i, V i ⟶ U i) [∀ i, AlgebraicGeometry.IsOpenImmersion (f i)] + (f' : ∀ i, V' i ⟶ U' i) [∀ i, AlgebraicGeometry.IsOpenImmersion (f' i)] + (W W' : AlgebraicGeometry.Scheme.{v}) + (s : ∀ i, V i ≅ W) (s' : ∀ i, V' i ≅ W') + (g : ∀ i, U i ⟶ U' i) (q : W ⟶ W') + (h : ∀ i, f i ≫ g i = (s i).hom ≫ q ≫ (s' i).inv ≫ f' i) + (i : J) : + (constantOpenGlueDataOfCommonTarget U V f W s).ι i ≫ + constantOpenGlueDataOfCommonTargetMap U V U' V' f f' W W' s s' g q h = + g i ≫ (constantOpenGlueDataOfCommonTarget U' V' f' W' s').ι i := by + dsimp [constantOpenGlueDataOfCommonTargetMap] + unfold CategoryTheory.GlueData.ι + rw [Multicoequalizer.π_desc] + +end + +end BGS diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean new file mode 100644 index 0000000000..3c46837104 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.AlgebraicGeometry.GammaSpecAdjunction + +/-! +# Concrete `Spec` isomorphisms from ring equivalences + +The concrete constructor `AlgebraicGeometry.Spec` and the functor `Scheme.Spec` have propositionally +equivalent objects, but mixing them introduces equality transports in later compositions. This +module keeps affine scheme isomorphisms in the concrete `Spec` presentation used by the project. +-/ + +namespace BGS + +open CategoryTheory +open AlgebraicGeometry + +noncomputable section + +universe u + +variable {R S : Type u} [CommRing R] [CommRing S] + +/-- A ring equivalence induces the contravariant isomorphism of its concrete affine spectra. -/ +def specIsoOfRingEquiv (e : R ≃+* S) : + Spec (CommRingCat.of S) ≅ Spec (CommRingCat.of R) where + hom := Spec.map (CommRingCat.ofHom e.toRingHom) + inv := Spec.map (CommRingCat.ofHom e.symm.toRingHom) + hom_inv_id := by + rw [← Spec.map_comp, ← CommRingCat.ofHom_comp] + simp + inv_hom_id := by + rw [← Spec.map_comp, ← CommRingCat.ofHom_comp] + simp + +/-- Transport an equality between a two-step and a three-step ring map to the corresponding +contravariant equality of concrete affine-spectrum morphisms. -/ +theorem specMap_two_eq_three_of_comp_eq + {A B C B' C' : Type u} + [CommRing A] [CommRing B] [CommRing C] [CommRing B'] [CommRing C'] + (f : A →+* B) (g : B →+* C) + (f' : A →+* B') (g' : B' →+* C') (h' : C' →+* C) + (h : g.comp f = h'.comp (g'.comp f')) : + Spec.map (CommRingCat.ofHom g) ≫ Spec.map (CommRingCat.ofHom f) = + Spec.map (CommRingCat.ofHom h') ≫ Spec.map (CommRingCat.ofHom g') ≫ + Spec.map (CommRingCat.ofHom f') := by + rw [← Spec.map_comp, ← Spec.map_comp, ← Spec.map_comp] + rw [← CommRingCat.ofHom_comp, ← CommRingCat.ofHom_comp, + ← CommRingCat.ofHom_comp] + rw [h] + +/-- Contravariant `Spec` transports an equality between two two-step ring maps. -/ +theorem specMap_two_eq_two_of_comp_eq + {A B C B' : Type u} + [CommRing A] [CommRing B] [CommRing C] [CommRing B'] + (f : A →+* B) (g : B →+* C) (f' : A →+* B') (g' : B' →+* C) + (h : g.comp f = g'.comp f') : + Spec.map (CommRingCat.ofHom g) ≫ Spec.map (CommRingCat.ofHom f) = + Spec.map (CommRingCat.ofHom g') ≫ Spec.map (CommRingCat.ofHom f') := by + rw [← Spec.map_comp, ← Spec.map_comp] + rw [← CommRingCat.ofHom_comp, ← CommRingCat.ofHom_comp] + rw [h] + +end + +end BGS diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean new file mode 100644 index 0000000000..2d129ca2b8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner + +/-! +# Cardinality semantics of divisor-rank coefficients + +This identifies the executable coefficient recurrence used by factorization +payloads with the actual rank layers of the divisor exponent box. +-/ + +namespace BGS.NumberTheory + +/-- One rank layer in a divisor exponent box. -/ +abbrev DivisorExponentLayer + (factors : List PrimePowerFactor) (rank : ℕ) := + {exponentVector : DivisorExponentBox factors // + divisorExponentRank factors exponentVector = rank} + +private def divisorExponentLayerConsEquiv + (factor : PrimePowerFactor) (factors : List PrimePowerFactor) + (rank : ℕ) : + DivisorExponentLayer (factor :: factors) rank ≃ + Σ exponent : Fin (min factor.exponent rank + 1), + DivisorExponentLayer factors (rank - exponent) where + toFun exponentVector := by + have hexponentLeRank : + (exponentVector.1.2 : ℕ) ≤ rank := by + have hrank := exponentVector.2 + simp only [divisorExponentRank] at hrank + omega + have hexponentLeFactor : + (exponentVector.1.2 : ℕ) ≤ factor.exponent := + Nat.le_of_lt_succ exponentVector.1.2.isLt + let exponent : Fin (min factor.exponent rank + 1) := + ⟨exponentVector.1.2, Nat.lt_succ_iff.mpr + (le_min hexponentLeFactor hexponentLeRank)⟩ + have htail : + divisorExponentRank factors exponentVector.1.1 = + rank - exponent := by + have hrank := exponentVector.2 + simp only [divisorExponentRank] at hrank + dsimp [exponent] + omega + exact ⟨exponent, ⟨exponentVector.1.1, htail⟩⟩ + invFun point := by + have hexponentLeRank : + (point.1 : ℕ) ≤ rank := + (Nat.le_of_lt_succ point.1.isLt).trans (min_le_right _ _) + let exponent : Fin (factor.exponent + 1) := + ⟨point.1, Nat.lt_succ_iff.mpr + ((Nat.le_of_lt_succ point.1.isLt).trans + (min_le_left _ _))⟩ + have hrank : + divisorExponentRank factors point.2.1 + exponent = rank := by + have htail := point.2.2 + dsimp [exponent] + omega + exact ⟨(point.2.1, exponent), by + simp only [divisorExponentRank] + exact hrank⟩ + left_inv := by + intro exponentVector + apply Subtype.ext + apply Prod.ext + · rfl + · apply Fin.ext + rfl + right_inv := by + rintro ⟨exponent, tail⟩ + apply Sigma.ext + · apply Fin.ext + rfl + · apply heq_of_eq + apply Subtype.ext + rfl + +/-- The executable recurrence is exactly the cardinality of the corresponding +rank layer of the exponent box. -/ +theorem divisorExponentLayer_card_eq_divisorRankCoefficient + (factors : List PrimePowerFactor) (rank : ℕ) : + Fintype.card (DivisorExponentLayer factors rank) = + divisorRankCoefficient factors rank := by + induction factors generalizing rank with + | nil => + cases rank with + | zero => + simp [DivisorExponentLayer, DivisorExponentBox, + divisorExponentRank, divisorRankCoefficient] + | succ rank => + simp [DivisorExponentLayer, DivisorExponentBox, + divisorExponentRank, divisorRankCoefficient] + | cons factor factors ih => + calc + Fintype.card + (DivisorExponentLayer (factor :: factors) rank) = + Fintype.card + (Σ exponent : + Fin (min factor.exponent rank + 1), + DivisorExponentLayer factors (rank - exponent)) := + Fintype.card_congr + (divisorExponentLayerConsEquiv factor factors rank) + _ = ∑ exponent : + Fin (min factor.exponent rank + 1), + Fintype.card + (DivisorExponentLayer factors (rank - exponent)) := + Fintype.card_sigma + _ = ∑ exponent : + Fin (min factor.exponent rank + 1), + divisorRankCoefficient factors (rank - exponent) := by + apply Finset.sum_congr rfl + intro exponent hexponent + exact ih _ + _ = ∑ exponent ∈ + Finset.range (min factor.exponent rank + 1), + divisorRankCoefficient factors (rank - exponent) := by + exact + Fin.sum_univ_eq_sum_range + (fun exponent ↦ + divisorRankCoefficient factors (rank - exponent)) + (min factor.exponent rank + 1) + _ = divisorRankCoefficient (factor :: factors) rank := by + rfl + +theorem centralDivisorRankCoefficient_eq_layer_card + (factors : List PrimePowerFactor) : + centralDivisorRankCoefficient factors = + Fintype.card + (DivisorExponentLayer factors + (primePowerTotalExponent factors / 2)) := by + rw [centralDivisorRankCoefficient] + exact + (divisorExponentLayer_card_eq_divisorRankCoefficient factors + (primePowerTotalExponent factors / 2)).symm + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean new file mode 100644 index 0000000000..b9f4301019 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean @@ -0,0 +1,36 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient + +/-! +# The divisor-antichain central-coefficient bound + +This is the semantic bridge missing from a purely executable factorization +payload: the recomputed central coefficient really bounds every antichain in +the represented divisor exponent lattice. +-/ + +namespace BGS.NumberTheory + +open BGS.Combinatorics + +theorem divisorExponentAntichain_card_le_centralDivisorRankCoefficient + (factors : List PrimePowerFactor) + (antichain : Finset (DivisorExponentBox factors)) + (hantichain : + IsAntichain (· ≤ ·) (antichain : Set (DivisorExponentBox factors))) : + antichain.card ≤ centralDivisorRankCoefficient factors := by + letI := divisorExponentBoxFintype factors + letI := divisorExponentBoxPartialOrder factors + have hcentral := + (divisorExponentBoxDecomposition factors).antichain_card_le_central_rank + antichain hantichain + rw [divisorExponentTotal_eq_primePowerTotalExponent] at hcentral + rw [centralDivisorRankCoefficient_eq_layer_card] + exact hcentral + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean new file mode 100644 index 0000000000..be331a0c3d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Tactic + +/-! +# Symmetric chains in a rectangle + +This is the explicit de Bruijn--Tengbergen--Kruyswijk rectangle decomposition +used in the product-of-chains proof. A point `(x,y)` in +`[0,m] × [0,n]` is encoded by a chain key and a position on that chain. +The decoder is inverse to the encoder, preserves rank, and is monotone along +each chain. +-/ + +namespace BGS.Combinatorics + +/-- Key of the L-shaped symmetric chain containing `(x,y)`. -/ +def gridKey (m n x y : ℕ) : ℕ := + if m ≤ n then min y (m - x) else min x (n - y) + +/-- Position of `(x,y)` along its rectangle chain. -/ +def gridPosition (m n x y : ℕ) : ℕ := + x + y - gridKey m n x y + +/-- First coordinate of the point at position `t` on chain `k`. -/ +def gridDecodeX (m n k t : ℕ) : ℕ := + if m ≤ n then + if t ≤ m - k then t else m - k + else + if t ≤ n - k then k else t + 2 * k - n + +/-- Second coordinate of the point at position `t` on chain `k`. -/ +def gridDecodeY (m n k t : ℕ) : ℕ := + if m ≤ n then + if t ≤ m - k then k else t + 2 * k - m + else + if t ≤ n - k then t else n - k + +theorem gridKey_le_min + {m n x y : ℕ} (hx : x ≤ m) (hy : y ≤ n) : + gridKey m n x y ≤ min m n := by + by_cases hmn : m ≤ n + · rw [gridKey, if_pos hmn] + apply le_min + · exact (min_le_right _ _).trans (Nat.sub_le _ _) + · exact (min_le_left _ _).trans hy + · rw [gridKey, if_neg hmn] + apply le_min + · exact (min_le_left _ _).trans hx + · exact (min_le_right _ _).trans (Nat.sub_le _ _) + +theorem gridPosition_le + {m n x y : ℕ} (hx : x ≤ m) (hy : y ≤ n) : + gridPosition m n x y ≤ + m + n - 2 * gridKey m n x y := by + by_cases hmn : m ≤ n + · by_cases hshort : y ≤ m - x + · simp [gridPosition, gridKey, hmn, min_eq_left hshort] + omega + · have hreverse : m - x ≤ y := Nat.le_of_not_ge hshort + simp [gridPosition, gridKey, hmn, min_eq_right hreverse] + omega + · have hnm : n ≤ m := Nat.le_of_not_ge hmn + by_cases hshort : x ≤ n - y + · simp [gridPosition, gridKey, hmn, min_eq_left hshort] + omega + · have hreverse : n - y ≤ x := Nat.le_of_not_ge hshort + simp [gridPosition, gridKey, hmn, min_eq_right hreverse] + omega + +theorem gridDecodeX_le + {m n k t : ℕ} (hk : k ≤ min m n) + (ht : t ≤ m + n - 2 * k) : + gridDecodeX m n k t ≤ m := by + have hkm : k ≤ m := hk.trans (min_le_left _ _) + have hkn : k ≤ n := hk.trans (min_le_right _ _) + by_cases hmn : m ≤ n + · by_cases hpos : t ≤ m - k + · simp [gridDecodeX, hmn, hpos] + omega + · simp [gridDecodeX, hmn, hpos] + · by_cases hpos : t ≤ n - k + · simp [gridDecodeX, hmn, hpos] + omega + · simp [gridDecodeX, hmn, hpos] + omega + +theorem gridDecodeY_le + {m n k t : ℕ} (hk : k ≤ min m n) + (ht : t ≤ m + n - 2 * k) : + gridDecodeY m n k t ≤ n := by + have hkm : k ≤ m := hk.trans (min_le_left _ _) + have hkn : k ≤ n := hk.trans (min_le_right _ _) + by_cases hmn : m ≤ n + · by_cases hpos : t ≤ m - k + · simp [gridDecodeY, hmn, hpos] + omega + · simp [gridDecodeY, hmn, hpos] + omega + · by_cases hpos : t ≤ n - k + · simp [gridDecodeY, hmn, hpos] + omega + · simp [gridDecodeY, hmn, hpos] + +theorem gridKey_decode + {m n k t : ℕ} (hk : k ≤ min m n) + (ht : t ≤ m + n - 2 * k) : + gridKey m n (gridDecodeX m n k t) + (gridDecodeY m n k t) = k := by + have hkm : k ≤ m := hk.trans (min_le_left _ _) + have hkn : k ≤ n := hk.trans (min_le_right _ _) + by_cases hmn : m ≤ n + · by_cases hpos : t ≤ m - k + · have hkSub : k ≤ m - t := by omega + simp [gridKey, gridDecodeX, gridDecodeY, hmn, hpos, + min_eq_left hkSub] + · have hkY : k ≤ t + 2 * k - m := by omega + simp [gridKey, gridDecodeX, gridDecodeY, hmn, hpos, + Nat.sub_sub_self hkm, min_eq_right hkY] + · by_cases hpos : t ≤ n - k + · have hkSub : k ≤ n - t := by omega + simp [gridKey, gridDecodeX, gridDecodeY, hmn, hpos, + min_eq_left hkSub] + · have hkX : k ≤ t + 2 * k - n := by omega + simp [gridKey, gridDecodeX, gridDecodeY, hmn, hpos, + Nat.sub_sub_self hkn, min_eq_right hkX] + +theorem gridDecode_rank + {m n k t : ℕ} (hk : k ≤ min m n) + (ht : t ≤ m + n - 2 * k) : + gridDecodeX m n k t + gridDecodeY m n k t = k + t := by + have hkm : k ≤ m := hk.trans (min_le_left _ _) + have hkn : k ≤ n := hk.trans (min_le_right _ _) + by_cases hmn : m ≤ n + · by_cases hpos : t ≤ m - k + · simp [gridDecodeX, gridDecodeY, hmn, hpos] + omega + · simp [gridDecodeX, gridDecodeY, hmn, hpos] + omega + · by_cases hpos : t ≤ n - k + · simp [gridDecodeX, gridDecodeY, hmn, hpos] + · simp [gridDecodeX, gridDecodeY, hmn, hpos] + omega + +theorem gridPosition_decode + {m n k t : ℕ} (hk : k ≤ min m n) + (ht : t ≤ m + n - 2 * k) : + gridPosition m n (gridDecodeX m n k t) + (gridDecodeY m n k t) = t := by + rw [gridPosition, gridKey_decode hk ht, gridDecode_rank hk ht] + omega + +theorem gridDecode_encode_x + {m n x y : ℕ} (hx : x ≤ m) (hy : y ≤ n) : + gridDecodeX m n (gridKey m n x y) + (gridPosition m n x y) = x := by + by_cases hmn : m ≤ n + · by_cases hshort : y ≤ m - x + · have hdecode : x ≤ m - y := by omega + simp [gridDecodeX, gridPosition, gridKey, hmn, + min_eq_left hshort, hdecode] + · have hreverse : m - x ≤ y := Nat.le_of_not_ge hshort + have hdecode : + ¬x + y - (m - x) ≤ m - (m - x) := by + rw [Nat.sub_sub_self hx] + omega + simp [gridDecodeX, gridPosition, gridKey, hmn, hshort, + min_eq_right hreverse, hdecode, Nat.sub_sub_self hx] + · by_cases hshort : x ≤ n - y + · have hdecode : y ≤ n - x := by omega + simp [gridDecodeX, gridPosition, gridKey, hmn, + min_eq_left hshort, hdecode] + · have hreverse : n - y ≤ x := Nat.le_of_not_ge hshort + have hdecode : + ¬x + y - (n - y) ≤ n - (n - y) := by + rw [Nat.sub_sub_self hy] + omega + have hsum : ¬x + y ≤ y + (n - y) := by omega + simp [gridDecodeX, gridPosition, gridKey, hmn, hshort, + min_eq_right hreverse, hdecode, hsum, Nat.sub_sub_self hy] + omega + +theorem gridDecode_encode_y + {m n x y : ℕ} (hx : x ≤ m) (hy : y ≤ n) : + gridDecodeY m n (gridKey m n x y) + (gridPosition m n x y) = y := by + by_cases hmn : m ≤ n + · by_cases hshort : y ≤ m - x + · have hdecode : x ≤ m - y := by omega + simp [gridDecodeY, gridPosition, gridKey, hmn, + min_eq_left hshort, hdecode] + · have hreverse : m - x ≤ y := Nat.le_of_not_ge hshort + have hdecode : + ¬x + y - (m - x) ≤ m - (m - x) := by + rw [Nat.sub_sub_self hx] + omega + simp [gridDecodeY, gridPosition, gridKey, hmn, hshort, + min_eq_right hreverse, hdecode, Nat.sub_sub_self hx] + omega + · by_cases hshort : x ≤ n - y + · have hdecode : y ≤ n - x := by omega + simp [gridDecodeY, gridPosition, gridKey, hmn, + min_eq_left hshort, hdecode] + · have hreverse : n - y ≤ x := Nat.le_of_not_ge hshort + have hdecode : + ¬x + y - (n - y) ≤ n - (n - y) := by + rw [Nat.sub_sub_self hy] + omega + simp [gridDecodeY, gridPosition, gridKey, hmn, hshort, + min_eq_right hreverse, hdecode, Nat.sub_sub_self hy] + omega + +theorem gridDecode_mono + {m n k t₁ t₂ : ℕ} (_hk : k ≤ min m n) + (_ht₁ : t₁ ≤ m + n - 2 * k) + (_ht₂ : t₂ ≤ m + n - 2 * k) + (h : t₁ ≤ t₂) : + gridDecodeX m n k t₁ ≤ gridDecodeX m n k t₂ ∧ + gridDecodeY m n k t₁ ≤ gridDecodeY m n k t₂ := by + by_cases hmn : m ≤ n + · by_cases hpos₁ : t₁ ≤ m - k <;> + by_cases hpos₂ : t₂ ≤ m - k <;> + simp [gridDecodeX, gridDecodeY, hmn, hpos₁, hpos₂] <;> + omega + · by_cases hpos₁ : t₁ ≤ n - k <;> + by_cases hpos₂ : t₂ ≤ n - k <;> + simp [gridDecodeX, gridDecodeY, hmn, hpos₁, hpos₂] <;> + omega + +end BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean new file mode 100644 index 0000000000..433b6c1ba4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct +import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization + +/-! +# Sperner bounds for divisor exponent boxes + +The divisor lattice attached to prime-power exponents is a product of finite +chains. The explicit symmetric-chain product construction therefore bounds +every antichain by the central coefficient of +`∏ (1 + X + ... + X^e)`. +-/ + +namespace BGS.NumberTheory + +open BGS.Combinatorics + +/-- Exponent vectors, ordered tail-first to match the product constructor. -/ +def DivisorExponentBox : List PrimePowerFactor → Type + | [] => PUnit + | factor :: factors => + DivisorExponentBox factors × Fin (factor.exponent + 1) + +instance divisorExponentBoxFintype : + ∀ factors : List PrimePowerFactor, Fintype (DivisorExponentBox factors) + | [] => by + change Fintype PUnit + infer_instance + | _ :: factors => by + letI := divisorExponentBoxFintype factors + unfold DivisorExponentBox + infer_instance + +instance divisorExponentBoxPartialOrder : + ∀ factors : List PrimePowerFactor, + PartialOrder (DivisorExponentBox factors) + | [] => by + change PartialOrder PUnit + infer_instance + | _ :: factors => by + letI := divisorExponentBoxPartialOrder factors + unfold DivisorExponentBox + infer_instance + +/-- Sum of the chosen prime-power exponents. -/ +def divisorExponentRank : + ∀ factors : List PrimePowerFactor, DivisorExponentBox factors → ℕ + | [], _ => 0 + | _ :: factors, exponentVector => + divisorExponentRank factors exponentVector.1 + exponentVector.2 + +/-- Top rank in the tail-first recursion used by the decomposition. -/ +def divisorExponentTotal : List PrimePowerFactor → ℕ + | [] => 0 + | factor :: factors => + divisorExponentTotal factors + factor.exponent + +theorem divisorExponentTotal_eq_primePowerTotalExponent + (factors : List PrimePowerFactor) : + divisorExponentTotal factors = primePowerTotalExponent factors := by + induction factors with + | nil => rfl + | cons factor factors ih => + simp only [divisorExponentTotal, primePowerTotalExponent, ih] + omega + +/-- Explicit symmetric-chain decomposition of every divisor exponent box. -/ +def divisorExponentBoxDecomposition : + ∀ factors : List PrimePowerFactor, + SymmetricChainDecomposition + (DivisorExponentBox factors) + (divisorExponentRank factors) + (divisorExponentTotal factors) + | [] => by + change SymmetricChainDecomposition PUnit (fun _ ↦ 0) 0 + exact SymmetricChainDecomposition.punit + | factor :: factors => by + letI := divisorExponentBoxPartialOrder factors + exact + (divisorExponentBoxDecomposition factors).productWithChain + factor.exponent + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean new file mode 100644 index 0000000000..71b1eac068 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Data.Fintype.Card +import Mathlib.Order.Antichain +import Mathlib.Tactic + +/-! +# Finite symmetric-chain decompositions + +The structure below packages an explicit partition into monotone chains. +Each chain is indexed by a finite key type, starts at a declared rank, and +has a declared length symmetric about `total / 2`. + +The main abstract consequence is the Sperner injection: an antichain meets +each chain at most once, so mapping every point to the central point of its +chain injects the antichain into the central rank. +-/ + +namespace BGS.Combinatorics + +/-- An explicit symmetric-chain decomposition of a ranked partial order. -/ +structure SymmetricChainDecomposition + (P : Type*) [PartialOrder P] (rank : P → ℕ) (total : ℕ) where + Key : Type + [keyFintype : Fintype Key] + start : Key → ℕ + length : Key → ℕ + equiv : P ≃ Σ key : Key, Fin (length key + 1) + rank_decode : + ∀ point : Σ key : Key, Fin (length key + 1), + rank (equiv.symm point) = start point.1 + point.2 + decode_mono : + ∀ (key : Key) (i j : Fin (length key + 1)), + i ≤ j → + equiv.symm ⟨key, i⟩ ≤ equiv.symm ⟨key, j⟩ + symmetric : ∀ key : Key, 2 * start key + length key = total + +namespace SymmetricChainDecomposition + +variable {P : Type*} [PartialOrder P] {rank : P → ℕ} {total : ℕ} + +/-- The first component of the chain code of a point. -/ +def key (decomposition : SymmetricChainDecomposition P rank total) + (x : P) : decomposition.Key := + (decomposition.equiv x).1 + +/-- The position component of the chain code of a point. -/ +def position (decomposition : SymmetricChainDecomposition P rank total) + (x : P) : Fin (decomposition.length (decomposition.key x) + 1) := + (decomposition.equiv x).2 + +theorem start_le_half + (decomposition : SymmetricChainDecomposition P rank total) + (key : decomposition.Key) : + decomposition.start key ≤ total / 2 := by + have hsymmetric := decomposition.symmetric key + omega + +theorem half_sub_start_le_length + (decomposition : SymmetricChainDecomposition P rank total) + (key : decomposition.Key) : + total / 2 - decomposition.start key ≤ decomposition.length key := by + have hsymmetric := decomposition.symmetric key + omega + +/-- The unique point of a symmetric chain in the central rank. -/ +def center + (decomposition : SymmetricChainDecomposition P rank total) + (key : decomposition.Key) : P := + decomposition.equiv.symm + ⟨key, + ⟨total / 2 - decomposition.start key, + Nat.lt_succ_iff.mpr + (decomposition.half_sub_start_le_length key)⟩⟩ + +theorem rank_center + (decomposition : SymmetricChainDecomposition P rank total) + (key : decomposition.Key) : + rank (decomposition.center key) = total / 2 := by + rw [center, decomposition.rank_decode] + exact Nat.add_sub_of_le (decomposition.start_le_half key) + +private theorem key_injective_on_antichain + [Fintype P] + (decomposition : SymmetricChainDecomposition P rank total) + (antichain : Finset P) + (hantichain : IsAntichain (· ≤ ·) (antichain : Set P)) : + Function.Injective + (fun x : ↥antichain ↦ decomposition.key x.1) := by + intro x y hkey + apply Subtype.ext + rcases hxcode : decomposition.equiv x.1 with ⟨kx, ix⟩ + rcases hycode : decomposition.equiv y.1 with ⟨ky, iy⟩ + have hkey' : kx = ky := by + simpa [key, hxcode, hycode] using hkey + subst ky + rcases le_total ix iy with hxy | hyx + · have hle : x.1 ≤ y.1 := by + have hdecode := + decomposition.decode_mono kx ix iy hxy + have hxback : decomposition.equiv.symm ⟨kx, ix⟩ = x.1 := by + apply decomposition.equiv.injective + simpa [hxcode] + have hyback : decomposition.equiv.symm ⟨kx, iy⟩ = y.1 := by + apply decomposition.equiv.injective + simpa [hycode] + simpa [hxback, hyback] using hdecode + by_contra hne + exact + (hantichain (by simpa using x.2) + (by simpa using y.2) hne) hle + · have hle : y.1 ≤ x.1 := by + have hdecode := + decomposition.decode_mono kx iy ix hyx + have hxback : decomposition.equiv.symm ⟨kx, ix⟩ = x.1 := by + apply decomposition.equiv.injective + simpa [hxcode] + have hyback : decomposition.equiv.symm ⟨kx, iy⟩ = y.1 := by + apply decomposition.equiv.injective + simpa [hycode] + simpa [hxback, hyback] using hdecode + by_contra hne + exact + (hantichain (by simpa using y.2) + (by simpa using x.2) (Ne.symm hne)) hle + +/-- Every antichain injects into the central rank of a finite ranked poset +equipped with an explicit symmetric-chain decomposition. -/ +theorem antichain_card_le_central_rank + [Fintype P] + (decomposition : SymmetricChainDecomposition P rank total) + (antichain : Finset P) + (hantichain : IsAntichain (· ≤ ·) (antichain : Set P)) : + antichain.card ≤ + Fintype.card {x : P // rank x = total / 2} := by + classical + let centerMap : ↥antichain → {x : P // rank x = total / 2} := + fun x ↦ + ⟨decomposition.center (decomposition.key x.1), + decomposition.rank_center (decomposition.key x.1)⟩ + have hkeyInjective := + decomposition.key_injective_on_antichain antichain hantichain + have hcenterInjective : Function.Injective centerMap := by + intro x y hcenter + apply hkeyInjective + have hcode := congrArg decomposition.equiv (congrArg Subtype.val hcenter) + simpa [centerMap, center] using congrArg Sigma.fst hcode + simpa using Fintype.card_le_of_injective centerMap hcenterInjective + +end SymmetricChainDecomposition + +end BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean new file mode 100644 index 0000000000..58c9aff939 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle + +/-! +# Products of symmetric-chain decompositions + +The product with one more finite chain is obtained by composing four standard +equivalences: the old chain code, sigma-product distribution, the explicit +rectangle decomposition on each old chain, and sigma associativity. +-/ + +namespace BGS.Combinatorics + +namespace SymmetricChainDecomposition + +variable {P : Type*} [PartialOrder P] {rank : P → ℕ} {total : ℕ} + +abbrev productKey + (decomposition : SymmetricChainDecomposition P rank total) + (a : ℕ) : Type := + Σ key : decomposition.Key, + gridChainKey (decomposition.length key) a + +instance productKeyFintype + (decomposition : SymmetricChainDecomposition P rank total) + (a : ℕ) : + Fintype (decomposition.productKey a) := by + letI : Fintype decomposition.Key := decomposition.keyFintype + unfold productKey + infer_instance + +abbrev productLength + (decomposition : SymmetricChainDecomposition P rank total) + (a : ℕ) (key : decomposition.productKey a) : ℕ := + gridChainLength (decomposition.length key.1) a key.2 + +def productStart + (decomposition : SymmetricChainDecomposition P rank total) + (key : decomposition.productKey a) : ℕ := + decomposition.start key.1 + key.2 + +private def productEquiv + (decomposition : SymmetricChainDecomposition P rank total) + (a : ℕ) : + P × Fin (a + 1) ≃ + Σ key : decomposition.productKey a, + Fin (decomposition.productLength a key + 1) := + (((Equiv.prodCongr decomposition.equiv (Equiv.refl (Fin (a + 1)))).trans + (Equiv.sigmaProdDistrib + (fun key : decomposition.Key ↦ + Fin (decomposition.length key + 1)) + (Fin (a + 1)))).trans + (Equiv.sigmaCongrRight + (fun key : decomposition.Key ↦ + gridChainEquiv (decomposition.length key) a))).trans + (Equiv.sigmaAssoc + (fun (key : decomposition.Key) + (rectangleKey : + gridChainKey (decomposition.length key) a) ↦ + Fin (gridChainLength + (decomposition.length key) a rectangleKey + 1))).symm + +def productWithChain + (decomposition : SymmetricChainDecomposition P rank total) + (a : ℕ) : + SymmetricChainDecomposition + (P × Fin (a + 1)) + (fun x ↦ rank x.1 + x.2) + (total + a) where + Key := decomposition.productKey a + start := decomposition.productStart + length := decomposition.productLength a + equiv := decomposition.productEquiv a + rank_decode := by + rintro ⟨⟨key, rectangleKey⟩, rectanglePosition⟩ + have hkey : + (rectangleKey : ℕ) ≤ min (decomposition.length key) a := + Nat.le_of_lt_succ rectangleKey.isLt + have hposition : + (rectanglePosition : ℕ) ≤ + decomposition.length key + a - 2 * rectangleKey := + Nat.le_of_lt_succ rectanglePosition.isLt + let oldPosition : Fin (decomposition.length key + 1) := + ⟨gridDecodeX (decomposition.length key) a + rectangleKey rectanglePosition, + Nat.lt_succ_iff.mpr + (gridDecodeX_le hkey hposition)⟩ + let newPosition : Fin (a + 1) := + ⟨gridDecodeY (decomposition.length key) a + rectangleKey rectanglePosition, + Nat.lt_succ_iff.mpr + (gridDecodeY_le hkey hposition)⟩ + have holdRank := + decomposition.rank_decode ⟨key, oldPosition⟩ + have hgrid := gridDecode_rank hkey hposition + change + rank (decomposition.equiv.symm ⟨key, oldPosition⟩) + + newPosition = + decomposition.start key + rectangleKey + rectanglePosition + rw [holdRank] + dsimp [oldPosition, newPosition] + omega + decode_mono := by + intro productKey i j hij + rcases productKey with ⟨key, rectangleKey⟩ + have hkey : + (rectangleKey : ℕ) ≤ min (decomposition.length key) a := + Nat.le_of_lt_succ rectangleKey.isLt + have hi : + (i : ℕ) ≤ decomposition.length key + a - 2 * rectangleKey := + Nat.le_of_lt_succ i.isLt + have hj : + (j : ℕ) ≤ decomposition.length key + a - 2 * rectangleKey := + Nat.le_of_lt_succ j.isLt + have hgrid := gridDecode_mono hkey hi hj hij + change + (decomposition.equiv.symm + ⟨key, + ⟨gridDecodeX (decomposition.length key) a rectangleKey i, + Nat.lt_succ_iff.mpr (gridDecodeX_le hkey hi)⟩⟩, + (⟨gridDecodeY (decomposition.length key) a rectangleKey i, + Nat.lt_succ_iff.mpr (gridDecodeY_le hkey hi)⟩ : Fin (a + 1))) ≤ + (decomposition.equiv.symm + ⟨key, + ⟨gridDecodeX (decomposition.length key) a rectangleKey j, + Nat.lt_succ_iff.mpr (gridDecodeX_le hkey hj)⟩⟩, + (⟨gridDecodeY (decomposition.length key) a rectangleKey j, + Nat.lt_succ_iff.mpr (gridDecodeY_le hkey hj)⟩ : Fin (a + 1))) + constructor + · exact decomposition.decode_mono key + ⟨gridDecodeX (decomposition.length key) a rectangleKey i, + Nat.lt_succ_iff.mpr (gridDecodeX_le hkey hi)⟩ + ⟨gridDecodeX (decomposition.length key) a rectangleKey j, + Nat.lt_succ_iff.mpr (gridDecodeX_le hkey hj)⟩ + hgrid.1 + · exact hgrid.2 + symmetric := by + rintro ⟨key, rectangleKey⟩ + have hkey : + (rectangleKey : ℕ) ≤ min (decomposition.length key) a := + Nat.le_of_lt_succ rectangleKey.isLt + have hleft : (rectangleKey : ℕ) ≤ decomposition.length key := + hkey.trans (min_le_left _ _) + have hright : (rectangleKey : ℕ) ≤ a := + hkey.trans (min_le_right _ _) + have hold := decomposition.symmetric key + dsimp [productStart, productLength, gridChainLength] + omega + +def punit : + SymmetricChainDecomposition PUnit (fun _ ↦ 0) 0 where + Key := PUnit + start := fun _ ↦ 0 + length := fun _ ↦ 0 + equiv := + { toFun := fun _ ↦ ⟨PUnit.unit, ⟨0, by omega⟩⟩ + invFun := fun _ ↦ PUnit.unit + left_inv := by intro x; cases x; rfl + right_inv := by + rintro ⟨key, position⟩ + cases key + apply Sigma.ext + · rfl + · apply heq_of_eq + apply Fin.ext + omega } + rank_decode := by + rintro ⟨key, position⟩ + simp + decode_mono := by + intro key i j hij + trivial + symmetric := by + intro key + rfl + +end SymmetricChainDecomposition + +end BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean new file mode 100644 index 0000000000..40d506716f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid + +/-! +# The rectangle symmetric-chain equivalence + +This packages the explicit rectangle codec as an equivalence. Keeping this +finite, self-contained transport boundary separate lets product decompositions +be assembled from standard equivalence combinators. +-/ + +namespace BGS.Combinatorics + +abbrev gridChainKey (m n : ℕ) := + Fin (min m n + 1) + +abbrev gridChainLength (m n : ℕ) (key : gridChainKey m n) := + m + n - 2 * key + +private def gridChainEncode (m n : ℕ) + (point : Fin (m + 1) × Fin (n + 1)) : + Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1) := by + have hx : (point.1 : ℕ) ≤ m := + Nat.le_of_lt_succ point.1.isLt + have hy : (point.2 : ℕ) ≤ n := + Nat.le_of_lt_succ point.2.isLt + let key := gridKey m n point.1 point.2 + let position := gridPosition m n point.1 point.2 + exact + ⟨⟨key, Nat.lt_succ_iff.mpr (gridKey_le_min hx hy)⟩, + ⟨position, Nat.lt_succ_iff.mpr (gridPosition_le hx hy)⟩⟩ + +private def gridChainDecode (m n : ℕ) + (point : + Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1)) : + Fin (m + 1) × Fin (n + 1) := by + have hkey : (point.1 : ℕ) ≤ min m n := + Nat.le_of_lt_succ point.1.isLt + have hposition : + (point.2 : ℕ) ≤ m + n - 2 * point.1 := + Nat.le_of_lt_succ point.2.isLt + exact + (⟨gridDecodeX m n point.1 point.2, + Nat.lt_succ_iff.mpr (gridDecodeX_le hkey hposition)⟩, + ⟨gridDecodeY m n point.1 point.2, + Nat.lt_succ_iff.mpr (gridDecodeY_le hkey hposition)⟩) + +private theorem gridChainDecode_encode (m n : ℕ) + (point : Fin (m + 1) × Fin (n + 1)) : + gridChainDecode m n (gridChainEncode m n point) = point := by + have hx : (point.1 : ℕ) ≤ m := + Nat.le_of_lt_succ point.1.isLt + have hy : (point.2 : ℕ) ≤ n := + Nat.le_of_lt_succ point.2.isLt + apply Prod.ext + · apply Fin.ext + exact gridDecode_encode_x hx hy + · apply Fin.ext + exact gridDecode_encode_y hx hy + +private theorem gridChainEncode_decode (m n : ℕ) + (point : + Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1)) : + gridChainEncode m n (gridChainDecode m n point) = point := by + rcases point with ⟨key, position⟩ + have hkey : (key : ℕ) ≤ min m n := + Nat.le_of_lt_succ key.isLt + have hposition : (position : ℕ) ≤ m + n - 2 * key := + Nat.le_of_lt_succ position.isLt + have hencodedKey : + (gridChainEncode m n (gridChainDecode m n ⟨key, position⟩)).1 = key := by + apply Fin.ext + exact gridKey_decode hkey hposition + refine Sigma.ext hencodedKey ?_ + apply (Fin.heq_ext_iff + (congrArg (fun k ↦ gridChainLength m n k + 1) hencodedKey)).2 + exact gridPosition_decode hkey hposition + +/-- The explicit symmetric-chain decomposition of a rectangle. -/ +def gridChainEquiv (m n : ℕ) : + Fin (m + 1) × Fin (n + 1) ≃ + Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1) where + toFun := gridChainEncode m n + invFun := gridChainDecode m n + left_inv := gridChainDecode_encode m n + right_inv := gridChainEncode_decode m n + +end BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean new file mode 100644 index 0000000000..fb24306654 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis +import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean new file mode 100644 index 0000000000..0f73bef4ea --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import Mathlib.Algebra.MvPolynomial.Nilpotent +import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +import Mathlib.RingTheory.Nullstellensatz + +/-! +# Base change of absolutely irreducible multivariate polynomials + +An irreducible multivariate polynomial over an algebraic closure remains +irreducible after extending its original coefficient field to an arbitrary +field. The proof is a direct Nullstellensatz descent. Given a hypothetical +factorization over the target field, introduce one variable for each of its +finitely many coefficients and two additional variables for inverses of +chosen nonconstant coefficients. A closed point of a maximal ideal over the +kernel specializes the factorization to the algebraically closed field, while +the inverse relations ensure that both specialized factors remain nonunits. + +The final theorem supplies the exact constant-field base-change step used in +Corvaja--Zannier's auxiliary-family argument. +-/ + +open scoped BigOperators + +noncomputable section + +namespace BGS.CorvajaZannier + +open MvPolynomial + +variable {K E F σ : Type*} [Field K] [Field E] [Field F] + [Algebra K E] [IsAlgClosed E] + +private theorem exists_nonconstant_coeff_of_nonzero_nonunit + (g : MvPolynomial σ F) (hg0 : g ≠ 0) (hgu : ¬ IsUnit g) : + ∃ m, m ≠ 0 ∧ g.coeff m ≠ 0 := by + classical + by_contra h + have h : ∀ m, m ≠ 0 → g.coeff m = 0 := by + intro m hm + by_contra hcoeff + exact h ⟨m, hm, hcoeff⟩ + have heq : g = MvPolynomial.C (g.coeff 0) := by + ext m + by_cases hm : m = 0 + · subst m + simp + · simpa [MvPolynomial.coeff_C, Ne.symm hm] using h m hm + have hc : g.coeff 0 ≠ 0 := by + intro hc + apply hg0 + rw [heq, hc] + simp + apply hgu + rw [heq] + exact (isUnit_iff_ne_zero.mpr hc).map MvPolynomial.C + +/-- If a multivariate polynomial is irreducible after extension to an +algebraically closed field, it remains irreducible after any other injective +field extension of its original coefficient field. -/ +theorem irreducible_map_of_irreducible_map_isAlgClosed + (iF : K →+* F) (f : MvPolynomial σ K) + (hE : Irreducible (MvPolynomial.map (algebraMap K E) f)) : + Irreducible (MvPolynomial.map iF f) := by + refine ⟨?_, ?_⟩ + · intro hu + have huE : IsUnit (MvPolynomial.map (algebraMap K E) f) := by + rw [MvPolynomial.isUnit_iff] + constructor + · have h0 := (MvPolynomial.isUnit_iff.mp hu).1 + rw [MvPolynomial.coeff_map] at h0 ⊢ + rw [isUnit_iff_ne_zero] at h0 ⊢ + intro hcE + have hc : f.coeff 0 = 0 := + (algebraMap K E).injective (by simpa using hcE) + exact h0 (by simp [hc]) + · intro m hm + have hmF := (MvPolynomial.isUnit_iff.mp hu).2 m hm + simp only [MvPolynomial.coeff_map, isNilpotent_iff_eq_zero] at hmF ⊢ + have hc : f.coeff m = 0 := iF.injective (by simpa using hmF) + simp [hc] + exact hE.not_isUnit huE + · intro g h hfac + classical + by_contra hnot + have hnot : ¬ IsUnit g ∧ ¬ IsUnit h := not_or.mp hnot + have hf0 : f ≠ 0 := by + intro hf + exact hE.ne_zero (by simp [hf]) + have hmap0 : MvPolynomial.map iF f ≠ 0 := by + intro hm + apply hf0 + apply MvPolynomial.map_injective iF iF.injective + simpa using hm + have hg0 : g ≠ 0 := by + intro hg + rw [hg, zero_mul] at hfac + exact hmap0 hfac + have hh0 : h ≠ 0 := by + intro hh + rw [hh, mul_zero] at hfac + exact hmap0 hfac + obtain ⟨mg, hmg0, hmg⟩ := + exists_nonconstant_coeff_of_nonzero_nonunit g hg0 hnot.1 + obtain ⟨mh, hmh0, hmh⟩ := + exists_nonconstant_coeff_of_nonzero_nonunit h hh0 hnot.2 + let V := Sum (Sum {m // m ∈ g.support} {m // m ∈ h.support}) (Fin 2) + let invG : V := Sum.inr 0 + let invH : V := Sum.inr 1 + let gVar : (σ →₀ ℕ) → V := fun m => + if hm : m ∈ g.support then Sum.inl (Sum.inl ⟨m, hm⟩) else invG + let hVar : (σ →₀ ℕ) → V := fun m => + if hm : m ∈ h.support then Sum.inl (Sum.inr ⟨m, hm⟩) else invH + let val : V → F := fun v => + match v with + | Sum.inl (Sum.inl m) => g.coeff m.1 + | Sum.inl (Sum.inr m) => h.coeff m.1 + | Sum.inr j => if j = 0 then (g.coeff mg)⁻¹ else (h.coeff mh)⁻¹ + let ψ : MvPolynomial V K →+* F := MvPolynomial.eval₂Hom iF val + let G : MvPolynomial σ (MvPolynomial V K) := + g.support.sum fun m => MvPolynomial.monomial m (MvPolynomial.X (gVar m)) + let H : MvPolynomial σ (MvPolynomial V K) := + h.support.sum fun m => MvPolynomial.monomial m (MvPolynomial.X (hVar m)) + have hmapG : MvPolynomial.map ψ G = g := by + rw [g.as_sum] + simp only [G, map_sum, map_monomial] + apply Finset.sum_congr rfl + intro m hm + have hm0 : g.coeff m ≠ 0 := by + simpa [MvPolynomial.mem_support_iff] using hm + simp [ψ, val, gVar, hm0] + have hmapH : MvPolynomial.map ψ H = h := by + rw [h.as_sum] + simp only [H, map_sum, map_monomial] + apply Finset.sum_congr rfl + intro m hm + have hm0 : h.coeff m ≠ 0 := by + simpa [MvPolynomial.mem_support_iff] using hm + simp [ψ, val, hVar, hm0] + let fA : MvPolynomial σ (MvPolynomial V K) := + MvPolynomial.map MvPolynomial.C f + have hmapfA : MvPolynomial.map ψ fA = MvPolynomial.map iF f := by + calc + MvPolynomial.map ψ fA = + MvPolynomial.map (ψ.comp MvPolynomial.C) f := by + simp only [fA, MvPolynomial.map_map] + _ = MvPolynomial.map iF f := by + have hcomp : ψ.comp MvPolynomial.C = iF := by + ext c + simp [ψ] + rw [hcomp] + let D : MvPolynomial σ (MvPolynomial V K) := G * H - fA + have hcoeffD (m : σ →₀ ℕ) : D.coeff m ∈ RingHom.ker ψ := by + change ψ (D.coeff m) = 0 + rw [← MvPolynomial.coeff_map] + simp only [D, map_sub, map_mul, hmapG, hmapH, hmapfA, hfac] + simp + let P : Ideal (MvPolynomial V K) := RingHom.ker ψ + have hPprime : P.IsPrime := RingHom.ker_isPrime ψ + obtain ⟨M, hMmax, hPM⟩ := Ideal.exists_le_maximal P hPprime.ne_top + letI : Finite V := by infer_instance + obtain ⟨x, hx⟩ := + MvPolynomial.eq_vanishingIdeal_singleton_of_isMaximal E hMmax + let θ : MvPolynomial V K →+* E := + MvPolynomial.eval₂Hom (algebraMap K E) x + have hker_specialize {q : MvPolynomial V K} (hq : q ∈ RingHom.ker ψ) : + θ q = 0 := by + have hqM : q ∈ M := hPM hq + rw [hx] at hqM + simpa [θ, MvPolynomial.aeval_def] using hqM x rfl + let gE : MvPolynomial σ E := MvPolynomial.map θ G + let hE' : MvPolynomial σ E := MvPolynomial.map θ H + have hfactorE : MvPolynomial.map (algebraMap K E) f = gE * hE' := by + have hDzero : MvPolynomial.map θ D = 0 := by + ext m + rw [MvPolynomial.coeff_map] + simp only [coeff_zero] + exact hker_specialize (hcoeffD m) + simp only [D, map_sub, map_mul] at hDzero + have hmapfAE : MvPolynomial.map θ fA = + MvPolynomial.map (algebraMap K E) f := by + calc + MvPolynomial.map θ fA = + MvPolynomial.map (θ.comp MvPolynomial.C) f := by + simp only [fA, MvPolynomial.map_map] + _ = MvPolynomial.map (algebraMap K E) f := by + have hcomp : θ.comp MvPolynomial.C = algebraMap K E := by + ext c + simp [θ] + rw [hcomp] + rw [hmapfAE] at hDzero + exact sub_eq_zero.mp hDzero |>.symm + have hgCoeff : gE.coeff mg ≠ 0 := by + have hmgMem : mg ∈ g.support := + MvPolynomial.mem_support_iff.mpr hmg + let qG : MvPolynomial V K := + MvPolynomial.X (gVar mg) * MvPolynomial.X invG - 1 + have hqG : qG ∈ RingHom.ker ψ := by + change ψ qG = 0 + simp [qG, ψ, val, gVar, invG, hmg] + have hqGE := hker_specialize hqG + have hxG : x (gVar mg) ≠ 0 := by + have hprod : x (gVar mg) * x invG = 1 := by + apply sub_eq_zero.mp + simpa [qG, θ] using hqGE + exact left_ne_zero_of_mul_eq_one hprod + have hcoeffFormula : gE.coeff mg = x (gVar mg) := by + simp [gE, G, MvPolynomial.coeff_sum, + MvPolynomial.coeff_monomial, hmgMem, θ] + rw [hcoeffFormula] + exact hxG + have hhCoeff : hE'.coeff mh ≠ 0 := by + have hmhMem : mh ∈ h.support := + MvPolynomial.mem_support_iff.mpr hmh + let qH : MvPolynomial V K := + MvPolynomial.X (hVar mh) * MvPolynomial.X invH - 1 + have hqH : qH ∈ RingHom.ker ψ := by + change ψ qH = 0 + simp [qH, ψ, val, hVar, invH, hmh] + have hqHE := hker_specialize hqH + have hxH : x (hVar mh) ≠ 0 := by + have hprod : x (hVar mh) * x invH = 1 := by + apply sub_eq_zero.mp + simpa [qH, θ] using hqHE + exact left_ne_zero_of_mul_eq_one hprod + have hcoeffFormula : hE'.coeff mh = x (hVar mh) := by + simp [hE', H, MvPolynomial.coeff_sum, + MvPolynomial.coeff_monomial, hmhMem, θ] + rw [hcoeffFormula] + exact hxH + have hgENonunit : ¬ IsUnit gE := by + intro hu + have := (MvPolynomial.isUnit_iff.mp hu).2 mg hmg0 + simp only [isNilpotent_iff_eq_zero] at this + exact hgCoeff this + have hhENonunit : ¬ IsUnit hE' := by + intro hu + have := (MvPolynomial.isUnit_iff.mp hu).2 mh hmh0 + simp only [isNilpotent_iff_eq_zero] at this + exact hhCoeff this + exact hE.isUnit_or_isUnit hfactorE |>.elim hgENonunit hhENonunit + +/-- Absolute irreducibility, stated using `AlgebraicClosure K`, implies +irreducibility after an arbitrary field-valued coefficient embedding. -/ +theorem irreducible_map_of_irreducible_map_algebraicClosure + {K F σ : Type*} [Field K] [Field F] + (iF : K →+* F) (f : MvPolynomial σ K) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) : + Irreducible (MvPolynomial.map iF f) := + irreducible_map_of_irreducible_map_isAlgClosed + (E := AlgebraicClosure K) iF f habsolute + +variable {K L : Type*} [Field K] [Field L] {p : ℕ} + [Fact p.Prime] [CharP K p] [CharP L p] [PerfectField K] [Algebra K L] + +/-- The exact base-change bridge needed by the plane-curve auxiliary-family +theorem: absolute irreducibility over `K` implies irreducibility after +extension of constants to the Frobenius subfield `L^p`. -/ +theorem irreducible_map_perfectConstantsToFrobeniusSubfield + (f : MvPolynomial (Fin 2) K) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) : + Irreducible + (MvPolynomial.map + (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)) f) := + irreducible_map_of_irreducible_map_algebraicClosure + (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)) f habsolute + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean new file mode 100644 index 0000000000..a47a41b1d5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean @@ -0,0 +1,323 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Algebra.Algebra.Basic +import Mathlib.Algebra.Polynomial.OfFn +import Mathlib.Algebra.Polynomial.Eval.Degree +import Mathlib.LinearAlgebra.LinearIndependent.Defs +import Mathlib.Tactic.FieldSimp + +/-! +# The Corvaja--Zannier auxiliary family + +The proof of Corvaja--Zannier's Proposition 2 considers the family + +`u ^ i * (1 - u) / (1 - v)` for `0 ≤ i < k`, together with +`u ^ r * v ^ s` for `0 ≤ r ≤ k` and `0 ≤ s < h`. + +This file formalizes the purely algebraic first half of their linear- +independence argument. Any dependence of that family produces a nonzero +bivariate polynomial of the exact source form + +`P₁(U) * (1 - U) + P₂(U, V) * (1 - V)` + +which vanishes at `(u, v)`. Bivariate polynomials are represented as +polynomials in `V` whose coefficients are polynomials in `U`. Excluding the +resulting relation by a resultant and degree argument is deliberately left as +the next boundary; it is not assumed here through a typeclass or an axiom. + +Source provenance: published pages 1933--1934; checked semantic reconstruction +`Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 518--570. The +dependence-to-relation step formalized here is lines 518--545. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators + +variable {C L : Type*} [Field C] [Field L] [Algebra C L] + +/-- The exact auxiliary family used in Corvaja--Zannier's Proposition 2. + +The left summand indexes `u ^ i * (1 - u) / (1 - v)` for `i < k`; the right +summand indexes the rectangular family `u ^ r * v ^ s` for `r ≤ k`, `s < h`. +-/ +def auxiliaryFamily (u v : L) (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) → L + | Sum.inl i => u ^ (i : ℕ) * ((1 - u) / (1 - v)) + | Sum.inr rs => u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) + +/-- The polynomial `Σ i, c i * U ^ i`. -/ +noncomputable def auxiliaryPowerPolynomial {k : ℕ} + (c : Fin k → C) : Polynomial C := by + classical + exact Polynomial.ofFn k c + +/-- The bivariate polynomial `Σ (r,s), d (r,s) * U ^ r * V ^ s`, represented +as a polynomial in `V` over `C[U]`. -/ +noncomputable def auxiliaryGridPolynomial {h k : ℕ} + (d : Fin (k + 1) × Fin h → C) : Polynomial (Polynomial C) := by + classical + exact Polynomial.ofFn h fun s => + Polynomial.ofFn (k + 1) fun r => d (r, s) + +/-- The bivariate relation obtained after clearing the denominator `1 - v` +from a dependence of the auxiliary family. -/ +def auxiliaryRelationPolynomial {h k : ℕ} + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) : + Polynomial (Polynomial C) := + Polynomial.C + (auxiliaryPowerPolynomial c * (1 - Polynomial.X)) + + auxiliaryGridPolynomial d * (1 - Polynomial.X) + +/-- Evaluate a bivariate polynomial, represented as a polynomial in `V` over +`C[U]`, at `(u, v)`. -/ +def evalBivariate (u v : L) (P : Polynomial (Polynomial C)) : L := + P.eval₂ (Polynomial.eval₂RingHom (algebraMap C L) u) v + +private theorem one_sub_X_ne_zero (R : Type*) [Ring R] [Nontrivial R] : + (1 - Polynomial.X : Polynomial R) ≠ 0 := by + intro h + have hatZero := congrArg (fun P : Polynomial R => P.eval 0) h + simp at hatZero + +@[simp] +theorem evalBivariate_auxiliaryPowerPolynomial + {k : ℕ} (u : L) (c : Fin k → C) : + (auxiliaryPowerPolynomial c).eval₂ (algebraMap C L) u = + ∑ i, algebraMap C L (c i) * u ^ (i : ℕ) := by + classical + change (Polynomial.eval₂RingHom (algebraMap C L) u) + (auxiliaryPowerPolynomial c) = _ + rw [auxiliaryPowerPolynomial, Polynomial.ofFn_eq_sum_monomial, map_sum] + simp only [Polynomial.coe_eval₂RingHom, Polynomial.eval₂_monomial] + +@[simp] +theorem evalBivariate_auxiliaryGridPolynomial + {h k : ℕ} (u v : L) (d : Fin (k + 1) × Fin h → C) : + evalBivariate u v (auxiliaryGridPolynomial d) = + ∑ rs, algebraMap C L (d rs) * + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) := by + classical + change (Polynomial.eval₂RingHom + (Polynomial.eval₂RingHom (algebraMap C L) u) v) + (auxiliaryGridPolynomial d) = _ + rw [Fintype.sum_prod_type_right' + (fun (r : Fin (k + 1)) (s : Fin h) => algebraMap C L (d (r, s)) * + (u ^ (r : ℕ) * v ^ (s : ℕ)))] + rw [auxiliaryGridPolynomial, Polynomial.ofFn_eq_sum_monomial, map_sum] + apply Finset.sum_congr rfl + intro s _ + simp only [Polynomial.coe_eval₂RingHom, Polynomial.eval₂_monomial] + rw [Polynomial.ofFn_eq_sum_monomial] + change (Polynomial.eval₂RingHom (algebraMap C L) u) + (∑ r : Fin (k + 1), Polynomial.monomial (r : ℕ) (d (r, s))) * + v ^ (s : ℕ) = _ + rw [map_sum] + simp only [Polynomial.coe_eval₂RingHom, Polynomial.eval₂_monomial, + Finset.sum_mul] + apply Finset.sum_congr rfl + intro r _ + ring + +@[simp] +theorem evalBivariate_auxiliaryRelationPolynomial + {h k : ℕ} (u v : L) (c : Fin k → C) + (d : Fin (k + 1) × Fin h → C) : + evalBivariate u v (auxiliaryRelationPolynomial c d) = + (∑ i, algebraMap C L (c i) * u ^ (i : ℕ)) * (1 - u) + + (∑ rs, algebraMap C L (d rs) * + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) * (1 - v) := by + unfold evalBivariate auxiliaryRelationPolynomial + simp only [Polynomial.eval₂_add, Polynomial.eval₂_C, + Polynomial.eval₂_mul, Polynomial.eval₂_sub, Polynomial.eval₂_one, + Polynomial.eval₂_X, Polynomial.coe_eval₂RingHom] + rw [evalBivariate_auxiliaryPowerPolynomial] + change _ + evalBivariate u v (auxiliaryGridPolynomial d) * (1 - v) = _ + rw [evalBivariate_auxiliaryGridPolynomial] + +/-- The first coefficient polynomial has degree strictly less than `k`, as in +the source's bound `deg P₁ ≤ k - 1`. -/ +theorem auxiliaryPowerPolynomial_natDegree_lt + {k : ℕ} (hk : 0 < k) (c : Fin k → C) : + (auxiliaryPowerPolynomial c).natDegree < k := by + classical + simpa [auxiliaryPowerPolynomial] using + Polynomial.ofFn_natDegree_lt (Nat.one_le_iff_ne_zero.mpr hk.ne') c + +/-- The rectangular polynomial has degree strictly less than `h` in its outer +variable `V`, as in the source's bound `deg_V P₂ ≤ h - 1`. -/ +theorem auxiliaryGridPolynomial_natDegree_lt + {h k : ℕ} (hh : 0 < h) (d : Fin (k + 1) × Fin h → C) : + (auxiliaryGridPolynomial d).natDegree < h := by + classical + simpa [auxiliaryGridPolynomial] using + Polynomial.ofFn_natDegree_lt (Nat.one_le_iff_ne_zero.mpr hh.ne') + (fun s : Fin h => Polynomial.ofFn (k + 1) fun r => d (r, s)) + +/-- Every coefficient of the rectangular polynomial, viewed as a polynomial +in `V`, has degree at most `k` in `U`. -/ +theorem auxiliaryGridPolynomial_coeff_natDegree_le + {h k : ℕ} (d : Fin (k + 1) × Fin h → C) (s : ℕ) : + ((auxiliaryGridPolynomial d).coeff s).natDegree ≤ k := by + classical + by_cases hs : s < h + · have hcoeff : + (auxiliaryGridPolynomial d).coeff s = + Polynomial.ofFn (k + 1) (fun r => d (r, ⟨s, hs⟩)) := by + simp [auxiliaryGridPolynomial, hs] + rw [hcoeff] + have hdegree := Polynomial.ofFn_natDegree_lt + (n := k + 1) (by omega : 1 ≤ k + 1) + (fun r : Fin (k + 1) => d (r, ⟨s, hs⟩)) + omega + · have hge : h ≤ s := Nat.le_of_not_gt hs + have hcoeff : (auxiliaryGridPolynomial d).coeff s = 0 := by + simp [auxiliaryGridPolynomial, + Polynomial.ofFn_coeff_eq_zero_of_ge, hge] + rw [hcoeff, Polynomial.natDegree_zero] + exact Nat.zero_le k + +/-- The power polynomial is zero exactly when all of its coefficients are +zero. -/ +theorem auxiliaryPowerPolynomial_eq_zero_iff + {k : ℕ} (c : Fin k → C) : + auxiliaryPowerPolynomial c = 0 ↔ ∀ i, c i = 0 := by + classical + constructor + · intro hc i + have hcoeff := congrArg (fun P : Polynomial C => P.coeff (i : ℕ)) hc + simpa [auxiliaryPowerPolynomial] using hcoeff + · intro hc + have hc' : c = 0 := funext hc + change Polynomial.ofFn k c = 0 + rw [hc'] + exact Polynomial.ofFn_zero k + +/-- The grid polynomial is zero exactly when all of its coefficients are +zero. -/ +theorem auxiliaryGridPolynomial_eq_zero_iff + {h k : ℕ} (d : Fin (k + 1) × Fin h → C) : + auxiliaryGridPolynomial d = 0 ↔ ∀ rs, d rs = 0 := by + classical + constructor + · intro hd rs + have hcoeff := congrArg + (fun P : Polynomial (Polynomial C) => + (P.coeff (rs.2 : ℕ)).coeff (rs.1 : ℕ)) hd + simp only [auxiliaryGridPolynomial, + Polynomial.ofFn_coeff_eq_val_of_lt _ rs.2.isLt] at hcoeff + rw [Polynomial.ofFn_coeff_eq_val_of_lt _ rs.1.isLt] at hcoeff + exact hcoeff + · intro hd + change Polynomial.ofFn h + (fun s => Polynomial.ofFn (k + 1) fun r => d (r, s)) = 0 + have hinner : + (fun s : Fin h => Polynomial.ofFn (k + 1) fun r => d (r, s)) = 0 := by + funext s + apply Polynomial.ext + intro n + by_cases hn : n < k + 1 + · simpa [hn] using hd (⟨n, hn⟩, s) + · simp [Polynomial.ofFn_coeff_eq_zero_of_ge, Nat.le_of_not_gt hn] + rw [hinner] + exact Polynomial.ofFn_zero h + +/-- The source's relation polynomial is identically zero only for the trivial +pair of coefficient families. This is the formal version of evaluating at +`V = 1` first and then using that both polynomial rings are domains. -/ +theorem auxiliaryRelationPolynomial_eq_zero_iff + {h k : ℕ} (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) : + auxiliaryRelationPolynomial c d = 0 ↔ + (∀ i, c i = 0) ∧ ∀ rs, d rs = 0 := by + constructor + · intro hrel + have hatOne := congrArg + (fun P : Polynomial (Polynomial C) => P.eval 1) hrel + have hpowerMul : + auxiliaryPowerPolynomial c * (1 - Polynomial.X) = 0 := by + simpa [auxiliaryRelationPolynomial] using hatOne + have hpower : auxiliaryPowerPolynomial c = 0 := + (mul_eq_zero.mp hpowerMul).resolve_right (one_sub_X_ne_zero C) + have hgridMul : auxiliaryGridPolynomial d * (1 - Polynomial.X) = 0 := by + simpa [auxiliaryRelationPolynomial, hpower] using hrel + have hgrid : auxiliaryGridPolynomial d = 0 := + (mul_eq_zero.mp hgridMul).resolve_right (one_sub_X_ne_zero (Polynomial C)) + exact ⟨(auxiliaryPowerPolynomial_eq_zero_iff c).mp hpower, + (auxiliaryGridPolynomial_eq_zero_iff d).mp hgrid⟩ + · rintro ⟨hc, hd⟩ + simp only [auxiliaryRelationPolynomial] + rw [(auxiliaryPowerPolynomial_eq_zero_iff c).mpr hc, + (auxiliaryGridPolynomial_eq_zero_iff d).mpr hd] + simp + +/-- A dependence of the Corvaja--Zannier auxiliary family produces a nonzero +bivariate relation of the exact source form which vanishes at `(u, v)`. + +This is the algebraic input to the subsequent resultant argument. -/ +theorem exists_nonzero_auxiliaryRelationPolynomial_of_not_linearIndependent + {h k : ℕ} (u v : L) (hv : v ≠ 1) + (hdep : ¬ LinearIndependent C (auxiliaryFamily u v h k)) : + ∃ (c : Fin k → C) (d : Fin (k + 1) × Fin h → C), + auxiliaryRelationPolynomial c d ≠ 0 ∧ + evalBivariate u v (auxiliaryRelationPolynomial c d) = 0 := by + rw [Fintype.not_linearIndependent_iff] at hdep + obtain ⟨g, hg, i, hi⟩ := hdep + let c : Fin k → C := fun j => g (Sum.inl j) + let d : Fin (k + 1) × Fin h → C := fun rs => g (Sum.inr rs) + refine ⟨c, d, ?_, ?_⟩ + · intro hzero + have hcoeffs := (auxiliaryRelationPolynomial_eq_zero_iff c d).mp hzero + cases i with + | inl j => exact hi (by simpa [c] using hcoeffs.1 j) + | inr rs => exact hi (by simpa [d] using hcoeffs.2 rs) + · have hden : 1 - v ≠ 0 := sub_ne_zero.mpr hv.symm + have hcleared := congrArg (fun x : L => x * (1 - v)) hg + simp only [Fintype.sum_sum_type, auxiliaryFamily, Algebra.smul_def] at hcleared + rw [add_mul, Finset.sum_mul, Finset.sum_mul] at hcleared + field_simp [hden] at hcleared + simpa [c, d, div_mul_eq_mul_div, hden, mul_assoc, mul_left_comm, mul_comm, + Finset.mul_sum] using hcleared + +/-- The dependence-to-relation implication together with all three degree +bounds used by the source's resultant estimate. -/ +theorem exists_nonzero_bounded_auxiliaryRelationPolynomial_of_not_linearIndependent + {h k : ℕ} (u v : L) (hh : 0 < h) (hk : 0 < k) (hv : v ≠ 1) + (hdep : ¬ LinearIndependent C (auxiliaryFamily u v h k)) : + ∃ (c : Fin k → C) (d : Fin (k + 1) × Fin h → C), + auxiliaryRelationPolynomial c d ≠ 0 ∧ + evalBivariate u v (auxiliaryRelationPolynomial c d) = 0 ∧ + (auxiliaryPowerPolynomial c).natDegree < k ∧ + (auxiliaryGridPolynomial d).natDegree < h ∧ + ∀ s, ((auxiliaryGridPolynomial d).coeff s).natDegree ≤ k := by + obtain ⟨c, d, hnonzero, heval⟩ := + exists_nonzero_auxiliaryRelationPolynomial_of_not_linearIndependent + u v hv hdep + exact ⟨c, d, hnonzero, heval, + auxiliaryPowerPolynomial_natDegree_lt hk c, + auxiliaryGridPolynomial_natDegree_lt hh d, + auxiliaryGridPolynomial_coeff_natDegree_le d⟩ + +/-- If the resultant step excludes every nonzero relation polynomial of the +source form, then the auxiliary family is linearly independent. -/ +theorem auxiliaryFamily_linearIndependent_of_no_relation + {h k : ℕ} (u v : L) (hv : v ≠ 1) + (hNoRelation : + ∀ (c : Fin k → C) (d : Fin (k + 1) × Fin h → C), + auxiliaryRelationPolynomial c d ≠ 0 → + evalBivariate u v (auxiliaryRelationPolynomial c d) ≠ 0) : + LinearIndependent C (auxiliaryFamily u v h k) := by + by_contra hdep + obtain ⟨c, d, hnonzero, heval⟩ := + exists_nonzero_auxiliaryRelationPolynomial_of_not_linearIndependent + u v hv hdep + exact hNoRelation c d hnonzero heval + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean new file mode 100644 index 0000000000..59cd944f6a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +import Mathlib.Tactic + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators + +/-- The source auxiliary family has exactly `h*k+h+k` members. -/ +theorem auxiliaryFamily_index_card (h k : ℕ) : + Fintype.card (Sum (Fin k) (Fin (k + 1) × Fin h)) = + h * k + h + k := by + simp only [Fintype.card_sum, Fintype.card_fin, Fintype.card_prod] + ring + +/-- A fixed enumeration of the auxiliary family by consecutive derivative +orders. -/ +def auxiliaryFamilyIndexEquiv (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin (h * k + h + k) := + Fintype.equivFinOfCardEq (auxiliaryFamily_index_card h k) + +/-- The derivative order assigned to an auxiliary-family row. -/ +def auxiliaryFamilyDerivativeOrder (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ := + fun i => (auxiliaryFamilyIndexEquiv h k i : ℕ) + +theorem auxiliaryFamilyDerivativeOrder_injective (h k : ℕ) : + Function.Injective (auxiliaryFamilyDerivativeOrder h k) := by + intro i j hij + apply (auxiliaryFamilyIndexEquiv h k).injective + exact Fin.ext hij + +theorem auxiliaryFamilyDerivativeOrder_le_pred + (h k : ℕ) (hn : 0 < h * k + h + k) + (i : Sum (Fin k) (Fin (k + 1) × Fin h)) : + auxiliaryFamilyDerivativeOrder h k i ≤ h * k + h + k - 1 := by + have hi := (auxiliaryFamilyIndexEquiv h k i).isLt + change (auxiliaryFamilyIndexEquiv h k i : ℕ) ≤ h * k + h + k - 1 + omega + +theorem auxiliaryFamilyDerivativeOrder_sum (h k : ℕ) : + (∑ i, auxiliaryFamilyDerivativeOrder h k i) = + (h * k + h + k).choose 2 := by + let n := h * k + h + k + let e := auxiliaryFamilyIndexEquiv h k + calc + (∑ i, auxiliaryFamilyDerivativeOrder h k i) = + ∑ j : Fin n, (j : ℕ) := by + simpa only [auxiliaryFamilyDerivativeOrder, e, n] using + (Equiv.sum_comp e (fun j : Fin n => (j : ℕ))) + _ = ∑ j ∈ Finset.range n, j := by + simpa using (Fin.sum_univ_eq_sum_range (fun j : ℕ => j) n) + _ = n * (n - 1) / 2 := Finset.sum_range_id n + _ = n.choose 2 := by rw [Nat.choose_two_right] + +theorem auxiliaryFamily_k_le_card (h k : ℕ) : + k ≤ h * k + h + k := by omega + +section IndexedWronskian + +variable {C L : Type*} [Field C] [Field L] [Algebra C L] + +/-- Reindexing both rows and columns identifies the indexed consecutive-order +Wronskian with the ordinary `Fin n` Wronskian. -/ +theorem indexedAuxiliaryWronskian_det_eq_derivationWronskian_det + (D : Derivation C L L) (h k : ℕ) + (f : Sum (Fin k) (Fin (k + 1) × Fin h) → L) : + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) f).det = + (BGS.Algebra.derivationWronskian D + (fun j : Fin (h * k + h + k) => + f ((auxiliaryFamilyIndexEquiv h k).symm j))).det := by + let e := auxiliaryFamilyIndexEquiv h k + let g : Fin (h * k + h + k) → L := fun j => f (e.symm j) + have hmatrix : + indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) f = + Matrix.reindex e.symm e.symm + (BGS.Algebra.derivationWronskian D g) := by + ext i j + simp [indexedDedekindLocalWronskian, + auxiliaryFamilyDerivativeOrder, BGS.Algebra.derivationWronskian, + Matrix.reindex_apply, Matrix.submatrix, g, e] + exact (Module.End.pow_apply D.toLinearMap _ (f j)).symm + rw [hmatrix, Matrix.det_reindex_self] + +/-- Exact constants and linear independence make the indexed global +Wronskian nonzero. -/ +theorem indexedAuxiliaryWronskian_det_ne_zero_of_linearIndependent + (D : Derivation C L L) + (hconstants : ∀ x : L, D x = 0 → + ∃ c : C, algebraMap C L c = x) + (h k : ℕ) (f : Sum (Fin k) (Fin (k + 1) × Fin h) → L) + (hLI : LinearIndependent C f) : + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) f).det ≠ 0 := by + let e := auxiliaryFamilyIndexEquiv h k + let g : Fin (h * k + h + k) → L := fun j => f (e.symm j) + have hLIg : LinearIndependent C g := hLI.comp e.symm e.symm.injective + rw [indexedAuxiliaryWronskian_det_eq_derivationWronskian_det] + exact BGS.Algebra.derivationWronskian_det_ne_zero_of_linearIndependent + D hconstants _ g hLIg + +end IndexedWronskian + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean new file mode 100644 index 0000000000..34d1aede5e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean @@ -0,0 +1,199 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +import Mathlib.RingTheory.Polynomial.GaussLemma + +/-! +# Gauss descent for the Corvaja--Zannier bivariate resultant + +When the resultant in the first variable vanishes, Corvaja and Zannier first +obtain divisibility over the rational-function coefficient field and then use +Gauss' lemma to descend that divisibility to the bivariate polynomial ring. +This descent is what permits reading off *both* coordinate degrees, rather +than only the degree in the eliminated variable. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {C : Type*} [Field C] + +/-- The project-local transpose is the standard bivariate variable swap. -/ +theorem transposeBivariate_eq_bivariateSwap : + transposeBivariate (C := C) = + (Polynomial.Bivariate.swap (R := C)).toRingHom := by + ext <;> simp [transposeBivariate, Polynomial.Bivariate.swap_apply] + +/-- Swapping the two variables twice is the identity. -/ +@[simp] +theorem transposeBivariate_transposeBivariate + (P : Polynomial (Polynomial C)) : + transposeBivariate (transposeBivariate P) = P := by + rw [transposeBivariate_eq_bivariateSwap] + change Polynomial.Bivariate.swap + (Polynomial.Bivariate.swap P) = P + exact Polynomial.Bivariate.swap_swap_apply P + +/-- Swapping the variables is injective. -/ +theorem transposeBivariate_injective : + Function.Injective (transposeBivariate (C := C)) := by + intro P Q h + simpa only [transposeBivariate_transposeBivariate] using + congrArg transposeBivariate h + +/-- The ordinary (actual-degree) resultant vanishes in the common-zero branch +once its degree is smaller than the minimal-polynomial degree of `v`. + +Using the ordinary resultant here is essential: a Sylvester determinant +padded to an upper degree bound can vanish for the purely formal reason that +one polynomial has smaller actual degree, and therefore cannot support the +subsequent Gauss descent. -/ +theorem resultant_auxiliaryRelation_default_eq_zero_of_common_zero + {L : Type*} [Field L] [Algebra C L] + (f : Polynomial (Polynomial C)) (a b h k q : ℕ) + (ha : 0 < a) (hh : 0 < h) (hk : 0 < k) + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) + (hfDegree : f.natDegree = a) + (hfCoeffDegree : ∀ i, (f.coeff i).natDegree ≤ b) + (u v : L) (hminpoly : (minpoly C v).natDegree = q) + (hfZero : evalBivariate v u f = 0) + (hauxZero : + evalBivariate u v (auxiliaryRelationPolynomial c d) = 0) + (hsize : a * h + k * b < q) : + Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d)) = 0 := by + apply eq_zero_of_natDegree_lt_minpoly_of_eval₂_eq_zero v + · rw [hminpoly] + exact (natDegree_resultant_auxiliaryRelation_default_le + f a b h k hh hk c d hfDegree.le hfCoeffDegree).trans_lt hsize + · have hfNatDegreeNonzero : f.natDegree ≠ 0 := + hfDegree.trans_ne ha.ne' + have hauxAtCommonZero : + evalBivariate v u + (transposeBivariate (auxiliaryRelationPolynomial c d)) = 0 := by + rw [evalBivariate_transposeBivariate] + exact hauxZero + exact eval₂_resultant_eq_zero_of_common_zero f + (transposeBivariate (auxiliaryRelationPolynomial c d)) + f.natDegree + (transposeBivariate (auxiliaryRelationPolynomial c d)).natDegree + (le_refl _) (le_refl _) (Or.inl hfNatDegreeNonzero) u v + hfZero hauxAtCommonZero + +/-- Source-faithful Gauss descent: zero resultant gives divisibility already +in `C[V][U]`, not merely after passing to `C(V)[U]`. + +The nonconstant hypothesis is exactly what makes the irreducible polynomial +primitive over `C[V]`; Gauss' lemma then descends the divisibility obtained +over `Frac(C[V])`. -/ +theorem dvd_of_irreducible_of_resultant_eq_zero_via_gauss + {f g : Polynomial (Polynomial C)} + (hf : Irreducible f) (hfNonconstant : f.natDegree ≠ 0) + (hresultant : Polynomial.resultant f g = 0) : + f ∣ g := by + let K := FractionRing (Polynomial C) + let φ : Polynomial C →+* K := algebraMap (Polynomial C) K + have hφ : Function.Injective φ := IsFractionRing.injective _ _ + have hprimitive : f.IsPrimitive := hf.isPrimitive hfNonconstant + have hfMap : Irreducible (f.map φ) := by + exact hprimitive.irreducible_iff_irreducible_map_fraction_map.mp hf + have hdvdMap : f.map φ ∣ g.map φ := + map_dvd_of_resultant_eq_zero f g φ hφ hfMap hresultant + exact hprimitive.dvd_of_fraction_map_dvd_fraction_map hdvdMap + +/-- Gauss descent followed by variable swapping bounds both bidegrees of a +nonzero multiple. -/ +theorem bidegree_le_of_irreducible_of_resultant_eq_zero + {f g : Polynomial (Polynomial C)} + (hf : Irreducible f) (hfNonconstant : f.natDegree ≠ 0) + (hg : g ≠ 0) (hresultant : Polynomial.resultant f g = 0) : + f.natDegree ≤ g.natDegree ∧ + (transposeBivariate f).natDegree ≤ + (transposeBivariate g).natDegree := by + have hdvd : f ∣ g := + dvd_of_irreducible_of_resultant_eq_zero_via_gauss + hf hfNonconstant hresultant + refine ⟨Polynomial.natDegree_le_of_dvd hdvd hg, ?_⟩ + have hdvdTranspose : transposeBivariate f ∣ transposeBivariate g := + map_dvd transposeBivariate hdvd + have hgTranspose : transposeBivariate g ≠ 0 := + fun hzero => hg (transposeBivariate_injective (by simpa using hzero)) + exact Polynomial.natDegree_le_of_dvd hdvdTranspose hgTranspose + +/-- The exact degree conclusion in the zero-resultant branch of the +Corvaja--Zannier auxiliary-family argument. + +Here `f` is oriented as a polynomial in `U` with coefficients in `C[V]`. +Thus `f.natDegree = a`, while the degree of its variable swap is `b`. The +auxiliary relation is constructed in the source orientation and swapped for +the resultant. -/ +theorem auxiliaryRelation_bidegree_bounds_of_resultant_eq_zero + (f : Polynomial (Polynomial C)) (a b h k : ℕ) + (ha : 0 < a) (hh : 0 < h) (hk : 0 < k) + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) + (hf : Irreducible f) + (hfDegreeU : f.natDegree = a) + (hfDegreeV : (transposeBivariate f).natDegree = b) + (hauxNonzero : auxiliaryRelationPolynomial c d ≠ 0) + (hresultant : Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d)) = 0) : + a ≤ k ∧ b ≤ h := by + have hauxTransposeNonzero : + transposeBivariate (auxiliaryRelationPolynomial c d) ≠ 0 := by + intro hzero + exact hauxNonzero (transposeBivariate_injective (by simpa using hzero)) + have hdegrees := bidegree_le_of_irreducible_of_resultant_eq_zero + hf (hfDegreeU.trans_ne ha.ne') hauxTransposeNonzero hresultant + constructor + · rw [← hfDegreeU] + exact hdegrees.1.trans + (transpose_auxiliaryRelationPolynomial_natDegree_le hk c d) + · rw [← hfDegreeV] + exact hdegrees.2.trans (by + simpa only [transposeBivariate_transposeBivariate] using + auxiliaryRelationPolynomial_natDegree_le hh c d) + +/-- Corvaja--Zannier Proposition 1, through its complete algebraic resultant +branch. If the defining relation has bidegree `(a,b)`, its ordinary +resultant with any nonzero auxiliary relation would force `a ≤ k` and +`b ≤ h`. Excluding that degree alternative therefore makes the exact +auxiliary family linearly independent. + +The assumptions expose the two genuinely external inputs to this algebraic +step: iterated-polynomial irreducibility of the defining equation and the +minimal-polynomial degree `q` of `v` over the coefficient field. -/ +theorem auxiliaryFamily_linearIndependent_of_irreducible_bidegree + {L : Type*} [Field L] [Algebra C L] + (f : Polynomial (Polynomial C)) (a b h k q : ℕ) + (ha : 0 < a) (hh : 0 < h) (hk : 0 < k) + (hf : Irreducible f) + (hfDegreeU : f.natDegree = a) + (hfDegreeV : (transposeBivariate f).natDegree = b) + (hfCoeffDegree : ∀ i, (f.coeff i).natDegree ≤ b) + (u v : L) (hv : v ≠ 1) + (hminpoly : (minpoly C v).natDegree = q) + (hfZero : evalBivariate v u f = 0) + (hsize : a * h + b * k < q) + (hdegreeAlternativeExcluded : ¬ (a ≤ k ∧ b ≤ h)) : + LinearIndependent C (auxiliaryFamily u v h k) := by + apply auxiliaryFamily_linearIndependent_of_no_relation u v hv + intro c d hauxNonzero hauxZero + have hresultant : Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d)) = 0 := + resultant_auxiliaryRelation_default_eq_zero_of_common_zero + f a b h k q ha hh hk c d hfDegreeU hfCoeffDegree u v hminpoly + hfZero hauxZero (by simpa [Nat.mul_comm] using hsize) + have hbidegrees : a ≤ k ∧ b ≤ h := + auxiliaryRelation_bidegree_bounds_of_resultant_eq_zero + f a b h k ha hh hk c d hf hfDegreeU hfDegreeV hauxNonzero + hresultant + exact hdegreeAlternativeExcluded hbidegrees + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean new file mode 100644 index 0000000000..8c4d2db82d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean @@ -0,0 +1,514 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +import Mathlib.Algebra.Polynomial.BigOperators +import Mathlib.Algebra.Polynomial.Bivariate +import Mathlib.FieldTheory.Minpoly.Field +import Mathlib.RingTheory.Polynomial.Resultant.Basic + +/-! +# Degree bounds for bivariate resultants + +Corvaja--Zannier eliminate the first variable from a defining polynomial +`f(U,V)` and an auxiliary relation `P(U,V)`. They use the Sylvester +determinant estimate + +`deg_V Res_U(f, P) ≤ deg_U(f) * deg_V(P) + deg_U(P) * deg_V(f)`. + +Here bivariate polynomials are represented as polynomials in `U` whose +coefficients lie in `C[V]`. The proof records the sharper columnwise degree +bound for determinants: each determinant term uses exactly one entry from +every Sylvester column, so the coefficient bounds add with the correct +multiplicities. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators + +variable {C : Type*} [Field C] + +/-- Exchange the two variables of an iterated bivariate polynomial. Both the +source and target have Lean type `C[U][V]`; the target is interpreted as +`C[V][U]`. -/ +def transposeBivariate : + Polynomial (Polynomial C) →+* Polynomial (Polynomial C) := + Polynomial.eval₂RingHom + (Polynomial.mapRingHom (Polynomial.C : C →+* Polynomial C)) + (Polynomial.C Polynomial.X) + +@[simp] +theorem transposeBivariate_C (p : Polynomial C) : + transposeBivariate (Polynomial.C p) = p.map Polynomial.C := by + simp [transposeBivariate] + +@[simp] +theorem transposeBivariate_X : + transposeBivariate (Polynomial.X : Polynomial (Polynomial C)) = + Polynomial.C Polynomial.X := by + simp [transposeBivariate] + +private theorem evalBivariate_add + {L : Type*} [Field L] [Algebra C L] + (u v : L) (P Q : Polynomial (Polynomial C)) : + evalBivariate u v (P + Q) = + evalBivariate u v P + evalBivariate u v Q := by + unfold evalBivariate + exact Polynomial.eval₂_add + (Polynomial.eval₂RingHom (algebraMap C L) u) v + +private theorem evalBivariate_mul + {L : Type*} [Field L] [Algebra C L] + (u v : L) (P Q : Polynomial (Polynomial C)) : + evalBivariate u v (P * Q) = + evalBivariate u v P * evalBivariate u v Q := by + unfold evalBivariate + exact Polynomial.eval₂_mul + (Polynomial.eval₂RingHom (algebraMap C L) u) v + +@[simp] +theorem evalBivariate_map_C + {L : Type*} [Field L] [Algebra C L] + (u v : L) (p : Polynomial C) : + evalBivariate v u (p.map Polynomial.C) = + p.eval₂ (algebraMap C L) u := by + unfold evalBivariate + rw [Polynomial.eval₂_map] + congr 1 + exact Polynomial.eval₂RingHom_comp_C (algebraMap C L) v + +@[simp] +theorem evalBivariate_C_X_pow + {L : Type*} [Field L] [Algebra C L] + (u v : L) (n : ℕ) : + evalBivariate v u + ((Polynomial.C Polynomial.X : Polynomial (Polynomial C)) ^ n) = v ^ n := by + unfold evalBivariate + rw [Polynomial.eval₂_pow, Polynomial.eval₂_C] + change (Polynomial.eval₂ (algebraMap C L) v Polynomial.X) ^ n = v ^ n + rw [Polynomial.eval₂_X] + +/-- Swapping variables and then evaluating at the swapped point preserves the +value of a bivariate polynomial. -/ +theorem evalBivariate_transposeBivariate + {L : Type*} [Field L] [Algebra C L] + (u v : L) (P : Polynomial (Polynomial C)) : + evalBivariate v u (transposeBivariate P) = evalBivariate u v P := by + induction P using Polynomial.induction_on' with + | add P Q hP hQ => + rw [map_add, evalBivariate_add, evalBivariate_add, hP, hQ] + | monomial n p => + rw [show transposeBivariate (Polynomial.monomial n p) = + p.map Polynomial.C * + (Polynomial.C Polynomial.X : Polynomial (Polynomial C)) ^ n by + simp [transposeBivariate, Polynomial.eval₂_monomial]] + rw [evalBivariate_mul, evalBivariate_map_C, evalBivariate_C_X_pow] + unfold evalBivariate + rw [Polynomial.eval₂_monomial] + rfl + +/-- A coefficientwise degree bound becomes an outer degree bound after +transposing the variables. -/ +theorem transposeBivariate_natDegree_le + (P : Polynomial (Polynomial C)) (k : ℕ) + (hcoeff : ∀ s, (P.coeff s).natDegree ≤ k) : + (transposeBivariate P).natDegree ≤ k := by + classical + change (P.eval₂ + (Polynomial.mapRingHom (Polynomial.C : C →+* Polynomial C)) + (Polynomial.C Polynomial.X)).natDegree ≤ k + rw [Polynomial.eval₂_eq_sum, Polynomial.sum_def] + apply Polynomial.natDegree_sum_le_of_forall_le + intro s _ + calc + ((P.coeff s).map Polynomial.C * + (Polynomial.C Polynomial.X : Polynomial (Polynomial C)) ^ s).natDegree + ≤ ((P.coeff s).map Polynomial.C).natDegree + + ((Polynomial.C Polynomial.X : Polynomial (Polynomial C)) ^ s).natDegree := + Polynomial.natDegree_mul_le + _ ≤ k + 0 := by + exact Nat.add_le_add + (Polynomial.natDegree_map_le.trans (hcoeff s)) (by simp) + _ = k := Nat.add_zero k + +/-- An outer degree bound becomes a coefficientwise degree bound after +transposing the variables. -/ +theorem transposeBivariate_coeff_natDegree_le + (P : Polynomial (Polynomial C)) (h : ℕ) + (hdegree : P.natDegree ≤ h) (r : ℕ) : + ((transposeBivariate P).coeff r).natDegree ≤ h := by + classical + change ((P.eval₂ + (Polynomial.mapRingHom (Polynomial.C : C →+* Polynomial C)) + (Polynomial.C Polynomial.X)).coeff r).natDegree ≤ h + rw [Polynomial.eval₂_eq_sum, Polynomial.sum_def, + Polynomial.finsetSum_coeff] + apply Polynomial.natDegree_sum_le_of_forall_le + intro s hs + rw [show (Polynomial.C Polynomial.X : Polynomial (Polynomial C)) ^ s = + Polynomial.C (Polynomial.X ^ s) by simp] + rw [Polynomial.coeff_mul_C, Polynomial.coe_mapRingHom, + Polynomial.coeff_map] + exact (Polynomial.natDegree_C_mul_X_pow_le _ s).trans + ((Polynomial.le_natDegree_of_mem_supp s hs).trans hdegree) + +private theorem auxiliaryPowerPolynomial_mul_one_sub_X_natDegree_le + {k : ℕ} (hk : 0 < k) (c : Fin k → C) : + (auxiliaryPowerPolynomial c * (1 - Polynomial.X)).natDegree ≤ k := by + have hfactor : + (1 - Polynomial.X : Polynomial C).natDegree ≤ 1 := by + exact (Polynomial.natDegree_sub_le _ _).trans (by simp) + calc + (auxiliaryPowerPolynomial c * (1 - Polynomial.X)).natDegree + ≤ (auxiliaryPowerPolynomial c).natDegree + + (1 - Polynomial.X : Polynomial C).natDegree := + Polynomial.natDegree_mul_le + _ ≤ (auxiliaryPowerPolynomial c).natDegree + 1 := + Nat.add_le_add_left hfactor _ + _ ≤ k := by + have := auxiliaryPowerPolynomial_natDegree_lt hk c + omega + +/-- The source-oriented auxiliary relation has degree at most `h` in its +outer variable `V`. -/ +theorem auxiliaryRelationPolynomial_natDegree_le + {h k : ℕ} (hh : 0 < h) (c : Fin k → C) + (d : Fin (k + 1) × Fin h → C) : + (auxiliaryRelationPolynomial c d).natDegree ≤ h := by + have hfactor : + (1 - Polynomial.X : Polynomial (Polynomial C)).natDegree ≤ 1 := by + exact (Polynomial.natDegree_sub_le _ _).trans (by simp) + have hgrid : (auxiliaryGridPolynomial d).natDegree + 1 ≤ h := by + have := auxiliaryGridPolynomial_natDegree_lt hh d + omega + have hconstant : + (Polynomial.C + (auxiliaryPowerPolynomial c * (1 - Polynomial.X)) : + Polynomial (Polynomial C)).natDegree ≤ h := by + rw [Polynomial.natDegree_C] + exact Nat.zero_le h + unfold auxiliaryRelationPolynomial + apply Polynomial.natDegree_add_le_of_degree_le + · simpa only [map_mul, map_sub, map_one, Polynomial.map_X] using hconstant + · calc + (auxiliaryGridPolynomial d * (1 - Polynomial.X)).natDegree + ≤ (auxiliaryGridPolynomial d).natDegree + + (1 - Polynomial.X : Polynomial (Polynomial C)).natDegree := + Polynomial.natDegree_mul_le + _ ≤ (auxiliaryGridPolynomial d).natDegree + 1 := + Nat.add_le_add_left hfactor _ + _ ≤ h := hgrid + +/-- Every `V`-coefficient of the source-oriented auxiliary relation has +`U`-degree at most `k`. -/ +theorem auxiliaryRelationPolynomial_coeff_natDegree_le + {h k : ℕ} (hk : 0 < k) (c : Fin k → C) + (d : Fin (k + 1) × Fin h → C) (s : ℕ) : + ((auxiliaryRelationPolynomial c d).coeff s).natDegree ≤ k := by + let A : Polynomial C := auxiliaryPowerPolynomial c * (1 - Polynomial.X) + let G : Polynomial (Polynomial C) := auxiliaryGridPolynomial d + have hA : A.natDegree ≤ k := + auxiliaryPowerPolynomial_mul_one_sub_X_natDegree_le hk c + have hG (i : ℕ) : (G.coeff i).natDegree ≤ k := + auxiliaryGridPolynomial_coeff_natDegree_le d i + have hrewrite : auxiliaryRelationPolynomial c d = + Polynomial.C A + G - G * Polynomial.X := by + simp only [auxiliaryRelationPolynomial, A, G] + ring + rw [hrewrite] + cases s with + | zero => + simp only [Polynomial.coeff_sub, Polynomial.coeff_add, + Polynomial.coeff_C_zero, Polynomial.coeff_mul_X_zero, sub_zero] + exact Polynomial.natDegree_add_le_of_degree_le hA (hG 0) + | succ s => + simp only [Polynomial.coeff_sub, Polynomial.coeff_add, + Polynomial.coeff_C, if_neg (Nat.succ_ne_zero s), zero_add, + Polynomial.coeff_mul_X] + simpa using Polynomial.natDegree_sub_le_of_le (hG (s + 1)) (hG s) + +/-- In the `U`-oriented representation required by `Res_U`, the auxiliary +relation has `U`-degree at most `k`. -/ +theorem transpose_auxiliaryRelationPolynomial_natDegree_le + {h k : ℕ} (hk : 0 < k) (c : Fin k → C) + (d : Fin (k + 1) × Fin h → C) : + (transposeBivariate (auxiliaryRelationPolynomial c d)).natDegree ≤ k := + transposeBivariate_natDegree_le _ k + (auxiliaryRelationPolynomial_coeff_natDegree_le hk c d) + +/-- In the `U`-oriented representation required by `Res_U`, every coefficient +has `V`-degree at most `h`. -/ +theorem transpose_auxiliaryRelationPolynomial_coeff_natDegree_le + {h k : ℕ} (hh : 0 < h) (c : Fin k → C) + (d : Fin (k + 1) × Fin h → C) (r : ℕ) : + ((transposeBivariate (auxiliaryRelationPolynomial c d)).coeff r).natDegree ≤ h := + transposeBivariate_coeff_natDegree_le _ h + (auxiliaryRelationPolynomial_natDegree_le hh c d) r + +/-- A determinant over `C[V]` has degree at most the sum of columnwise degree +bounds. -/ +theorem Matrix.natDegree_det_le_sum_columnDegree + {n : Type*} [Fintype n] [DecidableEq n] + (M : Matrix n n (Polynomial C)) (columnDegree : n → ℕ) + (hM : ∀ i j, (M i j).natDegree ≤ columnDegree j) : + M.det.natDegree ≤ ∑ j, columnDegree j := by + classical + rw [Matrix.det_apply'] + apply Polynomial.natDegree_sum_le_of_forall_le + intro σ _ + calc + (Equiv.Perm.sign σ * ∏ i, M (σ i) i).natDegree + ≤ (∏ i, M (σ i) i).natDegree := by + exact Polynomial.natDegree_C_mul_le _ _ + _ ≤ ∑ i, (M (σ i) i).natDegree := by + simpa using Polynomial.natDegree_prod_le Finset.univ (fun i => M (σ i) i) + _ ≤ ∑ i, columnDegree i := by + exact Finset.sum_le_sum fun i _ => hM (σ i) i + +/-- The exact coefficient-degree estimate for a resultant over `C[V]`. + +`f` has `U`-degree bounded by `m` and every `V`-coefficient degree bounded by +`df`; `g` has the analogous bounds `n` and `dg`. -/ +theorem natDegree_resultant_le + (f g : Polynomial (Polynomial C)) (m n df dg : ℕ) + (hf : ∀ i, (f.coeff i).natDegree ≤ df) + (hg : ∀ i, (g.coeff i).natDegree ≤ dg) : + (Polynomial.resultant f g m n).natDegree ≤ m * dg + n * df := by + rw [Polynomial.resultant] + let columnDegree : Fin (m + n) → ℕ := fun j => + j.addCases (fun _ => dg) (fun _ => df) + have hcolumns : ∀ i j, + ((Polynomial.sylvester f g m n) i j).natDegree ≤ columnDegree j := by + intro i j + induction j using Fin.addCases with + | left j => + simp only [Polynomial.sylvester, Matrix.of_apply, Fin.addCases_left, + columnDegree] + split_ifs + · exact hg _ + · simp + | right j => + simp only [Polynomial.sylvester, Matrix.of_apply, Fin.addCases_right, + columnDegree] + split_ifs + · exact hf _ + · simp + calc + (Polynomial.sylvester f g m n).det.natDegree + ≤ ∑ j, columnDegree j := + Matrix.natDegree_det_le_sum_columnDegree + (Polynomial.sylvester f g m n) columnDegree hcolumns + _ = m * dg + n * df := by + simp [columnDegree, Fin.sum_univ_add] + +/-- The source-faithful version using the ordinary resultant at the actual +degrees, while bounding those degrees by `m` and `n`. -/ +theorem natDegree_resultant_le_of_degree_le + (f g : Polynomial (Polynomial C)) (m n df dg : ℕ) + (hfDegree : f.natDegree ≤ m) (hgDegree : g.natDegree ≤ n) + (hf : ∀ i, (f.coeff i).natDegree ≤ df) + (hg : ∀ i, (g.coeff i).natDegree ≤ dg) : + (Polynomial.resultant f g).natDegree ≤ m * dg + n * df := by + calc + (Polynomial.resultant f g).natDegree + ≤ f.natDegree * dg + g.natDegree * df := + natDegree_resultant_le f g f.natDegree g.natDegree df dg hf hg + _ ≤ m * dg + n * df := by + exact Nat.add_le_add + (Nat.mul_le_mul_right dg hfDegree) + (Nat.mul_le_mul_right df hgDegree) + +/-- The exact Corvaja--Zannier resultant degree bound for the transposed +auxiliary relation. -/ +theorem natDegree_resultant_auxiliaryRelation_le + (f : Polynomial (Polynomial C)) (a b h k : ℕ) (hh : 0 < h) + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) + (hf : ∀ i, (f.coeff i).natDegree ≤ b) : + (Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d)) a k).natDegree + ≤ a * h + k * b := + natDegree_resultant_le f + (transposeBivariate (auxiliaryRelationPolynomial c d)) a k b h hf + (transpose_auxiliaryRelationPolynomial_coeff_natDegree_le hh c d) + +/-- The ordinary-resultant degree bound for the transposed auxiliary relation. +This is the version used by the subsequent irreducibility/divisibility +argument. -/ +theorem natDegree_resultant_auxiliaryRelation_default_le + (f : Polynomial (Polynomial C)) (a b h k : ℕ) + (hh : 0 < h) (hk : 0 < k) + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) + (hfDegree : f.natDegree ≤ a) + (hf : ∀ i, (f.coeff i).natDegree ≤ b) : + (Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d))).natDegree + ≤ a * h + k * b := + natDegree_resultant_le_of_degree_le f + (transposeBivariate (auxiliaryRelationPolynomial c d)) a k b h + hfDegree (transpose_auxiliaryRelationPolynomial_natDegree_le hk c d) hf + (transpose_auxiliaryRelationPolynomial_coeff_natDegree_le hh c d) + +/-- Two polynomials of the prescribed degree bounds with a common root have +zero explicit-degree resultant. -/ +theorem resultant_eq_zero_of_common_root + {K : Type*} [Field K] (f g : Polynomial K) (m n : ℕ) + (hf : f.natDegree ≤ m) (hg : g.natDegree ≤ n) + (hmn : m ≠ 0 ∨ n ≠ 0) (x : K) + (hfx : f.eval x = 0) (hgx : g.eval x = 0) : + Polynomial.resultant f g m n = 0 := by + obtain ⟨p, q, _, _, hbezout⟩ := + Polynomial.exists_mul_add_mul_eq_C_resultant f g hf hg hmn + have heval := congrArg (Polynomial.eval x) hbezout + simpa [hfx, hgx] using heval.symm + +/-- If two bivariate polynomials vanish at `(u,v)`, their resultant in `U` +vanishes at `v`. -/ +theorem eval₂_resultant_eq_zero_of_common_zero + {L : Type*} [Field L] [Algebra C L] + (f g : Polynomial (Polynomial C)) (m n : ℕ) + (hf : f.natDegree ≤ m) (hg : g.natDegree ≤ n) + (hmn : m ≠ 0 ∨ n ≠ 0) (u v : L) + (hfu : evalBivariate v u f = 0) + (hgu : evalBivariate v u g = 0) : + (Polynomial.resultant f g m n).eval₂ (algebraMap C L) v = 0 := by + let ev : Polynomial C →+* L := + Polynomial.eval₂RingHom (algebraMap C L) v + have hfmap : (f.map ev).natDegree ≤ m := + Polynomial.natDegree_map_le.trans hf + have hgmap : (g.map ev).natDegree ≤ n := + Polynomial.natDegree_map_le.trans hg + have hfeval : (f.map ev).eval u = 0 := by + simpa [ev, evalBivariate, Polynomial.eval_map] using hfu + have hgeval : (g.map ev).eval u = 0 := by + simpa [ev, evalBivariate, Polynomial.eval_map] using hgu + have hmapped : Polynomial.resultant (f.map ev) (g.map ev) m n = 0 := + resultant_eq_zero_of_common_root + (f.map ev) (g.map ev) m n hfmap hgmap hmn u hfeval hgeval + rw [Polynomial.resultant_map_map] at hmapped + exact hmapped + +/-- The common-zero implication specialized to the Corvaja--Zannier +auxiliary relation. -/ +theorem eval₂_resultant_auxiliaryRelation_eq_zero_of_common_zero + {L : Type*} [Field L] [Algebra C L] + (f : Polynomial (Polynomial C)) (a h k : ℕ) + (ha : 0 < a) (hk : 0 < k) + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) + (hfDegree : f.natDegree ≤ a) (u v : L) + (hfZero : evalBivariate v u f = 0) + (hauxZero : + evalBivariate u v (auxiliaryRelationPolynomial c d) = 0) : + (Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d)) a k).eval₂ + (algebraMap C L) v = 0 := by + apply eval₂_resultant_eq_zero_of_common_zero f + (transposeBivariate (auxiliaryRelationPolynomial c d)) a k + hfDegree (transpose_auxiliaryRelationPolynomial_natDegree_le hk c d) + (Or.inl ha.ne') u v hfZero + rw [evalBivariate_transposeBivariate] + exact hauxZero + +/-- A nonzero polynomial vanishing at an algebraic element has degree at least +the degree of that element's minimal polynomial. -/ +theorem minpoly_natDegree_le_of_eval₂_eq_zero + {L : Type*} [Field L] [Algebra C L] + (y : L) (P : Polynomial C) (hP : P ≠ 0) + (hzero : P.eval₂ (algebraMap C L) y = 0) : + (minpoly C y).natDegree ≤ P.natDegree := by + apply Polynomial.natDegree_le_of_dvd (minpoly.dvd C y ?_) hP + simpa [Polynomial.aeval_def] using hzero + +/-- A polynomial whose degree is strictly smaller than the minimal-polynomial +degree cannot vanish at the element unless it is zero. -/ +theorem eq_zero_of_natDegree_lt_minpoly_of_eval₂_eq_zero + {L : Type*} [Field L] [Algebra C L] + (y : L) (P : Polynomial C) + (hdegree : P.natDegree < (minpoly C y).natDegree) + (hzero : P.eval₂ (algebraMap C L) y = 0) : P = 0 := by + by_contra hP + exact (not_lt_of_ge (minpoly_natDegree_le_of_eval₂_eq_zero y P hP hzero)) + hdegree + +/-- The complete nonzero-resultant contradiction in the +Corvaja--Zannier auxiliary-family argument. Under `a*h + k*b < q` and +minimal-polynomial degree `q`, the resultant must vanish identically. -/ +theorem resultant_auxiliaryRelation_eq_zero_of_common_zero + {L : Type*} [Field L] [Algebra C L] + (f : Polynomial (Polynomial C)) (a b h k q : ℕ) + (ha : 0 < a) (hh : 0 < h) (hk : 0 < k) + (c : Fin k → C) (d : Fin (k + 1) × Fin h → C) + (hfDegree : f.natDegree ≤ a) + (hfCoeffDegree : ∀ i, (f.coeff i).natDegree ≤ b) + (u v : L) (hminpoly : (minpoly C v).natDegree = q) + (hfZero : evalBivariate v u f = 0) + (hauxZero : + evalBivariate u v (auxiliaryRelationPolynomial c d) = 0) + (hsize : a * h + k * b < q) : + Polynomial.resultant f + (transposeBivariate (auxiliaryRelationPolynomial c d)) a k = 0 := by + apply eq_zero_of_natDegree_lt_minpoly_of_eval₂_eq_zero v + · rw [hminpoly] + exact (natDegree_resultant_auxiliaryRelation_le + f a b h k hh c d hfCoeffDegree).trans_lt hsize + · exact eval₂_resultant_auxiliaryRelation_eq_zero_of_common_zero + f a h k ha hk c d hfDegree u v hfZero hauxZero + +/-- Over a field, an irreducible polynomial divides any nonzero polynomial +with which it has zero resultant. -/ +theorem irreducible_dvd_of_resultant_eq_zero + {K : Type*} [Field K] {f g : Polynomial K} + (hf : Irreducible f) + (hresultant : Polynomial.resultant f g = 0) : f ∣ g := by + have hnotCoprime : ¬ IsCoprime f g := + (Polynomial.resultant_eq_zero_iff.mp hresultant).2 + exact (hf.dvd_iff_not_isCoprime).mpr hnotCoprime + +/-- The zero-resultant divisibility branch after embedding the coefficient +ring into a field (in the application, `C[V] → C(V)`). -/ +theorem map_dvd_of_resultant_eq_zero + {R K : Type*} [CommRing R] [Field K] + (f g : Polynomial R) (phi : R →+* K) (hphi : Function.Injective phi) + (hf : Irreducible (f.map phi)) + (hresultant : Polynomial.resultant f g = 0) : + f.map phi ∣ g.map phi := by + have hfgDegree : (f.map phi).natDegree = f.natDegree := + Polynomial.natDegree_map_eq_of_injective hphi f + have hggDegree : (g.map phi).natDegree = g.natDegree := + Polynomial.natDegree_map_eq_of_injective hphi g + have hresultantMappedExplicit : + Polynomial.resultant (f.map phi) (g.map phi) + f.natDegree g.natDegree = 0 := by + rw [Polynomial.resultant_map_map, hresultant, map_zero] + have hresultantMapped : + Polynomial.resultant (f.map phi) (g.map phi) = 0 := by + simpa only [hfgDegree, hggDegree] using hresultantMappedExplicit + exact irreducible_dvd_of_resultant_eq_zero hf hresultantMapped + +/-- The zero-resultant branch already forces the defining polynomial's +degree in the eliminated variable to be no larger than that of the auxiliary +relation after any injective coefficient-field embedding. -/ +theorem natDegree_le_of_map_irreducible_of_resultant_eq_zero + {R K : Type*} [CommRing R] [Field K] + (f g : Polynomial R) (phi : R →+* K) (hphi : Function.Injective phi) + (hf : Irreducible (f.map phi)) (hg : g ≠ 0) + (hresultant : Polynomial.resultant f g = 0) : + f.natDegree ≤ g.natDegree := by + have hdvd := map_dvd_of_resultant_eq_zero f g phi hphi hf hresultant + have hgmapped : g.map phi ≠ 0 := by + intro hzero + apply hg + apply Polynomial.map_injective phi hphi + simpa using hzero + rw [← Polynomial.natDegree_map_eq_of_injective hphi f, + ← Polynomial.natDegree_map_eq_of_injective hphi g] + exact Polynomial.natDegree_le_of_dvd hdvd hgmapped + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean new file mode 100644 index 0000000000..676e80c37e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean @@ -0,0 +1,145 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +import Mathlib.FieldTheory.LinearDisjoint + +/-! +# The completion linear-disjointness bridge + +This file isolates the abstract algebraic content of Corvaja--Zannier's +completion argument. Suppose that `L / F` has a basis +`1, z, ..., z^(q - 1)`, that `L` is embedded in a Laurent-series field, and +that the completed field over `F` has the same carrier as the exponent- +dilation subfield `K((z^q))`. The residue classes of exponents modulo `q` +then show that the basis remains linearly independent over the completed +field. Hence the completed field and `L` are linearly disjoint over `F`, and +their intersection in the ambient Laurent-series field is exactly the image +of `F`. + +The hypotheses below deliberately expose both compatibility conditions that +must come from curve geometry: + +* `hcompletion` identifies the chosen completed field, as a subfield of the + ambient Laurent-series field, with the exponent-dilation subfield; +* `hbasis` says that the ambient images of the chosen `F`-basis of `L` really + are `1, z, ..., z^(q - 1)`. + +No assertion here constructs a completion map or proves these compatibility +conditions for a plane curve. +-/ + +open HahnSeries +open Module + +noncomputable section + +namespace BGS.CorvajaZannier + +section AbstractBasisBridge + +universe u v w + +variable {F : Type u} {L : Type v} {E : Type w} + [Field F] [Field L] [Field E] + [Algebra F L] [Algebra F E] [Algebra L E] [IsScalarTower F L E] + +/-- A basis of `L / F` which remains linearly independent over an ambient +intermediate field proves linear disjointness and identifies the intersection +with the embedded base field. + +This is the abstract linear-algebra boundary used by the Laurent-series +specialization below. -/ +theorem linearDisjoint_and_inf_eq_bot_of_basis_ambient_linearIndependent + (C : IntermediateField F E) {ι : Type*} (b : Basis ι F L) + (hlinear : LinearIndependent C (fun i => algebraMap L E (b i))) : + C.LinearDisjoint L ∧ + C ⊓ (IsScalarTower.toAlgHom F L E).fieldRange = ⊥ := by + have hdisjoint : C.LinearDisjoint L := + IntermediateField.LinearDisjoint.of_basis_right' b (by + change LinearIndependent C (fun i => algebraMap L E (b i)) + exact hlinear) + have hdisjointRange : + C.LinearDisjoint (IsScalarTower.toAlgHom F L E).fieldRange := by + rw [IntermediateField.linearDisjoint_iff', AlgHom.fieldRange_toSubalgebra] + exact hdisjoint + exact ⟨hdisjoint, hdisjointRange.inf_eq_bot⟩ + +end AbstractBasisBridge + +section LaurentCompletion + +universe u v w + +variable {K : Type u} {F : Type v} {L : Type w} + [Field K] [Field F] [Field L] + [Algebra F L] + [Algebra F (LaurentSeries K)] + [Algebra L (LaurentSeries K)] + [IsScalarTower F L (LaurentSeries K)] + +private def sameCarrierRingEquiv + (C : IntermediateField F (LaurentSeries K)) + (D : IntermediateField K (LaurentSeries K)) + (hcarrier : ∀ x : LaurentSeries K, x ∈ C ↔ x ∈ D) : C ≃+* D where + toFun x := ⟨x, (hcarrier x).mp x.property⟩ + invFun x := ⟨x, (hcarrier x).mpr x.property⟩ + left_inv _ := Subtype.ext rfl + right_inv _ := Subtype.ext rfl + map_mul' := fun _ _ => rfl + map_add' := fun _ _ => rfl + +/-- **Completion form of Corvaja--Zannier's Lemma 2.** + +Let `C` be the completed exponent-dilation field inside `K((z))`, represented +as an intermediate field over `F`. If `L / F` has a `Fin q`-indexed basis +whose ambient images are `1, z, ..., z^(q - 1)`, then `C` and `L` are linearly +disjoint over `F`. Their intersection inside `K((z))` is the bottom +intermediate field, i.e. the image of `F`. + +The carrier equality is stated elementwise because `C` and +`laurentExponentSubfield K hq` have different declared base fields even +though they are subfields of the same Laurent-series field. -/ +theorem laurentExponentCompletion_linearDisjoint_and_inf_eq_bot + {q : ℕ} (hq : 0 < q) + (C : IntermediateField F (LaurentSeries K)) + (hcompletion : ∀ x : LaurentSeries K, + x ∈ C ↔ x ∈ laurentExponentSubfield K hq) + (b : Basis (Fin q) F L) + (hbasis : ∀ i : Fin q, + algebraMap L (LaurentSeries K) (b i) = + laurentParameter K ^ (i : ℕ)) : + C.LinearDisjoint L ∧ + C ⊓ (IsScalarTower.toAlgHom F L (LaurentSeries K)).fieldRange = ⊥ := by + let D : IntermediateField K (LaurentSeries K) := + laurentExponentSubfield K hq + let e : C ≃+* D := sameCarrierRingEquiv C D hcompletion + have he_val (c : C) : ((e c : D) : LaurentSeries K) = (c : LaurentSeries K) := rfl + have hpowersD : LinearIndependent D + (fun i : Fin q => laurentParameter K ^ (i : ℕ)) := by + simpa only [D] using linearIndependent_laurentParameter_pow K hq + have hpowersC : LinearIndependent C + (fun i : Fin q => laurentParameter K ^ (i : ℕ)) := by + refine hpowersD.map_of_injective_injective + (fun c : C => e c) (AddMonoidHom.id (LaurentSeries K)) ?_ ?_ ?_ + · intro c hc + exact e.injective (by simpa using hc) + · intro x hx + exact hx + · intro c x + change ((e c : D) : LaurentSeries K) * x = (c : LaurentSeries K) * x + rw [he_val] + have hbasisLinear : LinearIndependent C + (fun i : Fin q => algebraMap L (LaurentSeries K) (b i)) := by + rw [show (fun i : Fin q => algebraMap L (LaurentSeries K) (b i)) = + (fun i : Fin q => laurentParameter K ^ (i : ℕ)) from funext hbasis] + exact hpowersC + exact linearDisjoint_and_inf_eq_bot_of_basis_ambient_linearIndependent + C b hbasisLinear + +end LaurentCompletion + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean new file mode 100644 index 0000000000..e51da05fb1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean @@ -0,0 +1,926 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +import Mathlib.LinearAlgebra.Matrix.Transvection + +/-! +# Corvaja--Zannier case (i) at a Dedekind DVR place + +This file transports the repeated-leading-term cancellation argument of +Corvaja--Zannier's local case (i) from Laurent series to the fraction field of +a discrete valuation ring. Constants are assumed to surject onto the residue +field. This is precisely the input needed to cancel equal-order leading +terms; no coefficient field or completion is chosen. + +The Wronskian estimate only assumes that the derivation preserves the DVR. +In particular, a column of nonnegative order and every one of its iterated +derivatives remain regular. Combining this with determinant-one elimination +gives the source bound `q * ord(rho)` for the full auxiliary family. + +Source provenance: published pages 1935--1936; checked semantic reconstruction +`Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 640--685. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators +open IsDedekindDomain Multiplicative WithZero + +variable {C R L : Type*} [Field C] [CommRing R] [IsDedekindDomain R] + [IsDiscreteValuationRing R] [Field L] [Algebra C R] [Algebra R L] + [Algebra C L] [IsScalarTower C R L] [IsFractionRing R L] + +/-- The depth of the pole of `x` at `v`; zero has pole depth zero. -/ +def dedekindPoleDepth (v : HeightOneSpectrum R) (x : L) : ℕ := + by + classical + exact if x = 0 then 0 else Int.toNat (-finitePlaceOrder v x) + +/-- A terminating measure for repeated leading-term cancellation. -/ +def dedekindPoleWeight {k : ℕ} (v : HeightOneSpectrum R) (f : Fin k → L) : ℕ := + ∑ i, dedekindPoleDepth v (f i) + +@[simp] +theorem dedekindPoleDepth_zero (v : HeightOneSpectrum R) : + dedekindPoleDepth (L := L) v 0 = 0 := by + simp [dedekindPoleDepth] + +/-- All negative finite-place orders in a family are pairwise distinct. -/ +def NegativeFinitePlaceOrdersPairwiseDistinct {ι : Type*} + (v : HeightOneSpectrum R) (f : ι → L) : Prop := + ∀ ⦃i j : ι⦄, finitePlaceOrderTop v (f i) < 0 → + finitePlaceOrderTop v (f j) < 0 → + finitePlaceOrderTop v (f i) = finitePlaceOrderTop v (f j) → i = j + +@[simp] +theorem dedekindPoleDepth_pos_iff (v : HeightOneSpectrum R) (x : L) : + 0 < dedekindPoleDepth v x ↔ finitePlaceOrderTop v x < 0 := by + by_cases hx : x = 0 + · subst x + simp [dedekindPoleDepth] + · rw [finitePlaceOrderTop_eq_coe v x hx] + simp [dedekindPoleDepth, hx] + +@[simp] +theorem dedekindPoleDepth_eq_zero_iff (v : HeightOneSpectrum R) (x : L) : + dedekindPoleDepth v x = 0 ↔ 0 ≤ finitePlaceOrderTop v x := by + by_cases hx : x = 0 + · subst x + simp [dedekindPoleDepth] + · rw [finitePlaceOrderTop_eq_coe v x hx] + simp [dedekindPoleDepth, hx, Int.toNat_eq_zero] + +/-- Equal negative orders have a constant cancellation which strictly lowers +the pole-depth measure. -/ +theorem exists_constant_dedekindPoleDepth_sub_mul_lt + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (x y : L) + (hxneg : finitePlaceOrderTop v x < 0) + (hyneg : finitePlaceOrderTop v y < 0) + (horder : finitePlaceOrderTop v x = finitePlaceOrderTop v y) : + ∃ c : C, + dedekindPoleDepth v (x - algebraMap C L c * y) < + dedekindPoleDepth v x ∧ + finitePlaceOrderTop v x < + finitePlaceOrderTop v (x - algebraMap C L c * y) := by + have hx : x ≠ 0 := by + intro h + subst x + simp at hxneg + have hy : y ≠ 0 := by + intro h + subst y + simp at hyneg + have horder' : finitePlaceOrder v x = finitePlaceOrder v y := by + rw [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy] at horder + exact_mod_cast horder + obtain ⟨c, hz | hlt⟩ := + exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt + v hresidue x y hx hy horder' + · refine ⟨c, ?_, ?_⟩ + rw [hz] + have hxdepth : 0 < dedekindPoleDepth v x := + (dedekindPoleDepth_pos_iff v x).2 hxneg + simpa only [dedekindPoleDepth_zero] using hxdepth + rw [hz, finitePlaceOrderTop_eq_coe v x hx] + simp + · by_cases hz : x - algebraMap C L c * y = 0 + · refine ⟨c, ?_, ?_⟩ + rw [hz] + have hxdepth : 0 < dedekindPoleDepth v x := + (dedekindPoleDepth_pos_iff v x).2 hxneg + simpa only [dedekindPoleDepth_zero] using hxdepth + rw [hz, finitePlaceOrderTop_eq_coe v x hx] + simp + · refine ⟨c, ?_, ?_⟩ + simp only [dedekindPoleDepth, hx, hz, if_false] + have hxorderneg : finitePlaceOrder v x < 0 := by + rw [finitePlaceOrderTop_eq_coe v x hx] at hxneg + exact_mod_cast hxneg + omega + rw [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v _ hz] + exact_mod_cast hlt + +private theorem indexedDedekindLocalColumnCombination_transvection_same + {k : ℕ} (f : Fin k → L) (i j : Fin k) (c : C) : + indexedDedekindLocalColumnCombination f (Matrix.transvection j i c) i = + f i + c • f j := by + classical + simp [indexedDedekindLocalColumnCombination, Matrix.transvection, + Matrix.single, Matrix.one_apply, add_smul, Finset.sum_add_distrib] + +private theorem indexedDedekindLocalColumnCombination_transvection_ne + {k : ℕ} (f : Fin k → L) (i j b : Fin k) (c : C) (hb : b ≠ i) : + indexedDedekindLocalColumnCombination f (Matrix.transvection j i c) b = + f b := by + classical + have hib : i ≠ b := Ne.symm hb + simp [indexedDedekindLocalColumnCombination, Matrix.transvection, + Matrix.single, Matrix.one_apply, hib] + +private theorem exists_dedekindPoleWeight_transvection_lt + {k : ℕ} (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (f : Fin k → L) (i j : Fin k) + (hi : finitePlaceOrderTop v (f i) < 0) + (hj : finitePlaceOrderTop v (f j) < 0) + (horder : finitePlaceOrderTop v (f i) = finitePlaceOrderTop v (f j)) : + ∃ c : C, + dedekindPoleWeight v + (indexedDedekindLocalColumnCombination f + (Matrix.transvection j i (-c))) < + dedekindPoleWeight v f ∧ + finitePlaceOrderTop v (f i) < + finitePlaceOrderTop v (f i - algebraMap C L c * f j) := by + obtain ⟨c, hstrict, hraise⟩ := + exists_constant_dedekindPoleDepth_sub_mul_lt + v hresidue (f i) (f j) hi hj horder + refine ⟨c, ?_, hraise⟩ + unfold dedekindPoleWeight + apply Finset.sum_lt_sum + · intro b _ + by_cases hb : b = i + · subst b + rw [indexedDedekindLocalColumnCombination_transvection_same] + simpa only [Algebra.smul_def, map_neg, sub_eq_add_neg, neg_mul] using hstrict.le + · rw [indexedDedekindLocalColumnCombination_transvection_ne f i j b (-c) hb] + · refine ⟨i, Finset.mem_univ _, ?_⟩ + rw [indexedDedekindLocalColumnCombination_transvection_same] + simpa only [Algebra.smul_def, map_neg, sub_eq_add_neg, neg_mul] using hstrict + +/-- Successive constant column combinations compose by matrix +multiplication. -/ +theorem indexedDedekindLocalColumnCombination_mul {k : ℕ} + (f : Fin k → L) (A B : Matrix (Fin k) (Fin k) C) : + indexedDedekindLocalColumnCombination + (indexedDedekindLocalColumnCombination f A) B = + indexedDedekindLocalColumnCombination f (A * B) := by + classical + funext b + simp only [indexedDedekindLocalColumnCombination, Matrix.mul_apply] + simp_rw [Finset.smul_sum, smul_smul] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.sum_smul] + apply Finset.sum_congr rfl + intro j _ + rw [mul_comm (B j b) (A i j)] + +private theorem indexedDedekindLocalColumnCombination_one {k : ℕ} + (f : Fin k → L) : + indexedDedekindLocalColumnCombination f + (1 : Matrix (Fin k) (Fin k) C) = f := by + classical + funext i + simp [indexedDedekindLocalColumnCombination, Matrix.one_apply] + +/-- Repeated equal negative orders can be eliminated by a determinant-one +constant matrix, while preserving a common lower order bound. -/ +theorem exists_det_one_dedekindColumnMatrix_negativeOrdersPairwiseDistinct + {k : ℕ} (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (a : ℤ) (f : Fin k → L) + (hf : ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v (f i)) : + ∃ A : Matrix (Fin k) (Fin k) C, + A.det = 1 ∧ + NegativeFinitePlaceOrdersPairwiseDistinct v + (indexedDedekindLocalColumnCombination f A) ∧ + ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v + (indexedDedekindLocalColumnCombination f A i) := by + induction hN : dedekindPoleWeight v f using Nat.strong_induction_on + generalizing f with + | h N ih => + by_cases hdistinct : NegativeFinitePlaceOrdersPairwiseDistinct v f + · refine ⟨(1 : Matrix (Fin k) (Fin k) C), Matrix.det_one, ?_, ?_⟩ + · simpa [indexedDedekindLocalColumnCombination_one] + · simpa [indexedDedekindLocalColumnCombination_one] using hf + · have hdup : ∃ i j : Fin k, + finitePlaceOrderTop v (f i) < 0 ∧ + finitePlaceOrderTop v (f j) < 0 ∧ + finitePlaceOrderTop v (f i) = finitePlaceOrderTop v (f j) ∧ + i ≠ j := by + simp only [NegativeFinitePlaceOrdersPairwiseDistinct] at hdistinct + push Not at hdistinct + obtain ⟨i, j, hi, hj, ho, hij⟩ := hdistinct + exact ⟨i, j, hi, hj, ho, hij⟩ + obtain ⟨i, j, hi, hj, horder, hij⟩ := hdup + obtain ⟨c, hweight', hraise⟩ := + exists_dedekindPoleWeight_transvection_lt + v hresidue f i j hi hj horder + let T : Matrix (Fin k) (Fin k) C := Matrix.transvection j i (-c) + let g := indexedDedekindLocalColumnCombination f T + have hweight : dedekindPoleWeight v g < N := by + rw [← hN] + exact hweight' + have hgi : g i = f i - algebraMap C L c * f j := by + change indexedDedekindLocalColumnCombination f + (Matrix.transvection j i (-c)) i = _ + rw [indexedDedekindLocalColumnCombination_transvection_same] + simp only [Algebra.smul_def, map_neg, neg_mul, sub_eq_add_neg] + have hg : ∀ b, (a : WithTop ℤ) ≤ finitePlaceOrderTop v (g b) := by + intro b + by_cases hb : b = i + · subst b + rw [hgi] + exact (hf i).trans hraise.le + · change (a : WithTop ℤ) ≤ finitePlaceOrderTop v + (indexedDedekindLocalColumnCombination f + (Matrix.transvection j i (-c)) b) + rw [indexedDedekindLocalColumnCombination_transvection_ne f i j b (-c) hb] + exact hf b + obtain ⟨B, hBdet, hBdistinct, hBlower⟩ := ih _ hweight g hg rfl + refine ⟨T * B, ?_, ?_, ?_⟩ + · rw [Matrix.det_mul, hBdet, mul_one] + exact Matrix.det_transvection_of_ne j i (Ne.symm hij) (-c) + · rw [← indexedDedekindLocalColumnCombination_mul] + exact hBdistinct + · rw [← indexedDedekindLocalColumnCombination_mul] + exact hBlower + +omit [Algebra C R] [IsScalarTower C R L] in +/-- A DVR-preserving derivation and all of its iterates preserve the +nonnegative-order part of the fraction field. -/ +theorem finitePlaceOrderTop_derivation_iterate_nonnegative_of_nonnegative + (v : HeightOneSpectrum R) (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (m : ℕ) (x : L) (hx : (0 : WithTop ℤ) ≤ finitePlaceOrderTop v x) : + (0 : WithTop ℤ) ≤ + finitePlaceOrderTop v (((D : L → L)^[m]) x) := by + by_cases hx0 : x = 0 + · subst x + simp + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : v.asIdeal = Ideal.span {π} := by + calc + v.asIdeal = IsLocalRing.maximalIdeal R := + IsLocalRing.eq_maximalIdeal v.isMaximal + _ = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + obtain ⟨n, u, hxu⟩ := + IsDiscreteValuationRing.exists_units_eq_smul_zpow_of_irreducible + (K := L) hπ hx0 + have hxrepr : + x = algebraMap R L (u : R) * (algebraMap R L π) ^ n := by + simpa [Units.smul_def, Algebra.smul_def] using hxu + have hxOrder : finitePlaceOrder v x = n := by + rw [hxrepr] + exact finitePlaceOrder_unit_mul_uniformizer_zpow + v π hπ hπIdeal u n + have hn : 0 ≤ n := by + rw [finitePlaceOrderTop_eq_coe v x hx0, hxOrder] at hx + exact_mod_cast hx + let x0 : R := (u : R) * π ^ n.toNat + have hxMap : x = algebraMap R L x0 := by + rw [hxrepr] + change algebraMap R L (u : R) * (algebraMap R L π) ^ n = + algebraMap R L ((u : R) * π ^ n.toNat) + rw [map_mul, map_pow] + congr 1 + calc + (algebraMap R L π) ^ n = + (algebraMap R L π) ^ (n.toNat : ℤ) := by + rw [Int.toNat_of_nonneg hn] + _ = (algebraMap R L π) ^ n.toNat := zpow_natCast _ _ + have hiter : ∀ r : ℕ, ∃ s : R, + ((D : L → L)^[r]) x = algebraMap R L s := by + intro r + induction r with + | zero => exact ⟨x0, by simpa using hxMap⟩ + | succ r ih => + rw [Function.iterate_succ_apply'] + obtain ⟨s, hs⟩ := ih + rw [hs] + exact hDIntegral s + obtain ⟨s, hs⟩ := hiter m + rw [hs] + exact finitePlaceOrderTop_algebraMap_nonnegative (L := L) v s + +private theorem dedekindCaseI_coe_sum_int_finset + {ι : Type*} [DecidableEq ι] (s : Finset ι) (g : ι → ℤ) : + (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] + +omit [Algebra C R] [IsScalarTower C R L] in +/-- In a DVR-preserving Wronskian, only the pole columns pay a derivative +order cost. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_poles + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (epsilonOrder : ι → ℕ) (g : ι → L) (poles : Finset ι) + (E : ℤ) + (hpole : ∀ i ∈ poles, finitePlaceOrderTop v (g i) < 0) + (hregular : ∀ i ∉ poles, (0 : WithTop ℤ) ≤ finitePlaceOrderTop v (g i)) + (hselected : ∀ σ : Equiv.Perm ι, + (∑ i ∈ poles, (epsilonOrder (σ i) : ℤ)) ≤ E) : + (((∑ i ∈ poles, finitePlaceOrder v (g i)) - E : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder g).det := by + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : v.asIdeal = Ideal.span {π} := by + calc + v.asIdeal = IsLocalRing.maximalIdeal R := + IsLocalRing.eq_maximalIdeal v.isMaximal + _ = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + rw [Matrix.det_apply'] + apply le_finitePlaceOrderTop_finset_sum_of_forall + intro σ _ + let term : L := + ((Equiv.Perm.sign σ : ℤ) : L) * + ∏ i, indexedDedekindLocalWronskian D epsilonOrder g (σ i) i + change + (((∑ i ∈ poles, finitePlaceOrder v (g i)) - E : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v term + calc + (((∑ i ∈ poles, finitePlaceOrder v (g i)) - E : ℤ) : WithTop ℤ) ≤ + (((∑ i ∈ poles, + (finitePlaceOrder v (g i) - (epsilonOrder (σ i) : ℤ)) : ℤ)) : + WithTop ℤ) := by + rw [Finset.sum_sub_distrib] + exact_mod_cast sub_le_sub_left (hselected σ) _ + _ = ∑ i, if i ∈ poles then + (((finitePlaceOrder v (g i) - + (epsilonOrder (σ i) : ℤ) : ℤ)) : WithTop ℤ) + else 0 := by + rw [Finset.sum_ite_mem_eq] + exact dedekindCaseI_coe_sum_int_finset poles + (fun i => finitePlaceOrder v (g i) - (epsilonOrder (σ i) : ℤ)) + _ ≤ ∑ i, finitePlaceOrderTop v + (((D : L → L)^[epsilonOrder (σ i)]) (g i)) := by + gcongr with i + by_cases hi : i ∈ poles + · simp only [hi, if_true] + have hgi : g i ≠ 0 := by + intro hz + have hneg := hpole i hi + rw [hz] at hneg + simpa using hneg + have hbound := + finitePlaceOrderTop_derivation_iterate_ge_sub_nat_of_preserves + v π hπ hπIdeal D hDIntegral (epsilonOrder (σ i)) (g i) + rw [finitePlaceOrderTop_eq_coe v (g i) hgi] at hbound + simpa only [← WithTop.coe_add, sub_eq_add_neg] using hbound + · simp only [hi, if_false] + exact finitePlaceOrderTop_derivation_iterate_nonnegative_of_nonnegative + v D hDIntegral (epsilonOrder (σ i)) (g i) (hregular i hi) + _ = finitePlaceOrderTop v + (∏ i, indexedDedekindLocalWronskian D epsilonOrder g (σ i) i) := by + rw [finitePlaceOrderTop_finset_prod] + rfl + _ ≤ finitePlaceOrderTop v term := by + exact finitePlaceOrderTop_le_intCast_mul v + (Equiv.Perm.sign σ : ℤ) + (∏ i, indexedDedekindLocalWronskian D epsilonOrder g (σ i) i) + +private theorem dedekindCaseI_sum_range_int_mul_two (r : ℕ) : + (∑ n ∈ Finset.range r, (n : ℤ)) * 2 = + (r : ℤ) * (r - 1 : ℕ) := by + have h := congrArg (fun n : ℕ => (n : ℤ)) + (Finset.sum_range_id_mul_two r) + push_cast at h + exact h + +private theorem dedekindCaseI_int_natCast_mul_pred (r : ℕ) : + (r : ℤ) * (r - 1 : ℕ) = (r : ℤ) * ((r : ℤ) - 1) := by + cases r <;> simp + +omit [Algebra C R] [IsScalarTower C R L] in +/-- The exact intermediate case-(i) estimate at a Dedekind DVR place. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_epsilon_plus_one_lower_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (epsilonOrder : ι → ℕ) (g : ι → L) + (rhoOrder : ℤ) (epsilon : ℕ) + (hgdistinct : NegativeFinitePlaceOrdersPairwiseDistinct v g) + (hglower : ∀ i, (rhoOrder : WithTop ℤ) ≤ finitePlaceOrderTop v (g i)) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hcardRho : rhoOrder ≤ + -((Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card : ℤ)) + (hcardEpsilon : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + epsilon + 1) : + ((rhoOrder * (epsilon + 1 : ℕ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder g).det := by + let poles : Finset ι := + Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0 + let E : ℤ := ∑ n ∈ Finset.range poles.card, ((epsilon : ℤ) - n) + have hpole : ∀ i ∈ poles, finitePlaceOrderTop v (g i) < 0 := by + intro i hi + simpa [poles] using hi + have hpoleNe : ∀ i ∈ poles, g i ≠ 0 := by + intro i hi hz + have hneg := hpole i hi + rw [hz] at hneg + simpa using hneg + have horderInj : + Set.InjOn (fun i => finitePlaceOrder v (g i)) (poles : Set ι) := by + intro i hi j hj hij + apply hgdistinct (hpole i hi) (hpole j hj) + rw [finitePlaceOrderTop_eq_coe v (g i) (hpoleNe i hi), + finitePlaceOrderTop_eq_coe v (g j) (hpoleNe j hj)] + exact_mod_cast hij + have hpoleLower : + (∑ n ∈ Finset.range poles.card, (rhoOrder + n : ℤ)) ≤ + ∑ i ∈ poles, finitePlaceOrder v (g i) := + sum_range_add_le_sum_of_injOn poles + (fun i => finitePlaceOrder v (g i)) rhoOrder horderInj (by + intro i hi + have h := hglower i + rw [finitePlaceOrderTop_eq_coe v (g i) (hpoleNe i hi)] at h + exact_mod_cast h) + have hselected : ∀ σ : Equiv.Perm ι, + (∑ i ∈ poles, (epsilonOrder (σ i) : ℤ)) ≤ E := by + intro σ + apply sum_le_sum_range_sub_of_injOn poles + (fun i => epsilonOrder (σ i)) epsilon + · intro i hi j hj hij + exact σ.injective (hepsilonInjective hij) + · intro i _ + exact hepsilonMax (σ i) + have hregular : ∀ i ∉ poles, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v (g i) := by + intro i hi + simp only [poles, Finset.mem_filter, Finset.mem_univ, true_and] at hi + exact le_of_not_gt hi + have hW := + finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_poles + v D hDIntegral epsilonOrder g poles E hpole hregular hselected + apply le_trans ?_ hW + norm_cast + have hcardRho' : rhoOrder ≤ -(poles.card : ℤ) := by + simpa [poles] using hcardRho + have hcardEpsilon' : poles.card ≤ epsilon + 1 := by + simpa [poles] using hcardEpsilon + let S : ℤ := ∑ n ∈ Finset.range poles.card, (n : ℤ) + have htri : S * 2 = (poles.card : ℤ) * (poles.card - 1 : ℕ) := by + exact dedekindCaseI_sum_range_int_mul_two poles.card + have htri' : S * 2 = + (poles.card : ℤ) * ((poles.card : ℤ) - 1) := + htri.trans (dedekindCaseI_int_natCast_mul_pred poles.card) + have hpoleRange : + (∑ n ∈ Finset.range poles.card, (rhoOrder + n : ℤ)) = + (poles.card : ℤ) * rhoOrder + S := by + rw [Finset.sum_add_distrib] + simp [S, mul_comm] + have hcostRange : E = + (poles.card : ℤ) * epsilon - S := by + change (∑ n ∈ Finset.range poles.card, ((epsilon : ℤ) - n)) = _ + rw [Finset.sum_sub_distrib] + simp [S, mul_comm] + have hgapEpsilon : + 0 ≤ (epsilon + 1 : ℤ) - (poles.card : ℤ) := by + have hcast : (poles.card : ℤ) ≤ (epsilon + 1 : ℕ) := by + exact_mod_cast hcardEpsilon' + omega + have hgapRho : 0 ≤ -rhoOrder - (poles.card : ℤ) := by omega + have hgapProduct : + 0 ≤ ((epsilon + 1 : ℤ) - (poles.card : ℤ)) * + (-rhoOrder - (poles.card : ℤ)) := + mul_nonneg hgapEpsilon hgapRho + calc + rhoOrder * (epsilon + 1 : ℕ) ≤ + (∑ n ∈ Finset.range poles.card, (rhoOrder + n : ℤ)) - E := by + rw [hpoleRange, hcostRange] + push_cast + nlinarith + _ ≤ (∑ i ∈ poles, finitePlaceOrder v (g i)) - E := + sub_le_sub_right hpoleLower E + +omit [Algebra C R] [IsScalarTower C R L] in +/-- Source case (i), in the final `q * rhoOrder` form, at a Dedekind DVR +place. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_q_lower_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (epsilonOrder : ι → ℕ) (g : ι → L) + (rhoOrder : ℤ) (epsilon q : ℕ) + (hgdistinct : NegativeFinitePlaceOrdersPairwiseDistinct v g) + (hglower : ∀ i, (rhoOrder : WithTop ℤ) ≤ finitePlaceOrderTop v (g i)) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hcardRho : rhoOrder ≤ + -((Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card : ℤ)) + (hcardEpsilon : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + epsilon + 1) + (hrho : rhoOrder ≤ 0) (hepsilonQ : epsilon + 1 ≤ q) : + (((q : ℤ) * rhoOrder : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder g).det := by + apply le_trans ?_ + (finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_epsilon_plus_one_lower_bound + v D hDIntegral epsilonOrder g rhoOrder epsilon hgdistinct hglower + hepsilonInjective hepsilonMax hcardRho hcardEpsilon) + norm_cast + have hepsilonQ' : (epsilon + 1 : ℤ) ≤ q := by + exact_mod_cast hepsilonQ + calc + (q : ℤ) * rhoOrder ≤ (epsilon + 1 : ℤ) * rhoOrder := + mul_le_mul_of_nonpos_right hepsilonQ' hrho + _ = rhoOrder * (epsilon + 1 : ℕ) := by push_cast; ring + +/-- Pairwise-distinct negative finite-place orders bounded below by a +nonpositive integer are no more numerous than its pole depth. -/ +theorem card_negativeFinitePlaceOrders_le_neg + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (g : ι → L) (a : ℤ) (ha : a ≤ 0) + (hgdistinct : NegativeFinitePlaceOrdersPairwiseDistinct v g) + (hglower : ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v (g i)) : + a ≤ -((Finset.univ.filter fun i => + finitePlaceOrderTop v (g i) < 0).card : ℤ) := by + let poles : Finset ι := + Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0 + have hpole : ∀ i ∈ poles, finitePlaceOrderTop v (g i) < 0 := by + intro i hi + simpa [poles] using hi + have hpoleNe : ∀ i ∈ poles, g i ≠ 0 := by + intro i hi hz + have hneg := hpole i hi + rw [hz] at hneg + simpa using hneg + let w : ι → ℤ := fun i => finitePlaceOrder v (g i) + have hinj : Set.InjOn w (poles : Set ι) := by + intro i hi j hj hij + apply hgdistinct (hpole i hi) (hpole j hj) + rw [finitePlaceOrderTop_eq_coe v (g i) (hpoleNe i hi), + finitePlaceOrderTop_eq_coe v (g j) (hpoleNe j hj)] + exact_mod_cast hij + have hsubset : poles.image w ⊆ Finset.Ico a 0 := by + intro x hx + rw [Finset.mem_image] at hx + obtain ⟨i, hi, rfl⟩ := hx + rw [Finset.mem_Ico] + constructor + · have h := hglower i + rw [finitePlaceOrderTop_eq_coe v (g i) (hpoleNe i hi)] at h + exact_mod_cast h + · have h := hpole i hi + rw [finitePlaceOrderTop_eq_coe v (g i) (hpoleNe i hi)] at h + exact_mod_cast h + have hcard := Finset.card_le_card hsubset + rw [Finset.card_image_iff.mpr hinj, Int.card_Ico] at hcard + have hcard' : poles.card ≤ Int.toNat (-a) := by simpa using hcard + have hcast : (poles.card : ℤ) ≤ Int.toNat (-a) := by + exact_mod_cast hcard' + have htoNat : (Int.toNat (-a) : ℤ) = -a := by + rw [Int.toNat_of_nonneg] + omega + rw [htoNat] at hcast + simpa [poles] using (show a ≤ -(poles.card : ℤ) by omega) + +/-- Complete local case (i) for an arbitrary `Fin k` fraction-field family. -/ +theorem exists_dedekindCaseI_columnMatrix_and_q_wronskian_bound + {k : ℕ} (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (epsilonOrder : Fin k → ℕ) (f : Fin k → L) + (a : ℤ) (epsilon q : ℕ) + (ha : a ≤ 0) + (hf : ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v (f i)) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) C, + A.det = 1 ∧ + (indexedDedekindLocalWronskian D epsilonOrder + (indexedDedekindLocalColumnCombination f A)).det = + (indexedDedekindLocalWronskian D epsilonOrder f).det ∧ + (((q : ℤ) * a : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder f).det := by + obtain ⟨A, hAdet, hdistinct, hlower⟩ := + exists_det_one_dedekindColumnMatrix_negativeOrdersPairwiseDistinct + v hresidue a f hf + let g := indexedDedekindLocalColumnCombination f A + have hdet : + (indexedDedekindLocalWronskian D epsilonOrder g).det = + (indexedDedekindLocalWronskian D epsilonOrder f).det := by + exact indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D epsilonOrder f A hAdet + have hcardRho : + a ≤ -((Finset.univ.filter fun i => + finitePlaceOrderTop v (g i) < 0).card : ℤ) := + card_negativeFinitePlaceOrders_le_neg v g a ha hdistinct hlower + have hcardEpsilon : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + epsilon + 1 := by + calc + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + (Finset.univ : Finset (Fin k)).card := Finset.card_filter_le _ _ + _ = k := Fintype.card_fin k + _ ≤ epsilon + 1 := hk + have hbound := + finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_q_lower_bound + v D hDIntegral epsilonOrder g a epsilon q hdistinct hlower + hepsilonInjective hepsilonMax hcardRho hcardEpsilon ha hepsilonQ + refine ⟨A, hAdet, hdet, ?_⟩ + rw [← hdet] + exact hbound + +/-- Extend a first-block operation by the identity on the grid columns. -/ +def dedekindCaseIColumnMatrix (h k : ℕ) + (A : Matrix (Fin k) (Fin k) C) : + Matrix (Sum (Fin k) (Fin (k + 1) × Fin h)) + (Sum (Fin k) (Fin (k + 1) × Fin h)) C := + Matrix.fromBlocks A 0 0 1 + +theorem dedekindCaseIColumnMatrix_det (h k : ℕ) + (A : Matrix (Fin k) (Fin k) C) : + (dedekindCaseIColumnMatrix h k A).det = A.det := by + rw [dedekindCaseIColumnMatrix, Matrix.det_fromBlocks_zero₁₂] + simp + +theorem indexedDedekindLocalColumnCombination_dedekindCaseIColumnMatrix_inl + (h k : ℕ) + (f : Sum (Fin k) (Fin (k + 1) × Fin h) → L) + (A : Matrix (Fin k) (Fin k) C) (i : Fin k) : + indexedDedekindLocalColumnCombination f + (dedekindCaseIColumnMatrix h k A) (Sum.inl i) = + indexedDedekindLocalColumnCombination (fun j => f (Sum.inl j)) A i := by + classical + rw [indexedDedekindLocalColumnCombination, Fintype.sum_sum_type] + simp [dedekindCaseIColumnMatrix, indexedDedekindLocalColumnCombination] + +theorem indexedDedekindLocalColumnCombination_dedekindCaseIColumnMatrix_inr + (h k : ℕ) + (f : Sum (Fin k) (Fin (k + 1) × Fin h) → L) + (A : Matrix (Fin k) (Fin k) C) (rs : Fin (k + 1) × Fin h) : + indexedDedekindLocalColumnCombination f + (dedekindCaseIColumnMatrix h k A) (Sum.inr rs) = + f (Sum.inr rs) := by + classical + rw [indexedDedekindLocalColumnCombination, Fintype.sum_sum_type] + simp [dedekindCaseIColumnMatrix, Matrix.one_apply] + +/-- The full Dedekind-local auxiliary family after eliminating repeated +orders in its first block. -/ +def dedekindCaseITransformedLocalAuxiliaryFamily + (u w rho : L) (h k : ℕ) (A : Matrix (Fin k) (Fin k) C) : + Sum (Fin k) (Fin (k + 1) × Fin h) → L := + indexedDedekindLocalColumnCombination + (dedekindLocalAuxiliaryFamily u w rho h k) + (dedekindCaseIColumnMatrix h k A) + +@[simp] +theorem dedekindCaseITransformedLocalAuxiliaryFamily_inl + (u w rho : L) (h k : ℕ) (A : Matrix (Fin k) (Fin k) C) (i : Fin k) : + dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A (Sum.inl i) = + indexedDedekindLocalColumnCombination + (fun j => dedekindLocalAuxiliaryFamily u w rho h k (Sum.inl j)) A i := + indexedDedekindLocalColumnCombination_dedekindCaseIColumnMatrix_inl + h k (dedekindLocalAuxiliaryFamily u w rho h k) A i + +@[simp] +theorem dedekindCaseITransformedLocalAuxiliaryFamily_inr + (u w rho : L) (h k : ℕ) (A : Matrix (Fin k) (Fin k) C) + (rs : Fin (k + 1) × Fin h) : + dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A (Sum.inr rs) = + dedekindLocalAuxiliaryFamily u w rho h k (Sum.inr rs) := + indexedDedekindLocalColumnCombination_dedekindCaseIColumnMatrix_inr + h k (dedekindLocalAuxiliaryFamily u w rho h k) A rs + +/-- Source-facing case-(i) elimination for the full auxiliary family. The +ratio block starts at the common negative order of `rho`, while the grid +columns are assumed regular. -/ +theorem exists_dedekindLocalAuxiliaryFamily_caseI_columnMatrix + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (u w rho : L) (h k : ℕ) + (hrhoNe : rho ≠ 0) + (huOrder : finitePlaceOrderTop v u = 0) + (hrhoOrder : finitePlaceOrder v rho < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (u ^ (rs.1 : ℕ) * w ^ (rs.2 : ℕ))) : + ∃ A : Matrix (Fin k) (Fin k) C, + A.det = 1 ∧ + NegativeFinitePlaceOrdersPairwiseDistinct v + (dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A) ∧ + (∀ i, (finitePlaceOrder v rho : WithTop ℤ) ≤ + finitePlaceOrderTop v + (dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A i)) ∧ + (∀ rs, dedekindCaseITransformedLocalAuxiliaryFamily + u w rho h k A (Sum.inr rs) = + dedekindLocalAuxiliaryFamily u w rho h k (Sum.inr rs)) := by + let first : Fin k → L := + fun i => dedekindLocalAuxiliaryFamily u w rho h k (Sum.inl i) + have hfirstOrder : ∀ i, + finitePlaceOrderTop v (first i) = + (finitePlaceOrder v rho : WithTop ℤ) := by + intro i + simp only [first, dedekindLocalAuxiliaryFamily] + rw [finitePlaceOrderTop_mul, finitePlaceOrderTop_pow, huOrder, + finitePlaceOrderTop_eq_coe v rho hrhoNe] + simp + have hfirstLower : ∀ i, (finitePlaceOrder v rho : WithTop ℤ) ≤ + finitePlaceOrderTop v (first i) := by + intro i + rw [hfirstOrder i] + obtain ⟨A, hAdet, hdistinct, hlower⟩ := + exists_det_one_dedekindColumnMatrix_negativeOrdersPairwiseDistinct + v hresidue (finitePlaceOrder v rho) first hfirstLower + refine ⟨A, hAdet, ?_, ?_, ?_⟩ + · intro x y hx hy hxy + cases x with + | inl i => + cases y with + | inl j => + apply congrArg Sum.inl + apply hdistinct + · simpa [first] using hx + · simpa [first] using hy + · simpa [first] using hxy + | inr rs => + rw [dedekindCaseITransformedLocalAuxiliaryFamily_inr] at hy + exact (not_lt_of_ge (hgridRegular rs)) hy |>.elim + | inr rs => + rw [dedekindCaseITransformedLocalAuxiliaryFamily_inr] at hx + exact (not_lt_of_ge (hgridRegular rs)) hx |>.elim + · intro i + cases i with + | inl j => simpa [first] using hlower j + | inr rs => + rw [dedekindCaseITransformedLocalAuxiliaryFamily_inr] + exact (show (finitePlaceOrder v rho : WithTop ℤ) ≤ 0 by + exact_mod_cast hrhoOrder.le) |>.trans (hgridRegular rs) + · intro rs + exact dedekindCaseITransformedLocalAuxiliaryFamily_inr + u w rho h k A rs + +/-- Full Dedekind-DVR case (i): determinant-one repeated cancellation on the +first block preserves the original Wronskian and proves the exact +`q * ord(rho)` lower bound. -/ +theorem exists_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (u w rho : L) (h k : ℕ) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (epsilon q : ℕ) + (hrhoNe : rho ≠ 0) + (huOrder : finitePlaceOrderTop v u = 0) + (hrhoOrder : finitePlaceOrder v rho < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (u ^ (rs.1 : ℕ) * w ^ (rs.2 : ℕ))) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) C, + A.det = 1 ∧ + (indexedDedekindLocalWronskian D epsilonOrder + (dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A)).det = + (indexedDedekindLocalWronskian D epsilonOrder + (dedekindLocalAuxiliaryFamily u w rho h k)).det ∧ + (((q : ℤ) * finitePlaceOrder v rho : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder + (dedekindLocalAuxiliaryFamily u w rho h k)).det := by + obtain ⟨A, hAdet, hdistinct, hlower, hgrid⟩ := + exists_dedekindLocalAuxiliaryFamily_caseI_columnMatrix + v hresidue u w rho h k hrhoNe huOrder hrhoOrder hgridRegular + let f := dedekindLocalAuxiliaryFamily u w rho h k + let B := dedekindCaseIColumnMatrix h k A + let g := dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A + have hBdet : B.det = 1 := by + rw [dedekindCaseIColumnMatrix_det, hAdet] + have hdet : + (indexedDedekindLocalWronskian D epsilonOrder g).det = + (indexedDedekindLocalWronskian D epsilonOrder f).det := by + exact indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D epsilonOrder f B hBdet + have hcardRho : + finitePlaceOrder v rho ≤ -((Finset.univ.filter fun i => + finitePlaceOrderTop v (g i) < 0).card : ℤ) := + card_negativeFinitePlaceOrders_le_neg v g (finitePlaceOrder v rho) + hrhoOrder.le hdistinct hlower + let firstPoles : Finset (Fin k) := Finset.univ.filter fun i => + finitePlaceOrderTop v (g (Sum.inl i)) < 0 + have hpoles : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0) = + firstPoles.map ⟨Sum.inl, Sum.inl_injective⟩ := by + ext x + cases x with + | inl i => simp [firstPoles] + | inr rs => + have hregg : (0 : WithTop ℤ) ≤ + finitePlaceOrderTop v (g (Sum.inr rs)) := by + change (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (dedekindCaseITransformedLocalAuxiliaryFamily + u w rho h k A (Sum.inr rs)) + rw [hgrid rs] + simpa [dedekindLocalAuxiliaryFamily] using hgridRegular rs + have hrs : ¬ finitePlaceOrderTop v (g (Sum.inr rs)) < 0 := + not_lt_of_ge hregg + simp [firstPoles, hrs] + have hcardEpsilon : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + epsilon + 1 := by + rw [hpoles, Finset.card_map] + exact (Finset.card_filter_le _ _).trans (by simpa using hk) + have hbound := + finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_q_lower_bound + v D hDIntegral epsilonOrder g (finitePlaceOrder v rho) epsilon q + hdistinct hlower hepsilonInjective hepsilonMax hcardRho hcardEpsilon + hrhoOrder.le hepsilonQ + refine ⟨A, hAdet, hdet, ?_⟩ + rw [← hdet] + exact hbound + +/-- The same endpoint for the source `auxiliaryFamily`, specialized to +`rho = (1-u)/(1-w)`. -/ +theorem exists_dedekindAuxiliaryFamily_caseI_q_wronskian_bound + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (u w : L) (h k : ℕ) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (epsilon q : ℕ) + (hrhoNe : (1 - u) / (1 - w) ≠ 0) + (huOrder : finitePlaceOrderTop v u = 0) + (hrhoOrder : finitePlaceOrder v ((1 - u) / (1 - w)) < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (u ^ (rs.1 : ℕ) * w ^ (rs.2 : ℕ))) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) C, + A.det = 1 ∧ + (indexedDedekindLocalWronskian D epsilonOrder + (indexedDedekindLocalColumnCombination (auxiliaryFamily u w h k) + (dedekindCaseIColumnMatrix h k A))).det = + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u w h k)).det ∧ + (((q : ℤ) * finitePlaceOrder v ((1 - u) / (1 - w)) : ℤ) : + WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u w h k)).det := by + simpa only [dedekindCaseITransformedLocalAuxiliaryFamily, + dedekindLocalAuxiliaryFamily_div_eq_auxiliaryFamily] using + (exists_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound + v hresidue D hDIntegral u w ((1 - u) / (1 - w)) h k epsilonOrder + epsilon q hrhoNe huOrder hrhoOrder hgridRegular hepsilonInjective + hepsilonMax hk hepsilonQ) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean new file mode 100644 index 0000000000..d904d26901 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean @@ -0,0 +1,88 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian + +/-! +# Uniformizer-free Dedekind auxiliary cases + +This module packages Corvaja--Zannier local cases (iii) and (iv) using only a +DVR-preserving derivation. The uniformizer needed by the determinant estimate +is chosen internally. In particular, callers do not need an algebra map from +the derivation's constant field into the local DVR. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators +open IsDedekindDomain + +variable {C R L : Type*} [Field C] [CommRing R] [IsDedekindDomain R] + [IsDiscreteValuationRing R] [Field L] [Algebra R L] [Algebra C L] + [IsFractionRing R L] + +/-- Uniformizer-free form of source case (iii). -/ +theorem finitePlaceOrderTop_auxiliaryFamily_caseIII_source_lower_bound_of_preserves + (vPlace : HeightOneSpectrum R) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + (h * k) • finitePlaceOrder vPlace v + + k • finitePlaceOrder vPlace ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder vPlace + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : vPlace.asIdeal = Ideal.span {π} := by + calc + vPlace.asIdeal = IsLocalRing.maximalIdeal R := + IsLocalRing.eq_maximalIdeal vPlace.isMaximal + _ = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + exact finitePlaceOrderTop_auxiliaryFamily_caseIII_source_lower_bound + vPlace π hπ hπIdeal D hDIntegral h k epsilon u v hu hv hu1 hv1 + +/-- Uniformizer-free form of source case (iv). -/ +theorem finitePlaceOrderTop_auxiliaryFamily_caseIV_source_lower_bound_of_preserves + (vPlace : HeightOneSpectrum R) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + k • finitePlaceOrder vPlace ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder vPlace + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : vPlace.asIdeal = Ideal.span {π} := by + calc + vPlace.asIdeal = IsLocalRing.maximalIdeal R := + IsLocalRing.eq_maximalIdeal vPlace.isMaximal + _ = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + exact finitePlaceOrderTop_auxiliaryFamily_caseIV_source_lower_bound + vPlace π hπ hπIdeal D hDIntegral h k epsilon u v hu hv hu1 hv1 + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean new file mode 100644 index 0000000000..28439e6353 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean @@ -0,0 +1,428 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian + +/-! +# Auxiliary-family Wronskian estimates at a Dedekind place + +This file transports the algebraic local cases (ii)--(iv) in +Corvaja--Zannier's Proposition 2 from Laurent series to an arbitrary +height-one DVR place. The derivation is only required to preserve the DVR; +no choice of a normalized local parameter is used. + +The case-(iii) column operation is exactly the lower-unitriangular matrix +`caseIIIColumnMatrix`. Consequently the resulting estimates retain the +source terms: the triangular `u` contribution, the `h * k` contribution of +`v`, the `k` copies of the ratio `rho`, the full grid sum, and the loss given +by the sum of the selected derivative orders. + +Source provenance: published pages 1935--1936; checked semantic reconstruction +`Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 636--732. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators +open IsDedekindDomain Multiplicative WithZero + +variable {C R L : Type*} [Field C] [CommRing R] [IsDedekindDomain R] + [IsDiscreteValuationRing R] [Field L] [Algebra C R] [Algebra R L] + [Algebra C L] [IsScalarTower C R L] [IsFractionRing R L] + +/-- The auxiliary family with the ratio column written using an explicit +parameter `rho`. -/ +def dedekindLocalAuxiliaryFamily (u v rho : L) (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) → L + | Sum.inl i => u ^ (i : ℕ) * rho + | Sum.inr rs => u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) + +@[simp] +theorem dedekindLocalAuxiliaryFamily_div_eq_auxiliaryFamily + (u v : L) (h k : ℕ) : + dedekindLocalAuxiliaryFamily u v ((1 - u) / (1 - v)) h k = + auxiliaryFamily u v h k := by + rfl + +/-- The case-(iii) family after replacing each first-block column +`u ^ i * rho` by `u ^ i * v ^ h * rho`. -/ +def dedekindCaseIIIImprovedAuxiliaryFamily (u v rho : L) (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) → L + | Sum.inl i => u ^ (i : ℕ) * v ^ h * rho + | Sum.inr rs => u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) + +private theorem dedekind_caseIII_geometricSeries_column_identity + (u v rho : L) (h j : ℕ) (hrho : (1 - v) * rho = 1 - u) : + u ^ j * rho - u ^ j * (1 - u) * (∑ s ∈ Finset.range h, v ^ s) = + u ^ j * v ^ h * rho := by + rw [← hrho] + calc + u ^ j * rho - u ^ j * ((1 - v) * rho) * + (∑ s ∈ Finset.range h, v ^ s) = + u ^ j * rho - u ^ j * rho * + ((1 - v) * ∑ s ∈ Finset.range h, v ^ s) := by ring + _ = u ^ j * rho - u ^ j * rho * (1 - v ^ h) := by + rw [mul_neg_geom_sum] + _ = u ^ j * v ^ h * rho := by ring + +private theorem dedekind_caseIIIGridCorrection_sum_smul + (u v : L) (h k : ℕ) (i : Fin k) : + (∑ rs : Fin (k + 1) × Fin h, + caseIIIGridCorrection (K := C) h k rs i • + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) = + -(u ^ (i : ℕ) * ∑ s : Fin h, v ^ (s : ℕ)) + + u ^ (i.succ : ℕ) * ∑ s : Fin h, v ^ (s : ℕ) := by + rw [Fintype.sum_prod_type_right] + rw [Finset.mul_sum, Finset.mul_sum, ← Finset.sum_neg_distrib, + ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro s _ + have hne : i.castSucc ≠ i.succ := i.castSucc_lt_succ.ne + simp only [caseIIIGridCorrection] + calc + (∑ r : Fin (k + 1), + (if r = i.castSucc then (-1 : C) + else if r = i.succ then 1 else 0) • + (u ^ (r : ℕ) * v ^ (s : ℕ))) = + (∑ r : Fin (k + 1), + if r = i.castSucc then -(u ^ (r : ℕ) * v ^ (s : ℕ)) else 0) + + ∑ r : Fin (k + 1), + if r = i.succ then u ^ (r : ℕ) * v ^ (s : ℕ) else 0 := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro r _ + by_cases hr0 : r = i.castSucc + · simp [hr0, hne] + · by_cases hr1 : r = i.succ + · simp [hr1, hne.symm] + · simp [hr0, hr1] + _ = -(u ^ (i : ℕ) * v ^ (s : ℕ)) + + u ^ (i.succ : ℕ) * v ^ (s : ℕ) := by + rw [Fintype.sum_ite_eq', Fintype.sum_ite_eq'] + simp + +/-- The determinant-one source column operation performs the case-(iii) +replacement over an arbitrary fraction field. -/ +theorem indexedDedekindLocalColumnCombination_caseIIIColumnMatrix + (u v rho : L) (h k : ℕ) (hrho : (1 - v) * rho = 1 - u) : + indexedDedekindLocalColumnCombination + (dedekindLocalAuxiliaryFamily u v rho h k) + (caseIIIColumnMatrix (K := C) h k) = + dedekindCaseIIIImprovedAuxiliaryFamily u v rho h k := by + classical + funext j + cases j with + | inl i => + rw [indexedDedekindLocalColumnCombination, Fintype.sum_sum_type] + simp only [caseIIIColumnMatrix, Matrix.fromBlocks_apply₁₁, + Matrix.fromBlocks_apply₂₁, dedekindLocalAuxiliaryFamily, + dedekindCaseIIIImprovedAuxiliaryFamily] + have hleft : + (∑ x : Fin k, (1 : Matrix (Fin k) (Fin k) C) x i • + (u ^ (x : ℕ) * rho)) = u ^ (i : ℕ) * rho := by + simp [Matrix.one_apply] + rw [hleft, dedekind_caseIIIGridCorrection_sum_smul] + rw [Fin.sum_univ_eq_sum_range] + simp only [Fin.val_succ, pow_succ] + convert dedekind_caseIII_geometricSeries_column_identity + u v rho h (i : ℕ) hrho using 1 + all_goals ring + | inr rs => + rw [indexedDedekindLocalColumnCombination, Fintype.sum_sum_type] + simp [caseIIIColumnMatrix, dedekindLocalAuxiliaryFamily, + dedekindCaseIIIImprovedAuxiliaryFamily, Matrix.one_apply] + +omit [IsDiscreteValuationRing R] [Algebra C R] [IsScalarTower C R L] in +/-- Case (ii): if `u`, `v`, and the ratio are all represented by elements of +the DVR, then the auxiliary Wronskian is regular. -/ +theorem finitePlaceOrderTop_auxiliaryFamily_caseII_nonnegative_of_integral + (vPlace : HeightOneSpectrum R) (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) + (huIntegral : ∃ u0 : R, u = algebraMap R L u0) + (hvIntegral : ∃ v0 : R, v = algebraMap R L v0) + (hratioIntegral : ∃ rho0 : R, + (1 - u) / (1 - v) = algebraMap R L rho0) : + (0 : WithTop ℤ) ≤ finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + apply finitePlaceOrderTop_indexedDedekindLocalWronskian_det_nonnegative_of_integral + vPlace D hDIntegral epsilon (auxiliaryFamily u v h k) + intro j + obtain ⟨u0, hu⟩ := huIntegral + obtain ⟨v0, hv⟩ := hvIntegral + obtain ⟨rho0, hrho⟩ := hratioIntegral + cases j with + | inl i => + refine ⟨u0 ^ (i : ℕ) * rho0, ?_⟩ + change u ^ (i : ℕ) * ((1 - u) / (1 - v)) = + algebraMap R L (u0 ^ (i : ℕ) * rho0) + rw [hrho, hu, map_mul, map_pow] + | inr rs => + refine ⟨u0 ^ (rs.1 : ℕ) * v0 ^ (rs.2 : ℕ), ?_⟩ + change u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) = + algebraMap R L (u0 ^ (rs.1 : ℕ) * v0 ^ (rs.2 : ℕ)) + rw [hu, hv, map_mul, map_pow, map_pow] + +omit [IsDiscreteValuationRing R] in +private theorem dedekind_finitePlaceOrder_mul + (vPlace : HeightOneSpectrum R) (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finitePlaceOrder vPlace (x * y) = + finitePlaceOrder vPlace x + finitePlaceOrder vPlace y := by + have h := finitePlaceOrderTop_mul vPlace x y + rw [finitePlaceOrderTop_eq_coe vPlace (x * y) (mul_ne_zero hx hy), + finitePlaceOrderTop_eq_coe vPlace x hx, + finitePlaceOrderTop_eq_coe vPlace y hy] at h + exact_mod_cast h + +omit [IsDiscreteValuationRing R] in +private theorem dedekind_finitePlaceOrder_pow + (vPlace : HeightOneSpectrum R) (x : L) (hx : x ≠ 0) (n : ℕ) : + finitePlaceOrder vPlace (x ^ n) = n • finitePlaceOrder vPlace x := by + have h := finitePlaceOrderTop_pow vPlace x n + rw [finitePlaceOrderTop_eq_coe vPlace (x ^ n) (pow_ne_zero n hx), + finitePlaceOrderTop_eq_coe vPlace x hx] at h + exact_mod_cast h + +omit [IsDiscreteValuationRing R] in +private theorem dedekind_finitePlaceOrder_caseIIIImproved_inl + (vPlace : HeightOneSpectrum R) (u v rho : L) (h k : ℕ) (i : Fin k) + (hu : u ≠ 0) (hv : v ≠ 0) (hrho : rho ≠ 0) : + finitePlaceOrder vPlace + (dedekindCaseIIIImprovedAuxiliaryFamily u v rho h k (Sum.inl i)) = + (i : ℕ) • finitePlaceOrder vPlace u + + h • finitePlaceOrder vPlace v + finitePlaceOrder vPlace rho := by + simp only [dedekindCaseIIIImprovedAuxiliaryFamily] + rw [dedekind_finitePlaceOrder_mul vPlace + (u ^ (i : ℕ) * v ^ h) rho + (mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv)) hrho, + dedekind_finitePlaceOrder_mul vPlace (u ^ (i : ℕ)) (v ^ h) + (pow_ne_zero _ hu) (pow_ne_zero _ hv), + dedekind_finitePlaceOrder_pow vPlace u hu, + dedekind_finitePlaceOrder_pow vPlace v hv] + +omit [IsDiscreteValuationRing R] in +private theorem dedekind_finitePlaceOrder_localAuxiliary_inl + (vPlace : HeightOneSpectrum R) (u v rho : L) (h k : ℕ) (i : Fin k) + (hu : u ≠ 0) (hrho : rho ≠ 0) : + finitePlaceOrder vPlace + (dedekindLocalAuxiliaryFamily u v rho h k (Sum.inl i)) = + (i : ℕ) • finitePlaceOrder vPlace u + finitePlaceOrder vPlace rho := by + simp only [dedekindLocalAuxiliaryFamily] + rw [dedekind_finitePlaceOrder_mul vPlace (u ^ (i : ℕ)) rho + (pow_ne_zero _ hu) hrho, + dedekind_finitePlaceOrder_pow vPlace u hu] + +private theorem dedekind_sum_fin_cast_int (k : ℕ) : + (∑ i : Fin k, (i : ℤ)) = (k * (k - 1) / 2 : ℕ) := by + rw [Fin.sum_univ_eq_sum_range, ← Nat.cast_sum, Finset.sum_range_id] + +omit [IsDiscreteValuationRing R] in +private theorem dedekind_sum_caseIIIImproved_inl_orders + (vPlace : HeightOneSpectrum R) (u v rho : L) (h k : ℕ) + (hu : u ≠ 0) (hv : v ≠ 0) (hrho : rho ≠ 0) : + (∑ i : Fin k, finitePlaceOrder vPlace + (dedekindCaseIIIImprovedAuxiliaryFamily u v rho h k (Sum.inl i))) = + (k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + (h * k) • finitePlaceOrder vPlace v + + k • finitePlaceOrder vPlace rho := by + simp_rw [dedekind_finitePlaceOrder_caseIIIImproved_inl + vPlace u v rho h k _ hu hv hrho] + simp only [Finset.sum_add_distrib, Finset.sum_const, + Finset.card_univ, Fintype.card_fin] + simp_rw [nsmul_eq_mul] + rw [← Finset.sum_mul, dedekind_sum_fin_cast_int] + simp only [Nat.cast_mul] + ring + +omit [IsDiscreteValuationRing R] in +private theorem dedekind_sum_localAuxiliary_inl_orders + (vPlace : HeightOneSpectrum R) (u v rho : L) (h k : ℕ) + (hu : u ≠ 0) (hrho : rho ≠ 0) : + (∑ i : Fin k, finitePlaceOrder vPlace + (dedekindLocalAuxiliaryFamily u v rho h k (Sum.inl i))) = + (k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + k • finitePlaceOrder vPlace rho := by + simp_rw [dedekind_finitePlaceOrder_localAuxiliary_inl + vPlace u v rho h k _ hu hrho] + simp only [Finset.sum_add_distrib, Finset.sum_const, + Finset.card_univ, Fintype.card_fin] + simp_rw [nsmul_eq_mul] + rw [← Finset.sum_mul, dedekind_sum_fin_cast_int] + +private theorem dedekind_coe_sum_int + {ι : Type*} [Fintype ι] (g : ι → ℤ) : + (((∑ i, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i, ((g i : ℤ) : WithTop ℤ) := by + classical + induction (Finset.univ : Finset ι) using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] + +omit [Algebra C R] [IsScalarTower C R L] in +/-- Case (iii) at a Dedekind DVR place, in the displayed source form. The +grid contribution is retained as the exact sum that cancels under the global +product formula. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_caseIII_source_lower_bound + (vPlace : HeightOneSpectrum R) (pi : R) (hpi : Irreducible pi) + (hpiIdeal : vPlace.asIdeal = Ideal.span {pi}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v rho : L) (hrhoIdentity : (1 - v) * rho = 1 - u) + (hu : u ≠ 0) (hv : v ≠ 0) (hrho : rho ≠ 0) : + (((k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + (h * k) • finitePlaceOrder vPlace v + + k • finitePlaceOrder vPlace rho + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder vPlace + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (dedekindLocalAuxiliaryFamily u v rho h k)).det := by + have hbound := + finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + vPlace pi hpi hpiIdeal D hDIntegral epsilon + (dedekindCaseIIIImprovedAuxiliaryFamily u v rho h k) + have hdet : + (indexedDedekindLocalWronskian D epsilon + (dedekindCaseIIIImprovedAuxiliaryFamily u v rho h k)).det = + (indexedDedekindLocalWronskian D epsilon + (dedekindLocalAuxiliaryFamily u v rho h k)).det := by + rw [← indexedDedekindLocalColumnCombination_caseIIIColumnMatrix (C := C) + u v rho h k hrhoIdentity] + exact indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D epsilon (dedekindLocalAuxiliaryFamily u v rho h k) + (caseIIIColumnMatrix (K := C) h k) (caseIIIColumnMatrix_det h k) + rw [hdet] at hbound + rw [Fintype.sum_sum_type] at hbound + simp only [dedekindCaseIIIImprovedAuxiliaryFamily] at hbound + simp_rw [finitePlaceOrderTop_eq_coe vPlace _ + (mul_ne_zero (mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv)) hrho)] + at hbound + simp_rw [finitePlaceOrderTop_eq_coe vPlace _ + (mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv))] at hbound + rw [← dedekind_coe_sum_int, ← dedekind_coe_sum_int] at hbound + have hfirst : + (∑ i : Fin k, finitePlaceOrder vPlace (u ^ (i : ℕ) * v ^ h * rho)) = + (k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + (h * k) • finitePlaceOrder vPlace v + + k • finitePlaceOrder vPlace rho := by + simpa only [dedekindCaseIIIImprovedAuxiliaryFamily] using + dedekind_sum_caseIIIImproved_inl_orders + vPlace u v rho h k hu hv hrho + rw [hfirst] at hbound + exact_mod_cast hbound + +omit [Algebra C R] [IsScalarTower C R L] in +/-- Case (iv) at a Dedekind DVR place, in the displayed source form. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_caseIV_source_lower_bound + (vPlace : HeightOneSpectrum R) (pi : R) (hpi : Irreducible pi) + (hpiIdeal : vPlace.asIdeal = Ideal.span {pi}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v rho : L) (hu : u ≠ 0) (hv : v ≠ 0) (hrho : rho ≠ 0) : + (((k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + k • finitePlaceOrder vPlace rho + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder vPlace + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (dedekindLocalAuxiliaryFamily u v rho h k)).det := by + have hbound := + finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + vPlace pi hpi hpiIdeal D hDIntegral epsilon + (dedekindLocalAuxiliaryFamily u v rho h k) + rw [Fintype.sum_sum_type] at hbound + simp only [dedekindLocalAuxiliaryFamily] at hbound + simp_rw [finitePlaceOrderTop_eq_coe vPlace _ + (mul_ne_zero (pow_ne_zero _ hu) hrho)] at hbound + simp_rw [finitePlaceOrderTop_eq_coe vPlace _ + (mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv))] at hbound + rw [← dedekind_coe_sum_int, ← dedekind_coe_sum_int] at hbound + have hfirst : + (∑ i : Fin k, finitePlaceOrder vPlace (u ^ (i : ℕ) * rho)) = + (k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + k • finitePlaceOrder vPlace rho := by + simpa only [dedekindLocalAuxiliaryFamily] using + dedekind_sum_localAuxiliary_inl_orders + vPlace u v rho h k hu hrho + rw [hfirst] at hbound + exact_mod_cast hbound + +omit [Algebra C R] [IsScalarTower C R L] in +/-- Case (iii) connected to the exact Corvaja--Zannier auxiliary family. -/ +theorem finitePlaceOrderTop_auxiliaryFamily_caseIII_source_lower_bound + (vPlace : HeightOneSpectrum R) (pi : R) (hpi : Irreducible pi) + (hpiIdeal : vPlace.asIdeal = Ideal.span {pi}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + (h * k) • finitePlaceOrder vPlace v + + k • finitePlaceOrder vPlace ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder vPlace + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hden : 1 - v ≠ 0 := sub_ne_zero.mpr hv1.symm + have hnum : 1 - u ≠ 0 := sub_ne_zero.mpr hu1.symm + have hratio : (1 - u) / (1 - v) ≠ 0 := div_ne_zero hnum hden + have hclear : (1 - v) * ((1 - u) / (1 - v)) = 1 - u := by + field_simp + simpa only [dedekindLocalAuxiliaryFamily_div_eq_auxiliaryFamily] using + finitePlaceOrderTop_indexedDedekindLocalWronskian_caseIII_source_lower_bound + vPlace pi hpi hpiIdeal D hDIntegral h k epsilon u v + ((1 - u) / (1 - v)) hclear hu hv hratio + +omit [Algebra C R] [IsScalarTower C R L] in +/-- Case (iv) connected to the exact Corvaja--Zannier auxiliary family. -/ +theorem finitePlaceOrderTop_auxiliaryFamily_caseIV_source_lower_bound + (vPlace : HeightOneSpectrum R) (pi : R) (hpi : Irreducible pi) + (hpiIdeal : vPlace.asIdeal = Ideal.span {pi}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • finitePlaceOrder vPlace u + + k • finitePlaceOrder vPlace ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder vPlace + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop vPlace + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hden : 1 - v ≠ 0 := sub_ne_zero.mpr hv1.symm + have hnum : 1 - u ≠ 0 := sub_ne_zero.mpr hu1.symm + have hratio : (1 - u) / (1 - v) ≠ 0 := div_ne_zero hnum hden + simpa only [dedekindLocalAuxiliaryFamily_div_eq_auxiliaryFamily] using + finitePlaceOrderTop_indexedDedekindLocalWronskian_caseIV_source_lower_bound + vPlace pi hpi hpiIdeal D hDIntegral h k epsilon u v + ((1 - u) / (1 - v)) hu hv hratio + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean new file mode 100644 index 0000000000..e54ddae700 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean @@ -0,0 +1,197 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling + +/-! +# Canonical different scalings at Dedekind places + +This file removes the explicit comparison hypothesis between the trace +different and the Kähler differentials from the finite- and infinite-place +derivation-scaling certificates. + +The different need not be principal globally. At a prescribed height-one +place `v`, Dedekind approximation supplies a global element `δ` in the +different whose principal ideal has exactly the same `v`-multiplicity. Thus +`δ` is a generator after localization at `v`. The theorem that the different +annihilates relative Kähler differentials then makes `δ` a derivation-clearing +factor. No local power basis or finiteness assertion for a map between two +independently localized rings is used. +-/ + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- Every nonzero ideal in a Dedekind domain admits, at a prescribed height-one +place, a global element which generates that ideal after localization. -/ +theorem exists_element_locally_generating_ideal + {R : Type*} [CommRing R] [IsDedekindDomain R] + (I : Ideal R) (hI : I ≠ ⊥) (v : HeightOneSpectrum R) : + ∃ a : R, a ≠ 0 ∧ a ∈ I ∧ + multiplicity v.asIdeal (Ideal.span {a}) = + multiplicity v.asIdeal I := by + have hprod : v.asIdeal * I ≠ ⊥ := mul_ne_zero v.ne_bot hI + obtain ⟨a, ha⟩ := IsDedekindDomain.exists_sup_span_eq + (I := v.asIdeal * I) (J := I) Ideal.mul_le_left hprod + have ha0 : a ≠ 0 := by + intro ha_zero + have hprod_eq : v.asIdeal * I = I := by + simpa [ha_zero] using ha + have hmult := congrArg (multiplicity v.asIdeal) hprod_eq + rw [multiplicity_mul v.prime + (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self] at hmult + omega + have hspan0 : Ideal.span {a} ≠ ⊥ := by + simpa [Ideal.span_singleton_eq_bot] using ha0 + have ha_mem : a ∈ I := by + rw [← Ideal.span_singleton_le_iff_mem] + rw [← ha] + exact le_sup_right + have hsup := v.multiplicity_sup hprod hspan0 + rw [ha, multiplicity_mul v.prime + (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self] at hsup + have hmult : multiplicity v.asIdeal (Ideal.span {a}) = + multiplicity v.asIdeal I := by + by_cases hle : multiplicity v.asIdeal (Ideal.span {a}) ≤ + 1 + multiplicity v.asIdeal I + · rw [min_eq_right hle] at hsup + exact hsup.symm + · have hle' : 1 + multiplicity v.asIdeal I ≤ + multiplicity v.asIdeal (Ideal.span {a}) := by omega + rw [min_eq_left hle'] at hsup + omega + exact ⟨a, ha0, ha_mem, hmult⟩ + +/-- At every height-one place, a global element locally generates the +different and clears the obstruction to preserving the integral closure. -/ +theorem exists_finitePlace_different_localGenerator_scaling_certificate + {C S T U F : Type*} + [CommRing C] [CommRing S] [CommRing T] [CommRing U] + [Algebra C S] [Algebra C T] [Algebra S T] + [Algebra C U] [Algebra S U] [Algebra T U] + [IsScalarTower C S T] [IsScalarTower C S U] + [IsScalarTower C T U] [IsScalarTower S T U] + [IsDomain S] [IsIntegrallyClosed S] [IsDedekindDomain T] + [Module.IsTorsionFree S T] [Module.Finite S T] [Module.Free S T] + [Algebra.IsSeparable (FractionRing S) (FractionRing T)] + [Field F] [Algebra T F] [IsFractionRing T F] + (v : HeightOneSpectrum T) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ δ : T, + δ ≠ 0 ∧ + δ ∈ differentIdeal S T ∧ + multiplicity v.asIdeal (Ideal.span {δ}) = + multiplicity v.asIdeal (differentIdeal S T) ∧ + finitePlaceOrder v (algebraMap T F δ) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) ∧ + δ ∈ kaehlerDifferentialAnnihilator S T ∧ + ∀ t : T, ∃ t' : T, + algebraMap T U δ * E (algebraMap T U t) = algebraMap T U t' := by + have hDifferent : differentIdeal S T ≠ ⊥ := + differentIdeal_ne_bot (A := S) (B := T) + obtain ⟨δ, hδ, hδmem, hδmult⟩ := + exists_element_locally_generating_ideal (differentIdeal S T) hDifferent v + have hDifferentKaehler : + differentIdeal S T ≤ kaehlerDifferentialAnnihilator S T := by + simpa [kaehlerDifferentialAnnihilator] using + (differentIdeal_le_kaehlerDifferentialAnnihilator (A := S) (B := T)) + have hδann : δ ∈ kaehlerDifferentialAnnihilator S T := + hDifferentKaehler hδmem + have hδorder : + finitePlaceOrder v (algebraMap T F δ) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) := by + rw [finitePlaceOrder_algebraMap_eq_multiplicity v δ hδ, hδmult] + exact ⟨δ, hδ, hδmem, hδmult, hδorder, hδann, + scaled_ambientDerivation_preserves_of_mem_kaehlerDifferentialAnnihilator + D E hE δ hδann⟩ + +/-- At a place over the pole of the reciprocal parameter `s`, the scalar +`-δ/s²` has order equal to the different multiplicity minus twice the +ramification index and makes the reparameterized derivation integral. -/ +theorem exists_infinity_different_localGenerator_scaling_certificate + {C S T L : Type*} + [CommRing C] [CommRing S] [CommRing T] [Field L] + [Algebra C S] [Algebra C T] [Algebra S T] + [Algebra C L] [Algebra S L] [Algebra T L] + [IsScalarTower C S T] [IsScalarTower C S L] + [IsScalarTower C T L] [IsScalarTower S T L] + [IsDomain S] [IsIntegrallyClosed S] [IsDedekindDomain T] + [Module.IsTorsionFree S T] [Module.Finite S T] [Module.Free S T] + [Algebra.IsSeparable (FractionRing S) (FractionRing T)] + [IsFractionRing T L] + (p : HeightOneSpectrum S) (v : HeightOneSpectrum T) + [v.asIdeal.LiesOver p.asIdeal] + (s : S) (hs : s ≠ 0) (hspan : p.asIdeal = Ideal.span {s}) + (Ds : Derivation C S S) (Es DX : Derivation C L L) + (hEs : ∀ r : S, Es (algebraMap S L r) = algebraMap S L (Ds r)) + (hDX : DX = (-(algebraMap S L s) ^ 2) • Es) : + ∃ δ : T, + δ ≠ 0 ∧ + δ ∈ differentIdeal S T ∧ + multiplicity v.asIdeal (Ideal.span {δ}) = + multiplicity v.asIdeal (differentIdeal S T) ∧ + let c : L := -(algebraMap T L δ) / (algebraMap S L s) ^ 2 + finitePlaceOrder v c = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) - + 2 * (v.asIdeal.ramificationIdx S : ℤ) ∧ + ∀ t : T, ∃ t' : T, + c * DX (algebraMap T L t) = algebraMap T L t' := by + obtain ⟨δ, hδ, hδmem, hδmult, hδorder, _hδann, hδpreserves⟩ := + exists_finitePlace_different_localGenerator_scaling_certificate + (U := L) (F := L) v Ds Es hEs + refine ⟨δ, hδ, hδmem, hδmult, ?_, ?_⟩ + · have hsT : algebraMap S T s ≠ 0 := by + simpa using (FaithfulSMul.algebraMap_injective S T).ne hs + have hsL : algebraMap S L s ≠ 0 := by + rw [IsScalarTower.algebraMap_apply S T L] + simpa using (IsFractionRing.injective T L).ne hsT + have hδL : algebraMap T L δ ≠ 0 := by + simpa using (IsFractionRing.injective T L).ne hδ + have hsOrder : + finitePlaceOrder v (algebraMap S L s) = + (v.asIdeal.ramificationIdx S : ℤ) := by + simpa only [IsScalarTower.algebraMap_apply S T L] using + finitePlaceOrder_algebraMap_uniformizer_eq_ramificationIdx + (F := L) p v s hs hspan + rw [div_eq_mul_inv, + finitePlaceOrder_mul_eq_add v + (-(algebraMap T L δ)) (((algebraMap S L s) ^ 2)⁻¹) + (neg_ne_zero.mpr hδL) (inv_ne_zero (pow_ne_zero 2 hsL)), + finitePlaceOrder_neg_eq v (algebraMap T L δ) hδL, + finitePlaceOrder_inv_eq_neg' v ((algebraMap S L s) ^ 2) + (pow_ne_zero 2 hsL)] + have hsSquareOrder := finitePlaceOrder_mul_eq_add v + (algebraMap S L s) (algebraMap S L s) hsL hsL + rw [← pow_two] at hsSquareOrder + rw [hδorder, hsSquareOrder, hsOrder] + ring + · intro t + obtain ⟨t', ht'⟩ := hδpreserves t + refine ⟨t', ?_⟩ + have hsT : algebraMap S T s ≠ 0 := by + simpa using (FaithfulSMul.algebraMap_injective S T).ne hs + have hsL : algebraMap S L s ≠ 0 := by + rw [IsScalarTower.algebraMap_apply S T L] + simpa using (IsFractionRing.injective T L).ne hsT + rw [hDX, Derivation.smul_apply, Algebra.smul_def] + calc + (-(algebraMap T L δ) / (algebraMap S L s) ^ 2) * + (-(algebraMap S L s) ^ 2 * Es (algebraMap T L t)) = + algebraMap T L δ * Es (algebraMap T L t) := by + field_simp + _ = algebraMap T L t' := ht' + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean new file mode 100644 index 0000000000..050281bb5e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean @@ -0,0 +1,319 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import Mathlib.RingTheory.Discriminant +import Mathlib.Data.Finsupp.Order + +/-! +# The different divisor and the primitive-element derivative + +For a finite separable extension represented by an integral primitive element, +the different ideal divides the principal ideal generated by the derivative of +the integral minimal polynomial. This file packages that fact at four levels: + +* effective finitely supported divisors of nonzero Dedekind ideals; +* coefficientwise and arbitrary nonnegative weighted bounds for the different; +* the corresponding local finite-place order inequality; and +* the field norm identity relating the derivative to the power-basis + discriminant. + +Thus all ramified finite-place contributions represented by the different are +controlled by one principal divisor. No canonical-divisor or genus estimate is +assumed here. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Polynomial + +namespace BGS.CorvajaZannier + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +section IdealDivisor + +variable {R : Type*} [CommRing R] [IsDedekindDomain R] + +/-- The effective divisor associated to a nonzero integral ideal of a Dedekind domain. -/ +def idealMultiplicityDivisor (I : Ideal R) (hI : I ≠ ⊥) : + HeightOneSpectrum R →₀ Nat := + let h := Ideal.finite_factors hI + Finsupp.mk h.toFinset (fun v => multiplicity v.asIdeal I) (fun v => by + rw [h.mem_toFinset, Set.mem_setOf_eq] + simpa [Nat.pos_iff_ne_zero] using + (dvd_iff_multiplicity_pos (a := v.asIdeal) (b := I)).symm) + +@[simp] +theorem idealMultiplicityDivisor_apply (I : Ideal R) (hI : I ≠ ⊥) + (v : HeightOneSpectrum R) : + idealMultiplicityDivisor I hI v = multiplicity v.asIdeal I := by + simp [idealMultiplicityDivisor] + +theorem idealMultiplicityDivisor_mono + {I J : Ideal R} (hI : I ≠ ⊥) (hJ : J ≠ ⊥) (h : J <= I) : + idealMultiplicityDivisor I hI <= idealMultiplicityDivisor J hJ := by + intro v + simp only [idealMultiplicityDivisor_apply] + exact v.multiplicity_le_of_ideal_ge h hJ + +theorem idealMultiplicityDivisor_weightedSum_mono + {I J : Ideal R} (hI : I ≠ ⊥) (hJ : J ≠ ⊥) (h : J <= I) + (weight : HeightOneSpectrum R -> Nat) : + (idealMultiplicityDivisor I hI).sum (fun v e => e * weight v) <= + (idealMultiplicityDivisor J hJ).sum (fun v e => e * weight v) := by + classical + apply Finsupp.sum_le_sum_index (idealMultiplicityDivisor_mono hI hJ h) + · intro v _ a b hab + exact Nat.mul_le_mul_right (weight v) hab + · simp + +end IdealDivisor + +section DifferentDivisor + +variable (A B : Type*) [CommRing A] [CommRing B] + [IsDomain A] [IsDedekindDomain B] [Algebra A B] + [Module.IsTorsionFree A B] + +/-- The effective different divisor of a finite separable Dedekind extension. -/ +def differentMultiplicityDivisor (hDifferent : differentIdeal A B ≠ ⊥) : + HeightOneSpectrum B →₀ Nat := + idealMultiplicityDivisor (differentIdeal A B) hDifferent + +@[simp] +theorem differentMultiplicityDivisor_apply + (hDifferent : differentIdeal A B ≠ ⊥) (v : HeightOneSpectrum B) : + differentMultiplicityDivisor A B hDifferent v = + multiplicity v.asIdeal (differentIdeal A B) := by + simp [differentMultiplicityDivisor] + +end DifferentDivisor + +section PrimitiveDifferent + +variable {A K L B : Type*} + [CommRing A] [Field K] [CommRing B] [Field L] + [Algebra A K] [Algebra B L] [Algebra A B] [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [IsScalarTower A B L] + [IsDomain A] [IsFractionRing A K] [FiniteDimensional K L] + [Algebra.IsSeparable K L] [IsIntegralClosure B A L] + [IsIntegrallyClosed A] [IsDedekindDomain B] + [Module.IsTorsionFree A B] + +include K L in +omit [FiniteDimensional K L] [Module.IsTorsionFree A B] in +/-- In a separable function-field extension, the integral minimal-polynomial +derivative of every integral element is nonzero. -/ +theorem minpolyDerivative_ne_zero (x : B) : + aeval x (derivative (minpoly A x)) ≠ 0 := by + have hne : + aeval (algebraMap B L x) + (derivative (minpoly K (algebraMap B L x))) ≠ 0 := + (Algebra.IsSeparable.isSeparable _ _).aeval_derivative_ne_zero + (minpoly.aeval K (algebraMap B L x)) + have hmap : algebraMap B L (aeval x (derivative (minpoly A x))) ≠ 0 := by + rwa [minpoly.isIntegrallyClosed_eq_field_fractions K L + (IsIntegralClosure.isIntegral A L x), derivative_map, + aeval_map_algebraMap, aeval_algebraMap_apply] at hne + exact fun hzero => hmap (by simp [hzero]) + +include K L in +omit [FiniteDimensional K L] [Module.IsTorsionFree A B] in +theorem minpolyDerivative_span_ne_bot (x : B) : + Ideal.span {aeval x (derivative (minpoly A x))} ≠ ⊥ := by + rw [ne_eq, Ideal.span_singleton_eq_bot] + exact minpolyDerivative_ne_zero (A := A) (K := K) (L := L) x + +/-- A separable primitive element supplies a nonzero element of the different, +so the different ideal itself is nonzero. -/ +theorem differentIdeal_ne_bot_of_primitiveElement + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) : + differentIdeal A B ≠ ⊥ := by + intro hDifferent + have hmem := aeval_derivative_mem_differentIdeal A K L x hx + rw [hDifferent, Ideal.mem_bot] at hmem + exact minpolyDerivative_ne_zero (A := A) (K := K) (L := L) x hmem + +/-- The different divides the principal ideal generated by the derivative of a +primitive element's integral minimal polynomial. -/ +theorem differentIdeal_dvd_minpolyDerivativeSpan + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) : + differentIdeal A B ∣ + Ideal.span {aeval x (derivative (minpoly A x))} := by + rw [Ideal.dvd_iff_le, Ideal.span_singleton_le_iff_mem] + exact aeval_derivative_mem_differentIdeal A K L x hx + +/-- At every finite prime, the different exponent is bounded by the order of +the primitive element's minimal-polynomial derivative. -/ +theorem differentIdeal_multiplicity_le_minpolyDerivativeSpan + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) + (v : HeightOneSpectrum B) : + multiplicity v.asIdeal (differentIdeal A B) <= + multiplicity v.asIdeal + (Ideal.span {aeval x (derivative (minpoly A x))}) := by + apply v.multiplicity_le_of_ideal_ge + · exact Ideal.dvd_iff_le.mp (differentIdeal_dvd_minpolyDerivativeSpan x hx) + · exact minpolyDerivative_span_ne_bot (A := A) (K := K) (L := L) x + +theorem differentPrime_dvd_minpolyDerivativeSpan + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) + (v : HeightOneSpectrum B) + (hv : v.asIdeal ∣ differentIdeal A B) : + v.asIdeal ∣ Ideal.span {aeval x (derivative (minpoly A x))} := + hv.trans (differentIdeal_dvd_minpolyDerivativeSpan x hx) + +end PrimitiveDifferent + +section DifferentFinsuppBound + +variable {A K L B : Type*} + [CommRing A] [Field K] [CommRing B] [Field L] + [Algebra A K] [Algebra B L] [Algebra A B] [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [IsScalarTower A B L] + [IsDomain A] [IsIntegrallyClosed A] [IsDedekindDomain B] + [IsFractionRing A K] [FiniteDimensional K L] + [Algebra.IsSeparable K L] [IsIntegralClosure B A L] + [Module.IsTorsionFree A B] + +theorem differentMultiplicityDivisor_le_minpolyDerivativeDivisor + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) : + differentMultiplicityDivisor A B + (differentIdeal_ne_bot_of_primitiveElement + (A := A) (K := K) (L := L) (B := B) x hx) <= + idealMultiplicityDivisor + (Ideal.span {aeval x (derivative (minpoly A x))}) + (minpolyDerivative_span_ne_bot + (A := A) (K := K) (L := L) (B := B) x) := by + intro v + simp only [differentMultiplicityDivisor_apply, + idealMultiplicityDivisor_apply] + exact differentIdeal_multiplicity_le_minpolyDerivativeSpan + (A := A) (K := K) (L := L) (B := B) x hx v + +theorem differentMultiplicityWeightedSum_le_minpolyDerivative + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) + (weight : HeightOneSpectrum B -> Nat) : + (differentMultiplicityDivisor A B + (differentIdeal_ne_bot_of_primitiveElement + (A := A) (K := K) (L := L) (B := B) x hx)).sum + (fun v e => e * weight v) <= + (idealMultiplicityDivisor + (Ideal.span {aeval x (derivative (minpoly A x))}) + (minpolyDerivative_span_ne_bot + (A := A) (K := K) (L := L) (B := B) x)).sum + (fun v e => e * weight v) := by + classical + apply Finsupp.sum_le_sum_index + (differentMultiplicityDivisor_le_minpolyDerivativeDivisor + (A := A) (K := K) (L := L) (B := B) x hx) + · intro v _ a b hab + exact Nat.mul_le_mul_right (weight v) hab + · simp + +theorem finite_differentPrimes_of_primitiveElement + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) : + {v : HeightOneSpectrum B | + v.asIdeal ∣ differentIdeal A B}.Finite := by + apply Set.Finite.subset + (Ideal.finite_factors (minpolyDerivative_span_ne_bot + (A := A) (K := K) (L := L) (B := B) x)) + intro v hv + exact differentPrime_dvd_minpolyDerivativeSpan + (A := A) (K := K) (L := L) (B := B) x hx v hv + +end DifferentFinsuppBound + +section LocalOrder + +variable {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + +theorem finitePlaceOrder_algebraMap_eq_multiplicity + (v : HeightOneSpectrum R) (a : R) (ha : a ≠ 0) : + finitePlaceOrder v (algebraMap R F a) = + (multiplicity v.asIdeal (Ideal.span {a}) : Int) := by + have hmap : algebraMap R F a ≠ 0 := by + intro hzero + apply ha + apply IsFractionRing.injective R F + simpa using hzero + have hvaluation := + valuation_eq_exp_neg_finitePlaceOrder v (algebraMap R F a) hmap + rw [HeightOneSpectrum.valuation_of_algebraMap, + v.intValuation_eq_exp_neg_multiplicity ha] at hvaluation + exact (neg_injective (WithZero.exp_injective hvaluation)).symm + +end LocalOrder + +section PrimitiveLocalOrder + +variable {A K L B : Type*} + [CommRing A] [Field K] [CommRing B] [Field L] + [Algebra A K] [Algebra A B] [Algebra B L] + [Algebra K L] [Algebra A L] + [IsScalarTower A K L] + [IsScalarTower A B L] + [IsDomain A] [IsFractionRing A K] + [IsFractionRing B L] [FiniteDimensional K L] + [Algebra.IsSeparable K L] + [IsIntegralClosure B A L] + [IsIntegrallyClosed A] [IsDedekindDomain B] + [Module.IsTorsionFree A B] + +theorem differentIdeal_multiplicity_le_finitePlaceOrder_minpolyDerivative + (x : B) + (hx : Algebra.adjoin K + {algebraMap B L x} = ⊤) + (v : HeightOneSpectrum B) : + (multiplicity v.asIdeal (differentIdeal A B) : Int) <= + finitePlaceOrder v + (algebraMap B L + (aeval x (derivative (minpoly A x)))) := by + rw [finitePlaceOrder_algebraMap_eq_multiplicity _ _ + (minpolyDerivative_ne_zero (A := A) (K := K) (L := L) x)] + exact_mod_cast differentIdeal_multiplicity_le_minpolyDerivativeSpan x hx v + +end PrimitiveLocalOrder + +section NormDiscriminant + +variable {A K L B : Type*} + [CommRing A] [Field K] [CommRing B] [Field L] + [Algebra A K] [Algebra B L] [Algebra A B] [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [IsScalarTower A B L] + [IsDomain A] [IsFractionRing A K] [FiniteDimensional K L] + [Algebra.IsSeparable K L] [IsIntegralClosure B A L] + [IsIntegrallyClosed A] [IsDedekindDomain B] + +/-- The field norm of the integral minimal-polynomial derivative is the +power-basis discriminant, up to the standard sign. -/ +theorem discr_powerBasisOfPrimitiveElement_eq_norm_minpolyDerivative + (x : B) (hx : Algebra.adjoin K {algebraMap B L x} = ⊤) : + let pb : PowerBasis K L := + PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral _) hx + Algebra.discr K pb.basis = + (-1) ^ (Module.finrank K L * (Module.finrank K L - 1) / 2) * + Algebra.norm K + (algebraMap B L (aeval x (derivative (minpoly A x)))) := by + dsimp only + let pb : PowerBasis K L := + PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral _) hx + rw [Algebra.discr_powerBasis_eq_norm K pb] + congr 2 + simp only [pb, PowerBasis.ofAdjoinEqTop'_gen] + rw [minpoly.isIntegrallyClosed_eq_field_fractions K L + (IsIntegralClosure.isIntegral A L x), derivative_map, + aeval_map_algebraMap, aeval_algebraMap_apply] + +end NormDiscriminant + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean new file mode 100644 index 0000000000..0166c71f6b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.DedekindDomain.Different +import Mathlib.RingTheory.Kaehler.Basic +import Mathlib.RingTheory.TensorProduct.Maps +import Mathlib.LinearAlgebra.TensorProduct.Basis + +/-! +# The trace different annihilates Kähler differentials + +For a finite free extension `B / A` of integrally closed domains whose +fraction-field extension is separable, this file proves + +`differentIdeal A B ≤ Module.annihilator B Ω[B⁄A]`. + +The proof clears denominators in the trace-dual separability element. If +`b₁, ..., bₙ` is an integral basis with trace-dual basis `b₁ˇ, ..., bₙˇ` +and `d` lies in the different, then every `d bᵢˇ` is integral. Thus + +`e_d = ∑ i, bᵢ ⊗ d bᵢˇ` + +lies in `B ⊗[A] B`, has product `d`, and is killed by the kernel of the +multiplication map. It follows that multiplication by `d` sends this kernel +into its square, hence kills its cotangent module `I / I² = Ω[B⁄A]`. +-/ + +open scoped BigOperators TensorProduct +open Polynomial Module + +namespace BGS.CorvajaZannier + +noncomputable section + +section TraceSeparabilityElement + +variable {K L ι : Type*} [Field K] [Field L] [Algebra K L] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + [Fintype ι] [DecidableEq ι] + +/-- The separability element attached to a basis and its trace-dual basis. -/ +def traceSeparabilityElement (b : Basis ι K L) : L ⊗[K] L := + ∑ i, b i ⊗ₜ[K] b.traceDual i + +private lemma traceDual_mul_eq_sum_repr (b : Basis ι K L) (x : L) (j : ι) : + x * b.traceDual j = ∑ i, b.repr (x * b i) j • b.traceDual i := by + rw [← b.traceDual.sum_repr (x * b.traceDual j)] + apply Finset.sum_congr rfl + intro i hi + congr 1 + calc + (b.traceDual).repr (x * b.traceDual j) i = + Algebra.traceForm K L (x * b.traceDual j) (b i) := + b.traceDual_repr_apply _ _ + _ = Algebra.traceForm K L (x * b i) (b.traceDual j) := by + simp only [Algebra.traceForm_apply] + congr 1 + ring + _ = (b.traceDual.traceDual).repr (x * b i) j := + ((b.traceDual).traceDual_repr_apply _ _).symm + _ = b.repr (x * b i) j := by rw [b.traceDual_traceDual] + +/-- The trace-dual separability element commutes with the two copies of the +field extension in the tensor product. -/ +theorem traceSeparabilityElement_central (b : Basis ι K L) (x : L) : + (x ⊗ₜ[K] (1 : L)) * traceSeparabilityElement b = + ((1 : L) ⊗ₜ[K] x) * traceSeparabilityElement b := by + apply (TensorProduct.equivFinsuppOfBasisLeft b).injective + ext j + simp only [traceSeparabilityElement, Finset.mul_sum, + Algebra.TensorProduct.tmul_mul_tmul, one_mul, map_sum] + simp only [Finset.sum_apply'] + simp_rw [TensorProduct.equivFinsuppOfBasisLeft_apply_tmul_apply] + simp only [Basis.repr_self, Finsupp.single_apply, ite_smul, one_smul, zero_smul, + Finset.sum_ite_eq', Finset.mem_univ, if_true] + rw [← traceDual_mul_eq_sum_repr b x j] + +/-- Multiplication sends the trace-dual separability element to one. -/ +theorem traceSeparabilityElement_mul (b : Basis ι K L) : + Algebra.TensorProduct.lmul' K (traceSeparabilityElement b) = 1 := by + apply sub_eq_zero.mp + apply (traceForm_nondegenerate K L).1 + intro y + change Algebra.trace K L + ((Algebra.TensorProduct.lmul' K (traceSeparabilityElement b) - 1) * y) = 0 + rw [sub_mul, one_mul, map_sub, sub_eq_zero, traceSeparabilityElement, map_sum] + simp only [Algebra.TensorProduct.lmul'_apply_tmul, Finset.sum_mul, map_sum] + rw [Algebra.trace_eq_matrix_trace b, Matrix.trace] + apply Finset.sum_congr rfl + intro i hi + rw [Matrix.diag_apply, Algebra.leftMulMatrix_eq_repr_mul] + calc + Algebra.trace K L (b i * b.traceDual i * y) = + Algebra.traceForm K L (y * b i) (b.traceDual i) := by + simp only [Algebra.traceForm_apply] + congr 1 + ring + _ = (b.traceDual.traceDual).repr (y * b i) i := + ((b.traceDual).traceDual_repr_apply _ _).symm + _ = b.repr (y * b i) i := by rw [b.traceDual_traceDual] + +end TraceSeparabilityElement + +section KaehlerFromSeparabilityElement + +variable {R S : Type*} [CommRing R] [CommRing S] [Algebra R S] + +/-- A denominator-cleared separability element with product `d` proves that +`d` annihilates the relative Kähler differentials. -/ +theorem mem_kaehlerAnnihilator_of_separabilityElement + (d : S) (e : S ⊗[R] S) + (hcentral : ∀ s : S, (s ⊗ₜ[R] (1 : S)) * e = ((1 : S) ⊗ₜ[R] s) * e) + (hmul : Algebra.TensorProduct.lmul' R e = d) : + d ∈ Module.annihilator S Ω[S⁄R] := by + rw [Module.mem_annihilator] + intro m + let I := KaehlerDifferential.ideal R S + obtain ⟨x, rfl⟩ := Ideal.toCotangent_surjective I m + suffices d • (I.toCotangent x : I.Cotangent) = 0 by + exact this + rw [← smul_one_smul (S ⊗[R] S) d (I.toCotangent x)] + rw [show d • (1 : S ⊗[R] S) = algebraMap S (S ⊗[R] S) d by + simp [Algebra.smul_def]] + rw [← LinearMap.map_smul I.toCotangent] + apply (Ideal.toCotangent_eq_zero I _).2 + have hxspan : (x : S ⊗[R] S) ∈ + Submodule.span S (Set.range fun s : S ↦ + (1 : S) ⊗ₜ[R] s - s ⊗ₜ[R] (1 : S)) := by + rw [KaehlerDifferential.submodule_span_range_eq_ideal] + exact x.2 + have hxe : (x : S ⊗[R] S) * e = 0 := by + refine Submodule.span_induction ?_ ?_ ?_ ?_ hxspan + · rintro y ⟨s, rfl⟩ + rw [sub_mul, sub_eq_zero] + exact (hcentral s).symm + · rw [zero_mul] + · intro y z hy hz hye hze + rw [add_mul, hye, hze, add_zero] + · intro c y hy hye + rw [smul_mul_assoc, hye, smul_zero] + let delta : S ⊗[R] S := d ⊗ₜ[R] (1 : S) - e + have hdelta : delta ∈ I := by + change Algebra.TensorProduct.lmul' R delta = 0 + simp [delta, hmul] + rw [pow_two] + have hprod : delta * (x : S ⊗[R] S) ∈ I * I := + Ideal.mul_mem_mul hdelta x.2 + convert hprod using 1 + · simp only [Submodule.coe_smul, Algebra.smul_def, + Algebra.TensorProduct.algebraMap_apply] + dsimp [delta] + rw [sub_mul, mul_comm e, hxe, sub_zero] + +end KaehlerFromSeparabilityElement + +section IntegralDifferent + +open scoped nonZeroDivisors + +variable {A K B L κ : Type*} + [CommRing A] [Field K] [CommRing B] [Field L] + [Algebra A K] [Algebra B L] [Algebra A B] [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [IsScalarTower A B L] + [IsDomain A] [IsFractionRing A K] [FiniteDimensional K L] + [Algebra.IsSeparable K L] [IsIntegralClosure B A L] + [IsIntegrallyClosed A] [IsDedekindDomain B] + [Module.IsTorsionFree A B] + [IsLocalization (Algebra.algebraMapSubmonoid B A⁰) L] + [Fintype κ] [DecidableEq κ] + +private lemma exists_integral_traceDual_mul + (bA : Basis κ A B) (d : B) (hd : d ∈ differentIdeal A B) (i : κ) : + ∃ c : B, algebraMap B L c = algebraMap B L d * + (bA.localizationLocalization K A⁰ L).traceDual i := by + let bK := bA.localizationLocalization K A⁰ L + have hbspan : (1 : Submodule B L).restrictScalars A = + Submodule.span A (Set.range bK) := by + rw [Submodule.one_eq_range] + exact (bA.localizationLocalization_span K A⁰ L).symm + have hdual : bK.traceDual i ∈ Submodule.traceDual A K (1 : Submodule B L) := by + rw [← Submodule.restrictScalars_mem A, + Submodule.traceDual_span_of_basis A (1 : Submodule B L) bK hbspan] + exact Submodule.subset_span (Set.mem_range_self i) + letI : IsFractionRing B L := + IsIntegralClosure.isFractionRing_of_finite_extension A K L B + have hd' : algebraMap B L d ∈ + (FractionalIdeal.dual A K (1 : FractionalIdeal B⁰ L))⁻¹ := by + have h := FractionalIdeal.mem_coeIdeal_of_mem (S := B⁰) (P := L) hd + rwa [coeIdeal_differentIdeal A K L B] at h + have hdual' : bK.traceDual i ∈ + FractionalIdeal.dual A K (1 : FractionalIdeal B⁰ L) := by + change bK.traceDual i ∈ + (FractionalIdeal.dual A K (1 : FractionalIdeal B⁰ L) : Submodule B L) + rw [FractionalIdeal.coe_dual_one] + exact hdual + have hprod : algebraMap B L d * bK.traceDual i ∈ + (1 : FractionalIdeal B⁰ L) := + (FractionalIdeal.mem_inv_iff + (FractionalIdeal.dual_ne_zero A K + (@one_ne_zero (FractionalIdeal B⁰ L) _ _ _))).mp hd' _ hdual' + obtain ⟨c, hc⟩ := (FractionalIdeal.mem_one_iff B⁰).mp hprod + exact ⟨c, hc⟩ + +end IntegralDifferent + +section CanonicalDifferent + +open scoped nonZeroDivisors + +variable {A B κ : Type*} + [CommRing A] [CommRing B] [Algebra A B] + [IsDomain A] [IsIntegrallyClosed A] [IsDedekindDomain B] + [Module.IsTorsionFree A B] [Module.Finite A B] + [Algebra (FractionRing A) (FractionRing B)] + [IsScalarTower A (FractionRing A) (FractionRing B)] + [Algebra.IsSeparable (FractionRing A) (FractionRing B)] + [Fintype κ] [DecidableEq κ] + +private theorem mem_kaehlerAnnihilator_of_mem_differentIdeal_of_basis + (bA : Basis κ A B) (d : B) (hd : d ∈ differentIdeal A B) : + d ∈ Module.annihilator B Ω[B⁄A] := by + letI : IsIntegralClosure B A (FractionRing B) := + IsIntegralClosure.of_isIntegrallyClosed B A (FractionRing B) + letI : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := + isAlgebraic_of_isFractionRing A B .. + letI : IsLocalization + (Algebra.algebraMapSubmonoid B A⁰) (FractionRing B) := + IsIntegralClosure.isLocalization A (FractionRing A) (FractionRing B) B + letI : FiniteDimensional (FractionRing A) (FractionRing B) := + .of_isLocalization A B A⁰ + let bK := bA.localizationLocalization (FractionRing A) A⁰ (FractionRing B) + let c : κ → B := fun i ↦ + Classical.choose (exists_integral_traceDual_mul + (K := FractionRing A) (L := FractionRing B) bA d hd i) + have hc (i : κ) : algebraMap B (FractionRing B) (c i) = + algebraMap B (FractionRing B) d * bK.traceDual i := by + exact Classical.choose_spec (exists_integral_traceDual_mul + (K := FractionRing A) (L := FractionRing B) bA d hd i) + let e : B ⊗[A] B := ∑ i, bA i ⊗ₜ[A] c i + apply mem_kaehlerAnnihilator_of_separabilityElement d e + · intro x + apply (TensorProduct.equivFinsuppOfBasisLeft bA).injective + ext j + simp only [e, Finset.mul_sum, Algebra.TensorProduct.tmul_mul_tmul, + one_mul, map_sum, Finset.sum_apply'] + simp_rw [TensorProduct.equivFinsuppOfBasisLeft_apply_tmul_apply] + simp only [Basis.repr_self, Finsupp.single_apply, ite_smul, one_smul, + zero_smul, Finset.sum_ite_eq', Finset.mem_univ, if_true] + apply FaithfulSMul.algebraMap_injective B (FractionRing B) + rw [map_sum] + have htrace := traceDual_mul_eq_sum_repr bK + (algebraMap B (FractionRing B) x) j + calc + ∑ i, algebraMap B (FractionRing B) + ((bA.repr (x * bA i) j) • c i) = + algebraMap B (FractionRing B) d * + ∑ i, bK.repr + (algebraMap B (FractionRing B) x * bK i) j • + bK.traceDual i := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro i hi + rw [Algebra.smul_def, map_mul, hc] + have harg : algebraMap B (FractionRing B) x * bK i = + algebraMap B (FractionRing B) (x * bA i) := by + simp only [bK, Basis.localizationLocalization_apply, map_mul] + rw [harg] + simp only [bK, Basis.localizationLocalization_repr_algebraMap] + simp only [Algebra.smul_def] + rw [← IsScalarTower.algebraMap_apply A B (FractionRing B), + ← IsScalarTower.algebraMap_apply A (FractionRing A) + (FractionRing B)] + ring + _ = algebraMap B (FractionRing B) d * + (algebraMap B (FractionRing B) x * bK.traceDual j) := by + rw [htrace] + _ = algebraMap B (FractionRing B) x * + (algebraMap B (FractionRing B) d * bK.traceDual j) := by ring + _ = algebraMap B (FractionRing B) (x * c j) := by + rw [map_mul, hc] + · apply FaithfulSMul.algebraMap_injective B (FractionRing B) + simp only [e, map_sum, Algebra.TensorProduct.lmul'_apply_tmul, + map_mul, hc] + have hsum : ∑ i, bK i * bK.traceDual i = 1 := by + simpa only [traceSeparabilityElement, map_sum, + Algebra.TensorProduct.lmul'_apply_tmul] using + (traceSeparabilityElement_mul + (K := FractionRing A) (L := FractionRing B) bK) + calc + ∑ i, algebraMap B (FractionRing B) (bA i) * + (algebraMap B (FractionRing B) d * bK.traceDual i) = + algebraMap B (FractionRing B) d * + ∑ i, bK i * bK.traceDual i := by + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro i hi + simp only [bK, Basis.localizationLocalization_apply] + ring + _ = algebraMap B (FractionRing B) d := by rw [hsum, mul_one] + +/-- The trace different is contained in the annihilator of the relative +Kähler differentials. -/ +theorem differentIdeal_le_kaehlerDifferentialAnnihilator + [Module.Free A B] : + differentIdeal A B ≤ Module.annihilator B Ω[B⁄A] := by + intro d hd + let bA := Module.Free.chooseBasis A B + letI := Classical.decEq (Module.Free.ChooseBasisIndex A B) + exact mem_kaehlerAnnihilator_of_mem_differentIdeal_of_basis bA d hd + +/-- In a principal target, a generator of the trace different is also a +Kähler-annihilating scalar. This applies to a localized DVR whenever the +localized extension is finite free. -/ +theorem exists_differentIdeal_generator_mem_kaehlerAnnihilator + [Module.Free A B] [IsPrincipalIdealRing B] : + ∃ c : B, Ideal.span {c} = differentIdeal A B ∧ + c ∈ Module.annihilator B Ω[B⁄A] := by + let c : B := Submodule.IsPrincipal.generator (differentIdeal A B) + refine ⟨c, Ideal.span_singleton_generator _, ?_⟩ + exact differentIdeal_le_kaehlerDifferentialAnnihilator + (Submodule.IsPrincipal.generator_mem (differentIdeal A B)) + +end CanonicalDifferent + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean new file mode 100644 index 0000000000..f8c73c3214 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import Mathlib.Tactic + +/-! +# Leading-term cancellation at a Dedekind DVR place + +At a discrete valuation place, two nonzero functions of the same order have +unit leading coefficients. If the derivation-constant field surjects onto +the residue field, one can subtract a constant multiple of one function from +the other and cancel that leading coefficient. The result either vanishes +or has strictly larger order. + +This is the global-Dedekind analogue of the Laurent-series cancellation used +in Corvaja--Zannier case (i). The surjectivity hypothesis is stated directly +on the residue field, so the theorem can be applied independently of how the +constant field is presented. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {C R L : Type*} [Field C] [CommRing R] [IsDedekindDomain R] + [IsDiscreteValuationRing R] [Field L] [Algebra C R] [Algebra R L] + [Algebra C L] [IsScalarTower C R L] [IsFractionRing R L] + +/-- A nonzero regular element lying in the place has positive order. -/ +theorem one_le_finitePlaceOrder_algebraMap_of_mem + (v : HeightOneSpectrum R) (a : R) (ha : a ∈ v.asIdeal) (ha0 : a ≠ 0) : + (1 : ℤ) ≤ finitePlaceOrder v (algebraMap R L a) := by + have hmap : algebraMap R L a ≠ 0 := by + intro hzero + apply ha0 + exact IsFractionRing.injective R L (by simpa using hzero) + have hvaluation := + valuation_eq_exp_neg_finitePlaceOrder v (algebraMap R L a) hmap + rw [HeightOneSpectrum.valuation_of_algebraMap] at hvaluation + have hlt : exp (-finitePlaceOrder v (algebraMap R L a)) < 1 := by + rw [← hvaluation] + exact (v.intValuation_lt_one_iff_mem a).2 ha + rw [← exp_zero, exp_lt_exp] at hlt + omega + +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] in +/-- Residue-field surjectivity lets constants cancel the ratio of two unit +leading coefficients. -/ +theorem exists_constant_unit_sub_mul_mem + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (u w : Rˣ) : + ∃ c : C, (u : R) - algebraMap C R c * (w : R) ∈ v.asIdeal := by + let κ := v.asIdeal.ResidueField + obtain ⟨c, hc⟩ := hresidue + (algebraMap R κ (((u * w⁻¹ : Rˣ) : R))) + refine ⟨c, ?_⟩ + rw [← Ideal.algebraMap_residueField_eq_zero] + calc + algebraMap R κ ((u : R) - algebraMap C R c * (w : R)) = + algebraMap R κ (u : R) - + algebraMap C κ c * algebraMap R κ (w : R) := by + rw [map_sub, map_mul, ← IsScalarTower.algebraMap_apply C R κ] + _ = algebraMap R κ (u : R) - + algebraMap R κ (((u * w⁻¹ : Rˣ) : R)) * + algebraMap R κ (w : R) := by rw [hc] + _ = 0 := by + rw [← map_mul] + simp + +/-- If constants surject onto the residue field at `v`, equal-order nonzero +functions have a constant leading-term cancellation. The cancelled function +is either zero or has strictly larger finite-place order. + +No uniformizer is part of the interface: one is chosen internally from the +DVR structure, and uniqueness of the maximal ideal identifies it with `v`. -/ +theorem exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField)) + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) + (horder : finitePlaceOrder v x = finitePlaceOrder v y) : + ∃ c : C, + x - algebraMap C L c * y = 0 ∨ + finitePlaceOrder v x < + finitePlaceOrder v (x - algebraMap C L c * y) := by + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : v.asIdeal = Ideal.span {π} := by + calc + v.asIdeal = IsLocalRing.maximalIdeal R := + IsLocalRing.eq_maximalIdeal v.isMaximal + _ = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + obtain ⟨nx, ux, hxrepr⟩ := + IsDiscreteValuationRing.exists_units_eq_smul_zpow_of_irreducible + (K := L) hπ hx + obtain ⟨ny, uy, hyrepr⟩ := + IsDiscreteValuationRing.exists_units_eq_smul_zpow_of_irreducible + (K := L) hπ hy + have hxrepr' : + x = algebraMap R L (ux : R) * (algebraMap R L π) ^ nx := by + simpa [Units.smul_def, Algebra.smul_def] using hxrepr + have hyrepr' : + y = algebraMap R L (uy : R) * (algebraMap R L π) ^ ny := by + simpa [Units.smul_def, Algebra.smul_def] using hyrepr + have hxOrder : finitePlaceOrder v x = nx := by + rw [hxrepr'] + exact finitePlaceOrder_unit_mul_uniformizer_zpow + v π hπ hπIdeal ux nx + have hyOrder : finitePlaceOrder v y = ny := by + rw [hyrepr'] + exact finitePlaceOrder_unit_mul_uniformizer_zpow + v π hπ hπIdeal uy ny + have hnxny : nx = ny := by omega + rw [← hnxny] at hyrepr' + obtain ⟨c, hc⟩ := exists_constant_unit_sub_mul_mem v hresidue ux uy + let a : R := (ux : R) - algebraMap C R c * (uy : R) + have haMem : a ∈ v.asIdeal := by simpa [a] using hc + have hfactor : + x - algebraMap C L c * y = + algebraMap R L a * (algebraMap R L π) ^ nx := by + rw [hxrepr', hyrepr'] + simp only [a, map_sub, map_mul] + rw [IsScalarTower.algebraMap_apply C R L] + ring + by_cases ha : a = 0 + · refine ⟨c, Or.inl ?_⟩ + rw [hfactor, ha, map_zero, zero_mul] + · refine ⟨c, Or.inr ?_⟩ + have haMap : algebraMap R L a ≠ 0 := by + intro hzero + apply ha + exact IsFractionRing.injective R L (by simpa using hzero) + have hπMap : algebraMap R L π ≠ 0 := by + simpa using hπ.ne_zero + have hprod := finitePrincipalDivisor_mul (R := R) + (algebraMap R L a) ((algebraMap R L π) ^ nx) + haMap (zpow_ne_zero nx hπMap) + have hprodOrder := congrArg (fun D ↦ D v) hprod + simp only [finitePrincipalDivisor_apply, Finsupp.add_apply] at hprodOrder + rw [finitePlaceOrder_uniformizer_zpow v π hπ hπIdeal nx] at hprodOrder + have haOrder : (1 : ℤ) ≤ finitePlaceOrder v (algebraMap R L a) := + one_le_finitePlaceOrder_algebraMap_of_mem v a haMem ha + rw [hxOrder, hfactor, hprodOrder] + omega + +section FrobeniusConstants + +variable {K : Type*} [Field K] {p : ℕ} [Fact p.Prime] + [CharP K p] [CharP L p] [PerfectField K] + [Algebra K R] [Algebra K L] [IsScalarTower K R L] + +/-- Over a perfect field of constants, the cancelling coefficient may be +regarded as an element of the Frobenius subfield `L^p`, which is the constant +field of the separating derivation used by Corvaja--Zannier. + +The residue-surjectivity hypothesis is deliberately imposed on the genuine +constant field `K`: the full subfield `L^p` is not contained in a nontrivial +valuation ring. Perfectness embeds `K` into `L^p`, and this is exactly enough +to make the column operation linear over the derivation-constant field. -/ +theorem exists_frobeniusSubfield_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt + (v : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap K v.asIdeal.ResidueField)) + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) + (horder : finitePlaceOrder v x = finitePlaceOrder v y) : + ∃ c : frobeniusSubfield L p, + x - algebraMap (frobeniusSubfield L p) L c * y = 0 ∨ + finitePlaceOrder v x < finitePlaceOrder v + (x - algebraMap (frobeniusSubfield L p) L c * y) := by + obtain ⟨c, hc⟩ := + exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt + (C := K) v hresidue x y hx hy horder + let cF : frobeniusSubfield L p := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) c + refine ⟨cF, ?_⟩ + have hcF : algebraMap (frobeniusSubfield L p) L cF = algebraMap K L c := by + exact coe_perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c + simpa only [hcF] using hc + +end FrobeniusConstants + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean new file mode 100644 index 0000000000..16979806ef --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean @@ -0,0 +1,264 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.Etale.Kaehler +import Mathlib.RingTheory.DedekindDomain.Different +import Mathlib.RingTheory.Flat.TorsionFree +import Mathlib.RingTheory.Smooth.Fiber + +namespace BGS.CorvajaZannier + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +variable {C S T U : Type*} + [CommRing C] [CommRing S] [CommRing T] [CommRing U] + [Algebra C S] [Algebra C T] [Algebra S T] + [Algebra C U] [Algebra S U] [Algebra T U] + [IsScalarTower C S T] [IsScalarTower C S U] + [IsScalarTower C T U] [IsScalarTower S T U] + +/-- A derivation over `C` which vanishes on `S` is an `S`-derivation. -/ +def derivationToRelative + (D : Derivation C T U) + (hD : ∀ s : S, D (algebraMap S T s) = 0) : + Derivation S T U where + toLinearMap := + { toFun := D + map_add' := D.map_add + map_smul' := by + intro s t + rw [show s • t = algebraMap S T s * t by + exact Algebra.smul_def s t] + rw [D.leibniz, hD, smul_zero, add_zero, + IsScalarTower.algebraMap_smul T, RingHom.id_apply] } + map_one_eq_zero' := D.map_one_eq_zero + leibniz' := D.leibniz + +omit [Algebra C S] [IsScalarTower C S T] [IsScalarTower C S U] + [IsScalarTower C T U] in +@[simp] +theorem derivationToRelative_apply + (D : Derivation C T U) + (hD : ∀ s : S, D (algebraMap S T s) = 0) (t : T) : + derivationToRelative D hD t = D t := + rfl + +omit [Algebra C S] [IsScalarTower C S T] [IsScalarTower C S U] + [IsScalarTower C T U] in +/-- Relative formal unramifiedness makes a `C`-derivation into a `T`-module +unique once its restriction to `S` is fixed. -/ +theorem derivation_ext_of_formallyUnramified + [Algebra.FormallyUnramified S T] + (D₁ D₂ : Derivation C T U) + (hD : ∀ s : S, D₁ (algebraMap S T s) = D₂ (algebraMap S T s)) : + D₁ = D₂ := by + let E : Derivation C T U := D₁ - D₂ + have hE : ∀ s : S, E (algebraMap S T s) = 0 := by + intro s + exact sub_eq_zero.mpr (hD s) + let Erel : Derivation S T U := derivationToRelative E hE + have hLift : Erel.liftKaehlerDifferential = 0 := by + apply LinearMap.ext + intro x + rw [show x = 0 from Subsingleton.elim x 0] + simp + have hErel : Erel = 0 := by + rw [← Erel.liftKaehlerDifferential_comp, hLift] + rfl + apply Derivation.ext + intro t + have := Derivation.congr_fun hErel t + apply sub_eq_zero.mp + simpa [Erel, E, derivationToRelative] using this + +/-- Lift a `C`-derivation through a formally étale `S`-algebra. The target +may be any compatible `T`-algebra. -/ +noncomputable def formallyEtaleDerivationLift + [Algebra.FormallyEtale S T] + (D : Derivation C S U) : Derivation C T U := + KaehlerDifferential.linearMapEquivDerivation C T + ((D.liftKaehlerDifferential.liftBaseChange T).comp + (KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale C S T).symm.toLinearMap) + +@[simp] +theorem formallyEtaleDerivationLift_algebraMap + [Algebra.FormallyEtale S T] + (D : Derivation C S U) (s : S) : + formallyEtaleDerivationLift D (algebraMap S T s) = D s := by + change (D.liftKaehlerDifferential.liftBaseChange T) + ((KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale C S T).symm + (KaehlerDifferential.D C T (algebraMap S T s))) = D s + rw [KaehlerDifferential.tensorKaehlerEquivOfFormallyEtale_symm_D_algebraMap] + simp + +/-- The formally étale lift is the unique extension of the given derivation. -/ +theorem formallyEtaleDerivationLift_unique + [Algebra.FormallyEtale S T] + (D : Derivation C S U) (E : Derivation C T U) + (hE : ∀ s : S, E (algebraMap S T s) = D s) : + E = formallyEtaleDerivationLift D := by + apply derivation_ext_of_formallyUnramified (S := S) + E (formallyEtaleDerivationLift D) + intro s + rw [hE, formallyEtaleDerivationLift_algebraMap] + +/-- Extend a derivation taking values in the base ring to one taking values +in the formally étale algebra. -/ +noncomputable def formallyEtaleDerivationExtension + [Algebra.FormallyEtale S T] + (D : Derivation C S S) : Derivation C T T := + formallyEtaleDerivationLift ((Algebra.linearMap S T).compDer D) + +@[simp] +theorem formallyEtaleDerivationExtension_algebraMap + [Algebra.FormallyEtale S T] + (D : Derivation C S S) (s : S) : + formallyEtaleDerivationExtension D (algebraMap S T s) = + algebraMap S T (D s) := by + simp [formallyEtaleDerivationExtension] + +omit [IsScalarTower C S U] in +/-- If an ambient derivation preserves the base local ring, then it preserves +every formally étale extension ring inside the ambient algebra. -/ +theorem formallyEtale_derivation_preserves + [Algebra.FormallyEtale S T] + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ D' : Derivation C T T, + (∀ s : S, D' (algebraMap S T s) = algebraMap S T (D s)) ∧ + ∀ t : T, E (algebraMap T U t) = algebraMap T U (D' t) := by + let D' : Derivation C T T := formallyEtaleDerivationExtension D + refine ⟨D', formallyEtaleDerivationExtension_algebraMap D, ?_⟩ + have hDer : E.compAlgebraMap T = + (Algebra.linearMap T U).compDer D' := by + apply derivation_ext_of_formallyUnramified (S := S) + intro s + change E (algebraMap T U (algebraMap S T s)) = + algebraMap T U (D' (algebraMap S T s)) + rw [show D' = formallyEtaleDerivationExtension D from rfl, + formallyEtaleDerivationExtension_algebraMap] + simpa only [IsScalarTower.algebraMap_apply S T U] using hE s + intro t + exact Derivation.congr_fun hDer t + +/-- A finite torsion-free extension of Dedekind domains is formally étale on +the local branch at every unramified prime. -/ +theorem dedekindLocal_formallyEtale_of_isUnramifiedAt + {A B : Type*} [CommRing A] [CommRing B] + [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] + (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] + [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] + [Localization.AtPrime.IsLiesOverAlgebra p Q] + [Algebra.IsUnramifiedAt A Q] : + Algebra.FormallyEtale (Localization.AtPrime p) + (Localization.AtPrime Q) := by + letI : Algebra.FinitePresentation A B := + Algebra.FinitePresentation.of_finiteType.mp inferInstance + letI : Algebra.FormallyEtale A (Localization.AtPrime Q) := + Algebra.IsEtaleAt.of_isUnramifiedAt_of_flat Q + exact Algebra.FormallyEtale.of_restrictScalars + (R := A) (A := Localization.AtPrime p) (B := Localization.AtPrime Q) + +/-- Outside the different ideal, the corresponding map of Dedekind local +rings is formally étale. -/ +theorem dedekindLocal_formallyEtale_of_not_dvd_different + {A B : Type*} [CommRing A] [CommRing B] + [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] + [Algebra.IsSeparable (FractionRing A) (FractionRing B)] + (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] + [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] + [Localization.AtPrime.IsLiesOverAlgebra p Q] + (hQ : ¬ Q ∣ differentIdeal A B) : + Algebra.FormallyEtale (Localization.AtPrime p) + (Localization.AtPrime Q) := by + letI : Algebra.IsUnramifiedAt A Q := + not_dvd_differentIdeal_iff.mp hQ + exact dedekindLocal_formallyEtale_of_isUnramifiedAt p Q + +/-- An ambient derivation preserving the base Dedekind local ring preserves +an unramified local branch of a finite torsion-free Dedekind extension. -/ +theorem dedekindLocal_derivation_preserves_of_isUnramifiedAt + {A B C U : Type*} + [CommRing A] [CommRing B] [CommRing C] [CommRing U] + [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] + (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] + [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] + [Localization.AtPrime.IsLiesOverAlgebra p Q] + [Algebra C (Localization.AtPrime p)] + [Algebra C (Localization.AtPrime Q)] + [Algebra C U] + [Algebra (Localization.AtPrime p) U] + [Algebra (Localization.AtPrime Q) U] + [IsScalarTower C (Localization.AtPrime p) (Localization.AtPrime Q)] + [IsScalarTower C (Localization.AtPrime p) U] + [IsScalarTower C (Localization.AtPrime Q) U] + [IsScalarTower (Localization.AtPrime p) (Localization.AtPrime Q) U] + [Algebra.IsUnramifiedAt A Q] + (D : Derivation C (Localization.AtPrime p) (Localization.AtPrime p)) + (E : Derivation C U U) + (hE : ∀ s : Localization.AtPrime p, + E (algebraMap (Localization.AtPrime p) U s) = + algebraMap (Localization.AtPrime p) U (D s)) : + ∃ D' : Derivation C (Localization.AtPrime Q) (Localization.AtPrime Q), + (∀ s : Localization.AtPrime p, + D' (algebraMap (Localization.AtPrime p) (Localization.AtPrime Q) s) = + algebraMap (Localization.AtPrime p) (Localization.AtPrime Q) (D s)) ∧ + ∀ t : Localization.AtPrime Q, + E (algebraMap (Localization.AtPrime Q) U t) = + algebraMap (Localization.AtPrime Q) U (D' t) := by + letI : Algebra.FormallyEtale (Localization.AtPrime p) + (Localization.AtPrime Q) := + dedekindLocal_formallyEtale_of_isUnramifiedAt p Q + exact formallyEtale_derivation_preserves D E hE + +/-- Away from the different, an ambient derivation preserving the base local +ring preserves the selected extension DVR. This is the direct local +derivation-extension statement used in the Corvaja--Zannier argument. -/ +theorem dedekindLocal_derivation_preserves_of_not_dvd_different + {A B C U : Type*} + [CommRing A] [CommRing B] [CommRing C] [CommRing U] + [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] + [Algebra.IsSeparable (FractionRing A) (FractionRing B)] + (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] + [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] + [Localization.AtPrime.IsLiesOverAlgebra p Q] + [Algebra C (Localization.AtPrime p)] + [Algebra C (Localization.AtPrime Q)] + [Algebra C U] + [Algebra (Localization.AtPrime p) U] + [Algebra (Localization.AtPrime Q) U] + [IsScalarTower C (Localization.AtPrime p) (Localization.AtPrime Q)] + [IsScalarTower C (Localization.AtPrime p) U] + [IsScalarTower C (Localization.AtPrime Q) U] + [IsScalarTower (Localization.AtPrime p) (Localization.AtPrime Q) U] + (hQ : ¬ Q ∣ differentIdeal A B) + (D : Derivation C (Localization.AtPrime p) (Localization.AtPrime p)) + (E : Derivation C U U) + (hE : ∀ s : Localization.AtPrime p, + E (algebraMap (Localization.AtPrime p) U s) = + algebraMap (Localization.AtPrime p) U (D s)) : + ∃ D' : Derivation C (Localization.AtPrime Q) (Localization.AtPrime Q), + (∀ s : Localization.AtPrime p, + D' (algebraMap (Localization.AtPrime p) (Localization.AtPrime Q) s) = + algebraMap (Localization.AtPrime p) (Localization.AtPrime Q) (D s)) ∧ + ∀ t : Localization.AtPrime Q, + E (algebraMap (Localization.AtPrime Q) U t) = + algebraMap (Localization.AtPrime Q) U (D' t) := by + letI : Algebra.FormallyEtale (Localization.AtPrime p) + (Localization.AtPrime Q) := + dedekindLocal_formallyEtale_of_not_dvd_different p Q hQ + exact formallyEtale_derivation_preserves D E hE + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean new file mode 100644 index 0000000000..b10dd36ecc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean @@ -0,0 +1,533 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +import Mathlib.LinearAlgebra.Matrix.Determinant.Basic + +/-! +# Wronskian order estimates at a Dedekind DVR place + +This file proves the determinant-level local estimate directly in a fraction +field equipped with a height-one-place order. It avoids passage to Laurent +series: the only local input is a DVR-preserving derivation which sends a +chosen uniformizer to one. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators +open IsDedekindDomain Multiplicative WithZero + +variable {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + +/-- The order of a finite product is the sum of the orders, including zero +factors via `WithTop`. -/ +theorem finitePlaceOrderTop_finset_prod + {ι : Type*} [DecidableEq ι] (v : HeightOneSpectrum R) + (s : Finset ι) (g : ι → L) : + finitePlaceOrderTop v (∏ i ∈ s, g i) = + ∑ i ∈ s, finitePlaceOrderTop v (g i) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => + simp only [Finset.prod_insert, Finset.sum_insert, ha, not_false_eq_true] + rw [finitePlaceOrderTop_mul, ih] + +/-- If every summand has order at least `b`, then their finite sum also has +order at least `b`. This is the cancellation step in the determinant +estimate. -/ +theorem le_finitePlaceOrderTop_finset_sum_of_forall + {ι : Type*} [DecidableEq ι] (v : HeightOneSpectrum R) + (b : WithTop ℤ) (s : Finset ι) (g : ι → L) + (h : ∀ i ∈ s, b ≤ finitePlaceOrderTop v (g i)) : + b ≤ finitePlaceOrderTop v (∑ i ∈ s, g i) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => + simp only [Finset.sum_insert, ha, not_false_eq_true] + have haBound : b ≤ finitePlaceOrderTop v (g a) := + h a (Finset.mem_insert_self a s) + have hsBound : b ≤ finitePlaceOrderTop v (∑ i ∈ s, g i) := by + apply ih + intro i hi + exact h i (Finset.mem_insert_of_mem hi) + exact (le_min haBound hsBound).trans + (finitePlaceOrderTop_add_ge_min v (g a) (∑ i ∈ s, g i)) + +/-- Multiplication by an integer coefficient cannot decrease finite-place +order. This handles the permutation signs in the Leibniz determinant +formula. -/ +theorem finitePlaceOrderTop_le_intCast_mul + (v : HeightOneSpectrum R) (z : ℤ) (x : L) : + finitePlaceOrderTop v x ≤ finitePlaceOrderTop v ((z : L) * x) := by + rw [finitePlaceOrderTop_mul] + have hz : (0 : WithTop ℤ) ≤ finitePlaceOrderTop v (z : L) := by + simpa using finitePlaceOrderTop_algebraMap_nonnegative + (L := L) v (z : R) + calc + finitePlaceOrderTop v x = 0 + finitePlaceOrderTop v x := by simp + _ ≤ finitePlaceOrderTop v (z : L) + finitePlaceOrderTop v x := + add_le_add hz le_rfl + +private theorem coe_sum_int_finset + {ι : Type*} [DecidableEq ι] (s : Finset ι) (g : ι → ℤ) : + (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] + +private theorem coe_sum_int + {ι : Type*} [Fintype ι] (g : ι → ℤ) : + (((∑ i, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i, ((g i : ℤ) : WithTop ℤ) := by + classical + exact coe_sum_int_finset Finset.univ g + +section DVR + +variable [IsDiscreteValuationRing R] +variable {C : Type*} [Field C] [Algebra C R] [Algebra C L] + [IsScalarTower C R L] + +/-- An indexed ordinary-derivation Wronskian over the fraction field. The +function `ε` records the derivative order assigned to each row. -/ +def indexedDedekindLocalWronskian + {ι : Type*} [Fintype ι] (D : Derivation C L L) + (ε : ι → ℕ) (f : ι → L) : Matrix ι ι L := + fun i j ↦ ((D : L → L)^[ε i]) (f j) + +/-- Apply a constant scalar matrix to the columns of an indexed fraction-field +family. -/ +def indexedDedekindLocalColumnCombination + {ι : Type*} [Fintype ι] (f : ι → L) (A : Matrix ι ι C) : ι → L := + fun j ↦ ∑ i, A i j • f i + +private theorem derivation_iterate_sum_smul + {ι : Type*} [Fintype ι] (D : Derivation C L L) + (r : ℕ) (a : ι → C) (f : ι → L) : + ((D : L → L)^[r]) (∑ i, a i • f i) = + ∑ i, a i • ((D : L → L)^[r]) (f i) := by + induction r with + | zero => simp + | succ r ih => + simp_rw [Function.iterate_succ_apply'] + rw [ih, map_sum] + simp + +/-- Constant column operations commute with the indexed DVR Wronskian. -/ +theorem indexedDedekindLocalWronskian_columnCombination + {ι : Type*} [Fintype ι] [DecidableEq ι] + (D : Derivation C L L) (ε : ι → ℕ) (f : ι → L) + (A : Matrix ι ι C) : + indexedDedekindLocalWronskian D ε + (indexedDedekindLocalColumnCombination f A) = + indexedDedekindLocalWronskian D ε f * + A.map (algebraMap C L) := by + apply Matrix.ext + intro i j + rw [Matrix.mul_apply] + simp only [indexedDedekindLocalWronskian, + indexedDedekindLocalColumnCombination, Matrix.map_apply] + rw [derivation_iterate_sum_smul] + simp only [Algebra.smul_def] + apply Finset.sum_congr rfl + intro k _ + exact mul_comm _ _ + +/-- A determinant-one constant column operation preserves the indexed DVR +Wronskian determinant. -/ +theorem indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + (D : Derivation C L L) (ε : ι → ℕ) (f : ι → L) + (A : Matrix ι ι C) (hA : A.det = 1) : + (indexedDedekindLocalWronskian D ε + (indexedDedekindLocalColumnCombination f A)).det = + (indexedDedekindLocalWronskian D ε f).det := by + rw [indexedDedekindLocalWronskian_columnCombination, Matrix.det_mul] + have hdetmap : (A.map (algebraMap C L)).det = 1 := by + calc + (A.map (algebraMap C L)).det = algebraMap C L A.det := by + simpa using ((algebraMap C L).map_det A).symm + _ = 1 := by rw [hA, map_one] + rw [hdetmap, mul_one] + +omit [IsDedekindDomain R] [IsFractionRing R L] [IsDiscreteValuationRing R] + [Algebra C R] [IsScalarTower C R L] in +private theorem derivation_iterate_algebraMap_exists + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (m : ℕ) (r : R) : + ∃ s : R, ((D : L → L)^[m]) (algebraMap R L r) = algebraMap R L s := by + induction m with + | zero => exact ⟨r, rfl⟩ + | succ m ih => + rw [Function.iterate_succ_apply'] + obtain ⟨s, hs⟩ := ih + rw [hs] + exact hDIntegral s + +omit [Algebra C R] [IsScalarTower C R L] in +/-- For any DVR-preserving derivation, the indexed Wronskian determinant has +order at least the sum of its column orders minus the sum of its row +derivative orders. Cancellation in the determinant expansion is included. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (ε : ι → ℕ) (f : ι → L) : + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v (indexedDedekindLocalWronskian D ε f).det := by + rw [Matrix.det_apply'] + apply le_finitePlaceOrderTop_finset_sum_of_forall + intro σ _ + let term : L := + ((Equiv.Perm.sign σ : ℤ) : L) * + ∏ i, indexedDedekindLocalWronskian D ε f (σ i) i + change + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v term + calc + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) = + ∑ j, (finitePlaceOrderTop v (f j) + + ((-(ε (σ j) : ℤ) : ℤ) : WithTop ℤ)) := by + rw [Finset.sum_add_distrib] + congr 1 + rw [← coe_sum_int] + congr 1 + rw [Finset.sum_neg_distrib] + congr 1 + exact (Equiv.sum_comp σ (fun i ↦ (ε i : ℤ))).symm + _ ≤ ∑ j, finitePlaceOrderTop v + (((D : L → L)^[ε (σ j)]) (f j)) := by + gcongr with j + exact finitePlaceOrderTop_derivation_iterate_ge_sub_nat_of_preserves + v π hπ hπIdeal D hDIntegral (ε (σ j)) (f j) + _ = finitePlaceOrderTop v + (∏ i, indexedDedekindLocalWronskian D ε f (σ i) i) := by + rw [finitePlaceOrderTop_finset_prod] + rfl + _ ≤ finitePlaceOrderTop v term := by + exact finitePlaceOrderTop_le_intCast_mul v + (Equiv.Perm.sign σ : ℤ) + (∏ i, indexedDedekindLocalWronskian D ε f (σ i) i) + +omit [Algebra C R] [IsScalarTower C R L] in +/-- The normalized-uniformizer form retained for compatibility with the +existing local-parameter API. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (_hDπ : D (algebraMap R L π) = 1) + (ε : ι → ℕ) (f : ι → L) : + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v (indexedDedekindLocalWronskian D ε f).det := + finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + v π hπ hπIdeal D hDIntegral ε f + +omit [IsDiscreteValuationRing R] [Algebra C R] [IsScalarTower C R L] in +/-- If every column is represented by an element of the DVR and the +derivation preserves the DVR, then the indexed Wronskian determinant is +regular. This is the direct DVR analogue of the regular local auxiliary +case. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_nonnegative_of_integral + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (ε : ι → ℕ) (f : ι → L) + (hfIntegral : ∀ j, ∃ r : R, f j = algebraMap R L r) : + (0 : WithTop ℤ) ≤ + finitePlaceOrderTop v (indexedDedekindLocalWronskian D ε f).det := by + rw [Matrix.det_apply'] + apply le_finitePlaceOrderTop_finset_sum_of_forall + intro σ _ + let term : L := + ((Equiv.Perm.sign σ : ℤ) : L) * + ∏ i, indexedDedekindLocalWronskian D ε f (σ i) i + change (0 : WithTop ℤ) ≤ finitePlaceOrderTop v term + calc + (0 : WithTop ℤ) = ∑ _i : ι, (0 : WithTop ℤ) := by simp + _ ≤ ∑ i, finitePlaceOrderTop v + (indexedDedekindLocalWronskian D ε f (σ i) i) := by + gcongr with i + obtain ⟨r, hr⟩ := hfIntegral i + obtain ⟨s, hs⟩ := derivation_iterate_algebraMap_exists + D hDIntegral (ε (σ i)) r + have hentry : indexedDedekindLocalWronskian D ε f (σ i) i = + algebraMap R L s := by + simp only [indexedDedekindLocalWronskian, hr, hs] + rw [hentry] + exact finitePlaceOrderTop_algebraMap_nonnegative (L := L) v s + _ = finitePlaceOrderTop v + (∏ i, indexedDedekindLocalWronskian D ε f (σ i) i) := by + rw [finitePlaceOrderTop_finset_prod] + _ ≤ finitePlaceOrderTop v term := by + exact finitePlaceOrderTop_le_intCast_mul v + (Equiv.Perm.sign σ : ℤ) + (∏ i, indexedDedekindLocalWronskian D ε f (σ i) i) + +omit [Algebra C R] [IsScalarTower C R L] in +/-- The indexed determinant estimate after a determinant-one constant column +operation, assuming only that the derivation preserves the DVR. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_after_columnCombination_of_preserves + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (ε : ι → ℕ) (f : ι → L) (A : Matrix ι ι C) (hA : A.det = 1) : + (∑ j, finitePlaceOrderTop v + (indexedDedekindLocalColumnCombination f A j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v (indexedDedekindLocalWronskian D ε f).det := by + rw [← indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D ε f A hA] + exact finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + v π hπ hπIdeal D hDIntegral ε + (indexedDedekindLocalColumnCombination f A) + +omit [Algebra C R] [IsScalarTower C R L] in +/-- The indexed determinant estimate after a determinant-one constant column +operation. This normalized form is retained for the local-parameter API. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_after_columnCombination + {ι : Type*} [Fintype ι] [DecidableEq ι] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (hDπ : D (algebraMap R L π) = 1) + (ε : ι → ℕ) (f : ι → L) (A : Matrix ι ι C) (hA : A.det = 1) : + (∑ j, finitePlaceOrderTop v + (indexedDedekindLocalColumnCombination f A j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v (indexedDedekindLocalWronskian D ε f).det := by + rw [← indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D ε f A hA] + exact finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound + v π hπ hπIdeal D hDIntegral hDπ ε + (indexedDedekindLocalColumnCombination f A) + +/-- Change of parameter for an indexed ordinary Wronskian whose derivative +orders are `0, ..., n - 1`, transported along an explicit equivalence. -/ +theorem indexedDedekindLocalWronskian_det_changeParameter + {ι : Type*} [Fintype ι] [DecidableEq ι] + {n : ℕ} (e : ι ≃ Fin n) (ε : ι → ℕ) + (hε : ∀ i, ε i = (e i : ℕ)) + (D E : Derivation C L L) (a : L) (hD : D = a • E) + (f : ι → L) : + (indexedDedekindLocalWronskian D ε f).det = + a ^ n.choose 2 * (indexedDedekindLocalWronskian E ε f).det := by + let g : Fin n → L := fun j ↦ f (e.symm j) + have hreindexD : Matrix.reindex e e + (indexedDedekindLocalWronskian D ε f) = + BGS.Algebra.derivationWronskian D g := by + ext i j + change ((D : L → L)^[ε (e.symm i)]) (f (e.symm j)) = + (D.toLinearMap ^ (i : ℕ)) (f (e.symm j)) + rw [hε] + simp only [e.apply_symm_apply] + induction i.1 with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply', pow_succ', Module.End.mul_apply, ih] + rfl + have hreindexE : Matrix.reindex e e + (indexedDedekindLocalWronskian E ε f) = + BGS.Algebra.derivationWronskian E g := by + ext i j + change ((E : L → L)^[ε (e.symm i)]) (f (e.symm j)) = + (E.toLinearMap ^ (i : ℕ)) (f (e.symm j)) + rw [hε] + simp only [e.apply_symm_apply] + induction i.1 with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply', pow_succ', Module.End.mul_apply, ih] + rfl + calc + (indexedDedekindLocalWronskian D ε f).det = + (Matrix.reindex e e + (indexedDedekindLocalWronskian D ε f)).det := by + rw [Matrix.det_reindex_self] + _ = (BGS.Algebra.derivationWronskian D g).det := by rw [hreindexD] + _ = a ^ n.choose 2 * + (BGS.Algebra.derivationWronskian E g).det := + derivationWronskian_det_changeParameter D E a hD g + _ = a ^ n.choose 2 * + (Matrix.reindex e e + (indexedDedekindLocalWronskian E ε f)).det := by rw [hreindexE] + _ = a ^ n.choose 2 * + (indexedDedekindLocalWronskian E ε f).det := by + rw [Matrix.det_reindex_self] + +omit [Algebra C R] [IsScalarTower C R L] in +/-- Indexed scaled-derivation estimate. The equivalence certifies that the +row orders are precisely the ordinary derivative orders, so the scalar costs +the expected triangular exponent. -/ +theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_scaled_preserves + {ι : Type*} [Fintype ι] [DecidableEq ι] + {n : ℕ} (e : ι ≃ Fin n) (ε : ι → ℕ) + (hε : ∀ i, ε i = (e i : ℕ)) + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) (c : L) + (hScaledIntegral : ∀ r : R, ∃ s : R, + (c • D) (algebraMap R L r) = algebraMap R L s) + (f : ι → L) : + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • finitePlaceOrderTop v c + + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D ε f).det := by + calc + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(∑ i, (ε i : ℤ)) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian (c • D) ε f).det := + finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + v π hπ hπIdeal (c • D) hScaledIntegral ε f + _ = finitePlaceOrderTop v + (c ^ n.choose 2 * + (indexedDedekindLocalWronskian D ε f).det) := by + rw [indexedDedekindLocalWronskian_det_changeParameter + e ε hε (c • D) D c rfl f] + _ = n.choose 2 • finitePlaceOrderTop v c + + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D ε f).det := by + rw [finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] + +/-- The ordinary `n × n` Wronskian, with derivative orders +`0, ..., n - 1`. -/ +def dedekindLocalWronskian {n : ℕ} + (D : Derivation C L L) (f : Fin n → L) : Matrix (Fin n) (Fin n) L := + indexedDedekindLocalWronskian D (fun i ↦ i.1) f + +/-- The direct Dedekind-local Wronskian is definitionally the ordinary +derivation Wronskian used by the change-of-parameter theorem. -/ +theorem dedekindLocalWronskian_eq_derivationWronskian + (D : Derivation C L L) {n : ℕ} (f : Fin n → L) : + dedekindLocalWronskian D f = BGS.Algebra.derivationWronskian D f := by + ext i j + change ((D : L → L)^[i.1]) (f j) = (D.toLinearMap ^ i.1) (f j) + induction i.1 with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply', pow_succ', Module.End.mul_apply, ih] + rfl + +/-- Change of parameter for the direct Dedekind-local Wronskian. In +particular this permits replacing a global derivation by a DVR-preserving +scalar multiple while recording the exact triangular valuation cost. -/ +theorem dedekindLocalWronskian_det_changeParameter + (D E : Derivation C L L) (a : L) (hD : D = a • E) + {n : ℕ} (f : Fin n → L) : + (dedekindLocalWronskian D f).det = + a ^ n.choose 2 * (dedekindLocalWronskian E f).det := by + rw [dedekindLocalWronskian_eq_derivationWronskian, + dedekindLocalWronskian_eq_derivationWronskian] + exact derivationWronskian_det_changeParameter D E a hD f + +omit [Algebra C R] [IsScalarTower C R L] in +/-- For a DVR-preserving derivation, the ordinary Wronskian loses at most the +triangular number `n * (n - 1) / 2` from the sum of its column orders. -/ +theorem finitePlaceOrderTop_dedekindLocalWronskian_det_lower_bound_of_preserves + {n : ℕ} + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (f : Fin n → L) : + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(n * (n - 1) / 2 : ℕ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v (dedekindLocalWronskian D f).det := by + convert finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_preserves + v π hπ hπIdeal D hDIntegral (fun i : Fin n => i.1) f using 1 + · congr 2 + apply congrArg Neg.neg + rw [Fin.sum_univ_eq_sum_range, ← Nat.cast_sum] + exact congrArg (fun x : ℕ => (x : ℤ)) (Finset.sum_range_id n).symm + · rfl + +omit [Algebra C R] [IsScalarTower C R L] in +/-- A scalar multiple of the ambient derivation may be used to obtain a +DVR-preserving local derivation. The right side records exactly the order of +the scalar to the Wronskian triangular exponent; no false formula for +iterates of `c • D` is used. -/ +theorem finitePlaceOrderTop_dedekindLocalWronskian_det_lower_bound_of_scaled_preserves + {n : ℕ} + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) (c : L) + (hScaledIntegral : ∀ r : R, ∃ s : R, + (c • D) (algebraMap R L r) = algebraMap R L s) + (f : Fin n → L) : + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(n * (n - 1) / 2 : ℕ) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • finitePlaceOrderTop v c + + finitePlaceOrderTop v (dedekindLocalWronskian D f).det := by + calc + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(n * (n - 1) / 2 : ℕ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (dedekindLocalWronskian (c • D) f).det := + finitePlaceOrderTop_dedekindLocalWronskian_det_lower_bound_of_preserves + v π hπ hπIdeal (c • D) hScaledIntegral f + _ = finitePlaceOrderTop v + (c ^ n.choose 2 * (dedekindLocalWronskian D f).det) := by + rw [dedekindLocalWronskian_det_changeParameter (c • D) D c rfl f] + _ = n.choose 2 • finitePlaceOrderTop v c + + finitePlaceOrderTop v (dedekindLocalWronskian D f).det := by + rw [finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] + +omit [Algebra C R] [IsScalarTower C R L] in +/-- The ordinary Wronskian loses at most the triangular number +`n * (n - 1) / 2` from the sum of its column orders. This normalized form is +retained for the local-parameter API. -/ +theorem finitePlaceOrderTop_dedekindLocalWronskian_det_lower_bound + {n : ℕ} + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (hDπ : D (algebraMap R L π) = 1) + (f : Fin n → L) : + (∑ j, finitePlaceOrderTop v (f j)) + + ((-(n * (n - 1) / 2 : ℕ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v (dedekindLocalWronskian D f).det := by + convert finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound + v π hπ hπIdeal D hDIntegral hDπ (fun i : Fin n ↦ i.1) f using 1 + · congr 2 + apply congrArg Neg.neg + rw [Fin.sum_univ_eq_sum_range, ← Nat.cast_sum] + exact congrArg (fun x : ℕ ↦ (x : ℤ)) (Finset.sum_range_id n).symm + · rfl + +end DVR + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean new file mode 100644 index 0000000000..8a3793874b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.Derivation.Basic +import Mathlib.RingTheory.Localization.Basic +import Mathlib.RingTheory.Localization.FractionRing +import Mathlib.Tactic + +/-! +# Derivations preserving localizations + +An ambient derivation that maps a domain into itself also maps every prime +localization into itself. The statement deliberately does not require an +algebra structure from the derivation's constant ring to the localized ring; +that structure need not exist in the Frobenius-constant application. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- An ambient derivation which preserves a domain also preserves each of its +localizations at a prime. This is the quotient-rule bridge from a global +different-annihilator certificate to the local DVR Wronskian bounds. -/ +theorem ambientDerivation_preserves_localizationAtPrime_of_preserves + {C R U : Type*} [CommRing C] [CommRing R] [IsDomain R] [Field U] + [Algebra C U] [Algebra R U] [IsFractionRing R U] + (q : Ideal R) [q.IsPrime] + [Algebra (Localization.AtPrime q) U] + [IsScalarTower R (Localization.AtPrime q) U] + (E : Derivation C U U) + (hE : ∀ r : R, ∃ r' : R, + E (algebraMap R U r) = algebraMap R U r') : + ∀ z : Localization.AtPrime q, ∃ z' : Localization.AtPrime q, + E (algebraMap (Localization.AtPrime q) U z) = + algebraMap (Localization.AtPrime q) U z' := by + intro z + obtain ⟨⟨a, d, hd⟩, hzd⟩ := IsLocalization.surj q.primeCompl z + obtain ⟨a', ha'⟩ := hE a + obtain ⟨d', hd'⟩ := hE d + let dSub : q.primeCompl := ⟨d, hd⟩ + let invD : Localization.AtPrime q := + IsLocalization.mk' (Localization.AtPrime q) 1 dSub + let z' : Localization.AtPrime q := + (algebraMap R (Localization.AtPrime q) a' - + z * algebraMap R (Localization.AtPrime q) d') * invD + have hd0 : d ≠ 0 := by + intro hdZero + exact hd (hdZero ▸ q.zero_mem) + have hdU : algebraMap R U d ≠ 0 := by + simpa using (IsFractionRing.injective R U).ne hd0 + have hzdU : + algebraMap (Localization.AtPrime q) U z * algebraMap R U d = + algebraMap R U a := by + calc + algebraMap (Localization.AtPrime q) U z * algebraMap R U d = + algebraMap (Localization.AtPrime q) U z * + algebraMap (Localization.AtPrime q) U + (algebraMap R (Localization.AtPrime q) d) := by + rw [IsScalarTower.algebraMap_apply R + (Localization.AtPrime q) U d] + _ = algebraMap (Localization.AtPrime q) U + (z * algebraMap R (Localization.AtPrime q) d) := by + rw [map_mul] + _ = algebraMap (Localization.AtPrime q) U + (algebraMap R (Localization.AtPrime q) a) := by rw [hzd] + _ = algebraMap R U a := + (IsScalarTower.algebraMap_apply R (Localization.AtPrime q) U a).symm + have hder := congrArg (fun x : U => E x) hzdU + rw [E.leibniz, ha', hd'] at hder + have hder' : + E (algebraMap (Localization.AtPrime q) U z) * algebraMap R U d + + algebraMap (Localization.AtPrime q) U z * algebraMap R U d' = + algebraMap R U a' := by + simp only [Algebra.smul_def, Algebra.algebraMap_self_apply] at hder + linear_combination hder + have hinv : + algebraMap (Localization.AtPrime q) U invD * algebraMap R U d = 1 := by + have hspec := IsLocalization.mk'_spec + (Localization.AtPrime q) (1 : R) dSub + calc + algebraMap (Localization.AtPrime q) U invD * algebraMap R U d = + algebraMap (Localization.AtPrime q) U invD * + algebraMap (Localization.AtPrime q) U + (algebraMap R (Localization.AtPrime q) d) := by + rw [IsScalarTower.algebraMap_apply R + (Localization.AtPrime q) U d] + _ = algebraMap (Localization.AtPrime q) U + (invD * algebraMap R (Localization.AtPrime q) d) := by rw [map_mul] + _ = algebraMap (Localization.AtPrime q) U + (algebraMap R (Localization.AtPrime q) 1) := by + rw [show invD * algebraMap R (Localization.AtPrime q) d = + algebraMap R (Localization.AtPrime q) 1 by + simpa [invD, dSub] using hspec] + _ = 1 := by simp + refine ⟨z', ?_⟩ + apply mul_right_cancel₀ hdU + calc + E (algebraMap (Localization.AtPrime q) U z) * algebraMap R U d = + algebraMap R U a' - + algebraMap (Localization.AtPrime q) U z * algebraMap R U d' := + eq_sub_of_add_eq hder' + _ = algebraMap (Localization.AtPrime q) U z' * algebraMap R U d := by + simp only [z', map_mul, map_sub] + rw [← IsScalarTower.algebraMap_apply R (Localization.AtPrime q) U a', + ← IsScalarTower.algebraMap_apply R (Localization.AtPrime q) U d'] + rw [mul_assoc, hinv, mul_one] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean new file mode 100644 index 0000000000..699be2d3c0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing +import Mathlib.Tactic + +/-! +# Compatibility of global and localized Dedekind orders + +The height-one valuation of a Dedekind domain and the maximal-ideal +valuation of its localization at that height-one prime have the same +normalization. This file proves equality, rather than equivalence up to an +unspecified rescaling, and transfers the associated principal-ideal orders. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- Equivalent surjective valuations with value group `ℤᵐ⁰` have the same +normalization. Surjectivity rules out a nontrivial integral rescaling. -/ +theorem valuation_eq_of_isEquiv_of_surjective + {F : Type*} [Field F] + {v w : Valuation F ℤᵐ⁰} + (h : v.IsEquiv w) + (hv : Function.Surjective v) + (hw : Function.Surjective w) : + v = w := by + ext x + by_cases hx : x = 0 + · simp [hx] + obtain ⟨π, hπv⟩ := hv (exp (-1 : ℤ)) + obtain ⟨ρ, hρw⟩ := hw (exp (-1 : ℤ)) + have hπw0 : w π ≠ 0 := by + intro hzero + have : v π = 0 := h.eq_zero.mpr hzero + rw [hπv] at this + exact exp_ne_zero this + have hρv0 : v ρ ≠ 0 := by + intro hzero + have : w ρ = 0 := h.eq_zero.mp hzero + rw [hρw] at this + exact exp_ne_zero this + let a : ℤ := log (w π) + let b : ℤ := log (v ρ) + have hπw : w π = exp a := by + simpa [a] using (exp_log hπw0).symm + have hρv : v ρ = exp b := by + simpa [b] using (exp_log hρv0).symm + have ha : a < 0 := by + rw [← exp_lt_exp, ← hπw] + have hvlt : v π < v 1 := by + rw [hπv, map_one] + simpa using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) + simpa using h.lt_iff_lt.mp hvlt + have hb : b < 0 := by + rw [← exp_lt_exp, ← hρv] + have hwlt : w ρ < w 1 := by + rw [hρw, map_one] + simpa using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) + simpa using h.lt_iff_lt.mpr hwlt + have hwEq : w π = w (ρ ^ (-a)) := by + rw [hπw, map_zpow₀, hρw, ← exp_zsmul] + congr 1 + simp + have hvEq : v π = v (ρ ^ (-a)) := h.eq_iff.mpr hwEq + have hab : (-a) * b = -1 := by + rw [hπv, map_zpow₀, hρv, ← exp_zsmul] at hvEq + apply exp_injective + simpa [mul_comm] using hvEq.symm + have ha1 : a = -1 := by nlinarith + have hπw1 : w π = exp (-1 : ℤ) := by simpa [ha1] using hπw + have hwx0 : w x ≠ 0 := by simpa using hx + let n : ℤ := log (w x) + have hwx : w x = exp n := by + simpa [n] using (exp_log hwx0).symm + have hwPow : w x = w (π ^ (-n)) := by + rw [hwx, map_zpow₀, hπw1, ← exp_zsmul] + congr 1 + simp + have hvPow : v x = v (π ^ (-n)) := h.eq_iff.mpr hwPow + rw [map_zpow₀, hπv, ← exp_zsmul] at hvPow + calc + v x = exp n := by simpa using hvPow + _ = w x := hwx.symm + +section FractionRingEquiv + +variable {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + +/-- The canonical equivalence from the chosen fraction-ring model preserves +every normalized height-one valuation. -/ +theorem fractionRingAlgEquiv_valuation + (q : HeightOneSpectrum R) (x : FractionRing R) : + q.valuation L (FractionRing.algEquiv R L x) = + q.valuation (FractionRing R) x := by + obtain ⟨a, b, hb, rfl⟩ := IsFractionRing.div_surjective R x + rw [map_div₀, (FractionRing.algEquiv R L).commutes a, + (FractionRing.algEquiv R L).commutes b, + Valuation.map_div, Valuation.map_div, + q.valuation_of_algebraMap, q.valuation_of_algebraMap, + q.valuation_of_algebraMap, q.valuation_of_algebraMap] + +/-- The canonical fraction-ring equivalence preserves the additive order at +every height-one prime, including Mathlib's zero-order convention. -/ +theorem fractionRingAlgEquiv_finitePlaceOrder_eq + (q : HeightOneSpectrum R) (x : FractionRing R) : + finitePlaceOrder q (FractionRing.algEquiv R L x) = + finitePlaceOrder q x := by + by_cases hx : x = 0 + · subst x + simp only [map_zero, finitePlaceOrder, + FractionalIdeal.spanSingleton_zero, FractionalIdeal.count_zero] + · have hmap : FractionRing.algEquiv R L x ≠ 0 := by simpa using hx + have hactual := valuation_eq_exp_neg_finitePlaceOrder + q (FractionRing.algEquiv R L x) hmap + have hcanonical := valuation_eq_exp_neg_finitePlaceOrder q x hx + rw [fractionRingAlgEquiv_valuation q x, hcanonical] at hactual + exact neg_injective (exp_injective hactual.symm) + +end FractionRingEquiv + +variable {R S L : Type*} + [CommRing R] [IsDedekindDomain R] + [CommRing S] [IsDomain S] [IsDiscreteValuationRing S] + [Field L] + [Algebra R S] [Algebra R L] [Algebra S L] + [IsScalarTower R S L] + [IsFractionRing R L] + [IsFractionRing S L] + +/-- The normalized valuation of the maximal ideal of `R_q` is the normalized +height-one valuation attached to `q`. -/ +theorem localizationAtPrime_valuation_eq + (q : HeightOneSpectrum R) + [IsLocalization q.asIdeal.primeCompl S] : + (IsDiscreteValuationRing.maximalIdeal S).valuation L = q.valuation L := by + apply valuation_eq_of_isEquiv_of_surjective + · rw [Valuation.isEquiv_iff_val_le_one] + intro x + constructor + · intro hlocal + obtain ⟨s, hs⟩ := IsDiscreteValuationRing.exists_lift_of_le_one hlocal + obtain ⟨⟨a, d, hd⟩, had⟩ := IsLocalization.surj q.asIdeal.primeCompl s + have hdOne : q.valuation L (algebraMap R L d) = 1 := by + rw [HeightOneSpectrum.valuation_eq_one_iff_notMem] + exact hd + have hEq : + algebraMap S L s * algebraMap R L d = algebraMap R L a := by + calc + algebraMap S L s * algebraMap R L d = + algebraMap S L (s * algebraMap R S d) := by + rw [map_mul, IsScalarTower.algebraMap_apply R S L] + _ = algebraMap S L (algebraMap R S a) := by + exact congrArg (algebraMap S L) (by simpa using had) + _ = algebraMap R L a := + (IsScalarTower.algebraMap_apply R S L a).symm + have hValEq := congrArg (q.valuation L) hEq + rw [map_mul, hdOne, mul_one] at hValEq + rw [← hs, hValEq] + exact HeightOneSpectrum.valuation_le_one (K := L) q a + · intro hglobal + obtain ⟨a, d, had⟩ := + HeightOneSpectrum.exists_primeCompl_mul_eq_of_integer q x hglobal + let s : S := IsLocalization.mk' S a d + have hs : algebraMap S L s = x := by + have hdR : (d : R) ≠ 0 := by + intro hd0 + exact d.2 (hd0 ▸ q.asIdeal.zero_mem) + have hdL : algebraMap R L (d : R) ≠ 0 := by + simpa only [map_zero] using (IsFractionRing.injective R L).ne hdR + apply (mul_right_cancel₀ hdL) + calc + algebraMap S L s * algebraMap R L (d : R) = + algebraMap S L (s * algebraMap R S (d : R)) := by + rw [map_mul, IsScalarTower.algebraMap_apply R S L] + _ = algebraMap R L a := by + dsimp [s] + rw [IsLocalization.mk'_spec, + IsScalarTower.algebraMap_apply R S L] + _ = x * algebraMap R L (d : R) := had.symm + rw [← hs] + exact HeightOneSpectrum.valuation_le_one + (K := L) (IsDiscreteValuationRing.maximalIdeal S) s + · exact (IsDiscreteValuationRing.maximalIdeal S).valuation_surjective L + · exact q.valuation_surjective L + +/-- Principal-ideal orders computed globally and in the localized DVR agree. -/ +theorem localizationAtPrime_finitePlaceOrder_eq + (q : HeightOneSpectrum R) + [IsLocalization q.asIdeal.primeCompl S] + (x : L) : + finitePlaceOrder (IsDiscreteValuationRing.maximalIdeal S) x = + finitePlaceOrder q x := by + by_cases hx : x = 0 + · subst x + simp only [finitePlaceOrder, FractionalIdeal.spanSingleton_zero, + FractionalIdeal.count_zero] + · have hlocal := valuation_eq_exp_neg_finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal S) x hx + have hglobal := valuation_eq_exp_neg_finitePlaceOrder q x hx + rw [localizationAtPrime_valuation_eq q, hglobal] at hlocal + exact neg_injective (exp_injective hlocal.symm) + +/-- `WithTop`-valued orders computed globally and in the localized DVR agree, +including the zero element. -/ +theorem localizationAtPrime_finitePlaceOrderTop_eq + (q : HeightOneSpectrum R) + [IsLocalization q.asIdeal.primeCompl S] + (x : L) : + finitePlaceOrderTop (IsDiscreteValuationRing.maximalIdeal S) x = + finitePlaceOrderTop q x := by + by_cases hx : x = 0 + · simp [hx] + · rw [finitePlaceOrderTop_eq_coe _ _ hx, + finitePlaceOrderTop_eq_coe _ _ hx, + localizationAtPrime_finitePlaceOrder_eq q x] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean new file mode 100644 index 0000000000..3c0276db61 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean @@ -0,0 +1,589 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +import Mathlib.FieldTheory.Perfect + +/-! +# Corvaja--Zannier case (i) over a perfect residue field + +The usual leading-coefficient cancellation in local case (i) does not require +the global constant field to surject onto the residue field. In +characteristic `p`, it is enough that the residue field is perfect. Given the +ratio of two unit leading coefficients, choose its `p`-th root in the residue +field, lift that root to the DVR, and use the `p`-th power of the lift. This +coefficient is regular and belongs to the Frobenius subfield of the fraction +field, hence is killed by the separating derivation. + +This file packages that argument and then repeats the determinant-one +elimination from `DedekindAuxiliaryCaseI` with coefficients in the Frobenius +subfield. No algebra structure from the whole Frobenius subfield to the DVR +is asserted: such a structure would be false at a nontrivial place. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators +open IsDedekindDomain Multiplicative WithZero + +variable {R L : Type*} [CommRing R] [IsDedekindDomain R] + [IsDiscreteValuationRing R] [Field L] [Algebra R L] + [IsFractionRing R L] + {p : ℕ} [Fact p.Prime] [CharP R p] [CharP L p] + +omit [IsDiscreteValuationRing R] [IsFractionRing R L] in +/-- Over a perfect residue field, the ratio of two unit leading coefficients +can be cancelled by a regular element whose image in the fraction field is a +`p`-th power. + +The extra witness `b : R` records regularity of the coefficient; its image in +`L` is the coefficient represented by `c : L^p`. -/ +theorem exists_frobeniusSubfield_regular_unit_sub_mul_mem_of_perfect_residue + (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (u w : Rˣ) : + ∃ (c : frobeniusSubfield L p) (b : R), + algebraMap (frobeniusSubfield L p) L c = algebraMap R L b ∧ + (u : R) - b * (w : R) ∈ v.asIdeal := by + let κ := v.asIdeal.ResidueField + letI : CharP κ p := + CharP.of_ringHom_of_ne_zero (algebraMap R κ) p + (Fact.out : p.Prime).ne_zero + letI : ExpChar κ p := inferInstance + let ratio : κ := algebraMap R κ (((u * w⁻¹ : Rˣ) : R)) + obtain ⟨z, hz⟩ := surjective_frobenius κ p ratio + obtain ⟨a, ha⟩ := v.asIdeal.algebraMap_residueField_surjective z + let b : R := a ^ p + have hbMap : algebraMap R κ b = ratio := by + rw [show algebraMap R κ b = (algebraMap R κ a) ^ p by + simp [b]] + rw [ha] + simpa [frobenius_def] using hz + have hbCancel : (u : R) - b * (w : R) ∈ v.asIdeal := by + rw [← Ideal.algebraMap_residueField_eq_zero] + rw [map_sub, map_mul, hbMap] + dsimp [ratio] + rw [← map_mul] + simp + change algebraMap R κ (u : R) - algebraMap R κ (u : R) = 0 + exact sub_self _ + have hbFrob : algebraMap R L b ∈ frobeniusSubfield L p := by + refine ⟨algebraMap R L a, ?_⟩ + simp [frobenius_def, b] + let c : frobeniusSubfield L p := ⟨algebraMap R L b, hbFrob⟩ + refine ⟨c, b, ?_, hbCancel⟩ + rfl + +/-- Equal-order nonzero functions admit a strict leading-term cancellation +with a coefficient in the Frobenius subfield whenever the residue field is +perfect. -/ +theorem exists_frobeniusSubfield_finitePlaceOrder_sub_mul_eq_zero_or_lt_of_perfect_residue + (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) + (horder : finitePlaceOrder v x = finitePlaceOrder v y) : + ∃ c : frobeniusSubfield L p, + x - algebraMap (frobeniusSubfield L p) L c * y = 0 ∨ + finitePlaceOrder v x < finitePlaceOrder v + (x - algebraMap (frobeniusSubfield L p) L c * y) := by + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : v.asIdeal = Ideal.span {π} := by + calc + v.asIdeal = IsLocalRing.maximalIdeal R := + IsLocalRing.eq_maximalIdeal v.isMaximal + _ = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + obtain ⟨nx, ux, hxrepr⟩ := + IsDiscreteValuationRing.exists_units_eq_smul_zpow_of_irreducible + (K := L) hπ hx + obtain ⟨ny, uy, hyrepr⟩ := + IsDiscreteValuationRing.exists_units_eq_smul_zpow_of_irreducible + (K := L) hπ hy + have hxrepr' : + x = algebraMap R L (ux : R) * (algebraMap R L π) ^ nx := by + simpa [Units.smul_def, Algebra.smul_def] using hxrepr + have hyrepr' : + y = algebraMap R L (uy : R) * (algebraMap R L π) ^ ny := by + simpa [Units.smul_def, Algebra.smul_def] using hyrepr + have hxOrder : finitePlaceOrder v x = nx := by + rw [hxrepr'] + exact finitePlaceOrder_unit_mul_uniformizer_zpow + v π hπ hπIdeal ux nx + have hyOrder : finitePlaceOrder v y = ny := by + rw [hyrepr'] + exact finitePlaceOrder_unit_mul_uniformizer_zpow + v π hπ hπIdeal uy ny + have hnxny : nx = ny := by omega + rw [← hnxny] at hyrepr' + obtain ⟨c, b, hc, hb⟩ := + exists_frobeniusSubfield_regular_unit_sub_mul_mem_of_perfect_residue + (L := L) (p := p) v ux uy + let a : R := (ux : R) - b * (uy : R) + have haMem : a ∈ v.asIdeal := by simpa [a] using hb + have hfactor : + x - algebraMap (frobeniusSubfield L p) L c * y = + algebraMap R L a * (algebraMap R L π) ^ nx := by + rw [hxrepr', hyrepr', hc] + simp only [a, map_sub, map_mul] + ring + by_cases ha : a = 0 + · refine ⟨c, Or.inl ?_⟩ + rw [hfactor, ha, map_zero, zero_mul] + · refine ⟨c, Or.inr ?_⟩ + have haMap : algebraMap R L a ≠ 0 := by + intro hzero + apply ha + exact IsFractionRing.injective R L (by simpa using hzero) + have hπMap : algebraMap R L π ≠ 0 := by + simpa using hπ.ne_zero + have hprod := finitePrincipalDivisor_mul (R := R) + (algebraMap R L a) ((algebraMap R L π) ^ nx) + haMap (zpow_ne_zero nx hπMap) + have hprodOrder := congrArg (fun D ↦ D v) hprod + simp only [finitePrincipalDivisor_apply, Finsupp.add_apply] at hprodOrder + rw [finitePlaceOrder_uniformizer_zpow v π hπ hπIdeal nx] at hprodOrder + have haOrder : (1 : ℤ) ≤ finitePlaceOrder v (algebraMap R L a) := + one_le_finitePlaceOrder_algebraMap_of_mem v a haMem ha + rw [hxOrder, hfactor, hprodOrder] + omega + +/-- Equal negative orders have a Frobenius-subfield cancellation which +strictly lowers the pole-depth measure. -/ +theorem exists_frobeniusSubfield_dedekindPoleDepth_sub_mul_lt_of_perfect_residue + (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (x y : L) + (hxneg : finitePlaceOrderTop v x < 0) + (hyneg : finitePlaceOrderTop v y < 0) + (horder : finitePlaceOrderTop v x = finitePlaceOrderTop v y) : + ∃ c : frobeniusSubfield L p, + dedekindPoleDepth v + (x - algebraMap (frobeniusSubfield L p) L c * y) < + dedekindPoleDepth v x ∧ + finitePlaceOrderTop v x < finitePlaceOrderTop v + (x - algebraMap (frobeniusSubfield L p) L c * y) := by + have hx : x ≠ 0 := by + intro h + subst x + simp at hxneg + have hy : y ≠ 0 := by + intro h + subst y + simp at hyneg + have horder' : finitePlaceOrder v x = finitePlaceOrder v y := by + rw [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy] at horder + exact_mod_cast horder + obtain ⟨c, hz | hlt⟩ := + exists_frobeniusSubfield_finitePlaceOrder_sub_mul_eq_zero_or_lt_of_perfect_residue + (p := p) v x y hx hy horder' + · refine ⟨c, ?_, ?_⟩ + · rw [hz] + have hxdepth : 0 < dedekindPoleDepth v x := + (dedekindPoleDepth_pos_iff v x).2 hxneg + simpa only [dedekindPoleDepth_zero] using hxdepth + · rw [hz, finitePlaceOrderTop_eq_coe v x hx] + simp + · by_cases hz : + x - algebraMap (frobeniusSubfield L p) L c * y = 0 + · refine ⟨c, ?_, ?_⟩ + · rw [hz] + have hxdepth : 0 < dedekindPoleDepth v x := + (dedekindPoleDepth_pos_iff v x).2 hxneg + simpa only [dedekindPoleDepth_zero] using hxdepth + · rw [hz, finitePlaceOrderTop_eq_coe v x hx] + simp + · refine ⟨c, ?_, ?_⟩ + · simp only [dedekindPoleDepth, hx, hz, if_false] + have hxorderneg : finitePlaceOrder v x < 0 := by + rw [finitePlaceOrderTop_eq_coe v x hx] at hxneg + exact_mod_cast hxneg + omega + · rw [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v _ hz] + exact_mod_cast hlt + +private theorem + indexedDedekindLocalColumnCombination_frobenius_transvection_same + {k : ℕ} (f : Fin k → L) (i j : Fin k) + (c : frobeniusSubfield L p) : + indexedDedekindLocalColumnCombination f (Matrix.transvection j i c) i = + f i + c • f j := by + classical + simp [indexedDedekindLocalColumnCombination, Matrix.transvection, + Matrix.single, Matrix.one_apply, add_smul, Finset.sum_add_distrib] + +private theorem + indexedDedekindLocalColumnCombination_frobenius_transvection_ne + {k : ℕ} (f : Fin k → L) (i j b : Fin k) + (c : frobeniusSubfield L p) (hb : b ≠ i) : + indexedDedekindLocalColumnCombination f (Matrix.transvection j i c) b = + f b := by + classical + have hib : i ≠ b := Ne.symm hb + simp [indexedDedekindLocalColumnCombination, Matrix.transvection, + Matrix.single, Matrix.one_apply, hib] + +private theorem indexedDedekindLocalColumnCombination_frobenius_one + {k : ℕ} (f : Fin k → L) : + indexedDedekindLocalColumnCombination f + (1 : Matrix (Fin k) (Fin k) (frobeniusSubfield L p)) = f := by + classical + funext i + simp [indexedDedekindLocalColumnCombination, Matrix.one_apply] + +private theorem + exists_frobeniusSubfield_dedekindPoleWeight_transvection_lt_of_perfect_residue + {k : ℕ} (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (f : Fin k → L) (i j : Fin k) + (hi : finitePlaceOrderTop v (f i) < 0) + (hj : finitePlaceOrderTop v (f j) < 0) + (horder : finitePlaceOrderTop v (f i) = finitePlaceOrderTop v (f j)) : + ∃ c : frobeniusSubfield L p, + dedekindPoleWeight v + (indexedDedekindLocalColumnCombination f + (Matrix.transvection j i (-c))) < + dedekindPoleWeight v f ∧ + finitePlaceOrderTop v (f i) < finitePlaceOrderTop v + (f i - algebraMap (frobeniusSubfield L p) L c * f j) := by + obtain ⟨c, hstrict, hraise⟩ := + exists_frobeniusSubfield_dedekindPoleDepth_sub_mul_lt_of_perfect_residue + (p := p) v (f i) (f j) hi hj horder + refine ⟨c, ?_, hraise⟩ + unfold dedekindPoleWeight + apply Finset.sum_lt_sum + · intro b _ + by_cases hb : b = i + · subst b + rw [indexedDedekindLocalColumnCombination_frobenius_transvection_same] + simpa only [Algebra.smul_def, map_neg, sub_eq_add_neg, neg_mul] using + hstrict.le + · rw [indexedDedekindLocalColumnCombination_frobenius_transvection_ne + f i j b (-c) hb] + · refine ⟨i, Finset.mem_univ _, ?_⟩ + rw [indexedDedekindLocalColumnCombination_frobenius_transvection_same] + simpa only [Algebra.smul_def, map_neg, sub_eq_add_neg, neg_mul] using + hstrict + +/-- Repeated equal negative orders can be eliminated over the Frobenius +subfield by a determinant-one matrix when the residue field is perfect. + +Unlike the constant-field version, this theorem does not require an algebra +map from the coefficient field to the DVR. -/ +theorem exists_det_one_frobeniusSubfield_dedekindColumnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue + {k : ℕ} (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (a : ℤ) (f : Fin k → L) + (hf : ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v (f i)) : + ∃ A : Matrix (Fin k) (Fin k) (frobeniusSubfield L p), + A.det = 1 ∧ + NegativeFinitePlaceOrdersPairwiseDistinct v + (indexedDedekindLocalColumnCombination f A) ∧ + ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v + (indexedDedekindLocalColumnCombination f A i) := by + induction hN : dedekindPoleWeight v f using Nat.strong_induction_on + generalizing f with + | h N ih => + by_cases hdistinct : NegativeFinitePlaceOrdersPairwiseDistinct v f + · refine ⟨(1 : Matrix (Fin k) (Fin k) (frobeniusSubfield L p)), + Matrix.det_one, ?_, ?_⟩ + · simpa [indexedDedekindLocalColumnCombination_frobenius_one] + · simpa [indexedDedekindLocalColumnCombination_frobenius_one] using hf + · have hdup : ∃ i j : Fin k, + finitePlaceOrderTop v (f i) < 0 ∧ + finitePlaceOrderTop v (f j) < 0 ∧ + finitePlaceOrderTop v (f i) = finitePlaceOrderTop v (f j) ∧ + i ≠ j := by + simp only [NegativeFinitePlaceOrdersPairwiseDistinct] at hdistinct + push Not at hdistinct + obtain ⟨i, j, hi, hj, ho, hij⟩ := hdistinct + exact ⟨i, j, hi, hj, ho, hij⟩ + obtain ⟨i, j, hi, hj, horder, hij⟩ := hdup + obtain ⟨c, hweight', hraise⟩ := + exists_frobeniusSubfield_dedekindPoleWeight_transvection_lt_of_perfect_residue + (p := p) v f i j hi hj horder + let T : Matrix (Fin k) (Fin k) (frobeniusSubfield L p) := + Matrix.transvection j i (-c) + let g := indexedDedekindLocalColumnCombination f T + have hweight : dedekindPoleWeight v g < N := by + rw [← hN] + exact hweight' + have hgi : + g i = f i - algebraMap (frobeniusSubfield L p) L c * f j := by + change indexedDedekindLocalColumnCombination f + (Matrix.transvection j i (-c)) i = _ + rw [indexedDedekindLocalColumnCombination_frobenius_transvection_same] + simp only [Algebra.smul_def, map_neg, neg_mul, sub_eq_add_neg] + have hg : ∀ b, (a : WithTop ℤ) ≤ + finitePlaceOrderTop v (g b) := by + intro b + by_cases hb : b = i + · subst b + rw [hgi] + exact (hf i).trans hraise.le + · change (a : WithTop ℤ) ≤ finitePlaceOrderTop v + (indexedDedekindLocalColumnCombination f + (Matrix.transvection j i (-c)) b) + rw [indexedDedekindLocalColumnCombination_frobenius_transvection_ne + f i j b (-c) hb] + exact hf b + obtain ⟨B, hBdet, hBdistinct, hBlower⟩ := ih _ hweight g hg rfl + refine ⟨T * B, ?_, ?_, ?_⟩ + · rw [Matrix.det_mul, hBdet, mul_one] + exact Matrix.det_transvection_of_ne j i (Ne.symm hij) (-c) + · rw [← indexedDedekindLocalColumnCombination_mul] + exact hBdistinct + · rw [← indexedDedekindLocalColumnCombination_mul] + exact hBlower + +/-- Complete local case (i) for a `Fin k` family, with coefficients in the +Frobenius subfield and no residue-surjectivity assumption. -/ +theorem exists_frobeniusSubfield_dedekindCaseI_columnMatrix_and_q_wronskian_bound_of_perfect_residue + {k : ℕ} (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (D : Derivation (frobeniusSubfield L p) L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (epsilonOrder : Fin k → ℕ) (f : Fin k → L) + (a : ℤ) (epsilon q : ℕ) + (ha : a ≤ 0) + (hf : ∀ i, (a : WithTop ℤ) ≤ finitePlaceOrderTop v (f i)) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) (frobeniusSubfield L p), + A.det = 1 ∧ + (indexedDedekindLocalWronskian D epsilonOrder + (indexedDedekindLocalColumnCombination f A)).det = + (indexedDedekindLocalWronskian D epsilonOrder f).det ∧ + (((q : ℤ) * a : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder f).det := by + obtain ⟨A, hAdet, hdistinct, hlower⟩ := + exists_det_one_frobeniusSubfield_dedekindColumnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue + (p := p) v a f hf + let g := indexedDedekindLocalColumnCombination f A + have hdet : + (indexedDedekindLocalWronskian D epsilonOrder g).det = + (indexedDedekindLocalWronskian D epsilonOrder f).det := by + exact indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D epsilonOrder f A hAdet + have hcardRho : + a ≤ -((Finset.univ.filter fun i => + finitePlaceOrderTop v (g i) < 0).card : ℤ) := + card_negativeFinitePlaceOrders_le_neg v g a ha hdistinct hlower + have hcardEpsilon : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + epsilon + 1 := by + calc + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + (Finset.univ : Finset (Fin k)).card := Finset.card_filter_le _ _ + _ = k := Fintype.card_fin k + _ ≤ epsilon + 1 := hk + have hbound := + finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_q_lower_bound + v D hDIntegral epsilonOrder g a epsilon q hdistinct hlower + hepsilonInjective hepsilonMax hcardRho hcardEpsilon ha hepsilonQ + refine ⟨A, hAdet, hdet, ?_⟩ + rw [← hdet] + exact hbound + +/-- Source-facing case-(i) elimination for the full auxiliary family over the +Frobenius subfield. Perfectness of the residue field replaces surjectivity +from a global constant field. -/ +theorem exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_columnMatrix_of_perfect_residue + (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (u w rho : L) (h k : ℕ) + (hrhoNe : rho ≠ 0) + (huOrder : finitePlaceOrderTop v u = 0) + (hrhoOrder : finitePlaceOrder v rho < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (u ^ (rs.1 : ℕ) * w ^ (rs.2 : ℕ))) : + ∃ A : Matrix (Fin k) (Fin k) (frobeniusSubfield L p), + A.det = 1 ∧ + NegativeFinitePlaceOrdersPairwiseDistinct v + (dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A) ∧ + (∀ i, (finitePlaceOrder v rho : WithTop ℤ) ≤ + finitePlaceOrderTop v + (dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A i)) ∧ + (∀ rs, dedekindCaseITransformedLocalAuxiliaryFamily + u w rho h k A (Sum.inr rs) = + dedekindLocalAuxiliaryFamily u w rho h k (Sum.inr rs)) := by + let first : Fin k → L := + fun i => dedekindLocalAuxiliaryFamily u w rho h k (Sum.inl i) + have hfirstOrder : ∀ i, + finitePlaceOrderTop v (first i) = + (finitePlaceOrder v rho : WithTop ℤ) := by + intro i + simp only [first, dedekindLocalAuxiliaryFamily] + rw [finitePlaceOrderTop_mul, finitePlaceOrderTop_pow, huOrder, + finitePlaceOrderTop_eq_coe v rho hrhoNe] + simp + have hfirstLower : ∀ i, (finitePlaceOrder v rho : WithTop ℤ) ≤ + finitePlaceOrderTop v (first i) := by + intro i + rw [hfirstOrder i] + obtain ⟨A, hAdet, hdistinct, hlower⟩ := + exists_det_one_frobeniusSubfield_dedekindColumnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue + (p := p) v (finitePlaceOrder v rho) first hfirstLower + refine ⟨A, hAdet, ?_, ?_, ?_⟩ + · intro x y hx hy hxy + cases x with + | inl i => + cases y with + | inl j => + apply congrArg Sum.inl + apply hdistinct + · simpa [first] using hx + · simpa [first] using hy + · simpa [first] using hxy + | inr rs => + rw [dedekindCaseITransformedLocalAuxiliaryFamily_inr] at hy + exact (not_lt_of_ge (hgridRegular rs)) hy |>.elim + | inr rs => + rw [dedekindCaseITransformedLocalAuxiliaryFamily_inr] at hx + exact (not_lt_of_ge (hgridRegular rs)) hx |>.elim + · intro i + cases i with + | inl j => simpa [first] using hlower j + | inr rs => + rw [dedekindCaseITransformedLocalAuxiliaryFamily_inr] + exact (show (finitePlaceOrder v rho : WithTop ℤ) ≤ 0 by + exact_mod_cast hrhoOrder.le) |>.trans (hgridRegular rs) + · intro rs + exact dedekindCaseITransformedLocalAuxiliaryFamily_inr + u w rho h k A rs + +/-- Full Dedekind-DVR case (i) over the Frobenius subfield: perfect residue +fields supply every leading-term cancellation, the determinant-one column +operation preserves the Wronskian, and the exact `q * ord(rho)` lower bound +follows. -/ +theorem exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue + (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (D : Derivation (frobeniusSubfield L p) L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (u w rho : L) (h k : ℕ) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (epsilon q : ℕ) + (hrhoNe : rho ≠ 0) + (huOrder : finitePlaceOrderTop v u = 0) + (hrhoOrder : finitePlaceOrder v rho < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (u ^ (rs.1 : ℕ) * w ^ (rs.2 : ℕ))) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) (frobeniusSubfield L p), + A.det = 1 ∧ + (indexedDedekindLocalWronskian D epsilonOrder + (dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A)).det = + (indexedDedekindLocalWronskian D epsilonOrder + (dedekindLocalAuxiliaryFamily u w rho h k)).det ∧ + (((q : ℤ) * finitePlaceOrder v rho : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder + (dedekindLocalAuxiliaryFamily u w rho h k)).det := by + obtain ⟨A, hAdet, hdistinct, hlower, hgrid⟩ := + exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_columnMatrix_of_perfect_residue + (p := p) v u w rho h k hrhoNe huOrder hrhoOrder hgridRegular + let f := dedekindLocalAuxiliaryFamily u w rho h k + let B := dedekindCaseIColumnMatrix h k A + let g := dedekindCaseITransformedLocalAuxiliaryFamily u w rho h k A + have hBdet : B.det = 1 := by + rw [dedekindCaseIColumnMatrix_det, hAdet] + have hdet : + (indexedDedekindLocalWronskian D epsilonOrder g).det = + (indexedDedekindLocalWronskian D epsilonOrder f).det := by + exact indexedDedekindLocalWronskian_det_columnCombination_of_det_eq_one + D epsilonOrder f B hBdet + have hcardRho : + finitePlaceOrder v rho ≤ -((Finset.univ.filter fun i => + finitePlaceOrderTop v (g i) < 0).card : ℤ) := + card_negativeFinitePlaceOrders_le_neg v g (finitePlaceOrder v rho) + hrhoOrder.le hdistinct hlower + let firstPoles : Finset (Fin k) := Finset.univ.filter fun i => + finitePlaceOrderTop v (g (Sum.inl i)) < 0 + have hpoles : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0) = + firstPoles.map ⟨Sum.inl, Sum.inl_injective⟩ := by + ext x + cases x with + | inl i => simp [firstPoles] + | inr rs => + have hregg : (0 : WithTop ℤ) ≤ + finitePlaceOrderTop v (g (Sum.inr rs)) := by + change (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (dedekindCaseITransformedLocalAuxiliaryFamily + u w rho h k A (Sum.inr rs)) + rw [hgrid rs] + simpa [dedekindLocalAuxiliaryFamily] using hgridRegular rs + have hrs : ¬ finitePlaceOrderTop v (g (Sum.inr rs)) < 0 := + not_lt_of_ge hregg + simp [firstPoles, hrs] + have hcardEpsilon : + (Finset.univ.filter fun i => finitePlaceOrderTop v (g i) < 0).card ≤ + epsilon + 1 := by + rw [hpoles, Finset.card_map] + exact (Finset.card_filter_le _ _).trans (by simpa using hk) + have hbound := + finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_q_lower_bound + v D hDIntegral epsilonOrder g (finitePlaceOrder v rho) epsilon q + hdistinct hlower hepsilonInjective hepsilonMax hcardRho hcardEpsilon + hrhoOrder.le hepsilonQ + refine ⟨A, hAdet, hdet, ?_⟩ + rw [← hdet] + exact hbound + +/-- Source `auxiliaryFamily` endpoint, specialized to +`rho = (1-u)/(1-w)`, over a perfect residue field. -/ +theorem exists_frobeniusSubfield_dedekindAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue + (v : HeightOneSpectrum R) + [PerfectField v.asIdeal.ResidueField] + (D : Derivation (frobeniusSubfield L p) L L) + (hDIntegral : ∀ r : R, ∃ s : R, + D (algebraMap R L r) = algebraMap R L s) + (u w : L) (h k : ℕ) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (epsilon q : ℕ) + (hrhoNe : (1 - u) / (1 - w) ≠ 0) + (huOrder : finitePlaceOrderTop v u = 0) + (hrhoOrder : finitePlaceOrder v ((1 - u) / (1 - w)) < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v + (u ^ (rs.1 : ℕ) * w ^ (rs.2 : ℕ))) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) (frobeniusSubfield L p), + A.det = 1 ∧ + (indexedDedekindLocalWronskian D epsilonOrder + (indexedDedekindLocalColumnCombination (auxiliaryFamily u w h k) + (dedekindCaseIColumnMatrix h k A))).det = + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u w h k)).det ∧ + (((q : ℤ) * finitePlaceOrder v ((1 - u) / (1 - w)) : ℤ) : + WithTop ℤ) ≤ + finitePlaceOrderTop v + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u w h k)).det := by + simpa only [dedekindCaseITransformedLocalAuxiliaryFamily, + dedekindLocalAuxiliaryFamily_div_eq_auxiliaryFamily] using + (exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue + (p := p) v D hDIntegral u w ((1 - u) / (1 - w)) h k epsilonOrder + epsilon q hrhoNe huOrder hrhoOrder hgridRegular hepsilonInjective + hepsilonMax hk hepsilonQ) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean new file mode 100644 index 0000000000..8c9b7654f7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean @@ -0,0 +1,357 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +import Mathlib.RingTheory.DiscreteValuationRing.Basic +import Mathlib.RingTheory.Derivation.Basic +import Mathlib.Tactic + +open scoped nonZeroDivisors +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + +/-- The additive order at a finite place satisfies the ultrametric inequality +on nonzero inputs. -/ +theorem finitePlaceOrder_add_ge_min + (v : HeightOneSpectrum R) (x y : L) + (hx : x ≠ 0) (hy : y ≠ 0) (hxy : x + y ≠ 0) : + min (finitePlaceOrder v x) (finitePlaceOrder v y) ≤ + finitePlaceOrder v (x + y) := by + have hVal := (v.valuation L).map_add x y + rw [valuation_eq_exp_neg_finitePlaceOrder v (x + y) hxy, + valuation_eq_exp_neg_finitePlaceOrder v x hx, + valuation_eq_exp_neg_finitePlaceOrder v y hy] at hVal + by_cases hOrder : finitePlaceOrder v x ≤ finitePlaceOrder v y + · rw [min_eq_left hOrder] + have hExp : exp (-finitePlaceOrder v y) ≤ exp (-finitePlaceOrder v x) := + (WithZero.exp_le_exp).2 (neg_le_neg hOrder) + rw [max_eq_left hExp] at hVal + exact neg_le_neg_iff.mp ((WithZero.exp_le_exp).1 hVal) + · have hOrder' : finitePlaceOrder v y ≤ finitePlaceOrder v x := + le_of_not_ge hOrder + rw [min_eq_right hOrder'] + have hExp : exp (-finitePlaceOrder v x) ≤ exp (-finitePlaceOrder v y) := + (WithZero.exp_le_exp).2 (neg_le_neg hOrder') + rw [max_eq_right hExp] at hVal + exact neg_le_neg_iff.mp ((WithZero.exp_le_exp).1 hVal) + +/-- The order attached to a height-one prime, with the zero element assigned +infinite order. -/ +noncomputable def finitePlaceOrderTop (v : HeightOneSpectrum R) (x : L) : WithTop ℤ := by + classical + exact if x = 0 then ⊤ else finitePlaceOrder v x + +@[simp] +theorem finitePlaceOrderTop_zero (v : HeightOneSpectrum R) : + finitePlaceOrderTop (L := L) v 0 = ⊤ := by + simp [finitePlaceOrderTop] + +@[simp] +theorem finitePlaceOrderTop_eq_top_iff (v : HeightOneSpectrum R) (x : L) : + finitePlaceOrderTop v x = ⊤ ↔ x = 0 := by + simp [finitePlaceOrderTop] + +theorem finitePlaceOrderTop_eq_coe (v : HeightOneSpectrum R) + (x : L) (hx : x ≠ 0) : + finitePlaceOrderTop v x = finitePlaceOrder v x := by + simp [finitePlaceOrderTop, hx] + +theorem finitePlaceOrderTop_add_ge_min + (v : HeightOneSpectrum R) (x y : L) : + min (finitePlaceOrderTop v x) (finitePlaceOrderTop v y) ≤ + finitePlaceOrderTop v (x + y) := by + by_cases hx : x = 0 + · subst x + simp + by_cases hy : y = 0 + · subst y + simp + by_cases hxy : x + y = 0 + · simp [finitePlaceOrderTop, hxy] + simp only [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy, + finitePlaceOrderTop_eq_coe v (x + y) hxy] + exact_mod_cast finitePlaceOrder_add_ge_min v x y hx hy hxy + +theorem finitePlaceOrderTop_mul + (v : HeightOneSpectrum R) (x y : L) : + finitePlaceOrderTop v (x * y) = + finitePlaceOrderTop v x + finitePlaceOrderTop v y := by + by_cases hx : x = 0 + · subst x + simp + by_cases hy : y = 0 + · subst y + simp + rw [finitePlaceOrderTop_eq_coe v (x * y) (mul_ne_zero hx hy), + finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy] + norm_cast + have hDivisor := finitePrincipalDivisor_mul (R := R) x y hx hy + exact congrArg (fun D ↦ D v) hDivisor + +@[simp] +theorem finitePlaceOrderTop_one (v : HeightOneSpectrum R) : + finitePlaceOrderTop (L := L) v 1 = 0 := by + rw [finitePlaceOrderTop_eq_coe v 1 one_ne_zero] + have hvaluation := valuation_eq_exp_neg_finitePlaceOrder v (1 : L) one_ne_zero + rw [map_one] at hvaluation + have hexp : exp (0 : ℤ) = exp (-finitePlaceOrder v (1 : L)) := by + simpa using hvaluation + have hzero : (0 : ℤ) = -finitePlaceOrder v (1 : L) := + WithZero.exp_injective hexp + have horder : finitePlaceOrder v (1 : L) = 0 := by omega + exact_mod_cast horder + +/-- The order of a natural power is the corresponding natural multiple of +the order. The `WithTop` formulation also covers a zero base. -/ +theorem finitePlaceOrderTop_pow + (v : HeightOneSpectrum R) (x : L) (n : ℕ) : + finitePlaceOrderTop v (x ^ n) = n • finitePlaceOrderTop v x := by + induction n with + | zero => simp + | succ n ih => + rw [pow_succ, finitePlaceOrderTop_mul, ih, succ_nsmul] + +/-- A regular element of the Dedekind domain has nonnegative order at every +height-one place. -/ +theorem finitePlaceOrderTop_algebraMap_nonnegative + (v : HeightOneSpectrum R) (a : R) : + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v (algebraMap R L a) := by + by_cases ha : a = 0 + · subst a + simp + have hmap : algebraMap R L a ≠ 0 := by + intro hzero + apply ha + apply IsFractionRing.injective R L + simpa using hzero + rw [finitePlaceOrderTop_eq_coe v _ hmap] + have hvaluation := + valuation_eq_exp_neg_finitePlaceOrder v (algebraMap R L a) hmap + rw [HeightOneSpectrum.valuation_of_algebraMap, + v.intValuation_eq_exp_neg_multiplicity ha] at hvaluation + have horder : + finitePlaceOrder v (algebraMap R L a) = + (multiplicity v.asIdeal (Ideal.span {a}) : ℤ) := by + exact (neg_injective (WithZero.exp_injective hvaluation)).symm + rw [horder] + exact_mod_cast Int.natCast_nonneg (multiplicity v.asIdeal (Ideal.span {a})) + +section DVR + +variable [IsDiscreteValuationRing R] + +/-- At the place generated by a uniformizer, a unit times its `n`-th +integer power has order exactly `n`. -/ +theorem finitePlaceOrder_unit_mul_uniformizer_zpow + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) (u : Rˣ) (n : ℤ) : + finitePlaceOrder v + ((algebraMap R L (u : R)) * (algebraMap R L π) ^ n) = n := by + have hπ0 : algebraMap R L π ≠ 0 := by simpa using hπ.ne_zero + have hu0 : algebraMap R L (u : R) ≠ 0 := by simp + have hx0 : + algebraMap R L (u : R) * (algebraMap R L π) ^ n ≠ 0 := + mul_ne_zero hu0 (zpow_ne_zero n hπ0) + have hValπ : v.valuation L (algebraMap R L π) = exp (-1 : ℤ) := by + rw [HeightOneSpectrum.valuation_of_algebraMap, + HeightOneSpectrum.intValuation_singleton v hπ.ne_zero hπIdeal] + have hValu : v.valuation L (algebraMap R L (u : R)) = 1 := by + exact Valuation.Integers.one_of_isUnit' u.isUnit + (HeightOneSpectrum.valuation_le_one (K := L) v) + have hValX : + v.valuation L + ((algebraMap R L (u : R)) * (algebraMap R L π) ^ n) = + exp (-n) := by + rw [map_mul, map_zpow₀ (v.valuation L) (algebraMap R L π) n, + hValu, one_mul, hValπ, ← WithZero.exp_zsmul] + congr 1 + simp + rw [valuation_eq_exp_neg_finitePlaceOrder v _ hx0] at hValX + exact neg_injective (WithZero.exp_injective hValX) + +theorem finitePlaceOrder_uniformizer_zpow + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) (n : ℤ) : + finitePlaceOrder v ((algebraMap R L π) ^ n) = n := by + simpa using finitePlaceOrder_unit_mul_uniformizer_zpow + (L := L) v π hπ hπIdeal (1 : Rˣ) n + +theorem finitePlaceOrderTop_uniformizer_zpow + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) (n : ℤ) : + finitePlaceOrderTop v ((algebraMap R L π) ^ n) = (n : WithTop ℤ) := by + have hπ0 : algebraMap R L π ≠ 0 := by simpa using hπ.ne_zero + rw [finitePlaceOrderTop_eq_coe v _ (zpow_ne_zero n hπ0)] + exact_mod_cast finitePlaceOrder_uniformizer_zpow + (L := L) v π hπ hπIdeal n + +/-- Any derivation preserving a DVR lowers order by at most one. No +normalization of the derivative of the chosen uniformizer is required. The +`WithTop`-valued statement includes the cases `x = 0` and `D x = 0`. -/ +theorem finitePlaceOrderTop_derivation_ge_sub_one_of_preserves + {C : Type*} [Field C] [Algebra C L] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, D (algebraMap R L r) = algebraMap R L s) + (x : L) : + finitePlaceOrderTop v x + (-(1 : ℤ) : ℤ) ≤ + finitePlaceOrderTop v (D x) := by + by_cases hx : x = 0 + · subst x + simp + obtain ⟨n, u, hxu⟩ := + IsDiscreteValuationRing.exists_units_eq_smul_zpow_of_irreducible + (K := L) hπ hx + let a : L := algebraMap R L (u : R) + let q : L := algebraMap R L π + have hq0 : q ≠ 0 := by + dsimp [q] + simpa using hπ.ne_zero + have ha0 : a ≠ 0 := by simp [a] + have hx' : x = a * q ^ n := by + simpa [a, q, Units.smul_def, Algebra.smul_def] using hxu + have hOrderX : finitePlaceOrder v x = n := by + rw [hx'] + exact finitePlaceOrder_unit_mul_uniformizer_zpow v π hπ hπIdeal u n + by_cases hDx : D x = 0 + · simp [finitePlaceOrderTop, hDx] + obtain ⟨da, hda⟩ := hDIntegral (u : R) + have hDa : D a = algebraMap R L da := by simpa [a] using hda + obtain ⟨dπ, hdπ⟩ := hDIntegral π + have hDq : D q = algebraMap R L dπ := by simpa [q] using hdπ + have hValπ : v.valuation L q = exp (-1 : ℤ) := by + dsimp [q] + calc + v.valuation L (algebraMap R L π) = v.intValuation π := + HeightOneSpectrum.valuation_of_algebraMap v π + _ = exp (-1 : ℤ) := + HeightOneSpectrum.intValuation_singleton v hπ.ne_zero hπIdeal + have hValu : v.valuation L a = 1 := by + dsimp [a] + exact Valuation.Integers.one_of_isUnit' u.isUnit + (HeightOneSpectrum.valuation_le_one (K := L) v) + have hValPow (m : ℤ) : v.valuation L (q ^ m) = exp (-m) := by + rw [map_zpow₀ (v.valuation L) q m, hValπ, ← WithZero.exp_zsmul] + congr 1 + simp + have hValDa : v.valuation L (D a) ≤ 1 := by + rw [hDa] + exact HeightOneSpectrum.valuation_le_one (K := L) v da + have hValDq : v.valuation L (D q) ≤ 1 := by + rw [hDq] + exact HeightOneSpectrum.valuation_le_one (K := L) v dπ + have hValN : v.valuation L (n : L) ≤ 1 := by + simpa using HeightOneSpectrum.valuation_le_one (K := L) v (n : R) + have hDFormula : + D x = D a * q ^ n + a * ((n : L) * q ^ (n - 1) * D q) := by + rw [hx', D.leibniz, D.leibniz_zpow] + simp only [smul_eq_mul] + ring + have hTermOne : + v.valuation L (D a * q ^ n) ≤ exp (-(n - 1)) := by + rw [map_mul, hValPow] + calc + v.valuation L (D a) * exp (-n) ≤ 1 * exp (-n) := by gcongr + _ = exp (-n) := one_mul _ + _ ≤ exp (-(n - 1)) := (WithZero.exp_le_exp).2 (by omega) + have hTermTwo : + v.valuation L (a * ((n : L) * q ^ (n - 1) * D q)) ≤ + exp (-(n - 1)) := by + rw [map_mul, map_mul, map_mul, hValu, one_mul, hValPow] + calc + v.valuation L (n : L) * exp (-(n - 1)) * v.valuation L (D q) ≤ + 1 * exp (-(n - 1)) * 1 := by gcongr + _ = exp (-(n - 1)) := by simp + have hValDx : v.valuation L (D x) ≤ exp (-(n - 1)) := by + rw [hDFormula] + exact ((v.valuation L).map_add _ _).trans (max_le hTermOne hTermTwo) + rw [valuation_eq_exp_neg_finitePlaceOrder v (D x) hDx] at hValDx + have hOrderDx : n - 1 ≤ finitePlaceOrder v (D x) := by + exact neg_le_neg_iff.mp ((WithZero.exp_le_exp).1 hValDx) + rw [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v (D x) hDx, hOrderX] + norm_cast + +/-- The normalized-uniformizer version retained for callers that naturally +construct a local derivative. -/ +theorem finitePlaceOrderTop_derivation_ge_sub_one + {C : Type*} [Field C] [Algebra C R] [Algebra C L] + [IsScalarTower C R L] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, D (algebraMap R L r) = algebraMap R L s) + (_hDπ : D (algebraMap R L π) = 1) (x : L) : + finitePlaceOrderTop v x + (-(1 : ℤ) : ℤ) ≤ + finitePlaceOrderTop v (D x) := + finitePlaceOrderTop_derivation_ge_sub_one_of_preserves + v π hπ hπIdeal D hDIntegral x + +/-- Iterating any DVR-preserving derivation lowers finite-place order by at +most the number of iterations. -/ +theorem finitePlaceOrderTop_derivation_iterate_ge_sub_nat_of_preserves + {C : Type*} [Field C] [Algebra C L] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, D (algebraMap R L r) = algebraMap R L s) + (r : ℕ) (x : L) : + finitePlaceOrderTop v x + (-(r : ℤ) : ℤ) ≤ + finitePlaceOrderTop v ((D : L → L)^[r] x) := by + induction r with + | zero => simp + | succ r ih => + rw [Function.iterate_succ_apply'] + have hshift := + add_le_add_right ih ((-(1 : ℤ) : ℤ) : WithTop ℤ) + have hshift' : + (finitePlaceOrderTop v x + (-(r : ℤ) : ℤ)) + + ((-(1 : ℤ) : ℤ) : WithTop ℤ) ≤ + finitePlaceOrderTop v ((D : L → L)^[r] x) + + ((-(1 : ℤ) : ℤ) : WithTop ℤ) := by + simpa [add_comm] using hshift + have hstep := finitePlaceOrderTop_derivation_ge_sub_one_of_preserves + v π hπ hπIdeal D hDIntegral ((D : L → L)^[r] x) + calc + finitePlaceOrderTop v x + (-(↑r.succ : ℤ) : ℤ) = + (finitePlaceOrderTop v x + (-(r : ℤ) : ℤ)) + + ((-(1 : ℤ) : ℤ) : WithTop ℤ) := by + rw [add_assoc] + congr 1 + exact_mod_cast (show -(↑r.succ : ℤ) = -(r : ℤ) + (-(1 : ℤ)) by omega) + _ ≤ finitePlaceOrderTop v ((D : L → L)^[r] x) + + ((-(1 : ℤ) : ℤ) : WithTop ℤ) := hshift' + _ ≤ finitePlaceOrderTop v (D ((D : L → L)^[r] x)) := hstep + +/-- The iterated normalized-uniformizer version retained for compatibility +with the local Wronskian API. -/ +theorem finitePlaceOrderTop_derivation_iterate_ge_sub_nat + {C : Type*} [Field C] [Algebra C R] [Algebra C L] + [IsScalarTower C R L] + (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) + (hπIdeal : v.asIdeal = Ideal.span {π}) + (D : Derivation C L L) + (hDIntegral : ∀ r : R, ∃ s : R, D (algebraMap R L r) = algebraMap R L s) + (_hDπ : D (algebraMap R L π) = 1) (r : ℕ) (x : L) : + finitePlaceOrderTop v x + (-(r : ℤ) : ℤ) ≤ + finitePlaceOrderTop v ((D : L → L)^[r] x) := + finitePlaceOrderTop_derivation_iterate_ge_sub_nat_of_preserves + v π hπ hπIdeal D hDIntegral r x + +end DVR + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean new file mode 100644 index 0000000000..8f2aa327a2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean @@ -0,0 +1,509 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import Mathlib.RingTheory.Conductor +import Mathlib.RingTheory.Derivation.MapCoeffs +import Mathlib.RingTheory.RamificationInertia.Ramification + +/-! +# Scaling derivations at ramified Dedekind places + +Let `C → S → T → U` be a tower, let `D` preserve `S`, and let `E` be an +ambient derivation on `U` extending `D`. The transitivity exact sequence for +Kähler differentials shows that every element annihilating `Ω[T⁄S]` clears the +obstruction to `E` preserving `T`. + +For a power basis, the minimal-polynomial derivative supplies such a factor +and generates the trace different. For a general ramified extension, the +comparison between the trace different and the Kähler annihilator is retained +as an explicit hypothesis; mathlib does not currently supply it in the needed +generality. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {C S T U : Type*} + [CommRing C] [CommRing S] [CommRing T] [CommRing U] + [Algebra C S] [Algebra C T] [Algebra S T] + [Algebra C U] [Algebra S U] [Algebra T U] + [IsScalarTower C S T] [IsScalarTower C S U] + [IsScalarTower C T U] [IsScalarTower S T U] + +/-- The ideal of scalars annihilating the relative Kähler differentials. -/ +def kaehlerDifferentialAnnihilator (S T : Type*) + [CommRing S] [CommRing T] [Algebra S T] : Ideal T := + Module.annihilator T Ω[T⁄S] + +theorem mem_kaehlerDifferentialAnnihilator_iff (c : T) : + c ∈ kaehlerDifferentialAnnihilator S T ↔ + ∀ ω : Ω[T⁄S], c • ω = 0 := by + exact Module.mem_annihilator + +theorem liftKaehlerDifferential_algebraMap_compDer + (D : Derivation C S S) : + ((Algebra.linearMap S T).compDer D).liftKaehlerDifferential = + (Algebra.linearMap S T).comp D.liftKaehlerDifferential := by + apply Derivation.liftKaehlerDifferential_unique + ext s + simp + +/-- Evaluation of a base-changed differential agrees with evaluation by an +ambient derivation extending the base derivation. -/ +theorem kaehler_baseChange_evaluation_naturality + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) + (z : TensorProduct S T (KaehlerDifferential C S)) : + algebraMap T U + (((((Algebra.linearMap S T).compDer D).liftKaehlerDifferential).liftBaseChange T) z) = + E.liftKaehlerDifferential + (KaehlerDifferential.map C C T U + (KaehlerDifferential.mapBaseChange C S T z)) := by + induction z using TensorProduct.induction_on with + | zero => simp + | tmul t ω => + rw [LinearMap.liftBaseChange_tmul, + KaehlerDifferential.mapBaseChange_tmul] + simp only [map_smul] + let l₁ : KaehlerDifferential C S →ₗ[S] U := + (Algebra.linearMap S U).comp D.liftKaehlerDifferential + let l₂ : KaehlerDifferential C S →ₗ[S] U := + (E.liftKaehlerDifferential.restrictScalars S).comp + ((KaehlerDifferential.map C C T U).restrictScalars S |>.comp + (KaehlerDifferential.map C C S T)) + have hl : l₁ = l₂ := by + apply Derivation.liftKaehlerDifferential_unique + apply Derivation.ext + intro s + change l₁ (KaehlerDifferential.D C S s) = + l₂ (KaehlerDifferential.D C S s) + dsimp only [l₁, l₂, LinearMap.comp_apply, + LinearMap.restrictScalars_apply] + rw [Derivation.liftKaehlerDifferential_comp_D, + KaehlerDifferential.map_D, KaehlerDifferential.map_D, + Derivation.liftKaehlerDifferential_comp_D] + rw [← IsScalarTower.algebraMap_apply S T U] + simpa using (hE s).symm + have hω : + algebraMap T U + (((Algebra.linearMap S T).compDer D).liftKaehlerDifferential ω) = + E.liftKaehlerDifferential + (KaehlerDifferential.map C C T U + (KaehlerDifferential.map C C S T ω)) := by + rw [liftKaehlerDifferential_algebraMap_compDer] + change algebraMap T U + (algebraMap S T (D.liftKaehlerDifferential ω)) = _ + rw [← IsScalarTower.algebraMap_apply S T U] + simpa [l₁, l₂] using LinearMap.congr_fun hl ω + simpa [Algebra.smul_def] using + congrArg (fun y : U => algebraMap T U t * y) hω + | add x y hx hy => + simp only [map_add, hx, hy] + +/-- A scalar annihilating `Ω[T⁄S]` makes the scaled ambient derivation preserve +`T`. This is the ramified analogue of formal-étale derivation preservation. -/ +theorem scaled_ambientDerivation_preserves_of_mem_kaehlerDifferentialAnnihilator + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) + (c : T) (hc : c ∈ kaehlerDifferentialAnnihilator S T) : + ∀ t : T, ∃ t' : T, + algebraMap T U c * E (algebraMap T U t) = algebraMap T U t' := by + intro t + have hker : KaehlerDifferential.map C S T T + (c • KaehlerDifferential.D C T t) = 0 := by + rw [map_smul, KaehlerDifferential.map_D] + exact (mem_kaehlerDifferentialAnnihilator_iff c).mp hc _ + have hrange : c • KaehlerDifferential.D C T t ∈ + LinearMap.range (KaehlerDifferential.mapBaseChange C S T) := + ((KaehlerDifferential.exact_mapBaseChange_map C S T) + (c • KaehlerDifferential.D C T t)).mp hker + obtain ⟨z, hz⟩ := hrange + let t' : T := + (((((Algebra.linearMap S T).compDer D).liftKaehlerDifferential).liftBaseChange T) z) + refine ⟨t', ?_⟩ + rw [kaehler_baseChange_evaluation_naturality D E hE z, hz, map_smul, + KaehlerDifferential.map_D] + simp [Derivation.liftKaehlerDifferential_comp_D, Algebra.smul_def] + +section PrincipalAnnihilatingIdeal + +variable [IsPrincipalIdealRing T] + +/-- A nonzero principal ideal contained in the Kähler annihilator has a +nonzero generator which clears the ambient derivation. -/ +theorem exists_generator_scaled_ambientDerivation_preserves + (I : Ideal T) (hI : I ≠ ⊥) + (hIann : I ≤ kaehlerDifferentialAnnihilator S T) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ c : T, + c ≠ 0 ∧ + Ideal.span {c} = I ∧ + c ∈ kaehlerDifferentialAnnihilator S T ∧ + ∀ t : T, ∃ t' : T, + algebraMap T U c * E (algebraMap T U t) = algebraMap T U t' := by + let c : T := Submodule.IsPrincipal.generator I + have hspan : Ideal.span {c} = I := Ideal.span_singleton_generator I + have hc : c ≠ 0 := by + intro hc0 + have hbot : Ideal.span {c} = ⊥ := + Ideal.span_singleton_eq_bot.mpr hc0 + exact hI (hspan.symm.trans hbot) + have hcann : c ∈ kaehlerDifferentialAnnihilator S T := + hIann (Submodule.IsPrincipal.generator_mem I) + exact ⟨c, hc, hspan, hcann, + scaled_ambientDerivation_preserves_of_mem_kaehlerDifferentialAnnihilator + D E hE c hcann⟩ + +end PrincipalAnnihilatingIdeal + +section PowerBasisAnnihilator + +/-- For a power basis, the derivative of the generator's minimal polynomial +annihilates the relative Kähler differentials. -/ +theorem powerBasis_minpolyDerivative_mem_kaehlerDifferentialAnnihilator + (pb : PowerBasis S T) : + Polynomial.aeval pb.gen + (Polynomial.derivative (minpoly S pb.gen)) ∈ + kaehlerDifferentialAnnihilator S T := by + rw [mem_kaehlerDifferentialAnnihilator_iff] + let c : T := Polynomial.aeval pb.gen + (Polynomial.derivative (minpoly S pb.gen)) + have hcgen : c • KaehlerDifferential.D S T pb.gen = 0 := by + have hchain := + (KaehlerDifferential.D S T).map_aeval (minpoly S pb.gen) pb.gen + rw [minpoly.aeval, map_zero] at hchain + exact hchain.symm + intro ω + change c • ω = 0 + let l : KaehlerDifferential S T →ₗ[T] KaehlerDifferential S T := + LinearMap.lsmul T (KaehlerDifferential S T) c + have hl : l = 0 := by + apply Derivation.liftKaehlerDifferential_unique + apply Derivation.ext_of_adjoin_eq_top {pb.gen} pb.adjoin_gen_eq_top + intro x hx + rw [Set.mem_singleton_iff.mp hx] + change c • KaehlerDifferential.D S T pb.gen = 0 + exact hcgen + have hω := LinearMap.congr_fun hl ω + simpa [l] using hω + +/-- The minimal-polynomial derivative of a power-basis generator clears the +ambient derivation. -/ +theorem powerBasis_minpolyDerivative_scaled_ambientDerivation_preserves + (pb : PowerBasis S T) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∀ t : T, ∃ t' : T, + algebraMap T U + (Polynomial.aeval pb.gen + (Polynomial.derivative (minpoly S pb.gen))) * + E (algebraMap T U t) = algebraMap T U t' := by + exact + scaled_ambientDerivation_preserves_of_mem_kaehlerDifferentialAnnihilator + D E hE _ + (powerBasis_minpolyDerivative_mem_kaehlerDifferentialAnnihilator pb) + +end PowerBasisAnnihilator + +section PrincipalDifferent + +variable [IsDomain S] [IsDedekindDomain T] + [Module.IsTorsionFree S T] + +/-- If the trace different is contained in the Kähler annihilator, a generator +of the different is an exact ramified derivation-clearing factor. -/ +theorem exists_differentGenerator_scaled_ambientDerivation_preserves + [IsPrincipalIdealRing T] + (hDifferent : differentIdeal S T ≠ ⊥) + (hDifferentKaehler : + differentIdeal S T ≤ kaehlerDifferentialAnnihilator S T) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ c : T, + c ≠ 0 ∧ + Ideal.span {c} = differentIdeal S T ∧ + c ∈ kaehlerDifferentialAnnihilator S T ∧ + ∀ t : T, ∃ t' : T, + algebraMap T U c * E (algebraMap T U t) = algebraMap T U t' := by + exact exists_generator_scaled_ambientDerivation_preserves + (differentIdeal S T) hDifferent hDifferentKaehler D E hE + +variable {F : Type*} [Field F] [Algebra T F] [IsFractionRing T F] + +/-- A generator of the different has finite-place order exactly equal to the +different multiplicity. -/ +theorem finitePlaceOrder_differentGenerator_eq_multiplicity + (c : T) (hc : c ≠ 0) + (hspan : Ideal.span {c} = differentIdeal S T) + (v : HeightOneSpectrum T) : + finitePlaceOrder v (algebraMap T F c) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) := by + rw [finitePlaceOrder_algebraMap_eq_multiplicity v c hc, hspan] + +/-- A single certificate combining ramified derivation preservation with the +exact local order of the clearing factor. -/ +theorem exists_differentGenerator_scaling_certificate + [IsPrincipalIdealRing T] + (hDifferent : differentIdeal S T ≠ ⊥) + (hDifferentKaehler : + differentIdeal S T ≤ kaehlerDifferentialAnnihilator S T) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ c : T, + c ≠ 0 ∧ + Ideal.span {c} = differentIdeal S T ∧ + c ∈ kaehlerDifferentialAnnihilator S T ∧ + (∀ v : HeightOneSpectrum T, + finitePlaceOrder v (algebraMap T F c) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ)) ∧ + ∀ t : T, ∃ t' : T, + algebraMap T U c * E (algebraMap T U t) = algebraMap T U t' := by + obtain ⟨c, hc, hspan, hcann, hpreserves⟩ := + exists_differentGenerator_scaled_ambientDerivation_preserves + hDifferent hDifferentKaehler D E hE + exact ⟨c, hc, hspan, hcann, + fun v => finitePlaceOrder_differentGenerator_eq_multiplicity c hc hspan v, + hpreserves⟩ + +end PrincipalDifferent + +section ReparameterizedLocalOrder + +variable {R A F : Type*} [CommRing R] [IsDomain R] + [CommRing A] [IsDedekindDomain A] [Algebra R A] + [Module.IsTorsionFree R A] + [Field F] [Algebra A F] [IsFractionRing A F] + +/-- Multiplication of two nonzero field elements adds their finite-place +orders. This non-`WithTop` form is convenient for exact local certificates. -/ +theorem finitePlaceOrder_mul_eq_add + (v : HeightOneSpectrum A) (x y : F) (hx : x ≠ 0) (hy : y ≠ 0) : + finitePlaceOrder v (x * y) = + finitePlaceOrder v x + finitePlaceOrder v y := by + have h := finitePlaceOrderTop_mul v x y + rw [finitePlaceOrderTop_eq_coe v (x * y) (mul_ne_zero hx hy), + finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy] at h + exact_mod_cast h + +/-- Inversion negates finite-place order. -/ +theorem finitePlaceOrder_inv_eq_neg' + (v : HeightOneSpectrum A) (x : F) (hx : x ≠ 0) : + finitePlaceOrder v x⁻¹ = -finitePlaceOrder v x := by + have h := finitePlaceOrder_mul_eq_add v x⁻¹ x (inv_ne_zero hx) hx + rw [inv_mul_cancel₀ hx] at h + have hone : finitePlaceOrder v (1 : F) = 0 := by + have htop := finitePlaceOrderTop_one (L := F) v + rw [finitePlaceOrderTop_eq_coe v 1 one_ne_zero] at htop + exact_mod_cast htop + rw [hone] at h + omega + +/-- Negating a nonzero field element does not change its finite-place order. -/ +theorem finitePlaceOrder_neg_eq + (v : HeightOneSpectrum A) (x : F) (hx : x ≠ 0) : + finitePlaceOrder v (-x) = finitePlaceOrder v x := by + have hval : (v.valuation F) (-x) = (v.valuation F) x := by simp + rw [valuation_eq_exp_neg_finitePlaceOrder v (-x) (neg_ne_zero.mpr hx), + valuation_eq_exp_neg_finitePlaceOrder v x hx] at hval + exact neg_injective (WithZero.exp_injective hval) + +/-- If `s` generates a base height-one prime, then its order at a prime above +it is exactly the ramification index. -/ +theorem finitePlaceOrder_algebraMap_uniformizer_eq_ramificationIdx + (p : HeightOneSpectrum R) (v : HeightOneSpectrum A) + [v.asIdeal.LiesOver p.asIdeal] + (s : R) (hs : s ≠ 0) (hspan : p.asIdeal = Ideal.span {s}) : + finitePlaceOrder v (algebraMap A F (algebraMap R A s)) = + (v.asIdeal.ramificationIdx R : ℤ) := by + have hsA : algebraMap R A s ≠ 0 := by + simpa using (FaithfulSMul.algebraMap_injective R A).ne hs + rw [finitePlaceOrder_algebraMap_eq_multiplicity v _ hsA] + have hmap : p.asIdeal.map (algebraMap R A) ≠ ⊥ := + Ideal.map_ne_bot_of_ne_bot p.ne_bot + rw [show Ideal.span {algebraMap R A s} = + p.asIdeal.map (algebraMap R A) by + rw [hspan, Ideal.map_span, Set.image_singleton]] + exact_mod_cast + (Ideal.IsDedekindDomain.ramificationIdx_eq_multiplicity + p.asIdeal v.asIdeal hmap).symm + +end ReparameterizedLocalOrder + +section PowerBasisDifferent + +variable {K L : Type*} [Field K] [Field L] + [Algebra S K] [Algebra T L] [Algebra K L] [Algebra S L] + [IsScalarTower S K L] [IsScalarTower S T L] + [IsDomain S] [IsFractionRing S K] [IsFractionRing T L] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + [IsIntegralClosure T S L] [IsIntegrallyClosed S] [IsDedekindDomain T] + [Module.IsTorsionFree S T] + +omit [IsFractionRing T L] in +/-- For an integral power basis generated by a primitive field element, the +trace different is exactly the principal ideal generated by the +minimal-polynomial derivative. -/ +theorem differentIdeal_eq_span_powerBasis_minpolyDerivative + (pb : PowerBasis S T) + (hprimitive : Algebra.adjoin K {algebraMap T L pb.gen} = ⊤) : + differentIdeal S T = + Ideal.span + {Polynomial.aeval pb.gen + (Polynomial.derivative (minpoly S pb.gen))} := by + have h := conductor_mul_differentIdeal S K L pb.gen hprimitive + simpa [conductor_eq_top_of_powerBasis pb] using h + +/-- The power-basis derivative has exact order equal to the different +multiplicity at every finite place. -/ +theorem powerBasis_minpolyDerivative_finitePlaceOrder_eq_differentMultiplicity + (pb : PowerBasis S T) + (hprimitive : Algebra.adjoin K {algebraMap T L pb.gen} = ⊤) + (v : HeightOneSpectrum T) : + finitePlaceOrder v + (algebraMap T L + (Polynomial.aeval pb.gen + (Polynomial.derivative (minpoly S pb.gen)))) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) := by + rw [finitePlaceOrder_algebraMap_eq_multiplicity v _ + (minpolyDerivative_ne_zero (A := S) (K := K) (L := L) pb.gen)] + rw [differentIdeal_eq_span_powerBasis_minpolyDerivative pb hprimitive] + +/-- In the power-basis case, the minimal-polynomial derivative simultaneously +generates the different, annihilates relative differentials, has exact local +different order, and clears the ambient derivation. -/ +theorem exists_powerBasis_differentGenerator_scaled_ambientDerivation_preserves + (pb : PowerBasis S T) + (hprimitive : Algebra.adjoin K {algebraMap T L pb.gen} = ⊤) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ c : T, + c ≠ 0 ∧ + Ideal.span {c} = differentIdeal S T ∧ + c ∈ kaehlerDifferentialAnnihilator S T ∧ + (∀ v : HeightOneSpectrum T, + finitePlaceOrder v (algebraMap T L c) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ)) ∧ + ∀ t : T, ∃ t' : T, + algebraMap T U c * E (algebraMap T U t) = algebraMap T U t' := by + let c : T := Polynomial.aeval pb.gen + (Polynomial.derivative (minpoly S pb.gen)) + refine ⟨c, + minpolyDerivative_ne_zero (A := S) (K := K) (L := L) pb.gen, + ?_, powerBasis_minpolyDerivative_mem_kaehlerDifferentialAnnihilator pb, + ?_, ?_⟩ + · exact (differentIdeal_eq_span_powerBasis_minpolyDerivative + pb hprimitive).symm + · exact fun v => + powerBasis_minpolyDerivative_finitePlaceOrder_eq_differentMultiplicity + pb hprimitive v + · exact powerBasis_minpolyDerivative_scaled_ambientDerivation_preserves + pb D E hE + +/-- Placewise finite certificate extracted from an integral power basis: one +nonzero scalar has exactly the local different order and makes the ambient +derivation preserve the local Dedekind ring. -/ +theorem exists_powerBasis_finitePlace_different_scaling_certificate + (pb : PowerBasis S T) + (hprimitive : Algebra.adjoin K {algebraMap T L pb.gen} = ⊤) + (v : HeightOneSpectrum T) + (D : Derivation C S S) (E : Derivation C U U) + (hE : ∀ s : S, E (algebraMap S U s) = algebraMap S U (D s)) : + ∃ c : T, + c ≠ 0 ∧ + finitePlaceOrder v (algebraMap T L c) = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) ∧ + ∀ t : T, ∃ t' : T, + algebraMap T U c * E (algebraMap T U t) = algebraMap T U t' := by + obtain ⟨c, hc, _hspan, _hcann, horder, hpreserves⟩ := + exists_powerBasis_differentGenerator_scaled_ambientDerivation_preserves + pb hprimitive D E hE + exact ⟨c, hc, horder v, hpreserves⟩ + +/-- Exact change from the local parameter derivation `D_s` to the global +`X`-derivation when `s = X⁻¹`. If `D_X = -s² D_s`, dividing a different +generator by `-s²` leaves the scaled derivation unchanged and subtracts +`2e` from its local order. Thus the resulting scalar realizes exactly the +infinity coefficient `different exponent - 2 * ramification index` of the +canonical different divisor. -/ +theorem exists_powerBasis_infinity_different_scaling_certificate + [Algebra C L] [IsScalarTower C S L] [IsScalarTower C T L] + (pb : PowerBasis S T) + (hprimitive : Algebra.adjoin K {algebraMap T L pb.gen} = ⊤) + (p : HeightOneSpectrum S) (v : HeightOneSpectrum T) + [v.asIdeal.LiesOver p.asIdeal] + (s : S) (hs : s ≠ 0) (hspan : p.asIdeal = Ideal.span {s}) + (Ds : Derivation C S S) (Es DX : Derivation C L L) + (hEs : ∀ r : S, Es (algebraMap S L r) = algebraMap S L (Ds r)) + (hDX : DX = (-(algebraMap S L s) ^ 2) • Es) : + ∃ δ : T, + δ ≠ 0 ∧ + Ideal.span {δ} = differentIdeal S T ∧ + let c : L := -(algebraMap T L δ) / (algebraMap S L s) ^ 2 + finitePlaceOrder v c = + (multiplicity v.asIdeal (differentIdeal S T) : ℤ) - + 2 * (v.asIdeal.ramificationIdx S : ℤ) ∧ + ∀ t : T, ∃ t' : T, + c * DX (algebraMap T L t) = algebraMap T L t' := by + obtain ⟨δ, hδ, hδspan, _hδann, hδorder, hδpreserves⟩ := + exists_powerBasis_differentGenerator_scaled_ambientDerivation_preserves + (U := L) pb hprimitive Ds Es hEs + refine ⟨δ, hδ, hδspan, ?_, ?_⟩ + · have hsK : algebraMap S K s ≠ 0 := by + intro hzero + exact hs (IsFractionRing.injective S K (by simpa using hzero)) + have hsL : algebraMap S L s ≠ 0 := by + rw [IsScalarTower.algebraMap_apply S K L] + exact (map_ne_zero (algebraMap K L)).2 hsK + have hδL : algebraMap T L δ ≠ 0 := by + intro hzero + exact hδ (IsFractionRing.injective T L (by simpa using hzero)) + have hsOrder : + finitePlaceOrder v (algebraMap S L s) = + (v.asIdeal.ramificationIdx S : ℤ) := by + simpa only [IsScalarTower.algebraMap_apply S T L] using + finitePlaceOrder_algebraMap_uniformizer_eq_ramificationIdx + (F := L) p v s hs hspan + rw [div_eq_mul_inv, + finitePlaceOrder_mul_eq_add v + (-(algebraMap T L δ)) (((algebraMap S L s) ^ 2)⁻¹) + (neg_ne_zero.mpr hδL) (inv_ne_zero (pow_ne_zero 2 hsL)), + finitePlaceOrder_neg_eq v (algebraMap T L δ) hδL, + finitePlaceOrder_inv_eq_neg' v ((algebraMap S L s) ^ 2) + (pow_ne_zero 2 hsL)] + have hsSquareOrder := finitePlaceOrder_mul_eq_add v + (algebraMap S L s) (algebraMap S L s) hsL hsL + rw [← pow_two] at hsSquareOrder + rw [hδorder v, hsSquareOrder, hsOrder] + ring + · intro t + obtain ⟨t', ht'⟩ := hδpreserves t + refine ⟨t', ?_⟩ + have hsK : algebraMap S K s ≠ 0 := by + intro hzero + exact hs (IsFractionRing.injective S K (by simpa using hzero)) + have hsL : algebraMap S L s ≠ 0 := by + rw [IsScalarTower.algebraMap_apply S K L] + exact (map_ne_zero (algebraMap K L)).2 hsK + rw [hDX, Derivation.smul_apply, Algebra.smul_def] + calc + (-(algebraMap T L δ) / (algebraMap S L s) ^ 2) * + (-(algebraMap S L s) ^ 2 * Es (algebraMap T L t)) = + algebraMap T L δ * Es (algebraMap T L t) := by + field_simp + _ = algebraMap T L t' := ht' + +end PowerBasisDifferent + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean new file mode 100644 index 0000000000..d17914e4a6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import Mathlib.RingTheory.RootsOfUnity.Basic +import Mathlib.Tactic + +/-! +# Elementary finite-field torsion bounds + +This file records the part of the finite-field Corvaja--Zannier estimate that +uses only the fact that a nonzero polynomial has at most its degree many roots. +It does not use curve geometry or the Corvaja--Zannier Wronskian argument. +-/ + +namespace BGS.External + +noncomputable section + +/-- The torsion intersection injects into the product of the two groups of +roots of unity. Consequently its cardinality is at most the product of the +two specified orders. -/ +theorem torusCurveTorsionIntersection_card_le_orders + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) + (hfirst : 0 < firstOrder) (hsecond : 0 < secondOrder) : + (torusCurveTorsionIntersection K f firstOrder secondOrder).card ≤ + firstOrder * secondOrder := by + let S := torusCurveTorsionIntersection K f firstOrder secondOrder + letI : NeZero firstOrder := ⟨hfirst.ne'⟩ + letI : NeZero secondOrder := ⟨hsecond.ne'⟩ + letI : Fintype (rootsOfUnity firstOrder K) := Fintype.ofFinite _ + letI : Fintype (rootsOfUnity secondOrder K) := Fintype.ofFinite _ + let toRoots : {z // z ∈ S} → + rootsOfUnity firstOrder K × rootsOfUnity secondOrder K := fun z ↦ + (⟨z.1.1, (mem_rootsOfUnity firstOrder z.1.1).2 + (mem_torusCurveTorsionIntersection_iff.1 z.2).2.1⟩, + ⟨z.1.2, (mem_rootsOfUnity secondOrder z.1.2).2 + (mem_torusCurveTorsionIntersection_iff.1 z.2).2.2⟩) + have hInjective : Function.Injective toRoots := by + intro z w hzw + apply Subtype.ext + apply Prod.ext + · exact congrArg (fun q ↦ (q.1 : Kˣ)) hzw + · exact congrArg (fun q ↦ (q.2 : Kˣ)) hzw + calc + S.card = Fintype.card {z // z ∈ S} := by simp + _ ≤ Fintype.card + (rootsOfUnity firstOrder K × rootsOfUnity secondOrder K) := + Fintype.card_le_of_injective toRoots hInjective + _ = Nat.card (rootsOfUnity firstOrder K) * + Nat.card (rootsOfUnity secondOrder K) := by + simp only [Fintype.card_prod, Nat.card_eq_fintype_card] + _ ≤ firstOrder * secondOrder := + Nat.mul_le_mul (card_rootsOfUnity K firstOrder) + (card_rootsOfUnity K secondOrder) + +/-- In the small-characteristic regime `p ≤ 12 d₁ d₂`, the second +branch of the Corvaja--Zannier numerical maximum follows from the elementary +finite-group cardinality bound. -/ +theorem torusCurveTorsionIntersection_le_corvajaZannierBound_of_smallChar + (p : ℕ) [Fact p.Prime] + (K : Type*) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) + (hsmall : p ≤ 12 * firstDegree * secondDegree) : + ((torusCurveTorsionIntersection K f firstOrder secondOrder).card : ℝ) ≤ + BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + p firstOrder secondOrder firstDegree secondDegree + (planeTorusEulerCharacteristicBound firstDegree secondDegree) := by + have hp : 0 < p := (Fact.out : p.Prime).pos + have hcardNat := torusCurveTorsionIntersection_card_le_orders + f firstOrder secondOrder hfirstOrder hsecondOrder + have hcardReal : + ((torusCurveTorsionIntersection K f firstOrder secondOrder).card : ℝ) ≤ + ((firstOrder * secondOrder : ℕ) : ℝ) := by + exact_mod_cast hcardNat + have hscaledNat : + p * (firstOrder * secondOrder) ≤ + 12 * (firstOrder * secondOrder * firstDegree * secondDegree) := by + have := Nat.mul_le_mul_right (firstOrder * secondOrder) hsmall + simpa [mul_assoc, mul_left_comm, mul_comm] using this + have hscaledReal' : + (p : ℝ) * ((firstOrder * secondOrder : ℕ) : ℝ) ≤ + 12 * ((firstOrder * secondOrder * firstDegree * secondDegree : ℕ) : ℝ) := by + exact_mod_cast hscaledNat + have hscaledReal : + ((firstOrder * secondOrder : ℕ) : ℝ) * (p : ℝ) ≤ + 12 * ((firstOrder * secondOrder * firstDegree * secondDegree : ℕ) : ℝ) := by + simpa [mul_comm] using hscaledReal' + have hsecond : + ((firstOrder * secondOrder : ℕ) : ℝ) ≤ + 12 * ((firstOrder * secondOrder * firstDegree * secondDegree : ℕ) : ℝ) / + (p : ℝ) := by + apply (le_div_iff₀ (by exact_mod_cast hp)).2 + simpa [mul_comm] using hscaledReal + unfold BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + exact hcardReal.trans (hsecond.trans (le_max_right _ _)) + +/-- The part of the general plane-curve statement lying strictly outside the +elementary range `p ≤ 12 d₁ d₂`. This is an ordinary proposition, not an +additional assumption or axiom. -/ +def GeneralCorvajaZannierPlaneCurveTheoremAboveElementaryRange : Prop := + ∀ (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ), + 0 < firstDegree → + 0 < secondDegree → + HasBidegreeAtMost (K := K) f firstDegree secondDegree → + IsCorvajaZannierPlaneCurve f → + 0 < firstOrder → + 0 < secondOrder → + ¬ p ∣ firstOrder → + ¬ p ∣ secondOrder → + 12 * firstDegree * secondDegree < p → + ((torusCurveTorsionIntersection + K f firstOrder secondOrder).card : ℝ) ≤ + BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + p firstOrder secondOrder firstDegree secondDegree + (planeTorusEulerCharacteristicBound firstDegree secondDegree) + +/-- The full general plane-curve theorem is equivalent to its restriction to +the complementary range `12 d₁ d₂ < p`; the omitted range is exactly the +elementary small-characteristic theorem above. -/ +theorem generalCorvajaZannierPlaneCurveTheorem_iff_aboveElementaryRange : + GeneralCorvajaZannierPlaneCurveTheorem ↔ + GeneralCorvajaZannierPlaneCurveTheoremAboveElementaryRange := by + constructor + · intro hGeneral + unfold GeneralCorvajaZannierPlaneCurveTheoremAboveElementaryRange + intro p _ K _ _ _ _ f firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar _hlarge + exact hGeneral p (K := K) f + firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar + · intro hLarge + unfold GeneralCorvajaZannierPlaneCurveTheorem + intro p _ K _ _ _ _ f firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar + by_cases hsmall : p ≤ 12 * firstDegree * secondDegree + · exact + torusCurveTorsionIntersection_le_corvajaZannierBound_of_smallChar + p K f firstDegree secondDegree firstOrder secondOrder + hfirstOrder hsecondOrder hsmall + · exact hLarge p (K := K) f + firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar (Nat.lt_of_not_ge hsmall) + +end + +end BGS.External diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean new file mode 100644 index 0000000000..e1341dbd35 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean @@ -0,0 +1,480 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge + +/-! +# Composition of the Corvaja--Zannier plane-curve endpoint + +This module discharges the algebraic and numerical bookkeeping between the +public plane-curve interface and the remaining global geometric estimate. It +constructs the powered-image relation from `IsCorvajaZannierPlaneCurve`, proves +that the two powered torsion functions are nonzero, identifies the finite-set +cardinality with the torsion-point subtype cardinality, and composes the +Dedekind gcd divisor estimate with the proved numerical optimization. + +The only remaining input is exposed as the ordinary proposition +`GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange`. Its +certificate is precisely a gcd-divisor number which bounds the rational +torsion points, satisfies the trivial degree bound, and satisfies the +Corvaja--Zannier Proposition 2 alternatives. No axiom or typeclass hides this +geometric obligation. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open Polynomial + +theorem pow_sub_one_ne_zero_of_transcendental + {K L : Type*} [Field K] [Field L] [Algebra K L] + {z : L} (hz : Transcendental K z) (n : ℕ) (hn : 0 < n) : + z ^ n - 1 ≠ 0 := by + intro hzero + have hroot : Polynomial.aeval z (Polynomial.X ^ n - 1 : Polynomial K) = 0 := by + simpa using hzero + have hpolyZero := (transcendental_iff.mp hz) + (Polynomial.X ^ n - 1 : Polynomial K) hroot + have hmonic : (Polynomial.X ^ n - Polynomial.C 1 : Polynomial K).Monic := + Polynomial.monic_X_pow_sub_C 1 hn.ne' + exact hmonic.ne_zero (by simpa using hpolyZero) + +theorem torusCurveTorsionIntersection_card_eq_torsionPoint_card + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card = + Fintype.card (TorusCurveTorsionPoint f firstOrder secondOrder) := by + exact (Fintype.card_coe + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder)).symm + +theorem poweredTorsionFunctions_ne_zero_of_isCorvajaZannierPlaneCurve + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (firstOrder secondOrder : ℕ) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + letI := planeCurveCoordinateRing_isDomain hf + planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0 ∧ + planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0 := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have hxTrans : Transcendental K (planeCurveFunction f 0) := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hcurve.2.2.2) + have hyTrans : Transcendental K (planeCurveFunction f 1) := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hcurve.2.2.1) + exact ⟨pow_sub_one_ne_zero_of_transcendental + hxTrans firstOrder hfirstOrder, + pow_sub_one_ne_zero_of_transcendental + hyTrans secondOrder hsecondOrder⟩ + +/-- The public curve hypotheses instantiate the canonical powered-image +relation, including the advertised source bidegree bounds. -/ +theorem poweredCoordinateImageRelation_spec_of_isCorvajaZannierPlaneCurve + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + letI := planeCurveCoordinateRing_isDomain hf + let g := poweredCoordinateImageRelation hf hcurve.2.2.2 + firstOrder hfirstOrder secondOrder + Irreducible g ∧ + evalBivariate (planeCurveFunction f 0 ^ firstOrder) + (planeCurveFunction f 1 ^ secondOrder) g = 0 ∧ + 0 < g.natDegree ∧ + 0 < (transposeBivariate g).natDegree ∧ + g.natDegree ≤ firstOrder * secondDegree ∧ + (transposeBivariate g).natDegree ≤ secondOrder * firstDegree ∧ + ∀ i, (g.coeff i).natDegree ≤ secondOrder * firstDegree := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let g := poweredCoordinateImageRelation hf hcurve.2.2.2 + firstOrder hfirstOrder secondOrder + have hspec := poweredCoordinateImageRelation_spec + hf hcurve.2.2.1 hcurve.2.2.2 + firstOrder hfirstOrder secondOrder hsecondOrder + refine ⟨hspec.1, hspec.2.1, hspec.2.2.1, hspec.2.2.2.1, + hspec.2.2.2.2.1.trans ?_, hspec.2.2.2.2.2.1.trans ?_, ?_⟩ + · exact Nat.mul_le_mul_left firstOrder + (degreeOf_second_le_of_hasBidegreeAtMost hbidegree) + · exact Nat.mul_le_mul_left secondOrder + (degreeOf_first_le_of_hasBidegreeAtMost hbidegree) + · intro i + exact (hspec.2.2.2.2.2.2 i).trans + (Nat.mul_le_mul_left secondOrder + (degreeOf_first_le_of_hasBidegreeAtMost hbidegree)) + +/-- The smaller of the degrees of `x ^ firstOrder` and `y ^ secondOrder`, +using only the public bidegree bounds. -/ +def planeCurveTorsionLowerDegree + (firstDegree secondDegree firstOrder secondOrder : ℕ) : ℕ := + min (secondOrder * firstDegree) (firstOrder * secondDegree) + +/-- The larger of the degrees of `x ^ firstOrder` and `y ^ secondOrder`, +using only the public bidegree bounds. -/ +def planeCurveTorsionUpperDegree + (firstDegree secondDegree firstOrder secondOrder : ℕ) : ℕ := + max (secondOrder * firstDegree) (firstOrder * secondDegree) + +theorem planeCurveTorsionLowerDegree_mul_upperDegree + (firstDegree secondDegree firstOrder secondOrder : ℕ) : + planeCurveTorsionLowerDegree firstDegree secondDegree firstOrder secondOrder * + planeCurveTorsionUpperDegree firstDegree secondDegree firstOrder secondOrder = + firstOrder * secondOrder * firstDegree * secondDegree := by + rw [planeCurveTorsionLowerDegree, planeCurveTorsionUpperDegree, min_mul_max] + ac_rfl + +/-- Proposition 2 plus the trivial gcd bound gives exactly the numerical +right-hand side of the public plane-curve theorem, independently of which +powered coordinate has the smaller degree. -/ +theorem planeCurveCorvajaZannierNumericalBound_of_propositionTwo + (p firstDegree secondDegree firstOrder secondOrder : ℕ) (G : ℝ) + (hfirstDegree : 0 < firstDegree) + (hsecondDegree : 0 < secondDegree) + (hfirstOrder : 0 < firstOrder) + (hsecondOrder : 0 < secondOrder) + (hp : 0 < p) + (hGNonneg : 0 ≤ G) + (hGTrivial : G ≤ planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (hPropositionTwo : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder) + p (2 * firstDegree * secondDegree) G) : + G ≤ BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + p firstOrder secondOrder firstDegree secondDegree + (BGS.External.planeTorusEulerCharacteristicBound + firstDegree secondDegree) := by + let a := planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder + let b := planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder + let chi : ℕ := 2 * firstDegree * secondDegree + have ha : 0 < a := by + simp only [a, planeCurveTorsionLowerDegree] + exact lt_min (Nat.mul_pos hsecondOrder hfirstDegree) + (Nat.mul_pos hfirstOrder hsecondDegree) + have hab : a ≤ b := by + simp only [a, b, planeCurveTorsionLowerDegree, + planeCurveTorsionUpperDegree] + exact min_le_max + have hchi : 0 < chi := by + simp only [chi] + positivity + have hbound := theoremTwo_maxBound_of_propositionTwo + a b chi p G ha hab hchi hp hGNonneg hGTrivial hPropositionTwo + have habProductNat : + a * b = firstOrder * secondOrder * firstDegree * secondDegree := by + exact planeCurveTorsionLowerDegree_mul_upperDegree + firstDegree secondDegree firstOrder secondOrder + have habProductReal : + (a : ℝ) * (b : ℝ) = + ((firstOrder * secondOrder * firstDegree * secondDegree : ℕ) : ℝ) := by + exact_mod_cast habProductNat + rw [habProductReal] at hbound + unfold BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + simp only [chi, Nat.cast_mul] at hbound + simpa only [BGS.External.planeTorusEulerCharacteristicBound, + Nat.cast_ofNat, Nat.cast_mul, mul_assoc] using hbound + +/-- A certificate for the only remaining geometric input at the endpoint. +The real number `G` is intended to be the degree of the gcd divisor of the +two powered torsion functions. Its fields state, respectively, that every +rational torsion point contributes to it, that the elementary divisor bound +holds, and that the Corvaja--Zannier Proposition 2 alternatives hold. -/ +def PlaneCurvePropositionTwoCertificate + (p : ℕ) (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) : Prop := + ∃ G : ℝ, + ((BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card : ℝ) ≤ G ∧ + G ≤ planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder ∧ + PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder) + p (2 * firstDegree * secondDegree) G + +/-- Proposition 2's alternatives are downward closed in the gcd quantity. -/ +theorem propositionTwoNumericalAlternatives_mono + {a b p chi : ℕ} {G H : ℝ} (hGH : G ≤ H) + (hH : PropositionTwoNumericalAlternatives a b p chi H) : + PropositionTwoNumericalAlternatives a b p chi G := by + intro h k hadmissible + rcases hH h k hadmissible with hdegree | hbound + · exact Or.inl hdegree + · exact Or.inr (hGH.trans hbound) + +theorem torusCurveTorsionIntersection_le_corvajaZannierBound_of_certificate + (p : ℕ) (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hfirstDegree : 0 < firstDegree) + (hsecondDegree : 0 < secondDegree) + (hfirstOrder : 0 < firstOrder) + (hsecondOrder : 0 < secondOrder) + (hp : 0 < p) + (hcertificate : PlaneCurvePropositionTwoCertificate + p K f firstDegree secondDegree firstOrder secondOrder) : + ((BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card : ℝ) ≤ + BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + p firstOrder secondOrder firstDegree secondDegree + (BGS.External.planeTorusEulerCharacteristicBound + firstDegree secondDegree) := by + obtain ⟨G, hcard, htrivial, hpropositionTwo⟩ := hcertificate + have hGNonneg : 0 ≤ G := + (Nat.cast_nonneg + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card).trans hcard + exact hcard.trans + (planeCurveCorvajaZannierNumericalBound_of_propositionTwo + p firstDegree secondDegree firstOrder secondOrder G + hfirstDegree hsecondDegree hfirstOrder hsecondOrder hp + hGNonneg htrivial hpropositionTwo) + +/-- The explicit Dedekind gcd sum supplies a Proposition 2 certificate once +the two still-geometric inequalities for that sum have been proved. -/ +theorem planeCurvePropositionTwoCertificate_of_dedekindGcdSum + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} + [IsDomain (PlaneCurveCoordinateRing f)] + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (p firstDegree secondDegree firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (htrivial : + ((∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v : ℕ) : ℝ) ≤ + planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (hpropositionTwo : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder) + p (2 * firstDegree * secondDegree) + ((∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v : ℕ) : ℝ)) : + PlaneCurvePropositionTwoCertificate + p K f firstDegree secondDegree firstOrder secondOrder := by + let GNat : ℕ := + ∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v + refine ⟨(GNat : ℝ), ?_, htrivial, hpropositionTwo⟩ + have hcardNat := torsionPoint_card_le_torsionGcdMultiplicity_sum + (f := f) (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero + have hfinsetNat : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card ≤ GNat := by + rw [torusCurveTorsionIntersection_card_eq_torsionPoint_card] + exact hcardNat + exact_mod_cast hfinsetNat + +/-- The sharp fiber-counting bound supplies the trivial certificate bound +directly. Consequently an upper gcd divisor only has to satisfy Proposition +2; it need not separately be proved below the smaller coordinate height. -/ +theorem planeCurvePropositionTwoCertificate_of_dedekindGcdSum_and_bidegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} + [IsDomain (PlaneCurveCoordinateRing f)] + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (p firstDegree secondDegree firstOrder secondOrder : ℕ) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (hpropositionTwo : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder) + p (2 * firstDegree * secondDegree) + ((∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v : ℕ) : ℝ)) : + PlaneCurvePropositionTwoCertificate + p K f firstDegree secondDegree firstOrder secondOrder := by + let card : ℕ := + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card + let gcdDegree : ℕ := + ∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v + have hcardTrivial : card ≤ planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder := by + dsimp only [card, planeCurveTorsionLowerDegree] + simpa only [min_comm] using + torusCurveTorsionIntersection_card_le_min_bidegree_order + f firstDegree secondDegree firstOrder secondOrder + hbidegree hcurve hfirstOrder hsecondOrder + have hcardGcd : card ≤ gcdDegree := by + dsimp only [card, gcdDegree] + rw [torusCurveTorsionIntersection_card_eq_torsionPoint_card] + exact torsionPoint_card_le_torsionGcdMultiplicity_sum + (f := f) (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero + refine ⟨(card : ℝ), le_rfl, ?_, ?_⟩ + · exact_mod_cast hcardTrivial + · apply propositionTwoNumericalAlternatives_mono + (G := (card : ℝ)) (H := (gcdDegree : ℝ)) + · exact_mod_cast hcardGcd + · simpa only [gcdDegree] using hpropositionTwo + +/-- A concrete Dedekind gcd sum satisfying the divisor and Proposition 2 +inequalities gives the public numerical endpoint directly. -/ +theorem torusCurveTorsionIntersection_le_corvajaZannierBound_of_dedekindGcdSum + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} + [IsDomain (PlaneCurveCoordinateRing f)] + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (p firstDegree secondDegree firstOrder secondOrder : ℕ) + (hfirstDegree : 0 < firstDegree) + (hsecondDegree : 0 < secondDegree) + (hfirstOrder : 0 < firstOrder) + (hsecondOrder : 0 < secondOrder) + (hp : 0 < p) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (htrivial : + ((∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v : ℕ) : ℝ) ≤ + planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (hpropositionTwo : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder) + p (2 * firstDegree * secondDegree) + ((∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) + firstOrder secondOrder v : ℕ) : ℝ)) : + ((BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card : ℝ) ≤ + BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + p firstOrder secondOrder firstDegree secondDegree + (BGS.External.planeTorusEulerCharacteristicBound + firstDegree secondDegree) := by + apply torusCurveTorsionIntersection_le_corvajaZannierBound_of_certificate + p K f firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hfirstOrder hsecondOrder hp + exact planeCurvePropositionTwoCertificate_of_dedekindGcdSum + p firstDegree secondDegree firstOrder secondOrder + hfirstNonzero hsecondNonzero htrivial hpropositionTwo + +/-- The remaining above-elementary-range assertion, now reduced to explicit +Proposition 2 certificates. It contains no axiom or typeclass assumption. -/ +def GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange : Prop := + ∀ (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ), + 0 < firstDegree → + 0 < secondDegree → + BGS.External.HasBidegreeAtMost f firstDegree secondDegree → + BGS.External.IsCorvajaZannierPlaneCurve f → + 0 < firstOrder → + 0 < secondOrder → + ¬ p ∣ firstOrder → + ¬ p ∣ secondOrder → + 12 * firstDegree * secondDegree < p → + PlaneCurvePropositionTwoCertificate + p K f firstDegree secondDegree firstOrder secondOrder + +theorem generalCorvajaZannierPlaneCurveTheoremAboveElementaryRange_of_certificates + (hcertificates : + GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange) : + BGS.External.GeneralCorvajaZannierPlaneCurveTheoremAboveElementaryRange := by + unfold GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange at hcertificates + unfold BGS.External.GeneralCorvajaZannierPlaneCurveTheoremAboveElementaryRange + intro p _ K _ _ _ _ f firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar hlarge + exact torusCurveTorsionIntersection_le_corvajaZannierBound_of_certificate + p K f firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hfirstOrder hsecondOrder + (Fact.out : p.Prime).pos + (hcertificates p (K := K) f + firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve + hfirstOrder hsecondOrder hfirstPrimeToChar hsecondPrimeToChar hlarge) + +/-- The exact endpoint follows from the remaining certificate proposition; +the complementary characteristic range is the proved elementary theorem. -/ +theorem generalCorvajaZannierPlaneCurveTheorem_of_certificates + (hcertificates : + GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange) : + BGS.External.GeneralCorvajaZannierPlaneCurveTheorem := by + rw [BGS.External.generalCorvajaZannierPlaneCurveTheorem_iff_aboveElementaryRange] + exact generalCorvajaZannierPlaneCurveTheoremAboveElementaryRange_of_certificates + hcertificates + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean new file mode 100644 index 0000000000..cb2297c676 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean @@ -0,0 +1,367 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +import Mathlib.Tactic + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable {C : Type*} [Field C] [Algebra C L] + +local instance (priority := 10) finiteCanonicalCasesPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance finiteCanonicalCasesPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finiteCanonicalCasesFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance finiteCanonicalCasesFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance finiteCanonicalCasesPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance finiteCanonicalCasesFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +private theorem finiteExtensionFinitePlace_gridOrder_sum_eq + (q : FiniteExtensionFinitePlace K L) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) (h k : ℕ) : + (∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder q (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) = + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) := by + have hdiv := congrArg (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inl q)) + (finiteExtensionPrincipalDivisor_auxiliaryGridProduct K L u v hu hv h k) + rw [hdiv] + rw [Finset.sum_apply'] + apply Finset.sum_congr rfl + intro rs hrs + have hmul := congrArg (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inl q)) + (finiteExtensionPrincipalDivisor_mul K L + (u ^ (rs.1 : ℕ)) (v ^ (rs.2 : ℕ)) + (pow_ne_zero _ hu) (pow_ne_zero _ hv)) + have hupow := congrArg (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inl q)) + (finiteExtensionPrincipalDivisor_pow K L u hu (rs.1 : ℕ)) + have hvpow := congrArg (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inl q)) + (finiteExtensionPrincipalDivisor_pow K L v hv (rs.2 : ℕ)) + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] at hmul hupow hvpow + rw [hmul, hupow, hvpow] + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + +private theorem auxiliaryFamilyDerivativeOrder_sum_int (h k : ℕ) : + (∑ i : Sum (Fin k) (Fin (k + 1) × Fin h), + (auxiliaryFamilyDerivativeOrder h k i : ℤ)) = + ((h * k + h + k).choose 2 : ℤ) := by + exact_mod_cast auxiliaryFamilyDerivativeOrder_sum h k + +private theorem finitePlaceOrder_gridMonomial_eq_zero + (q : FiniteExtensionFinitePlace K L) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huOrder : finitePlaceOrder q u = 0) + (hvOrder : finitePlaceOrder q v = 0) + (i j : ℕ) : + finitePlaceOrder q (u ^ i * v ^ j) = 0 := by + have hmul := congrArg (fun E : FiniteExtensionPlace K L →₀ ℤ => E (.inl q)) + (finiteExtensionPrincipalDivisor_mul K L + (u ^ i) (v ^ j) (pow_ne_zero _ hu) (pow_ne_zero _ hv)) + have hupow := congrArg (fun E : FiniteExtensionPlace K L →₀ ℤ => E (.inl q)) + (finiteExtensionPrincipalDivisor_pow K L u hu i) + have hvpow := congrArg (fun E : FiniteExtensionPlace K L →₀ ℤ => E (.inl q)) + (finiteExtensionPrincipalDivisor_pow K L v hv j) + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] at hmul hupow hvpow + rw [hmul, hupow, hvpow, huOrder, hvOrder] + simp + +/-- Finite-place source case (i), specialized to the consecutive derivative +orders on the source auxiliary family. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI + {p : ℕ} [Fact p.Prime] [CharP L p] [Fintype K] + (q : FiniteExtensionFinitePlace K L) + (D : Derivation (frobeniusSubfield L p) L L) + (c : L) (hc : c ≠ 0) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (hn : 0 < h * k + h + k) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : finitePlaceOrder q u = 0) + (hvOrder : finitePlaceOrder q v = 0) + (hrhoOrder : finitePlaceOrder q ((1 - u) / (1 - v)) < 0) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((h * k + h + k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) (.inl q) ≤ + ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + let n := h * k + h + k + have hrho : (1 - u) / (1 - v) ≠ 0 := + div_ne_zero (sub_ne_zero.mpr hu1.symm) (sub_ne_zero.mpr hv1.symm) + have huTop : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q u = 0 := by + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q u hu] + exact_mod_cast huOrder + have hrhoLocal : + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) < 0 := by + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder] + exact hrhoOrder + have hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) := by + intro rs + have hmonomial : u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) ≠ 0 := + mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv) + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q _ hmonomial] + have hzero := finitePlaceOrder_gridMonomial_eq_zero + K L q u v hu hv huOrder hvOrder (rs.1 : ℕ) (rs.2 : ℕ) + rw [hzero] + exact le_rfl + have hepsilonMax : ∀ i, auxiliaryFamilyDerivativeOrder h k i ≤ n - 1 := by + intro i + exact auxiliaryFamilyDerivativeOrder_le_pred h k hn i + have hkBound : k ≤ (n - 1) + 1 := by + have hcancel : n - 1 + 1 = n := Nat.sub_add_cancel hn + rw [hcancel] + exact auxiliaryFamily_k_le_card h k + have hepsilonQ : (n - 1) + 1 ≤ n := by + rw [Nat.sub_add_cancel hn] + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseI_q_wronskian_bound_of_scaled_preserves + (K := K) (L := L) (p := p) q h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + (n - 1) n D c hScaledIntegral u v hrho huTop hrhoLocal + hgridRegular (auxiliaryFamilyDerivativeOrder_injective h k) + hepsilonMax hkBound hepsilonQ + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q c hc, + finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q _ hW] at hbound + have hboundInt : + (n : ℤ) * finitePlaceOrder q ((1 - u) / (1 - v)) ≤ + (n.choose 2 : ℤ) * finitePlaceOrder q c + + finitePlaceOrder q + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + simpa only [n, finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + using hboundInt + +/-- Finite-place source case (ii), with every local order converted to the +coefficient used by the exhaustive principal divisor. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII + (q : FiniteExtensionFinitePlace K L) + (D : Derivation C L L) (c : L) (hc : c ≠ 0) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : 0 ≤ finitePlaceOrder q u) + (hvOrder : 0 ≤ finitePlaceOrder q v) + (hrhoOrder : 0 ≤ finitePlaceOrder q ((1 - u) / (1 - v))) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + have hrho : (1 - u) / (1 - v) ≠ 0 := + div_ne_zero (sub_ne_zero.mpr hu1.symm) (sub_ne_zero.mpr hv1.symm) + have huTop : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q u := by + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q u hu] + exact_mod_cast huOrder + have hvTop : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q v := by + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q v hv] + exact_mod_cast hvOrder + have hrhoTop : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + ((1 - u) / (1 - v)) := by + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q _ hrho] + exact_mod_cast hrhoOrder + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseII_nonnegative_of_scaled_preserves + (K := K) (L := L) q h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + D c hScaledIntegral u v huTop hvTop hrhoTop + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q c hc, + finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q _ hW] at hbound + have hboundInt : + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finitePlaceOrder q + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hboundInt + +/-- Finite-place source case (iii), expressed directly with the global +principal divisor and the consecutive-order Wronskian. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII + (q : FiniteExtensionFinitePlace K L) + (D : Derivation C L L) (c : L) (hc : c ≠ 0) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u (.inl q) + + ((h * k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L v (.inl q) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inl q) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_scaled_preserves + (K := K) (L := L) q h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + D c hScaledIntegral u v hu hv hu1 hv1 + have hrho : (1 - u) / (1 - v) ≠ 0 := + div_ne_zero (sub_ne_zero.mpr hu1.symm) (sub_ne_zero.mpr hv1.symm) + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + finiteExtensionFinitePlaceLocalOrder_eq_globalOrder] at hbound + simp_rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder] at hbound + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q c hc, + finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q _ hW] at hbound + have hboundInt : + ((k * (k - 1) / 2 : ℕ) : ℤ) * finitePlaceOrder q u + + ((h * k : ℕ) : ℤ) * finitePlaceOrder q v + + (k : ℤ) * finitePlaceOrder q ((1 - u) / (1 - v)) + + (∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder q (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) - + (∑ i : Sum (Fin k) (Fin (k + 1) × Fin h), + (auxiliaryFamilyDerivativeOrder h k i : ℤ)) ≤ + ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finitePlaceOrder q + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + rw [auxiliaryFamilyDerivativeOrder_sum_int, + finiteExtensionFinitePlace_gridOrder_sum_eq K L q u v hu hv h k] at hboundInt + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hboundInt + +/-- Finite-place source case (iv), in the same global-divisor form. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIV + (q : FiniteExtensionFinitePlace K L) + (D : Derivation C L L) (c : L) (hc : c ≠ 0) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u (.inl q) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inl q) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_scaled_preserves + (K := K) (L := L) q h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + D c hScaledIntegral u v hu hv hu1 hv1 + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + finiteExtensionFinitePlaceLocalOrder_eq_globalOrder] at hbound + simp_rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder] at hbound + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q c hc, + finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q _ hW] at hbound + have hboundInt : + ((k * (k - 1) / 2 : ℕ) : ℤ) * finitePlaceOrder q u + + (k : ℤ) * finitePlaceOrder q ((1 - u) / (1 - v)) + + (∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder q (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) - + (∑ i : Sum (Fin k) (Fin (k + 1) × Fin h), + (auxiliaryFamilyDerivativeOrder h k i : ℤ)) ≤ + ((h * k + h + k).choose 2 : ℤ) * finitePlaceOrder q c + + finitePlaceOrder q + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + rw [auxiliaryFamilyDerivativeOrder_sum_int, + finiteExtensionFinitePlace_gridOrder_sum_eq K L q u v hu hv h k] at hboundInt + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hboundInt + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean new file mode 100644 index 0000000000..5c204a90dd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling + +/-! +# Canonical finite-place bounds for a normalized derivation + +The raw local Wronskian estimates accept an arbitrary clearing scalar. This +file chooses that scalar from the different at each finite place, so its order +is definitionally replaced by the coefficient of the canonical different +divisor. These are the four finite-place inputs used by the exhaustive global +summation. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable {p : ℕ} [Fact p.Prime] [CharP K p] [CharP L p] + +local instance (priority := 10) normalizedCasesPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance normalizedCasesPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance normalizedCasesFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance normalizedCasesFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance normalizedCasesPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance normalizedCasesFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +private abbrev canonicalDifferent : FiniteExtensionPlace K L →₀ ℤ := + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + +/-- Canonical finite-place case (i), outside the exceptional set with a pole +of `(1-u)/(1-v)`. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI_of_normalized + (q : FiniteExtensionFinitePlace K L) + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (h k : ℕ) (hn : 0 < h * k + h + k) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : finitePlaceOrder q u = 0) + (hvOrder : finitePlaceOrder q v = 0) + (hrhoOrder : finitePlaceOrder q ((1 - u) / (1 - v)) < 0) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((h * k + h + k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) (.inl q) ≤ + ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + obtain ⟨c, hc, hcOrder, hIntegral⟩ := + exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate + K L D hDX q + have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseI + K L q D c hc hIntegral h k hn u v hu hv hu1 hv1 + huOrder hvOrder hrhoOrder hW + simpa only [canonicalDifferent, hcOrder] using hcase + +/-- Canonical finite-place case (ii), outside the exceptional set without a +pole of `(1-u)/(1-v)`. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII_of_normalized + (q : FiniteExtensionFinitePlace K L) + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : 0 ≤ finitePlaceOrder q u) + (hvOrder : 0 ≤ finitePlaceOrder q v) + (hrhoOrder : 0 ≤ finitePlaceOrder q ((1 - u) / (1 - v))) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + obtain ⟨c, hc, hcOrder, hIntegral⟩ := + exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate + K L D hDX q + have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseII + K L q D c hc hIntegral h k u v hu hv hu1 hv1 + huOrder hvOrder hrhoOrder hW + simpa only [canonicalDifferent, hcOrder] using hcase + +/-- Canonical finite-place case (iii), at a positive-order place of `v`. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII_of_normalized + (q : FiniteExtensionFinitePlace K L) + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((k * (k - 1) / 2 : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L u (.inl q) + + ((h * k : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L v (.inl q) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inl q) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + obtain ⟨c, hc, hcOrder, hIntegral⟩ := + exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate + K L D hDX q + have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseIII + K L q D c hc hIntegral h k u v hu hv hu1 hv1 hW + simpa only [canonicalDifferent, hcOrder] using hcase + +/-- Canonical finite-place case (iv), at a nonpositive-order place of `v`. -/ +theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIV_of_normalized + (q : FiniteExtensionFinitePlace K L) + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((k * (k - 1) / 2 : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L u (.inl q) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inl q) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inl q) := by + obtain ⟨c, hc, hcOrder, hIntegral⟩ := + exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate + K L D hDX q + have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseIV + K L q D c hc hIntegral h k u v hu hv hu1 hv1 hW + simpa only [canonicalDifferent, hcOrder] using hcase + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean new file mode 100644 index 0000000000..8340ebbb9c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean @@ -0,0 +1,1185 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +import Mathlib.Tactic + +/-! +# Canonical auxiliary bounds at infinity places + +This module transports the four local Corvaja--Zannier auxiliary-family cases to +branches above the infinity place of a finite separable extension of `RatFunc K`. +The scaling supplied by the canonical different identifies its local order with +the coefficient of `finiteExtensionCanonicalDifferentDivisor` at `.inr P`. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance infinityAuxiliaryBaseConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance infinityAuxiliaryBaseConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + .of_algebraMap_eq' rfl + +local instance infinityAuxiliaryIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityAuxiliaryIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance infinityAuxiliaryBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance infinityAuxiliaryIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance infinityAuxiliaryIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityAuxiliaryIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityAuxiliaryIntegralClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance infinityAuxiliaryIntegralClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + .of_algebraMap_eq' rfl + +local instance infinityAuxiliaryBaseFaithfulSmulFractionRing : + FaithfulSMul (RatFuncInfinityIntegers K) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + have hT := IsFractionRing.injective (RatFuncInfinityIntegralClosure K L) + (FractionRing (RatFuncInfinityIntegralClosure K L)) hxy + have hL := congrArg Subtype.val hT + apply Subtype.ext + apply (algebraMap (RatFunc K) L).injective + exact hL + +local instance infinityAuxiliaryFractionRingAlgebra : + Algebra (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := + FractionRing.liftAlgebra (RatFuncInfinityIntegers K) + (FractionRing (RatFuncInfinityIntegralClosure K L)) + +local instance infinityAuxiliaryFractionRingSeparable : + Algebra.IsSeparable (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncInfinityFractionRingEquiv K).symm.toRingEquiv + (FractionRing.algEquiv (RatFuncInfinityIntegralClosure K L) L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncInfinityFractionRingEquiv K).symm + (FractionRing.algEquiv (RatFuncInfinityIntegralClosure K L) L).symm z + +local instance infinityAuxiliaryPlaceIsPrime + (P : FiniteExtensionInfinityPlace K L) : P.1.IsPrime := + Ideal.primesOver.isPrime (ratFuncInfinityPlace K).asIdeal P + +local instance infinityAuxiliaryPlaceLiesOver + (P : FiniteExtensionInfinityPlace K L) : + P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := + Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P + +/-- The localization of the infinity integral closure at one branch. -/ +abbrev FiniteExtensionInfinityPlaceLocalRing + (P : FiniteExtensionInfinityPlace K L) := + Localization.AtPrime + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal + +section InfinityLocalOrder + +variable {K L} + +noncomputable def finiteExtensionInfinityPlaceLocalizationToField + (P : FiniteExtensionInfinityPlace K L) : + FiniteExtensionInfinityPlaceLocalRing K L P →+* L := + IsLocalization.lift + (S := FiniteExtensionInfinityPlaceLocalRing K L P) + (M := (primeOverHeightOne + (ratFuncInfinityPlace K) P).asIdeal.primeCompl) + (g := algebraMap (RatFuncInfinityIntegralClosure K L) L) fun y => + IsLocalization.map_units L + ⟨y.1, (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.primeCompl_le_nonZeroDivisors + y.2⟩ + +omit [DecidableEq K] in +@[simp] theorem finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (P : FiniteExtensionInfinityPlace K L) : + (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P).comp + (algebraMap (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P)) = + algebraMap (RatFuncInfinityIntegralClosure K L) L := by + exact IsLocalization.lift_comp _ + +@[reducible] noncomputable def finiteExtensionInfinityPlaceLocalAlgebra + (P : FiniteExtensionInfinityPlace K L) : + Algebra (FiniteExtensionInfinityPlaceLocalRing K L P) L := + (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P).toAlgebra + +omit [DecidableEq K] in +theorem finiteExtensionInfinityPlaceLocalIsFractionRing + (P : FiniteExtensionInfinityPlace K L) : + letI := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + IsFractionRing (FiniteExtensionInfinityPlaceLocalRing K L P) L := by + letI hIntegralClosureLocalAlgebra : + Algebra (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) := inferInstance + letI := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) L := by + exact IsScalarTower.of_algebraMap_eq' + (R := RatFuncInfinityIntegralClosure K L) + (S := FiniteExtensionInfinityPlaceLocalRing K L P) (A := L) + (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) P).symm + exact IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + (R := RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.primeCompl + (FiniteExtensionInfinityPlaceLocalRing K L P) L + +noncomputable def finiteExtensionInfinityPlaceLocalOrderTop + (P : FiniteExtensionInfinityPlace K L) (x : L) : WithTop ℤ := by + letI := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + exact finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) x + +noncomputable def finiteExtensionInfinityPlaceLocalOrder + (P : FiniteExtensionInfinityPlace K L) (x : L) : ℤ := by + letI := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + exact finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) x + +omit [DecidableEq K] in +theorem finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder + (P : FiniteExtensionInfinityPlace K L) (x : L) : + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P x = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by + letI := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) L := by + exact IsScalarTower.of_algebraMap_eq' + (R := RatFuncInfinityIntegralClosure K L) + (S := FiniteExtensionInfinityPlaceLocalRing K L P) (A := L) + (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) P).symm + change finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) x = _ + exact localizationAtPrime_finitePlaceOrder_eq + (primeOverHeightOne (ratFuncInfinityPlace K) P) x + +omit [DecidableEq K] in +theorem finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder + (P : FiniteExtensionInfinityPlace K L) (x : L) (hx : x ≠ 0) : + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P x = + (finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) x : WithTop ℤ) := by + letI := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + simp only [finiteExtensionInfinityPlaceLocalOrderTop] + rw [finitePlaceOrderTop_eq_coe _ _ hx] + exact_mod_cast finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder + (K := K) (L := L) P x + +omit [DecidableEq K] in +@[simp] theorem finiteExtensionInfinityPlaceLocalOrderTop_mul + (P : FiniteExtensionInfinityPlace K L) (x y : L) : + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (x * y) = + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P x + + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P y := by + simp only [finiteExtensionInfinityPlaceLocalOrderTop, + finitePlaceOrderTop_mul] + +omit [DecidableEq K] in +@[simp] theorem finiteExtensionInfinityPlaceLocalOrderTop_pow + (P : FiniteExtensionInfinityPlace K L) (x : L) (n : ℕ) : + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (x ^ n) = + n • finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P x := by + simp only [finiteExtensionInfinityPlaceLocalOrderTop, + finitePlaceOrderTop_pow] + +end InfinityLocalOrder + +section InfinityLocalAuxiliaryBounds + +variable {K L} +variable {C : Type*} [Field C] [Algebra C L] + +omit [DecidableEq K] in +/-- Preservation of the infinity integral closure propagates to the selected +localized branch. -/ +theorem finiteExtensionInfinityPlace_local_preserves_of_global_preserves + (P : FiniteExtensionInfinityPlace K L) + (E : Derivation C L L) + (hE : ∀ t : RatFuncInfinityIntegralClosure K L, + ∃ t' : RatFuncInfinityIntegralClosure K L, + E (algebraMap (RatFuncInfinityIntegralClosure K L) L t) = + algebraMap (RatFuncInfinityIntegralClosure K L) L t') : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + E (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s := by + letI hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) L := by + exact IsScalarTower.of_algebraMap_eq' + (R := RatFuncInfinityIntegralClosure K L) + (S := FiniteExtensionInfinityPlaceLocalRing K L P) (A := L) + (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) P).symm + exact ambientDerivation_preserves_localizationAtPrime_of_preserves + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal E hE + +/-- The infinity different supplies the exact canonical scaling coefficient. +The reciprocal-parameter derivations are explicit inputs: `Es` preserves the +infinity valuation ring and `D = -s² Es` after restricting constants. -/ +theorem exists_finiteExtensionInfinityPlace_canonicalDifferent_scaling_certificate + [Algebra K L] [IsScalarTower K (RatFunc K) L] + [IsScalarTower K (RatFuncInfinityIntegers K) L] + [IsScalarTower K (RatFuncInfinityIntegralClosure K L) L] + [IsScalarTower (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) L] + [Algebra K C] [IsScalarTower K C L] + (D : Derivation C L L) + (Ds : Derivation K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegers K)) + (Es : Derivation K L L) + (hEs : ∀ r : RatFuncInfinityIntegers K, + Es (algebraMap (RatFuncInfinityIntegers K) L r) = + algebraMap (RatFuncInfinityIntegers K) L (Ds r)) + (hDX : D.restrictScalars K = + (-(algebraMap (RatFuncInfinityIntegers K) L + (ratFuncInfinityUniformizer K)) ^ 2) • Es) + (P : FiniteExtensionInfinityPlace K L) : + ∃ c : L, c ≠ 0 ∧ + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) ∧ + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s := by + let q := primeOverHeightOne (ratFuncInfinityPlace K) P + letI : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by + simpa [q] using + (Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P) + have hs : ratFuncInfinityUniformizer K ≠ 0 := by + intro hsZero + have hcoe : (ratFuncInfinityUniformizer K : RatFunc K) = 0 := + congrArg Subtype.val hsZero + exact (ratFuncInfinityUniformizer_isUniformizer K).ne_zero hcoe + obtain ⟨δ, hδ, _hδmem, _hδmult, hOrder, hPreserves⟩ := + exists_infinity_different_localGenerator_scaling_certificate + (C := K) (S := RatFuncInfinityIntegers K) + (T := RatFuncInfinityIntegralClosure K L) (L := L) + (ratFuncInfinityPlace K) q (ratFuncInfinityUniformizer K) hs + (ratFuncInfinityPlace_span_uniformizer K) Ds Es + (D.restrictScalars K) hEs hDX + let c : L := + -(algebraMap (RatFuncInfinityIntegralClosure K L) L δ) / + (algebraMap (RatFuncInfinityIntegers K) L + (ratFuncInfinityUniformizer K)) ^ 2 + have hδL : algebraMap (RatFuncInfinityIntegralClosure K L) L δ ≠ 0 := by + simpa using + (IsFractionRing.injective (RatFuncInfinityIntegralClosure K L) L).ne hδ + have hsL : algebraMap (RatFuncInfinityIntegers K) L + (ratFuncInfinityUniformizer K) ≠ 0 := by + have hsT : algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) + (ratFuncInfinityUniformizer K) ≠ 0 := by + simpa using (FaithfulSMul.algebraMap_injective + (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).ne hs + rw [IsScalarTower.algebraMap_apply (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) L] + exact (IsFractionRing.injective + (RatFuncInfinityIntegralClosure K L) L).ne hsT + have hc : c ≠ 0 := div_ne_zero (neg_ne_zero.mpr hδL) (pow_ne_zero 2 hsL) + have hGlobal : ∀ t : RatFuncInfinityIntegralClosure K L, + ∃ t' : RatFuncInfinityIntegralClosure K L, + (c • D) (algebraMap (RatFuncInfinityIntegralClosure K L) L t) = + algebraMap (RatFuncInfinityIntegralClosure K L) L t' := by + intro t + obtain ⟨t', ht'⟩ := hPreserves t + refine ⟨t', ?_⟩ + simpa only [c, Derivation.smul_apply, Algebra.smul_def, + Algebra.algebraMap_self_apply, Derivation.restrictScalars_apply] using ht' + refine ⟨c, hc, ?_, ?_⟩ + · rw [primeOverHeightOne_asIdeal] at hOrder + simpa only [c, finiteExtensionCanonicalDifferentDivisor_inr] using hOrder + · exact finiteExtensionInfinityPlace_local_preserves_of_global_preserves + (K := K) (L := L) P (c • D) hGlobal + +omit [DecidableEq K] in +/-- Infinity-place source case (iii), after scaling a global derivation by a +factor preserving the infinity integral closure. -/ +theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseIII_of_scaled_preserves + (P : FiniteExtensionInfinityPlace K L) + (h k : ℕ) {n : ℕ} + (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilon i = (e i : ℕ)) + (D : Derivation C L L) (c : L) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) * + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P u + + (h * k) * + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P v + + k * finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P c + + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + letI hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + have hbound := + finitePlaceOrderTop_auxiliaryFamily_caseIII_source_lower_bound_of_preserves + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) + (c • D) hScaledLocal h k epsilon u v hu hv hu1 hv1 + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilon hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + change (((_ : ℤ) : WithTop ℤ) ≤ _) at hbound + rw [hchange, finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] at hbound + exact hbound + +omit [DecidableEq K] in +/-- Infinity-place source case (iv), with the same exact scaling correction. -/ +theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseIV_of_scaled_preserves + (P : FiniteExtensionInfinityPlace K L) + (h k : ℕ) {n : ℕ} + (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilon i = (e i : ℕ)) + (D : Derivation C L L) (c : L) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) * + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P u + + k * finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P c + + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + letI hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra + (K := K) (L := L) P + letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + have hbound := + finitePlaceOrderTop_auxiliaryFamily_caseIV_source_lower_bound_of_preserves + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) + (c • D) hScaledLocal h k epsilon u v hu hv hu1 hv1 + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilon hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + change (((_ : ℤ) : WithTop ℤ) ≤ _) at hbound + rw [hchange, finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] at hbound + exact hbound + +end InfinityLocalAuxiliaryBounds + +section InfinityGlobalOrderHelpers + +variable {K L} + +@[simp] theorem finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder + (x : L) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L x (.inr P) = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by + rw [finiteExtensionPrincipalDivisor_inr] + symm + simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using + fractionRingAlgEquiv_finitePlaceOrder_eq + (R := RatFuncInfinityIntegralClosure K L) (L := L) + (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + +private theorem finiteExtensionInfinityPlace_gridOrder_sum_eq + (P : FiniteExtensionInfinityPlace K L) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) (h k : ℕ) : + (∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) = + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inr P) := by + have hdiv := congrArg + (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inr P)) + (finiteExtensionPrincipalDivisor_auxiliaryGridProduct K L u v hu hv h k) + rw [hdiv] + rw [Finset.sum_apply'] + apply Finset.sum_congr rfl + intro rs hrs + have hmul := congrArg + (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inr P)) + (finiteExtensionPrincipalDivisor_mul K L + (u ^ (rs.1 : ℕ)) (v ^ (rs.2 : ℕ)) + (pow_ne_zero _ hu) (pow_ne_zero _ hv)) + have hupow := congrArg + (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inr P)) + (finiteExtensionPrincipalDivisor_pow K L u hu (rs.1 : ℕ)) + have hvpow := congrArg + (fun D : FiniteExtensionPlace K L →₀ ℤ => D (.inr P)) + (finiteExtensionPrincipalDivisor_pow K L v hv (rs.2 : ℕ)) + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] at hmul hupow hvpow + rw [hmul, hupow, hvpow] + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] + +private theorem infinityAuxiliaryFamilyDerivativeOrder_sum_int (h k : ℕ) : + (∑ i : Sum (Fin k) (Fin (k + 1) × Fin h), + (auxiliaryFamilyDerivativeOrder h k i : ℤ)) = + ((h * k + h + k).choose 2 : ℤ) := by + exact_mod_cast auxiliaryFamilyDerivativeOrder_sum h k + +end InfinityGlobalOrderHelpers + +section InfinityCanonicalAuxiliaryCases + +variable {K L} +variable {C : Type*} [Field C] [Algebra C L] + +/-- Infinity source case (iii), expressed with the actual canonical different +coefficient and exhaustive principal divisors. -/ +theorem finiteExtensionInfinityPlace_canonicalAuxiliary_caseIII_of_scaling + (P : FiniteExtensionInfinityPlace K L) + (D : Derivation C L L) (c : L) (hc : c ≠ 0) + (hcOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P)) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u (.inr P) + + ((h * k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L v (.inr P) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inr P) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inr P) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P) := by + have hbound := + finiteExtensionInfinityPlace_auxiliaryFamily_caseIII_of_scaled_preserves + (K := K) (L := L) P h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + D c hScaledLocal u v hu hv hu1 hv1 + rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, + finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, + finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder] at hbound + simp_rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder] at hbound + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P c hc, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P _ hW] at hbound + have hboundInt : + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) u + + ((h * k : ℕ) : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) v + + (k : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i : Sum (Fin k) (Fin (k + 1) × Fin h), + (auxiliaryFamilyDerivativeOrder h k i : ℤ) ≤ + (h * k + h + k).choose 2 • + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c + + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + rw [infinityAuxiliaryFamilyDerivativeOrder_sum_int, + finiteExtensionInfinityPlace_gridOrder_sum_eq P u v hu hv h k, + hcOrder] at hboundInt + simpa only [nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using + hboundInt + +/-- Infinity source case (iv), in the same canonical global-divisor form. -/ +theorem finiteExtensionInfinityPlace_canonicalAuxiliary_caseIV_of_scaling + (P : FiniteExtensionInfinityPlace K L) + (D : Derivation C L L) (c : L) (hc : c ≠ 0) + (hcOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P)) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u (.inr P) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inr P) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inr P) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P) := by + have hbound := + finiteExtensionInfinityPlace_auxiliaryFamily_caseIV_of_scaled_preserves + (K := K) (L := L) P h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + D c hScaledLocal u v hu hv hu1 hv1 + rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, + finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder] at hbound + simp_rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder] at hbound + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P c hc, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P _ hW] at hbound + have hboundInt : + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) u + + (k : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i : Sum (Fin k) (Fin (k + 1) × Fin h), + (auxiliaryFamilyDerivativeOrder h k i : ℤ) ≤ + (h * k + h + k).choose 2 • + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c + + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + rw [infinityAuxiliaryFamilyDerivativeOrder_sum_int, + finiteExtensionInfinityPlace_gridOrder_sum_eq P u v hu hv h k, + hcOrder] at hboundInt + simpa only [nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using + hboundInt + +end InfinityCanonicalAuxiliaryCases + +section InfinityCaseII + +variable {K L} +variable {C : Type*} [Field C] [Algebra C L] + +omit [DecidableEq K] in +theorem finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative + (P : FiniteExtensionInfinityPlace K L) (x : L) + (hx : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P x) : + ∃ x₀ : FiniteExtensionInfinityPlaceLocalRing K L P, + x = finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P x₀ := by + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + by_cases hx0 : x = 0 + · exact ⟨0, by simp [hx0]⟩ + have horder : 0 ≤ finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) x := by + simpa only [finiteExtensionInfinityPlaceLocalOrderTop, + finitePlaceOrderTop_eq_coe _ _ hx0, WithTop.coe_nonneg] using hx + have hval : + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)).valuation L x ≤ 1 := by + rw [valuation_eq_exp_neg_finitePlaceOrder _ x hx0] + simpa only [← WithZero.exp_zero] using + (WithZero.exp_le_exp.mpr (by omega : + -finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) x ≤ 0)) + obtain ⟨x₀, hx₀⟩ := IsDiscreteValuationRing.exists_lift_of_le_one hval + exact ⟨x₀, hx₀.symm⟩ + +omit [DecidableEq K] in +theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseII_of_scaled_preserves + (P : FiniteExtensionInfinityPlace K L) + (h k : ℕ) {n : ℕ} + (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilon i = (e i : ℕ)) + (D : Derivation C L L) (c : L) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (u v : L) + (hu : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P u) + (hv : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P v) + (hrho : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + ((1 - u) / (1 - v))) : + (0 : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P c + + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + have hbound := finitePlaceOrderTop_auxiliaryFamily_caseII_nonnegative_of_integral + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) + (c • D) hScaledLocal h k epsilon u v + (by + obtain ⟨u₀, hu₀⟩ := + finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative + P u hu + exact ⟨u₀, hu₀⟩) + (by + obtain ⟨v₀, hv₀⟩ := + finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative + P v hv + exact ⟨v₀, hv₀⟩) + (by + obtain ⟨rho₀, hrho₀⟩ := + finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative + P ((1 - u) / (1 - v)) hrho + exact ⟨rho₀, hrho₀⟩) + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilon hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + rw [hchange, finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] at hbound + exact hbound + +theorem finiteExtensionInfinityPlace_canonicalAuxiliary_caseII_of_scaling + (P : FiniteExtensionInfinityPlace K L) + (D : Derivation C L L) (c : L) (hc : c ≠ 0) + (hcOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P)) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (h k : ℕ) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : 0 ≤ + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) u) + (hvOrder : 0 ≤ + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) v) + (hrhoOrder : 0 ≤ + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((1 - u) / (1 - v))) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P) := by + have hrho : (1 - u) / (1 - v) ≠ 0 := + div_ne_zero (sub_ne_zero.mpr hu1.symm) (sub_ne_zero.mpr hv1.symm) + have huTop : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P u := by + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P u hu] + exact_mod_cast huOrder + have hvTop : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P v := by + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P v hv] + exact_mod_cast hvOrder + have hrhoTop : (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + ((1 - u) / (1 - v)) := by + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P _ hrho] + exact_mod_cast hrhoOrder + have hbound := + finiteExtensionInfinityPlace_auxiliaryFamily_caseII_of_scaled_preserves + (K := K) (L := L) P h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + D c hScaledLocal u v huTop hvTop hrhoTop + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P c hc, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P _ hW] at hbound + have hboundInt : + 0 ≤ (h * k + h + k).choose 2 • + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c + + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + rw [hcOrder] at hboundInt + simpa only [nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using hboundInt + +end InfinityCaseII + +section InfinityResiduePerfect + +variable {K L} + +theorem ratFuncInfinityPlace_residueField_finite [Fintype K] : + Finite (ratFuncInfinityPlace K).asIdeal.ResidueField := by + exact Finite.of_injective (ratFuncInfinityPlaceResidueEquiv K) + (ratFuncInfinityPlaceResidueEquiv K).injective + +theorem finiteExtensionInfinityPlace_residueField_finite [Fintype K] + (P : FiniteExtensionInfinityPlace K L) : Finite P.1.ResidueField := by + let p := (ratFuncInfinityPlace K).asIdeal + letI : Finite p.ResidueField := + ratFuncInfinityPlace_residueField_finite (K := K) + letI : P.1.LiesOver p := by + simpa [p] using Ideal.primesOver.liesOver + (ratFuncInfinityPlace K).asIdeal P + letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance + letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + exact Module.finite_of_finite p.ResidueField + +theorem finiteExtensionInfinityPlaceLocal_residueField_perfect [Fintype K] + (P : FiniteExtensionInfinityPlace K L) : + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + PerfectField + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal.ResidueField := by + let q := (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal + letI : Finite q.ResidueField := by + simpa [q, primeOverHeightOne_asIdeal] using + finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P + letI : Finite (HasQuotient.Quotient + (RatFuncInfinityIntegralClosure K L) q) := + Finite.of_injective + (algebraMap (HasQuotient.Quotient + (RatFuncInfinityIntegralClosure K L) q) q.ResidueField) + q.injective_algebraMap_quotient_residueField + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + let e := IsLocalization.AtPrime.equivQuotMaximalIdeal q + (FiniteExtensionInfinityPlaceLocalRing K L P) + letI : Finite (HasQuotient.Quotient + (FiniteExtensionInfinityPlaceLocalRing K L P) + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal) := + Finite.of_injective e.symm e.symm.injective + let Rq := HasQuotient.Quotient + (FiniteExtensionInfinityPlaceLocalRing K L P) + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal + letI : Finite + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal.ResidueField := + IsLocalization.finite Rq (nonZeroDivisors Rq) + exact PerfectField.ofFinite + +end InfinityResiduePerfect + +section InfinityCaseI + +variable {K L} +variable {p : ℕ} [Fact p.Prime] [CharP L p] + +private theorem infinityPlaceOrder_gridMonomial_eq_zero + (P : FiniteExtensionInfinityPlace K L) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huOrder : finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) u = 0) + (hvOrder : finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) v = 0) + (i j : ℕ) : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (u ^ i * v ^ j) = 0 := by + have hmul := congrArg + (fun E : FiniteExtensionPlace K L →₀ ℤ => E (.inr P)) + (finiteExtensionPrincipalDivisor_mul K L + (u ^ i) (v ^ j) (pow_ne_zero _ hu) (pow_ne_zero _ hv)) + have hupow := congrArg + (fun E : FiniteExtensionPlace K L →₀ ℤ => E (.inr P)) + (finiteExtensionPrincipalDivisor_pow K L u hu i) + have hvpow := congrArg + (fun E : FiniteExtensionPlace K L →₀ ℤ => E (.inr P)) + (finiteExtensionPrincipalDivisor_pow K L v hv j) + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] at hmul hupow hvpow + rw [hmul, hupow, hvpow, huOrder, hvOrder] + simp + +theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseI_of_scaled_preserves + [Fintype K] + (P : FiniteExtensionInfinityPlace K L) + (h k : ℕ) {n : ℕ} + (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilonOrder i = (e i : ℕ)) + (epsilon qBound : ℕ) + (D : Derivation (frobeniusSubfield L p) L L) (c : L) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (u v : L) + (hrhoNe : (1 - u) / (1 - v) ≠ 0) + (huOrder : + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P u = 0) + (hrhoOrder : + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + ((1 - u) / (1 - v)) < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ qBound) : + (((qBound : ℤ) * + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + ((1 - u) / (1 - v)) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P c + + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u v h k)).det := by + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing + (K := K) (L := L) P + letI : IsDiscreteValuationRing + (FiniteExtensionInfinityPlaceLocalRing K L P) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot + (FiniteExtensionInfinityPlaceLocalRing K L P) + letI : CharP (FiniteExtensionInfinityPlaceLocalRing K L P) p := ⟨by + intro m + rw [← map_eq_zero_iff + (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P) + (by + change Function.Injective + (algebraMap (FiniteExtensionInfinityPlaceLocalRing K L P) L) + exact IsFractionRing.injective + (FiniteExtensionInfinityPlaceLocalRing K L P) L), + map_natCast, CharP.cast_eq_zero_iff L p]⟩ + letI : PerfectField + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal.ResidueField := + finiteExtensionInfinityPlaceLocal_residueField_perfect + (K := K) (L := L) P + obtain ⟨A, hAdet, hdet, hbound⟩ := + exists_frobeniusSubfield_dedekindAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue + (p := p) + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionInfinityPlaceLocalRing K L P)) + (c • D) hScaledLocal u v h k epsilonOrder epsilon qBound + hrhoNe huOrder hrhoOrder hgridRegular hepsilonInjective + hepsilonMax hk hepsilonQ + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilonOrder hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + rw [hchange, finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] at hbound + change (((qBound : ℤ) * + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + ((1 - u) / (1 - v)) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P c + + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u v h k)).det at hbound + exact hbound + +theorem finiteExtensionInfinityPlace_canonicalAuxiliary_caseI_of_scaling + [Fintype K] + (P : FiniteExtensionInfinityPlace K L) + (D : Derivation (frobeniusSubfield L p) L L) + (c : L) (hc : c ≠ 0) + (hcOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P)) + (hScaledLocal : + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s) + (h k : ℕ) (hn : 0 < h * k + h + k) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) u = 0) + (hvOrder : finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) v = 0) + (hrhoOrder : finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((1 - u) / (1 - v)) < 0) + (hW : (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) : + ((h * k + h + k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inr P) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P) := by + let n := h * k + h + k + have hrho : (1 - u) / (1 - v) ≠ 0 := + div_ne_zero (sub_ne_zero.mpr hu1.symm) (sub_ne_zero.mpr hv1.symm) + have huTop : + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P u = 0 := by + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P u hu] + exact_mod_cast huOrder + have hrhoLocal : + finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P + ((1 - u) / (1 - v)) < 0 := by + rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder] + exact hrhoOrder + have hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) := by + intro rs + have hmonomial : u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) ≠ 0 := + mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv) + rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P _ hmonomial] + have hzero := infinityPlaceOrder_gridMonomial_eq_zero + (K := K) (L := L) P u v hu hv huOrder hvOrder + (rs.1 : ℕ) (rs.2 : ℕ) + rw [hzero] + exact le_rfl + have hepsilonMax : ∀ i, auxiliaryFamilyDerivativeOrder h k i ≤ n - 1 := by + intro i + exact auxiliaryFamilyDerivativeOrder_le_pred h k hn i + have hkBound : k ≤ (n - 1) + 1 := by + have hcancel : n - 1 + 1 = n := Nat.sub_add_cancel hn + rw [hcancel] + exact auxiliaryFamily_k_le_card h k + have hepsilonQ : (n - 1) + 1 ≤ n := by + rw [Nat.sub_add_cancel hn] + have hbound := + finiteExtensionInfinityPlace_auxiliaryFamily_caseI_of_scaled_preserves + (K := K) (L := L) (p := p) P h k + (auxiliaryFamilyIndexEquiv h k) + (auxiliaryFamilyDerivativeOrder h k) (fun _ => rfl) + (n - 1) n D c hScaledLocal u v hrho huTop hrhoLocal + hgridRegular (auxiliaryFamilyDerivativeOrder_injective h k) + hepsilonMax hkBound hepsilonQ + rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P c hc, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P _ hW] at hbound + have hboundInt : + (n : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((1 - u) / (1 - v)) ≤ + n.choose 2 • + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c + + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det := by + exact_mod_cast hbound + rw [hcOrder] at hboundInt + simpa only [n, nsmul_eq_mul, + finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using hboundInt + +end InfinityCaseI + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean new file mode 100644 index 0000000000..3f4028b1e0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean @@ -0,0 +1,341 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +import Mathlib.RingTheory.RamificationInertia.Basic + +/-! +# The canonical different divisor of a finite function-field extension + +For a finite separable extension `L / K(X)`, this module packages the local +correction divisor of the differential `dX`. Its coefficient is the different +exponent at a finite place and `different exponent - 2 * ramification index` +above infinity. The weighted degree is therefore the total different degree +minus twice the extension degree. +-/ + +open scoped BigOperators nonZeroDivisors Polynomial +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) canonicalDifferentPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance canonicalDifferentPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance canonicalDifferentFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance canonicalDifferentFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance canonicalDifferentPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance canonicalDifferentFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance canonicalDifferentFiniteBaseFaithfulSmulFractionRing : + FaithfulSMul K[X] + (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + have hS := IsFractionRing.injective (RatFuncFiniteIntegralClosure K L) + (FractionRing (RatFuncFiniteIntegralClosure K L)) hxy + exact FunctionField.ringOfIntegers.algebraMap_injective K L hS + +local instance canonicalDifferentFiniteFractionRingAlgebra : + Algebra (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := + FractionRing.liftAlgebra K[X] + (FractionRing (RatFuncFiniteIntegralClosure K L)) + +local instance canonicalDifferentFiniteFractionRingSeparable : + Algebra.IsSeparable (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncFiniteFractionRingEquiv K).symm.toRingEquiv + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncFiniteFractionRingEquiv K).symm + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm z + +local instance canonicalDifferentInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance canonicalDifferentInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance canonicalDifferentInfinityTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance canonicalDifferentInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance canonicalDifferentInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance canonicalDifferentInfinityIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance canonicalDifferentInfinityPlaceFintype : + Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + +/-- The finite-place part of the different divisor, with integer coefficients. -/ +def finiteExtensionFiniteDifferentDivisor + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) : + FiniteExtensionFinitePlace K L →₀ ℤ := + (differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) hDifferent).mapRange + (fun n : ℕ => (n : ℤ)) (by simp) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +@[simp] theorem finiteExtensionFiniteDifferentDivisor_apply + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionFiniteDifferentDivisor K L hDifferent q = + (multiplicity q.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) : ℤ) := by + simp [finiteExtensionFiniteDifferentDivisor, + differentMultiplicityDivisor_apply] + +/-- Above infinity, the canonical correction is the different exponent minus +twice the ramification index over the parameter `X⁻¹`. -/ +def finiteExtensionInfinityCanonicalDifferentDivisor : + FiniteExtensionInfinityPlace K L →₀ ℤ := + Finsupp.equivFunOnFinite.symm (fun P => + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ)) + +omit [DecidableEq K] in +@[simp] theorem finiteExtensionInfinityCanonicalDifferentDivisor_apply + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionInfinityCanonicalDifferentDivisor K L P = + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + simp [finiteExtensionInfinityCanonicalDifferentDivisor] + +/-- The exhaustive canonical divisor attached to `dX`: the finite different +at finite places and `different - 2e` above infinity. -/ +def finiteExtensionCanonicalDifferentDivisor + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) : + FiniteExtensionPlace K L →₀ ℤ := + (finiteExtensionFiniteDifferentDivisor K L hDifferent).sumElim + (finiteExtensionInfinityCanonicalDifferentDivisor K L) + +omit [DecidableEq K] in +@[simp] theorem finiteExtensionCanonicalDifferentDivisor_inl + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionCanonicalDifferentDivisor K L hDifferent (.inl q) = + (multiplicity q.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) : ℤ) := by + simp [finiteExtensionCanonicalDifferentDivisor] + +omit [DecidableEq K] in +@[simp] theorem finiteExtensionCanonicalDifferentDivisor_inr + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionCanonicalDifferentDivisor K L hDifferent (.inr P) = + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + simp [finiteExtensionCanonicalDifferentDivisor] + +/-- Residue- and base-place-degree weighted finite different degree. -/ +def finiteExtensionFiniteDifferentDegree + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) : ℕ := + (differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) hDifferent).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) + +omit [DecidableEq K] in +theorem finiteExtensionInfinity_sum_ramification_inertia_eq_finrank : + (∑ P : FiniteExtensionInfinityPlace K L, + P.1.ramificationIdx (RatFuncInfinityIntegers K) * + P.1.inertiaDeg (RatFuncInfinityIntegers K)) = + Module.finrank (RatFunc K) L := by + calc + _ = Module.finrank (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + Ideal.sum_ramification_inertia_eq_finrank + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L) + _ = Module.finrank (RatFunc K) L := + (Algebra.IsAlgebraic.finrank_of_isFractionRing + (RatFuncInfinityIntegers K) (RatFunc K) + (RatFuncInfinityIntegralClosure K L) L).symm + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- The finite different is nonzero in the separable extension model. -/ +theorem finiteExtensionFiniteDifferentIdeal_ne_bot : + differentIdeal K[X] (RatFuncFiniteIntegralClosure K L) ≠ ⊥ := by + exact differentIdeal_ne_bot + +/-- Degree formula for the canonical different divisor, given the standard +ramification-inertia sum above infinity. -/ +theorem finiteExtensionCanonicalDifferentDivisor_degree_of_ramification_sum + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (hRamification : + (∑ P : FiniteExtensionInfinityPlace K L, + P.1.ramificationIdx (RatFuncInfinityIntegers K) * + P.1.inertiaDeg (RatFuncInfinityIntegers K)) = + Module.finrank (RatFunc K) L) : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L hDifferent) = + (finiteExtensionFiniteDifferentDegree K L hDifferent : ℤ) + + (infinityDifferentDegree K L : ℤ) - + 2 * (Module.finrank (RatFunc K) L : ℤ) := by + rw [finiteExtensionDivisorDegree, finiteExtensionCanonicalDifferentDivisor, + Finsupp.sum_sumElim] + have hfinite : + (finiteExtensionFiniteDifferentDivisor K L hDifferent).sum + (fun q e => e * + (finiteExtensionPlaceDegree K L (.inl q) : ℤ)) = + (finiteExtensionFiniteDifferentDegree K L hDifferent : ℤ) := by + rw [finiteExtensionFiniteDifferentDivisor, + Finsupp.sum_mapRange_index (fun _ => by simp)] + simp only [finiteExtensionPlaceDegree] + rw [finiteExtensionFiniteDifferentDegree, Nat.cast_finsupp_sum] + apply Finsupp.sum_congr + intro q hq + push_cast + ring + have hfinite' : + (finiteExtensionFiniteDifferentDivisor K L hDifferent).sum + ((fun v e => e * + (finiteExtensionPlaceDegree K L v : ℤ)) ∘ Sum.inl) = + (finiteExtensionFiniteDifferentDegree K L hDifferent : ℤ) := by + change + (finiteExtensionFiniteDifferentDivisor K L hDifferent).sum + (fun q e => e * + (finiteExtensionPlaceDegree K L (.inl q) : ℤ)) = _ + exact hfinite + rw [hfinite'] + rw [Finsupp.sum_fintype _ _ (fun _ => by simp)] + simp only [Function.comp_apply, finiteExtensionPlaceDegree, + finiteExtensionInfinityCanonicalDifferentDivisor_apply] + rw [infinityDifferentDegree, Nat.cast_sum] + push_cast + rw [← hRamification] + push_cast + simp_rw [sub_mul] + rw [Finset.sum_sub_distrib] + have hdiff : + (∑ P : FiniteExtensionInfinityPlace K L, + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) * + (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ)) = + ∑ P : FiniteExtensionInfinityPlace K L, + (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ) * + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) := by + apply Finset.sum_congr rfl + intro P hP + ring + rw [hdiff] + simp_rw [mul_assoc] + rw [← Finset.mul_sum] + ring + +/-- The canonical different divisor has weighted degree equal to the finite +different degree plus the infinity different degree minus twice `[L : K(X)]`.-/ +theorem finiteExtensionCanonicalDifferentDivisor_degree : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + (finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) : ℤ) + + (infinityDifferentDegree K L : ℤ) - + 2 * (Module.finrank (RatFunc K) L : ℤ) := by + exact finiteExtensionCanonicalDifferentDivisor_degree_of_ramification_sum + K L (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + (finiteExtensionInfinity_sum_ramification_inertia_eq_finrank K L) + +/-- Separate finite-discriminant and complementary infinity bounds combine +into the expected canonical bound `totalDifferent - 2 * [L : K(X)]`. -/ +theorem finiteExtensionCanonicalDifferentDivisor_degree_le_of_bounds + (finiteDiscriminantDegree totalDifferentBudget : ℕ) + (hFinite : finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) ≤ + finiteDiscriminantDegree) + (hInfinity : (infinityDifferentDegree K L : ℤ) ≤ + (totalDifferentBudget : ℤ) - (finiteDiscriminantDegree : ℤ)) : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + (totalDifferentBudget : ℤ) - + 2 * (Module.finrank (RatFunc K) L : ℤ) := by + rw [finiteExtensionCanonicalDifferentDivisor_degree] + have hFiniteInt : + (finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) : ℤ) ≤ + (finiteDiscriminantDegree : ℤ) := by + exact_mod_cast hFinite + omega + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean new file mode 100644 index 0000000000..2fbe548b80 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +import Mathlib.Tactic + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The exact integer-valued canonical Wronskian inequality, together with +the one-minus divisor comparison, implies the numerical bound of Proposition +2 for the exhaustive gcd divisor. -/ +theorem finiteExtensionGcdBound_of_canonicalWronskianInequality + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) + (h k : ℕ) (hn : 0 < h * k + h + k) (chi : ℕ) + (hWronskian : + Int.ofNat (h * k) * + Int.ofNat (finiteExtensionPositiveDegree K L v) - + Int.ofNat k * + (Int.ofNat (finiteExtensionPositiveDegree K L v) + + Int.ofNat (finiteExtensionPositiveDegree K L u)) - + Int.ofNat ((h * k + h + k).choose 2) * Int.ofNat chi ≤ + Int.ofNat (h * k + h + k) * + Int.ofNat (finiteExtensionOutsideHeight K L ((1 - u) / (1 - v)) + (propositionTwoExceptionalPlaces K L u v))) : + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) ≤ + (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * + (finiteExtensionPositiveDegree K L v : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * + (finiteExtensionPositiveDegree K L u : ℝ) + + (((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ)) := by + let H : ℕ := finiteExtensionOutsideHeight K L ((1 - u) / (1 - v)) + (propositionTwoExceptionalPlaces K L u v) + have hsum := + finiteExtensionOneSubGcd_add_outsideHeight_le_positiveDegree_coordinate + K L u v hu hv huone hvone + have hsumReal : + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) + + (H : ℝ) ≤ (finiteExtensionPositiveDegree K L v : ℝ) := by + dsimp only [H] + exact_mod_cast hsum + have hGHeight : + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) ≤ + (finiteExtensionPositiveDegree K L v : ℝ) - (H : ℝ) := by + linarith + have hWronskianCast : + ((Int.ofNat (h * k) * + Int.ofNat (finiteExtensionPositiveDegree K L v) - + Int.ofNat k * + (Int.ofNat (finiteExtensionPositiveDegree K L v) + + Int.ofNat (finiteExtensionPositiveDegree K L u)) - + Int.ofNat ((h * k + h + k).choose 2) * Int.ofNat chi : ℤ) : ℝ) ≤ + ((Int.ofNat (h * k + h + k) * Int.ofNat H : ℤ) : ℝ) := + Int.cast_le.mpr hWronskian + push_cast at hWronskianCast + have hWronskianReal : + (((h * k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L v : ℝ) - + (k : ℝ) * + ((finiteExtensionPositiveDegree K L v : ℝ) + + (finiteExtensionPositiveDegree K L u : ℝ)) - + (((h * k + h + k).choose 2 : ℕ) : ℝ) * (chi : ℝ) ≤ + ((h * k + h + k : ℕ) : ℝ) * (H : ℝ)) := by + simpa only [Int.ofNat_eq_natCast, Int.cast_mul, Int.cast_natCast, + Nat.cast_mul] using hWronskianCast + apply gcdBound_of_globalWronskianInequality + (finiteExtensionPositiveDegree K L v : ℝ) + (finiteExtensionPositiveDegree K L u : ℝ) + (chi : ℝ) + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) + (H : ℝ) h k hn hGHeight + simpa only [Nat.cast_choose_two] using hWronskianReal + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean new file mode 100644 index 0000000000..324f2fe954 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +import Mathlib.Tactic + +/-! +# Canonical placewise bounds imply the exhaustive gcd estimate + +This is the global composition boundary for Corvaja--Zannier Proposition 2. +It fixes the canonical different divisor and the direct zero-and-pole +exceptional set, discharges all support bookkeeping, performs the exhaustive +weighted place sum, and then converts the resulting Wronskian inequality into +the numerical gcd estimate. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +attribute [local instance] Classical.decEq + +/-- The four canonical local estimates, together with the logarithmic Euler +degree bound, imply the exact exhaustive weighted gcd bound of Proposition 2. +-/ +theorem finiteExtensionGcdBound_of_canonicalPlacewiseBounds + (u v W : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) (hW : W ≠ 0) + (h k : ℕ) (hn : 0 < h * k + h + k) (chi : ℕ) + (hEuler : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + + (∑ P ∈ propositionTwoExceptionalPlaces K L u v, + finiteExtensionPlaceDegree K L P : ℤ) ≤ (chi : ℤ)) + (hCaseI : ∀ P, + P ∉ propositionTwoExceptionalPlaces K L u v → + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) P < 0 → + ((h * k + h + k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) P ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) P + + finiteExtensionPrincipalDivisor K L W P) + (hCaseII : ∀ P, + P ∉ propositionTwoExceptionalPlaces K L u v → + 0 ≤ finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) P → + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) P + + finiteExtensionPrincipalDivisor K L W P) + (hCaseIII : ∀ P, + P ∈ propositionTwoExceptionalPlaces K L u v → + 0 < finiteExtensionPrincipalDivisor K L v P → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u P + + ((h * k : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L v P + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) P + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) P - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) P + + finiteExtensionPrincipalDivisor K L W P) + (hCaseIV : ∀ P, + P ∈ propositionTwoExceptionalPlaces K L u v → + finiteExtensionPrincipalDivisor K L v P ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u P + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) P + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) P - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) P + + finiteExtensionPrincipalDivisor K L W P) : + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L v : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L u : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + let S := propositionTwoExceptionalPlaces K L u v + let canonical := finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + let rho := (1 - u) / (1 - v) + let grid := finiteExtensionAuxiliaryGridProduct L u v h k + have hgrid : grid ≠ 0 := by + dsimp only [grid, finiteExtensionAuxiliaryGridProduct] + exact Finset.prod_ne_zero_iff.mpr fun rs _ => + mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv) + have hUOutside : ∀ P, P ∉ S → + finiteExtensionPrincipalDivisor K L u P = 0 := by + intro P hP + exact + finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v P hP + have hGridOutside : ∀ P, P ∉ S → + finiteExtensionPrincipalDivisor K L grid P = 0 := by + intro P hP + exact + finiteExtensionPrincipalDivisor_auxiliaryGridProduct_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v hu hv h k P hP + have hVPositiveSupport : ∀ P, + 0 < finiteExtensionPrincipalDivisor K L v P → P ∈ S := by + intro P hP + exact mem_propositionTwoExceptionalPlaces_of_v_order_pos K L u v P hP + have hRhoSupport : + -((finiteExtensionPositiveDegree K L u : ℤ) + + (finiteExtensionPositiveDegree K L v : ℤ)) ≤ + ∑ P ∈ S, finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ) := by + have hbound := finiteExtensionOneSubU_div_oneSubV_weightedOrder_lower_bound + K L u v hu hv huone hvone S + dsimp only [rho] + linarith + have hGlobal := + globalWronskianInequality_of_finiteExtensionCanonicalPlacewiseBounds + K L S canonical u v rho grid W h k (h * k + h + k) + ((h * k + h + k).choose 2) chi hu hgrid hW + hUOutside hGridOutside hVPositiveSupport + (by simpa only [S, canonical] using hEuler) + hRhoSupport + (by simpa only [S, canonical, rho] using hCaseI) + (by simpa only [S, canonical, rho] using hCaseII) + (by simpa only [S, canonical, rho, grid] using hCaseIII) + (by simpa only [S, canonical, rho, grid] using hCaseIV) + exact finiteExtensionGcdBound_of_canonicalWronskianInequality + K L u v hu hv huone hvone h k hn chi (by + simpa only [S, rho, add_comm, Int.ofNat_eq_natCast] using hGlobal) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean new file mode 100644 index 0000000000..c708858bc0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound + +/-! +# Global canonical bound from a normalized derivation + +The finite-place branch is now completely automatic: the different supplies +the canonical clearing scalar, and the four local estimates are selected after +splitting the exhaustive place type. This module leaves only the four +corresponding infinity statements as explicit inputs. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable {p : ℕ} [Fact p.Prime] [CharP K p] [CharP L p] + +local instance (priority := 10) globalNormalizedPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance globalNormalizedPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance globalNormalizedFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance globalNormalizedFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance globalNormalizedPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance globalNormalizedFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +attribute [local instance] Classical.decEq + +/-- A normalized Frobenius-constant derivation and the four infinity cases +imply the exact exhaustive Proposition 2 gcd estimate. -/ +theorem finiteExtensionGcdBound_of_normalizedCanonicalInfinityPlacewiseBounds + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) + (h k : ℕ) (hn : 0 < h * k + h + k) (chi : ℕ) + (hWronskian : + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) + (hEuler : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + + (∑ P ∈ propositionTwoExceptionalPlaces K L u v, + finiteExtensionPlaceDegree K L P : ℤ) ≤ (chi : ℤ)) + (hInfinityCaseI : ∀ P : FiniteExtensionInfinityPlace K L, + (Sum.inr P : FiniteExtensionPlace K L) ∉ + propositionTwoExceptionalPlaces K L u v → + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) (.inr P) < 0 → + ((h * k + h + k : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) (.inr P) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P)) + (hInfinityCaseII : ∀ P : FiniteExtensionInfinityPlace K L, + (Sum.inr P : FiniteExtensionPlace K L) ∉ + propositionTwoExceptionalPlaces K L u v → + 0 ≤ finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) (.inr P) → + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P)) + (hInfinityCaseIII : ∀ P : FiniteExtensionInfinityPlace K L, + (Sum.inr P : FiniteExtensionPlace K L) ∈ + propositionTwoExceptionalPlaces K L u v → + 0 < finiteExtensionPrincipalDivisor K L v (.inr P) → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u (.inr P) + + ((h * k : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L v (.inr P) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inr P) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inr P) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P)) + (hInfinityCaseIV : ∀ P : FiniteExtensionInfinityPlace K L, + (Sum.inr P : FiniteExtensionPlace K L) ∈ + propositionTwoExceptionalPlaces K L u v → + finiteExtensionPrincipalDivisor K L v (.inr P) ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u (.inr P) + + (k : ℤ) * finiteExtensionPrincipalDivisor K L + ((1 - u) / (1 - v)) (.inr P) + + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) (.inr P) - + ((h * k + h + k).choose 2 : ℤ) ≤ + ((h * k + h + k).choose 2 : ℤ) * + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) + + finiteExtensionPrincipalDivisor K L + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det (.inr P)) : + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L v : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L u : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + let W := (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det + apply finiteExtensionGcdBound_of_canonicalPlacewiseBounds + K L u v W hu hv huone hvone hWronskian h k hn chi hEuler + · intro P hP hrho + cases P with + | inl q => + have huOrder : finitePlaceOrder q u = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using + finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inl q) hP + have hvOrder : finitePlaceOrder q v = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using + finiteExtensionPrincipalDivisor_v_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inl q) hP + exact finiteExtensionFinitePlace_canonicalAuxiliary_caseI_of_normalized + K L q D hDX h k hn u v hu hv huone hvone huOrder hvOrder + (by simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + using hrho) + hWronskian + | inr P => exact hInfinityCaseI P hP hrho + · intro P hP hrho + cases P with + | inl q => + have huOrder : finitePlaceOrder q u = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using + finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inl q) hP + have hvOrder : finitePlaceOrder q v = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using + finiteExtensionPrincipalDivisor_v_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inl q) hP + exact finiteExtensionFinitePlace_canonicalAuxiliary_caseII_of_normalized + K L q D hDX h k u v hu hv huone hvone huOrder.ge hvOrder.ge + (by simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + using hrho) + hWronskian + | inr P => exact hInfinityCaseII P hP hrho + · intro P hP hvP + cases P with + | inl q => + exact finiteExtensionFinitePlace_canonicalAuxiliary_caseIII_of_normalized + K L q D hDX h k u v hu hv huone hvone hWronskian + | inr P => exact hInfinityCaseIII P hP hvP + · intro P hP hvP + cases P with + | inl q => + exact finiteExtensionFinitePlace_canonicalAuxiliary_caseIV_of_normalized + K L q D hDX h k u v hu hv huone hvone hWronskian + | inr P => exact hInfinityCaseIV P hP hvP + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean new file mode 100644 index 0000000000..d3a7b71cd6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean @@ -0,0 +1,632 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import Mathlib.Tactic + +namespace BGS.CorvajaZannier + +noncomputable section + + +open scoped Polynomial nonZeroDivisors +open Multiplicative WithZero IsDedekindDomain + +variable (K : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +local instance automaticInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance automaticInfinityConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + IsScalarTower.of_algebraMap_eq' rfl + +noncomputable def probeRatFuncDerivation : + Derivation K (RatFunc K) (RatFunc K) := by + letI : IsScalarTower K K[X] (RatFunc K) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra.FormallyEtale K[X] (RatFunc K) := + Algebra.FormallyEtale.of_isLocalization K[X]⁰ + exact formallyEtaleDerivationExtension (Polynomial.mkDerivation K 1) + +@[simp] theorem probeRatFuncDerivation_algebraMap (f : K[X]) : + probeRatFuncDerivation K (algebraMap K[X] (RatFunc K) f) = + algebraMap K[X] (RatFunc K) f.derivative := by + letI : IsScalarTower K K[X] (RatFunc K) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra.FormallyEtale K[X] (RatFunc K) := + Algebra.FormallyEtale.of_isLocalization K[X]⁰ + simpa only [probeRatFuncDerivation, + Polynomial.mkDerivation_apply, smul_eq_mul, mul_one] using + formallyEtaleDerivationExtension_algebraMap + (T := RatFunc K) (Polynomial.mkDerivation K 1) f + +example : probeRatFuncDerivation K RatFunc.X = 1 := by + rw [← RatFunc.algebraMap_X] + rw [probeRatFuncDerivation_algebraMap] + simp + +theorem probeRatFuncDerivation_eq (x : RatFunc K) : + probeRatFuncDerivation K x = + (algebraMap K[X] (RatFunc K) x.denom)⁻¹ ^ 2 * + algebraMap K[X] (RatFunc K) + (x.denom * x.num.derivative - x.num * x.denom.derivative) := by + conv_lhs => rw [← RatFunc.num_div_denom x] + rw [Derivation.leibniz_div, + probeRatFuncDerivation_algebraMap, + probeRatFuncDerivation_algebraMap] + rw [map_sub, map_mul, map_mul] + simp only [Algebra.smul_def, Algebra.algebraMap_self_apply] + +private theorem natDegree_derivativeNumerator_le + (p q : K[X]) (hp : p ≠ 0) (hq : q ≠ 0) + (hN : q * p.derivative - p * q.derivative ≠ 0) : + (q * p.derivative - p * q.derivative).natDegree ≤ + p.natDegree + q.natDegree - 1 := by + have hsum : 0 < p.natDegree + q.natDegree := by + by_contra h + have hpdeg : p.natDegree = 0 := by omega + have hqdeg : q.natDegree = 0 := by omega + have hpder : p.derivative = 0 := by + rw [Polynomial.eq_C_of_natDegree_eq_zero hpdeg, + Polynomial.derivative_C] + have hqder : q.derivative = 0 := by + rw [Polynomial.eq_C_of_natDegree_eq_zero hqdeg, + Polynomial.derivative_C] + simp [hpder, hqder] at hN + have hleft : (q * p.derivative).natDegree ≤ + p.natDegree + q.natDegree - 1 := by + by_cases hpder : p.derivative = 0 + · rw [hpder, mul_zero, Polynomial.natDegree_zero] + omega + · have hpdeg : p.natDegree ≠ 0 := by + intro hzero + apply hpder + rw [Polynomial.eq_C_of_natDegree_eq_zero hzero, + Polynomial.derivative_C] + rw [Polynomial.natDegree_mul hq hpder] + have hder := Polynomial.natDegree_derivative_le p + omega + have hright : (p * q.derivative).natDegree ≤ + p.natDegree + q.natDegree - 1 := by + by_cases hqder : q.derivative = 0 + · rw [hqder, mul_zero, Polynomial.natDegree_zero] + omega + · have hqdeg : q.natDegree ≠ 0 := by + intro hzero + apply hqder + rw [Polynomial.eq_C_of_natDegree_eq_zero hzero, + Polynomial.derivative_C] + rw [Polynomial.natDegree_mul hp hqder] + have hder := Polynomial.natDegree_derivative_le q + omega + exact (Polynomial.natDegree_sub_le _ _).trans (max_le hleft hright) + +theorem probeRatFuncDerivation_intDegree_le_sub_one + (x : RatFunc K) (hx : x ≠ 0) + (hDx : probeRatFuncDerivation K x ≠ 0) : + (probeRatFuncDerivation K x).intDegree ≤ x.intDegree - 1 := by + let N := x.denom * x.num.derivative - x.num * x.denom.derivative + have hden : algebraMap K[X] (RatFunc K) x.denom ≠ 0 := + RatFunc.algebraMap_ne_zero x.denom_ne_zero + have hN : N ≠ 0 := by + intro hzero + apply hDx + rw [probeRatFuncDerivation_eq] + change _ * algebraMap K[X] (RatFunc K) N = 0 + rw [hzero, map_zero, mul_zero] + have hrepr : probeRatFuncDerivation K x = + algebraMap K[X] (RatFunc K) N / + algebraMap K[X] (RatFunc K) (x.denom ^ 2) := by + rw [probeRatFuncDerivation_eq, map_pow] + change _ * algebraMap K[X] (RatFunc K) N = _ + field_simp + rw [hrepr, RatFunc.intDegree_div + (RatFunc.algebraMap_ne_zero hN) + (RatFunc.algebraMap_ne_zero (pow_ne_zero 2 x.denom_ne_zero)), + RatFunc.intDegree_polynomial, RatFunc.intDegree_polynomial, + Polynomial.natDegree_pow, RatFunc.intDegree] + have hdegree := natDegree_derivativeNumerator_le + K x.num x.denom (RatFunc.num_ne_zero hx) x.denom_ne_zero hN + have hsum : 0 < x.num.natDegree + x.denom.natDegree := by + by_contra h + have hnumDegree : x.num.natDegree = 0 := by omega + have hdenDegree : x.denom.natDegree = 0 := by omega + apply hN + change x.denom * x.num.derivative - + x.num * x.denom.derivative = 0 + rw [Polynomial.eq_C_of_natDegree_eq_zero hnumDegree, + Polynomial.eq_C_of_natDegree_eq_zero hdenDegree, + Polynomial.derivative_C, Polynomial.derivative_C] + simp + have hdegreeInt : + ((x.denom * x.num.derivative - + x.num * x.denom.derivative).natDegree : ℤ) ≤ + ((x.num.natDegree + x.denom.natDegree - 1 : ℕ) : ℤ) := by + exact_mod_cast hdegree + rw [Nat.cast_sub (by omega : 1 ≤ + x.num.natDegree + x.denom.natDegree)] at hdegreeInt + simp only [N] at hdegree ⊢ + omega + +noncomputable def probeRatFuncReciprocalDerivation : + Derivation K (RatFunc K) (RatFunc K) := + (-RatFunc.X ^ 2 : RatFunc K) • probeRatFuncDerivation K + +@[simp] theorem probeRatFuncReciprocalDerivation_apply (x : RatFunc K) : + probeRatFuncReciprocalDerivation K x = + -RatFunc.X ^ 2 * probeRatFuncDerivation K x := by + simp only [probeRatFuncReciprocalDerivation, Derivation.smul_apply, + Algebra.smul_def, Algebra.algebraMap_self_apply] + +theorem probeRatFuncReciprocalDerivation_intDegree_nonpositive_of_negative + (x : RatFunc K) (hxDegree : x.intDegree < 0) : + (probeRatFuncReciprocalDerivation K x).intDegree ≤ 0 := by + by_cases hEx : probeRatFuncReciprocalDerivation K x = 0 + · simp [hEx] + have hx : x ≠ 0 := by + intro hzero + apply hEx + simp [hzero] + have hDx : probeRatFuncDerivation K x ≠ 0 := by + intro hzero + apply hEx + rw [probeRatFuncReciprocalDerivation_apply, hzero, mul_zero] + rw [probeRatFuncReciprocalDerivation_apply, + RatFunc.intDegree_mul + (neg_ne_zero.mpr (pow_ne_zero 2 RatFunc.X_ne_zero)) hDx, + RatFunc.intDegree_neg, + show (RatFunc.X ^ 2 : RatFunc K).intDegree = 2 by + rw [pow_two, + RatFunc.intDegree_mul RatFunc.X_ne_zero RatFunc.X_ne_zero, + RatFunc.intDegree_X] + norm_num] + have hder := probeRatFuncDerivation_intDegree_le_sub_one K x hx hDx + omega + +theorem probeRatFuncReciprocalDerivation_mem_infinityIntegers + (r : RatFuncInfinityIntegers K) : + probeRatFuncReciprocalDerivation K (r : RatFunc K) ∈ + RatFuncInfinityIntegers K := by + obtain ⟨c, hc⟩ := + ratFuncInfinityIntegers_exists_constant_mod_maximalIdeal K r + let y : RatFuncInfinityIntegers K := + r - algebraMap K (RatFuncInfinityIntegers K) c + have hyMax : y ∈ (ratFuncInfinityPlace K).asIdeal := by + simpa only [y] using hc + have hEr : probeRatFuncReciprocalDerivation K (r : RatFunc K) = + probeRatFuncReciprocalDerivation K (y : RatFunc K) := by + rw [show (y : RatFunc K) = (r : RatFunc K) - RatFunc.C c by rfl] + rw [map_sub] + have hconst : probeRatFuncReciprocalDerivation K (RatFunc.C c) = 0 := by + exact (probeRatFuncReciprocalDerivation K).map_algebraMap c + rw [hconst, sub_zero] + rw [hEr] + by_cases hy : (y : RatFunc K) = 0 + · simp [hy] + have hyDegree : (y : RatFunc K).intDegree < 0 := by + change y ∈ IsLocalRing.maximalIdeal + (RatFuncInfinityIntegers K) at hyMax + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff, + Valuation.Integer.not_isUnit_iff_valuation_lt_one] at hyMax + change RatFunc.inftyValuation K (y : RatFunc K) < 1 at hyMax + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K hy, + ← exp_zero, exp_lt_exp] at hyMax + exact hyMax + by_cases hEy : probeRatFuncReciprocalDerivation K (y : RatFunc K) = 0 + · simp [hEy] + change RatFunc.inftyValuation K + (probeRatFuncReciprocalDerivation K (y : RatFunc K)) ≤ 1 + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K hEy, + ← exp_zero, exp_le_exp] + exact probeRatFuncReciprocalDerivation_intDegree_nonpositive_of_negative + K (y : RatFunc K) hyDegree + +noncomputable def probeInfinityRingDerivation : + Derivation K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegers K) where + toLinearMap := + { toFun := fun r => + ⟨probeRatFuncReciprocalDerivation K (r : RatFunc K), + probeRatFuncReciprocalDerivation_mem_infinityIntegers K r⟩ + map_add' := by + intro x y + apply Subtype.ext + exact map_add (probeRatFuncReciprocalDerivation K) + (x : RatFunc K) (y : RatFunc K) + map_smul' := by + intro c x + apply Subtype.ext + change probeRatFuncReciprocalDerivation K + (algebraMap K (RatFunc K) c * (x : RatFunc K)) = + algebraMap K (RatFunc K) c * + probeRatFuncReciprocalDerivation K (x : RatFunc K) + simpa only [Algebra.smul_def, Algebra.algebraMap_self_apply] using + (probeRatFuncReciprocalDerivation K).map_smul c (x : RatFunc K) } + map_one_eq_zero' := by + apply Subtype.ext + exact (probeRatFuncReciprocalDerivation K).map_one_eq_zero + leibniz' := by + intro x y + apply Subtype.ext + exact (probeRatFuncReciprocalDerivation K).leibniz + (x : RatFunc K) (y : RatFunc K) + +@[simp] theorem probeInfinityRingDerivation_coe + (r : RatFuncInfinityIntegers K) : + ((probeInfinityRingDerivation K r : RatFuncInfinityIntegers K) : + RatFunc K) = probeRatFuncReciprocalDerivation K (r : RatFunc K) := + rfl + +section AmbientExtension + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable {p : ℕ} [Fact p.Prime] [CharP K p] [CharP L p] + [PerfectField K] + +local instance probeConstantAlgebraL : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance probeConstantRatFuncTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance probeInfinityConstantLTower : + IsScalarTower K (RatFuncInfinityIntegers K) L := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFuncInfinityIntegers K) (A := L) rfl + +local instance automaticInfinityClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance probeInfinityClosureConstantBaseTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFuncInfinityIntegers K) + (A := RatFuncInfinityIntegralClosure K L) rfl + +local instance probeInfinityClosureToFieldTower : + IsScalarTower (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) L := + IsScalarTower.of_algebraMap_eq' + (R := RatFuncInfinityIntegers K) + (S := RatFuncInfinityIntegralClosure K L) (A := L) rfl + +local instance probeInfinityClosureConstantToFieldTower : + IsScalarTower K (RatFuncInfinityIntegralClosure K L) L := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFuncInfinityIntegralClosure K L) (A := L) rfl + +local instance probeInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance probeInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance probeInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance probeInfinityClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance probeInfinityClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance probeInfinityClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance (priority := 10) probePolynomialLAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance probePolynomialRatFuncLTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' + (R := K[X]) (S := RatFunc K) (A := L) rfl + +local instance probePolynomialConstantLTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance probeFrobeniusConstantAlgebra : + Algebra K (frobeniusSubfield L p) := + (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)).toAlgebra + +local instance probeFrobeniusConstantTower : + IsScalarTower K (frobeniusSubfield L p) L := + IsScalarTower.of_algebraMap_eq' rfl + +theorem probe_normalizedDerivation_comp_ratFunc + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) : + (D.restrictScalars K).compAlgebraMap (RatFunc K) = + (Algebra.linearMap (RatFunc K) L).compDer + (probeRatFuncDerivation K) := by + letI : IsScalarTower K K[X] (RatFunc K) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := K[X]) (A := RatFunc K) rfl + letI : Algebra.FormallyEtale K[X] (RatFunc K) := + Algebra.FormallyEtale.of_isLocalization K[X]⁰ + apply derivation_ext_of_formallyUnramified (S := K[X]) + intro f + change (D.restrictScalars K) + (algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) f)) = + algebraMap (RatFunc K) L + (probeRatFuncDerivation K + (algebraMap K[X] (RatFunc K) f)) + rw [show algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) f) = algebraMap K[X] L f by + rw [IsScalarTower.algebraMap_apply K[X] (RatFunc K) L]] + have hpoly : (D.restrictScalars K).compAlgebraMap K[X] = + (Algebra.linearMap K[X] L).compDer + (Polynomial.mkDerivation K 1) := by + apply Polynomial.derivation_ext + calc + ((D.restrictScalars K).compAlgebraMap K[X]) Polynomial.X = + D (algebraMap (RatFunc K) L RatFunc.X) := by + change D (algebraMap K[X] L Polynomial.X) = _ + rw [IsScalarTower.algebraMap_apply K[X] (RatFunc K) L, + RatFunc.algebraMap_X] + _ = 1 := hDX + _ = ((Algebra.linearMap K[X] L).compDer + (Polynomial.mkDerivation K 1)) Polynomial.X := by simp + have hpolyf := Derivation.congr_fun hpoly f + change (D.restrictScalars K) (algebraMap K[X] L f) = + algebraMap K[X] L ((Polynomial.mkDerivation K 1) f) at hpolyf + rw [hpolyf] + change algebraMap K[X] L ((Polynomial.mkDerivation K 1) f) = _ + rw [show (probeRatFuncDerivation K) + (algebraMap K[X] (RatFunc K) f) = + algebraMap K[X] (RatFunc K) ((Polynomial.mkDerivation K 1) f) by + simpa only [Polynomial.mkDerivation_apply, smul_eq_mul, mul_one] using + probeRatFuncDerivation_algebraMap K f] + rw [IsScalarTower.algebraMap_apply K[X] (RatFunc K) L] + +noncomputable def probeAmbientReciprocalDerivation + (D : Derivation (frobeniusSubfield L p) L L) : + Derivation K L L := + (-(algebraMap (RatFunc K) L RatFunc.X) ^ 2) • + D.restrictScalars K + +theorem probeAmbientReciprocalDerivation_extends + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (r : RatFuncInfinityIntegers K) : + probeAmbientReciprocalDerivation K L D + (algebraMap (RatFuncInfinityIntegers K) L r) = + algebraMap (RatFuncInfinityIntegers K) L + (probeInfinityRingDerivation K r) := by + have hcomp := Derivation.congr_fun + (probe_normalizedDerivation_comp_ratFunc K L D hDX) + (r : RatFunc K) + change (D.restrictScalars K) + (algebraMap (RatFunc K) L (r : RatFunc K)) = + algebraMap (RatFunc K) L + (probeRatFuncDerivation K (r : RatFunc K)) at hcomp + rw [probeAmbientReciprocalDerivation, + Derivation.smul_apply, Algebra.smul_def, + Algebra.algebraMap_self_apply] + change -(algebraMap (RatFunc K) L RatFunc.X) ^ 2 * + (D.restrictScalars K) + (algebraMap (RatFunc K) L (r : RatFunc K)) = + algebraMap (RatFunc K) L + ((probeInfinityRingDerivation K r : + RatFuncInfinityIntegers K) : RatFunc K) + rw [hcomp] + change -(algebraMap (RatFunc K) L RatFunc.X) ^ 2 * + algebraMap (RatFunc K) L + (probeRatFuncDerivation K (r : RatFunc K)) = + algebraMap (RatFunc K) L + (probeRatFuncReciprocalDerivation K (r : RatFunc K)) + rw [probeRatFuncReciprocalDerivation_apply, map_mul, map_neg, map_pow] + +theorem probeAmbientReciprocalDerivation_changeParameter + (D : Derivation (frobeniusSubfield L p) L L) : + D.restrictScalars K = + (-(algebraMap (RatFuncInfinityIntegers K) L + (ratFuncInfinityUniformizer K)) ^ 2) • + probeAmbientReciprocalDerivation K L D := by + let sL : L := algebraMap (RatFuncInfinityIntegers K) L + (ratFuncInfinityUniformizer K) + let xL : L := algebraMap (RatFunc K) L RatFunc.X + have hsx : sL * xL = 1 := by + rw [show sL = algebraMap (RatFunc K) L (1 / RatFunc.X) by rfl, + ← map_mul, div_mul_cancel₀ _ RatFunc.X_ne_zero, map_one] + have hscalar : -(sL ^ 2) * -(xL ^ 2) = 1 := by + calc + -(sL ^ 2) * -(xL ^ 2) = (sL * xL) ^ 2 := by ring + _ = 1 := by rw [hsx]; simp + apply Derivation.ext + intro z + simp only [probeAmbientReciprocalDerivation, + Derivation.smul_apply, Algebra.smul_def, + Algebra.algebraMap_self_apply] + change (D.restrictScalars K) z = + -(sL ^ 2) * (-(xL ^ 2) * (D.restrictScalars K) z) + rw [← mul_assoc, hscalar, one_mul] + +theorem probe_exists_normalizedInfinityScaling + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (P : FiniteExtensionInfinityPlace K L) : + ∃ c : L, c ≠ 0 ∧ + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inr P) ∧ + ∀ r : FiniteExtensionInfinityPlaceLocalRing K L P, + ∃ s : FiniteExtensionInfinityPlaceLocalRing K L P, + (c • D) (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P r) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P s := by + letI : IsScalarTower K (RatFuncInfinityIntegers K) L := + probeInfinityConstantLTower K L + exact exists_finiteExtensionInfinityPlace_canonicalDifferent_scaling_certificate + (K := K) (L := L) D (probeInfinityRingDerivation K) + (probeAmbientReciprocalDerivation K L D) + (probeAmbientReciprocalDerivation_extends K L D hDX) + (probeAmbientReciprocalDerivation_changeParameter K L D) P + +end AmbientExtension + +section GlobalNormalized + +variable [Fintype K] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable {p : ℕ} [Fact p.Prime] [CharP K p] [CharP L p] + +local instance globalInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance globalInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance globalInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance globalInfinityClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance globalInfinityClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance globalInfinityClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- The exact exhaustive Proposition 2 gcd estimate from a normalized +Frobenius-constant derivation. The infinity-place hypotheses of +`finiteExtensionGcdBound_of_normalizedCanonicalInfinityPlacewiseBounds` are +automatic: the reciprocal derivation at infinity gives the change of +parameter, and the different supplies the canonical clearing scalar. -/ +theorem finiteExtensionGcdBound_of_normalizedCanonicalPlacewiseBounds + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) + (h k : ℕ) (hn : 0 < h * k + h + k) (chi : ℕ) + (hWronskian : + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily u v h k)).det ≠ 0) + (hEuler : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + + (∑ P ∈ propositionTwoExceptionalPlaces K L u v, + finiteExtensionPlaceDegree K L P : ℤ) ≤ (chi : ℤ)) : + (finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L v : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L u : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + apply finiteExtensionGcdBound_of_normalizedCanonicalInfinityPlacewiseBounds + K L D hDX u v hu hv huone hvone h k hn chi hWronskian hEuler + · intro P hP hrho + obtain ⟨c, hc, hcOrder, hScaledLocal⟩ := + probe_exists_normalizedInfinityScaling K L D hDX P + have huOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) u = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using + finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inr P) hP + have hvOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) v = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using + finiteExtensionPrincipalDivisor_v_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inr P) hP + exact finiteExtensionInfinityPlace_canonicalAuxiliary_caseI_of_scaling + (K := K) (L := L) P D c hc hcOrder hScaledLocal h k hn + u v hu hv huone hvone huOrder hvOrder + (by simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] + using hrho) + hWronskian + · intro P hP hrho + obtain ⟨c, hc, hcOrder, hScaledLocal⟩ := + probe_exists_normalizedInfinityScaling K L D hDX P + have huOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) u = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using + finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inr P) hP + have hvOrder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) v = 0 := by + simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] using + finiteExtensionPrincipalDivisor_v_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v (.inr P) hP + exact finiteExtensionInfinityPlace_canonicalAuxiliary_caseII_of_scaling + (K := K) (L := L) P D c hc hcOrder hScaledLocal h k + u v hu hv huone hvone huOrder.ge hvOrder.ge + (by simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] + using hrho) + hWronskian + · intro P _hP _hvP + obtain ⟨c, hc, hcOrder, hScaledLocal⟩ := + probe_exists_normalizedInfinityScaling K L D hDX P + exact finiteExtensionInfinityPlace_canonicalAuxiliary_caseIII_of_scaling + (K := K) (L := L) P D c hc hcOrder hScaledLocal h k + u v hu hv huone hvone hWronskian + · intro P _hP _hvP + obtain ⟨c, hc, hcOrder, hScaledLocal⟩ := + probe_exists_normalizedInfinityScaling K L D hDX P + exact finiteExtensionInfinityPlace_canonicalAuxiliary_caseIV_of_scaling + (K := K) (L := L) P D c hc hcOrder hScaledLocal h k + u v hu hv huone hvone hWronskian + +end GlobalNormalized + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean new file mode 100644 index 0000000000..621904f3cc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean @@ -0,0 +1,344 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +import Mathlib.Tactic + +open scoped BigOperators + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +attribute [local instance] Classical.decEq + +/-- The finite set on which all terms in the canonical Wronskian summation +can be nonzero. -/ +def finiteExtensionCanonicalSummationSupport + (S : Finset (FiniteExtensionPlace K L)) + (canonical : FiniteExtensionPlace K L →₀ ℤ) + (u v rho grid W : L) : Finset (FiniteExtensionPlace K L) := by + classical + exact S ∪ canonical.support ∪ + (finiteExtensionPrincipalDivisor K L u).support ∪ + (finiteExtensionPrincipalDivisor K L v).support ∪ + (finiteExtensionPrincipalDivisor K L rho).support ∪ + (finiteExtensionPrincipalDivisor K L grid).support ∪ + (finiteExtensionPrincipalDivisor K L W).support + +/-- The pole height of `rho` away from an exceptional set. -/ +def finiteExtensionOutsideHeight + (rho : L) (S : Finset (FiniteExtensionPlace K L)) : ℕ := by + classical + exact ∑ P ∈ (finiteExtensionPrincipalDivisor K L rho).support.filter + (fun P => P ∉ S ∧ finiteExtensionPrincipalDivisor K L rho P < 0), + (finiteExtensionPrincipalDivisor K L rho P).natAbs * + finiteExtensionPlaceDegree K L P + +theorem finiteExtensionOutsideHeight_negativeSum + (rho : L) (S : Finset (FiniteExtensionPlace K L)) : + ∑ P ∈ (finiteExtensionPrincipalDivisor K L rho).support.filter + (fun P => P ∉ S ∧ finiteExtensionPrincipalDivisor K L rho P < 0), + finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ) = + -(finiteExtensionOutsideHeight K L rho S : ℤ) := by + classical + rw [finiteExtensionOutsideHeight, Nat.cast_sum, ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro P hP + have hneg : finiteExtensionPrincipalDivisor K L rho P < 0 := + (Finset.mem_filter.mp hP).2.2 + rw [Nat.cast_mul, Int.natCast_natAbs, abs_of_nonpos (le_of_lt hneg)] + ring + +/-- Exhaustive residue-degree-weighted summation with a genuine canonical +divisor and a nonzero global Wronskian. -/ +theorem globalWronskianInequality_of_finiteExtensionCanonicalPlacewiseBounds + (S : Finset (FiniteExtensionPlace K L)) + (canonical : FiniteExtensionPlace K L →₀ ℤ) + (u v rho grid W : L) + (h k n sigma chi : ℕ) + (hu : u ≠ 0) (hgrid : grid ≠ 0) (hW : W ≠ 0) + (hUOutside : ∀ P, P ∉ S → finiteExtensionPrincipalDivisor K L u P = 0) + (hGridOutside : ∀ P, P ∉ S → + finiteExtensionPrincipalDivisor K L grid P = 0) + (hVPositiveSupport : ∀ P, + 0 < finiteExtensionPrincipalDivisor K L v P → P ∈ S) + (hEuler : finiteExtensionDivisorDegree K L canonical + + (∑ P ∈ S, finiteExtensionPlaceDegree K L P : ℤ) ≤ (chi : ℤ)) + (hRhoSupport : + -((finiteExtensionPositiveDegree K L u : ℤ) + + (finiteExtensionPositiveDegree K L v : ℤ)) ≤ + ∑ P ∈ S, finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ)) + (hCaseI : ∀ P, P ∉ S → + finiteExtensionPrincipalDivisor K L rho P < 0 → + (n : ℤ) * finiteExtensionPrincipalDivisor K L rho P ≤ + (sigma : ℤ) * canonical P + + finiteExtensionPrincipalDivisor K L W P) + (hCaseII : ∀ P, P ∉ S → + 0 ≤ finiteExtensionPrincipalDivisor K L rho P → + 0 ≤ (sigma : ℤ) * canonical P + + finiteExtensionPrincipalDivisor K L W P) + (hCaseIII : ∀ P, P ∈ S → + 0 < finiteExtensionPrincipalDivisor K L v P → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u P + + ((h * k : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L v P + + (k : ℤ) * finiteExtensionPrincipalDivisor K L rho P + + finiteExtensionPrincipalDivisor K L grid P - (sigma : ℤ) ≤ + (sigma : ℤ) * canonical P + + finiteExtensionPrincipalDivisor K L W P) + (hCaseIV : ∀ P, P ∈ S → + finiteExtensionPrincipalDivisor K L v P ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L u P + + (k : ℤ) * finiteExtensionPrincipalDivisor K L rho P + + finiteExtensionPrincipalDivisor K L grid P - (sigma : ℤ) ≤ + (sigma : ℤ) * canonical P + + finiteExtensionPrincipalDivisor K L W P) : + ((h * k : ℕ) : ℤ) * (finiteExtensionPositiveDegree K L v : ℤ) - + (k : ℤ) * ((finiteExtensionPositiveDegree K L u : ℤ) + + (finiteExtensionPositiveDegree K L v : ℤ)) - + (sigma : ℤ) * (chi : ℤ) ≤ + (n : ℤ) * (finiteExtensionOutsideHeight K L rho S : ℤ) := by + classical + let T := finiteExtensionCanonicalSummationSupport K L S canonical u v rho grid W + let I := {P // P ∈ T} + let eS : {P // P ∈ S} ↪ I := + ⟨fun P => ⟨P.1, by + change P.1 ∈ finiteExtensionCanonicalSummationSupport K L S canonical u v rho grid W + simp [finiteExtensionCanonicalSummationSupport, P.2]⟩, + fun P Q hPQ => Subtype.ext + (congrArg (fun R : I => R.1) hPQ)⟩ + let S' : Finset I := S.attach.map eS + let ord (x : L) : I → ℤ := fun P => finiteExtensionPrincipalDivisor K L x P.1 + let ordW : I → ℤ := fun P => + (sigma : ℤ) * canonical P.1 + finiteExtensionPrincipalDivisor K L W P.1 + have hS'_iff (P : I) : P ∈ S' ↔ P.1 ∈ S := by + constructor + · intro hP + rcases Finset.mem_map.mp hP with ⟨Q, hQS, hQP⟩ + have : Q.1 = P.1 := congrArg Subtype.val hQP + simpa [this] using Q.2 + · intro hP + let Q : {P // P ∈ S} := ⟨P.1, hP⟩ + have hQattach : Q ∈ S.attach := by simp [Q] + apply Finset.mem_map.mpr + refine ⟨Q, hQattach, ?_⟩ + apply Subtype.ext + rfl + have hsum_of_support_subset + (D : FiniteExtensionPlace K L →₀ ℤ) (hDT : D.support ⊆ T) : + ∑ P : I, D P.1 * (finiteExtensionPlaceDegree K L P.1 : ℤ) = + D.sum (fun P a => a * (finiteExtensionPlaceDegree K L P : ℤ)) := by + rw [← Finset.sum_subtype T (fun P => by simp) (fun P => + D P * (finiteExtensionPlaceDegree K L P : ℤ))] + symm + exact Finsupp.sum_of_support_subset D hDT + (fun P a => a * (finiteExtensionPlaceDegree K L P : ℤ)) + (by simp) + have hcanonicalSupport : canonical.support ⊆ T := by + intro P hP + simp [T, finiteExtensionCanonicalSummationSupport, hP] + have hWsupport : (finiteExtensionPrincipalDivisor K L W).support ⊆ T := by + intro P hP + simp [T, finiteExtensionCanonicalSummationSupport, hP] + have hUSum : ∑ P : I, ord u P * + (finiteExtensionPlaceDegree K L P.1 : ℤ) = 0 := by + rw [hsum_of_support_subset (finiteExtensionPrincipalDivisor K L u)] + · exact finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L u hu + · intro P hP + simp [T, finiteExtensionCanonicalSummationSupport, hP] + have hGridSum : ∑ P : I, ord grid P * + (finiteExtensionPlaceDegree K L P.1 : ℤ) = 0 := by + rw [hsum_of_support_subset (finiteExtensionPrincipalDivisor K L grid)] + · exact finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L grid hgrid + · intro P hP + simp [T, finiteExtensionCanonicalSummationSupport, hP] + have hCanonicalSum : ∑ P : I, ordW P * + (finiteExtensionPlaceDegree K L P.1 : ℤ) = + (sigma : ℤ) * finiteExtensionDivisorDegree K L canonical := by + change ∑ P : I, + ((sigma : ℤ) * canonical P.1 + + finiteExtensionPrincipalDivisor K L W P.1) * + (finiteExtensionPlaceDegree K L P.1 : ℤ) = _ + simp_rw [add_mul, Finset.sum_add_distrib] + have hscale : + (∑ P : I, (sigma : ℤ) * canonical P.1 * + (finiteExtensionPlaceDegree K L P.1 : ℤ)) = + (sigma : ℤ) * ∑ P : I, canonical P.1 * + (finiteExtensionPlaceDegree K L P.1 : ℤ) := by + calc + _ = ∑ P : I, (sigma : ℤ) * + (canonical P.1 * (finiteExtensionPlaceDegree K L P.1 : ℤ)) := by + apply Finset.sum_congr rfl + intro P hP + ring + _ = _ := by rw [Finset.mul_sum] + rw [hscale] + rw [hsum_of_support_subset canonical hcanonicalSupport, + hsum_of_support_subset (finiteExtensionPrincipalDivisor K L W) hWsupport] + have hprincipal := finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L W hW + change (finiteExtensionPrincipalDivisor K L W).sum + (fun P a => a * (finiteExtensionPlaceDegree K L P : ℤ)) = 0 at hprincipal + rw [hprincipal, add_zero] + rfl + have hDegreeS : ∑ P ∈ S', finiteExtensionPlaceDegree K L P.1 = + ∑ P ∈ S, finiteExtensionPlaceDegree K L P := by + change ∑ P ∈ S.attach.map eS, finiteExtensionPlaceDegree K L P.1 = _ + rw [Finset.sum_map] + change ∑ P ∈ S.attach, finiteExtensionPlaceDegree K L P.1 = _ + exact Finset.sum_attach S (fun P => finiteExtensionPlaceDegree K L P) + have hSumS (F : FiniteExtensionPlace K L → ℤ) : + ∑ P ∈ S', F P.1 = ∑ P ∈ S, F P := by + change ∑ P ∈ S.attach.map eS, F P.1 = _ + rw [Finset.sum_map] + change ∑ P ∈ S.attach, F P.1 = _ + exact Finset.sum_attach S F + have hOutside : + ∑ P ∈ Finset.univ.filter (fun P : I => P ∉ S' ∧ ord rho P < 0), + ord rho P * (finiteExtensionPlaceDegree K L P.1 : ℤ) = + -(finiteExtensionOutsideHeight K L rho S : ℤ) := by + let R := (finiteExtensionPrincipalDivisor K L rho).support.filter + (fun P => P ∉ S ∧ finiteExtensionPrincipalDivisor K L rho P < 0) + have hRT : R ⊆ T := by + intro P hP + have hsupport : P ∈ (finiteExtensionPrincipalDivisor K L rho).support := + (Finset.mem_filter.mp hP).1 + simp [T, finiteExtensionCanonicalSummationSupport, hsupport] + let eR : {P // P ∈ R} ↪ I := + ⟨fun P => ⟨P.1, hRT P.2⟩, + fun P Q hPQ => Subtype.ext + (congrArg (fun R : I => R.1) hPQ)⟩ + have hfilter : Finset.univ.filter (fun P : I => P ∉ S' ∧ ord rho P < 0) = + R.attach.map eR := by + ext P + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_map, + ] + constructor + · intro hP + have hne : finiteExtensionPrincipalDivisor K L rho P.1 ≠ 0 := + ne_of_lt hP.2 + have hmemR : P.1 ∈ R := by + apply Finset.mem_filter.mpr + refine ⟨Finsupp.mem_support_iff.mpr hne, ?_, hP.2⟩ + intro hPS + exact hP.1 ((hS'_iff P).mpr hPS) + let Q : {P // P ∈ R} := ⟨P.1, hmemR⟩ + refine ⟨Q, by simp, ?_⟩ + apply Subtype.ext + rfl + · rintro ⟨Q, hQattach, hQP⟩ + have hval : Q.1 = P.1 := congrArg (fun R : I => R.1) hQP + have hQR := (Finset.mem_filter.mp Q.2).2 + constructor + · rw [hS'_iff] + simpa [hval] using hQR.1 + · simpa [ord, hval] using hQR.2 + rw [hfilter, Finset.sum_map] + change ∑ Q ∈ R.attach, + finiteExtensionPrincipalDivisor K L rho Q.1 * + (finiteExtensionPlaceDegree K L Q.1 : ℤ) = _ + calc + _ = ∑ P ∈ R, finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ) := + Finset.sum_attach R (fun P => finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ)) + _ = _ := by + simpa [R] using finiteExtensionOutsideHeight_negativeSum K L rho S + apply globalWronskianInequality_of_weightedPlacewiseBounds + (fun P : I => finiteExtensionPlaceDegree K L P.1) S' + (ord u) (ord v) (ord rho) (ord grid) ordW + h k n sigma + (finiteExtensionPositiveDegree K L u) + (finiteExtensionPositiveDegree K L v) + chi (finiteExtensionOutsideHeight K L rho S) + (finiteExtensionDivisorDegree K L canonical) + · intro P hP + exact hUOutside P.1 ((hS'_iff P).not.mp hP) + · intro P hP + exact hGridOutside P.1 ((hS'_iff P).not.mp hP) + · exact hUSum + · exact hGridSum + · have hpositive : ∀ P : I, 0 < ord v P → P ∈ S' := by + intro P hP + rw [hS'_iff] + exact hVPositiveSupport P.1 hP + let D := finiteExtensionPrincipalDivisor K L v + have hDsupport : D.support ⊆ T := by + intro P hP + have hne : finiteExtensionPrincipalDivisor K L v P ≠ 0 := by + simpa [D, Finsupp.mem_support_iff] using + (Finsupp.mem_support_iff.mp hP) + simp [T, finiteExtensionCanonicalSummationSupport, + Finsupp.mem_support_iff, hne] + have hPositiveAll : + (∑ P : I, if 0 < ord v P then + ord v P * (finiteExtensionPlaceDegree K L P.1 : ℤ) else 0) = + (finiteExtensionPositiveDegree K L v : ℤ) := by + calc + _ = ∑ P ∈ T, if 0 < D P then + D P * (finiteExtensionPlaceDegree K L P : ℤ) else 0 := by + exact (Finset.sum_subtype T (fun P => by simp) + (fun P => if 0 < D P then + D P * (finiteExtensionPlaceDegree K L P : ℤ) else 0)).symm + _ = ∑ P ∈ D.support, if 0 < D P then + D P * (finiteExtensionPlaceDegree K L P : ℤ) else 0 := by + apply Eq.symm + apply Finset.sum_subset hDsupport + intro P hPT hnot + have hzero : D P = 0 := Finsupp.notMem_support_iff.mp hnot + simp [hzero] + _ = ∑ P ∈ D.support.filter (fun P => 0 < D P), + D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + rw [Finset.sum_filter] + _ = (finiteExtensionPositiveDegree K L v : ℤ) := by + exact (finiteExtensionPositiveDegree_cast K L v).symm + calc + ∑ P ∈ S'.filter (fun P => 0 < ord v P), + ord v P * (finiteExtensionPlaceDegree K L P.1 : ℤ) = + ∑ P ∈ S', if 0 < ord v P then + ord v P * (finiteExtensionPlaceDegree K L P.1 : ℤ) else 0 := by + rw [Finset.sum_filter] + _ = ∑ P : I, if 0 < ord v P then + ord v P * (finiteExtensionPlaceDegree K L P.1 : ℤ) else 0 := by + apply Finset.sum_subset (Finset.subset_univ S') + intro P hP hnotS + have hnotpos : ¬ 0 < ord v P := by + intro hpos + exact hnotS (hpositive P hpos) + simp [hnotpos] + _ = _ := hPositiveAll + · exact hOutside + · exact hCanonicalSum + · rw [hDegreeS] + simpa only [Nat.cast_sum] using hEuler + · change -((finiteExtensionPositiveDegree K L u : ℤ) + + (finiteExtensionPositiveDegree K L v : ℤ)) ≤ + ∑ P ∈ S', finiteExtensionPrincipalDivisor K L rho P.1 * + (finiteExtensionPlaceDegree K L P.1 : ℤ) + rw [hSumS (fun P => finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ))] + exact hRhoSupport + · intro P hPS hneg + exact hCaseI P.1 ((hS'_iff P).not.mp hPS) hneg + · intro P hPS hnonneg + exact hCaseII P.1 ((hS'_iff P).not.mp hPS) hnonneg + · intro P hPS hpos + exact hCaseIII P.1 ((hS'_iff P).mp hPS) hpos + · intro P hPS hnonpos + exact hCaseIV P.1 ((hS'_iff P).mp hPS) hnonpos + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean new file mode 100644 index 0000000000..03e832e248 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import Mathlib.Tactic + +/-! +# Canonical derivation scalings at finite extension places + +This file instantiates the abstract different-annihilator construction for a +finite separable extension of `K(X)`. If the Frobenius-constant derivation is +normalized by `D(X) = 1`, the resulting scalar has order equal to the finite +coefficient of the canonical different divisor. The quotient-rule bridge then +shows that the scaled derivation preserves the complete localized DVR used by +the finite-place Wronskian estimates. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +variable (K : Type*) [Field K] [PerfectField K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable {p : ℕ} [Fact p.Prime] [CharP K p] [CharP L p] + +local instance (priority := 10) canonicalScalingPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance canonicalScalingPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance canonicalScalingFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance canonicalScalingFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance canonicalScalingPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance canonicalScalingFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance canonicalScalingFiniteBaseFaithfulSmulFractionRing : + FaithfulSMul K[X] + (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + have hS := IsFractionRing.injective (RatFuncFiniteIntegralClosure K L) + (FractionRing (RatFuncFiniteIntegralClosure K L)) hxy + exact FunctionField.ringOfIntegers.algebraMap_injective K L hS + +local instance canonicalScalingFiniteFractionRingAlgebra : + Algebra (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := + FractionRing.liftAlgebra K[X] + (FractionRing (RatFuncFiniteIntegralClosure K L)) + +local instance canonicalScalingFiniteFractionRingSeparable : + Algebra.IsSeparable (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncFiniteFractionRingEquiv K).symm.toRingEquiv + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncFiniteFractionRingEquiv K).symm + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm z + +/-- At every finite place, the normalized Frobenius-constant derivation admits +a scalar whose order is the canonical different coefficient and whose scalar +multiple preserves the localized DVR. -/ +theorem exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate + (D : Derivation (frobeniusSubfield L p) L L) + (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) + (q : FiniteExtensionFinitePlace K L) : + ∃ c : L, c ≠ 0 ∧ + finitePlaceOrder q c = + finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) (.inl q) ∧ + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s := by + letI : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + let F := frobeniusSubfield L p + letI : Algebra K F := + (perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p)).toAlgebra + letI : IsScalarTower K F L := IsScalarTower.of_algebraMap_eq' rfl + let Ds : Derivation K K[X] K[X] := Polynomial.mkDerivation K 1 + let E : Derivation K L L := D.restrictScalars K + have hE : ∀ s : K[X], + E (algebraMap K[X] L s) = algebraMap K[X] L (Ds s) := by + have hder : E.compAlgebraMap K[X] = + (Algebra.linearMap K[X] L).compDer Ds := by + apply Polynomial.derivation_ext + calc + (E.compAlgebraMap K[X]) Polynomial.X = + E (algebraMap K[X] L Polynomial.X) := rfl + _ = D (algebraMap (RatFunc K) L RatFunc.X) := by + rw [IsScalarTower.algebraMap_apply K[X] (RatFunc K) L] + rw [RatFunc.algebraMap_X] + rfl + _ = 1 := hDX + _ = ((Algebra.linearMap K[X] L).compDer Ds) Polynomial.X := by + simp [Ds] + intro s + exact Derivation.congr_fun hder s + obtain ⟨δ, hδ, _hδmem, _hδmult, hδorder, _hδann, hδpreserves⟩ := + exists_finitePlace_different_localGenerator_scaling_certificate + (C := K) (S := K[X]) (T := RatFuncFiniteIntegralClosure K L) + (U := L) (F := L) q Ds E hE + let c : L := algebraMap (RatFuncFiniteIntegralClosure K L) L δ + have hc : c ≠ 0 := by + exact (IsFractionRing.injective (RatFuncFiniteIntegralClosure K L) L).ne hδ + refine ⟨c, hc, ?_, ?_⟩ + · simpa only [c, finiteExtensionCanonicalDifferentDivisor_inl] using hδorder + · letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI : IsScalarTower (RatFuncFiniteIntegralClosure K L) + (FiniteExtensionFinitePlaceLocalRing K L q) L := by + apply IsScalarTower.of_algebraMap_eq' + exact (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q).symm + have hGlobal : ∀ t : RatFuncFiniteIntegralClosure K L, + ∃ t' : RatFuncFiniteIntegralClosure K L, + (c • D) (algebraMap (RatFuncFiniteIntegralClosure K L) L t) = + algebraMap (RatFuncFiniteIntegralClosure K L) L t' := by + intro t + obtain ⟨t', ht'⟩ := hδpreserves t + refine ⟨t', ?_⟩ + simpa only [c, E, Derivation.smul_apply, Algebra.smul_def, + Algebra.algebraMap_self_apply, Derivation.restrictScalars_apply] using ht' + exact ambientDerivation_preserves_localizationAtPrime_of_preserves + q.asIdeal (c • D) hGlobal + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean new file mode 100644 index 0000000000..5ed786a8a2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean @@ -0,0 +1,483 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +import Mathlib.Tactic + +/-! +# The global Wronskian divisor and the finite different degree + +This module supplies two exact global pieces of the Corvaja--Zannier +Wronskian argument for a finite separable extension of `K(X)`. + +First, a global derivation gives one global Wronskian element. Replacing it +at a place by a local-parameter derivation changes the order by exactly the +triangular multiple of the change-of-parameter coefficient. Accordingly, +the local Wronskians form the sum of the principal divisor of the global +Wronskian and a triangular multiple of a canonical correction divisor. The +product formula then proves that its degree is exactly the triangular +multiple of the canonical degree. + +Second, for an integral primitive element in the finite integral closure, +the weighted degree of the finite different is bounded by the degree of its +power-basis discriminant. This is obtained without an abstract norm-of-ideal +interface: ideal multiplicities are identified with finite-place orders, and +the existing exhaustive norm formula evaluates their weighted sum. + +What is deliberately not asserted here is a Riemann--Hurwitz theorem, an +identification of the correction divisor at the places above infinity, or a +plane-curve genus/boundary estimate. Those are the remaining geometric +inputs needed to derive the final bound `canonicalDegree + |S| <= 2ab`. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) canonicalWronskianPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance canonicalWronskianPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance canonicalWronskianFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance canonicalWronskianPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance canonicalWronskianFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance canonicalWronskianFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +/-! ## The finite different and the discriminant degree -/ + +private theorem finiteExtensionFinitePrincipalDivisor_algebraMap_apply + (d : RatFuncFiniteIntegralClosure K L) (hd : d ≠ 0) + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionFinitePrincipalDivisor K L + (algebraMap (RatFuncFiniteIntegralClosure K L) L d) q = + (multiplicity q.asIdeal (Ideal.span {d}) : ℤ) := by + let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L + have hrepr : + e.symm (algebraMap (RatFuncFiniteIntegralClosure K L) L d) = + algebraMap (RatFuncFiniteIntegralClosure K L) + (FractionRing (RatFuncFiniteIntegralClosure K L)) d := by + apply e.injective + rw [e.apply_symm_apply, e.commutes] + rw [finiteExtensionFinitePrincipalDivisor_apply, hrepr, + finitePlaceOrder_algebraMap_eq_multiplicity q d hd] + +private theorem finiteExtensionFinitePrincipalDivisor_algebraMap_eq_mapRange + (d : RatFuncFiniteIntegralClosure K L) (hd : d ≠ 0) : + finiteExtensionFinitePrincipalDivisor K L + (algebraMap (RatFuncFiniteIntegralClosure K L) L d) = + (idealMultiplicityDivisor (Ideal.span {d}) + (by simpa [Ideal.span_singleton_eq_bot] using hd)).mapRange + (fun n : ℕ => (n : ℤ)) (by simp) := by + ext q + rw [finiteExtensionFinitePrincipalDivisor_algebraMap_apply K L d hd, + Finsupp.mapRange_apply, idealMultiplicityDivisor_apply] + +/-- The weighted degree of the principal ideal of an integral element is the +finite-place degree sum of that element in the exhaustive `K(X)` model. -/ +theorem idealMultiplicityWeightedDegree_eq_finiteExtensionFiniteDirectDegreeSum + (d : RatFuncFiniteIntegralClosure K L) (hd : d ≠ 0) : + ((idealMultiplicityDivisor (Ideal.span {d}) + (by simpa [Ideal.span_singleton_eq_bot] using hd)).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) : ℤ) = + finiteExtensionFiniteDirectDegreeSum K L + (algebraMap (RatFuncFiniteIntegralClosure K L) L d) := by + rw [finiteExtensionFiniteDirectDegreeSum, + finiteExtensionFinitePrincipalDivisor_algebraMap_eq_mapRange K L d hd, + Finsupp.sum_mapRange_index (fun q => by simp)] + +/-- The finite different degree is bounded by the finite degree of the +minimal-polynomial derivative of an integral primitive element. -/ +theorem finiteDifferentDegree_le_minpolyDerivativeDegree + (x : RatFuncFiniteIntegralClosure K L) + (hx : Algebra.adjoin (RatFunc K) + {algebraMap (RatFuncFiniteIntegralClosure K L) L x} = ⊤) : + ((differentMultiplicityDivisor K[X] (RatFuncFiniteIntegralClosure K L) + (differentIdeal_ne_bot_of_primitiveElement + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx)).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) : ℤ) ≤ + finiteExtensionFiniteDirectDegreeSum K L + (algebraMap (RatFuncFiniteIntegralClosure K L) L + (Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)))) := by + let d : RatFuncFiniteIntegralClosure K L := + Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)) + have hd : d ≠ 0 := by + simpa [d] using minpolyDerivative_ne_zero + (A := K[X]) (K := RatFunc K) (L := L) x + have hbound := differentMultiplicityWeightedSum_le_minpolyDerivative + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx + (fun q => q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) + have hcast : + (((differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) + (differentIdeal_ne_bot_of_primitiveElement + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx)).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) : ℕ) : ℤ) ≤ + (((idealMultiplicityDivisor (Ideal.span {d}) + (by + simpa [d] using minpolyDerivative_span_ne_bot + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x)).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) : ℕ) : ℤ) := by + exact_mod_cast (show + (differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) + (differentIdeal_ne_bot_of_primitiveElement + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx)).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) ≤ + (idealMultiplicityDivisor (Ideal.span {d}) + (by + simpa [d] using minpolyDerivative_span_ne_bot + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x)).sum + (fun q e => e * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) by + simpa only [d, Nat.mul_assoc] using hbound) + have hcast' : + (differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) + (differentIdeal_ne_bot_of_primitiveElement + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx)).sum + (fun q e => (e : ℤ) * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) ≤ + (idealMultiplicityDivisor (Ideal.span {d}) + (by + simpa [d] using minpolyDerivative_span_ne_bot + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x)).sum + (fun q e => (e : ℤ) * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) := by + simpa only [Nat.cast_finsupp_sum, Nat.cast_mul] using hcast + rw [idealMultiplicityWeightedDegree_eq_finiteExtensionFiniteDirectDegreeSum + K L d hd] at hcast' + simpa only [d] using hcast' + +private theorem ratFunc_intDegree_neg_one_pow (m : ℕ) : + ((-1 : RatFunc K) ^ m).intDegree = 0 := by + induction m with + | zero => simp + | succ m ih => + rw [pow_succ, RatFunc.intDegree_mul (pow_ne_zero m (by simp)) (by simp), ih] + simp + +/-- The finite degree of the integral minimal-polynomial derivative is exactly +the rational-function degree of the associated power-basis discriminant. -/ +theorem finiteExtensionMinpolyDerivativeDegree_eq_powerBasisDiscriminantDegree + (x : RatFuncFiniteIntegralClosure K L) + (hx : Algebra.adjoin (RatFunc K) + {algebraMap (RatFuncFiniteIntegralClosure K L) L x} = ⊤) : + finiteExtensionFiniteDirectDegreeSum K L + (algebraMap (RatFuncFiniteIntegralClosure K L) L + (Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)))) = + (Algebra.discr (RatFunc K) + (PowerBasis.ofAdjoinEqTop' + (Algebra.IsIntegral.isIntegral + (algebraMap (RatFuncFiniteIntegralClosure K L) L x)) hx).basis).intDegree := by + let d : RatFuncFiniteIntegralClosure K L := + Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)) + let y : L := algebraMap (RatFuncFiniteIntegralClosure K L) L d + have hd : d ≠ 0 := by + simpa [d] using minpolyDerivative_ne_zero + (A := K[X]) (K := RatFunc K) (L := L) x + have hy : y ≠ 0 := + (IsFractionRing.injective (RatFuncFiniteIntegralClosure K L) L).ne hd + have hnorm : Algebra.norm (RatFunc K) y ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hy + rw [show algebraMap (RatFuncFiniteIntegralClosure K L) L + (Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x))) = y by rfl, + finiteExtensionFiniteDirectDegreeSum_eq_grouped K L y hy, + finiteExtensionFinitePlaceDegreeSum_eq_normFinitePlaceDegreeSum K L y hy, + ratFuncExhaustiveFinitePlaceDegreeSum_eq_intDegree _ hnorm] + have hdisc := discr_powerBasisOfPrimitiveElement_eq_norm_minpolyDerivative + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx + change Algebra.discr (RatFunc K) + (PowerBasis.ofAdjoinEqTop' + (Algebra.IsIntegral.isIntegral + (algebraMap (RatFuncFiniteIntegralClosure K L) L x)) hx).basis = + (-1) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2) * Algebra.norm (RatFunc K) y at hdisc + have hdegree := congrArg RatFunc.intDegree hdisc + rw [RatFunc.intDegree_mul (pow_ne_zero _ (by simp)) hnorm, + ratFunc_intDegree_neg_one_pow K] at hdegree + omega + +/-- The finite different degree is bounded by the power-basis discriminant +degree of any integral primitive element. -/ +theorem finiteDifferentDegree_le_powerBasisDiscriminantDegree + (x : RatFuncFiniteIntegralClosure K L) + (hx : Algebra.adjoin (RatFunc K) + {algebraMap (RatFuncFiniteIntegralClosure K L) L x} = ⊤) : + (differentMultiplicityDivisor K[X] (RatFuncFiniteIntegralClosure K L) + (differentIdeal_ne_bot_of_primitiveElement + (A := K[X]) (K := RatFunc K) (L := L) + (B := RatFuncFiniteIntegralClosure K L) x hx)).sum + (fun q e => (e : ℤ) * q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) ≤ + (Algebra.discr (RatFunc K) + (PowerBasis.ofAdjoinEqTop' + (Algebra.IsIntegral.isIntegral + (algebraMap (RatFuncFiniteIntegralClosure K L) L x)) hx).basis).intDegree := by + calc + _ ≤ finiteExtensionFiniteDirectDegreeSum K L + (algebraMap (RatFuncFiniteIntegralClosure K L) L + (Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)))) := + finiteDifferentDegree_le_minpolyDerivativeDegree K L x hx + _ = _ := + finiteExtensionMinpolyDerivativeDegree_eq_powerBasisDiscriminantDegree K L x hx + +/-! ## The local-parameter Wronskian divisor -/ + +section WronskianDivisor + +variable {C : Type*} [Field C] [Algebra C L] + +/-- The global ordinary Wronskian attached to one derivation. -/ +def finiteExtensionGlobalWronskian {n : ℕ} + (D : Derivation C L L) (g : Fin n → L) : L := + (BGS.Algebra.derivationWronskian D g).det + +section LocalChangeParameter + +variable {R : Type*} [CommRing R] [IsDedekindDomain R] + [Algebra R L] [IsFractionRing R L] + +private theorem finitePlaceOrder_mul_of_ne_zero + (v : HeightOneSpectrum R) (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finitePlaceOrder v (x * y) = finitePlaceOrder v x + finitePlaceOrder v y := by + have h := finitePlaceOrderTop_mul v x y + rw [finitePlaceOrderTop_eq_coe v (x * y) (mul_ne_zero hx hy), + finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy] at h + exact_mod_cast h + +private theorem finitePlaceOrder_pow_of_ne_zero + (v : HeightOneSpectrum R) (x : L) (hx : x ≠ 0) (m : ℕ) : + finitePlaceOrder v (x ^ m) = m • finitePlaceOrder v x := by + have h := finitePlaceOrderTop_pow v x m + rw [finitePlaceOrderTop_eq_coe v (x ^ m) (pow_ne_zero m hx), + finitePlaceOrderTop_eq_coe v x hx] at h + exact_mod_cast h + +/-- Exact order change from a global derivation to a local-parameter +derivation. If `D = a E`, then the local `E`-Wronskian has the global +`D`-Wronskian order minus `choose(n,2)` times the order of `a`. -/ +theorem finitePlaceOrder_globalWronskian_changeParameter + (v : HeightOneSpectrum R) {n : ℕ} + (D E : Derivation C L L) (a : L) (hD : D = a • E) + (g : Fin n → L) (ha : a ≠ 0) + (hE : finiteExtensionGlobalWronskian L E g ≠ 0) : + finitePlaceOrder v (finiteExtensionGlobalWronskian L E g) = + finitePlaceOrder v (finiteExtensionGlobalWronskian L D g) - + (n.choose 2 : ℤ) * finitePlaceOrder v a := by + have hchange := derivationWronskian_det_changeParameter D E a hD g + change finiteExtensionGlobalWronskian L D g = + a ^ n.choose 2 * finiteExtensionGlobalWronskian L E g at hchange + have hpow : a ^ n.choose 2 ≠ 0 := pow_ne_zero _ ha + have hord := finitePlaceOrder_mul_of_ne_zero L v + (a ^ n.choose 2) (finiteExtensionGlobalWronskian L E g) hpow hE + rw [← hchange, finitePlaceOrder_pow_of_ne_zero L v a ha] at hord + simp only [nsmul_eq_mul] at hord + omega + +end LocalChangeParameter + +/-- Degree of a finitely supported divisor on the exhaustive places of the +finite extension. -/ +def finiteExtensionDivisorDegree + (D : FiniteExtensionPlace K L →₀ ℤ) : ℤ := + D.sum (fun v e => e * (finiteExtensionPlaceDegree K L v : ℤ)) + +/-- The divisor represented by local-parameter Wronskians: the principal +divisor of the global Wronskian plus the triangular multiple of a supplied +canonical correction divisor. -/ +def finiteExtensionLocalWronskianDivisor {n : ℕ} + (D : Derivation C L L) (g : Fin n → L) + (canonicalDivisor : FiniteExtensionPlace K L →₀ ℤ) : + FiniteExtensionPlace K L →₀ ℤ := + (n.choose 2 : ℤ) • canonicalDivisor + + finiteExtensionPrincipalDivisor K L + (finiteExtensionGlobalWronskian L D g) + +@[simp] theorem finiteExtensionLocalWronskianDivisor_apply {n : ℕ} + (D : Derivation C L L) (g : Fin n → L) + (canonicalDivisor : FiniteExtensionPlace K L →₀ ℤ) + (v : FiniteExtensionPlace K L) : + finiteExtensionLocalWronskianDivisor K L D g canonicalDivisor v = + (n.choose 2 : ℤ) * canonicalDivisor v + + finiteExtensionPrincipalDivisor K L + (finiteExtensionGlobalWronskian L D g) v := by + simp [finiteExtensionLocalWronskianDivisor] + +/-- The product formula kills the principal global Wronskian contribution. +Thus the local Wronskian divisor has exactly the triangular multiple of the +canonical degree. -/ +theorem finiteExtensionLocalWronskianDivisor_degree + {n : ℕ} (D : Derivation C L L) (g : Fin n → L) + (canonicalDivisor : FiniteExtensionPlace K L →₀ ℤ) + (hW : finiteExtensionGlobalWronskian L D g ≠ 0) : + finiteExtensionDivisorDegree K L + (finiteExtensionLocalWronskianDivisor K L D g canonicalDivisor) = + (n.choose 2 : ℤ) * + finiteExtensionDivisorDegree K L canonicalDivisor := by + classical + rw [finiteExtensionDivisorDegree, finiteExtensionLocalWronskianDivisor, + Finsupp.sum_add_index (by simp) (by intros; ring), + Finsupp.sum_smul_index (by simp)] + have hprincipal : + (finiteExtensionPrincipalDivisor K L + (finiteExtensionGlobalWronskian L D g)).sum + (fun v e => e * (finiteExtensionPlaceDegree K L v : ℤ)) = 0 := by + exact finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L + (finiteExtensionGlobalWronskian L D g) hW + rw [hprincipal] + simp only [finiteExtensionDivisorDegree] + rw [add_zero] + unfold Finsupp.sum + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro v hv + ring + +/-- Over algebraically closed constants every place has degree one, so the +global canonical identity becomes the ordinary unweighted sum of local +Wronskian orders used by Corvaja--Zannier. -/ +theorem finiteExtensionLocalWronskianDivisor_sum + [IsAlgClosed K] + {n : ℕ} (D : Derivation C L L) (g : Fin n → L) + (canonicalDivisor : FiniteExtensionPlace K L →₀ ℤ) + (hW : finiteExtensionGlobalWronskian L D g ≠ 0) : + (finiteExtensionLocalWronskianDivisor K L D g canonicalDivisor).sum + (fun _ e => e) = + (n.choose 2 : ℤ) * canonicalDivisor.sum (fun _ e => e) := by + have hdegree := finiteExtensionLocalWronskianDivisor_degree + K L D g canonicalDivisor hW + simpa only [finiteExtensionDivisorDegree, + finiteExtensionPlaceDegree_eq_one K L, + Int.ofNat_eq_natCast, Nat.cast_one, mul_one] using hdegree + +end WronskianDivisor + +/-! ## Final log-canonical arithmetic -/ + +/-- Once geometry bounds the canonical degree with the coarse boundary +allowance `2(a+b)`, and the actual exceptional set has at most that many +points, the exact Corvaja--Zannier choice `chi = 2ab` follows. -/ +theorem canonicalDegree_add_boundaryCard_le_twice_bidegree + {I : Type*} (S : Finset I) (canonicalDegree : ℤ) + (firstDegree secondDegree : ℕ) + (hCanonical : + canonicalDegree + (2 * (firstDegree + secondDegree) : ℕ) ≤ + (2 * firstDegree * secondDegree : ℕ)) + (hBoundary : S.card ≤ 2 * (firstDegree + secondDegree)) : + canonicalDegree + S.card ≤ + (2 * firstDegree * secondDegree : ℕ) := by + have hBoundaryInt : (S.card : ℤ) ≤ + (2 * (firstDegree + secondDegree) : ℕ) := by + exact_mod_cast hBoundary + omega + +/-- The usual genus and toric-boundary estimates imply the exact +log-canonical allowance used by Corvaja--Zannier. This theorem is purely the +numerical assembly: constructing a normalization and proving the two supplied +geometric estimates remain separate obligations. -/ +theorem canonicalDegree_add_boundaryCard_le_twice_bidegree_of_genus_bound + {I : Type*} (S : Finset I) (canonicalDegree : ℤ) + (genus firstDegree secondDegree : ℕ) + (hFirst : 0 < firstDegree) (hSecond : 0 < secondDegree) + (hCanonical : canonicalDegree ≤ 2 * (genus : ℤ) - 2) + (hGenus : genus ≤ (firstDegree - 1) * (secondDegree - 1)) + (hBoundary : S.card ≤ 2 * (firstDegree + secondDegree)) : + canonicalDegree + S.card ≤ + (2 * firstDegree * secondDegree : ℕ) := by + have hGenusInt : (genus : ℤ) ≤ + ((firstDegree - 1 : ℕ) : ℤ) * ((secondDegree - 1 : ℕ) : ℤ) := by + exact_mod_cast hGenus + have hFirstOne : 1 ≤ firstDegree := hFirst + have hSecondOne : 1 ≤ secondDegree := hSecond + rw [Nat.cast_sub hFirstOne, Nat.cast_sub hSecondOne] at hGenusInt + have hBoundaryInt : (S.card : ℤ) ≤ + 2 * ((firstDegree : ℤ) + secondDegree) := by + exact_mod_cast hBoundary + norm_num at hGenusInt hBoundaryInt ⊢ + nlinarith + +/-- The divisor-theoretic replacement for the genus-bound assembly. If the +canonical correction is bounded by the total different minus twice the +projection degree, the sharp bivariate discriminant budget and the toric +boundary budget give the same log-canonical bound `2 * a * b` directly. -/ +theorem canonicalDegree_add_boundaryCard_le_twice_bidegree_of_different_bound + {I : Type*} (S : Finset I) (canonicalDegree : ℤ) + (totalDifferent firstDegree secondDegree : ℕ) + (hSecond : 0 < secondDegree) + (hCanonical : + canonicalDegree ≤ (totalDifferent : ℤ) - 2 * (secondDegree : ℤ)) + (hDifferent : + totalDifferent ≤ (2 * secondDegree - 2) * firstDegree) + (hBoundary : S.card ≤ 2 * (firstDegree + secondDegree)) : + canonicalDegree + S.card ≤ + (2 * firstDegree * secondDegree : ℕ) := by + have hDifferentInt : (totalDifferent : ℤ) ≤ + ((2 * secondDegree - 2) * firstDegree : ℕ) := by + exact_mod_cast hDifferent + have hBoundaryInt : (S.card : ℤ) ≤ + (2 * (firstDegree + secondDegree) : ℕ) := by + exact_mod_cast hBoundary + rw [Nat.cast_mul, Nat.cast_sub (by omega : 2 ≤ 2 * secondDegree), + Nat.cast_mul, Nat.cast_ofNat] at hDifferentInt + norm_num at hDifferentInt hBoundaryInt ⊢ + nlinarith + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean new file mode 100644 index 0000000000..839fed57ff --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import Mathlib.Tactic + +/-! +# Direct weighted bounds on exhaustive exceptional places + +The family-place API is useful when several functions are indexed together. +The canonical global summation, however, is stated directly on the exhaustive +sum of finite and infinite places. This file records the corresponding +subset lower bound and specializes it to the one-minus quotient used in +Proposition 2. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +attribute [local instance] Classical.decEq + +omit [DecidableEq K] in +/-- The first coordinate has order zero away from the direct Proposition 2 +exceptional set. -/ +theorem finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + (u v : L) (P : FiniteExtensionPlace K L) + (hP : P ∉ propositionTwoExceptionalPlaces K L u v) : + finiteExtensionPrincipalDivisor K L u P = 0 := by + apply Finsupp.notMem_support_iff.mp + intro hmem + apply hP + rw [propositionTwoExceptionalPlaces] + exact Finset.mem_union_left _ hmem + +omit [DecidableEq K] in +/-- The second coordinate has order zero away from the direct Proposition 2 +exceptional set. -/ +theorem finiteExtensionPrincipalDivisor_v_eq_zero_outside_propositionTwoExceptionalPlaces + (u v : L) (P : FiniteExtensionPlace K L) + (hP : P ∉ propositionTwoExceptionalPlaces K L u v) : + finiteExtensionPrincipalDivisor K L v P = 0 := by + apply Finsupp.notMem_support_iff.mp + intro hmem + apply hP + rw [propositionTwoExceptionalPlaces] + exact Finset.mem_union_right _ hmem + +omit [DecidableEq K] in +/-- Every positive-order place of the second coordinate belongs to the direct +Proposition 2 exceptional set. -/ +theorem mem_propositionTwoExceptionalPlaces_of_v_order_pos + (u v : L) (P : FiniteExtensionPlace K L) + (hP : 0 < finiteExtensionPrincipalDivisor K L v P) : + P ∈ propositionTwoExceptionalPlaces K L u v := by + rw [propositionTwoExceptionalPlaces] + exact Finset.mem_union_right _ (Finsupp.mem_support_iff.mpr (ne_of_gt hP)) + +/-- Every auxiliary grid product has order zero away from the direct +Proposition 2 exceptional set. -/ +theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct_eq_zero_outside_propositionTwoExceptionalPlaces + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (h k : ℕ) (P : FiniteExtensionPlace K L) + (hP : P ∉ propositionTwoExceptionalPlaces K L u v) : + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) P = 0 := by + rw [finiteExtensionPrincipalDivisor_auxiliaryGridProduct K L u v hu hv h k] + have huP := + finiteExtensionPrincipalDivisor_u_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v P hP + have hvP := + finiteExtensionPrincipalDivisor_v_eq_zero_outside_propositionTwoExceptionalPlaces + K L u v P hP + simp only [Finset.sum_apply', Finsupp.add_apply, Finsupp.smul_apply, + huP, hvP, nsmul_zero, add_zero, Finset.sum_const_zero] + +/-- On any finite set of exhaustive places, the weighted order sum of a +function is bounded below by minus its full pole height. -/ +theorem finiteExtensionWeightedOrder_sum_ge_neg_height + (x : L) (S : Finset (FiniteExtensionPlace K L)) : + -((finiteExtensionHeight K L x : ℕ) : ℤ) ≤ + ∑ P ∈ S, finiteExtensionPrincipalDivisor K L x P * + (finiteExtensionPlaceDegree K L P : ℤ) := by + classical + let D := finiteExtensionPrincipalDivisor K L x + let N := D.support.filter (fun P => D P < 0) + let T := S.filter (fun P => D P < 0) + have hTN : T ⊆ N := by + intro P hP + have hneg : D P < 0 := (Finset.mem_filter.mp hP).2 + exact Finset.mem_filter.mpr + ⟨Finsupp.mem_support_iff.mpr (ne_of_lt hneg), hneg⟩ + have hfilterTN : N.filter (fun P => P ∈ T) = T := by + ext P + simp only [Finset.mem_filter] + constructor + · exact fun hP => hP.2 + · exact fun hP => ⟨hTN hP, hP⟩ + have hMissingNonpos : + ∑ P ∈ N.filter (fun P => P ∉ T), + D P * (finiteExtensionPlaceDegree K L P : ℤ) ≤ 0 := by + apply Finset.sum_nonpos + intro P hP + have hneg : D P < 0 := + (Finset.mem_filter.mp (Finset.mem_filter.mp hP).1).2 + exact mul_nonpos_of_nonpos_of_nonneg (le_of_lt hneg) (by positivity) + have hNegativeAllLeT : + (∑ P ∈ N, D P * (finiteExtensionPlaceDegree K L P : ℤ)) ≤ + ∑ P ∈ T, D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + have hsplit := Finset.sum_filter_add_sum_filter_not N + (fun P => P ∈ T) + (fun P => D P * (finiteExtensionPlaceDegree K L P : ℤ)) + rw [hfilterTN] at hsplit + linarith + have hRemainingNonneg : + 0 ≤ ∑ P ∈ S.filter (fun P => ¬ D P < 0), + D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + apply Finset.sum_nonneg + intro P hP + have hnonneg : 0 ≤ D P := le_of_not_gt (Finset.mem_filter.mp hP).2 + exact mul_nonneg hnonneg (by positivity) + have hTLeS : + (∑ P ∈ T, D P * (finiteExtensionPlaceDegree K L P : ℤ)) ≤ + ∑ P ∈ S, D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + have hsplit := Finset.sum_filter_add_sum_filter_not S + (fun P => D P < 0) + (fun P => D P * (finiteExtensionPlaceDegree K L P : ℤ)) + change + (∑ P ∈ T, D P * (finiteExtensionPlaceDegree K L P : ℤ)) + + ∑ P ∈ S.filter (fun P => ¬ D P < 0), + D P * (finiteExtensionPlaceDegree K L P : ℤ) = + ∑ P ∈ S, D P * (finiteExtensionPlaceDegree K L P : ℤ) at hsplit + linarith + have hNegativeAll := finiteExtensionHeight_negativeSum K L x + change -((finiteExtensionHeight K L x : ℕ) : ℤ) = + ∑ P ∈ N, D P * (finiteExtensionPlaceDegree K L P : ℤ) at hNegativeAll + rw [hNegativeAll] + exact hNegativeAllLeT.trans hTLeS + +/-- The exceptional-set contribution of `(1-u)/(1-v)` is bounded below by +minus the sum of the two coordinate heights. The assertion holds for every +finite set, and hence in particular for the zero-and-pole set of `u,v`. -/ +theorem finiteExtensionOneSubU_div_oneSubV_weightedOrder_lower_bound + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) + (S : Finset (FiniteExtensionPlace K L)) : + -((finiteExtensionPositiveDegree K L u : ℕ) : ℤ) - + (finiteExtensionPositiveDegree K L v : ℤ) ≤ + ∑ P ∈ S, + finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) P * + (finiteExtensionPlaceDegree K L P : ℤ) := by + have hheight : + finiteExtensionHeight K L ((1 - u) / (1 - v)) ≤ + finiteExtensionPositiveDegree K L u + + finiteExtensionPositiveDegree K L v := by + calc + finiteExtensionHeight K L ((1 - u) / (1 - v)) ≤ + finiteExtensionHeight K L u + finiteExtensionHeight K L v := + by simpa only [add_comm] using + finiteExtensionHeight_one_sub_div_one_sub_le K L + v u hv hu hvone huone + _ = finiteExtensionPositiveDegree K L u + + finiteExtensionPositiveDegree K L v := by + rw [finiteExtensionPositiveDegree_eq_height K L u hu, + finiteExtensionPositiveDegree_eq_height K L v hv] + have hheightInt : + (finiteExtensionHeight K L ((1 - u) / (1 - v)) : ℤ) ≤ + (finiteExtensionPositiveDegree K L u : ℤ) + + (finiteExtensionPositiveDegree K L v : ℤ) := by + exact_mod_cast hheight + have hsubset := finiteExtensionWeightedOrder_sum_ge_neg_height + K L ((1 - u) / (1 - v)) S + linarith + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean new file mode 100644 index 0000000000..f16c70701e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -0,0 +1,929 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +import Mathlib.Tactic + +/-! +# Exceptional-place bookkeeping for Corvaja--Zannier + +This file constructs the exceptional set used in the global summation in +Corvaja--Zannier Proposition 2. For two nonzero functions `u` and `v`, it is +the union of the supports of their exhaustive principal divisors. Thus both +functions, every auxiliary grid monomial, and their grid product have order +zero away from the set. Its residue-degree-weighted size is at most twice +the sum of the two heights. + +The final section proves the source estimate + +`-(H(u) + H(v)) <= sum_{w in S} ord_w ((1-v)/(1-u)) deg(w)`. + +The same estimate is also supplied in the paper's orientation +`(1-u)/(1-v)`. No algebraic-closedness hypothesis is needed for the weighted +statements; over an algebraically closed constant field they specialize to +ordinary cardinality and unweighted orders. + +Source provenance: published pages 1936--1937; checked semantic +reconstruction `Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines +731--779. The earlier Proposition 2 source gives the same bookkeeping in +`Papers/arXiv-math-0512074v3/jag_rivisto2.tex`, lines 618--653. +-/ + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) exceptionalSupportPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance exceptionalSupportPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance exceptionalSupportFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance exceptionalSupportFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance exceptionalSupportPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance exceptionalSupportFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance exceptionalSupportInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance exceptionalSupportInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +private theorem finitePlaceOrder_one + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (w : HeightOneSpectrum R) : + finitePlaceOrder w (1 : F) = 0 := by + have h := finitePlaceOrderTop_one (L := F) w + rw [finitePlaceOrderTop_eq_coe w (1 : F) one_ne_zero] at h + exact_mod_cast h + +/-- The exhaustive principal divisor of one is zero. -/ +theorem finiteExtensionPrincipalDivisor_one : + finiteExtensionPrincipalDivisor K L (1 : L) = 0 := by + ext w + cases w with + | inl q => + rw [finiteExtensionPrincipalDivisor_inl] + simpa using finitePlaceOrder_one + (w := q) (F := FractionRing (RatFuncFiniteIntegralClosure K L)) + | inr P => + rw [finiteExtensionPrincipalDivisor_inr] + simpa using finitePlaceOrder_one + (w := primeOverHeightOne (ratFuncInfinityPlace K) P) + (F := FractionRing (RatFuncInfinityIntegralClosure K L)) + +/-- Exhaustive principal divisors turn a nonzero product into a sum. -/ +theorem finiteExtensionPrincipalDivisor_mul + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finiteExtensionPrincipalDivisor K L (x * y) = + finiteExtensionPrincipalDivisor K L x + + finiteExtensionPrincipalDivisor K L y := by + ext w + cases w with + | inl q => + have hx' : + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x ≠ 0 := + by simpa using + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.injective.ne hx + have hy' : + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm y ≠ 0 := + by simpa using + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.injective.ne hy + have h := congrArg (fun D => D q) + (finitePrincipalDivisor_mul + (R := RatFuncFiniteIntegralClosure K L) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm y) + hx' hy') + simpa only [finiteExtensionPrincipalDivisor_inl, map_mul, + finitePrincipalDivisor_apply, Finsupp.add_apply] using h + | inr P => + let w := primeOverHeightOne (ratFuncInfinityPlace K) P + have hx' : + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x ≠ 0 := + by simpa using + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm.injective.ne hx + have hy' : + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm y ≠ 0 := + by simpa using + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm.injective.ne hy + have h := congrArg (fun D => D w) + (finitePrincipalDivisor_mul + (R := RatFuncInfinityIntegralClosure K L) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm y) + hx' hy') + simpa only [finiteExtensionPrincipalDivisor_inr, map_mul, + finitePrincipalDivisor_apply, Finsupp.add_apply] using h + +/-- Exhaustive principal divisors turn a nonzero power into a multiple. -/ +theorem finiteExtensionPrincipalDivisor_pow + (x : L) (hx : x ≠ 0) (m : ℕ) : + finiteExtensionPrincipalDivisor K L (x ^ m) = + m • finiteExtensionPrincipalDivisor K L x := by + induction m with + | zero => simp [finiteExtensionPrincipalDivisor_one K L] + | succ m ih => + rw [pow_succ, finiteExtensionPrincipalDivisor_mul K L + (x ^ m) x (pow_ne_zero _ hx) hx, ih, succ_nsmul] + +/-- Exhaustive principal divisors turn a nonzero inverse into a negative. -/ +theorem finiteExtensionPrincipalDivisor_inv + (x : L) (hx : x ≠ 0) : + finiteExtensionPrincipalDivisor K L x⁻¹ = + -finiteExtensionPrincipalDivisor K L x := by + have hmul := finiteExtensionPrincipalDivisor_mul K L x⁻¹ x + (inv_ne_zero hx) hx + rw [inv_mul_cancel₀ hx, finiteExtensionPrincipalDivisor_one K L] at hmul + exact eq_neg_of_add_eq_zero_left hmul.symm + +/-- Exhaustive principal divisors turn a quotient into a difference. -/ +theorem finiteExtensionPrincipalDivisor_div + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finiteExtensionPrincipalDivisor K L (x / y) = + finiteExtensionPrincipalDivisor K L x - + finiteExtensionPrincipalDivisor K L y := by + rw [div_eq_mul_inv, finiteExtensionPrincipalDivisor_mul K L x y⁻¹ hx + (inv_ne_zero hy), finiteExtensionPrincipalDivisor_inv K L y hy, sub_eq_add_neg] + +/-- Product of all grid monomials in the auxiliary family. Its divisor is +the `ordGrid` term in the global Wronskian summation. -/ +def finiteExtensionAuxiliaryGridProduct (u v : L) (h k : ℕ) : L := + ∏ rs : Fin (k + 1) × Fin h, u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) + +private theorem finiteExtensionPrincipalDivisor_finset_prod + {ι : Type*} [DecidableEq ι] (s : Finset ι) (g : ι → L) + (hg : ∀ i ∈ s, g i ≠ 0) : + finiteExtensionPrincipalDivisor K L (∏ i ∈ s, g i) = + ∑ i ∈ s, finiteExtensionPrincipalDivisor K L (g i) := by + classical + induction s using Finset.induction_on with + | empty => simp [finiteExtensionPrincipalDivisor_one K L] + | @insert a s ha ih => + have hga : g a ≠ 0 := hg a (Finset.mem_insert_self a s) + have hgs : ∀ i ∈ s, g i ≠ 0 := fun i hi => + hg i (Finset.mem_insert_of_mem hi) + rw [Finset.prod_insert ha, Finset.sum_insert ha, + finiteExtensionPrincipalDivisor_mul K L _ _ hga + (Finset.prod_ne_zero_iff.mpr hgs), ih hgs] + +/-- Exact principal-divisor formula for the auxiliary grid product. -/ +theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) (h k : ℕ) : + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L u v h k) = + ∑ rs : Fin (k + 1) × Fin h, + ((rs.1 : ℕ) • finiteExtensionPrincipalDivisor K L u + + (rs.2 : ℕ) • finiteExtensionPrincipalDivisor K L v) := by + classical + rw [finiteExtensionAuxiliaryGridProduct, + finiteExtensionPrincipalDivisor_finset_prod K L Finset.univ + (fun rs : Fin (k + 1) × Fin h => + u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))] + · apply Finset.sum_congr rfl + intro rs _ + rw [finiteExtensionPrincipalDivisor_mul K L _ _ + (pow_ne_zero _ hu) (pow_ne_zero _ hv), + finiteExtensionPrincipalDivisor_pow K L u hu, + finiteExtensionPrincipalDivisor_pow K L v hv] + · intro rs _ + exact mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv) + +private theorem weightedSupportDegree_le_positive_add_negative + {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) : + ∑ i ∈ D.support, weight i ≤ + (∑ i ∈ D.support.filter (fun i => 0 < D i), + (D i).toNat * weight i) + + ∑ i ∈ D.support.filter (fun i => D i < 0), + (-D i).toNat * weight i := by + classical + have hfilters : + D.support.filter (fun i => ¬ 0 < D i) = + D.support.filter (fun i => D i < 0) := by + ext i + simp only [Finset.mem_filter] + constructor + · intro ⟨hi, hnotpos⟩ + have hine : D i ≠ 0 := Finsupp.mem_support_iff.mp hi + exact ⟨hi, lt_of_le_of_ne (le_of_not_gt hnotpos) hine⟩ + · intro ⟨hi, hneg⟩ + exact ⟨hi, not_lt_of_ge (le_of_lt hneg)⟩ + rw [← Finset.sum_filter_add_sum_filter_not D.support + (fun i => 0 < D i) weight, hfilters] + apply Nat.add_le_add + · apply Finset.sum_le_sum + intro i hi + have hpos : 0 < D i := (Finset.mem_filter.mp hi).2 + have hone : 1 ≤ (D i).toNat := by omega + simpa using Nat.mul_le_mul_right (weight i) hone + · apply Finset.sum_le_sum + intro i hi + have hneg : D i < 0 := (Finset.mem_filter.mp hi).2 + have hone : 1 ≤ (-D i).toNat := by omega + simpa using Nat.mul_le_mul_right (weight i) hone + +local instance exceptionalSupportPlaceDecidableEq : + DecidableEq (FiniteExtensionPlace K L) := Classical.decEq _ + +/-- The residue-degree-weighted number of places in the support of a +principal divisor is bounded by its positive degree plus its pole height. -/ +theorem finiteExtensionPrincipalDivisor_supportDegree_le + (x : L) : + ∑ w ∈ (finiteExtensionPrincipalDivisor K L x).support, + finiteExtensionPlaceDegree K L w ≤ + finiteExtensionPositiveDegree K L x + finiteExtensionHeight K L x := by + simpa only [finiteExtensionPositiveDegree, finiteExtensionHeight] using + weightedSupportDegree_le_positive_add_negative + (finiteExtensionPrincipalDivisor K L x) + (finiteExtensionPlaceDegree K L) + +/-- For a nonzero function, the weighted support has degree at most twice +its height. -/ +theorem finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + (x : L) (hx : x ≠ 0) : + ∑ w ∈ (finiteExtensionPrincipalDivisor K L x).support, + finiteExtensionPlaceDegree K L w ≤ + 2 * finiteExtensionPositiveDegree K L x := by + calc + _ ≤ finiteExtensionPositiveDegree K L x + finiteExtensionHeight K L x := + finiteExtensionPrincipalDivisor_supportDegree_le K L x + _ = finiteExtensionPositiveDegree K L x + + finiteExtensionPositiveDegree K L x := by + rw [← finiteExtensionPositiveDegree_eq_height K L x hx] + _ = _ := by omega + +private def finsuppWeightedNegativeDegree + {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) : ℕ := + ∑ i ∈ D.support, (-D i).toNat * weight i + +private theorem finsuppWeightedNegativeDegree_eq_filter + {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) : + finsuppWeightedNegativeDegree D weight = + ∑ i ∈ D.support.filter (fun i => D i < 0), + (-D i).toNat * weight i := by + classical + calc + ∑ i ∈ D.support, (-D i).toNat * weight i = + (∑ i ∈ D.support.filter (fun i => D i < 0), + (-D i).toNat * weight i) + + ∑ i ∈ D.support.filter (fun i => ¬ D i < 0), + (-D i).toNat * weight i := by + rw [Finset.sum_filter_add_sum_filter_not] + _ = (∑ i ∈ D.support.filter (fun i => D i < 0), + (-D i).toNat * weight i) + 0 := by + congr 1 + apply Finset.sum_eq_zero + intro i hi + have hnonneg : 0 ≤ D i := le_of_not_gt (Finset.mem_filter.mp hi).2 + rw [Int.toNat_of_nonpos (neg_nonpos.mpr hnonneg)] + simp + _ = _ := by simp + +private theorem finsuppWeightedPositiveDegree_eq_filter + {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) : + (∑ i ∈ D.support, (D i).toNat * weight i) = + ∑ i ∈ D.support.filter (fun i => 0 < D i), + (D i).toNat * weight i := by + classical + calc + ∑ i ∈ D.support, (D i).toNat * weight i = + (∑ i ∈ D.support.filter (fun i => 0 < D i), + (D i).toNat * weight i) + + ∑ i ∈ D.support.filter (fun i => ¬ 0 < D i), + (D i).toNat * weight i := by + rw [Finset.sum_filter_add_sum_filter_not] + _ = (∑ i ∈ D.support.filter (fun i => 0 < D i), + (D i).toNat * weight i) + 0 := by + congr 1 + apply Finset.sum_eq_zero + intro i hi + have hnonpos : D i ≤ 0 := le_of_not_gt (Finset.mem_filter.mp hi).2 + rw [Int.toNat_of_nonpos hnonpos] + simp + _ = _ := by simp + +private theorem finsuppWeightedNegativeDegree_eq_sum_of_support_subset + {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) + (s : Finset ι) (hs : D.support ⊆ s) : + finsuppWeightedNegativeDegree D weight = + ∑ i ∈ s, (-D i).toNat * weight i := by + apply Finset.sum_subset hs + intro i _ hi + have hzero : D i = 0 := Finsupp.notMem_support_iff.mp hi + simp [hzero] + +private theorem finsuppWeightedNegativeDegree_add_le + {ι : Type*} [DecidableEq ι] (D E : ι →₀ ℤ) (weight : ι → ℕ) : + finsuppWeightedNegativeDegree (D + E) weight ≤ + finsuppWeightedNegativeDegree D weight + + finsuppWeightedNegativeDegree E weight := by + let s := D.support ∪ E.support + rw [finsuppWeightedNegativeDegree_eq_sum_of_support_subset + (D + E) weight s Finsupp.support_add, + finsuppWeightedNegativeDegree_eq_sum_of_support_subset + D weight s Finset.subset_union_left, + finsuppWeightedNegativeDegree_eq_sum_of_support_subset + E weight s Finset.subset_union_right, + ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro i _ + have hlocal : (-(D i + E i)).toNat ≤ + (-D i).toNat + (-E i).toNat := by omega + simpa [Finsupp.add_apply, add_mul] using + Nat.mul_le_mul_right (weight i) hlocal + +private theorem finiteExtensionHeight_eq_finsuppWeightedNegativeDegree + (x : L) : + finiteExtensionHeight K L x = + finsuppWeightedNegativeDegree + (finiteExtensionPrincipalDivisor K L x) + (finiteExtensionPlaceDegree K L) := by + rw [finsuppWeightedNegativeDegree_eq_filter] + rfl + +/-- Pole height is subadditive under multiplication. -/ +theorem finiteExtensionHeight_mul_le + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finiteExtensionHeight K L (x * y) ≤ + finiteExtensionHeight K L x + finiteExtensionHeight K L y := by + rw [finiteExtensionHeight_eq_finsuppWeightedNegativeDegree, + finiteExtensionHeight_eq_finsuppWeightedNegativeDegree, + finiteExtensionHeight_eq_finsuppWeightedNegativeDegree, + finiteExtensionPrincipalDivisor_mul K L x y hx hy] + exact finsuppWeightedNegativeDegree_add_le _ _ _ + +/-- The pole height of an inverse is the positive degree of the original +function. -/ +theorem finiteExtensionHeight_inv_eq_positiveDegree + (x : L) (hx : x ≠ 0) : + finiteExtensionHeight K L x⁻¹ = finiteExtensionPositiveDegree K L x := by + rw [finiteExtensionHeight_eq_finsuppWeightedNegativeDegree, + finiteExtensionPrincipalDivisor_inv K L x hx, + finsuppWeightedNegativeDegree, + finiteExtensionPositiveDegree] + simpa using finsuppWeightedPositiveDegree_eq_filter + (finiteExtensionPrincipalDivisor K L x) (finiteExtensionPlaceDegree K L) + +/-- Pole height is invariant under inversion of a nonzero function. -/ +theorem finiteExtensionHeight_inv + (x : L) (hx : x ≠ 0) : + finiteExtensionHeight K L x⁻¹ = finiteExtensionHeight K L x := by + rw [finiteExtensionHeight_inv_eq_positiveDegree K L x hx, + finiteExtensionPositiveDegree_eq_height K L x hx] + +/-- Pole height is subadditive under division. -/ +theorem finiteExtensionHeight_div_le + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finiteExtensionHeight K L (x / y) ≤ + finiteExtensionHeight K L x + finiteExtensionHeight K L y := by + rw [div_eq_mul_inv] + calc + finiteExtensionHeight K L (x * y⁻¹) ≤ + finiteExtensionHeight K L x + finiteExtensionHeight K L y⁻¹ := + finiteExtensionHeight_mul_le K L x y⁻¹ hx (inv_ne_zero hy) + _ = _ := by rw [finiteExtensionHeight_inv K L y hy] + +private theorem finitePlaceOrder_neg + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (w : HeightOneSpectrum R) (x : F) (hx : x ≠ 0) : + finitePlaceOrder w (-x) = finitePlaceOrder w x := by + have hval : (w.valuation F) (-x) = (w.valuation F) x := by simp + rw [valuation_eq_exp_neg_finitePlaceOrder w (-x) (neg_ne_zero.mpr hx), + valuation_eq_exp_neg_finitePlaceOrder w x hx] at hval + have horder := WithZero.exp_injective hval + omega + +private theorem finitePlaceOrder_one_sub_eq_of_neg + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (w : HeightOneSpectrum R) (x : F) (hx : x ≠ 0) + (hxneg : finitePlaceOrder w x < 0) : + finitePlaceOrder w (1 - x) = finitePlaceOrder w x := by + have hxone : x ≠ 1 := by + intro h + subst x + rw [finitePlaceOrder_one] at hxneg + omega + have honeSub : 1 - x ≠ 0 := sub_ne_zero.mpr hxone.symm + have hlower := finitePlaceOrder_add_ge_min w (1 : F) (-x) + one_ne_zero (neg_ne_zero.mpr hx) + (by simpa [sub_eq_add_neg] using honeSub) + rw [show (1 : F) + -x = 1 - x by ring, + finitePlaceOrder_one, finitePlaceOrder_neg w x hx, + min_eq_right (le_of_lt hxneg)] at hlower + have hreverse := finitePlaceOrder_add_ge_min w (1 : F) (-(1 - x)) + one_ne_zero (neg_ne_zero.mpr honeSub) + (by simpa using hx) + rw [show (1 : F) + -(1 - x) = x by ring, + finitePlaceOrder_one, + finitePlaceOrder_neg w (1 - x) honeSub] at hreverse + by_cases hnonneg : 0 ≤ finitePlaceOrder w (1 - x) + · rw [min_eq_left hnonneg] at hreverse + omega + · have hnonpos : finitePlaceOrder w (1 - x) ≤ 0 := le_of_not_ge hnonneg + rw [min_eq_right hnonpos] at hreverse + exact le_antisymm hreverse hlower + +omit [DecidableEq K] in +/-- At a pole of `x`, subtracting `x` from one does not change the exhaustive +place order. -/ +theorem finiteExtensionPrincipalDivisor_one_sub_apply_of_neg + (x : L) (hx : x ≠ 0) (w : FiniteExtensionPlace K L) + (hxneg : finiteExtensionPrincipalDivisor K L x w < 0) : + finiteExtensionPrincipalDivisor K L (1 - x) w = + finiteExtensionPrincipalDivisor K L x w := by + cases w with + | inl q => + have hx' : + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x ≠ 0 := by + simpa using + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.injective.ne hx + change finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) < 0 at hxneg + change finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm (1 - x)) = + finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) + rw [map_sub, map_one] + exact finitePlaceOrder_one_sub_eq_of_neg q _ hx' hxneg + | inr P => + let q := primeOverHeightOne (ratFuncInfinityPlace K) P + have hx' : + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x ≠ 0 := by + simpa using + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm.injective.ne hx + change finitePlaceOrder q + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) < 0 at hxneg + change finitePlaceOrder q + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm (1 - x)) = + finitePlaceOrder q + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + rw [map_sub, map_one] + exact finitePlaceOrder_one_sub_eq_of_neg q _ hx' hxneg + +omit [DecidableEq K] in +private theorem finiteExtensionPrincipalDivisor_one_sub_negativePart + (x : L) (hx : x ≠ 0) (hxone : x ≠ 1) + (w : FiniteExtensionPlace K L) : + (-finiteExtensionPrincipalDivisor K L (1 - x) w).toNat = + (-finiteExtensionPrincipalDivisor K L x w).toNat := by + by_cases hxneg : finiteExtensionPrincipalDivisor K L x w < 0 + · rw [finiteExtensionPrincipalDivisor_one_sub_apply_of_neg K L x hx w hxneg] + · by_cases hsubneg : finiteExtensionPrincipalDivisor K L (1 - x) w < 0 + · have hsubne : 1 - x ≠ 0 := sub_ne_zero.mpr hxone.symm + have hreverse := finiteExtensionPrincipalDivisor_one_sub_apply_of_neg + K L (1 - x) hsubne w hsubneg + rw [show (1 : L) - (1 - x) = x by ring] at hreverse + rw [hreverse] + · have hxnonneg : 0 ≤ finiteExtensionPrincipalDivisor K L x w := + le_of_not_gt hxneg + have hsubnonneg : 0 ≤ + finiteExtensionPrincipalDivisor K L (1 - x) w := + le_of_not_gt hsubneg + rw [Int.toNat_of_nonpos (neg_nonpos.mpr hsubnonneg), + Int.toNat_of_nonpos (neg_nonpos.mpr hxnonneg)] + +/-- The functions `x` and `1-x` have the same pole height. -/ +theorem finiteExtensionHeight_one_sub + (x : L) (hx : x ≠ 0) (hxone : x ≠ 1) : + finiteExtensionHeight K L (1 - x) = finiteExtensionHeight K L x := by + rw [finiteExtensionHeight_eq_finsuppWeightedNegativeDegree, + finiteExtensionHeight_eq_finsuppWeightedNegativeDegree] + let Dsub := finiteExtensionPrincipalDivisor K L (1 - x) + let Dx := finiteExtensionPrincipalDivisor K L x + let s := Dsub.support ∪ Dx.support + rw [finsuppWeightedNegativeDegree_eq_sum_of_support_subset + Dsub (finiteExtensionPlaceDegree K L) s Finset.subset_union_left, + finsuppWeightedNegativeDegree_eq_sum_of_support_subset + Dx (finiteExtensionPlaceDegree K L) s Finset.subset_union_right] + apply Finset.sum_congr rfl + intro w _ + rw [show Dsub w = finiteExtensionPrincipalDivisor K L (1 - x) w by rfl, + show Dx w = finiteExtensionPrincipalDivisor K L x w by rfl, + finiteExtensionPrincipalDivisor_one_sub_negativePart K L x hx hxone w] + +private theorem sum_union_le_sum_add_sum + {ι : Type*} [DecidableEq ι] (s t : Finset ι) (g : ι → ℕ) : + ∑ i ∈ s ∪ t, g i ≤ (∑ i ∈ s, g i) + ∑ i ∈ t, g i := by + calc + ∑ i ∈ s ∪ t, g i = + (∑ i ∈ s, g i) + ∑ i ∈ t \ s, g i := by + rw [show s ∪ t = s ∪ (t \ s) by ext i; simp, + Finset.sum_union Finset.disjoint_sdiff] + _ ≤ (∑ i ∈ s, g i) + ∑ i ∈ t, g i := by + exact Nat.add_le_add_left + (Finset.sum_le_sum_of_subset Finset.sdiff_subset) _ + +section ExceptionalSet + +variable {A : Type*} [Fintype A] + +private def finiteExtensionFamilyMemberSupportEmbedding + (f : A → L) (a : A) : + {w // w ∈ (finiteExtensionPrincipalDivisor K L (f a)).support} ↪ + FiniteExtensionFamilyPlace K L f where + toFun w := ⟨w.1, + finiteExtensionPrincipalDivisor_support_subset_familySupport K L f a w.2⟩ + inj' := by + intro w z hwz + apply Subtype.ext + exact congrArg + (fun q : FiniteExtensionFamilyPlace K L f => q.1) hwz + +/-- The support of one family member, lifted to the common family place +type. -/ +def finiteExtensionFamilyMemberSupport (f : A → L) (a : A) : + Finset (FiniteExtensionFamilyPlace K L f) := by + classical + exact (finiteExtensionPrincipalDivisor K L (f a)).support.attach.map + (finiteExtensionFamilyMemberSupportEmbedding K L f a) + +@[simp] +theorem mem_finiteExtensionFamilyMemberSupport_iff + (f : A → L) (a : A) (w : FiniteExtensionFamilyPlace K L f) : + w ∈ finiteExtensionFamilyMemberSupport K L f a ↔ + w.1 ∈ (finiteExtensionPrincipalDivisor K L (f a)).support := by + classical + constructor + · intro hw + rw [finiteExtensionFamilyMemberSupport, Finset.mem_map] at hw + obtain ⟨z, _, hz⟩ := hw + have hval : z.1 = w.1 := congrArg + (fun q : FiniteExtensionFamilyPlace K L f => q.1) hz + simpa only [hval] using z.2 + · intro hw + rw [finiteExtensionFamilyMemberSupport, Finset.mem_map] + refine ⟨⟨w.1, hw⟩, by simp, ?_⟩ + apply Subtype.ext + rfl + +theorem sum_finiteExtensionFamilyMemberSupport_placeDegree + (f : A → L) (a : A) : + ∑ w ∈ finiteExtensionFamilyMemberSupport K L f a, + finiteExtensionPlaceDegree K L w.1 = + ∑ w ∈ (finiteExtensionPrincipalDivisor K L (f a)).support, + finiteExtensionPlaceDegree K L w := by + classical + rw [finiteExtensionFamilyMemberSupport, Finset.sum_map] + simpa [finiteExtensionFamilyMemberSupportEmbedding] using + (Finset.sum_attach + (finiteExtensionPrincipalDivisor K L (f a)).support + (fun w => finiteExtensionPlaceDegree K L w)) + +/-- The finite exceptional set consisting exactly of the zero and pole places +of the selected functions `u` and `v`, embedded into a caller's common family +place type. -/ +def finiteExtensionExceptionalSet (f : A → L) (iU iV : A) : + Finset (FiniteExtensionFamilyPlace K L f) := by + classical + exact finiteExtensionFamilyMemberSupport K L f iU ∪ + finiteExtensionFamilyMemberSupport K L f iV + +@[simp] +theorem mem_finiteExtensionExceptionalSet_iff + (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) : + w ∈ finiteExtensionExceptionalSet K L f iU iV ↔ + w.1 ∈ (finiteExtensionPrincipalDivisor K L (f iU)).support ∨ + w.1 ∈ (finiteExtensionPrincipalDivisor K L (f iV)).support := by + simp [finiteExtensionExceptionalSet] + +/-- Residue-degree-weighted boundary bound for the exceptional set. -/ +theorem finiteExtensionExceptionalSet_weightedDegree_le + (f : A → L) (iU iV : A) (hu : f iU ≠ 0) (hv : f iV ≠ 0) : + ∑ w ∈ finiteExtensionExceptionalSet K L f iU iV, + finiteExtensionPlaceDegree K L w.1 ≤ + 2 * (finiteExtensionPositiveDegree K L (f iU) + + finiteExtensionPositiveDegree K L (f iV)) := by + calc + _ ≤ + (∑ w ∈ finiteExtensionFamilyMemberSupport K L f iU, + finiteExtensionPlaceDegree K L w.1) + + ∑ w ∈ finiteExtensionFamilyMemberSupport K L f iV, + finiteExtensionPlaceDegree K L w.1 := by + simpa only [finiteExtensionExceptionalSet] using + sum_union_le_sum_add_sum + (finiteExtensionFamilyMemberSupport K L f iU) + (finiteExtensionFamilyMemberSupport K L f iV) + (fun w => finiteExtensionPlaceDegree K L w.1) + _ = + (∑ w ∈ (finiteExtensionPrincipalDivisor K L (f iU)).support, + finiteExtensionPlaceDegree K L w) + + ∑ w ∈ (finiteExtensionPrincipalDivisor K L (f iV)).support, + finiteExtensionPlaceDegree K L w := by + rw [sum_finiteExtensionFamilyMemberSupport_placeDegree, + sum_finiteExtensionFamilyMemberSupport_placeDegree] + _ ≤ 2 * finiteExtensionPositiveDegree K L (f iU) + + 2 * finiteExtensionPositiveDegree K L (f iV) := + Nat.add_le_add + (finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + K L (f iU) hu) + (finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + K L (f iV) hv) + _ = _ := by omega + +/-- The sum of the weighted orders over an arbitrary subset of the common +family place type is bounded below by minus the full pole height. -/ +theorem finiteExtensionFamilyWeightedOrder_sum_ge_neg_height + (f : A → L) (a : A) + (S : Finset (FiniteExtensionFamilyPlace K L f)) : + -((finiteExtensionHeight K L (f a) : ℕ) : ℤ) ≤ + ∑ w ∈ S, finiteExtensionFamilyWeightedOrder K L f a w := by + classical + let N := Finset.univ.filter + (fun w : FiniteExtensionFamilyPlace K L f => + finiteExtensionFamilyOrder K L f a w < 0) + let T := S.filter + (fun w : FiniteExtensionFamilyPlace K L f => + finiteExtensionFamilyOrder K L f a w < 0) + have hTN : T ⊆ N := by + intro w hw + exact Finset.mem_filter.mpr ⟨Finset.mem_univ w, + (Finset.mem_filter.mp hw).2⟩ + have hfilterTN : N.filter (fun w => w ∈ T) = T := by + ext w + simp only [Finset.mem_filter] + constructor + · exact fun hw => hw.2 + · exact fun hw => ⟨hTN hw, hw⟩ + have hMissingNonpos : + ∑ w ∈ N.filter (fun w => ¬ w ∈ T), + finiteExtensionFamilyWeightedOrder K L f a w ≤ 0 := by + apply Finset.sum_nonpos + intro w hw + have hneg : finiteExtensionFamilyOrder K L f a w < 0 := by + exact (Finset.mem_filter.mp (Finset.mem_filter.mp hw).1).2 + rw [finiteExtensionFamilyWeightedOrder] + exact mul_nonpos_of_nonpos_of_nonneg (le_of_lt hneg) (by positivity) + have hNegativeAllLeT : + (∑ w ∈ N, finiteExtensionFamilyWeightedOrder K L f a w) ≤ + ∑ w ∈ T, finiteExtensionFamilyWeightedOrder K L f a w := by + have hsplit := Finset.sum_filter_add_sum_filter_not N + (fun w => w ∈ T) (fun w => + finiteExtensionFamilyWeightedOrder K L f a w) + rw [hfilterTN] at hsplit + linarith + have hRemainingNonneg : + 0 ≤ ∑ w ∈ S.filter (fun w => + ¬ finiteExtensionFamilyOrder K L f a w < 0), + finiteExtensionFamilyWeightedOrder K L f a w := by + apply Finset.sum_nonneg + intro w hw + have hnonneg : 0 ≤ finiteExtensionFamilyOrder K L f a w := + le_of_not_gt (Finset.mem_filter.mp hw).2 + rw [finiteExtensionFamilyWeightedOrder] + exact mul_nonneg hnonneg (by positivity) + have hTLeS : + (∑ w ∈ T, finiteExtensionFamilyWeightedOrder K L f a w) ≤ + ∑ w ∈ S, finiteExtensionFamilyWeightedOrder K L f a w := by + have hsplit := Finset.sum_filter_add_sum_filter_not S + (fun w => finiteExtensionFamilyOrder K L f a w < 0) + (fun w => finiteExtensionFamilyWeightedOrder K L f a w) + change (∑ w ∈ T, finiteExtensionFamilyWeightedOrder K L f a w) + + ∑ w ∈ S.filter (fun w => + ¬ finiteExtensionFamilyOrder K L f a w < 0), + finiteExtensionFamilyWeightedOrder K L f a w = + ∑ w ∈ S, finiteExtensionFamilyWeightedOrder K L f a w at hsplit + linarith + have hNegativeAll := finiteExtensionFamilyWeightedNegativeSum K L f a + change (∑ w ∈ N, finiteExtensionFamilyWeightedOrder K L f a w) = + -((finiteExtensionHeight K L (f a) : ℕ) : ℤ) at hNegativeAll + rw [← hNegativeAll] + exact hNegativeAllLeT.trans hTLeS + +/-- The height bound for the reciprocal one-minus ratio used in the support +estimate. -/ +theorem finiteExtensionHeight_one_sub_div_one_sub_le + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) : + finiteExtensionHeight K L ((1 - v) / (1 - u)) ≤ + finiteExtensionHeight K L u + finiteExtensionHeight K L v := by + have hnum : 1 - v ≠ 0 := sub_ne_zero.mpr hvone.symm + have hden : 1 - u ≠ 0 := sub_ne_zero.mpr huone.symm + calc + finiteExtensionHeight K L ((1 - v) / (1 - u)) ≤ + finiteExtensionHeight K L (1 - v) + + finiteExtensionHeight K L (1 - u) := + finiteExtensionHeight_div_le K L (1 - v) (1 - u) hnum hden + _ = finiteExtensionHeight K L v + finiteExtensionHeight K L u := by + rw [finiteExtensionHeight_one_sub K L v hv hvone, + finiteExtensionHeight_one_sub K L u hu huone] + _ = _ := by omega + +/-- The source lower bound for the exceptional-set contribution of +`rho = (1-v)/(1-u)`. -/ +theorem finiteExtensionExceptionalSet_oneSubV_div_oneSubU_weightedOrder_lower_bound + (f : A → L) (iU iV iRho : A) + (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (huone : f iU ≠ 1) (hvone : f iV ≠ 1) + (hRho : f iRho = (1 - f iV) / (1 - f iU)) : + -((finiteExtensionPositiveDegree K L (f iU) : ℕ) + + finiteExtensionPositiveDegree K L (f iV) : ℤ) ≤ + ∑ w ∈ finiteExtensionExceptionalSet K L f iU iV, + finiteExtensionFamilyWeightedOrder K L f iRho w := by + have hheight : + finiteExtensionHeight K L (f iRho) ≤ + finiteExtensionPositiveDegree K L (f iU) + + finiteExtensionPositiveDegree K L (f iV) := by + rw [hRho] + calc + finiteExtensionHeight K L ((1 - f iV) / (1 - f iU)) ≤ + finiteExtensionHeight K L (f iU) + + finiteExtensionHeight K L (f iV) := + finiteExtensionHeight_one_sub_div_one_sub_le K L + (f iU) (f iV) hu hv huone hvone + _ = _ := by + rw [← finiteExtensionPositiveDegree_eq_height K L (f iU) hu, + ← finiteExtensionPositiveDegree_eq_height K L (f iV) hv] + have hheightInt : + (finiteExtensionHeight K L (f iRho) : ℤ) ≤ + (finiteExtensionPositiveDegree K L (f iU) : ℤ) + + (finiteExtensionPositiveDegree K L (f iV) : ℤ) := by + exact_mod_cast hheight + exact (neg_le_neg hheightInt).trans + (finiteExtensionFamilyWeightedOrder_sum_ge_neg_height K L f iRho + (finiteExtensionExceptionalSet K L f iU iV)) + +/-- The same lower bound in the paper's orientation +`rho = (1-u)/(1-v)`. -/ +theorem finiteExtensionExceptionalSet_oneSubU_div_oneSubV_weightedOrder_lower_bound + (f : A → L) (iU iV iRho : A) + (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (huone : f iU ≠ 1) (hvone : f iV ≠ 1) + (hRho : f iRho = (1 - f iU) / (1 - f iV)) : + -((finiteExtensionPositiveDegree K L (f iU) : ℕ) + + finiteExtensionPositiveDegree K L (f iV) : ℤ) ≤ + ∑ w ∈ finiteExtensionExceptionalSet K L f iU iV, + finiteExtensionFamilyWeightedOrder K L f iRho w := by + simpa [finiteExtensionExceptionalSet, Finset.union_comm, add_comm] using + finiteExtensionExceptionalSet_oneSubV_div_oneSubU_weightedOrder_lower_bound + K L f iV iU iRho hv hu hvone huone hRho + +/-- Away from the exceptional set, `u` has order zero. -/ +theorem finiteExtensionFamilyOrder_u_eq_zero_outsideExceptionalSet + (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) + (hw : w ∉ finiteExtensionExceptionalSet K L f iU iV) : + finiteExtensionFamilyOrder K L f iU w = 0 := by + apply finiteExtensionFamilyOrder_eq_zero_of_not_mem_support K L f iU w + exact (not_or.mp ((mem_finiteExtensionExceptionalSet_iff K L f iU iV w).not.mp hw)).1 + +/-- Away from the exceptional set, `v` has order zero. -/ +theorem finiteExtensionFamilyOrder_v_eq_zero_outsideExceptionalSet + (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) + (hw : w ∉ finiteExtensionExceptionalSet K L f iU iV) : + finiteExtensionFamilyOrder K L f iV w = 0 := by + apply finiteExtensionFamilyOrder_eq_zero_of_not_mem_support K L f iV w + exact (not_or.mp ((mem_finiteExtensionExceptionalSet_iff K L f iU iV w).not.mp hw)).2 + +/-- Every positive-order place of `v` lies in the exceptional set. -/ +theorem finiteExtensionFamilyOrder_v_positive_mem_exceptionalSet + (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) + (hw : 0 < finiteExtensionFamilyOrder K L f iV w) : + w ∈ finiteExtensionExceptionalSet K L f iU iV := by + rw [mem_finiteExtensionExceptionalSet_iff] + right + rw [Finsupp.mem_support_iff] + exact ne_of_gt hw + +/-- Every individual grid monomial has order zero away from the exceptional +set. -/ +theorem finiteExtensionPrincipalDivisor_gridMonomial_eq_zero_outside + (f : A → L) (iU iV : A) (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (r s : ℕ) (w : FiniteExtensionFamilyPlace K L f) + (hw : w ∉ finiteExtensionExceptionalSet K L f iU iV) : + finiteExtensionPrincipalDivisor K L + (f iU ^ r * f iV ^ s) w.1 = 0 := by + rw [finiteExtensionPrincipalDivisor_mul K L _ _ + (pow_ne_zero _ hu) (pow_ne_zero _ hv), + finiteExtensionPrincipalDivisor_pow K L (f iU) hu, + finiteExtensionPrincipalDivisor_pow K L (f iV) hv] + have hu0 := finiteExtensionFamilyOrder_u_eq_zero_outsideExceptionalSet + K L f iU iV w hw + have hv0 := finiteExtensionFamilyOrder_v_eq_zero_outsideExceptionalSet + K L f iU iV w hw + change finiteExtensionPrincipalDivisor K L (f iU) w.1 = 0 at hu0 + change finiteExtensionPrincipalDivisor K L (f iV) w.1 = 0 at hv0 + simp [hu0, hv0] + +/-- The auxiliary grid product has order zero away from the zero and pole +places of `u` and `v`. -/ +theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct_eq_zero_outside + (f : A → L) (iU iV : A) (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (h k : ℕ) (w : FiniteExtensionFamilyPlace K L f) + (hw : w ∉ finiteExtensionExceptionalSet K L f iU iV) : + finiteExtensionPrincipalDivisor K L + (finiteExtensionAuxiliaryGridProduct L (f iU) (f iV) h k) w.1 = 0 := by + rw [finiteExtensionPrincipalDivisor_auxiliaryGridProduct K L + (f iU) (f iV) hu hv h k] + have hu0 := finiteExtensionFamilyOrder_u_eq_zero_outsideExceptionalSet + K L f iU iV w hw + have hv0 := finiteExtensionFamilyOrder_v_eq_zero_outsideExceptionalSet + K L f iU iV w hw + change finiteExtensionPrincipalDivisor K L (f iU) w.1 = 0 at hu0 + change finiteExtensionPrincipalDivisor K L (f iV) w.1 = 0 at hv0 + simp [hu0, hv0] + +/-- A family entry equal to the grid product has family order zero away from +the exceptional set. -/ +theorem finiteExtensionFamilyOrder_gridProduct_eq_zero_outsideExceptionalSet + (f : A → L) (iU iV iGrid : A) (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (h k : ℕ) + (hGrid : f iGrid = finiteExtensionAuxiliaryGridProduct L (f iU) (f iV) h k) + (w : FiniteExtensionFamilyPlace K L f) + (hw : w ∉ finiteExtensionExceptionalSet K L f iU iV) : + finiteExtensionFamilyOrder K L f iGrid w = 0 := by + rw [finiteExtensionFamilyOrder, hGrid] + exact finiteExtensionPrincipalDivisor_auxiliaryGridProduct_eq_zero_outside + K L f iU iV hu hv h k w hw + +section AlgebraicallyClosedConstants + +variable [IsAlgClosed K] + +/-- Over an algebraically closed constant field, the weighted boundary bound +is the ordinary cardinality bound used in the published proof. -/ +theorem finiteExtensionExceptionalSet_card_le + (f : A → L) (iU iV : A) (hu : f iU ≠ 0) (hv : f iV ≠ 0) : + (finiteExtensionExceptionalSet K L f iU iV).card ≤ + 2 * (finiteExtensionPositiveDegree K L (f iU) + + finiteExtensionPositiveDegree K L (f iV)) := by + have hbound := finiteExtensionExceptionalSet_weightedDegree_le + K L f iU iV hu hv + simpa [finiteExtensionPlaceDegree_eq_one K L] using hbound + +/-- Unweighted source estimate for `rho = (1-v)/(1-u)` over algebraically +closed constants. -/ +theorem finiteExtensionExceptionalSet_oneSubV_div_oneSubU_order_lower_bound + (f : A → L) (iU iV iRho : A) + (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (huone : f iU ≠ 1) (hvone : f iV ≠ 1) + (hRho : f iRho = (1 - f iV) / (1 - f iU)) : + -((finiteExtensionPositiveDegree K L (f iU) : ℕ) + + finiteExtensionPositiveDegree K L (f iV) : ℤ) ≤ + ∑ w ∈ finiteExtensionExceptionalSet K L f iU iV, + finiteExtensionFamilyOrder K L f iRho w := by + simpa only [finiteExtensionFamilyWeightedOrder_eq_order K L f iRho] using + finiteExtensionExceptionalSet_oneSubV_div_oneSubU_weightedOrder_lower_bound + K L f iU iV iRho hu hv huone hvone hRho + +/-- Unweighted source estimate in the paper's orientation +`rho = (1-u)/(1-v)`. -/ +theorem finiteExtensionExceptionalSet_oneSubU_div_oneSubV_order_lower_bound + (f : A → L) (iU iV iRho : A) + (hu : f iU ≠ 0) (hv : f iV ≠ 0) + (huone : f iU ≠ 1) (hvone : f iV ≠ 1) + (hRho : f iRho = (1 - f iU) / (1 - f iV)) : + -((finiteExtensionPositiveDegree K L (f iU) : ℕ) + + finiteExtensionPositiveDegree K L (f iV) : ℤ) ≤ + ∑ w ∈ finiteExtensionExceptionalSet K L f iU iV, + finiteExtensionFamilyOrder K L f iRho w := by + simpa only [finiteExtensionFamilyWeightedOrder_eq_order K L f iRho] using + finiteExtensionExceptionalSet_oneSubU_div_oneSubV_weightedOrder_lower_bound + K L f iU iV iRho hu hv huone hvone hRho + +end AlgebraicallyClosedConstants + +end ExceptionalSet + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean new file mode 100644 index 0000000000..f0fea8614a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean @@ -0,0 +1,355 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +import Mathlib.NumberTheory.FunctionField + +/-! +# Exhaustive product formula in a finite extension of `K(X)` + +This file combines the norm/count formula at every finite polynomial place +with the corresponding formula at infinity. An element of a finite +separable extension is transported to the canonical fraction fields of the +two integral closures. Naturality of the field norm shows that both models +compute the same norm in `K(X)`. + +The final theorem sums the residue-degree-weighted orders at every prime +above every finite place, with the finite-place degree factor, and at every +prime above infinity. The total is zero. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain Multiplicative WithZero + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) polynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance polynomialScalarTower : IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x ↦ by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +abbrev RatFuncFiniteIntegralClosure := FunctionField.ringOfIntegers K L + +noncomputable def ratFuncFiniteFractionRingEquiv : + FractionRing K[X] ≃ₐ[K[X]] RatFunc K := + FractionRing.algEquiv K[X] (RatFunc K) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem ratFuncFiniteFractionRingEquiv_valuation + (v : HeightOneSpectrum K[X]) (x : FractionRing K[X]) : + v.valuation (RatFunc K) (ratFuncFiniteFractionRingEquiv K x) = + v.valuation (FractionRing K[X]) x := by + obtain ⟨a, b, hb, rfl⟩ := IsFractionRing.div_surjective K[X] x + rw [map_div₀, (ratFuncFiniteFractionRingEquiv K).commutes a, + (ratFuncFiniteFractionRingEquiv K).commutes b, + Valuation.map_div, Valuation.map_div, + v.valuation_of_algebraMap, v.valuation_of_algebraMap, + v.valuation_of_algebraMap, v.valuation_of_algebraMap] + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem ratFuncFiniteFractionRing_order_eq + (v : HeightOneSpectrum K[X]) (x : FractionRing K[X]) (hx : x ≠ 0) : + finitePlaceOrder v x = + ratFuncFiniteOrder v (ratFuncFiniteFractionRingEquiv K x) := by + let e := ratFuncFiniteFractionRingEquiv K + have hcanon := valuation_eq_exp_neg_finitePlaceOrder + (R := K[X]) (L := FractionRing K[X]) v x hx + have he_ne : e x ≠ 0 := by simpa using hx + have hactual := valuation_eq_exp_neg_finitePlaceOrder + (R := K[X]) (L := RatFunc K) v (e x) he_ne + have hval := ratFuncFiniteFractionRingEquiv_valuation K v x + have hexp : exp (-finitePlaceOrder v x) = + exp (-finitePlaceOrder v (e x)) := by + rw [← hcanon, ← hactual] + exact hval.symm + rw [exp_inj] at hexp + change finitePlaceOrder v x = finitePlaceOrder v (e x) + omega + +noncomputable def ratFuncFiniteIntegralClosureFractionRingEquiv : + FractionRing (RatFuncFiniteIntegralClosure K L) ≃ₐ[RatFuncFiniteIntegralClosure K L] L := + FractionRing.algEquiv (RatFuncFiniteIntegralClosure K L) L + +local instance finiteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance finiteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance polynomialTorsionFreeTop : Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance finiteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance finiteBaseFaithfulSMulExtensionFractionRing : + FaithfulSMul K[X] (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + have hS := IsFractionRing.injective (RatFuncFiniteIntegralClosure K L) + (FractionRing (RatFuncFiniteIntegralClosure K L)) hxy + exact FunctionField.ringOfIntegers.algebraMap_injective K L hS + +local instance finiteFractionRingAlgebra : + Algebra (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := + FractionRing.liftAlgebra K[X] + (FractionRing (RatFuncFiniteIntegralClosure K L)) + +local instance finiteFractionRingSeparable : + Algebra.IsSeparable (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncFiniteFractionRingEquiv K).symm.toRingEquiv + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncFiniteFractionRingEquiv K).symm + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm z + +local instance infinityIntegralClosureModuleFinite' : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityIntegralClosureIsDedekindDomain' : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityIntegralClosureIsFractionRing' : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +noncomputable def ratFuncInfinityIntegralClosureFractionRingEquiv : + FractionRing (RatFuncInfinityIntegralClosure K L) ≃ₐ[RatFuncInfinityIntegralClosure K L] L := + FractionRing.algEquiv (RatFuncInfinityIntegralClosure K L) L + +local instance infinityBaseFaithfulSMulExtensionFractionRing' : + FaithfulSMul (RatFuncInfinityIntegers K) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + have hS := IsFractionRing.injective (RatFuncInfinityIntegralClosure K L) + (FractionRing (RatFuncInfinityIntegralClosure K L)) hxy + have hL := congrArg Subtype.val hS + apply Subtype.ext + apply (algebraMap (RatFunc K) L).injective + change algebraMap (RatFunc K) L (x : RatFunc K) = + algebraMap (RatFunc K) L (y : RatFunc K) + exact hL + +local instance infinityFractionRingAlgebra' : + Algebra (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := + FractionRing.liftAlgebra (RatFuncInfinityIntegers K) + (FractionRing (RatFuncInfinityIntegralClosure K L)) + +local instance infinityFractionRingSeparable' : + Algebra.IsSeparable (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncInfinityFractionRingEquiv K).symm.toRingEquiv + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncInfinityFractionRingEquiv K).symm + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm z + +omit [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra.IsSeparable (RatFunc K) L] in +theorem ratFuncFinite_norm_transport (x : L) : + ratFuncFiniteFractionRingEquiv K + (Algebra.norm (FractionRing K[X]) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x)) = + Algebra.norm (RatFunc K) x := by + let eA := ratFuncFiniteFractionRingEquiv K + let eS := ratFuncFiniteIntegralClosureFractionRingEquiv K L + have hcompat : + RingHom.comp (algebraMap (RatFunc K) L) eA.toRingEquiv.toRingHom = + RingHom.comp eS.toRingEquiv.toRingHom + (algebraMap (FractionRing K[X]) + (FractionRing (RatFuncFiniteIntegralClosure K L))) := by + ext z + exact IsFractionRing.algEquiv_commutes eA eS z + have hnorm := Algebra.norm_eq_of_equiv_equiv + eA.toRingEquiv eS.toRingEquiv hcompat (eS.symm x) + calc + eA (Algebra.norm (FractionRing K[X]) (eS.symm x)) = + eA (eA.symm (Algebra.norm (RatFunc K) (eS (eS.symm x)))) := + congrArg eA hnorm + _ = Algebra.norm (RatFunc K) x := by simp + +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) L] + in +theorem ratFuncInfinity_norm_transport (x : L) : + ratFuncInfinityFractionRingEquiv K + (Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x)) = + Algebra.norm (RatFunc K) x := by + let eA := ratFuncInfinityFractionRingEquiv K + let eS := ratFuncInfinityIntegralClosureFractionRingEquiv K L + have hcompat : + RingHom.comp (algebraMap (RatFunc K) L) eA.toRingEquiv.toRingHom = + RingHom.comp eS.toRingEquiv.toRingHom + (algebraMap (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L))) := by + ext z + exact IsFractionRing.algEquiv_commutes eA eS z + have hnorm := Algebra.norm_eq_of_equiv_equiv + eA.toRingEquiv eS.toRingEquiv hcompat (eS.symm x) + calc + eA (Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) (eS.symm x)) = + eA (eA.symm (Algebra.norm (RatFunc K) (eS (eS.symm x)))) := + congrArg eA hnorm + _ = Algebra.norm (RatFunc K) x := by simp + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finitePrimesAbove_weightedOrder_eq_normOrder + (p : HeightOneSpectrum K[X]) (x : L) (hx : x ≠ 0) : + (∑ P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + (P.1.inertiaDeg K[X] : ℤ) * + finitePlaceOrder (primeOverHeightOne p P) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x)) = + ratFuncFiniteOrder p (Algebra.norm (RatFunc K) x) := by + let y := (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x + have hy : y ≠ 0 := by simpa [y] using hx + have hcount := count_spanSingleton_norm_eq_sum_inertiaDeg_mul_count + (R := K[X]) (S := RatFuncFiniteIntegralClosure K L) p y + change finitePlaceOrder p (Algebra.norm (FractionRing K[X]) y) = + ∑ P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + (P.1.inertiaDeg K[X] : ℤ) * + finitePlaceOrder (primeOverHeightOne p P) y at hcount + have hnorm_ne : Algebra.norm (FractionRing K[X]) y ≠ 0 := by + intro hzero + have hmapped := congrArg (ratFuncFiniteFractionRingEquiv K) hzero + rw [map_zero, ratFuncFinite_norm_transport K L x] at hmapped + exact (Algebra.norm_ne_zero_iff.mpr hx) hmapped + calc + _ = finitePlaceOrder p (Algebra.norm (FractionRing K[X]) y) := hcount.symm + _ = ratFuncFiniteOrder p + (ratFuncFiniteFractionRingEquiv K + (Algebra.norm (FractionRing K[X]) y)) := + ratFuncFiniteFractionRing_order_eq K p _ hnorm_ne + _ = ratFuncFiniteOrder p (Algebra.norm (RatFunc K) x) := by + rw [ratFuncFinite_norm_transport K L x] + +omit [DecidableEq K] in +theorem primesAboveInfinity_weightedOrder_eq_normInfinityOrder + (x : L) (hx : x ≠ 0) : + (∑ P : (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L), + (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x)) = + ratFuncInfinityOrder (Algebra.norm (RatFunc K) x) := by + let y := (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x + have hy : y ≠ 0 := by simpa [y] using hx + have hcount := count_spanSingleton_norm_at_infinity_eq_sum + (K := K) (L := L) y + change finitePlaceOrder (ratFuncInfinityPlace K) + (Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) y) = + ∑ P : (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L), + (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) y at hcount + have hnorm_ne : + Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) y ≠ 0 := by + intro hzero + have hmapped := congrArg (ratFuncInfinityFractionRingEquiv K) hzero + rw [map_zero, ratFuncInfinity_norm_transport K L x] at hmapped + exact (Algebra.norm_ne_zero_iff.mpr hx) hmapped + calc + _ = finitePlaceOrder (ratFuncInfinityPlace K) + (Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) y) := hcount.symm + _ = ratFuncInfinityOrder + (ratFuncInfinityFractionRingEquiv K + (Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) y)) := + ratFuncInfinityFractionRing_order_eq K _ hnorm_ne + _ = ratFuncInfinityOrder (Algebra.norm (RatFunc K) x) := by + rw [ratFuncInfinity_norm_transport K L x] + +/-- The exhaustive finite-place contribution in `L`, grouped by the finite +places of `K(X)` supporting the divisor of the norm. -/ +def finiteExtensionFinitePlaceDegreeSum (x : L) : ℤ := + (ratFuncFiniteDivisor (Algebra.norm (RatFunc K) x)).sum + (fun p _ ↦ + (∑ P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + (P.1.inertiaDeg K[X] : ℤ) * + finitePlaceOrder (primeOverHeightOne p P) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x)) * + (ratFuncFinitePlaceDegree p : ℤ)) + +/-- The contribution of all primes of `L` above the place at infinity. -/ +def finiteExtensionInfinityOrderSum (x : L) : ℤ := + ∑ P : (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L), + (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ) * + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + +omit [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlaceDegreeSum_eq_normFinitePlaceDegreeSum + (x : L) (hx : x ≠ 0) : + finiteExtensionFinitePlaceDegreeSum K L x = + ratFuncExhaustiveFinitePlaceDegreeSum (Algebra.norm (RatFunc K) x) := by + rw [finiteExtensionFinitePlaceDegreeSum, + ratFuncExhaustiveFinitePlaceDegreeSum] + apply Finsupp.sum_congr + intro p _ + rw [finitePrimesAbove_weightedOrder_eq_normOrder K L p x hx, + ratFuncFiniteDivisor_apply] + +omit [DecidableEq K] in +theorem finiteExtensionInfinityOrderSum_eq_normInfinityOrder + (x : L) (hx : x ≠ 0) : + finiteExtensionInfinityOrderSum K L x = + ratFuncInfinityOrder (Algebra.norm (RatFunc K) x) := by + exact primesAboveInfinity_weightedOrder_eq_normInfinityOrder K L x hx + +/-- The exhaustive weighted principal-divisor product formula in a finite +separable extension `L / K(X)`. Every finite prime is grouped under its base +finite place and weighted by residue degree times the degree of that base +place; the second sum contains every prime above infinity. -/ +theorem finiteExtension_exhaustivePrincipalDivisor_productFormula + (x : L) (hx : x ≠ 0) : + finiteExtensionFinitePlaceDegreeSum K L x + + finiteExtensionInfinityOrderSum K L x = 0 := by + rw [finiteExtensionFinitePlaceDegreeSum_eq_normFinitePlaceDegreeSum K L x hx, + finiteExtensionInfinityOrderSum_eq_normInfinityOrder K L x hx] + apply ratFunc_exhaustiveFinitePlace_plus_infinity_productFormula + exact Algebra.norm_ne_zero_iff.mpr hx + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean new file mode 100644 index 0000000000..21bfc8343c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +import Mathlib.Tactic + +/-! The gcd divisor is controlled by the poles of the one-minus quotient. -/ + +open scoped BigOperators + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +attribute [local instance] Classical.decEq + +/-- The local integer identity behind the Corvaja--Zannier comparison between +the gcd divisor and the pole height of `(1-u)/(1-v)`. -/ +theorem gcdMultiplicity_add_outsidePole_le_secondPositivePart + (S : Finset (FiniteExtensionPlace K L)) + (Du Dv Drho : FiniteExtensionPlace K L → ℤ) + (P : FiniteExtensionPlace K L) + (hRho : Drho P = Du P - Dv P) + (hOutside : P ∉ S → 0 ≤ Du P ∧ 0 ≤ Dv P) + (hInside : P ∈ S → min (Du P) (Dv P) ≤ 0) : + Int.toNat (min (Du P) (Dv P)) + + (if P ∉ S ∧ Drho P < 0 then (Drho P).natAbs else 0) ≤ + Int.toNat (Dv P) := by + by_cases hPS : P ∈ S + · have hmin := hInside hPS + have hminToNat : Int.toNat (min (Du P) (Dv P)) = 0 := + Int.toNat_of_nonpos hmin + simp [hPS, hminToNat] + · obtain ⟨hDu, hDv⟩ := hOutside hPS + rw [hRho] + by_cases hneg : Du P - Dv P < 0 + · simp only [hPS, not_false_eq_true, hneg, and_self, if_pos] + have hmin : min (Du P) (Dv P) = Du P := + min_eq_left (sub_nonpos.mp (le_of_lt hneg)) + have hcast : + ((Int.toNat (min (Du P) (Dv P)) + + (Du P - Dv P).natAbs : ℕ) : ℤ) ≤ + (Int.toNat (Dv P) : ℤ) := by + rw [Nat.cast_add, Int.toNat_of_nonneg (le_min hDu hDv), + Int.toNat_of_nonneg hDv, Int.natCast_natAbs, + abs_of_nonpos (le_of_lt hneg), hmin] + omega + exact_mod_cast hcast + · have hnonneg : 0 ≤ Du P - Dv P := le_of_not_gt hneg + simp only [hPS, not_false_eq_true, hneg, and_false, if_false, add_zero] + exact Int.toNat_le_toNat (min_le_right _ _) + +/-- If the local order of `rho` is the difference of the two one-minus +orders, those one-minus orders are nonnegative off `S`, and their minimum is +nonpositive on `S`, then gcd degree plus outside pole height is bounded by the +positive degree of the second one-minus function. -/ +theorem finiteExtensionGcdWeightedDegree_add_outsideHeight_le + (x y rho : L) (S : Finset (FiniteExtensionPlace K L)) + (hRho : ∀ P, finiteExtensionPrincipalDivisor K L rho P = + finiteExtensionPrincipalDivisor K L x P - + finiteExtensionPrincipalDivisor K L y P) + (hOutside : ∀ P, P ∉ S → + 0 ≤ finiteExtensionPrincipalDivisor K L x P ∧ + 0 ≤ finiteExtensionPrincipalDivisor K L y P) + (hInside : ∀ P, P ∈ S → + min (finiteExtensionPrincipalDivisor K L x P) + (finiteExtensionPrincipalDivisor K L y P) ≤ 0) : + finiteExtensionGcdWeightedDegree K L x y + + finiteExtensionOutsideHeight K L rho S ≤ + finiteExtensionPositiveDegree K L y := by + classical + let Dx := finiteExtensionPrincipalDivisor K L x + let Dy := finiteExtensionPrincipalDivisor K L y + let Drho := finiteExtensionPrincipalDivisor K L rho + let T : Finset (FiniteExtensionPlace K L) := + S ∪ Dx.support ∪ Dy.support ∪ Drho.support + have hGcdSupport : finiteExtensionGcdSupport K L x y ⊆ T := by + intro P hP + rcases Finset.mem_union.mp hP with hxP | hyP + · simp [T, Dx, hxP] + · simp [T, Dy, hyP] + have hRhoSupport : Drho.support ⊆ T := by + intro P hP + simp [T, hP] + have hYSupport : Dy.support ⊆ T := by + intro P hP + simp [T, hP] + have hGcd : finiteExtensionGcdWeightedDegree K L x y = + ∑ P ∈ T, Int.toNat (min (Dx P) (Dy P)) * + finiteExtensionPlaceDegree K L P := by + rw [finiteExtensionGcdWeightedDegree] + apply Finset.sum_subset hGcdSupport + intro P hPT hnot + have hx0 : Dx P = 0 := by + apply Finsupp.notMem_support_iff.mp + intro hxmem + exact hnot (by + rw [finiteExtensionGcdSupport] + exact Finset.mem_union_left _ hxmem) + have hy0 : Dy P = 0 := by + apply Finsupp.notMem_support_iff.mp + intro hymem + exact hnot (by + rw [finiteExtensionGcdSupport] + exact Finset.mem_union_right _ hymem) + simp [finiteExtensionGcdMultiplicity, Dx, Dy, hx0, hy0] + have hOutsideHeight : finiteExtensionOutsideHeight K L rho S = + ∑ P ∈ T, (if P ∉ S ∧ Drho P < 0 then (Drho P).natAbs else 0) * + finiteExtensionPlaceDegree K L P := by + rw [finiteExtensionOutsideHeight] + rw [Finset.sum_filter] + change (∑ P ∈ Drho.support, + if P ∉ S ∧ Drho P < 0 then + (Drho P).natAbs * finiteExtensionPlaceDegree K L P else 0) = _ + calc + _ = ∑ P ∈ Drho.support, + (if P ∉ S ∧ Drho P < 0 then (Drho P).natAbs else 0) * + finiteExtensionPlaceDegree K L P := by + apply Finset.sum_congr rfl + intro P hP + split_ifs <;> simp + _ = _ := by + apply Finset.sum_subset hRhoSupport + intro P hPT hnot + have hzero : Drho P = 0 := Finsupp.notMem_support_iff.mp hnot + simp [hzero] + have hPositive : finiteExtensionPositiveDegree K L y = + ∑ P ∈ T, Int.toNat (Dy P) * finiteExtensionPlaceDegree K L P := by + rw [finiteExtensionPositiveDegree] + rw [Finset.sum_filter] + change (∑ P ∈ Dy.support, + if 0 < Dy P then Int.toNat (Dy P) * + finiteExtensionPlaceDegree K L P else 0) = _ + calc + _ = ∑ P ∈ Dy.support, Int.toNat (Dy P) * + finiteExtensionPlaceDegree K L P := by + apply Finset.sum_congr rfl + intro P hP + by_cases hpos : 0 < Dy P + · simp [hpos] + · have hnonpos : Dy P ≤ 0 := le_of_not_gt hpos + simp [hpos, Int.toNat_of_nonpos hnonpos] + _ = _ := by + apply Finset.sum_subset hYSupport + intro P hPT hnot + have hzero : Dy P = 0 := Finsupp.notMem_support_iff.mp hnot + simp [hzero] + rw [hGcd, hOutsideHeight, hPositive, ← Finset.sum_add_distrib] + apply Finset.sum_le_sum + intro P hPT + have hlocal := gcdMultiplicity_add_outsidePole_le_secondPositivePart + K L S Dx Dy Drho P (hRho P) (hOutside P) (hInside P) + calc + Int.toNat (min (Dx P) (Dy P)) * finiteExtensionPlaceDegree K L P + + (if P ∉ S ∧ Drho P < 0 then (Drho P).natAbs else 0) * + finiteExtensionPlaceDegree K L P = + (Int.toNat (min (Dx P) (Dy P)) + + (if P ∉ S ∧ Drho P < 0 then (Drho P).natAbs else 0)) * + finiteExtensionPlaceDegree K L P := by rw [add_mul] + _ ≤ Int.toNat (Dy P) * finiteExtensionPlaceDegree K L P := + Nat.mul_le_mul_right (finiteExtensionPlaceDegree K L P) hlocal + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean new file mode 100644 index 0000000000..46bd725a2f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean @@ -0,0 +1,282 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import Mathlib.Tactic + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +attribute [local instance] Classical.decEq + +local instance (priority := 10) oneSubGcdPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance oneSubGcdPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance oneSubGcdFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance oneSubGcdFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance oneSubGcdPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance oneSubGcdFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance oneSubGcdInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance oneSubGcdInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance oneSubGcdInfinityTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance oneSubGcdInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance oneSubGcdInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +omit [DecidableEq K] in +theorem finiteExtensionPrincipalDivisor_add_ge_min + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (hxy : x + y ≠ 0) + (w : FiniteExtensionPlace K L) : + min (finiteExtensionPrincipalDivisor K L x w) + (finiteExtensionPrincipalDivisor K L y w) ≤ + finiteExtensionPrincipalDivisor K L (x + y) w := by + cases w with + | inl q => + let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L + have hx' : e.symm x ≠ 0 := by simpa using e.symm.injective.ne hx + have hy' : e.symm y ≠ 0 := by simpa using e.symm.injective.ne hy + have hxy' : e.symm (x + y) ≠ 0 := by + simpa using e.symm.injective.ne hxy + simp only [finiteExtensionPrincipalDivisor_inl] + change min (finitePlaceOrder q (e.symm x)) + (finitePlaceOrder q (e.symm y)) ≤ + finitePlaceOrder q (e.symm (x + y)) + have hadd : e.symm (x + y) = e.symm x + e.symm y := + e.symm.map_add x y + rw [hadd] + exact finitePlaceOrder_add_ge_min q (e.symm x) (e.symm y) + hx' hy' (by rw [← hadd]; exact hxy') + | inr P => + let q := primeOverHeightOne (ratFuncInfinityPlace K) P + let e := ratFuncInfinityIntegralClosureFractionRingEquiv K L + have hx' : e.symm x ≠ 0 := by simpa using e.symm.injective.ne hx + have hy' : e.symm y ≠ 0 := by simpa using e.symm.injective.ne hy + have hxy' : e.symm (x + y) ≠ 0 := by + simpa using e.symm.injective.ne hxy + simp only [finiteExtensionPrincipalDivisor_inr] + change min (finitePlaceOrder q (e.symm x)) + (finitePlaceOrder q (e.symm y)) ≤ + finitePlaceOrder q (e.symm (x + y)) + have hadd : e.symm (x + y) = e.symm x + e.symm y := + e.symm.map_add x y + rw [hadd] + exact finitePlaceOrder_add_ge_min q (e.symm x) (e.symm y) + hx' hy' (by rw [← hadd]; exact hxy') + +private theorem finitePlaceOrder_neg_oneSubGcd + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (w : HeightOneSpectrum R) (x : F) (hx : x ≠ 0) : + finitePlaceOrder w (-x) = finitePlaceOrder w x := by + have hval : (w.valuation F) (-x) = (w.valuation F) x := by simp + rw [valuation_eq_exp_neg_finitePlaceOrder w (-x) (neg_ne_zero.mpr hx), + valuation_eq_exp_neg_finitePlaceOrder w x hx] at hval + have horder := WithZero.exp_injective hval + omega + +omit [DecidableEq K] in +theorem finiteExtensionPrincipalDivisor_neg_apply + (x : L) (hx : x ≠ 0) (w : FiniteExtensionPlace K L) : + finiteExtensionPrincipalDivisor K L (-x) w = + finiteExtensionPrincipalDivisor K L x w := by + cases w with + | inl q => + simp only [finiteExtensionPrincipalDivisor_inl, map_neg] + exact finitePlaceOrder_neg_oneSubGcd q _ + (by simpa using + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm.injective.ne hx) + | inr P => + simp only [finiteExtensionPrincipalDivisor_inr, map_neg] + exact finitePlaceOrder_neg_oneSubGcd + (primeOverHeightOne (ratFuncInfinityPlace K) P) _ + (by simpa using + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm.injective.ne hx) + +omit [DecidableEq K] in +theorem finiteExtensionPrincipalDivisor_one_sub_nonnegative_of_eq_zero + (x : L) (hxone : x ≠ 1) + (w : FiniteExtensionPlace K L) + (hzero : finiteExtensionPrincipalDivisor K L x w = 0) : + 0 ≤ finiteExtensionPrincipalDivisor K L (1 - x) w := by + by_contra h + have hneg : finiteExtensionPrincipalDivisor K L (1 - x) w < 0 := + lt_of_not_ge h + have hsub : (1 : L) - x ≠ 0 := sub_ne_zero.mpr hxone.symm + have heq := finiteExtensionPrincipalDivisor_one_sub_apply_of_neg + K L (1 - x) hsub w hneg + rw [show (1 : L) - (1 - x) = x by ring] at heq + omega + +omit [DecidableEq K] in +theorem finiteExtensionPrincipalDivisor_eq_zero_of_one_sub_pos + (x : L) (hx : x ≠ 0) (hxone : x ≠ 1) + (w : FiniteExtensionPlace K L) + (hpos : 0 < finiteExtensionPrincipalDivisor K L (1 - x) w) : + finiteExtensionPrincipalDivisor K L x w = 0 := by + have hsub : (1 : L) - x ≠ 0 := sub_ne_zero.mpr hxone.symm + have hlower := finiteExtensionPrincipalDivisor_add_ge_min + K L (1 : L) (-(1 - x)) one_ne_zero (neg_ne_zero.mpr hsub) + (by simpa using hx) w + rw [finiteExtensionPrincipalDivisor_one K L, + show (1 : L) + -(1 - x) = x by ring] at hlower + simp only [Finsupp.zero_apply] at hlower + have hnegOrder : + finiteExtensionPrincipalDivisor K L (-(1 - x)) w = + finiteExtensionPrincipalDivisor K L (1 - x) w := + finiteExtensionPrincipalDivisor_neg_apply K L (1 - x) hsub w + rw [hnegOrder] at hlower + have hxnonneg : 0 ≤ finiteExtensionPrincipalDivisor K L x w := by + simpa [min_eq_left (le_of_lt hpos)] using hlower + have hreverse := finiteExtensionPrincipalDivisor_add_ge_min + K L x (1 - x) hx hsub (by simp) w + rw [show x + (1 - x) = (1 : L) by ring, + finiteExtensionPrincipalDivisor_one K L] at hreverse + simp only [Finsupp.zero_apply] at hreverse + rcases le_total (finiteExtensionPrincipalDivisor K L x w) + (finiteExtensionPrincipalDivisor K L (1 - x) w) with hle | hle + · rw [min_eq_left hle] at hreverse + omega + · rw [min_eq_right hle] at hreverse + omega + +/-- The exceptional places used in Proposition 2: exactly the zeroes and +poles of the two coordinates. -/ +def propositionTwoExceptionalPlaces (u v : L) : + Finset (FiniteExtensionPlace K L) := by + classical + exact (finiteExtensionPrincipalDivisor K L u).support ∪ + (finiteExtensionPrincipalDivisor K L v).support + +/-- The divisor-theoretic gcd comparison used in Proposition 2, now on the +actual exhaustive place type used by the canonical Wronskian sum. -/ +theorem finiteExtensionOneSubGcd_add_outsideHeight_le_positiveDegree + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) : + finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) + + finiteExtensionOutsideHeight K L ((1 - u) / (1 - v)) + (propositionTwoExceptionalPlaces K L u v) ≤ + finiteExtensionPositiveDegree K L (1 - v) := by + apply finiteExtensionGcdWeightedDegree_add_outsideHeight_le + · intro P + have huSub : (1 : L) - u ≠ 0 := sub_ne_zero.mpr huone.symm + have hvSub : (1 : L) - v ≠ 0 := sub_ne_zero.mpr hvone.symm + have hdiv := congrArg (fun D => D P) + (finiteExtensionPrincipalDivisor_div K L (1 - u) (1 - v) + huSub hvSub) + simpa using hdiv + · intro P hP + have hu0 : finiteExtensionPrincipalDivisor K L u P = 0 := by + apply Finsupp.notMem_support_iff.mp + intro huP + exact hP (by + rw [propositionTwoExceptionalPlaces] + exact Finset.mem_union_left _ huP) + have hv0 : finiteExtensionPrincipalDivisor K L v P = 0 := by + apply Finsupp.notMem_support_iff.mp + intro hvP + exact hP (by + rw [propositionTwoExceptionalPlaces] + exact Finset.mem_union_right _ hvP) + exact ⟨ + finiteExtensionPrincipalDivisor_one_sub_nonnegative_of_eq_zero + K L u huone P hu0, + finiteExtensionPrincipalDivisor_one_sub_nonnegative_of_eq_zero + K L v hvone P hv0⟩ + · intro P hP + by_contra hmin + have hminpos : 0 < min + (finiteExtensionPrincipalDivisor K L (1 - u) P) + (finiteExtensionPrincipalDivisor K L (1 - v) P) := + lt_of_not_ge hmin + have huPos : 0 < finiteExtensionPrincipalDivisor K L (1 - u) P := + lt_of_lt_of_le hminpos (min_le_left _ _) + have hvPos : 0 < finiteExtensionPrincipalDivisor K L (1 - v) P := + lt_of_lt_of_le hminpos (min_le_right _ _) + have hu0 := finiteExtensionPrincipalDivisor_eq_zero_of_one_sub_pos + K L u hu huone P huPos + have hv0 := finiteExtensionPrincipalDivisor_eq_zero_of_one_sub_pos + K L v hv hvone P hvPos + rw [propositionTwoExceptionalPlaces] at hP + rcases Finset.mem_union.mp hP with huP | hvP + · exact (Finsupp.mem_support_iff.mp huP) hu0 + · exact (Finsupp.mem_support_iff.mp hvP) hv0 + +/-- In the gcd comparison, the positive degree of `1-v` is exactly the +coordinate height, hence the positive degree of `v`. -/ +theorem finiteExtensionOneSubGcd_add_outsideHeight_le_positiveDegree_coordinate + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (huone : u ≠ 1) (hvone : v ≠ 1) : + finiteExtensionGcdWeightedDegree K L (1 - u) (1 - v) + + finiteExtensionOutsideHeight K L ((1 - u) / (1 - v)) + (propositionTwoExceptionalPlaces K L u v) ≤ + finiteExtensionPositiveDegree K L v := by + calc + _ ≤ finiteExtensionPositiveDegree K L (1 - v) := + finiteExtensionOneSubGcd_add_outsideHeight_le_positiveDegree + K L u v hu hv huone hvone + _ = finiteExtensionPositiveDegree K L v := by + rw [finiteExtensionPositiveDegree_eq_height K L (1 - v) + (sub_ne_zero.mpr hvone.symm), + finiteExtensionHeight_one_sub K L v hv hvone, + ← finiteExtensionPositiveDegree_eq_height K L v hv] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean new file mode 100644 index 0000000000..d9746f68a4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean @@ -0,0 +1,288 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +import Mathlib.Tactic + +/-! +# Height of a polynomial in a finite rational-function extension + +For a nonzero polynomial `P : K[X]`, regarded first as a rational function and +then as an element of a finite separable extension `L / K(X)`, this file proves +that the positive degree of its exhaustive principal divisor is + +`Module.finrank (RatFunc K) L * P.natDegree`. + +The proof is place-theoretic. At finite places the lift is integral, hence has +nonnegative order. Above infinity its inverse is integral, hence its order is +nonpositive. The positive part is therefore exactly the finite-place degree +sum, which is evaluated by the norm and the rational-function product formula. +No algebraic-closedness hypothesis on the constant field is needed. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) polynomialHeightPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance polynomialHeightPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance polynomialHeightFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance polynomialHeightFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance polynomialHeightPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance polynomialHeightFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance polynomialHeightInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance polynomialHeightInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- The order of an inverse at a height-one place is the negative order. -/ +theorem finitePlaceOrder_inv_eq_neg + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (v : HeightOneSpectrum R) (x : F) (hx : x ≠ 0) : + finitePlaceOrder v x⁻¹ = -finitePlaceOrder v x := by + have hone := finitePrincipalDivisor_mul (R := R) + (1 : F) (1 : F) one_ne_zero one_ne_zero + have hone' := congrArg (fun D => D v) hone + simp only [one_mul, finitePrincipalDivisor_apply, Finsupp.add_apply] at hone' + have hmul := finitePrincipalDivisor_mul (R := R) + x⁻¹ x (inv_ne_zero hx) hx + have hmul' := congrArg (fun D => D v) hmul + rw [inv_mul_cancel₀ hx] at hmul' + simp only [finitePrincipalDivisor_apply, Finsupp.add_apply] at hmul' + omega + +/-- A nonzero regular element has nonnegative finite-place order. -/ +theorem finitePlaceOrder_algebraMap_nonnegative + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (v : HeightOneSpectrum R) (a : R) (ha : a ≠ 0) : + 0 ≤ finitePlaceOrder v (algebraMap R F a) := by + have hmap : algebraMap R F a ≠ 0 := by + intro hzero + apply ha + apply IsFractionRing.injective R F + simpa using hzero + have htop := finitePlaceOrderTop_algebraMap_nonnegative (L := F) v a + rw [finitePlaceOrderTop_eq_coe v _ hmap] at htop + exact_mod_cast htop + +private theorem polynomial_lift_finitePlaceOrder_nonnegative + (P : K[X]) (hP : P ≠ 0) + (q : FiniteExtensionFinitePlace K L) : + 0 ≤ finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) P)) (.inl q) := by + let S := RatFuncFiniteIntegralClosure K L + let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L + let s : S := algebraMap K[X] S P + have hs : s ≠ 0 := by + have hinj : Function.Injective (algebraMap K[X] S) := + FunctionField.ringOfIntegers.algebraMap_injective K L + simpa [s] using hinj.ne hP + have hrepr : + e.symm (algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) P)) = + algebraMap S (FractionRing S) s := by + apply e.injective + rw [e.apply_symm_apply, e.commutes] + rfl + rw [finiteExtensionPrincipalDivisor_inl, hrepr] + exact finitePlaceOrder_algebraMap_nonnegative q s hs + +private theorem polynomial_lift_infinityPlaceOrder_nonpositive + (P : K[X]) (hP : P ≠ 0) + (q : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) P)) (.inr q) ≤ 0 := by + let f : RatFunc K := algebraMap K[X] (RatFunc K) P + let x : L := algebraMap (RatFunc K) L f + let S := RatFuncInfinityIntegralClosure K L + let e := ratFuncInfinityIntegralClosureFractionRingEquiv K L + have hf : f ≠ 0 := RatFunc.algebraMap_ne_zero hP + have hx : x ≠ 0 := (map_ne_zero (algebraMap (RatFunc K) L)).2 hf + let a : RatFuncInfinityIntegers K := ⟨f⁻¹, by + change RatFunc.inftyValuation K f⁻¹ ≤ 1 + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K (inv_ne_zero hf), + ← exp_zero, exp_le_exp, RatFunc.intDegree_inv] + have hdegree : f.intDegree = (P.natDegree : ℤ) := by + exact RatFunc.intDegree_polynomial + rw [hdegree] + omega⟩ + let s : S := algebraMap (RatFuncInfinityIntegers K) S a + have ha : a ≠ 0 := by + intro hzero + apply inv_ne_zero hf + have hval := congrArg Subtype.val hzero + simpa [a] using hval + have hs : s ≠ 0 := by + intro hzero + apply ha + apply Subtype.ext + apply (algebraMap (RatFunc K) L).injective + have hL := congrArg Subtype.val hzero + change algebraMap (RatFunc K) L (a : RatFunc K) = + algebraMap (RatFunc K) L (0 : RatFunc K) + simpa [s] using hL + have hrepr : (e.symm x)⁻¹ = algebraMap S (FractionRing S) s := by + apply e.injective + rw [map_inv₀, e.apply_symm_apply, e.commutes] + change x⁻¹ = algebraMap (RatFunc K) L (a : RatFunc K) + simp [x, a, f] + have hey : e.symm x ≠ 0 := by simpa using hx + have hinv : 0 ≤ finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) q) ((e.symm x)⁻¹) := by + rw [hrepr] + exact finitePlaceOrder_algebraMap_nonnegative _ s hs + rw [finiteExtensionPrincipalDivisor_inr] + change finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) q) (e.symm x) ≤ 0 + rw [finitePlaceOrder_inv_eq_neg _ _ hey] at hinv + omega + +theorem finiteExtensionPositiveDegree_polynomial_cast + (P : K[X]) (hP : P ≠ 0) : + (finiteExtensionPositiveDegree K L + (algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) P)) : ℤ) = + finiteExtensionFiniteDirectDegreeSum K L + (algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) P)) := by + let x : L := algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) P) + let D := finiteExtensionPrincipalDivisor K L x + rw [finiteExtensionPositiveDegree_cast] + change (∑ v ∈ D.support.filter (fun v => 0 < D v), + D v * (finiteExtensionPlaceDegree K L v : ℤ)) = _ + have hfilter : + (∑ v ∈ D.support.filter (fun v => 0 < D v), + D v * (finiteExtensionPlaceDegree K L v : ℤ)) = + D.sum (fun v n => if 0 < n then + n * (finiteExtensionPlaceDegree K L v : ℤ) else 0) := by + rw [Finsupp.sum] + exact Finset.sum_filter _ _ + rw [hfilter] + change _ = finiteExtensionFiniteDirectDegreeSum K L x + rw [show D = + (finiteExtensionFinitePrincipalDivisor K L x).sumElim + (finiteExtensionInfinityPrincipalDivisor K L x) by + rfl, + Finsupp.sum_sumElim] + rw [finiteExtensionFiniteDirectDegreeSum] + have hfinite : + (finiteExtensionFinitePrincipalDivisor K L x).sum + (fun q n => if 0 < n then + n * (finiteExtensionPlaceDegree K L (.inl q) : ℤ) else 0) = + (finiteExtensionFinitePrincipalDivisor K L x).sum + (fun q n => n * (q.asIdeal.inertiaDeg K[X] : ℤ) * + (ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q) : ℤ)) := by + apply Finsupp.sum_congr + intro q hq + have hnonneg := polynomial_lift_finitePlaceOrder_nonnegative K L P hP q + have hne : finiteExtensionFinitePrincipalDivisor K L x q ≠ 0 := + Finsupp.mem_support_iff.mp hq + have hpos : 0 < finiteExtensionFinitePrincipalDivisor K L x q := by + rw [finiteExtensionFinitePrincipalDivisor_apply] + change 0 < finiteExtensionPrincipalDivisor K L x (.inl q) + exact lt_of_le_of_ne hnonneg (Ne.symm hne) + rw [if_pos hpos] + simp only [finiteExtensionPlaceDegree, Nat.cast_mul] + ring + have hinfinity : + (finiteExtensionInfinityPrincipalDivisor K L x).sum + (fun q n => if 0 < n then + n * (finiteExtensionPlaceDegree K L (.inr q) : ℤ) else 0) = 0 := by + rw [Finsupp.sum] + apply Finset.sum_eq_zero + intro q hq + have hnonpos := polynomial_lift_infinityPlaceOrder_nonpositive K L P hP q + have hnotpos : ¬ 0 < finiteExtensionInfinityPrincipalDivisor K L x q := by + rw [finiteExtensionInfinityPrincipalDivisor_apply] + change ¬ 0 < finiteExtensionPrincipalDivisor K L x (.inr q) + exact not_lt_of_ge hnonpos + rw [if_neg hnotpos] + change + (finiteExtensionFinitePrincipalDivisor K L x).sum + (fun q n => if 0 < n then + n * (finiteExtensionPlaceDegree K L (.inl q) : ℤ) else 0) + + (finiteExtensionInfinityPrincipalDivisor K L x).sum + (fun q n => if 0 < n then + n * (finiteExtensionPlaceDegree K L (.inr q) : ℤ) else 0) = + (finiteExtensionFinitePrincipalDivisor K L x).sum + (fun q n => n * (q.asIdeal.inertiaDeg K[X] : ℤ) * + (ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q) : ℤ)) + rw [hfinite, hinfinity, add_zero] + +theorem finiteExtensionPositiveDegree_polynomial + (P : K[X]) (hP : P ≠ 0) : + finiteExtensionPositiveDegree K L + (algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) P)) = + Module.finrank (RatFunc K) L * P.natDegree := by + have hx : algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) P) ≠ 0 := by + exact (map_ne_zero (algebraMap (RatFunc K) L)).2 + (RatFunc.algebraMap_ne_zero hP) + have hcast := finiteExtensionPositiveDegree_polynomial_cast K L P hP + rw [finiteExtensionFiniteDirectDegreeSum_eq_grouped K L _ hx, + finiteExtensionFinitePlaceDegreeSum_eq_normFinitePlaceDegreeSum K L _ hx, + Algebra.norm_algebraMap, + ratFuncExhaustiveFinitePlaceDegreeSum_eq_intDegree _ + (pow_ne_zero _ (RatFunc.algebraMap_ne_zero hP))] at hcast + have hdegree : + ((algebraMap K[X] (RatFunc K) P) ^ Module.finrank (RatFunc K) L).intDegree = + (Module.finrank (RatFunc K) L * P.natDegree : ℕ) := by + rw [← map_pow, RatFunc.intDegree_polynomial, Polynomial.natDegree_pow] + rw [hdegree] at hcast + exact_mod_cast hcast + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean new file mode 100644 index 0000000000..11b8d85b9a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean @@ -0,0 +1,72 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +import Mathlib.Tactic + +/-! # Positive divisor degree of a power -/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators + +variable (K : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The positive degree of a principal divisor scales by the exponent. -/ +theorem finiteExtensionPositiveDegree_pow + (x : L) (hx : x ≠ 0) (m : ℕ) : + finiteExtensionPositiveDegree K L (x ^ m) = + m * finiteExtensionPositiveDegree K L x := by + classical + by_cases hm : m = 0 + · subst m + simp [finiteExtensionPositiveDegree, + finiteExtensionPrincipalDivisor_one K L] + have hmpos : 0 < m := Nat.pos_of_ne_zero hm + rw [finiteExtensionPositiveDegree, + finiteExtensionPrincipalDivisor_pow K L x hx m] + have hsupp : + (m • finiteExtensionPrincipalDivisor K L x).support = + (finiteExtensionPrincipalDivisor K L x).support := by + ext w + simp only [Finsupp.mem_support_iff, Finsupp.smul_apply, nsmul_eq_mul] + constructor + · exact fun h hzero ↦ h (by rw [hzero, mul_zero]) + · exact fun h hzero ↦ h (mul_eq_zero.mp hzero |>.resolve_left + (by exact_mod_cast hm)) + rw [hsupp] + have hfilter : + (finiteExtensionPrincipalDivisor K L x).support.filter + (fun w ↦ 0 < (m • finiteExtensionPrincipalDivisor K L x) w) = + (finiteExtensionPrincipalDivisor K L x).support.filter + (fun w ↦ 0 < finiteExtensionPrincipalDivisor K L x w) := by + apply Finset.filter_congr + intro w hw + simp only [Finsupp.smul_apply, nsmul_eq_mul] + have hmposInt : (0 : ℤ) < m := by exact_mod_cast hmpos + constructor + · intro h + nlinarith + · intro h + exact mul_pos hmposInt h + rw [hfilter, finiteExtensionPositiveDegree, Finset.mul_sum] + apply Finset.sum_congr rfl + intro w hw + have hwpos : 0 < finiteExtensionPrincipalDivisor K L x w := + (Finset.mem_filter.mp hw).2 + simp only [Finsupp.smul_apply, nsmul_eq_mul] + rw [Int.toNat_mul (by positivity) hwpos.le] + simp [Nat.mul_assoc] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean new file mode 100644 index 0000000000..41166521a7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean @@ -0,0 +1,1015 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import Mathlib.Tactic + +/-! +# Principal divisors on the exhaustive places of a finite function field + +This file packages the finite primes and the primes above infinity of a finite +separable extension `L / K(X)` into one place type. Principal divisors on that +type have finite support. Their degree-weighted sum is proved to vanish by +regrouping finite primes below `K[X]` and applying the exhaustive norm product +formula. + +It also provides common finite supports for arbitrary finite families, +degree-weighted product formulas on those family place types, and the positive +degree / pole-height decomposition. Over an algebraically closed constant +field, all finite and above-infinity residue degrees are proved equal to one, +so the ordinary-order specialization has no residual place-degree hypothesis. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) principalDivisorPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance principalDivisorPolynomialScalarTower : IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance principalDivisorFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance principalDivisorFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance principalDivisorPolynomialTorsionFreeTop : Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance principalDivisorFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance principalDivisorInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance principalDivisorInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance principalDivisorInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance principalDivisorInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +def finitePlaceFiberEquivPrimesOver (p : HeightOneSpectrum K[X]) : + {q : HeightOneSpectrum (RatFuncFiniteIntegralClosure K L) // + HeightOneSpectrum.under K[X] q = p} ≃ + p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) where + toFun q := ⟨q.1.asIdeal, q.1.isPrime, ⟨by + have h := congrArg HeightOneSpectrum.asIdeal q.2 + exact h.symm⟩⟩ + invFun P := ⟨primeOverHeightOne p P, by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P.1 p.asIdeal).symm⟩ + left_inv q := by + apply Subtype.ext + apply HeightOneSpectrum.ext + rfl + right_inv P := by + apply Subtype.ext + rfl + +abbrev FiniteExtensionFinitePlace := + HeightOneSpectrum (RatFuncFiniteIntegralClosure K L) + +abbrev FiniteExtensionInfinityPlace := + (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L) + +abbrev FiniteExtensionPlace := + FiniteExtensionFinitePlace K L ⊕ FiniteExtensionInfinityPlace K L + +local instance principalDivisorInfinityPlaceFintype : + Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + +def finiteExtensionFinitePrincipalDivisor (x : L) : + FiniteExtensionFinitePlace K L →₀ ℤ := + finitePrincipalDivisor + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) + +@[simp] theorem finiteExtensionFinitePrincipalDivisor_apply + (x : L) (q : FiniteExtensionFinitePlace K L) : + finiteExtensionFinitePrincipalDivisor K L x q = + finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by + simp [finiteExtensionFinitePrincipalDivisor] + +def finiteExtensionInfinityPrincipalDivisor (x : L) : + FiniteExtensionInfinityPlace K L →₀ ℤ := + Finsupp.equivFunOnFinite.symm (fun P => + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x)) + +@[simp] theorem finiteExtensionInfinityPrincipalDivisor_apply + (x : L) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionInfinityPrincipalDivisor K L x P = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) := by + simp [finiteExtensionInfinityPrincipalDivisor] + +def finiteExtensionPrincipalDivisor (x : L) : + FiniteExtensionPlace K L →₀ ℤ := + (finiteExtensionFinitePrincipalDivisor K L x).sumElim + (finiteExtensionInfinityPrincipalDivisor K L x) + +@[simp] theorem finiteExtensionPrincipalDivisor_inl + (x : L) (q : FiniteExtensionFinitePlace K L) : + finiteExtensionPrincipalDivisor K L x (.inl q) = + finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by + simp [finiteExtensionPrincipalDivisor] + +@[simp] theorem finiteExtensionPrincipalDivisor_inr + (x : L) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L x (.inr P) = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) := by + simp [finiteExtensionPrincipalDivisor] + +def finiteExtensionFiniteResidueWeightedDivisor (x : L) : + FiniteExtensionFinitePlace K L →₀ ℤ := + (finiteExtensionFinitePrincipalDivisor K L x).sum (fun q n => + Finsupp.single q ((q.asIdeal.inertiaDeg K[X] : ℤ) * n)) + +@[simp] theorem finiteExtensionFiniteResidueWeightedDivisor_apply + (x : L) (q : FiniteExtensionFinitePlace K L) : + finiteExtensionFiniteResidueWeightedDivisor K L x q = + (q.asIdeal.inertiaDeg K[X] : ℤ) * + finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by + classical + rw [finiteExtensionFiniteResidueWeightedDivisor, Finsupp.sum_apply] + unfold Finsupp.sum + by_cases hq : q ∈ (finiteExtensionFinitePrincipalDivisor K L x).support + · rw [Finset.sum_eq_single q] + · simp + · intro b hb hbq + simp [hbq] + · exact fun hnot => (hnot hq).elim + · rw [Finset.sum_eq_zero] + · change 0 = (q.asIdeal.inertiaDeg K[X] : ℤ) * + finiteExtensionFinitePrincipalDivisor K L x q + rw [Finsupp.notMem_support_iff.mp hq] + simp + · intro b hb + have hbq : b ≠ q := by + intro h + subst h + exact hq hb + simp [hbq] + +def finiteExtensionFiniteDivisorBelow (x : L) : + HeightOneSpectrum K[X] →₀ ℤ := + (finiteExtensionFiniteResidueWeightedDivisor K L x).mapDomain + (HeightOneSpectrum.under K[X]) + +theorem finiteExtensionFiniteDivisorBelow_apply + (x : L) (p : HeightOneSpectrum K[X]) : + finiteExtensionFiniteDivisorBelow K L x p = + ∑ P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + (P.1.inertiaDeg K[X] : ℤ) * + finitePlaceOrder (primeOverHeightOne p P) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by + classical + let e := finitePlaceFiberEquivPrimesOver K L p + letI : Fintype {q : FiniteExtensionFinitePlace K L // + HeightOneSpectrum.under K[X] q = p} := + Fintype.ofEquiv (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) e.symm + let P₀ : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := + Classical.choice (Set.nonempty_coe_sort.mpr + (Set.nonempty_iff_ne_empty.mpr (by + intro hempty + have hncard := IsDedekindDomain.primesOver_ncard_ne_zero p.asIdeal + (RatFuncFiniteIntegralClosure K L) + exact hncard (by simp [hempty])))) + let q₀ : FiniteExtensionFinitePlace K L := primeOverHeightOne p P₀ + have hq₀ : HeightOneSpectrum.under K[X] q₀ = p := by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P₀.1 p.asIdeal).symm + rw [finiteExtensionFiniteDivisorBelow, show p = + HeightOneSpectrum.under K[X] q₀ from hq₀.symm, + Finsupp.mapDomain_apply_eq_sum] + let D := finiteExtensionFiniteResidueWeightedDivisor K L x + have hfilter : + (∑ q ∈ D.support with HeightOneSpectrum.under K[X] q = + HeightOneSpectrum.under K[X] q₀, D q) = + ∑ q : {q : FiniteExtensionFinitePlace K L // + HeightOneSpectrum.under K[X] q = p}, D q := by + rw [hq₀] + calc + _ = ∑ q ∈ Finset.subtype + (fun q => HeightOneSpectrum.under K[X] q = p) D.support, + D q := (Finset.sum_subtype_eq_sum_filter (s := D.support) + (fun q => D q)).symm + _ = ∑ q : {q : FiniteExtensionFinitePlace K L // + HeightOneSpectrum.under K[X] q = p}, D q := by + apply Finset.sum_subset (Finset.subset_univ _) + intro q _ hq + have hnot : q.1 ∉ D.support := by + intro hmem + exact hq (Finset.mem_subtype.mpr hmem) + exact Finsupp.notMem_support_iff.mp hnot + rw [hfilter] + rw [hq₀] + apply Fintype.sum_equiv e + intro q + have hplace : primeOverHeightOne p (e q) = q.1 := by + apply HeightOneSpectrum.ext + rfl + simp only [D, finiteExtensionFiniteResidueWeightedDivisor_apply] + rw [hplace] + rfl + +theorem finiteExtensionFiniteDivisorBelow_eq_normDivisor + (x : L) (hx : x ≠ 0) : + finiteExtensionFiniteDivisorBelow K L x = + ratFuncFiniteDivisor (Algebra.norm (RatFunc K) x) := by + ext p + rw [finiteExtensionFiniteDivisorBelow_apply K L x p, + finitePrimesAbove_weightedOrder_eq_normOrder K L p x hx, + ratFuncFiniteDivisor_apply] + +/-- The finite-place degree sum written directly on the height-one primes of +the finite integral closure. -/ +def finiteExtensionFiniteDirectDegreeSum (x : L) : ℤ := + (finiteExtensionFinitePrincipalDivisor K L x).sum (fun q n => + n * (q.asIdeal.inertiaDeg K[X] : ℤ) * + (ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q) : ℤ)) + +theorem finiteExtensionFiniteDirectDegreeSum_eq_grouped + (x : L) (hx : x ≠ 0) : + finiteExtensionFiniteDirectDegreeSum K L x = + finiteExtensionFinitePlaceDegreeSum K L x := by + classical + let D := finiteExtensionFinitePrincipalDivisor K L x + let DW := finiteExtensionFiniteResidueWeightedDivisor K L x + let DB := finiteExtensionFiniteDivisorBelow K L x + calc + finiteExtensionFiniteDirectDegreeSum K L x = + DW.sum (fun q n => n * + (ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q) : ℤ)) := by + rw [finiteExtensionFiniteDirectDegreeSum] + change D.sum _ = DW.sum _ + dsimp only [DW] + rw [finiteExtensionFiniteResidueWeightedDivisor, + Finsupp.sum_sum_index (fun _ => by simp) + (fun _ _ _ => by ring)] + apply Finsupp.sum_congr + intro q _ + rw [Finsupp.sum_single_index] + · ring + · simp + _ = DB.sum (fun p n => n * (ratFuncFinitePlaceDegree p : ℤ)) := by + dsimp only [DB, DW] + rw [finiteExtensionFiniteDivisorBelow] + symm + apply Finsupp.sum_mapDomain_index + · intro + simp + · intro _ _ _ + ring + _ = finiteExtensionFinitePlaceDegreeSum K L x := by + dsimp only [DB] + rw [finiteExtensionFiniteDivisorBelow_eq_normDivisor K L x hx, + finiteExtensionFinitePlaceDegreeSum] + apply Finsupp.sum_congr + intro p _ + rw [ratFuncFiniteDivisor_apply, + finitePrimesAbove_weightedOrder_eq_normOrder K L p x hx] + +/-- The above-infinity order sum written as a `Finsupp.sum` on the infinity +part of the principal divisor. -/ +def finiteExtensionInfinityDirectDegreeSum (x : L) : ℤ := + (finiteExtensionInfinityPrincipalDivisor K L x).sum (fun P n => + n * (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ)) + +theorem finiteExtensionInfinityDirectDegreeSum_eq_grouped (x : L) : + finiteExtensionInfinityDirectDegreeSum K L x = + finiteExtensionInfinityOrderSum K L x := by + classical + rw [finiteExtensionInfinityDirectDegreeSum, + Finsupp.sum_fintype _ _ (fun _ => by simp), + finiteExtensionInfinityOrderSum] + apply Finset.sum_congr rfl + intro P _ + rw [finiteExtensionInfinityPrincipalDivisor_apply] + ring + +/-- Degree of a place of `L`: residue degree times the degree of the place +below it. The place at infinity of `K(X)` has degree one. -/ +def finiteExtensionPlaceDegree : FiniteExtensionPlace K L → ℕ + | .inl q => q.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q) + | .inr P => P.1.inertiaDeg (RatFuncInfinityIntegers K) + +/-- Degree of the exhaustive principal divisor, summed on the actual finite +and above-infinity places of `L`. -/ +def finiteExtensionPrincipalDivisorDegreeSum (x : L) : ℤ := + (finiteExtensionPrincipalDivisor K L x).sum (fun v n => + n * (finiteExtensionPlaceDegree K L v : ℤ)) + +theorem finiteExtensionPrincipalDivisorDegreeSum_eq_grouped + (x : L) (hx : x ≠ 0) : + finiteExtensionPrincipalDivisorDegreeSum K L x = + finiteExtensionFinitePlaceDegreeSum K L x + + finiteExtensionInfinityOrderSum K L x := by + rw [finiteExtensionPrincipalDivisorDegreeSum, + finiteExtensionPrincipalDivisor, Finsupp.sum_sumElim, + ← finiteExtensionFiniteDirectDegreeSum_eq_grouped K L x hx, + ← finiteExtensionInfinityDirectDegreeSum_eq_grouped K L x] + rw [finiteExtensionFiniteDirectDegreeSum, + finiteExtensionInfinityDirectDegreeSum] + congr 1 + · apply Finsupp.sum_congr + intro q _ + simp only [Function.comp_apply, finiteExtensionPlaceDegree, Nat.cast_mul] + ring + +/-- Product formula on the actual place type, rather than grouped below the +base places. -/ +theorem finiteExtensionPrincipalDivisorDegreeSum_eq_zero + (x : L) (hx : x ≠ 0) : + finiteExtensionPrincipalDivisorDegreeSum K L x = 0 := by + rw [finiteExtensionPrincipalDivisorDegreeSum_eq_grouped K L x hx] + exact finiteExtension_exhaustivePrincipalDivisor_productFormula K L x hx + +/-- Positive degree of the principal divisor of `x`. -/ +def finiteExtensionPositiveDegree (x : L) : ℕ := + ∑ v ∈ (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => 0 < finiteExtensionPrincipalDivisor K L x v), + (finiteExtensionPrincipalDivisor K L x v).toNat * + finiteExtensionPlaceDegree K L v + +/-- Pole height of `x`, i.e. the degree of the negative part of its principal +divisor. -/ +def finiteExtensionHeight (x : L) : ℕ := + ∑ v ∈ (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => finiteExtensionPrincipalDivisor K L x v < 0), + (-finiteExtensionPrincipalDivisor K L x v).toNat * + finiteExtensionPlaceDegree K L v + +theorem finiteExtensionPositiveDegree_cast + (x : L) : + (finiteExtensionPositiveDegree K L x : ℤ) = + ∑ v ∈ (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => 0 < finiteExtensionPrincipalDivisor K L x v), + finiteExtensionPrincipalDivisor K L x v * + (finiteExtensionPlaceDegree K L v : ℤ) := by + rw [finiteExtensionPositiveDegree, Nat.cast_sum] + apply Finset.sum_congr rfl + intro v hv + have hpos : 0 < finiteExtensionPrincipalDivisor K L x v := + (Finset.mem_filter.mp hv).2 + rw [Nat.cast_mul, Int.toNat_of_nonneg (le_of_lt hpos)] + +theorem finiteExtensionHeight_negativeSum + (x : L) : + -((finiteExtensionHeight K L x : ℕ) : ℤ) = + ∑ v ∈ (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => finiteExtensionPrincipalDivisor K L x v < 0), + finiteExtensionPrincipalDivisor K L x v * + (finiteExtensionPlaceDegree K L v : ℤ) := by + rw [finiteExtensionHeight, Nat.cast_sum, ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro v hv + have hneg : finiteExtensionPrincipalDivisor K L x v < 0 := + (Finset.mem_filter.mp hv).2 + rw [Nat.cast_mul, Int.toNat_of_nonneg (Int.neg_nonneg.mpr (le_of_lt hneg))] + ring + +theorem finiteExtensionPositiveDegree_eq_height + (x : L) (hx : x ≠ 0) : + finiteExtensionPositiveDegree K L x = finiteExtensionHeight K L x := by + have hproduct := finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L x hx + rw [finiteExtensionPrincipalDivisorDegreeSum] at hproduct + have hsplit : + (finiteExtensionPrincipalDivisor K L x).sum (fun v n => + n * (finiteExtensionPlaceDegree K L v : ℤ)) = + (∑ v ∈ (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => 0 < finiteExtensionPrincipalDivisor K L x v), + finiteExtensionPrincipalDivisor K L x v * + (finiteExtensionPlaceDegree K L v : ℤ)) + + (∑ v ∈ (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => finiteExtensionPrincipalDivisor K L x v < 0), + finiteExtensionPrincipalDivisor K L x v * + (finiteExtensionPlaceDegree K L v : ℤ)) := by + rw [Finsupp.sum] + rw [← Finset.sum_filter_add_sum_filter_not + (finiteExtensionPrincipalDivisor K L x).support + (fun v => 0 < finiteExtensionPrincipalDivisor K L x v)] + congr 1 + have hfilters : + (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => ¬ 0 < finiteExtensionPrincipalDivisor K L x v) = + (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => finiteExtensionPrincipalDivisor K L x v < 0) := by + ext v + simp only [Finset.mem_filter] + constructor + · intro ⟨hv, hnotpos⟩ + have hvne : finiteExtensionPrincipalDivisor K L x v ≠ 0 := + Finsupp.mem_support_iff.mp hv + exact ⟨hv, lt_of_le_of_ne (le_of_not_gt hnotpos) hvne⟩ + · intro ⟨hv, hneg⟩ + exact ⟨hv, not_lt_of_ge (le_of_lt hneg)⟩ + rw [hfilters] + have hcast : (finiteExtensionPositiveDegree K L x : ℤ) = + (finiteExtensionHeight K L x : ℤ) := by + rw [finiteExtensionPositiveDegree_cast] + rw [hsplit, ← finiteExtensionHeight_negativeSum K L x] at hproduct + omega + exact_mod_cast hcast + +section Families + +variable {A : Type*} [Fintype A] + +local instance familyPlaceDecidableEq : DecidableEq (FiniteExtensionPlace K L) := + Classical.decEq _ + +/-- A single finite place set supporting the principal divisors of every +member of a finite family. -/ +def finiteExtensionFamilySupport (f : A → L) : + Finset (FiniteExtensionPlace K L) := by + classical + exact Finset.univ.biUnion (fun a => + (finiteExtensionPrincipalDivisor K L (f a)).support) + +abbrev FiniteExtensionFamilyPlace (f : A → L) := + {v : FiniteExtensionPlace K L // v ∈ finiteExtensionFamilySupport K L f} + +/-- Ordinary order of a family member on the common finite place set. -/ +def finiteExtensionFamilyOrder (f : A → L) (a : A) + (v : FiniteExtensionFamilyPlace K L f) : ℤ := + finiteExtensionPrincipalDivisor K L (f a) v.1 + +/-- Degree-weighted order. These are the values whose unweighted sum is zero +without any algebraic-closedness assumption on the constant field. -/ +def finiteExtensionFamilyWeightedOrder (f : A → L) (a : A) + (v : FiniteExtensionFamilyPlace K L f) : ℤ := + finiteExtensionFamilyOrder K L f a v * + (finiteExtensionPlaceDegree K L v.1 : ℤ) + +theorem finiteExtensionPrincipalDivisor_support_subset_familySupport + (f : A → L) (a : A) : + (finiteExtensionPrincipalDivisor K L (f a)).support ⊆ + finiteExtensionFamilySupport K L f := by + intro v hv + simp only [finiteExtensionFamilySupport, Finset.mem_biUnion, + Finset.mem_univ, true_and] + exact ⟨a, hv⟩ + +theorem finiteExtensionFamilyOrder_eq_zero_of_not_mem_support + (f : A → L) (a : A) (v : FiniteExtensionFamilyPlace K L f) + (hv : v.1 ∉ (finiteExtensionPrincipalDivisor K L (f a)).support) : + finiteExtensionFamilyOrder K L f a v = 0 := by + exact Finsupp.notMem_support_iff.mp hv + +/-- Product formula for any member of an arbitrary finite family, on the one +common finite place type attached to that family. -/ +theorem finiteExtensionFamilyWeightedOrder_sum_eq_zero + (f : A → L) (a : A) (ha : f a ≠ 0) : + ∑ v : FiniteExtensionFamilyPlace K L f, + finiteExtensionFamilyWeightedOrder K L f a v = 0 := by + let D := finiteExtensionPrincipalDivisor K L (f a) + let S := finiteExtensionFamilySupport K L f + calc + ∑ v : FiniteExtensionFamilyPlace K L f, + finiteExtensionFamilyWeightedOrder K L f a v = + ∑ v ∈ S, D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + symm + apply Finset.sum_subtype S (fun _ => Iff.rfl) + _ = ∑ v ∈ D.support, + D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + symm + apply Finset.sum_subset + (finiteExtensionPrincipalDivisor_support_subset_familySupport K L f a) + intro v _ hv + have hzero : D v = 0 := by + apply Finsupp.notMem_support_iff.mp + exact hv + simp [hzero] + _ = finiteExtensionPrincipalDivisorDegreeSum K L (f a) := by + rfl + _ = 0 := finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L (f a) ha + +theorem finiteExtensionFamilyWeightedPositiveSum + (f : A → L) (a : A) : + ∑ v ∈ Finset.univ.filter + (fun v : FiniteExtensionFamilyPlace K L f => + 0 < finiteExtensionFamilyOrder K L f a v), + finiteExtensionFamilyWeightedOrder K L f a v = + (finiteExtensionPositiveDegree K L (f a) : ℤ) := by + let D := finiteExtensionPrincipalDivisor K L (f a) + let S := finiteExtensionFamilySupport K L f + rw [finiteExtensionPositiveDegree_cast K L (f a)] + calc + _ = ∑ v : FiniteExtensionFamilyPlace K L f, + if 0 < finiteExtensionFamilyOrder K L f a v then + finiteExtensionFamilyWeightedOrder K L f a v else 0 := by + rw [Finset.sum_filter] + _ = ∑ v ∈ S, if 0 < D v then + D v * (finiteExtensionPlaceDegree K L v : ℤ) else 0 := by + symm + apply Finset.sum_subtype S (fun _ => Iff.rfl) + _ = ∑ v ∈ S.filter (fun v => 0 < D v), + D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + rw [Finset.sum_filter] + _ = ∑ v ∈ D.support.filter (fun v => 0 < D v), + D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + symm + apply Finset.sum_subset + · intro v hv + exact Finset.mem_filter.mpr ⟨ + finiteExtensionPrincipalDivisor_support_subset_familySupport K L f a + (Finset.mem_filter.mp hv).1, + (Finset.mem_filter.mp hv).2⟩ + · intro v hvS hvD + have hnotSupport : v ∉ D.support := by + intro hv + exact hvD (Finset.mem_filter.mpr ⟨hv, (Finset.mem_filter.mp hvS).2⟩) + have hzero := Finsupp.notMem_support_iff.mp hnotSupport + simp [hzero] + +theorem finiteExtensionFamilyWeightedNegativeSum + (f : A → L) (a : A) : + ∑ v ∈ Finset.univ.filter + (fun v : FiniteExtensionFamilyPlace K L f => + finiteExtensionFamilyOrder K L f a v < 0), + finiteExtensionFamilyWeightedOrder K L f a v = + -((finiteExtensionHeight K L (f a) : ℕ) : ℤ) := by + let D := finiteExtensionPrincipalDivisor K L (f a) + let S := finiteExtensionFamilySupport K L f + rw [finiteExtensionHeight_negativeSum K L (f a)] + calc + _ = ∑ v : FiniteExtensionFamilyPlace K L f, + if finiteExtensionFamilyOrder K L f a v < 0 then + finiteExtensionFamilyWeightedOrder K L f a v else 0 := by + rw [Finset.sum_filter] + _ = ∑ v ∈ S, if D v < 0 then + D v * (finiteExtensionPlaceDegree K L v : ℤ) else 0 := by + symm + apply Finset.sum_subtype S (fun _ => Iff.rfl) + _ = ∑ v ∈ S.filter (fun v => D v < 0), + D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + rw [Finset.sum_filter] + _ = ∑ v ∈ D.support.filter (fun v => D v < 0), + D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + symm + apply Finset.sum_subset + · intro v hv + exact Finset.mem_filter.mpr ⟨ + finiteExtensionPrincipalDivisor_support_subset_familySupport K L f a + (Finset.mem_filter.mp hv).1, + (Finset.mem_filter.mp hv).2⟩ + · intro v hvS hvD + have hnotSupport : v ∉ D.support := by + intro hv + exact hvD (Finset.mem_filter.mpr ⟨hv, (Finset.mem_filter.mp hvS).2⟩) + have hzero := Finsupp.notMem_support_iff.mp hnotSupport + simp [hzero] + +/-- Pole height outside a caller-specified exceptional set. This is the +quantity occurring on the right of the global Wronskian inequality. -/ +def finiteExtensionFamilyOutsideHeight + (f : A → L) (S : Finset (FiniteExtensionFamilyPlace K L f)) + (a : A) : ℕ := by + classical + exact ∑ v ∈ Finset.univ.filter (fun v => v ∉ S ∧ + finiteExtensionFamilyOrder K L f a v < 0), + (finiteExtensionFamilyWeightedOrder K L f a v).natAbs + +theorem finiteExtensionFamilyOutsideHeight_negativeSum + (f : A → L) (S : Finset (FiniteExtensionFamilyPlace K L f)) + (a : A) : + ∑ v ∈ Finset.univ.filter (fun v => v ∉ S ∧ + finiteExtensionFamilyOrder K L f a v < 0), + finiteExtensionFamilyWeightedOrder K L f a v = + -((finiteExtensionFamilyOutsideHeight K L f S a : ℕ) : ℤ) := by + classical + rw [finiteExtensionFamilyOutsideHeight, Nat.cast_sum, + ← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro v hv + have hneg : finiteExtensionFamilyOrder K L f a v < 0 := + (Finset.mem_filter.mp hv).2.2 + have hdegree : 0 ≤ (finiteExtensionPlaceDegree K L v.1 : ℤ) := by + positivity + have hweighted : finiteExtensionFamilyWeightedOrder K L f a v ≤ 0 := by + rw [finiteExtensionFamilyWeightedOrder] + exact mul_nonpos_of_nonpos_of_nonneg (le_of_lt hneg) hdegree + rw [Int.natCast_natAbs, abs_of_nonpos hweighted] + ring + +end Families + +section WeightedFamilies + +variable {A : Type*} [Fintype A] + +/-- The residue-degree-weighted Corvaja--Zannier summation on the exhaustive +family place type. Unlike the later degree-one specialization, this theorem +does not assume that the constant field is algebraically closed. -/ +theorem globalWronskianInequality_of_finiteExtensionWeightedPlacewiseBounds + (f : A → L) (iU iV iRho iGrid iW : A) + (S : Finset (FiniteExtensionFamilyPlace K L f)) + (h k n sigma chi : ℕ) (canonicalDegree : ℤ) + (hUne : f iU ≠ 0) (hGridne : f iGrid ≠ 0) + (hUOutside : ∀ i, i ∉ S → + finiteExtensionFamilyOrder K L f iU i = 0) + (hGridOutside : ∀ i, i ∉ S → + finiteExtensionFamilyOrder K L f iGrid i = 0) + (hVPositiveSupport : ∀ i, + 0 < finiteExtensionFamilyOrder K L f iV i → i ∈ S) + (hCanonical : + ∑ i, finiteExtensionFamilyWeightedOrder K L f iW i = + (sigma : ℤ) * canonicalDegree) + (hEuler : canonicalDegree + + (∑ i ∈ S, finiteExtensionPlaceDegree K L i.1 : ℕ) ≤ (chi : ℤ)) + (hRhoSupport : + -((finiteExtensionPositiveDegree K L (f iU) : ℤ) + + (finiteExtensionPositiveDegree K L (f iV) : ℤ)) ≤ + ∑ i ∈ S, finiteExtensionFamilyWeightedOrder K L f iRho i) + (hCaseI : ∀ i, i ∉ S → + finiteExtensionFamilyOrder K L f iRho i < 0 → + (n : ℤ) * finiteExtensionFamilyOrder K L f iRho i ≤ + finiteExtensionFamilyOrder K L f iW i) + (hCaseII : ∀ i, i ∉ S → + 0 ≤ finiteExtensionFamilyOrder K L f iRho i → + 0 ≤ finiteExtensionFamilyOrder K L f iW i) + (hCaseIII : ∀ i, i ∈ S → + 0 < finiteExtensionFamilyOrder K L f iV i → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionFamilyOrder K L f iU i + + ((h * k : ℕ) : ℤ) * finiteExtensionFamilyOrder K L f iV i + + (k : ℤ) * finiteExtensionFamilyOrder K L f iRho i + + finiteExtensionFamilyOrder K L f iGrid i - (sigma : ℤ) ≤ + finiteExtensionFamilyOrder K L f iW i) + (hCaseIV : ∀ i, i ∈ S → + finiteExtensionFamilyOrder K L f iV i ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionFamilyOrder K L f iU i + + (k : ℤ) * finiteExtensionFamilyOrder K L f iRho i + + finiteExtensionFamilyOrder K L f iGrid i - (sigma : ℤ) ≤ + finiteExtensionFamilyOrder K L f iW i) : + ((h * k : ℕ) : ℤ) * + (finiteExtensionPositiveDegree K L (f iV) : ℤ) - + (k : ℤ) * + ((finiteExtensionPositiveDegree K L (f iU) : ℤ) + + (finiteExtensionPositiveDegree K L (f iV) : ℤ)) - + (sigma : ℤ) * (chi : ℤ) ≤ + (n : ℤ) * + (finiteExtensionFamilyOutsideHeight K L f S iRho : ℤ) := by + classical + have hUSum : + ∑ i, finiteExtensionFamilyOrder K L f iU i * + (finiteExtensionPlaceDegree K L i.1 : ℤ) = 0 := by + simpa only [finiteExtensionFamilyWeightedOrder] using + finiteExtensionFamilyWeightedOrder_sum_eq_zero K L f iU hUne + have hGridSum : + ∑ i, finiteExtensionFamilyOrder K L f iGrid i * + (finiteExtensionPlaceDegree K L i.1 : ℤ) = 0 := by + simpa only [finiteExtensionFamilyWeightedOrder] using + finiteExtensionFamilyWeightedOrder_sum_eq_zero K L f iGrid hGridne + have hPositiveAll := finiteExtensionFamilyWeightedPositiveSum K L f iV + have hDegreeV : + ∑ i ∈ S.filter (fun i ↦ + 0 < finiteExtensionFamilyOrder K L f iV i), + finiteExtensionFamilyOrder K L f iV i * + (finiteExtensionPlaceDegree K L i.1 : ℤ) = + finiteExtensionPositiveDegree K L (f iV) := by + calc + _ = ∑ i ∈ Finset.univ.filter (fun i ↦ + 0 < finiteExtensionFamilyOrder K L f iV i), + finiteExtensionFamilyWeightedOrder K L f iV i := by + rw [show (∑ i ∈ S.filter (fun i ↦ + 0 < finiteExtensionFamilyOrder K L f iV i), + finiteExtensionFamilyOrder K L f iV i * + (finiteExtensionPlaceDegree K L i.1 : ℤ)) = + ∑ i ∈ S.filter (fun i ↦ + 0 < finiteExtensionFamilyOrder K L f iV i), + finiteExtensionFamilyWeightedOrder K L f iV i by + apply Finset.sum_congr rfl + intro i _ + rfl] + apply Finset.sum_subset + · intro i hi + exact Finset.mem_filter.mpr ⟨Finset.mem_univ i, + (Finset.mem_filter.mp hi).2⟩ + · intro i hi hiS + have hpos := (Finset.mem_filter.mp hi).2 + exact False.elim + (hiS (Finset.mem_filter.mpr ⟨hVPositiveSupport i hpos, hpos⟩)) + _ = _ := hPositiveAll + have hOutside := finiteExtensionFamilyOutsideHeight_negativeSum K L f S iRho + have hOutside' : + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ + finiteExtensionFamilyOrder K L f iRho i < 0), + finiteExtensionFamilyOrder K L f iRho i * + (finiteExtensionPlaceDegree K L i.1 : ℤ) = + -((finiteExtensionFamilyOutsideHeight K L f S iRho : ℕ) : ℤ) := by + rw [show (∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ + finiteExtensionFamilyOrder K L f iRho i < 0), + finiteExtensionFamilyOrder K L f iRho i * + (finiteExtensionPlaceDegree K L i.1 : ℤ)) = + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ + finiteExtensionFamilyOrder K L f iRho i < 0), + finiteExtensionFamilyWeightedOrder K L f iRho i by + apply Finset.sum_congr rfl + intro i _ + rfl] + convert hOutside using 1 + apply Finset.sum_congr + · ext i + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + · intro i hi + rfl + apply globalWronskianInequality_of_weightedPlacewiseBounds + (fun i ↦ finiteExtensionPlaceDegree K L i.1) S + (finiteExtensionFamilyOrder K L f iU) + (finiteExtensionFamilyOrder K L f iV) + (finiteExtensionFamilyOrder K L f iRho) + (finiteExtensionFamilyOrder K L f iGrid) + (finiteExtensionFamilyOrder K L f iW) + h k n sigma + (finiteExtensionPositiveDegree K L (f iU)) + (finiteExtensionPositiveDegree K L (f iV)) + chi (finiteExtensionFamilyOutsideHeight K L f S iRho) + canonicalDegree + · exact hUOutside + · exact hGridOutside + · exact hUSum + · exact hGridSum + · exact hDegreeV + · exact hOutside' + · simpa only [finiteExtensionFamilyWeightedOrder] using hCanonical + · exact hEuler + · simpa only [finiteExtensionFamilyWeightedOrder] using hRhoSupport + · exact hCaseI + · exact hCaseII + · exact hCaseIII + · exact hCaseIV + +end WeightedFamilies + +section AlgebraicallyClosedProbe + +variable [IsAlgClosed K] + +local instance finiteIntegralClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp + (algebraMap K K[X])) + +local instance finiteIntegralClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + .of_algebraMap_eq' rfl + +noncomputable def ratFuncFinitePlaceResidueEquiv (p : HeightOneSpectrum K[X]) : + p.asIdeal.ResidueField ≃ₐ[K] K := by + let r := finitePlaceNormalizedPrime p + have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero + have hrmonic : (r : K[X]).Monic := + (Polynomial.normalize_eq_self_iff_monic hr0).mp r.property.2 + have hrdegree : (r : K[X]).degree = 1 := + IsAlgClosed.degree_eq_one_of_irreducible K r.property.1.irreducible + let c : K := -(r : K[X]).coeff 0 + have hrlinear : (r : K[X]) = Polynomial.X - Polynomial.C c := by + rw [Polynomial.eq_X_add_C_of_degree_eq_one hrdegree, hrmonic.leadingCoeff] + simp [c] + have hpideal : p.asIdeal = Ideal.span + ({Polynomial.X - Polynomial.C c} : Set K[X]) := by + calc + p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by + rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] + _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl + _ = Ideal.span ({Polynomial.X - Polynomial.C c} : Set K[X]) := by + rw [hrlinear] + let eQuot : (K[X] ⧸ p.asIdeal) ≃ₐ[K] K := + (Ideal.quotientEquivAlgOfEq K hpideal).trans + (Polynomial.quotientSpanXSubCAlgEquiv c) + let eResidue : (K[X] ⧸ p.asIdeal) ≃ₐ[K] p.asIdeal.ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K (K[X] ⧸ p.asIdeal) p.asIdeal.ResidueField) + p.asIdeal.bijective_algebraMap_quotient_residueField + exact eResidue.symm.trans eQuot + +theorem ratFuncFinitePlaceDegree_eq_one (p : HeightOneSpectrum K[X]) : + ratFuncFinitePlaceDegree p = 1 := by + let r := finitePlaceNormalizedPrime p + have hrdegree : (r : K[X]).degree = 1 := + IsAlgClosed.degree_eq_one_of_irreducible K r.property.1.irreducible + rw [ratFuncFinitePlaceDegree] + exact Polynomial.natDegree_eq_of_degree_eq_some hrdegree + +theorem finiteExtensionFinitePlace_inertiaDeg_eq_one + (q : FiniteExtensionFinitePlace K L) : + q.asIdeal.inertiaDeg K[X] = 1 := by + let p := HeightOneSpectrum.under K[X] q + letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := + ⟨rfl⟩ + letI : IsAlgClosed p.asIdeal.ResidueField := + IsAlgClosed.of_ringEquiv K p.asIdeal.ResidueField + (ratFuncFinitePlaceResidueEquiv K p).symm.toRingEquiv + letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance + letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := + inferInstance + letI : Algebra.IsIntegral p.asIdeal.ResidueField q.asIdeal.ResidueField := + Algebra.IsIntegral.of_finite _ _ + rw [Ideal.inertiaDeg_eq p.asIdeal q.asIdeal, + Algebra.finrank_eq_one_iff_bijective_algebraMap] + exact IsAlgClosed.algebraMap_bijective_of_isIntegral + +/-- Over an algebraically closed constant field, all actual places of the +extension have degree one. -/ +theorem finiteExtensionPlaceDegree_eq_one + (v : FiniteExtensionPlace K L) : + finiteExtensionPlaceDegree K L v = 1 := by + cases v with + | inl q => + simp [finiteExtensionPlaceDegree, + finiteExtensionFinitePlace_inertiaDeg_eq_one K L q, + ratFuncFinitePlaceDegree_eq_one K + (HeightOneSpectrum.under K[X] q)] + | inr P => + simpa [finiteExtensionPlaceDegree] using + finiteExtensionInfinityPlace_inertiaDeg_eq_one K L P + +section AlgebraicallyClosedFamilies + +variable {A : Type*} [Fintype A] + +/-- Ordinary (unweighted) product formula on the common family place type. -/ +theorem finiteExtensionFamilyOrder_sum_eq_zero + (f : A → L) (a : A) (ha : f a ≠ 0) : + ∑ v : FiniteExtensionFamilyPlace K L f, + finiteExtensionFamilyOrder K L f a v = 0 := by + have hweighted := finiteExtensionFamilyWeightedOrder_sum_eq_zero K L f a ha + simpa only [finiteExtensionFamilyWeightedOrder, + finiteExtensionPlaceDegree_eq_one K L, + Int.ofNat_eq_natCast, Nat.cast_one, mul_one] using hweighted + +theorem finiteExtensionFamilyWeightedOrder_eq_order + (f : A → L) (a : A) (v : FiniteExtensionFamilyPlace K L f) : + finiteExtensionFamilyWeightedOrder K L f a v = + finiteExtensionFamilyOrder K L f a v := by + rw [finiteExtensionFamilyWeightedOrder, + finiteExtensionPlaceDegree_eq_one K L] + simp + +/-- The global Corvaja--Zannier summation specialized to the exhaustive family +place type. Principal-divisor sums, the positive degree of `V`, and the pole +height of `rho` outside `S` are discharged by this file. The exceptional-set +support conditions, canonical-divisor identity and bound, rho support bound, +and the four local Wronskian estimates remain explicit inputs. -/ +theorem globalWronskianInequality_of_finiteExtensionPlacewiseBounds + (f : A → L) (iU iV iRho iGrid iW : A) + (S : Finset (FiniteExtensionFamilyPlace K L f)) + (h k n sigma chi : ℕ) (canonicalDegree : ℤ) + (hUne : f iU ≠ 0) (hGridne : f iGrid ≠ 0) + (hUOutside : ∀ i, i ∉ S → + finiteExtensionFamilyOrder K L f iU i = 0) + (hGridOutside : ∀ i, i ∉ S → + finiteExtensionFamilyOrder K L f iGrid i = 0) + (hVPositiveSupport : ∀ i, + 0 < finiteExtensionFamilyOrder K L f iV i → i ∈ S) + (hCanonical : + ∑ i, finiteExtensionFamilyOrder K L f iW i = + (sigma : ℤ) * canonicalDegree) + (hEuler : canonicalDegree + S.card ≤ (chi : ℤ)) + (hRhoSupport : + -((finiteExtensionPositiveDegree K L (f iU) : ℤ) + + (finiteExtensionPositiveDegree K L (f iV) : ℤ)) ≤ + ∑ i ∈ S, finiteExtensionFamilyOrder K L f iRho i) + (hCaseI : ∀ i, i ∉ S → + finiteExtensionFamilyOrder K L f iRho i < 0 → + (n : ℤ) * finiteExtensionFamilyOrder K L f iRho i ≤ + finiteExtensionFamilyOrder K L f iW i) + (hCaseII : ∀ i, i ∉ S → + 0 ≤ finiteExtensionFamilyOrder K L f iRho i → + 0 ≤ finiteExtensionFamilyOrder K L f iW i) + (hCaseIII : ∀ i, i ∈ S → + 0 < finiteExtensionFamilyOrder K L f iV i → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionFamilyOrder K L f iU i + + ((h * k : ℕ) : ℤ) * finiteExtensionFamilyOrder K L f iV i + + (k : ℤ) * finiteExtensionFamilyOrder K L f iRho i + + finiteExtensionFamilyOrder K L f iGrid i - (sigma : ℤ) ≤ + finiteExtensionFamilyOrder K L f iW i) + (hCaseIV : ∀ i, i ∈ S → + finiteExtensionFamilyOrder K L f iV i ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * + finiteExtensionFamilyOrder K L f iU i + + (k : ℤ) * finiteExtensionFamilyOrder K L f iRho i + + finiteExtensionFamilyOrder K L f iGrid i - (sigma : ℤ) ≤ + finiteExtensionFamilyOrder K L f iW i) : + ((h * k : ℕ) : ℤ) * + (finiteExtensionPositiveDegree K L (f iV) : ℤ) - + (k : ℤ) * + ((finiteExtensionPositiveDegree K L (f iU) : ℤ) + + (finiteExtensionPositiveDegree K L (f iV) : ℤ)) - + (sigma : ℤ) * (chi : ℤ) ≤ + (n : ℤ) * + (finiteExtensionFamilyOutsideHeight K L f S iRho : ℤ) := by + classical + have hUSum : ∑ i, finiteExtensionFamilyOrder K L f iU i = 0 := + finiteExtensionFamilyOrder_sum_eq_zero K L f iU hUne + have hGridSum : ∑ i, finiteExtensionFamilyOrder K L f iGrid i = 0 := + finiteExtensionFamilyOrder_sum_eq_zero K L f iGrid hGridne + have hPositiveAll := finiteExtensionFamilyWeightedPositiveSum K L f iV + simp_rw [finiteExtensionFamilyWeightedOrder_eq_order K L f iV] at hPositiveAll + have hDegreeV : + ∑ i ∈ S.filter (fun i => + 0 < finiteExtensionFamilyOrder K L f iV i), + finiteExtensionFamilyOrder K L f iV i = + finiteExtensionPositiveDegree K L (f iV) := by + calc + _ = ∑ i ∈ Finset.univ.filter (fun i => + 0 < finiteExtensionFamilyOrder K L f iV i), + finiteExtensionFamilyOrder K L f iV i := by + apply Finset.sum_subset + · intro i hi + exact Finset.mem_filter.mpr ⟨Finset.mem_univ i, + (Finset.mem_filter.mp hi).2⟩ + · intro i hi hiS + have hpos := (Finset.mem_filter.mp hi).2 + exact False.elim + (hiS (Finset.mem_filter.mpr ⟨hVPositiveSupport i hpos, hpos⟩)) + _ = _ := hPositiveAll + have hOutside := finiteExtensionFamilyOutsideHeight_negativeSum K L f S iRho + simp_rw [finiteExtensionFamilyWeightedOrder_eq_order K L f iRho] at hOutside + have hOutside' : + ∑ i ∈ Finset.univ.filter (fun i => i ∉ S ∧ + finiteExtensionFamilyOrder K L f iRho i < 0), + finiteExtensionFamilyOrder K L f iRho i = + -((finiteExtensionFamilyOutsideHeight K L f S iRho : ℕ) : ℤ) := by + convert hOutside using 1 + apply Finset.sum_congr + · ext i + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + · intro i hi + rfl + exact globalWronskianInequality_of_placewiseBounds + S + (finiteExtensionFamilyOrder K L f iU) + (finiteExtensionFamilyOrder K L f iV) + (finiteExtensionFamilyOrder K L f iRho) + (finiteExtensionFamilyOrder K L f iGrid) + (finiteExtensionFamilyOrder K L f iW) + h k n sigma + (finiteExtensionPositiveDegree K L (f iU)) + (finiteExtensionPositiveDegree K L (f iV)) + chi (finiteExtensionFamilyOutsideHeight K L f S iRho) + canonicalDegree hUOutside hGridOutside hUSum hGridSum hDegreeV + hOutside' hCanonical hEuler hRhoSupport hCaseI hCaseII hCaseIII hCaseIV + +end AlgebraicallyClosedFamilies + +end AlgebraicallyClosedProbe + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean new file mode 100644 index 0000000000..43ca13d7a7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean @@ -0,0 +1,380 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.Ideal.Norm.RelNorm +import Mathlib.FieldTheory.IsSepClosed + +/-! +# Finite-extension norm and place-count formula + +For a finite torsion-free extension of Dedekind domains, this file identifies +the exponent of the relative norm of an integral ideal at a height-one prime +with the inertia-degree-weighted sum of the ideal's exponents at all primes +above it. The principal-integral specialization gives the corresponding +formula for `Algebra.intNorm`. + +This is the finite-place norm bridge needed to pass from the rational-function +field product formula to a finite function-field extension. The final theorem +clears a denominator to extend the identity to arbitrary elements of the +fraction field. Places at infinity are treated separately. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain UniqueFactorizationMonoid + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +namespace BGS.CorvajaZannier + +noncomputable section + + +section PrimeOver + +variable {R S : Type*} [CommRing R] [IsDomain R] + [CommRing S] [IsDomain S] [Algebra R S] [Module.IsTorsionFree R S] + +/-- A prime of `S` over a height-one prime of `R`, regarded as a height-one +prime of `S`. -/ +def primeOverHeightOne (p : HeightOneSpectrum R) + (P : p.asIdeal.primesOver S) : HeightOneSpectrum S where + asIdeal := P.1 + isPrime := P.2.1 + ne_bot := Ideal.ne_bot_of_mem_primesOver p.ne_bot P.2 + +@[simp] +theorem primeOverHeightOne_asIdeal (p : HeightOneSpectrum R) + (P : p.asIdeal.primesOver S) : + (primeOverHeightOne p P).asIdeal = P.1 := rfl + +end PrimeOver + +section RelativeNorm + +variable {R S : Type*} [CommRing R] [IsDedekindDomain R] + [CommRing S] [IsDedekindDomain S] [Algebra R S] [Module.Finite R S] + [Module.IsTorsionFree R S] + [Algebra.IsSeparable (FractionRing R) (FractionRing S)] + +local instance relativeNormFractionRingFiniteDimensional : + FiniteDimensional (FractionRing R) (FractionRing S) := + Module.Finite.of_isLocalization R S R⁰ + +local notation3 "K" => FractionRing R +local notation3 "L" => FractionRing S + +/-- The maximal-prime relative-norm formula needs separability of the actual +fraction-field extension, not perfectness of the base fraction field. The +normal-closure proof is the same as Mathlib's +`Ideal.relNorm_eq_pow_of_isMaximal`, with that sharper hypothesis. -/ +private theorem relNorm_eq_pow_of_isMaximal_of_isSeparable + (P : Ideal S) (p : Ideal R) [P.LiesOver p] + [P.IsMaximal] [p.IsMaximal] : + Ideal.relNorm R P = p ^ P.inertiaDeg R := by + let M := SeparableClosure K + let φ : L →ₐ[K] M := IsSepClosed.lift + let E : IntermediateField K M := IntermediateField.normalClosure K L M + let φE := φ.codRestrict E.toSubalgebra (fun x => + φ.fieldRange_le_normalClosure ⟨x, rfl⟩) + letI : Algebra L E := φE.toAlgebra + letI : IsScalarTower K L E := IsScalarTower.of_algHom φE + letI : Algebra S E := + ((algebraMap L E).comp (algebraMap S L)).toAlgebra + letI : IsScalarTower S L E := IsScalarTower.of_algebraMap_eq' rfl + let T := integralClosure S E + letI : CommRing T := inferInstanceAs (CommRing (integralClosure S E)) + letI : IsDomain T := inferInstanceAs (IsDomain (integralClosure S E)) + letI : Algebra S T := inferInstanceAs (Algebra S (integralClosure S E)) + letI : Algebra T E := inferInstanceAs (Algebra (integralClosure S E) E) + letI : IsScalarTower S T E := + inferInstanceAs (IsScalarTower S (integralClosure S E) E) + letI : IsIntegralClosure T S E := + integralClosure.isIntegralClosure S E + letI : Algebra R T := ((algebraMap S T).comp (algebraMap R S)).toAlgebra + letI : IsScalarTower R S T := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower R L E := IsScalarTower.to₁₃₄ R K L E + letI : IsScalarTower R S E := IsScalarTower.to₁₂₄ R S L E + letI : IsScalarTower R T E := IsScalarTower.to₁₃₄ R S T E + letI : FaithfulSMul S E := + (faithfulSMul_iff_algebraMap_injective S E).mpr + ((FaithfulSMul.algebraMap_injective L E).comp + (FaithfulSMul.algebraMap_injective S L)) + letI : IsGalois K E := IsGalois.normalClosure K L M + letI : FiniteDimensional K E := + normalClosure.is_finiteDimensional K L M + letI : FiniteDimensional L E := Module.Finite.right K L E + letI : Algebra.IsSeparable L E := + Algebra.isSeparable_tower_top_of_isSeparable K L E + letI : IsFractionRing T E := + integralClosure.isFractionRing_of_finite_extension L E + letI : Module.IsTorsionFree S T := + Subalgebra.instIsTorsionFree (integralClosure S E) + letI : FaithfulSMul R T := + (faithfulSMul_iff_algebraMap_injective R T).mpr + ((FaithfulSMul.algebraMap_injective S T).comp + (FaithfulSMul.algebraMap_injective R S)) + letI : Module.Finite S T := IsIntegralClosure.finite S L E T + letI : Module.Finite R T := Module.Finite.trans S T + letI : IsDedekindDomain T := + integralClosure.isDedekindDomain S L E + letI : IsGalois K (FractionRing T) := by + refine IsGalois.of_equiv_equiv (F := K) (E := E) + (f := (FractionRing.algEquiv R K).symm.toRingEquiv) + (g := (FractionRing.algEquiv T E).symm.toRingEquiv) ?_ + ext + simpa using! IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv R K).symm + (FractionRing.algEquiv T E).symm _ + obtain ⟨Q, hQ⟩ : ∃ Q : Ideal T, Q.IsMaximal ∧ Q.LiesOver P := + Ideal.exists_maximal_ideal_liesOver_of_isIntegral P + letI : Q.IsMaximal := hQ.1 + letI : Q.LiesOver P := hQ.2 + letI : Q.LiesOver p := Ideal.LiesOver.trans Q P p + have h := Ideal.relNorm_eq_pow_of_isPrime_isGalois Q p + letI : IsGalois (FractionRing S) (FractionRing T) := + IsGalois.tower_top_of_isGalois + (FractionRing R) (FractionRing S) (FractionRing T) + rwa [← Ideal.relNorm_relNorm R S, + Ideal.relNorm_eq_pow_of_isPrime_isGalois Q P, map_pow, + Ideal.inertiaDeg_tower (R := R) P Q, pow_mul, + pow_left_inj (Ideal.inertiaDeg_pos Q S).ne'] at h + +private theorem count_relNorm_heightOne_of_liesOver (p : HeightOneSpectrum R) + (Q : HeightOneSpectrum S) (hQp : Q.asIdeal.LiesOver p.asIdeal) : + FractionalIdeal.count (FractionRing R) p + (Ideal.relNorm R Q.asIdeal : + FractionalIdeal R⁰ (FractionRing R)) = + Q.asIdeal.inertiaDeg R := by + classical + have hpmax : p.asIdeal.IsMaximal := + Ring.DimensionLEOne.maximalOfPrime p.ne_bot p.isPrime + have hQmax : Q.asIdeal.IsMaximal := + Ring.DimensionLEOne.maximalOfPrime Q.ne_bot Q.isPrime + letI : Q.asIdeal.LiesOver p.asIdeal := hQp + rw [relNorm_eq_pow_of_isMaximal_of_isSeparable Q.asIdeal p.asIdeal] + rw [FractionalIdeal.coeIdeal_pow] + simp [FractionalIdeal.count_pow, FractionalIdeal.count_self] + +private theorem count_relNorm_heightOne_of_not_liesOver + (p : HeightOneSpectrum R) (Q : HeightOneSpectrum S) + (hQp : ¬ Q.asIdeal.LiesOver p.asIdeal) : + FractionalIdeal.count (FractionRing R) p + (Ideal.relNorm R Q.asIdeal : + FractionalIdeal R⁰ (FractionRing R)) = 0 := by + classical + let q : HeightOneSpectrum R := HeightOneSpectrum.under R Q + have hqmax : q.asIdeal.IsMaximal := + Ring.DimensionLEOne.maximalOfPrime q.ne_bot q.isPrime + have hQmax : Q.asIdeal.IsMaximal := + Ring.DimensionLEOne.maximalOfPrime Q.ne_bot Q.isPrime + have hQq : Q.asIdeal.LiesOver q.asIdeal := by + change Q.asIdeal.LiesOver (Q.asIdeal.under R) + infer_instance + have hqp : q ≠ p := by + intro heq + apply hQp + rw [← heq] + exact hQq + letI : Q.asIdeal.LiesOver q.asIdeal := hQq + rw [relNorm_eq_pow_of_isMaximal_of_isSeparable Q.asIdeal q.asIdeal] + rw [FractionalIdeal.coeIdeal_pow] + rw [FractionalIdeal.count_pow, + FractionalIdeal.count_maximal_coprime (FractionRing R) p hqp] + simp + +/-- The finite-prime exponent of the relative norm of an integral ideal is +the residue-degree-weighted sum of its exponents at primes above it. -/ +theorem count_relNorm_eq_sum_inertiaDeg_mul_count + (p : HeightOneSpectrum R) [Fintype (p.asIdeal.primesOver S)] + (I : Ideal S) : + FractionalIdeal.count (FractionRing R) p + (Ideal.relNorm R I : FractionalIdeal R⁰ (FractionRing R)) = + ∑ P : p.asIdeal.primesOver S, + (P.1.inertiaDeg R : ℤ) * + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (I : FractionalIdeal S⁰ (FractionRing S)) := by + classical + let property : Ideal S → Prop := fun J ↦ + FractionalIdeal.count (FractionRing R) p + (Ideal.relNorm R J : FractionalIdeal R⁰ (FractionRing R)) = + ∑ P : p.asIdeal.primesOver S, + (P.1.inertiaDeg R : ℤ) * + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (J : FractionalIdeal S⁰ (FractionRing S)) + by_cases hI : I = ⊥ + · subst hI + simp [FractionalIdeal.count_zero] + rw [← Ideal.prod_normalizedFactors_eq_self hI] + refine Multiset.prod_induction property (normalizedFactors I) ?_ ?_ ?_ + · intro A B hA hB + by_cases hA0 : A = ⊥ + · subst hA0 + simp [property, FractionalIdeal.count_zero] + by_cases hB0 : B = ⊥ + · subst hB0 + simp [property, FractionalIdeal.count_zero] + simp only [property, map_mul, FractionalIdeal.coeIdeal_mul] + rw [FractionalIdeal.count_mul _ _ + (FractionalIdeal.coeIdeal_ne_zero.mpr + (Ideal.relNorm_eq_bot_iff.not.mpr hA0)) + (FractionalIdeal.coeIdeal_ne_zero.mpr + (Ideal.relNorm_eq_bot_iff.not.mpr hB0)), hA, hB] + simp_rw [FractionalIdeal.count_mul _ _ + (FractionalIdeal.coeIdeal_ne_zero.mpr hA0) + (FractionalIdeal.coeIdeal_ne_zero.mpr hB0), mul_add] + exact Finset.sum_add_distrib.symm + · simp [property, FractionalIdeal.count_one] + · intro Q hQ + have hQ0 : Q ≠ ⊥ := + UniqueFactorizationMonoid.ne_zero_of_mem_normalizedFactors hQ + rw [Ideal.mem_normalizedFactors_iff hI] at hQ + let q : HeightOneSpectrum S := ⟨Q, hQ.1, hQ0⟩ + dsimp only [property] + by_cases hQp : Q.LiesOver p.asIdeal + · rw [count_relNorm_heightOne_of_liesOver p q hQp] + let P : p.asIdeal.primesOver S := ⟨Q, hQ.1, hQp⟩ + rw [Finset.sum_eq_single P] + · have heq : primeOverHeightOne p P = q := by + apply HeightOneSpectrum.ext + rfl + rw [heq] + have hcount : + FractionalIdeal.count (FractionRing S) q + (Q : FractionalIdeal S⁰ (FractionRing S)) = 1 := by + change FractionalIdeal.count (FractionRing S) q + (q.asIdeal : FractionalIdeal S⁰ (FractionRing S)) = 1 + exact FractionalIdeal.count_self (FractionRing S) q + rw [hcount, mul_one] + · intro P' _ hP' + have hne : primeOverHeightOne p P' ≠ q := by + intro heq + apply hP' + apply Subtype.ext + exact HeightOneSpectrum.ext_iff.mp heq + have hcount : + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P') + (Q : FractionalIdeal S⁰ (FractionRing S)) = 0 := by + change FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P') + (q.asIdeal : FractionalIdeal S⁰ (FractionRing S)) = 0 + exact FractionalIdeal.count_maximal_coprime + (FractionRing S) (primeOverHeightOne p P') hne.symm + rw [hcount, mul_zero] + · intro hP + exact (hP (Finset.mem_univ P)).elim + · rw [count_relNorm_heightOne_of_not_liesOver p q hQp] + symm + apply Finset.sum_eq_zero + intro P _ + have hne : primeOverHeightOne p P ≠ q := by + intro heq + apply hQp + have hPQ : P.1 = Q := HeightOneSpectrum.ext_iff.mp heq + rw [← hPQ] + exact P.2.2 + have hcount : + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (Q : FractionalIdeal S⁰ (FractionRing S)) = 0 := by + change FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (q.asIdeal : FractionalIdeal S⁰ (FractionRing S)) = 0 + exact FractionalIdeal.count_maximal_coprime + (FractionRing S) (primeOverHeightOne p P) hne.symm + rw [hcount, mul_zero] + +/-- For an integral element, the finite-place order of its integral norm is +the residue-degree-weighted sum of the principal orders above the place. -/ +theorem count_spanSingleton_intNorm_eq_sum_inertiaDeg_mul_count + (p : HeightOneSpectrum R) [Fintype (p.asIdeal.primesOver S)] + (x : S) : + FractionalIdeal.count (FractionRing R) p + (FractionalIdeal.spanSingleton R⁰ + (algebraMap R (FractionRing R) (Algebra.intNorm R S x))) = + ∑ P : p.asIdeal.primesOver S, + (P.1.inertiaDeg R : ℤ) * + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (FractionalIdeal.spanSingleton S⁰ + (algebraMap S (FractionRing S) x)) := by + simpa only [Ideal.relNorm_singleton, + FractionalIdeal.coeIdeal_span_singleton] using + count_relNorm_eq_sum_inertiaDeg_mul_count p (Ideal.span {x}) + +/-- The same principal-integral identity with the field norm written +explicitly in the fraction fields. -/ +theorem count_spanSingleton_norm_algebraMap_eq_sum_inertiaDeg_mul_count + (p : HeightOneSpectrum R) [Fintype (p.asIdeal.primesOver S)] + (x : S) : + FractionalIdeal.count (FractionRing R) p + (FractionalIdeal.spanSingleton R⁰ + (Algebra.norm (FractionRing R) + (algebraMap S (FractionRing S) x))) = + ∑ P : p.asIdeal.primesOver S, + (P.1.inertiaDeg R : ℤ) * + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (FractionalIdeal.spanSingleton S⁰ + (algebraMap S (FractionRing S) x)) := by + simpa only [Algebra.algebraMap_intNorm_fractionRing] using + count_spanSingleton_intNorm_eq_sum_inertiaDeg_mul_count p x + +/-- For an arbitrary fraction-field element, the finite-place order of its +field norm is the residue-degree-weighted sum of its principal orders at the +places above the given base place. -/ +theorem count_spanSingleton_norm_eq_sum_inertiaDeg_mul_count + (p : HeightOneSpectrum R) [Fintype (p.asIdeal.primesOver S)] + (x : FractionRing S) : + FractionalIdeal.count (FractionRing R) p + (FractionalIdeal.spanSingleton R⁰ + (Algebra.norm (FractionRing R) x)) = + ∑ P : p.asIdeal.primesOver S, + (P.1.inertiaDeg R : ℤ) * + FractionalIdeal.count (FractionRing S) (primeOverHeightOne p P) + (FractionalIdeal.spanSingleton S⁰ x) := by + obtain ⟨a, b, hb, rfl⟩ := IsFractionRing.div_surjective S x + have hb0 : b ≠ 0 := nonZeroDivisors.ne_zero hb + by_cases ha0 : a = 0 + · subst a + simp [FractionalIdeal.count_zero] + have hma0 : algebraMap S (FractionRing S) a ≠ 0 := by simp [ha0] + have hmb0 : algebraMap S (FractionRing S) b ≠ 0 := by simp [hb0] + have hna0 : Algebra.norm (FractionRing R) + (algebraMap S (FractionRing S) a) ≠ 0 := Algebra.norm_ne_zero_iff.mpr hma0 + have hnb0 : Algebra.norm (FractionRing R) + (algebraMap S (FractionRing S) b) ≠ 0 := Algebra.norm_ne_zero_iff.mpr hmb0 + have hcount (q : HeightOneSpectrum S) : + FractionalIdeal.count (FractionRing S) q + (FractionalIdeal.spanSingleton S⁰ + (algebraMap S (FractionRing S) a * + (algebraMap S (FractionRing S) b)⁻¹)) = + FractionalIdeal.count (FractionRing S) q + (FractionalIdeal.spanSingleton S⁰ + (algebraMap S (FractionRing S) a)) - + FractionalIdeal.count (FractionRing S) q + (FractionalIdeal.spanSingleton S⁰ + (algebraMap S (FractionRing S) b)) := by + rw [← FractionalIdeal.spanSingleton_mul_spanSingleton, + ← FractionalIdeal.spanSingleton_inv, + FractionalIdeal.count_mul _ _ + ((FractionalIdeal.spanSingleton_ne_zero_iff).2 hma0) + (inv_ne_zero ((FractionalIdeal.spanSingleton_ne_zero_iff).2 hmb0)), + FractionalIdeal.count_inv] + simp [sub_eq_add_neg] + rw [div_eq_mul_inv, map_mul, Algebra.norm_inv, + ← FractionalIdeal.spanSingleton_mul_spanSingleton, + ← FractionalIdeal.spanSingleton_inv] + rw [FractionalIdeal.count_mul _ _ + ((FractionalIdeal.spanSingleton_ne_zero_iff).2 hna0) + (inv_ne_zero ((FractionalIdeal.spanSingleton_ne_zero_iff).2 hnb0)), + FractionalIdeal.count_inv] + simp_rw [hcount, mul_sub] + rw [count_spanSingleton_norm_algebraMap_eq_sum_inertiaDeg_mul_count p a, + count_spanSingleton_norm_algebraMap_eq_sum_inertiaDeg_mul_count p b, + Finset.sum_sub_distrib] + simp [sub_eq_add_neg] + +end RelativeNorm + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean new file mode 100644 index 0000000000..5b0bbdde87 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean @@ -0,0 +1,159 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor + +/-! +# Constants surject onto residue fields of all function-field places + +Let `L / K(X)` be finite and separable, with `K` algebraically closed. At a +finite place of `L`, the residue field is integral over the residue field of +the place below it; the latter is canonically `K`. The same argument applies +above infinity, using the explicit residue equivalence at the rational +function infinity place. Thus constants surject onto every residue field. + +This is the exact coefficient-lifting input used by Corvaja--Zannier case (i): +equal negative leading terms can be cancelled by a genuine constant. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) residuePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance residuePolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + .of_algebraMap_eq' rfl + +local instance residueFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance residueFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance residuePolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance residueFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance residueFiniteIntegralClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance residueFiniteIntegralClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + .of_algebraMap_eq' rfl + +local instance residueInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance residueInfinityConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + .of_algebraMap_eq' rfl + +local instance residueInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance residueInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance residueInfinityIntegralClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance residueInfinityIntegralClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + .of_algebraMap_eq' rfl + +variable [IsAlgClosed K] + +omit [DecidableEq (RatFunc K)] in +/-- Constants surject onto the residue field of every finite place of a finite +separable extension of `K(X)`, when `K` is algebraically closed. -/ +theorem finiteExtensionFinitePlace_constantResidue_surjective + (q : FiniteExtensionFinitePlace K L) : + Function.Surjective (algebraMap K q.asIdeal.ResidueField) := by + let p := HeightOneSpectrum.under K[X] q + letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance + letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := + inferInstance + letI : Algebra.IsIntegral p.asIdeal.ResidueField q.asIdeal.ResidueField := + Algebra.IsIntegral.of_finite _ _ + let e := ratFuncFinitePlaceResidueEquiv K p + letI : IsAlgClosed p.asIdeal.ResidueField := + IsAlgClosed.of_ringEquiv K p.asIdeal.ResidueField e.symm.toRingEquiv + letI : IsScalarTower K p.asIdeal.ResidueField q.asIdeal.ResidueField := + inferInstance + intro z + obtain ⟨a, ha⟩ := + (IsAlgClosed.algebraMap_bijective_of_isIntegral + (k := p.asIdeal.ResidueField) (K := q.asIdeal.ResidueField)).2 z + refine ⟨e a, ?_⟩ + rw [← ha, IsScalarTower.algebraMap_apply K p.asIdeal.ResidueField] + congr 1 + apply e.injective + simp + +/-- Constants surject onto the residue field of every place above infinity in +a finite separable extension of `K(X)`, when `K` is algebraically closed. -/ +theorem finiteExtensionInfinityPlace_constantResidue_surjective + (P : FiniteExtensionInfinityPlace K L) : + Function.Surjective (algebraMap K P.1.ResidueField) := by + let p := (ratFuncInfinityPlace K).asIdeal + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := + inferInstance + letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + letI : Algebra.IsIntegral p.ResidueField P.1.ResidueField := + Algebra.IsIntegral.of_finite _ _ + let e := ratFuncInfinityPlaceResidueEquiv K + letI : IsAlgClosed p.ResidueField := + IsAlgClosed.of_ringEquiv K p.ResidueField e.symm.toRingEquiv + letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + intro z + obtain ⟨a, ha⟩ := + (IsAlgClosed.algebraMap_bijective_of_isIntegral + (k := p.ResidueField) (K := P.1.ResidueField)).2 z + refine ⟨e a, ?_⟩ + rw [← ha, IsScalarTower.algebraMap_apply K p.ResidueField] + congr 1 + simpa using (e.symm.commutes (e a)).symm + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean new file mode 100644 index 0000000000..04efbb1aa8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean @@ -0,0 +1,172 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.Finite.Basic +import Mathlib.FieldTheory.RatFunc.IntermediateField +import Mathlib.FieldTheory.Relrank + +/-! +# Frobenius degree of a finite function field + +Let `k` be a finite field and put `q = #k`. The `q`-power Frobenius is a +`k`-algebra endomorphism, since it fixes every element of `k`. This file +proves that a finite extension `L / k(X)` has degree exactly `q` over the +image of that endomorphism. + +This `q` is the cardinality of the constant field, not merely its +characteristic `p`. Thus `q = p` only when `k` is the prime field. The +Corvaja--Zannier formulation with `k` contained in a larger field of +cardinality `q ^ m` corresponds to an iterate of this Frobenius step; the +declarations below prove the single `#k`-power step. + +No separability hypothesis is required. Frobenius transports the finite +extension `L / k(X)` to the corresponding extension of image fields, while +the rational function field contributes the factor `q`. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open IntermediateField RatFunc +open scoped Polynomial + +variable (k : Type*) [Field k] [Fintype k] + +/-- In `k(X)`, the image of the `#k`-power Frobenius is exactly +`k(X ^ #k)`. -/ +theorem ratFunc_frobeniusFieldRange_eq_adjoin_pow_card : + (FiniteField.frobeniusAlgHom k k⟮X⟯).fieldRange = + k⟮(X : k⟮X⟯) ^ Fintype.card k⟯ := by + calc + (FiniteField.frobeniusAlgHom k k⟮X⟯).fieldRange = + (⊤ : IntermediateField k k⟮X⟯).map + (FiniteField.frobeniusAlgHom k k⟮X⟯) := + AlgHom.fieldRange_eq_map _ + _ = k⟮(FiniteField.frobeniusAlgHom k k⟮X⟯) (X : k⟮X⟯)⟯ := by + rw [← RatFunc.adjoin_X (K := k), IntermediateField.adjoin_map] + simp + _ = k⟮(X : k⟮X⟯) ^ Fintype.card k⟯ := by + rw [FiniteField.frobeniusAlgHom_apply] + +/-- The rational function field has degree `#k` over the image of its +`#k`-power Frobenius. -/ +theorem ratFunc_finrank_frobeniusFieldRange_eq_card : + Module.finrank (FiniteField.frobeniusAlgHom k k⟮X⟯).fieldRange k⟮X⟯ = + Fintype.card k := by + rw [ratFunc_frobeniusFieldRange_eq_adjoin_pow_card] + rw [RatFunc.finrank_eq_max_natDegree] + have hpow : (X : k⟮X⟯) ^ Fintype.card k = + algebraMap k[X] k⟮X⟯ (Polynomial.X ^ Fintype.card k) := by + simp + rw [hpow, RatFunc.num_algebraMap, RatFunc.denom_algebraMap] + simp + +variable {L : Type*} [Field L] [Algebra k L] [Algebra k⟮X⟯ L] + [IsScalarTower k k⟮X⟯ L] [FiniteDimensional k⟮X⟯ L] + +/-- A finite extension of `k(X)` has degree `#k` over the image of its +`#k`-power Frobenius. + +The proof compares the two towers through the Frobenius image. The embedded +rational base contributes degree `#k`, and Frobenius preserves the relative +degree of the finite top extension. -/ +theorem finiteFunctionField_finrank_frobeniusFieldRange_eq_card : + Module.finrank (FiniteField.frobeniusAlgHom k L).fieldRange L = + Fintype.card k := by + let i : k⟮X⟯ →ₐ[k] L := Algebra.algHom k k⟮X⟯ L + let φF : k⟮X⟯ →ₐ[k] k⟮X⟯ := FiniteField.frobeniusAlgHom k k⟮X⟯ + let φL : L →ₐ[k] L := FiniteField.frobeniusAlgHom k L + let F0 : IntermediateField k L := i.fieldRange + let Fq0 : IntermediateField k L := φF.fieldRange.map i + let Lq : IntermediateField k L := φL.fieldRange + + have hcomp : φL.comp i = i.comp φF := by + ext x + change (i x) ^ Fintype.card k = i (x ^ Fintype.card k) + exact (map_pow i x (Fintype.card k)).symm + + have hFmap : F0.map φL = Fq0 := by + change i.fieldRange.map φL = φF.fieldRange.map i + rw [AlgHom.map_fieldRange, AlgHom.map_fieldRange, hcomp] + + have hTopMap : (⊤ : IntermediateField k L).map φL = Lq := by + exact (AlgHom.fieldRange_eq_map φL).symm + + have hRelativeFrobenius : + IntermediateField.relfinrank Fq0 Lq = + IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) := by + have h := IntermediateField.relfinrank_map_map + F0 (⊤ : IntermediateField k L) φL + rwa [hFmap, hTopMap] at h + + have hFq0F0 : Fq0 ≤ F0 := by + change φF.fieldRange.map i ≤ i.fieldRange + calc + φF.fieldRange.map i ≤ + (⊤ : IntermediateField k k⟮X⟯).map i := + IntermediateField.map_mono i le_top + _ = i.fieldRange := (AlgHom.fieldRange_eq_map i).symm + + have hFq0Lq : Fq0 ≤ Lq := by + rw [← hFmap, ← hTopMap] + exact IntermediateField.map_mono φL le_top + + have hBaseDegree : + IntermediateField.relfinrank Fq0 F0 = Fintype.card k := by + have h := IntermediateField.relfinrank_map_map + φF.fieldRange (⊤ : IntermediateField k k⟮X⟯) i + change IntermediateField.relfinrank Fq0 F0 = Fintype.card k + calc + IntermediateField.relfinrank Fq0 F0 = + IntermediateField.relfinrank φF.fieldRange + (⊤ : IntermediateField k k⟮X⟯) := by + simpa only [Fq0, F0, AlgHom.fieldRange_eq_map] using h + _ = Module.finrank φF.fieldRange k⟮X⟯ := + IntermediateField.relfinrank_top_right _ + _ = Fintype.card k := ratFunc_finrank_frobeniusFieldRange_eq_card k + + have hBaseTower := IntermediateField.relfinrank_mul_relfinrank + hFq0F0 (show F0 ≤ (⊤ : IntermediateField k L) from le_top) + have hFrobeniusTower := IntermediateField.relfinrank_mul_relfinrank + hFq0Lq (show Lq ≤ (⊤ : IntermediateField k L) from le_top) + rw [hBaseDegree] at hBaseTower + rw [hRelativeFrobenius] at hFrobeniusTower + + let e : k⟮X⟯ ≃ₐ[k] F0 := i.equivFieldRange + let b := Module.finBasis k⟮X⟯ L + let b0 := b.mapCoeffs e.toRingEquiv (by + intro c x + simp only [Algebra.smul_def] + apply congrArg (· * x) + simp only [e, F0] + exact Algebra.algHom_apply k k⟮X⟯ L c) + letI : FiniteDimensional F0 L := b0.finiteDimensional_of_finite + have hF0TopPos : 0 < IntermediateField.relfinrank F0 + (⊤ : IntermediateField k L) := by + rw [IntermediateField.relfinrank_top_right] + exact Module.finrank_pos + + have hcancel : + IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) * Fintype.card k = + IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) * + IntermediateField.relfinrank Lq (⊤ : IntermediateField k L) := by + calc + _ = Fintype.card k * + IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) := Nat.mul_comm _ _ + _ = IntermediateField.relfinrank Fq0 (⊤ : IntermediateField k L) := hBaseTower + _ = IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) * + IntermediateField.relfinrank Lq (⊤ : IntermediateField k L) := + hFrobeniusTower.symm + have hResult : IntermediateField.relfinrank Lq + (⊤ : IntermediateField k L) = Fintype.card k := by + exact (Nat.mul_left_cancel hF0TopPos hcancel).symm + rw [← IntermediateField.relfinrank_top_right Lq] + exact hResult + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean new file mode 100644 index 0000000000..897e51c44e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.DedekindDomain.AdicValuation +import Mathlib.RingTheory.DedekindDomain.Factorization + +/-! +# Finite places and their adic completions + +Let `R` be a Dedekind domain with fraction field `L`. Mathlib supplies both +the exponent `FractionalIdeal.count L v I` of a height-one prime `v` in a +fractional ideal `I` and the `v`-adic completion of `L`. This file connects +those two interfaces for principal fractional ideals. + +For a nonzero global function `x`, the valuation of its image in the actual +adic completion is `exp (-ord_v(x))`, where `ord_v(x)` is the exponent of `v` +in `(x)`. The orders at all finite places are also packaged as a genuine +finitely supported divisor. This is the finite-place part of the global +divisor infrastructure needed in the Corvaja--Zannier Wronskian argument. + +It does not add the places above infinity, a degree map on divisors, or the +canonical-divisor degree formula. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + +/-- The additive order of `x` at the finite place `v`, defined as the +exponent of `v` in the principal fractional ideal `(x)`. -/ +def finitePlaceOrder (v : HeightOneSpectrum R) (x : L) : ℤ := + FractionalIdeal.count L v (FractionalIdeal.spanSingleton R⁰ x) + +/-- The multiplicative `v`-adic valuation is the exponential of minus the +additive order defined by principal fractional-ideal factorization. -/ +theorem valuation_eq_exp_neg_finitePlaceOrder + (v : HeightOneSpectrum R) (x : L) (hx : x ≠ 0) : + v.valuation L x = exp (-finitePlaceOrder v x) := by + obtain ⟨⟨n, d, hd⟩, hnd⟩ := IsLocalization.surj (nonZeroDivisors R) x + obtain rfl : x = IsLocalization.mk' L n ⟨d, hd⟩ := + IsLocalization.eq_mk'_iff_mul_eq.mpr hnd + have hn : n ≠ 0 := by + intro hn + apply hx + simp [hn] + have hd' : d ≠ 0 := nonZeroDivisors.ne_zero hd + have hprincipal : + FractionalIdeal.spanSingleton R⁰ (IsLocalization.mk' L n ⟨d, hd⟩) = + FractionalIdeal.spanSingleton R⁰ ((algebraMap R L d)⁻¹) * + (↑(Ideal.span {n}) : FractionalIdeal R⁰ L) := by + rw [FractionalIdeal.coeIdeal_span_singleton, + FractionalIdeal.spanSingleton_mul_spanSingleton] + apply congrArg (FractionalIdeal.spanSingleton R⁰) + rw [IsFractionRing.mk'_eq_div, div_eq_mul_inv, mul_comm] + have hspan : + FractionalIdeal.spanSingleton R⁰ (IsLocalization.mk' L n ⟨d, hd⟩) ≠ 0 := by + rw [FractionalIdeal.spanSingleton_ne_zero_iff] + exact hx + rw [IsDedekindDomain.HeightOneSpectrum.valuation_of_mk', + IsDedekindDomain.HeightOneSpectrum.intValuation_if_neg v hn, + IsDedekindDomain.HeightOneSpectrum.intValuation_if_neg v hd', + finitePlaceOrder, + FractionalIdeal.count_well_defined L v hspan hprincipal] + rw [← exp_sub] + congr 1 + ring + +/-- The canonical embedding of the global fraction field into the actual +adic completion attached to a finite place. -/ +def finitePlaceCompletionEmbedding (v : HeightOneSpectrum R) : + L →+* v.adicCompletion L := + algebraMap L (v.adicCompletion L) + +theorem finitePlaceCompletionEmbedding_injective (v : HeightOneSpectrum R) : + Function.Injective (finitePlaceCompletionEmbedding (R := R) (L := L) v) := + (finitePlaceCompletionEmbedding (R := R) (L := L) v).injective + +/-- After the canonical completion embedding, the completed-field valuation +still records the exponent of `v` in the global principal fractional ideal. -/ +theorem valued_finitePlaceCompletionEmbedding_eq_exp_neg_order + (v : HeightOneSpectrum R) (x : L) (hx : x ≠ 0) : + Valued.v (finitePlaceCompletionEmbedding (R := R) (L := L) v x) = + exp (-finitePlaceOrder v x) := by + calc + Valued.v (finitePlaceCompletionEmbedding (R := R) (L := L) v x) = + v.valuation L x := by + simp [finitePlaceCompletionEmbedding, + IsDedekindDomain.HeightOneSpectrum.algebraMap_adicCompletion] + _ = exp (-finitePlaceOrder v x) := + valuation_eq_exp_neg_finitePlaceOrder v x hx + +/-- The finite-place part of the principal divisor of `x`. Finiteness is +provided by unique factorization of nonzero fractional ideals in a Dedekind +domain (and is harmlessly true for `x = 0` under Mathlib's `count 0 = 0` +convention). -/ +def finitePrincipalDivisor (x : L) : HeightOneSpectrum R →₀ ℤ := + let h := FractionalIdeal.finite_factors + (FractionalIdeal.spanSingleton R⁰ x) + Finsupp.mk h.toFinset (fun v ↦ finitePlaceOrder v x) + (fun _ ↦ h.mem_toFinset) + +@[simp] +theorem finitePrincipalDivisor_apply (x : L) (v : HeightOneSpectrum R) : + finitePrincipalDivisor x v = finitePlaceOrder v x := by + simp [finitePrincipalDivisor] + +/-- The finite principal divisor of a nonzero product is the sum of the two +finite principal divisors. -/ +theorem finitePrincipalDivisor_mul + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finitePrincipalDivisor (R := R) (x * y) = + finitePrincipalDivisor (R := R) x + finitePrincipalDivisor (R := R) y := by + ext v + simp only [finitePrincipalDivisor_apply, Finsupp.add_apply, finitePlaceOrder] + rw [← FractionalIdeal.spanSingleton_mul_spanSingleton, + FractionalIdeal.count_mul L v] + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hx + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hy + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean new file mode 100644 index 0000000000..2e41f69864 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Algebra.CharP.Frobenius +import Mathlib.Algebra.Field.Subfield.Basic +import Mathlib.Algebra.Polynomial.Derivation +import Mathlib.Algebra.Polynomial.Expand +import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra +import Mathlib.FieldTheory.KummerPolynomial +import Mathlib.FieldTheory.PurelyInseparable.Basic +import Mathlib.RingTheory.Adjoin.PowerBasis +import Mathlib.RingTheory.Derivation.Basic + +/-! +# The Frobenius subfield + +Every derivation in characteristic `p` kills `p`-th powers. Consequently the +image of Frobenius is contained in the derivation's constant field. The +field extension over that image is purely inseparable. If a parameter `z` is +not a `p`-th power and the extension over `L^p(z)` is separable, the two +properties force `L = L^p(z)`; Kummer irreducibility then gives the exact +degree `[L : L^p] = p`. + +The last two hypotheses are the algebraic boundary at which the geometric +notion of a separating parameter enters. They are explicit theorem +hypotheses rather than hidden curve axioms. + +For such a parameter, polynomial differentiation descends along evaluation +at `z` to a derivation of `L`. Its constants are exactly the Frobenius +subfield: the degree-`< p` normal form of an element has zero derivative only +when it is constant. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The subfield of `p`-th powers in a field of prime characteristic `p`. -/ +abbrev frobeniusSubfield (L : Type*) [Field L] (p : ℕ) + [Fact p.Prime] [CharP L p] : Subfield L := + (frobenius L p).fieldRange + +variable {R L : Type*} [CommRing R] [Field L] [Algebra R L] + {p : ℕ} [Fact p.Prime] [CharP L p] + +/-- Every Frobenius power is killed by every derivation. -/ +theorem derivation_frobenius_eq_zero (D : Derivation R L L) (x : L) : + D (frobenius L p x) = 0 := by + rw [frobenius_def, D.leibniz_pow] + simp + +/-- The Frobenius image subfield is contained in the constant field of every +derivation. -/ +theorem frobenius_fieldRange_is_constant (D : Derivation R L L) + (x : (frobenius L p).fieldRange) : + D (x : L) = 0 := by + rcases x.2 with ⟨y, hy⟩ + rw [← hy] + exact derivation_frobenius_eq_zero D y + +section FrobeniusDegree + +variable {L : Type*} [Field L] (p : ℕ) [Fact p.Prime] [CharP L p] + +/-- The extension of a characteristic-`p` field over its Frobenius image is +purely inseparable (of exponent at most one). -/ +theorem frobeniusSubfield_isPurelyInseparable : + IsPurelyInseparable (frobeniusSubfield L p) L := by + rw [isPurelyInseparable_iff_pow_mem (frobeniusSubfield L p) p] + intro x + refine ⟨1, ?_⟩ + rw [pow_one] + exact ⟨⟨x ^ p, ⟨x, by simp [frobenius_def]⟩⟩, rfl⟩ + +/-- A parameter over which the Frobenius-pure extension becomes separable +generates the whole field over the Frobenius subfield. + +This is the algebraic first assertion of the separating-parameter lemma: the +extension over `L^p(z)` is simultaneously purely inseparable and separable, +and is therefore trivial. -/ +theorem adjoin_frobeniusSubfield_eq_top + (z : L) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + IntermediateField.adjoin (frobeniusSubfield L p) {z} = ⊤ := by + let F : Subfield L := frobeniusSubfield L p + let E : IntermediateField F L := IntermediateField.adjoin F {z} + letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + letI : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L + have hbij : Function.Bijective (algebraMap E L) := + IsPurelyInseparable.bijective_algebraMap_of_isSeparable E L + change E = ⊤ + apply top_unique + intro x _ + obtain ⟨y, hy⟩ := hbij.2 x + rw [← hy] + exact y.property + +/-- A Frobenius-separating parameter gives the exact degree of the Frobenius +subfield. + +The separability hypothesis implies that the simultaneously purely +inseparable extension `L / L^p(z)` is trivial. Since `z` is not in `L^p`, its +minimal polynomial over `L^p` is the irreducible polynomial +`X ^ p - z ^ p`, of degree `p`. -/ +theorem finrank_frobeniusSubfield_eq_char + (z : L) (hz : z ∉ frobeniusSubfield L p) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + Module.finrank (frobeniusSubfield L p) L = p := by + let F : Subfield L := frobeniusSubfield L p + let E : IntermediateField F L := IntermediateField.adjoin F {z} + let zp : F := ⟨z ^ p, ⟨z, by simp [frobenius_def]⟩⟩ + have hnoRoot : ∀ b : F, b ^ p ≠ zp := by + intro b hb + apply hz + have hpowers : (b : L) ^ p = z ^ p := by + simpa [zp] using congrArg Subtype.val hb + have hbz : (b : L) = z := by + exact frobenius_inj L p (by simpa [frobenius_def] using hpowers) + rw [← hbz] + exact b.property + have hirr : Irreducible (Polynomial.X ^ p - Polynomial.C zp) := + X_pow_sub_C_irreducible_of_prime (Fact.out : p.Prime) hnoRoot + have hmonic : (Polynomial.X ^ p - Polynomial.C zp).Monic := + Polynomial.monic_X_pow_sub_C zp (Fact.out : p.Prime).ne_zero + have hroot : Polynomial.aeval z (Polynomial.X ^ p - Polynomial.C zp) = 0 := by + simp only [map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C] + rw [Subfield.algebraMap_ofSubfield] + simp [zp] + have hzint : IsIntegral F z := ⟨_, hmonic, hroot⟩ + have hminpoly : minpoly F z = Polynomial.X ^ p - Polynomial.C zp := + (minpoly.eq_of_irreducible_of_monic hirr hroot hmonic).symm + have hfinE : Module.finrank F E = p := by + rw [IntermediateField.adjoin.finrank hzint, hminpoly, + Polynomial.natDegree_X_pow_sub_C] + letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + letI : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L + have hbij : Function.Bijective (algebraMap E L) := + IsPurelyInseparable.bijective_algebraMap_of_isSeparable E L + let e : E ≃ₐ[F] L := + AlgEquiv.ofBijective (IsScalarTower.toAlgHom F E L) hbij + exact e.toLinearEquiv.finrank_eq ▸ hfinE + +/-- A Frobenius-separating parameter determines a derivation whose constant +field is exactly the Frobenius subfield. + +The derivation is obtained by descending polynomial differentiation through +the surjective evaluation map `F[X] → L`, where `F = L^p`. Its kernel is +computed from the unique polynomial representative of degree less than `p`: +in characteristic `p`, a polynomial with zero derivative is an expansion in +`X ^ p`, and the degree bound forces that expansion to be constant. -/ +theorem exists_derivation_with_exact_frobenius_constants + (z : L) (hz : z ∉ frobeniusSubfield L p) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + ∃ D : Derivation (frobeniusSubfield L p) L L, + D z = 1 ∧ + ∀ x : L, D x = 0 ↔ + ∃ c : frobeniusSubfield L p, + algebraMap (frobeniusSubfield L p) L c = x := by + let F : Subfield L := frobeniusSubfield L p + let E : IntermediateField F L := IntermediateField.adjoin F {z} + let zp : F := ⟨z ^ p, ⟨z, by simp [frobenius_def]⟩⟩ + have hnoRoot : ∀ b : F, b ^ p ≠ zp := by + intro b hb + apply hz + have hpowers : (b : L) ^ p = z ^ p := by + simpa [zp] using congrArg Subtype.val hb + have hbz : (b : L) = z := by + exact frobenius_inj L p (by simpa [frobenius_def] using hpowers) + rw [← hbz] + exact b.property + have hirr : Irreducible (Polynomial.X ^ p - Polynomial.C zp) := + X_pow_sub_C_irreducible_of_prime (Fact.out : p.Prime) hnoRoot + have hmonic : (Polynomial.X ^ p - Polynomial.C zp).Monic := + Polynomial.monic_X_pow_sub_C zp (Fact.out : p.Prime).ne_zero + have hroot : Polynomial.aeval z (Polynomial.X ^ p - Polynomial.C zp) = 0 := by + simp only [map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C] + rw [Subfield.algebraMap_ofSubfield] + simp [zp] + have hzint : IsIntegral F z := ⟨_, hmonic, hroot⟩ + have hminpoly : minpoly F z = Polynomial.X ^ p - Polynomial.C zp := + (minpoly.eq_of_irreducible_of_monic hirr hroot hmonic).symm + letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + letI : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L + have hbij : Function.Bijective (algebraMap E L) := + IsPurelyInseparable.bijective_algebraMap_of_isSeparable E L + have hEtop : E = ⊤ := by + apply top_unique + intro x hx + obtain ⟨y, hy⟩ := hbij.2 x + rw [← hy] + exact y.property + have hAlgTop : Algebra.adjoin F {z} = ⊤ := by + have hzalg : IsAlgebraic F z := hzint.isAlgebraic + apply (IntermediateField.adjoin_eq_top_iff_of_isAlgebraic + (S := ({z} : Set L)) (by simpa)).mp + simpa [E] using hEtop + have heval : Function.Surjective + (Polynomial.aeval z : Polynomial F →ₐ[F] L) := by + rw [← AlgHom.range_eq_top, ← Algebra.adjoin_singleton_eq_range_aeval] + exact hAlgTop + have hderivMin : Polynomial.derivative (minpoly F z) = 0 := by + rw [hminpoly] + simp [Polynomial.derivative_pow] + have hstable : ∀ q : Polynomial F, Polynomial.aeval z q = 0 → + Polynomial.aeval z q.derivative = 0 := by + intro q hq + rcases minpoly.dvd F z hq with ⟨r, rfl⟩ + rw [Polynomial.derivative_mul, hderivMin] + simp [minpoly.aeval] + let D : Derivation F L L := + Polynomial.derivative'.liftOfSurjective heval hstable + have hDz : D z = 1 := by + have h := Derivation.liftOfSurjective_apply + (d := Polynomial.derivative') heval hstable Polynomial.X + simpa [D] using h + refine ⟨D, hDz, ?_⟩ + intro x + change D x = 0 ↔ ∃ c : F, algebraMap F L c = x + constructor + · intro hx + let pb : PowerBasis F L := PowerBasis.ofAdjoinEqTop hzint hAlgTop + obtain ⟨q, hqdeg, hxq⟩ := pb.exists_eq_aeval x + have hpbgen : pb.gen = z := PowerBasis.ofAdjoinEqTop_gen hzint hAlgTop + have hpbDim : pb.dim = p := by + rw [PowerBasis.ofAdjoinEqTop_dim, hminpoly, + Polynomial.natDegree_X_pow_sub_C] + rw [hpbDim] at hqdeg + rw [hpbgen] at hxq + have hEvalDeriv : Polynomial.aeval z q.derivative = 0 := by + have h := Derivation.liftOfSurjective_apply + (d := Polynomial.derivative') heval hstable q + change Polynomial.aeval z (Polynomial.derivative' q) = 0 + rw [← h, ← hxq] + exact hx + have hqderiv : q.derivative = 0 := by + by_contra hne + have hdvd : minpoly F z ∣ q.derivative := minpoly.dvd F z hEvalDeriv + have hle := Polynomial.natDegree_le_of_dvd hdvd hne + rw [hminpoly, Polynomial.natDegree_X_pow_sub_C] at hle + have hlt : q.derivative.natDegree < p := by + exact (Polynomial.natDegree_derivative_le q).trans_lt + ((Nat.sub_le q.natDegree 1).trans_lt hqdeg) + exact (Nat.not_lt_of_ge hle) hlt + have hexpand : Polynomial.expand F p (Polynomial.contract p q) = q := + Polynomial.expand_contract p hqderiv (Fact.out : p.Prime).ne_zero + have hcontractDegree : (Polynomial.contract p q).natDegree = 0 := by + have hdegrees : (Polynomial.contract p q).natDegree * p = q.natDegree := by + simpa only [Polynomial.natDegree_expand] using + congrArg Polynomial.natDegree hexpand + by_contra hne + have hpos : 0 < (Polynomial.contract p q).natDegree := Nat.pos_of_ne_zero hne + have hp_le : p ≤ q.natDegree := by + calc + p ≤ (Polynomial.contract p q).natDegree * p := + Nat.le_mul_of_pos_left p hpos + _ = q.natDegree := hdegrees + exact (Nat.not_le_of_lt hqdeg) hp_le + have hqConstant : q = Polynomial.C ((Polynomial.contract p q).coeff 0) := by + rw [← hexpand, Polynomial.eq_C_of_natDegree_eq_zero hcontractDegree] + simp + refine ⟨(Polynomial.contract p q).coeff 0, ?_⟩ + rw [hxq, hqConstant] + simp + · rintro ⟨c, rfl⟩ + exact D.map_algebraMap c + +end FrobeniusDegree + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean new file mode 100644 index 0000000000..29288f04ae --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield + +/-! +# Frobenius constants and ordinary Wronskians + +A Frobenius-separating parameter supplies a derivation whose exact constant +field is the Frobenius subfield. Combining that construction with the +ordinary differential-field Wronskian criterion gives the algebraic +Wronskian boundary used in the Corvaja--Zannier argument. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {L : Type*} [Field L] (p : ℕ) [Fact p.Prime] [CharP L p] + +/-- A Frobenius-separating parameter gives a derivation normalized by +`D z = 1`, with exact constant field `L^p`, for which every finite family has +nonzero ordinary Wronskian exactly when it is linearly independent over +`L^p`. -/ +theorem exists_derivation_with_exact_constants_and_wronskian_criterion + (z : L) (hz : z ∉ frobeniusSubfield L p) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + ∃ D : Derivation (frobeniusSubfield L p) L L, + D z = 1 ∧ + (∀ x : L, D x = 0 ↔ + ∃ c : frobeniusSubfield L p, + algebraMap (frobeniusSubfield L p) L c = x) ∧ + ∀ (n : ℕ) (f : Fin n → L), + (BGS.Algebra.derivationWronskian D f).det ≠ 0 ↔ + LinearIndependent (frobeniusSubfield L p) f := by + obtain ⟨D, hDz, hconstants⟩ := + exists_derivation_with_exact_frobenius_constants p z hz + refine ⟨D, hDz, hconstants, ?_⟩ + intro n f + exact BGS.Algebra.derivationWronskian_det_ne_zero_iff_linearIndependent D + (fun x hx ↦ (hconstants x).mp hx) f + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean new file mode 100644 index 0000000000..926c38baf2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.NumberTheory.RatFunc.Ostrowski +import Mathlib.RingTheory.DedekindDomain.Factorization +import Mathlib.RingTheory.Ideal.IsPrincipal +import Mathlib.RingTheory.UniqueFactorizationDomain.NormalizedFactors +import Mathlib.Algebra.Polynomial.BigOperators + +/-! +# A normalized-factor product formula for the rational function field + +This file proves the normalized-factor form of the degree-zero formula for a +principal divisor on `K(X)`. At every normalized prime factor, the +multiplicity is identified with the actual Dedekind-domain exponent +`FractionalIdeal.count` of the principal fractional ideal. Normalized +polynomial factorization makes the finite contribution explicit; the +remaining term is Mathlib's valuation at infinity. Packaging that finite +contribution as one exhaustive sum over `HeightOneSpectrum K[X]` is completed +in `RatFuncExhaustiveProductFormula`. + +This is the base-field input for the Corvaja--Zannier valuation argument. It +does **not** yet supply the corresponding formula for a finite extension of +`K(X)`: Mathlib currently has no packaged degree map on the divisor group of +the integral closure, nor the global finite-place identity combining +ramification and residue degrees over each base place. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Polynomial UniqueFactorizationMonoid +open Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The height-one prime of `K[X]` cut out by a prime polynomial. -/ +def polynomialFinitePlace (r : K[X]) (hr : Prime r) : HeightOneSpectrum K[X] where + asIdeal := Ideal.span {r} + isPrime := (Ideal.span_singleton_prime hr.ne_zero).2 hr + ne_bot := by + intro h + exact hr.ne_zero (Ideal.span_singleton_eq_bot.mp h) + +@[simp] +theorem polynomialFinitePlace_asIdeal (r : K[X]) (hr : Prime r) : + (polynomialFinitePlace r hr).asIdeal = Ideal.span {r} := rfl + +/-- The sum of the degrees of the normalized irreducible factors of a +nonzero polynomial, with multiplicity, is its degree. -/ +theorem sum_normalizedFactor_natDegree [DecidableEq K] + (p : K[X]) (hp : p ≠ 0) : + ∑ r ∈ (normalizedFactors p).toFinset, + (normalizedFactors p).count r * r.natDegree = p.natDegree := by + have hprodDegree : (normalizedFactors p).prod.natDegree = p.natDegree := + Polynomial.natDegree_eq_of_degree_eq + (Polynomial.degree_eq_degree_of_associated (prod_normalizedFactors hp)) + calc + ∑ r ∈ (normalizedFactors p).toFinset, + (normalizedFactors p).count r * r.natDegree = + (Multiset.map Polynomial.natDegree (normalizedFactors p)).sum := by + simpa [nsmul_eq_mul, mul_comm] using + (Finset.sum_multiset_map_count (normalizedFactors p) + Polynomial.natDegree).symm + _ = (normalizedFactors p).prod.natDegree := by + rw [Polynomial.natDegree_multiset_prod] + exact zero_notMem_normalizedFactors p + _ = p.natDegree := hprodDegree + +/-- The additive order of a rational function at a finite polynomial place, +implemented by the Dedekind-domain exponent of its principal fractional ideal. -/ +def ratFuncFiniteOrder (v : HeightOneSpectrum K[X]) (f : RatFunc K) : ℤ := + FractionalIdeal.count (RatFunc K) v + (FractionalIdeal.spanSingleton (K[X])⁰ f) + +private theorem ratFunc_principal_fractionalIdeal_representation + (f : RatFunc K) : + FractionalIdeal.spanSingleton (K[X])⁰ f = + FractionalIdeal.spanSingleton (K[X])⁰ + ((algebraMap K[X] (RatFunc K) f.denom)⁻¹) * + (↑(Ideal.span {f.num}) : FractionalIdeal (K[X])⁰ (RatFunc K)) := by + rw [FractionalIdeal.coeIdeal_span_singleton, + FractionalIdeal.spanSingleton_mul_spanSingleton] + apply congrArg (FractionalIdeal.spanSingleton (K[X])⁰) + simpa only [div_eq_mul_inv, mul_comm] using (RatFunc.num_div_denom f).symm + +/-- At a normalized prime polynomial, the Dedekind-domain order of a +nonzero rational function is the numerator multiplicity minus the denominator +multiplicity. -/ +theorem ratFuncFiniteOrder_polynomialFinitePlace + [DecidableEq K] + (f : RatFunc K) (hf : f ≠ 0) (r : K[X]) (hr : Prime r) + (hrnorm : normalize r = r) : + ratFuncFiniteOrder (polynomialFinitePlace r hr) f = + ((normalizedFactors f.num).count r : ℤ) - + (normalizedFactors f.denom).count r := by + have hprincipal : + FractionalIdeal.spanSingleton (K[X])⁰ f ≠ 0 := by + rw [FractionalIdeal.spanSingleton_ne_zero_iff] + exact hf + rw [ratFuncFiniteOrder, + FractionalIdeal.count_well_defined (RatFunc K) + (polynomialFinitePlace r hr) hprincipal + (ratFunc_principal_fractionalIdeal_representation f)] + change + ((Associates.mk (Ideal.span {r})).count + (Associates.mk (Ideal.span {f.num})).factors : ℤ) - + ((Associates.mk (Ideal.span {r})).count + (Associates.mk (Ideal.span {f.denom})).factors : ℤ) = _ + congr 1 <;> norm_cast + · rw [Ideal.count_associates_factors_eq + (by + intro h + exact RatFunc.num_ne_zero hf (Ideal.span_singleton_eq_bot.mp h)) + ((Ideal.span_singleton_prime hr.ne_zero).2 hr) + (by + intro h + exact hr.ne_zero (Ideal.span_singleton_eq_bot.mp h)), + Ideal.count_span_normalizedFactors_eq (RatFunc.num_ne_zero hf) hr, + hrnorm] + · rw [Ideal.count_associates_factors_eq + (by + intro h + exact f.denom_ne_zero (Ideal.span_singleton_eq_bot.mp h)) + ((Ideal.span_singleton_prime hr.ne_zero).2 hr) + (by + intro h + exact hr.ne_zero (Ideal.span_singleton_eq_bot.mp h)), + Ideal.count_span_normalizedFactors_eq f.denom_ne_zero hr, + hrnorm] + +/-- The degree-weighted finite-place contribution of a nonzero rational +function, written as its zero contribution minus its pole contribution. The +preceding theorem identifies the multiplicities here with +`FractionalIdeal.count` at the corresponding height-one primes. -/ +def ratFuncFinitePlaceDegreeSum [DecidableEq K] (f : RatFunc K) : ℤ := + (∑ r ∈ (normalizedFactors f.num).toFinset, + (normalizedFactors f.num).count r * r.natDegree : ℕ) - + (∑ r ∈ (normalizedFactors f.denom).toFinset, + (normalizedFactors f.denom).count r * r.natDegree : ℕ) + +/-- The additive order at infinity. Mathlib's multiplicative infinity +valuation sends a nonzero `f` to `exp (-ratFuncInfinityOrder f)`. -/ +def ratFuncInfinityOrder (f : RatFunc K) : ℤ := -f.intDegree + +theorem inftyValuation_eq_exp_neg_ratFuncInfinityOrder + [DecidableEq (RatFunc K)] (f : RatFunc K) (hf : f ≠ 0) : + RatFunc.inftyValuation K f = + exp (-ratFuncInfinityOrder f) := by + rw [RatFunc.inftyValuation_apply] + rw [RatFunc.inftyValuation_of_nonzero (F := K) hf] + simp only [ratFuncInfinityOrder, neg_neg] + +theorem ratFuncFinitePlaceDegreeSum_eq_intDegree + [DecidableEq K] + (f : RatFunc K) (hf : f ≠ 0) : + ratFuncFinitePlaceDegreeSum f = f.intDegree := by + rw [ratFuncFinitePlaceDegreeSum, + sum_normalizedFactor_natDegree f.num (RatFunc.num_ne_zero hf), + sum_normalizedFactor_natDegree f.denom f.denom_ne_zero] + rfl + +/-- The normalized-factor form of the product formula for `K(X)`: the +degree-weighted numerator-minus-denominator contribution plus the order at +infinity is zero. -/ +theorem ratFunc_finitePlace_plus_infinity_productFormula + [DecidableEq K] + (f : RatFunc K) (hf : f ≠ 0) : + ratFuncFinitePlaceDegreeSum f + ratFuncInfinityOrder f = 0 := by + rw [ratFuncFinitePlaceDegreeSum_eq_intDegree f hf] + simp only [ratFuncInfinityOrder, add_neg_cancel] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean new file mode 100644 index 0000000000..25cb167943 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound + +/-! +# The general Corvaja--Zannier plane-curve theorem + +This file is the final public assembly. Its first theorem isolates the sole +powered-image index input, so that the geometric index theorem can be audited +independently; the unconditional endpoint below instantiates that input. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + + +/-- A uniform source-to-powered-image index bound supplies all Proposition 2 +certificates above the elementary range. -/ +theorem generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange_of_poweredImageIndexBound + (hindex : ∀ (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) (m n : ℕ) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (_hm : 0 < m) (_hn : 0 < n) (_hmPrime : ¬ p ∣ m) (_hnPrime : ¬ p ∣ n), + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hcurve.1 + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : + GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange := by + apply generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange_of_actualDegree + intro p _ K _ _ _ _ f firstDegree secondDegree firstOrder secondOrder + _hfirstDegree _hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar hlarge + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + have hfirstActual : MvPolynomial.degreeOf 0 f ≤ firstDegree := + degreeOf_first_le_of_hasBidegreeAtMost hbidegree + have hsecondActual : MvPolynomial.degreeOf 1 f ≤ secondDegree := + degreeOf_second_le_of_hasBidegreeAtMost hbidegree + have hactualDegreeProduct : + 12 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f ≤ + 12 * firstDegree * secondDegree := + Nat.mul_le_mul (Nat.mul_le_mul_left 12 hfirstActual) hsecondActual + have hlargeActual : + 12 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f < p := + hactualDegreeProduct.trans_lt hlarge + have hpoweredIndex : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f firstOrder secondOrder) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + simpa only [hf] using hindex p K f firstOrder secondOrder + hcurve hfirstOrder hsecondOrder hfirstPrimeToChar hsecondPrimeToChar + simpa only [hf] using + planeCurvePropositionTwo_of_poweredImageIndexBound + (p := p) hf hcurve.1 hcurve.2.2.1 hcurve.2.2.2 + firstOrder secondOrder hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar hlargeActual hpoweredIndex + +/-- The public finite-field Corvaja--Zannier theorem follows from the exact +powered-image index statement. -/ +theorem generalCorvajaZannierPlaneCurveTheorem_of_poweredImageIndexBound + (hindex : ∀ (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) (m n : ℕ) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (_hm : 0 < m) (_hn : 0 < n) (_hmPrime : ¬ p ∣ m) (_hnPrime : ¬ p ∣ n), + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hcurve.1 + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : + BGS.External.GeneralCorvajaZannierPlaneCurveTheorem := + generalCorvajaZannierPlaneCurveTheorem_of_certificates + (generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange_of_poweredImageIndexBound + hindex) + +/-- The geometric powered-image index input required by the final assembly is +provided by the exact Galois stabilizer count. -/ +theorem poweredImageIndexBound_of_isCorvajaZannierPlaneCurve + (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) (m n : ℕ) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (hm : 0 < m) (hn : 0 < n) (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + exact finrank_poweredImageOverFirst_le_twice_bidegree + hcurve.1 hcurve.2.1 hcurve.2.2.1 hcurve.2.2.2 + m n hm hn hmPrime hnPrime + +/-- The unconditional certificates for the high-characteristic range. -/ +theorem generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange : + GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange := + generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange_of_poweredImageIndexBound + poweredImageIndexBound_of_isCorvajaZannierPlaneCurve + +/-- **The general Corvaja--Zannier finite-field plane-curve theorem.** -/ +theorem generalCorvajaZannierPlaneCurveTheorem : + BGS.External.GeneralCorvajaZannierPlaneCurveTheorem := + generalCorvajaZannierPlaneCurveTheorem_of_poweredImageIndexBound + poweredImageIndexBound_of_isCorvajaZannierPlaneCurve + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean new file mode 100644 index 0000000000..42e2be1034 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +import Mathlib.Tactic + +/-! +# Summing the four local Corvaja--Zannier Wronskian cases + +This module proves the exact finite-support divisor summation used in +Corvaja--Zannier Proposition 2. Its hypotheses are the four already proved +local lower bounds together with explicit principal-divisor, degree, and +canonical-divisor identities. Thus it isolates the remaining geometric +boundary: constructing these data from the places of the plane-curve +function field. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- Finite-support form of the summation step in the proof of +Corvaja--Zannier Proposition 2. -/ +theorem globalWronskianInequality_of_placewiseBounds + {ι : Type*} [Fintype ι] [DecidableEq ι] + (S : Finset ι) + (ordU ordV ordRho ordGrid ordW : ι → ℤ) + (h k n sigma degreeU degreeV chi heightOutside : ℕ) + (canonicalDegree : ℤ) + (hUOutside : ∀ i, i ∉ S → ordU i = 0) + (hGridOutside : ∀ i, i ∉ S → ordGrid i = 0) + (hUSum : ∑ i, ordU i = 0) + (hGridSum : ∑ i, ordGrid i = 0) + (hDegreeV : ∑ i ∈ S.filter (fun i ↦ 0 < ordV i), ordV i = degreeV) + (hOutsideHeight : + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ ordRho i < 0), ordRho i = + -(heightOutside : ℤ)) + (hCanonical : ∑ i, ordW i = (sigma : ℤ) * canonicalDegree) + (hEuler : canonicalDegree + S.card ≤ (chi : ℤ)) + (hRhoSupport : + -((degreeU : ℤ) + (degreeV : ℤ)) ≤ ∑ i ∈ S, ordRho i) + (hCaseI : ∀ i, i ∉ S → ordRho i < 0 → + (n : ℤ) * ordRho i ≤ ordW i) + (hCaseII : ∀ i, i ∉ S → 0 ≤ ordRho i → 0 ≤ ordW i) + (hCaseIII : ∀ i, i ∈ S → 0 < ordV i → + ((k * (k - 1) / 2 : ℕ) : ℤ) * ordU i + + ((h * k : ℕ) : ℤ) * ordV i + (k : ℤ) * ordRho i + + ordGrid i - (sigma : ℤ) ≤ ordW i) + (hCaseIV : ∀ i, i ∈ S → ordV i ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * ordU i + + (k : ℤ) * ordRho i + ordGrid i - (sigma : ℤ) ≤ ordW i) : + ((h * k : ℕ) : ℤ) * (degreeV : ℤ) - + (k : ℤ) * ((degreeU : ℤ) + (degreeV : ℤ)) - + (sigma : ℤ) * (chi : ℤ) ≤ + (n : ℤ) * (heightOutside : ℤ) := by + let base : ι → ℤ := fun i ↦ + ((k * (k - 1) / 2 : ℕ) : ℤ) * ordU i + + (k : ℤ) * ordRho i + ordGrid i - (sigma : ℤ) + let lower : ι → ℤ := fun i ↦ + if i ∈ S then + base i + if 0 < ordV i then ((h * k : ℕ) : ℤ) * ordV i else 0 + else if ordRho i < 0 then (n : ℤ) * ordRho i else 0 + have hPointwise (i : ι) : lower i ≤ ordW i := by + by_cases hiS : i ∈ S + · by_cases hvi : 0 < ordV i + · have hLocal := hCaseIII i hiS hvi + simp only [lower, hiS, if_pos, hvi] + dsimp [base] + norm_num at hLocal ⊢ + linarith + · have hvi' : ordV i ≤ 0 := le_of_not_gt hvi + simpa [lower, base, hiS, hvi] using hCaseIV i hiS hvi' + · by_cases hρi : ordRho i < 0 + · simpa [lower, hiS, hρi] using hCaseI i hiS hρi + · have hρi' : 0 ≤ ordRho i := le_of_not_gt hρi + simpa [lower, hiS, hρi] using hCaseII i hiS hρi' + have hSumLower : ∑ i, lower i ≤ ∑ i, ordW i := + Finset.sum_le_sum fun i _ ↦ hPointwise i + have hSumUOnS : ∑ i ∈ S, ordU i = 0 := by + calc + ∑ i ∈ S, ordU i = ∑ i, ordU i := by + apply Finset.sum_subset (Finset.subset_univ S) + intro i _ hiS + exact hUOutside i hiS + _ = 0 := hUSum + have hSumGridOnS : ∑ i ∈ S, ordGrid i = 0 := by + calc + ∑ i ∈ S, ordGrid i = ∑ i, ordGrid i := by + apply Finset.sum_subset (Finset.subset_univ S) + intro i _ hiS + exact hGridOutside i hiS + _ = 0 := hGridSum + have hPositiveVSum : + ∑ i ∈ S, (if 0 < ordV i then ((h * k : ℕ) : ℤ) * ordV i else 0) = + ((h * k : ℕ) : ℤ) * (degreeV : ℤ) := by + calc + _ = ∑ i ∈ S.filter (fun i ↦ 0 < ordV i), + ((h * k : ℕ) : ℤ) * ordV i := by + exact (Finset.sum_filter + (s := S) (fun i ↦ 0 < ordV i) + (fun i ↦ ((h * k : ℕ) : ℤ) * ordV i)).symm + _ = ((h * k : ℕ) : ℤ) * + (∑ i ∈ S.filter (fun i ↦ 0 < ordV i), ordV i) := by + rw [Finset.mul_sum] + _ = ((h * k : ℕ) : ℤ) * (degreeV : ℤ) := by rw [hDegreeV] + have hOutsideRhoSum : + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S), + (if ordRho i < 0 then (n : ℤ) * ordRho i else 0) = + -(n : ℤ) * (heightOutside : ℤ) := by + calc + _ = ∑ i ∈ (Finset.univ.filter (fun i ↦ i ∉ S)).filter + (fun i ↦ ordRho i < 0), (n : ℤ) * ordRho i := by + exact (Finset.sum_filter + (s := Finset.univ.filter (fun i ↦ i ∉ S)) + (fun i ↦ ordRho i < 0) + (fun i ↦ (n : ℤ) * ordRho i)).symm + _ = ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ ordRho i < 0), + (n : ℤ) * ordRho i := by rw [Finset.filter_filter] + _ = (n : ℤ) * + (∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ ordRho i < 0), + ordRho i) := by rw [Finset.mul_sum] + _ = -(n : ℤ) * (heightOutside : ℤ) := by rw [hOutsideHeight]; ring + have hBaseSum : + ∑ i ∈ S, base i = + (k : ℤ) * (∑ i ∈ S, ordRho i) - (sigma : ℤ) * S.card := by + dsimp [base] + rw [Finset.sum_sub_distrib, Finset.sum_add_distrib, + Finset.sum_add_distrib, ← Finset.mul_sum, ← Finset.mul_sum, + hSumUOnS, hSumGridOnS] + simp + ring + have hLowerSum : + ∑ i, lower i = + (k : ℤ) * (∑ i ∈ S, ordRho i) - (sigma : ℤ) * S.card + + ((h * k : ℕ) : ℤ) * (degreeV : ℤ) - + (n : ℤ) * (heightOutside : ℤ) := by + have hSplit := Finset.sum_filter_add_sum_filter_not + Finset.univ (fun i ↦ i ∈ S) lower + have hFilterS : Finset.univ.filter (fun i ↦ i ∈ S) = S := by + ext i + simp + rw [hFilterS] at hSplit + calc + ∑ i, lower i = + (∑ i ∈ S, + (base i + if 0 < ordV i then ((h * k : ℕ) : ℤ) * ordV i else 0)) + + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S), + (if ordRho i < 0 then (n : ℤ) * ordRho i else 0) := by + rw [← hSplit] + congr 1 + · apply Finset.sum_congr rfl + intro i hi + simp only [lower, hi, if_pos] + · apply Finset.sum_congr rfl + intro i hi + have hiS : i ∉ S := (Finset.mem_filter.1 hi).2 + simp only [lower, hiS, if_false] + _ = (∑ i ∈ S, base i) + + (∑ i ∈ S, + (if 0 < ordV i then ((h * k : ℕ) : ℤ) * ordV i else 0)) + + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S), + (if ordRho i < 0 then (n : ℤ) * ordRho i else 0) := by + rw [Finset.sum_add_distrib] + _ = _ := by rw [hBaseSum, hPositiveVSum, hOutsideRhoSum]; ring + rw [hLowerSum, hCanonical] at hSumLower + have hRhoScaled : + -(k : ℤ) * ((degreeU : ℤ) + (degreeV : ℤ)) ≤ + (k : ℤ) * (∑ i ∈ S, ordRho i) := by + have hScaled := + mul_le_mul_of_nonneg_left hRhoSupport (Int.natCast_nonneg k) + calc + -(k : ℤ) * ((degreeU : ℤ) + (degreeV : ℤ)) = + (k : ℤ) * (-((degreeU : ℤ) + (degreeV : ℤ))) := by ring + _ ≤ (k : ℤ) * (∑ i ∈ S, ordRho i) := hScaled + have hEulerScaled : + (sigma : ℤ) * canonicalDegree + (sigma : ℤ) * S.card ≤ + (sigma : ℤ) * (chi : ℤ) := by + have hScaled := + mul_le_mul_of_nonneg_left hEuler (Int.natCast_nonneg sigma) + linarith + linarith + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean new file mode 100644 index 0000000000..f6b21aecb4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean @@ -0,0 +1,104 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound + +/-! +# Global Wronskian summation for Corvaja--Zannier Proposition 2 + +This file formalizes the exact real-arithmetic passage from the global +Wronskian divisor inequality to the numerical alternatives consumed by the +proved optimization stage. The remaining geometric theorem must supply the +displayed summed Wronskian inequality; it is not assumed as an axiom or hidden +in a typeclass. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The real-arithmetic passage from the global Wronskian inequality to the +displayed gcd bound in Corvaja--Zannier Proposition 2. -/ +theorem gcdBound_of_globalWronskianInequality + (a b chi G heightOutside : ℝ) (h k : ℕ) + (hn : 0 < h * k + h + k) + (hGHeight : G ≤ a - heightOutside) + (hWronskian : + ((h * k : ℕ) : ℝ) * a - (k : ℝ) * (a + b) - + (((h * k + h + k : ℕ) : ℝ) * + (((h * k + h + k : ℕ) : ℝ) - 1) / 2) * chi ≤ + ((h * k + h + k : ℕ) : ℝ) * heightOutside) : + G ≤ + (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * a + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * b + + (((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * chi) := by + let n : ℕ := h * k + h + k + have hnReal : 0 < (n : ℝ) := by exact_mod_cast hn + have hmain : + (n : ℝ) * G ≤ + ((h + 2 * k : ℕ) : ℝ) * a + (k : ℝ) * b + + (((n : ℝ) * ((n : ℝ) - 1) / 2) * chi) := by + dsimp [n] at hnReal ⊢ + norm_num at hWronskian ⊢ + have hGScaled := mul_le_mul_of_nonneg_left hGHeight hnReal.le + norm_num at hGScaled + have hNegHeight : + -(↑h * ↑k + ↑h + ↑k) * heightOutside ≤ + -(↑h * ↑k) * a + ↑k * (a + b) + + ((↑h * ↑k + ↑h + ↑k) * + (↑h * ↑k + ↑h + ↑k - 1) / 2) * chi := by + linarith + calc + (↑h * ↑k + ↑h + ↑k) * G ≤ + (↑h * ↑k + ↑h + ↑k) * (a - heightOutside) := hGScaled + _ = (↑h * ↑k + ↑h + ↑k) * a - + (↑h * ↑k + ↑h + ↑k) * heightOutside := by ring + _ ≤ (↑h * ↑k + ↑h + ↑k) * a + + (-(↑h * ↑k) * a + ↑k * (a + b) + + ((↑h * ↑k + ↑h + ↑k) * + (↑h * ↑k + ↑h + ↑k - 1) / 2) * chi) := + by linarith + _ = (↑h + 2 * ↑k) * a + ↑k * b + + ((↑h * ↑k + ↑h + ↑k) * + (↑h * ↑k + ↑h + ↑k - 1) / 2) * chi := by ring + calc + G ≤ (((h + 2 * k : ℕ) : ℝ) * a + (k : ℝ) * b + + (((n : ℝ) * ((n : ℝ) - 1) / 2) * chi)) / (n : ℝ) := by + apply (le_div_iff₀ hnReal).2 + simpa [mul_comm] using hmain + _ = + (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * a + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * b + + (((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * chi) := by + dsimp [n] + field_simp [hnReal.ne'] + +/-- Proposition 2's numerical alternatives follow once the single outside +height comparison and the summed Wronskian inequality have been established +for every admissible parameter pair outside the degree alternative. -/ +theorem propositionTwoNumericalAlternatives_of_globalWronskianInequality + (a b p chi : ℕ) (G heightOutside : ℝ) + (hGHeight : G ≤ (a : ℝ) - heightOutside) + (hWronskian : ∀ h k : ℕ, + PropositionTwoParametersAreAdmissible a b p h k → + ¬(a ≤ k ∧ b ≤ h) → + ((h * k : ℕ) : ℝ) * (a : ℝ) - + (k : ℝ) * ((a : ℝ) + (b : ℝ)) - + (((h * k + h + k : ℕ) : ℝ) * + (((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) ≤ + ((h * k + h + k : ℕ) : ℝ) * heightOutside) : + PropositionTwoNumericalAlternatives a b p chi G := by + intro h k hadmissible + by_cases hdegree : a ≤ k ∧ b ≤ h + · exact Or.inl hdegree + · exact Or.inr <| + gcdBound_of_globalWronskianInequality + (a : ℝ) (b : ℝ) (chi : ℝ) G heightOutside h k + hadmissible.1 hGHeight (hWronskian h k hadmissible hdegree) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean new file mode 100644 index 0000000000..8ec08a410d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +import Mathlib.Tactic + +/-! +# Degree-weighted Corvaja--Zannier Wronskian summation + +The published proof sums local orders with the residue degree of each place. +This module derives the weighted version of the four-case global inequality by +replacing a place of weight `e` by `e` identical copies and applying +`globalWronskianInequality_of_placewiseBounds`. + +This is the finite combinatorial form of the weighted divisor summation in +Corvaja--Zannier, Proposition 2 (published reconstruction, pp. 15--16). +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +private abbrev ReplicatedPlace {ι : Type*} (weight : ι → ℕ) := + Σ i, Fin (weight i) + +private def replicatedFinset {ι : Type*} [Fintype ι] [DecidableEq ι] + (weight : ι → ℕ) (S : Finset ι) : + Finset (ReplicatedPlace weight) := by + classical + exact Finset.univ.filter (fun x ↦ x.1 ∈ S) + +private theorem sum_replicatedFinset + {ι : Type*} [Fintype ι] [DecidableEq ι] + (weight : ι → ℕ) (S : Finset ι) (F : ι → ℤ) : + ∑ x ∈ replicatedFinset weight S, F x.1 = + ∑ i ∈ S, (weight i : ℤ) * F i := by + classical + rw [replicatedFinset, Finset.sum_filter, Fintype.sum_sigma] + calc + ∑ i, ∑ _j : Fin (weight i), (if i ∈ S then F i else 0) = + ∑ i, if i ∈ S then (weight i : ℤ) * F i else 0 := by + apply Finset.sum_congr rfl + intro i _ + by_cases hi : i ∈ S + · simp [hi, Finset.sum_const] + · simp [hi] + _ = ∑ i ∈ S, (weight i : ℤ) * F i := by + rw [← Finset.sum_filter] + congr 1 + ext i + simp + +private theorem card_replicatedFinset + {ι : Type*} [Fintype ι] [DecidableEq ι] + (weight : ι → ℕ) (S : Finset ι) : + (replicatedFinset weight S).card = ∑ i ∈ S, weight i := by + classical + have h := sum_replicatedFinset weight S (fun _ ↦ (1 : ℤ)) + simp only [Finset.sum_const, nsmul_eq_mul, mul_one] at h + exact_mod_cast h + +/-- Residue-degree-weighted finite-support form of the global summation step in +the proof of Corvaja--Zannier Proposition 2. -/ +theorem globalWronskianInequality_of_weightedPlacewiseBounds + {ι : Type*} [Fintype ι] [DecidableEq ι] + (weight : ι → ℕ) (S : Finset ι) + (ordU ordV ordRho ordGrid ordW : ι → ℤ) + (h k n sigma degreeU degreeV chi heightOutside : ℕ) + (canonicalDegree : ℤ) + (hUOutside : ∀ i, i ∉ S → ordU i = 0) + (hGridOutside : ∀ i, i ∉ S → ordGrid i = 0) + (hUSum : ∑ i, ordU i * (weight i : ℤ) = 0) + (hGridSum : ∑ i, ordGrid i * (weight i : ℤ) = 0) + (hDegreeV : ∑ i ∈ S.filter (fun i ↦ 0 < ordV i), + ordV i * (weight i : ℤ) = degreeV) + (hOutsideHeight : + ∑ i ∈ Finset.univ.filter (fun i ↦ i ∉ S ∧ ordRho i < 0), + ordRho i * (weight i : ℤ) = -(heightOutside : ℤ)) + (hCanonical : ∑ i, ordW i * (weight i : ℤ) = + (sigma : ℤ) * canonicalDegree) + (hEuler : canonicalDegree + (∑ i ∈ S, weight i : ℕ) ≤ (chi : ℤ)) + (hRhoSupport : + -((degreeU : ℤ) + (degreeV : ℤ)) ≤ + ∑ i ∈ S, ordRho i * (weight i : ℤ)) + (hCaseI : ∀ i, i ∉ S → ordRho i < 0 → + (n : ℤ) * ordRho i ≤ ordW i) + (hCaseII : ∀ i, i ∉ S → 0 ≤ ordRho i → 0 ≤ ordW i) + (hCaseIII : ∀ i, i ∈ S → 0 < ordV i → + ((k * (k - 1) / 2 : ℕ) : ℤ) * ordU i + + ((h * k : ℕ) : ℤ) * ordV i + (k : ℤ) * ordRho i + + ordGrid i - (sigma : ℤ) ≤ ordW i) + (hCaseIV : ∀ i, i ∈ S → ordV i ≤ 0 → + ((k * (k - 1) / 2 : ℕ) : ℤ) * ordU i + + (k : ℤ) * ordRho i + ordGrid i - (sigma : ℤ) ≤ ordW i) : + ((h * k : ℕ) : ℤ) * (degreeV : ℤ) - + (k : ℤ) * ((degreeU : ℤ) + (degreeV : ℤ)) - + (sigma : ℤ) * (chi : ℤ) ≤ + (n : ℤ) * (heightOutside : ℤ) := by + classical + let ι' := ReplicatedPlace weight + let S' : Finset ι' := replicatedFinset weight S + let lift (F : ι → ℤ) : ι' → ℤ := fun x ↦ F x.1 + apply globalWronskianInequality_of_placewiseBounds + S' (lift ordU) (lift ordV) (lift ordRho) (lift ordGrid) (lift ordW) + h k n sigma degreeU degreeV chi heightOutside canonicalDegree + · intro x hx + apply hUOutside x.1 + simpa [S', replicatedFinset] using hx + · intro x hx + apply hGridOutside x.1 + simpa [S', replicatedFinset] using hx + · simpa [lift, replicatedFinset, mul_comm] using + (sum_replicatedFinset weight Finset.univ ordU).trans + (by simpa [mul_comm] using hUSum) + · simpa [lift, replicatedFinset, mul_comm] using + (sum_replicatedFinset weight Finset.univ ordGrid).trans + (by simpa [mul_comm] using hGridSum) + · rw [show S'.filter (fun x ↦ 0 < lift ordV x) = + replicatedFinset weight (S.filter fun i ↦ 0 < ordV i) by + ext x + simp [S', replicatedFinset, lift]] + rw [sum_replicatedFinset] + simpa [mul_comm] using hDegreeV + · rw [show Finset.univ.filter (fun x : ι' ↦ x ∉ S' ∧ lift ordRho x < 0) = + replicatedFinset weight + (Finset.univ.filter fun i ↦ i ∉ S ∧ ordRho i < 0) by + ext x + simp [S', replicatedFinset, lift]] + rw [sum_replicatedFinset] + simpa [mul_comm] using hOutsideHeight + · simpa [lift, replicatedFinset, mul_comm] using + (sum_replicatedFinset weight Finset.univ ordW).trans + (by simpa [mul_comm] using hCanonical) + · rw [show S'.card = ∑ i ∈ S, weight i by + exact card_replicatedFinset weight S] + exact hEuler + · rw [show ∑ x ∈ S', lift ordRho x = + ∑ i ∈ S, (weight i : ℤ) * ordRho i by + exact sum_replicatedFinset weight S ordRho] + simpa [mul_comm] using hRhoSupport + · intro x hxS hxRho + exact hCaseI x.1 (by simpa [S', replicatedFinset] using hxS) hxRho + · intro x hxS hxRho + exact hCaseII x.1 (by simpa [S', replicatedFinset] using hxS) hxRho + · intro x hxS hxV + exact hCaseIII x.1 (by simpa [S', replicatedFinset] using hxS) hxV + · intro x hxS hxV + exact hCaseIV x.1 (by simpa [S', replicatedFinset] using hxS) hxV + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean new file mode 100644 index 0000000000..fe1cff2542 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +import Mathlib.Tactic + +/-! +# Residue degree one above the rational-function place at infinity + +For the infinity valuation ring of `K(X)`, every integral rational function is +congruent modulo the maximal ideal to a constant. Consequently its residue +field is canonically a copy of `K`. When `K` is algebraically closed, the +residue field at every prime above infinity in a finite separable extension of +`K(X)` is therefore the same field, so the corresponding inertia degree is +one. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + +/-- Embed the constant field into the infinity valuation ring. -/ +noncomputable def ratFuncInfinityConstantRingHom : + K →+* RatFuncInfinityIntegers K := + (RatFunc.C : K →+* RatFunc K).codRestrict (RatFuncInfinityIntegers K) (fun c => by + by_cases hc : c = 0 + · simp [hc] + · show RatFunc.inftyValuation K (RatFunc.C c) ≤ 1 + rw [RatFunc.inftyValuation.C (F := K) hc]) + +local instance ratFuncInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +/-- The constant-field algebra map has underlying rational function `RatFunc.C c`. -/ +@[simp] theorem ratFuncInfinityConstantAlgebra_coe (c : K) : + ((algebraMap K (RatFuncInfinityIntegers K) c : + RatFuncInfinityIntegers K) : RatFunc K) = RatFunc.C c := by + rfl + +local instance ratFuncInfinityConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + .of_algebraMap_eq' rfl + +/-- Every rational function integral at infinity is congruent to a constant +modulo the maximal ideal at infinity. -/ +theorem ratFuncInfinityIntegers_exists_constant_mod_maximalIdeal + (r : RatFuncInfinityIntegers K) : + ∃ c : K, r - algebraMap K (RatFuncInfinityIntegers K) c ∈ + (ratFuncInfinityPlace K).asIdeal := by + let f : RatFunc K := r + by_cases hf : f = 0 + · refine ⟨0, ?_⟩ + have hr : r = 0 := by + apply Subtype.ext + exact hf + simp [hr] + have hdegree : f.intDegree ≤ 0 := by + have hmem := r.property + change RatFunc.inftyValuation K f ≤ 1 at hmem + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K hf, ← exp_zero, exp_le_exp] at hmem + exact hmem + rcases lt_or_eq_of_le hdegree with hdegree | hdegree + · refine ⟨0, ?_⟩ + simp only [map_zero, sub_zero] + change r ∈ IsLocalRing.maximalIdeal (RatFuncInfinityIntegers K) + rw [IsLocalRing.mem_maximalIdeal] + change ¬ IsUnit r + rw [Valuation.Integer.not_isUnit_iff_valuation_lt_one] + change RatFunc.inftyValuation K f < 1 + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K hf, ← exp_zero, exp_lt_exp] + exact hdegree + · let c : K := f.num.leadingCoeff / f.denom.leadingCoeff + refine ⟨c, ?_⟩ + let P : K[X] := f.num - Polynomial.C c * f.denom + have hnum : f.num ≠ 0 := RatFunc.num_ne_zero hf + have hdenom : f.denom ≠ 0 := f.denom_ne_zero + have hlcnum : f.num.leadingCoeff ≠ 0 := + Polynomial.leadingCoeff_ne_zero.mpr hnum + have hlcdenom : f.denom.leadingCoeff ≠ 0 := + Polynomial.leadingCoeff_ne_zero.mpr hdenom + have hc : c ≠ 0 := div_ne_zero hlcnum hlcdenom + have hnatDegree : f.num.natDegree = f.denom.natDegree := by + rw [RatFunc.intDegree] at hdegree + omega + have hdegreeEq : f.num.degree = (Polynomial.C c * f.denom).degree := by + rw [Polynomial.degree_C_mul hc, + Polynomial.degree_eq_natDegree hnum, + Polynomial.degree_eq_natDegree hdenom, + hnatDegree] + have hleadingCoeff : + f.num.leadingCoeff = (Polynomial.C c * f.denom).leadingCoeff := by + rw [Polynomial.leadingCoeff_mul, Polynomial.leadingCoeff_C] + exact (div_mul_cancel₀ f.num.leadingCoeff hlcdenom).symm + have hdegreeP : P.degree < f.num.degree := by + exact Polynomial.degree_sub_lt hdegreeEq hnum hleadingCoeff + have hrepr : f - RatFunc.C c = + algebraMap K[X] (RatFunc K) P / + algebraMap K[X] (RatFunc K) f.denom := by + calc + f - RatFunc.C c = + algebraMap K[X] (RatFunc K) f.num / + algebraMap K[X] (RatFunc K) f.denom - RatFunc.C c := by + rw [RatFunc.num_div_denom] + _ = (algebraMap K[X] (RatFunc K) f.num - + RatFunc.C c * algebraMap K[X] (RatFunc K) f.denom) / + algebraMap K[X] (RatFunc K) f.denom := by + field_simp [RatFunc.algebraMap_ne_zero hdenom] + _ = _ := by simp [P] + by_cases hP : P = 0 + · have hdiff : f - RatFunc.C c = 0 := by simp [hrepr, hP] + have hrEq : r = algebraMap K (RatFuncInfinityIntegers K) c := by + apply Subtype.ext + simpa [f] using sub_eq_zero.mp hdiff + simp [hrEq] + · have hnatDegreeP : P.natDegree < f.denom.natDegree := by + rw [Polynomial.natDegree_lt_iff_degree_lt hP] + calc + P.degree < f.num.degree := hdegreeP + _ = (f.num.natDegree : WithBot ℕ) := + Polynomial.degree_eq_natDegree hnum + _ = (f.denom.natDegree : WithBot ℕ) := by rw [hnatDegree] + have hdiff : f - RatFunc.C c ≠ 0 := by + rw [hrepr] + exact div_ne_zero + (RatFunc.algebraMap_ne_zero hP) + (RatFunc.algebraMap_ne_zero hdenom) + change r - algebraMap K (RatFuncInfinityIntegers K) c ∈ + IsLocalRing.maximalIdeal (RatFuncInfinityIntegers K) + rw [IsLocalRing.mem_maximalIdeal] + change ¬ IsUnit (r - algebraMap K (RatFuncInfinityIntegers K) c) + rw [Valuation.Integer.not_isUnit_iff_valuation_lt_one] + change RatFunc.inftyValuation K (f - RatFunc.C c) < 1 + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K hdiff, ← exp_zero, exp_lt_exp, + hrepr, RatFunc.intDegree_div + (RatFunc.algebraMap_ne_zero hP) + (RatFunc.algebraMap_ne_zero hdenom), + RatFunc.intDegree_polynomial, RatFunc.intDegree_polynomial] + omega + +/-- The residue field of the rational-function place at infinity is the +constant field. -/ +noncomputable def ratFuncInfinityPlaceResidueEquiv : + (ratFuncInfinityPlace K).asIdeal.ResidueField ≃ₐ[K] K := by + let p := (ratFuncInfinityPlace K).asIdeal + have hsurjective : + Function.Surjective (algebraMap K p.ResidueField) := by + intro z + obtain ⟨r, hr⟩ := p.algebraMap_residueField_surjective z + obtain ⟨c, hc⟩ := + ratFuncInfinityIntegers_exists_constant_mod_maximalIdeal K r + have hzero : + algebraMap (RatFuncInfinityIntegers K) p.ResidueField + (r - algebraMap K (RatFuncInfinityIntegers K) c) = 0 := + Ideal.algebraMap_residueField_eq_zero.mpr hc + have heq : + algebraMap (RatFuncInfinityIntegers K) p.ResidueField r = + algebraMap (RatFuncInfinityIntegers K) p.ResidueField + (algebraMap K (RatFuncInfinityIntegers K) c) := by + exact sub_eq_zero.mp (by simpa only [map_sub] using hzero) + refine ⟨c, ?_⟩ + calc + algebraMap K p.ResidueField c = + algebraMap (RatFuncInfinityIntegers K) p.ResidueField + (algebraMap K (RatFuncInfinityIntegers K) c) := by + rw [IsScalarTower.algebraMap_apply K + (RatFuncInfinityIntegers K) p.ResidueField] + _ = algebraMap (RatFuncInfinityIntegers K) p.ResidueField r := heq.symm + _ = z := hr + exact (AlgEquiv.ofBijective (Algebra.ofId K _) + ⟨RingHom.injective _, hsurjective⟩).symm + +section Extension + +variable [IsAlgClosed K] + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance infinityInertiaIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityInertiaIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +/-- Over an algebraically closed constant field, every prime above the place at +infinity has residue degree (inertia degree) one. -/ +theorem finiteExtensionInfinityPlace_inertiaDeg_eq_one + (P : (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L)) : + P.1.inertiaDeg (RatFuncInfinityIntegers K) = 1 := by + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver + (ratFuncInfinityPlace K).asIdeal P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra + (ratFuncInfinityPlace K).asIdeal P.1 := ⟨rfl⟩ + letI : IsAlgClosed (ratFuncInfinityPlace K).asIdeal.ResidueField := + IsAlgClosed.of_ringEquiv K + (ratFuncInfinityPlace K).asIdeal.ResidueField + (ratFuncInfinityPlaceResidueEquiv K).symm.toRingEquiv + letI : Algebra (ratFuncInfinityPlace K).asIdeal.ResidueField + P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra + letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := + inferInstance + letI : Module.Finite + (ratFuncInfinityPlace K).asIdeal.ResidueField + P.1.ResidueField := inferInstance + letI : Algebra.IsIntegral + (ratFuncInfinityPlace K).asIdeal.ResidueField + P.1.ResidueField := Algebra.IsIntegral.of_finite _ _ + rw [Ideal.inertiaDeg_eq (ratFuncInfinityPlace K).asIdeal P.1, + Algebra.finrank_eq_one_iff_bijective_algebraMap] + exact IsAlgClosed.algebraMap_bijective_of_isIntegral + +end Extension + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean new file mode 100644 index 0000000000..49919513b4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean @@ -0,0 +1,289 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +import Mathlib.RingTheory.DiscreteValuationRing.TFAE +import Mathlib.RingTheory.Valuation.Archimedean +import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing + +/-! +# The place at infinity and its primes in finite extensions + +This file realizes the place at infinity of `K(X)` as an honest height-one +prime. Its base ring is the integer ring of `RatFunc.inftyValuation`; this is +a discrete valuation ring with uniformizer `X⁻¹`. The resulting +fractional-ideal order is proved to equal the previously defined +`ratFuncInfinityOrder = -intDegree`. + +For a finite separable extension `L / K(X)`, the integral closure of the +infinity valuation ring is Dedekind and finite over the base. The final +theorem specializes the finite-extension norm/count formula to the unique +base prime, producing the residue-degree-weighted sum over all primes above +infinity. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Multiplicative WithZero + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq (RatFunc K)] + +/-- The valuation ring of the place at infinity of `K(X)`. -/ +abbrev RatFuncInfinityIntegers := (RatFunc.inftyValuation K).integer + +instance : IsDiscreteValuationRing (RatFuncInfinityIntegers K) := + (RatFunc.inftyValuation K).valuationSubring_isDiscreteValuationRing + +instance : IsDedekindDomain (RatFuncInfinityIntegers K) := by + let hnf : ¬ IsField (RatFuncInfinityIntegers K) := + IsDiscreteValuationRing.not_isField (RatFuncInfinityIntegers K) + apply ((IsDiscreteValuationRing.TFAE (RatFuncInfinityIntegers K) hnf).out 0 2).mp + infer_instance + +/-- The unique height-one prime of the infinity valuation ring. -/ +def ratFuncInfinityPlace : HeightOneSpectrum (RatFuncInfinityIntegers K) := + IsDiscreteValuationRing.maximalIdeal (RatFuncInfinityIntegers K) + +/-- `X⁻¹` as an element of the infinity valuation ring. -/ +def ratFuncInfinityUniformizer : RatFuncInfinityIntegers K := + ⟨1 / RatFunc.X, by + show RatFunc.inftyValuation K (1 / RatFunc.X) ≤ 1 + rw [RatFunc.inftyValuation.X_inv] + rw [← WithZero.exp_zero, WithZero.exp_le_exp] + omega⟩ + +theorem ratFuncInfinityUniformizer_isUniformizer : + (RatFunc.inftyValuation K).IsUniformizer (ratFuncInfinityUniformizer K) := by + rw [Valuation.IsUniformizer, + Valuation.IsRankOneDiscrete.generator_eq_exp_neg_one_of_mem_range] + · simp [ratFuncInfinityUniformizer] + · exact ⟨1 / RatFunc.X, RatFunc.inftyValuation.X_inv (F := K)⟩ + +theorem ratFuncInfinityPlace_span_uniformizer : + (ratFuncInfinityPlace K).asIdeal = Ideal.span {ratFuncInfinityUniformizer K} := by + exact Valuation.IsUniformizer.is_generator + (ratFuncInfinityUniformizer_isUniformizer K) + +/-- The canonical fraction field of the infinity valuation ring, identified +with the usual rational-function field. -/ +noncomputable def ratFuncInfinityFractionRingEquiv : + FractionRing (RatFuncInfinityIntegers K) ≃ₐ[RatFuncInfinityIntegers K] RatFunc K := + FractionRing.algEquiv (RatFuncInfinityIntegers K) (RatFunc K) + +/-- The height-one valuation is unchanged by the canonical identification of +the fraction field of the infinity valuation ring with `K(X)`. -/ +theorem ratFuncInfinityFractionRingEquiv_valuation + (x : FractionRing (RatFuncInfinityIntegers K)) : + (ratFuncInfinityPlace K).valuation (RatFunc K) + (ratFuncInfinityFractionRingEquiv K x) = + (ratFuncInfinityPlace K).valuation + (FractionRing (RatFuncInfinityIntegers K)) x := by + obtain ⟨a, b, hb, rfl⟩ := + IsFractionRing.div_surjective (RatFuncInfinityIntegers K) x + rw [map_div₀, (ratFuncInfinityFractionRingEquiv K).commutes a, + (ratFuncInfinityFractionRingEquiv K).commutes b, + Valuation.map_div, Valuation.map_div, + (ratFuncInfinityPlace K).valuation_of_algebraMap, + (ratFuncInfinityPlace K).valuation_of_algebraMap, + (ratFuncInfinityPlace K).valuation_of_algebraMap, + (ratFuncInfinityPlace K).valuation_of_algebraMap] + +/-- The height-one-prime order on the infinity valuation ring agrees with +the usual rational-function order `-intDegree`. -/ +theorem ratFuncInfinityPlace_order_eq + (f : RatFunc K) (hf : f ≠ 0) : + finitePlaceOrder (ratFuncInfinityPlace K) f = ratFuncInfinityOrder f := by + have hadic := valuation_eq_exp_neg_finitePlaceOrder + (R := RatFuncInfinityIntegers K) (L := RatFunc K) + (ratFuncInfinityPlace K) f hf + have hpi_ne : ratFuncInfinityUniformizer K ≠ 0 := by + intro h + have hc := congrArg Subtype.val h + exact (one_div_ne_zero RatFunc.X_ne_zero) hc + have hadic_pi : + (ratFuncInfinityPlace K).valuation (RatFunc K) + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K) + (ratFuncInfinityUniformizer K)) = exp (-1 : ℤ) := by + rw [IsDedekindDomain.HeightOneSpectrum.valuation_of_algebraMap] + exact (ratFuncInfinityPlace K).intValuation_singleton hpi_ne + (ratFuncInfinityPlace_span_uniformizer K) + let d : ℤ := f.intDegree + let u0 : RatFunc K := f * RatFunc.X ^ (-d) + have hinfty_u0 : RatFunc.inftyValuation K u0 = 1 := by + rw [show u0 = f * RatFunc.X ^ (-d) by rfl, map_mul, + RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero (F := K) hf, + RatFunc.inftyValuation.X_zpow, ← WithZero.exp_add] + simp [d] + let u : RatFuncInfinityIntegers K := ⟨u0, hinfty_u0.le⟩ + have hu_unit : IsUnit u := by + apply (Valuation.Integers.isUnit_iff_valuation_eq_one + (Valuation.integer.integers (RatFunc.inftyValuation K))).mpr + exact hinfty_u0 + have hadic_u : + (ratFuncInfinityPlace K).valuation (RatFunc K) + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K) u) = 1 := by + exact Valuation.Integers.one_of_isUnit' hu_unit + (fun x ↦ (ratFuncInfinityPlace K).valuation_le_one x) + have hadic_invX : + (ratFuncInfinityPlace K).valuation (RatFunc K) (1 / RatFunc.X) = + exp (-1 : ℤ) := by + change (ratFuncInfinityPlace K).valuation (RatFunc K) (1 / RatFunc.X) = + exp (-1 : ℤ) at hadic_pi + exact hadic_pi + have hadic_X : + (ratFuncInfinityPlace K).valuation (RatFunc K) RatFunc.X = exp (1 : ℤ) := by + calc + (ratFuncInfinityPlace K).valuation (RatFunc K) RatFunc.X = + (ratFuncInfinityPlace K).valuation (RatFunc K) ((1 / RatFunc.X)⁻¹) := by + congr 1 + simp + _ = ((ratFuncInfinityPlace K).valuation (RatFunc K) (1 / RatFunc.X))⁻¹ := by + rw [map_inv₀] + _ = (exp (-1 : ℤ))⁻¹ := by rw [hadic_invX] + _ = exp (1 : ℤ) := by simp + have hcancel : RatFunc.X ^ d * RatFunc.X ^ (-d) = (1 : RatFunc K) := by + rw [← zpow_add₀ RatFunc.X_ne_zero] + simp + have hdecomp : + f = RatFunc.X ^ d * + algebraMap (RatFuncInfinityIntegers K) (RatFunc K) u := by + change f = RatFunc.X ^ d * u0 + change f = RatFunc.X ^ d * (f * RatFunc.X ^ (-d)) + symm + rw [← mul_assoc, mul_comm (RatFunc.X ^ d) f, mul_assoc, hcancel, mul_one] + have hadic_f : + (ratFuncInfinityPlace K).valuation (RatFunc K) f = exp d := by + rw [hdecomp, map_mul, map_zpow₀, hadic_X, hadic_u, mul_one] + simp + have hexp : + exp (-finitePlaceOrder (ratFuncInfinityPlace K) f) = exp d := + hadic.symm.trans hadic_f + rw [exp_inj] at hexp + rw [ratFuncInfinityOrder] + omega + +/-- In the canonical `FractionRing` model used by the norm/count theorem, the +height-one-prime count still equals the ordinary rational-function order at +infinity after applying the canonical field equivalence. -/ +theorem ratFuncInfinityFractionRing_order_eq + (x : FractionRing (RatFuncInfinityIntegers K)) (hx : x ≠ 0) : + finitePlaceOrder (ratFuncInfinityPlace K) x = + ratFuncInfinityOrder (ratFuncInfinityFractionRingEquiv K x) := by + let e := ratFuncInfinityFractionRingEquiv K + have hcanon := valuation_eq_exp_neg_finitePlaceOrder + (R := RatFuncInfinityIntegers K) + (L := FractionRing (RatFuncInfinityIntegers K)) + (ratFuncInfinityPlace K) x hx + have he_ne : e x ≠ 0 := by simpa using hx + have hactual := valuation_eq_exp_neg_finitePlaceOrder + (R := RatFuncInfinityIntegers K) (L := RatFunc K) + (ratFuncInfinityPlace K) (e x) he_ne + have hval := ratFuncInfinityFractionRingEquiv_valuation K x + have hexp : + exp (-finitePlaceOrder (ratFuncInfinityPlace K) x) = + exp (-finitePlaceOrder (ratFuncInfinityPlace K) (e x)) := by + rw [← hcanon, ← hactual] + exact hval.symm + rw [exp_inj] at hexp + have hcount : finitePlaceOrder (ratFuncInfinityPlace K) x = + finitePlaceOrder (ratFuncInfinityPlace K) (e x) := by omega + rw [hcount] + exact ratFuncInfinityPlace_order_eq K (e x) he_ne + +section Extension + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + +/-- The integral closure in a finite extension at the infinity valuation +ring. -/ +abbrev RatFuncInfinityIntegralClosure := + integralClosure (RatFuncInfinityIntegers K) L + +variable [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance infinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityBaseFaithfulSMulExtensionFractionRing : + FaithfulSMul (RatFuncInfinityIntegers K) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + have hS := IsFractionRing.injective (RatFuncInfinityIntegralClosure K L) + (FractionRing (RatFuncInfinityIntegralClosure K L)) hxy + have hL := congrArg Subtype.val hS + apply Subtype.ext + apply (algebraMap (RatFunc K) L).injective + change algebraMap (RatFunc K) L (x : RatFunc K) = + algebraMap (RatFunc K) L (y : RatFunc K) + exact hL + +local instance infinityFractionRingAlgebra : + Algebra (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := + FractionRing.liftAlgebra (RatFuncInfinityIntegers K) + (FractionRing (RatFuncInfinityIntegralClosure K L)) + +local instance infinityFractionRingSeparable : + Algebra.IsSeparable (FractionRing (RatFuncInfinityIntegers K)) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncInfinityFractionRingEquiv K).symm.toRingEquiv + (FractionRing.algEquiv (RatFuncInfinityIntegralClosure K L) L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncInfinityFractionRingEquiv K).symm + (FractionRing.algEquiv (RatFuncInfinityIntegralClosure K L) L).symm z + +/-- The norm/count identity at infinity in a finite separable extension of +`K(X)`: the order of the norm at infinity is the residue-degree-weighted sum +of the orders at all primes above infinity. -/ +theorem count_spanSingleton_norm_at_infinity_eq_sum + (x : FractionRing (RatFuncInfinityIntegralClosure K L)) : + FractionalIdeal.count (FractionRing (RatFuncInfinityIntegers K)) + (ratFuncInfinityPlace K) + (FractionalIdeal.spanSingleton (RatFuncInfinityIntegers K)⁰ + (Algebra.norm (FractionRing (RatFuncInfinityIntegers K)) x)) = + ∑ P : (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L), + (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ) * + FractionalIdeal.count + (FractionRing (RatFuncInfinityIntegralClosure K L)) + (primeOverHeightOne (ratFuncInfinityPlace K) P) + (FractionalIdeal.spanSingleton + (RatFuncInfinityIntegralClosure K L)⁰ x) := by + exact count_spanSingleton_norm_eq_sum_inertiaDeg_mul_count + (ratFuncInfinityPlace K) x + +end Extension + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean new file mode 100644 index 0000000000..1f6411dd88 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean @@ -0,0 +1,182 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.Adjoin.PowerBasis +import Mathlib.RingTheory.LaurentSeries + +/-! +# Exponent dilation on Laurent series + +This file isolates the *parameter* map `z |-> z^q` on `K((z))`. It is not +the coefficientwise Frobenius: coefficients are left unchanged. +-/ + +open HahnSeries + +noncomputable section + +namespace BGS.CorvajaZannier + +variable (K : Type*) [Field K] + +/-- Multiplication of Laurent exponents by `q`. -/ +def laurentExponentDilationIndex (q : ℕ) : ℤ →+ ℤ where + toFun n := (q : ℤ) * n + map_zero' := by simp + map_add' _ _ := by ring + +@[simp] +theorem laurentExponentDilationIndex_apply (q : ℕ) (n : ℤ) : + laurentExponentDilationIndex q n = (q : ℤ) * n := rfl + +theorem laurentExponentDilationIndex_injective {q : ℕ} (hq : 0 < q) : + Function.Injective (laurentExponentDilationIndex q) := by + intro a b hab + simp only [laurentExponentDilationIndex_apply] at hab + exact mul_left_cancel₀ (by exact_mod_cast hq.ne') hab + +theorem laurentExponentDilationIndex_le_iff {q : ℕ} (hq : 0 < q) (a b : ℤ) : + laurentExponentDilationIndex q a ≤ laurentExponentDilationIndex q b ↔ a ≤ b := by + simp only [laurentExponentDilationIndex_apply] + exact Int.mul_le_mul_left (by exact_mod_cast hq) + +/-- The `K`-algebra embedding of Laurent series induced by `z |-> z^q`. + +This map dilates exponents and fixes every coefficient. In particular it is +different from coefficientwise Frobenius unless extra hypotheses identify the +two maps on a chosen constant field. +-/ +def laurentExponentDilation {q : ℕ} (hq : 0 < q) : + LaurentSeries K →ₐ[K] LaurentSeries K := + { HahnSeries.embDomainRingHom (R := K) (Γ := ℤ) (Γ' := ℤ) + (laurentExponentDilationIndex q) + (laurentExponentDilationIndex_injective hq) + (laurentExponentDilationIndex_le_iff hq) with + commutes' := by + intro a + rw [LaurentSeries.algebraMap_apply] + change HahnSeries.embDomain _ (HahnSeries.C a) = HahnSeries.C a + exact HahnSeries.embDomainRingHom_C } + +theorem laurentExponentDilation_injective {q : ℕ} (hq : 0 < q) : + Function.Injective (laurentExponentDilation K hq) := + by + change Function.Injective + (HahnSeries.embDomain (R := K) (Γ := ℤ) (Γ' := ℤ) _) + exact HahnSeries.embDomain_injective + +@[simp] +theorem coeff_laurentExponentDilation_mul {q : ℕ} (hq : 0 < q) + (f : LaurentSeries K) (n : ℤ) : + ((laurentExponentDilation K hq) f).coeff ((q : ℤ) * n) = f.coeff n := + by + change (HahnSeries.embDomain (R := K) (Γ := ℤ) (Γ' := ℤ) _ f).coeff _ = _ + exact HahnSeries.embDomain_coeff + +@[simp] +theorem laurentExponentDilation_single {q : ℕ} (hq : 0 < q) + (n : ℤ) (a : K) : + (laurentExponentDilation K hq) (HahnSeries.single n a) = + HahnSeries.single ((q : ℤ) * n) a := + by + change HahnSeries.embDomain (R := K) (Γ := ℤ) (Γ' := ℤ) _ + (HahnSeries.single n a) = _ + exact HahnSeries.embDomain_single + +/-- The embedded copy `K((z^q))` inside `K((z))`. -/ +abbrev laurentExponentSubfield {q : ℕ} (hq : 0 < q) : + IntermediateField K (LaurentSeries K) := + (laurentExponentDilation K hq).fieldRange + +/-- A chosen inverse image under exponent dilation. -/ +def laurentUndilate {q : ℕ} (hq : 0 < q) + (a : laurentExponentSubfield K hq) : LaurentSeries K := + Classical.choose (AlgHom.mem_fieldRange.mp a.property) + +@[simp] +theorem laurentExponentDilation_undilate {q : ℕ} (hq : 0 < q) + (a : laurentExponentSubfield K hq) : + (laurentExponentDilation K hq) (laurentUndilate K hq a) = a := + Classical.choose_spec (AlgHom.mem_fieldRange.mp a.property) + +/-- The Laurent parameter `z`. -/ +def laurentParameter : LaurentSeries K := HahnSeries.single 1 1 + +@[simp] +theorem laurentParameter_pow (n : ℕ) : + laurentParameter K ^ n = HahnSeries.single (n : ℤ) 1 := by + simp [laurentParameter, HahnSeries.single_pow] + +private theorem dilation_notin_wrong_residue {q : ℕ} (hq : 0 < q) + (i j : Fin q) (hij : i ≠ j) (n : ℤ) : + (q : ℤ) * n + (i : ℤ) - (j : ℤ) ∉ + Set.range (laurentExponentDilationIndex q) := by + rintro ⟨m, hm⟩ + simp only [laurentExponentDilationIndex_apply] at hm + have hqz : (0 : ℤ) < q := by exact_mod_cast hq + have hi0 : (0 : ℤ) ≤ i := Int.natCast_nonneg _ + have hj0 : (0 : ℤ) ≤ j := Int.natCast_nonneg _ + have hiq : (i : ℤ) < q := by exact_mod_cast i.isLt + have hjq : (j : ℤ) < q := by exact_mod_cast j.isLt + have heq : (q : ℤ) * (m - n) = (i : ℤ) - (j : ℤ) := by + nlinarith + have hmn : m - n = 0 := by + by_contra hne + rcases lt_or_gt_of_ne hne with hneg | hpos + · have : (q : ℤ) * (m - n) ≤ -q := by nlinarith + nlinarith + · have : (q : ℤ) ≤ q * (m - n) := by nlinarith + nlinarith + apply hij + apply Fin.ext + exact_mod_cast (by nlinarith [heq, hmn] : (i : ℤ) = j) + +theorem coeff_subfield_smul_parameter_pow {q : ℕ} (hq : 0 < q) + (a : laurentExponentSubfield K hq) (i j : Fin q) (n : ℤ) : + (a • laurentParameter K ^ (j : ℕ)).coeff ((q : ℤ) * n + (i : ℤ)) = + if i = j then (laurentUndilate K hq a).coeff n else 0 := by + rw [laurentParameter_pow, Algebra.smul_def, HahnSeries.coeff_mul_single] + simp only [mul_one] + change ((a : LaurentSeries K)).coeff ((q : ℤ) * n + (i : ℤ) - (j : ℤ)) = _ + split_ifs with hij + · subst j + rw [add_sub_cancel_right] + rw [← laurentExponentDilation_undilate K hq a] + exact coeff_laurentExponentDilation_mul K hq _ _ + · rw [← laurentExponentDilation_undilate K hq a] + change (HahnSeries.embDomain (R := K) (Γ := ℤ) (Γ' := ℤ) _ + (laurentUndilate K hq a)).coeff + ((q : ℤ) * n + (i : ℤ) - (j : ℤ)) = 0 + exact HahnSeries.embDomain_notin_range + (dilation_notin_wrong_residue hq i j hij n) + +/-- The residue classes of exponents prove that +`1, z, ..., z^(q-1)` are linearly independent over the embedded field +`K((z^q))`. + +This is the local linear-disjointness half of the Laurent-series argument. It +does not assert spanning; the complementary spanning statement requires an +explicit residue-component decomposition of arbitrary Laurent series. +-/ +theorem linearIndependent_laurentParameter_pow {q : ℕ} (hq : 0 < q) : + LinearIndependent (laurentExponentSubfield K hq) + (fun i : Fin q ↦ laurentParameter K ^ (i : ℕ)) := by + rw [Fintype.linearIndependent_iff] + intro g hg i + have hcoeff (n : ℤ) : (laurentUndilate K hq (g i)).coeff n = 0 := by + have hc := congrArg + (fun f : LaurentSeries K ↦ f.coeff ((q : ℤ) * n + (i : ℤ))) hg + simp only [HahnSeries.coeff_sum, + coeff_subfield_smul_parameter_pow K hq] at hc + simpa using hc + have hundilate : laurentUndilate K hq (g i) = 0 := by + ext n + simpa using hcoeff n + apply Subtype.ext + change (g i : LaurentSeries K) = 0 + rw [← laurentExponentDilation_undilate K hq (g i), hundilate, map_zero] + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean new file mode 100644 index 0000000000..78b2f551a3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +import Mathlib.LinearAlgebra.Basis.Basic +import Mathlib.LinearAlgebra.Dimension.StrongRankCondition + +/-! +# The Laurent-series power basis over exponent dilation + +Every Laurent series splits uniquely into its `q` exponent residue classes. +Together with the residue-class independence theorem, this proves that +`1, z, ..., z^(q-1)` is a basis of `K((z))` over `K((z^q))` and that the +extension has degree `q`. +-/ + +open HahnSeries + +noncomputable section + +namespace BGS.CorvajaZannier + +variable (K : Type*) [Field K] + +/-- The Laurent series obtained from the coefficients of `f` in one residue +class modulo `q`. -/ +def laurentResidueComponent {q : ℕ} (hq : 0 < q) + (f : LaurentSeries K) (i : Fin q) : LaurentSeries K := + HahnSeries.ofSuppBddBelow + (fun n : ℤ ↦ f.coeff ((q : ℤ) * n + (i : ℤ))) (by + refine ⟨min 0 (f.order - (i : ℤ)), ?_⟩ + intro n hn + change f.coeff ((q : ℤ) * n + (i : ℤ)) ≠ 0 at hn + have hord : f.order ≤ (q : ℤ) * n + (i : ℤ) := + HahnSeries.order_le_of_coeff_ne_zero hn + by_cases hn0 : 0 ≤ n + · exact (min_le_left _ _).trans hn0 + · have hnneg : n < 0 := lt_of_not_ge hn0 + have hqone : (1 : ℤ) ≤ q := by exact_mod_cast hq + have hmul : (q : ℤ) * n ≤ n := by nlinarith + exact (min_le_right _ _).trans (by linarith)) + +@[simp] +theorem coeff_laurentResidueComponent {q : ℕ} (hq : 0 < q) + (f : LaurentSeries K) (i : Fin q) (n : ℤ) : + (laurentResidueComponent K hq f i).coeff n = + f.coeff ((q : ℤ) * n + (i : ℤ)) := + rfl + +/-- A residue component, embedded back by exponent dilation and regarded as a +scalar in `K((z^q))`. -/ +def laurentResidueScalar {q : ℕ} (hq : 0 < q) + (f : LaurentSeries K) (i : Fin q) : laurentExponentSubfield K hq := + ⟨(laurentExponentDilation K hq) (laurentResidueComponent K hq f i), + ⟨laurentResidueComponent K hq f i, rfl⟩⟩ + +theorem laurentUndilate_residueScalar {q : ℕ} (hq : 0 < q) + (f : LaurentSeries K) (i : Fin q) : + laurentUndilate K hq (laurentResidueScalar K hq f i) = + laurentResidueComponent K hq f i := by + apply laurentExponentDilation_injective K hq + rw [laurentExponentDilation_undilate] + rfl + +/-- Euclidean division gives the exponent residue in `Fin q`. -/ +def laurentExponentResidue {q : ℕ} (hq : 0 < q) (m : ℤ) : Fin q := + ⟨(m % (q : ℤ)).toNat, by + have hnonneg : 0 ≤ m % (q : ℤ) := Int.emod_nonneg _ (by exact_mod_cast hq.ne') + have hlt : m % (q : ℤ) < q := Int.emod_lt_of_pos _ (by exact_mod_cast hq) + rw [Int.toNat_lt hnonneg] + exact hlt⟩ + +@[simp] +theorem coe_laurentExponentResidue {q : ℕ} (hq : 0 < q) (m : ℤ) : + ((laurentExponentResidue hq m : Fin q) : ℤ) = m % (q : ℤ) := by + have hqz : (q : ℤ) ≠ 0 := by exact_mod_cast hq.ne' + have hnonneg : 0 ≤ m % (q : ℤ) := Int.emod_nonneg _ hqz + simp [laurentExponentResidue, Int.toNat_of_nonneg hnonneg] + +theorem exponent_ediv_residue {q : ℕ} (hq : 0 < q) (m : ℤ) : + (q : ℤ) * (m / (q : ℤ)) + (laurentExponentResidue hq m : ℤ) = m := by + rw [coe_laurentExponentResidue] + linarith [Int.emod_add_mul_ediv m (q : ℤ)] + +/-- Reassemble a Laurent series from its `q` residue components. -/ +theorem sum_residueScalar_smul_parameter_pow {q : ℕ} (hq : 0 < q) + (f : LaurentSeries K) : + (∑ i : Fin q, + laurentResidueScalar K hq f i • laurentParameter K ^ (i : ℕ)) = f := by + ext m + let i₀ : Fin q := laurentExponentResidue hq m + let n : ℤ := m / (q : ℤ) + have hm : (q : ℤ) * n + (i₀ : ℤ) = m := by + exact exponent_ediv_residue hq m + rw [← hm] + simp only [HahnSeries.coeff_sum, + coeff_subfield_smul_parameter_pow K hq] + rw [Finset.sum_ite_eq Finset.univ i₀] + simp only [Finset.mem_univ, if_true] + rw [laurentUndilate_residueScalar, coeff_laurentResidueComponent, hm] + +/-- The powers `1,z,...,z^(q-1)` span `K((z))` over `K((z^q))`. -/ +theorem span_laurentParameter_pow_eq_top {q : ℕ} (hq : 0 < q) : + Submodule.span (laurentExponentSubfield K hq) + (Set.range (fun i : Fin q ↦ laurentParameter K ^ (i : ℕ))) = ⊤ := by + apply top_unique + intro f _ + rw [← sum_residueScalar_smul_parameter_pow K hq f] + exact Submodule.sum_mem _ fun i _ ↦ + Submodule.smul_mem _ _ + (Submodule.subset_span (Set.mem_range_self i)) + +/-- The source's Laurent power basis. -/ +noncomputable def laurentParameterPowerBasis {q : ℕ} (hq : 0 < q) : + Module.Basis (Fin q) (laurentExponentSubfield K hq) (LaurentSeries K) := + Module.Basis.mk (linearIndependent_laurentParameter_pow K hq) + (span_laurentParameter_pow_eq_top K hq).ge + +@[simp] +theorem laurentParameterPowerBasis_apply {q : ℕ} (hq : 0 < q) (i : Fin q) : + laurentParameterPowerBasis K hq i = laurentParameter K ^ (i : ℕ) := + Module.Basis.mk_apply _ _ i + +/-- The exponent-dilation Laurent subfield has index exactly `q`. -/ +theorem finrank_laurentExponentSubfield {q : ℕ} (hq : 0 < q) : + Module.finrank (laurentExponentSubfield K hq) (LaurentSeries K) = q := by + rw [Module.finrank_eq_card_basis (laurentParameterPowerBasis K hq)] + exact Fintype.card_fin q + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean new file mode 100644 index 0000000000..d54a601977 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean @@ -0,0 +1,768 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +import Mathlib.Algebra.Order.Group.Int.Sum +import Mathlib.LinearAlgebra.Matrix.Transvection + +/-! +# Corvaja--Zannier local case (i) + +This file formalizes the column elimination and the sharp local Wronskian +estimate in case (i) of Corvaja--Zannier's Proposition 2. Repeated negative +Laurent orders are eliminated by an explicitly constructed product of +transvections. Consequently the column matrix has determinant one; the +finite-dimensional elimination is not assumed as a hypothesis. + +The second part isolates the exact source inequalities. Pairwise-distinct +negative column orders give the first triangular-number gain, and distinct +derivative orders give the second. Under the source's cardinal inequalities +this sharpens the ordinary Wronskian order to +`rhoOrder * (epsilon + 1)`, and hence to `rhoOrder * q` when +`epsilon + 1 ≤ q`. + +Source provenance: published pages 1935--1936; checked semantic reconstruction +`Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 640--685. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators + +open HahnSeries LaurentSeries + +variable {K : Type*} [Field K] + +/-- The depth of the negative part of a Laurent series. -/ +def laurentPoleDepth (f : LaurentSeries K) : ℕ := Int.toNat (-f.order) + +/-- A terminating measure for repeated leading-term cancellation. -/ +def laurentPoleWeight {k : ℕ} (f : Fin k → LaurentSeries K) : ℕ := + ∑ i, laurentPoleDepth (f i) + +/-- All negative orders in a finite family are pairwise distinct. -/ +def NegativeOrdersPairwiseDistinct {ι : Type*} + (f : ι → LaurentSeries K) : Prop := + ∀ ⦃i j : ι⦄, (f i).order < 0 → (f j).order < 0 → + (f i).order = (f j).order → i = j + +/-- Cancel the leading term of `x` using a series `y` of the same order. -/ +def cancelLaurentLeadingTerm (x y : LaurentSeries K) : LaurentSeries K := + x - (x.leadingCoeff / y.leadingCoeff) • y + +@[simp] +theorem laurentPoleDepth_pos_iff (f : LaurentSeries K) : + 0 < laurentPoleDepth f ↔ f.order < 0 := by + simp [laurentPoleDepth] + +@[simp] +theorem laurentPoleDepth_eq_zero_iff (f : LaurentSeries K) : + laurentPoleDepth f = 0 ↔ 0 ≤ f.order := by + simp [laurentPoleDepth, Int.toNat_eq_zero] + +/-- Cancellation of equal leading terms strictly raises Laurent order. -/ +theorem order_lt_orderTop_cancelLaurentLeadingTerm + (x y : LaurentSeries K) (hx : x ≠ 0) (hy : y ≠ 0) + (horder : x.order = y.order) : + (x.order : WithTop ℤ) < (cancelLaurentLeadingTerm x y).orderTop := by + have hycoeff : y.coeff y.order ≠ 0 := HahnSeries.coeff_order_eq_zero.not.2 hy + have hxcoeff : x.coeff x.order ≠ 0 := HahnSeries.coeff_order_eq_zero.not.2 hx + have hylc : y.leadingCoeff ≠ 0 := by + simpa [HahnSeries.leadingCoeff_eq] using hycoeff + have hc : x.leadingCoeff / y.leadingCoeff ≠ 0 := div_ne_zero + (by simpa [HahnSeries.leadingCoeff_eq] using hxcoeff) hylc + have hscaled : (x.leadingCoeff / y.leadingCoeff) • y ≠ 0 := smul_ne_zero hc hy + have hscaledOrder : + ((x.leadingCoeff / y.leadingCoeff) • y).order = y.order := by + apply le_antisymm + · apply HahnSeries.order_le_of_coeff_ne_zero + simp only [HahnSeries.coeff_smul] + exact mul_ne_zero hc hycoeff + · exact HahnSeries.le_order_smul _ _ hscaled + have hscaledTop : + ((x.leadingCoeff / y.leadingCoeff) • y).orderTop = + (x.order : WithTop ℤ) := by + rw [← HahnSeries.order_eq_orderTop_of_ne_zero hscaled, hscaledOrder, ← horder] + have hlc : + ((x.leadingCoeff / y.leadingCoeff) • y).leadingCoeff = x.leadingCoeff := by + rw [HahnSeries.leadingCoeff_eq, hscaledOrder, HahnSeries.coeff_smul] + rw [HahnSeries.leadingCoeff_eq] + simp only [smul_eq_mul] + rw [← HahnSeries.leadingCoeff_eq (x := y)] + exact div_mul_cancel₀ _ hylc + have hxtop : x.orderTop = (x.order : WithTop ℤ) := + (HahnSeries.order_eq_orderTop_of_ne_zero hx).symm + unfold cancelLaurentLeadingTerm + exact HahnSeries.le_orderTop_of_leadingCoeff_eq hxtop hscaledTop hlc.symm + +/-- Leading-term cancellation strictly decreases pole depth. -/ +theorem laurentPoleDepth_cancelLaurentLeadingTerm_lt + (x y : LaurentSeries K) (hxneg : x.order < 0) + (hyneg : y.order < 0) (horder : x.order = y.order) : + laurentPoleDepth (cancelLaurentLeadingTerm x y) < laurentPoleDepth x := by + have hx : x ≠ 0 := by + intro h + simp [h] at hxneg + have hy : y ≠ 0 := by + intro h + simp [h] at hyneg + have hraise := order_lt_orderTop_cancelLaurentLeadingTerm x y hx hy horder + by_cases hz : cancelLaurentLeadingTerm x y = 0 + · simp [laurentPoleDepth, hz] + omega + · rw [← HahnSeries.order_eq_orderTop_of_ne_zero hz] at hraise + simp only [WithTop.coe_lt_coe] at hraise + simp [laurentPoleDepth] + omega + +private theorem indexedColumnCombination_transvection_same {k : ℕ} + (f : Fin k → LaurentSeries K) (i j : Fin k) (c : K) : + indexedLaurentSeriesColumnCombination f (Matrix.transvection j i c) i = + f i + c • f j := by + classical + simp [indexedLaurentSeriesColumnCombination, Matrix.transvection, + Matrix.single, Matrix.one_apply, add_smul, Finset.sum_add_distrib] + +private theorem indexedColumnCombination_transvection_ne {k : ℕ} + (f : Fin k → LaurentSeries K) (i j b : Fin k) (c : K) (hb : b ≠ i) : + indexedLaurentSeriesColumnCombination f (Matrix.transvection j i c) b = + f b := by + classical + have hib : i ≠ b := Ne.symm hb + simp [indexedLaurentSeriesColumnCombination, Matrix.transvection, + Matrix.single, Matrix.one_apply, hib] + +private theorem laurentPoleWeight_transvection_lt {k : ℕ} + (f : Fin k → LaurentSeries K) (i j : Fin k) + (hi : (f i).order < 0) (hj : (f j).order < 0) + (horder : (f i).order = (f j).order) : + laurentPoleWeight + (indexedLaurentSeriesColumnCombination f + (Matrix.transvection j i (-(f i).leadingCoeff / (f j).leadingCoeff))) < + laurentPoleWeight f := by + let c : K := -(f i).leadingCoeff / (f j).leadingCoeff + let g := indexedLaurentSeriesColumnCombination f (Matrix.transvection j i c) + have hgi : g i = cancelLaurentLeadingTerm (f i) (f j) := by + change indexedLaurentSeriesColumnCombination f (Matrix.transvection j i c) i = _ + rw [indexedColumnCombination_transvection_same] + simp only [c, cancelLaurentLeadingTerm, neg_div, neg_smul, sub_eq_add_neg] + have hstrict : laurentPoleDepth (g i) < laurentPoleDepth (f i) := by + rw [hgi] + exact laurentPoleDepth_cancelLaurentLeadingTerm_lt (f i) (f j) hi hj horder + unfold laurentPoleWeight + apply Finset.sum_lt_sum + · intro b _ + by_cases hb : b = i + · subst b + exact hstrict.le + · rw [indexedColumnCombination_transvection_ne f i j b c hb] + · exact ⟨i, Finset.mem_univ _, hstrict⟩ + +/-- Successive constant column combinations compose by matrix multiplication. -/ +theorem indexedLaurentSeriesColumnCombination_mul {k : ℕ} + (f : Fin k → LaurentSeries K) (A B : Matrix (Fin k) (Fin k) K) : + indexedLaurentSeriesColumnCombination + (indexedLaurentSeriesColumnCombination f A) B = + indexedLaurentSeriesColumnCombination f (A * B) := by + classical + funext b + simp only [indexedLaurentSeriesColumnCombination, Matrix.mul_apply] + simp_rw [Finset.smul_sum, smul_smul] + rw [Finset.sum_comm] + apply Finset.sum_congr rfl + intro i _ + rw [Finset.sum_smul] + apply Finset.sum_congr rfl + intro j _ + rw [mul_comm (B j b) (A i j)] + +private theorem indexedLaurentSeriesColumnCombination_one {k : ℕ} + (f : Fin k → LaurentSeries K) : + indexedLaurentSeriesColumnCombination f 1 = f := by + classical + funext i + simp [indexedLaurentSeriesColumnCombination, Matrix.one_apply] + +/-- Explicit finite-dimensional elimination of repeated negative orders. +The resulting matrix is a product of transvections and therefore has +determinant one. -/ +theorem exists_det_one_columnMatrix_negativeOrdersPairwiseDistinct + {k : ℕ} (a : ℤ) (ha : a ≤ 0) + (f : Fin k → LaurentSeries K) (hf : ∀ i, a ≤ (f i).order) : + ∃ A : Matrix (Fin k) (Fin k) K, + A.det = 1 ∧ + NegativeOrdersPairwiseDistinct + (indexedLaurentSeriesColumnCombination f A) ∧ + ∀ i, a ≤ (indexedLaurentSeriesColumnCombination f A i).order := by + induction hN : laurentPoleWeight f using Nat.strong_induction_on generalizing f with + | h N ih => + by_cases hdistinct : NegativeOrdersPairwiseDistinct f + · refine ⟨1, Matrix.det_one, ?_, ?_⟩ + · simpa [indexedLaurentSeriesColumnCombination_one] + · simpa [indexedLaurentSeriesColumnCombination_one] using hf + · have hdup : ∃ i j : Fin k, + (f i).order < 0 ∧ (f j).order < 0 ∧ + (f i).order = (f j).order ∧ i ≠ j := by + simp only [NegativeOrdersPairwiseDistinct] at hdistinct + push Not at hdistinct + obtain ⟨i, j, hi, hj, ho, hij⟩ := hdistinct + exact ⟨i, j, hi, hj, ho, hij⟩ + obtain ⟨i, j, hi, hj, horder, hij⟩ := hdup + let c : K := -(f i).leadingCoeff / (f j).leadingCoeff + let T : Matrix (Fin k) (Fin k) K := Matrix.transvection j i c + let g := indexedLaurentSeriesColumnCombination f T + have hweight : laurentPoleWeight g < N := by + rw [← hN] + exact laurentPoleWeight_transvection_lt f i j hi hj horder + have hgi : g i = cancelLaurentLeadingTerm (f i) (f j) := by + change indexedLaurentSeriesColumnCombination f + (Matrix.transvection j i c) i = _ + rw [indexedColumnCombination_transvection_same] + simp only [c, cancelLaurentLeadingTerm, neg_div, neg_smul, sub_eq_add_neg] + have hg : ∀ b, a ≤ (g b).order := by + intro b + by_cases hb : b = i + · subst b + rw [hgi] + have hfi : f i ≠ 0 := by + intro hz + simp [hz] at hi + have hfj : f j ≠ 0 := by + intro hz + simp [hz] at hj + have hraise := + order_lt_orderTop_cancelLaurentLeadingTerm (f i) (f j) hfi hfj horder + by_cases hz : cancelLaurentLeadingTerm (f i) (f j) = 0 + · simpa [hz] using ha + · rw [← HahnSeries.order_eq_orderTop_of_ne_zero hz] at hraise + simp only [WithTop.coe_lt_coe] at hraise + exact (hf i).trans hraise.le + · change a ≤ (indexedLaurentSeriesColumnCombination f + (Matrix.transvection j i c) b).order + rw [indexedColumnCombination_transvection_ne f i j b c hb] + exact hf b + obtain ⟨B, hBdet, hBdistinct, hBlower⟩ := ih _ hweight g hg rfl + refine ⟨T * B, ?_, ?_, ?_⟩ + · rw [Matrix.det_mul, hBdet, mul_one] + exact Matrix.det_transvection_of_ne j i (Ne.symm hij) c + · rw [← indexedLaurentSeriesColumnCombination_mul] + exact hBdistinct + · rw [← indexedLaurentSeriesColumnCombination_mul] + exact hBlower + +/-- Sharp lower sum bound for distinct integers bounded below. -/ +theorem sum_range_add_le_sum_of_injOn {ι : Type*} [DecidableEq ι] + (s : Finset ι) (w : ι → ℤ) (a : ℤ) + (hinj : Set.InjOn w (s : Set ι)) (hlower : ∀ i ∈ s, a ≤ w i) : + (∑ n ∈ Finset.range s.card, (a + n : ℤ)) ≤ ∑ i ∈ s, w i := by + have hcard : (s.image w).card = s.card := Finset.card_image_iff.mpr hinj + have hbound := Finset.sum_range_le_sum + (s := s.image w) (c := a) (by + intro x hx + rw [Finset.mem_image] at hx + obtain ⟨i, hi, rfl⟩ := hx + exact hlower i hi) + rw [hcard] at hbound + simpa [Finset.sum_image hinj] using hbound + +/-- Sharp upper sum bound for distinct natural numbers bounded above. -/ +theorem sum_le_sum_range_sub_of_injOn {ι : Type*} [DecidableEq ι] + (s : Finset ι) (e : ι → ℕ) (epsilon : ℕ) + (hinj : Set.InjOn e (s : Set ι)) (hupper : ∀ i ∈ s, e i ≤ epsilon) : + (∑ i ∈ s, (e i : ℤ)) ≤ + ∑ n ∈ Finset.range s.card, ((epsilon : ℤ) - n) := by + let w : ι → ℤ := fun i => e i + have hinjw : Set.InjOn w (s : Set ι) := by + intro i hi j hj hij + exact hinj hi hj (by simpa [w] using hij) + have hcard : (s.image w).card = s.card := Finset.card_image_iff.mpr hinjw + have hbound := Finset.sum_le_sum_range + (s := s.image w) (c := (epsilon : ℤ)) (by + intro x hx + rw [Finset.mem_image] at hx + obtain ⟨i, hi, rfl⟩ := hx + change (e i : ℤ) ≤ (epsilon : ℤ) + exact_mod_cast hupper i hi) + rw [hcard] at hbound + simpa [w, Finset.sum_image hinjw] using hbound + +private theorem caseI_addVal_prod {ι : Type*} [DecidableEq ι] + (s : Finset ι) (g : ι → LaurentSeries K) : + HahnSeries.addVal ℤ K (∏ i ∈ s, g i) = + ∑ i ∈ s, HahnSeries.addVal ℤ K (g i) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, AddValuation.map_mul] + +private theorem caseI_coe_sum_int_finset {ι : Type*} [DecidableEq ι] + (s : Finset ι) (g : ι → ℤ) : + (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] + +/-- The determinant bound in which only pole columns pay a derivative-order +cost; regular columns contribute a nonnegative order. -/ +theorem orderTop_indexedWronskian_det_lower_bound_of_poles + {ι : Type*} [Fintype ι] [DecidableEq ι] + (epsilonOrder : ι → ℕ) (g : ι → LaurentSeries K) (poles : Finset ι) + (E : ℤ) + (hregular : ∀ i ∉ poles, 0 ≤ (g i).order) + (hselected : ∀ σ : Equiv.Perm ι, + (∑ i ∈ poles, (epsilonOrder (σ i) : ℤ)) ≤ E) : + ((((∑ i ∈ poles, (g i).order) - E : ℤ)) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian epsilonOrder g).det.orderTop := by + rw [Matrix.det_apply] + change ((((∑ i ∈ poles, (g i).order) - E : ℤ)) : WithTop ℤ) ≤ + HahnSeries.addVal ℤ K + (∑ σ, Equiv.Perm.sign σ • + ∏ i, indexedLaurentSeriesWronskian epsilonOrder g (σ i) i) + apply AddValuation.map_le_sum + intro σ _ + calc + ((((∑ i ∈ poles, (g i).order) - E : ℤ)) : WithTop ℤ) ≤ + (((∑ i ∈ poles, + ((g i).order - (epsilonOrder (σ i) : ℤ)) : ℤ)) : WithTop ℤ) := by + rw [Finset.sum_sub_distrib] + exact_mod_cast sub_le_sub_left (hselected σ) _ + _ = ∑ i, if i ∈ poles then + (((g i).order - (epsilonOrder (σ i) : ℤ) : ℤ) : WithTop ℤ) + else 0 := by + rw [Finset.sum_ite_mem_eq] + exact caseI_coe_sum_int_finset poles + (fun i => (g i).order - (epsilonOrder (σ i) : ℤ)) + _ ≤ ∑ i, + ((((LaurentSeries.derivative K)^[epsilonOrder (σ i)]) (g i)).orderTop) := by + gcongr with i + by_cases hi : i ∈ poles + · simp only [hi, if_true] + exact order_sub_le_orderTop_derivative_iterate (epsilonOrder (σ i)) (g i) + · simp only [hi, if_false] + exact orderTop_derivative_iterate_nonnegative_of_order_nonnegative + (epsilonOrder (σ i)) (g i) (hregular i hi) + _ = (∏ i, + indexedLaurentSeriesWronskian epsilonOrder g (σ i) i).orderTop := by + rw [← HahnSeries.addVal_apply, caseI_addVal_prod] + simp only [HahnSeries.addVal_apply] + rfl + _ ≤ (Equiv.Perm.sign σ • + ∏ i, indexedLaurentSeriesWronskian epsilonOrder g (σ i) i).orderTop := by + exact orderTop_le_orderTop_smul _ _ + +private theorem sum_range_int_mul_two (r : ℕ) : + (∑ n ∈ Finset.range r, (n : ℤ)) * 2 = + (r : ℤ) * (r - 1 : ℕ) := by + have h := congrArg (fun n : ℕ => (n : ℤ)) + (Finset.sum_range_id_mul_two r) + push_cast at h + exact h + +private theorem int_natCast_mul_pred (r : ℕ) : + (r : ℤ) * (r - 1 : ℕ) = (r : ℤ) * ((r : ℤ) - 1) := by + cases r <;> simp + +/-- The exact intermediate bound in source case (i). -/ +theorem orderTop_indexedWronskian_det_caseI_epsilon_plus_one_lower_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (epsilonOrder : ι → ℕ) (g : ι → LaurentSeries K) + (rhoOrder : ℤ) (epsilon : ℕ) + (hgdistinct : NegativeOrdersPairwiseDistinct g) + (hglower : ∀ i, rhoOrder ≤ (g i).order) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hcardRho : rhoOrder ≤ + -((Finset.univ.filter fun i => (g i).order < 0).card : ℤ)) + (hcardEpsilon : + (Finset.univ.filter fun i => (g i).order < 0).card ≤ epsilon + 1) : + ((rhoOrder * (epsilon + 1 : ℕ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian epsilonOrder g).det.orderTop := by + let poles : Finset ι := Finset.univ.filter fun i => (g i).order < 0 + let E : ℤ := ∑ n ∈ Finset.range poles.card, ((epsilon : ℤ) - n) + have horderInj : Set.InjOn (fun i => (g i).order) (poles : Set ι) := by + intro i hi j hj hij + apply hgdistinct + · simpa [poles] using hi + · simpa [poles] using hj + · exact hij + have hpoleLower : + (∑ n ∈ Finset.range poles.card, (rhoOrder + n : ℤ)) ≤ + ∑ i ∈ poles, (g i).order := + sum_range_add_le_sum_of_injOn poles (fun i => (g i).order) rhoOrder + horderInj (fun i _ => hglower i) + have hselected : ∀ σ : Equiv.Perm ι, + (∑ i ∈ poles, (epsilonOrder (σ i) : ℤ)) ≤ E := by + intro σ + apply sum_le_sum_range_sub_of_injOn poles (fun i => epsilonOrder (σ i)) epsilon + · intro i hi j hj hij + exact σ.injective (hepsilonInjective hij) + · intro i _ + exact hepsilonMax (σ i) + have hregular : ∀ i ∉ poles, 0 ≤ (g i).order := by + intro i hi + simp only [poles, Finset.mem_filter, Finset.mem_univ, true_and] at hi + omega + have hW := orderTop_indexedWronskian_det_lower_bound_of_poles + epsilonOrder g poles E hregular hselected + apply le_trans ?_ hW + norm_cast + have hcardRho' : rhoOrder ≤ -(poles.card : ℤ) := by + simpa [poles] using hcardRho + have hcardEpsilon' : poles.card ≤ epsilon + 1 := by + simpa [poles] using hcardEpsilon + let S : ℤ := ∑ n ∈ Finset.range poles.card, (n : ℤ) + have htri : S * 2 = (poles.card : ℤ) * (poles.card - 1 : ℕ) := by + exact sum_range_int_mul_two poles.card + have htri' : S * 2 = (poles.card : ℤ) * ((poles.card : ℤ) - 1) := + htri.trans (int_natCast_mul_pred poles.card) + have hpoleRange : + (∑ n ∈ Finset.range poles.card, (rhoOrder + n : ℤ)) = + (poles.card : ℤ) * rhoOrder + S := by + rw [Finset.sum_add_distrib] + simp [S, mul_comm] + have hcostRange : E = + (poles.card : ℤ) * epsilon - S := by + change (∑ n ∈ Finset.range poles.card, ((epsilon : ℤ) - n)) = _ + rw [Finset.sum_sub_distrib] + simp [S, mul_comm] + have hgapEpsilon : + 0 ≤ (epsilon + 1 : ℤ) - (poles.card : ℤ) := by + have hcast : (poles.card : ℤ) ≤ (epsilon + 1 : ℕ) := by + exact_mod_cast hcardEpsilon' + omega + have hgapRho : 0 ≤ -rhoOrder - (poles.card : ℤ) := by omega + have hgapProduct : + 0 ≤ ((epsilon + 1 : ℤ) - (poles.card : ℤ)) * + (-rhoOrder - (poles.card : ℤ)) := + mul_nonneg hgapEpsilon hgapRho + calc + rhoOrder * (epsilon + 1 : ℕ) ≤ + (∑ n ∈ Finset.range poles.card, (rhoOrder + n : ℤ)) - E := by + rw [hpoleRange, hcostRange] + push_cast + nlinarith + _ ≤ (∑ i ∈ poles, (g i).order) - E := sub_le_sub_right hpoleLower E + +/-- Source case (i), in the final `q * rhoOrder` form. -/ +theorem orderTop_indexedWronskian_det_caseI_q_lower_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (epsilonOrder : ι → ℕ) (g : ι → LaurentSeries K) + (rhoOrder : ℤ) (epsilon q : ℕ) + (hgdistinct : NegativeOrdersPairwiseDistinct g) + (hglower : ∀ i, rhoOrder ≤ (g i).order) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hcardRho : rhoOrder ≤ + -((Finset.univ.filter fun i => (g i).order < 0).card : ℤ)) + (hcardEpsilon : + (Finset.univ.filter fun i => (g i).order < 0).card ≤ epsilon + 1) + (hrho : rhoOrder ≤ 0) (hepsilonQ : epsilon + 1 ≤ q) : + (((q : ℤ) * rhoOrder : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian epsilonOrder g).det.orderTop := by + apply le_trans ?_ + (orderTop_indexedWronskian_det_caseI_epsilon_plus_one_lower_bound + epsilonOrder g rhoOrder epsilon hgdistinct hglower hepsilonInjective + hepsilonMax hcardRho hcardEpsilon) + norm_cast + have hepsilonQ' : (epsilon + 1 : ℤ) ≤ q := by exact_mod_cast hepsilonQ + calc + (q : ℤ) * rhoOrder ≤ (epsilon + 1 : ℤ) * rhoOrder := + mul_le_mul_of_nonpos_right hepsilonQ' hrho + _ = rhoOrder * (epsilon + 1 : ℕ) := by push_cast; ring + +/-- Pairwise-distinct negative integers bounded below by a nonpositive integer +are no more numerous than its pole depth. -/ +theorem card_negativeOrders_le_neg + {ι : Type*} [Fintype ι] [DecidableEq ι] + (g : ι → LaurentSeries K) (a : ℤ) (ha : a ≤ 0) + (hgdistinct : NegativeOrdersPairwiseDistinct g) + (hglower : ∀ i, a ≤ (g i).order) : + a ≤ -((Finset.univ.filter fun i => (g i).order < 0).card : ℤ) := by + let poles : Finset ι := Finset.univ.filter fun i => (g i).order < 0 + let w : ι → ℤ := fun i => (g i).order + have hinj : Set.InjOn w (poles : Set ι) := by + intro i hi j hj hij + apply hgdistinct + · simpa [poles] using hi + · simpa [poles] using hj + · exact hij + have hsubset : poles.image w ⊆ Finset.Ico a 0 := by + intro x hx + rw [Finset.mem_image] at hx + obtain ⟨i, hi, rfl⟩ := hx + rw [Finset.mem_Ico] + exact ⟨hglower i, by simpa [poles] using hi⟩ + have hcard := Finset.card_le_card hsubset + rw [Finset.card_image_iff.mpr hinj, Int.card_Ico] at hcard + have hcard' : poles.card ≤ Int.toNat (-a) := by simpa using hcard + have hcast : (poles.card : ℤ) ≤ Int.toNat (-a) := by + exact_mod_cast hcard' + have htoNat : (Int.toNat (-a) : ℤ) = -a := by + rw [Int.toNat_of_nonneg] + omega + rw [htoNat] at hcast + simpa [poles] using (show a ≤ -(poles.card : ℤ) by omega) + +/-- Complete local case (i) for an arbitrary `Fin k` family. The theorem +constructs the determinant-one elimination matrix, preserves the original +Wronskian determinant, and proves the final `q * a` order bound. -/ +theorem exists_caseI_columnMatrix_and_q_wronskian_bound + {k : ℕ} (epsilonOrder : Fin k → ℕ) + (f : Fin k → LaurentSeries K) (a : ℤ) (epsilon q : ℕ) + (ha : a ≤ 0) (hf : ∀ i, a ≤ (f i).order) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) K, + A.det = 1 ∧ + (indexedLaurentSeriesWronskian epsilonOrder + (indexedLaurentSeriesColumnCombination f A)).det = + (indexedLaurentSeriesWronskian epsilonOrder f).det ∧ + (((q : ℤ) * a : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian epsilonOrder f).det.orderTop := by + obtain ⟨A, hAdet, hdistinct, hlower⟩ := + exists_det_one_columnMatrix_negativeOrdersPairwiseDistinct a ha f hf + let g := indexedLaurentSeriesColumnCombination f A + have hdet : + (indexedLaurentSeriesWronskian epsilonOrder g).det = + (indexedLaurentSeriesWronskian epsilonOrder f).det := by + exact indexedLaurentSeriesWronskian_det_columnCombination_of_det_eq_one + epsilonOrder f A hAdet + have hcardRho : + a ≤ -((Finset.univ.filter fun i => (g i).order < 0).card : ℤ) := + card_negativeOrders_le_neg g a ha hdistinct hlower + have hcardEpsilon : + (Finset.univ.filter fun i => (g i).order < 0).card ≤ epsilon + 1 := by + calc + (Finset.univ.filter fun i => (g i).order < 0).card ≤ + (Finset.univ : Finset (Fin k)).card := Finset.card_filter_le _ _ + _ = k := Fintype.card_fin k + _ ≤ epsilon + 1 := hk + have hbound := orderTop_indexedWronskian_det_caseI_q_lower_bound + epsilonOrder g a epsilon q hdistinct hlower hepsilonInjective hepsilonMax + hcardRho hcardEpsilon ha hepsilonQ + refine ⟨A, hAdet, hdet, ?_⟩ + rw [← hdet] + exact hbound + +/-- Extend a first-block column operation by the identity on the grid columns +of the source auxiliary family. -/ +def caseIColumnMatrix (h k : ℕ) (A : Matrix (Fin k) (Fin k) K) : + Matrix (Sum (Fin k) (Fin (k + 1) × Fin h)) + (Sum (Fin k) (Fin (k + 1) × Fin h)) K := + Matrix.fromBlocks A 0 0 1 + +theorem caseIColumnMatrix_det (h k : ℕ) (A : Matrix (Fin k) (Fin k) K) : + (caseIColumnMatrix (K := K) h k A).det = A.det := by + rw [caseIColumnMatrix, Matrix.det_fromBlocks_zero₁₂] + simp + +theorem indexedColumnCombination_caseIColumnMatrix_inl + (h k : ℕ) + (f : Sum (Fin k) (Fin (k + 1) × Fin h) → LaurentSeries K) + (A : Matrix (Fin k) (Fin k) K) (i : Fin k) : + indexedLaurentSeriesColumnCombination f (caseIColumnMatrix h k A) (Sum.inl i) = + indexedLaurentSeriesColumnCombination (fun j => f (Sum.inl j)) A i := by + classical + rw [indexedLaurentSeriesColumnCombination, Fintype.sum_sum_type] + simp [caseIColumnMatrix, indexedLaurentSeriesColumnCombination] + +theorem indexedColumnCombination_caseIColumnMatrix_inr + (h k : ℕ) + (f : Sum (Fin k) (Fin (k + 1) × Fin h) → LaurentSeries K) + (A : Matrix (Fin k) (Fin k) K) (rs : Fin (k + 1) × Fin h) : + indexedLaurentSeriesColumnCombination f (caseIColumnMatrix h k A) (Sum.inr rs) = + f (Sum.inr rs) := by + classical + rw [indexedLaurentSeriesColumnCombination, Fintype.sum_sum_type] + simp [caseIColumnMatrix, Matrix.one_apply] + +/-- The full auxiliary family after a case-(i) operation on its first block. -/ +def caseITransformedLocalAuxiliaryFamily + (u v rho : LaurentSeries K) (h k : ℕ) (A : Matrix (Fin k) (Fin k) K) : + Sum (Fin k) (Fin (k + 1) × Fin h) → LaurentSeries K := + indexedLaurentSeriesColumnCombination (localAuxiliaryFamily u v rho h k) + (caseIColumnMatrix h k A) + +@[simp] +theorem caseITransformedLocalAuxiliaryFamily_inl + (u v rho : LaurentSeries K) (h k : ℕ) + (A : Matrix (Fin k) (Fin k) K) (i : Fin k) : + caseITransformedLocalAuxiliaryFamily u v rho h k A (Sum.inl i) = + indexedLaurentSeriesColumnCombination + (fun j => localAuxiliaryFamily u v rho h k (Sum.inl j)) A i := + indexedColumnCombination_caseIColumnMatrix_inl h k + (localAuxiliaryFamily u v rho h k) A i + +@[simp] +theorem caseITransformedLocalAuxiliaryFamily_inr + (u v rho : LaurentSeries K) (h k : ℕ) + (A : Matrix (Fin k) (Fin k) K) (rs : Fin (k + 1) × Fin h) : + caseITransformedLocalAuxiliaryFamily u v rho h k A (Sum.inr rs) = + localAuxiliaryFamily u v rho h k (Sum.inr rs) := + indexedColumnCombination_caseIColumnMatrix_inr h k + (localAuxiliaryFamily u v rho h k) A rs + +/-- The exact source-facing case-(i) result for `localAuxiliaryFamily`. +Only the first `k` columns can have poles; the constructed block matrix +eliminates their repeated negative orders and fixes every grid column. -/ +theorem exists_localAuxiliaryFamily_caseI_columnMatrix + (u v rho : LaurentSeries K) (h k : ℕ) + (hu : u ≠ 0) (hrhoNe : rho ≠ 0) + (huOrder : u.order = 0) (hrhoOrder : rho.order ≤ 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + 0 ≤ (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order) : + ∃ A : Matrix (Fin k) (Fin k) K, + A.det = 1 ∧ + NegativeOrdersPairwiseDistinct + (caseITransformedLocalAuxiliaryFamily u v rho h k A) ∧ + (∀ i, rho.order ≤ + (caseITransformedLocalAuxiliaryFamily u v rho h k A i).order) ∧ + (∀ rs, caseITransformedLocalAuxiliaryFamily u v rho h k A (Sum.inr rs) = + localAuxiliaryFamily u v rho h k (Sum.inr rs)) := by + let first : Fin k → LaurentSeries K := + fun i => localAuxiliaryFamily u v rho h k (Sum.inl i) + have hfirstOrder : ∀ i, (first i).order = rho.order := by + intro i + simp only [first, localAuxiliaryFamily] + rw [HahnSeries.order_mul (pow_ne_zero _ hu) hrhoNe, HahnSeries.order_pow, + huOrder] + simp + have hfirstLower : ∀ i, rho.order ≤ (first i).order := by + intro i + rw [hfirstOrder i] + obtain ⟨A, hAdet, hdistinct, hlower⟩ := + exists_det_one_columnMatrix_negativeOrdersPairwiseDistinct + rho.order hrhoOrder first hfirstLower + refine ⟨A, hAdet, ?_, ?_, ?_⟩ + · intro x y hx hy hxy + cases x with + | inl i => + cases y with + | inl j => + apply congrArg Sum.inl + apply hdistinct + · simpa [first] using hx + · simpa [first] using hy + · simpa [first] using hxy + | inr rs => + rw [caseITransformedLocalAuxiliaryFamily_inr] at hy + exact (not_lt_of_ge (hgridRegular rs)) hy |>.elim + | inr rs => + rw [caseITransformedLocalAuxiliaryFamily_inr] at hx + exact (not_lt_of_ge (hgridRegular rs)) hx |>.elim + · intro i + cases i with + | inl j => + simpa [first] using hlower j + | inr rs => + rw [caseITransformedLocalAuxiliaryFamily_inr] + exact hrhoOrder.trans (hgridRegular rs) + · intro rs + exact caseITransformedLocalAuxiliaryFamily_inr u v rho h k A rs + +/-- Full source case (i) for the exact Sum-indexed auxiliary family: the +first-block elimination preserves the original Wronskian determinant and +gives the `q * order rho` lower bound. -/ +theorem exists_localAuxiliaryFamily_caseI_q_wronskian_bound + (u v rho : LaurentSeries K) (h k : ℕ) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (epsilon q : ℕ) + (hu : u ≠ 0) (hrhoNe : rho ≠ 0) + (huOrder : u.order = 0) (hrhoOrder : rho.order ≤ 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + 0 ≤ (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) K, + A.det = 1 ∧ + (indexedLaurentSeriesWronskian epsilonOrder + (caseITransformedLocalAuxiliaryFamily u v rho h k A)).det = + (indexedLaurentSeriesWronskian epsilonOrder + (localAuxiliaryFamily u v rho h k)).det ∧ + (((q : ℤ) * rho.order : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian epsilonOrder + (localAuxiliaryFamily u v rho h k)).det.orderTop := by + obtain ⟨A, hAdet, hdistinct, hlower, hgrid⟩ := + exists_localAuxiliaryFamily_caseI_columnMatrix + u v rho h k hu hrhoNe huOrder hrhoOrder hgridRegular + let f := localAuxiliaryFamily u v rho h k + let B := caseIColumnMatrix h k A + let g := caseITransformedLocalAuxiliaryFamily u v rho h k A + have hBdet : B.det = 1 := by + rw [caseIColumnMatrix_det, hAdet] + have hdet : + (indexedLaurentSeriesWronskian epsilonOrder g).det = + (indexedLaurentSeriesWronskian epsilonOrder f).det := by + exact indexedLaurentSeriesWronskian_det_columnCombination_of_det_eq_one + epsilonOrder f B hBdet + have hcardRho : + rho.order ≤ -((Finset.univ.filter fun i => (g i).order < 0).card : ℤ) := + card_negativeOrders_le_neg g rho.order hrhoOrder hdistinct hlower + let firstPoles : Finset (Fin k) := Finset.univ.filter fun i => + (g (Sum.inl i)).order < 0 + have hpoles : + (Finset.univ.filter fun i => (g i).order < 0) = + firstPoles.map ⟨Sum.inl, Sum.inl_injective⟩ := by + ext x + cases x with + | inl i => simp [firstPoles] + | inr rs => + have hregg : 0 ≤ (g (Sum.inr rs)).order := by + change 0 ≤ (caseITransformedLocalAuxiliaryFamily u v rho h k A + (Sum.inr rs)).order + rw [hgrid rs] + simpa [localAuxiliaryFamily] using hgridRegular rs + have hrs : ¬(g (Sum.inr rs)).order < 0 := + not_lt_of_ge hregg + simp [firstPoles, hrs] + have hcardEpsilon : + (Finset.univ.filter fun i => (g i).order < 0).card ≤ epsilon + 1 := by + rw [hpoles, Finset.card_map] + exact (Finset.card_filter_le _ _).trans (by simpa using hk) + have hbound := orderTop_indexedWronskian_det_caseI_q_lower_bound + epsilonOrder g rho.order epsilon q hdistinct hlower hepsilonInjective + hepsilonMax hcardRho hcardEpsilon hrhoOrder hepsilonQ + refine ⟨A, hAdet, ?_, ?_⟩ + · exact hdet + · rw [← hdet] + exact hbound + +/-- The same case-(i) endpoint for the source `auxiliaryFamily`, obtained by +specializing `rho = (1-u)/(1-v)`. -/ +theorem exists_auxiliaryFamily_caseI_q_wronskian_bound + (u v : LaurentSeries K) (h k : ℕ) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (epsilon q : ℕ) + (hu : u ≠ 0) (hrhoNe : (1 - u) / (1 - v) ≠ 0) + (huOrder : u.order = 0) (hrhoOrder : ((1 - u) / (1 - v)).order ≤ 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + 0 ≤ (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ q) : + ∃ A : Matrix (Fin k) (Fin k) K, + A.det = 1 ∧ + (indexedLaurentSeriesWronskian epsilonOrder + (indexedLaurentSeriesColumnCombination (auxiliaryFamily u v h k) + (caseIColumnMatrix h k A))).det = + (indexedLaurentSeriesWronskian epsilonOrder + (auxiliaryFamily u v h k)).det ∧ + (((q : ℤ) * ((1 - u) / (1 - v)).order : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian epsilonOrder + (auxiliaryFamily u v h k)).det.orderTop := by + simpa only [caseITransformedLocalAuxiliaryFamily, + localAuxiliaryFamily_div_eq_auxiliaryFamily] using + (exists_localAuxiliaryFamily_caseI_q_wronskian_bound + u v ((1 - u) / (1 - v)) h k epsilonOrder epsilon q hu hrhoNe + huOrder hrhoOrder hgridRegular hepsilonInjective hepsilonMax hk hepsilonQ) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean new file mode 100644 index 0000000000..93cbffd5b4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean @@ -0,0 +1,542 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +import Mathlib.LinearAlgebra.Matrix.Determinant.Basic + +/-! +# Local auxiliary-family Wronskian estimates + +This file formalizes completion-level parts of the four local cases in the +proof of Corvaja--Zannier's Proposition 2. The functions are Laurent series, +and every order hypothesis is stated explicitly. No assertion is made here +about embeddings of a global function field into its completions or about +summing orders over all places. + +The main new ingredients are: + +* an indexed ordinary-derivative Wronskian, allowing the source's exact index + type `Fin k ⊕ (Fin (k + 1) × Fin h)`; +* the regular-family estimate used in case (ii); +* the explicit lower-unitriangular column matrix used in case (iii), together + with its determinant-one proof; and +* the geometric-series identity which improves the first `k` columns from + `u ^ j * ρ` to `u ^ j * v ^ h * ρ`. + +Source provenance: published pages 1935--1936; checked semantic reconstruction +`Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 636--732. Case (ii) +is lines 689--691, and the case-(iii) column operation is lines 694--719. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators + +open HahnSeries LaurentSeries + +variable {K : Type*} [Field K] + +/-- An ordinary-derivative Wronskian whose rows and columns have an arbitrary +common finite index type. The function `ε` specifies the derivative order of +each row. -/ +def indexedLaurentSeriesWronskian {ι : Type*} [Fintype ι] + (ε : ι → ℕ) (f : ι → LaurentSeries K) : + Matrix ι ι (LaurentSeries K) := + fun i j => ((LaurentSeries.derivative K)^[ε i]) (f j) + +/-- Apply a constant scalar matrix to an indexed Laurent-series family. -/ +def indexedLaurentSeriesColumnCombination {ι : Type*} [Fintype ι] + (f : ι → LaurentSeries K) (A : Matrix ι ι K) : + ι → LaurentSeries K := + fun j => ∑ i, A i j • f i + +private theorem indexed_derivative_iterate_sum_smul {ι : Type*} [Fintype ι] + (r : ℕ) (a : ι → K) (f : ι → LaurentSeries K) : + ((LaurentSeries.derivative K)^[r]) (∑ i, a i • f i) = + ∑ i, a i • ((LaurentSeries.derivative K)^[r]) (f i) := by + induction r with + | zero => simp + | succ r ih => + simp_rw [Function.iterate_succ_apply'] + rw [ih, map_sum] + simp + +/-- Constant column operations commute with the indexed ordinary Wronskian. -/ +theorem indexedLaurentSeriesWronskian_columnCombination + {ι : Type*} [Fintype ι] [DecidableEq ι] + (ε : ι → ℕ) (f : ι → LaurentSeries K) (A : Matrix ι ι K) : + indexedLaurentSeriesWronskian ε + (indexedLaurentSeriesColumnCombination f A) = + indexedLaurentSeriesWronskian ε f * + A.map (algebraMap K (LaurentSeries K)) := by + apply Matrix.ext + intro i j + rw [Matrix.mul_apply] + simp only [indexedLaurentSeriesWronskian, + indexedLaurentSeriesColumnCombination, Matrix.map_apply] + rw [indexed_derivative_iterate_sum_smul] + have halgebraMap (a : K) : + algebraMap K (LaurentSeries K) a = HahnSeries.single 0 a := by + change ((algebraMap K (PowerSeries K) a : PowerSeries K) : + LaurentSeries K) = HahnSeries.single 0 a + rw [← PowerSeries.C_eq_algebraMap, PowerSeries.coe_C] + rfl + have hscalar (a : K) (x : LaurentSeries K) : + a • x = algebraMap K (LaurentSeries K) a * x := by + rw [halgebraMap] + exact HahnSeries.single_zero_mul_eq_smul.symm + simp_rw [hscalar] + apply Finset.sum_congr rfl + intro i _ + exact mul_comm _ _ + +/-- A determinant-one constant column operation preserves an indexed local +Wronskian determinant. -/ +theorem indexedLaurentSeriesWronskian_det_columnCombination_of_det_eq_one + {ι : Type*} [Fintype ι] [DecidableEq ι] + (ε : ι → ℕ) (f : ι → LaurentSeries K) (A : Matrix ι ι K) + (hA : A.det = 1) : + (indexedLaurentSeriesWronskian ε + (indexedLaurentSeriesColumnCombination f A)).det = + (indexedLaurentSeriesWronskian ε f).det := by + rw [indexedLaurentSeriesWronskian_columnCombination, Matrix.det_mul] + have hdetmap : + (A.map (algebraMap K (LaurentSeries K))).det = 1 := by + calc + (A.map (algebraMap K (LaurentSeries K))).det = + algebraMap K (LaurentSeries K) A.det := by + simpa using ((algebraMap K (LaurentSeries K)).map_det A).symm + _ = 1 := by rw [hA, map_one] + rw [hdetmap, mul_one] + +private theorem indexed_addVal_prod {ι : Type*} [DecidableEq ι] + (s : Finset ι) (g : ι → LaurentSeries K) : + HahnSeries.addVal ℤ K (∏ i ∈ s, g i) = + ∑ i ∈ s, HahnSeries.addVal ℤ K (g i) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, AddValuation.map_mul] + +private theorem indexed_coe_sum_int_finset {ι : Type*} [DecidableEq ι] + (s : Finset ι) (g : ι → ℤ) : + (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] + +private theorem indexed_coe_sum_int {ι : Type*} [Fintype ι] (g : ι → ℤ) : + (((∑ i, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i, ((g i : ℤ) : WithTop ℤ) := by + classical + exact indexed_coe_sum_int_finset Finset.univ g + +/-- The indexed ordinary Wronskian has order at least the sum of its column +orders minus the sum of its row derivative orders. -/ +theorem orderTop_indexedLaurentSeriesWronskian_det_lower_bound + {ι : Type*} [Fintype ι] [DecidableEq ι] + (ε : ι → ℕ) (f : ι → LaurentSeries K) : + (((∑ j, (f j).order) - ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε f).det.orderTop := by + rw [Matrix.det_apply] + change (((∑ j, (f j).order) - ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + HahnSeries.addVal ℤ K + (∑ σ, Equiv.Perm.sign σ • + ∏ i, indexedLaurentSeriesWronskian ε f (σ i) i) + apply AddValuation.map_le_sum + intro σ _ + calc + (((∑ j, (f j).order) - ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) = + ∑ j, (((f j).order - (ε (σ j) : ℤ) : ℤ) : WithTop ℤ) := by + rw [← Equiv.sum_comp σ (fun i => (ε i : ℤ))] + rw [← indexed_coe_sum_int] + congr 1 + rw [Finset.sum_sub_distrib] + _ ≤ ∑ j, + ((((LaurentSeries.derivative K)^[ε (σ j)]) (f j)).orderTop) := by + gcongr with j + exact order_sub_le_orderTop_derivative_iterate (ε (σ j)) (f j) + _ = (∏ i, indexedLaurentSeriesWronskian ε f (σ i) i).orderTop := by + rw [← HahnSeries.addVal_apply, indexed_addVal_prod] + simp only [HahnSeries.addVal_apply] + rfl + _ ≤ (Equiv.Perm.sign σ • + ∏ i, indexedLaurentSeriesWronskian ε f (σ i) i).orderTop := by + exact orderTop_le_orderTop_smul _ _ + +/-- Ordinary differentiation preserves Laurent-series integrality. -/ +theorem orderTop_derivative_iterate_nonnegative_of_order_nonnegative + (r : ℕ) (f : LaurentSeries K) (hf : 0 ≤ f.order) : + (0 : WithTop ℤ) ≤ (((LaurentSeries.derivative K)^[r]) f).orderTop := by + rw [le_orderTop_iff_forall] + intro j hj + rw [LaurentSeries.derivative_iterate_coeff] + by_cases hsum : j + (r : ℤ) < 0 + · rw [coeff_eq_zero_of_lt_order (hsum.trans_le hf), smul_zero] + · have hnonneg : 0 ≤ j + (r : ℤ) := le_of_not_gt hsum + obtain ⟨m, hm⟩ := Int.eq_ofNat_of_zero_le hnonneg + have hj' : j < 0 := by exact_mod_cast hj + have hm_lt_int : (m : ℤ) < (r : ℤ) := by omega + have hm_lt : m < r := by exact_mod_cast hm_lt_int + rw [hm, Polynomial.descPochhammer_smeval_eq_descFactorial] + rw [Nat.descFactorial_eq_zero_iff_lt.mpr hm_lt, Nat.cast_zero, zero_smul] + +/-- Case (ii), at the completion level: if every column is regular, then the +ordinary-derivative Wronskian determinant is regular. -/ +theorem orderTop_indexedLaurentSeriesWronskian_det_nonnegative_of_regular + {ι : Type*} [Fintype ι] [DecidableEq ι] + (ε : ι → ℕ) (f : ι → LaurentSeries K) + (hf : ∀ i, 0 ≤ (f i).order) : + (0 : WithTop ℤ) ≤ (indexedLaurentSeriesWronskian ε f).det.orderTop := by + rw [Matrix.det_apply] + change (0 : WithTop ℤ) ≤ HahnSeries.addVal ℤ K + (∑ σ, Equiv.Perm.sign σ • + ∏ i, indexedLaurentSeriesWronskian ε f (σ i) i) + apply AddValuation.map_le_sum + intro σ _ + calc + (0 : WithTop ℤ) = ∑ _i : ι, (0 : WithTop ℤ) := by simp + _ ≤ ∑ i, + (((LaurentSeries.derivative K)^[ε (σ i)]) (f i)).orderTop := by + gcongr with i + exact orderTop_derivative_iterate_nonnegative_of_order_nonnegative + (ε (σ i)) (f i) (hf i) + _ = (∏ i, indexedLaurentSeriesWronskian ε f (σ i) i).orderTop := by + rw [← HahnSeries.addVal_apply, indexed_addVal_prod] + simp only [HahnSeries.addVal_apply] + rfl + _ ≤ (Equiv.Perm.sign σ • + ∏ i, indexedLaurentSeriesWronskian ε f (σ i) i).orderTop := by + exact orderTop_le_orderTop_smul _ _ + +/-- Case (ii) connected to the exact auxiliary family. Outside the support +of `u` and `v`, both have order zero; if the ratio `(1-u)/(1-v)` is regular, +then every auxiliary column is regular and so is its Wronskian determinant. -/ +theorem orderTop_auxiliaryFamily_caseII_nonnegative + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : LaurentSeries K) + (hu0 : u ≠ 0) (hv0 : v ≠ 0) (hu1 : u ≠ 1) (hv1 : v ≠ 1) + (huOrder : u.order = 0) (hvOrder : v.order = 0) + (hratio : 0 ≤ ((1 - u) / (1 - v)).order) : + (0 : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε + (auxiliaryFamily u v h k)).det.orderTop := by + apply orderTop_indexedLaurentSeriesWronskian_det_nonnegative_of_regular + intro i + have hnum : 1 - u ≠ 0 := sub_ne_zero.mpr hu1.symm + have hden : 1 - v ≠ 0 := sub_ne_zero.mpr hv1.symm + have hratio0 : (1 - u) / (1 - v) ≠ 0 := div_ne_zero hnum hden + cases i with + | inl i => + change 0 ≤ (u ^ (i : ℕ) * ((1 - u) / (1 - v))).order + rw [HahnSeries.order_mul (pow_ne_zero _ hu0) hratio0, + HahnSeries.order_pow, huOrder] + simpa using hratio + | inr rs => + change 0 ≤ (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order + rw [HahnSeries.order_mul (pow_ne_zero _ hu0) (pow_ne_zero _ hv0), + HahnSeries.order_pow, HahnSeries.order_pow, huOrder, hvOrder] + simp + +/-- The lower-left block of the case-(iii) column operation. For each first +column `i`, it subtracts every grid column `(i,s)` and adds every grid column +`(i+1,s)`. -/ +def caseIIIGridCorrection (h k : ℕ) : + Matrix (Fin (k + 1) × Fin h) (Fin k) K := + fun rs i => + if rs.1 = i.castSucc then -1 + else if rs.1 = i.succ then 1 + else 0 + +/-- The exact lower-unitriangular constant column matrix used in case (iii). -/ +def caseIIIColumnMatrix (h k : ℕ) : + Matrix (Sum (Fin k) (Fin (k + 1) × Fin h)) + (Sum (Fin k) (Fin (k + 1) × Fin h)) K := + Matrix.fromBlocks 1 0 (caseIIIGridCorrection h k) 1 + +/-- The case-(iii) column matrix has determinant one. -/ +theorem caseIIIColumnMatrix_det (h k : ℕ) : + (caseIIIColumnMatrix (K := K) h k).det = 1 := by + rw [caseIIIColumnMatrix, Matrix.det_fromBlocks_zero₁₂] + simp + +/-- The geometric-series identity behind the case-(iii) column operation. +The hypothesis is the denominator-cleared identity `(1-v)ρ = 1-u`. -/ +theorem caseIII_geometricSeries_column_identity + (u v ρ : LaurentSeries K) (h j : ℕ) + (hρ : (1 - v) * ρ = 1 - u) : + u ^ j * ρ - u ^ j * (1 - u) * (∑ s ∈ Finset.range h, v ^ s) = + u ^ j * v ^ h * ρ := by + rw [← hρ] + calc + u ^ j * ρ - u ^ j * ((1 - v) * ρ) * + (∑ s ∈ Finset.range h, v ^ s) = + u ^ j * ρ - u ^ j * ρ * + ((1 - v) * ∑ s ∈ Finset.range h, v ^ s) := by ring + _ = u ^ j * ρ - u ^ j * ρ * (1 - v ^ h) := by + rw [mul_neg_geom_sum] + _ = u ^ j * v ^ h * ρ := by ring + +/-- The source auxiliary family written with `ρ` as an explicit parameter. +This separates the local column algebra from the later specialization +`ρ = (1-u)/(1-v)`. -/ +def localAuxiliaryFamily (u v ρ : LaurentSeries K) (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) → LaurentSeries K + | Sum.inl i => u ^ (i : ℕ) * ρ + | Sum.inr rs => u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) + +/-- Specializing the explicit ratio parameter recovers the auxiliary family +from `AuxiliaryFamily`. -/ +@[simp] +theorem localAuxiliaryFamily_div_eq_auxiliaryFamily + (u v : LaurentSeries K) (h k : ℕ) : + localAuxiliaryFamily u v ((1 - u) / (1 - v)) h k = + auxiliaryFamily u v h k := by + rfl + +/-- The case-(iii) family after replacing its first `k` columns. -/ +def caseIIIImprovedAuxiliaryFamily (u v ρ : LaurentSeries K) (h k : ℕ) : + Sum (Fin k) (Fin (k + 1) × Fin h) → LaurentSeries K + | Sum.inl i => u ^ (i : ℕ) * v ^ h * ρ + | Sum.inr rs => u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) + +private theorem caseIIIGridCorrection_sum_smul + (u v : LaurentSeries K) (h k : ℕ) (i : Fin k) : + (∑ rs : Fin (k + 1) × Fin h, + caseIIIGridCorrection (K := K) h k rs i • + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) = + -(u ^ (i : ℕ) * ∑ s : Fin h, v ^ (s : ℕ)) + + u ^ (i.succ : ℕ) * ∑ s : Fin h, v ^ (s : ℕ) := by + rw [Fintype.sum_prod_type_right] + rw [Finset.mul_sum, Finset.mul_sum, ← Finset.sum_neg_distrib, + ← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro s _ + have hne : i.castSucc ≠ i.succ := i.castSucc_lt_succ.ne + simp only [caseIIIGridCorrection] + calc + (∑ r : Fin (k + 1), + (if r = i.castSucc then (-1 : K) + else if r = i.succ then 1 else 0) • + (u ^ (r : ℕ) * v ^ (s : ℕ))) = + (∑ r : Fin (k + 1), + if r = i.castSucc then -(u ^ (r : ℕ) * v ^ (s : ℕ)) else 0) + + ∑ r : Fin (k + 1), + if r = i.succ then u ^ (r : ℕ) * v ^ (s : ℕ) else 0 := by + rw [← Finset.sum_add_distrib] + apply Finset.sum_congr rfl + intro r _ + by_cases hr0 : r = i.castSucc + · simp [hr0, hne] + · by_cases hr1 : r = i.succ + · simp [hr1, hne.symm] + · simp [hr0, hr1] + _ = -(u ^ (i : ℕ) * v ^ (s : ℕ)) + + u ^ (i.succ : ℕ) * v ^ (s : ℕ) := by + rw [Fintype.sum_ite_eq', Fintype.sum_ite_eq'] + simp + +/-- The explicit determinant-one matrix performs exactly the column +replacement from case (iii). -/ +theorem indexedColumnCombination_caseIIIColumnMatrix + (u v ρ : LaurentSeries K) (h k : ℕ) + (hρ : (1 - v) * ρ = 1 - u) : + indexedLaurentSeriesColumnCombination (localAuxiliaryFamily u v ρ h k) + (caseIIIColumnMatrix (K := K) h k) = + caseIIIImprovedAuxiliaryFamily u v ρ h k := by + classical + funext j + cases j with + | inl i => + rw [indexedLaurentSeriesColumnCombination, Fintype.sum_sum_type] + simp only [caseIIIColumnMatrix, Matrix.fromBlocks_apply₁₁, + Matrix.fromBlocks_apply₂₁, localAuxiliaryFamily, + caseIIIImprovedAuxiliaryFamily] + have hleft : + (∑ x : Fin k, (1 : Matrix (Fin k) (Fin k) K) x i • + (u ^ (x : ℕ) * ρ)) = u ^ (i : ℕ) * ρ := by + simp [Matrix.one_apply] + rw [hleft] + rw [caseIIIGridCorrection_sum_smul] + rw [Fin.sum_univ_eq_sum_range] + simp only [Fin.val_succ, pow_succ] + convert caseIII_geometricSeries_column_identity u v ρ h (i : ℕ) hρ using 1; + ring + | inr rs => + rw [indexedLaurentSeriesColumnCombination, Fintype.sum_sum_type] + simp [caseIIIColumnMatrix, localAuxiliaryFamily, + caseIIIImprovedAuxiliaryFamily, Matrix.one_apply] + +/-- Case (iii), completion-level determinant identity: the Wronskian is +unchanged after replacing `u^j ρ` by `u^j v^h ρ` in its first `k` columns. -/ +theorem indexedWronskian_det_caseIII_columnReplacement + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v ρ : LaurentSeries K) + (hρ : (1 - v) * ρ = 1 - u) : + (indexedLaurentSeriesWronskian ε + (caseIIIImprovedAuxiliaryFamily u v ρ h k)).det = + (indexedLaurentSeriesWronskian ε + (localAuxiliaryFamily u v ρ h k)).det := by + rw [← indexedColumnCombination_caseIIIColumnMatrix u v ρ h k hρ] + exact indexedLaurentSeriesWronskian_det_columnCombination_of_det_eq_one + ε (localAuxiliaryFamily u v ρ h k) (caseIIIColumnMatrix h k) + (caseIIIColumnMatrix_det h k) + +/-- Case (iii), completion-level order estimate after the exact source column +replacement. The right side retains the column orders explicitly; evaluating +those orders from `ν(u)`, `ν(v)`, and `ν(ρ)` is a separate elementary step. -/ +theorem orderTop_indexedWronskian_det_caseIII_lower_bound + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v ρ : LaurentSeries K) + (hρ : (1 - v) * ρ = 1 - u) : + (((∑ j, (caseIIIImprovedAuxiliaryFamily u v ρ h k j).order) - + ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε + (localAuxiliaryFamily u v ρ h k)).det.orderTop := by + rw [← indexedWronskian_det_caseIII_columnReplacement h k ε u v ρ hρ] + exact orderTop_indexedLaurentSeriesWronskian_det_lower_bound ε + (caseIIIImprovedAuxiliaryFamily u v ρ h k) + +private theorem order_caseIIIImprovedAuxiliaryFamily_inl + (u v ρ : LaurentSeries K) (h k : ℕ) (i : Fin k) + (hu : u ≠ 0) (hv : v ≠ 0) (hρ0 : ρ ≠ 0) : + (caseIIIImprovedAuxiliaryFamily u v ρ h k (Sum.inl i)).order = + (i : ℕ) • u.order + h • v.order + ρ.order := by + simp only [caseIIIImprovedAuxiliaryFamily] + rw [HahnSeries.order_mul + (mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv)) hρ0, + HahnSeries.order_mul (pow_ne_zero _ hu) (pow_ne_zero _ hv), + HahnSeries.order_pow, HahnSeries.order_pow] + +private theorem order_localAuxiliaryFamily_inl + (u v ρ : LaurentSeries K) (h k : ℕ) (i : Fin k) + (hu : u ≠ 0) (hρ0 : ρ ≠ 0) : + (localAuxiliaryFamily u v ρ h k (Sum.inl i)).order = + (i : ℕ) • u.order + ρ.order := by + simp only [localAuxiliaryFamily] + rw [HahnSeries.order_mul (pow_ne_zero _ hu) hρ0, + HahnSeries.order_pow] + +private theorem sum_fin_cast_int (k : ℕ) : + (∑ i : Fin k, (i : ℤ)) = (k * (k - 1) / 2 : ℕ) := by + rw [Fin.sum_univ_eq_sum_range, ← Nat.cast_sum, Finset.sum_range_id] + +private theorem sum_caseIIIImprovedAuxiliaryFamily_inl_orders + (u v ρ : LaurentSeries K) (h k : ℕ) + (hu : u ≠ 0) (hv : v ≠ 0) (hρ0 : ρ ≠ 0) : + (∑ i : Fin k, + (caseIIIImprovedAuxiliaryFamily u v ρ h k (Sum.inl i)).order) = + (k * (k - 1) / 2 : ℕ) • u.order + + (h * k) • v.order + k • ρ.order := by + simp_rw [order_caseIIIImprovedAuxiliaryFamily_inl u v ρ h k _ hu hv hρ0] + simp only [Finset.sum_add_distrib, Finset.sum_const, + Finset.card_univ, Fintype.card_fin] + simp_rw [nsmul_eq_mul] + rw [← Finset.sum_mul] + rw [sum_fin_cast_int] + simp only [Nat.cast_mul] + ring + +private theorem sum_localAuxiliaryFamily_inl_orders + (u v ρ : LaurentSeries K) (h k : ℕ) + (hu : u ≠ 0) (hρ0 : ρ ≠ 0) : + (∑ i : Fin k, + (localAuxiliaryFamily u v ρ h k (Sum.inl i)).order) = + (k * (k - 1) / 2 : ℕ) • u.order + k • ρ.order := by + simp_rw [order_localAuxiliaryFamily_inl u v ρ h k _ hu hρ0] + simp only [Finset.sum_add_distrib, Finset.sum_const, Finset.card_univ, + Fintype.card_fin] + simp_rw [nsmul_eq_mul] + rw [← Finset.sum_mul, sum_fin_cast_int] + +/-- Case (iii) in the displayed source form. The grid-column contribution is +left as the exact sum appearing in the paper; it is the part that cancels by +the global product formula after summing over places. -/ +theorem orderTop_indexedWronskian_det_caseIII_source_lower_bound + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v ρ : LaurentSeries K) + (hρ : (1 - v) * ρ = 1 - u) + (hu : u ≠ 0) (hv : v ≠ 0) (hρ0 : ρ ≠ 0) : + (((k * (k - 1) / 2 : ℕ) • u.order + + (h * k) • v.order + k • ρ.order + + ∑ rs : Fin (k + 1) × Fin h, + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order - + ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε + (localAuxiliaryFamily u v ρ h k)).det.orderTop := by + have hbound := orderTop_indexedWronskian_det_caseIII_lower_bound + h k ε u v ρ hρ + rw [Fintype.sum_sum_type] at hbound + rw [sum_caseIIIImprovedAuxiliaryFamily_inl_orders u v ρ h k hu hv hρ0] + at hbound + exact hbound + +/-- Case (iv), completion-level displayed source estimate: no column operation +is made, so the first `k` columns contribute the triangular `u` term and the +`kρ` term directly. -/ +theorem orderTop_indexedWronskian_det_caseIV_source_lower_bound + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v ρ : LaurentSeries K) (hu : u ≠ 0) (hρ0 : ρ ≠ 0) : + (((k * (k - 1) / 2 : ℕ) • u.order + k • ρ.order + + ∑ rs : Fin (k + 1) × Fin h, + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order - + ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε + (localAuxiliaryFamily u v ρ h k)).det.orderTop := by + have hbound := orderTop_indexedLaurentSeriesWronskian_det_lower_bound ε + (localAuxiliaryFamily u v ρ h k) + rw [Fintype.sum_sum_type] at hbound + rw [sum_localAuxiliaryFamily_inl_orders u v ρ h k hu hρ0] at hbound + exact hbound + +/-- Case (iii) connected to the exact auxiliary family defined earlier in the +formalization. The hypotheses `u ≠ 1` and `v ≠ 1` ensure that the ratio column +is nonzero and that clearing its denominator is sound. -/ +theorem orderTop_auxiliaryFamily_caseIII_source_lower_bound + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : LaurentSeries K) + (hu0 : u ≠ 0) (hv0 : v ≠ 0) (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • u.order + + (h * k) • v.order + + k • ((1 - u) / (1 - v)).order + + ∑ rs : Fin (k + 1) × Fin h, + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order - + ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε + (auxiliaryFamily u v h k)).det.orderTop := by + have hden : 1 - v ≠ 0 := sub_ne_zero.mpr hv1.symm + have hnum : 1 - u ≠ 0 := sub_ne_zero.mpr hu1.symm + have hratio : (1 - u) / (1 - v) ≠ 0 := div_ne_zero hnum hden + have hclear : (1 - v) * ((1 - u) / (1 - v)) = 1 - u := by + field_simp + simpa only [localAuxiliaryFamily_div_eq_auxiliaryFamily] using + orderTop_indexedWronskian_det_caseIII_source_lower_bound + h k ε u v ((1 - u) / (1 - v)) hclear hu0 hv0 hratio + +/-- Case (iv) connected to the exact auxiliary family. -/ +theorem orderTop_auxiliaryFamily_caseIV_source_lower_bound + (h k : ℕ) (ε : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : LaurentSeries K) (hu0 : u ≠ 0) (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • u.order + + k • ((1 - u) / (1 - v)).order + + ∑ rs : Fin (k + 1) × Fin h, + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)).order - + ∑ i, (ε i : ℤ) : ℤ) : WithTop ℤ) ≤ + (indexedLaurentSeriesWronskian ε + (auxiliaryFamily u v h k)).det.orderTop := by + have hden : 1 - v ≠ 0 := sub_ne_zero.mpr hv1.symm + have hnum : 1 - u ≠ 0 := sub_ne_zero.mpr hu1.symm + have hratio : (1 - u) / (1 - v) ≠ 0 := div_ne_zero hnum hden + simpa only [localAuxiliaryFamily_div_eq_auxiliaryFamily] using + orderTop_indexedWronskian_det_caseIV_source_lower_bound + h k ε u v ((1 - u) / (1 - v)) hu0 hratio + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean new file mode 100644 index 0000000000..e30667b042 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean @@ -0,0 +1,51 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.LaurentSeries + +/-! +# Local derivative estimates for Corvaja--Zannier + +The local Wronskian argument is carried out after expanding a rational +function in a Laurent series at a point of the curve. This file proves the +completion-level estimate that an `r`-th derivative lowers the Laurent-series +order by at most `r`. + +The statements use `HahnSeries.orderTop`, rather than `HahnSeries.order`, so +that they remain valid when the derivative vanishes. +-/ + +namespace BGS.CorvajaZannier + +open HahnSeries LaurentSeries + +variable {K : Type*} [Ring K] + +/-- The `r`-th Hasse derivative lowers Laurent-series order by at most `r`. + +The `orderTop` formulation also covers the case in which the Hasse derivative +is zero. -/ +theorem order_sub_le_orderTop_hasseDeriv (r : ℕ) (f : LaurentSeries K) : + ((f.order - (r : ℤ) : ℤ) : WithTop ℤ) ≤ (hasseDeriv K r f).orderTop := by + rw [le_orderTop_iff_forall] + intro j hj + have hj' : j < f.order - (r : ℤ) := by + exact_mod_cast hj + have hjr : j + (r : ℤ) < f.order := (lt_sub_iff_add_lt).mp hj' + rw [hasseDeriv_coeff, coeff_eq_zero_of_lt_order hjr, smul_zero] + +/-- Every ordinary iterated derivative lowers Laurent-series order by at most +its iteration count. + +The `orderTop` formulation also covers the case in which the iterated +derivative is zero. -/ +theorem order_sub_le_orderTop_derivative_iterate (r : ℕ) (f : LaurentSeries K) : + ((f.order - (r : ℤ) : ℤ) : WithTop ℤ) ≤ (((derivative K)^[r]) f).orderTop := by + rw [derivative_iterate] + refine (order_sub_le_orderTop_hasseDeriv r f).trans ?_ + exact orderTop_le_orderTop_smul _ _ + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean new file mode 100644 index 0000000000..e0bfc61091 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean @@ -0,0 +1,373 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.LocalRing.Etale +import Mathlib.RingTheory.RingHom.Etale +import Mathlib.RingTheory.Ideal.Height + +/-! +# Monogenicity from étale height-one quotients + +If `R` and `S` are local integral domains with `S` a finite extension of `R`, `R` integrally +closed, `S` a UFD, and there exists a height-one prime `q ⊆ S` such that `R/(q ∩ R) → S/q` is +étale, then `S ≅ R[X]/(f)` for some monic `f`. This formalizes Lemma 3.1 of +[arXiv:2503.07846](https://arxiv.org/abs/2503.07846). + +## Main results + +* `Monogenic.exists_isAdjoinRootMonic_of_quotientMap_etale`: the main theorem (Lemma 3.1). + +## Auxiliary lemmas + +* `Ideal.exists_span_singleton_eq_of_prime_of_height_one`: in a UFD, a height-one prime ideal + is principal. +* `Monogenic.exists_aeval_add_eq`: Taylor expansion `f(x + h) = f(x) + f'(x)·h + h²·c`. +* `Monogenic.maximalIdeal_eq_sup_of_etale_quotient`: when `R/p → S/q` is étale, + `m_S = q + m_R·S`. +* `Monogenic.exists_isAdjoinRootMonic_of_principal_adjust`: adjusting a generator by adding + a generator of `q` via Taylor expansion when `f₁(B) = q₀ · a` with `a ∈ m_S`. + +## References + +* [Balçik et al., *Monogenic generators for étale extensions of local rings*](https://arxiv.org/abs/2503.07846) + +## Tags + +étale, monogenic, local ring, height one, UFD +-/ + +open Polynomial Function RingHom IsLocalRing + +namespace BGS.CorvajaZannier.LocalMonogenic + +variable {R S : Type*} [CommRing R] [CommRing S] [IsLocalRing R] [IsLocalRing S] + +section SubLemmas + +omit [IsLocalRing R] [IsLocalRing S] in +/- Can be placed in `Height.lean` with no additional imports. -/ +/-- In a UFD, a height one prime ideal is principal. -/ +lemma Ideal.exists_span_singleton_eq_of_prime_of_height_one {S : Type*} [CommRing S] [IsDomain S] + [UniqueFactorizationMonoid S] + (q : Ideal S) [hq_prime : q.IsPrime] (hq_height : q.height = 1) : + ∃ q₀ : S, q = Ideal.span {q₀} := by + have hq_ne_bot : q ≠ ⊥ := by rintro rfl; simp at hq_height + obtain ⟨p, hp_mem, hp_prime⟩ := hq_prime.exists_mem_prime_of_ne_bot hq_ne_bot + exact ⟨p, q.eq_span_singleton_of_height_eq_one hq_height hp_mem hp_prime⟩ + +/- Can be placed in `Taylor.lean` with no additional imports. -/ +/-- Taylor expansion: for any polynomial `f` and elements `x`, `h`, +there exists `c` such that `f(x + h) = f(x) + f'(x) · h + h² · c`. +Proved by lifting `Polynomial.aeval_add_of_sq_eq_zero` from `S ⧸ ⟨h²⟩`. -/ +lemma exists_aeval_add_eq {R S : Type*} [CommRing R] [CommRing S] [Algebra R S] + (f : R[X]) (x h : S) : + ∃ c : S, f.aeval (x + h) = f.aeval x + f.derivative.aeval x * h + h ^ 2 * c := by + set π := Ideal.Quotient.mkₐ R (Ideal.span ({h ^ 2} : Set S)) + have hsq : (π h) ^ 2 = 0 := by + rw [← map_pow]; exact Ideal.Quotient.eq_zero_iff_mem.mpr (Ideal.subset_span rfl) + have key : π (f.aeval (x + h) - (f.aeval x + f.derivative.aeval x * h)) = 0 := by + simp only [map_sub, map_add, map_mul, ← Polynomial.aeval_algHom_apply] + exact sub_eq_zero.mpr (Polynomial.aeval_add_of_sq_eq_zero f _ _ hsq) + obtain ⟨c, hc⟩ := Ideal.mem_span_singleton.mp (Ideal.Quotient.eq_zero_iff_mem.mp key) + exact ⟨c, by linear_combination hc⟩ + +/-- When the quotient map `R/p → S/q` is étale and both rings are local, +the maximal ideal of `S` decomposes as `m_S = q + m_R·S`. -/ +lemma maximalIdeal_eq_sup_of_etale_quotient + [Algebra R S] [Module.Finite R S] + (q : Ideal S) [hq_prime : q.IsPrime] + (hétale : (Ideal.quotientMap q (algebraMap R S) le_rfl).Etale) : + IsLocalRing.maximalIdeal S = + q ⊔ Ideal.map (algebraMap R S) (IsLocalRing.maximalIdeal R) := by + set p := q.comap (algebraMap R S) + set φ₀ : R ⧸ p →+* S ⧸ q := Ideal.quotientMap q (algebraMap R S) le_rfl + letI : Algebra (R ⧸ p) (S ⧸ q) := φ₀.toAlgebra + have hφ₀_eq : algebraMap (R ⧸ p) (S ⧸ q) = φ₀ := RingHom.algebraMap_toAlgebra φ₀ + haveI hp : p.IsPrime := Ideal.IsPrime.comap (algebraMap R S) + haveI : IsLocalRing (R ⧸ p) := .of_surjective' _ Ideal.Quotient.mk_surjective + haveI : IsLocalRing (S ⧸ q) := .of_surjective' _ Ideal.Quotient.mk_surjective + haveI : Algebra.FormallyUnramified (R ⧸ p) (S ⧸ q) := by + have := ((RingHom.etale_iff_formallyUnramified_and_smooth φ₀).mp hétale).1 + rwa [← hφ₀_eq] at this + haveI : IsScalarTower R (R ⧸ p) (S ⧸ q) := .of_algebraMap_eq' rfl + haveI : Module.Finite (R ⧸ p) (S ⧸ q) := Module.Finite.of_restrictScalars_finite R _ _ + haveI : IsLocalHom (algebraMap (R ⧸ p) (S ⧸ q)) := by + rw [hφ₀_eq]; exact RingHom.IsIntegral.isLocalHom (.of_finite + (RingHom.finite_algebraMap.mpr ‹_›)) Ideal.quotientMap_injective + have mk_max_R : (IsLocalRing.maximalIdeal R).map (Ideal.Quotient.mk p) = + IsLocalRing.maximalIdeal (R ⧸ p) := by + haveI := IsLocalHom.of_surjective (Ideal.Quotient.mk p) Ideal.Quotient.mk_surjective + ext x; obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective x + simp [sup_eq_left.mpr (IsLocalRing.le_maximalIdeal hp.ne_top)] + have mk_max_S : (IsLocalRing.maximalIdeal S).map (Ideal.Quotient.mk q) = + IsLocalRing.maximalIdeal (S ⧸ q) := by + haveI := IsLocalHom.of_surjective (Ideal.Quotient.mk q) Ideal.Quotient.mk_surjective + ext x; obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective x + simp [sup_eq_left.mpr (IsLocalRing.le_maximalIdeal hq_prime.ne_top)] + have key : (IsLocalRing.maximalIdeal S).map (Ideal.Quotient.mk q) = + (Ideal.map (algebraMap R S) (IsLocalRing.maximalIdeal R)).map (Ideal.Quotient.mk q) := by + rw [mk_max_S, ← (by rw [← hφ₀_eq]; exact Algebra.FormallyUnramified.map_maximalIdeal : + Ideal.map φ₀ (IsLocalRing.maximalIdeal (R ⧸ p)) = IsLocalRing.maximalIdeal (S ⧸ q)), + ← mk_max_R, Ideal.map_map, Ideal.map_map]; congr 1 + rwa [Ideal.map_eq_iff_sup_ker_eq_of_surjective _ Ideal.Quotient.mk_surjective, + Ideal.mk_ker, sup_eq_left.mpr (IsLocalRing.le_maximalIdeal hq_prime.ne_top), + sup_comm] at key + +lemma cofactor_mem_maximalIdeal_of_not_generator + [Algebra R S] + (f₁_B : S) (q : Ideal S) [hq_prime : q.IsPrime] + (h_f₁B_in_q : f₁_B ∈ q) + (h_gen : ¬ (f₁_B ∈ IsLocalRing.maximalIdeal S ∧ Ideal.span {f₁_B} ⊔ Ideal.map (algebraMap R S) + (IsLocalRing.maximalIdeal R) • ⊤ = IsLocalRing.maximalIdeal S)) + (q₀ : S) (hq₀ : q = Ideal.span {q₀}) + (a : S) (ha : f₁_B = q₀ * a) + (h_ms_eq : IsLocalRing.maximalIdeal S = + q ⊔ Ideal.map (algebraMap R S) (IsLocalRing.maximalIdeal R)) : + a ∈ IsLocalRing.maximalIdeal S := by + by_contra ha_not_in_ms + exact h_gen ⟨IsLocalRing.le_maximalIdeal hq_prime.ne_top h_f₁B_in_q, by + rw [show Ideal.span {f₁_B} = q from by + rw [ha, hq₀] + exact Ideal.span_singleton_mul_right_unit + (IsLocalRing.notMem_maximalIdeal.mp ha_not_in_ms) q₀] + rw [h_ms_eq, Ideal.smul_eq_mul, Ideal.mul_top]⟩ + +-- private lemma? +omit [IsLocalRing R] [IsLocalRing S] in +lemma Ideal.quotient_adjust (q : Ideal S) (q₀ : S) (hq₀ : q = Ideal.span {q₀}) (B : S) : + Ideal.Quotient.mk q (B + q₀) = Ideal.Quotient.mk q B := + Ideal.Quotient.eq.mpr <| by + simp only [add_sub_cancel_left] + exact hq₀ ▸ Ideal.mem_span_singleton_self q₀ + +omit [IsLocalRing R] [IsLocalRing S] in +lemma Ideal.quotient_comp_map [Algebra R S] (q : Ideal S) : (Ideal.Quotient.mk q).comp + (algebraMap R S) = (Ideal.quotientMap q (algebraMap R S) (le_refl (q.comap + (algebraMap R S)))).comp (Ideal.Quotient.mk (q.comap (algebraMap R S))) := by + ext r; exact (Ideal.quotientMap_mk (I := q) (f := algebraMap R S) (H := le_rfl)).symm + +omit [IsLocalRing R] [IsLocalRing S] in +/-- If `I = ⟨π⟩ + J`, then `I ^ k ≤ ⟨π ^ k⟩ + J`. -/ +lemma Ideal.pow_le_span_pow_sup {I J : Ideal S} {π : S} + (h : I = Ideal.span {π} ⊔ J) (k : ℕ) : + I ^ k ≤ Ideal.span {π ^ k} ⊔ J := by + induction k with + | zero => simp [Ideal.span_singleton_one] + | succ k ih => + rw [pow_succ] + refine (Ideal.mul_mono ih h.le).trans ?_ + rw [Ideal.sup_mul, Ideal.mul_sup, Ideal.mul_sup] + refine sup_le (sup_le ?_ (Ideal.mul_le_left.trans le_sup_right)) + (sup_le (Ideal.mul_le_right.trans le_sup_right) + (Ideal.mul_le_left.trans le_sup_right)) + rw [Ideal.span_singleton_mul_span_singleton, pow_succ] + exact le_sup_left + +omit [IsLocalRing R] [IsLocalRing S] in +/-- If the residue of `β` generates `S / q`, every element of `S` is congruent modulo `q` +to an element of `R[β]`. -/ +lemma exists_adjoin_sub_mem [Algebra R S] + (β : S) (q : Ideal S) + (h_gen : Algebra.adjoin (R ⧸ q.comap (algebraMap R S)) + {Ideal.Quotient.mk q β} = ⊤) (s : S) : + ∃ t ∈ Algebra.adjoin R {β}, s - t ∈ q := by + rw [Algebra.adjoin_singleton_eq_range_aeval, AlgHom.range_eq_top] at h_gen + obtain ⟨p, hp⟩ := h_gen (Ideal.Quotient.mk q s) + obtain ⟨r, rfl⟩ := Polynomial.map_surjective _ Ideal.Quotient.mk_surjective p + refine ⟨aeval β r, ?_, Ideal.Quotient.eq.mp ?_⟩ + · rw [Algebra.adjoin_singleton_eq_range_aeval] + exact ⟨r, rfl⟩ + · rw [map_aeval_eq_aeval_map (ψ := Ideal.Quotient.mk q) + (φ := Ideal.Quotient.mk (q.comap (algebraMap R S))) + (by ext; exact (Ideal.quotientMap_mk (I := q) (f := algebraMap R S) + (H := le_rfl)).symm), hp] + +omit [IsLocalRing R] [IsLocalRing S] in +/-- Iteratively approximate elements by `A` modulo `⟨π ^ k⟩ + m_R S`. -/ +lemma exists_sub_mem_adjoin_of_pow [Algebra R S] + {A : Subalgebra R S} {q ms mR_S : Ideal S} {π : S} + (h_lift : ∀ s : S, ∃ t ∈ A, s - t ∈ q) + (hπ_mem : π ∈ A) (hπ_ms : π ∈ ms) (hq_le : q ≤ ms) + (h_ms : ms = Ideal.span {π} ⊔ mR_S) + (k : ℕ) (x : S) : + ∃ a ∈ A.toSubmodule, x - a ∈ (Ideal.span {π ^ k} ⊔ mR_S : Ideal S) := by + induction k with + | zero => exact ⟨0, Subalgebra.zero_mem A, by simp [Ideal.span_singleton_one]⟩ + | succ k ih => + obtain ⟨a₀, ha₀, hz⟩ := ih + obtain ⟨y, hy, r, hr, hyr⟩ := Submodule.mem_sup.mp hz + obtain ⟨c, rfl⟩ := Ideal.mem_span_singleton.mp hy + obtain ⟨a₁, ha₁, hc⟩ := h_lift c + refine ⟨a₀ + a₁ * π ^ k, Subalgebra.add_mem A ha₀ + (Subalgebra.mul_mem A ha₁ (Subalgebra.pow_mem A hπ_mem k)), ?_⟩ + rw [show x - (a₀ + a₁ * π ^ k) = π ^ k * (c - a₁) + r + by linear_combination hyr.symm] + exact Ideal.add_mem _ + (Ideal.pow_le_span_pow_sup h_ms (k + 1) <| by + rw [pow_succ] + exact Ideal.mul_mem_mul (Ideal.pow_mem_pow hπ_ms k) (hq_le hc)) + (Ideal.mem_sup_right hr) + +omit [IsLocalRing R] [IsLocalRing S] in +/-- Lift a monogenic quotient across a height-one direction whose generator lies in the +adjoined algebra. The Artinian descent supplies the finite approximation needed by Nakayama. -/ +lemma adjoin_eq_top_of_quotient [Algebra R S] [IsLocalRing R] [IsLocalRing S] + [Module.Finite R S] + (β : S) (q : Ideal S) [q.IsPrime] + (h_gen : Algebra.adjoin (R ⧸ q.comap (algebraMap R S)) + {Ideal.Quotient.mk q β} = ⊤) + (π : S) (hπ_mem : π ∈ Algebra.adjoin R {β}) + (h_ms : IsLocalRing.maximalIdeal S = + Ideal.span {π} ⊔ Ideal.map (algebraMap R S) (IsLocalRing.maximalIdeal R)) : + Algebra.adjoin R {β} = ⊤ := by + set A := Algebra.adjoin R {β} + set mR := IsLocalRing.maximalIdeal R + set mS := IsLocalRing.maximalIdeal S + set mR_S := Ideal.map (algebraMap R S) mR + haveI : IsArtinianRing (S ⧸ mR_S) := by + letI := Ideal.Quotient.field mR + haveI := Module.Finite.of_restrictScalars_finite R (R ⧸ mR) (S ⧸ mR_S) + exact IsArtinianRing.of_finite (R ⧸ mR) (S ⧸ mR_S) + obtain ⟨n, hn⟩ := IsLocalRing.exists_maximalIdeal_pow_le_of_isArtinianRing_quotient mR_S + have h_lift := exists_adjoin_sub_mem β q h_gen + have hπ_ms : π ∈ mS := h_ms ▸ Ideal.mem_sup_left (Ideal.mem_span_singleton_self π) + have hq_le : q ≤ mS := IsLocalRing.le_maximalIdeal (Ideal.IsPrime.ne_top inferInstance) + have h_q : (q.restrictScalars R : Submodule R S) ≤ A.toSubmodule ⊔ mR • ⊤ := by + intro x hx + obtain ⟨a, ha, hxa⟩ := + exists_sub_mem_adjoin_of_pow h_lift hπ_mem hπ_ms hq_le h_ms n x + rw [Ideal.smul_top_eq_map] + exact Submodule.mem_sup.mpr ⟨a, ha, x - a, + show x - a ∈ mR_S.restrictScalars R from + (sup_le (Ideal.span_le.mpr (Set.singleton_subset_iff.mpr + (hn (Ideal.pow_mem_pow hπ_ms n)))) le_rfl) hxa, + by ring⟩ + refine eq_top_iff.mpr (Submodule.le_of_le_smul_of_le_jacobson_bot + (Module.finite_def.mp inferInstance) (IsLocalRing.maximalIdeal_le_jacobson ⊥) + (?_ : ⊤ ≤ A.toSubmodule ⊔ mR • ⊤)) + intro s _ + obtain ⟨t, ht, hst⟩ := h_lift s + rw [show s = t + (s - t) by ring] + exact Submodule.add_mem _ (Submodule.mem_sup_left ht) (h_q hst) + + +end SubLemmas + + +/-- When `q` is principal, `f₁(B) = q₀ · a` with `a ∈ m_S`, and `f₁'(B) ∉ m_S`, +adjusting `B` to `B + q₀` yields a monogenic extension via Taylor expansion. -/ +lemma exists_isAdjoinRootMonic_of_principal_adjust + [IsDomain R] [IsDomain S] [IsIntegrallyClosed R] [Algebra R S] + [FaithfulSMul R S] [Module.Finite R S] + (q : Ideal S) [hq_prime : q.IsPrime] + (q₀ : S) (hq₀ : q = Ideal.span {q₀}) + (B : S) (f₁ : R[X]) + (a : S) (ha : Polynomial.aeval B f₁ = q₀ * a) + (ha_mem : a ∈ IsLocalRing.maximalIdeal S) + (h_deriv_not_in_ms : f₁.derivative.aeval B ∉ IsLocalRing.maximalIdeal S) + (h_ms_eq : IsLocalRing.maximalIdeal S = + q ⊔ Ideal.map (algebraMap R S) (IsLocalRing.maximalIdeal R)) + (h_adj : Algebra.adjoin (R ⧸ q.comap (algebraMap R S)) + {Ideal.Quotient.mk q B} = ⊤) : + ∃ f : R[X], Nonempty (IsAdjoinRootMonic S f) := by + set ms := IsLocalRing.maximalIdeal S + set B' := B + q₀ + have hq_le_ms : q ≤ ms := IsLocalRing.le_maximalIdeal hq_prime.ne_top + obtain ⟨b, hb⟩ : ∃ b : S, Polynomial.aeval B' f₁ = + q₀ * (a + f₁.derivative.aeval B + q₀ * b) := by + obtain ⟨c, hc⟩ := exists_aeval_add_eq f₁ B q₀ + exact ⟨c, by rw [hc, show (aeval B) f₁ = q₀ * a from ha]; ring⟩ + have h_cofactor_unit : IsUnit (a + f₁.derivative.aeval B + q₀ * b) := by + rw [show a + f₁.derivative.aeval B + q₀ * b = + f₁.derivative.aeval B + (a + q₀ * b) by ring, ← IsLocalRing.notMem_maximalIdeal] + refine fun h => h_deriv_not_in_ms ?_ + have : a + q₀ * b ∈ ms := + Ideal.add_mem ms ha_mem + (mul_comm q₀ b ▸ + Ideal.mul_mem_left ms b (hq_le_ms (hq₀ ▸ Ideal.mem_span_singleton_self q₀))) + convert Ideal.sub_mem ms h this using 1; ring + have h_span_eq : Ideal.span {Polynomial.aeval B' f₁} = q := by + rw [hb, hq₀]; exact Ideal.span_singleton_mul_right_unit h_cofactor_unit q₀ + exact ⟨minpoly R B', ⟨IsAdjoinRootMonic.mkOfAdjoinEqTop + (Algebra.IsIntegral.isIntegral (R := R) B') + (adjoin_eq_top_of_quotient B' q + (by rw [Ideal.quotient_adjust q q₀ hq₀ B]; exact h_adj) + (Polynomial.aeval B' f₁) + (by rw [Algebra.adjoin_singleton_eq_range_aeval]; exact ⟨f₁, rfl⟩) + (by rw [h_span_eq]; exact h_ms_eq))⟩⟩ + + +/-- **Lemma 3.1** of [arXiv:2503.07846](https://arxiv.org/abs/2503.07846). +If `R` and `S` are local integral domains with `R` integrally closed, +`S` a UFD, and `R → S` finite and injective, and there exists a +height-one prime `q ⊆ S` such that `R/(q ∩ R) → S/q` is étale, then +there exists a monic `f` with `S ≅ R[X]/(f)`. -/ +theorem exists_isAdjoinRootMonic_of_quotientMap_etale + [IsDomain R] [IsDomain S] [IsIntegrallyClosed R] [UniqueFactorizationMonoid S] [Algebra R S] + [FaithfulSMul R S] [Module.Finite R S] + (q : Ideal S) + [hq_prime : q.IsPrime] (hq_height : q.height = 1) + (hétale : (Ideal.quotientMap q (algebraMap R S) le_rfl).Etale) : + ∃ f : R[X], Nonempty (IsAdjoinRootMonic S f) := by + by_cases hφ_etale : Algebra.Etale R S + · obtain ⟨β, adj⟩ := exists_adjoin_eq_top (R := R) (S := S) + haveI : Module.Free R S := Module.free_of_flat_of_isLocalRing + exact ⟨minpoly R β, ⟨IsAdjoinRootMonic.mkOfAdjoinEqTop' adj⟩⟩ + set p := q.comap (algebraMap R S) + set φ₀ := Ideal.quotientMap q (algebraMap R S) (le_refl p) + haveI : IsLocalRing (R ⧸ p) := .of_surjective' _ Ideal.Quotient.mk_surjective + haveI : IsLocalRing (S ⧸ q) := .of_surjective' _ Ideal.Quotient.mk_surjective + haveI : Module.Finite (R ⧸ p) (S ⧸ q) := Module.Finite.of_restrictScalars_finite R _ _ + haveI : Algebra.Etale (R ⧸ p) (S ⧸ q) := RingHom.etale_algebraMap.mp hétale + obtain ⟨B₀, adj⟩ := exists_adjoin_eq_top (R := R ⧸ p) (S := S ⧸ q) + obtain ⟨B, hB⟩ := Ideal.Quotient.mk_surjective B₀ + obtain ⟨f₁, hf₁_map, hf₁_monic⟩ : + ∃ f₁ : R[X], f₁.map (Ideal.Quotient.mk p) = minpoly (R ⧸ p) B₀ ∧ f₁.Monic := by + have h_lifts : (minpoly (R ⧸ p) B₀) ∈ Polynomial.lifts (Ideal.Quotient.mk p) := + (Polynomial.mem_lifts _).mpr + (Polynomial.map_surjective _ Ideal.Quotient.mk_surjective _) + obtain ⟨f₁, hf₁_eq, _, hf₁_monic⟩ := Polynomial.lifts_and_degree_eq_and_monic + h_lifts (minpoly.monic (Algebra.IsIntegral.isIntegral B₀)) + exact ⟨f₁, hf₁_eq, hf₁_monic⟩ + set ms := IsLocalRing.maximalIdeal S + have h_ms_eq := maximalIdeal_eq_sup_of_etale_quotient q hétale + obtain ⟨q₀, hq₀⟩ := Ideal.exists_span_singleton_eq_of_prime_of_height_one q hq_height + set f₁_B := Polynomial.aeval B f₁ + have h_f₁B_in_q : f₁_B ∈ q := by + rw [← Ideal.Quotient.eq_zero_iff_mem] + change Ideal.Quotient.mk q (Polynomial.aeval B f₁) = 0 + simp only [Polynomial.aeval_def] + rw [Polynomial.hom_eval₂, hB, Ideal.quotient_comp_map, ← Polynomial.eval₂_map, hf₁_map] + exact minpoly.aeval (R ⧸ p) B₀ + have h_adj_quot : Algebra.adjoin (R ⧸ q.comap (algebraMap R S)) + {Ideal.Quotient.mk q B} = ⊤ := by + simpa only [hB] using adj + by_cases h_gen : f₁_B ∈ ms ∧ Ideal.span {f₁_B} ⊔ Ideal.map (algebraMap R S) + (IsLocalRing.maximalIdeal R) • ⊤ = ms + · exact ⟨minpoly R B, ⟨IsAdjoinRootMonic.mkOfAdjoinEqTop + (Algebra.IsIntegral.isIntegral (R := R) B) + (adjoin_eq_top_of_quotient B q h_adj_quot + f₁_B (by rw [Algebra.adjoin_singleton_eq_range_aeval]; exact ⟨f₁, rfl⟩) + (by simpa [Ideal.smul_eq_mul, Ideal.mul_top] using h_gen.2.symm))⟩⟩ + · obtain ⟨a, ha⟩ : ∃ a : S, f₁_B = q₀ * a := by + rw [hq₀] at h_f₁B_in_q; exact Ideal.mem_span_singleton.mp h_f₁B_in_q + have h_deriv_not_in_ms : f₁.derivative.aeval B ∉ ms := by + intro h_in_ms + haveI : IsLocalHom (Ideal.Quotient.mk q) := + IsLocalHom.of_surjective _ Ideal.Quotient.mk_surjective + refine (IsLocalRing.mem_maximalIdeal _).mp h_in_ms + (isUnit_of_map_unit (Ideal.Quotient.mk q) _ ?_) + have h_deriv_comm : Ideal.Quotient.mk q (f₁.derivative.aeval B) = + (minpoly (R ⧸ p) B₀).derivative.aeval B₀ := by + simp only [Polynomial.aeval_def] + rw [Polynomial.hom_eval₂, hB, Ideal.quotient_comp_map, ← Polynomial.eval₂_map] + congr 1; rw [← Polynomial.derivative_map, hf₁_map] + exact h_deriv_comm ▸ isUnit_aeval_derivative_minpoly_of_adjoin_eq_top adj + exact exists_isAdjoinRootMonic_of_principal_adjust q q₀ hq₀ B f₁ a ha + (cofactor_mem_maximalIdeal_of_not_generator f₁_B q h_f₁B_in_q h_gen q₀ hq₀ a ha h_ms_eq) + h_deriv_not_in_ms h_ms_eq (by rw [hB]; exact adj) + +end BGS.CorvajaZannier.LocalMonogenic diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean new file mode 100644 index 0000000000..eec443a62c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean @@ -0,0 +1,829 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import Mathlib.Algebra.Polynomial.Reverse +import Mathlib.RingTheory.Polynomial.Resultant.Basic + +/-! +# Reciprocal normalization at a finite base place + +This file supplies the local algebraic bridge used in the Corvaja--Zannier +middle game. If a polynomial relation `f(v) = 0` has unit value `f(c)`, the +reciprocal parameter `z = (v-c)⁻¹` satisfies a monic integral equation. The +normalization preserves primitive generation, becomes the minimal polynomial +under the full-degree hypothesis, and changes the discriminant only by a unit. +Consequently its discriminant has exactly the same order at every finite base +place as the discriminant of `f`. + +The fixed-degree reflection/resultant identities are proved here because the +coefficient-reversal discriminant formula needed for a nonmonic relation was +not previously available in Mathlib in this form. +-/ + +namespace BGS.CorvajaZannier + +open IsDedekindDomain Polynomial + +noncomputable section + +variable {R : Type*} [CommRing R] + +private def reflectSylvesterEquiv (m n : ℕ) : Fin (n + m) ≃ Fin (m + n) := + (finCongr (Nat.add_comm n m)).trans Fin.revPerm + +@[simp] +private theorem reflectSylvesterEquiv_symm_left (m n : ℕ) (j : Fin m) : + (reflectSylvesterEquiv m n).symm (j.castAdd n) = + (Fin.rev j).natAdd n := by + ext + simp [reflectSylvesterEquiv, Fin.rev] + omega + +@[simp] +private theorem reflectSylvesterEquiv_symm_right (m n : ℕ) (j : Fin n) : + (reflectSylvesterEquiv m n).symm (j.natAdd m) = + (Fin.rev j).castAdd m := by + ext + simp [reflectSylvesterEquiv, Fin.rev] + omega + +@[simp] +private theorem reflectSylvesterEquiv_symm_val (m n : ℕ) (i : Fin (m + n)) : + ((reflectSylvesterEquiv m n).symm i : ℕ) = m + n - (i + 1) := by + simp [reflectSylvesterEquiv, Fin.rev] + +private theorem reflected_row_sub_reflected_shift + (m n i j : ℕ) (_hi : i < m + n) (hj : j < m) + (hji : j ≤ i) (hij : i ≤ j + n) : + m + n - (i + 1) - (m - (j + 1)) = n - (i - j) := by + omega + +theorem sylvester_reflect (f g : R[X]) (m n : ℕ) : + sylvester (reflect m f) (reflect n g) m n = + (sylvester g f n m).reindex + (reflectSylvesterEquiv m n) (reflectSylvesterEquiv m n) := by + ext i j + induction j using Fin.addCases with + | left j => + simp only [sylvester, Matrix.of_apply, Fin.addCases_left, + Matrix.reindex_apply, Matrix.submatrix_apply, + reflectSylvesterEquiv_symm_left, Fin.addCases_right, + reflectSylvesterEquiv_symm_val] + simp only [coeff_reflect] + split_ifs <;> simp_all [revAt] <;> try omega + congr 1 + rw [if_pos (by omega)] + exact (reflected_row_sub_reflected_shift m n i j i.isLt j.isLt + (by omega) (by omega)).symm + | right j => + simp only [sylvester, Matrix.of_apply, Fin.addCases_right, + Matrix.reindex_apply, Matrix.submatrix_apply, + reflectSylvesterEquiv_symm_right, Fin.addCases_left, + reflectSylvesterEquiv_symm_val] + simp only [coeff_reflect] + split_ifs <;> simp_all [revAt] <;> try omega + congr 1 + rw [if_pos (by omega)] + simpa [Nat.add_comm] using + (reflected_row_sub_reflected_shift n m i j (by omega) j.isLt + (by omega) (by omega)).symm + +/-- Reversing both coefficient lists changes the fixed-degree resultant only +by the standard interchange sign. -/ +theorem resultant_reflect (f g : R[X]) (m n : ℕ) : + resultant (reflect m f) (reflect n g) m n = + (-1) ^ (m * n) * resultant f g m n := by + rw [resultant, sylvester_reflect, Matrix.det_reindex_self, ← resultant] + simpa [Nat.mul_comm] using resultant_comm g f n m + +theorem reflect_derivative_relation (f : R[X]) (n : ℕ) + (hf : f.natDegree ≤ n) : + reflect (n - 1) f.derivative = + C (n : R) * reflect n f - X * (reflect n f).derivative := by + ext k + by_cases hk0 : k = 0 + · subst k + simp only [coeff_reflect, coeff_derivative, revAt_zero, coeff_sub, + coeff_C_mul, coeff_X_mul_zero, sub_zero] + by_cases hn : n = 0 + · subst n + have hcoeff : f.coeff 1 = 0 := coeff_eq_zero_of_natDegree_lt (by omega) + simp [hcoeff] + · have hnsub : n - 1 + 1 = n := by omega + have hncast : ((n - 1 : ℕ) : R) + 1 = (n : R) := by + simpa only [Nat.cast_add, Nat.cast_one] using + congrArg (fun x : ℕ => (x : R)) hnsub + rw [hnsub, hncast] + exact mul_comm _ _ + · obtain ⟨l, rfl⟩ := Nat.exists_eq_succ_of_ne_zero hk0 + simp only [coeff_reflect, coeff_derivative, coeff_sub, coeff_C_mul, + coeff_X_mul] + rcases lt_trichotomy (l + 1) n with hlt | heq | hgt + · rw [revAt_le (by omega : l + 1 ≤ n - 1), revAt_le hlt.le] + have hindex : n - 1 - (l + 1) + 1 = n - (l + 1) := by omega + have hcast : ((n - 1 - (l + 1) : ℕ) : R) + 1 = + ((n - (l + 1) : ℕ) : R) := by + simpa only [Nat.cast_add, Nat.cast_one] using + congrArg (fun x : ℕ => (x : R)) hindex + rw [hindex, hcast] + rw [Nat.cast_sub hlt.le] + push_cast + ring + · rw [← heq, revAt_le le_rfl, + revAt_eq_self_of_lt (by omega : l + 1 - 1 < l + 1)] + have hcoeff : f.coeff (l + 1 + 1) = 0 := + coeff_eq_zero_of_natDegree_lt (by omega) + rw [hcoeff, zero_mul] + push_cast + ring + · rw [revAt_eq_self_of_lt hgt, + revAt_eq_self_of_lt (by omega : n - 1 < l + 1)] + have hcoeff : f.coeff (l + 1) = 0 := + coeff_eq_zero_of_natDegree_lt (by omega) + have hcoeff' : f.coeff (l + 1 + 1) = 0 := + coeff_eq_zero_of_natDegree_lt (by omega) + rw [hcoeff, hcoeff'] + simp + +section Field + +variable {F : Type*} [Field F] + +theorem natDegree_reflect_eq (f : F[X]) (n : ℕ) + (hf : f.natDegree ≤ n) (hzero : f.coeff 0 ≠ 0) : + (reflect n f).natDegree = n := by + apply le_antisymm + · exact natDegree_reflect_le.trans (max_le le_rfl hf) + · apply le_natDegree_of_ne_zero + simpa [coeff_reflect, revAt_le le_rfl] using hzero + +private theorem resultant_reflect_derivative_balance_of_splits + (f : F[X]) (n : ℕ) (hf : f.natDegree ≤ n) + (hzero : f.coeff 0 ≠ 0) (hs : (reflect n f).Splits) : + (reflect n f).leadingCoeff * + resultant (reflect n f) (reflect (n - 1) f.derivative) n (n - 1) = + (reflect n f).coeff 0 * + resultant (reflect n f) (reflect n f).derivative n (n - 1) := by + let h := reflect n f + let q := reflect (n - 1) f.derivative + have hhdeg : h.natDegree = n := natDegree_reflect_eq f n hf hzero + have hqdeg : q.natDegree ≤ n - 1 := by + apply natDegree_reflect_le.trans + rw [max_le_iff] + exact ⟨le_rfl, + (natDegree_derivative_le f).trans (Nat.sub_le_sub_right hf 1)⟩ + have hh'deg : h.derivative.natDegree ≤ n - 1 := by + rw [← hhdeg] + exact natDegree_derivative_le h + rw [show resultant h q n (n - 1) = resultant h q h.natDegree (n - 1) by rw [hhdeg], + resultant_eq_prod_eval h q (n - 1) hqdeg hs] + rw [show resultant h h.derivative n (n - 1) = + resultant h h.derivative h.natDegree (n - 1) by rw [hhdeg], + resultant_eq_prod_eval h h.derivative (n - 1) hh'deg hs] + have hhne : h ≠ 0 := by + intro hh + apply hzero + have hreflect : reflect n f = 0 := by simpa [h] using hh + have : f = 0 := (reflect_eq_zero_iff (N := n) (f := f)).mp hreflect + simp [this] + have hqeval : ∀ r ∈ h.roots, q.eval r = -r * h.derivative.eval r := by + intro r hr + have hroot : h.eval r = 0 := (mem_roots hhne).mp hr + have hrel : q = C (n : F) * h - X * h.derivative := by + simpa [h, q] using reflect_derivative_relation f n hf + rw [hrel] + simp [eval_mul, hroot] + have hprod : (h.roots.map q.eval).prod = + (-1 : F) ^ n * h.roots.prod * (h.roots.map h.derivative.eval).prod := by + calc + (h.roots.map q.eval).prod = + (h.roots.map (fun r => -r * h.derivative.eval r)).prod := by + congr 1 + exact Multiset.map_congr rfl hqeval + _ = (h.roots.map (fun r => (-1 : F))).prod * + h.roots.prod * (h.roots.map h.derivative.eval).prod := by + have hpoint : (h.roots.map (fun r => -r * h.derivative.eval r)) = + h.roots.map (fun r => (((-1 : F) * r) * h.derivative.eval r)) := by + apply Multiset.map_congr rfl + intro r hr + ring + rw [hpoint, Multiset.prod_map_mul, Multiset.prod_map_mul] + simp + _ = (-1 : F) ^ n * h.roots.prod * + (h.roots.map h.derivative.eval).prod := by + have hconst : (h.roots.map (fun _ => (-1 : F))).prod = + (-1 : F) ^ h.roots.card := by + induction h.roots using Multiset.induction_on with + | empty => simp + | cons a s _ => simp [pow_succ] + rw [hconst, ← hs.natDegree_eq_card_roots, hhdeg] + rw [hprod, hs.coeff_zero_eq_leadingCoeff_mul_prod_roots, hhdeg] + ring + +theorem resultant_reflect_derivative_balance + (f : F[X]) (n : ℕ) (hf : f.natDegree ≤ n) + (hzero : f.coeff 0 ≠ 0) : + (reflect n f).leadingCoeff * + resultant (reflect n f) (reflect (n - 1) f.derivative) n (n - 1) = + (reflect n f).coeff 0 * + resultant (reflect n f) (reflect n f).derivative n (n - 1) := by + let h := reflect n f + let E := h.SplittingField + let φ : F →+* E := algebraMap F E + have hφ : Function.Injective φ := (algebraMap F E).injective + apply hφ + have hsplit : (reflect n (f.map φ)).Splits := by + rw [reflect_map] + exact SplittingField.splits h + have hzeroMap : (f.map φ).coeff 0 ≠ 0 := by + simpa [coeff_map] using hφ.ne hzero + have hbalance := resultant_reflect_derivative_balance_of_splits + (f.map φ) n (by simpa [natDegree_map_eq_of_injective hφ] using hf) + hzeroMap hsplit + rw [reflect_map, derivative_map, reflect_map, derivative_map] at hbalance + simpa only [map_mul, resultant_map_map, coeff_map, + leadingCoeff_map_of_injective hφ] using hbalance + +/-- Reversing a polynomial of positive degree with nonzero constant term +preserves its discriminant. -/ +theorem discr_reflect_eq (f : F[X]) (hzero : f.coeff 0 ≠ 0) : + (reflect f.natDegree f).discr = f.discr := by + let n := f.natDegree + by_cases hn : n = 0 + · have hfdeg : f.natDegree = 0 := hn + obtain ⟨a, rfl⟩ := natDegree_eq_zero.mp hfdeg + simp [reflect] + have hnpos : 0 < n := Nat.pos_of_ne_zero hn + let h := reflect n f + have hfne : f ≠ 0 := by + intro hf + apply hzero + simp [hf] + have hhdeg : h.natDegree = n := natDegree_reflect_eq f n le_rfl hzero + have hhne : h ≠ 0 := by + intro hh + apply hfne + apply (reflect_eq_zero_iff (N := n) (f := f)).mp + simpa [h] using hh + have hfDegreePos : 0 < f.degree := by + rw [← natDegree_pos_iff_degree_pos] + exact hnpos + have hhDegreePos : 0 < h.degree := by + rw [← natDegree_pos_iff_degree_pos, hhdeg] + exact hnpos + have hbalance := resultant_reflect_derivative_balance f n le_rfl hzero + have hreflect := resultant_reflect f f.derivative n (n - 1) + have heven : (-1 : F) ^ (n * (n - 1)) = 1 := + n.even_mul_pred_self.neg_one_pow + rw [heven, one_mul] at hreflect + rw [hreflect] at hbalance + have hfResultant := resultant_deriv (f := f) hfDegreePos + have hhResultant := resultant_deriv (f := h) hhDegreePos + rw [show f.natDegree = n from rfl] at hfResultant + rw [hhdeg] at hhResultant + rw [hfResultant, hhResultant] at hbalance + have hhLeading : h.leadingCoeff = f.coeff 0 := by + rw [leadingCoeff, hhdeg, coeff_reflect, revAt_le le_rfl] + simp + have hhCoeffZero : h.coeff 0 = f.leadingCoeff := by + change (reflect n f).coeff 0 = f.leadingCoeff + rw [coeff_reflect, revAt_zero] + change f.coeff f.natDegree = f.coeff f.natDegree + rfl + rw [hhLeading, hhCoeffZero] at hbalance + let s : F := (-1) ^ (n * (n - 1) / 2) + have hs : s ≠ 0 := pow_ne_zero _ (neg_ne_zero.mpr one_ne_zero) + have hlc : f.leadingCoeff ≠ 0 := leadingCoeff_ne_zero.mpr hfne + have hfactor : f.coeff 0 * f.leadingCoeff * s ≠ 0 := + mul_ne_zero (mul_ne_zero hzero hlc) hs + apply mul_left_cancel₀ hfactor + change (f.coeff 0 * f.leadingCoeff * s) * h.discr = + (f.coeff 0 * f.leadingCoeff * s) * f.discr + change f.coeff 0 * (s * f.leadingCoeff * f.discr) = + f.leadingCoeff * (s * f.coeff 0 * h.discr) at hbalance + calc + (f.coeff 0 * f.leadingCoeff * s) * h.discr = + f.leadingCoeff * (s * f.coeff 0 * h.discr) := by ring + _ = f.coeff 0 * (s * f.leadingCoeff * f.discr) := hbalance.symm + _ = (f.coeff 0 * f.leadingCoeff * s) * f.discr := by ring + +/-- Translation of the variable preserves the discriminant. -/ +theorem discr_taylor_eq (f : F[X]) (c : F) : + (f.taylor c).discr = f.discr := by + by_cases hn : f.natDegree = 0 + · obtain ⟨a, rfl⟩ := natDegree_eq_zero.mp hn + simp + let n := f.natDegree + let d := f.derivative.natDegree + let k := n - 1 - d + have hnpos : 0 < n := Nat.pos_of_ne_zero hn + have hdle : d ≤ n - 1 := natDegree_derivative_le f + have hsum : d + k = n - 1 := by omega + have htder : (f.taylor c).derivative = f.derivative.taylor c := by + simp [taylor_apply, derivative_comp] + have htdeg : (f.taylor c).natDegree = n := natDegree_taylor f c + have htderdeg : (f.taylor c).derivative.natDegree = d := by + rw [htder, natDegree_taylor] + have hordinary : + resultant (f.taylor c) (f.taylor c).derivative n d = + resultant f f.derivative n d := by + have ht := resultant_taylor f f.derivative c + rw [← htder] at ht + simpa [n, d, natDegree_taylor, htderdeg] using ht + have hfixedF := resultant_add_right_deg f f.derivative n d k le_rfl + have hfixedT := resultant_add_right_deg + (f.taylor c) (f.taylor c).derivative n d k htderdeg.le + rw [hsum] at hfixedF hfixedT + have hfixed : + resultant (f.taylor c) (f.taylor c).derivative n (n - 1) = + resultant f f.derivative n (n - 1) := by + rw [hfixedT, hfixedF, hordinary] + rw [coeff_natDegree, ← htdeg, coeff_natDegree, leadingCoeff_taylor] + have hfDegreePos : 0 < f.degree := by + rw [← natDegree_pos_iff_degree_pos] + exact hnpos + have htDegreePos : 0 < (f.taylor c).degree := by + rw [← natDegree_pos_iff_degree_pos, htdeg] + exact hnpos + have hfResultant := resultant_deriv (f := f) hfDegreePos + have htResultant := resultant_deriv (f := f.taylor c) htDegreePos + rw [show f.natDegree = n from rfl] at hfResultant + rw [htdeg] at htResultant + rw [htResultant, hfResultant] at hfixed + have hfne : f ≠ 0 := by + intro hf + subst f + simp at hn + have hlc : f.leadingCoeff ≠ 0 := leadingCoeff_ne_zero.mpr hfne + have hs : ((-1 : F) ^ (n * (n - 1) / 2)) ≠ 0 := + pow_ne_zero _ (neg_ne_zero.mpr one_ne_zero) + have hfactor : ((-1 : F) ^ (n * (n - 1) / 2)) * f.leadingCoeff ≠ 0 := + mul_ne_zero hs hlc + rw [leadingCoeff_taylor] at hfixed + exact mul_left_cancel₀ hfactor hfixed + +/-- Scaling every coefficient by `b` scales the discriminant by +`b^(2 * degree - 2)`. -/ +theorem discr_C_mul (f : F[X]) (b : F) (hb : b ≠ 0) : + (C b * f).discr = b ^ (2 * f.natDegree - 2) * f.discr := by + by_cases hn : f.natDegree = 0 + · obtain ⟨a, rfl⟩ := natDegree_eq_zero.mp hn + rw [show b ^ (2 * (C a).natDegree - 2) * (C a).discr = 1 by simp] + simpa only [C_mul] using (discr_C (b * a) : (C (b * a) : F[X]).discr = 1) + let n := f.natDegree + have hnpos : 0 < n := Nat.pos_of_ne_zero hn + have hfne : f ≠ 0 := by + intro hf + subst f + simp at hn + have hgdeg : (C b * f).natDegree = n := by + rw [natDegree_C_mul hb] + have hgder : (C b * f).derivative = C b * f.derivative := by simp + have hres : + resultant (C b * f) (C b * f.derivative) n (n - 1) = + b ^ (n - 1) * b ^ n * resultant f f.derivative n (n - 1) := by + rw [resultant_C_mul_left, resultant_C_mul_right] + ring + have hpow : b ^ (n - 1) * b ^ n = + b * b ^ (2 * n - 2) := by + rw [← pow_add, ← pow_succ'] + congr 1 + omega + rw [hpow] at hres + have hfDegreePos : 0 < f.degree := by + rw [← natDegree_pos_iff_degree_pos] + exact hnpos + have hgDegreePos : 0 < (C b * f).degree := by + rw [← natDegree_pos_iff_degree_pos, hgdeg] + exact hnpos + have hfResultant := resultant_deriv (f := f) hfDegreePos + have hgResultant := resultant_deriv (f := C b * f) hgDegreePos + rw [show f.natDegree = n from rfl] at hfResultant + rw [hgdeg, hgder] at hgResultant + rw [hgResultant, hfResultant] at hres + have hlc : f.leadingCoeff ≠ 0 := leadingCoeff_ne_zero.mpr hfne + have hleading : (C b * f).leadingCoeff = b * f.leadingCoeff := by + rw [leadingCoeff_mul' (mul_ne_zero (by simpa) hlc)] + simp + rw [hleading] at hres + let s : F := (-1) ^ (n * (n - 1) / 2) + have hs : s ≠ 0 := pow_ne_zero _ (neg_ne_zero.mpr one_ne_zero) + have hfactor : s * b * f.leadingCoeff ≠ 0 := + mul_ne_zero (mul_ne_zero hs hb) hlc + apply mul_left_cancel₀ hfactor + change s * (b * f.leadingCoeff) * (C b * f).discr = + b * b ^ (2 * n - 2) * (s * f.leadingCoeff * f.discr) at hres + rw [show f.natDegree = n from rfl] + calc + (s * b * f.leadingCoeff) * (C b * f).discr = + s * (b * f.leadingCoeff) * (C b * f).discr := by ring + _ = b * b ^ (2 * n - 2) * (s * f.leadingCoeff * f.discr) := hres + _ = (s * b * f.leadingCoeff) * + (b ^ (2 * n - 2) * f.discr) := by ring + +end Field + +/-- The reciprocal translate `Z^deg(f) * f(c + Z⁻¹)`, represented without +Laurent polynomials as the reflection of the Taylor translate. -/ +def reciprocalTranslate (f : R[X]) (c : R) : R[X] := + reflect f.natDegree (f.taylor c) + +theorem reciprocalTranslate_natDegree_eq (f : R[X]) (c : R) + (heval : f.eval c ≠ 0) : + (reciprocalTranslate f c).natDegree = f.natDegree := by + apply le_antisymm + · exact natDegree_reflect_le.trans (by simp [natDegree_taylor]) + · apply le_natDegree_of_ne_zero + simpa [reciprocalTranslate, coeff_reflect, revAt_le le_rfl, + taylor_coeff_zero] using heval + +theorem reciprocalTranslate_leadingCoeff (f : R[X]) (c : R) + (heval : f.eval c ≠ 0) : + (reciprocalTranslate f c).leadingCoeff = f.eval c := by + rw [leadingCoeff, reciprocalTranslate_natDegree_eq f c heval] + simp [reciprocalTranslate, coeff_reflect, revAt_le le_rfl, + taylor_coeff_zero] + +section DiscriminantMap + +variable {S : Type*} [CommRing S] [IsDomain S] + +/-- Discriminants commute with an injective coefficient map. -/ +theorem discr_map_of_injective (φ : R →+* S) (hφ : Function.Injective φ) + (f : R[X]) : + (f.map φ).discr = φ f.discr := by + by_cases hn : f.natDegree = 0 + · obtain ⟨a, rfl⟩ := natDegree_eq_zero.mp hn + simp + let n := f.natDegree + have hnpos : 0 < n := Nat.pos_of_ne_zero hn + have hfDegreePos : 0 < f.degree := by + rw [← natDegree_pos_iff_degree_pos] + exact hnpos + have hmapdeg : (f.map φ).natDegree = n := + natDegree_map_eq_of_injective hφ f + have hmapDegreePos : 0 < (f.map φ).degree := by + rw [← natDegree_pos_iff_degree_pos, hmapdeg] + exact hnpos + have hres := resultant_map_map f f.derivative n (n - 1) φ + have hfResultant := resultant_deriv (f := f) hfDegreePos + have hmapResultant := resultant_deriv (f := f.map φ) hmapDegreePos + rw [show f.natDegree = n from rfl] at hfResultant + rw [hmapdeg, derivative_map] at hmapResultant + rw [hmapResultant, hfResultant, map_mul, map_mul, map_pow, + map_neg, map_one, leadingCoeff_map_of_injective hφ] at hres + have hfne : f ≠ 0 := by + intro hf + subst f + simp at hn + have hlc : φ f.leadingCoeff ≠ 0 := + by simpa using hφ.ne (leadingCoeff_ne_zero.mpr hfne) + have hs : ((-1 : S) ^ (n * (n - 1) / 2)) ≠ 0 := + pow_ne_zero _ (neg_ne_zero.mpr one_ne_zero) + exact mul_left_cancel₀ (mul_ne_zero hs hlc) hres + +end DiscriminantMap + +section ReciprocalField + +variable {F : Type*} [Field F] + +theorem reciprocalTranslate_discr (f : F[X]) (c : F) + (heval : f.eval c ≠ 0) : + (reciprocalTranslate f c).discr = f.discr := by + calc + (reciprocalTranslate f c).discr = (f.taylor c).discr := by + simpa [reciprocalTranslate, natDegree_taylor] using + discr_reflect_eq (f.taylor c) (by simpa using heval) + _ = f.discr := discr_taylor_eq f c + +end ReciprocalField + +section ReciprocalRoot + +variable {A L : Type*} [CommRing A] [Field L] [Algebra A L] + +theorem aeval_reciprocalTranslate_inv_sub_eq_zero + (f : A[X]) (c : A) (v : L) + (hvc : v ≠ algebraMap A L c) (hv : aeval v f = 0) : + aeval ((v - algebraMap A L c)⁻¹) (reciprocalTranslate f c) = 0 := by + let x : L := v - algebraMap A L c + have hx : x ≠ 0 := sub_ne_zero.mpr hvc + letI : Invertible x := invertibleOfNonzero hx + have htaylor : eval₂ (algebraMap A L) x (f.taylor c) = 0 := by + rw [taylor_apply, eval₂_comp] + simpa [x, aeval_def] using hv + have hreflect := (eval₂_reflect_eq_zero_iff + (algebraMap A L) x f.natDegree (f.taylor c) + (by simp [natDegree_taylor])).2 htaylor + simpa [reciprocalTranslate, aeval_def, x, invOf_eq_inv] using hreflect + +end ReciprocalRoot + +section ReciprocalPrimitiveElement + +variable {K L : Type*} [Field K] [Field L] [Algebra K L] + [Algebra.IsAlgebraic K L] + +/-- Replacing a primitive element `v` by `(v - c)⁻¹` preserves primitive +generation. This is the field-theoretic half of the reciprocal local +normalization used below. -/ +theorem adjoin_inv_sub_eq_top_of_adjoin_eq_top + (c : K) (v : L) (hv : Algebra.adjoin K {v} = ⊤) : + Algebra.adjoin K {(v - algebraMap K L c)⁻¹} = ⊤ := by + apply (IntermediateField.adjoin_eq_top_iff).mp + have hv' : IntermediateField.adjoin K {v} = + (⊤ : IntermediateField K L) := + (IntermediateField.adjoin_eq_top_iff).mpr hv + apply top_unique + rw [← hv'] + apply IntermediateField.adjoin_simple_le_iff.mpr + let z : L := (v - algebraMap K L c)⁻¹ + change v ∈ IntermediateField.adjoin K {z} + have hz : z ∈ IntermediateField.adjoin K {z} := + IntermediateField.mem_adjoin_simple_self K z + rw [show v = z⁻¹ + algebraMap K L c by simp [z]] + exact add_mem (inv_mem hz) (IntermediateField.algebraMap_mem _ c) + +end ReciprocalPrimitiveElement + +section UnitNormalization + +variable {A L : Type*} [CommRing A] [Nontrivial A] [Field L] [Algebra A L] + +/-- Divide a reciprocal translate by its unit leading coefficient. -/ +def unitNormalizedReciprocalTranslate + (f : A[X]) (c : A) (u : Aˣ) : A[X] := + C (↑(u⁻¹) : A) * reciprocalTranslate f c + +omit [Nontrivial A] in +theorem unitNormalizedReciprocalTranslate_map + {S : Type*} [CommRing S] (φ : A →+* S) (hφ : Function.Injective φ) + (f : A[X]) (c : A) (u : Aˣ) : + (unitNormalizedReciprocalTranslate f c u).map φ = + unitNormalizedReciprocalTranslate (f.map φ) (φ c) (Units.map φ u) := by + rw [unitNormalizedReciprocalTranslate, unitNormalizedReciprocalTranslate, + Polynomial.map_mul, Polynomial.map_C] + simp only [Units.coe_map_inv] + congr 1 + rw [reciprocalTranslate, reciprocalTranslate, ← reflect_map, + map_taylor, natDegree_map_eq_of_injective hφ] + +theorem unitNormalizedReciprocalTranslate_monic + (f : A[X]) (c : A) (u : Aˣ) (hu : f.eval c = u) : + (unitNormalizedReciprocalTranslate f c u).Monic := by + apply monic_C_mul_of_mul_leadingCoeff_eq_one + have heval : f.eval c ≠ 0 := by + rw [hu] + exact Units.ne_zero u + rw [reciprocalTranslate_leadingCoeff f c heval] + rw [hu] + simp + +omit [Nontrivial A] in +theorem aeval_unitNormalizedReciprocalTranslate_inv_sub_eq_zero + (f : A[X]) (c : A) (u : Aˣ) (v : L) + (hvc : v ≠ algebraMap A L c) (hv : aeval v f = 0) : + aeval ((v - algebraMap A L c)⁻¹) + (unitNormalizedReciprocalTranslate f c u) = 0 := by + simp [unitNormalizedReciprocalTranslate, + aeval_reciprocalTranslate_inv_sub_eq_zero f c v hvc hv] + +/-- If `f(c)` is a unit, the reciprocal local parameter `(v-c)⁻¹` is +integral over the coefficient ring. -/ +theorem isIntegral_inv_sub_of_eval_eq_unit + (f : A[X]) (c : A) (u : Aˣ) (v : L) + (hu : f.eval c = u) + (hvc : v ≠ algebraMap A L c) (hv : aeval v f = 0) : + IsIntegral A ((v - algebraMap A L c)⁻¹) := by + refine ⟨unitNormalizedReciprocalTranslate f c u, + unitNormalizedReciprocalTranslate_monic f c u hu, ?_⟩ + exact aeval_unitNormalizedReciprocalTranslate_inv_sub_eq_zero + f c u v hvc hv + +end UnitNormalization + +section UnitNormalizationField + +variable {F : Type*} [Field F] + +theorem unitNormalizedReciprocalTranslate_discr + (f : F[X]) (c : F) (u : Fˣ) (hu : f.eval c = u) : + (unitNormalizedReciprocalTranslate f c u).discr = + (↑(u⁻¹) : F) ^ (2 * f.natDegree - 2) * f.discr := by + have heval : f.eval c ≠ 0 := by + rw [hu] + exact Units.ne_zero u + rw [unitNormalizedReciprocalTranslate, + discr_C_mul _ _ (Units.ne_zero (u⁻¹)), + reciprocalTranslate_natDegree_eq f c heval, + reciprocalTranslate_discr f c heval] + +end UnitNormalizationField + +section UnitNormalizationBaseChange + +variable {A K : Type*} [CommRing A] [Nontrivial A] + [Field K] [Algebra A K] + +omit [Nontrivial A] in +/-- After embedding the coefficient ring in a field, normalization changes +the discriminant only by the displayed unit power. -/ +theorem map_unitNormalizedReciprocalTranslate_discr + (hAK : Function.Injective (algebraMap A K)) + (f : A[X]) (c : A) (u : Aˣ) (hu : f.eval c = u) : + algebraMap A K (unitNormalizedReciprocalTranslate f c u).discr = + algebraMap A K (↑(u⁻¹) : A) ^ (2 * f.natDegree - 2) * + algebraMap A K f.discr := by + let φ : A →+* K := algebraMap A K + let uK : Kˣ := Units.map φ u + have huK : (f.map φ).eval (φ c) = uK := by + simpa [φ, uK, hu] using eval_map_apply (p := f) φ c + rw [← discr_map_of_injective φ hAK + (unitNormalizedReciprocalTranslate f c u)] + rw [unitNormalizedReciprocalTranslate_map φ hAK] + rw [unitNormalizedReciprocalTranslate_discr (f.map φ) (φ c) uK huK] + rw [natDegree_map_eq_of_injective hAK] + rw [discr_map_of_injective φ hAK f] + simp [φ, uK] + +end UnitNormalizationBaseChange + +section ReciprocalMinpoly + +variable {A K L : Type*} + [CommRing A] [IsDomain A] [Field K] [Field L] + [Algebra A K] [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [IsFractionRing A K] + [FiniteDimensional K L] + +/-- If the original equation has the full extension degree, then its monic +reciprocal normalization is exactly the minimal polynomial of `(v-c)⁻¹` over +the fraction field. -/ +theorem minpoly_inv_sub_eq_map_unitNormalizedReciprocalTranslate + (f : A[X]) (c : A) (u : Aˣ) (v : L) + (hu : f.eval c = u) + (hvc : v ≠ algebraMap A L c) (hv : aeval v f = 0) + (hprimitive : Algebra.adjoin K {v} = ⊤) + (hdegree : f.natDegree = Module.finrank K L) : + minpoly K ((v - algebraMap A L c)⁻¹) = + (unitNormalizedReciprocalTranslate f c u).map (algebraMap A K) := by + let z : L := (v - algebraMap A L c)⁻¹ + let q : A[X] := unitNormalizedReciprocalTranslate f c u + have hq_monic_A : q.Monic := + unitNormalizedReciprocalTranslate_monic f c u hu + have hq_monic_K : (q.map (algebraMap A K)).Monic := + hq_monic_A.map (algebraMap A K) + have hq_root_A : aeval z q = 0 := by + exact aeval_unitNormalizedReciprocalTranslate_inv_sub_eq_zero + f c u v hvc hv + have hq_root_K : aeval z (q.map (algebraMap A K)) = 0 := by + rw [aeval_map_algebraMap] + exact hq_root_A + have hdvd : minpoly K z ∣ q.map (algebraMap A K) := + minpoly.dvd K z hq_root_K + have hz_primitive_algebra : Algebra.adjoin K {z} = ⊤ := by + simpa [z, IsScalarTower.algebraMap_apply A K L] using + (adjoin_inv_sub_eq_top_of_adjoin_eq_top + (algebraMap A K c) v hprimitive) + have hz_primitive : + IntermediateField.adjoin K {z} = (⊤ : IntermediateField K L) := + (IntermediateField.adjoin_eq_top_iff).mpr hz_primitive_algebra + have hmin_degree : (minpoly K z).natDegree = Module.finrank K L := + (Field.primitive_element_iff_minpoly_natDegree_eq K z).mp hz_primitive + have heval : f.eval c ≠ 0 := by + rw [hu] + exact Units.ne_zero u + have hq_degree : + (q.map (algebraMap A K)).natDegree = (minpoly K z).natDegree := by + rw [natDegree_map_eq_of_injective (IsFractionRing.injective A K)] + change (C ((↑u⁻¹ : A)) * reciprocalTranslate f c).natDegree = _ + rw [natDegree_C_mul (Units.ne_zero (u⁻¹)), + reciprocalTranslate_natDegree_eq f c heval, hdegree, hmin_degree] + have hq_eq : q.map (algebraMap A K) = minpoly K z := + eq_of_monic_of_dvd_of_natDegree_le + (minpoly.monic (Algebra.IsIntegral.isIntegral z)) hq_monic_K hdvd + hq_degree.le + exact hq_eq.symm + +end ReciprocalMinpoly + +section ReciprocalPrimitiveDifferent + +variable {A K L B : Type*} + [CommRing A] [Field K] [CommRing B] [Field L] + [Algebra A K] [Algebra A B] [Algebra B L] + [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [IsScalarTower A B L] + [IsDomain A] [IsIntegrallyClosed A] [IsFractionRing A K] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + [IsIntegralClosure B A L] [IsDedekindDomain B] + [Module.IsTorsionFree A B] + +/-- A reciprocal translate whose value at the center is a unit gives an +integral primitive element, and its minimal-polynomial derivative bounds the +different at every finite prime. -/ +theorem exists_reciprocal_integral_primitive_and_different_bound + (f : A[X]) (c : A) (u : Aˣ) (v : L) + (hu : f.eval c = u) + (hvc : v ≠ algebraMap A L c) (hv : aeval v f = 0) + (hprimitive : Algebra.adjoin K {v} = ⊤) + (w : HeightOneSpectrum B) : + ∃ z : B, + algebraMap B L z = (v - algebraMap A L c)⁻¹ ∧ + Algebra.adjoin K {algebraMap B L z} = ⊤ ∧ + multiplicity w.asIdeal (differentIdeal A B) ≤ + multiplicity w.asIdeal + (Ideal.span {aeval z (derivative (minpoly A z))}) := by + have hz_integral : IsIntegral A ((v - algebraMap A L c)⁻¹) := + isIntegral_inv_sub_of_eval_eq_unit f c u v hu hvc hv + let z : B := + IsIntegralClosure.mk' B ((v - algebraMap A L c)⁻¹) hz_integral + have hz_map : algebraMap B L z = (v - algebraMap A L c)⁻¹ := by + simp [z] + have hz_primitive : Algebra.adjoin K {algebraMap B L z} = ⊤ := by + rw [hz_map] + simpa only [IsScalarTower.algebraMap_apply A K L] using + (adjoin_inv_sub_eq_top_of_adjoin_eq_top + (algebraMap A K c) v hprimitive) + refine ⟨z, hz_map, hz_primitive, ?_⟩ + exact differentIdeal_multiplicity_le_minpolyDerivativeSpan z hz_primitive w + +end ReciprocalPrimitiveDifferent + +section UnitNormalizationFinitePlace + +variable {A K : Type*} [CommRing A] [IsDedekindDomain A] + [Field K] [Algebra A K] [IsFractionRing A K] + +/-- A base-ring unit has order zero at every finite place. -/ +@[simp] +theorem finitePlaceOrderTop_algebraMap_unit + (v : HeightOneSpectrum A) (u : Aˣ) : + finitePlaceOrderTop v (algebraMap A K (u : A)) = 0 := by + have hu_nonnegative : + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v (algebraMap A K (u : A)) := + finitePlaceOrderTop_algebraMap_nonnegative v (u : A) + have hu_inv_nonnegative : + (0 : WithTop ℤ) ≤ finitePlaceOrderTop v (algebraMap A K ((↑u⁻¹ : A))) := + finitePlaceOrderTop_algebraMap_nonnegative v (↑u⁻¹ : A) + have hsum : + finitePlaceOrderTop v (algebraMap A K (u : A)) + + finitePlaceOrderTop v (algebraMap A K ((↑u⁻¹ : A))) = 0 := by + rw [← finitePlaceOrderTop_mul] + simp + apply le_antisymm + · calc + finitePlaceOrderTop v (algebraMap A K (u : A)) ≤ + finitePlaceOrderTop v (algebraMap A K (u : A)) + + finitePlaceOrderTop v (algebraMap A K ((↑u⁻¹ : A))) := + le_add_of_nonneg_right hu_inv_nonnegative + _ = 0 := hsum + · exact hu_nonnegative + +/-- Unit-normalizing a reciprocal translate preserves the discriminant order +at every finite place of the coefficient ring. -/ +theorem finitePlaceOrderTop_map_unitNormalizedReciprocalTranslate_discr + (v : HeightOneSpectrum A) + (f : A[X]) (c : A) (u : Aˣ) (hu : f.eval c = u) : + finitePlaceOrderTop v + (algebraMap A K (unitNormalizedReciprocalTranslate f c u).discr) = + finitePlaceOrderTop v (algebraMap A K f.discr) := by + rw [map_unitNormalizedReciprocalTranslate_discr + (IsFractionRing.injective A K) f c u hu] + rw [finitePlaceOrderTop_mul, finitePlaceOrderTop_pow, + finitePlaceOrderTop_algebraMap_unit] + simp + +/-- Under the full-degree primitive-element hypothesis, the discriminant of +the reciprocal element's minimal polynomial has exactly the order of the +original equation's discriminant at every finite base place. -/ +theorem finitePlaceOrderTop_minpoly_inv_sub_discr + {L : Type*} [Field L] [Algebra K L] [Algebra A L] + [IsScalarTower A K L] [FiniteDimensional K L] + (v₀ : HeightOneSpectrum A) + (f : A[X]) (c : A) (u : Aˣ) (v : L) + (hu : f.eval c = u) + (hvc : v ≠ algebraMap A L c) (hv : aeval v f = 0) + (hprimitive : Algebra.adjoin K {v} = ⊤) + (hdegree : f.natDegree = Module.finrank K L) : + finitePlaceOrderTop v₀ + (minpoly K ((v - algebraMap A L c)⁻¹)).discr = + finitePlaceOrderTop v₀ (algebraMap A K f.discr) := by + rw [minpoly_inv_sub_eq_map_unitNormalizedReciprocalTranslate + f c u v hu hvc hv hprimitive hdegree] + rw [discr_map_of_injective (algebraMap A K) + (IsFractionRing.injective A K)] + exact finitePlaceOrderTop_map_unitNormalizedReciprocalTranslate_discr + v₀ f c u hu + +end UnitNormalizationFinitePlace + + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean new file mode 100644 index 0000000000..8e299e6125 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +import Mathlib.LinearAlgebra.Matrix.Determinant.Basic +import Mathlib.RingTheory.HahnSeries.Valuation + +/-! +# Local Wronskian order estimates + +After choosing a local parameter, the Corvaja--Zannier Wronskian becomes a +Wronskian of Laurent series. This file proves the determinant-level local +estimate: the order of an `n × n` ordinary Wronskian is at least the sum of +the column orders minus `n * (n - 1) / 2`. + +The theorem uses `orderTop`, so it also covers a vanishing determinant. It is +the completion-level inequality in the source argument; embedding a curve's +function field in these completions and summing the resulting orders remain +separate global geometric obligations. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix BigOperators + +open HahnSeries LaurentSeries + +variable {K : Type*} [Field K] + +/-- The ordinary Wronskian matrix of Laurent series with respect to the local +parameter. -/ +def laurentSeriesWronskian {n : ℕ} (f : Fin n → LaurentSeries K) : + Matrix (Fin n) (Fin n) (LaurentSeries K) := + fun i j ↦ ((LaurentSeries.derivative K)^[i.1]) (f j) + +/-- Apply a constant scalar matrix to the columns of a Laurent-series family. -/ +def laurentSeriesColumnCombination {n : ℕ} + (f : Fin n → LaurentSeries K) (A : Matrix (Fin n) (Fin n) K) : + Fin n → LaurentSeries K := + fun j ↦ ∑ i, A i j • f i + +private theorem derivative_iterate_sum_smul {ι : Type*} [Fintype ι] + (r : ℕ) (a : ι → K) (f : ι → LaurentSeries K) : + ((LaurentSeries.derivative K)^[r]) (∑ i, a i • f i) = + ∑ i, a i • ((LaurentSeries.derivative K)^[r]) (f i) := by + induction r with + | zero => simp + | succ r ih => + simp_rw [Function.iterate_succ_apply'] + rw [ih, map_sum] + simp + +/-- A constant change of columns commutes with formation of the local +Wronskian. -/ +theorem laurentSeriesWronskian_columnCombination {n : ℕ} + (f : Fin n → LaurentSeries K) (A : Matrix (Fin n) (Fin n) K) : + laurentSeriesWronskian (laurentSeriesColumnCombination f A) = + laurentSeriesWronskian f * A.map (algebraMap K (LaurentSeries K)) := by + apply Matrix.ext + intro i j + rw [Matrix.mul_apply] + simp only [laurentSeriesWronskian, laurentSeriesColumnCombination, + Matrix.map_apply] + rw [derivative_iterate_sum_smul] + have halgebraMap (a : K) : + algebraMap K (LaurentSeries K) a = HahnSeries.single 0 a := by + change ((algebraMap K (PowerSeries K) a : PowerSeries K) : + LaurentSeries K) = HahnSeries.single 0 a + rw [← PowerSeries.C_eq_algebraMap, PowerSeries.coe_C] + rfl + have hscalar (a : K) (x : LaurentSeries K) : + a • x = algebraMap K (LaurentSeries K) a * x := by + rw [halgebraMap] + exact HahnSeries.single_zero_mul_eq_smul.symm + simp_rw [hscalar] + apply Finset.sum_congr rfl + intro k _ + exact mul_comm _ _ + +/-- A determinant-one constant column operation leaves the local Wronskian +determinant unchanged. This is the formal column-operation principle used in +the source's local cases. -/ +theorem laurentSeriesWronskian_det_columnCombination_of_det_eq_one {n : ℕ} + (f : Fin n → LaurentSeries K) (A : Matrix (Fin n) (Fin n) K) + (hA : A.det = 1) : + (laurentSeriesWronskian (laurentSeriesColumnCombination f A)).det = + (laurentSeriesWronskian f).det := by + rw [laurentSeriesWronskian_columnCombination, Matrix.det_mul] + have hdetmap : + (A.map (algebraMap K (LaurentSeries K))).det = 1 := by + calc + (A.map (algebraMap K (LaurentSeries K))).det = + algebraMap K (LaurentSeries K) A.det := by + simpa using ((algebraMap K (LaurentSeries K)).map_det A).symm + _ = 1 := by rw [hA, map_one] + rw [hdetmap, mul_one] + +private theorem addVal_prod {ι : Type*} [DecidableEq ι] + (s : Finset ι) (g : ι → LaurentSeries K) : + HahnSeries.addVal ℤ K (∏ i ∈ s, g i) = + ∑ i ∈ s, HahnSeries.addVal ℤ K (g i) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, AddValuation.map_mul] + +private theorem coe_sum_int_finset {ι : Type*} [DecidableEq ι] + (s : Finset ι) (g : ι → ℤ) : + (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + induction s using Finset.induction_on with + | empty => simp + | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] + +private theorem coe_sum_int {ι : Type*} [Fintype ι] (g : ι → ℤ) : + (((∑ i, g i : ℤ) : ℤ) : WithTop ℤ) = + ∑ i, ((g i : ℤ) : WithTop ℤ) := by + classical + exact coe_sum_int_finset Finset.univ g + +/-- Before evaluating the triangular number, the local Wronskian determinant +has order at least the sum of the column orders minus the sum of the derivative +orders `0, ..., n - 1`. -/ +theorem orderTop_laurentSeriesWronskian_det_lower_bound {n : ℕ} + (f : Fin n → LaurentSeries K) : + (((∑ j, (f j).order) - ∑ j : Fin n, (j : ℤ) : ℤ) : WithTop ℤ) ≤ + (laurentSeriesWronskian f).det.orderTop := by + rw [Matrix.det_apply] + change (((∑ j, (f j).order) - ∑ j : Fin n, (j : ℤ) : ℤ) : WithTop ℤ) ≤ + HahnSeries.addVal ℤ K + (∑ σ, Equiv.Perm.sign σ • ∏ i, laurentSeriesWronskian f (σ i) i) + apply AddValuation.map_le_sum + intro σ _ + calc + (((∑ j, (f j).order) - ∑ j : Fin n, (j : ℤ) : ℤ) : WithTop ℤ) = + ∑ j : Fin n, (((f j).order - (σ j : ℕ) : ℤ) : WithTop ℤ) := by + rw [← Equiv.sum_comp σ (fun j : Fin n ↦ (j : ℤ))] + rw [← coe_sum_int] + congr 1 + rw [Finset.sum_sub_distrib] + _ ≤ ∑ j : Fin n, + ((((LaurentSeries.derivative K)^[((σ j : Fin n) : ℕ)]) + (f j)).orderTop) := by + gcongr with j + exact order_sub_le_orderTop_derivative_iterate + ((σ j : Fin n) : ℕ) (f j) + _ = (∏ i, laurentSeriesWronskian f (σ i) i).orderTop := by + rw [← HahnSeries.addVal_apply, addVal_prod] + simp only [HahnSeries.addVal_apply] + rfl + _ ≤ (Equiv.Perm.sign σ • + ∏ i, laurentSeriesWronskian f (σ i) i).orderTop := by + exact orderTop_le_orderTop_smul _ _ + +/-- The local Wronskian determinant loses at most the triangular number +`n * (n - 1) / 2` from the sum of its column orders. -/ +theorem orderTop_laurentSeriesWronskian_det_lower_bound_closed {n : ℕ} + (f : Fin n → LaurentSeries K) : + (((∑ j, (f j).order) - (n * (n - 1) / 2 : ℕ) : ℤ) : WithTop ℤ) ≤ + (laurentSeriesWronskian f).det.orderTop := by + convert orderTop_laurentSeriesWronskian_det_lower_bound f using 1 + congr 1 + apply congrArg (fun x : ℤ ↦ (∑ j, (f j).order) - x) + rw [Fin.sum_univ_eq_sum_range] + rw [← Nat.cast_sum] + exact congrArg (fun x : ℕ ↦ (x : ℤ)) (Finset.sum_range_id n).symm + +/-- The determinant order can be estimated after any determinant-one constant +column operation. This is the form used when the source separates repeated +pole orders or replaces columns by better local approximations. -/ +theorem orderTop_laurentSeriesWronskian_det_lower_bound_after_columnCombination + {n : ℕ} (f : Fin n → LaurentSeries K) + (A : Matrix (Fin n) (Fin n) K) (hA : A.det = 1) : + (((∑ j, (laurentSeriesColumnCombination f A j).order) - + (n * (n - 1) / 2 : ℕ) : ℤ) : WithTop ℤ) ≤ + (laurentSeriesWronskian f).det.orderTop := by + rw [← laurentSeriesWronskian_det_columnCombination_of_det_eq_one f A hA] + exact orderTop_laurentSeriesWronskian_det_lower_bound_closed + (laurentSeriesColumnCombination f A) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean new file mode 100644 index 0000000000..6804d9c05a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean @@ -0,0 +1,52 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization + +/-! +# The numerical Corvaja--Zannier Theorem 2 bound + +This file composes the floor-parameter proof of Theorem 4 with the corrected +one-parameter optimization in `NumericalOptimization`. Its only substantive +hypothesis is the ordinary Proposition 2 alternative for every admissible +pair of natural parameters. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The exact numerical maximum in Corvaja--Zannier Theorem 2, deduced from +the numerical alternatives in Proposition 2. + +The final optimization uses the corrected split recorded in +`theoremTwo_bound_of_theoremFour_bound`; it does not use the incompatible +parameter choices printed in the last paragraph of the source proof. -/ +theorem theoremTwo_maxBound_of_propositionTwo + (a b chi p : ℕ) (G : ℝ) + (ha : 0 < a) (hab : a ≤ b) (hchi : 0 < chi) (hp : 0 < p) + (hGNonneg : 0 ≤ G) (hGTrivial : G ≤ (a : ℝ)) + (hPropositionTwo : PropositionTwoNumericalAlternatives a b p chi G) : + G ≤ max + (3 * (2 * ((a : ℝ) * (b : ℝ) * (chi : ℝ))) ^ ((1 : ℝ) / 3)) + (12 * ((a : ℝ) * (b : ℝ)) / (p : ℝ)) := by + have haReal : 0 < (a : ℝ) := by exact_mod_cast ha + have hbReal : 0 < (b : ℝ) := by exact_mod_cast (lt_of_lt_of_le ha hab) + have hchiReal : 0 < (chi : ℝ) := by exact_mod_cast hchi + have hpReal : 0 < (p : ℝ) := by exact_mod_cast hp + apply theoremTwo_bound_of_theoremFour_bound + (p : ℝ) (a : ℝ) (b : ℝ) (chi : ℝ) G + hpReal haReal hbReal hchiReal + intro t ht hAdmissible + apply theoremFour_parameterizedBound_of_propositionTwo + a b chi p G t ha hab hchi hp hGNonneg hGTrivial ht hPropositionTwo + apply (lt_div_iff₀ (by positivity : 0 < 8 * t ^ 3)).2 + simpa [mul_comm, mul_left_comm, mul_assoc] using hAdmissible + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean new file mode 100644 index 0000000000..644344bb26 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Analysis.SpecialFunctions.Pow.Real +import Mathlib.Tactic.FieldSimp +import Mathlib.Tactic.Linarith +import Mathlib.Tactic.NormNum +import Mathlib.Tactic.Positivity +import Mathlib.Tactic.Ring + +/-! +# Numerical optimization in Corvaja--Zannier Theorem 2 + +The last step in the proof of Corvaja--Zannier's Theorem 2 optimizes the +parameterized estimate of their Theorem 4. The split printed in the paper is +not compatible with the strict hypothesis of Theorem 4: if + +`Q = p^3 * chi / (degreeU * degreeV)^2`, + +then the fixed choice `t = 4^(1/3)` requires `Q >= 32`, not `Q >= 4`. +For `Q < 32`, the valid choice is `t = Q^(1/3) / 2`. These two choices give +exactly the maximum displayed in Theorem 2. + +This file isolates that corrected real-arithmetic argument. Its theorem takes +the parameterized Theorem-4 estimate as an ordinary hypothesis, so it can be +applied directly once the curve-theoretic part of Theorem 4 is formalized. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The dimensionless ratio used in the final optimization of +Corvaja--Zannier Theorem 2. -/ +def optimizationRatio + (p degreeProduct eulerCharacteristic : ℝ) : ℝ := + p ^ 3 * eulerCharacteristic / degreeProduct ^ 2 + +private theorem rpow_one_third_cube {x : ℝ} (hx : 0 ≤ x) : + (x ^ ((1 : ℝ) / 3)) ^ (3 : ℕ) = x := by + rw [← Real.rpow_mul_natCast hx] + norm_num + +private theorem fixed_parameter_coefficient_identity : + let t : ℝ := (4 : ℝ) ^ ((1 : ℝ) / 3) + 4 / t + t ^ 2 / 2 = 3 * (2 : ℝ) ^ ((1 : ℝ) / 3) := by + dsimp only + let t : ℝ := (4 : ℝ) ^ ((1 : ℝ) / 3) + let twoRoot : ℝ := (2 : ℝ) ^ ((1 : ℝ) / 3) + have htPos : 0 < t := by + dsimp [t] + positivity + have htCube : t ^ 3 = 4 := by + simpa [t] using rpow_one_third_cube (show (0 : ℝ) ≤ 4 by norm_num) + have htwoRootNonneg : 0 ≤ twoRoot := by + dsimp [twoRoot] + positivity + have htwoRootCube : twoRoot ^ 3 = 2 := by + simpa [twoRoot] using rpow_one_third_cube (show (0 : ℝ) ≤ 2 by norm_num) + have hscaledCube : (t ^ 2 / 2) ^ 3 = 2 := by + calc + (t ^ 2 / 2) ^ 3 = (t ^ 3) ^ 2 / 8 := by ring + _ = 2 := by rw [htCube]; norm_num + have hscaled : t ^ 2 / 2 = twoRoot := by + apply (pow_left_inj₀ (by positivity) htwoRootNonneg (by norm_num : (3 : ℕ) ≠ 0)).mp + exact hscaledCube.trans htwoRootCube.symm + have hfourDiv : 4 / t = t ^ 2 := by + apply (div_eq_iff htPos.ne').2 + nlinarith [htCube] + change 4 / t + t ^ 2 / 2 = 3 * twoRoot + rw [hfourDiv, ← hscaled] + ring + +/-- The corrected numerical deduction of Corvaja--Zannier Theorem 2 from the +parameterized estimate in Theorem 4. + +The hypothesis `hTheoremFour` is precisely the real-valued part of Theorem 4: +for every positive parameter satisfying its strict size condition, it supplies +the parameterized gcd bound. The proof uses the valid split `Q ≥ 32` and +`Q < 32`; it does not use the erroneous `Q = 4` split printed in the final +paragraph of the paper. -/ +theorem theoremTwo_bound_of_theoremFour_bound + (p degreeU degreeV eulerCharacteristic gcdValue : ℝ) + (hp : 0 < p) (hdegreeU : 0 < degreeU) (hdegreeV : 0 < degreeV) + (hEuler : 0 < eulerCharacteristic) + (hTheoremFour : ∀ t : ℝ, 0 < t → + 8 * t ^ 3 * (degreeU * degreeV) ^ 2 < + (p + degreeU + degreeV) ^ 3 * eulerCharacteristic → + gcdValue ≤ + (4 / t + t ^ 2 / 2) * + (degreeU * degreeV * eulerCharacteristic) ^ ((1 : ℝ) / 3)) : + gcdValue ≤ max + (3 * (2 * (degreeU * degreeV * eulerCharacteristic)) ^ ((1 : ℝ) / 3)) + (12 * (degreeU * degreeV) / p) := by + let degreeProduct : ℝ := degreeU * degreeV + let base : ℝ := degreeProduct * eulerCharacteristic + let Q : ℝ := optimizationRatio p degreeProduct eulerCharacteristic + have hdegreeProduct : 0 < degreeProduct := by + dsimp [degreeProduct] + positivity + have hbase : 0 < base := by + dsimp [base] + positivity + have hQ : 0 < Q := by + dsimp [Q, optimizationRatio] + positivity + have hQProduct : Q * degreeProduct ^ 2 = p ^ 3 * eulerCharacteristic := by + dsimp [Q, optimizationRatio] + field_simp [hdegreeProduct.ne'] + have hpSum : p < p + degreeU + degreeV := by linarith + have hpCube : p ^ 3 < (p + degreeU + degreeV) ^ 3 := + pow_lt_pow_left₀ hpSum hp.le (by norm_num) + have hpEuler : + p ^ 3 * eulerCharacteristic < + (p + degreeU + degreeV) ^ 3 * eulerCharacteristic := + mul_lt_mul_of_pos_right hpCube hEuler + by_cases hlarge : (32 : ℝ) ≤ Q + · let t : ℝ := (4 : ℝ) ^ ((1 : ℝ) / 3) + have htPos : 0 < t := by + dsimp [t] + positivity + have htCube : t ^ 3 = 4 := by + simpa [t] using rpow_one_third_cube (show (0 : ℝ) ≤ 4 by norm_num) + have hthreshold : + 32 * degreeProduct ^ 2 ≤ p ^ 3 * eulerCharacteristic := by + calc + 32 * degreeProduct ^ 2 ≤ Q * degreeProduct ^ 2 := by + exact mul_le_mul_of_nonneg_right hlarge (sq_nonneg degreeProduct) + _ = p ^ 3 * eulerCharacteristic := hQProduct + have htAdmissible : + 8 * t ^ 3 * (degreeU * degreeV) ^ 2 < + (p + degreeU + degreeV) ^ 3 * eulerCharacteristic := by + calc + 8 * t ^ 3 * (degreeU * degreeV) ^ 2 = + 32 * degreeProduct ^ 2 := by + rw [htCube] + simp only [degreeProduct] + ring + _ ≤ p ^ 3 * eulerCharacteristic := hthreshold + _ < (p + degreeU + degreeV) ^ 3 * eulerCharacteristic := hpEuler + have hBound := hTheoremFour t htPos htAdmissible + have hfixed : + (4 / t + t ^ 2 / 2) * base ^ ((1 : ℝ) / 3) = + 3 * (2 * base) ^ ((1 : ℝ) / 3) := by + rw [show 4 / t + t ^ 2 / 2 = + 3 * (2 : ℝ) ^ ((1 : ℝ) / 3) by + simpa [t] using fixed_parameter_coefficient_identity] + rw [Real.mul_rpow (show (0 : ℝ) ≤ 2 by norm_num) hbase.le] + ring + apply hBound.trans + rw [show degreeU * degreeV * eulerCharacteristic = base by + simp [base, degreeProduct]] + rw [hfixed] + exact le_max_left _ _ + · have hsmall : Q < 32 := lt_of_not_ge hlarge + let qRoot : ℝ := Q ^ ((1 : ℝ) / 3) + let t : ℝ := qRoot / 2 + let baseRoot : ℝ := base ^ ((1 : ℝ) / 3) + have hqRootPos : 0 < qRoot := by + dsimp [qRoot] + positivity + have hqRootCube : qRoot ^ 3 = Q := by + simpa [qRoot] using rpow_one_third_cube hQ.le + have htPos : 0 < t := by + dsimp [t] + positivity + have htCube : 8 * t ^ 3 = Q := by + dsimp [t] + nlinarith [hqRootCube] + have htAdmissible : + 8 * t ^ 3 * (degreeU * degreeV) ^ 2 < + (p + degreeU + degreeV) ^ 3 * eulerCharacteristic := by + change 8 * t ^ 3 * degreeProduct ^ 2 < + (p + degreeU + degreeV) ^ 3 * eulerCharacteristic + rw [htCube, hQProduct] + exact hpEuler + have hBound := hTheoremFour t htPos htAdmissible + have hcoefficient : 4 / t + t ^ 2 / 2 ≤ 12 / qRoot := by + dsimp [t] + apply (le_div_iff₀ hqRootPos).2 + field_simp [hqRootPos.ne'] + nlinarith [hqRootCube] + have hbaseRootNonneg : 0 ≤ baseRoot := by + dsimp [baseRoot] + positivity + have hbaseRootCube : baseRoot ^ 3 = base := by + simpa [baseRoot] using rpow_one_third_cube hbase.le + have hrootRatio : baseRoot / qRoot = degreeProduct / p := by + apply (pow_left_inj₀ (by positivity) (by positivity) + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [div_pow, div_pow, hbaseRootCube, hqRootCube] + dsimp [base, Q, optimizationRatio] + field_simp [hp.ne', hdegreeProduct.ne', hEuler.ne'] + have hsecond : + (12 / qRoot) * baseRoot = 12 * degreeProduct / p := by + calc + (12 / qRoot) * baseRoot = 12 * (baseRoot / qRoot) := by ring + _ = 12 * (degreeProduct / p) := by rw [hrootRatio] + _ = 12 * degreeProduct / p := by ring + apply hBound.trans + rw [show degreeU * degreeV * eulerCharacteristic = base by + simp [base, degreeProduct]] + change (4 / t + t ^ 2 / 2) * baseRoot ≤ _ + calc + (4 / t + t ^ 2 / 2) * baseRoot ≤ + (12 / qRoot) * baseRoot := + mul_le_mul_of_nonneg_right hcoefficient hbaseRootNonneg + _ = 12 * degreeProduct / p := hsecond + _ ≤ max + (3 * (2 * (degreeU * degreeV * eulerCharacteristic)) ^ ((1 : ℝ) / 3)) + (12 * (degreeU * degreeV) / p) := by + simp [degreeProduct] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean new file mode 100644 index 0000000000..b5be513d97 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean @@ -0,0 +1,455 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Analysis.SpecialFunctions.Pow.Real +import Mathlib.Tactic + +/-! +# The parameterized numerical bound in Corvaja--Zannier Theorem 4 + +This file isolates the real and natural-number optimization in the proof of +Corvaja--Zannier, JEMS 15 (2013), Theorem 4. The curve-theoretic content of +their Proposition 2 is an ordinary proposition-valued hypothesis below. No +function-field or valuation statement is assumed through a typeclass. + +The source chooses + +`h = floor (t * (b^2 / (a * chi))^(1/3)) - 1` and +`k = floor (t * (a^2 / (b * chi))^(1/3)) - 1`. + +The proof below retains that choice and checks the small-`k`, degree- +alternative, parameter-admissibility, and numerical-bound cases separately. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The natural parameters to which the numerical form of Corvaja--Zannier +Proposition 2 applies. Positivity of `h * k + h + k` records that the +denominator in Proposition 2 is meaningful. -/ +def PropositionTwoParametersAreAdmissible + (a b p h k : ℕ) : Prop := + 0 < h * k + h + k ∧ a * h + b * k < p + +/-- The two alternatives supplied by the numerical part of +Corvaja--Zannier Proposition 2. + +Here `a = deg(v)`, `b = deg(u)`, `chi` is the Euler characteristic, and `G` +is the gcd sum. This is deliberately an ordinary `Prop`, not a structure, +class, or axiom. -/ +def PropositionTwoNumericalAlternatives + (a b p chi : ℕ) (G : ℝ) : Prop := + ∀ h k : ℕ, + PropositionTwoParametersAreAdmissible a b p h k → + (a ≤ k ∧ b ≤ h) ∨ + G ≤ + (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (a : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (b : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) + +private theorem rpow_one_third_cube {x : ℝ} (hx : 0 ≤ x) : + (x ^ ((1 : ℝ) / 3)) ^ (3 : ℕ) = x := by + rw [← Real.rpow_mul_natCast hx] + norm_num + +private theorem lt_natFloor_sub_one_add_two (x : ℝ) : + x < ((⌊x⌋₊ - 1 : ℕ) : ℝ) + 2 := by + have hfloor := Nat.lt_floor_add_one x + have hnat : ⌊x⌋₊ + 1 ≤ (⌊x⌋₊ - 1) + 2 := by omega + exact hfloor.trans_le (by exact_mod_cast hnat) + +private theorem natFloor_sub_one_add_one_le + {x : ℝ} (hx : 0 ≤ x) (hfloor : 1 ≤ ⌊x⌋₊) : + (((⌊x⌋₊ - 1 : ℕ) : ℝ) + 1) ≤ x := by + have hnat : ⌊x⌋₊ - 1 + 1 = ⌊x⌋₊ := Nat.sub_add_cancel hfloor + have hcast : (((⌊x⌋₊ - 1 : ℕ) : ℝ) + 1) = (⌊x⌋₊ : ℝ) := by + exact_mod_cast hnat + rw [hcast] + exact Nat.floor_le hx + +private theorem propositionTwo_first_coefficient_le + {h k : ℝ} (hkPos : 0 < k) (hk : k ≤ h) : + (h + 2 * k) / (h * k + h + k) ≤ 3 / (k + 2) := by + have hhPos : 0 < h := lt_of_lt_of_le hkPos hk + have hnPos : 0 < h * k + h + k := by positivity + have hkTwoPos : 0 < k + 2 := by positivity + rw [div_le_div_iff₀ hnPos hkTwoPos] + nlinarith [mul_nonneg (sub_nonneg.mpr hk) (by positivity : 0 ≤ 2 * k + 1)] + +private theorem propositionTwo_second_coefficient_le + {h k : ℝ} (hkPos : 0 < k) (hk : k ≤ h) : + k / (h * k + h + k) ≤ 1 / (h + 2) := by + have hhPos : 0 < h := lt_of_lt_of_le hkPos hk + have hnPos : 0 < h * k + h + k := by positivity + have hhTwoPos : 0 < h + 2 := by positivity + rw [div_le_div_iff₀ hnPos hhTwoPos] + nlinarith + +private theorem sqrt_le_theoremFour_coefficient {t : ℝ} (ht : 0 < t) : + Real.sqrt t ≤ 4 / t + t ^ 2 / 2 := by + have hsqrtNonneg : 0 ≤ Real.sqrt t := Real.sqrt_nonneg _ + have hsqrtSq : (Real.sqrt t) ^ 2 = t := Real.sq_sqrt ht.le + apply (mul_le_mul_iff_right₀ ht).mp + have hfour : t * (4 / t) = 4 := by field_simp [ht.ne'] + rw [mul_add, hfour] + have htsqrt : t * Real.sqrt t = (Real.sqrt t) ^ 3 := by + calc + t * Real.sqrt t = (Real.sqrt t) ^ 2 * Real.sqrt t := by rw [hsqrtSq] + _ = (Real.sqrt t) ^ 3 := by ring + have htquadratic : t * (t ^ 2 / 2) = (Real.sqrt t) ^ 6 / 2 := by + calc + t * (t ^ 2 / 2) = t ^ 3 / 2 := by ring + _ = ((Real.sqrt t) ^ 2) ^ 3 / 2 := by rw [hsqrtSq] + _ = (Real.sqrt t) ^ 6 / 2 := by ring + rw [htsqrt, htquadratic] + nlinarith [sq_nonneg ((Real.sqrt t) ^ 3 - 1)] + +private theorem degree_le_theoremFour_bound_of_sq_le_cube + {degree root t : ℝ} (hdegree : 0 ≤ degree) (hroot : 0 ≤ root) + (ht : 0 < t) (hSq : degree ^ 2 ≤ root ^ 3) (hrootLe : root ≤ t) : + degree ≤ (4 / t + t ^ 2 / 2) * root := by + have hrootCube : 0 ≤ root ^ 3 := pow_nonneg hroot _ + have hdegreeLeSqrt : degree ≤ Real.sqrt (root ^ 3) := by + exact (sq_le_sq₀ hdegree (Real.sqrt_nonneg _)).mp + (hSq.trans_eq (Real.sq_sqrt hrootCube).symm) + have hsqrtCube : Real.sqrt (root ^ 3) = root * Real.sqrt root := by + have hproductNonneg : 0 ≤ root * Real.sqrt root := + mul_nonneg hroot (Real.sqrt_nonneg _) + apply (sq_eq_sq₀ (Real.sqrt_nonneg _) hproductNonneg).mp + calc + (Real.sqrt (root ^ 3)) ^ 2 = root ^ 3 := Real.sq_sqrt hrootCube + _ = (root * Real.sqrt root) ^ 2 := by + rw [mul_pow, Real.sq_sqrt hroot] + ring + have hsqrtRootLe : Real.sqrt root ≤ Real.sqrt t := Real.sqrt_le_sqrt hrootLe + have hsqrtTCoefficient := sqrt_le_theoremFour_coefficient ht + calc + degree ≤ Real.sqrt (root ^ 3) := hdegreeLeSqrt + _ = root * Real.sqrt root := hsqrtCube + _ ≤ root * Real.sqrt t := mul_le_mul_of_nonneg_left hsqrtRootLe hroot + _ ≤ root * (4 / t + t ^ 2 / 2) := + mul_le_mul_of_nonneg_left hsqrtTCoefficient hroot + _ = (4 / t + t ^ 2 / 2) * root := mul_comm _ _ + +/-- The floor-parameter optimization in Corvaja--Zannier Theorem 4. + +The hypothesis `hPropositionTwo` is exactly the numerical alternative of +Proposition 2, supplied for every admissible pair of natural parameters. +All remaining hypotheses are elementary: positive natural degrees and Euler +characteristic, positive characteristic and real parameter, a nonnegative gcd +quantity, and its trivial upper bound by the smaller degree. -/ +theorem theoremFour_parameterizedBound_of_propositionTwo + (a b chi p : ℕ) (G t : ℝ) + (ha : 0 < a) (hab : a ≤ b) (hchi : 0 < chi) (hp : 0 < p) + (hGNonneg : 0 ≤ G) (hGTrivial : G ≤ (a : ℝ)) (ht : 0 < t) + (hPropositionTwo : PropositionTwoNumericalAlternatives a b p chi G) + (hSize : + ((a : ℝ) * (b : ℝ)) ^ 2 < + (((p : ℝ) + (a : ℝ) + (b : ℝ)) ^ 3 * (chi : ℝ)) / + (8 * t ^ 3)) : + G ≤ (4 / t + t ^ 2 / 2) * + ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by + let A : ℝ := a + let B : ℝ := b + let C : ℝ := chi + let P : ℝ := p + let base : ℝ := A * B * C + let baseRoot : ℝ := base ^ ((1 : ℝ) / 3) + let hScale : ℝ := (B ^ 2 / (A * C)) ^ ((1 : ℝ) / 3) + let kScale : ℝ := (A ^ 2 / (B * C)) ^ ((1 : ℝ) / 3) + let xH : ℝ := t * hScale + let xK : ℝ := t * kScale + let h : ℕ := ⌊xH⌋₊ - 1 + let k : ℕ := ⌊xK⌋₊ - 1 + + have hAPos : 0 < A := by dsimp [A]; exact_mod_cast ha + have hANonnegFromG : 0 ≤ A := hGNonneg.trans (by simpa [A] using hGTrivial) + have hBPos : 0 < B := by + dsimp [B] + exact_mod_cast (lt_of_lt_of_le ha hab) + have hCPos : 0 < C := by dsimp [C]; exact_mod_cast hchi + have hPPos : 0 < P := by dsimp [P]; exact_mod_cast hp + have hAB : A ≤ B := by dsimp [A, B]; exact_mod_cast hab + have hCOne : 1 ≤ C := by + have hchiOne : 1 ≤ chi := by omega + dsimp [C] + exact_mod_cast hchiOne + have hbasePos : 0 < base := by dsimp [base]; positivity + have hbaseRootPos : 0 < baseRoot := by dsimp [baseRoot]; positivity + have hbaseRootCube : baseRoot ^ 3 = base := by + simpa [baseRoot] using rpow_one_third_cube hbasePos.le + have hhRadicandPos : 0 < B ^ 2 / (A * C) := by positivity + have hkRadicandPos : 0 < A ^ 2 / (B * C) := by positivity + have hhScalePos : 0 < hScale := by dsimp [hScale]; positivity + have hkScalePos : 0 < kScale := by dsimp [kScale]; positivity + have hhScaleCube : hScale ^ 3 = B ^ 2 / (A * C) := by + simpa [hScale] using rpow_one_third_cube hhRadicandPos.le + have hkScaleCube : kScale ^ 3 = A ^ 2 / (B * C) := by + simpa [kScale] using rpow_one_third_cube hkRadicandPos.le + have hxHPos : 0 < xH := by dsimp [xH]; positivity + have hxKPos : 0 < xK := by dsimp [xK]; positivity + + have hscaledDegrees : A * hScale = B * kScale := by + apply (pow_left_inj₀ (by positivity) (by positivity) (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [mul_pow, mul_pow, hhScaleCube, hkScaleCube] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + have hAhScaleCube : (A * hScale) ^ 3 = (A * B) ^ 2 / C := by + rw [mul_pow, hhScaleCube] + field_simp [hAPos.ne', hCPos.ne'] + have hAdivKScale : A / kScale = baseRoot := by + apply (pow_left_inj₀ (by positivity) hbaseRootPos.le + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [div_pow, hkScaleCube, hbaseRootCube] + dsimp [base] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + have hBdivHScale : B / hScale = baseRoot := by + apply (pow_left_inj₀ (by positivity) hbaseRootPos.le + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [div_pow, hhScaleCube, hbaseRootCube] + dsimp [base] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + have hscaleProduct : hScale * kScale * C = baseRoot := by + apply (pow_left_inj₀ (by positivity) hbaseRootPos.le + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [mul_pow, mul_pow, hhScaleCube, hkScaleCube, hbaseRootCube] + dsimp [base] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + + have hkScaleLeHScale : kScale ≤ hScale := by + apply le_of_pow_le_pow_left₀ (by norm_num : (3 : ℕ) ≠ 0) hhScalePos.le + rw [hkScaleCube, hhScaleCube] + apply (div_le_div_iff₀ (by positivity : 0 < B * C) + (by positivity : 0 < A * C)).2 + nlinarith [mul_nonneg (sub_nonneg.mpr hAB) + (by positivity : 0 ≤ A ^ 2 + A * B + B ^ 2)] + have hxKLeXH : xK ≤ xH := by + dsimp [xK, xH] + exact mul_le_mul_of_nonneg_left hkScaleLeHScale ht.le + have hkh : k ≤ h := by + dsimp [h, k] + exact Nat.sub_le_sub_right (Nat.floor_mono hxKLeXH) 1 + + have hSizeCross : + ((A * B) ^ 2) * (8 * t ^ 3) < (P + A + B) ^ 3 * C := by + have hdenPos : 0 < 8 * t ^ 3 := by positivity + exact (lt_div_iff₀ hdenPos).mp (by simpa [A, B, C, P] using hSize) + have hCommonCubeLt : (2 * t * (A * hScale)) ^ 3 < (P + A + B) ^ 3 := by + have hdiv : 8 * t ^ 3 * (A * B) ^ 2 / C < (P + A + B) ^ 3 := by + apply (div_lt_iff₀ hCPos).2 + nlinarith [hSizeCross] + calc + (2 * t * (A * hScale)) ^ 3 = + 8 * t ^ 3 * (A * B) ^ 2 / C := by + rw [mul_pow, mul_pow, hAhScaleCube] + norm_num + ring + _ < (P + A + B) ^ 3 := hdiv + have hCommonLt : 2 * t * (A * hScale) < P + A + B := by + exact lt_of_pow_lt_pow_left₀ 3 (by positivity) hCommonCubeLt + + by_cases hkSmall : k < 1 + · have hkZero : k = 0 := by omega + have hxKTwo : xK < 2 := by + simpa [k, hkZero] using lt_natFloor_sub_one_add_two xK + have hxKCubeLt : xK ^ 3 < (2 : ℝ) ^ 3 := + pow_lt_pow_left₀ hxKTwo hxKPos.le (by norm_num) + have htkCube : t ^ 3 * A ^ 2 / (B * C) < 8 := by + calc + t ^ 3 * A ^ 2 / (B * C) = xK ^ 3 := by + dsimp [xK] + rw [mul_pow, hkScaleCube] + ring + _ < (2 : ℝ) ^ 3 := hxKCubeLt + _ = 8 := by norm_num + have htA : t ^ 3 * A ^ 2 < 8 * (B * C) := + (div_lt_iff₀ (by positivity : 0 < B * C)).mp htkCube + have htACube : t ^ 3 * A ^ 3 < 8 * base := by + have := mul_lt_mul_of_pos_left htA hAPos + dsimp [base] + nlinarith + have hACube : A ^ 3 < 8 * base / t ^ 3 := by + apply (lt_div_iff₀ (by positivity : 0 < t ^ 3)).2 + simpa [mul_comm] using htACube + have hsmallCube : (2 / t * baseRoot) ^ 3 = 8 * base / t ^ 3 := by + rw [mul_pow, div_pow, hbaseRootCube] + norm_num + field_simp [ht.ne'] + have hASmall : A < 2 / t * baseRoot := by + have hsmallNonneg : 0 ≤ 2 / t * baseRoot := by positivity + apply lt_of_pow_lt_pow_left₀ 3 hsmallNonneg + rwa [hsmallCube] + calc + G ≤ A := by simpa [A] using hGTrivial + _ ≤ 2 / t * baseRoot := hASmall.le + _ ≤ (4 / t + t ^ 2 / 2) * baseRoot := by + apply mul_le_mul_of_nonneg_right _ hbaseRootPos.le + calc + 2 / t ≤ 4 / t := + div_le_div_of_nonneg_right (by norm_num) ht.le + _ ≤ 4 / t + t ^ 2 / 2 := le_add_of_nonneg_right (by positivity) + _ = (4 / t + t ^ 2 / 2) * + ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by + simp [baseRoot, base, A, B, C] + · have hkPos : 0 < k := by omega + have hhPos : 0 < h := lt_of_lt_of_le hkPos hkh + have hkFloorOne : 1 ≤ ⌊xK⌋₊ := by + dsimp [k] at hkPos + omega + have hhFloorOne : 1 ≤ ⌊xH⌋₊ := by + dsimp [h] at hhPos + omega + have hkFloorUpper : ((k : ℝ) + 1) ≤ xK := by + simpa [k] using natFloor_sub_one_add_one_le hxKPos.le hkFloorOne + have hhFloorUpper : ((h : ℝ) + 1) ≤ xH := by + simpa [h] using natFloor_sub_one_add_one_le hxHPos.le hhFloorOne + have hParameterReal : A * (h : ℝ) + B * (k : ℝ) < P := by + have hhUpper : (h : ℝ) ≤ xH - 1 := by linarith + have hkUpper : (k : ℝ) ≤ xK - 1 := by linarith + have hweighted : + A * (h : ℝ) + B * (k : ℝ) ≤ + A * (xH - 1) + B * (xK - 1) := by + exact add_le_add + (mul_le_mul_of_nonneg_left hhUpper hAPos.le) + (mul_le_mul_of_nonneg_left hkUpper hBPos.le) + have hweightedIdentity : + A * (xH - 1) + B * (xK - 1) = + 2 * t * (A * hScale) - A - B := by + dsimp [xH, xK] + calc + A * (t * hScale - 1) + B * (t * kScale - 1) = + t * (A * hScale) + t * (B * kScale) - A - B := by ring + _ = 2 * t * (A * hScale) - A - B := by + rw [← hscaledDegrees] + ring + rw [hweightedIdentity] at hweighted + linarith + have hParameterNat : a * h + b * k < p := by + dsimp [A, B, P] at hParameterReal + exact_mod_cast hParameterReal + have hnPos : 0 < h * k + h + k := by omega + have hAlternative := hPropositionTwo h k ⟨hnPos, hParameterNat⟩ + rcases hAlternative with hDegrees | hNumerical + · have hbLeH : b ≤ h := hDegrees.2 + have hBLtXH : B < xH := by + have hbCast : B ≤ (h : ℝ) := by + dsimp [B] + exact_mod_cast hbLeH + calc + B ≤ (h : ℝ) := hbCast + _ < (h : ℝ) + 1 := by norm_num + _ ≤ xH := hhFloorUpper + have hrootLtT : baseRoot < t := by + rw [← hBdivHScale] + apply (div_lt_iff₀ hhScalePos).2 + simpa [xH, mul_comm] using hBLtXH + have hASqLeBase : A ^ 2 ≤ base := by + have hAASq : A ^ 2 ≤ A * B := by + rw [pow_two] + exact mul_le_mul_of_nonneg_left hAB hAPos.le + have hABNonneg : 0 ≤ A * B := by positivity + have hABLe : A * B ≤ A * B * C := by + calc + A * B = (A * B) * 1 := (mul_one _).symm + _ ≤ (A * B) * C := mul_le_mul_of_nonneg_left hCOne hABNonneg + exact hAASq.trans hABLe + have hASqLeRootCube : A ^ 2 ≤ baseRoot ^ 3 := by + calc + A ^ 2 ≤ base := hASqLeBase + _ = baseRoot ^ 3 := hbaseRootCube.symm + have hADegreeBound : + A ≤ (4 / t + t ^ 2 / 2) * baseRoot := + degree_le_theoremFour_bound_of_sq_le_cube (degree := A) (root := baseRoot) (t := t) + hANonnegFromG hbaseRootPos.le ht hASqLeRootCube hrootLtT.le + calc + G ≤ A := by change G ≤ (a : ℝ); exact hGTrivial + _ ≤ (4 / t + t ^ 2 / 2) * baseRoot := hADegreeBound + _ = (4 / t + t ^ 2 / 2) * + ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by + rfl + · let H : ℝ := h + let K : ℝ := k + let N : ℝ := h * k + h + k + have hKPos : 0 < K := by dsimp [K]; exact_mod_cast hkPos + have hKLeH : K ≤ H := by dsimp [K, H]; exact_mod_cast hkh + have hNPos : 0 < N := by dsimp [N]; exact_mod_cast hnPos + have hFirstCoefficient : (H + 2 * K) / N ≤ 3 / (K + 2) := by + simpa [H, K, N, Nat.cast_add, Nat.cast_mul] using + propositionTwo_first_coefficient_le hKPos hKLeH + have hSecondCoefficient : K / N ≤ 1 / (H + 2) := by + simpa [H, K, N, Nat.cast_add, Nat.cast_mul] using + propositionTwo_second_coefficient_le hKPos hKLeH + have hxKDenominator : xK ≤ K + 2 := by + simpa [K, k] using (lt_natFloor_sub_one_add_two xK).le + have hxHDenominator : xH ≤ H + 2 := by + simpa [H, h] using (lt_natFloor_sub_one_add_two xH).le + have hADiv : A / (K + 2) ≤ baseRoot / t := by + calc + A / (K + 2) ≤ A / xK := + div_le_div_of_nonneg_left hAPos.le hxKPos hxKDenominator + _ = baseRoot / t := by + dsimp [xK] + rw [show A / (t * kScale) = (A / kScale) / t by + field_simp [ht.ne', hkScalePos.ne']] + rw [hAdivKScale] + have hBDiv : B / (H + 2) ≤ baseRoot / t := by + calc + B / (H + 2) ≤ B / xH := + div_le_div_of_nonneg_left hBPos.le hxHPos hxHDenominator + _ = baseRoot / t := by + dsimp [xH] + rw [show B / (t * hScale) = (B / hScale) / t by + field_simp [ht.ne', hhScalePos.ne']] + rw [hBdivHScale] + have hFirstTerm : ((H + 2 * K) / N) * A ≤ (3 / t) * baseRoot := by + calc + ((H + 2 * K) / N) * A ≤ (3 / (K + 2)) * A := + mul_le_mul_of_nonneg_right hFirstCoefficient hAPos.le + _ = 3 * (A / (K + 2)) := by ring + _ ≤ 3 * (baseRoot / t) := + mul_le_mul_of_nonneg_left hADiv (by norm_num) + _ = (3 / t) * baseRoot := by ring + have hSecondTerm : (K / N) * B ≤ (1 / t) * baseRoot := by + calc + (K / N) * B ≤ (1 / (H + 2)) * B := + mul_le_mul_of_nonneg_right hSecondCoefficient hBPos.le + _ = B / (H + 2) := by ring + _ ≤ baseRoot / t := hBDiv + _ = (1 / t) * baseRoot := by ring + have hFloorProduct : (H + 1) * (K + 1) ≤ xH * xK := by + have hhFloorUpper' : H + 1 ≤ xH := by simpa [H] using hhFloorUpper + have hkFloorUpper' : K + 1 ≤ xK := by simpa [K] using hkFloorUpper + exact mul_le_mul hhFloorUpper' hkFloorUpper' (by positivity) (by positivity) + have hThirdNumerator : N - 1 ≤ (H + 1) * (K + 1) := by + dsimp [N, H, K] + ring_nf + norm_num + have hThirdTerm : ((N - 1) / 2) * C ≤ (t ^ 2 / 2) * baseRoot := by + calc + ((N - 1) / 2) * C ≤ (((H + 1) * (K + 1)) / 2) * C := by + gcongr + _ ≤ ((xH * xK) / 2) * C := by + gcongr + _ = (t ^ 2 / 2) * baseRoot := by + dsimp [xH, xK] + rw [← hscaleProduct] + ring + have hNumerical' : + G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := by + simpa [H, K, N, A, B, C, Nat.cast_add, Nat.cast_mul] using hNumerical + calc + G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := + hNumerical' + _ ≤ (3 / t) * baseRoot + (1 / t) * baseRoot + + (t ^ 2 / 2) * baseRoot := by linarith + _ = (4 / t + t ^ 2 / 2) * baseRoot := by ring + _ = (4 / t + t ^ 2 / 2) * + ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by + simp [baseRoot, base, A, B, C] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean new file mode 100644 index 0000000000..cd893bc04c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean @@ -0,0 +1,53 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +import Mathlib.FieldTheory.Perfect + +/-! +# Perfect constants inside the Frobenius subfield + +The Section 5 specialization of Corvaja--Zannier works over a perfect +constant field. Consequently every constant, after embedding in the curve +function field, is a `p`-th power and belongs to the Frobenius subfield. +This file records that compatibility without identifying the two fields. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K L : Type*} [Field K] [Field L] {p : ℕ} + [Fact p.Prime] [CharP K p] [CharP L p] [PerfectField K] [Algebra K L] + +/-- Constants from a perfect field land in the Frobenius subfield of every +field extension of the same prime characteristic. -/ +theorem algebraMap_mem_frobeniusSubfield (c : K) : + algebraMap K L c ∈ frobeniusSubfield L p := by + refine ⟨algebraMap K L ((frobeniusEquiv K p).symm c), ?_⟩ + simp only [frobenius_def] + rw [← map_pow, frobeniusEquiv_symm_pow_p] + +/-- The constant-field embedding, with codomain restricted to the Frobenius +subfield. -/ +def perfectConstantsToFrobeniusSubfield : K →+* frobeniusSubfield L p := + (algebraMap K L).codRestrict (frobeniusSubfield L p) + (fun c ↦ algebraMap_mem_frobeniusSubfield c) + +@[simp] +theorem coe_perfectConstantsToFrobeniusSubfield (c : K) : + ((perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) c : + frobeniusSubfield L p) : L) = algebraMap K L c := + rfl + +theorem perfectConstantsToFrobeniusSubfield_injective : + Function.Injective + (perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p)) := + (perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p)).injective + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean new file mode 100644 index 0000000000..ab0b8cc122 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean @@ -0,0 +1,591 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +import Mathlib.NumberTheory.FunctionField + +/-! +# Auxiliary Wronskian bounds at finite plane-curve places + +This file connects the uniformizer-free local Corvaja--Zannier estimates to +the actual finite primes of the integral closure in a finite extension of +`K(X)`. The constants used for the local derivation-extension step are the +ground field `K`; the Wronskian derivation may subsequently be obtained by +restricting scalars from the Frobenius constant field. Thus no algebra map +from the Frobenius constant field to a nontrivial DVR is required. +-/ + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +/-! ## The unramified local-preservation bridge -/ + +/-- Outside the different, the ambient derivation preserves the selected +extension DVR. This is the existential-preservation form consumed by the +uniformizer-free Wronskian estimates. In the plane-curve application `C` is +the ground field `K` (after restricting scalars from `L^p`), so all local +algebra structures here are genuine; no map `L^p → B_Q` is requested. -/ +theorem dedekindLocal_ambientDerivation_preserves_of_not_dvd_different + {A B C U : Type*} + [CommRing A] [CommRing B] [CommRing C] [CommRing U] + [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] + [Algebra.IsSeparable (FractionRing A) (FractionRing B)] + (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] + [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] + [Localization.AtPrime.IsLiesOverAlgebra p Q] + [Algebra C (Localization.AtPrime p)] + [Algebra C (Localization.AtPrime Q)] + [Algebra C U] + [Algebra (Localization.AtPrime p) U] + [Algebra (Localization.AtPrime Q) U] + [IsScalarTower C (Localization.AtPrime p) (Localization.AtPrime Q)] + [IsScalarTower C (Localization.AtPrime p) U] + [IsScalarTower C (Localization.AtPrime Q) U] + [IsScalarTower (Localization.AtPrime p) (Localization.AtPrime Q) U] + (hQ : ¬ Q ∣ differentIdeal A B) + (D : Derivation C (Localization.AtPrime p) (Localization.AtPrime p)) + (E : Derivation C U U) + (hE : ∀ s : Localization.AtPrime p, + E (algebraMap (Localization.AtPrime p) U s) = + algebraMap (Localization.AtPrime p) U (D s)) : + ∀ t : Localization.AtPrime Q, ∃ t' : Localization.AtPrime Q, + E (algebraMap (Localization.AtPrime Q) U t) = + algebraMap (Localization.AtPrime Q) U t' := by + obtain ⟨D', _hD', hpres⟩ := + dedekindLocal_derivation_preserves_of_not_dvd_different + p Q hQ D E hE + intro t + exact ⟨D' t, hpres t⟩ + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) auxiliaryFinitePlacePolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance auxiliaryFinitePlacePolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + .of_algebraMap_eq' rfl + +local instance auxiliaryFinitePlaceFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance auxiliaryFinitePlaceFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (FunctionField.ringOfIntegers K L) := + Module.IsNoetherian.finite K[X] (FunctionField.ringOfIntegers K L) + +local instance auxiliaryFinitePlacePolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance auxiliaryFinitePlaceFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance auxiliaryFinitePlaceFiniteIntegralClosureIsDedekindDomain : + IsDedekindDomain (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (FunctionField.ringOfIntegers K L) + +/-- The actual finite places of `L / K(X)`, before adjoining the places over +infinity. This is definitionally the finite summand used by the exhaustive +place infrastructure. -/ +abbrev PlaneCurveExtensionFinitePlace := + HeightOneSpectrum (FunctionField.ringOfIntegers K L) + +abbrev FiniteExtensionFinitePlaceBaseLocalRing + (q : PlaneCurveExtensionFinitePlace K L) := + Localization.AtPrime (HeightOneSpectrum.under K[X] q).asIdeal + +abbrev FiniteExtensionFinitePlaceLocalRing + (q : PlaneCurveExtensionFinitePlace K L) := + Localization.AtPrime q.asIdeal + +section LocalOrder + +variable {K L} + +/-- Canonical inclusion of the localization at an actual finite extension +place into the ambient function field. -/ +noncomputable def finiteExtensionFinitePlaceLocalizationToField + (q : PlaneCurveExtensionFinitePlace K L) : + FiniteExtensionFinitePlaceLocalRing K L q →+* L := + IsLocalization.lift + (S := FiniteExtensionFinitePlaceLocalRing K L q) + (M := q.asIdeal.primeCompl) + (g := algebraMap (FunctionField.ringOfIntegers K L) L) fun y => + IsLocalization.map_units L + ⟨y.1, q.asIdeal.primeCompl_le_nonZeroDivisors y.2⟩ + +omit [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra.IsSeparable (RatFunc K) L] in +@[simp] theorem finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (q : PlaneCurveExtensionFinitePlace K L) : + (finiteExtensionFinitePlaceLocalizationToField (K := K) (L := L) q).comp + (algebraMap (FunctionField.ringOfIntegers K L) + (FiniteExtensionFinitePlaceLocalRing K L q)) = + algebraMap (FunctionField.ringOfIntegers K L) L := by + exact IsLocalization.lift_comp _ + +/-- The canonical algebra structure on the ambient function field from the +localized finite-place DVR. -/ +@[reducible] noncomputable def finiteExtensionFinitePlaceLocalAlgebra + (q : PlaneCurveExtensionFinitePlace K L) : + Algebra (FiniteExtensionFinitePlaceLocalRing K L q) L := + (finiteExtensionFinitePlaceLocalizationToField (K := K) (L := L) q).toAlgebra + +omit [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra.IsSeparable (RatFunc K) L] in +/-- The ambient function field is the fraction field of every finite-place +localization. -/ +theorem finiteExtensionFinitePlaceLocalIsFractionRing + (q : PlaneCurveExtensionFinitePlace K L) : + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + IsFractionRing (FiniteExtensionFinitePlaceLocalRing K L q) L := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI : IsScalarTower (FunctionField.ringOfIntegers K L) + (FiniteExtensionFinitePlaceLocalRing K L q) L := by + apply IsScalarTower.of_algebraMap_eq' + exact (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q).symm + exact IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + q.asIdeal.primeCompl (FiniteExtensionFinitePlaceLocalRing K L q) L + +/-- The normalized order on the localization at an actual finite place of +`L / K(X)`. Keeping this definition attached to `q` avoids introducing a +spurious algebra structure from the Frobenius constant field to the DVR. -/ +noncomputable def finiteExtensionFinitePlaceLocalOrderTop + (q : PlaneCurveExtensionFinitePlace K L) + (x : L) : WithTop ℤ := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + exact finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) x + +/-- Integer-valued form of the localized order. -/ +noncomputable def finiteExtensionFinitePlaceLocalOrder + (q : PlaneCurveExtensionFinitePlace K L) + (x : L) : ℤ := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + exact finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) x + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- The order used by the actual localized DVR bound is exactly the global +height-one order of the same finite place. -/ +theorem finiteExtensionFinitePlaceLocalOrder_eq_globalOrder + (q : PlaneCurveExtensionFinitePlace K L) (x : L) : + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q x = + finitePlaceOrder q x := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + letI : IsScalarTower (FunctionField.ringOfIntegers K L) + (FiniteExtensionFinitePlaceLocalRing K L q) L := by + apply IsScalarTower.of_algebraMap_eq' + exact (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q).symm + change finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) x = _ + exact localizationAtPrime_finitePlaceOrder_eq q x + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Nonzero localized `WithTop` orders are the corresponding global +height-one orders. -/ +theorem finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder + (q : PlaneCurveExtensionFinitePlace K L) (x : L) (hx : x ≠ 0) : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q x = + (finitePlaceOrder q x : WithTop ℤ) := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + simp only [finiteExtensionFinitePlaceLocalOrderTop] + rw [finitePlaceOrderTop_eq_coe _ _ hx] + exact_mod_cast + finiteExtensionFinitePlaceLocalOrder_eq_globalOrder + (K := K) (L := L) q x + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +@[simp] theorem finiteExtensionFinitePlaceLocalOrderTop_mul + (q : PlaneCurveExtensionFinitePlace K L) (x y : L) : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (x * y) = + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q x + + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q y := by + simp only [finiteExtensionFinitePlaceLocalOrderTop, + finitePlaceOrderTop_mul] + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +@[simp] theorem finiteExtensionFinitePlaceLocalOrderTop_pow + (q : PlaneCurveExtensionFinitePlace K L) (x : L) (n : ℕ) : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (x ^ n) = + n • finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q x := by + simp only [finiteExtensionFinitePlaceLocalOrderTop, + finitePlaceOrderTop_pow] + +variable {C : Type*} [Field C] [Algebra C L] + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Source case (iii), now indexed by an actual finite place of the integral +closure. The sole local hypothesis says that the derivation preserves the +localized DVR; it does not ask for an algebra map `C → R_q`. -/ +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (D : Derivation C L L) + (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q u + + (h * k) • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q v + + k • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + have hDIntegral' : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (algebraMap (FiniteExtensionFinitePlaceLocalRing K L q) L r) = + algebraMap (FiniteExtensionFinitePlaceLocalRing K L q) L s := by + intro r + obtain ⟨s, hs⟩ := hDIntegral r + exact ⟨s, hs⟩ + exact finitePlaceOrderTop_auxiliaryFamily_caseIII_source_lower_bound_of_preserves + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) + D hDIntegral' h k epsilon u v hu hv hu1 hv1 + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Source case (iv), indexed by an actual finite place of the integral +closure and requiring only preservation of its localized DVR. -/ +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (D : Derivation C L L) + (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q u + + k • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + have hDIntegral' : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (algebraMap (FiniteExtensionFinitePlaceLocalRing K L q) L r) = + algebraMap (FiniteExtensionFinitePlaceLocalRing K L q) L s := by + intro r + obtain ⟨s, hs⟩ := hDIntegral r + exact ⟨s, hs⟩ + exact finitePlaceOrderTop_auxiliaryFamily_caseIV_source_lower_bound_of_preserves + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) + D hDIntegral' h k epsilon u v hu hv hu1 hv1 + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Source case (iii) for a global derivation after multiplying it by the +local correction factor `c`. The displayed right side has been transported +back to the original global Wronskian and records the exact triangular +correction `choose(n,2) * ord_q(c)`. -/ +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_scaled_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (h k : ℕ) + {n : ℕ} (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilon i = (e i : ℕ)) + (D : Derivation C L L) (c : L) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q u + + (h * k) • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q v + + k • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q c + + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_preserves + (K := K) (L := L) q (c • D) hScaledIntegral + h k epsilon u v hu hv hu1 hv1 + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilon hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + rw [hchange, finiteExtensionFinitePlaceLocalOrderTop_mul, + finiteExtensionFinitePlaceLocalOrderTop_pow] at hbound + exact hbound + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Source case (iv) with the same exact local correction term. -/ +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_scaled_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (h k : ℕ) + {n : ℕ} (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilon i = (e i : ℕ)) + (D : Derivation C L L) (c : L) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q u + + k • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q c + + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_preserves + (K := K) (L := L) q (c • D) hScaledIntegral + h k epsilon u v hu hv hu1 hv1 + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilon hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + rw [hchange, finiteExtensionFinitePlaceLocalOrderTop_mul, + finiteExtensionFinitePlaceLocalOrderTop_pow] at hbound + exact hbound + +section RestrictConstants + +variable [Algebra K C] [Algebra K L] [IsScalarTower K C L] + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Case (iii) for a derivation over a larger constant field (in the +application, `C = L^p`). The proof restricts scalars to `K` before invoking +the local DVR theorem, while the displayed Wronskian is still the original +`C`-derivation Wronskian because restriction does not change its function. -/ +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_restrictScalars_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (D : Derivation C L L) + (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q u + + (h * k) • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q v + + k • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_preserves + (K := K) (L := L) q (D.restrictScalars K) hDIntegral + h k epsilon u v hu hv hu1 hv1 + have hmatrix : + indexedDedekindLocalWronskian (D.restrictScalars K) epsilon + (auxiliaryFamily u v h k) = + indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k) := by + ext i j + rfl + rw [hmatrix] at hbound + exact hbound + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Case (iv) after the same honest restriction of constants from `C` to +the ground field `K`. -/ +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_restrictScalars_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (D : Derivation C L L) + (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) + (hu1 : u ≠ 1) (hv1 : v ≠ 1) : + (((k * (k - 1) / 2 : ℕ) • + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q u + + k • finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) + + ∑ rs : Fin (k + 1) × Fin h, + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) - + ∑ i, (epsilon i : ℤ) : ℤ) : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_preserves + (K := K) (L := L) q (D.restrictScalars K) hDIntegral + h k epsilon u v hu hv hu1 hv1 + have hmatrix : + indexedDedekindLocalWronskian (D.restrictScalars K) epsilon + (auxiliaryFamily u v h k) = + indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k) := by + ext i j + rfl + rw [hmatrix] at hbound + exact hbound + +end RestrictConstants + +end LocalOrder + +/-! ## Plane-curve reciprocal normalization at a selected extension place -/ + +section PlaneCurve + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- The reciprocal minimal-polynomial normalization, with the base prime +selected as the prime lying below an actual finite place of the plane-curve +function field. This is the local primitive-element/different certificate +paired with the Wronskian estimates above. -/ +theorem planeCurve_minpoly_reciprocal_local_normalization_at_finiteExtensionPlace + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + ∀ q : PlaneCurveExtensionFinitePlace K (PlaneCurveFunctionField f), + let p := HeightOneSpectrum.under K[X] q + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + ∃ (a : Polynomial K) (u : Aˣ), + let c := algebraMap (Polynomial K) A a + let G := (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) A) + minpoly (RatFunc K) + ((planeCurveFunction f 1 - + algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c))⁻¹) = + (unitNormalizedReciprocalTranslate G c u).map ι := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + exact fun q => + planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_fintypeCard + hf hpartialSecond hcardK (HeightOneSpectrum.under K[X] q) + +end PlaneCurve + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean new file mode 100644 index 0000000000..3494f65502 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean @@ -0,0 +1,343 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula + +/-! +# Cases I and II at actual finite extension places + +This file supplies the regular-element lifting, finite/perfect residue-field +bridge, and scaled-derivation forms of the first two local +Corvaja--Zannier Wronskian estimates. +-/ + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) tempPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance tempPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := .of_algebraMap_eq' rfl + +local instance tempFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance tempFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (FunctionField.ringOfIntegers K L) := + Module.IsNoetherian.finite K[X] (FunctionField.ringOfIntegers K L) + +local instance tempPolynomialTorsionFreeTop : Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance tempFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance tempFiniteIntegralClosureIsDedekindDomain : + IsDedekindDomain (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (FunctionField.ringOfIntegers K L) + +variable {K L} + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (q : PlaneCurveExtensionFinitePlace K L) (x : L) + (hx : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q x) : + ∃ x₀ : FiniteExtensionFinitePlaceLocalRing K L q, + x = finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q x₀ := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + by_cases hx0 : x = 0 + · exact ⟨0, by simp [hx0]⟩ + have horder : 0 ≤ finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) x := by + simpa only [finiteExtensionFinitePlaceLocalOrderTop, + finitePlaceOrderTop_eq_coe _ _ hx0, WithTop.coe_nonneg] using hx + have hval : + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)).valuation L x ≤ 1 := by + rw [valuation_eq_exp_neg_finitePlaceOrder _ x hx0] + simpa only [← WithZero.exp_zero] using + (WithZero.exp_le_exp.mpr (by omega : + -finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) x ≤ 0)) + obtain ⟨x₀, hx₀⟩ := IsDiscreteValuationRing.exists_lift_of_le_one hval + exact ⟨x₀, hx₀.symm⟩ + +variable {C : Type*} [Field C] [Algebra C L] + +omit [DecidableEq (RatFunc K)] in +theorem ratFuncFinitePlace_residueField_finite [Fintype K] + (p : HeightOneSpectrum K[X]) : + Finite p.asIdeal.ResidueField := by + let r := finitePlaceNormalizedPrime p + have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero + have hrmonic : (r : K[X]).Monic := + (Polynomial.normalize_eq_self_iff_monic hr0).mp r.property.2 + have hp : p.asIdeal = Ideal.span ({(r : K[X])} : Set K[X]) := by + calc + p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by + rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] + _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl + letI : Module.Finite K + (HasQuotient.Quotient K[X] p.asIdeal) := by + rw [hp] + exact hrmonic.finite_quotient + letI : Finite (HasQuotient.Quotient K[X] p.asIdeal) := + Module.finite_of_finite K + infer_instance + +omit [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlace_residueField_finite [Fintype K] + (q : PlaneCurveExtensionFinitePlace K L) : + Finite q.asIdeal.ResidueField := by + let p := HeightOneSpectrum.under K[X] q + letI : Finite p.asIdeal.ResidueField := + ratFuncFinitePlace_residueField_finite p + letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance + letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := + inferInstance + exact Module.finite_of_finite p.asIdeal.ResidueField + +omit [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlaceLocal_residueField_perfect [Fintype K] + (q : PlaneCurveExtensionFinitePlace K L) : + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + PerfectField + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := by + letI : Finite q.asIdeal.ResidueField := + finiteExtensionFinitePlace_residueField_finite q + letI : Finite (HasQuotient.Quotient + (FunctionField.ringOfIntegers K L) q.asIdeal) := + Finite.of_injective + (algebraMap + (HasQuotient.Quotient (FunctionField.ringOfIntegers K L) q.asIdeal) + q.asIdeal.ResidueField) + q.asIdeal.injective_algebraMap_quotient_residueField + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + let e := IsLocalization.AtPrime.equivQuotMaximalIdeal q.asIdeal + (FiniteExtensionFinitePlaceLocalRing K L q) + letI : Finite (HasQuotient.Quotient + (FiniteExtensionFinitePlaceLocalRing K L q) + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal) := + Finite.of_injective e.symm e.symm.injective + let Rq := HasQuotient.Quotient + (FiniteExtensionFinitePlaceLocalRing K L q) + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal + letI : Finite + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := + IsLocalization.finite Rq (nonZeroDivisors Rq) + exact PerfectField.ofFinite + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseII_nonnegative_of_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (D : Derivation C L L) + (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + D (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (h k : ℕ) (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (u v : L) + (hu : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q u) + (hv : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q v) + (hrho : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + ((1 - u) / (1 - v))) : + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + apply finitePlaceOrderTop_auxiliaryFamily_caseII_nonnegative_of_integral + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) D hDIntegral h k epsilon u v + · obtain ⟨u₀, hu₀⟩ := + finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative q u hu + exact ⟨u₀, hu₀⟩ + · obtain ⟨v₀, hv₀⟩ := + finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative q v hv + exact ⟨v₀, hv₀⟩ + · obtain ⟨rho₀, hrho₀⟩ := + finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + q ((1 - u) / (1 - v)) hrho + exact ⟨rho₀, hrho₀⟩ + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseII_nonnegative_of_scaled_preserves + (q : PlaneCurveExtensionFinitePlace K L) + (h k : ℕ) {n : ℕ} + (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilon : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilon i = (e i : ℕ)) + (D : Derivation C L L) (c : L) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (u v : L) + (hu : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q u) + (hv : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q v) + (hrho : (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + ((1 - u) / (1 - v))) : + (0 : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q c + + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilon + (auxiliaryFamily u v h k)).det := by + have hbound := + finiteExtensionFinitePlace_auxiliaryFamily_caseII_nonnegative_of_preserves + q (c • D) hScaledIntegral h k epsilon u v hu hv hrho + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilon hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + rw [hchange, finiteExtensionFinitePlaceLocalOrderTop_mul, + finiteExtensionFinitePlaceLocalOrderTop_pow] at hbound + exact hbound + +variable {p : ℕ} [Fact p.Prime] [CharP L p] + +omit [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlace_auxiliaryFamily_caseI_q_wronskian_bound_of_scaled_preserves + [Fintype K] + (q : PlaneCurveExtensionFinitePlace K L) + (h k : ℕ) {n : ℕ} + (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) + (epsilonOrder : Sum (Fin k) (Fin (k + 1) × Fin h) → ℕ) + (hepsilon : ∀ i, epsilonOrder i = (e i : ℕ)) + (epsilon qBound : ℕ) + (D : Derivation (frobeniusSubfield L p) L L) (c : L) + (hScaledIntegral : + ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, + ∃ s : FiniteExtensionFinitePlaceLocalRing K L q, + (c • D) (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q r) = + finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q s) + (u v : L) + (hrhoNe : (1 - u) / (1 - v) ≠ 0) + (huOrder : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q u = 0) + (hrhoOrder : + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) < 0) + (hgridRegular : ∀ rs : Fin (k + 1) × Fin h, + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ))) + (hepsilonInjective : Function.Injective epsilonOrder) + (hepsilonMax : ∀ i, epsilonOrder i ≤ epsilon) + (hk : k ≤ epsilon + 1) (hepsilonQ : epsilon + 1 ≤ qBound) : + (((qBound : ℤ) * + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q c + + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u v h k)).det := by + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsDiscreteValuationRing + (FiniteExtensionFinitePlaceLocalRing K L q) := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (FunctionField.ringOfIntegers K L) q.ne_bot + (FiniteExtensionFinitePlaceLocalRing K L q) + letI : CharP (FiniteExtensionFinitePlaceLocalRing K L q) p := ⟨by + intro n + rw [← map_eq_zero_iff + (finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q) + (by + change Function.Injective + (algebraMap (FiniteExtensionFinitePlaceLocalRing K L q) L) + exact IsFractionRing.injective + (FiniteExtensionFinitePlaceLocalRing K L q) L), + map_natCast, CharP.cast_eq_zero_iff L p]⟩ + letI : PerfectField + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := + finiteExtensionFinitePlaceLocal_residueField_perfect q + obtain ⟨A, hAdet, hdet, hbound⟩ := + exists_frobeniusSubfield_dedekindAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue + (p := p) + (IsDiscreteValuationRing.maximalIdeal + (FiniteExtensionFinitePlaceLocalRing K L q)) + (c • D) hScaledIntegral u v h k epsilonOrder epsilon qBound + hrhoNe huOrder hrhoOrder hgridRegular hepsilonInjective + hepsilonMax hk hepsilonQ + have hchange := indexedDedekindLocalWronskian_det_changeParameter + e epsilonOrder hepsilon (c • D) D c rfl (auxiliaryFamily u v h k) + rw [hchange, finitePlaceOrderTop_mul, finitePlaceOrderTop_pow] at hbound + change (((qBound : ℤ) * + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q + ((1 - u) / (1 - v)) : ℤ) : WithTop ℤ) ≤ + n.choose 2 • + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q c + + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q + (indexedDedekindLocalWronskian D epsilonOrder + (auxiliaryFamily u v h k)).det at hbound + exact hbound + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean new file mode 100644 index 0000000000..087880d17f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace + +/-! +# Actual finite-place auxiliary orders in the exhaustive divisor model + +This file keeps the local DVR construction independent of the heavier +exhaustive-place infrastructure, then identifies its normalized order with +the coefficient used by the global principal divisor. +-/ + +open scoped Polynomial +open IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) auxiliaryFinitePlaceBridgePolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance auxiliaryFinitePlaceBridgePolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + .of_algebraMap_eq' rfl + +local instance auxiliaryFinitePlaceBridgeIntegralClosureIsDedekindDomain : + IsDedekindDomain (FunctionField.ringOfIntegers K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (FunctionField.ringOfIntegers K L) + +/-- The actual localized finite-place order is exactly the coefficient in +the exhaustive finite principal divisor. -/ +theorem finiteExtensionFinitePlaceLocalOrder_eq_principalDivisor + (q : PlaneCurveExtensionFinitePlace K L) (x : L) : + finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q x = + finiteExtensionFinitePrincipalDivisor K L x q := by + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + finiteExtensionFinitePrincipalDivisor_apply] + have h := fractionRingAlgEquiv_finitePlaceOrder_eq + (L := L) q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) + simpa [ratFuncFiniteIntegralClosureFractionRingEquiv] using h + +/-- For a nonzero element, the `WithTop` order appearing in the local +Wronskian inequality is the exhaustive principal-divisor coefficient. -/ +theorem finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + (q : PlaneCurveExtensionFinitePlace K L) (x : L) (hx : x ≠ 0) : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q x = + (finiteExtensionFinitePrincipalDivisor K L x q : WithTop ℤ) := by + rw [finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder q x hx] + have horder := + finiteExtensionFinitePlaceLocalOrder_eq_principalDivisor K L q x + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder] at horder + exact_mod_cast horder + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean new file mode 100644 index 0000000000..d5083a9a48 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean @@ -0,0 +1,553 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius + +/-! +# The plane-curve auxiliary family over the Frobenius subfield + +This file specializes the algebraic resultant argument in +`BivariateGauss.lean` to the function field of an irreducible affine plane +curve over a perfect field of prime characteristic. Constants are embedded +in the Frobenius subfield `L^p`, and separability over a coordinate rational +subfield is promoted to separability over `L^p` adjoined with that coordinate. + +The only irreducibility hypothesis retained at the final boundary is the +literal base change of the defining equation from the constant field to +`L^p`. This is the precise consequence of absolute irreducibility used in +Corvaja--Zannier's Proposition 1; it is not replaced by an unrelated +typeclass or by an axiom. + +Source provenance: published pages 1933--1934; checked semantic reconstruction +`Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 486--571. The +specialization with Frobenius exponent `p` and no auxiliary twists is the +linear-independence input cited on published page 1940. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- View a polynomial in affine coordinates `0,1` as a polynomial in +coordinate `0` whose coefficients are ordinary polynomials in coordinate +`1`. -/ +def planeCurveToBivariate (K : Type*) [Field K] : + MvPolynomial (Fin 2) K ≃ₐ[K] Polynomial (Polynomial K) := + (MvPolynomial.finSuccEquiv K 1).trans + (Polynomial.mapAlgEquiv (MvPolynomial.uniqueAlgEquiv K (Fin 1))) + +@[simp] +theorem planeCurveToBivariate_X_zero + (K : Type*) [Field K] : + planeCurveToBivariate K (MvPolynomial.X 0) = Polynomial.X := by + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 0) = + (Polynomial.X : Polynomial (MvPolynomial (Fin 1) K)) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp + rw [planeCurveToBivariate] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 0)) = Polynomial.X + rw [hinner] + simp + +@[simp] +theorem planeCurveToBivariate_X_one + (K : Type*) [Field K] : + planeCurveToBivariate K (MvPolynomial.X 1) = + Polynomial.C Polynomial.X := by + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 1) = + Polynomial.C (MvPolynomial.X (0 : Fin 1)) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp only [MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_X] + rw [show (1 : Fin 2) = Fin.succ (0 : Fin 1) by decide] + rfl + rw [planeCurveToBivariate] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 1)) = + Polynomial.C Polynomial.X + rw [hinner] + simp [MvPolynomial.uniqueAlgEquiv] + +@[simp] +theorem planeCurveToBivariate_C + (K : Type*) [Field K] (c : K) : + planeCurveToBivariate K (MvPolynomial.C c) = + Polynomial.C (Polynomial.C c) := by + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.C c) = + Polynomial.C (MvPolynomial.C c) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp + rw [planeCurveToBivariate] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 (MvPolynomial.C c)) = + Polynomial.C (Polynomial.C c) + rw [hinner] + simp [MvPolynomial.uniqueAlgEquiv] + +/-- The outer degree of the source-oriented iterated presentation is exactly +the degree in coordinate `0`. -/ +theorem planeCurveToBivariate_natDegree_eq_degreeOf_zero + (K : Type*) [Field K] (f : MvPolynomial (Fin 2) K) : + (planeCurveToBivariate K f).natDegree = + MvPolynomial.degreeOf 0 f := by + rw [planeCurveToBivariate] + change + ((MvPolynomial.finSuccEquiv K 1 f).map + (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom).natDegree = _ + rw [Polynomial.natDegree_map_eq_of_injective + (MvPolynomial.uniqueAlgEquiv K (Fin 1)).injective] + exact MvPolynomial.natDegree_finSuccEquiv f + +/-- Transposing the source-oriented iterated presentation gives the standard +bivariate-polynomial presentation. -/ +theorem transposeBivariate_planeCurveToBivariate + (K : Type*) [Field K] (f : MvPolynomial (Fin 2) K) : + transposeBivariate (planeCurveToBivariate K f) = + (Polynomial.Bivariate.equivMvPolynomial K).symm f := by + let lhs : MvPolynomial (Fin 2) K →+* Polynomial (Polynomial K) := + transposeBivariate.comp + (planeCurveToBivariate K).toRingEquiv.toRingHom + let rhs : MvPolynomial (Fin 2) K →+* Polynomial (Polynomial K) := + (Polynomial.Bivariate.equivMvPolynomial K).symm.toRingEquiv.toRingHom + change lhs f = rhs f + congr 1 + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs] + · intro i + fin_cases i <;> simp [lhs, rhs] + +/-- The outer degree in the standard bivariate presentation is exactly the +degree in coordinate `1`. -/ +theorem bivariateEquiv_symm_natDegree_eq_degreeOf_one + (K : Type*) [Field K] (f : MvPolynomial (Fin 2) K) : + ((Polynomial.Bivariate.equivMvPolynomial K).symm f).natDegree = + MvPolynomial.degreeOf 1 f := by + let remaining := {i : Fin 2 // i ≠ 1} + let i0 : remaining := ⟨0, by decide⟩ + letI : Unique remaining := + { default := i0 + uniq := by + intro i + apply Subtype.ext + omega } + let q : MvPolynomial (Fin 2) K →+* + Polynomial (MvPolynomial remaining K) := + (MvPolynomial.optionEquivLeft K remaining).toRingEquiv.toRingHom.comp + (MvPolynomial.rename + (Equiv.optionSubtypeNe (1 : Fin 2)).symm).toRingHom + let e : MvPolynomial remaining K ≃ₐ[K] Polynomial K := + MvPolynomial.uniqueAlgEquiv K remaining + let lhs : MvPolynomial (Fin 2) K →+* Polynomial (Polynomial K) := + (Polynomial.Bivariate.equivMvPolynomial K).symm.toRingEquiv.toRingHom + let rhs : MvPolynomial (Fin 2) K →+* Polynomial (Polynomial K) := + (Polynomial.mapRingHom e.toRingHom).comp q + have hhom : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs, q, e] + · intro i + fin_cases i <;> simp [lhs, rhs, q, e, remaining] + change (lhs f).natDegree = _ + rw [hhom] + change ((q f).map e.toRingHom).natDegree = _ + rw [Polynomial.natDegree_map_eq_of_injective e.injective] + exact (MvPolynomial.degreeOf_eq_natDegree (1 : Fin 2) f).symm + +/-- An injective change of coefficients preserves every coordinate degree. -/ +theorem degreeOf_map_eq_of_injective + {R S σ : Type*} [CommSemiring R] [CommSemiring S] + (ι : R →+* S) (hι : Function.Injective ι) (i : σ) + (f : MvPolynomial σ R) : + MvPolynomial.degreeOf i (MvPolynomial.map ι f) = + MvPolynomial.degreeOf i f := by + rw [MvPolynomial.degreeOf_eq_sup, MvPolynomial.degreeOf_eq_sup, + MvPolynomial.support_map_of_injective f hι] + +variable {K L : Type*} [Field K] [Field L] {p : ℕ} + [Fact p.Prime] [CharP K p] [CharP L p] [PerfectField K] [Algebra K L] + +/-- The defining plane equation after extension of constants from `K` to the +Frobenius subfield `L^p`, in the iterated-polynomial orientation used by the +resultant proof. -/ +def planeCurveFrobeniusRelation (f : MvPolynomial (Fin 2) K) : + Polynomial (Polynomial (frobeniusSubfield L p)) := + planeCurveToBivariate (frobeniusSubfield L p) + (MvPolynomial.map + (perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p)) f) + +/-- The first exact bidegree of the Frobenius-base-changed relation. -/ +theorem planeCurveFrobeniusRelation_natDegree + (f : MvPolynomial (Fin 2) K) : + (planeCurveFrobeniusRelation (L := L) (p := p) f).natDegree = + MvPolynomial.degreeOf 0 f := by + rw [planeCurveFrobeniusRelation, + planeCurveToBivariate_natDegree_eq_degreeOf_zero, + degreeOf_map_eq_of_injective] + exact (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)).injective + +/-- The second exact bidegree of the Frobenius-base-changed relation. -/ +theorem transposeBivariate_planeCurveFrobeniusRelation_natDegree + (f : MvPolynomial (Fin 2) K) : + (transposeBivariate + (planeCurveFrobeniusRelation (L := L) (p := p) f)).natDegree = + MvPolynomial.degreeOf 1 f := by + rw [planeCurveFrobeniusRelation, + transposeBivariate_planeCurveToBivariate, + bivariateEquiv_symm_natDegree_eq_degreeOf_one, + degreeOf_map_eq_of_injective] + exact (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)).injective + +/-- Evaluation of the Frobenius-base-changed relation agrees with direct +evaluation of the original plane equation. -/ +theorem evalBivariate_planeCurveFrobeniusRelation + (f : MvPolynomial (Fin 2) K) (x y : L) : + evalBivariate y x + (planeCurveFrobeniusRelation (L := L) (p := p) f) = + MvPolynomial.eval₂ (algebraMap K L) ![x, y] f := by + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + let evalIterated : Polynomial (Polynomial F) →+* L := + Polynomial.eval₂RingHom + (Polynomial.eval₂RingHom (algebraMap F L) y) x + let lhs : MvPolynomial (Fin 2) K →+* L := + evalIterated.comp + ((planeCurveToBivariate F).toRingEquiv.toRingHom.comp + (MvPolynomial.map ι)) + let rhs : MvPolynomial (Fin 2) K →+* L := + MvPolynomial.eval₂Hom (algebraMap K L) ![x, y] + have hhom : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro c + dsimp only [lhs, RingHom.comp_apply] + rw [MvPolynomial.map_C] + change evalIterated + (planeCurveToBivariate F (MvPolynomial.C (ι c))) = + rhs (MvPolynomial.C c) + rw [planeCurveToBivariate_C] + simp [evalIterated, rhs, ι, F] + change + (((perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c : frobeniusSubfield L p) : L)) = + algebraMap K L c + exact coe_perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c + · intro i + fin_cases i <;> + simp [lhs, rhs, evalIterated, ι, RingHom.comp_apply] + change lhs f = rhs f + rw [hhom] + +/-- Irreducibility after the precise constant-field extension to `L^p` +implies irreducibility in the iterated-polynomial presentation. -/ +theorem planeCurveFrobeniusRelation_irreducible + {f : MvPolynomial (Fin 2) K} + (hbaseChange : Irreducible + (MvPolynomial.map + (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)) f)) : + Irreducible (planeCurveFrobeniusRelation (L := L) (p := p) f) := by + exact hbaseChange.map + (planeCurveToBivariate (frobeniusSubfield L p)).toMulEquiv + +/-- Extending the base from the perfect constant field to the Frobenius +subfield preserves separability of the remaining top extension. -/ +theorem isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (z : L) + [Algebra.IsSeparable (IntermediateField.adjoin K {z}) L] : + Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L := by + let F := frobeniusSubfield L p + letI : Algebra K F := + (perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p)).toAlgebra + letI : IsScalarTower K F L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + exact (coe_perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c).symm + let A : IntermediateField K L := IntermediateField.adjoin K {z} + let E : IntermediateField F L := IntermediateField.adjoin F {z} + have hAE : A ≤ E.restrictScalars K := by + apply IntermediateField.adjoin_le_iff.mpr + intro x hx + rw [Set.mem_singleton_iff] at hx + subst x + exact IntermediateField.subset_adjoin F {z} (Set.mem_singleton z) + letI : Algebra A E := (IntermediateField.inclusion hAE).toAlgebra + letI : IsScalarTower A E L := IsScalarTower.of_algebraMap_eq' rfl + exact Algebra.isSeparable_tower_top_of_isSeparable A E L + +/-- A separating element has minimal polynomial of exact degree `p` over the +Frobenius subfield. -/ +theorem minpoly_natDegree_over_frobeniusSubfield_eq_char + (z : L) (hz : z ∉ frobeniusSubfield L p) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + (minpoly (frobeniusSubfield L p) z).natDegree = p := by + let F := frobeniusSubfield L p + letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + have hzIntegral : IsIntegral F z := IsPurelyInseparable.isIntegral' F z + calc + (minpoly F z).natDegree = + Module.finrank F (IntermediateField.adjoin F {z}) := + (IntermediateField.adjoin.finrank hzIntegral).symm + _ = Module.finrank F L := by + rw [adjoin_frobeniusSubfield_eq_top (p := p) z, + IntermediateField.finrank_top'] + _ = p := finrank_frobeniusSubfield_eq_char (p := p) z hz + +/-- **Plane-curve form of the Corvaja--Zannier auxiliary-family +linear-independence proposition (the `q = p`, `z = w = 1` specialization).** + +The two nonzero partial derivatives are the source's two separating-coordinate +hypotheses. For the displayed orientation, separability over the field +generated by coordinate `1` is the one used to prove that this coordinate has +minimal-polynomial degree `p` over `L^p`; the symmetric partial is retained +because the source proposition assumes both coordinates separating. + +Two hypotheses mark exact geometric boundaries rather than hiding them: + +* `hbaseChange` is irreducibility after the literal extension of constants + `K → L^p`, the consequence of absolute irreducibility needed by Gauss + descent; +* `hsecondNotFrobenius` says that the separating second coordinate is not a + `p`-th power in `L`. Equivalently, it is the missing differential/basis + compatibility needed to turn separability into degree exactly `p`. + +All remaining assumptions are the printed positivity, exact bidegree, +size, and excluded-degree-alternative hypotheses. -/ +theorem planeCurve_auxiliaryFamily_linearIndependent + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (_hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ∀ (a b h k : ℕ), + 0 < a → 0 < h → 0 < k → + Irreducible + (MvPolynomial.map + (perfectConstantsToFrobeniusSubfield + (K := K) (L := PlaneCurveFunctionField f) (p := p)) f) → + (planeCurveFrobeniusRelation + (K := K) (L := PlaneCurveFunctionField f) (p := p) f).natDegree = a → + (transposeBivariate + (planeCurveFrobeniusRelation + (K := K) (L := PlaneCurveFunctionField f) (p := p) f)).natDegree = b → + planeCurveFunction f 1 ∉ + frobeniusSubfield (PlaneCurveFunctionField f) p → + a * h + b * k < p → + ¬ (a ≤ k ∧ b ≤ h) → + LinearIndependent (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily + (planeCurveFunction f 0) (planeCurveFunction f 1) h k) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + intro a b h k ha hh hk hbaseChange hdegreeFirst hdegreeSecond + hsecondNotFrobenius hsize hdegreeAlternativeExcluded + let L := PlaneCurveFunctionField f + let F := frobeniusSubfield L p + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + let g : Polynomial (Polynomial F) := + planeCurveFrobeniusRelation (K := K) (L := L) (p := p) f + have hseparableOverSecond := + finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst + letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := + hseparableOverSecond.2 + letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := by + exact isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) y + have hminpoly : (minpoly F y).natDegree = p := + minpoly_natDegree_over_frobeniusSubfield_eq_char + (p := p) y hsecondNotFrobenius + have hyTranscendental : Transcendental K y := by + exact secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hyOne : y ≠ 1 := by + intro hy + apply hyTranscendental + rw [hy] + exact isAlgebraic_one + have hgIrreducible : Irreducible g := by + exact planeCurveFrobeniusRelation_irreducible hbaseChange + have hgCoefficientDegree : ∀ i, (g.coeff i).natDegree ≤ b := by + intro i + have hbound := transposeBivariate_coeff_natDegree_le + (transposeBivariate g) b hdegreeSecond.le i + simpa only [transposeBivariate_transposeBivariate] using hbound + have hgZero : evalBivariate y x g = 0 := by + rw [evalBivariate_planeCurveFrobeniusRelation] + have hcoordinates : ![x, y] = planeCurveFunction f := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f + exact auxiliaryFamily_linearIndependent_of_irreducible_bidegree + g a b h k p ha hh hk hgIrreducible hdegreeFirst hdegreeSecond + hgCoefficientDegree x y hyOne hminpoly hgZero hsize + hdegreeAlternativeExcluded + +/-- Plane-curve auxiliary-family linear independence with the Frobenius +exclusion discharged from the separating-coordinate hypothesis. -/ +theorem planeCurve_auxiliaryFamily_linearIndependent_of_nonzero_partials + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ∀ (a b h k : ℕ), + 0 < a → 0 < h → 0 < k → + Irreducible + (MvPolynomial.map + (perfectConstantsToFrobeniusSubfield + (K := K) (L := PlaneCurveFunctionField f) (p := p)) f) → + (planeCurveFrobeniusRelation + (K := K) (L := PlaneCurveFunctionField f) (p := p) f).natDegree = a → + (transposeBivariate + (planeCurveFrobeniusRelation + (K := K) (L := PlaneCurveFunctionField f) (p := p) f)).natDegree = b → + a * h + b * k < p → + ¬ (a ≤ k ∧ b ≤ h) → + LinearIndependent (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily + (planeCurveFunction f 0) (planeCurveFunction f 1) h k) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + intro a b h k ha hh hk hbaseChange hdegreeFirst hdegreeSecond + hsize hdegreeAlternativeExcluded + exact planeCurve_auxiliaryFamily_linearIndependent + (p := p) hf hpartialFirst hpartialSecond a b h k ha hh hk + hbaseChange hdegreeFirst hdegreeSecond + (secondCoordinate_not_mem_frobeniusSubfield + (p := p) hf hpartialFirst) + hsize hdegreeAlternativeExcluded + +/-- Plane-curve auxiliary-family linear independence from absolute +irreducibility and the two separating-coordinate hypotheses. Absolute +irreducibility supplies both irreducibility over the constant field and the +literal base change to the Frobenius subfield used by the resultant proof. -/ +theorem planeCurve_auxiliaryFamily_linearIndependent_of_absoluteIrreducible + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := by + simpa only [MvPolynomial.map_id] using + irreducible_map_of_irreducible_map_algebraicClosure + (RingHom.id K) f habsolute + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ∀ (a b h k : ℕ), + 0 < a → 0 < h → 0 < k → + (planeCurveFrobeniusRelation + (K := K) (L := PlaneCurveFunctionField f) (p := p) f).natDegree = a → + (transposeBivariate + (planeCurveFrobeniusRelation + (K := K) (L := PlaneCurveFunctionField f) (p := p) f)).natDegree = b → + a * h + b * k < p → + ¬ (a ≤ k ∧ b ≤ h) → + LinearIndependent (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily + (planeCurveFunction f 0) (planeCurveFunction f 1) h k) := by + let hf : Irreducible f := by + simpa only [MvPolynomial.map_id] using + irreducible_map_of_irreducible_map_algebraicClosure + (RingHom.id K) f habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + dsimp only + intro a b h k ha hh hk hdegreeFirst hdegreeSecond hsize + hdegreeAlternativeExcluded + apply planeCurve_auxiliaryFamily_linearIndependent_of_nonzero_partials + (p := p) hf hpartialFirst hpartialSecond a b h k ha hh hk + · exact irreducible_map_perfectConstantsToFrobeniusSubfield + (K := K) (L := PlaneCurveFunctionField f) (p := p) f habsolute + · exact hdegreeFirst + · exact hdegreeSecond + · exact hsize + · exact hdegreeAlternativeExcluded + +/-- The strongest plane-curve auxiliary-family theorem at the present +algebraic boundary: the bidegrees are the actual coordinate degrees of the +defining equation, so no degree-identification hypotheses remain. -/ +theorem planeCurve_auxiliaryFamily_linearIndependent_of_absoluteIrreducible_coordinateDegrees + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := by + simpa only [MvPolynomial.map_id] using + irreducible_map_of_irreducible_map_algebraicClosure + (RingHom.id K) f habsolute + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ∀ (h k : ℕ), + 0 < h → 0 < k → + MvPolynomial.degreeOf 0 f * h + + MvPolynomial.degreeOf 1 f * k < p → + ¬ (MvPolynomial.degreeOf 0 f ≤ k ∧ + MvPolynomial.degreeOf 1 f ≤ h) → + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily + (planeCurveFunction f 0) (planeCurveFunction f 1) h k) := by + let hf : Irreducible f := by + simpa only [MvPolynomial.map_id] using + irreducible_map_of_irreducible_map_algebraicClosure + (RingHom.id K) f habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + dsimp only + intro h k hh hk hsize hdegreeAlternativeExcluded + apply planeCurve_auxiliaryFamily_linearIndependent_of_absoluteIrreducible + (p := p) habsolute hpartialFirst hpartialSecond + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) h k + · exact degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst + · exact hh + · exact hk + · exact planeCurveFrobeniusRelation_natDegree + (K := K) (L := PlaneCurveFunctionField f) (p := p) f + · exact transposeBivariate_planeCurveFrobeniusRelation_natDegree + (K := K) (L := PlaneCurveFunctionField f) (p := p) f + · exact hsize + · exact hdegreeAlternativeExcluded + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean new file mode 100644 index 0000000000..8ac9e132c9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean @@ -0,0 +1,99 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems + +/-! +# From the public bidegree interface to function-field degrees + +The finite-field Corvaja--Zannier endpoint states its degree hypothesis +support-wise, through `BGS.External.HasBidegreeAtMost`. The function-field +development uses `MvPolynomial.degreeOf` and the degrees of the two coordinate +projections. This file records the exact, assumption-free bridge between +those two presentations. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The first coordinate degree is bounded by the first component of a +support-wise bidegree bound. -/ +theorem degreeOf_first_le_of_hasBidegreeAtMost + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + MvPolynomial.degreeOf 0 f ≤ firstDegree := by + rw [MvPolynomial.degreeOf_le_iff] + intro monomial hmonomial + exact (hdegree monomial hmonomial).1 + +/-- The second coordinate degree is bounded by the second component of a +support-wise bidegree bound. -/ +theorem degreeOf_second_le_of_hasBidegreeAtMost + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + MvPolynomial.degreeOf 1 f ≤ secondDegree := by + rw [MvPolynomial.degreeOf_le_iff] + intro monomial hmonomial + exact (hdegree monomial hmonomial).2 + +/-- Absolute irreducibility in the public plane-curve interface implies +irreducibility over the original constant field. -/ +theorem irreducible_of_irreducible_map_algebraicClosure + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) : + Irreducible f := by + have h := irreducible_map_of_irreducible_map_algebraicClosure + (RingHom.id K) f habsolute + rw [MvPolynomial.map_id] at h + exact h + +/-- The degree of the first-coordinate projection of the plane-curve +function field is bounded by the supplied second bidegree. -/ +theorem finrank_over_firstCoordinate_le_of_hasBidegreeAtMost + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + letI := planeCurveCoordinateRing_isDomain + (irreducible_of_irreducible_map_algebraicClosure habsolute) + Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ + secondDegree := by + let hf := irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible + hf hpartialSecond).le.trans + (degreeOf_second_le_of_hasBidegreeAtMost hdegree) + +/-- The degree of the second-coordinate projection of the plane-curve +function field is bounded by the supplied first bidegree. -/ +theorem finrank_over_secondCoordinate_le_of_hasBidegreeAtMost + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + letI := planeCurveCoordinateRing_isDomain + (irreducible_of_irreducible_map_algebraicClosure habsolute) + Module.finrank (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ + firstDegree := by + let hf := irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible + hf hpartialFirst).le.trans + (degreeOf_first_le_of_hasBidegreeAtMost hdegree) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean new file mode 100644 index 0000000000..10d0def05a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -0,0 +1,1042 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import Mathlib.Tactic + +/-! +# Weighted boundary support for a plane curve + +This file proves the sharp coordinate-boundary estimate needed in the +Corvaja--Zannier middle game. The exhaustive places are defined using the +first-coordinate `RatFunc` model. To bound the positive divisor of the +second coordinate, each positive place is transported to the finite chart +of the second-coordinate model. The transport preserves both the normalized +valuation and the residue degree; injectivity then compares the two weighted +positive-divisor sums. + +The final theorem is stated directly for the zero/pole boundary +`propositionTwoExceptionalPlaces` of positive coordinate powers. +-/ + +open scoped Polynomial +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + + +attribute [local instance high] Module.Free.of_divisionRing + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) probePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance probePolynomialScalarTower : IsScalarTower K[X] (RatFunc K) L := + .of_algebraMap_eq' rfl + +local instance probeFiniteConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp + (algebraMap K K[X])) + +local instance probeFiniteConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + .of_algebraMap_eq' rfl + +local instance probeInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance probeInfinityConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + .of_algebraMap_eq' rfl + +local instance probeInfinityClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance probeInfinityClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + .of_algebraMap_eq' rfl + +local instance probeFiniteIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + integralClosure.isDedekindDomain K[X] (RatFunc K) L + +local instance probeFiniteIntegralClosureIsFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) L + +local instance probeInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance probeInfinityIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) L + +/-- The normalized valuation on `L` represented by an exhaustive place. -/ +private noncomputable def probeFiniteExtensionPlaceValuation + (w : FiniteExtensionPlace K L) : + Valuation L (WithZero (Multiplicative ℤ)) := + match w with + | .inl q => q.valuation L + | .inr P => (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L + +private theorem probeFiniteExtensionPlaceValuation_surjective + (w : FiniteExtensionPlace K L) : + Function.Surjective (probeFiniteExtensionPlaceValuation K L w) := by + intro z + cases w with + | inl q => + exact q.valuation_surjective L z + | inr P => + exact (primeOverHeightOne + (ratFuncInfinityPlace K) P).valuation_surjective L z + +private theorem probeFiniteExtensionPlaceValuation_eq_exp_neg_order + (w : FiniteExtensionPlace K L) (x : L) (hx : x ≠ 0) : + probeFiniteExtensionPlaceValuation K L w x = + exp (-finiteExtensionPrincipalDivisor K L x w) := by + cases w with + | inl q => + have hord := fractionRingAlgEquiv_finitePlaceOrder_eq + (L := L) q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) + have hord' : finitePlaceOrder q x = finitePlaceOrder q + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by + simpa [ratFuncFiniteIntegralClosureFractionRingEquiv] using hord + rw [finiteExtensionPrincipalDivisor_inl, ← hord'] + exact valuation_eq_exp_neg_finitePlaceOrder q x hx + | inr P => + have hord := fractionRingAlgEquiv_finitePlaceOrder_eq + (L := L) (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + have hord' : finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) x = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) := by + simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using hord + rw [finiteExtensionPrincipalDivisor_inr, ← hord'] + exact valuation_eq_exp_neg_finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) x hx + +private theorem probe_finiteExtensionFinitePlace_X_le_one + (q : FiniteExtensionFinitePlace K L) : + q.valuation L (algebraMap (RatFunc K) L RatFunc.X) ≤ 1 := by + change q.valuation L (algebraMap K[X] L Polynomial.X) ≤ 1 + rw [IsScalarTower.algebraMap_apply K[X] + (RatFuncFiniteIntegralClosure K L) L] + exact q.valuation_le_one _ + +private theorem probe_finiteExtensionInfinityPlace_X_gt_one + (P : FiniteExtensionInfinityPlace K L) : + 1 < (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L + (algebraMap (RatFunc K) L RatFunc.X) := by + let q := primeOverHeightOne (ratFuncInfinityPlace K) P + let pi := ratFuncInfinityUniformizer K + have hpiBase : pi ∈ (ratFuncInfinityPlace K).asIdeal := by + rw [ratFuncInfinityPlace_span_uniformizer] + exact Ideal.mem_span_singleton_self pi + have hpiP : algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi ∈ P.1 := by + have hover : (ratFuncInfinityPlace K).asIdeal = Ideal.comap + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) P.1 := by + exact Ideal.over_def P.1 (ratFuncInfinityPlace K).asIdeal + exact Ideal.mem_comap.mp (hover ▸ hpiBase) + have hpiLt : q.valuation L + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi) < 1 := + (q.valuation_lt_one_iff_mem + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi)).mpr hpiP + have hpiImage : algebraMap + (RatFuncInfinityIntegralClosure K L) L + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi) = + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ := by + change algebraMap (RatFunc K) L (1 / RatFunc.X) = + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ + simp + have hxinverse : q.valuation L + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ < 1 := by + rw [← hpiImage] + exact hpiLt + exact ((q.valuation L).one_lt_val_iff + (by + simpa using + (algebraMap (RatFunc K) L).injective.ne RatFunc.X_ne_zero)).mpr hxinverse + +private theorem probeFiniteExtensionPlaceValuation_injective : + Function.Injective (probeFiniteExtensionPlaceValuation K L) := by + intro w₁ w₂ h + cases w₁ with + | inl q₁ => + cases w₂ with + | inl q₂ => + apply congrArg Sum.inl + apply HeightOneSpectrum.eq_of_valuation_isEquiv_valuation (K := L) + have hval : q₁.valuation L = q₂.valuation L := by + simpa [probeFiniteExtensionPlaceValuation] using h + rw [hval] + | inr P₂ => + exfalso + have hle := probe_finiteExtensionFinitePlace_X_le_one K L q₁ + have hgt := probe_finiteExtensionInfinityPlace_X_gt_one K L P₂ + have hval : q₁.valuation L = + (primeOverHeightOne (ratFuncInfinityPlace K) P₂).valuation L := by + simpa [probeFiniteExtensionPlaceValuation] using h + rw [← hval] at hgt + exact (not_lt_of_ge hle) hgt + | inr P₁ => + cases w₂ with + | inl q₂ => + exfalso + have hgt := probe_finiteExtensionInfinityPlace_X_gt_one K L P₁ + have hle := probe_finiteExtensionFinitePlace_X_le_one K L q₂ + have hval : + (primeOverHeightOne (ratFuncInfinityPlace K) P₁).valuation L = + q₂.valuation L := by + simpa [probeFiniteExtensionPlaceValuation] using h + rw [hval] at hgt + exact (not_lt_of_ge hle) hgt + | inr P₂ => + apply congrArg Sum.inr + apply Subtype.ext + have hval : + (primeOverHeightOne (ratFuncInfinityPlace K) P₁).valuation L = + (primeOverHeightOne (ratFuncInfinityPlace K) P₂).valuation L := by + simpa [probeFiniteExtensionPlaceValuation] using h + have hprime : + primeOverHeightOne (ratFuncInfinityPlace K) P₁ = + primeOverHeightOne (ratFuncInfinityPlace K) P₂ := by + apply HeightOneSpectrum.eq_of_valuation_isEquiv_valuation (K := L) + rw [hval] + exact congrArg HeightOneSpectrum.asIdeal hprime + +private theorem probeFiniteExtensionPlaceValuation_constant_le_one + [Algebra K L] [IsScalarTower K (RatFunc K) L] + (w : FiniteExtensionPlace K L) (c : K) : + probeFiniteExtensionPlaceValuation K L w (algebraMap K L c) ≤ 1 := by + cases w with + | inl q => + have hrepr : algebraMap K L c = + algebraMap (RatFuncFiniteIntegralClosure K L) L + (algebraMap K (RatFuncFiniteIntegralClosure K L) c) := by + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + rw [hrepr] + exact q.valuation_le_one _ + | inr P => + have hrepr : algebraMap K L c = + algebraMap (RatFuncInfinityIntegralClosure K L) L + (algebraMap K (RatFuncInfinityIntegralClosure K L) c) := by + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + rw [hrepr] + exact (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation_le_one _ + +private noncomputable def residueFieldAlgEquivOfIdealEq + {I J : Ideal K[X]} [I.IsPrime] [J.IsPrime] (h : I = J) : + I.ResidueField ≃ₐ[K] J.ResidueField := by + subst J + exact AlgEquiv.refl + +section ResidueTransport + +variable {R F S E : Type*} + [CommRing R] [IsDedekindDomain R] [Field F] [Algebra R F] [IsFractionRing R F] + [CommRing S] [IsDedekindDomain S] [Field E] [Algebra S E] [IsFractionRing S E] + +private noncomputable def valuationSubringRingEquivOfComapEq + (V : ValuationSubring F) (W : ValuationSubring E) (e : F ≃+* E) + (h : W.comap e.toRingHom = V) : V ≃+* W where + toFun x := ⟨e x, by + change (x : F) ∈ W.comap e.toRingHom + rw [h] + exact x.2⟩ + invFun y := ⟨e.symm y, by + rw [← h] + change e (e.symm (y : E)) ∈ W + simpa using y.2⟩ + left_inv x := Subtype.ext (e.symm_apply_apply x) + right_inv y := Subtype.ext (e.apply_symm_apply y) + map_mul' x y := Subtype.ext (map_mul e (x : F) (y : F)) + map_add' x y := Subtype.ext (map_add e (x : F) (y : F)) + +private noncomputable def heightOneSpectrumResidueFieldToValuationSubring + (q : HeightOneSpectrum R) : + q.asIdeal.ResidueField ≃+* + IsLocalRing.ResidueField + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime F q) := + IsLocalRing.ResidueField.mapEquiv + (IsLocalization.algEquiv q.asIdeal.primeCompl + (Localization.AtPrime q.asIdeal) + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime F q)).toRingEquiv + +private noncomputable def heightOneSpectrumResidueFieldRingEquivOfComapEq + (q : HeightOneSpectrum R) (r : HeightOneSpectrum S) (e : F ≃+* E) + (h : (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E r).comap + e.toRingHom = + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime F q) : + q.asIdeal.ResidueField ≃+* r.asIdeal.ResidueField := + (heightOneSpectrumResidueFieldToValuationSubring q).trans <| + (IsLocalRing.ResidueField.mapEquiv + (valuationSubringRingEquivOfComapEq + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime F q) + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E r) + e h)).trans + (heightOneSpectrumResidueFieldToValuationSubring r).symm + +end ResidueTransport + +private theorem finrank_eq_of_ringEquiv_of_finite_base + {k E F : Type*} [Field k] [Fintype k] + [Field E] [Field F] [Algebra k E] [Algebra k F] + [FiniteDimensional k E] [FiniteDimensional k F] + (e : E ≃+* F) : Module.finrank k E = Module.finrank k F := by + apply Nat.pow_right_injective (a := Nat.card k) (by + rw [Nat.card_eq_fintype_card] + exact Nat.succ_le_iff.mpr Fintype.one_lt_card) + change Nat.card k ^ Module.finrank k E = + Nat.card k ^ Module.finrank k F + rw [← Module.natCard_eq_pow_finrank, + ← Module.natCard_eq_pow_finrank] + exact Nat.card_congr e.toEquiv + +section ValuationCenter + +variable {R S F : Type*} [CommRing R] [IsDomain R] + [CommRing S] [Field F] + [Algebra R F] [Algebra R S] [Algebra S F] + [IsScalarTower R S F] [IsIntegralClosure S R F] + [IsDedekindDomain S] [IsFractionRing S F] + +private noncomputable def integralClosureToValuationSubring + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) : + S →+* V := by + letI : IsIntegrallyClosedIn V.toSubring F := + inferInstanceAs (IsIntegrallyClosedIn V F) + exact (Subring.inclusion ((Subring.integralClosure_le_iff).2 hbase)).comp + (IsIntegralClosure.equiv R S F (integralClosure R F)).toRingEquiv.toRingHom + +private def valuationCenterIdeal + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) : + Ideal S := + Ideal.comap (integralClosureToValuationSubring (S := S) V hbase) + (IsLocalRing.maximalIdeal V) + +private theorem valuationCenterIdeal_isPrime + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) : + (valuationCenterIdeal (S := S) V hbase).IsPrime := by + exact Ideal.comap_isPrime _ _ + +private theorem valuationCenterIdeal_ne_bot_of_mem_nonunits + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) + (r : R) (hr0 : algebraMap R F r ≠ 0) + (hr : algebraMap R F r ∈ V.nonunits) : + valuationCenterIdeal (S := S) V hbase ≠ ⊥ := by + intro hbot + let a : S := algebraMap R S r + have ha0 : a ≠ 0 := by + intro ha + apply hr0 + have hval : algebraMap S F a = algebraMap S F 0 := + congrArg (fun z : S => algebraMap S F z) ha + rw [IsScalarTower.algebraMap_apply R S F] + simpa [a] using hval + have ha : a ∈ valuationCenterIdeal (S := S) V hbase := by + change integralClosureToValuationSubring (S := S) V hbase a ∈ + IsLocalRing.maximalIdeal V + rw [IsLocalRing.mem_maximalIdeal] + apply ValuationSubring.coe_mem_nonunits_iff.mp + all_goals + have hφa : + ((integralClosureToValuationSubring (S := S) V hbase a : V) : F) = + algebraMap S F a := + IsIntegralClosure.algebraMap_equiv R S F (integralClosure R F) a + have hSR : algebraMap S F a = algebraMap R F r := by + rw [IsScalarTower.algebraMap_apply R S F] + simpa only [hφa.trans hSR] using hr + rw [hbot] at ha + exact ha0 (Ideal.mem_bot.mp ha) + +private noncomputable def valuationCenterPlace + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) + (hne : valuationCenterIdeal (S := S) V hbase ≠ ⊥) : + HeightOneSpectrum S := + ⟨valuationCenterIdeal (S := S) V hbase, + valuationCenterIdeal_isPrime (S := S) V hbase, hne⟩ + +private theorem valuationSubringAt_valuationCenterPlace_le + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) + (hne : valuationCenterIdeal (S := S) V hbase ≠ ⊥) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime F + (valuationCenterPlace (S := S) V hbase hne) ≤ V := by + let q := valuationCenterPlace (S := S) V hbase hne + let φ : S →+* V := + integralClosureToValuationSubring (S := S) V hbase + rintro x ⟨a, s, hs, rfl⟩ + have hsNotMem : s ∉ q.asIdeal := hs + have hsUnit : IsUnit (φ s) := by + rw [← IsLocalRing.notMem_maximalIdeal] + exact hsNotMem + obtain ⟨u, hu⟩ := hsUnit + let t : V := φ a * ↑(u⁻¹) + have ht : algebraMap S F a * (algebraMap S F s)⁻¹ = (t : F) := by + dsimp only [t] + have hφa : ((φ a : V) : F) = algebraMap S F a := by + exact IsIntegralClosure.algebraMap_equiv R S F + (integralClosure R F) a + have hφs : ((φ s : V) : F) = algebraMap S F s := by + exact IsIntegralClosure.algebraMap_equiv R S F + (integralClosure R F) s + rw [← hφa, ← hφs, ← hu] + change ((φ a : V) : F) * ((((u : V) : F))⁻¹) = + ((φ a : V) : F) * (((↑(u⁻¹) : V) : F)) + congr 1 + exact (map_units_inv V.toSubring.subtype u).symm + rw [ht] + exact t.property + +private theorem valuationSubringAt_valuationCenterPlace_eq + (V : ValuationSubring F) + (hbase : ∀ r : R, algebraMap R F r ∈ V) + (hne : valuationCenterIdeal (S := S) V hbase ≠ ⊥) + (hV : V ≠ ⊤) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime F + (valuationCenterPlace (S := S) V hbase hne) = V := by + exact ValuationSubring.eq_of_le_of_ne_top _ + (valuationSubringAt_valuationCenterPlace_le (S := S) V hbase hne) hV + +end ValuationCenter + +include L in +private theorem probe_ratFuncFinitePlaceDegree_eq_finrank_residue + (p : HeightOneSpectrum K[X]) : + Module.finrank K p.asIdeal.ResidueField = ratFuncFinitePlaceDegree p := by + let r := finitePlaceNormalizedPrime p + have hp : normalizedPrimeFinitePlace (K := K) r = p := by + exact normalizedPrimeFinitePlace_finitePlaceNormalizedPrime p + have hpIdeal : p.asIdeal = Ideal.span {(r : K[X])} := by + rw [← show (normalizedPrimeFinitePlace (K := K) r).asIdeal = p.asIdeal by + exact congrArg HeightOneSpectrum.asIdeal hp] + rfl + letI : (Ideal.span {(r : K[X])}).IsPrime := + (normalizedPrimeFinitePlace (K := K) r).isPrime + letI : (Ideal.span {(r : K[X])}).IsMaximal := + (inferInstance : (Ideal.span {(r : K[X])}).IsPrime).isMaximal (by + simpa only [ne_eq, Ideal.span_singleton_eq_bot] using r.property.1.ne_zero) + let ep := residueFieldAlgEquivOfIdealEq (K := K) hpIdeal + let e : (K[X] ⧸ Ideal.span {(r : K[X])}) ≃ₐ[K] + (Ideal.span {(r : K[X])}).ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K + (K[X] ⧸ Ideal.span {(r : K[X])}) + (Ideal.span {(r : K[X])}).ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField _) + calc + Module.finrank K p.asIdeal.ResidueField = + Module.finrank K (Ideal.span {(r : K[X])}).ResidueField := + ep.toLinearEquiv.finrank_eq + _ = Module.finrank K (K[X] ⧸ Ideal.span {(r : K[X])}) := + e.toLinearEquiv.finrank_eq.symm + _ = (r : K[X]).natDegree := + (AdjoinRoot.powerBasis r.property.1.ne_zero).finrank + _ = ratFuncFinitePlaceDegree p := by + rw [ratFuncFinitePlaceDegree] + +private theorem probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K L (.inl q) = + Module.finrank K q.asIdeal.ResidueField := by + let p := HeightOneSpectrum.under K[X] q + letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p.asIdeal q.asIdeal] + rw [← probe_ratFuncFinitePlaceDegree_eq_finrank_residue K L p] + rw [mul_comm, Module.finrank_mul_finrank] + +private theorem probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPlaceDegree K L (.inr P) = + Module.finrank K P.1.ResidueField := by + let p := (ratFuncInfinityPlace K).asIdeal + letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra p.ResidueField P.1.ResidueField := + IsLocalRing.ResidueField.instAlgebra + letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p P.1] + have hbase : Module.finrank K p.ResidueField = 1 := + by simpa [p] using + (ratFuncInfinityPlaceResidueEquiv K).toLinearEquiv.finrank_eq + calc + Module.finrank p.ResidueField P.1.ResidueField = + 1 * Module.finrank p.ResidueField P.1.ResidueField := by simp + _ = Module.finrank K p.ResidueField * + Module.finrank p.ResidueField P.1.ResidueField := by rw [hbase] + _ = Module.finrank K P.1.ResidueField := + Module.finrank_mul_finrank K p.ResidueField P.1.ResidueField + +end + +noncomputable section + +section PlaneBoundaryProbe + + +variable {K₀ : Type*} [Field K₀] [Fintype K₀] [DecidableEq K₀] + [DecidableEq (RatFunc K₀)] + +theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_first + {f : MvPolynomial (Fin 2) K₀} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionPositiveDegree K₀ (PlaneCurveFunctionField f) + (planeCurveFunction f 1) ≤ MvPolynomial.degreeOf 0 f := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L₀ := PlaneCurveFunctionField f + let x : L₀ := planeCurveFunction f 0 + let y : L₀ := planeCurveFunction f 1 + have hxTrans : Transcendental K₀ x := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hyTrans : Transcendental K₀ y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + let firstAlg : Algebra (RatFunc K₀) L₀ := + planeCurveFirstCoordinateRatFuncAlgebra f hxTrans + letI : Algebra (RatFunc K₀) L₀ := firstAlg + letI : FiniteDimensional (RatFunc K₀) L₀ := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K₀) L₀ := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsScalarTower K₀ (RatFunc K₀) L₀ := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap K₀ L₀ c = + ratFuncSpecialization x hxTrans (RatFunc.C c) + have h := DFunLike.congr_fun + (ratFuncSpecialization_comp_polynomial_algebraMap x hxTrans) + (Polynomial.C c) + simpa using h.symm + letI : Algebra K₀[X] L₀ := + RingHom.toAlgebra ((algebraMap (RatFunc K₀) L₀).comp + (algebraMap K₀[X] (RatFunc K₀))) + letI : IsScalarTower K₀[X] (RatFunc K₀) L₀ := + .of_algebraMap_eq' rfl + letI : Algebra K₀ (RatFuncFiniteIntegralClosure K₀ L₀) := + RingHom.toAlgebra + ((algebraMap K₀[X] (RatFuncFiniteIntegralClosure K₀ L₀)).comp + (algebraMap K₀ K₀[X])) + letI : IsScalarTower K₀ K₀[X] + (RatFuncFiniteIntegralClosure K₀ L₀) := + .of_algebraMap_eq' rfl + letI : Algebra K₀ (RatFuncInfinityIntegers K₀) := + (ratFuncInfinityConstantRingHom K₀).toAlgebra + letI : IsScalarTower K₀ (RatFuncInfinityIntegers K₀) (RatFunc K₀) := + .of_algebraMap_eq' rfl + letI : Algebra K₀ (RatFuncInfinityIntegralClosure K₀ L₀) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K₀) + (RatFuncInfinityIntegralClosure K₀ L₀)).comp + (algebraMap K₀ (RatFuncInfinityIntegers K₀))) + letI : IsScalarTower K₀ (RatFuncInfinityIntegers K₀) + (RatFuncInfinityIntegralClosure K₀ L₀) := + .of_algebraMap_eq' rfl + letI : IsDedekindDomain (RatFuncFiniteIntegralClosure K₀ L₀) := + integralClosure.isDedekindDomain K₀[X] (RatFunc K₀) L₀ + letI : IsFractionRing (RatFuncFiniteIntegralClosure K₀ L₀) L₀ := + integralClosure.isFractionRing_of_finite_extension (RatFunc K₀) L₀ + letI : IsDedekindDomain (RatFuncInfinityIntegralClosure K₀ L₀) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K₀) (RatFunc K₀) L₀ + (RatFuncInfinityIntegralClosure K₀ L₀) + letI : IsFractionRing (RatFuncInfinityIntegralClosure K₀ L₀) L₀ := + integralClosure.isFractionRing_of_finite_extension (RatFunc K₀) L₀ + let W₁ := FiniteExtensionPlace K₀ L₀ + let divisor₁ : W₁ →₀ ℤ := + finiteExtensionPrincipalDivisor K₀ L₀ y + let D₁ : W₁ → ℤ := fun w => + divisor₁ w + let S₁ : Finset W₁ := divisor₁.support.filter + (fun w => 0 < D₁ w) + let degree₁ : W₁ → ℕ := fun w => + finiteExtensionPlaceDegree K₀ L₀ w + let infinityPrime₁ := fun P : FiniteExtensionInfinityPlace K₀ L₀ => + primeOverHeightOne (ratFuncInfinityPlace K₀) P + have hdegree₁ : ∀ w : W₁, degree₁ w = + match w with + | .inl q => Module.finrank K₀ q.asIdeal.ResidueField + | .inr P => Module.finrank K₀ P.1.ResidueField := by + intro w + cases w with + | inl q => + exact probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue + K₀ L₀ q + | inr P => + exact probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue + K₀ L₀ P + let v₁ : W₁ → Valuation L₀ (WithZero (Multiplicative ℤ)) := + probeFiniteExtensionPlaceValuation K₀ L₀ + have hv₁surj : ∀ w : W₁, Function.Surjective (v₁ w) := by + intro w + exact probeFiniteExtensionPlaceValuation_surjective K₀ L₀ w + have hv₁y : ∀ w : W₁, + v₁ w y = exp (-D₁ w) := by + intro w + exact probeFiniteExtensionPlaceValuation_eq_exp_neg_order + K₀ L₀ w y hy0 + have hv₁const : ∀ (w : W₁) (c : K₀), + v₁ w (algebraMap K₀ L₀ c) ≤ 1 := by + intro w c + exact (by + change probeFiniteExtensionPlaceValuation K₀ L₀ w + (algebraMap K₀ L₀ c) ≤ 1 + cases w with + | inl q => + have hrepr : algebraMap K₀ L₀ c = + algebraMap (RatFuncFiniteIntegralClosure K₀ L₀) L₀ + (algebraMap K₀ + (RatFuncFiniteIntegralClosure K₀ L₀) c) := by + rw [IsScalarTower.algebraMap_apply K₀ (RatFunc K₀) L₀] + rfl + rw [hrepr] + exact q.valuation_le_one _ + | inr P => + have hrepr : algebraMap K₀ L₀ c = + algebraMap (RatFuncInfinityIntegralClosure K₀ L₀) L₀ + (algebraMap K₀ + (RatFuncInfinityIntegralClosure K₀ L₀) c) := by + rw [IsScalarTower.algebraMap_apply K₀ (RatFunc K₀) L₀] + rfl + rw [hrepr] + exact (primeOverHeightOne + (ratFuncInfinityPlace K₀) P).valuation_le_one _) + have hv₁inj : Function.Injective v₁ := by + change Function.Injective + (probeFiniteExtensionPlaceValuation K₀ L₀) + exact probeFiniteExtensionPlaceValuation_injective K₀ L₀ + let secondAlg : Algebra (RatFunc K₀) L₀ := + planeCurveSecondCoordinateRatFuncAlgebra f hyTrans + letI : Algebra (RatFunc K₀) L₀ := secondAlg + letI : FiniteDimensional (RatFunc K₀) L₀ := + finiteDimensional_planeCurveFunctionField_over_secondRatFunc + hf hpartialFirst + letI : Algebra.IsSeparable (RatFunc K₀) L₀ := + separable_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst + letI : IsScalarTower K₀ (RatFunc K₀) L₀ := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap K₀ L₀ c = + ratFuncSpecialization y hyTrans (RatFunc.C c) + have h := DFunLike.congr_fun + (ratFuncSpecialization_comp_polynomial_algebraMap y hyTrans) + (Polynomial.C c) + simpa using h.symm + letI : Algebra K₀[X] L₀ := + RingHom.toAlgebra ((algebraMap (RatFunc K₀) L₀).comp + (algebraMap K₀[X] (RatFunc K₀))) + letI : IsScalarTower K₀[X] (RatFunc K₀) L₀ := + .of_algebraMap_eq' rfl + letI : Algebra K₀ (RatFuncFiniteIntegralClosure K₀ L₀) := + RingHom.toAlgebra + ((algebraMap K₀[X] (RatFuncFiniteIntegralClosure K₀ L₀)).comp + (algebraMap K₀ K₀[X])) + letI : IsScalarTower K₀ K₀[X] + (RatFuncFiniteIntegralClosure K₀ L₀) := + .of_algebraMap_eq' rfl + letI : IsDedekindDomain (RatFuncFiniteIntegralClosure K₀ L₀) := + integralClosure.isDedekindDomain K₀[X] (RatFunc K₀) L₀ + letI : IsFractionRing (RatFuncFiniteIntegralClosure K₀ L₀) L₀ := + integralClosure.isFractionRing_of_finite_extension (RatFunc K₀) L₀ + have hpolyX : algebraMap K₀[X] L₀ Polynomial.X = y := by + change ratFuncSpecialization y hyTrans RatFunc.X = y + simp [ratFuncSpecialization, RatFunc.algEquivOfTranscendental_X] + have hcenter : ∀ (w : W₁), 0 < D₁ w → + ∃ q : FiniteExtensionFinitePlace K₀ L₀, + q.valuation L₀ = v₁ w ∧ + finiteExtensionPlaceDegree K₀ L₀ (.inl q) = degree₁ w ∧ + finiteExtensionPrincipalDivisor K₀ L₀ y (.inl q) = D₁ w := by + intro w hw + let v := v₁ w + let V := v.valuationSubring + have hvylt : v y < 1 := by + rw [hv₁y w, ← exp_zero, exp_lt_exp] + omega + have hyV : y ∈ V := by + change v y ≤ 1 + exact le_of_lt hvylt + have hconstV : ∀ c : K₀, algebraMap K₀ L₀ c ∈ V := by + intro c + change v (algebraMap K₀ L₀ c) ≤ 1 + exact hv₁const w c + have hbase : ∀ P : K₀[X], algebraMap K₀[X] L₀ P ∈ V := by + intro P + induction P using Polynomial.induction_on' with + | add P Q hP hQ => + rw [map_add] + exact add_mem hP hQ + | monomial n c => + rw [← Polynomial.C_mul_X_pow_eq_monomial, map_mul, map_pow, + hpolyX] + have hC : algebraMap K₀[X] L₀ (Polynomial.C c) = + algebraMap K₀ L₀ c := by + change algebraMap (RatFunc K₀) L₀ + (algebraMap K₀[X] (RatFunc K₀) (Polynomial.C c)) = + algebraMap K₀ L₀ c + rw [show algebraMap K₀[X] (RatFunc K₀) (Polynomial.C c) = + algebraMap K₀ (RatFunc K₀) c by simp, + IsScalarTower.algebraMap_apply K₀ (RatFunc K₀) L₀] + rw [hC] + exact mul_mem (hconstV c) (pow_mem hyV n) + have hyNonunit : algebraMap K₀[X] L₀ Polynomial.X ∈ V.nonunits := by + rw [hpolyX, ValuationSubring.mem_nonunits_iff_exists_mem_maximalIdeal] + exact ⟨hyV, (Valuation.mem_maximalIdeal_iff (v := v)).mpr hvylt⟩ + have hcenterNe : valuationCenterIdeal + (S := RatFuncFiniteIntegralClosure K₀ L₀) V hbase ≠ ⊥ := + valuationCenterIdeal_ne_bot_of_mem_nonunits + (S := RatFuncFiniteIntegralClosure K₀ L₀) V hbase + Polynomial.X (by + rw [hpolyX] + intro hy0 + apply hyTrans + rw [hy0] + exact isAlgebraic_zero) hyNonunit + let q : FiniteExtensionFinitePlace K₀ L₀ := + valuationCenterPlace (S := RatFuncFiniteIntegralClosure K₀ L₀) + V hbase hcenterNe + have hvNontrivial : v.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one v).mpr + ⟨y, (by + intro hy0 + apply hyTrans + rw [hy0] + exact isAlgebraic_zero), hvylt⟩ + have hVne : V ≠ ⊤ := by + rw [ne_eq, Valuation.valuationSubring_eq_top_iff] + exact not_not_intro hvNontrivial + have hsubring : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L₀ q = V := + valuationSubringAt_valuationCenterPlace_eq + (S := RatFuncFiniteIntegralClosure K₀ L₀) + V hbase hcenterNe hVne + have hequiv : (q.valuation L₀).IsEquiv v := by + rw [Valuation.isEquiv_iff_valuationSubring, + ← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + exact hsubring + have hqval : q.valuation L₀ = v₁ w := + valuation_eq_of_isEquiv_of_surjective hequiv + (q.valuation_surjective L₀) (hv₁surj w) + have hqOrderVal := probeFiniteExtensionPlaceValuation_eq_exp_neg_order + K₀ L₀ (.inl q) y hy0 + have horder : finiteExtensionPrincipalDivisor K₀ L₀ y (.inl q) = + D₁ w := by + change q.valuation L₀ y = + exp (-finiteExtensionPrincipalDivisor K₀ L₀ y (.inl q)) at hqOrderVal + rw [hqval, hv₁y w] at hqOrderVal + have hneg := exp_injective hqOrderVal + omega + refine ⟨q, hqval, ?_, horder⟩ + letI : Finite q.asIdeal.ResidueField := + finiteExtensionFinitePlace_residueField_finite + (K := K₀) (L := L₀) q + cases w with + | inl q₁ => + let e := heightOneSpectrumResidueFieldRingEquivOfComapEq + q₁ q (RingEquiv.refl L₀) (by + have hqval' : q.valuation L₀ = q₁.valuation L₀ := by + simpa [v₁, probeFiniteExtensionPlaceValuation] using hqval + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + ext z + change q.valuation L₀ z ≤ 1 ↔ q₁.valuation L₀ z ≤ 1 + rw [hqval']) + letI : Finite q₁.asIdeal.ResidueField := + Finite.of_injective e e.injective + letI : FiniteDimensional K₀ q.asIdeal.ResidueField := inferInstance + letI : FiniteDimensional K₀ q₁.asIdeal.ResidueField := inferInstance + rw [probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue + K₀ L₀ q, hdegree₁] + exact (finrank_eq_of_ringEquiv_of_finite_base e).symm + | inr P₁ => + let q₁ := infinityPrime₁ P₁ + let e := heightOneSpectrumResidueFieldRingEquivOfComapEq + q₁ q (RingEquiv.refl L₀) (by + have hqval' : q.valuation L₀ = q₁.valuation L₀ := by + simpa [v₁, probeFiniteExtensionPlaceValuation, + q₁, infinityPrime₁] using hqval + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + ext z + change q.valuation L₀ z ≤ 1 ↔ q₁.valuation L₀ z ≤ 1 + rw [hqval']) + letI : Finite q₁.asIdeal.ResidueField := + Finite.of_injective e e.injective + letI : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ + letI : Fintype q₁.asIdeal.ResidueField := Fintype.ofFinite _ + letI : Module.Finite K₀ q.asIdeal.ResidueField := by + rw [Module.finite_def] + exact ⟨Finset.univ, by simp⟩ + letI : Module.Finite K₀ q₁.asIdeal.ResidueField := by + rw [Module.finite_def] + exact ⟨Finset.univ, by simp⟩ + rw [probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue + K₀ L₀ q, hdegree₁] + exact (finrank_eq_of_ringEquiv_of_finite_base e).symm + let T₁ := {w : W₁ // w ∈ S₁} + let centerFinite : T₁ → FiniteExtensionFinitePlace K₀ L₀ := + fun w => Classical.choose + (hcenter w.1 (Finset.mem_filter.mp w.2).2) + have hcenterFiniteVal (w : T₁) : + (centerFinite w).valuation L₀ = v₁ w.1 := by + exact (Classical.choose_spec + (hcenter w.1 (Finset.mem_filter.mp w.2).2)).1 + have hcenterFiniteDegree (w : T₁) : + finiteExtensionPlaceDegree K₀ L₀ (.inl (centerFinite w)) = + degree₁ w.1 := by + exact (Classical.choose_spec + (hcenter w.1 (Finset.mem_filter.mp w.2).2)).2.1 + have hcenterFiniteOrder (w : T₁) : + finiteExtensionPrincipalDivisor K₀ L₀ y + (.inl (centerFinite w)) = D₁ w.1 := by + exact (Classical.choose_spec + (hcenter w.1 (Finset.mem_filter.mp w.2).2)).2.2 + let W₂ := FiniteExtensionPlace K₀ L₀ + let D₂ : W₂ → ℤ := fun w => + finiteExtensionPrincipalDivisor K₀ L₀ y w + let degree₂ : W₂ → ℕ := fun w => + finiteExtensionPlaceDegree K₀ L₀ w + let center : T₁ → W₂ := fun w => .inl (centerFinite w) + have hcenterOrder (w : T₁) : D₂ (center w) = D₁ w.1 := by + exact hcenterFiniteOrder w + have hcenterDegree (w : T₁) : + degree₂ (center w) = degree₁ w.1 := by + exact hcenterFiniteDegree w + have hcenterInj : Function.Injective center := by + intro a b hab + have hcf : centerFinite a = centerFinite b := by + change Sum.inl (centerFinite a) = Sum.inl (centerFinite b) at hab + exact Sum.inl.inj hab + apply Subtype.ext + apply hv₁inj + rw [← hcenterFiniteVal a, ← hcenterFiniteVal b, hcf] + let S₂ := (finiteExtensionPrincipalDivisor K₀ L₀ y).support.filter + (fun w => 0 < D₂ w) + have hcenterImageSubset : S₁.attach.image center ⊆ S₂ := by + intro z hz + rcases Finset.mem_image.mp hz with ⟨w, hw, rfl⟩ + apply Finset.mem_filter.mpr + have hpos : 0 < D₁ w.1 := (Finset.mem_filter.mp w.2).2 + constructor + · apply Finsupp.mem_support_iff.mpr + change D₂ (center w) ≠ 0 + rw [hcenterOrder] + exact ne_of_gt hpos + · rw [hcenterOrder] + exact hpos + have hsumImage : + (∑ z ∈ S₁.attach.image center, + (D₂ z).toNat * degree₂ z) = + ∑ w ∈ S₁.attach, + (D₁ w.1).toNat * degree₁ w.1 := by + rw [Finset.sum_image] + · apply Finset.sum_congr rfl + intro w hw + rw [hcenterOrder, hcenterDegree] + · intro a ha b hb hab + exact hcenterInj hab + have hsource_le : + (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ + finiteExtensionPositiveDegree K₀ L₀ y := by + calc + _ = ∑ w ∈ S₁.attach, + (D₁ w.1).toNat * degree₁ w.1 := by + symm + exact Finset.sum_attach S₁ + (fun w => (D₁ w).toNat * degree₁ w) + _ = ∑ z ∈ S₁.attach.image center, + (D₂ z).toNat * degree₂ z := hsumImage.symm + _ ≤ ∑ z ∈ S₂, (D₂ z).toNat * degree₂ z := + Finset.sum_le_sum_of_subset hcenterImageSubset + _ = finiteExtensionPositiveDegree K₀ L₀ y := by + rfl + have hySecondDegree : + finiteExtensionPositiveDegree K₀ L₀ y = + MvPolynomial.degreeOf 0 f := by + have hheight := finiteExtensionPositiveDegree_polynomial + K₀ L₀ Polynomial.X Polynomial.X_ne_zero + change finiteExtensionPositiveDegree K₀ L₀ + (algebraMap K₀[X] L₀ Polynomial.X) = + Module.finrank (RatFunc K₀) L₀ * + Polynomial.X.natDegree at hheight + rw [hpolyX, + finrank_planeCurveFunctionField_over_secondRatFunc_eq_degreeOf_first + hf hpartialFirst] at hheight + simpa using hheight + have hySourceBound : + (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ + MvPolynomial.degreeOf 0 f := by + exact hsource_le.trans_eq hySecondDegree + change (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ + MvPolynomial.degreeOf 0 f + exact hySourceBound + +/-- The zero/pole boundary of positive powers of the two plane-curve +coordinates has degree at most twice the sum of the two coordinate degrees. -/ +theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_le + {f : MvPolynomial (Fin 2) K₀} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∑ w ∈ propositionTwoExceptionalPlaces K₀ (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K₀ (PlaneCurveFunctionField f) w ≤ + 2 * (MvPolynomial.degreeOf 0 f + MvPolynomial.degreeOf 1 f) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L₀ := PlaneCurveFunctionField f + let x : L₀ := planeCurveFunction f 0 + let y : L₀ := planeCurveFunction f 1 + have hxTrans : Transcendental K₀ x := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hyTrans : Transcendental K₀ y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro h + apply hxTrans + rw [h] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + letI : Algebra (RatFunc K₀) L₀ := + planeCurveFirstCoordinateRatFuncAlgebra f hxTrans + letI : FiniteDimensional (RatFunc K₀) L₀ := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K₀) L₀ := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hxDegree : finiteExtensionPositiveDegree K₀ L₀ x = + MvPolynomial.degreeOf 1 f := by + have hheight := finiteExtensionPositiveDegree_polynomial + K₀ L₀ Polynomial.X Polynomial.X_ne_zero + have hmap : algebraMap (RatFunc K₀) L₀ + (algebraMap K₀[X] (RatFunc K₀) Polynomial.X) = x := by + change ratFuncSpecialization x hxTrans RatFunc.X = x + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hxTrans + rw [hmap, + finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond] at hheight + simpa using hheight + have hyDegree : finiteExtensionPositiveDegree K₀ L₀ y ≤ + MvPolynomial.degreeOf 0 f := by + exact finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_first + hf hpartialFirst hpartialSecond + have hsupportX : + (finiteExtensionPrincipalDivisor K₀ L₀ (x ^ m)).support = + (finiteExtensionPrincipalDivisor K₀ L₀ x).support := by + rw [finiteExtensionPrincipalDivisor_pow K₀ L₀ x hx0 m] + ext w + simp [Finsupp.mem_support_iff, hm.ne'] + have hsupportY : + (finiteExtensionPrincipalDivisor K₀ L₀ (y ^ n)).support = + (finiteExtensionPrincipalDivisor K₀ L₀ y).support := by + rw [finiteExtensionPrincipalDivisor_pow K₀ L₀ y hy0 n] + ext w + simp [Finsupp.mem_support_iff, hn.ne'] + change (∑ w ∈ + (finiteExtensionPrincipalDivisor K₀ L₀ (x ^ m)).support ∪ + (finiteExtensionPrincipalDivisor K₀ L₀ (y ^ n)).support, + finiteExtensionPlaceDegree K₀ L₀ w) ≤ _ + rw [hsupportX, hsupportY] + calc + _ ≤ + (∑ w ∈ (finiteExtensionPrincipalDivisor K₀ L₀ x).support, + finiteExtensionPlaceDegree K₀ L₀ w) + + ∑ w ∈ (finiteExtensionPrincipalDivisor K₀ L₀ y).support, + finiteExtensionPlaceDegree K₀ L₀ w := by + let s := (finiteExtensionPrincipalDivisor K₀ L₀ x).support + let t := (finiteExtensionPrincipalDivisor K₀ L₀ y).support + let g := fun w => finiteExtensionPlaceDegree K₀ L₀ w + calc + ∑ w ∈ s ∪ t, g w = + (∑ w ∈ s, g w) + ∑ w ∈ t \ s, g w := by + rw [show s ∪ t = s ∪ (t \ s) by ext i; simp, + Finset.sum_union Finset.disjoint_sdiff] + _ ≤ (∑ w ∈ s, g w) + ∑ w ∈ t, g w := by + exact Nat.add_le_add_left + (Finset.sum_le_sum_of_subset Finset.sdiff_subset) _ + _ ≤ 2 * finiteExtensionPositiveDegree K₀ L₀ x + + 2 * finiteExtensionPositiveDegree K₀ L₀ y := + Nat.add_le_add + (finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + K₀ L₀ x hx0) + (finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + K₀ L₀ y hy0) + _ ≤ 2 * (MvPolynomial.degreeOf 0 f + + MvPolynomial.degreeOf 1 f) := by + rw [hxDegree] + omega + +end PlaneBoundaryProbe + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean new file mode 100644 index 0000000000..4fba87a194 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +import Mathlib.Tactic + +/-! +# The canonical different degree of a plane function field + +This module combines the sharp finite different bound with the complementary +bound above infinity. Keeping the actual polynomial discriminant as the +intermediate budget makes its degree cancel between the two contributions. +The result is the expected first-projection canonical bound + +`2 * degreeOf 0 f * degreeOf 1 f - 2 * degreeOf 0 f - 2 * degreeOf 1 f`. + +No algebraic closure of the constant field is assumed. +-/ + +open scoped Polynomial nonZeroDivisors BigOperators +open Polynomial IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Every bivariate polynomial has its tautological support-wise bidegree +bound given by its two `degreeOf` values. -/ +theorem hasBidegreeAtMost_degreeOf + (f : MvPolynomial (Fin 2) K) : + BGS.External.HasBidegreeAtMost f + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) := by + intro m hm + exact ⟨MvPolynomial.monomial_le_degreeOf 0 hm, + MvPolynomial.monomial_le_degreeOf 1 hm⟩ + +/-- The second-coordinate equation's discriminant satisfies the sharp +bidegree estimate at the curve's actual coordinate degrees. -/ +theorem planeCurvePolynomialInSecondCoordinate_discr_natDegree_le_degreeOf + (f : MvPolynomial (Fin 2) K) : + (planeCurvePolynomialInSecondCoordinate f).discr.natDegree ≤ + (2 * MvPolynomial.degreeOf 1 f - 2) * + MvPolynomial.degreeOf 0 f := by + exact planeCurvePolynomialInSecondCoordinate_discr_natDegree_le + (hasBidegreeAtMost_degreeOf f) + +variable [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + +/-- The sharp finite-different estimate implies the usual bidegree-only +finite discriminant budget. The canonical theorem below retains the sharper +intermediate discriminant so that it cancels against the infinity +complement. -/ +theorem planeCurve_finiteDifferentDegree_le_bidegreeDiscriminantBudget + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + finiteExtensionFiniteDifferentDegree K (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f)) ≤ + (2 * MvPolynomial.degreeOf 1 f - 2) * + MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + exact (planeCurve_finiteDifferentDegree_le_discrNatDegree + hf hpartialSecond hcardK).trans + (planeCurvePolynomialInSecondCoordinate_discr_natDegree_le_degreeOf f) + +/-- The canonical different divisor of the first-coordinate plane function +field has the sharp bidegree bound. -/ +theorem planeCurve_canonicalDifferentDivisor_degree_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) ≤ + 2 * (MvPolynomial.degreeOf 0 f : ℤ) * + (MvPolynomial.degreeOf 1 f : ℤ) - + 2 * (MvPolynomial.degreeOf 0 f : ℤ) - + 2 * (MvPolynomial.degreeOf 1 f : ℤ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let F : K[X][X] := planeCurvePolynomialInSecondCoordinate f + let firstDegree := MvPolynomial.degreeOf 0 f + let secondDegree := MvPolynomial.degreeOf 1 f + have hFne : F ≠ 0 := by + dsimp only [F] + simpa only [map_zero] using + (planeCurvePolynomialInSecondCoordinate (K := K)).injective.ne hf.ne_zero + have hsupport : F.support.Nonempty := + Polynomial.nonempty_support_iff.mpr hFne + let localFirstDegree : ℕ := + F.support.sup (fun i => (F.coeff i).natDegree) + obtain ⟨i, hiSupport, hiMax⟩ := Finset.exists_mem_eq_sup + F.support hsupport (fun i => (F.coeff i).natDegree) + have hFi : F.coeff i ≠ 0 := Polynomial.mem_support_iff.mp hiSupport + have hiDegree : (F.coeff i).natDegree = localFirstDegree := by + simpa only [localFirstDegree] using hiMax.symm + have hcoeff : ∀ j, (F.coeff j).natDegree ≤ localFirstDegree := by + intro j + by_cases hj : F.coeff j = 0 + · simp [hj] + · change (F.coeff j).natDegree ≤ + F.support.sup (fun i => (F.coeff i).natDegree) + exact Finset.le_sup (s := F.support) + (f := fun i : ℕ => (F.coeff i).natDegree) + (Polynomial.mem_support_iff.mpr hj) + have hlocalFirstDegree_le : localFirstDegree ≤ firstDegree := by + rw [← hiDegree] + exact planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le_degreeOf_first + f i + let v : L := planeCurveFunction f 1 + have hrootF : Polynomial.aeval v + (F.map (algebraMap K[X] (RatFunc K))) = 0 := by + simpa only [F, v] using + aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + hf hpartialSecond + have hrootNormalized : Polynomial.aeval v + (infinityNormalizedPolynomial K localFirstDegree F) = 0 := by + rw [infinityNormalizedPolynomial] + simp only [map_mul, aeval_C, hrootF, mul_zero] + have hrootIntegral : Polynomial.aeval v + (infinityNormalizedIntegralPolynomial K localFirstDegree F hcoeff) = 0 := by + rw [← Polynomial.aeval_map_algebraMap (RatFunc K) v] + rw [infinityNormalizedIntegralPolynomial_map] + exact hrootNormalized + have hprimitive : Algebra.adjoin (RatFunc K) {v} = ⊤ := by + exact adjoin_secondCoordinate_over_firstRatFunc_eq_top + hf hpartialSecond + have hFnatDegree : F.natDegree = secondDegree := by + simp [F, secondDegree] + have hfinrank : Module.finrank (RatFunc K) L = secondDegree := + finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond + have hFdegree : F.natDegree = Module.finrank (RatFunc K) L := + hFnatDegree.trans hfinrank.symm + have hFdiscr : F.discr ≠ 0 := by + simpa only [F] using + planeCurvePolynomialInSecondCoordinate_discr_ne_zero + hf hpartialSecond + have hcard : (F.natDegree : Cardinal) < Cardinal.mk K := by + have hdegree : F.natDegree = secondDegree := by + simp [F, secondDegree] + rw [hdegree] + simpa only [secondDegree, Cardinal.mk_fintype, Nat.cast_lt] using hcardK + have hFinite : finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) ≤ F.discr.natDegree := by + simpa only [F] using + planeCurve_finiteDifferentDegree_le_discrNatDegree + hf hpartialSecond hcardK + have hInfinity : (infinityDifferentDegree K L : ℤ) ≤ + (localFirstDegree * (2 * F.natDegree - 2) : ℕ) - + (F.discr.natDegree : ℤ) := + planeCurveInfinityDifferentDegree_le_bidegreeComplement + K L localFirstDegree F hcoeff i hFi hiDegree v + hrootIntegral hprimitive hFdegree hFdiscr hcard + have hCanonical := finiteExtensionCanonicalDifferentDivisor_degree_le_of_bounds + K L F.discr.natDegree + (localFirstDegree * (2 * F.natDegree - 2)) hFinite hInfinity + have hsecondPos : 0 < secondDegree := by + exact degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + have htwo_le : 2 ≤ 2 * secondDegree := by omega + have hlocalFirstDegreeInt : (localFirstDegree : ℤ) ≤ firstDegree := by + exact_mod_cast hlocalFirstDegree_le + have hfactorNonneg : (0 : ℤ) ≤ 2 * (secondDegree : ℤ) - 2 := by + omega + have hmul : (localFirstDegree : ℤ) * + (2 * (secondDegree : ℤ) - 2) ≤ + (firstDegree : ℤ) * (2 * (secondDegree : ℤ) - 2) := + mul_le_mul_of_nonneg_right hlocalFirstDegreeInt hfactorNonneg + have hbudgetCast : + ((localFirstDegree * (2 * secondDegree - 2) : ℕ) : ℤ) = + (localFirstDegree : ℤ) * (2 * (secondDegree : ℤ) - 2) := by + rw [Nat.cast_mul, Nat.cast_sub htwo_le] + push_cast + rfl + calc + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + ((localFirstDegree * (2 * secondDegree - 2) : ℕ) : ℤ) - + 2 * (secondDegree : ℤ) := by + simpa only [hFnatDegree, hfinrank] using hCanonical + _ = (localFirstDegree : ℤ) * (2 * (secondDegree : ℤ) - 2) - + 2 * (secondDegree : ℤ) := by rw [hbudgetCast] + _ ≤ (firstDegree : ℤ) * (2 * (secondDegree : ℤ) - 2) - + 2 * (secondDegree : ℤ) := sub_le_sub_right hmul _ + _ = 2 * (MvPolynomial.degreeOf 0 f : ℤ) * + (MvPolynomial.degreeOf 1 f : ℤ) - + 2 * (MvPolynomial.degreeOf 0 f : ℤ) - + 2 * (MvPolynomial.degreeOf 1 f : ℤ) := by + dsimp only [firstDegree, secondDegree] + ring + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean new file mode 100644 index 0000000000..da0dfec2f2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +import Mathlib.Tactic + +/-! +# The log-canonical degree budget for a plane curve + +This module combines the canonical-different estimate with the weighted +zero/pole boundary estimate. It is the exact geometric input `chi = 2ab` +used by the exhaustive-place form of Corvaja--Zannier Proposition 2. +-/ + +open scoped Polynomial BigOperators + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- The canonical divisor together with the actual weighted zero/pole +boundary of positive coordinate powers has degree at most twice the product +of the two coordinate degrees. -/ +theorem planeCurve_canonicalDifferent_add_propositionTwoExceptional_weightedDegree_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) + + (∑ w ∈ propositionTwoExceptionalPlaces K + (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℤ) ≤ + (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f : ℕ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hcanonical := planeCurve_canonicalDifferentDivisor_degree_le + hf hpartialSecond hcardK + have hboundary := + planeCurve_propositionTwoExceptionalPlaces_weightedDegree_le + hf hpartialFirst hpartialSecond m n hm hn + have hboundaryInt : + (∑ w ∈ propositionTwoExceptionalPlaces K + (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℤ) ≤ + 2 * ((MvPolynomial.degreeOf 0 f : ℤ) + + MvPolynomial.degreeOf 1 f) := by + exact_mod_cast hboundary + norm_num at hcanonical hboundaryInt ⊢ + omega + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean new file mode 100644 index 0000000000..d875c233bf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean @@ -0,0 +1,328 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +import Mathlib.Tactic + +/-! +# The canonical Corvaja--Zannier bound for powered plane coordinates + +This module composes the automatic canonical placewise estimate with the +first-coordinate model of a plane function field. Linear independence of +the auxiliary family supplies the Wronskian nonvanishing, while the two +powered-coordinate height theorems replace abstract positive divisor degrees +by the actual bidegree budgets. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped BigOperators Polynomial + +/-- The automatic canonical placewise estimate, specialized to +`u = x^m`, `v = y^n` on a plane curve and expressed using the actual +coordinate degrees. -/ +theorem finiteExtensionGcdBound_planeCurvePowers_of_auxiliaryFamily_linearIndependent + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (h k : ℕ) (hcard : 0 < h * k + h + k) (chi : ℕ) : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) h k) → + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) + + (∑ P ∈ propositionTwoExceptionalPlaces K (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) P : ℤ) ≤ + (chi : ℤ) → + (finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 0) ^ m) + (1 - (planeCurveFunction f 1) ^ n) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((n * MvPolynomial.degreeOf 0 f : ℕ) : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((m * MvPolynomial.degreeOf 1 f : ℕ) : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + dsimp only + intro hLI hEuler + let F := frobeniusSubfield L p + have hxTrans : Transcendental K x := hx + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro hzero + apply hxTrans + rw [hzero] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro hzero + apply hyTrans + rw [hzero] + exact isAlgebraic_zero + have hxm0 : x ^ m ≠ 0 := pow_ne_zero m hx0 + have hyn0 : y ^ n ≠ 0 := pow_ne_zero n hy0 + have hxm1 : x ^ m ≠ 1 := by + intro hone + apply hxTrans.pow hm + rw [hone] + exact isAlgebraic_one + have hyn1 : y ^ n ≠ 1 := by + intro hone + apply hyTrans.pow hn + rw [hone] + exact isAlgebraic_one + have hsepX := + (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX + letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) x + have hxNot : x ∉ F := + firstCoordinate_not_mem_frobeniusSubfield hf hpartialSecond + obtain ⟨D, hDx, hconstants⟩ := + exists_derivation_with_exact_frobenius_constants (p := p) x hxNot + have hmapX : algebraMap (RatFunc K) L RatFunc.X = x := by + change ratFuncSpecialization x hx RatFunc.X = x + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx + have hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1 := by + rw [hmapX] + exact hDx + have hWronskian : + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily (x ^ m) (y ^ n) h k)).det ≠ 0 := by + exact indexedAuxiliaryWronskian_det_ne_zero_of_linearIndependent D + (fun z hz ↦ (hconstants z).mp hz) h k + (auxiliaryFamily (x ^ m) (y ^ n) h k) hLI + have hcanonical := + finiteExtensionGcdBound_of_normalizedCanonicalPlacewiseBounds + K L D hDX (x ^ m) (y ^ n) hxm0 hyn0 hxm1 hyn1 + h k hcard chi hWronskian hEuler + have hxDegree : finiteExtensionPositiveDegree K L (x ^ m) = + m * MvPolynomial.degreeOf 1 f := by + simpa only [L, x] using + finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow + hf hpartialSecond m hm + have hyDegree : finiteExtensionPositiveDegree K L (y ^ n) ≤ + n * MvPolynomial.degreeOf 0 f := by + simpa only [L, y] using + finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_le + hf hpartialFirst hpartialSecond n + have hdenom : (0 : ℝ) < (h * k + h + k : ℕ) := by + exact_mod_cast hcard + have hfirstCoeff : + (0 : ℝ) ≤ ((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ) := by positivity + calc + (finiteExtensionGcdWeightedDegree K L (1 - x ^ m) (1 - y ^ n) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L (y ^ n) : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L (x ^ m) : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := hcanonical + _ ≤ ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((n * MvPolynomial.degreeOf 0 f : ℕ) : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((m * MvPolynomial.degreeOf 1 f : ℕ) : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + rw [hxDegree] + gcongr + +/-- The companion specialization with the powered coordinates exchanged. +Here the leading coefficient multiplies the exact height of `x^m`, while the +second coefficient multiplies the degree budget for `y^n`. -/ +theorem finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_linearIndependent + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (h k : ℕ) (hcard : 0 < h * k + h + k) (chi : ℕ) : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) h k) → + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) + + (∑ P ∈ propositionTwoExceptionalPlaces K (PlaneCurveFunctionField f) + ((planeCurveFunction f 1) ^ n) ((planeCurveFunction f 0) ^ m), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) P : ℤ) ≤ + (chi : ℤ) → + (finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 1) ^ n) + (1 - (planeCurveFunction f 0) ^ m) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((m * MvPolynomial.degreeOf 1 f : ℕ) : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((n * MvPolynomial.degreeOf 0 f : ℕ) : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + dsimp only + intro hLI hEuler + let F := frobeniusSubfield L p + have hxTrans : Transcendental K x := hx + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro hzero + apply hxTrans + rw [hzero] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro hzero + apply hyTrans + rw [hzero] + exact isAlgebraic_zero + have hxm0 : x ^ m ≠ 0 := pow_ne_zero m hx0 + have hyn0 : y ^ n ≠ 0 := pow_ne_zero n hy0 + have hxm1 : x ^ m ≠ 1 := by + intro hone + apply hxTrans.pow hm + rw [hone] + exact isAlgebraic_one + have hyn1 : y ^ n ≠ 1 := by + intro hone + apply hyTrans.pow hn + rw [hone] + exact isAlgebraic_one + have hsepX := + (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX + letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) x + have hxNot : x ∉ F := + firstCoordinate_not_mem_frobeniusSubfield hf hpartialSecond + obtain ⟨D, hDx, hconstants⟩ := + exists_derivation_with_exact_frobenius_constants (p := p) x hxNot + have hmapX : algebraMap (RatFunc K) L RatFunc.X = x := by + change ratFuncSpecialization x hx RatFunc.X = x + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx + have hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1 := by + rw [hmapX] + exact hDx + have hWronskian : + (indexedDedekindLocalWronskian D + (auxiliaryFamilyDerivativeOrder h k) + (auxiliaryFamily (y ^ n) (x ^ m) h k)).det ≠ 0 := by + exact indexedAuxiliaryWronskian_det_ne_zero_of_linearIndependent D + (fun z hz ↦ (hconstants z).mp hz) h k + (auxiliaryFamily (y ^ n) (x ^ m) h k) hLI + have hcanonical := + finiteExtensionGcdBound_of_normalizedCanonicalPlacewiseBounds + K L D hDX (y ^ n) (x ^ m) hyn0 hxm0 hyn1 hxm1 + h k hcard chi hWronskian hEuler + have hxDegree : finiteExtensionPositiveDegree K L (x ^ m) = + m * MvPolynomial.degreeOf 1 f := by + simpa only [L, x] using + finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow + hf hpartialSecond m hm + have hyDegree : finiteExtensionPositiveDegree K L (y ^ n) ≤ + n * MvPolynomial.degreeOf 0 f := by + simpa only [L, y] using + finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_le + hf hpartialFirst hpartialSecond n + have hdenom : (0 : ℝ) < (h * k + h + k : ℕ) := by + exact_mod_cast hcard + have hsecondCoeff : + (0 : ℝ) ≤ (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) := by + positivity + calc + (finiteExtensionGcdWeightedDegree K L (1 - y ^ n) (1 - x ^ m) : ℝ) ≤ + ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L (x ^ m) : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + (finiteExtensionPositiveDegree K L (y ^ n) : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := hcanonical + _ ≤ ((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((m * MvPolynomial.degreeOf 1 f : ℕ) : ℝ) + + (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * + ((n * MvPolynomial.degreeOf 0 f : ℕ) : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by + rw [hxDegree] + gcongr + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean new file mode 100644 index 0000000000..665b4fcb03 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean @@ -0,0 +1,95 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import Mathlib.Algebra.CharP.CharAndCard +import Mathlib.Tactic + +/-! +# Plane-curve degrees versus finite-field cardinality + +This file converts the characteristic bound used in the +Corvaja--Zannier argument into the finite-field cardinality bounds required +by the local reciprocal-discriminant and canonical Euler estimates. +-/ + +namespace BGS.CorvajaZannier + +/-- The prime characteristic of a finite field is at most its cardinality. -/ +theorem prime_le_fintype_card_of_charP + {K : Type*} [Field K] [Fintype K] + (p : ℕ) [Fact p.Prime] [CharP K p] : + p ≤ Fintype.card K := by + apply Nat.le_of_dvd Fintype.card_pos + apply (prime_dvd_char_iff_dvd_card p).mp + rw [ringChar.eq K p] + +/-- If twelve times the product of the two coordinate degrees is smaller +than `p`, and both coordinate partial derivatives are nonzero, then each +coordinate degree is smaller than `p`. -/ +theorem planeCurve_coordinateDegrees_lt_char_of_twelve_mul_degrees_lt_char + {K : Type*} [Field K] + {f : MvPolynomial (Fin 2) K} {p : ℕ} + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hbound : 12 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) : + MvPolynomial.degreeOf 0 f < p ∧ + MvPolynomial.degreeOf 1 f < p := by + have hfirst : 0 < MvPolynomial.degreeOf 0 f := + degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst + have hsecond : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + constructor <;> nlinarith + +/-- Under the characteristic-size hypothesis of the Corvaja--Zannier +application, both coordinate degrees are strictly smaller than the cardinality +of the finite constant field. -/ +theorem planeCurve_coordinateDegrees_lt_card_of_twelve_mul_degrees_lt_char + {K : Type*} [Field K] [Fintype K] + {f : MvPolynomial (Fin 2) K} {p : ℕ} + [Fact p.Prime] [CharP K p] + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hbound : 12 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) : + MvPolynomial.degreeOf 0 f < Fintype.card K ∧ + MvPolynomial.degreeOf 1 f < Fintype.card K := by + have hpCard : p ≤ Fintype.card K := + prime_le_fintype_card_of_charP (K := K) p + exact And.imp (fun h => h.trans_le hpCard) (fun h => h.trans_le hpCard) + (planeCurve_coordinateDegrees_lt_char_of_twelve_mul_degrees_lt_char + hpartialFirst hpartialSecond hbound) + +/-- First-coordinate specialization of +`planeCurve_coordinateDegrees_lt_card_of_twelve_mul_degrees_lt_char`. -/ +theorem planeCurve_degreeOf_first_lt_card_of_twelve_mul_degrees_lt_char + {K : Type*} [Field K] [Fintype K] + {f : MvPolynomial (Fin 2) K} {p : ℕ} + [Fact p.Prime] [CharP K p] + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hbound : 12 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) : + MvPolynomial.degreeOf 0 f < Fintype.card K := + (planeCurve_coordinateDegrees_lt_card_of_twelve_mul_degrees_lt_char + hpartialFirst hpartialSecond hbound).1 + +/-- Second-coordinate specialization of +`planeCurve_coordinateDegrees_lt_card_of_twelve_mul_degrees_lt_char`. -/ +theorem planeCurve_degreeOf_second_lt_card_of_twelve_mul_degrees_lt_char + {K : Type*} [Field K] [Fintype K] + {f : MvPolynomial (Fin 2) K} {p : ℕ} + [Fact p.Prime] [CharP K p] + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hbound : 12 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) : + MvPolynomial.degreeOf 1 f < Fintype.card K := + (planeCurve_coordinateDegrees_lt_card_of_twelve_mul_degrees_lt_char + hpartialFirst hpartialSecond hbound).2 + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean new file mode 100644 index 0000000000..ba7b1c1bde --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel + +/-! +# Exact heights of powered plane-curve coordinates + +The two rational-function-field models of a plane curve identify the base +variable `RatFunc.X` with the corresponding coordinate function. Combining +those models with the polynomial-height formula computes the positive degree +of the principal divisor of `x ^ m - 1` and `y ^ n - 1` exactly. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- In the first-coordinate `RatFunc K` model, the positive principal-divisor +degree of `x ^ m - 1` is `m` times the degree of the curve equation in the +second coordinate. -/ +theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow_sub_one + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m - 1) = + MvPolynomial.degreeOf 1 f * m := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + classical + let P : Polynomial K := Polynomial.X ^ m - 1 + have hP : P ≠ 0 := by + simpa [P] using + (Polynomial.X_pow_sub_C_ne_zero (R := K) hm (1 : K)) + have hheight := finiteExtensionPositiveDegree_polynomial + K (PlaneCurveFunctionField f) P hP + have hmap : + algebraMap (RatFunc K) (PlaneCurveFunctionField f) + (algebraMap (Polynomial K) (RatFunc K) P) = + (planeCurveFunction f 0) ^ m - 1 := by + simp [P] + rw [show ratFuncSpecialization (planeCurveFunction f 0) hx RatFunc.X = + planeCurveFunction f 0 by + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx] + rw [hmap, + finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond, + show P.natDegree = m by + simpa [P] using (Polynomial.natDegree_X_pow_sub_C + (R := K) (n := m) (r := 1))] + at hheight + exact hheight + +/-- In the second-coordinate `RatFunc K` model, the positive +principal-divisor degree of `y ^ n - 1` is `n` times the degree of the curve +equation in the first coordinate. -/ +theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_sub_one + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + letI := finiteDimensional_planeCurveFunctionField_over_secondRatFunc + hf hpartialFirst + letI := separable_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst + finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) + ((planeCurveFunction f 1) ^ n - 1) = + MvPolynomial.degreeOf 0 f * n := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveSecondCoordinateRatFuncAlgebra f hy + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_secondRatFunc + hf hpartialFirst + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst + classical + let P : Polynomial K := Polynomial.X ^ n - 1 + have hP : P ≠ 0 := by + simpa [P] using + (Polynomial.X_pow_sub_C_ne_zero (R := K) hn (1 : K)) + have hheight := finiteExtensionPositiveDegree_polynomial + K (PlaneCurveFunctionField f) P hP + have hmap : + algebraMap (RatFunc K) (PlaneCurveFunctionField f) + (algebraMap (Polynomial K) (RatFunc K) P) = + (planeCurveFunction f 1) ^ n - 1 := by + simp [P] + rw [hmap, + finrank_planeCurveFunctionField_over_secondRatFunc_eq_degreeOf_first + hf hpartialFirst, + show P.natDegree = n by + simpa [P] using (Polynomial.natDegree_X_pow_sub_C + (R := K) (n := n) (r := 1))] + at hheight + exact hheight + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean new file mode 100644 index 0000000000..808a09ce94 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss +import Mathlib.Tactic + +namespace BGS.CorvajaZannier +noncomputable section + +/-- Scale the two variables of a bivariate polynomial by a pair of units. -/ +def diagonalScale {F : Type*} [Field F] + (z : Fˣ × Fˣ) (f : MvPolynomial (Fin 2) F) := + f.support.sum fun m => + MvPolynomial.monomial m + (MvPolynomial.coeff m f * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1) + +theorem coeff_diagonalScale {F : Type*} [Field F] + (z : Fˣ × Fˣ) (f : MvPolynomial (Fin 2) F) + (m : Fin 2 →₀ ℕ) : + MvPolynomial.coeff m (diagonalScale z f) = + MvPolynomial.coeff m f * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 := by + classical + by_cases hm : m ∈ f.support + · simp [diagonalScale, MvPolynomial.coeff_sum, + MvPolynomial.coeff_monomial, hm] + · have hcoeff : MvPolynomial.coeff m f = 0 := + MvPolynomial.notMem_support_iff.mp hm + simp [diagonalScale, MvPolynomial.coeff_sum, + MvPolynomial.coeff_monomial, hm, hcoeff] + +theorem support_diagonalScale {F : Type*} [Field F] + (z : Fˣ × Fˣ) (f : MvPolynomial (Fin 2) F) : + (diagonalScale z f).support = f.support := by + ext m + simp only [MvPolynomial.mem_support_iff, coeff_diagonalScale] + constructor + · exact fun h => left_ne_zero_of_mul (left_ne_zero_of_mul h) + · intro h + exact mul_ne_zero + (mul_ne_zero h (pow_ne_zero _ (Units.ne_zero z.1))) + (pow_ne_zero _ (Units.ne_zero z.2)) + +theorem eval₂_diagonalScale {F L : Type*} [Field F] [Field L] + (φ : F →+* L) (z : Fˣ × Fˣ) + (x y : L) (f : MvPolynomial (Fin 2) F) : + MvPolynomial.eval₂ φ ![x, y] (diagonalScale z f) = + MvPolynomial.eval₂ φ ![φ z.1 * x, φ z.2 * y] f := by + classical + change (MvPolynomial.eval₂Hom φ ![x, y]) (diagonalScale z f) = + (MvPolynomial.eval₂Hom φ ![φ z.1 * x, φ z.2 * y]) f + rw [diagonalScale, map_sum] + conv_rhs => rw [f.as_sum, map_sum] + apply Finset.sum_congr rfl + intro m hm + have hprod (v : Fin 2 → L) : + m.prod (fun i k => v i ^ k) = v 0 ^ m 0 * v 1 ^ m 1 := by + rw [m.prod_fintype (fun i k => v i ^ k) (fun _ => pow_zero _), + Fin.prod_univ_two] + simp only [MvPolynomial.eval₂Hom_monomial, map_mul, map_pow, + hprod, Matrix.cons_val_zero, Matrix.cons_val_one, mul_pow] + ring + +private theorem eq_C_coeff_zero_of_bidegree_zero + {F : Type*} [Field F] (g : MvPolynomial (Fin 2) F) + (h0 : MvPolynomial.degreeOf 0 g = 0) + (h1 : MvPolynomial.degreeOf 1 g = 0) : + g = MvPolynomial.C (MvPolynomial.coeff 0 g) := by + ext m + by_cases hm : m = 0 + · subst m + simp + · have hcoordinate : m 0 ≠ 0 ∨ m 1 ≠ 0 := by + by_contra h + push Not at h + apply hm + ext i + fin_cases i <;> simp_all + have hmnot : m ∉ g.support := by + intro hmem + rcases hcoordinate with hm0 | hm1 + · have := MvPolynomial.le_degreeOf_of_mem_support 0 hmem + omega + · have := MvPolynomial.le_degreeOf_of_mem_support 1 hmem + omega + rw [MvPolynomial.notMem_support_iff.mp hmnot] + have hm' : (0 : Fin 2 →₀ ℕ) ≠ m := Ne.symm hm + simp [hm'] + +/-- A diagonal scaling divisible by the original polynomial differs from it by +a scalar. Equality of supports is what rules out a nonconstant quotient. -/ +theorem diagonalScale_eq_C_mul_of_dvd + {F : Type*} [Field F] {f : MvPolynomial (Fin 2) F} + (hf : f ≠ 0) (z : Fˣ × Fˣ) + (hdvd : f ∣ diagonalScale z f) : + ∃ c : F, diagonalScale z f = MvPolynomial.C c * f := by + obtain ⟨g, hg⟩ := hdvd + have hscale : diagonalScale z f ≠ 0 := by + intro h + have hs := support_diagonalScale z f + rw [h, MvPolynomial.support_zero] at hs + exact hf (MvPolynomial.support_eq_empty.mp hs.symm) + have hg0 : g ≠ 0 := by + intro h + apply hscale + rw [hg, h, mul_zero] + have hdegree (i : Fin 2) : + MvPolynomial.degreeOf i (diagonalScale z f) = + MvPolynomial.degreeOf i f := by + apply le_antisymm <;> rw [MvPolynomial.degreeOf_le_iff] + · intro m hm + exact MvPolynomial.le_degreeOf_of_mem_support i + (support_diagonalScale z f ▸ hm) + · intro m hm + exact MvPolynomial.le_degreeOf_of_mem_support i + (support_diagonalScale z f ▸ hm) + have hgDegree0 : MvPolynomial.degreeOf 0 g = 0 := by + have h := hdegree 0 + rw [hg, MvPolynomial.degreeOf_mul_eq hf hg0] at h + omega + have hgDegree1 : MvPolynomial.degreeOf 1 g = 0 := by + have h := hdegree 1 + rw [hg, MvPolynomial.degreeOf_mul_eq hf hg0] at h + omega + let c := MvPolynomial.coeff 0 g + have hgC : g = MvPolynomial.C c := + eq_C_coeff_zero_of_bidegree_zero g hgDegree0 hgDegree1 + refine ⟨c, ?_⟩ + rw [hg, hgC, mul_comm] + +/-- If a diagonal scaling of an irreducible plane curve vanishes at its generic +point, the scaling lies in the character stabilizer detected by its support. -/ +theorem planeCurveSupportCharacterStabilizer_of_diagonalScale_eval_zero + {F : Type*} [Field F] {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) (z : Fˣ × Fˣ) + (heval : + letI := planeCurveCoordinateRing_isDomain hf + MvPolynomial.eval₂ (algebraMap F (PlaneCurveFunctionField f)) + (planeCurveFunction f) (diagonalScale z f) = 0) : + ∀ r ∈ f.support, ∀ s ∈ f.support, + z.1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * + z.2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have hquotient : planeCurveQuotientMap f (diagonalScale z f) = 0 := by + apply IsFractionRing.injective + (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + rw [map_zero] + change ((algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)).comp (planeCurveQuotientMap f)) + (diagonalScale z f) = 0 + rw [← eval₂_planeCurveFunction f] + exact heval + have hdvd : f ∣ diagonalScale z f := + Ideal.mem_span_singleton.mp + (Ideal.Quotient.eq_zero_iff_mem.mp hquotient) + obtain ⟨c, hc⟩ := diagonalScale_eq_C_mul_of_dvd hf.ne_zero z hdvd + intro r hr s hs + have hweight (m : Fin 2 →₀ ℕ) (hm : m ∈ f.support) : + (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 = c := by + have hcoeff := congrArg (MvPolynomial.coeff m) hc + rw [coeff_diagonalScale] at hcoeff + simp only [MvPolynomial.coeff_C_mul] at hcoeff + have hm0 : MvPolynomial.coeff m f ≠ 0 := + MvPolynomial.mem_support_iff.mp hm + exact mul_left_cancel₀ hm0 + (by simpa [mul_comm, mul_left_comm, mul_assoc] using hcoeff) + have hwField : + (z.1 : F) ^ s 0 * (z.2 : F) ^ s 1 = + (z.1 : F) ^ r 0 * (z.2 : F) ^ r 1 := by + rw [hweight s hs, hweight r hr] + have hwUnits : z.1 ^ s 0 * z.2 ^ s 1 = z.1 ^ r 0 * z.2 ^ r 1 := by + apply Units.ext + exact hwField + calc + z.1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * + z.2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = + (z.1 ^ s 0 * z.2 ^ s 1) * + (z.1 ^ r 0 * z.2 ^ r 1)⁻¹ := by + simp only [zpow_sub, zpow_natCast, mul_inv_rev] + ac_rfl + _ = 1 := by rw [hwUnits]; simp + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean new file mode 100644 index 0000000000..7716fd1fff --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge + +/-! +# A sharp degree bound for a bivariate discriminant + +For a polynomial `F` in one variable whose coefficients are polynomials of degree at most +`a`, this file proves that the discriminant of `F` has degree at most +`(2 * F.natDegree - 2) * a` in the coefficient variable. The missing two copies of `a` +relative to the naive Sylvester-determinant estimate come from the constant bottom row in +Mathlib's modified Sylvester matrix for the derivative. + +This is the algebraic degree estimate needed in the Corvaja--Zannier canonical/divisor +calculation. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +theorem natDegree_sylvesterDeriv_apply_le_of_row_ne + (F : Polynomial (Polynomial K)) (a : ℕ) + (hcoeff : ∀ i, (F.coeff i).natDegree ≤ a) + (i j : Fin (F.natDegree - 1 + F.natDegree)) + (hi : (i : ℕ) ≠ 2 * F.natDegree - 2) : + (F.sylvesterDeriv i j).natDegree ≤ a := by + rw [Polynomial.sylvesterDeriv] + split_ifs with hn + · simp + · rw [Matrix.updateRow_ne (Fin.ne_of_val_ne hi)] + induction j using Fin.addCases with + | left j => + simp only [Polynomial.sylvester, Matrix.of_apply, Fin.addCases_left] + split_ifs + · exact hcoeff _ + · simp + | right j => + simp only [Polynomial.sylvester, Matrix.of_apply, Fin.addCases_right] + split_ifs + · rw [Polynomial.coeff_derivative] + have hconstant : + ((↑((i : ℕ) - (j : ℕ)) : Polynomial K) + 1).natDegree = 0 := by + apply Nat.eq_zero_of_le_zero + exact (Polynomial.natDegree_add_le _ _).trans (by simp) + calc + (F.coeff ((i : ℕ) - (j : ℕ) + 1) * + ((↑((i : ℕ) - (j : ℕ)) : Polynomial K) + 1)).natDegree ≤ + (F.coeff ((i : ℕ) - (j : ℕ) + 1)).natDegree + + ((↑((i : ℕ) - (j : ℕ)) : Polynomial K) + 1).natDegree := + Polynomial.natDegree_mul_le + _ ≤ a + 0 := add_le_add (hcoeff _) hconstant.le + _ = a := by omega + · simp + +theorem natDegree_sylvesterDeriv_apply_bottom + (F : Polynomial (Polynomial K)) (hF : 0 < F.natDegree) + (j : Fin (F.natDegree - 1 + F.natDegree)) : + (F.sylvesterDeriv ⟨2 * F.natDegree - 2, by omega⟩ j).natDegree = 0 := by + rw [Polynomial.sylvesterDeriv, dif_neg hF.ne'] + rw [Matrix.updateRow_self] + split_ifs <;> simp + +/-- The discriminant of a degree-`b` polynomial whose coefficients have degree at most +`a` has degree at most `(2 * b - 2) * a`. -/ +theorem natDegree_discr_le + (F : Polynomial (Polynomial K)) (a : ℕ) + (hcoeff : ∀ i, (F.coeff i).natDegree ≤ a) : + F.discr.natDegree ≤ (2 * F.natDegree - 2) * a := by + by_cases hF : F.natDegree = 0 + · rw [Polynomial.eq_C_of_natDegree_eq_zero hF, Polynomial.discr_C] + simp + have hFpos : 0 < F.natDegree := Nat.pos_of_ne_zero hF + let bottom : Fin (F.natDegree - 1 + F.natDegree) := + ⟨2 * F.natDegree - 2, by omega⟩ + let rowDegree : Fin (F.natDegree - 1 + F.natDegree) → ℕ := fun i => + if i = bottom then 0 else a + have hmatrix : ∀ i j, + ((F.sylvesterDeriv.transpose) i j).natDegree ≤ rowDegree j := by + intro i j + simp only [Matrix.transpose_apply] + by_cases hj : j = bottom + · subst j + simp only [rowDegree, ↓reduceIte] + exact (natDegree_sylvesterDeriv_apply_bottom F hFpos i).le + · rw [show rowDegree j = a by simp [rowDegree, hj]] + exact natDegree_sylvesterDeriv_apply_le_of_row_ne F a hcoeff j i (by + intro heq + apply hj + apply Fin.ext + simpa [bottom] using heq) + have hdet : F.sylvesterDeriv.det.natDegree ≤ ∑ j, rowDegree j := by + rw [← Matrix.det_transpose] + exact Matrix.natDegree_det_le_sum_columnDegree _ rowDegree hmatrix + have hsum : ∑ j, rowDegree j = + (F.natDegree - 1 + F.natDegree - 1) * a := by + rw [← Finset.sum_erase_add _ _ (Finset.mem_univ bottom)] + have hbottom : rowDegree bottom = 0 := by simp [rowDegree] + rw [hbottom, add_zero] + calc + ∑ x ∈ Finset.univ.erase bottom, rowDegree x = + ∑ x ∈ Finset.univ.erase bottom, a := by + apply Finset.sum_congr rfl + intro x hx + have hne : x ≠ bottom := (Finset.mem_erase.mp hx).1 + simp [rowDegree, hne] + _ = (F.natDegree - 1 + F.natDegree - 1) * a := by + rw [Finset.sum_const, nsmul_eq_mul, + Finset.card_erase_of_mem (Finset.mem_univ bottom)] + simp + have hindex : F.natDegree - 1 + F.natDegree - 1 = + 2 * F.natDegree - 2 := by omega + rw [Polynomial.discr] + calc + (F.sylvesterDeriv.det * + (-1) ^ (F.natDegree * (F.natDegree - 1) / 2)).natDegree ≤ + F.sylvesterDeriv.det.natDegree + + ((-1 : Polynomial K) ^ + (F.natDegree * (F.natDegree - 1) / 2)).natDegree := + Polynomial.natDegree_mul_le + _ ≤ (∑ j, rowDegree j) + 0 := add_le_add hdet (by simp) + _ = (F.natDegree - 1 + F.natDegree - 1) * a := by rw [hsum]; omega + _ = (2 * F.natDegree - 2) * a := by rw [hindex] + +/-- View a bivariate polynomial as a polynomial in coordinate `1`, with ordinary +polynomial coefficients in coordinate `0`. -/ +def planeCurvePolynomialInSecondCoordinate : + MvPolynomial (Fin 2) K ≃ₐ[K] Polynomial (Polynomial K) := + (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1)).trans + ((MvPolynomial.finSuccEquiv K 1).trans + (Polynomial.mapAlgEquiv (MvPolynomial.uniqueAlgEquiv K (Fin 1)))) + +theorem natDegree_uniqueAlgEquiv_le_degreeOf + {σ : Type*} [Unique σ] (P : MvPolynomial σ K) : + (MvPolynomial.uniqueAlgEquiv K σ P).natDegree ≤ + MvPolynomial.degreeOf default P := by + rw [Polynomial.natDegree_le_iff_coeff_eq_zero] + intro N hN + rw [MvPolynomial.coeff_uniqueAlgEquiv] + by_contra hcoeff + have hmem : Finsupp.single (default : σ) N ∈ P.support := + MvPolynomial.mem_support_iff.mpr hcoeff + have hle := MvPolynomial.monomial_le_degreeOf (default : σ) hmem + exact (not_le_of_gt hN) (by simpa using hle) + +@[simp] +theorem planeCurvePolynomialInSecondCoordinate_natDegree + (f : MvPolynomial (Fin 2) K) : + (planeCurvePolynomialInSecondCoordinate f).natDegree = + MvPolynomial.degreeOf 1 f := by + rw [planeCurvePolynomialInSecondCoordinate] + change (Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f))).natDegree = _ + rw [Polynomial.natDegree_map_eq_of_injective + (MvPolynomial.uniqueAlgEquiv K (Fin 1)).injective] + rw [MvPolynomial.natDegree_finSuccEquiv] + simpa using MvPolynomial.degreeOf_rename_of_injective + (Equiv.swap (0 : Fin 2) 1).injective (1 : Fin 2) (p := f) + +theorem planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le_degreeOf_first + (f : MvPolynomial (Fin 2) K) (i : ℕ) : + ((planeCurvePolynomialInSecondCoordinate f).coeff i).natDegree ≤ + MvPolynomial.degreeOf 0 f := by + rw [planeCurvePolynomialInSecondCoordinate] + change ((Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f))).coeff i).natDegree ≤ _ + rw [Polynomial.coeff_map] + calc + (MvPolynomial.uniqueAlgEquiv K (Fin 1) + ((MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f)).coeff i)).natDegree ≤ + MvPolynomial.degreeOf (0 : Fin 1) + ((MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f)).coeff i) := + natDegree_uniqueAlgEquiv_le_degreeOf _ + _ ≤ MvPolynomial.degreeOf (Fin.succ (0 : Fin 1)) + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f) := + MvPolynomial.degreeOf_coeff_finSuccEquiv _ _ _ + _ = MvPolynomial.degreeOf 0 f := by + simpa using MvPolynomial.degreeOf_rename_of_injective + (Equiv.swap (0 : Fin 2) 1).injective (0 : Fin 2) (p := f) + +theorem planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (i : ℕ) : + ((planeCurvePolynomialInSecondCoordinate f).coeff i).natDegree ≤ firstDegree := + (planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le_degreeOf_first f i).trans + (degreeOf_first_le_of_hasBidegreeAtMost hdegree) + +/-- The discriminant in the first coordinate of a plane curve of bidegree at most +`(firstDegree, secondDegree)` has the sharp degree bound +`(2 * secondDegree - 2) * firstDegree`. -/ +theorem planeCurvePolynomialInSecondCoordinate_discr_natDegree_le + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + (planeCurvePolynomialInSecondCoordinate f).discr.natDegree ≤ + (2 * secondDegree - 2) * firstDegree := by + calc + (planeCurvePolynomialInSecondCoordinate f).discr.natDegree ≤ + (2 * (planeCurvePolynomialInSecondCoordinate f).natDegree - 2) * + firstDegree := + natDegree_discr_le _ _ + (planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le hdegree) + _ ≤ (2 * secondDegree - 2) * firstDegree := by + gcongr + rw [planeCurvePolynomialInSecondCoordinate_natDegree] + exact degreeOf_second_le_of_hasBidegreeAtMost hdegree + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean new file mode 100644 index 0000000000..2127b0ca0a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound + +/-! +# Exhaustive gcd divisor at the plane-curve endpoint + +This module converts the exhaustive, degree-weighted gcd divisor into the +certificate expected by the public Corvaja--Zannier endpoint. The sharp +bidegree fiber count supplies the certificate's elementary upper bound, while +the injection of rational torsion points into the exhaustive divisor lets us +transfer Proposition 2 downward to the actual torsion-point cardinality. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The exhaustive weighted gcd divisor supplies a Proposition 2 certificate. + +The certificate uses the actual torsion-point cardinality as its gcd quantity. +The bidegree estimate gives its trivial bound, and monotonicity transfers the +Proposition 2 alternatives from the larger exhaustive weighted gcd degree. -/ +theorem planeCurvePropositionTwoCertificate_of_exhaustiveGcdWeightedDegree_and_bidegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} + (p firstDegree secondDegree firstOrder secondOrder : ℕ) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (hpropositionTwo : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder) + (planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder) + p (2 * firstDegree * secondDegree) + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder : ℝ)) : + PlaneCurvePropositionTwoCertificate + p K f firstDegree secondDegree firstOrder secondOrder := by + let card : ℕ := + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card + let gcdDegree : ℕ := + planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder + have hcardTrivial : card ≤ planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder := by + dsimp only [card, planeCurveTorsionLowerDegree] + simpa only [min_comm] using + torusCurveTorsionIntersection_card_le_min_bidegree_order + f firstDegree secondDegree firstOrder secondOrder + hbidegree hcurve hfirstOrder hsecondOrder + have hcardGcd : card ≤ gcdDegree := by + dsimp only [card, gcdDegree] + rw [torusCurveTorsionIntersection_card_eq_torsionPoint_card] + exact torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder + hfirstNonzero hsecondNonzero + refine ⟨(card : ℝ), le_rfl, ?_, ?_⟩ + · exact_mod_cast hcardTrivial + · apply propositionTwoNumericalAlternatives_mono + (G := (card : ℝ)) (H := (gcdDegree : ℝ)) + · exact_mod_cast hcardGcd + · simpa only [gcdDegree] using hpropositionTwo + +end + + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean new file mode 100644 index 0000000000..d0c99fba2e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean @@ -0,0 +1,813 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +import Mathlib.RingTheory.Localization.Integral +import Mathlib.Tactic + +/-! +# The sharp finite different bound for a plane curve + +This file bounds the residue-weighted finite different of the plane function +field by the discriminant degree of the original second-coordinate equation. +The key local step chooses a reciprocal primitive element separately at each +base prime; a prime-unit denominator-clearing argument then compares its +minimal-polynomial discriminant with the global different. +-/ + +open scoped Polynomial nonZeroDivisors BigOperators +open Polynomial IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +theorem adjoin_smul_eq_top_of_adjoin_eq_top + {K L : Type*} [Field K] [Field L] [Algebra K L] + [Algebra.IsAlgebraic K L] + (r : K) (hr : r ≠ 0) (z : L) + (hz : Algebra.adjoin K {z} = ⊤) : + Algebra.adjoin K {r • z} = ⊤ := by + apply (IntermediateField.adjoin_eq_top_iff).mp + have hz' : IntermediateField.adjoin K {z} = + (⊤ : IntermediateField K L) := + (IntermediateField.adjoin_eq_top_iff).mpr hz + apply top_unique + rw [← hz'] + apply IntermediateField.adjoin_simple_le_iff.mpr + let H := IntermediateField.adjoin K {r • z} + have hxmem : r • z ∈ H := + IntermediateField.mem_adjoin_simple_self K (r • z) + have hmem : algebraMap K L (r⁻¹) * (r • z) ∈ H := + mul_mem (IntermediateField.algebraMap_mem H (r⁻¹)) hxmem + have heq : z = algebraMap K L (r⁻¹) * (r • z) := by + simp [Algebra.smul_def, hr] + exact Eq.mpr (congrArg (fun x : L => x ∈ H) heq) hmem + +theorem minpoly_discr_ne_zero_of_adjoin_eq_top + {K L : Type*} [Field K] [Field L] [Algebra K L] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + (z : L) (hz : Algebra.adjoin K {z} = ⊤) : + (minpoly K z).discr ≠ 0 := by + let pb : PowerBasis K L := + PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral z) hz + have hgen : pb.gen = z := PowerBasis.ofAdjoinEqTop'_gen _ _ + have hdisc := discr_powerBasis_eq_minpoly_discr pb + rw [hgen] at hdisc + rw [← hdisc] + exact Algebra.discr_not_zero_of_basis K pb.basis + +theorem powerBasis_discr_smul_eq_diagonal_det_sq_mul + {K L : Type*} [Field K] [Field L] [Algebra K L] + (r : K) (z : L) (pbz pbx : PowerBasis K L) + (hgenZ : pbz.gen = z) (hgenX : pbx.gen = r • z) : + Algebra.discr K pbx.basis = + (Matrix.diagonal (fun i : Fin pbx.dim => r ^ (i : ℕ))).det ^ 2 * + Algebra.discr K pbz.basis := by + have hdim : pbx.dim = pbz.dim := pbx.finrank.symm.trans pbz.finrank + let e : Fin pbx.dim ≃ Fin pbz.dim := finCongr hdim + let P : Matrix (Fin pbx.dim) (Fin pbx.dim) K := + Matrix.diagonal (fun i => r ^ (i : ℕ)) + have hbasis : (fun i => pbx.basis i) = + (P.map (algebraMap K L)).mulVec (fun i => pbz.basis (e i)) := by + funext i + rw [show pbx.basis i = pbx.gen ^ (i : ℕ) by + simpa only [PowerBasis.coe_basis] using congrFun (PowerBasis.coe_basis pbx) i] + rw [show P.map (algebraMap K L) = + Matrix.diagonal (fun i : Fin pbx.dim => + algebraMap K L (r ^ (i : ℕ))) by + ext i j + simp only [P, Matrix.map_apply, Matrix.diagonal_apply] + split <;> simp_all] + rw [Matrix.mulVec_diagonal] + rw [show pbz.basis (e i) = pbz.gen ^ ((e i : Fin pbz.dim) : ℕ) by + simpa only [PowerBasis.coe_basis] using + congrFun (PowerBasis.coe_basis pbz) (e i)] + rw [hgenX, hgenZ] + have hei : ((e i : Fin pbz.dim) : ℕ) = (i : ℕ) := by simp [e] + rw [hei] + simp [Algebra.smul_def, mul_pow] + have hreindex : Algebra.discr K (fun i => pbz.basis (e i)) = + Algebra.discr K pbz.basis := by + simpa [Function.comp_def] using Algebra.discr_reindex K pbz.basis e.symm + have hchange := Algebra.discr_of_matrix_mulVec + (fun i => pbz.basis (e i)) P + rw [← hbasis, hreindex] at hchange + exact hchange + +theorem exists_minpoly_discr_smul_eq_pow_mul + {K L : Type*} [Field K] [Field L] [Algebra K L] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + (r : K) (hr : r ≠ 0) (z : L) + (hz : Algebra.adjoin K {z} = ⊤) : + ∃ N : ℕ, (minpoly K (r • z)).discr = + r ^ N * (minpoly K z).discr := by + let pbz : PowerBasis K L := + PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral z) hz + have hgenZ : pbz.gen = z := by + exact PowerBasis.ofAdjoinEqTop'_gen _ _ + have hx : Algebra.adjoin K {r • z} = ⊤ := + adjoin_smul_eq_top_of_adjoin_eq_top r hr z hz + let pbx : PowerBasis K L := + PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral (r • z)) hx + have hgenX : pbx.gen = r • z := by + exact PowerBasis.ofAdjoinEqTop'_gen _ _ + have hdiscX := discr_powerBasis_eq_minpoly_discr pbx + have hdiscZ := discr_powerBasis_eq_minpoly_discr pbz + rw [hgenX] at hdiscX + rw [hgenZ] at hdiscZ + have hchange := powerBasis_discr_smul_eq_diagonal_det_sq_mul + r z pbz pbx hgenZ hgenX + let P : Matrix (Fin pbx.dim) (Fin pbx.dim) K := + Matrix.diagonal (fun i => r ^ (i : ℕ)) + have hdisc : (minpoly K (r • z)).discr = + P.det ^ 2 * (minpoly K z).discr := by + exact hdiscX.symm.trans (hchange.trans + (congrArg (P.det ^ 2 * ·) hdiscZ)) + let d : ℕ := ∑ i : Fin pbx.dim, (i : ℕ) + have hdet : P.det = r ^ d := by + rw [show P.det = ∏ i : Fin pbx.dim, r ^ (i : ℕ) by + simp [P, Matrix.det_diagonal]] + simpa [d] using + (Finset.prod_pow_eq_pow_sum Finset.univ + (fun i : Fin pbx.dim => (i : ℕ)) r) + refine ⟨2 * d, ?_⟩ + rw [hdisc, hdet] + congr 1 + rw [← pow_mul] + congr 1 + omega + +theorem finitePlaceOrder_mul_of_ne_zero + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (v : HeightOneSpectrum R) (x y : F) (hx : x ≠ 0) (hy : y ≠ 0) : + finitePlaceOrder v (x * y) = + finitePlaceOrder v x + finitePlaceOrder v y := by + have h := finitePlaceOrderTop_mul v x y + rw [finitePlaceOrderTop_eq_coe v (x * y) (mul_ne_zero hx hy), + finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v y hy] at h + exact_mod_cast h + +theorem finitePlaceOrder_pow_of_ne_zero + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (v : HeightOneSpectrum R) (x : F) (hx : x ≠ 0) (n : ℕ) : + finitePlaceOrder v (x ^ n) = n • finitePlaceOrder v x := by + have h := finitePlaceOrderTop_pow v x n + rw [finitePlaceOrderTop_eq_coe v (x ^ n) (pow_ne_zero n hx), + finitePlaceOrderTop_eq_coe v x hx] at h + exact_mod_cast h + +theorem finitePlaceOrder_algebraMap_unit_eq_zero + {R F : Type*} [CommRing R] [IsDedekindDomain R] + [Field F] [Algebra R F] [IsFractionRing R F] + (v : HeightOneSpectrum R) (u : Rˣ) : + finitePlaceOrder v (algebraMap R F (u : R)) = 0 := by + have h := finitePlaceOrderTop_algebraMap_unit (A := R) (K := F) v u + have hu : algebraMap R F (u : R) ≠ 0 := + by simpa using (IsFractionRing.injective R F).ne u.ne_zero + rw [finitePlaceOrderTop_eq_coe v _ hu] at h + exact_mod_cast h + +/-- The discriminant of the second-coordinate plane equation is nonzero +under the separating-coordinate hypothesis. -/ +theorem planeCurvePolynomialInSecondCoordinate_discr_ne_zero + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + (planeCurvePolynomialInSecondCoordinate f).discr ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let F : (RatFunc K)[X] := + (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap K[X] (RatFunc K)) + have hFirreducible : Irreducible F := + planeCurvePolynomialInSecondCoordinate_ratFunc_irreducible + hf hpartialSecond + have hFroot : Polynomial.aeval (planeCurveFunction f 1) F = 0 := + aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + hf hpartialSecond + have heq := minpoly.eq_of_irreducible hFirreducible hFroot + have hprimitive := adjoin_secondCoordinate_over_firstRatFunc_eq_top + hf hpartialSecond + have hminNe : + (minpoly (RatFunc K) (planeCurveFunction f 1)).discr ≠ 0 := + minpoly_discr_ne_zero_of_adjoin_eq_top + (planeCurveFunction f 1) hprimitive + have hinvNe : F.leadingCoeff⁻¹ ≠ 0 := + inv_ne_zero (leadingCoeff_ne_zero.mpr hFirreducible.ne_zero) + have hscaledNe : (Polynomial.C F.leadingCoeff⁻¹ * F).discr ≠ 0 := by + simpa only [mul_comm] using (heq ▸ hminNe) + rw [discr_C_mul F F.leadingCoeff⁻¹ hinvNe] at hscaledNe + have hFdiscrNe : F.discr ≠ 0 := by + intro hzero + exact hscaledNe (by rw [hzero, mul_zero]) + have hmap := discr_map_of_injective + (algebraMap K[X] (RatFunc K)) + (IsFractionRing.injective K[X] (RatFunc K)) + (planeCurvePolynomialInSecondCoordinate f) + intro hzero + apply hFdiscrNe + rw [show F.discr = algebraMap K[X] (RatFunc K) + (planeCurvePolynomialInSecondCoordinate f).discr by + exact hmap] + rw [hzero, map_zero] + +section FiniteDifferentBelow + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) finiteDifferentBoundPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance finiteDifferentBoundPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + ⟨fun r s x => by + simp only [Algebra.smul_def] + rw [map_mul] + change (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) * + algebraMap (RatFunc K) L s) * x = + algebraMap K[X] L r * (algebraMap (RatFunc K) L s * x) + rw [show algebraMap K[X] L r = + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) by rfl] + ring⟩ + +local instance finiteDifferentBoundFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance finiteDifferentBoundFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance finiteDifferentBoundPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance finiteDifferentBoundFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +/-- The finite different, weighted by residue degree but not yet by the +degree of the base prime. -/ +def finiteExtensionFiniteDifferentResidueWeightedDivisor + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) : + FiniteExtensionFinitePlace K L →₀ ℕ := + (differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) hDifferent).sum (fun q e => + Finsupp.single q (e * q.asIdeal.inertiaDeg K[X])) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +@[simp] theorem finiteExtensionFiniteDifferentResidueWeightedDivisor_apply + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionFiniteDifferentResidueWeightedDivisor K L hDifferent q = + multiplicity q.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) * + q.asIdeal.inertiaDeg K[X] := by + classical + let D := differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) hDifferent + rw [finiteExtensionFiniteDifferentResidueWeightedDivisor, Finsupp.sum_apply] + unfold Finsupp.sum + by_cases hq : q ∈ D.support + · rw [Finset.sum_eq_single q] + · simp [differentMultiplicityDivisor_apply] + · intro b hb hbq + simp [hbq] + · exact fun hnot => (hnot hq).elim + · rw [Finset.sum_eq_zero] + · change 0 = multiplicity q.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) * + q.asIdeal.inertiaDeg K[X] + have hzero : D q = 0 := Finsupp.notMem_support_iff.mp hq + simpa [D, differentMultiplicityDivisor_apply] using + congrArg (fun n => n * q.asIdeal.inertiaDeg K[X]) hzero.symm + · intro b hb + have hbq : b ≠ q := by + intro h + subst h + exact hq hb + simp [hbq] + +/-- Push the residue-weighted finite different down to the finite primes of +`K[X]`. -/ +def finiteExtensionFiniteDifferentDivisorBelow + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) : + HeightOneSpectrum K[X] →₀ ℕ := + (finiteExtensionFiniteDifferentResidueWeightedDivisor K L hDifferent).mapDomain + (HeightOneSpectrum.under K[X]) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finiteExtensionFiniteDifferentDivisorBelow_apply + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (p : HeightOneSpectrum K[X]) : + finiteExtensionFiniteDifferentDivisorBelow K L hDifferent p = + ∑ P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + P.1.inertiaDeg K[X] * + multiplicity P.1 + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) := by + classical + let e := finitePlaceFiberEquivPrimesOver K L p + letI : Fintype {q : FiniteExtensionFinitePlace K L // + HeightOneSpectrum.under K[X] q = p} := + Fintype.ofEquiv (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) e.symm + let P₀ : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := + Classical.choice (Set.nonempty_coe_sort.mpr + (Set.nonempty_iff_ne_empty.mpr (by + intro hempty + have hncard := IsDedekindDomain.primesOver_ncard_ne_zero p.asIdeal + (RatFuncFiniteIntegralClosure K L) + exact hncard (by simp [hempty])))) + let q₀ : FiniteExtensionFinitePlace K L := primeOverHeightOne p P₀ + have hq₀ : HeightOneSpectrum.under K[X] q₀ = p := by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P₀.1 p.asIdeal).symm + rw [finiteExtensionFiniteDifferentDivisorBelow, show p = + HeightOneSpectrum.under K[X] q₀ from hq₀.symm, + Finsupp.mapDomain_apply_eq_sum] + let D := finiteExtensionFiniteDifferentResidueWeightedDivisor K L hDifferent + have hfilter : + (∑ q ∈ D.support with HeightOneSpectrum.under K[X] q = + HeightOneSpectrum.under K[X] q₀, D q) = + ∑ q : {q : FiniteExtensionFinitePlace K L // + HeightOneSpectrum.under K[X] q = p}, D q := by + rw [hq₀] + calc + _ = ∑ q ∈ Finset.subtype + (fun q => HeightOneSpectrum.under K[X] q = p) D.support, + D q := (Finset.sum_subtype_eq_sum_filter (s := D.support) + (fun q => D q)).symm + _ = ∑ q : {q : FiniteExtensionFinitePlace K L // + HeightOneSpectrum.under K[X] q = p}, D q := by + apply Finset.sum_subset (Finset.subset_univ _) + intro q _ hq + have hnot : q.1 ∉ D.support := by + intro hmem + exact hq (Finset.mem_subtype.mpr hmem) + exact Finsupp.notMem_support_iff.mp hnot + rw [hfilter, hq₀] + apply Fintype.sum_equiv e + intro q + rw [finiteExtensionFiniteDifferentResidueWeightedDivisor_apply] + change multiplicity q.1.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) * + q.1.asIdeal.inertiaDeg K[X] = + q.1.asIdeal.inertiaDeg K[X] * + multiplicity q.1.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) + ring + +omit [DecidableEq (RatFunc K)] in +/-- Pushing the residue-weighted different down to the base does not change +its degree-weighted sum. -/ +theorem finiteExtensionFiniteDifferentDegree_eq_belowWeightedDegree + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) : + finiteExtensionFiniteDifferentDegree K L hDifferent = + (finiteExtensionFiniteDifferentDivisorBelow K L hDifferent).sum + (fun p e => e * ratFuncFinitePlaceDegree p) := by + classical + let D := differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) hDifferent + let DW := finiteExtensionFiniteDifferentResidueWeightedDivisor + K L hDifferent + let DB := finiteExtensionFiniteDifferentDivisorBelow K L hDifferent + calc + finiteExtensionFiniteDifferentDegree K L hDifferent = + DW.sum (fun q e => e * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q)) := by + rw [finiteExtensionFiniteDifferentDegree] + change D.sum _ = DW.sum _ + dsimp only [DW] + rw [finiteExtensionFiniteDifferentResidueWeightedDivisor, + Finsupp.sum_sum_index (fun _ => by simp) + (fun _ _ _ => by ring)] + apply Finsupp.sum_congr + intro q _ + rw [Finsupp.sum_single_index] + · ring + _ = DB.sum (fun p e => e * ratFuncFinitePlaceDegree p) := by + dsimp only [DB, DW] + rw [finiteExtensionFiniteDifferentDivisorBelow] + symm + apply Finsupp.sum_mapDomain_index + · intro + simp + · intro _ _ _ + ring + +omit [DecidableEq (RatFunc K)] in +/-- A coefficientwise finite-place discriminant bound sums to the corresponding +degree bound. -/ +theorem finiteExtensionFiniteDifferentDegree_le_polynomialDegree_of_localBounds + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (Δ : K[X]) (hΔ : Δ ≠ 0) + (hlocal : ∀ p : HeightOneSpectrum K[X], + (finiteExtensionFiniteDifferentDivisorBelow K L hDifferent p : ℤ) ≤ + ratFuncFiniteOrder p (algebraMap K[X] (RatFunc K) Δ)) : + finiteExtensionFiniteDifferentDegree K L hDifferent ≤ Δ.natDegree := by + classical + let DB := finiteExtensionFiniteDifferentDivisorBelow K L hDifferent + let DBZ : HeightOneSpectrum K[X] →₀ ℤ := + DB.mapRange (fun n : ℕ => (n : ℤ)) (by simp) + let P := ratFuncFiniteDivisor (algebraMap K[X] (RatFunc K) Δ) + have hpoint : DBZ ≤ P := by + intro p + dsimp only [DBZ, P] + rw [Finsupp.mapRange_apply, ratFuncFiniteDivisor_apply] + exact hlocal p + have hsum : + DBZ.sum (fun p e => e * (ratFuncFinitePlaceDegree p : ℤ)) ≤ + P.sum (fun p e => e * (ratFuncFinitePlaceDegree p : ℤ)) := by + apply Finsupp.sum_le_sum_index hpoint + · intro p _ a b hab + exact mul_le_mul_of_nonneg_right hab (Int.natCast_nonneg _) + · intro p _ + simp + have hcast : (finiteExtensionFiniteDifferentDegree K L hDifferent : ℤ) ≤ + (Δ.natDegree : ℤ) := by + calc + (finiteExtensionFiniteDifferentDegree K L hDifferent : ℤ) = + DBZ.sum (fun p e => e * + (ratFuncFinitePlaceDegree p : ℤ)) := by + rw [finiteExtensionFiniteDifferentDegree_eq_belowWeightedDegree] + rw [Nat.cast_finsupp_sum] + dsimp only [DBZ, DB] + rw [Finsupp.sum_mapRange_index (fun _ => by simp)] + apply Finsupp.sum_congr + intro p _ + push_cast + rfl + _ ≤ P.sum (fun p e => e * + (ratFuncFinitePlaceDegree p : ℤ)) := hsum + _ = ratFuncExhaustiveFinitePlaceDegreeSum + (algebraMap K[X] (RatFunc K) Δ) := by rfl + _ = (algebraMap K[X] (RatFunc K) Δ).intDegree := + ratFuncExhaustiveFinitePlaceDegreeSum_eq_intDegree _ + (RatFunc.algebraMap_ne_zero hΔ) + _ = (Δ.natDegree : ℤ) := RatFunc.intDegree_polynomial + exact_mod_cast hcast + +theorem finiteExtensionFiniteDifferentDivisorBelow_apply_le_minpolyDiscr_of_localPrimitive + (hDifferent : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥) + (p : HeightOneSpectrum K[X]) + [Algebra (Localization.AtPrime p.asIdeal) L] + [IsScalarTower K[X] (Localization.AtPrime p.asIdeal) L] + (z : L) (hzIntegral : IsIntegral (Localization.AtPrime p.asIdeal) z) + (hzPrimitive : Algebra.adjoin (RatFunc K) {z} = ⊤) : + (finiteExtensionFiniteDifferentDivisorBelow K L hDifferent p : ℤ) ≤ + ratFuncFiniteOrder p (minpoly (RatFunc K) z).discr := by + let A := Localization.AtPrime p.asIdeal + let B := RatFuncFiniteIntegralClosure K L + obtain ⟨m, hmIntegral⟩ := + IsIntegral.exists_multiple_integral_of_isLocalization + p.asIdeal.primeCompl z hzIntegral + have hm_ne : (m : K[X]) ≠ 0 := by + intro hm + exact m.property (hm ▸ p.asIdeal.zero_mem) + let r : RatFunc K := algebraMap K[X] (RatFunc K) (m : K[X]) + have hr : r ≠ 0 := RatFunc.algebraMap_ne_zero hm_ne + let x : B := IsIntegralClosure.mk' B ((m : K[X]) • z) hmIntegral + have hxMap : algebraMap B L x = (m : K[X]) • z := by + simp [x] + have hxScale : algebraMap B L x = r • z := by + rw [hxMap] + simp only [Algebra.smul_def, r] + rw [IsScalarTower.algebraMap_apply K[X] (RatFunc K) L] + have hxPrimitive : Algebra.adjoin (RatFunc K) + {algebraMap B L x} = ⊤ := by + rw [hxScale] + exact adjoin_smul_eq_top_of_adjoin_eq_top r hr z hzPrimitive + let d : B := aeval x (derivative (minpoly K[X] x)) + have hd : d ≠ 0 := by + simpa [d] using minpolyDerivative_ne_zero + (A := K[X]) (K := RatFunc K) (L := L) x + let dL : L := algebraMap B L d + have hdL : dL ≠ 0 := (IsFractionRing.injective B L).ne hd + have hrepr : + (ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm dL = + algebraMap B (FractionRing B) d := by + apply (ratFuncFiniteIntegralClosureFractionRingEquiv K L).injective + rw [(ratFuncFiniteIntegralClosureFractionRingEquiv K L).apply_symm_apply] + exact (ratFuncFiniteIntegralClosureFractionRingEquiv K L).commutes d |>.symm + have hpoint : ∀ P : p.asIdeal.primesOver B, + ((P.1.inertiaDeg K[X] * + multiplicity P.1 (differentIdeal K[X] B) : ℕ) : ℤ) ≤ + (P.1.inertiaDeg K[X] : ℤ) * + finitePlaceOrder (primeOverHeightOne p P) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm dL) := by + intro P + have hmul := differentIdeal_multiplicity_le_minpolyDerivativeSpan + (A := K[X]) (K := RatFunc K) (L := L) (B := B) + x hxPrimitive (primeOverHeightOne p P) + have horder : + finitePlaceOrder (primeOverHeightOne p P) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm dL) = + (multiplicity P.1 (Ideal.span {d}) : ℤ) := by + rw [hrepr] + simpa using finitePlaceOrder_algebraMap_eq_multiplicity + (primeOverHeightOne p P) d hd + rw [horder] + exact_mod_cast Nat.mul_le_mul_left (P.1.inertiaDeg K[X]) hmul + have hsum : + (finiteExtensionFiniteDifferentDivisorBelow K L hDifferent p : ℤ) ≤ + ∑ P : p.asIdeal.primesOver B, + (P.1.inertiaDeg K[X] : ℤ) * + finitePlaceOrder (primeOverHeightOne p P) + ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm dL) := by + rw [finiteExtensionFiniteDifferentDivisorBelow_apply, Nat.cast_sum] + exact Finset.sum_le_sum fun P _ => hpoint P + rw [finitePrimesAbove_weightedOrder_eq_normOrder K L p dL hdL] at hsum + let pb : PowerBasis (RatFunc K) L := + PowerBasis.ofAdjoinEqTop' + (Algebra.IsIntegral.isIntegral (algebraMap B L x)) hxPrimitive + have hdiscNorm := discr_powerBasisOfPrimitiveElement_eq_norm_minpolyDerivative + (A := K[X]) (K := RatFunc K) (L := L) (B := B) x hxPrimitive + have hpb : Algebra.discr (RatFunc K) pb.basis = + (minpoly (RatFunc K) (algebraMap B L x)).discr := by + have hpbg : pb.gen = algebraMap B L x := by simp [pb] + simpa only [hpbg] using discr_powerBasis_eq_minpoly_discr pb + change Algebra.discr (RatFunc K) pb.basis = + (-1) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2) * + Algebra.norm (RatFunc K) dL at hdiscNorm + rw [hpb] at hdiscNorm + have hnormNe : Algebra.norm (RatFunc K) dL ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hdL + have hsignNe : + ((-1 : RatFunc K) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2)) ≠ 0 := by simp + have hminXNe : + (minpoly (RatFunc K) (algebraMap B L x)).discr ≠ 0 := by + rw [hdiscNorm] + exact mul_ne_zero hsignNe hnormNe + have hnormOrder : + ratFuncFiniteOrder p (Algebra.norm (RatFunc K) dL) = + ratFuncFiniteOrder p + (minpoly (RatFunc K) (algebraMap B L x)).discr := by + have horder := congrArg (finitePlaceOrder p) hdiscNorm + rw [finitePlaceOrder_mul_of_ne_zero p _ _ hsignNe hnormNe] at horder + have hsignOrder : finitePlaceOrder p + ((-1 : RatFunc K) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2)) = 0 := by + rw [finitePlaceOrder_pow_of_ne_zero p (-1 : RatFunc K) (by simp)] + have hminus := finitePlaceOrder_algebraMap_unit_eq_zero + (R := K[X]) (F := RatFunc K) p (-1 : K[X]ˣ) + have hminus' : finitePlaceOrder p (-1 : RatFunc K) = 0 := by + simpa using hminus + rw [hminus', smul_zero] + rw [hsignOrder, zero_add] at horder + exact horder.symm + have hmMultiplicity : + multiplicity p.asIdeal (Ideal.span {(m : K[X])}) = 0 := by + rw [multiplicity_eq_zero, Ideal.dvd_span_singleton] + exact m.property + have hrOrder : ratFuncFiniteOrder p r = 0 := by + change finitePlaceOrder p (algebraMap K[X] (RatFunc K) (m : K[X])) = 0 + rw [finitePlaceOrder_algebraMap_eq_multiplicity p (m : K[X]) hm_ne] + exact_mod_cast hmMultiplicity + obtain ⟨N, hscaleDisc⟩ := + exists_minpoly_discr_smul_eq_pow_mul r hr z hzPrimitive + rw [← hxScale] at hscaleDisc + have hminZNe : (minpoly (RatFunc K) z).discr ≠ 0 := by + intro hzero + rw [hzero, mul_zero] at hscaleDisc + exact hminXNe hscaleDisc + have hscaleOrder : + ratFuncFiniteOrder p + (minpoly (RatFunc K) (algebraMap B L x)).discr = + ratFuncFiniteOrder p (minpoly (RatFunc K) z).discr := by + have horder := congrArg (finitePlaceOrder p) hscaleDisc + rw [finitePlaceOrder_mul_of_ne_zero p _ _ + (pow_ne_zero N hr) hminZNe, + finitePlaceOrder_pow_of_ne_zero p r hr N] at horder + have hrOrder' : finitePlaceOrder p r = 0 := hrOrder + rw [hrOrder', smul_zero, zero_add] at horder + exact horder + exact hsum.trans_eq (hnormOrder.trans hscaleOrder) + +end FiniteDifferentBelow + +section PlaneCurveFiniteDifferentBound + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- At each finite first-coordinate prime, the residue-weighted different is +bounded by the order of the discriminant of the original plane equation. -/ +theorem planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (p : HeightOneSpectrum K[X]) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + (finiteExtensionFiniteDifferentDivisorBelow K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f)) p : ℤ) ≤ + ratFuncFiniteOrder p (algebraMap K[X] (RatFunc K) + (planeCurvePolynomialInSecondCoordinate f).discr) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let algRL : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := algRL + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + obtain ⟨a, u, hu, hroot, hvc, hprimitive, hdegree⟩ := + planeCurve_local_reciprocal_certificate_of_degreeOf_second_lt_fintypeCard + hf hpartialSecond hcardK p + let c : A := algebraMap K[X] A a + let G : A[X] := (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap K[X] A) + let algRA : Algebra K[X] A := inferInstance + let algRR : Algebra K[X] (RatFunc K) := inferInstance + let algAR : Algebra A (RatFunc K) := ι.toAlgebra + let algPL : Algebra K[X] L := RingHom.toAlgebra + ((algebraMap (RatFunc K) L).comp (algebraMap K[X] (RatFunc K))) + letI : Algebra K[X] A := algRA + letI : Algebra K[X] (RatFunc K) := algRR + letI : Algebra A (RatFunc K) := algAR + letI : Algebra K[X] L := algPL + letI : SMul K[X] A := algRA.toSMul + letI : SMul K[X] (RatFunc K) := algRR.toSMul + letI : SMul A (RatFunc K) := algAR.toSMul + letI : SMul K[X] L := algPL.toSMul + letI : IsScalarTower K[X] A (RatFunc K) := by + apply IsScalarTower.of_algebraMap_eq' + exact (localizationAtPrimeToRatFunc_comp_algebraMap p).symm + letI : IsFractionRing A (RatFunc K) := + IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + p.asIdeal.primeCompl A (RatFunc K) + let algAL : Algebra A L := + ((algebraMap (RatFunc K) L).comp ι).toAlgebra + letI : SMul (RatFunc K) L := algRL.toSMul + letI : Algebra A L := algAL + letI : SMul A L := algAL.toSMul + letI : IsScalarTower A (RatFunc K) L := by + apply IsScalarTower.of_algebraMap_eq' + rfl + letI : IsScalarTower K[X] A L := by + apply IsScalarTower.of_algebraMap_eq' + apply DFunLike.ext _ _ + intro r + change algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) r) = + algebraMap (RatFunc K) L (ι (algebraMap K[X] A r)) + exact (congrArg (algebraMap (RatFunc K) L) + (DFunLike.congr_fun + (localizationAtPrimeToRatFunc_comp_algebraMap p) r)).symm + letI : IsDiscreteValuationRing A := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + K[X] p.ne_bot A + let v : L := planeCurveFunction f 1 + let z : L := (v - algebraMap A L c)⁻¹ + have hroot' : Polynomial.aeval v G = 0 := by + simpa [Polynomial.aeval_def, algAL, RingHom.algebraMap_toAlgebra, + G, v] using hroot + have hvc' : v ≠ algebraMap A L c := by + simpa [algAL, RingHom.algebraMap_toAlgebra, RingHom.comp_apply, + c, v] using hvc + have hzIntegral : IsIntegral A z := by + exact isIntegral_inv_sub_of_eval_eq_unit + G c u v hu hvc' hroot' + have hzPrimitive : Algebra.adjoin (RatFunc K) {z} = ⊤ := by + change Algebra.adjoin (RatFunc K) + {(v - algebraMap A L c)⁻¹} = ⊤ + have hmap : algebraMap A L c = + algebraMap (RatFunc K) L (ι c) := by rfl + rw [hmap] + exact adjoin_inv_sub_eq_top_of_adjoin_eq_top (ι c) v hprimitive + have hbound := + finiteExtensionFiniteDifferentDivisorBelow_apply_le_minpolyDiscr_of_localPrimitive + K L (finiteExtensionFiniteDifferentIdeal_ne_bot K L) p + z hzIntegral hzPrimitive + have htop := finitePlaceOrderTop_minpoly_inv_sub_discr + (A := A) (K := RatFunc K) (L := L) + (IsDiscreteValuationRing.maximalIdeal A) + G c u v hu hvc' hroot' hprimitive hdegree + change finitePlaceOrderTop (IsDiscreteValuationRing.maximalIdeal A) + (minpoly (RatFunc K) z).discr = + finitePlaceOrderTop (IsDiscreteValuationRing.maximalIdeal A) + (algebraMap A (RatFunc K) G.discr) at htop + rw [localizationAtPrime_finitePlaceOrderTop_eq p, + localizationAtPrime_finitePlaceOrderTop_eq p] at htop + have hminNe : (minpoly (RatFunc K) z).discr ≠ 0 := + minpoly_discr_ne_zero_of_adjoin_eq_top z hzPrimitive + have hFdiscr : (planeCurvePolynomialInSecondCoordinate f).discr ≠ 0 := + planeCurvePolynomialInSecondCoordinate_discr_ne_zero + hf hpartialSecond + have hGdiscEq : G.discr = algebraMap K[X] A + (planeCurvePolynomialInSecondCoordinate f).discr := by + exact discr_map_of_injective (algebraMap K[X] A) + (IsLocalization.injective A + p.asIdeal.primeCompl_le_nonZeroDivisors) + (planeCurvePolynomialInSecondCoordinate f) + have hGdiscr : G.discr ≠ 0 := by + rw [hGdiscEq] + simpa only [map_zero] using (IsLocalization.injective A + p.asIdeal.primeCompl_le_nonZeroDivisors).ne hFdiscr + have hmapGdiscr : algebraMap A (RatFunc K) G.discr ≠ 0 := + by simpa only [map_zero] using + (IsFractionRing.injective A (RatFunc K)).ne hGdiscr + rw [finitePlaceOrderTop_eq_coe p _ hminNe, + finitePlaceOrderTop_eq_coe p _ hmapGdiscr] at htop + have hmapEq : algebraMap A (RatFunc K) G.discr = + algebraMap K[X] (RatFunc K) + (planeCurvePolynomialInSecondCoordinate f).discr := by + rw [hGdiscEq] + exact (IsScalarTower.algebraMap_apply K[X] A (RatFunc K) _).symm + have horderEq : ratFuncFiniteOrder p (minpoly (RatFunc K) z).discr = + ratFuncFiniteOrder p (algebraMap K[X] (RatFunc K) + (planeCurvePolynomialInSecondCoordinate f).discr) := by + change finitePlaceOrder p (minpoly (RatFunc K) z).discr = + finitePlaceOrder p (algebraMap K[X] (RatFunc K) + (planeCurvePolynomialInSecondCoordinate f).discr) + rw [← hmapEq] + exact_mod_cast htop + exact hbound.trans_eq horderEq + +/-- The sharp finite different contribution for the plane function field is +bounded by the discriminant degree of the original second-coordinate +equation. -/ +theorem planeCurve_finiteDifferentDegree_le_discrNatDegree + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + finiteExtensionFiniteDifferentDegree K (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f)) ≤ + (planeCurvePolynomialInSecondCoordinate f).discr.natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + apply finiteExtensionFiniteDifferentDegree_le_polynomialDegree_of_localBounds + K (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f)) + (planeCurvePolynomialInSecondCoordinate f).discr + (planeCurvePolynomialInSecondCoordinate_discr_ne_zero + hf hpartialSecond) + intro p + exact planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder + hf hpartialSecond hcardK p + +end PlaneCurveFiniteDifferentBound + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean new file mode 100644 index 0000000000..d87302046e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean @@ -0,0 +1,545 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Algebra.MvPolynomial.Equiv +import Mathlib.Algebra.MvPolynomial.PDeriv +import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra +import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic +import Mathlib.FieldTheory.Minpoly.Field +import Mathlib.RingTheory.Localization.FractionRing +import Mathlib.Algebra.MvPolynomial.NoZeroDivisors +import Mathlib.RingTheory.AlgebraicIndependent.Transcendental + +/-! +# Function fields of irreducible affine plane curves + +This file constructs the affine coordinate domain and its fraction field directly from an +irreducible polynomial in two variables. It also records the two coordinate functions and their +defining relation. These are the algebraic objects used in the plane-curve specialization of the +Corvaja--Zannier argument. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The affine coordinate ring of the plane curve cut out by `f`. -/ +abbrev PlaneCurveCoordinateRing (f : MvPolynomial (Fin 2) K) := + MvPolynomial (Fin 2) K ⧸ Ideal.span {f} + +/-- The quotient map from the polynomial ring to the affine coordinate ring. -/ +abbrev planeCurveQuotientMap (f : MvPolynomial (Fin 2) K) : + MvPolynomial (Fin 2) K →+* PlaneCurveCoordinateRing f := + Ideal.Quotient.mk (Ideal.span {f}) + +/-- The two affine coordinate classes in the coordinate ring. -/ +def planeCurveCoordinate (f : MvPolynomial (Fin 2) K) (i : Fin 2) : + PlaneCurveCoordinateRing f := + planeCurveQuotientMap f (MvPolynomial.X i) + +/-- Evaluation at the coordinate classes is the quotient map. -/ +theorem eval₂_planeCurveCoordinate (f : MvPolynomial (Fin 2) K) : + MvPolynomial.eval₂Hom + (algebraMap K (PlaneCurveCoordinateRing f)) (planeCurveCoordinate f) = + planeCurveQuotientMap f := by + apply MvPolynomial.ringHom_ext + · intro c + rw [MvPolynomial.eval₂Hom_C] + change algebraMap K (PlaneCurveCoordinateRing f) c = + Ideal.Quotient.mk (Ideal.span {f}) (MvPolynomial.C c) + rw [← MvPolynomial.algebraMap_eq, Ideal.Quotient.mk_algebraMap] + · intro i + simp [planeCurveCoordinate, planeCurveQuotientMap] + +/-- The coordinate classes satisfy the equation defining the curve. -/ +theorem eval₂_planeCurveCoordinate_eq_zero (f : MvPolynomial (Fin 2) K) : + MvPolynomial.eval₂ (algebraMap K (PlaneCurveCoordinateRing f)) + (planeCurveCoordinate f) f = 0 := by + change (MvPolynomial.eval₂Hom + (algebraMap K (PlaneCurveCoordinateRing f)) (planeCurveCoordinate f)) f = 0 + rw [eval₂_planeCurveCoordinate] + exact Ideal.Quotient.eq_zero_iff_mem.mpr (Ideal.subset_span (Set.mem_singleton f)) + +/-- Irreducibility of the equation makes its affine coordinate ring a domain. -/ +theorem planeCurveCoordinateRing_isDomain + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : + IsDomain (PlaneCurveCoordinateRing f) := by + have hprime : (Ideal.span {f} : Ideal (MvPolynomial (Fin 2) K)).IsPrime := + (Ideal.span_singleton_prime hf.ne_zero).mpr hf.prime + exact (Ideal.Quotient.isDomain_iff_prime (Ideal.span {f})).mpr hprime + +/-- The rational function field of the affine plane curve. -/ +abbrev PlaneCurveFunctionField (f : MvPolynomial (Fin 2) K) := + FractionRing (PlaneCurveCoordinateRing f) + +/-- A coordinate function in the fraction field of the curve. -/ +def planeCurveFunction (f : MvPolynomial (Fin 2) K) (i : Fin 2) : + PlaneCurveFunctionField f := + algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + (planeCurveCoordinate f i) + +/-- The quotient map followed by passage to the fraction field is evaluation at the two +coordinate functions. -/ +theorem eval₂_planeCurveFunction + (f : MvPolynomial (Fin 2) K) : + MvPolynomial.eval₂Hom + (algebraMap K (PlaneCurveFunctionField f)) (planeCurveFunction f) = + (algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)).comp + (planeCurveQuotientMap f) := by + apply MvPolynomial.ringHom_ext + · intro c + rw [MvPolynomial.eval₂Hom_C, RingHom.comp_apply] + change algebraMap K (PlaneCurveFunctionField f) c = + algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + (Ideal.Quotient.mk (Ideal.span {f}) (MvPolynomial.C c)) + rw [← MvPolynomial.algebraMap_eq, Ideal.Quotient.mk_algebraMap, + ← IsScalarTower.algebraMap_apply] + · intro i + simp [planeCurveFunction, planeCurveCoordinate, planeCurveQuotientMap] + +/-- The two rational coordinate functions satisfy the equation of the curve. -/ +theorem eval₂_planeCurveFunction_eq_zero + (f : MvPolynomial (Fin 2) K) : + MvPolynomial.eval₂ (algebraMap K (PlaneCurveFunctionField f)) + (planeCurveFunction f) f = 0 := by + change (MvPolynomial.eval₂Hom + (algebraMap K (PlaneCurveFunctionField f)) (planeCurveFunction f)) f = 0 + rw [eval₂_planeCurveFunction f, RingHom.comp_apply] + rw [Ideal.Quotient.eq_zero_iff_mem.mpr (Ideal.subset_span (Set.mem_singleton f)), map_zero] + +/-- Every affine regular function, viewed in the fraction field, belongs to the field generated by +the two coordinate functions. -/ +theorem algebraMap_coordinateRing_mem_adjoin_coordinates + {f : MvPolynomial (Fin 2) K} [IsDomain (PlaneCurveCoordinateRing f)] + (a : PlaneCurveCoordinateRing f) : + algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) a ∈ + IntermediateField.adjoin K (Set.range (planeCurveFunction f)) := by + obtain ⟨p, rfl⟩ := Ideal.Quotient.mk_surjective a + change + ((algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)).comp + (planeCurveQuotientMap f)) p ∈ + IntermediateField.adjoin K (Set.range (planeCurveFunction f)) + rw [← eval₂_planeCurveFunction f] + exact MvPolynomial.eval₂_mem + (fun _ _ ↦ (IntermediateField.adjoin K + (Set.range (planeCurveFunction f))).algebraMap_mem _) + (fun i ↦ IntermediateField.subset_adjoin K _ ⟨i, rfl⟩) + +/-- The fraction field is generated, as a field over `K`, by its two coordinate functions. -/ +theorem adjoin_planeCurveFunctions_eq_top + {f : MvPolynomial (Fin 2) K} [IsDomain (PlaneCurveCoordinateRing f)] : + IntermediateField.adjoin K (Set.range (planeCurveFunction f)) = ⊤ := by + apply top_unique + intro z _ + obtain ⟨a, b, _hb, hz⟩ := + IsFractionRing.div_surjective (PlaneCurveCoordinateRing f) z + rw [← hz] + exact div_mem (algebraMap_coordinateRing_mem_adjoin_coordinates a) + (algebraMap_coordinateRing_mem_adjoin_coordinates b) + +/-- Irreducibility supplies the domain instance needed by +`adjoin_planeCurveFunctions_eq_top`. -/ +theorem adjoin_planeCurveFunctions_eq_top_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : + letI := planeCurveCoordinateRing_isDomain hf + IntermediateField.adjoin K (Set.range (planeCurveFunction f)) = ⊤ := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + exact adjoin_planeCurveFunctions_eq_top + +/-- Embed a univariate polynomial in the first coordinate of the affine plane. -/ +def polynomialInFirstCoordinate (P : Polynomial K) : MvPolynomial (Fin 2) K := + P.sum fun n c ↦ MvPolynomial.C c * MvPolynomial.X 0 ^ n + +/-- Evaluating a polynomial embedded in the first coordinate is ordinary univariate evaluation. -/ +theorem eval₂_polynomialInFirstCoordinate + {S : Type*} [CommSemiring S] (P : Polynomial K) (phi : K →+* S) (x y : S) : + MvPolynomial.eval₂ phi ![x, y] (polynomialInFirstCoordinate P) = + P.eval₂ phi x := by + classical + simp [polynomialInFirstCoordinate, Polynomial.sum_def, Polynomial.eval₂_eq_sum] + +/-- The embedding in the first coordinate is injective. -/ +theorem polynomialInFirstCoordinate_ne_zero {P : Polynomial K} (hP : P ≠ 0) : + polynomialInFirstCoordinate P ≠ 0 := by + intro hzero + have heval := eval₂_polynomialInFirstCoordinate P Polynomial.C + Polynomial.X (0 : Polynomial K) + rw [hzero, MvPolynomial.eval₂_zero] at heval + apply hP + simpa using heval.symm + +private theorem planeCurve_degreeOf_finset_sum_le + {R ι : Type*} [CommSemiring R] + (coordinate : Fin 2) (terms : ι → MvPolynomial (Fin 2) R) + (indices : Finset ι) (bound : ℕ) + (hterms : ∀ i ∈ indices, MvPolynomial.degreeOf coordinate (terms i) ≤ bound) : + MvPolynomial.degreeOf coordinate (∑ i ∈ indices, terms i) ≤ bound := by + classical + induction indices using Finset.induction_on with + | empty => simp + | @insert i indices hi ih => + rw [Finset.sum_insert hi] + exact (MvPolynomial.degreeOf_add_le _ _ _).trans + (max_le (hterms i (Finset.mem_insert_self i indices)) + (ih fun j hj ↦ hterms j (Finset.mem_insert_of_mem hj))) + +/-- A polynomial embedded in the first coordinate has degree zero in the second coordinate. -/ +theorem polynomialInFirstCoordinate_degreeOf_second_le (P : Polynomial K) : + MvPolynomial.degreeOf (1 : Fin 2) (polynomialInFirstCoordinate P) ≤ 0 := by + classical + rw [polynomialInFirstCoordinate, Polynomial.sum_def] + apply planeCurve_degreeOf_finset_sum_le (1 : Fin 2) _ P.support 0 + intro n _hn + calc + MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.C (P.coeff n) * MvPolynomial.X 0 ^ n) ≤ + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.C (P.coeff n)) + + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 0 ^ n) := + MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ 0 := by + have hpow : MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.X 0 ^ n : MvPolynomial (Fin 2) K) ≤ 0 := by + calc + _ ≤ n * MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 0) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = 0 := by rw [MvPolynomial.degreeOf_X]; norm_num + rw [MvPolynomial.degreeOf_C] + simpa using hpow + +/-- On an irreducible plane curve of positive second-coordinate degree, the first coordinate +function is transcendental over the constant field. -/ +theorem firstCoordinate_transcendental + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + Transcendental K (planeCurveFunction f 0) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [transcendental_iff] + intro P hPzero + by_contra hP + have hembedded : polynomialInFirstCoordinate P ≠ 0 := + polynomialInFirstCoordinate_ne_zero hP + have hquotient : planeCurveQuotientMap f (polynomialInFirstCoordinate P) = 0 := by + apply IsFractionRing.injective (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + rw [map_zero] + change + ((algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)).comp + (planeCurveQuotientMap f)) (polynomialInFirstCoordinate P) = 0 + rw [← eval₂_planeCurveFunction f] + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + change MvPolynomial.eval₂ (algebraMap K (PlaneCurveFunctionField f)) + ![planeCurveFunction f 0, planeCurveFunction f 1] + (polynomialInFirstCoordinate P) = 0 + rw [eval₂_polynomialInFirstCoordinate] + simpa [Polynomial.aeval_def] using hPzero + have hdvd : f ∣ polynomialInFirstCoordinate P := + Ideal.mem_span_singleton.mp (Ideal.Quotient.eq_zero_iff_mem.mp hquotient) + obtain ⟨g, hg⟩ := hdvd + have hgzero : g ≠ 0 := by + intro hzero + apply hembedded + rw [hg, hzero, mul_zero] + have hdegree : MvPolynomial.degreeOf 1 f ≤ + MvPolynomial.degreeOf 1 (polynomialInFirstCoordinate P) := by + rw [hg, MvPolynomial.degreeOf_mul_eq hf.ne_zero hgzero] + exact Nat.le_add_right _ _ + have hzeroDegree := polynomialInFirstCoordinate_degreeOf_second_le P + omega + +/-- The intermediate field generated by the first coordinate function. -/ +abbrev FirstCoordinateSubfield + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] := + IntermediateField.adjoin K ({planeCurveFunction f 0} : Set (PlaneCurveFunctionField f)) + +/-- The first coordinate function, regarded as an element of its generated subfield. -/ +def firstCoordinateInSubfield + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + FirstCoordinateSubfield f := + ⟨planeCurveFunction f 0, + IntermediateField.mem_adjoin_simple_self K (planeCurveFunction f 0)⟩ + +/-- Regard the plane equation as a polynomial in the second coordinate, with coefficients in the +field generated by the first coordinate. -/ +def polynomialOverFirstCoordinate + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + Polynomial (FirstCoordinateSubfield f) := + MvPolynomial.eval₂ (algebraMap K (Polynomial (FirstCoordinateSubfield f))) + ![Polynomial.C (firstCoordinateInSubfield f), Polynomial.X] f + +/-- The same change of viewpoint before specializing the remaining coefficient variable. The +outer polynomial variable is the original second coordinate. -/ +def polynomialInSecondCoordinate (f : MvPolynomial (Fin 2) K) : + Polynomial (MvPolynomial {i : Fin 2 // i ≠ 1} K) := + MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 1} + (MvPolynomial.rename (Equiv.optionSubtypeNe (1 : Fin 2)).symm f) + +/-- The iterated-polynomial presentation preserves nonzeroness. -/ +theorem polynomialInSecondCoordinate_ne_zero + {f : MvPolynomial (Fin 2) K} (hf : f ≠ 0) : + polynomialInSecondCoordinate f ≠ 0 := by + intro hzero + apply hf + apply MvPolynomial.rename_injective + (Equiv.optionSubtypeNe (1 : Fin 2)).symm + (Equiv.optionSubtypeNe (1 : Fin 2)).symm.injective + apply (MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 1}).injective + simpa [polynomialInSecondCoordinate] using hzero + +/-- Evaluate the sole coefficient variable at the first coordinate function. -/ +def firstCoordinateCoefficientEval + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + MvPolynomial {i : Fin 2 // i ≠ 1} K →+* FirstCoordinateSubfield f := + MvPolynomial.eval₂Hom (algebraMap K (FirstCoordinateSubfield f)) + (fun _ ↦ firstCoordinateInSubfield f) + +/-- Positive degree in the second coordinate makes coefficient evaluation at the first coordinate +injective. -/ +theorem firstCoordinateCoefficientEval_injective + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + Function.Injective (firstCoordinateCoefficientEval f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let remaining := {i : Fin 2 // i ≠ 1} + have remaining_value_zero (i : remaining) : i.1 = 0 := by + omega + letI : Subsingleton remaining := + ⟨fun i j ↦ Subtype.ext ((remaining_value_zero i).trans (remaining_value_zero j).symm)⟩ + let i0 : remaining := ⟨0, by decide⟩ + have hIndependent : AlgebraicIndependent K + (fun _ : remaining ↦ planeCurveFunction f 0) := by + rw [algebraicIndependent_singleton_iff i0] + exact firstCoordinate_transcendental hf hsecond + let composed : MvPolynomial remaining K →+* PlaneCurveFunctionField f := + (algebraMap (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)).comp + (firstCoordinateCoefficientEval f) + let evaluated : MvPolynomial remaining K →+* PlaneCurveFunctionField f := + MvPolynomial.eval₂Hom (algebraMap K (PlaneCurveFunctionField f)) + (fun _ ↦ planeCurveFunction f 0) + have hhom : composed = evaluated := by + apply MvPolynomial.ringHom_ext + · intro c + simp [composed, evaluated, firstCoordinateCoefficientEval] + · intro i + simp [composed, evaluated, firstCoordinateCoefficientEval, + firstCoordinateInSubfield] + intro a b hab + apply (algebraicIndependent_iff_injective_aeval.mp hIndependent) + change evaluated a = evaluated b + rw [← hhom] + exact congrArg (algebraMap (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)) hab + +/-- The direct two-variable specialization agrees with the standard +`MvPolynomial.optionEquivLeft` presentation. -/ +theorem polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + polynomialOverFirstCoordinate f = + (polynomialInSecondCoordinate f).map (firstCoordinateCoefficientEval f) := by + let lhs : MvPolynomial (Fin 2) K →+* Polynomial (FirstCoordinateSubfield f) := + MvPolynomial.eval₂Hom (algebraMap K (Polynomial (FirstCoordinateSubfield f))) + ![Polynomial.C (firstCoordinateInSubfield f), Polynomial.X] + let rhs : MvPolynomial (Fin 2) K →+* Polynomial (FirstCoordinateSubfield f) := + (Polynomial.mapRingHom (firstCoordinateCoefficientEval f)).comp + ((MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 1}).toRingEquiv.toRingHom.comp + (MvPolynomial.rename (Equiv.optionSubtypeNe (1 : Fin 2)).symm).toRingHom) + change lhs f = rhs f + congr 1 + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs, firstCoordinateCoefficientEval] + · intro i + fin_cases i <;> + simp [lhs, rhs, firstCoordinateCoefficientEval, firstCoordinateInSubfield] + +/-- Irreducibility and positive degree in the second variable ensure that the equation remains +nonzero after passing to the field generated by the first coordinate. -/ +theorem polynomialOverFirstCoordinate_ne_zero_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + polynomialOverFirstCoordinate f ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate] + exact (Polynomial.map_ne_zero_iff + (firstCoordinateCoefficientEval_injective hf hsecond)).mpr + (polynomialInSecondCoordinate_ne_zero hf.ne_zero) + +/-- Specializing the coefficient variable cannot increase the degree in the second coordinate. -/ +theorem natDegree_polynomialOverFirstCoordinate_le_degreeOf_second + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + (polynomialOverFirstCoordinate f).natDegree ≤ MvPolynomial.degreeOf 1 f := by + rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate] + calc + ((polynomialInSecondCoordinate f).map + (firstCoordinateCoefficientEval f)).natDegree ≤ + (polynomialInSecondCoordinate f).natDegree := Polynomial.natDegree_map_le + _ = MvPolynomial.degreeOf 1 f := + (MvPolynomial.degreeOf_eq_natDegree (1 : Fin 2) f).symm + +/-- Substituting the second coordinate function into `polynomialOverFirstCoordinate` recovers the +defining plane-curve relation. -/ +theorem eval₂_polynomialOverFirstCoordinate_eq_zero + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + Polynomial.eval₂ + (algebraMap (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)) + (planeCurveFunction f 1) (polynomialOverFirstCoordinate f) = 0 := by + let lhs : MvPolynomial (Fin 2) K →+* PlaneCurveFunctionField f := + (Polynomial.eval₂RingHom + (algebraMap (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)) + (planeCurveFunction f 1)).comp + (MvPolynomial.eval₂Hom + (algebraMap K (Polynomial (FirstCoordinateSubfield f))) + ![Polynomial.C (firstCoordinateInSubfield f), Polynomial.X]) + let rhs : MvPolynomial (Fin 2) K →+* PlaneCurveFunctionField f := + MvPolynomial.eval₂Hom (algebraMap K (PlaneCurveFunctionField f)) + (planeCurveFunction f) + have hhom : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs] + · intro i + fin_cases i <;> + simp [lhs, rhs, firstCoordinateInSubfield] + change lhs f = 0 + rw [hhom] + exact eval₂_planeCurveFunction_eq_zero f + +/-- If the specialized equation is nonzero, the second coordinate is algebraic over the field +generated by the first coordinate. -/ +theorem secondCoordinate_isAlgebraic_over_first + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hpoly : polynomialOverFirstCoordinate f ≠ 0) : + IsAlgebraic (FirstCoordinateSubfield f) (planeCurveFunction f 1) := by + refine ⟨polynomialOverFirstCoordinate f, hpoly, ?_⟩ + simpa [Polynomial.aeval_def] using eval₂_polynomialOverFirstCoordinate_eq_zero f + +/-- The range of the coordinate-function family is exactly the two-element set of affine +coordinates. -/ +theorem range_planeCurveFunction + (f : MvPolynomial (Fin 2) K) : + Set.range (planeCurveFunction f) = + ({planeCurveFunction f 0, planeCurveFunction f 1} : + Set (PlaneCurveFunctionField f)) := by + ext z + constructor + · rintro ⟨i, rfl⟩ + fin_cases i <;> simp + · intro hz + rcases hz with (rfl | rfl) + · exact ⟨0, rfl⟩ + · exact ⟨1, rfl⟩ + +/-- After adjoining the first coordinate to `K`, adjoining the second coordinate generates the +entire plane-curve function field. -/ +theorem adjoin_secondCoordinate_over_first_eq_top + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + IntermediateField.adjoin (FirstCoordinateSubfield f) {planeCurveFunction f 1} = ⊤ := by + have hpair : + IntermediateField.adjoin K + ({planeCurveFunction f 0, planeCurveFunction f 1} : + Set (PlaneCurveFunctionField f)) = ⊤ := by + rw [← range_planeCurveFunction f] + exact adjoin_planeCurveFunctions_eq_top + apply IntermediateField.restrictScalars_injective K + rw [IntermediateField.restrictScalars_top] + change + (IntermediateField.adjoin + (IntermediateField.adjoin K {planeCurveFunction f 0}) + {planeCurveFunction f 1}).restrictScalars K = ⊤ + rw [IntermediateField.adjoin_adjoin_left] + simpa only [Set.singleton_union] using hpair + +/-- A nonzero specialization of the plane equation makes the function field finite-dimensional +over the field generated by the first coordinate. -/ +theorem finiteDimensional_over_firstCoordinate + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hpoly : polynomialOverFirstCoordinate f ≠ 0) : + FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := by + have halg := secondCoordinate_isAlgebraic_over_first f hpoly + letI : FiniteDimensional (FirstCoordinateSubfield f) + (IntermediateField.adjoin (FirstCoordinateSubfield f) {planeCurveFunction f 1}) := + IntermediateField.adjoin.finiteDimensional halg.isIntegral + letI : FiniteDimensional (FirstCoordinateSubfield f) + (⊤ : IntermediateField (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)) := by + rw [← adjoin_secondCoordinate_over_first_eq_top f] + infer_instance + exact IntermediateField.topEquiv.toLinearEquiv.finiteDimensional + +/-- The extension degree over the first-coordinate field is at most the degree of the plane +equation in the second coordinate. -/ +theorem finrank_over_firstCoordinate_le_degreeOf_second + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hpoly : polynomialOverFirstCoordinate f ≠ 0) : + Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ + MvPolynomial.degreeOf 1 f := by + letI : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := + finiteDimensional_over_firstCoordinate f hpoly + have halg := secondCoordinate_isAlgebraic_over_first f hpoly + have hroot : Polynomial.aeval (planeCurveFunction f 1) + (polynomialOverFirstCoordinate f) = 0 := by + simpa [Polynomial.aeval_def] using eval₂_polynomialOverFirstCoordinate_eq_zero f + calc + Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) = + Module.finrank (FirstCoordinateSubfield f) + (⊤ : IntermediateField (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f)) := + by rw [IntermediateField.finrank_top'] + _ = Module.finrank (FirstCoordinateSubfield f) + (IntermediateField.adjoin (FirstCoordinateSubfield f) + {planeCurveFunction f 1}) := by + rw [adjoin_secondCoordinate_over_first_eq_top f] + _ = (minpoly (FirstCoordinateSubfield f) (planeCurveFunction f 1)).natDegree := + IntermediateField.adjoin.finrank halg.isIntegral + _ ≤ (polynomialOverFirstCoordinate f).natDegree := + Polynomial.natDegree_le_of_dvd + (minpoly.dvd (FirstCoordinateSubfield f) (planeCurveFunction f 1) hroot) hpoly + _ ≤ MvPolynomial.degreeOf 1 f := + natDegree_polynomialOverFirstCoordinate_le_degreeOf_second f + +/-- A nonzero partial derivative in the second coordinate forces positive degree in that +coordinate. -/ +theorem degreeOf_second_pos_of_pderiv_ne_zero + {f : MvPolynomial (Fin 2) K} (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + 0 < MvPolynomial.degreeOf 1 f := by + apply Nat.pos_of_ne_zero + apply MvPolynomial.mem_vars_iff_degreeOf_ne_zero.mp + by_contra hmem + exact hderiv (MvPolynomial.pderiv_eq_zero_of_notMem_vars hmem) + +/-- For an irreducible plane equation depending on the second coordinate, the function field is +finite over the field generated by the first coordinate. -/ +theorem finiteDimensional_over_firstCoordinate_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + exact finiteDimensional_over_firstCoordinate f + (polynomialOverFirstCoordinate_ne_zero_of_irreducible hf + (degreeOf_second_pos_of_pderiv_ne_zero hderiv)) + +/-- The degree of the plane-curve function field over the first-coordinate rational subfield is +bounded by the degree of the defining equation in the second coordinate. -/ +theorem finrank_over_firstCoordinate_le_degreeOf_second_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + exact finrank_over_firstCoordinate_le_degreeOf_second f + (polynomialOverFirstCoordinate_ne_zero_of_irreducible hf + (degreeOf_second_pos_of_pderiv_ne_zero hderiv)) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean new file mode 100644 index 0000000000..28e08712c8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree + +/-! +# The complementary different bound above infinity + +For a primitive infinity-chart equation of bidegree at most `(a,b)`, the +weighted different contribution above infinity is bounded by + +`a * (2 * b - 2) - degree(discriminant)`. + +Together with the finite-place discriminant bound, this gives the sharp total +different budget used in the Corvaja--Zannier plane-curve estimate. +-/ + +open scoped Polynomial nonZeroDivisors +open Multiplicative WithZero Polynomial IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance infinityComplementConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance infinityComplementConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + .of_algebraMap_eq' rfl + +local instance infinityComplementTopIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +/-- The residue-degree-weighted different above infinity is bounded by the +complement of the finite discriminant degree in the full bidegree budget. -/ +theorem planeCurveInfinityDifferentDegree_le_bidegreeComplement + (a : ℕ) (F : K[X][X]) + (hcoeff : ∀ i, (F.coeff i).natDegree ≤ a) + (i : ℕ) (hFi : F.coeff i ≠ 0) + (hi : (F.coeff i).natDegree = a) + (v : L) + (hv : aeval v (infinityNormalizedIntegralPolynomial K a F hcoeff) = 0) + (hprimitive : Algebra.adjoin (RatFunc K) {v} = ⊤) + (hdegree : F.natDegree = Module.finrank (RatFunc K) L) + (hFdiscr : F.discr ≠ 0) + (hcard : (F.natDegree : Cardinal) < Cardinal.mk K) : + (infinityDifferentDegree K L : ℤ) ≤ + (a * (2 * F.natDegree - 2) : ℕ) - (F.discr.natDegree : ℤ) := by + let A := RatFuncInfinityIntegers K + let G : A[X] := infinityNormalizedIntegralPolynomial K a F hcoeff + have hGprimitive : G.IsPrimitive := by + exact infinityNormalizedIntegralPolynomial_isPrimitive K a F hcoeff i hFi hi + have hmapG : G.map (algebraMap A (RatFunc K)) = + infinityNormalizedPolynomial K a F := by + exact infinityNormalizedIntegralPolynomial_map K a F hcoeff + have hGdegree : G.natDegree = F.natDegree := by + have h := congrArg Polynomial.natDegree hmapG + rw [natDegree_map_eq_of_injective + (IsFractionRing.injective A (RatFunc K)), + infinityNormalizedPolynomial_natDegree] at h + exact h + obtain ⟨c, hc⟩ := + exists_local_center_eval_isUnit_of_isPrimitive_natDegree_lt_card + G hGprimitive (by simpa [hGdegree] using hcard) + have hcunit := hc + obtain ⟨u, hu⟩ := hc + have hvc : v ≠ algebraMap A L c := by + intro heq + have hzero : algebraMap A L (G.eval c) = 0 := by + simpa [G, heq] using hv + exact (IsUnit.map (algebraMap A L) hcunit).ne_zero hzero + have hdiscrMap : algebraMap A (RatFunc K) G.discr = + (infinityNormalizedPolynomial K a F).discr := by + rw [← hmapG] + exact (discr_map_of_injective (algebraMap A (RatFunc K)) + (IsFractionRing.injective A (RatFunc K)) G).symm + have hnormDiscr : (infinityNormalizedPolynomial K a F).discr ≠ 0 := by + rw [infinityNormalizedPolynomial_discr] + exact mul_ne_zero + (pow_ne_zero _ (pow_ne_zero _ (inv_ne_zero RatFunc.X_ne_zero))) + (RatFunc.algebraMap_ne_zero hFdiscr) + have hGdiscr : G.discr ≠ 0 := by + intro hzero + apply hnormDiscr + rw [← hdiscrMap, hzero, map_zero] + have hbound := + infinityDifferentDegree_le_discriminantOrder_of_primitiveElement + K L G c u v hu.symm hvc hv hprimitive + (hGdegree.trans hdegree) hGdiscr + calc + (infinityDifferentDegree K L : ℤ) ≤ + ratFuncInfinityOrder (algebraMap A (RatFunc K) G.discr) := hbound + _ = ratFuncInfinityOrder (infinityNormalizedPolynomial K a F).discr := by + rw [hdiscrMap] + _ = (a * (2 * F.natDegree - 2) : ℕ) - + (F.discr.natDegree : ℤ) := + ratFuncInfinityOrder_infinityNormalizedPolynomial_discr K a F hFdiscr + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean new file mode 100644 index 0000000000..a79dc67900 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean @@ -0,0 +1,240 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +import Mathlib.Tactic + +/-! +# The discriminant budget at infinity for a plane curve + +Let `F` be a polynomial in `Y` with coefficients in `K[X]`, and suppose that +every coefficient has `X`-degree at most `a`. On the infinity chart of the +first projection the integral normalization of the equation is obtained by +multiplying by `X⁻ᵃ`. Its discriminant is therefore + +`X⁻ᵃ⁽²ᵇ⁻²⁾ * discr(F)`. + +The order of this element at infinity is exactly + +`a * (2 * b - 2) - degree(discr(F))`. + +This is the key complementarity needed for a Riemann--Hurwitz-free proof: +the finite discriminant contribution is at most `degree(discr(F))`, while the +above-infinity contribution is at most the displayed complementary order. +In particular, one must not bound the finite and infinity contributions +independently by `a * (2 * b - 2)`. + +The module also constructs the coefficientwise integral polynomial over the +infinity valuation ring. Identifying a reciprocal translate of that +polynomial with a primitive element of the plane-curve function field is the +remaining local normalization step. +-/ + +open scoped Polynomial nonZeroDivisors +open Multiplicative WithZero Polynomial IsDedekindDomain + +namespace BGS.CorvajaZannier + +noncomputable section + +universe u + +/-- A primitive polynomial over a local ring has a unit value at some center +as soon as its degree is smaller than the cardinality of a coefficient field. +The coefficient field and local ring are kept in the same universe, which is +the case needed for the infinity valuation ring of `K(X)`. -/ +theorem exists_local_center_eval_isUnit_of_isPrimitive_natDegree_lt_card + {K A : Type u} [Field K] [CommRing A] [IsLocalRing A] + [IsBezout A] [Algebra K A] + (F : A[X]) (hF : F.IsPrimitive) + (hcardK : (F.natDegree : Cardinal) < Cardinal.mk K) : + ∃ c : A, IsUnit (F.eval c) := by + let m := IsLocalRing.maximalIdeal A + let k := A ⧸ m + let π : A →+* k := Ideal.Quotient.mk m + have hFbar : F.map π ≠ 0 := by + intro hzero + have hcoeff : ∀ i, F.coeff i ∈ m := by + intro i + have hi := congrArg (fun q : k[X] => q.coeff i) hzero + rw [Polynomial.coeff_map, Polynomial.coeff_zero] at hi + exact Ideal.Quotient.eq_zero_iff_mem.mp hi + have hcontent : F.contentIdeal ≤ m := by + rw [Polynomial.contentIdeal_def, Ideal.span_le] + intro x hx + obtain ⟨i, _hi, rfl⟩ := Polynomial.mem_coeffs_iff.mp hx + exact hcoeff i + have htop : F.contentIdeal = ⊤ := + (Polynomial.isPrimitive_iff_contentIdeal_eq_top F).mp hF + apply (IsLocalRing.maximalIdeal.isMaximal A).ne_top + apply top_unique + simpa [htop] using hcontent + have hcard : (F.map π).natDegree < Cardinal.mk k := by + have hdegree : ((F.map π).natDegree : Cardinal) ≤ F.natDegree := by + exact_mod_cast Polynomial.natDegree_map_le + exact (hdegree.trans_lt hcardK).trans_le + (Cardinal.mk_le_of_injective + (RingHom.injective (algebraMap K k))) + obtain ⟨c, hc⟩ := + Polynomial.exists_eval_ne_zero_of_natDegree_lt_card (F.map π) hFbar hcard + obtain ⟨a, rfl⟩ := Ideal.Quotient.mk_surjective c + refine ⟨a, IsLocalRing.notMem_maximalIdeal.mp ?_⟩ + intro hmem + apply hc + rw [Polynomial.eval_map_apply] + change π (F.eval a) = 0 + exact Ideal.Quotient.eq_zero_iff_mem.mpr hmem + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + +/-! ## The normalized equation over `K(X)` -/ + +/-- Multiply an equation over `K[X]` by `X⁻ᵃ` on the infinity chart of the +first projection. -/ +def infinityNormalizedPolynomial (a : ℕ) (F : K[X][X]) : (RatFunc K)[X] := + C ((RatFunc.X⁻¹) ^ a) * F.map (algebraMap K[X] (RatFunc K)) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +private theorem ratFunc_intDegree_pow (x : RatFunc K) (hx : x ≠ 0) (n : ℕ) : + (x ^ n).intDegree = (n : ℤ) * x.intDegree := by + induction n with + | zero => simp + | succ n ih => + rw [pow_succ, RatFunc.intDegree_mul (pow_ne_zero n hx) hx, ih] + push_cast + ring + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Scaling by `X⁻ᵃ` does not change the degree in the second variable. -/ +theorem infinityNormalizedPolynomial_natDegree + (a : ℕ) (F : K[X][X]) : + (infinityNormalizedPolynomial K a F).natDegree = F.natDegree := by + rw [infinityNormalizedPolynomial] + rw [natDegree_C_mul + (pow_ne_zero a (inv_ne_zero RatFunc.X_ne_zero))] + exact natDegree_map_eq_of_injective + (RatFunc.algebraMap_injective K) F + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Exact discriminant formula for the infinity-normalized equation. -/ +theorem infinityNormalizedPolynomial_discr + (a : ℕ) (F : K[X][X]) : + (infinityNormalizedPolynomial K a F).discr = + ((RatFunc.X⁻¹) ^ a) ^ (2 * F.natDegree - 2) * + algebraMap K[X] (RatFunc K) F.discr := by + rw [infinityNormalizedPolynomial, + discr_C_mul _ _ (pow_ne_zero a (inv_ne_zero RatFunc.X_ne_zero)), + natDegree_map_eq_of_injective + (RatFunc.algebraMap_injective K), + discr_map_of_injective (algebraMap K[X] (RatFunc K)) + (RatFunc.algebraMap_injective K)] + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- The infinity order of the normalized discriminant is the complement of +the finite polynomial discriminant degree in the full bidegree budget. -/ +theorem ratFuncInfinityOrder_infinityNormalizedPolynomial_discr + (a : ℕ) (F : K[X][X]) (hdiscr : F.discr ≠ 0) : + ratFuncInfinityOrder (infinityNormalizedPolynomial K a F).discr = + (a * (2 * F.natDegree - 2) : ℕ) - (F.discr.natDegree : ℤ) := by + rw [infinityNormalizedPolynomial_discr] + have hXinv : RatFunc.X⁻¹ ≠ (0 : RatFunc K) := inv_ne_zero RatFunc.X_ne_zero + have hpow : ((RatFunc.X⁻¹) ^ a) ^ (2 * F.natDegree - 2) ≠ + (0 : RatFunc K) := pow_ne_zero _ (pow_ne_zero _ hXinv) + have hmap : algebraMap K[X] (RatFunc K) F.discr ≠ 0 := + RatFunc.algebraMap_ne_zero hdiscr + rw [ratFuncInfinityOrder, + RatFunc.intDegree_mul hpow hmap, + ratFunc_intDegree_pow K ((RatFunc.X⁻¹) ^ a) + (pow_ne_zero _ hXinv) (2 * F.natDegree - 2), + ratFunc_intDegree_pow K (RatFunc.X⁻¹) hXinv a, + RatFunc.intDegree_inv, RatFunc.intDegree_X, + RatFunc.intDegree_polynomial] + push_cast + ring + +/-! ## The normalized equation over the infinity valuation ring -/ + +/-- A polynomial of degree at most `a`, multiplied by `X⁻ᵃ`, is integral at +infinity. -/ +theorem infinityNormalizedCoefficient_mem + (a : ℕ) (P : K[X]) (hdegree : P.natDegree ≤ a) : + RatFunc.inftyValuation K + ((RatFunc.X⁻¹) ^ a * algebraMap K[X] (RatFunc K) P) ≤ 1 := by + by_cases hP : P = 0 + · simp [hP] + have hXinv : RatFunc.X⁻¹ ≠ (0 : RatFunc K) := inv_ne_zero RatFunc.X_ne_zero + have hleft : (RatFunc.X⁻¹) ^ a ≠ (0 : RatFunc K) := pow_ne_zero _ hXinv + have hright : algebraMap K[X] (RatFunc K) P ≠ 0 := + RatFunc.algebraMap_ne_zero hP + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero (F := K) (mul_ne_zero hleft hright), + RatFunc.intDegree_mul hleft hright, + ratFunc_intDegree_pow K (RatFunc.X⁻¹) hXinv a, + RatFunc.intDegree_inv, RatFunc.intDegree_X, + RatFunc.intDegree_polynomial] + rw [← exp_zero, exp_le_exp] + have hdegree' : (P.natDegree : ℤ) ≤ (a : ℤ) := by + exact_mod_cast hdegree + omega + +/-- The coefficient `X⁻ᵃ P(X)` as an element of the infinity valuation +ring. -/ +def infinityNormalizedCoefficient + (a : ℕ) (P : K[X]) (hdegree : P.natDegree ≤ a) : + RatFuncInfinityIntegers K := + ⟨(RatFunc.X⁻¹) ^ a * algebraMap K[X] (RatFunc K) P, + infinityNormalizedCoefficient_mem K a P hdegree⟩ + +@[simp] theorem infinityNormalizedCoefficient_coe + (a : ℕ) (P : K[X]) (hdegree : P.natDegree ≤ a) : + ((infinityNormalizedCoefficient K a P hdegree : + RatFuncInfinityIntegers K) : RatFunc K) = + (RatFunc.X⁻¹) ^ a * algebraMap K[X] (RatFunc K) P := + rfl + +/-- The coefficientwise integral infinity-chart equation. -/ +def infinityNormalizedIntegralPolynomial + (a : ℕ) (F : K[X][X]) + (hcoeff : ∀ i, (F.coeff i).natDegree ≤ a) : + (RatFuncInfinityIntegers K)[X] := + F.sum fun i _ => monomial i + (infinityNormalizedCoefficient K a (F.coeff i) (hcoeff i)) + +/-- Extending the integral infinity-chart equation to `K(X)` recovers the +field-valued normalization. -/ +theorem infinityNormalizedIntegralPolynomial_map + (a : ℕ) (F : K[X][X]) + (hcoeff : ∀ i, (F.coeff i).natDegree ≤ a) : + (infinityNormalizedIntegralPolynomial K a F hcoeff).map + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K)) = + infinityNormalizedPolynomial K a F := by + ext i + rw [coeff_map] + simp only [infinityNormalizedIntegralPolynomial, coeff_sum, + coeff_monomial] + simp [Polynomial.sum] + by_cases hzero : F.coeff i = 0 + · simp [hzero, infinityNormalizedPolynomial, coeff_C_mul] + · rw [if_neg hzero] + have hrhs : (infinityNormalizedPolynomial K a F).coeff i = + (RatFunc.X⁻¹) ^ a * + algebraMap K[X] (RatFunc K) (F.coeff i) := by + simp [infinityNormalizedPolynomial, coeff_C_mul] + rw [hrhs] + change algebraMap (RatFuncInfinityIntegers K) (RatFunc K) + (infinityNormalizedCoefficient K a (F.coeff i) (hcoeff i)) = + (RatFunc.X⁻¹) ^ a * algebraMap K[X] (RatFunc K) (F.coeff i) + change ((infinityNormalizedCoefficient K a (F.coeff i) (hcoeff i) : + RatFuncInfinityIntegers K) : RatFunc K) = _ + exact infinityNormalizedCoefficient_coe K a (F.coeff i) (hcoeff i) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean new file mode 100644 index 0000000000..ca0c2d2fcd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean @@ -0,0 +1,429 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound + +open Polynomial + +namespace BGS.CorvajaZannier + +noncomputable section + +theorem discr_powerBasis_eq_minpoly_discr + {K L : Type*} [Field K] [Field L] [Algebra K L] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + (pb : PowerBasis K L) : + Algebra.discr K pb.basis = (minpoly K pb.gen).discr := by + let E := AlgebraicClosure L + letI := fun a b : E => Classical.propDecidable (Eq a b) + let f := minpoly K pb.gen + have hfmonic : f.Monic := minpoly.monic pb.isIntegral_gen + have hfne : f ≠ 0 := hfmonic.ne_zero + have hfpos : 0 < f.degree := by + rw [← natDegree_pos_iff_degree_pos] + change 0 < (minpoly K pb.gen).natDegree + rw [pb.natDegree_minpoly] + rw [← pb.finrank] + exact Module.finrank_pos_iff.mpr inferInstance + have hsep : f.Separable := Algebra.IsSeparable.isSeparable K pb.gen + have hsplit : (f.map (algebraMap K E)).Splits := IsAlgClosed.splits _ + have hrootsNodup : (f.aroots E).Nodup := + nodup_roots (show (f.map (algebraMap K E)).Separable from hsep.map) + apply (algebraMap K E).injective + rw [Algebra.discr_powerBasis_eq_norm] + rw [map_mul, map_pow, map_neg, map_one, + Algebra.norm_eq_prod_embeddings K E] + have hprod : + (∏ σ : L →ₐ[K] E, σ (aeval pb.gen f.derivative)) = + ((f.aroots E).map + ((f.derivative.map (algebraMap K E)).eval)).prod := by + let e : (L →ₐ[K] E) ≃ {x : E // x ∈ f.aroots E} := by + simpa [f] using + (pb.liftEquiv' : (L →ₐ[K] E) ≃ + {x : E // x ∈ (minpoly K pb.gen).aroots E}) + calc + _ = ∏ x : {x : E // x ∈ f.aroots E}, + (f.derivative.map (algebraMap K E)).eval x.1 := by + apply Fintype.prod_equiv e + intro σ + have he : (e σ).1 = σ pb.gen := by + simp [e, f] + rw [he, ← aeval_algHom_apply, ← eval_map_algebraMap] + _ = _ := by + rw [Finset.prod_mem_multiset, Finset.prod_eq_multiset_prod, + Multiset.toFinset_val, Multiset.dedup_eq_self.mpr hrootsNodup] + intro x + rfl + rw [hprod] + have hres := resultant_deriv (f := f) hfpos + have hresMap : + (f.map (algebraMap K E)).resultant + (f.derivative.map (algebraMap K E)) f.natDegree + (f.natDegree - 1) = + (algebraMap K E) + ((-1) ^ (f.natDegree * (f.natDegree - 1) / 2) * + f.leadingCoeff * f.discr) := by + rw [resultant_map_map] + exact congrArg (algebraMap K E) hres + have hfmapDegree : (f.map (algebraMap K E)).natDegree = f.natDegree := + natDegree_map_eq_of_injective (algebraMap K E).injective f + have hresEval : + (f.map (algebraMap K E)).resultant + (f.derivative.map (algebraMap K E)) f.natDegree + (f.natDegree - 1) = + (f.map (algebraMap K E)).leadingCoeff ^ (f.natDegree - 1) * + (((f.map (algebraMap K E)).roots).map + ((f.derivative.map (algebraMap K E)).eval)).prod := by + convert resultant_eq_prod_eval + (f.map (algebraMap K E)) + (f.derivative.map (algebraMap K E)) + (f.natDegree - 1) + (natDegree_map_le.trans (natDegree_derivative_le f)) hsplit using 1 + rw [hfmapDegree] + rw [hresEval, + leadingCoeff_map_of_injective (algebraMap K E).injective, + hfmonic.leadingCoeff, map_one, one_pow, one_mul] at hresMap + simp only [map_mul, map_pow, map_neg, map_one] at hresMap + have hdegree : f.natDegree = Module.finrank K L := by + calc + f.natDegree = pb.dim := by simp [f, pb.natDegree_minpoly] + _ = Module.finrank K L := pb.finrank.symm + rw [hdegree] at hresMap + change ((f.aroots E).map + ((f.derivative.map (algebraMap K E)).eval)).prod = _ at hresMap + rw [hresMap] + let N := Module.finrank K L * (Module.finrank K L - 1) / 2 + have hsign : ((-1 : E) ^ N) * ((-1 : E) ^ N) = 1 := by + rw [← pow_add, show N + N = 2 * N by omega, pow_mul] + norm_num + dsimp only [N, f] at hsign ⊢ + rw [mul_one, ← mul_assoc, hsign, one_mul] + +open scoped nonZeroDivisors +open IsDedekindDomain Multiplicative WithZero + +section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance infinityDifferentIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityDifferentIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance infinityDifferentTopIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance infinityDifferentIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance infinityDifferentIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityDifferentIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityDifferentPlaceFintype : + Fintype ((ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L)) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + +/-- The residue-degree-weighted multiplicity of the different above the +infinity place of `K(X)`. -/ +def infinityDifferentDegree : ℕ := + ∑ P : (ratFuncInfinityPlace K).asIdeal.primesOver + (RatFuncInfinityIntegralClosure K L), + P.1.inertiaDeg (RatFuncInfinityIntegers K) * + multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) + +omit [DecidableEq K] in +theorem ratFuncInfinityIntegralClosureFractionRingEquiv_valuation + (q : HeightOneSpectrum (RatFuncInfinityIntegralClosure K L)) + (x : FractionRing (RatFuncInfinityIntegralClosure K L)) : + q.valuation L + (ratFuncInfinityIntegralClosureFractionRingEquiv K L x) = + q.valuation (FractionRing (RatFuncInfinityIntegralClosure K L)) x := by + obtain ⟨a, b, hb, rfl⟩ := + IsFractionRing.div_surjective + (RatFuncInfinityIntegralClosure K L) x + rw [map_div₀, + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).commutes a, + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).commutes b, + Valuation.map_div, Valuation.map_div, + q.valuation_of_algebraMap, q.valuation_of_algebraMap, + q.valuation_of_algebraMap, q.valuation_of_algebraMap] + +omit [DecidableEq K] in +theorem ratFuncInfinityIntegralClosureFractionRingEquiv_order_eq + (q : HeightOneSpectrum (RatFuncInfinityIntegralClosure K L)) + (x : FractionRing (RatFuncInfinityIntegralClosure K L)) (hx : x ≠ 0) : + finitePlaceOrder q x = + finitePlaceOrder q + (ratFuncInfinityIntegralClosureFractionRingEquiv K L x) := by + let e := ratFuncInfinityIntegralClosureFractionRingEquiv K L + have hcanon := valuation_eq_exp_neg_finitePlaceOrder q x hx + have he_ne : e x ≠ 0 := by simpa using e.injective.ne hx + have hactual := valuation_eq_exp_neg_finitePlaceOrder q (e x) he_ne + have hval := + ratFuncInfinityIntegralClosureFractionRingEquiv_valuation K L q x + have hexp : exp (-finitePlaceOrder q x) = + exp (-finitePlaceOrder q (e x)) := by + rw [← hcanon, ← hactual] + exact hval.symm + rw [exp_inj] at hexp + change finitePlaceOrder q x = finitePlaceOrder q (e x) + omega + +omit [DecidableEq K] in +/-- The different contribution above infinity is bounded by the infinity +order of the discriminant of any integral primitive-element equation having +a unit value at a center. The inverse translate of the primitive element is +integral and realizes the complementary reciprocal-discriminant estimate. -/ +theorem infinityDifferentDegree_le_discriminantOrder_of_primitiveElement + (G : (RatFuncInfinityIntegers K)[X]) + (c : RatFuncInfinityIntegers K) (u : (RatFuncInfinityIntegers K)ˣ) + (v : L) + (hu : G.eval c = u) + (hvc : v ≠ algebraMap (RatFuncInfinityIntegers K) L c) + (hv : aeval v G = 0) + (hprimitive : Algebra.adjoin (RatFunc K) {v} = ⊤) + (hdegree : G.natDegree = Module.finrank (RatFunc K) L) + (hGdiscr : G.discr ≠ 0) : + (infinityDifferentDegree K L : ℤ) ≤ + ratFuncInfinityOrder + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K) G.discr) := by + let A := RatFuncInfinityIntegers K + let B := RatFuncInfinityIntegralClosure K L + have hzIntegral : IsIntegral A + ((v - algebraMap A L c)⁻¹) := + isIntegral_inv_sub_of_eval_eq_unit G c u v hu hvc hv + let z : B := IsIntegralClosure.mk' B + ((v - algebraMap A L c)⁻¹) hzIntegral + have hzMap : algebraMap B L z = + (v - algebraMap A L c)⁻¹ := by + simp [z] + have hzPrimitive : Algebra.adjoin (RatFunc K) + {algebraMap B L z} = ⊤ := by + rw [hzMap] + simpa only [IsScalarTower.algebraMap_apply A (RatFunc K) L] using + (adjoin_inv_sub_eq_top_of_adjoin_eq_top + (algebraMap A (RatFunc K) c) v hprimitive) + let d : B := aeval z (derivative (minpoly A z)) + have hd : d ≠ 0 := by + simpa [d] using minpolyDerivative_ne_zero + (A := A) (K := RatFunc K) (L := L) z + let dL : L := algebraMap B L d + have hdL : dL ≠ 0 := by + exact (IsFractionRing.injective B L).ne hd + have hrepr : + (ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm dL = + algebraMap B (FractionRing B) d := by + apply (ratFuncInfinityIntegralClosureFractionRingEquiv K L).injective + rw [(ratFuncInfinityIntegralClosureFractionRingEquiv K L).apply_symm_apply] + exact (ratFuncInfinityIntegralClosureFractionRingEquiv K L).commutes d |>.symm + have hpoint : ∀ P : (ratFuncInfinityPlace K).asIdeal.primesOver B, + ((P.1.inertiaDeg A * + multiplicity P.1 (differentIdeal A B) : ℕ) : ℤ) ≤ + (P.1.inertiaDeg A : ℤ) * + finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm dL) := by + intro P + have hmul := differentIdeal_multiplicity_le_finitePlaceOrder_minpolyDerivative + (A := A) (K := RatFunc K) (L := L) (B := B) + z hzPrimitive (primeOverHeightOne (ratFuncInfinityPlace K) P) + change (multiplicity P.1 (differentIdeal A B) : ℤ) ≤ + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (algebraMap B L d) at hmul + have horder : + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (algebraMap B L d) = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm dL) := by + rw [hrepr] + have hne : algebraMap B (FractionRing B) d ≠ 0 := + by + have hinj : Function.Injective + (algebraMap B (FractionRing B)) := + FaithfulSMul.algebraMap_injective B (FractionRing B) + intro hzero + apply hd + apply hinj + rw [hzero, map_zero] + have heq := ratFuncInfinityIntegralClosureFractionRingEquiv_order_eq + K L (primeOverHeightOne (ratFuncInfinityPlace K) P) + (algebraMap B (FractionRing B) d) hne + calc + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (algebraMap B L d) = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) + (ratFuncInfinityIntegralClosureFractionRingEquiv K L + (algebraMap B (FractionRing B) d)) := by + rw [(ratFuncInfinityIntegralClosureFractionRingEquiv K L).commutes d] + _ = finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) + (algebraMap B (FractionRing B) d) := heq.symm + rw [horder] at hmul + simpa only [Nat.cast_mul] using + mul_le_mul_of_nonneg_left hmul (Int.natCast_nonneg _) + have hsum : (infinityDifferentDegree K L : ℤ) ≤ + ∑ P : (ratFuncInfinityPlace K).asIdeal.primesOver B, + (P.1.inertiaDeg A : ℤ) * + finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm dL) := by + rw [infinityDifferentDegree, Nat.cast_sum] + exact Finset.sum_le_sum fun P _ => hpoint P + rw [primesAboveInfinity_weightedOrder_eq_normInfinityOrder K L dL hdL] at hsum + let pb : PowerBasis (RatFunc K) L := + PowerBasis.ofAdjoinEqTop' + (Algebra.IsIntegral.isIntegral (algebraMap B L z)) hzPrimitive + have hdiscNorm := discr_powerBasisOfPrimitiveElement_eq_norm_minpolyDerivative + (A := A) (K := RatFunc K) (L := L) (B := B) z hzPrimitive + have hpb : Algebra.discr (RatFunc K) pb.basis = + (minpoly (RatFunc K) (algebraMap B L z)).discr := + by + have hpbg : pb.gen = algebraMap B L z := by simp [pb] + simpa only [hpbg] using discr_powerBasis_eq_minpoly_discr pb + change Algebra.discr (RatFunc K) pb.basis = + (-1) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2) * + Algebra.norm (RatFunc K) dL at hdiscNorm + rw [hpb] at hdiscNorm + have hnormOrder : + ratFuncInfinityOrder (Algebra.norm (RatFunc K) dL) = + ratFuncInfinityOrder + (minpoly (RatFunc K) (algebraMap B L z)).discr := by + have hsign : + (-1 : RatFunc K) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2) ≠ 0 := by simp + have hnorm : Algebra.norm (RatFunc K) dL ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hdL + have hdegreeEq := congrArg RatFunc.intDegree hdiscNorm + rw [RatFunc.intDegree_mul hsign hnorm] at hdegreeEq + have hsignDegree : RatFunc.intDegree + ((-1 : RatFunc K) ^ (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2)) = 0 := by + induction (Module.finrank (RatFunc K) L * + (Module.finrank (RatFunc K) L - 1) / 2) with + | zero => simp + | succ n ih => + rw [pow_succ, RatFunc.intDegree_mul (pow_ne_zero n (by simp)) (by simp), ih] + simp + rw [hsignDegree, zero_add] at hdegreeEq + exact congrArg Neg.neg hdegreeEq |>.symm + rw [hnormOrder] at hsum + have htop := finitePlaceOrderTop_minpoly_inv_sub_discr + (A := A) (K := RatFunc K) (L := L) + (ratFuncInfinityPlace K) G c u v hu hvc hv hprimitive hdegree + rw [← hzMap] at htop + have hminNe : (minpoly (RatFunc K) (algebraMap B L z)).discr ≠ 0 := by + intro hzero + rw [hzero] at hdiscNorm + exact (mul_ne_zero (by simp) (Algebra.norm_ne_zero_iff.mpr hdL)) hdiscNorm.symm + have hmapNe : algebraMap A (RatFunc K) G.discr ≠ 0 := + (IsFractionRing.injective A (RatFunc K)).ne hGdiscr + rw [finitePlaceOrderTop_eq_coe _ _ hminNe, + finitePlaceOrderTop_eq_coe _ _ hmapNe] at htop + have horderEq : ratFuncInfinityOrder + (minpoly (RatFunc K) (algebraMap B L z)).discr = + ratFuncInfinityOrder (algebraMap A (RatFunc K) G.discr) := by + have hfinite : finitePlaceOrder (ratFuncInfinityPlace K) + (minpoly (RatFunc K) (algebraMap B L z)).discr = + finitePlaceOrder (ratFuncInfinityPlace K) + (algebraMap A (RatFunc K) G.discr) := by + exact_mod_cast htop + simpa only [ratFuncInfinityPlace_order_eq K _ hminNe, + ratFuncInfinityPlace_order_eq K _ hmapNe] using hfinite + exact hsum.trans_eq horderEq + +end + +end + +end BGS.CorvajaZannier + +namespace BGS.CorvajaZannier + +open scoped Polynomial +open Multiplicative WithZero Polynomial + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + +theorem infinityNormalizedCoefficient_isUnit_of_natDegree_eq + (a : ℕ) (P : K[X]) (hP : P ≠ 0) (hdegree : P.natDegree = a) : + IsUnit (infinityNormalizedCoefficient K a P hdegree.le) := by + rw [Valuation.Integers.isUnit_iff_valuation_eq_one + (Valuation.integer.integers (RatFunc.inftyValuation K))] + change RatFunc.inftyValuation K + ((RatFunc.X⁻¹) ^ a * algebraMap K[X] (RatFunc K) P) = 1 + have hXinv : RatFunc.X⁻¹ ≠ (0 : RatFunc K) := + inv_ne_zero RatFunc.X_ne_zero + have hleft : (RatFunc.X⁻¹) ^ a ≠ (0 : RatFunc K) := + pow_ne_zero _ hXinv + have hright : algebraMap K[X] (RatFunc K) P ≠ 0 := + RatFunc.algebraMap_ne_zero hP + have hpow : ((((RatFunc.X : RatFunc K)⁻¹) ^ a) : RatFunc K).intDegree = + (a : ℤ) * ((RatFunc.X : RatFunc K)⁻¹).intDegree := by + clear hdegree hleft + induction a with + | zero => simp + | succ n ih => + rw [pow_succ, RatFunc.intDegree_mul + (pow_ne_zero n hXinv) hXinv, ih] + push_cast + ring + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero (F := K) (mul_ne_zero hleft hright), + RatFunc.intDegree_mul hleft hright, + hpow, + RatFunc.intDegree_inv, RatFunc.intDegree_X, + RatFunc.intDegree_polynomial, hdegree] + simp + +theorem infinityNormalizedIntegralPolynomial_isPrimitive + (a : ℕ) (F : K[X][X]) + (hcoeff : ∀ i, (F.coeff i).natDegree ≤ a) + (i : ℕ) (hFi : F.coeff i ≠ 0) + (hi : (F.coeff i).natDegree = a) : + (infinityNormalizedIntegralPolynomial K a F hcoeff).IsPrimitive := by + rw [Polynomial.isPrimitive_iff_contentIdeal_eq_top] + let G := infinityNormalizedIntegralPolynomial K a F hcoeff + have hcoeffG : G.coeff i = + infinityNormalizedCoefficient K a (F.coeff i) (hcoeff i) := by + simp only [G, infinityNormalizedIntegralPolynomial, coeff_sum, + coeff_monomial] + simp [Polynomial.sum, hFi] + apply G.contentIdeal.eq_top_of_isUnit_mem (G.coeff_mem_contentIdeal i) + rw [hcoeffG] + exact infinityNormalizedCoefficient_isUnit_of_natDegree_eq + K a (F.coeff i) hFi hi + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean new file mode 100644 index 0000000000..7d63870cc0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean @@ -0,0 +1,639 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +import Mathlib.Algebra.Polynomial.Roots +import Mathlib.RingTheory.Localization.LocalizationLocalization +import Mathlib.RingTheory.Polynomial.ContentIdeal + +/-! +# Local reciprocal normalization for an irreducible plane curve + +This file specializes `LocalReciprocalDiscriminant` to the first-coordinate +model of an irreducible plane curve. When the second-coordinate degree is +smaller than the cardinality of the constant field, at each finite prime of +`K[X]` it selects a local center at which the defining polynomial has unit +value. This includes explicit finite-field and infinite-field interfaces. It +also proves the defining relation, primitive generation, and the exact +extension degree over `K(X)`. The final theorem identifies the minimal +polynomial of the reciprocal local parameter with the unit-normalized +reciprocal translate of the localized plane equation. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Coordinate `0` becomes the coefficient variable in the iterated plane +curve presentation. -/ +@[simp] theorem planeCurvePolynomialInSecondCoordinate_X_zero : + planeCurvePolynomialInSecondCoordinate (K := K) (MvPolynomial.X 0) = + Polynomial.C Polynomial.X := by + rw [planeCurvePolynomialInSecondCoordinate] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) (MvPolynomial.X 0))) = _ + rw [MvPolynomial.rename_X] + have hswap : Equiv.swap (0 : Fin 2) 1 0 = 1 := by decide + rw [hswap] + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 1) = + Polynomial.C (MvPolynomial.X (0 : Fin 1)) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp only [MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_X] + rw [show (1 : Fin 2) = Fin.succ (0 : Fin 1) by decide] + rfl + rw [hinner] + simp [MvPolynomial.uniqueAlgEquiv] + +/-- Coordinate `1` becomes the outer polynomial variable. -/ +@[simp] theorem planeCurvePolynomialInSecondCoordinate_X_one : + planeCurvePolynomialInSecondCoordinate (K := K) (MvPolynomial.X 1) = + Polynomial.X := by + rw [planeCurvePolynomialInSecondCoordinate] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) (MvPolynomial.X 1))) = _ + rw [MvPolynomial.rename_X] + have hswap : Equiv.swap (0 : Fin 2) 1 1 = 0 := by decide + rw [hswap] + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 0) = + (Polynomial.X : Polynomial (MvPolynomial (Fin 1) K)) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp + rw [hinner] + simp + +/-- Constants remain constants in both polynomial variables. -/ +@[simp] theorem planeCurvePolynomialInSecondCoordinate_C (c : K) : + planeCurvePolynomialInSecondCoordinate (MvPolynomial.C c) = + Polynomial.C (Polynomial.C c) := by + rw [planeCurvePolynomialInSecondCoordinate] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) (MvPolynomial.C c))) = _ + rw [MvPolynomial.rename_C] + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.C c) = + Polynomial.C (MvPolynomial.C c) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp + rw [hinner] + simp [MvPolynomial.uniqueAlgEquiv] + +/-- The plane-curve presentation agrees with Mathlib's standard bivariate +polynomial equivalence. -/ +theorem planeCurvePolynomialInSecondCoordinate_eq_bivariateEquiv + (f : MvPolynomial (Fin 2) K) : + planeCurvePolynomialInSecondCoordinate f = + (Polynomial.Bivariate.equivMvPolynomial K).symm f := by + change planeCurvePolynomialInSecondCoordinate.toAlgHom f = + (Polynomial.Bivariate.equivMvPolynomial K).symm.toAlgHom f + congr 1 + apply MvPolynomial.algHom_ext + intro i + fin_cases i + · simp + · simp + +/-- Evaluation of the iterated polynomial is ordinary two-coordinate +evaluation of the original multivariate polynomial. -/ +theorem eval₂_planeCurvePolynomialInSecondCoordinate + {A : Type*} [CommSemiring A] [Algebra K A] + (f : MvPolynomial (Fin 2) K) (x y : A) : + Polynomial.eval₂ (Polynomial.eval₂RingHom (algebraMap K A) x) y + (planeCurvePolynomialInSecondCoordinate f) = + MvPolynomial.eval₂ (algebraMap K A) ![x, y] f := by + let lhs : MvPolynomial (Fin 2) K →+* A := + (Polynomial.eval₂RingHom + (Polynomial.eval₂RingHom (algebraMap K A) x) y).comp + planeCurvePolynomialInSecondCoordinate.toRingEquiv.toRingHom + let rhs : MvPolynomial (Fin 2) K →+* A := + MvPolynomial.eval₂Hom (algebraMap K A) ![x, y] + change lhs f = rhs f + congr 1 + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs, planeCurvePolynomialInSecondCoordinate_C] + · intro i + fin_cases i + · simp [lhs, rhs, + planeCurvePolynomialInSecondCoordinate_X_zero] + · simp [lhs, rhs, + planeCurvePolynomialInSecondCoordinate_X_one] + +open IsDedekindDomain Polynomial +open scoped nonZeroDivisors + +/-- The canonical inclusion of the local ring of `K[X]` at a finite prime +into its fraction field `K(X)`. -/ +noncomputable def localizationAtPrimeToRatFunc + (p : HeightOneSpectrum (Polynomial K)) : + Localization.AtPrime p.asIdeal →+* RatFunc K := + IsLocalization.lift (S := Localization.AtPrime p.asIdeal) + (M := p.asIdeal.primeCompl) + (g := algebraMap (Polynomial K) (RatFunc K)) fun + (y : p.asIdeal.primeCompl) => + IsLocalization.map_units (RatFunc K) + ⟨y.1, p.asIdeal.primeCompl_le_nonZeroDivisors y.2⟩ + +/-- The local inclusion extends the standard polynomial inclusion in +`RatFunc K`. -/ +@[simp] theorem localizationAtPrimeToRatFunc_comp_algebraMap + (p : HeightOneSpectrum (Polynomial K)) : + (localizationAtPrimeToRatFunc p).comp + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal)) = + algebraMap (Polynomial K) (RatFunc K) := by + simp only [localizationAtPrimeToRatFunc] + exact IsLocalization.lift_comp _ + +/-- A primitive polynomial over `K[X]` has a unit value at some center in +every finite localization when its degree is smaller than the cardinality of +the constant field. -/ +theorem exists_localized_center_eval_isUnit_of_natDegree_lt_card + (F : Polynomial (Polynomial K)) (hF : F.IsPrimitive) + (hcardK : (F.natDegree : Cardinal) < Cardinal.mk K) + (p : HeightOneSpectrum (Polynomial K)) : + ∃ a : Polynomial K, + IsUnit ((F.map + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal))).eval + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal) a)) := by + let k := (Polynomial K) ⧸ p.asIdeal + let π : Polynomial K →+* k := Ideal.Quotient.mk p.asIdeal + have hFbar : F.map π ≠ 0 := by + intro hzero + have hcoeff : ∀ i, F.coeff i ∈ p.asIdeal := by + intro i + have hi := congrArg (fun q : Polynomial k => q.coeff i) hzero + rw [Polynomial.coeff_map, Polynomial.coeff_zero] at hi + exact Ideal.Quotient.eq_zero_iff_mem.mp hi + have hcontent : F.contentIdeal ≤ p.asIdeal := by + rw [Polynomial.contentIdeal_def, Ideal.span_le] + intro x hx + obtain ⟨i, _hi, rfl⟩ := Polynomial.mem_coeffs_iff.mp hx + exact hcoeff i + have htop : F.contentIdeal = ⊤ := + (Polynomial.isPrimitive_iff_contentIdeal_eq_top F).mp hF + apply p.isPrime.ne_top + apply top_unique + simpa [htop] using hcontent + have hcard : (F.map π).natDegree < Cardinal.mk k := by + have hdegree : ((F.map π).natDegree : Cardinal) ≤ F.natDegree := by + exact_mod_cast Polynomial.natDegree_map_le + exact (hdegree.trans_lt hcardK).trans_le + (Cardinal.mk_le_of_injective + (RingHom.injective (algebraMap K k))) + obtain ⟨c, hc⟩ := + Polynomial.exists_eval_ne_zero_of_natDegree_lt_card (F.map π) hFbar hcard + obtain ⟨a, rfl⟩ := Ideal.Quotient.mk_surjective c + refine ⟨a, ?_⟩ + rw [Polynomial.eval_map_apply] + apply (IsLocalization.AtPrime.isUnit_to_map_iff + (Localization.AtPrime p.asIdeal) p.asIdeal (F.eval a)).2 + change F.eval a ∉ p.asIdeal + intro hmem + apply hc + rw [Polynomial.eval_map_apply] + change π (F.eval a) = 0 + exact Ideal.Quotient.eq_zero_iff_mem.mpr hmem + +/-- Infinite constant fields automatically satisfy the cardinality hypothesis +for a primitive polynomial of finite degree. -/ +theorem exists_localized_center_eval_isUnit + [Infinite K] (F : Polynomial (Polynomial K)) (hF : F.IsPrimitive) + (p : HeightOneSpectrum (Polynomial K)) : + ∃ a : Polynomial K, + IsUnit ((F.map + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal))).eval + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal) a)) := by + apply exists_localized_center_eval_isUnit_of_natDegree_lt_card F hF + exact (show (F.natDegree : Cardinal) < Cardinal.aleph0 from + Cardinal.natCast_lt_aleph0).trans_le (Cardinal.aleph0_le_mk K) + +/-- Finite constant fields satisfy the local center hypothesis as soon as the +polynomial degree is smaller than the field cardinality. -/ +theorem exists_localized_center_eval_isUnit_of_natDegree_lt_fintypeCard + [Fintype K] (F : Polynomial (Polynomial K)) (hF : F.IsPrimitive) + (hcardK : F.natDegree < Fintype.card K) + (p : HeightOneSpectrum (Polynomial K)) : + ∃ a : Polynomial K, + IsUnit ((F.map + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal))).eval + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal) a)) := by + apply exists_localized_center_eval_isUnit_of_natDegree_lt_card F hF + simpa only [Cardinal.mk_fintype, Nat.cast_lt] using hcardK + +/-- The irreducible plane equation admits a unit-valued center at every +finite first-coordinate prime when its second-coordinate degree is smaller +than the cardinality of the constant field. -/ +theorem exists_planeCurve_localized_center_eval_isUnit_of_degreeOf_second_lt_card + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (hcardK : (MvPolynomial.degreeOf 1 f : Cardinal) < Cardinal.mk K) + (p : HeightOneSpectrum (Polynomial K)) : + ∃ a : Polynomial K, + IsUnit (((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal))).eval + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal) a)) := by + let F : Polynomial (Polynomial K) := + planeCurvePolynomialInSecondCoordinate f + have hFirreducible : Irreducible F := + hf.map planeCurvePolynomialInSecondCoordinate + have hFdegree : F.natDegree ≠ 0 := by + simpa [F] using hsecond.ne' + apply exists_localized_center_eval_isUnit_of_natDegree_lt_card F + (hFirreducible.isPrimitive hFdegree) _ p + simpa [F] using hcardK + +/-- Over an infinite constant field, every finite first-coordinate prime has +a unit-valued plane-curve center. -/ +theorem exists_planeCurve_localized_center_eval_isUnit + [Infinite K] {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (p : HeightOneSpectrum (Polynomial K)) : + ∃ a : Polynomial K, + IsUnit (((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal))).eval + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal) a)) := by + apply exists_planeCurve_localized_center_eval_isUnit_of_degreeOf_second_lt_card + hf hsecond + exact (show (MvPolynomial.degreeOf 1 f : Cardinal) < Cardinal.aleph0 from + Cardinal.natCast_lt_aleph0).trans_le (Cardinal.aleph0_le_mk K) + +/-- Over a finite constant field, the plane-curve center exists under the +literal degree-versus-cardinality inequality. -/ +theorem exists_planeCurve_localized_center_eval_isUnit_of_degreeOf_second_lt_fintypeCard + [Fintype K] {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (p : HeightOneSpectrum (Polynomial K)) : + ∃ a : Polynomial K, + IsUnit (((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal))).eval + (algebraMap (Polynomial K) (Localization.AtPrime p.asIdeal) a)) := by + apply exists_planeCurve_localized_center_eval_isUnit_of_degreeOf_second_lt_card + hf hsecond _ p + simpa only [Cardinal.mk_fintype, Nat.cast_lt] using hcardK + +/-- The second coordinate is a root of the defining equation after extending +the first-coordinate coefficients to `K(X)`. -/ +theorem aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + Polynomial.aeval (planeCurveFunction f 1) + ((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K))) = 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + have hcoeff : + (algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.eval₂RingHom + (algebraMap K (PlaneCurveFunctionField f)) + (planeCurveFunction f 0) := by + exact ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx + calc + Polynomial.aeval (planeCurveFunction f 1) + ((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K))) = + Polynomial.eval₂ + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + (planeCurveFunction f 1) + (planeCurvePolynomialInSecondCoordinate f) := by + rw [Polynomial.aeval_def, Polynomial.eval₂_map] + _ = Polynomial.eval₂ + (Polynomial.eval₂RingHom + (algebraMap K (PlaneCurveFunctionField f)) + (planeCurveFunction f 0)) + (planeCurveFunction f 1) + (planeCurvePolynomialInSecondCoordinate f) := by rw [hcoeff] + _ = MvPolynomial.eval₂ + (algebraMap K (PlaneCurveFunctionField f)) + ![planeCurveFunction f 0, planeCurveFunction f 1] f := + eval₂_planeCurvePolynomialInSecondCoordinate f + (planeCurveFunction f 0) (planeCurveFunction f 1) + _ = 0 := by + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [← hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f + +/-- The defining equation remains irreducible over `K(X)`. -/ +theorem planeCurvePolynomialInSecondCoordinate_ratFunc_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + Irreducible ((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K))) := by + let F : Polynomial (Polynomial K) := + planeCurvePolynomialInSecondCoordinate f + have hFirreducible : Irreducible F := + hf.map planeCurvePolynomialInSecondCoordinate + have hFdegree : F.natDegree ≠ 0 := by + simpa [F] using + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond).ne' + exact (hFirreducible.isPrimitive hFdegree + |>.irreducible_iff_irreducible_map_fraction_map).mp hFirreducible + +/-- The second coordinate primitively generates the plane function field over +the first-coordinate copy of `K(X)`. -/ +theorem adjoin_secondCoordinate_over_firstRatFunc_eq_top + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + Algebra.adjoin (RatFunc K) {planeCurveFunction f 1} = ⊤ := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let F : Polynomial (RatFunc K) := + (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K)) + have hFirreducible : Irreducible F := + planeCurvePolynomialInSecondCoordinate_ratFunc_irreducible + hf hpartialSecond + have hFroot : Polynomial.aeval (planeCurveFunction f 1) F = 0 := + aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + hf hpartialSecond + have heq := minpoly.eq_of_irreducible hFirreducible hFroot + have hminDegree : + (minpoly (RatFunc K) (planeCurveFunction f 1)).natDegree = + F.natDegree := by + calc + (minpoly (RatFunc K) (planeCurveFunction f 1)).natDegree = + (F * Polynomial.C F.leadingCoeff⁻¹).natDegree := by rw [heq] + _ = F.natDegree := Polynomial.natDegree_mul_C + (inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr + hFirreducible.ne_zero)) + have hFdegree : F.natDegree = + MvPolynomial.degreeOf 1 f := by + change ((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K))).natDegree = _ + rw [Polynomial.natDegree_map_eq_of_injective + (IsFractionRing.injective (Polynomial K) (RatFunc K)), + planeCurvePolynomialInSecondCoordinate_natDegree] + have hfinrank : Module.finrank (RatFunc K) + (PlaneCurveFunctionField f) = MvPolynomial.degreeOf 1 f := + finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond + have hprimitiveField : + IntermediateField.adjoin (RatFunc K) {planeCurveFunction f 1} = + (⊤ : IntermediateField (RatFunc K) (PlaneCurveFunctionField f)) := + (Field.primitive_element_iff_minpoly_natDegree_eq + (RatFunc K) (planeCurveFunction f 1)).mpr (by + rw [hminDegree, hFdegree, hfinrank]) + exact (IntermediateField.adjoin_eq_top_iff).mp hprimitiveField + +/-- All local hypotheses for reciprocal normalization, packaged with an +explicit center and unit, under the exact cardinality hypothesis needed for +center selection. -/ +theorem planeCurve_local_reciprocal_certificate_of_degreeOf_second_lt_card + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : (MvPolynomial.degreeOf 1 f : Cardinal) < Cardinal.mk K) + (p : HeightOneSpectrum (Polynomial K)) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + let G := (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) A) + ∃ (a : Polynomial K) (u : Aˣ), + let c := algebraMap (Polynomial K) A a + G.eval c = (u : A) ∧ + G.eval₂ ((algebraMap (RatFunc K) + (PlaneCurveFunctionField f)).comp ι) + (planeCurveFunction f 1) = 0 ∧ + planeCurveFunction f 1 ≠ + algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c) ∧ + Algebra.adjoin (RatFunc K) {planeCurveFunction f 1} = ⊤ ∧ + G.natDegree = Module.finrank (RatFunc K) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + let F := planeCurvePolynomialInSecondCoordinate f + let G := F.map (algebraMap (Polynomial K) A) + have hsecond : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + obtain ⟨a, haUnit⟩ := + exists_planeCurve_localized_center_eval_isUnit_of_degreeOf_second_lt_card + (K := K) hf hsecond hcardK p + obtain ⟨u, hu⟩ := haUnit + let c : A := algebraMap (Polynomial K) A a + have hrootRat := + aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + hf hpartialSecond + have hroot : + G.eval₂ ((algebraMap (RatFunc K) + (PlaneCurveFunctionField f)).comp ι) + (planeCurveFunction f 1) = 0 := by + change (F.map (algebraMap (Polynomial K) A)).eval₂ + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp ι) + (planeCurveFunction f 1) = 0 + rw [Polynomial.eval₂_map] + rw [RingHom.comp_assoc, + localizationAtPrimeToRatFunc_comp_algebraMap] + rw [← Polynomial.eval₂_map] + simpa [Polynomial.aeval_def, F] using hrootRat + have hvc : planeCurveFunction f 1 ≠ + algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c) := by + intro heq + have hzeroMap : + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp ι) + (G.eval c) = 0 := by + rw [← Polynomial.eval₂_at_apply] + change planeCurveFunction f 1 = + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp ι) c at heq + rw [← heq] + exact hroot + have hmapUnit : IsUnit + (((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp ι) + (G.eval c)) := by + rw [← hu] + exact u.isUnit.map _ + exact hmapUnit.ne_zero hzeroMap + have hprimitive := + adjoin_secondCoordinate_over_firstRatFunc_eq_top + hf hpartialSecond + have hdegree : G.natDegree = Module.finrank (RatFunc K) + (PlaneCurveFunctionField f) := by + have hmapDegree : G.natDegree = F.natDegree := by + change (F.map (algebraMap (Polynomial K) A)).natDegree = F.natDegree + exact Polynomial.natDegree_map_eq_of_injective + (IsLocalization.injective A p.asIdeal.primeCompl_le_nonZeroDivisors) F + calc + G.natDegree = F.natDegree := hmapDegree + _ = MvPolynomial.degreeOf 1 f := by simp [F] + _ = Module.finrank (RatFunc K) (PlaneCurveFunctionField f) := + (finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond).symm + refine ⟨a, u, ?_, hroot, hvc, hprimitive, hdegree⟩ + exact hu.symm + +/-- Finite-field form of the full reciprocal-normalization certificate. -/ +theorem planeCurve_local_reciprocal_certificate_of_degreeOf_second_lt_fintypeCard + [Fintype K] {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (p : HeightOneSpectrum (Polynomial K)) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + let G := (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) A) + ∃ (a : Polynomial K) (u : Aˣ), + let c := algebraMap (Polynomial K) A a + G.eval c = (u : A) ∧ + G.eval₂ ((algebraMap (RatFunc K) + (PlaneCurveFunctionField f)).comp ι) + (planeCurveFunction f 1) = 0 ∧ + planeCurveFunction f 1 ≠ + algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c) ∧ + Algebra.adjoin (RatFunc K) {planeCurveFunction f 1} = ⊤ ∧ + G.natDegree = Module.finrank (RatFunc K) + (PlaneCurveFunctionField f) := by + apply planeCurve_local_reciprocal_certificate_of_degreeOf_second_lt_card + hf hpartialSecond _ p + simpa only [Cardinal.mk_fintype, Nat.cast_lt] using hcardK + +/-- At every finite first-coordinate prime, a reciprocal translate of the +localized plane equation is exactly the minimal polynomial of the reciprocal +local parameter, under the exact cardinality hypothesis needed to select its +center. -/ +theorem planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_card + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : (MvPolynomial.degreeOf 1 f : Cardinal) < Cardinal.mk K) + (p : HeightOneSpectrum (Polynomial K)) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + ∃ (a : Polynomial K) (u : Aˣ), + let c := algebraMap (Polynomial K) A a + let G := (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) A) + minpoly (RatFunc K) + ((planeCurveFunction f 1 - + algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c))⁻¹) = + (unitNormalizedReciprocalTranslate G c u).map ι := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let algRL : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := algRL + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + obtain ⟨a, u, hu, hroot, hvc, hprimitive, hdegree⟩ := + planeCurve_local_reciprocal_certificate_of_degreeOf_second_lt_card + (K := K) hf hpartialSecond hcardK p + let c : A := algebraMap (Polynomial K) A a + let G : Polynomial A := + (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) A) + let algRA : Algebra (Polynomial K) A := inferInstance + let algRR : Algebra (Polynomial K) (RatFunc K) := inferInstance + let algAR : Algebra A (RatFunc K) := ι.toAlgebra + letI : Algebra (Polynomial K) A := algRA + letI : Algebra (Polynomial K) (RatFunc K) := algRR + letI : Algebra A (RatFunc K) := algAR + letI : SMul (Polynomial K) A := algRA.toSMul + letI : SMul (Polynomial K) (RatFunc K) := algRR.toSMul + letI : SMul A (RatFunc K) := algAR.toSMul + letI : IsScalarTower (Polynomial K) A (RatFunc K) := by + apply IsScalarTower.of_algebraMap_eq' + exact (localizationAtPrimeToRatFunc_comp_algebraMap p).symm + letI : IsFractionRing A (RatFunc K) := + IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + p.asIdeal.primeCompl A (RatFunc K) + let algAL : Algebra A (PlaneCurveFunctionField f) := + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp ι).toAlgebra + letI : SMul (RatFunc K) (PlaneCurveFunctionField f) := algRL.toSMul + letI : Algebra A (PlaneCurveFunctionField f) := algAL + letI : SMul A (PlaneCurveFunctionField f) := algAL.toSMul + letI : IsScalarTower A (RatFunc K) (PlaneCurveFunctionField f) := by + apply IsScalarTower.of_algebraMap_eq' + rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hroot' : Polynomial.aeval (planeCurveFunction f 1) G = 0 := by + simpa [Polynomial.aeval_def, algAL, RingHom.algebraMap_toAlgebra, + G] using hroot + have hvc' : planeCurveFunction f 1 ≠ + algebraMap A (PlaneCurveFunctionField f) c := by + simpa [algAL, RingHom.algebraMap_toAlgebra, RingHom.comp_apply, c] using hvc + have hmin := minpoly_inv_sub_eq_map_unitNormalizedReciprocalTranslate + (A := A) (K := RatFunc K) (L := PlaneCurveFunctionField f) + G c u (planeCurveFunction f 1) hu hvc' hroot' hprimitive hdegree + refine ⟨a, u, ?_⟩ + simpa [c, G, algAL, algAR, RingHom.algebraMap_toAlgebra, + RingHom.comp_apply] using hmin + +/-- Finite-field form of the reciprocal minimal-polynomial normalization. -/ +theorem planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_fintypeCard + [Fintype K] {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (p : HeightOneSpectrum (Polynomial K)) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + let A := Localization.AtPrime p.asIdeal + let ι := localizationAtPrimeToRatFunc p + ∃ (a : Polynomial K) (u : Aˣ), + let c := algebraMap (Polynomial K) A a + let G := (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) A) + minpoly (RatFunc K) + ((planeCurveFunction f 1 - + algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c))⁻¹) = + (unitNormalizedReciprocalTranslate G c u).map ι := by + apply + planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_card + hf hpartialSecond _ p + simpa only [Cardinal.mk_fintype, Nat.cast_lt] using hcardK + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean new file mode 100644 index 0000000000..7d6bb8a44e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean @@ -0,0 +1,276 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +import Mathlib.Tactic + +/-! +# The logarithmic Gauss direction of a plane curve + +The logarithmic partial `X_i * ∂_i f` has exactly the same monomial +support as a subpolynomial of `f`. Consequently a scalar relation between +the two logarithmic partials forces every support exponent to lie on one +affine line in the constant field. + +If the support has a nonzero rank-two determinant and the characteristic is +larger than the public Euler budget, that determinant stays nonzero in the +constant field. Hence the logarithmic Gauss ratio cannot be constant on the +curve. This isolates the high-characteristic input needed by the +logarithmic-Gauss route to the powered-image index bound. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The logarithmic partial derivative `X_i * ∂_i f`. -/ +def planeCurveLogarithmicPDeriv {K : Type*} [Field K] + (i : Fin 2) (f : MvPolynomial (Fin 2) K) := + MvPolynomial.X i * MvPolynomial.pderiv i f + +theorem coeff_planeCurveLogarithmicPDeriv + {K : Type*} [Field K] (i : Fin 2) + (f : MvPolynomial (Fin 2) K) (m : Fin 2 →₀ ℕ) : + MvPolynomial.coeff m (planeCurveLogarithmicPDeriv i f) = + (m i : K) * MvPolynomial.coeff m f := by + induction f using MvPolynomial.induction_on' with + | add p q hp hq => + simp only [planeCurveLogarithmicPDeriv, map_add, mul_add, + MvPolynomial.coeff_add] + change MvPolynomial.coeff m (planeCurveLogarithmicPDeriv i p) + + MvPolynomial.coeff m (planeCurveLogarithmicPDeriv i q) = _ + rw [hp, hq] + | monomial n a => + rw [planeCurveLogarithmicPDeriv, + MvPolynomial.X_mul_pderiv_monomial] + simp only [MvPolynomial.coeff_smul, MvPolynomial.coeff_monomial] + split_ifs with h + · subst n + simp [nsmul_eq_mul] + · simp + +/-- A constant linear combination of the two logarithmic partials. -/ +def planeCurveLogarithmicDirection {K : Type*} [Field K] + (a b : K) (f : MvPolynomial (Fin 2) K) := + MvPolynomial.C a * planeCurveLogarithmicPDeriv 0 f + + MvPolynomial.C b * planeCurveLogarithmicPDeriv 1 f + +theorem coeff_planeCurveLogarithmicDirection + {K : Type*} [Field K] (a b : K) + (f : MvPolynomial (Fin 2) K) (m : Fin 2 →₀ ℕ) : + MvPolynomial.coeff m (planeCurveLogarithmicDirection a b f) = + (a * (m 0 : K) + b * (m 1 : K)) * MvPolynomial.coeff m f := by + simp only [planeCurveLogarithmicDirection, MvPolynomial.coeff_add, + MvPolynomial.coeff_C_mul, coeff_planeCurveLogarithmicPDeriv] + ring + +theorem support_planeCurveLogarithmicDirection_subset + {K : Type*} [Field K] (a b : K) + (f : MvPolynomial (Fin 2) K) : + (planeCurveLogarithmicDirection a b f).support ⊆ f.support := by + intro m hm + rw [MvPolynomial.mem_support_iff] at hm ⊢ + rw [coeff_planeCurveLogarithmicDirection] at hm + exact right_ne_zero_of_mul hm + +theorem degreeOf_planeCurveLogarithmicDirection_le + {K : Type*} [Field K] (a b : K) + (f : MvPolynomial (Fin 2) K) (i : Fin 2) : + MvPolynomial.degreeOf i (planeCurveLogarithmicDirection a b f) ≤ + MvPolynomial.degreeOf i f := by + rw [MvPolynomial.degreeOf_le_iff] + intro m hm + exact MvPolynomial.le_degreeOf_of_mem_support i + (support_planeCurveLogarithmicDirection_subset a b f hm) + +private theorem eq_C_coeff_zero_of_degreeOf_zero + {K : Type*} [Field K] (g : MvPolynomial (Fin 2) K) + (h0 : MvPolynomial.degreeOf 0 g = 0) + (h1 : MvPolynomial.degreeOf 1 g = 0) : + g = MvPolynomial.C (MvPolynomial.coeff 0 g) := by + ext m + by_cases hm : m = 0 + · subst m + simp + · have hcoordinate : m 0 ≠ 0 ∨ m 1 ≠ 0 := by + by_contra h + push Not at h + apply hm + ext i + fin_cases i <;> simp_all + have hmnot : m ∉ g.support := by + intro hmem + rcases hcoordinate with hm0 | hm1 + · have := MvPolynomial.le_degreeOf_of_mem_support 0 hmem + omega + · have := MvPolynomial.le_degreeOf_of_mem_support 1 hmem + omega + rw [MvPolynomial.notMem_support_iff.mp hmnot] + have hm' : (0 : Fin 2 →₀ ℕ) ≠ m := Ne.symm hm + simp [hm'] + +/-- A nonzero logarithmic direction divisible by `f` is only a constant +multiple of `f`; the coordinate degree bounds force the quotient to be +constant. -/ +theorem planeCurveLogarithmicDirection_eq_C_mul_of_dvd + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : f ≠ 0) (a b : K) + (hQ : planeCurveLogarithmicDirection a b f ≠ 0) + (hdvd : f ∣ planeCurveLogarithmicDirection a b f) : + ∃ d : K, planeCurveLogarithmicDirection a b f = MvPolynomial.C d * f := by + obtain ⟨g, hg⟩ := hdvd + have hg0 : g ≠ 0 := by + intro hzero + apply hQ + rw [hg, hzero, mul_zero] + have hdegree0 := degreeOf_planeCurveLogarithmicDirection_le a b f 0 + have hdegree1 := degreeOf_planeCurveLogarithmicDirection_le a b f 1 + rw [hg, MvPolynomial.degreeOf_mul_eq hf hg0] at hdegree0 hdegree1 + have hgDegree0 : MvPolynomial.degreeOf 0 g = 0 := by omega + have hgDegree1 : MvPolynomial.degreeOf 1 g = 0 := by omega + let d := MvPolynomial.coeff 0 g + have hgC : g = MvPolynomial.C d := + eq_C_coeff_zero_of_degreeOf_zero g hgDegree0 hgDegree1 + refine ⟨d, ?_⟩ + rw [hg, hgC, mul_comm] + +private theorem supportDifferenceDet_cast_eq_zero_of_logWeights_eq + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + {r s t : Fin 2 →₀ ℕ} (_hr : r ∈ f.support) + (hs : s ∈ f.support) (ht : t ∈ f.support) + (c : K) + (hweights : ∀ m ∈ f.support, + (m 0 : K) - c * (m 1 : K) = + (r 0 : K) - c * (r 1 : K)) : + (planeCurveSupportDifferenceDet r s t : K) = 0 := by + have hs' := hweights s hs + have ht' := hweights t ht + dsimp only [planeCurveSupportDifferenceDet] + push_cast + linear_combination + ((t 1 : K) - (r 1 : K)) * hs' - + ((s 1 : K) - (r 1 : K)) * ht' + +private theorem logWeights_eq_of_logarithmicPDeriv_eq + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (c d : K) + (hrelation : planeCurveLogarithmicPDeriv 0 f = + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f + + MvPolynomial.C d * f) : + ∀ m ∈ f.support, + (m 0 : K) - c * (m 1 : K) = d := by + intro m hm + have hcoeff := congrArg (MvPolynomial.coeff m) hrelation + simp only [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, + coeff_planeCurveLogarithmicPDeriv] at hcoeff + have hm0 : MvPolynomial.coeff m f ≠ 0 := + MvPolynomial.mem_support_iff.mp hm + apply (mul_right_cancel₀ hm0) + linear_combination hcoeff + +theorem planeCurveSupportDifferenceDet_cast_ne_zero_of_lt_char + {K : Type*} [Field K] {p : ℕ} [CharP K p] + {r s t : Fin 2 →₀ ℕ} + (hdet : planeCurveSupportDifferenceDet r s t ≠ 0) + (hlt : (planeCurveSupportDifferenceDet r s t).natAbs < p) : + (planeCurveSupportDifferenceDet r s t : K) ≠ 0 := by + intro hzero + have hdvd : (p : ℤ) ∣ planeCurveSupportDifferenceDet r s t := + (CharP.intCast_eq_zero_iff K p _).mp hzero + have hp0 : (p : ℤ) ≠ 0 := by + intro hp + have : p = 0 := by exact_mod_cast hp + subst p + simp at hlt + have hle := Int.natAbs_le_of_dvd_ne_zero hdvd hdet + simpa using (hle.trans_lt hlt) + +/-- Rank-two support excludes a scalar logarithmic-Gauss relation in +characteristic larger than the support determinant budget. -/ +theorem no_logarithmicPDeriv_scalar_relation_of_supportRankTwo + {K : Type*} [Field K] {p : ℕ} [CharP K p] + {f : MvPolynomial (Fin 2) K} + (hrank : PlaneCurveSupportHasRankTwo f) + (hlarge : 2 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) : + ¬ ∃ c d : K, planeCurveLogarithmicPDeriv 0 f = + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f + + MvPolynomial.C d * f := by + rintro ⟨c, d, hrelation⟩ + obtain ⟨r, s, t, hr, hs, ht, hdet⟩ := hrank + have hweights := logWeights_eq_of_logarithmicPDeriv_eq c d hrelation + have hcastZero : (planeCurveSupportDifferenceDet r s t : K) = 0 := + supportDifferenceDet_cast_eq_zero_of_logWeights_eq hr hs ht c + (by + intro m hm + rw [hweights m hm, hweights r hr]) + have hdetBound := + natAbs_planeCurveSupportDifferenceDet_le_twice_bidegree hr hs ht + have hcastNe : (planeCurveSupportDifferenceDet r s t : K) ≠ 0 := + planeCurveSupportDifferenceDet_cast_ne_zero_of_lt_char hdet + (hdetBound.trans_lt hlarge) + exact hcastNe hcastZero + +/-- On an irreducible curve with rank-two support, no constant can be the +logarithmic Gauss ratio in the high-characteristic range. -/ +theorem eval_planeCurveLogarithmicDirection_ne_zero_of_supportRankTwo + {K : Type*} [Field K] {p : ℕ} [CharP K p] + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hrank : PlaneCurveSupportHasRankTwo f) + (hlarge : 2 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) + (c : K) : + letI := planeCurveCoordinateRing_isDomain hf + MvPolynomial.eval₂ (algebraMap K (PlaneCurveFunctionField f)) + (planeCurveFunction f) + (planeCurveLogarithmicDirection 1 (-c) f) ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let Q := planeCurveLogarithmicDirection 1 (-c) f + have hno := no_logarithmicPDeriv_scalar_relation_of_supportRankTwo + hrank hlarge + have hQ : Q ≠ 0 := by + intro hzero + apply hno + refine ⟨c, 0, ?_⟩ + have hzero' : planeCurveLogarithmicPDeriv 0 f - + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f = 0 := by + simpa [Q, planeCurveLogarithmicDirection, sub_eq_add_neg] using hzero + simpa using sub_eq_zero.mp hzero' + intro heval + have hquotient : planeCurveQuotientMap f Q = 0 := by + apply IsFractionRing.injective + (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + rw [map_zero] + change ((algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)).comp (planeCurveQuotientMap f)) Q = 0 + rw [← eval₂_planeCurveFunction f] + exact heval + have hdvd : f ∣ Q := + Ideal.mem_span_singleton.mp + (Ideal.Quotient.eq_zero_iff_mem.mp hquotient) + obtain ⟨d, hd⟩ := + planeCurveLogarithmicDirection_eq_C_mul_of_dvd hf.ne_zero + 1 (-c) hQ hdvd + apply hno + refine ⟨c, d, ?_⟩ + have hd' : planeCurveLogarithmicPDeriv 0 f - + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f = + MvPolynomial.C d * f := by + simpa [Q, planeCurveLogarithmicDirection, sub_eq_add_neg] using hd + calc + planeCurveLogarithmicPDeriv 0 f = + (planeCurveLogarithmicPDeriv 0 f - + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f) + + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f := by abel + _ = MvPolynomial.C d * f + + MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f := by rw [hd'] + _ = MvPolynomial.C c * planeCurveLogarithmicPDeriv 1 f + + MvPolynomial.C d * f := add_comm _ _ + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean new file mode 100644 index 0000000000..f7cb265185 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +import Mathlib.Tactic + +/-! +# Powered coordinate heights in the first-coordinate place model + +The canonical place summation uses the first-coordinate `RatFunc` model. +This module records the exact first-coordinate height and the transported +upper bound for the second-coordinate height, including positive powers. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Polynomial + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- In the first-coordinate place model, `x^m` has its expected exact +positive divisor degree. -/ +theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) = + m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + have hx0 : x ≠ 0 := by + change planeCurveFunction f 0 ≠ 0 + intro h + apply hx + rw [h] + exact isAlgebraic_zero + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change finiteExtensionPositiveDegree K L (x ^ m) = + m * MvPolynomial.degreeOf 1 f + have hxDegree : finiteExtensionPositiveDegree K L x = + MvPolynomial.degreeOf 1 f := by + have hheight := finiteExtensionPositiveDegree_polynomial + K L Polynomial.X Polynomial.X_ne_zero + have hmap : algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) Polynomial.X) = x := by + change ratFuncSpecialization x hx RatFunc.X = x + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx + rw [hmap, + finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond] at hheight + simpa using hheight + rw [finiteExtensionPositiveDegree_pow K L x hx0 m, hxDegree] + +/-- In the same first-coordinate place model, the transported second +coordinate power has height at most `n * degreeOf 0 f`. -/ +theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) + ((planeCurveFunction f 1) ^ n) ≤ + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let y : L := planeCurveFunction f 1 + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change finiteExtensionPositiveDegree K L (y ^ n) ≤ + n * MvPolynomial.degreeOf 0 f + rw [finiteExtensionPositiveDegree_pow K L y hy0 n] + exact Nat.mul_le_mul_left n + (finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_first + hf hpartialFirst hpartialSecond) + +/-- The exhaustive gcd of `1-u` and `1-v` is bounded by the powered height +of `v`, and hence by its displayed plane-curve degree budget. -/ +theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 0) ^ m) + (1 - (planeCurveFunction f 1) ^ n) ≤ + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hxTrans : Transcendental K x := hx + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro h + apply hxTrans + rw [h] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + have hxmOne : x ^ m ≠ 1 := by + intro h + apply hxTrans.pow hm + rw [h] + exact isAlgebraic_one + have hynOne : y ^ n ≠ 1 := by + intro h + apply hyTrans.pow hn + rw [h] + exact isAlgebraic_one + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change finiteExtensionGcdWeightedDegree K L (1 - x ^ m) (1 - y ^ n) ≤ + n * MvPolynomial.degreeOf 0 f + have hgcd := finiteExtensionOneSubGcd_add_outsideHeight_le_positiveDegree_coordinate + K L (x ^ m) (y ^ n) (pow_ne_zero _ hx0) (pow_ne_zero _ hy0) + hxmOne hynOne + have hv : finiteExtensionPositiveDegree K L (y ^ n) ≤ + n * MvPolynomial.degreeOf 0 f := by + simpa only [L, y] using + finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_le + hf hpartialFirst hpartialSecond n + omega + +/-- The exhaustive gcd degree is symmetric in its two arguments. -/ +theorem finiteExtensionGcdWeightedDegree_comm + {L : Type*} [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (x y : L) : + finiteExtensionGcdWeightedDegree K L x y = + finiteExtensionGcdWeightedDegree K L y x := by + classical + unfold finiteExtensionGcdWeightedDegree finiteExtensionGcdMultiplicity + finiteExtensionGcdSupport + rw [Finset.union_comm] + apply Finset.sum_congr rfl + intro w _hw + rw [min_comm] + +/-- Simultaneously changing the signs of the two functions does not change +their exhaustive gcd divisor degree. -/ +theorem finiteExtensionGcdWeightedDegree_neg_neg + {L : Type*} [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : + finiteExtensionGcdWeightedDegree K L (-x) (-y) = + finiteExtensionGcdWeightedDegree K L x y := by + classical + have hdivx : finiteExtensionPrincipalDivisor K L (-x) = + finiteExtensionPrincipalDivisor K L x := by + ext w + exact finiteExtensionPrincipalDivisor_neg_apply K L x hx w + have hdivy : finiteExtensionPrincipalDivisor K L (-y) = + finiteExtensionPrincipalDivisor K L y := by + ext w + exact finiteExtensionPrincipalDivisor_neg_apply K L y hy w + unfold finiteExtensionGcdWeightedDegree finiteExtensionGcdMultiplicity + finiteExtensionGcdSupport + rw [hdivx, hdivy] + +/-- The torsion gcd used by the endpoint is exactly the `1-u`, `1-v` gcd +used by the canonical Wronskian estimate. -/ +theorem planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n = + finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 0) ^ m) + (1 - (planeCurveFunction f 1) ^ n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hxTrans : Transcendental K x := hx + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hxm : 1 - x ^ m ≠ 0 := by + apply sub_ne_zero.mpr + intro h + apply hxTrans.pow hm + rw [← h] + exact isAlgebraic_one + have hyn : 1 - y ^ n ≠ 0 := by + apply sub_ne_zero.mpr + intro h + apply hyTrans.pow hn + rw [← h] + exact isAlgebraic_one + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + dsimp only [planeCurveExhaustiveTorsionGcdWeightedDegree] + change finiteExtensionGcdWeightedDegree K L (x ^ m - 1) (y ^ n - 1) = + finiteExtensionGcdWeightedDegree K L (1 - x ^ m) (1 - y ^ n) + rw [show x ^ m - 1 = -(1 - x ^ m) by ring, + show y ^ n - 1 = -(1 - y ^ n) by ring] + exact finiteExtensionGcdWeightedDegree_neg_neg + (K := K) (L := L) (1 - x ^ m) (1 - y ^ n) hxm hyn + +/-- With the coordinates swapped, the one-minus gcd is bounded by the exact +powered height of the first coordinate. -/ +theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_swapped_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 1) ^ n) + (1 - (planeCurveFunction f 0) ^ m) ≤ + m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hxTrans : Transcendental K x := hx + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro h + apply hxTrans + rw [h] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + have hxmOne : x ^ m ≠ 1 := by + intro h + apply hxTrans.pow hm + rw [h] + exact isAlgebraic_one + have hynOne : y ^ n ≠ 1 := by + intro h + apply hyTrans.pow hn + rw [h] + exact isAlgebraic_one + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change finiteExtensionGcdWeightedDegree K L (1 - y ^ n) (1 - x ^ m) ≤ + m * MvPolynomial.degreeOf 1 f + have hgcd := finiteExtensionOneSubGcd_add_outsideHeight_le_positiveDegree_coordinate + K L (y ^ n) (x ^ m) (pow_ne_zero _ hy0) (pow_ne_zero _ hx0) + hynOne hxmOne + have hxPower : finiteExtensionPositiveDegree K L (x ^ m) = + m * MvPolynomial.degreeOf 1 f := by + simpa only [L, x] using + finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow + hf hpartialSecond m hm + omega + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean new file mode 100644 index 0000000000..5b2452c00a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree + +/-! +# Exact source-height factorization through the powered image + +These identities are the degree bookkeeping used in the two orientations of +Corvaja--Zannier Proposition 2. The first factor is the relevant degree of +the powered-image relation and the second is the common source-to-image +index. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + + +/-- In the orientation `(u,v)=(x^m,y^n)`, the degree of the image relation in +`u` times the common source-to-image index is the source height `n d₀`. -/ +theorem poweredCoordinateImageRelation_transpose_natDegree_mul_commonIndex + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree * + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let a := (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree + calc + a * Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + a * Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) := by + rw [finrank_poweredImageOverFirst_eq_poweredImageOverSecond] + _ = Module.finrank (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := by + exact poweredCoordinateImageRelation_transpose_natDegree_mul_imageIndex + hf hpartialFirst hpartialSecond m hm n hn + _ = n * MvPolynomial.degreeOf 0 f := + finrank_over_secondPoweredCoordinate_eq hf hpartialFirst n hn + +/-- In the swapped orientation `(u,v)=(y^n,x^m)`, the degree of the image +relation in `y^n` times the same index is the source height `m d₁`. -/ +theorem poweredCoordinateImageRelation_natDegree_mul_commonIndex + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree * + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + calc + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree * + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + poweredCoordinateImageRelation_natDegree_mul_imageIndex + hf hpartialSecond m hm n + _ = m * MvPolynomial.degreeOf 1 f := + finrank_over_firstPoweredCoordinate_eq hf hpartialSecond m hm + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean new file mode 100644 index 0000000000..6e0706e285 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean @@ -0,0 +1,273 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +import Mathlib.Tactic + +/-! +# Numerical assembly of plane-curve Proposition 2 + +This module isolates the final numerical use of the powered-image relation. +The geometric Wronskian estimate is supplied pointwise; the remaining degree, +index, and trivial-gcd bookkeeping is discharged here in both coordinate +orientations. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + +private theorem propositionTwoAuxiliaryBound_of_zero_parameter + (A B Chi h k : ℕ) (G : ℝ) (hG : G ≤ (A : ℝ)) + (hn : 0 < h * k + h + k) (hzero : h = 0 ∨ k = 0) : + G ≤ + (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (A : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (B : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (Chi : ℝ) := by + rcases hzero with rfl | rfl + · have hk : 0 < k := by simpa using hn + have hk0 : (k : ℝ) ≠ 0 := by exact_mod_cast hk.ne' + have heuler : 0 ≤ (((k : ℝ) - 1) / 2) * (Chi : ℝ) := by + have hkOne : (1 : ℝ) ≤ (k : ℝ) := by exact_mod_cast hk + positivity + norm_num [hk0] + have hA0 : 0 ≤ (A : ℝ) := Nat.cast_nonneg A + have hB0 : 0 ≤ (B : ℝ) := Nat.cast_nonneg B + linarith + · have hh : 0 < h := by simpa using hn + have hh0 : (h : ℝ) ≠ 0 := by exact_mod_cast hh.ne' + have heuler : 0 ≤ (((h : ℝ) - 1) / 2) * (Chi : ℝ) := by + have hhOne : (1 : ℝ) ≤ (h : ℝ) := by exact_mod_cast hh + positivity + norm_num [hh0] + linarith + +/-- Proposition 2 in the orientation `(u,v)=(x^m,y^n)`. -/ +theorem planeCurvePropositionTwo_natural_of_auxiliaryBounds + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n p Chi : ℕ) (hm : 0 < m) (hn : 0 < n) + (hindex : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ Chi) + (hauxiliary : ∀ h k : ℕ, 0 < h → 0 < k → + PropositionTwoParametersAreAdmissible + (n * MvPolynomial.degreeOf 0 f) + (m * MvPolynomial.degreeOf 1 f) p h k → + ¬ ((transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree ≤ k ∧ + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree ≤ h) → + letI := planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + (finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 0) ^ m) + (1 - (planeCurveFunction f 1) ^ n) : ℝ) ≤ + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * + (n * MvPolynomial.degreeOf 0 f : ℕ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * + (m * MvPolynomial.degreeOf 1 f : ℕ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (Chi : ℝ)) : + PropositionTwoNumericalAlternatives + (n * MvPolynomial.degreeOf 0 f) + (m * MvPolynomial.degreeOf 1 f) p Chi + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let a := (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree + let b := (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree + let d := Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) + let A := n * MvPolynomial.degreeOf 0 f + let B := m * MvPolynomial.degreeOf 1 f + have ha : 0 < a := by + dsimp only [a] + exact poweredCoordinateImageRelation_transpose_natDegree_pos + hf hpartialFirst hpartialSecond m hm n hn + have hb : 0 < b := by + dsimp only [b] + exact poweredCoordinateImageRelation_natDegree_pos + hf hpartialSecond m hm n + have hfactor : a * d = A := by + simpa only [a, d, A] using + poweredCoordinateImageRelation_transpose_natDegree_mul_commonIndex + hf hpartialFirst hpartialSecond m n hm hn + have hA : A ≤ d * a := by + rw [Nat.mul_comm, hfactor] + have hdChi : d ≤ Chi := by + simpa only [d] using hindex + have hGnat : planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n ≤ A := by + rw [planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub + hf hpartialFirst hpartialSecond m n hm hn] + exact finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_le + hf hpartialFirst hpartialSecond m n hm hn + have hG : (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) ≤ (A : ℝ) := by + exact_mod_cast hGnat + apply propositionTwoNumericalAlternatives_of_scaledAuxiliaryDegreeAlternative + a b d A B p Chi + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) + ha hb hA hdChi hG + intro h k hadmissible + by_cases hdegree : a ≤ k ∧ b ≤ h + · exact Or.inl hdegree + · right + by_cases hh : h = 0 + · exact propositionTwoAuxiliaryBound_of_zero_parameter + A B Chi h k + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) hG hadmissible.1 (Or.inl hh) + by_cases hk : k = 0 + · exact propositionTwoAuxiliaryBound_of_zero_parameter + A B Chi h k + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) hG hadmissible.1 (Or.inr hk) + simpa only [a, b, A, B, + planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub + hf hpartialFirst hpartialSecond m n hm hn] using + hauxiliary h k (Nat.pos_of_ne_zero hh) (Nat.pos_of_ne_zero hk) + (by simpa only [A, B] using hadmissible) + (by simpa only [a, b] using hdegree) + +/-- Proposition 2 in the swapped orientation `(u,v)=(y^n,x^m)`. -/ +theorem planeCurvePropositionTwo_swapped_of_auxiliaryBounds + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n p Chi : ℕ) (hm : 0 < m) (hn : 0 < n) + (hindex : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ Chi) + (hauxiliary : ∀ h k : ℕ, 0 < h → 0 < k → + PropositionTwoParametersAreAdmissible + (m * MvPolynomial.degreeOf 1 f) + (n * MvPolynomial.degreeOf 0 f) p h k → + ¬ ((poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree ≤ k ∧ + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree ≤ h) → + letI := planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + (finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (1 - (planeCurveFunction f 1) ^ n) + (1 - (planeCurveFunction f 0) ^ m) : ℝ) ≤ + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * + (m * MvPolynomial.degreeOf 1 f : ℕ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * + (n * MvPolynomial.degreeOf 0 f : ℕ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (Chi : ℝ)) : + PropositionTwoNumericalAlternatives + (m * MvPolynomial.degreeOf 1 f) + (n * MvPolynomial.degreeOf 0 f) p Chi + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let a := (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree + let b := (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree + let d := Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) + let A := m * MvPolynomial.degreeOf 1 f + let B := n * MvPolynomial.degreeOf 0 f + have ha : 0 < a := by + dsimp only [a] + exact poweredCoordinateImageRelation_natDegree_pos + hf hpartialSecond m hm n + have hb : 0 < b := by + dsimp only [b] + exact poweredCoordinateImageRelation_transpose_natDegree_pos + hf hpartialFirst hpartialSecond m hm n hn + have hfactor : a * d = A := by + simpa only [a, d, A] using + poweredCoordinateImageRelation_natDegree_mul_commonIndex + hf hpartialSecond m n hm + have hA : A ≤ d * a := by + rw [Nat.mul_comm, hfactor] + have hdChi : d ≤ Chi := by + simpa only [d] using hindex + have hGnat : planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n ≤ A := by + rw [planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub + hf hpartialFirst hpartialSecond m n hm hn] + rw [finiteExtensionGcdWeightedDegree_comm] + exact finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_swapped_le + hf hpartialFirst hpartialSecond m n hm hn + have hG : (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) ≤ (A : ℝ) := by + exact_mod_cast hGnat + apply propositionTwoNumericalAlternatives_of_scaledAuxiliaryDegreeAlternative + a b d A B p Chi + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) + ha hb hA hdChi hG + intro h k hadmissible + by_cases hdegree : a ≤ k ∧ b ≤ h + · exact Or.inl hdegree + · right + by_cases hh : h = 0 + · exact propositionTwoAuxiliaryBound_of_zero_parameter + A B Chi h k + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) hG hadmissible.1 (Or.inl hh) + by_cases hk : k = 0 + · exact propositionTwoAuxiliaryBound_of_zero_parameter + A B Chi h k + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) hG hadmissible.1 (Or.inr hk) + have hbound := hauxiliary h k (Nat.pos_of_ne_zero hh) (Nat.pos_of_ne_zero hk) + (by simpa only [A, B] using hadmissible) + (by simpa only [a, b] using hdegree) + rw [planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub + hf hpartialFirst hpartialSecond m n hm hn] + rw [finiteExtensionGcdWeightedDegree_comm] + simpa only [A, B] using hbound + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean new file mode 100644 index 0000000000..2214cb0782 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean @@ -0,0 +1,244 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +import Mathlib.Tactic + +/-! +# From actual plane-curve degrees to the public Proposition 2 certificate + +The canonical divisor argument naturally computes with the actual coordinate +degrees `degreeOf 0 f` and `degreeOf 1 f`. The public theorem instead accepts +arbitrary declared bidegree bounds. This file performs that last change of +degree data without asserting the false monotonicity of Proposition 2's degree +alternative. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The actual lower powered-coordinate degree is bounded by the lower degree +built from any declared bidegree bounds. -/ +theorem planeCurveTorsionLowerDegree_actual_le_public + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) : + planeCurveTorsionLowerDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder ≤ + planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder := by + unfold planeCurveTorsionLowerDegree + exact min_le_min + (Nat.mul_le_mul_left secondOrder + (degreeOf_first_le_of_hasBidegreeAtMost hbidegree)) + (Nat.mul_le_mul_left firstOrder + (degreeOf_second_le_of_hasBidegreeAtMost hbidegree)) + +/-- The actual upper powered-coordinate degree is bounded by the upper degree +built from any declared bidegree bounds. -/ +theorem planeCurveTorsionUpperDegree_actual_le_public + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) : + planeCurveTorsionUpperDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder ≤ + planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder := by + unfold planeCurveTorsionUpperDegree + exact max_le_max + (Nat.mul_le_mul_left secondOrder + (degreeOf_first_le_of_hasBidegreeAtMost hbidegree)) + (Nat.mul_le_mul_left firstOrder + (degreeOf_second_le_of_hasBidegreeAtMost hbidegree)) + +/-- The actual bidegree Euler budget is bounded by the public one. -/ +theorem planeCurve_actualEulerBudget_le_public + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (firstDegree secondDegree : ℕ) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) : + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f ≤ + 2 * firstDegree * secondDegree := by + exact Nat.mul_le_mul + (Nat.mul_le_mul_left 2 + (degreeOf_first_le_of_hasBidegreeAtMost hbidegree)) + (degreeOf_second_le_of_hasBidegreeAtMost hbidegree) + +/-- Proposition 2 at the actual coordinate degrees supplies the public +certificate at arbitrary declared bidegree bounds. + +The actual Proposition 2 input is allowed to bound the exhaustive gcd degree. +The certificate itself uses the torsion-point cardinality. It is below that +gcd degree, has the required trivial bound at the actual degrees, and can +therefore be transported to the larger public degrees by +`propositionTwoNumericalAlternatives_mono_degreeBounds`. -/ +theorem planeCurvePropositionTwoCertificate_of_actualDegree_exhaustiveGcd + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} + (p firstDegree secondDegree firstOrder secondOrder : ℕ) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hbidegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (hfirstDegree : 0 < firstDegree) + (hsecondDegree : 0 < secondDegree) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (hpropositionTwoActual : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder) + (planeCurveTorsionUpperDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder) + p (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder : ℝ)) : + PlaneCurvePropositionTwoCertificate + p K f firstDegree secondDegree firstOrder secondOrder := by + let actualLower : ℕ := planeCurveTorsionLowerDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder + let actualUpper : ℕ := planeCurveTorsionUpperDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder + let publicLower : ℕ := planeCurveTorsionLowerDegree + firstDegree secondDegree firstOrder secondOrder + let publicUpper : ℕ := planeCurveTorsionUpperDegree + firstDegree secondDegree firstOrder secondOrder + let actualChi : ℕ := + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f + let publicChi : ℕ := 2 * firstDegree * secondDegree + let card : ℕ := + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card + let gcdDegree : ℕ := planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder + have hfirstActual : 0 < MvPolynomial.degreeOf 0 f := + degreeOf_first_pos_of_pderiv_ne_zero hcurve.2.2.1 + have hsecondActual : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hcurve.2.2.2 + have hactualLowerPos : 0 < actualLower := by + dsimp only [actualLower, planeCurveTorsionLowerDegree] + exact lt_min (Nat.mul_pos hsecondOrder hfirstActual) + (Nat.mul_pos hfirstOrder hsecondActual) + have hactualUpperPos : 0 < actualUpper := by + dsimp only [actualUpper, planeCurveTorsionUpperDegree] + exact lt_of_lt_of_le + (Nat.mul_pos hsecondOrder hfirstActual) (le_max_left _ _) + have hactualLowerPublic : actualLower ≤ publicLower := by + exact planeCurveTorsionLowerDegree_actual_le_public + firstDegree secondDegree firstOrder secondOrder hbidegree + have hactualUpperPublic : actualUpper ≤ publicUpper := by + exact planeCurveTorsionUpperDegree_actual_le_public + firstDegree secondDegree firstOrder secondOrder hbidegree + have hactualChiPublic : actualChi ≤ publicChi := by + exact planeCurve_actualEulerBudget_le_public + firstDegree secondDegree hbidegree + have hpublicChiPos : 0 < publicChi := by + dsimp only [publicChi] + positivity + have hcardActualTrivial : card ≤ actualLower := by + dsimp only [card, actualLower, planeCurveTorsionLowerDegree] + simpa only [min_comm] using + torusCurveTorsionIntersection_card_le_min_bidegree_order + f (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder (hasBidegreeAtMost_degreeOf f) hcurve + hfirstOrder hsecondOrder + have hcardGcd : card ≤ gcdDegree := by + dsimp only [card, gcdDegree] + rw [torusCurveTorsionIntersection_card_eq_torsionPoint_card] + exact torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder + hfirstNonzero hsecondNonzero + have hpropositionTwoCardActual : PropositionTwoNumericalAlternatives + actualLower actualUpper p actualChi (card : ℝ) := by + apply propositionTwoNumericalAlternatives_mono + (G := (card : ℝ)) (H := (gcdDegree : ℝ)) + · exact_mod_cast hcardGcd + · simpa only [actualLower, actualUpper, actualChi, gcdDegree] using + hpropositionTwoActual + have hpropositionTwoCardPublic : PropositionTwoNumericalAlternatives + publicLower publicUpper p publicChi (card : ℝ) := by + exact propositionTwoNumericalAlternatives_mono_degreeBounds + actualLower actualUpper publicLower publicUpper p actualChi publicChi + (card : ℝ) hactualLowerPos hactualUpperPos + hactualLowerPublic hactualUpperPublic hactualChiPublic hpublicChiPos + (by exact_mod_cast hcardActualTrivial) hpropositionTwoCardActual + refine ⟨(card : ℝ), le_rfl, ?_, ?_⟩ + · exact_mod_cast hcardActualTrivial.trans hactualLowerPublic + · simpa only [publicLower, publicUpper, publicChi] using + hpropositionTwoCardPublic + +/-- Pointwise Proposition 2 at the actual source-coordinate heights assembles +the exact universal certificate proposition expected by the public endpoint. + +This theorem is intentionally a composition boundary, not a replacement for +the geometric proof: its hypothesis still asks for the actual-height +Proposition 2 estimate for the exhaustive gcd divisor. -/ +theorem generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange_of_actualDegree + (hactual : ∀ (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (_hfirstDegree : 0 < firstDegree) + (_hsecondDegree : 0 < secondDegree) + (_hbidegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (_hfirstOrder : 0 < firstOrder) + (_hsecondOrder : 0 < secondOrder) + (_hfirstPrimeToChar : ¬ p ∣ firstOrder) + (_hsecondPrimeToChar : ¬ p ∣ secondOrder) + (_hlarge : 12 * firstDegree * secondDegree < p), + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hcurve.1 + PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder) + (planeCurveTorsionUpperDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) + firstOrder secondOrder) + p (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hcurve.2.2.2 + firstOrder secondOrder : ℝ)) : + GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange := by + unfold GeneralPlaneCurvePropositionTwoCertificatesAboveElementaryRange + intro p _ K _ _ _ _ f firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar hlarge + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have hnonzero : + planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0 ∧ + planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0 := + poweredTorsionFunctions_ne_zero_of_isCorvajaZannierPlaneCurve + hcurve firstOrder secondOrder hfirstOrder hsecondOrder + apply planeCurvePropositionTwoCertificate_of_actualDegree_exhaustiveGcd + p firstDegree secondDegree firstOrder secondOrder hf hcurve.2.2.2 + hbidegree hcurve hfirstDegree hsecondDegree hfirstOrder hsecondOrder + hnonzero.1 hnonzero.2 + simpa only [hf] using hactual p (K := K) f + firstDegree secondDegree firstOrder secondOrder + hfirstDegree hsecondDegree hbidegree hcurve hfirstOrder hsecondOrder + hfirstPrimeToChar hsecondPrimeToChar hlarge + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean new file mode 100644 index 0000000000..849619f818 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped + +/-! +# Geometric Proposition 2 for a plane curve + +The powered-image linear-independence theorem and the canonical global +Wronskian estimate are assembled here. The source-to-image index remains an +explicit premise of the two orientation lemmas; the following endpoint module +discharges it from the non-subtorus hypothesis. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + + +/-- The natural orientation `(u,v)=(x^m,y^n)` of the geometric Proposition 2 +argument. -/ +theorem planeCurvePropositionTwo_natural_of_poweredImageIndexBound + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hnPrime : ¬ p ∣ n) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (hindex : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : + PropositionTwoNumericalAlternatives + (n * MvPolynomial.degreeOf 0 f) + (m * MvPolynomial.degreeOf 1 f) p + (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let Chi := 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f + apply planeCurvePropositionTwo_natural_of_auxiliaryBounds + hf hpartialFirst hpartialSecond m n p Chi hm hn hindex + intro h k hh hk hadmissible hexcluded + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n + let g := poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n + have hbidegree := poweredCoordinateImageRelation_bidegree_le + hf hpartialFirst hpartialSecond m hm n hn + have hdegreeG : g.natDegree ≤ n * MvPolynomial.degreeOf 0 f := by + dsimp only [g] + rw [poweredCoordinateFrobeniusImageRelation_natDegree] + exact hbidegree.2 + have hdegreeTranspose : (transposeBivariate g).natDegree ≤ + m * MvPolynomial.degreeOf 1 f := by + dsimp only [g] + rw [transposeBivariate_poweredCoordinateFrobeniusImageRelation_natDegree] + exact hbidegree.1 + have hsize : g.natDegree * h + (transposeBivariate g).natDegree * k < p := by + apply lt_of_le_of_lt _ hadmissible.2 + exact Nat.add_le_add + (Nat.mul_le_mul_right h hdegreeG) + (Nat.mul_le_mul_right k hdegreeTranspose) + have hexcludedG : ¬ (g.natDegree ≤ k ∧ + (transposeBivariate g).natDegree ≤ h) := by + dsimp only [g, gK] at hexcluded ⊢ + rw [poweredCoordinateFrobeniusImageRelation_natDegree, + transposeBivariate_poweredCoordinateFrobeniusImageRelation_natDegree] + exact hexcluded + have hLI := + poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent + (p := p) habsolute hf hpartialFirst hpartialSecond + m n hm hnPrime h k hh hk hsize hexcludedG + have hEuler := + planeCurve_canonicalDifferent_add_propositionTwoExceptional_weightedDegree_le + hf hpartialFirst hpartialSecond hcardK m n hm hn + exact finiteExtensionGcdBound_planeCurvePowers_of_auxiliaryFamily_linearIndependent + (p := p) hf hpartialFirst hpartialSecond m n hm hn + h k hadmissible.1 Chi hLI hEuler + +/-- The swapped orientation `(u,v)=(y^n,x^m)` of the geometric Proposition 2 +argument. -/ +theorem planeCurvePropositionTwo_swapped_of_poweredImageIndexBound + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (hindex : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : + PropositionTwoNumericalAlternatives + (m * MvPolynomial.degreeOf 1 f) + (n * MvPolynomial.degreeOf 0 f) p + (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let Chi := 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f + apply planeCurvePropositionTwo_swapped_of_auxiliaryBounds + hf hpartialFirst hpartialSecond m n p Chi hm hn hindex + intro h k hh hk hadmissible hexcluded + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n + let g : Polynomial (Polynomial F) := gK.map (Polynomial.mapRingHom ι) + have hι : Function.Injective ι := + perfectConstantsToFrobeniusSubfield_injective + (K := K) (L := L) (p := p) + have hmap : Function.Injective (Polynomial.mapRingHom ι) := + Polynomial.map_injective ι hι + have hdegreeG : g.natDegree = gK.natDegree := by + dsimp only [g] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have hdegreeTranspose : (transposeBivariate g).natDegree = + (transposeBivariate gK).natDegree := by + dsimp only [g] + rw [transposeBivariate_map] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have hbidegree := poweredCoordinateImageRelation_bidegree_le + hf hpartialFirst hpartialSecond m hm n hn + have hsize : g.natDegree * h + (transposeBivariate g).natDegree * k < p := by + apply lt_of_le_of_lt _ hadmissible.2 + rw [hdegreeG, hdegreeTranspose] + exact Nat.add_le_add + (Nat.mul_le_mul_right h hbidegree.1) + (Nat.mul_le_mul_right k hbidegree.2) + have hexcludedG : ¬ (g.natDegree ≤ k ∧ + (transposeBivariate g).natDegree ≤ h) := by + rw [hdegreeG, hdegreeTranspose] + exact hexcluded + have hLI := + poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent_swapped + (p := p) habsolute hf hpartialFirst hpartialSecond + m n hm hn hmPrime h k hh hk hsize hexcludedG + have hEulerNatural := + planeCurve_canonicalDifferent_add_propositionTwoExceptional_weightedDegree_le + hf hpartialFirst hpartialSecond hcardK m n hm hn + exact finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_linearIndependent + (p := p) hf hpartialFirst hpartialSecond m n hm hn + h k hadmissible.1 Chi hLI (by + simpa only [propositionTwoExceptionalPlaces, Finset.union_comm] using + hEulerNatural) + +/-- The two orientations combine to the actual minimum/maximum degree form +needed by the plane-curve endpoint. -/ +theorem planeCurvePropositionTwo_of_poweredImageIndexBound + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) + (hlarge : 12 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p) + (hindex : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : + PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) m n) + (planeCurveTorsionUpperDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) m n) + p (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n : ℝ) := by + have hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K := + planeCurve_degreeOf_second_lt_card_of_twelve_mul_degrees_lt_char + hpartialFirst hpartialSecond hlarge + by_cases horient : n * MvPolynomial.degreeOf 0 f ≤ + m * MvPolynomial.degreeOf 1 f + · have hnatural := planeCurvePropositionTwo_natural_of_poweredImageIndexBound + (p := p) hf habsolute hpartialFirst hpartialSecond + m n hm hn hnPrime hcardK hindex + simpa only [planeCurveTorsionLowerDegree, planeCurveTorsionUpperDegree, + min_eq_left horient, max_eq_right horient] using hnatural + · have horient' : m * MvPolynomial.degreeOf 1 f ≤ + n * MvPolynomial.degreeOf 0 f := Nat.le_of_lt (lt_of_not_ge horient) + have hswapped := planeCurvePropositionTwo_swapped_of_poweredImageIndexBound + (p := p) hf habsolute hpartialFirst hpartialSecond + m n hm hn hmPrime hcardK hindex + simpa only [planeCurveTorsionLowerDegree, planeCurveTorsionUpperDegree, + min_eq_right horient', max_eq_left horient'] using hswapped + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean new file mode 100644 index 0000000000..5780a53504 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability + +/-! +# A rational-function-field model for a plane curve + +The first coordinate of an irreducible plane curve with nonzero second +partial derivative is separating and transcendental. This file uses that +coordinate to put the function field over the standard field `K(X)`. It +then transports finiteness, separability, and the exact extension degree from +the intrinsic first-coordinate subfield. + +This is the model required by the exhaustive finite-plus-infinity divisor +formalization: its base is literally `RatFunc K`, and `X` specializes to the +first coordinate function. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The `RatFunc K`-algebra structure obtained by specializing `X` at the +first coordinate of the plane curve. -/ +@[reducible] noncomputable def planeCurveFirstCoordinateRatFuncAlgebra + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hx : Transcendental K (planeCurveFunction f 0)) : + Algebra (RatFunc K) (PlaneCurveFunctionField f) := + (ratFuncSpecialization (planeCurveFunction f 0) hx).toAlgebra + +@[simp] theorem planeCurveFirstCoordinateRatFuncAlgebra_algebraMap_apply + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hx : Transcendental K (planeCurveFunction f 0)) (z : RatFunc K) : + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + algebraMap (RatFunc K) (PlaneCurveFunctionField f) z = + ratFuncSpecialization (planeCurveFunction f 0) hx z := + rfl + +@[simp] theorem planeCurveFirstCoordinateRatFuncAlgebra_X + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hx : Transcendental K (planeCurveFunction f 0)) : + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + algebraMap (RatFunc K) (PlaneCurveFunctionField f) RatFunc.X = + planeCurveFunction f 0 := by + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + change ratFuncSpecialization (planeCurveFunction f 0) hx RatFunc.X = _ + simp [ratFuncSpecialization, RatFunc.algEquivOfTranscendental_X] + +private theorem planeCurve_firstCoordinate_changeBase_commutes + {f : MvPolynomial (Fin 2) K} [IsDomain (PlaneCurveCoordinateRing f)] + (hx : Transcendental K (planeCurveFunction f 0)) : + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + (algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 0) hx).symm.toRingEquiv.toRingHom = + (RingEquiv.refl (PlaneCurveFunctionField f)).toRingHom.comp + (algebraMap (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f)) := by + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + ext z + simp [ratFuncSpecialization] + +/-- The plane-curve function field is finite over the standard rational +function field when `X` is specialized to the first coordinate. -/ +theorem finiteDimensional_planeCurveFunctionField_over_ratFunc + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).1 + exact Module.Finite.of_equiv_equiv + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 0) hx).symm.toRingEquiv + (RingEquiv.refl (PlaneCurveFunctionField f)) + (planeCurve_firstCoordinate_changeBase_commutes hx) + +/-- The same change of base transports separability. -/ +theorem separable_planeCurveFunctionField_over_ratFunc + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + exact Algebra.IsSeparable.of_equiv_equiv + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 0) hx).symm.toRingEquiv + (RingEquiv.refl (PlaneCurveFunctionField f)) + (planeCurve_firstCoordinate_changeBase_commutes hx) + +/-- The extension degree over `K(X)` is exactly the degree of the equation in +the second coordinate. -/ +theorem finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + calc + Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = + Module.finrank (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (Algebra.finrank_eq_of_equiv_equiv + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 0) hx).symm.toRingEquiv + (RingEquiv.refl (PlaneCurveFunctionField f)) + (planeCurve_firstCoordinate_changeBase_commutes hx)).symm + _ = MvPolynomial.degreeOf 1 f := + finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible + hf hpartialSecond + +/-! ## The symmetric second-coordinate model -/ + +/-- The `RatFunc K`-algebra structure obtained by specializing `X` at the +second coordinate of the plane curve. -/ +@[reducible] noncomputable def planeCurveSecondCoordinateRatFuncAlgebra + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hy : Transcendental K (planeCurveFunction f 1)) : + Algebra (RatFunc K) (PlaneCurveFunctionField f) := + (ratFuncSpecialization (planeCurveFunction f 1) hy).toAlgebra + +@[simp] theorem planeCurveSecondCoordinateRatFuncAlgebra_X + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hy : Transcendental K (planeCurveFunction f 1)) : + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + algebraMap (RatFunc K) (PlaneCurveFunctionField f) RatFunc.X = + planeCurveFunction f 1 := by + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + change ratFuncSpecialization (planeCurveFunction f 1) hy RatFunc.X = _ + simp [ratFuncSpecialization, RatFunc.algEquivOfTranscendental_X] + +private theorem planeCurve_secondCoordinate_changeBase_commutes + {f : MvPolynomial (Fin 2) K} [IsDomain (PlaneCurveCoordinateRing f)] + (hy : Transcendental K (planeCurveFunction f 1)) : + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + (algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 1) hy).symm.toRingEquiv.toRingHom = + (RingEquiv.refl (PlaneCurveFunctionField f)).toRingHom.comp + (algebraMap (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f)) := by + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + ext z + change ratFuncSpecialization (planeCurveFunction f 1) hy + ((RatFunc.algEquivOfTranscendental + (planeCurveFunction f 1) hy).symm z) = + algebraMap (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) z + exact DFunLike.congr_fun + (ratFuncSpecialization_comp_symm_algEquiv + (planeCurveFunction f 1) hy) z + +/-- The second-coordinate specialization also makes the plane-curve function +field finite over the standard rational-function field. -/ +theorem finiteDimensional_planeCurveFunctionField_over_secondRatFunc + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveSecondCoordinateRatFuncAlgebra f hy + letI : FiniteDimensional (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).1 + exact Module.Finite.of_equiv_equiv + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 1) hy).symm.toRingEquiv + (RingEquiv.refl (PlaneCurveFunctionField f)) + (planeCurve_secondCoordinate_changeBase_commutes hy) + +/-- The second-coordinate change of base transports separability. -/ +theorem separable_planeCurveFunctionField_over_secondRatFunc + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveSecondCoordinateRatFuncAlgebra f hy + letI : Algebra.IsSeparable (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).2 + exact Algebra.IsSeparable.of_equiv_equiv + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 1) hy).symm.toRingEquiv + (RingEquiv.refl (PlaneCurveFunctionField f)) + (planeCurve_secondCoordinate_changeBase_commutes hy) + +/-- In the second-coordinate model the extension degree is exactly the degree +of the equation in the first coordinate. -/ +theorem finrank_planeCurveFunctionField_over_secondRatFunc_eq_degreeOf_first + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = + MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hy := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveSecondCoordinateRatFuncAlgebra f hy + calc + Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = + Module.finrank (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (Algebra.finrank_eq_of_equiv_equiv + (RatFunc.algEquivOfTranscendental + (planeCurveFunction f 1) hy).symm.toRingEquiv + (RingEquiv.refl (PlaneCurveFunctionField f)) + (planeCurve_secondCoordinate_changeBase_commutes hy)).symm + _ = MvPolynomial.degreeOf 0 f := + finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible + hf hpartialFirst + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean new file mode 100644 index 0000000000..e27414cc63 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean @@ -0,0 +1,825 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +import Mathlib.FieldTheory.Separable +import Mathlib.FieldTheory.SeparableDegree +import Mathlib.RingTheory.Polynomial.GaussLemma +import Mathlib.RingTheory.AlgebraicIndependent.Adjoin + +/-! +# Separability of a plane-curve coordinate extension + +For an irreducible plane equation whose partial derivative in the second coordinate is nonzero, +this file proves that the function field is a finite separable extension of the field generated by +the first coordinate. The proof passes through the iterated-polynomial presentation and Gauss's +lemma. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +private theorem derivative_optionEquivLeft + {σ : Type*} (p : MvPolynomial (Option σ) K) : + (MvPolynomial.optionEquivLeft K σ p).derivative = + MvPolynomial.optionEquivLeft K σ (MvPolynomial.pderiv none p) := by + classical + induction p using MvPolynomial.induction_on with + | C a => simp + | add p q hp hq => simp [hp, hq] + | mul_X p i hp => + cases i <;> simp_all [MvPolynomial.pderiv_X, mul_comm] + +/-- The iterated-polynomial presentation of an irreducible bivariate polynomial is irreducible. -/ +theorem polynomialInSecondCoordinate_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : + Irreducible (polynomialInSecondCoordinate f) := by + let e := Equiv.optionSubtypeNe (1 : Fin 2) + have hrename : Irreducible (MvPolynomial.rename e.symm f) := by + change Irreducible ((MvPolynomial.renameEquiv K e.symm) f) + exact hf.map (MvPolynomial.renameEquiv K e.symm).toMulEquiv + exact hrename.map (MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 1}).toMulEquiv + +/-- Ordinary differentiation of the iterated-polynomial presentation agrees with taking the +partial derivative in the second affine coordinate. -/ +theorem derivative_polynomialInSecondCoordinate + (f : MvPolynomial (Fin 2) K) : + (polynomialInSecondCoordinate f).derivative = + polynomialInSecondCoordinate (MvPolynomial.pderiv 1 f) := by + let e := Equiv.optionSubtypeNe (1 : Fin 2) + rw [polynomialInSecondCoordinate, polynomialInSecondCoordinate, + derivative_optionEquivLeft] + congr 1 + simpa [e] using MvPolynomial.pderiv_rename e.symm.injective (1 : Fin 2) f + +/-- A nonzero second-coordinate partial derivative remains nonzero after rewriting the equation +as a polynomial in the second coordinate over the first-coordinate polynomial ring. -/ +theorem derivative_polynomialInSecondCoordinate_ne_zero + {f : MvPolynomial (Fin 2) K} (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + (polynomialInSecondCoordinate f).derivative ≠ 0 := by + rw [derivative_polynomialInSecondCoordinate] + exact polynomialInSecondCoordinate_ne_zero hderiv + +/-- The fraction field of the polynomial coefficient ring in the remaining affine coordinate is +the intermediate field generated by the first coordinate function. -/ +def firstCoordinateFractionEquiv + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (htrans : Transcendental K (planeCurveFunction f 0)) : + FractionRing (MvPolynomial {i : Fin 2 // i ≠ 1} K) ≃ₐ[K] + FirstCoordinateSubfield f := by + let remaining := {i : Fin 2 // i ≠ 1} + have remaining_value_zero (i : remaining) : i.1 = 0 := by omega + letI : Subsingleton remaining := + ⟨fun i j => Subtype.ext ((remaining_value_zero i).trans (remaining_value_zero j).symm)⟩ + let i0 : remaining := ⟨0, by decide⟩ + have hIndependent : AlgebraicIndependent K + (fun _ : remaining => planeCurveFunction f 0) := by + rw [algebraicIndependent_singleton_iff i0] + exact htrans + have hrange : Set.range (fun _ : remaining => planeCurveFunction f 0) = + ({planeCurveFunction f 0} : Set (PlaneCurveFunctionField f)) := by + ext z + constructor + · rintro ⟨i, rfl⟩ + simp + · intro hz + rw [Set.mem_singleton_iff] at hz + subst z + exact ⟨i0, rfl⟩ + have hfield : + IntermediateField.adjoin K + (Set.range (fun _ : remaining => planeCurveFunction f 0)) = + FirstCoordinateSubfield f := by + rw [hrange] + exact hIndependent.aevalEquivField.trans (IntermediateField.equivOfEq hfield) + +/-- The fraction-field equivalence extends the coefficient evaluation homomorphism. -/ +@[simp] +theorem firstCoordinateFractionEquiv_algebraMap + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (htrans : Transcendental K (planeCurveFunction f 0)) + (p : MvPolynomial {i : Fin 2 // i ≠ 1} K) : + firstCoordinateFractionEquiv f htrans + (algebraMap (MvPolynomial {i : Fin 2 // i ≠ 1} K) + (FractionRing (MvPolynomial {i : Fin 2 // i ≠ 1} K)) p) = + firstCoordinateCoefficientEval f p := by + apply Subtype.ext + · simp [firstCoordinateFractionEquiv, firstCoordinateCoefficientEval, + firstCoordinateInSubfield] + simpa [MvPolynomial.aeval_def, firstCoordinateInSubfield] using + (MvPolynomial.hom_eval₂ p + (algebraMap K (FirstCoordinateSubfield f)) + (FirstCoordinateSubfield f).val.toRingHom + (fun _ => firstCoordinateInSubfield f)).symm + +/-- An irreducible plane equation with nonzero second partial derivative stays irreducible after +passing to the field generated by the first coordinate and viewing it as a polynomial in the +second coordinate. -/ +theorem polynomialOverFirstCoordinate_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Irreducible (polynomialOverFirstCoordinate f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let R := MvPolynomial {i : Fin 2 // i ≠ 1} K + let F := FractionRing R + let p := polynomialInSecondCoordinate f + have hsecond : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hderiv + have htrans : Transcendental K (planeCurveFunction f 0) := + firstCoordinate_transcendental hf hsecond + have hpIrreducible : Irreducible p := polynomialInSecondCoordinate_irreducible hf + have hpDerivative : p.derivative ≠ 0 := + derivative_polynomialInSecondCoordinate_ne_zero hderiv + have hpDegree : p.natDegree ≠ 0 := by + intro hdegree + exact hpDerivative (Polynomial.derivative_of_natDegree_zero hdegree) + have hpPrimitive : p.IsPrimitive := hpIrreducible.isPrimitive hpDegree + have hFractionIrreducible : + Irreducible (p.map (algebraMap R F)) := + (hpPrimitive.irreducible_iff_irreducible_map_fraction_map (K := F)).mp hpIrreducible + let e := firstCoordinateFractionEquiv f htrans + have hMappedIrreducible : + Irreducible ((p.map (algebraMap R F)).map e.toRingHom) := + hFractionIrreducible.map (Polynomial.mapEquiv e.toRingEquiv).toMulEquiv + have hmap : e.toRingHom.comp (algebraMap R F) = firstCoordinateCoefficientEval f := by + apply DFunLike.ext _ _ + intro q + exact firstCoordinateFractionEquiv_algebraMap f htrans q + rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate] + simpa only [Polynomial.map_map, hmap] using hMappedIrreducible + +/-- The ordinary derivative of the specialized plane equation is nonzero. -/ +theorem derivative_polynomialOverFirstCoordinate_ne_zero + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (polynomialOverFirstCoordinate f).derivative ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate, + Polynomial.derivative_map] + exact (Polynomial.map_ne_zero_iff + (firstCoordinateCoefficientEval_injective hf + (degreeOf_second_pos_of_pderiv_ne_zero hderiv))).mpr + (derivative_polynomialInSecondCoordinate_ne_zero hderiv) + +/-- The specialized defining polynomial over the first-coordinate field is separable. -/ +theorem polynomialOverFirstCoordinate_separable + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (polynomialOverFirstCoordinate f).Separable := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + exact (Polynomial.separable_iff_derivative_ne_zero + (polynomialOverFirstCoordinate_irreducible hf hderiv)).mpr + (derivative_polynomialOverFirstCoordinate_ne_zero hf hderiv) + +/-- The second coordinate function is separable over the field generated by the first +coordinate. -/ +theorem secondCoordinate_isSeparable_over_first + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + IsSeparable (FirstCoordinateSubfield f) (planeCurveFunction f 1) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + have hroot : Polynomial.aeval (planeCurveFunction f 1) + (polynomialOverFirstCoordinate f) = 0 := by + simpa [Polynomial.aeval_def] using eval₂_polynomialOverFirstCoordinate_eq_zero f + exact (polynomialOverFirstCoordinate_separable hf hderiv).of_dvd + (minpoly.dvd (FirstCoordinateSubfield f) (planeCurveFunction f 1) hroot) + +/-- The plane-curve function field is a finite separable extension of the field generated by its +first coordinate. -/ +theorem finiteSeparable_over_firstCoordinate_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ∧ + Algebra.IsSeparable (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + constructor + · exact finiteDimensional_over_firstCoordinate_of_irreducible hf hderiv + · have hAdjoin : Algebra.IsSeparable (FirstCoordinateSubfield f) + (IntermediateField.adjoin (FirstCoordinateSubfield f) + {planeCurveFunction f 1}) := + (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable + (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)).mpr + (secondCoordinate_isSeparable_over_first hf hderiv) + have hTop : Algebra.IsSeparable (FirstCoordinateSubfield f) + (⊤ : IntermediateField (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f)) := by + rw [← adjoin_secondCoordinate_over_first_eq_top f] + exact hAdjoin + exact (IntermediateField.isSeparable_top + (F := FirstCoordinateSubfield f) (E := PlaneCurveFunctionField f)).mp hTop + +/-- Specialization at the transcendental first coordinate preserves the second-coordinate +degree. -/ +theorem natDegree_polynomialOverFirstCoordinate_eq_degreeOf_second + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (polynomialOverFirstCoordinate f).natDegree = MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate, + Polynomial.natDegree_map_eq_of_injective + (firstCoordinateCoefficientEval_injective hf + (degreeOf_second_pos_of_pderiv_ne_zero hderiv))] + exact (MvPolynomial.degreeOf_eq_natDegree (1 : Fin 2) f).symm + +/-- The minimal polynomial of the second coordinate has the full second-coordinate degree of the +irreducible plane equation. -/ +theorem natDegree_minpoly_secondCoordinate_eq_degreeOf_second + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (minpoly (FirstCoordinateSubfield f) (planeCurveFunction f 1)).natDegree = + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let p := polynomialOverFirstCoordinate f + have hpIrreducible : Irreducible p := + polynomialOverFirstCoordinate_irreducible hf hderiv + have hroot : Polynomial.aeval (planeCurveFunction f 1) p = 0 := by + simpa [p, Polynomial.aeval_def] using eval₂_polynomialOverFirstCoordinate_eq_zero f + have heq := minpoly.eq_of_irreducible hpIrreducible hroot + calc + (minpoly (FirstCoordinateSubfield f) (planeCurveFunction f 1)).natDegree = + (p * Polynomial.C p.leadingCoeff⁻¹).natDegree := by rw [heq] + _ = p.natDegree := Polynomial.natDegree_mul_C + (inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hpIrreducible.ne_zero)) + _ = MvPolynomial.degreeOf 1 f := + natDegree_polynomialOverFirstCoordinate_eq_degreeOf_second hf hderiv + +/-- The extension degree over the first-coordinate field is exactly the degree of the defining +equation in the second coordinate. -/ +theorem finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) = + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := + finiteDimensional_over_firstCoordinate_of_irreducible hf hderiv + have halg := secondCoordinate_isAlgebraic_over_first f + (polynomialOverFirstCoordinate_ne_zero_of_irreducible hf + (degreeOf_second_pos_of_pderiv_ne_zero hderiv)) + calc + Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) = + Module.finrank (FirstCoordinateSubfield f) + (⊤ : IntermediateField (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f)) := by rw [IntermediateField.finrank_top'] + _ = Module.finrank (FirstCoordinateSubfield f) + (IntermediateField.adjoin (FirstCoordinateSubfield f) + {planeCurveFunction f 1}) := by + rw [adjoin_secondCoordinate_over_first_eq_top f] + _ = (minpoly (FirstCoordinateSubfield f) (planeCurveFunction f 1)).natDegree := + IntermediateField.adjoin.finrank halg.isIntegral + _ = MvPolynomial.degreeOf 1 f := + natDegree_minpoly_secondCoordinate_eq_degreeOf_second hf hderiv + +/-! ## The coordinate-swapped extension -/ + +/-- Embed a univariate polynomial in the second affine coordinate. -/ +def polynomialInSecondCoordinateOnly (P : Polynomial K) : MvPolynomial (Fin 2) K := + P.sum fun n c => MvPolynomial.C c * MvPolynomial.X 1 ^ n + +theorem eval₂_polynomialInSecondCoordinateOnly + {S : Type*} [CommSemiring S] (P : Polynomial K) (phi : K →+* S) (x y : S) : + MvPolynomial.eval₂ phi ![x, y] (polynomialInSecondCoordinateOnly P) = + P.eval₂ phi y := by + classical + simp [polynomialInSecondCoordinateOnly, Polynomial.sum_def, Polynomial.eval₂_eq_sum] + +theorem polynomialInSecondCoordinateOnly_ne_zero {P : Polynomial K} (hP : P ≠ 0) : + polynomialInSecondCoordinateOnly P ≠ 0 := by + intro hzero + have heval := eval₂_polynomialInSecondCoordinateOnly P Polynomial.C + (0 : Polynomial K) Polynomial.X + rw [hzero, MvPolynomial.eval₂_zero] at heval + apply hP + simpa using heval.symm + +private theorem degreeOf_finset_sum_le_for_second + {R ι : Type*} [CommSemiring R] + (coordinate : Fin 2) (terms : ι → MvPolynomial (Fin 2) R) + (indices : Finset ι) (bound : ℕ) + (hterms : ∀ i ∈ indices, MvPolynomial.degreeOf coordinate (terms i) ≤ bound) : + MvPolynomial.degreeOf coordinate (∑ i ∈ indices, terms i) ≤ bound := by + classical + induction indices using Finset.induction_on with + | empty => simp + | @insert i indices hi ih => + rw [Finset.sum_insert hi] + exact (MvPolynomial.degreeOf_add_le _ _ _).trans + (max_le (hterms i (Finset.mem_insert_self i indices)) + (ih fun j hj => hterms j (Finset.mem_insert_of_mem hj))) + +theorem polynomialInSecondCoordinateOnly_degreeOf_first_le (P : Polynomial K) : + MvPolynomial.degreeOf (0 : Fin 2) (polynomialInSecondCoordinateOnly P) ≤ 0 := by + classical + rw [polynomialInSecondCoordinateOnly, Polynomial.sum_def] + apply degreeOf_finset_sum_le_for_second (0 : Fin 2) _ P.support 0 + intro n _hn + calc + MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C (P.coeff n) * MvPolynomial.X 1 ^ n) ≤ + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.C (P.coeff n)) + + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 1 ^ n) := + MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ 0 := by + have hpow : MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.X 1 ^ n : MvPolynomial (Fin 2) K) ≤ 0 := by + calc + _ ≤ n * MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 1) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = 0 := by rw [MvPolynomial.degreeOf_X]; norm_num + rw [MvPolynomial.degreeOf_C] + simpa using hpow + +/-- Positive degree in the first coordinate makes the second coordinate function +transcendental. -/ +theorem secondCoordinate_transcendental + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hfirst : 0 < MvPolynomial.degreeOf 0 f) : + letI := planeCurveCoordinateRing_isDomain hf + Transcendental K (planeCurveFunction f 1) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [transcendental_iff] + intro P hPzero + by_contra hP + have hembedded : polynomialInSecondCoordinateOnly P ≠ 0 := + polynomialInSecondCoordinateOnly_ne_zero hP + have hquotient : planeCurveQuotientMap f (polynomialInSecondCoordinateOnly P) = 0 := by + apply IsFractionRing.injective (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + rw [map_zero] + change + ((algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)).comp + (planeCurveQuotientMap f)) (polynomialInSecondCoordinateOnly P) = 0 + rw [← eval₂_planeCurveFunction f] + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + change MvPolynomial.eval₂ (algebraMap K (PlaneCurveFunctionField f)) + ![planeCurveFunction f 0, planeCurveFunction f 1] + (polynomialInSecondCoordinateOnly P) = 0 + rw [eval₂_polynomialInSecondCoordinateOnly] + simpa [Polynomial.aeval_def] using hPzero + have hdvd : f ∣ polynomialInSecondCoordinateOnly P := + Ideal.mem_span_singleton.mp (Ideal.Quotient.eq_zero_iff_mem.mp hquotient) + obtain ⟨g, hg⟩ := hdvd + have hgzero : g ≠ 0 := by + intro hzero + apply hembedded + rw [hg, hzero, mul_zero] + have hdegree : MvPolynomial.degreeOf 0 f ≤ + MvPolynomial.degreeOf 0 (polynomialInSecondCoordinateOnly P) := by + rw [hg, MvPolynomial.degreeOf_mul_eq hf.ne_zero hgzero] + exact Nat.le_add_right _ _ + have hzeroDegree := polynomialInSecondCoordinateOnly_degreeOf_first_le P + omega + +/-- The intermediate field generated by the second coordinate function. -/ +abbrev SecondCoordinateSubfield + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] := + IntermediateField.adjoin K ({planeCurveFunction f 1} : Set (PlaneCurveFunctionField f)) + +def secondCoordinateInSubfield + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + SecondCoordinateSubfield f := + ⟨planeCurveFunction f 1, + IntermediateField.mem_adjoin_simple_self K (planeCurveFunction f 1)⟩ + +/-- Regard the plane equation as a polynomial in the first coordinate, with coefficients in the +field generated by the second coordinate. -/ +def polynomialOverSecondCoordinate + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + Polynomial (SecondCoordinateSubfield f) := + MvPolynomial.eval₂ (algebraMap K (Polynomial (SecondCoordinateSubfield f))) + ![Polynomial.X, Polynomial.C (secondCoordinateInSubfield f)] f + +/-- Iterated-polynomial presentation with the original first coordinate as outer variable. -/ +def polynomialInFirstVariablePresentation (f : MvPolynomial (Fin 2) K) : + Polynomial (MvPolynomial {i : Fin 2 // i ≠ 0} K) := + MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 0} + (MvPolynomial.rename (Equiv.optionSubtypeNe (0 : Fin 2)).symm f) + +theorem polynomialInFirstVariablePresentation_ne_zero + {f : MvPolynomial (Fin 2) K} (hf : f ≠ 0) : + polynomialInFirstVariablePresentation f ≠ 0 := by + intro hzero + apply hf + apply MvPolynomial.rename_injective + (Equiv.optionSubtypeNe (0 : Fin 2)).symm + (Equiv.optionSubtypeNe (0 : Fin 2)).symm.injective + apply (MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 0}).injective + simpa [polynomialInFirstVariablePresentation] using hzero + +def secondCoordinateCoefficientEval + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + MvPolynomial {i : Fin 2 // i ≠ 0} K →+* SecondCoordinateSubfield f := + MvPolynomial.eval₂Hom (algebraMap K (SecondCoordinateSubfield f)) + (fun _ => secondCoordinateInSubfield f) + +theorem secondCoordinateCoefficientEval_injective + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hfirst : 0 < MvPolynomial.degreeOf 0 f) : + letI := planeCurveCoordinateRing_isDomain hf + Function.Injective (secondCoordinateCoefficientEval f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let remaining := {i : Fin 2 // i ≠ 0} + have remaining_value_one (i : remaining) : i.1 = 1 := by omega + letI : Subsingleton remaining := + ⟨fun i j => Subtype.ext ((remaining_value_one i).trans (remaining_value_one j).symm)⟩ + let i1 : remaining := ⟨1, by decide⟩ + have hIndependent : AlgebraicIndependent K + (fun _ : remaining => planeCurveFunction f 1) := by + rw [algebraicIndependent_singleton_iff i1] + exact secondCoordinate_transcendental hf hfirst + let composed : MvPolynomial remaining K →+* PlaneCurveFunctionField f := + (algebraMap (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)).comp + (secondCoordinateCoefficientEval f) + let evaluated : MvPolynomial remaining K →+* PlaneCurveFunctionField f := + MvPolynomial.eval₂Hom (algebraMap K (PlaneCurveFunctionField f)) + (fun _ => planeCurveFunction f 1) + have hhom : composed = evaluated := by + apply MvPolynomial.ringHom_ext + · intro c + simp [composed, evaluated, secondCoordinateCoefficientEval] + · intro i + simp [composed, evaluated, secondCoordinateCoefficientEval, + secondCoordinateInSubfield] + intro a b hab + apply (algebraicIndependent_iff_injective_aeval.mp hIndependent) + change evaluated a = evaluated b + rw [← hhom] + exact congrArg (algebraMap (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)) hab + +theorem polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + polynomialOverSecondCoordinate f = + (polynomialInFirstVariablePresentation f).map (secondCoordinateCoefficientEval f) := by + let lhs : MvPolynomial (Fin 2) K →+* Polynomial (SecondCoordinateSubfield f) := + MvPolynomial.eval₂Hom (algebraMap K (Polynomial (SecondCoordinateSubfield f))) + ![Polynomial.X, Polynomial.C (secondCoordinateInSubfield f)] + let rhs : MvPolynomial (Fin 2) K →+* Polynomial (SecondCoordinateSubfield f) := + (Polynomial.mapRingHom (secondCoordinateCoefficientEval f)).comp + ((MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 0}).toRingEquiv.toRingHom.comp + (MvPolynomial.rename (Equiv.optionSubtypeNe (0 : Fin 2)).symm).toRingHom) + change lhs f = rhs f + congr 1 + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs, secondCoordinateCoefficientEval] + · intro i + fin_cases i <;> + simp [lhs, rhs, secondCoordinateCoefficientEval, secondCoordinateInSubfield] + +theorem polynomialInFirstVariablePresentation_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : + Irreducible (polynomialInFirstVariablePresentation f) := by + let e := Equiv.optionSubtypeNe (0 : Fin 2) + have hrename : Irreducible (MvPolynomial.rename e.symm f) := by + change Irreducible ((MvPolynomial.renameEquiv K e.symm) f) + exact hf.map (MvPolynomial.renameEquiv K e.symm).toMulEquiv + exact hrename.map (MvPolynomial.optionEquivLeft K {i : Fin 2 // i ≠ 0}).toMulEquiv + +theorem derivative_polynomialInFirstVariablePresentation + (f : MvPolynomial (Fin 2) K) : + (polynomialInFirstVariablePresentation f).derivative = + polynomialInFirstVariablePresentation (MvPolynomial.pderiv 0 f) := by + let e := Equiv.optionSubtypeNe (0 : Fin 2) + rw [polynomialInFirstVariablePresentation, polynomialInFirstVariablePresentation, + derivative_optionEquivLeft] + congr 1 + simpa [e] using MvPolynomial.pderiv_rename e.symm.injective (0 : Fin 2) f + +theorem derivative_polynomialInFirstVariablePresentation_ne_zero + {f : MvPolynomial (Fin 2) K} (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + (polynomialInFirstVariablePresentation f).derivative ≠ 0 := by + rw [derivative_polynomialInFirstVariablePresentation] + exact polynomialInFirstVariablePresentation_ne_zero hderiv + +theorem degreeOf_first_pos_of_pderiv_ne_zero + {f : MvPolynomial (Fin 2) K} (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + 0 < MvPolynomial.degreeOf 0 f := by + apply Nat.pos_of_ne_zero + apply MvPolynomial.mem_vars_iff_degreeOf_ne_zero.mp + by_contra hmem + exact hderiv (MvPolynomial.pderiv_eq_zero_of_notMem_vars hmem) + +theorem polynomialOverSecondCoordinate_ne_zero_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hfirst : 0 < MvPolynomial.degreeOf 0 f) : + letI := planeCurveCoordinateRing_isDomain hf + polynomialOverSecondCoordinate f ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation] + exact (Polynomial.map_ne_zero_iff + (secondCoordinateCoefficientEval_injective hf hfirst)).mpr + (polynomialInFirstVariablePresentation_ne_zero hf.ne_zero) + +theorem natDegree_polynomialOverSecondCoordinate_le_degreeOf_first + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + (polynomialOverSecondCoordinate f).natDegree ≤ MvPolynomial.degreeOf 0 f := by + rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation] + calc + ((polynomialInFirstVariablePresentation f).map + (secondCoordinateCoefficientEval f)).natDegree ≤ + (polynomialInFirstVariablePresentation f).natDegree := Polynomial.natDegree_map_le + _ = MvPolynomial.degreeOf 0 f := + (MvPolynomial.degreeOf_eq_natDegree (0 : Fin 2) f).symm + +theorem eval₂_polynomialOverSecondCoordinate_eq_zero + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + Polynomial.eval₂ + (algebraMap (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)) + (planeCurveFunction f 0) (polynomialOverSecondCoordinate f) = 0 := by + let lhs : MvPolynomial (Fin 2) K →+* PlaneCurveFunctionField f := + (Polynomial.eval₂RingHom + (algebraMap (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)) + (planeCurveFunction f 0)).comp + (MvPolynomial.eval₂Hom + (algebraMap K (Polynomial (SecondCoordinateSubfield f))) + ![Polynomial.X, Polynomial.C (secondCoordinateInSubfield f)]) + let rhs : MvPolynomial (Fin 2) K →+* PlaneCurveFunctionField f := + MvPolynomial.eval₂Hom (algebraMap K (PlaneCurveFunctionField f)) + (planeCurveFunction f) + have hhom : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs] + · intro i + fin_cases i <;> + simp [lhs, rhs, secondCoordinateInSubfield] + change lhs f = 0 + rw [hhom] + exact eval₂_planeCurveFunction_eq_zero f + +theorem firstCoordinate_isAlgebraic_over_second + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hpoly : polynomialOverSecondCoordinate f ≠ 0) : + IsAlgebraic (SecondCoordinateSubfield f) (planeCurveFunction f 0) := by + refine ⟨polynomialOverSecondCoordinate f, hpoly, ?_⟩ + simpa [Polynomial.aeval_def] using eval₂_polynomialOverSecondCoordinate_eq_zero f + +theorem adjoin_firstCoordinate_over_second_eq_top + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] : + IntermediateField.adjoin (SecondCoordinateSubfield f) {planeCurveFunction f 0} = ⊤ := by + have hpair : + IntermediateField.adjoin K + ({planeCurveFunction f 1, planeCurveFunction f 0} : + Set (PlaneCurveFunctionField f)) = ⊤ := by + have horiginal : + IntermediateField.adjoin K + ({planeCurveFunction f 0, planeCurveFunction f 1} : + Set (PlaneCurveFunctionField f)) = ⊤ := by + rw [← range_planeCurveFunction f] + exact adjoin_planeCurveFunctions_eq_top + simpa [Set.pair_comm] using horiginal + apply IntermediateField.restrictScalars_injective K + rw [IntermediateField.restrictScalars_top] + change + (IntermediateField.adjoin + (IntermediateField.adjoin K {planeCurveFunction f 1}) + {planeCurveFunction f 0}).restrictScalars K = ⊤ + rw [IntermediateField.adjoin_adjoin_left] + simpa only [Set.singleton_union] using hpair + +theorem finiteDimensional_over_secondCoordinate + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (hpoly : polynomialOverSecondCoordinate f ≠ 0) : + FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := by + have halg := firstCoordinate_isAlgebraic_over_second f hpoly + letI : FiniteDimensional (SecondCoordinateSubfield f) + (IntermediateField.adjoin (SecondCoordinateSubfield f) {planeCurveFunction f 0}) := + IntermediateField.adjoin.finiteDimensional halg.isIntegral + letI : FiniteDimensional (SecondCoordinateSubfield f) + (⊤ : IntermediateField (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)) := by + rw [← adjoin_firstCoordinate_over_second_eq_top f] + infer_instance + exact IntermediateField.topEquiv.toLinearEquiv.finiteDimensional + +/-- The fraction field of the coefficient polynomial ring in the second affine coordinate is the +field generated by that coordinate function. -/ +def secondCoordinateFractionEquiv + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (htrans : Transcendental K (planeCurveFunction f 1)) : + FractionRing (MvPolynomial {i : Fin 2 // i ≠ 0} K) ≃ₐ[K] + SecondCoordinateSubfield f := by + let remaining := {i : Fin 2 // i ≠ 0} + have remaining_value_one (i : remaining) : i.1 = 1 := by omega + letI : Subsingleton remaining := + ⟨fun i j => Subtype.ext ((remaining_value_one i).trans (remaining_value_one j).symm)⟩ + let i1 : remaining := ⟨1, by decide⟩ + have hIndependent : AlgebraicIndependent K + (fun _ : remaining => planeCurveFunction f 1) := by + rw [algebraicIndependent_singleton_iff i1] + exact htrans + have hrange : Set.range (fun _ : remaining => planeCurveFunction f 1) = + ({planeCurveFunction f 1} : Set (PlaneCurveFunctionField f)) := by + ext z + constructor + · rintro ⟨i, rfl⟩ + simp + · intro hz + rw [Set.mem_singleton_iff] at hz + subst z + exact ⟨i1, rfl⟩ + have hfield : + IntermediateField.adjoin K + (Set.range (fun _ : remaining => planeCurveFunction f 1)) = + SecondCoordinateSubfield f := by + rw [hrange] + exact hIndependent.aevalEquivField.trans (IntermediateField.equivOfEq hfield) + +/-- The second-coordinate fraction-field equivalence extends coefficient evaluation. -/ +@[simp] +theorem secondCoordinateFractionEquiv_algebraMap + (f : MvPolynomial (Fin 2) K) [IsDomain (PlaneCurveCoordinateRing f)] + (htrans : Transcendental K (planeCurveFunction f 1)) + (p : MvPolynomial {i : Fin 2 // i ≠ 0} K) : + secondCoordinateFractionEquiv f htrans + (algebraMap (MvPolynomial {i : Fin 2 // i ≠ 0} K) + (FractionRing (MvPolynomial {i : Fin 2 // i ≠ 0} K)) p) = + secondCoordinateCoefficientEval f p := by + apply Subtype.ext + · simp [secondCoordinateFractionEquiv, secondCoordinateCoefficientEval, + secondCoordinateInSubfield] + simpa [MvPolynomial.aeval_def, secondCoordinateInSubfield] using + (MvPolynomial.hom_eval₂ p + (algebraMap K (SecondCoordinateSubfield f)) + (SecondCoordinateSubfield f).val.toRingHom + (fun _ => secondCoordinateInSubfield f)).symm + +/-- The plane equation remains irreducible over the field generated by the second coordinate when +viewed as a polynomial in the first coordinate. -/ +theorem polynomialOverSecondCoordinate_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Irreducible (polynomialOverSecondCoordinate f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let R := MvPolynomial {i : Fin 2 // i ≠ 0} K + let F := FractionRing R + let p := polynomialInFirstVariablePresentation f + have hfirst : 0 < MvPolynomial.degreeOf 0 f := + degreeOf_first_pos_of_pderiv_ne_zero hderiv + have htrans : Transcendental K (planeCurveFunction f 1) := + secondCoordinate_transcendental hf hfirst + have hpIrreducible : Irreducible p := polynomialInFirstVariablePresentation_irreducible hf + have hpDerivative : p.derivative ≠ 0 := + derivative_polynomialInFirstVariablePresentation_ne_zero hderiv + have hpDegree : p.natDegree ≠ 0 := by + intro hdegree + exact hpDerivative (Polynomial.derivative_of_natDegree_zero hdegree) + have hpPrimitive : p.IsPrimitive := hpIrreducible.isPrimitive hpDegree + have hFractionIrreducible : Irreducible (p.map (algebraMap R F)) := + (hpPrimitive.irreducible_iff_irreducible_map_fraction_map (K := F)).mp hpIrreducible + let e := secondCoordinateFractionEquiv f htrans + have hMappedIrreducible : + Irreducible ((p.map (algebraMap R F)).map e.toRingHom) := + hFractionIrreducible.map (Polynomial.mapEquiv e.toRingEquiv).toMulEquiv + have hmap : e.toRingHom.comp (algebraMap R F) = secondCoordinateCoefficientEval f := by + apply DFunLike.ext _ _ + intro q + exact secondCoordinateFractionEquiv_algebraMap f htrans q + rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation] + simpa only [Polynomial.map_map, hmap] using hMappedIrreducible + +theorem derivative_polynomialOverSecondCoordinate_ne_zero + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (polynomialOverSecondCoordinate f).derivative ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation, + Polynomial.derivative_map] + exact (Polynomial.map_ne_zero_iff + (secondCoordinateCoefficientEval_injective hf + (degreeOf_first_pos_of_pderiv_ne_zero hderiv))).mpr + (derivative_polynomialInFirstVariablePresentation_ne_zero hderiv) + +theorem polynomialOverSecondCoordinate_separable + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (polynomialOverSecondCoordinate f).Separable := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + exact (Polynomial.separable_iff_derivative_ne_zero + (polynomialOverSecondCoordinate_irreducible hf hderiv)).mpr + (derivative_polynomialOverSecondCoordinate_ne_zero hf hderiv) + +/-- The first coordinate is separable over the field generated by the second coordinate. -/ +theorem firstCoordinate_isSeparable_over_second + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + IsSeparable (SecondCoordinateSubfield f) (planeCurveFunction f 0) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + have hroot : Polynomial.aeval (planeCurveFunction f 0) + (polynomialOverSecondCoordinate f) = 0 := by + simpa [Polynomial.aeval_def] using eval₂_polynomialOverSecondCoordinate_eq_zero f + exact (polynomialOverSecondCoordinate_separable hf hderiv).of_dvd + (minpoly.dvd (SecondCoordinateSubfield f) (planeCurveFunction f 0) hroot) + +/-- The plane-curve function field is finite and separable over the field generated by its second +coordinate. -/ +theorem finiteSeparable_over_secondCoordinate_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) ∧ + Algebra.IsSeparable (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + have hpoly : polynomialOverSecondCoordinate f ≠ 0 := + polynomialOverSecondCoordinate_ne_zero_of_irreducible hf + (degreeOf_first_pos_of_pderiv_ne_zero hderiv) + constructor + · exact finiteDimensional_over_secondCoordinate f hpoly + · have hAdjoin : Algebra.IsSeparable (SecondCoordinateSubfield f) + (IntermediateField.adjoin (SecondCoordinateSubfield f) + {planeCurveFunction f 0}) := + (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable + (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)).mpr + (firstCoordinate_isSeparable_over_second hf hderiv) + have hTop : Algebra.IsSeparable (SecondCoordinateSubfield f) + (⊤ : IntermediateField (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f)) := by + rw [← adjoin_firstCoordinate_over_second_eq_top f] + exact hAdjoin + exact (IntermediateField.isSeparable_top + (F := SecondCoordinateSubfield f) (E := PlaneCurveFunctionField f)).mp hTop + +theorem natDegree_polynomialOverSecondCoordinate_eq_degreeOf_first + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (polynomialOverSecondCoordinate f).natDegree = MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation, + Polynomial.natDegree_map_eq_of_injective + (secondCoordinateCoefficientEval_injective hf + (degreeOf_first_pos_of_pderiv_ne_zero hderiv))] + exact (MvPolynomial.degreeOf_eq_natDegree (0 : Fin 2) f).symm + +theorem natDegree_minpoly_firstCoordinate_eq_degreeOf_first + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (minpoly (SecondCoordinateSubfield f) (planeCurveFunction f 0)).natDegree = + MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let p := polynomialOverSecondCoordinate f + have hpIrreducible : Irreducible p := polynomialOverSecondCoordinate_irreducible hf hderiv + have hroot : Polynomial.aeval (planeCurveFunction f 0) p = 0 := by + simpa [p, Polynomial.aeval_def] using eval₂_polynomialOverSecondCoordinate_eq_zero f + have heq := minpoly.eq_of_irreducible hpIrreducible hroot + calc + (minpoly (SecondCoordinateSubfield f) (planeCurveFunction f 0)).natDegree = + (p * Polynomial.C p.leadingCoeff⁻¹).natDegree := by rw [heq] + _ = p.natDegree := Polynomial.natDegree_mul_C + (inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hpIrreducible.ne_zero)) + _ = MvPolynomial.degreeOf 0 f := + natDegree_polynomialOverSecondCoordinate_eq_degreeOf_first hf hderiv + +/-- The extension degree over the second-coordinate field is the first-coordinate degree of the +plane equation. -/ +theorem finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) = + MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + have hpoly : polynomialOverSecondCoordinate f ≠ 0 := + polynomialOverSecondCoordinate_ne_zero_of_irreducible hf + (degreeOf_first_pos_of_pderiv_ne_zero hderiv) + letI : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := + finiteDimensional_over_secondCoordinate f hpoly + have halg := firstCoordinate_isAlgebraic_over_second f hpoly + calc + Module.finrank (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) = + Module.finrank (SecondCoordinateSubfield f) + (⊤ : IntermediateField (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f)) := by rw [IntermediateField.finrank_top'] + _ = Module.finrank (SecondCoordinateSubfield f) + (IntermediateField.adjoin (SecondCoordinateSubfield f) + {planeCurveFunction f 0}) := by + rw [adjoin_firstCoordinate_over_second_eq_top f] + _ = (minpoly (SecondCoordinateSubfield f) (planeCurveFunction f 0)).natDegree := + IntermediateField.adjoin.finrank halg.isIntegral + _ = MvPolynomial.degreeOf 0 f := + natDegree_minpoly_firstCoordinate_eq_degreeOf_first hf hderiv + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean new file mode 100644 index 0000000000..e004b6f26e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +import Mathlib.Tactic + +/-! +# Saving one boundary degree at a shared affine origin + +The degree-only plane-curve estimate bounds the zero/pole support of the two +coordinate functions by adding their two support degrees. If the curve +contains the affine origin, the finite place selected above that point lies +in both supports. Since every place has positive degree, the union estimate +saves at least one. + +This argument does not assert that a branch above an arbitrary singular +rational point has residue degree one. Positivity of the selected place +degree is sufficient for the one-unit saving. +-/ + +open scoped Polynomial BigOperators + +namespace BGS.CorvajaZannier + +noncomputable section + +private theorem sum_union_add_weight_le_sum_add_sum + {ι : Type*} [DecidableEq ι] (s t : Finset ι) (g : ι → ℕ) + {q : ι} (hqs : q ∈ s) (hqt : q ∈ t) : + (∑ i ∈ s ∪ t, g i) + g q ≤ + (∑ i ∈ s, g i) + ∑ i ∈ t, g i := by + have hdisjoint : Disjoint (t \ s) {q} := by + rw [Finset.disjoint_singleton_right] + intro hq + exact (Finset.mem_sdiff.mp hq).2 hqs + have hsubset : (t \ s) ∪ {q} ⊆ t := by + intro i hi + rcases Finset.mem_union.mp hi with hi | hi + · exact (Finset.mem_sdiff.mp hi).1 + · rw [Finset.mem_singleton] at hi + simpa [hi] using hqt + have hremaining : + (∑ i ∈ t \ s, g i) + g q ≤ ∑ i ∈ t, g i := by + have hsum : + (∑ i ∈ (t \ s) ∪ {q}, g i) ≤ ∑ i ∈ t, g i := + Finset.sum_le_sum_of_subset hsubset + rw [Finset.sum_union hdisjoint] at hsum + simpa using hsum + calc + (∑ i ∈ s ∪ t, g i) + g q = + ((∑ i ∈ s, g i) + ∑ i ∈ t \ s, g i) + g q := by + rw [show s ∪ t = s ∪ (t \ s) by ext i; simp, + Finset.sum_union Finset.disjoint_sdiff] + _ = (∑ i ∈ s, g i) + ((∑ i ∈ t \ s, g i) + g q) := by + omega + _ ≤ (∑ i ∈ s, g i) + ∑ i ∈ t, g i := + Nat.add_le_add_left hremaining _ + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- If an irreducible plane curve contains the affine origin, then the +zero/pole boundary of positive powers of its two coordinate functions saves +one degree compared with the disjoint-support estimate. -/ +theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_add_one_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (origin : AffinePlaneCurvePoint f) + (horiginFirst : origin.1.1 = 0) + (horiginSecond : origin.1.2 = 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + (∑ w ∈ propositionTwoExceptionalPlaces K (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w) + 1 ≤ + 2 * (MvPolynomial.degreeOf 0 f + MvPolynomial.degreeOf 1 f) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hxTrans : Transcendental K x := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro h + apply hxTrans + rw [h] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hxTrans + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra (Polynomial K) L := + RingHom.toAlgebra + ((algebraMap (RatFunc K) L).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + let q : FiniteExtensionFinitePlace K L := + BGS.HasseWeil.affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond origin + have hqSpec := + BGS.HasseWeil.affinePointExhaustiveFinitePlace_spec + hf hpartialFirst hpartialSecond origin + have hqx : 0 < finitePlaceOrder q x := by + simpa only [q, x, horiginFirst, map_zero, sub_zero] using hqSpec.2.1 + have hqy : 0 < finitePlaceOrder q y := by + simpa only [q, y, horiginSecond, map_zero, sub_zero] using hqSpec.2.2 + have hxDegree : finiteExtensionPositiveDegree K L x = + MvPolynomial.degreeOf 1 f := by + have hheight := finiteExtensionPositiveDegree_polynomial + K L Polynomial.X Polynomial.X_ne_zero + have hmap : algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) Polynomial.X) = x := by + change ratFuncSpecialization x hxTrans RatFunc.X = x + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hxTrans + rw [hmap, + finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond] at hheight + simpa using hheight + have hyDegree : finiteExtensionPositiveDegree K L y ≤ + MvPolynomial.degreeOf 0 f := + finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_first + hf hpartialFirst hpartialSecond + have hsupportX : + (finiteExtensionPrincipalDivisor K L (x ^ m)).support = + (finiteExtensionPrincipalDivisor K L x).support := by + rw [finiteExtensionPrincipalDivisor_pow K L x hx0 m] + ext w + simp [Finsupp.mem_support_iff, hm.ne'] + have hsupportY : + (finiteExtensionPrincipalDivisor K L (y ^ n)).support = + (finiteExtensionPrincipalDivisor K L y).support := by + rw [finiteExtensionPrincipalDivisor_pow K L y hy0 n] + ext w + simp [Finsupp.mem_support_iff, hn.ne'] + let v : FiniteExtensionPlace K L := .inl q + let s := (finiteExtensionPrincipalDivisor K L x).support + let t := (finiteExtensionPrincipalDivisor K L y).support + let degree : FiniteExtensionPlace K L → ℕ := + finiteExtensionPlaceDegree K L + have hvs : v ∈ s := by + dsimp only [s, v] + rw [Finsupp.mem_support_iff, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + omega + have hvt : v ∈ t := by + dsimp only [t, v] + rw [Finsupp.mem_support_iff, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + omega + have hvDegree : 1 ≤ degree v := by + dsimp only [degree, v] + exact finiteExtensionPlaceDegree_inl_pos K L q + have hoverlap : + (∑ w ∈ s ∪ t, degree w) + degree v ≤ + (∑ w ∈ s, degree w) + ∑ w ∈ t, degree w := + sum_union_add_weight_le_sum_add_sum s t degree hvs hvt + have hsupportSum : + (∑ w ∈ s, degree w) + ∑ w ∈ t, degree w ≤ + 2 * (MvPolynomial.degreeOf 0 f + MvPolynomial.degreeOf 1 f) := by + have hxSupport : + (∑ w ∈ s, degree w) ≤ + 2 * finiteExtensionPositiveDegree K L x := by + exact finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + K L x hx0 + have hySupport : + (∑ w ∈ t, degree w) ≤ + 2 * finiteExtensionPositiveDegree K L y := by + exact finiteExtensionPrincipalDivisor_supportDegree_le_two_mul_height + K L y hy0 + rw [hxDegree] at hxSupport + omega + change + (∑ w ∈ (finiteExtensionPrincipalDivisor K L (x ^ m)).support ∪ + (finiteExtensionPrincipalDivisor K L (y ^ n)).support, + degree w) + 1 ≤ _ + rw [hsupportX, hsupportY] + exact (Nat.add_le_add_left hvDegree _).trans + (hoverlap.trans hsupportSum) + +/-- Adding the canonical divisor preserves the one-unit saving from a common +affine origin. -/ +theorem planeCurve_canonicalDifferent_add_propositionTwoExceptional_add_one_le + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) + (origin : AffinePlaneCurvePoint f) + (horiginFirst : origin.1.1 = 0) + (horiginSecond : origin.1.2 = 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) + + (∑ w ∈ propositionTwoExceptionalPlaces K + (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℤ) + + 1 ≤ + (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f : ℕ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hcanonical := + planeCurve_canonicalDifferentDivisor_degree_le + hf hpartialSecond hcardK + have hboundary := + planeCurve_propositionTwoExceptionalPlaces_weightedDegree_add_one_le + hf hpartialFirst hpartialSecond origin + horiginFirst horiginSecond m n hm hn + have hboundaryInt : + ((∑ w ∈ propositionTwoExceptionalPlaces K + (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℕ) : ℤ) + + 1 ≤ + 2 * ((MvPolynomial.degreeOf 0 f : ℤ) + + MvPolynomial.degreeOf 1 f) := by + exact_mod_cast hboundary + norm_num at hcanonical hboundaryInt ⊢ + omega + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean new file mode 100644 index 0000000000..9bea62c763 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +import Mathlib.Tactic + +/-! +# Rank-two support certificates for a plane curve + +A diagonal stabilizer of a torus curve is controlled by the lattice generated +by differences of exponent vectors in its equation. This file introduces the +two-dimensional determinant used for that lattice and proves the sharp box +bound `|det| ≤ 2 * degreeOf 0 f * degreeOf 1 f`. + +The bound is characteristic-free. In the high-characteristic range used by +the Corvaja--Zannier endpoint, every nonzero such determinant is automatically +nonzero modulo the characteristic. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The oriented lattice area of the two support differences based at `r`. -/ +def planeCurveSupportDifferenceDet + (r s t : Fin 2 →₀ ℕ) : ℤ := + ((s 0 : ℤ) - (r 0 : ℤ)) * ((t 1 : ℤ) - (r 1 : ℤ)) - + ((s 1 : ℤ) - (r 1 : ℤ)) * ((t 0 : ℤ) - (r 0 : ℤ)) + +/-- A polynomial has rank-two support when three of its monomials have +linearly independent exponent differences. -/ +def PlaneCurveSupportHasRankTwo + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) : Prop := + ∃ r s t : Fin 2 →₀ ℕ, + r ∈ f.support ∧ s ∈ f.support ∧ t ∈ f.support ∧ + planeCurveSupportDifferenceDet r s t ≠ 0 + +/-- Every support-lattice determinant is bounded by twice the area of the +coordinate-degree box. This is the sharp uniform determinant estimate needed +for the diagonal-stabilizer route to the powered-image index bound. -/ +theorem abs_planeCurveSupportDifferenceDet_le_twice_bidegree + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) : + |planeCurveSupportDifferenceDet r s t| ≤ + 2 * (MvPolynomial.degreeOf 0 f : ℤ) * + (MvPolynomial.degreeOf 1 f : ℤ) := by + have hr0 := MvPolynomial.le_degreeOf_of_mem_support (p := f) 0 hr + have hr1 := MvPolynomial.le_degreeOf_of_mem_support (p := f) 1 hr + have hs0 := MvPolynomial.le_degreeOf_of_mem_support (p := f) 0 hs + have hs1 := MvPolynomial.le_degreeOf_of_mem_support (p := f) 1 hs + have ht0 := MvPolynomial.le_degreeOf_of_mem_support (p := f) 0 ht + have ht1 := MvPolynomial.le_degreeOf_of_mem_support (p := f) 1 ht + have hsr0 : |(s 0 : ℤ) - (r 0 : ℤ)| ≤ + (MvPolynomial.degreeOf 0 f : ℤ) := by + rw [abs_le] + constructor <;> omega + have hsr1 : |(s 1 : ℤ) - (r 1 : ℤ)| ≤ + (MvPolynomial.degreeOf 1 f : ℤ) := by + rw [abs_le] + constructor <;> omega + have htr0 : |(t 0 : ℤ) - (r 0 : ℤ)| ≤ + (MvPolynomial.degreeOf 0 f : ℤ) := by + rw [abs_le] + constructor <;> omega + have htr1 : |(t 1 : ℤ) - (r 1 : ℤ)| ≤ + (MvPolynomial.degreeOf 1 f : ℤ) := by + rw [abs_le] + constructor <;> omega + calc + |planeCurveSupportDifferenceDet r s t| ≤ + |((s 0 : ℤ) - (r 0 : ℤ)) * ((t 1 : ℤ) - (r 1 : ℤ))| + + |((s 1 : ℤ) - (r 1 : ℤ)) * ((t 0 : ℤ) - (r 0 : ℤ))| := by + dsimp only [planeCurveSupportDifferenceDet] + exact abs_sub _ _ + _ = |(s 0 : ℤ) - (r 0 : ℤ)| * |(t 1 : ℤ) - (r 1 : ℤ)| + + |(s 1 : ℤ) - (r 1 : ℤ)| * |(t 0 : ℤ) - (r 0 : ℤ)| := by + rw [abs_mul, abs_mul] + _ ≤ (MvPolynomial.degreeOf 0 f : ℤ) * + (MvPolynomial.degreeOf 1 f : ℤ) + + (MvPolynomial.degreeOf 1 f : ℤ) * + (MvPolynomial.degreeOf 0 f : ℤ) := by + gcongr + _ = 2 * (MvPolynomial.degreeOf 0 f : ℤ) * + (MvPolynomial.degreeOf 1 f : ℤ) := by ring + +/-- Natural-number form of the support determinant bound. -/ +theorem natAbs_planeCurveSupportDifferenceDet_le_twice_bidegree + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) : + (planeCurveSupportDifferenceDet r s t).natAbs ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + have h := abs_planeCurveSupportDifferenceDet_le_twice_bidegree hr hs ht + have hcast : + ((planeCurveSupportDifferenceDet r s t).natAbs : ℤ) ≤ + (2 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f : ℕ) := by + rw [Int.natCast_natAbs] + exact h + exact_mod_cast hcast + +/-- A rank-two support certificate supplies a positive lattice index bounded +by the public Euler budget. -/ +theorem exists_positive_supportDet_natAbs_le_twice_bidegree + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hrank : PlaneCurveSupportHasRankTwo f) : + ∃ r s t : Fin 2 →₀ ℕ, + r ∈ f.support ∧ s ∈ f.support ∧ t ∈ f.support ∧ + 0 < (planeCurveSupportDifferenceDet r s t).natAbs ∧ + (planeCurveSupportDifferenceDet r s t).natAbs ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + obtain ⟨r, s, t, hr, hs, ht, hdet⟩ := hrank + exact ⟨r, s, t, hr, hs, ht, Int.natAbs_pos.mpr hdet, + natAbs_planeCurveSupportDifferenceDet_le_twice_bidegree hr hs ht⟩ + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean new file mode 100644 index 0000000000..f492fb3cf7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean @@ -0,0 +1,873 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import Mathlib.GroupTheory.Archimedean +import Mathlib.Algebra.Polynomial.Homogenize +import Mathlib.Algebra.MvPolynomial.NoZeroDivisors +import Mathlib.FieldTheory.IsAlgClosed.Basic +import Mathlib.Tactic + +/-! +# Absolute irreducibility forces rank-two torus support + +This file proves the support-lattice bridge needed by the diagonal-stabilizer +route to the Corvaja--Zannier powered-image index bound. A collinear finite +support lies in a translate of a cyclic subgroup of `ℤ²`; the corresponding +plane polynomial is a monomial times a directional homogenization of a +univariate polynomial. Over an algebraically closed field, irreducibility +forces that univariate polynomial to have degree one, so a nonzero torus +character is constant on the curve. This contradicts the semantic +`TorusCurveNotSubtorusTranslate` hypothesis. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +private def integerVectorDet (u v : Fin 2 → ℤ) : ℤ := + u 0 * v 1 - u 1 * v 0 + +private def integerVectorLine (d : Fin 2 → ℤ) : AddSubgroup (Fin 2 → ℤ) where + carrier := {w | integerVectorDet d w = 0} + zero_mem' := by simp [integerVectorDet] + add_mem' := by + intro u v hu hv + simp only [Set.mem_setOf_eq] at hu hv ⊢ + simp only [integerVectorDet] at hu hv + simp only [integerVectorDet, Pi.add_apply] + linear_combination hu + hv + neg_mem' := by + intro u hu + simp only [Set.mem_setOf_eq] at hu ⊢ + simp only [integerVectorDet] at hu + simp only [integerVectorDet, Pi.neg_apply] + linear_combination -hu + +private def integerCoordinate (i : Fin 2) : (Fin 2 → ℤ) →+ ℤ where + toFun w := w i + map_zero' := rfl + map_add' _ _ := rfl + +private def integerCoordinateOnLine (d : Fin 2 → ℤ) (i : Fin 2) : + integerVectorLine d →+ (integerVectorLine d).map (integerCoordinate i) where + toFun w := by + refine ⟨integerCoordinate i w.1, ?_⟩ + change ∃ x, x ∈ integerVectorLine d ∧ + integerCoordinate i x = integerCoordinate i w.1 + exact ⟨w.1, w.2, rfl⟩ + map_zero' := by apply Subtype.ext; rfl + map_add' _ _ := by apply Subtype.ext; rfl + +private theorem integerCoordinate_zero_injectiveOn_integerVectorLine + {d : Fin 2 → ℤ} (hi : d 0 ≠ 0) : + Function.Injective + ((integerCoordinate 0).comp (integerVectorLine d).subtype) := by + intro u v huv + apply Subtype.ext + funext j + have hj : j = 0 ∨ j = 1 := by + have hjlt := j.isLt + omega + rcases hj with rfl | rfl + · exact huv + · have hu := u.property + have hv := v.property + change d 0 * u.1 1 - d 1 * u.1 0 = 0 at hu + change d 0 * v.1 1 - d 1 * v.1 0 = 0 at hv + dsimp [integerCoordinate] at huv + have hmul : d 0 * u.1 1 = d 0 * v.1 1 := by + calc + d 0 * u.1 1 = d 1 * u.1 0 := by omega + _ = d 1 * v.1 0 := by rw [huv] + _ = d 0 * v.1 1 := by omega + exact (mul_left_cancel₀ hi hmul) + +private theorem integerCoordinate_one_injectiveOn_integerVectorLine + {d : Fin 2 → ℤ} (hi : d 1 ≠ 0) : + Function.Injective + ((integerCoordinate 1).comp (integerVectorLine d).subtype) := by + intro u v huv + apply Subtype.ext + funext j + have hj : j = 0 ∨ j = 1 := by + have hjlt := j.isLt + omega + rcases hj with rfl | rfl + · have hu := u.property + have hv := v.property + change d 0 * u.1 1 - d 1 * u.1 0 = 0 at hu + change d 0 * v.1 1 - d 1 * v.1 0 = 0 at hv + dsimp [integerCoordinate] at huv + have hmul : d 1 * u.1 0 = d 1 * v.1 0 := by + calc + d 1 * u.1 0 = d 0 * u.1 1 := by omega + _ = d 0 * v.1 1 := by rw [huv] + _ = d 1 * v.1 0 := by omega + exact (mul_left_cancel₀ hi hmul) + · exact huv + +private theorem integerVectorLine_cyclic {d : Fin 2 → ℤ} (hd : d ≠ 0) : + ∃ v : Fin 2 → ℤ, ∀ w : Fin 2 → ℤ, + integerVectorDet d w = 0 → ∃ k : ℤ, w = k • v := by + have hcoord : d 0 ≠ 0 ∨ d 1 ≠ 0 := by + by_cases h0 : d 0 = 0 + · right + intro h1 + apply hd + funext i + have hi : i = 0 ∨ i = 1 := by + have hilt := i.isLt + omega + rcases hi with rfl | rfl + · exact h0 + · exact h1 + · exact Or.inl h0 + obtain ⟨i, hi, hinj⟩ : ∃ i : Fin 2, d i ≠ 0 ∧ + Function.Injective + ((integerCoordinate i).comp (integerVectorLine d).subtype) := by + rcases hcoord with h | h + · exact ⟨0, h, integerCoordinate_zero_injectiveOn_integerVectorLine h⟩ + · exact ⟨1, h, integerCoordinate_one_injectiveOn_integerVectorLine h⟩ + let L := integerVectorLine d + let phi : L →+ L.map (integerCoordinate i) := integerCoordinateOnLine d i + have hphi_inj : Function.Injective phi := by + intro u v huv + apply hinj + exact congrArg Subtype.val huv + have hphi_surj : Function.Surjective phi := by + rintro ⟨z, hz⟩ + obtain ⟨w, hw, hwz⟩ := hz + refine ⟨⟨w, hw⟩, ?_⟩ + apply Subtype.ext + exact hwz + let e : L ≃+ L.map (integerCoordinate i) := + AddEquiv.ofBijective phi ⟨hphi_inj, hphi_surj⟩ + obtain ⟨a, ha⟩ := Int.subgroup_cyclic (L.map (integerCoordinate i)) + have ha_mem : a ∈ L.map (integerCoordinate i) := by + rw [ha] + exact AddSubgroup.subset_closure (Set.mem_singleton a) + let vL : L := e.symm ⟨a, ha_mem⟩ + refine ⟨vL.1, ?_⟩ + intro w hw + have wmem : w ∈ L := hw + let wL : L := ⟨w, wmem⟩ + have hew_mem : (e wL : ℤ) ∈ AddSubgroup.closure {a} := by + rw [← ha] + exact (e wL).property + obtain ⟨k, hk⟩ := AddSubgroup.mem_closure_singleton.mp hew_mem + refine ⟨k, ?_⟩ + have heq : wL = k • vL := by + apply e.injective + apply Subtype.ext + simpa [vL] using hk.symm + exact congrArg Subtype.val heq + +private def planeExponentDifference + (r s : Fin 2 →₀ ℕ) : Fin 2 → ℤ := + fun i => (s i : ℤ) - (r i : ℤ) + +private theorem integerVectorDet_planeExponentDifference + (r s t : Fin 2 →₀ ℕ) : + integerVectorDet (planeExponentDifference r s) + (planeExponentDifference r t) = + planeCurveSupportDifferenceDet r s t := by + rfl + +theorem exists_support_direction_of_not_rankTwo + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + {r : Fin 2 →₀ ℕ} (hr : r ∈ f.support) + (hnrank : ¬ PlaneCurveSupportHasRankTwo f) + (hnonsingleton : ∃ s ∈ f.support, s ≠ r) : + ∃ v : Fin 2 → ℤ, v ≠ 0 ∧ + ∀ s ∈ f.support, ∃ k : ℤ, + planeExponentDifference r s = k • v := by + obtain ⟨s, hs, hsr⟩ := hnonsingleton + have hd : planeExponentDifference r s ≠ 0 := by + intro h + apply hsr + apply Finsupp.ext + intro i + have hi := congrFun h i + dsimp [planeExponentDifference] at hi + omega + obtain ⟨v, hv⟩ := integerVectorLine_cyclic hd + have hparam : ∀ t ∈ f.support, ∃ k : ℤ, + planeExponentDifference r t = k • v := by + intro t ht + apply hv + rw [integerVectorDet_planeExponentDifference] + by_contra hdet + exact hnrank ⟨r, s, t, hr, hs, ht, hdet⟩ + have hvne : v ≠ 0 := by + obtain ⟨k, hk⟩ := hparam s hs + intro hv0 + apply hd + simpa [hv0] using hk + exact ⟨v, hvne, hparam⟩ + +private def intVectorPositive (v : Fin 2 → ℤ) : Fin 2 →₀ ℕ := + Finsupp.equivFunOnFinite.symm (fun i => (v i).toNat) + +private def intVectorNegative (v : Fin 2 → ℤ) : Fin 2 →₀ ℕ := + Finsupp.equivFunOnFinite.symm (fun i => (-v i).toNat) + +@[simp] private theorem intVectorPositive_apply (v : Fin 2 → ℤ) (i : Fin 2) : + intVectorPositive v i = (v i).toNat := by + simp [intVectorPositive] + +@[simp] private theorem intVectorNegative_apply (v : Fin 2 → ℤ) (i : Fin 2) : + intVectorNegative v i = (-v i).toNat := by + simp [intVectorNegative] + +private theorem intVectorPositive_sub_negative (v : Fin 2 → ℤ) (i : Fin 2) : + (intVectorPositive v i : ℤ) - (intVectorNegative v i : ℤ) = v i := by + simp only [intVectorPositive_apply, intVectorNegative_apply] + rw [Int.ofNat_toNat, Int.ofNat_toNat] + rcases le_total 0 (v i) with hvi | hvi + · simp [hvi, neg_nonpos.mpr hvi] + · simp [hvi] + +private def directionalHomogenization {A : Type*} [CommSemiring A] + (v : Fin 2 → ℤ) (p : Polynomial A) (n : ℕ) : + MvPolynomial (Fin 2) A := + MvPolynomial.eval₂Hom MvPolynomial.C + ![MvPolynomial.monomial (intVectorPositive v) 1, + MvPolynomial.monomial (intVectorNegative v) 1] + (p.homogenize n) + +private theorem directionalHomogenization_monomial + {A : Type*} [CommSemiring A] (v : Fin 2 → ℤ) + {k n : ℕ} (hkn : k ≤ n) (c : A) : + directionalHomogenization v (Polynomial.monomial k c) n = + MvPolynomial.monomial + (k • intVectorPositive v + (n - k) • intVectorNegative v) c := by + rw [directionalHomogenization, Polynomial.homogenize_monomial hkn] + rw [MvPolynomial.eval₂Hom_monomial] + simp [Finsupp.prod_fintype, Fin.prod_univ_two, + MvPolynomial.monomial_pow, MvPolynomial.monomial_mul, + MvPolynomial.C_mul_monomial] + +private theorem directionalHomogenization_mul + {A : Type*} [CommSemiring A] (v : Fin 2 → ℤ) + (p q : Polynomial A) {m n : ℕ} + (hp : p.natDegree ≤ m) (hq : q.natDegree ≤ n) : + directionalHomogenization v (p * q) (m + n) = + directionalHomogenization v p m * directionalHomogenization v q n := by + rw [directionalHomogenization, Polynomial.homogenize_mul p q hp hq] + exact map_mul _ _ _ + +private def directionalExponent (v : Fin 2 → ℤ) (N k : ℕ) : Fin 2 →₀ ℕ := + k • intVectorPositive v + (N - k) • intVectorNegative v + +private theorem directionalHomogenization_not_isUnit + {A : Type*} [Field A] {v : Fin 2 → ℤ} (hvne : v ≠ 0) + {q : Polynomial A} {N : ℕ} (hN : 0 < N) + (hqdeg : q.natDegree = N) (hq0 : q.coeff 0 ≠ 0) : + ¬ IsUnit (directionalHomogenization v q N) := by + let H := directionalHomogenization v q N + have hsum : H = ∑ k ∈ Finset.range (N + 1), + MvPolynomial.monomial (directionalExponent v N k) (q.coeff k) := by + have hqsum : q = ∑ k ∈ Finset.range (N + 1), + Polynomial.monomial k (q.coeff k) := by + simpa [hqdeg] using q.as_sum_range + calc + H = directionalHomogenization v q N := rfl + _ = directionalHomogenization v + (∑ k ∈ Finset.range (N + 1), + Polynomial.monomial k (q.coeff k)) N := by rw [← hqsum] + _ = ∑ k ∈ Finset.range (N + 1), + directionalHomogenization v (Polynomial.monomial k (q.coeff k)) N := by + simp only [directionalHomogenization, + Polynomial.homogenize_finsetSum, map_sum] + _ = ∑ k ∈ Finset.range (N + 1), + MvPolynomial.monomial (directionalExponent v N k) (q.coeff k) := by + apply Finset.sum_congr rfl + intro k hk + rw [directionalHomogenization_monomial] + · rfl + · exact Nat.le_of_lt_succ (Finset.mem_range.mp hk) + obtain ⟨i, hi⟩ : ∃ i : Fin 2, v i ≠ 0 := by + by_contra h + apply hvne + funext i + exact Classical.not_not.mp (not_exists.mp h i) + have coeff_sum (e : Fin 2 →₀ ℕ) : + (∑ k ∈ Finset.range (N + 1), + MvPolynomial.monomial (directionalExponent v N k) (q.coeff k)).coeff e = + ∑ k ∈ Finset.range (N + 1), + (MvPolynomial.monomial (directionalExponent v N k) (q.coeff k)).coeff e := by + have coeff_finset_sum (S : Finset ℕ) + (g : ℕ → MvPolynomial (Fin 2) A) : + (∑ k ∈ S, g k).coeff e = ∑ k ∈ S, (g k).coeff e := by + induction S using Finset.induction_on with + | empty => simp + | @insert a S ha ih => simp [ha, ih] + exact coeff_finset_sum _ _ + have htop : q.coeff N ≠ 0 := by + rw [← hqdeg] + rw [Polynomial.coeff_natDegree] + exact Polynomial.leadingCoeff_ne_zero.mpr fun hq => hq0 (by simp [hq]) + rcases lt_or_gt_of_ne hi.symm with hvi | hvi + · have hpos : 0 < intVectorPositive v i := by + simp only [intVectorPositive_apply] + apply Nat.pos_of_ne_zero + intro hz + have := Int.toNat_eq_zero.mp hz + omega + have hneg : intVectorNegative v i = 0 := by + simp [Int.toNat_of_nonpos (neg_nonpos.mpr (le_of_lt hvi))] + let e : Fin 2 →₀ ℕ := N • intVectorPositive v + have hcoeff : H.coeff e = q.coeff N := by + rw [hsum, coeff_sum e, Finset.sum_eq_single N] + · rw [MvPolynomial.coeff_monomial] + simp [e, directionalExponent] + · intro k hk hkN + rw [MvPolynomial.coeff_monomial] + split_ifs with heq + · have hcoord := congrArg (fun d : Fin 2 →₀ ℕ => d i) heq + dsimp [e] at hcoord + simp only [directionalExponent, Finsupp.add_apply, Finsupp.smul_apply, + nsmul_eq_mul] at hcoord + rw [hneg] at hcoord + simp only [mul_zero, add_zero] at hcoord + exact (hkN (Nat.eq_of_mul_eq_mul_right hpos hcoord)).elim + · rfl + · simp + have he_mem : e ∈ H.support := MvPolynomial.mem_support_iff.mpr (hcoeff ▸ htop) + have hei : 0 < e i := by + simp only [e, Finsupp.smul_apply, nsmul_eq_mul] + exact Nat.mul_pos hN hpos + have htotal : 0 < H.totalDegree := + lt_of_lt_of_le hei <| (MvPolynomial.le_degreeOf_of_mem_support i he_mem).trans + (MvPolynomial.degreeOf_le_totalDegree H i) + intro hunit + have hdvd : H ∣ (1 : MvPolynomial (Fin 2) A) := hunit.dvd + have hle := MvPolynomial.totalDegree_le_of_dvd_of_isDomain hdvd one_ne_zero + rw [MvPolynomial.totalDegree_one] at hle + omega + · have hneg : 0 < intVectorNegative v i := by + have hvneg : v i < 0 := hvi + simp only [intVectorNegative_apply] + apply Nat.pos_of_ne_zero + intro hz + have := Int.toNat_eq_zero.mp hz + omega + have hpos : intVectorPositive v i = 0 := by + simp [Int.toNat_of_nonpos (le_of_lt hvi)] + let e : Fin 2 →₀ ℕ := N • intVectorNegative v + have hcoeff : H.coeff e = q.coeff 0 := by + rw [hsum, coeff_sum e, Finset.sum_eq_single 0] + · rw [MvPolynomial.coeff_monomial] + simp [e, directionalExponent] + · intro k hk hk0 + rw [MvPolynomial.coeff_monomial] + split_ifs with heq + · have hcoord := congrArg (fun d : Fin 2 →₀ ℕ => d i) heq + dsimp [e] at hcoord + simp only [directionalExponent, Finsupp.add_apply, Finsupp.smul_apply, + nsmul_eq_mul] at hcoord + rw [hpos] at hcoord + simp only [mul_zero, zero_add] at hcoord + have hk_le : k ≤ N := Nat.le_of_lt_succ (Finset.mem_range.mp hk) + have hsub : N - k = N := Nat.eq_of_mul_eq_mul_right hneg hcoord + have hkzero : k = 0 := by omega + exact (hk0 hkzero).elim + · rfl + · simp + have he_mem : e ∈ H.support := MvPolynomial.mem_support_iff.mpr (hcoeff ▸ hq0) + have hei : 0 < e i := by + simp only [e, Finsupp.smul_apply, nsmul_eq_mul] + exact Nat.mul_pos hN hneg + have htotal : 0 < H.totalDegree := + lt_of_lt_of_le hei <| (MvPolynomial.le_degreeOf_of_mem_support i he_mem).trans + (MvPolynomial.degreeOf_le_totalDegree H i) + intro hunit + have hdvd : H ∣ (1 : MvPolynomial (Fin 2) A) := hunit.dvd + have hle := MvPolynomial.totalDegree_le_of_dvd_of_isDomain hdvd one_ne_zero + rw [MvPolynomial.totalDegree_one] at hle + omega + +private theorem exists_directionalPolynomial_representation + {A : Type*} [Field A] {F : MvPolynomial (Fin 2) A} + {r : Fin 2 →₀ ℕ} (hr : r ∈ F.support) + {v : Fin 2 → ℤ} (_hvne : v ≠ 0) + (hparam : ∀ s ∈ F.support, ∃ k : ℤ, + planeExponentDifference r s = k • v) + (hnonsingleton : ∃ s ∈ F.support, s ≠ r) : + ∃ (q : Polynomial A) (N : ℕ) (w : Fin 2 →₀ ℕ), + 0 < N ∧ q.natDegree = N ∧ q.coeff 0 ≠ 0 ∧ + F = MvPolynomial.monomial w 1 * + directionalHomogenization v q N := by + let parameter : (Fin 2 →₀ ℕ) → ℤ := fun s => + if hs : s ∈ F.support then Classical.choose (hparam s hs) else 0 + have parameter_spec : ∀ s ∈ F.support, + planeExponentDifference r s = parameter s • v := by + intro s hs + simp only [parameter, dif_pos hs] + exact Classical.choose_spec (hparam s hs) + have parameter_inj : ∀ {s t}, s ∈ F.support → t ∈ F.support → + parameter s = parameter t → s = t := by + intro s t hs ht heq + have hdiff : planeExponentDifference r s = planeExponentDifference r t := by + rw [parameter_spec s hs, parameter_spec t ht, heq] + apply Finsupp.ext + intro i + have hi := congrFun hdiff i + dsimp [planeExponentDifference] at hi + omega + let P : Finset ℤ := F.support.image parameter + have hP : P.Nonempty := by + rw [Finset.image_nonempty] + exact ⟨r, hr⟩ + let lo : ℤ := P.min' hP + let hi : ℤ := P.max' hP + have hlo_mem : lo ∈ P := Finset.min'_mem P hP + have hhi_mem : hi ∈ P := Finset.max'_mem P hP + obtain ⟨slo, hslo, hslo_param⟩ := Finset.mem_image.mp hlo_mem + obtain ⟨shi, hshi, hshi_param⟩ := Finset.mem_image.mp hhi_mem + have parameter_bounds : ∀ s ∈ F.support, lo ≤ parameter s ∧ parameter s ≤ hi := by + intro s hs + constructor + · exact Finset.min'_le P (parameter s) (Finset.mem_image.mpr ⟨s, hs, rfl⟩) + · exact Finset.le_max' P (parameter s) (Finset.mem_image.mpr ⟨s, hs, rfl⟩) + let index : (Fin 2 →₀ ℕ) → ℕ := fun s => (parameter s - lo).toNat + let N : ℕ := (hi - lo).toNat + have index_cast : ∀ s ∈ F.support, (index s : ℤ) = parameter s - lo := by + intro s hs + rw [show (index s : ℤ) = max (parameter s - lo) 0 by + simpa [index] using Int.ofNat_toNat (parameter s - lo)] + simp [parameter_bounds s hs |>.1] + have N_cast : (N : ℤ) = hi - lo := by + rw [show (N : ℤ) = max (hi - lo) 0 by + simpa [N] using Int.ofNat_toNat (hi - lo)] + have hlohi : lo ≤ hi := Finset.min'_le P hi hhi_mem + simp [hlohi] + have index_le : ∀ s ∈ F.support, index s ≤ N := by + intro s hs + have hcast : (index s : ℤ) ≤ (N : ℤ) := by + rw [index_cast s hs, N_cast] + exact sub_le_sub_right (parameter_bounds s hs).2 lo + exact_mod_cast hcast + have index_inj : ∀ {s t}, s ∈ F.support → t ∈ F.support → + index s = index t → s = t := by + intro s t hs ht heq + apply parameter_inj hs ht + have := congrArg (fun n : ℕ => (n : ℤ)) heq + rw [index_cast s hs, index_cast t ht] at this + omega + have hindex_slo : index slo = 0 := by + simp [index, hslo_param] + have hindex_shi : index shi = N := by + have h := index_cast shi hshi + rw [hshi_param, ← N_cast] at h + exact_mod_cast h + have hlohi : lo < hi := by + obtain ⟨s, hs, hsr⟩ := hnonsingleton + by_contra hnot + have hhile : hi ≤ lo := le_of_not_gt hnot + have hparam_eq : parameter s = parameter r := by + apply le_antisymm + · exact (parameter_bounds s hs).2.trans hhile |>.trans (parameter_bounds r hr).1 + · exact (parameter_bounds r hr).2.trans hhile |>.trans (parameter_bounds s hs).1 + exact hsr (parameter_inj hs hr hparam_eq) + let q : Polynomial A := + ∑ s ∈ F.support, Polynomial.monomial (index s) (MvPolynomial.coeff s F) + have coeff_finset_sum (n : ℕ) (S : Finset (Fin 2 →₀ ℕ)) + (g : (Fin 2 →₀ ℕ) → Polynomial A) : + (∑ s ∈ S, g s).coeff n = ∑ s ∈ S, (g s).coeff n := by + induction S using Finset.induction_on with + | empty => simp + | @insert a S ha ih => simp [ha, ih, Polynomial.coeff_add] + have coeff_q_index : ∀ s ∈ F.support, + q.coeff (index s) = MvPolynomial.coeff s F := by + intro s hs + rw [show q.coeff (index s) = + ∑ t ∈ F.support, + (Polynomial.monomial (index t) (MvPolynomial.coeff t F)).coeff (index s) by + simpa [q] using coeff_finset_sum (index s) F.support + (fun t => Polynomial.monomial (index t) (MvPolynomial.coeff t F))] + rw [Finset.sum_eq_single s] + · rw [Polynomial.coeff_monomial, if_pos rfl] + · intro t ht hts + rw [Polynomial.coeff_monomial] + simp only [ite_eq_right_iff] + intro hit + exfalso + exact hts (index_inj ht hs hit) + · intro hnot + exact (hnot hs).elim + have hNpos : 0 < N := by + have hcast : (0 : ℤ) < (N : ℤ) := by + rw [N_cast] + exact sub_pos.mpr hlohi + exact_mod_cast hcast + have hqN : q.coeff N ≠ 0 := by + rw [← hindex_shi, coeff_q_index shi hshi] + exact MvPolynomial.mem_support_iff.mp hshi + have hqdeg_ge : N ≤ q.natDegree := Polynomial.le_natDegree_of_ne_zero hqN + have hqdeg_le : q.natDegree ≤ N := by + rw [Polynomial.natDegree_le_iff_coeff_eq_zero] + intro n hn + rw [show q.coeff n = + ∑ s ∈ F.support, + (Polynomial.monomial (index s) (MvPolynomial.coeff s F)).coeff n by + simpa [q] using coeff_finset_sum n F.support + (fun s => Polynomial.monomial (index s) (MvPolynomial.coeff s F))] + simp only [Polynomial.coeff_monomial] + apply Finset.sum_eq_zero + intro s hs + simp only [ite_eq_right_iff] + intro hisn + subst n + exact (Nat.not_lt_of_ge (index_le s hs) hn).elim + have hqdeg : q.natDegree = N := Nat.le_antisymm hqdeg_le hqdeg_ge + have hq0 : q.coeff 0 ≠ 0 := by + rw [← hindex_slo, coeff_q_index slo hslo] + exact MvPolynomial.mem_support_iff.mp hslo + have support_coordinate : ∀ s ∈ F.support, ∀ i : Fin 2, + (s i : ℤ) - (slo i : ℤ) = (index s : ℤ) * v i := by + intro s hs i + have hs_eq := congrFun (parameter_spec s hs) i + have hlo_eq := congrFun (parameter_spec slo hslo) i + change (s i : ℤ) - (r i : ℤ) = parameter s * v i at hs_eq + change (slo i : ℤ) - (r i : ℤ) = parameter slo * v i at hlo_eq + rw [hslo_param] at hlo_eq + rw [index_cast s hs] + calc + (s i : ℤ) - (slo i : ℤ) = + ((s i : ℤ) - (r i : ℤ)) - ((slo i : ℤ) - (r i : ℤ)) := by ring + _ = parameter s * v i - lo * v i := by rw [hs_eq, hlo_eq] + _ = (parameter s - lo) * v i := by ring + have positive_sub_negative (i : Fin 2) : + (intVectorPositive v i : ℤ) - (intVectorNegative v i : ℤ) = v i := by + simp only [intVectorPositive_apply, intVectorNegative_apply] + rw [Int.ofNat_toNat, Int.ofNat_toNat] + rcases le_total 0 (v i) with hvi | hvi + · simp [hvi, neg_nonpos.mpr hvi] + · simp [hvi] + have negative_le_slo (i : Fin 2) : + N * intVectorNegative v i ≤ slo i := by + by_cases hvi : 0 ≤ v i + · have hneg : (-v i).toNat = 0 := Int.toNat_of_nonpos (neg_nonpos.mpr hvi) + simp [intVectorNegative_apply, hneg] + · have hvineg : v i < 0 := lt_of_not_ge hvi + have hcoord := support_coordinate shi hshi i + rw [hindex_shi] at hcoord + have hnegcast : (intVectorNegative v i : ℤ) = -v i := by + simp only [intVectorNegative_apply] + rw [Int.ofNat_toNat] + simp [le_of_lt hvineg] + have hcast : ((N * intVectorNegative v i : ℕ) : ℤ) ≤ (slo i : ℤ) := by + push_cast + rw [hnegcast] + have hshi_nonneg : (0 : ℤ) ≤ (shi i : ℤ) := by positivity + nlinarith + exact_mod_cast hcast + let w : Fin 2 →₀ ℕ := + Finsupp.equivFunOnFinite.symm + (fun i => slo i - N * intVectorNegative v i) + have w_apply (i : Fin 2) : + w i = slo i - N * intVectorNegative v i := by + simp [w] + have exponent_eq : ∀ s ∈ F.support, + s = w + index s • intVectorPositive v + + (N - index s) • intVectorNegative v := by + intro s hs + apply Finsupp.ext + intro i + have hk := index_le s hs + have hwcast : (w i : ℤ) = + (slo i : ℤ) - (N : ℤ) * (intVectorNegative v i : ℤ) := by + rw [w_apply, Nat.cast_sub (negative_le_slo i)] + push_cast + rfl + have hcoord := support_coordinate s hs i + have hpn := positive_sub_negative i + have hcast : (s i : ℤ) = + (w i : ℤ) + (index s : ℤ) * (intVectorPositive v i : ℤ) + + ((N - index s : ℕ) : ℤ) * (intVectorNegative v i : ℤ) := by + rw [Nat.cast_sub hk] + nlinarith + exact_mod_cast hcast + refine ⟨q, N, w, hNpos, hqdeg, hq0, ?_⟩ + rw [← F.support_sum_monomial_coeff] + have hhomog : directionalHomogenization v q N = + ∑ s ∈ F.support, + directionalHomogenization v + (Polynomial.monomial (index s) (MvPolynomial.coeff s F)) N := by + simp only [q, directionalHomogenization, + Polynomial.homogenize_finsetSum, map_sum] + rw [hhomog, Finset.mul_sum] + apply Finset.sum_congr rfl + intro s hs + rw [directionalHomogenization_monomial v (index_le s hs)] + rw [MvPolynomial.monomial_mul] + simp only [one_mul] + apply congrArg (fun e => MvPolynomial.monomial e (MvPolynomial.coeff s F)) + simpa [add_assoc] using exponent_eq s hs + +private theorem directionalPolynomial_degree_eq_one_of_irreducible + {A : Type*} [Field A] [IsAlgClosed A] + {F : MvPolynomial (Fin 2) A} (hF : Irreducible F) + {v : Fin 2 → ℤ} (hvne : v ≠ 0) + {q : Polynomial A} {N : ℕ} {w : Fin 2 →₀ ℕ} + (hN : 0 < N) (hqdeg : q.natDegree = N) (hq0 : q.coeff 0 ≠ 0) + (hrep : F = MvPolynomial.monomial w 1 * + directionalHomogenization v q N) : + N = 1 := by + let H := directionalHomogenization v q N + have hHnonunit : ¬ IsUnit H := + directionalHomogenization_not_isUnit hvne hN hqdeg hq0 + have hwunit : IsUnit (MvPolynomial.monomial w (1 : A)) := + (hF.isUnit_or_isUnit hrep).resolve_right hHnonunit + have hHirr : Irreducible H := by + have hprod : Irreducible (MvPolynomial.monomial w (1 : A) * H) := by + rw [← hrep] + exact hF + exact (irreducible_isUnit_mul hwunit).mp hprod + by_contra hN1 + have hNone : 1 < N := + lt_of_le_of_ne (Nat.succ_le_iff.mpr hN) (Ne.symm hN1) + have hqne : q ≠ 0 := fun hq => hq0 (by simp [hq]) + have hqdegree : q.degree ≠ 0 := by + have hposNat : 0 < q.natDegree := by rw [hqdeg]; exact hN + exact ne_of_gt (Polynomial.natDegree_pos_iff_degree_pos.mp hposNat) + obtain ⟨c, hcroot⟩ := IsAlgClosed.exists_root q hqdegree + obtain ⟨q₂, hqfac⟩ := Polynomial.dvd_iff_isRoot.mpr hcroot + have hlinear_ne : Polynomial.X - Polynomial.C c ≠ (0 : Polynomial A) := + Polynomial.X_sub_C_ne_zero c + have hq₂ne : q₂ ≠ 0 := by + intro hq₂ + apply hqne + rw [hqfac, hq₂, mul_zero] + have hq₂deg : q₂.natDegree = N - 1 := by + have hmul := Polynomial.natDegree_mul hlinear_ne hq₂ne + rw [Polynomial.natDegree_X_sub_C, ← hqfac, hqdeg] at hmul + omega + have hcne : c ≠ 0 := by + intro hc + apply hq0 + rw [hqfac, hc] + simp [Polynomial.coeff_mul] + have hq₂0 : q₂.coeff 0 ≠ 0 := by + intro hq₂zero + apply hq0 + rw [hqfac] + simp [Polynomial.coeff_mul, hq₂zero] + have hlinear0 : (Polynomial.X - Polynomial.C c).coeff 0 ≠ 0 := by + simp [hcne] + have hlinear_deg : (Polynomial.X - Polynomial.C c).natDegree = 1 := + Polynomial.natDegree_X_sub_C c + have hq₂pos : 0 < N - 1 := by omega + have hleft_nonunit : + ¬ IsUnit (directionalHomogenization v (Polynomial.X - Polynomial.C c) 1) := + directionalHomogenization_not_isUnit hvne Nat.zero_lt_one hlinear_deg hlinear0 + have hright_nonunit : + ¬ IsUnit (directionalHomogenization v q₂ (N - 1)) := + directionalHomogenization_not_isUnit hvne hq₂pos hq₂deg hq₂0 + have hHfac : H = + directionalHomogenization v (Polynomial.X - Polynomial.C c) 1 * + directionalHomogenization v q₂ (N - 1) := by + dsimp [H] + rw [hqfac] + have hsumN : 1 + (N - 1) = N := by omega + simpa [hsumN] using + (directionalHomogenization_mul v (Polynomial.X - Polynomial.C c) q₂ + (m := 1) (n := N - 1) (by rw [hlinear_deg]) (by rw [hq₂deg])) + exact (hHirr.isUnit_or_isUnit hHfac).elim hleft_nonunit hright_nonunit + +private theorem directionalHomogenization_natDegree_one + {A : Type*} [Field A] {v : Fin 2 → ℤ} {q : Polynomial A} + (hqdeg : q.natDegree = 1) : + directionalHomogenization v q 1 = + MvPolynomial.monomial (intVectorNegative v) (q.coeff 0) + + MvPolynomial.monomial (intVectorPositive v) (q.coeff 1) := by + have hqsum : q = Polynomial.monomial 0 (q.coeff 0) + + Polynomial.monomial 1 (q.coeff 1) := by + rw [q.as_sum_range, hqdeg] + simp [Finset.sum_range_succ] + calc + directionalHomogenization v q 1 = + directionalHomogenization v + (Polynomial.monomial 0 (q.coeff 0) + + Polynomial.monomial 1 (q.coeff 1)) 1 := by rw [← hqsum] + _ = directionalHomogenization v (Polynomial.monomial 0 (q.coeff 0)) 1 + + directionalHomogenization v (Polynomial.monomial 1 (q.coeff 1)) 1 := by + simp [directionalHomogenization, Polynomial.homogenize_add] + _ = _ := by + rw [directionalHomogenization_monomial v (Nat.zero_le 1), + directionalHomogenization_monomial v le_rfl] + simp + +private theorem eval_monomial_fin_two + {A : Type*} [CommSemiring A] (z : Fin 2 → A) + (e : Fin 2 →₀ ℕ) (c : A) : + MvPolynomial.eval z (MvPolynomial.monomial e c) = + c * z 0 ^ e 0 * z 1 ^ e 1 := by + rw [MvPolynomial.eval_monomial, Finsupp.prod_fintype] + · simp [Fin.prod_univ_two, mul_assoc] + · intro i + simp + +private theorem torusCharacter_eq_of_directional_linear_representation + {A : Type*} [Field A] + {F : MvPolynomial (Fin 2) A} {v : Fin 2 → ℤ} {q : Polynomial A} + {w : Fin 2 →₀ ℕ} (hqdeg : q.natDegree = 1) (hq0 : q.coeff 0 ≠ 0) + (hrep : F = MvPolynomial.monomial w 1 * + directionalHomogenization v q 1) + (x y : Aˣ) + (hzero : MvPolynomial.eval ![(x : A), (y : A)] F = 0) : + x ^ v 0 * y ^ v 1 = + Units.mk0 (-(q.coeff 0 / q.coeff 1)) (by + have hqne : q ≠ 0 := fun hq => hq0 (by simp [hq]) + have hq1 : q.coeff 1 ≠ 0 := by + rw [← hqdeg, Polynomial.coeff_natDegree] + exact Polynomial.leadingCoeff_ne_zero.mpr hqne + exact neg_ne_zero.mpr (div_ne_zero hq0 hq1)) := by + have hqne : q ≠ 0 := fun hq => hq0 (by simp [hq]) + have hq1 : q.coeff 1 ≠ 0 := by + rw [← hqdeg, Polynomial.coeff_natDegree] + exact Polynomial.leadingCoeff_ne_zero.mpr hqne + have hx : (x : A) ≠ 0 := Units.ne_zero x + have hy : (y : A) ≠ 0 := Units.ne_zero y + have hmon : MvPolynomial.eval ![(x : A), (y : A)] + (MvPolynomial.monomial w (1 : A)) ≠ 0 := by + rw [eval_monomial_fin_two] + simp [hx, hy] + have hHzero : MvPolynomial.eval ![(x : A), (y : A)] + (directionalHomogenization v q 1) = 0 := by + rw [hrep, map_mul] at hzero + exact (mul_eq_zero.mp hzero).resolve_left hmon + rw [directionalHomogenization_natDegree_one hqdeg, map_add, + eval_monomial_fin_two, eval_monomial_fin_two] at hHzero + simp only [Matrix.cons_val_zero, Matrix.cons_val_one] at hHzero + let Apos : A := (x : A) ^ intVectorPositive v 0 * + (y : A) ^ intVectorPositive v 1 + let Aneg : A := (x : A) ^ intVectorNegative v 0 * + (y : A) ^ intVectorNegative v 1 + have hAneg : Aneg ≠ 0 := by + dsimp [Aneg] + exact mul_ne_zero (pow_ne_zero _ hx) (pow_ne_zero _ hy) + have hratio : Apos / Aneg = -(q.coeff 0 / q.coeff 1) := by + rw [← neg_div] + apply (div_eq_div_iff hAneg hq1).mpr + dsimp [Apos, Aneg] + linear_combination hHzero + have hvcoord (i : Fin 2) : + v i = (intVectorPositive v i : ℤ) - (intVectorNegative v i : ℤ) := by + exact (intVectorPositive_sub_negative v i).symm + calc + x ^ v 0 * y ^ v 1 = + (x ^ (intVectorPositive v 0 : ℤ) * + (x ^ (intVectorNegative v 0 : ℤ))⁻¹) * + (y ^ (intVectorPositive v 1 : ℤ) * + (y ^ (intVectorNegative v 1 : ℤ))⁻¹) := by + rw [hvcoord 0, hvcoord 1, zpow_sub, zpow_sub] + _ = (x ^ intVectorPositive v 0 * y ^ intVectorPositive v 1) * + (x ^ intVectorNegative v 0 * y ^ intVectorNegative v 1)⁻¹ := by + simp only [zpow_natCast] + simp only [mul_inv_rev] + ac_rfl + _ = Units.mk0 (-(q.coeff 0 / q.coeff 1)) (by + exact neg_ne_zero.mpr (div_ne_zero hq0 hq1)) := by + apply Units.ext + simpa [Apos, Aneg, div_eq_mul_inv] using hratio + +/-- Absolute irreducibility and the semantic non-subtorus condition force the +support lattice of a plane torus curve to have rank two. -/ +theorem planeCurveSupportHasRankTwo_of_absoluteIrreducible_notSubtorusTranslate + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hirr : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hnot : BGS.External.TorusCurveNotSubtorusTranslate f) : + PlaneCurveSupportHasRankTwo f := by + let A := AlgebraicClosure K + let F : MvPolynomial (Fin 2) A := + MvPolynomial.map (algebraMap K A) f + have hsupp : F.support = f.support := by + exact MvPolynomial.support_map_of_injective f + (algebraMap K A).injective + by_contra hnrank + have hnrankF : ¬ PlaneCurveSupportHasRankTwo F := by + intro hrankF + obtain ⟨r, s, t, hr, hs, ht, hdet⟩ := hrankF + apply hnrank + rw [hsupp] at hr hs ht + exact ⟨r, s, t, hr, hs, ht, hdet⟩ + obtain ⟨x₀, y₀, hzero₀, _⟩ := + hnot 1 0 (Or.inl one_ne_zero) (1 : Aˣ) + have hFne : F ≠ 0 := hirr.ne_zero + obtain ⟨r, hr⟩ := MvPolynomial.support_nonempty.mpr hFne + have hnonsingleton : ∃ s ∈ F.support, s ≠ r := by + by_contra hsingle' + have hsingle : ∀ s ∈ F.support, s = r := by + intro s hs + by_contra hsr + exact hsingle' ⟨s, hs, hsr⟩ + have hsupp_single : F.support = {r} := by + apply Finset.eq_singleton_iff_unique_mem.mpr + exact ⟨hr, fun s hs => hsingle s hs⟩ + have hFmono : F = MvPolynomial.monomial r (MvPolynomial.coeff r F) := by + rw [← F.support_sum_monomial_coeff, hsupp_single] + simp + have hcoeff : MvPolynomial.coeff r F ≠ 0 := + MvPolynomial.mem_support_iff.mp hr + have hx₀ : (x₀ : A) ≠ 0 := Units.ne_zero x₀ + have hy₀ : (y₀ : A) ≠ 0 := Units.ne_zero y₀ + change MvPolynomial.eval ![(x₀ : A), (y₀ : A)] F = 0 at hzero₀ + rw [hFmono, eval_monomial_fin_two] at hzero₀ + exact (mul_ne_zero (mul_ne_zero hcoeff (pow_ne_zero _ hx₀)) + (pow_ne_zero _ hy₀)) hzero₀ + obtain ⟨v, hvne, hparam⟩ := + exists_support_direction_of_not_rankTwo hr hnrankF hnonsingleton + obtain ⟨q, N, w, hN, hqdeg, hq0, hrep⟩ := + exists_directionalPolynomial_representation hr hvne hparam hnonsingleton + have hNone : N = 1 := + directionalPolynomial_degree_eq_one_of_irreducible hirr hvne hN hqdeg hq0 hrep + have hqdeg1 : q.natDegree = 1 := hqdeg.trans hNone + have hrep1 : F = MvPolynomial.monomial w 1 * + directionalHomogenization v q 1 := by simpa [hNone] using hrep + have hvcoords : v 0 ≠ 0 ∨ v 1 ≠ 0 := by + by_cases h0 : v 0 = 0 + · right + intro h1 + apply hvne + funext i + have hi : i = 0 ∨ i = 1 := by + have hilt := i.isLt + omega + rcases hi with rfl | rfl + · exact h0 + · exact h1 + · exact Or.inl h0 + let c : Aˣ := Units.mk0 (-(q.coeff 0 / q.coeff 1)) (by + have hqne : q ≠ 0 := fun hq => hq0 (by simp [hq]) + have hq1 : q.coeff 1 ≠ 0 := by + rw [← hqdeg1, Polynomial.coeff_natDegree] + exact Polynomial.leadingCoeff_ne_zero.mpr hqne + exact neg_ne_zero.mpr (div_ne_zero hq0 hq1)) + obtain ⟨x, y, hzero, hcharacter⟩ := hnot (v 0) (v 1) hvcoords c + apply hcharacter + exact torusCharacter_eq_of_directional_linear_representation hqdeg1 hq0 hrep1 x y hzero + +/-- Injective extension of coefficients preserves a rank-two support +certificate. -/ +theorem planeCurveSupportHasRankTwo_map_of_injective + {K E : Type*} [Field K] [Field E] + (ι : K →+* E) (hι : Function.Injective ι) + {f : MvPolynomial (Fin 2) K} + (hrank : PlaneCurveSupportHasRankTwo f) : + PlaneCurveSupportHasRankTwo (MvPolynomial.map ι f) := by + obtain ⟨r, s, t, hr, hs, ht, hdet⟩ := hrank + have hsupp : (MvPolynomial.map ι f).support = f.support := + MvPolynomial.support_map_of_injective f hι + refine ⟨r, s, t, ?_, ?_, ?_, hdet⟩ <;> simpa only [hsupp] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean new file mode 100644 index 0000000000..23d0d8b947 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean @@ -0,0 +1,486 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +import Mathlib.Algebra.Polynomial.RingDivision + +/-! +# An explicit relation between powered plane-curve coordinates + +Let `F = L^p`, `u = x^m`, and `v = y^n`. When `n` is prime to `p`, the +element `v` is a primitive element of `L / F`. Its power basis therefore +writes `u` as a unique polynomial `P(v)` of degree less than `p`. This file +constructs that polynomial and the linear elimination relation + +`G(U,V) = U - P(V)`. + +The relation is irreducible over `F[V]`, has exact bidegree +`(1, degree P)`, satisfies the coefficient-degree bound used by the +Corvaja--Zannier resultant argument, and vanishes at `(u,v)`. The final +theorem feeds these facts into Proposition 1 without leaving an unspecified +relation polynomial as a hypothesis. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {F L : Type*} [Field F] [Field L] [Algebra F L] + +/-- The unique bounded-degree coordinate polynomial of `u` in a chosen power +basis generated by `v`. -/ +noncomputable def powerBasisCoordinatePolynomial + (pb : PowerBasis F L) (u : L) : Polynomial F := + Classical.choose (pb.exists_eq_aeval u) + +theorem powerBasisCoordinatePolynomial_natDegree_lt + (pb : PowerBasis F L) (u : L) : + (powerBasisCoordinatePolynomial pb u).natDegree < pb.dim := + (Classical.choose_spec (pb.exists_eq_aeval u)).1 + +theorem powerBasisCoordinatePolynomial_aeval + (pb : PowerBasis F L) (u : L) : + u = Polynomial.aeval pb.gen (powerBasisCoordinatePolynomial pb u) := + (Classical.choose_spec (pb.exists_eq_aeval u)).2 + +theorem powerBasisCoordinatePolynomial_natDegree_pos_of_not_mem_range + (pb : PowerBasis F L) (u : L) + (hu : u ∉ Set.range (algebraMap F L)) : + 0 < (powerBasisCoordinatePolynomial pb u).natDegree := by + apply Nat.pos_of_ne_zero + intro hdegree + have hconstant := Polynomial.eq_C_of_natDegree_eq_zero hdegree + apply hu + refine ⟨(powerBasisCoordinatePolynomial pb u).coeff 0, ?_⟩ + calc + algebraMap F L ((powerBasisCoordinatePolynomial pb u).coeff 0) = + Polynomial.aeval pb.gen + (Polynomial.C ((powerBasisCoordinatePolynomial pb u).coeff 0)) := by simp + _ = Polynomial.aeval pb.gen (powerBasisCoordinatePolynomial pb u) := by + exact congrArg (Polynomial.aeval pb.gen) hconstant.symm + _ = u := (powerBasisCoordinatePolynomial_aeval pb u).symm + +/-- The linear elimination relation `U - P(V)`. -/ +def powerBasisEliminationRelation (pb : PowerBasis F L) (u : L) : + Polynomial (Polynomial F) := + Polynomial.X - Polynomial.C (powerBasisCoordinatePolynomial pb u) + +theorem powerBasisEliminationRelation_irreducible + (pb : PowerBasis F L) (u : L) : + Irreducible (powerBasisEliminationRelation pb u) := by + exact Polynomial.irreducible_X_sub_C _ + +theorem powerBasisEliminationRelation_natDegree + (pb : PowerBasis F L) (u : L) : + (powerBasisEliminationRelation pb u).natDegree = 1 := by + exact Polynomial.natDegree_X_sub_C _ + +theorem transpose_powerBasisEliminationRelation + (pb : PowerBasis F L) (u : L) : + transposeBivariate (powerBasisEliminationRelation pb u) = + Polynomial.C Polynomial.X - + (powerBasisCoordinatePolynomial pb u).map Polynomial.C := by + simp [powerBasisEliminationRelation, transposeBivariate] + +theorem transpose_powerBasisEliminationRelation_natDegree + (pb : PowerBasis F L) (u : L) : + (transposeBivariate (powerBasisEliminationRelation pb u)).natDegree = + (powerBasisCoordinatePolynomial pb u).natDegree := by + rw [transpose_powerBasisEliminationRelation] + let P := powerBasisCoordinatePolynomial pb u + have hmap : (P.map Polynomial.C).natDegree = P.natDegree := by + rw [Polynomial.natDegree_map_eq_of_injective Polynomial.C_injective] + by_cases hP : P.natDegree = 0 + · change (Polynomial.C Polynomial.X - P.map Polynomial.C).natDegree = P.natDegree + rw [hP] + apply Nat.eq_zero_of_le_zero + exact (Polynomial.natDegree_sub_le _ _).trans (by simp [hP, hmap]) + · have hlt : (Polynomial.C Polynomial.X : Polynomial (Polynomial F)).natDegree < + (P.map Polynomial.C).natDegree := by + rw [hmap] + simpa using Nat.pos_of_ne_zero hP + rw [Polynomial.natDegree_sub_eq_right_of_natDegree_lt hlt, hmap] + +theorem powerBasisEliminationRelation_coeff_natDegree_le + (pb : PowerBasis F L) (u : L) (i : ℕ) : + ((powerBasisEliminationRelation pb u).coeff i).natDegree ≤ + (powerBasisCoordinatePolynomial pb u).natDegree := by + by_cases hi : i = 0 + · subst i + simp [powerBasisEliminationRelation] + · rw [powerBasisEliminationRelation, Polynomial.coeff_sub, + Polynomial.coeff_C_of_ne_zero hi] + by_cases hi1 : i = 1 + · subst i + simp + · rw [Polynomial.coeff_X_of_ne_one hi1] + simp + +theorem evalBivariate_powerBasisEliminationRelation + (pb : PowerBasis F L) (u : L) : + evalBivariate pb.gen u (powerBasisEliminationRelation pb u) = 0 := by + rw [powerBasisEliminationRelation] + unfold evalBivariate + rw [Polynomial.eval₂_sub, Polynomial.eval₂_X, Polynomial.eval₂_C] + change u - Polynomial.aeval pb.gen (powerBasisCoordinatePolynomial pb u) = 0 + rw [← powerBasisCoordinatePolynomial_aeval pb u, sub_self] + +/-- The canonical Frobenius power basis generated by the powered second +coordinate of an irreducible plane curve. -/ +noncomputable def secondPoweredCoordinateFrobeniusPowerBasis + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + PowerBasis (frobeniusSubfield (PlaneCurveFunctionField f) p) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + letI : IsPurelyInseparable F L := + frobeniusSubfield_isPurelyInseparable p + let v : L := (planeCurveFunction f 1) ^ n + have hvTop : IntermediateField.adjoin F {v} = ⊤ := by + simpa [F, L, v] using + (adjoin_frobeniusSubfield_secondCoordinatePow_eq_top + hf hpartialFirst n hn) + have hvIntegral : IsIntegral F v := + IsPurelyInseparable.isIntegral' F v + let pb : PowerBasis F L := PowerBasis.ofAdjoinEqTop hvIntegral + (Algebra.adjoin_eq_top_of_primitive_element + hvIntegral.isAlgebraic hvTop) + simpa [F, L] using pb + +theorem secondPoweredCoordinateFrobeniusPowerBasis_gen + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn).gen = + (planeCurveFunction f 1) ^ n := by + simp [secondPoweredCoordinateFrobeniusPowerBasis] + +theorem secondPoweredCoordinateFrobeniusPowerBasis_dim + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn).dim = p := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + rw [secondPoweredCoordinateFrobeniusPowerBasis, + PowerBasis.ofAdjoinEqTop_dim] + exact minpoly_secondCoordinatePow_natDegree_eq_char + hf hpartialFirst n hn + +/-- The bounded polynomial in `y^n` representing `x^m` over the Frobenius +subfield. -/ +noncomputable def poweredCoordinateExpansionPolynomial + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + Polynomial (frobeniusSubfield (PlaneCurveFunctionField f) p) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact powerBasisCoordinatePolynomial + (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn) + ((planeCurveFunction f 0) ^ m) + +theorem poweredCoordinateExpansionPolynomial_natDegree_lt_char + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree < p := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + calc + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree < + (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn).dim := by + exact powerBasisCoordinatePolynomial_natDegree_lt _ _ + _ = p := secondPoweredCoordinateFrobeniusPowerBasis_dim + hf hpartialFirst n hn + +theorem poweredCoordinateExpansionPolynomial_aeval + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (planeCurveFunction f 0) ^ m = + Polynomial.aeval ((planeCurveFunction f 1) ^ n) + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + rw [← secondPoweredCoordinateFrobeniusPowerBasis_gen + hf hpartialFirst n hn] + exact powerBasisCoordinatePolynomial_aeval _ _ + +/-- The explicit bivariate elimination relation +`U - P_{m,n}(V)` between `x^m` and `y^n`. -/ +noncomputable def poweredCoordinateEliminationRelation + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + Polynomial (Polynomial + (frobeniusSubfield (PlaneCurveFunctionField f) p)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact powerBasisEliminationRelation + (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn) + ((planeCurveFunction f 0) ^ m) + +theorem poweredCoordinateEliminationRelation_irreducible + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + Irreducible + (poweredCoordinateEliminationRelation hf hpartialFirst m n hn) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact powerBasisEliminationRelation_irreducible _ _ + +theorem poweredCoordinateEliminationRelation_natDegree + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (poweredCoordinateEliminationRelation hf hpartialFirst m n hn).natDegree = 1 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact powerBasisEliminationRelation_natDegree _ _ + +theorem transpose_poweredCoordinateEliminationRelation_natDegree + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (transposeBivariate + (poweredCoordinateEliminationRelation hf hpartialFirst m n hn)).natDegree = + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact transpose_powerBasisEliminationRelation_natDegree _ _ + +theorem poweredCoordinateEliminationRelation_coeff_natDegree_le + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) (i : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ((poweredCoordinateEliminationRelation hf hpartialFirst m n hn).coeff i).natDegree ≤ + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact powerBasisEliminationRelation_coeff_natDegree_le _ _ i + +theorem evalBivariate_poweredCoordinateEliminationRelation + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + evalBivariate ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) + (poweredCoordinateEliminationRelation hf hpartialFirst m n hn) = 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + rw [← secondPoweredCoordinateFrobeniusPowerBasis_gen + hf hpartialFirst n hn] + exact evalBivariate_powerBasisEliminationRelation _ _ + +/-- If both powered coordinates are separating, the second bidegree of the +linear elimination relation is positive as well as strictly below `p`. -/ +theorem poweredCoordinateExpansionPolynomial_natDegree_pos + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : ¬ p ∣ m) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + 0 < (poweredCoordinateExpansionPolynomial + hf hpartialFirst m n hn).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let x : L := planeCurveFunction f 0 + have hsep := (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep + letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) x + have hxTrans : Transcendental K x := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hx0 : x ≠ 0 := by + intro hx + apply hxTrans + rw [hx] + exact isAlgebraic_zero + have hxNot : x ∉ F := firstCoordinate_not_mem_frobeniusSubfield + hf hpartialSecond + have hxmNot : x ^ m ∉ F := frobeniusPower_not_mem + x hx0 hxNot m hm + have hxmRange : x ^ m ∉ Set.range (algebraMap F L) := by + rintro ⟨c, hc⟩ + apply hxmNot + rw [← hc] + exact c.property + exact powerBasisCoordinatePolynomial_natDegree_pos_of_not_mem_range + (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn) + (x ^ m) hxmRange + +/-- Proposition 1 for powered plane coordinates with the defining relation +constructed internally. The only remaining numerical hypotheses refer to +the actual second degree of the canonical elimination polynomial. -/ +theorem poweredCoordinates_auxiliaryFamily_linearIndependent_of_elimination + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) (h k : ℕ) + (hh : 0 < h) (hk : 0 < k) + (hsize : h + + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree * k < p) + (hdegree : h < + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) h k) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + exact poweredCoordinates_auxiliaryFamily_linearIndependent_of_relation + hf hpartialFirst m n hn + (poweredCoordinateEliminationRelation hf hpartialFirst m n hn) + 1 + (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree + h k Nat.zero_lt_one hh hk + (poweredCoordinateEliminationRelation_irreducible + hf hpartialFirst m n hn) + (poweredCoordinateEliminationRelation_natDegree + hf hpartialFirst m n hn) + (transpose_poweredCoordinateEliminationRelation_natDegree + hf hpartialFirst m n hn) + (poweredCoordinateEliminationRelation_coeff_natDegree_le + hf hpartialFirst m n hn) + (evalBivariate_poweredCoordinateEliminationRelation + hf hpartialFirst m n hn) + (by simpa using hsize) + (by + intro hdegrees + exact (Nat.not_le_of_lt hdegree) hdegrees.2) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean new file mode 100644 index 0000000000..1c099a9bf4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean @@ -0,0 +1,503 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import Mathlib.RingTheory.Coprime.Lemmas + +/-! +# Prime-to-characteristic powers of plane-curve coordinates + +Corvaja--Zannier's plane torsion corollary applies the function-field theorem +to powers of the two coordinate functions. This file makes the algebraic +part of that passage explicit. A positive power preserves the geometric +nonconstancy of every character. If the exponent is prime to the +characteristic, a separating coordinate power generates the function field +over its Frobenius subfield, has nonzero differential, and has minimal +polynomial of degree exactly the characteristic. + +The last theorem applies the already-proved resultant form of Proposition 1 +to powered coordinates once an explicit irreducible relation between those +powers is supplied. Constructing that elimination relation, and controlling +its bidegrees, remains a separate algebraic-geometric step; it is not assumed +implicitly here. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- No nontrivial character in the powered coordinates is constant on the +geometric torus curve. -/ +def PoweredTorusCurveNotSubtorusTranslate + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + (m n : ℕ) : Prop := + ∀ (a b : ℤ), (a ≠ 0 ∨ b ≠ 0) → + ∀ c : (AlgebraicClosure K)ˣ, + ∃ x y : (AlgebraicClosure K)ˣ, + MvPolynomial.eval ![(x : AlgebraicClosure K), + (y : AlgebraicClosure K)] + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f) = 0 ∧ + (x ^ m) ^ a * (y ^ n) ^ b ≠ c + +/-- Positive coordinate powers preserve the source's multiplicative +independence-modulo-constants condition. -/ +theorem poweredTorusCurveNotSubtorusTranslate + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + {m n : ℕ} (hm : 0 < m) (hn : 0 < n) + (hnot : BGS.External.TorusCurveNotSubtorusTranslate f) : + PoweredTorusCurveNotSubtorusTranslate f m n := by + intro a b hab c + have hm0 : (m : ℤ) ≠ 0 := by exact_mod_cast hm.ne' + have hn0 : (n : ℤ) ≠ 0 := by exact_mod_cast hn.ne' + have hab' : (m : ℤ) * a ≠ 0 ∨ (n : ℤ) * b ≠ 0 := by + rcases hab with ha | hb + · exact Or.inl (mul_ne_zero hm0 ha) + · exact Or.inr (mul_ne_zero hn0 hb) + obtain ⟨x, y, hcurve, hcharacter⟩ := + hnot ((m : ℤ) * a) ((n : ℤ) * b) hab' c + refine ⟨x, y, hcurve, ?_⟩ + simpa only [← zpow_natCast, ← zpow_mul] using hcharacter + +/-- If `m` is coprime to `p`, adjoining `z ^ m` is the same as adjoining +`z`, provided the `p`-th power of `z` is already in the smaller field. + +The reverse inclusion is the explicit Bézout identity +`a * m + b * p = 1`, interpreted using integer powers in the ambient field. -/ +theorem adjoin_pow_eq_adjoin_of_coprime + {F L : Type*} [Field F] [Field L] [Algebra F L] + (z : L) (hz : z ≠ 0) (p m : ℕ) (hcop : Nat.Coprime m p) + (hzp : z ^ p ∈ IntermediateField.adjoin F ({z ^ m} : Set L)) : + IntermediateField.adjoin F ({z ^ m} : Set L) = + IntermediateField.adjoin F ({z} : Set L) := by + apply le_antisymm + · apply IntermediateField.adjoin_le_iff.mpr + intro x hx + rw [Set.mem_singleton_iff] at hx + subst x + exact pow_mem (IntermediateField.subset_adjoin F {z} (Set.mem_singleton z)) m + · apply IntermediateField.adjoin_le_iff.mpr + intro x hx + rw [Set.mem_singleton_iff] at hx + subst x + rcases hcop.isCoprime with ⟨a, b, hab⟩ + have hzm : z ^ m ∈ IntermediateField.adjoin F ({z ^ m} : Set L) := + IntermediateField.subset_adjoin F {z ^ m} (Set.mem_singleton (z ^ m)) + have hprod : (z ^ m) ^ a * (z ^ p) ^ b = z := by + rw [← zpow_natCast, ← zpow_natCast, ← zpow_mul, ← zpow_mul, + ← zpow_add₀ hz] + simpa [mul_comm] using congrArg (fun e : ℤ => z ^ e) hab + have hmem : (z ^ m) ^ a * (z ^ p) ^ b ∈ + IntermediateField.adjoin F ({z ^ m} : Set L) := + mul_mem (zpow_mem hzm a) (zpow_mem hzp b) + rw [hprod] at hmem + exact hmem + +/-- A prime-to-characteristic power of a Frobenius-separating generator is +again a generator over the Frobenius subfield. -/ +theorem adjoin_frobeniusSubfield_pow_eq_top + {L : Type*} [Field L] {p : ℕ} [Fact p.Prime] [CharP L p] + (z : L) (hz : z ≠ 0) (m : ℕ) (hm : ¬ p ∣ m) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + IntermediateField.adjoin (frobeniusSubfield L p) ({z ^ m} : Set L) = ⊤ := by + let F := frobeniusSubfield L p + have hcop : Nat.Coprime m p := + ((Fact.out : p.Prime).coprime_iff_not_dvd.mpr hm).symm + have hzp : z ^ p ∈ IntermediateField.adjoin F ({z ^ m} : Set L) := by + let zp : F := ⟨z ^ p, ⟨z, by simp [frobenius_def]⟩⟩ + change (zp : L) ∈ IntermediateField.adjoin F ({z ^ m} : Set L) + exact (IntermediateField.adjoin F ({z ^ m} : Set L)).algebraMap_mem zp + rw [adjoin_pow_eq_adjoin_of_coprime z hz p m hcop hzp] + exact adjoin_frobeniusSubfield_eq_top p z + +/-- A prime-to-characteristic power of a function with nonzero derivative +again has nonzero derivative. -/ +theorem derivation_pow_ne_zero_of_not_dvd + {C L : Type*} [CommRing C] [Field L] [Algebra C L] + {p : ℕ} [CharP L p] + (D : Derivation C L L) (z : L) (m : ℕ) + (hm : ¬ p ∣ m) (hz : z ≠ 0) (hDz : D z ≠ 0) : + D (z ^ m) ≠ 0 := by + rw [D.leibniz_pow] + rw [← Nat.cast_smul_eq_nsmul L, smul_smul] + exact smul_ne_zero + (mul_ne_zero (by + rw [ne_eq, CharP.cast_eq_zero_iff L p] + exact hm) (pow_ne_zero _ hz)) hDz + +/-- The exact-constants derivation associated to `z` also detects every +prime-to-characteristic power of `z`. -/ +theorem exists_derivation_power_ne_zero_with_exact_frobenius_constants + {L : Type*} [Field L] {p : ℕ} [Fact p.Prime] [CharP L p] + (z : L) (hz : z ≠ 0) (hzNot : z ∉ frobeniusSubfield L p) + (m : ℕ) (hm : ¬ p ∣ m) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + ∃ D : Derivation (frobeniusSubfield L p) L L, + D (z ^ m) ≠ 0 ∧ + ∀ w : L, D w = 0 ↔ + ∃ c : frobeniusSubfield L p, + algebraMap (frobeniusSubfield L p) L c = w := by + obtain ⟨D, hDz, hker⟩ := + exists_derivation_with_exact_frobenius_constants (p := p) z hzNot + refine ⟨D, derivation_pow_ne_zero_of_not_dvd D z m hm hz ?_, hker⟩ + simp [hDz] + +/-- A prime-to-characteristic power of a Frobenius-separating element is not +itself a Frobenius power. -/ +theorem frobeniusPower_not_mem + {L : Type*} [Field L] {p : ℕ} [Fact p.Prime] [CharP L p] + (z : L) (hz : z ≠ 0) (hzNot : z ∉ frobeniusSubfield L p) + (m : ℕ) (hm : ¬ p ∣ m) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + z ^ m ∉ frobeniusSubfield L p := by + obtain ⟨D, hDpow, hker⟩ := + exists_derivation_power_ne_zero_with_exact_frobenius_constants + z hz hzNot m hm + intro hpow + apply hDpow + apply (hker (z ^ m)).2 + exact ⟨⟨z ^ m, hpow⟩, rfl⟩ + +/-- The minimal polynomial of a prime-to-characteristic power of a +Frobenius-separating element still has degree exactly `p` over `L^p`. -/ +theorem frobeniusPower_minpoly_natDegree_eq_char + {L : Type*} [Field L] {p : ℕ} [Fact p.Prime] [CharP L p] + (z : L) (hz : z ≠ 0) (hzNot : z ∉ frobeniusSubfield L p) + (m : ℕ) (hm : ¬ p ∣ m) + [Algebra.IsSeparable + (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : + (minpoly (frobeniusSubfield L p) (z ^ m)).natDegree = p := by + let F := frobeniusSubfield L p + have hnot : z ^ m ∉ F := frobeniusPower_not_mem z hz hzNot m hm + have htop : IntermediateField.adjoin F ({z ^ m} : Set L) = ⊤ := + adjoin_frobeniusSubfield_pow_eq_top z hz m hm + let E : IntermediateField F L := IntermediateField.adjoin F {z ^ m} + letI : Algebra.IsSeparable E L := by + change Algebra.IsSeparable + (IntermediateField.adjoin F ({z ^ m} : Set L)) L + rw [htop] + refine ⟨fun w ↦ ?_⟩ + let wTop : (⊤ : IntermediateField F L) := ⟨w, trivial⟩ + change IsSeparable (⊤ : IntermediateField F L) w + have hw : algebraMap (⊤ : IntermediateField F L) L wTop = w := rfl + rw [← hw] + exact isSeparable_algebraMap (K := L) wTop + exact minpoly_natDegree_over_frobeniusSubfield_eq_char + (p := p) (z ^ m) hnot + +/-- A positive power of the first coordinate remains transcendental over the +constant field. -/ +theorem firstCoordinatePow_transcendental + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + {m : ℕ} (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + Transcendental K ((planeCurveFunction f 0) ^ m) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond)).pow hm + +/-- A positive power of the second coordinate remains transcendental over the +constant field. -/ +theorem secondCoordinatePow_transcendental + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + {n : ℕ} (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + Transcendental K ((planeCurveFunction f 1) ^ n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst)).pow hn + +/-- The first powered coordinate alone generates the curve function field +over its Frobenius subfield. -/ +theorem adjoin_frobeniusSubfield_firstCoordinatePow_eq_top + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : ¬ p ∣ m) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + IntermediateField.adjoin + (frobeniusSubfield (PlaneCurveFunctionField f) p) + ({(planeCurveFunction f 0) ^ m} : Set (PlaneCurveFunctionField f)) = ⊤ := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let x : L := planeCurveFunction f 0 + have hsep := (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep + letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) x + have hxTrans : Transcendental K x := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hx0 : x ≠ 0 := by + intro hx + apply hxTrans + rw [hx] + exact isAlgebraic_zero + exact adjoin_frobeniusSubfield_pow_eq_top x hx0 m hm + +/-- The second powered coordinate alone generates the curve function field +over its Frobenius subfield. -/ +theorem adjoin_frobeniusSubfield_secondCoordinatePow_eq_top + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + IntermediateField.adjoin + (frobeniusSubfield (PlaneCurveFunctionField f) p) + ({(planeCurveFunction f 1) ^ n} : Set (PlaneCurveFunctionField f)) = ⊤ := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let y : L := planeCurveFunction f 1 + have hsep := (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).2 + letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsep + letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) y + have hyTrans : Transcendental K y := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro hy + apply hyTrans + rw [hy] + exact isAlgebraic_zero + exact adjoin_frobeniusSubfield_pow_eq_top y hy0 n hn + +/-- Exact Frobenius-subfield degree of the first powered coordinate. -/ +theorem minpoly_firstCoordinatePow_natDegree_eq_char + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : ¬ p ∣ m) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (minpoly (frobeniusSubfield (PlaneCurveFunctionField f) p) + ((planeCurveFunction f 0) ^ m)).natDegree = p := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let x : L := planeCurveFunction f 0 + have hsep := (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep + letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) x + have hxTrans : Transcendental K x := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hx0 : x ≠ 0 := by + intro hx + apply hxTrans + rw [hx] + exact isAlgebraic_zero + have hxNot : x ∉ F := firstCoordinate_not_mem_frobeniusSubfield + hf hpartialSecond + exact frobeniusPower_minpoly_natDegree_eq_char x hx0 hxNot m hm + +/-- Exact Frobenius-subfield degree of the second powered coordinate. -/ +theorem minpoly_secondCoordinatePow_natDegree_eq_char + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (minpoly (frobeniusSubfield (PlaneCurveFunctionField f) p) + ((planeCurveFunction f 1) ^ n)).natDegree = p := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let y : L := planeCurveFunction f 1 + have hsep := (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).2 + letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsep + letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) y + have hyTrans : Transcendental K y := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro hy + apply hyTrans + rw [hy] + exact isAlgebraic_zero + have hyNot : y ∉ F := secondCoordinate_not_mem_frobeniusSubfield + hf hpartialFirst + exact frobeniusPower_minpoly_natDegree_eq_char y hy0 hyNot n hn + +/-- One derivation with exact constant field `L^p` detects both powered plane +coordinates. This is the differential hypothesis required by the torsion +specialization. -/ +theorem exists_derivation_coordinatePowers_ne_zero + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : ¬ p ∣ m) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ∃ D : Derivation + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (PlaneCurveFunctionField f) (PlaneCurveFunctionField f), + D ((planeCurveFunction f 0) ^ m) ≠ 0 ∧ + D ((planeCurveFunction f 1) ^ n) ≠ 0 ∧ + ∀ z : PlaneCurveFunctionField f, D z = 0 ↔ + ∃ c : frobeniusSubfield (PlaneCurveFunctionField f) p, + algebraMap (frobeniusSubfield (PlaneCurveFunctionField f) p) + (PlaneCurveFunctionField f) c = z := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hsepX := (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).2 + letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX + letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) x + have hsepY := (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).2 + letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsepY + letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := + isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin + (K := K) (L := L) (p := p) y + have hxTrans : Transcendental K x := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hyTrans : Transcendental K y := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : x ≠ 0 := by + intro hx + apply hxTrans + rw [hx] + exact isAlgebraic_zero + have hy0 : y ≠ 0 := by + intro hy + apply hyTrans + rw [hy] + exact isAlgebraic_zero + have hxNot : x ∉ F := firstCoordinate_not_mem_frobeniusSubfield + hf hpartialSecond + have hyNot : y ∉ F := secondCoordinate_not_mem_frobeniusSubfield + hf hpartialFirst + have hynNot : y ^ n ∉ F := frobeniusPower_not_mem y hy0 hyNot n hn + obtain ⟨D, hDx, hker⟩ := + exists_derivation_power_ne_zero_with_exact_frobenius_constants + x hx0 hxNot m hm + have hDy : D (y ^ n) ≠ 0 := by + intro hzero + obtain ⟨c, hc⟩ := (hker (y ^ n)).mp hzero + apply hynNot + rw [← hc] + exact c.property + exact ⟨D, hDx, hDy, hker⟩ + +/-- Proposition 1 for powered plane coordinates, with all Frobenius and +separability obligations discharged. The remaining polynomial `g` is an +explicit relation between the powers; its irreducibility and bidegrees are +kept visible because constructing it is the genuine elimination frontier. -/ +theorem poweredCoordinates_auxiliaryFamily_linearIndependent_of_relation + {K : Type*} [Field K] [PerfectField K] + {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : ¬ p ∣ n) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + ∀ (g : Polynomial (Polynomial + (frobeniusSubfield (PlaneCurveFunctionField f) p))) + (a b h k : ℕ), + 0 < a → 0 < h → 0 < k → + Irreducible g → + g.natDegree = a → + (transposeBivariate g).natDegree = b → + (∀ i, (g.coeff i).natDegree ≤ b) → + evalBivariate ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) g = 0 → + a * h + b * k < p → + ¬ (a ≤ k ∧ b ≤ h) → + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) h k) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + intro g a b h k ha hh hk hg hdegreeU hdegreeV hcoeff hzero hsize hexcluded + have hminpoly : (minpoly F (y ^ n)).natDegree = p := + minpoly_secondCoordinatePow_natDegree_eq_char hf hpartialFirst n hn + have hn0 : n ≠ 0 := by + intro hn0 + apply hn + simp [hn0] + have hnPos : 0 < n := Nat.pos_of_ne_zero hn0 + have hyTrans : Transcendental K y := secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hynTrans : Transcendental K (y ^ n) := hyTrans.pow hnPos + have hynOne : y ^ n ≠ 1 := by + intro hyn + apply hynTrans + rw [hyn] + exact isAlgebraic_one + exact auxiliaryFamily_linearIndependent_of_irreducible_bidegree + g a b h k p ha hh hk hg hdegreeU hdegreeV hcoeff + (x ^ m) (y ^ n) hynOne hminpoly hzero hsize hexcluded + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean new file mode 100644 index 0000000000..f167dcc1f1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean @@ -0,0 +1,313 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +import Mathlib.Tactic + +/-! +# Constant-field base change for the powered-image index + +The canonical powered-image relation remains associated to its coefficient +base change. Comparing the exact tower-degree factorizations on the two +curves then shows that the source-to-powered-image finrank is invariant under +extension of constants. This is the descent bridge from the algebraically +closed stabilizer argument to the original constant field. +-/ + +open scoped TensorProduct Polynomial +open Polynomial + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- Bivariate evaluation commutes with an extension of the coefficient +field. -/ +theorem bivariateEvalAlgHom_map_mapRingHom + {K E L : Type*} [Field K] [Field E] [CommRing L] + [Algebra K E] [Algebra K L] [Algebra E L] + [IsScalarTower K E L] + (u v : L) (P : Polynomial (Polynomial K)) : + bivariateEvalAlgHom (K := E) u v + (P.map (Polynomial.mapRingHom (algebraMap K E))) = + bivariateEvalAlgHom (K := K) u v P := by + unfold bivariateEvalAlgHom + simp only [Polynomial.eval₂AlgHom_apply] + rw [Polynomial.eval₂_map] + congr 1 + apply Polynomial.ringHom_ext + · intro c + simp [IsScalarTower.algebraMap_apply K E L] + · simp + +/-- The coefficient-extension map between affine plane-curve coordinate +rings. -/ +noncomputable def planeCurveCoordinateRingMap + {K E : Type*} [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) : + PlaneCurveCoordinateRing f →ₐ[K] + PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f) := by + let ι : MvPolynomial (Fin 2) K →ₐ[K] MvPolynomial (Fin 2) E := + { toRingHom := MvPolynomial.map (algebraMap K E) + commutes' := by + intro c + simp [MvPolynomial.algebraMap_eq] } + apply Ideal.quotientMapₐ + (Ideal.span {MvPolynomial.map (algebraMap K E) f}) ι + intro q hq + obtain ⟨r, rfl⟩ := Ideal.mem_span_singleton.mp hq + apply Ideal.mem_span_singleton.mpr + refine ⟨MvPolynomial.map (algebraMap K E) r, ?_⟩ + simp [ι] + +/-- The coordinate-ring base-change map preserves the two coordinate +classes. -/ +@[simp] theorem planeCurveCoordinateRingMap_coordinate + {K E : Type*} [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) (i : Fin 2) : + planeCurveCoordinateRingMap (E := E) f (planeCurveCoordinate f i) = + planeCurveCoordinate (MvPolynomial.map (algebraMap K E) f) i := by + simp [planeCurveCoordinateRingMap, planeCurveCoordinate, + planeCurveQuotientMap] + +/-- The coefficient base change of the canonical powered-image relation +vanishes on the generic powered coordinates of the base-changed curve. -/ +theorem evalBivariate_poweredCoordinateImageRelation_map_eq_zero + {K E : Type*} [Field K] [Field E] [Algebra K E] + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + let fE := MvPolynomial.map (algebraMap K E) f + letI := planeCurveCoordinateRing_isDomain hfE + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + evalBivariate + ((planeCurveFunction fE 0) ^ m) + ((planeCurveFunction fE 1) ^ n) + (g.map (Polynomial.mapRingHom (algebraMap K E))) = 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let fE := MvPolynomial.map (algebraMap K E) f + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + let A := PlaneCurveCoordinateRing f + let AE := PlaneCurveCoordinateRing fE + let L := PlaneCurveFunctionField f + let LE := PlaneCurveFunctionField fE + let xA : A := (planeCurveCoordinate f 0) ^ m + let yA : A := (planeCurveCoordinate f 1) ^ n + let xL : L := (planeCurveFunction f 0) ^ m + let yL : L := (planeCurveFunction f 1) ^ n + let ι : A →ₐ[K] L := IsScalarTower.toAlgHom K A L + let φ : Polynomial (Polynomial K) →ₐ[K] A := + bivariateEvalAlgHom (K := K) xA yA + let ψ : Polynomial (Polynomial K) →ₐ[K] L := + bivariateEvalAlgHom (K := K) xL yL + have hcomp : ι.comp φ = ψ := by + simpa [φ, ψ, xA, xL, yA, yL, ι, planeCurveFunction] using + (bivariateEvalAlgHom_comp (K := K) ι xA yA) + have hzeroL : ψ g = 0 := by + simpa [ψ, xL, yL, g] using + (evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n) + have hι : Function.Injective ι := by + exact IsFractionRing.injective A L + have hzeroA : φ g = 0 := by + apply hι + rw [map_zero, ← AlgHom.comp_apply, hcomp] + exact hzeroL + let ρ : A →ₐ[K] AE := planeCurveCoordinateRingMap (E := E) f + have hzeroAE : ρ (φ g) = 0 := by rw [hzeroA, map_zero] + have hx : ρ xA = (planeCurveCoordinate fE 0) ^ m := by + dsimp only [ρ, xA] + rw [map_pow, planeCurveCoordinateRingMap_coordinate] + have hy : ρ yA = (planeCurveCoordinate fE 1) ^ n := by + dsimp only [ρ, yA] + rw [map_pow, planeCurveCoordinateRingMap_coordinate] + have hcoord : bivariateEvalAlgHom (K := K) + ((planeCurveCoordinate fE 0) ^ m) + ((planeCurveCoordinate fE 1) ^ n) g = 0 := by + change (ρ.comp φ) g = 0 at hzeroAE + rw [bivariateEvalAlgHom_comp] at hzeroAE + simpa only [hx, hy] using hzeroAE + have hcoordMap : bivariateEvalAlgHom (K := E) + ((planeCurveCoordinate fE 0) ^ m) + ((planeCurveCoordinate fE 1) ^ n) + (g.map (Polynomial.mapRingHom (algebraMap K E))) = 0 := by + rw [bivariateEvalAlgHom_map_mapRingHom] + exact hcoord + let η : AE →ₐ[E] LE := IsScalarTower.toAlgHom E AE LE + have hfun := congrArg η hcoordMap + rw [map_zero] at hfun + change (η.comp (bivariateEvalAlgHom (K := E) + ((planeCurveCoordinate fE 0) ^ m) + ((planeCurveCoordinate fE 1) ^ n))) + (g.map (Polynomial.mapRingHom (algebraMap K E))) = 0 at hfun + rw [bivariateEvalAlgHom_comp] at hfun + change evalBivariate + ((η (planeCurveCoordinate fE 0)) ^ m) + ((η (planeCurveCoordinate fE 1)) ^ n) + (g.map (Polynomial.mapRingHom (algebraMap K E))) = 0 + simpa only [map_pow, bivariateEvalAlgHom_eq_evalBivariate] using hfun + +/-- The canonical powered-image relation of the base-changed curve is +associated to the coefficient base change of the original relation. -/ +theorem poweredCoordinateImageRelation_map_associated_baseChange + {K E : Type*} [Field K] [Field E] [Algebra K E] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hpartialSecondE : + MvPolynomial.pderiv 1 (MvPolynomial.map (algebraMap K E) f) ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + Associated + (poweredCoordinateImageRelation hfE hpartialSecondE m hm n) + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom (algebraMap K E))) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let fE := MvPolynomial.map (algebraMap K E) f + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let LE := PlaneCurveFunctionField fE + letI : FiniteDimensional (FirstPoweredCoordinateSubfield fE m) LE := + finiteDimensional_over_firstPoweredCoordinate hfE hpartialSecondE m hm + have hv : IsIntegral (FirstPoweredCoordinateSubfield fE m) + ((planeCurveFunction fE 1) ^ n) := Algebra.IsIntegral.isIntegral _ + have hdvd : + poweredCoordinateImageRelation hfE hpartialSecondE m hm n ∣ + (poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom (algebraMap K E)) := by + change primitiveClearedMinpolyRelation + ((planeCurveFunction fE 0) ^ m) + (firstPoweredCoordinate_transcendental + hfE hpartialSecondE m hm) + ((planeCurveFunction fE 1) ^ n) ∣ _ + exact primitiveClearedMinpolyRelation_dvd_of_evalBivariate_eq_zero + ((planeCurveFunction fE 0) ^ m) + (firstPoweredCoordinate_transcendental hfE hpartialSecondE m hm) + ((planeCurveFunction fE 1) ^ n) hv _ + (evalBivariate_poweredCoordinateImageRelation_map_eq_zero + hf hfE hpartialSecond m hm n) + exact (poweredCoordinateImageRelation_irreducible + hfE hpartialSecondE m hm n).associated_of_dvd + (poweredCoordinateImageRelation_irreducible_map + (E := E) habsolute hf hpartialSecond m hm n) hdvd + +/-- The relevant powered-image relation degree is invariant under extension +of constants. -/ +theorem poweredCoordinateImageRelation_map_natDegree_eq_baseChange + {K E : Type*} [Field K] [Field E] [Algebra K E] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hpartialSecondE : + MvPolynomial.pderiv 1 (MvPolynomial.map (algebraMap K E) f) ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + (poweredCoordinateImageRelation hfE hpartialSecondE m hm n).natDegree = + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := by + let gE := poweredCoordinateImageRelation hfE hpartialSecondE m hm n + let gMap := (poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom (algebraMap K E)) + have hassoc : Associated gE gMap := + poweredCoordinateImageRelation_map_associated_baseChange + habsolute hf hfE hpartialSecond hpartialSecondE m hm n + have hgE0 : gE ≠ 0 := (poweredCoordinateImageRelation_irreducible + hfE hpartialSecondE m hm n).ne_zero + have hgMap0 : gMap ≠ 0 := (poweredCoordinateImageRelation_irreducible_map + (E := E) habsolute hf hpartialSecond m hm n).ne_zero + have hle : gE.natDegree ≤ gMap.natDegree := + Polynomial.natDegree_le_of_dvd hassoc.dvd hgMap0 + have hge : gMap.natDegree ≤ gE.natDegree := + Polynomial.natDegree_le_of_dvd hassoc.symm.dvd hgE0 + have hmapDegree : gMap.natDegree = + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := + Polynomial.natDegree_map_eq_of_injective + (Polynomial.map_injective (algebraMap K E) (algebraMap K E).injective) _ + exact (Nat.le_antisymm hle hge).trans hmapDegree + +/-- Extension of constants preserves the common source-to-powered-image +degree. -/ +theorem finrank_poweredCoordinateImageField_eq_baseChange + {K E : Type*} [Field K] [Field E] [Algebra K E] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + let fE := MvPolynomial.map (algebraMap K E) f + let hfE := irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K E) f habsolute + letI := planeCurveCoordinateRing_isDomain hf + letI := planeCurveCoordinateRing_isDomain hfE + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField fE m n) + (PlaneCurveFunctionField fE) := by + let fE := MvPolynomial.map (algebraMap K E) f + let hfE : Irreducible fE := + irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K E) f habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + have hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) (algebraMap K E).injective + simpa using hz + let aK := (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree + let aE := (poweredCoordinateImageRelation hfE hpartialSecondE m hm n).natDegree + let dK := Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) + let dE := Module.finrank (PoweredImageOverFirst fE m n) + (PlaneCurveFunctionField fE) + have ha : aE = aK := + poweredCoordinateImageRelation_map_natDegree_eq_baseChange + habsolute hf hfE hpartialSecond hpartialSecondE m hm n + have hK : aK * dK = m * MvPolynomial.degreeOf 1 f := + poweredCoordinateImageRelation_natDegree_mul_commonIndex + hf hpartialSecond m n hm + have hE : aE * dE = m * MvPolynomial.degreeOf 1 fE := + poweredCoordinateImageRelation_natDegree_mul_commonIndex + hfE hpartialSecondE m n hm + have hdegree : MvPolynomial.degreeOf 1 fE = MvPolynomial.degreeOf 1 f := + degreeOf_map_eq_of_injective (algebraMap K E) + (algebraMap K E).injective 1 f + have hprod : aK * dK = aK * dE := by + calc + aK * dK = m * MvPolynomial.degreeOf 1 f := hK + _ = m * MvPolynomial.degreeOf 1 fE := by rw [hdegree] + _ = aE * dE := hE.symm + _ = aK * dE := by rw [ha] + have haPos : 0 < aK := + poweredCoordinateImageRelation_natDegree_pos + hf hpartialSecond m hm n + have hd : dK = dE := Nat.eq_of_mul_eq_mul_left haPos hprod + calc + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) = dK := + (finrank_poweredImageOverFirst_eq_imageField m n).symm + _ = dE := hd + _ = Module.finrank (PoweredCoordinateImageField fE m n) + (PlaneCurveFunctionField fE) := + finrank_poweredImageOverFirst_eq_imageField m n + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean new file mode 100644 index 0000000000..7af7104178 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean @@ -0,0 +1,919 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +import Mathlib.FieldTheory.RatFunc.AsPolynomial +import Mathlib.RingTheory.Polynomial.GaussLemma + +/-! +# The actual powered-coordinate image curve + +For a plane curve with function-field coordinates `x,y`, this file defines +the intermediate field `K(x^m,y^n)` and controls its two projection degrees. +It then transports the minimal polynomial of `y^n` over `K(x^m)` to the +standard rational-function field, clears denominators, takes the primitive +part, and applies Gauss' lemma. The resulting polynomial in `K[U,V]` is +irreducible, vanishes at `(x^m,y^n)`, and has coordinate degrees exactly the +two projection degrees of the powered image. + +Consequently its degree in `y^n` is at most `m * degreeOf 1 f`, while its +degree in `x^m` is at most `n * degreeOf 0 f`. This is the source-sensitive +elimination input needed for the Corvaja--Zannier middle game. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped nonZeroDivisors Polynomial + +variable {K L : Type*} [Field K] [Field L] [Algebra K L] + +theorem adjoin_pow_le_adjoin (z : L) (m : ℕ) : + IntermediateField.adjoin K {z ^ m} ≤ IntermediateField.adjoin K {z} := by + apply IntermediateField.adjoin_le_iff.mpr + intro w hw + rw [Set.mem_singleton_iff] at hw + subst w + exact (IntermediateField.adjoin K {z}).toSubalgebra.pow_mem + (IntermediateField.subset_adjoin K {z} (Set.mem_singleton z)) m + +theorem restrictScalars_adjoin_over_adjoin_pow_eq_adjoin + (z : L) (m : ℕ) : + (IntermediateField.adjoin (IntermediateField.adjoin K {z ^ m}) {z}).restrictScalars K = + IntermediateField.adjoin K {z} := by + rw [IntermediateField.restrictScalars_adjoin_eq_sup] + exact sup_eq_right.mpr (adjoin_pow_le_adjoin z m) + +theorem finrank_adjoin_over_adjoin_pow_le + (z : L) (m : ℕ) (hm : 0 < m) : + Module.finrank (IntermediateField.adjoin K {z ^ m}) + (IntermediateField.adjoin (IntermediateField.adjoin K {z ^ m}) {z}) ≤ m := by + let E0 := IntermediateField.adjoin K {z ^ m} + let c : E0 := + ⟨z ^ m, IntermediateField.subset_adjoin K {z ^ m} (Set.mem_singleton (z ^ m))⟩ + let q : Polynomial E0 := Polynomial.X ^ m - Polynomial.C c + have hqMonic : q.Monic := Polynomial.monic_X_pow_sub_C c hm.ne' + have hqRoot : Polynomial.aeval z q = 0 := by + simp [q, c] + have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ + have hqNe : q ≠ 0 := hqMonic.ne_zero + calc + Module.finrank E0 (IntermediateField.adjoin E0 {z}) = + (minpoly E0 z).natDegree := + IntermediateField.adjoin.finrank hzIntegral + _ ≤ q.natDegree := + Polynomial.natDegree_le_of_dvd (minpoly.dvd E0 z hqRoot) hqNe + _ = m := by simp [q] + +theorem finiteDimensional_over_adjoin_pow + (z : L) (m : ℕ) (hm : 0 < m) + [FiniteDimensional (IntermediateField.adjoin K {z}) L] : + FiniteDimensional (IntermediateField.adjoin K {z ^ m}) L := by + let E0 := IntermediateField.adjoin K {z ^ m} + let A := IntermediateField.adjoin E0 {z} + let AK : IntermediateField K L := + IntermediateField.restrictScalars (L' := E0) K A + have hA : AK = IntermediateField.adjoin K {z} := by + exact restrictScalars_adjoin_over_adjoin_pow_eq_adjoin z m + let c : E0 := + ⟨z ^ m, IntermediateField.subset_adjoin K {z ^ m} (Set.mem_singleton (z ^ m))⟩ + let q : Polynomial E0 := Polynomial.X ^ m - Polynomial.C c + have hqMonic : q.Monic := Polynomial.monic_X_pow_sub_C c hm.ne' + have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] + have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ + letI : FiniteDimensional E0 A := + IntermediateField.adjoin.finiteDimensional hzIntegral + letI : FiniteDimensional A L := by + change FiniteDimensional AK L + rw [hA] + infer_instance + exact FiniteDimensional.trans E0 A L + +theorem finrank_over_adjoin_pow_le_mul + (z : L) (m d : ℕ) (hm : 0 < m) + [FiniteDimensional (IntermediateField.adjoin K {z}) L] + (hdegree : Module.finrank (IntermediateField.adjoin K {z}) L ≤ d) : + Module.finrank (IntermediateField.adjoin K {z ^ m}) L ≤ m * d := by + let E0 := IntermediateField.adjoin K {z ^ m} + let A := IntermediateField.adjoin E0 {z} + let AK : IntermediateField K L := + IntermediateField.restrictScalars (L' := E0) K A + have hA : AK = IntermediateField.adjoin K {z} := by + exact restrictScalars_adjoin_over_adjoin_pow_eq_adjoin z m + let c : E0 := + ⟨z ^ m, IntermediateField.subset_adjoin K {z ^ m} (Set.mem_singleton (z ^ m))⟩ + let q : Polynomial E0 := Polynomial.X ^ m - Polynomial.C c + have hqMonic : q.Monic := Polynomial.monic_X_pow_sub_C c hm.ne' + have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] + have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ + letI : FiniteDimensional E0 A := + IntermediateField.adjoin.finiteDimensional hzIntegral + letI : FiniteDimensional A L := by + change FiniteDimensional AK L + rw [hA] + infer_instance + have hrelative : Module.finrank E0 A ≤ m := + finrank_adjoin_over_adjoin_pow_le z m hm + have htop : Module.finrank A L ≤ d := by + change Module.finrank AK L ≤ d + rw [hA] + exact hdegree + calc + Module.finrank E0 L = Module.finrank E0 A * Module.finrank A L := by + rw [Module.finrank_mul_finrank] + _ ≤ m * d := Nat.mul_le_mul hrelative htop + +/-! ## Clearing the minimal polynomial over a rational coordinate field -/ + +/-- Transport the minimal polynomial of `v` over `K(u)` to the standard +rational-function field `K(X)`. -/ +noncomputable def ratFuncMinpoly + (u : L) (hu : Transcendental K u) (v : L) : Polynomial (RatFunc K) := + (minpoly (IntermediateField.adjoin K {u}) v).map + (RatFunc.algEquivOfTranscendental u hu).symm.toRingEquiv + +/-- Clear the coefficient denominators in the transported minimal +polynomial. This is an iterated polynomial over `K`. -/ +noncomputable def integerClearedMinpoly + (u : L) (hu : Transcendental K u) (v : L) : + Polynomial (Polynomial K) := + IsLocalization.integerNormalization (nonZeroDivisors (Polynomial K)) + (ratFuncMinpoly u hu v) + +/-- The primitive bivariate relation obtained from the minimal polynomial +of `v` over `K(u)`. -/ +noncomputable def primitiveClearedMinpolyRelation + (u : L) (hu : Transcendental K u) (v : L) : + Polynomial (Polynomial K) := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + exact (integerClearedMinpoly u hu v).primPart + +theorem ratFuncMinpoly_ne_zero + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + ratFuncMinpoly u hu v ≠ 0 := by + exact Polynomial.map_ne_zero (minpoly.ne_zero hv) + +theorem ratFuncMinpoly_irreducible + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + Irreducible (ratFuncMinpoly u hu v) := by + let e := RatFunc.algEquivOfTranscendental u hu + have h := (minpoly.irreducible hv).map (Polynomial.mapEquiv e.symm.toRingEquiv) + simpa only [ratFuncMinpoly, e, Polynomial.mapEquiv_apply] using h + +theorem integerClearedMinpoly_ne_zero + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + integerClearedMinpoly u hu v ≠ 0 := by + exact IsFractionRing.integerNormalization_eq_zero_iff.not.mpr + (ratFuncMinpoly_ne_zero u hu v hv) + +theorem primitiveClearedMinpolyRelation_ne_zero + (u : L) (hu : Transcendental K u) (v : L) : + primitiveClearedMinpolyRelation u hu v ≠ 0 := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + exact (integerClearedMinpoly u hu v).primPart_ne_zero + +theorem primitiveClearedMinpolyRelation_natDegree + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + (primitiveClearedMinpolyRelation u hu v).natDegree = + (minpoly (IntermediateField.adjoin K {u}) v).natDegree := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + let q := ratFuncMinpoly u hu v + let N := integerClearedMinpoly u hu v + obtain ⟨b, hb, hmap⟩ := + IsLocalization.integerNormalization_spec + (nonZeroDivisors (Polynomial K)) q + have hb0 : b ≠ 0 := nonZeroDivisors.ne_zero hb + have hqb0 : algebraMap (Polynomial K) (RatFunc K) b ≠ 0 := + (FaithfulSMul.algebraMap_eq_zero_iff (Polynomial K) (RatFunc K)).not.mpr hb0 + have hq0 : q ≠ 0 := ratFuncMinpoly_ne_zero u hu v hv + calc + (primitiveClearedMinpolyRelation u hu v).natDegree = N.natDegree := by + exact Polynomial.natDegree_primPart N + _ = (N.map (algebraMap (Polynomial K) (RatFunc K))).natDegree := by + symm + exact Polynomial.natDegree_map_eq_of_injective + (IsFractionRing.injective (Polynomial K) (RatFunc K)) N + _ = q.natDegree := by + change (Polynomial.map (algebraMap (Polynomial K) (RatFunc K)) + (IsLocalization.integerNormalization + (nonZeroDivisors (Polynomial K)) q)).natDegree = q.natDegree + rw [hmap, Algebra.smul_def] + change (Polynomial.C (algebraMap (Polynomial K) (RatFunc K) b) * q).natDegree = + q.natDegree + exact Polynomial.natDegree_C_mul hqb0 + _ = (minpoly (IntermediateField.adjoin K {u}) v).natDegree := by + exact Polynomial.natDegree_map_eq_of_injective + (RatFunc.algEquivOfTranscendental u hu).symm.injective _ + +/-- After embedding the coefficient ring in `K(X)`, the primitive cleared +relation is a nonzero constant multiple of the transported minimal +polynomial. -/ +theorem map_primitiveClearedMinpolyRelation_eq_C_mul + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + ∃ c : RatFunc K, c ≠ 0 ∧ + (primitiveClearedMinpolyRelation u hu v).map + (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.C c * ratFuncMinpoly u hu v := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + let q := ratFuncMinpoly u hu v + let N := integerClearedMinpoly u hu v + let g := primitiveClearedMinpolyRelation u hu v + obtain ⟨b, hb, hmap⟩ := + IsLocalization.integerNormalization_spec + (nonZeroDivisors (Polynomial K)) q + have hb0 : b ≠ 0 := nonZeroDivisors.ne_zero hb + have hN0 : N ≠ 0 := integerClearedMinpoly_ne_zero u hu v hv + have hcontent0 : N.content ≠ 0 := + Polynomial.content_eq_zero_iff.not.mpr hN0 + let a : RatFunc K := algebraMap (Polynomial K) (RatFunc K) N.content + let b' : RatFunc K := algebraMap (Polynomial K) (RatFunc K) b + have ha0 : a ≠ 0 := by + exact (FaithfulSMul.algebraMap_eq_zero_iff + (Polynomial K) (RatFunc K)).not.mpr hcontent0 + have hb'0 : b' ≠ 0 := by + exact (FaithfulSMul.algebraMap_eq_zero_iff + (Polynomial K) (RatFunc K)).not.mpr hb0 + have hdecomp : + N.map (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.C a * g.map (algebraMap (Polynomial K) (RatFunc K)) := by + rw [N.eq_C_content_mul_primPart, Polynomial.map_mul, Polynomial.map_C] + rfl + have hmap' : + N.map (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.C b' * q := by + change (IsLocalization.integerNormalization + (nonZeroDivisors (Polynomial K)) q).map + (algebraMap (Polynomial K) (RatFunc K)) = Polynomial.C b' * q + rw [hmap, Algebra.smul_def] + rfl + have hab : + Polynomial.C a * g.map (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.C b' * q := hdecomp.symm.trans hmap' + refine ⟨a⁻¹ * b', mul_ne_zero (inv_ne_zero ha0) hb'0, ?_⟩ + change g.map (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.C (a⁻¹ * b') * q + calc + g.map (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.C a⁻¹ * + (Polynomial.C a * + g.map (algebraMap (Polynomial K) (RatFunc K))) := by + rw [← mul_assoc, ← Polynomial.C_mul, inv_mul_cancel₀ ha0, + Polynomial.C_1, one_mul] + _ = Polynomial.C a⁻¹ * (Polynomial.C b' * q) := by rw [hab] + _ = Polynomial.C (a⁻¹ * b') * q := by + rw [← mul_assoc, ← Polynomial.C_mul] + +/-- The cleared minimal-polynomial relation is irreducible in `K[U,V]`. -/ +theorem primitiveClearedMinpolyRelation_irreducible + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + Irreducible (primitiveClearedMinpolyRelation u hu v) := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + let q := ratFuncMinpoly u hu v + let g := primitiveClearedMinpolyRelation u hu v + obtain ⟨c, hc0, hmap⟩ := + map_primitiveClearedMinpolyRelation_eq_C_mul u hu v hv + have hunit : IsUnit (Polynomial.C c : Polynomial (RatFunc K)) := + Polynomial.isUnit_C.mpr hc0.isUnit + have hassociated : Associated + (g.map (algebraMap (Polynomial K) (RatFunc K))) q := by + rw [hmap] + simpa only [mul_comm] using + associated_mul_unit_left q (Polynomial.C c) hunit + have hmapIrreducible : + Irreducible (g.map (algebraMap (Polynomial K) (RatFunc K))) := + hassociated.symm.irreducible (ratFuncMinpoly_irreducible u hu v hv) + exact (integerClearedMinpoly u hu v).isPrimitive_primPart + |>.irreducible_iff_irreducible_map_fraction_map.mpr hmapIrreducible + +/-- Specialize the rational-function variable `X` at a transcendental +element `u`, then include `K(u)` in the ambient field. -/ +noncomputable def ratFuncSpecialization + (u : L) (hu : Transcendental K u) : RatFunc K →+* L := + (algebraMap (IntermediateField.adjoin K {u}) L).comp + (RatFunc.algEquivOfTranscendental u hu).toRingEquiv.toRingHom + +theorem ratFuncSpecialization_comp_polynomial_algebraMap + (u : L) (hu : Transcendental K u) : + (ratFuncSpecialization u hu).comp + (algebraMap (Polynomial K) (RatFunc K)) = + Polynomial.eval₂RingHom (algebraMap K L) u := by + apply Polynomial.ringHom_ext + · intro c + simp [ratFuncSpecialization] + rw [← RatFunc.algebraMap_eq_C, + (RatFunc.algEquivOfTranscendental u hu).commutes] + rfl + · simp [ratFuncSpecialization, + RatFunc.algEquivOfTranscendental_X] + +theorem ratFuncSpecialization_comp_symm_algEquiv + (u : L) (hu : Transcendental K u) : + (ratFuncSpecialization u hu).comp + (RatFunc.algEquivOfTranscendental u hu).symm.toRingEquiv.toRingHom = + algebraMap (IntermediateField.adjoin K {u}) L := by + ext z + simp [ratFuncSpecialization] + +/-- Evaluation of an iterated polynomial at `(u,v)` agrees with first +mapping its coefficient polynomials to `K(X)` and then specializing `X` at +`u`. -/ +theorem evalBivariate_eq_eval₂_ratFuncSpecialization_map + (u : L) (hu : Transcendental K u) (v : L) + (P : Polynomial (Polynomial K)) : + evalBivariate u v P = + Polynomial.eval₂ (ratFuncSpecialization u hu) v + (P.map (algebraMap (Polynomial K) (RatFunc K))) := by + rw [Polynomial.eval₂_map, + ratFuncSpecialization_comp_polynomial_algebraMap] + rfl + +/-- The transported minimal polynomial vanishes after specializing the +rational-function variable at `u` and the outer variable at `v`. -/ +theorem eval₂_ratFuncSpecialization_ratFuncMinpoly_eq_zero + (u : L) (hu : Transcendental K u) (v : L) : + Polynomial.eval₂ (ratFuncSpecialization u hu) v + (ratFuncMinpoly u hu v) = 0 := by + rw [ratFuncMinpoly, Polynomial.eval₂_map] + change Polynomial.eval₂ + ((ratFuncSpecialization u hu).comp + (RatFunc.algEquivOfTranscendental u hu).symm.toRingEquiv.toRingHom) + v (minpoly (IntermediateField.adjoin K {u}) v) = 0 + rw [ratFuncSpecialization_comp_symm_algEquiv] + exact minpoly.aeval (IntermediateField.adjoin K {u}) v + +/-- The primitive cleared relation really vanishes at `(u,v)`. -/ +theorem evalBivariate_primitiveClearedMinpolyRelation_eq_zero + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : + evalBivariate u v (primitiveClearedMinpolyRelation u hu v) = 0 := by + rw [evalBivariate_eq_eval₂_ratFuncSpecialization_map u hu v] + obtain ⟨c, hc, hmap⟩ := + map_primitiveClearedMinpolyRelation_eq_C_mul u hu v hv + rw [hmap, Polynomial.eval₂_mul, Polynomial.eval₂_C, + eval₂_ratFuncSpecialization_ratFuncMinpoly_eq_zero u hu v, mul_zero] + +/-- Swapping the two variables preserves irreducibility. -/ +theorem irreducible_transposeBivariate + {P : Polynomial (Polynomial K)} (hP : Irreducible P) : + Irreducible (transposeBivariate P) := by + rw [transposeBivariate_eq_bivariateSwap] + change Irreducible ((Polynomial.Bivariate.swap (R := K)) P) + exact hP.map (Polynomial.Bivariate.swap (R := K)) + +/-- An irreducible relation vanishing at a pair whose first coordinate is +transcendental must genuinely depend on its outer variable. Applied after +swapping, this says the original relation genuinely depends on its inner +variable. -/ +theorem transposeBivariate_natDegree_ne_zero_of_eval_eq_zero + (u v : L) (hv : Transcendental K v) + {P : Polynomial (Polynomial K)} (hP : Irreducible P) + (hzero : evalBivariate u v P = 0) : + (transposeBivariate P).natDegree ≠ 0 := by + let Q := transposeBivariate P + have hzeroQ : evalBivariate v u Q = 0 := by + change evalBivariate v u (transposeBivariate P) = 0 + rw [evalBivariate_transposeBivariate] + exact hzero + intro hdegree + have hQ : Q = Polynomial.C (Q.coeff 0) := + Polynomial.eq_C_of_natDegree_eq_zero hdegree + have hcoeffEval : + Polynomial.eval₂ (algebraMap K L) v (Q.coeff 0) = 0 := by + have hzeroQ' := hzeroQ + rw [hQ] at hzeroQ' + unfold evalBivariate at hzeroQ' + rw [Polynomial.eval₂_C] at hzeroQ' + exact hzeroQ' + have hcoeff : Q.coeff 0 = 0 := by + have hinj : Function.Injective + (Polynomial.aeval (R := K) v : Polynomial K →ₐ[K] L) := + transcendental_iff_injective.mp hv + apply hinj + simpa only [Polynomial.aeval_def, map_zero] using hcoeffEval + have hQzero : Q = 0 := by rw [hQ, hcoeff, map_zero] + apply hP.ne_zero + apply transposeBivariate_injective + have hQzero' : transposeBivariate P = 0 := by + simpa only [Q] using hQzero + simpa only [map_zero] using hQzero' + +/-- For an irreducible bivariate relation at a transcendental pair, the +degree in the first coordinate is exactly the minimal-polynomial degree over +the rational field generated by the second coordinate. -/ +theorem transposeBivariate_natDegree_eq_minpoly + (u v : L) (hvTrans : Transcendental K v) + {P : Polynomial (Polynomial K)} (hP : Irreducible P) + (hzero : evalBivariate u v P = 0) : + (transposeBivariate P).natDegree = + (minpoly (IntermediateField.adjoin K {v}) u).natDegree := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + let Q := transposeBivariate P + let e := RatFunc.algEquivOfTranscendental v hvTrans + let qRat : Polynomial (RatFunc K) := + Q.map (algebraMap (Polynomial K) (RatFunc K)) + let qAdjoin : Polynomial (IntermediateField.adjoin K {v}) := + qRat.map e.toRingEquiv + have hQIrreducible : Irreducible Q := + irreducible_transposeBivariate hP + have hQDegree : Q.natDegree ≠ 0 := + transposeBivariate_natDegree_ne_zero_of_eval_eq_zero + u v hvTrans hP hzero + have hQPrimitive : Q.IsPrimitive := + hQIrreducible.isPrimitive hQDegree + have hqRatIrreducible : Irreducible qRat := by + exact hQPrimitive.irreducible_iff_irreducible_map_fraction_map.mp + hQIrreducible + have hqAdjoinIrreducible : Irreducible qAdjoin := by + have h := hqRatIrreducible.map (Polynomial.mapEquiv e.toRingEquiv) + simpa only [qAdjoin, Polynomial.mapEquiv_apply] using h + have hzeroQ : evalBivariate v u Q = 0 := by + change evalBivariate v u (transposeBivariate P) = 0 + rw [evalBivariate_transposeBivariate] + exact hzero + have hqAdjoinRootEval : + Polynomial.eval₂ + (algebraMap (IntermediateField.adjoin K {v}) L) u qAdjoin = 0 := by + dsimp only [qAdjoin] + rw [Polynomial.eval₂_map] + change Polynomial.eval₂ (ratFuncSpecialization v hvTrans) u qRat = 0 + rw [← evalBivariate_eq_eval₂_ratFuncSpecialization_map v hvTrans u Q] + exact hzeroQ + have hqAdjoinRoot : Polynomial.aeval u qAdjoin = 0 := by + simpa only [Polynomial.aeval_def] using hqAdjoinRootEval + have heq := minpoly.eq_of_irreducible hqAdjoinIrreducible hqAdjoinRoot + have hminDegree : + (minpoly (IntermediateField.adjoin K {v}) u).natDegree = + qAdjoin.natDegree := by + calc + (minpoly (IntermediateField.adjoin K {v}) u).natDegree = + (qAdjoin * Polynomial.C qAdjoin.leadingCoeff⁻¹).natDegree := by + rw [heq] + _ = qAdjoin.natDegree := Polynomial.natDegree_mul_C + (inv_ne_zero + (Polynomial.leadingCoeff_ne_zero.mpr hqAdjoinIrreducible.ne_zero)) + calc + (transposeBivariate P).natDegree = Q.natDegree := rfl + _ = qRat.natDegree := by + symm + exact Polynomial.natDegree_map_eq_of_injective + (IsFractionRing.injective (Polynomial K) (RatFunc K)) Q + _ = qAdjoin.natDegree := by + symm + exact Polynomial.natDegree_map_eq_of_injective e.injective qRat + _ = (minpoly (IntermediateField.adjoin K {v}) u).natDegree := + hminDegree.symm + +/-! ## Powered coordinate fields of a plane curve -/ + +/-- The rational subfield generated by the powered first coordinate. -/ +abbrev FirstPoweredCoordinateSubfield + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (m : ℕ) := + IntermediateField.adjoin K + ({(planeCurveFunction f 0) ^ m} : Set (PlaneCurveFunctionField f)) + +/-- The rational subfield generated by the powered second coordinate. -/ +abbrev SecondPoweredCoordinateSubfield + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (n : ℕ) := + IntermediateField.adjoin K + ({(planeCurveFunction f 1) ^ n} : Set (PlaneCurveFunctionField f)) + +/-- The function field of the image of the powered-coordinate map, realized +inside the source function field. -/ +abbrev PoweredCoordinateImageField + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) := + IntermediateField.adjoin K + ({(planeCurveFunction f 0) ^ m, (planeCurveFunction f 1) ^ n} : + Set (PlaneCurveFunctionField f)) + +/-- A positive power of the first coordinate remains transcendental. -/ +theorem firstPoweredCoordinate_transcendental + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + Transcendental K ((planeCurveFunction f 0) ^ m) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond)).pow hm + +/-- A positive power of the second coordinate remains transcendental. -/ +theorem secondPoweredCoordinate_transcendental + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + Transcendental K ((planeCurveFunction f 1) ^ n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst)).pow hn + +/-- The canonical irreducible equation of the powered-coordinate image, +obtained by clearing the minimal polynomial over `K(x^m)`. The outer +variable is the powered second coordinate. -/ +noncomputable def poweredCoordinateImageRelation + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : Polynomial (Polynomial K) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact primitiveClearedMinpolyRelation + ((planeCurveFunction f 0) ^ m) + (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) + ((planeCurveFunction f 1) ^ n) + +/-- The source function field is finite over the field generated by a +positive power of its first coordinate. -/ +theorem finiteDimensional_over_firstPoweredCoordinate + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstCoordinate_of_irreducible hf hpartialSecond + exact finiteDimensional_over_adjoin_pow + (planeCurveFunction f 0) m hm + +/-- Raising the first coordinate to the `m`-th power multiplies the source +degree bound by at most `m`. -/ +theorem finrank_over_firstPoweredCoordinate_le + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) ≤ m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstCoordinate_of_irreducible hf hpartialSecond + exact finrank_over_adjoin_pow_le_mul + (planeCurveFunction f 0) m (MvPolynomial.degreeOf 1 f) hm + (finrank_over_firstCoordinate_le_degreeOf_second_of_irreducible + hf hpartialSecond) + +/-- The source function field is finite over the field generated by a +positive power of its second coordinate. -/ +theorem finiteDimensional_over_secondPoweredCoordinate + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + FiniteDimensional (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).1 + exact finiteDimensional_over_adjoin_pow + (planeCurveFunction f 1) n hn + +/-- Raising the second coordinate to the `n`-th power multiplies the source +degree bound by at most `n`. -/ +theorem finrank_over_secondPoweredCoordinate_le + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) ≤ n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).1 + exact finrank_over_adjoin_pow_le_mul + (planeCurveFunction f 1) n (MvPolynomial.degreeOf 0 f) hn + (finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible + hf hpartialFirst).le + +/-- The powered image field, presented as an extension of the powered first +coordinate field by the powered second coordinate. -/ +abbrev PoweredImageOverFirst + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) := + IntermediateField.adjoin (FirstPoweredCoordinateSubfield f m) + ({(planeCurveFunction f 1) ^ n} : Set (PlaneCurveFunctionField f)) + +/-- The powered image field, presented as an extension of the powered second +coordinate field by the powered first coordinate. -/ +abbrev PoweredImageOverSecond + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) := + IntermediateField.adjoin (SecondPoweredCoordinateSubfield f n) + ({(planeCurveFunction f 0) ^ m} : Set (PlaneCurveFunctionField f)) + +/-- Forgetting the relative base field identifies the first presentation +with `K(x^m,y^n)`. -/ +theorem restrictScalars_poweredImageOverFirst_eq + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) : + (PoweredImageOverFirst f m n).restrictScalars K = + PoweredCoordinateImageField f m n := by + simpa only [Set.singleton_union] using + (IntermediateField.adjoin_adjoin_left K + ({(planeCurveFunction f 0) ^ m} : Set (PlaneCurveFunctionField f)) + ({(planeCurveFunction f 1) ^ n} : Set (PlaneCurveFunctionField f))) + +/-- Forgetting the relative base field identifies the second presentation +with `K(x^m,y^n)`. -/ +theorem restrictScalars_poweredImageOverSecond_eq + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) : + (PoweredImageOverSecond f m n).restrictScalars K = + PoweredCoordinateImageField f m n := by + rw [IntermediateField.adjoin_adjoin_left] + congr 1 + ext z + simp + +/-- The degree of the powered image over `K(x^m)` is bounded by the source +degree over that same rational subfield. -/ +theorem finrank_poweredImageOverFirst_le + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) ≤ + m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + exact (PoweredImageOverFirst f m n).toSubalgebra.toSubmodule.finrank_le.trans + (finrank_over_firstPoweredCoordinate_le hf hpartialSecond m hm) + +/-- The degree of the powered image over `K(y^n)` is bounded by the source +degree over that same rational subfield. -/ +theorem finrank_poweredImageOverSecond_le + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) ≤ + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := + finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn + exact (PoweredImageOverSecond f m n).toSubalgebra.toSubmodule.finrank_le.trans + (finrank_over_secondPoweredCoordinate_le hf hpartialFirst n hn) + +/-- The canonical powered-image equation is irreducible over `K`. -/ +theorem poweredCoordinateImageRelation_irreducible + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + Irreducible (poweredCoordinateImageRelation hf hpartialSecond m hm n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + change Irreducible (primitiveClearedMinpolyRelation + ((planeCurveFunction f 0) ^ m) + (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) + ((planeCurveFunction f 1) ^ n)) + exact primitiveClearedMinpolyRelation_irreducible _ _ _ hv + +/-- The canonical equation vanishes on the powered coordinate pair. -/ +theorem evalBivariate_poweredCoordinateImageRelation_eq_zero + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + evalBivariate ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) + (poweredCoordinateImageRelation hf hpartialSecond m hm n) = 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + change evalBivariate ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) + (primitiveClearedMinpolyRelation + ((planeCurveFunction f 0) ^ m) + (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) + ((planeCurveFunction f 1) ^ n)) = 0 + exact evalBivariate_primitiveClearedMinpolyRelation_eq_zero _ _ _ hv + +/-- The degree in the powered second coordinate is exactly the projection +degree of the image over `K(x^m)`. -/ +theorem poweredCoordinateImageRelation_natDegree_eq_finrank + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree = + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + calc + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree = + (minpoly (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n)).natDegree := by + change (primitiveClearedMinpolyRelation + ((planeCurveFunction f 0) ^ m) + (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) + ((planeCurveFunction f 1) ^ n)).natDegree = _ + exact primitiveClearedMinpolyRelation_natDegree _ _ _ hv + _ = Module.finrank (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) := + (IntermediateField.adjoin.finrank hv).symm + +/-- The degree in the powered first coordinate is exactly the projection +degree of the image over `K(y^n)`. -/ +theorem poweredCoordinateImageRelation_transpose_natDegree_eq_finrank + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree = + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := + finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn + have hu : IsIntegral (SecondPoweredCoordinateSubfield f n) + ((planeCurveFunction f 0) ^ m) := Algebra.IsIntegral.isIntegral _ + have hdegree := transposeBivariate_natDegree_eq_minpoly + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) + (secondPoweredCoordinate_transcendental hf hpartialFirst n hn) + (poweredCoordinateImageRelation_irreducible + hf hpartialSecond m hm n) + (evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n) + calc + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree = + (minpoly (SecondPoweredCoordinateSubfield f n) + ((planeCurveFunction f 0) ^ m)).natDegree := hdegree + _ = Module.finrank (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) := + (IntermediateField.adjoin.finrank hu).symm + +/-- Source-degree bounds for both coordinate degrees of the actual powered +image equation. -/ +theorem poweredCoordinateImageRelation_bidegree_le + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree ≤ + m * MvPolynomial.degreeOf 1 f ∧ + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree ≤ + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + constructor + · rw [poweredCoordinateImageRelation_natDegree_eq_finrank + hf hpartialSecond m hm n] + exact finrank_poweredImageOverFirst_le + hf hpartialSecond m n hm + · rw [poweredCoordinateImageRelation_transpose_natDegree_eq_finrank + hf hpartialFirst hpartialSecond m hm n hn] + exact finrank_poweredImageOverSecond_le + hf hpartialFirst m n hn + +/-- Every coefficient of the canonical powered-image equation has degree at +most its first-coordinate degree. -/ +theorem poweredCoordinateImageRelation_coeff_natDegree_le + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n i : ℕ) : + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).coeff i).natDegree ≤ + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree := by + have h := transposeBivariate_coeff_natDegree_le + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)) + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree + le_rfl i + simpa only [transposeBivariate_transposeBivariate] using h + +/-- The canonical powered-image equation has positive degree in the powered +second coordinate. -/ +theorem poweredCoordinateImageRelation_natDegree_pos + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + 0 < (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + rw [poweredCoordinateImageRelation_natDegree_eq_finrank + hf hpartialSecond m hm n, IntermediateField.adjoin.finrank hv] + exact minpoly.natDegree_pos hv + +/-- The canonical powered-image equation has positive degree in the powered +first coordinate. -/ +theorem poweredCoordinateImageRelation_transpose_natDegree_pos + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) (hn : 0 < n) : + 0 < (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + apply Nat.pos_of_ne_zero + exact transposeBivariate_natDegree_ne_zero_of_eval_eq_zero + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) + (secondPoweredCoordinate_transcendental hf hpartialFirst n hn) + (poweredCoordinateImageRelation_irreducible + hf hpartialSecond m hm n) + (evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n) + +/-- A single endpoint collecting the algebraic geometry of the powered +coordinate image: an irreducible equation over `K`, its vanishing, positive +bidegrees, source-degree bounds, and the corresponding coefficient bound. -/ +theorem poweredCoordinateImageRelation_spec + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + Irreducible g ∧ + evalBivariate ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) g = 0 ∧ + 0 < g.natDegree ∧ + 0 < (transposeBivariate g).natDegree ∧ + g.natDegree ≤ m * MvPolynomial.degreeOf 1 f ∧ + (transposeBivariate g).natDegree ≤ n * MvPolynomial.degreeOf 0 f ∧ + ∀ i, (g.coeff i).natDegree ≤ n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + have hbidegree := poweredCoordinateImageRelation_bidegree_le + hf hpartialFirst hpartialSecond m hm n hn + refine ⟨poweredCoordinateImageRelation_irreducible + hf hpartialSecond m hm n, + evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n, + poweredCoordinateImageRelation_natDegree_pos + hf hpartialSecond m hm n, + poweredCoordinateImageRelation_transpose_natDegree_pos + hf hpartialFirst hpartialSecond m hm n hn, + hbidegree.1, hbidegree.2, ?_⟩ + intro i + exact (poweredCoordinateImageRelation_coeff_natDegree_le + hf hpartialSecond m hm n i).trans hbidegree.2 + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean new file mode 100644 index 0000000000..0943fc7436 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean @@ -0,0 +1,245 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound + +/-! +# Powered-image index from an exact support determinant + +The general powered-image theorem replaces a support determinant by its +bidegree-box bound. This module retains a supplied support triple and hence +its exact determinant. It is useful for sparse curves whose support lattice +has much smaller index than the ambient degree box. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + + +/-- Over algebraically closed constants, the source-to-powered-image degree +is bounded by any nonzero determinant exhibited by three support monomials. -/ +theorem finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) + (hdet : planeCurveSupportDifferenceDet r s t ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmF : (m : F) ≠ 0) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) ≤ + (planeCurveSupportDifferenceDet r s t).natAbs := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + letI : FiniteDimensional B L := + finiteDimensional_poweredCoordinateImageField + hf hpartialSecond m n hm + letI : IsGalois B L := + isGalois_over_poweredCoordinateImageField + hf hpartialFirst hpartialSecond m n hm hn hmF hnF + have hbasic := + poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero + hf hpartialFirst hpartialSecond m n + have hgen : IntermediateField.adjoin B ({x, y} : Set L) = ⊤ := + hbasic.1 + have hgenAlg : Algebra.adjoin B ({x, y} : Set L) = ⊤ := by + rw [← IntermediateField.adjoin_toSubalgebra] + rw [hgen] + rfl + let a : ℤ := (s 0 : ℤ) - (r 0 : ℤ) + let b : ℤ := (s 1 : ℤ) - (r 1 : ℤ) + let c : ℤ := (t 0 : ℤ) - (r 0 : ℤ) + let d : ℤ := (t 1 : ℤ) - (r 1 : ℤ) + have hdet' : a * d - b * c ≠ 0 := by + simpa [a, b, c, d, planeCurveSupportDifferenceDet] using hdet + letI : Finite (torusCharacterKernel F a b c d) := + finite_torusCharacterKernel_of_det_ne_zero a b c d hdet' + let supportToKernel : planeCurveSupportCharacterStabilizer F f → + torusCharacterKernel F a b c d := fun z => + ⟨z.1, z.2 r hr s hs, z.2 r hr t ht⟩ + have supportToKernel_injective : + Function.Injective supportToKernel := by + intro z w hzw + apply Subtype.ext + exact congrArg + (fun u : torusCharacterKernel F a b c d => u.1) hzw + letI : Finite (planeCurveSupportCharacterStabilizer F f) := + Finite.of_injective supportToKernel supportToKernel_injective + have hscale (σ : L ≃ₐ[B] L) := + exists_support_stabilizer_scaling_of_poweredImage_aut + hf hpartialFirst hpartialSecond m n hm hn hmF hnF σ + let scalePair : (L ≃ₐ[B] L) → Fˣ × Fˣ := fun σ => + Classical.choose (hscale σ) + have scalePair_spec (σ : L ≃ₐ[B] L) : + algebraMap F L (scalePair σ).1 * x = σ x ∧ + algebraMap F L (scalePair σ).2 * y = σ y ∧ + ∀ r ∈ f.support, ∀ s ∈ f.support, + (scalePair σ).1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * + (scalePair σ).2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1 := + Classical.choose_spec (hscale σ) + let e : (L ≃ₐ[B] L) → planeCurveSupportCharacterStabilizer F f := + fun σ => ⟨scalePair σ, (scalePair_spec σ).2.2⟩ + have he : Function.Injective e := by + intro σ τ hστ + have hpairs : scalePair σ = scalePair τ := + congrArg Subtype.val hστ + have hx : σ x = τ x := by + rw [← (scalePair_spec σ).1, ← (scalePair_spec τ).1, hpairs] + have hy : σ y = τ y := by + rw [← (scalePair_spec σ).2.1, ← (scalePair_spec τ).2.1, hpairs] + apply AlgEquiv.ext + have hhom : σ.toAlgHom = τ.toAlgHom := by + apply AlgHom.ext_of_adjoin_eq_top hgenAlg + intro q hq + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl + · exact hx + · exact hy + exact fun z => DFunLike.congr_fun hhom z + calc + Module.finrank B L = Nat.card (L ≃ₐ[B] L) := + (IsGalois.card_aut_eq_finrank B L).symm + _ ≤ Nat.card (planeCurveSupportCharacterStabilizer F f) := + Nat.card_le_card_of_injective e he + _ ≤ (planeCurveSupportDifferenceDet r s t).natAbs := + natCard_planeCurveSupportCharacterStabilizer_le_supportDet + hr hs ht hdet + +/-- The determinant-sensitive algebraically closed bound in the +first-coordinate presentation used by Proposition Two. -/ +theorem finrank_poweredImageOverFirst_le_supportDet_isAlgClosed + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) + (hdet : planeCurveSupportDifferenceDet r s t ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmF : (m : F) ≠ 0) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + (planeCurveSupportDifferenceDet r s t).natAbs := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + rw [finrank_poweredImageOverFirst_eq_imageField] + exact finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed + hf hpartialFirst hpartialSecond hr hs ht hdet + m n hm hn hmF hnF + +/-- Exact-support index bound over arbitrary constants, obtained by the same +base-change descent as the public bidegree theorem. -/ +theorem finrank_poweredImageOverFirst_le_supportDet_of_nonzero_natCast + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) + (hdet : planeCurveSupportDifferenceDet r s t ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmK : (m : K) ≠ 0) (hnK : (n : K) ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + (planeCurveSupportDifferenceDet r s t).natAbs := by + let A := AlgebraicClosure K + let fA : MvPolynomial (Fin 2) A := + MvPolynomial.map (algebraMap K A) f + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + have hfA : Irreducible fA := habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fA) := + planeCurveCoordinateRing_isDomain hfA + have hpartialFirstA : MvPolynomial.pderiv 0 fA ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hzero + apply hpartialFirst + exact MvPolynomial.map_injective (algebraMap K A) + (algebraMap K A).injective (by simpa using hzero) + have hpartialSecondA : MvPolynomial.pderiv 1 fA ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hzero + apply hpartialSecond + exact MvPolynomial.map_injective (algebraMap K A) + (algebraMap K A).injective (by simpa using hzero) + have hsupp : fA.support = f.support := + MvPolynomial.support_map_of_injective f (algebraMap K A).injective + have hrA : r ∈ fA.support := by rwa [hsupp] + have hsA : s ∈ fA.support := by rwa [hsupp] + have htA : t ∈ fA.support := by rwa [hsupp] + have hmA : (m : A) ≠ 0 := by + rw [← map_natCast (algebraMap K A)] + simpa using (algebraMap K A).injective.ne hmK + have hnA : (n : A) ≠ 0 := by + rw [← map_natCast (algebraMap K A)] + simpa using (algebraMap K A).injective.ne hnK + have hindexBaseChange : + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField fA m n) + (PlaneCurveFunctionField fA) := + finrank_poweredCoordinateImageField_eq_baseChange + (E := A) habsolute hf hpartialSecond m hm n + change Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + (planeCurveSupportDifferenceDet r s t).natAbs + rw [finrank_poweredImageOverFirst_eq_imageField] + calc + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField fA m n) + (PlaneCurveFunctionField fA) := hindexBaseChange + _ ≤ (planeCurveSupportDifferenceDet r s t).natAbs := + finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed + hfA hpartialFirstA hpartialSecondA + hrA hsA htA hdet m n hm hn hmA hnA + +/-- Prime-to-characteristic powers satisfy the exact-support index bound. -/ +theorem finrank_poweredImageOverFirst_le_supportDet + {p : ℕ} [Fact p.Prime] + {K : Type*} [Field K] [CharP K p] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) + (hdet : planeCurveSupportDifferenceDet r s t ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + (planeCurveSupportDifferenceDet r s t).natAbs := by + apply finrank_poweredImageOverFirst_le_supportDet_of_nonzero_natCast + habsolute hpartialFirst hpartialSecond hr hs ht hdet + m n hm hn + · rwa [ne_eq, CharP.cast_eq_zero_iff K p] + · rwa [ne_eq, CharP.cast_eq_zero_iff K p] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean new file mode 100644 index 0000000000..03c2e71fde --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean @@ -0,0 +1,717 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +import Mathlib.RingTheory.TensorProduct.MvPolynomial +import Mathlib.RingTheory.TensorProduct.Quotient +import Mathlib.RingTheory.Flat.Basic + +/-! +# Powered-image relations over the Frobenius constant field + +This file proves that the equation of the image of a plane curve under the +coordinate-power map remains irreducible after arbitrary scalar extension. +It then transports that equation to the Frobenius constant field and applies +the relation criterion to obtain the auxiliary-family linear independence +used in the Corvaja--Zannier Wronskian argument. +-/ + +open scoped TensorProduct Polynomial + +namespace BGS.CorvajaZannier + +open Polynomial + +noncomputable section + +variable {K A B : Type*} [Field K] [CommRing A] [CommRing B] + [Algebra K A] [Algebra K B] + +noncomputable def bivariateEvalAlgHom (u v : A) : + Polynomial (Polynomial K) →ₐ[K] A := + Polynomial.eval₂AlgHom (Polynomial.aeval u) v (fun _ ↦ Commute.all _ _) + +theorem bivariateEvalAlgHom_comp (F : A →ₐ[K] B) (u v : A) : + F.comp (bivariateEvalAlgHom (K := K) u v) = + bivariateEvalAlgHom (K := K) (F u) (F v) := by + apply AlgHom.ext + intro P + have hr : + (F.comp (bivariateEvalAlgHom (K := K) u v)).toRingHom = + (bivariateEvalAlgHom (K := K) (F u) (F v)).toRingHom := by + apply Polynomial.ringHom_ext + · intro q + change F (bivariateEvalAlgHom (K := K) u v (Polynomial.C q)) = + bivariateEvalAlgHom (K := K) (F u) (F v) (Polynomial.C q) + simp only [bivariateEvalAlgHom, Polynomial.eval₂AlgHom_apply, + Polynomial.eval₂_C] + induction q using Polynomial.induction_on' with + | add q r hq hr => + simpa only [map_add] using congrArg₂ (fun a b ↦ a + b) hq hr + | monomial j c => simp + · simp [bivariateEvalAlgHom] + exact DFunLike.congr_fun hr P + +theorem bivariateQuotientEvalEmbedding + (u v : A) (g : Polynomial (Polynomial K)) + (hzero : bivariateEvalAlgHom u v g = 0) + (hdiv : ∀ P, bivariateEvalAlgHom u v P = 0 → g ∣ P) : + ∃ F : (Polynomial (Polynomial K) ⧸ Ideal.span {g}) →ₐ[K] A, + Function.Injective F := by + let φ : Polynomial (Polynomial K) →ₐ[K] A := + bivariateEvalAlgHom (K := K) u v + have hspan : ∀ a, a ∈ Ideal.span {g} → φ a = 0 := by + intro a ha + obtain ⟨b, rfl⟩ := Ideal.mem_span_singleton.mp ha + simp [φ, hzero] + let F : (Polynomial (Polynomial K) ⧸ Ideal.span {g}) →ₐ[K] A := + Ideal.Quotient.liftₐ (Ideal.span {g}) φ hspan + refine ⟨F, ?_⟩ + exact RingHom.lift_injective_of_ker_le_ideal (Ideal.span {g}) hspan (by + intro a ha + rw [RingHom.mem_ker] at ha + exact Ideal.mem_span_singleton.mpr (hdiv a (by simpa [φ] using ha))) + +variable {L : Type*} [Field L] [Algebra K L] + +@[simp] +theorem bivariateEvalAlgHom_eq_evalBivariate (u v : L) + (P : Polynomial (Polynomial K)) : + bivariateEvalAlgHom (K := K) u v P = evalBivariate u v P := by + rfl + +theorem primitiveClearedMinpolyRelation_dvd_of_evalBivariate_eq_zero + (u : L) (hu : Transcendental K u) (v : L) + (hv : IsIntegral (IntermediateField.adjoin K {u}) v) + (P : Polynomial (Polynomial K)) + (hP : evalBivariate u v P = 0) : + primitiveClearedMinpolyRelation u hu v ∣ P := by + letI := Classical.arbitrary (NormalizedGCDMonoid K) + let e := RatFunc.algEquivOfTranscendental u hu + let P_rat : Polynomial (RatFunc K) := + P.map (algebraMap (Polynomial K) (RatFunc K)) + let P_adjoin : Polynomial (IntermediateField.adjoin K {u}) := + P_rat.map e.toRingEquiv + have hroot_rat : + Polynomial.eval₂ (ratFuncSpecialization u hu) v P_rat = 0 := by + simpa only [P_rat, ← evalBivariate_eq_eval₂_ratFuncSpecialization_map] + using hP + have hroot_adjoin : Polynomial.aeval v P_adjoin = 0 := by + rw [Polynomial.aeval_def] + change Polynomial.eval₂ (algebraMap (IntermediateField.adjoin K {u}) L) v + (P_rat.map e.toRingEquiv.toRingHom) = 0 + rw [Polynomial.eval₂_map] + have hcoeff : + (algebraMap (IntermediateField.adjoin K {u}) L).comp + e.toRingEquiv.toRingHom = ratFuncSpecialization u hu := by + rfl + rw [hcoeff] + exact hroot_rat + obtain ⟨R, hR⟩ := minpoly.dvd (IntermediateField.adjoin K {u}) v hroot_adjoin + have hq_dvd : ratFuncMinpoly u hu v ∣ P_rat := by + refine ⟨R.map e.symm.toRingEquiv.toRingHom, ?_⟩ + have hmapped := congrArg + (fun Q : Polynomial (IntermediateField.adjoin K {u}) ↦ + Q.map e.symm.toRingEquiv.toRingHom) hR + have hcomp : + e.symm.toRingEquiv.toRingHom.comp + (e.toRingEquiv.toRingHom.comp + (algebraMap (Polynomial K) (RatFunc K))) = + algebraMap (Polynomial K) (RatFunc K) := by + apply DFunLike.ext _ _ + intro z + exact e.symm_apply_apply _ + simp only [P_adjoin, P_rat, Polynomial.map_mul, Polynomial.map_map] at hmapped + change Polynomial.map + (e.symm.toRingEquiv.toRingHom.comp + (e.toRingEquiv.toRingHom.comp + (algebraMap (Polynomial K) (RatFunc K)))) P = + Polynomial.map e.symm.toRingEquiv.toRingHom + (minpoly (IntermediateField.adjoin K {u}) v) * + Polynomial.map e.symm.toRingEquiv.toRingHom R at hmapped + rw [hcomp] at hmapped + have hmin : ratFuncMinpoly u hu v = + Polynomial.map e.symm.toRingEquiv.toRingHom + (minpoly (IntermediateField.adjoin K {u}) v) := by + rfl + rw [hmin] + exact hmapped + obtain ⟨c, hc, hgmap⟩ := + map_primitiveClearedMinpolyRelation_eq_C_mul u hu v hv + obtain ⟨R, hR⟩ := hq_dvd + have hgmap_dvd : + (primitiveClearedMinpolyRelation u hu v).map + (algebraMap (Polynomial K) (RatFunc K)) ∣ P_rat := by + refine ⟨Polynomial.C c⁻¹ * R, ?_⟩ + rw [hgmap] + calc + P_rat = ratFuncMinpoly u hu v * R := hR + _ = (Polynomial.C c * ratFuncMinpoly u hu v) * + (Polynomial.C c⁻¹ * R) := by + rw [mul_mul_mul_comm, ← Polynomial.C_mul, mul_inv_cancel₀ hc, + Polynomial.C_1, one_mul] + exact (integerClearedMinpoly u hu v).isPrimitive_primPart + |>.dvd_of_fraction_map_dvd_fraction_map hgmap_dvd + +theorem poweredCoordinateImageRelation_quotient_embeds_source + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + ∃ F : (Polynomial (Polynomial K) ⧸ Ideal.span {g}) →ₐ[K] + PlaneCurveCoordinateRing f, + Function.Injective F := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let A := PlaneCurveCoordinateRing f + let xA : A := (planeCurveCoordinate f 0) ^ m + let yA : A := (planeCurveCoordinate f 1) ^ n + let xL : L := (planeCurveFunction f 0) ^ m + let yL : L := (planeCurveFunction f 1) ^ n + let ι : A →ₐ[K] L := IsScalarTower.toAlgHom K A L + let φA : Polynomial (Polynomial K) →ₐ[K] A := + bivariateEvalAlgHom (K := K) xA yA + let φL : Polynomial (Polynomial K) →ₐ[K] L := + bivariateEvalAlgHom (K := K) xL yL + have hcomp : ι.comp φA = φL := by + simpa [φA, φL, xA, xL, yA, yL, ι, planeCurveFunction] using + (bivariateEvalAlgHom_comp (K := K) ι xA yA) + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) L := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) yL := + Algebra.IsIntegral.isIntegral _ + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + have hzeroL : φL g = 0 := by + simpa [φL, xL, yL, g] using + (evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n) + have hι : Function.Injective ι := by + exact IsFractionRing.injective A L + have hzeroA : φA g = 0 := by + apply hι + rw [map_zero, ← AlgHom.comp_apply, hcomp] + exact hzeroL + apply bivariateQuotientEvalEmbedding xA yA g hzeroA + intro P hP + change primitiveClearedMinpolyRelation xL + (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) yL ∣ P + apply primitiveClearedMinpolyRelation_dvd_of_evalBivariate_eq_zero + xL (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) yL hv + change φL P = 0 + rw [← hcomp, AlgHom.comp_apply, hP, map_zero] + +noncomputable def iteratedPolynomialBaseChangeEquiv + (E : Type*) [Field E] [Algebra K E] : + E ⊗[K] Polynomial (Polynomial K) ≃ₐ[E] + Polynomial (Polynomial E) := + (Algebra.TensorProduct.congr (AlgEquiv.refl : E ≃ₐ[E] E) + (Polynomial.Bivariate.equivMvPolynomial K)).trans + ((MvPolynomial.algebraTensorAlgEquiv K E).trans + (Polynomial.Bivariate.equivMvPolynomial E).symm) + +theorem bivariateEquiv_map_commutes + (E : Type*) [Field E] [Algebra K E] + (g : Polynomial (Polynomial K)) : + (Polynomial.Bivariate.equivMvPolynomial E).symm + (MvPolynomial.map (algebraMap K E) + (Polynomial.Bivariate.equivMvPolynomial K g)) = + g.map (Polynomial.mapRingHom (algebraMap K E)) := by + let lhs : Polynomial (Polynomial K) →+* Polynomial (Polynomial E) := + (Polynomial.Bivariate.equivMvPolynomial E).symm.toRingEquiv.toRingHom.comp + ((MvPolynomial.map (algebraMap K E)).comp + (Polynomial.Bivariate.equivMvPolynomial K).toRingEquiv.toRingHom) + let rhs : Polynomial (Polynomial K) →+* Polynomial (Polynomial E) := + Polynomial.mapRingHom (Polynomial.mapRingHom (algebraMap K E)) + change lhs g = rhs g + congr 1 + apply Polynomial.ringHom_ext + · intro q + induction q using Polynomial.induction_on' with + | add q r hq hr => simp only [map_add, hq, hr] + | monomial n c => + rw [← Polynomial.C_mul_X_pow_eq_monomial] + simp [lhs, rhs] + · simp [lhs, rhs] + +theorem iteratedPolynomialBaseChangeEquiv_tmul_one + (E : Type*) [Field E] [Algebra K E] + (g : Polynomial (Polynomial K)) : + iteratedPolynomialBaseChangeEquiv E (1 ⊗ₜ[K] g) = + g.map (Polynomial.mapRingHom (algebraMap K E)) := by + change (Polynomial.Bivariate.equivMvPolynomial E).symm + ((MvPolynomial.algebraTensorAlgEquiv K E) + ((Algebra.TensorProduct.congr (AlgEquiv.refl : E ≃ₐ[E] E) + (Polynomial.Bivariate.equivMvPolynomial K)) (1 ⊗ₜ[K] g))) = _ + rw [Algebra.TensorProduct.congr_apply, Algebra.TensorProduct.map_tmul, + MvPolynomial.algebraTensorAlgEquiv_tmul] + change (Polynomial.Bivariate.equivMvPolynomial E).symm + ((1 : E) • MvPolynomial.map (algebraMap K E) + (Polynomial.Bivariate.equivMvPolynomial K g)) = _ + rw [one_smul] + exact bivariateEquiv_map_commutes E g + +noncomputable def bivariateQuotientEquivMvPolynomial + (g : Polynomial (Polynomial K)) : + (Polynomial (Polynomial K) ⧸ Ideal.span {g}) ≃ₐ[K] + PlaneCurveCoordinateRing + (Polynomial.Bivariate.equivMvPolynomial K g) := by + apply Ideal.quotientEquivAlg + (Ideal.span {g}) + (Ideal.span {Polynomial.Bivariate.equivMvPolynomial K g}) + (Polynomial.Bivariate.equivMvPolynomial K) + simp only [Ideal.map_span, Set.image_singleton] + rfl + +theorem tensorProduct_map_id_injective + (E : Type*) [Field E] [Algebra K E] + {A B : Type*} [CommRing A] [CommRing B] + [Algebra K A] [Algebra K B] + (F : A →ₐ[K] B) (hF : Function.Injective F) : + Function.Injective + (Algebra.TensorProduct.map (AlgHom.id E E) F) := by + have heq : + (Algebra.TensorProduct.map (AlgHom.id E E) F).toLinearMap.restrictScalars K = + F.toLinearMap.lTensor E := by + ext e a + simp + rw [← heq] at * + exact Module.Flat.lTensor_preserves_injective_linearMap F.toLinearMap hF + +theorem tensorProduct_isDomain_of_embedding + (E : Type*) [Field E] [Algebra K E] + {A B : Type*} [CommRing A] [CommRing B] + [Algebra K A] [Algebra K B] + (F : A →ₐ[K] B) (hF : Function.Injective F) + (hdom : IsDomain (E ⊗[K] B)) : + IsDomain (E ⊗[K] A) := by + let Φ := Algebra.TensorProduct.map (AlgHom.id E E) F + have hΦ : Function.Injective Φ := + tensorProduct_map_id_injective E F hF + letI : IsDomain (E ⊗[K] B) := hdom + apply (isDomain_iff_noZeroDivisors_and_nontrivial _).mpr + constructor + · exact hΦ.noZeroDivisors Φ (map_zero Φ) (map_mul Φ) + · exact domain_nontrivial Φ (map_zero Φ) (map_one Φ) + +noncomputable def planeCurveCoordinateRingBaseChangeEquiv + (E : Type*) [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) : + E ⊗[K] PlaneCurveCoordinateRing f ≃+* + PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f) := by + let P := MvPolynomial (Fin 2) K + let PE := MvPolynomial (Fin 2) E + let I : Ideal P := Ideal.span {f} + let eP : E ⊗[K] P ≃ₐ[E] PE := + MvPolynomial.algebraTensorAlgEquiv K E + let IT : Ideal (E ⊗[K] P) := + I.map (Algebra.TensorProduct.includeRight (R := K) (A := E) (B := P)) + let IE : Ideal PE := + Ideal.span {MvPolynomial.map (algebraMap K E) f} + have hideal : IE = IT.map eP.toRingEquiv.toRingHom := by + simp only [IE, IT, I, Ideal.map_span, Set.image_singleton] + congr 2 + symm + change (MvPolynomial.algebraTensorAlgEquiv K E) + (1 ⊗ₜ[K] f) = MvPolynomial.map (algebraMap K E) f + simpa only [one_smul] using + (MvPolynomial.algebraTensorAlgEquiv_tmul + (R := K) (A := E) (a := (1 : E)) f) + exact + (Algebra.TensorProduct.tensorQuotientEquiv + (R := K) E P E I).toRingEquiv.trans + (Ideal.quotientEquiv IT IE eP.toRingEquiv hideal) + +theorem planeCurveCoordinateRingBaseChange_isDomain + (E : Type*) [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) : + IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := by + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + exact (planeCurveCoordinateRingBaseChangeEquiv E f).toMulEquiv.isDomain_iff.mpr + inferInstance + +theorem irreducible_mvPolynomial_map_of_tensorQuotient_isDomain + (E : Type*) [Field E] [Algebra K E] + (G : MvPolynomial (Fin 2) K) (hG : Irreducible G) + (hdom : IsDomain + (E ⊗[K] PlaneCurveCoordinateRing G)) : + Irreducible (MvPolynomial.map (algebraMap K E) G) := by + letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing G) := hdom + let e := planeCurveCoordinateRingBaseChangeEquiv E G + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) G)) := by + have hsource := (isDomain_iff_noZeroDivisors_and_nontrivial + (E ⊗[K] PlaneCurveCoordinateRing G)).mp hdom + letI : NoZeroDivisors (E ⊗[K] PlaneCurveCoordinateRing G) := hsource.1 + letI : Nontrivial (E ⊗[K] PlaneCurveCoordinateRing G) := hsource.2 + apply (isDomain_iff_noZeroDivisors_and_nontrivial _).mpr + constructor + · exact e.symm.injective.noZeroDivisors e.symm + (map_zero e.symm) (map_mul e.symm) + · exact e.symm.surjective.nontrivial + have hmap_ne : MvPolynomial.map (algebraMap K E) G ≠ 0 := by + intro hzero + apply hG.ne_zero + exact MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective (by simpa using hzero) + have hprime : + (Ideal.span {MvPolynomial.map (algebraMap K E) G} : + Ideal (MvPolynomial (Fin 2) E)).IsPrime := + (Ideal.Quotient.isDomain_iff_prime _).mp inferInstance + exact ((Ideal.span_singleton_prime hmap_ne).mp hprime).irreducible + +theorem poweredCoordinateImageRelation_irreducible_map + {E : Type*} [Field E] [Algebra K E] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + Irreducible + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom (algebraMap K E))) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let g := poweredCoordinateImageRelation hf hpartialSecond m hm n + let G := Polynomial.Bivariate.equivMvPolynomial K g + have hg : Irreducible g := + poweredCoordinateImageRelation_irreducible + hf hpartialSecond m hm n + have hG : Irreducible G := + hg.map (Polynomial.Bivariate.equivMvPolynomial K).toMulEquiv + obtain ⟨F, hF⟩ := + poweredCoordinateImageRelation_quotient_embeds_source + hf hpartialSecond m hm n + let eQ := bivariateQuotientEquivMvPolynomial g + let FMv : PlaneCurveCoordinateRing G →ₐ[K] + PlaneCurveCoordinateRing f := F.comp eQ.symm.toAlgHom + have hFMv : Function.Injective FMv := hF.comp eQ.symm.injective + have hfE : Irreducible (MvPolynomial.map (algebraMap K E) f) := + irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K E) f habsolute + have htarget : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := + planeCurveCoordinateRingBaseChange_isDomain E f hfE + have hsource : IsDomain (E ⊗[K] PlaneCurveCoordinateRing G) := + tensorProduct_isDomain_of_embedding E FMv hFMv htarget + have hGE : Irreducible (MvPolynomial.map (algebraMap K E) G) := + irreducible_mvPolynomial_map_of_tensorQuotient_isDomain + E G hG hsource + have hback := hGE.map + (Polynomial.Bivariate.equivMvPolynomial E).symm.toMulEquiv + change Irreducible + ((Polynomial.Bivariate.equivMvPolynomial E).symm + (MvPolynomial.map (algebraMap K E) + (Polynomial.Bivariate.equivMvPolynomial K g))) at hback + rw [bivariateEquiv_map_commutes E g] at hback + exact hback + +theorem transposeBivariate_map + {E : Type*} [Field E] (i : K →+* E) + (P : Polynomial (Polynomial K)) : + transposeBivariate + (P.map (Polynomial.mapRingHom i)) = + (transposeBivariate P).map (Polynomial.mapRingHom i) := by + let lhs : Polynomial (Polynomial K) →+* Polynomial (Polynomial E) := + transposeBivariate.comp + (Polynomial.mapRingHom (Polynomial.mapRingHom i)) + let rhs : Polynomial (Polynomial K) →+* Polynomial (Polynomial E) := + (Polynomial.mapRingHom (Polynomial.mapRingHom i)).comp transposeBivariate + change lhs P = rhs P + congr 1 + apply Polynomial.ringHom_ext + · intro q + simp only [lhs, rhs, RingHom.comp_apply, transposeBivariate_C] + ext c + simp + · simp [lhs, rhs, transposeBivariate] + +theorem evalBivariate_map_mapRingHom + {E : Type*} [Field E] [Algebra K E] + {L : Type*} [Field L] [Algebra K L] [Algebra E L] + [IsScalarTower K E L] + (u v : L) (P : Polynomial (Polynomial K)) : + evalBivariate u v + (P.map (Polynomial.mapRingHom (algebraMap K E))) = + evalBivariate u v P := by + unfold evalBivariate + rw [Polynomial.eval₂_map] + congr 1 + apply Polynomial.ringHom_ext + · intro c + simp [IsScalarTower.algebraMap_apply K E L] + · simp + +variable {p : ℕ} [Fact p.Prime] [CharP K p] [PerfectField K] + +noncomputable def poweredCoordinateFrobeniusImageRelation + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + Polynomial (Polynomial + (frobeniusSubfield (PlaneCurveFunctionField f) p)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let ι : K →+* frobeniusSubfield L p := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + exact transposeBivariate + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom ι)) + +theorem poweredCoordinateFrobeniusImageRelation_natDegree + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n).natDegree = + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + have hι : Function.Injective ι := + perfectConstantsToFrobeniusSubfield_injective + (K := K) (L := L) (p := p) + have hmap : Function.Injective (Polynomial.mapRingHom ι) := + Polynomial.map_injective ι hι + change (transposeBivariate + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom ι))).natDegree = _ + rw [transposeBivariate_map] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + +theorem transposeBivariate_poweredCoordinateFrobeniusImageRelation_natDegree + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + (transposeBivariate + (poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n)).natDegree = + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + have hι : Function.Injective ι := + perfectConstantsToFrobeniusSubfield_injective + (K := K) (L := L) (p := p) + have hmap : Function.Injective (Polynomial.mapRingHom ι) := + Polynomial.map_injective ι hι + change (transposeBivariate (transposeBivariate + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom ι)))).natDegree = _ + rw [transposeBivariate_transposeBivariate] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + +theorem evalBivariate_poweredCoordinateFrobeniusImageRelation_eq_zero + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + evalBivariate + ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) + (poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n) = 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + letI : Algebra K F := ι.toAlgebra + letI : IsScalarTower K F L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + exact (coe_perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c).symm + change evalBivariate + ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) + (transposeBivariate + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom (algebraMap K F)))) = 0 + rw [evalBivariate_transposeBivariate, evalBivariate_map_mapRingHom] + exact evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n + +theorem poweredCoordinateFrobeniusImageRelation_irreducible + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + Irreducible + (poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + have hbase : Irreducible + ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom ι)) := by + letI : Algebra K F := ι.toAlgebra + exact poweredCoordinateImageRelation_irreducible_map + (E := F) habsolute hf hpartialSecond m hm n + exact irreducible_transposeBivariate hbase + +theorem poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : ¬ p ∣ n) + (h k : ℕ) (hh : 0 < h) (hk : 0 < k) + (hsize : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + let g := poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n + g.natDegree * h + (transposeBivariate g).natDegree * k < p) + (hexcluded : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + let g := poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n + ¬ (g.natDegree ≤ k ∧ (transposeBivariate g).natDegree ≤ h)) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) h k) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + letI : Algebra K F := ι.toAlgebra + letI : IsScalarTower K F L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + exact (coe_perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c).symm + let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n + let gBase : Polynomial (Polynomial F) := + gK.map (Polynomial.mapRingHom ι) + let g : Polynomial (Polynomial F) := transposeBivariate gBase + have hι : Function.Injective ι := + perfectConstantsToFrobeniusSubfield_injective + (K := K) (L := L) (p := p) + have hmap : Function.Injective (Polynomial.mapRingHom ι) := + Polynomial.map_injective ι hι + have hg : Irreducible g := by + exact poweredCoordinateFrobeniusImageRelation_irreducible + (p := p) habsolute hf hpartialSecond m hm n + have hn0 : n ≠ 0 := by + intro hn0 + apply hn + simp [hn0] + have hnPos : 0 < n := Nat.pos_of_ne_zero hn0 + have hdegreeG : g.natDegree = + (transposeBivariate gK).natDegree := by + dsimp [g, gBase] + rw [transposeBivariate_map] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have ha : 0 < g.natDegree := by + rw [hdegreeG] + exact poweredCoordinateImageRelation_transpose_natDegree_pos + hf hpartialFirst hpartialSecond m hm n hnPos + have hdegreeTranspose : (transposeBivariate g).natDegree = gK.natDegree := by + dsimp [g] + rw [transposeBivariate_transposeBivariate] + dsimp [gBase] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have hb : 0 < (transposeBivariate g).natDegree := by + rw [hdegreeTranspose] + exact poweredCoordinateImageRelation_natDegree_pos + hf hpartialSecond m hm n + have hcoeff : ∀ i, (g.coeff i).natDegree ≤ + (transposeBivariate g).natDegree := by + intro i + have hcoeffBase := transposeBivariate_coeff_natDegree_le gBase + gBase.natDegree le_rfl i + simpa only [g, transposeBivariate_transposeBivariate] using hcoeffBase + have hzeroBase : evalBivariate + ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) gBase = 0 := by + dsimp [gBase] + change evalBivariate + ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) + (gK.map (Polynomial.mapRingHom (algebraMap K F))) = 0 + rw [evalBivariate_map_mapRingHom] + exact evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n + have hzero : evalBivariate + ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) g = 0 := by + dsimp [g] + rw [evalBivariate_transposeBivariate] + exact hzeroBase + exact poweredCoordinates_auxiliaryFamily_linearIndependent_of_relation + hf hpartialFirst m n hn g g.natDegree + (transposeBivariate g).natDegree h k ha hh hk hg rfl rfl + hcoeff hzero hsize hexcluded + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean new file mode 100644 index 0000000000..131982e67a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean @@ -0,0 +1,160 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +import Mathlib.Tactic + +/-! +# The powered-image auxiliary family with exchanged coordinates + +The existing powered-image theorem orients the auxiliary family as +`(x^m,y^n)`. Proposition 2 is applied with the smaller source height first, +so this module supplies the equally canonical orientation `(y^n,x^m)`. +It uses the untransposed powered-image equation and the first-coordinate +Frobenius power basis. +-/ + +open scoped Polynomial + +namespace BGS.CorvajaZannier + +open Polynomial + +noncomputable section + + +variable {K : Type*} [Field K] [PerfectField K] +variable {p : ℕ} [Fact p.Prime] [CharP K p] + +/-- Proposition 1 for the powered coordinates in the exchanged orientation. +The relation degrees are those of the untransposed powered-image equation. -/ +theorem poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent_swapped + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) (hmPrime : ¬ p ∣ m) + (h k : ℕ) (hh : 0 < h) (hk : 0 < k) + (hsize : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + let F := frobeniusSubfield (PlaneCurveFunctionField f) p + let ι : K →+* F := perfectConstantsToFrobeniusSubfield + (K := K) (L := PlaneCurveFunctionField f) (p := p) + let g := (poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom ι) + g.natDegree * h + (transposeBivariate g).natDegree * k < p) + (hexcluded : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + let F := frobeniusSubfield (PlaneCurveFunctionField f) p + let ι : K →+* F := perfectConstantsToFrobeniusSubfield + (K := K) (L := PlaneCurveFunctionField f) (p := p) + let g := (poweredCoordinateImageRelation hf hpartialSecond m hm n).map + (Polynomial.mapRingHom ι) + ¬ (g.natDegree ≤ k ∧ (transposeBivariate g).natDegree ≤ h)) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + LinearIndependent + (frobeniusSubfield (PlaneCurveFunctionField f) p) + (auxiliaryFamily ((planeCurveFunction f 1) ^ n) + ((planeCurveFunction f 0) ^ m) h k) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + letI : Algebra K F := ι.toAlgebra + letI : IsScalarTower K F L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + exact (coe_perfectConstantsToFrobeniusSubfield + (K := K) (L := L) (p := p) c).symm + let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n + let g : Polynomial (Polynomial F) := + gK.map (Polynomial.mapRingHom ι) + have hι : Function.Injective ι := + perfectConstantsToFrobeniusSubfield_injective + (K := K) (L := L) (p := p) + have hmap : Function.Injective (Polynomial.mapRingHom ι) := + Polynomial.map_injective ι hι + have hg : Irreducible g := by + dsimp only [g, gK] + exact poweredCoordinateImageRelation_irreducible_map + (E := F) habsolute hf hpartialSecond m hm n + have hdegreeG : g.natDegree = gK.natDegree := by + dsimp only [g] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have ha : 0 < g.natDegree := by + rw [hdegreeG] + exact poweredCoordinateImageRelation_natDegree_pos + hf hpartialSecond m hm n + have hdegreeTranspose : (transposeBivariate g).natDegree = + (transposeBivariate gK).natDegree := by + dsimp only [g] + rw [transposeBivariate_map] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have hb : 0 < (transposeBivariate g).natDegree := by + rw [hdegreeTranspose] + exact poweredCoordinateImageRelation_transpose_natDegree_pos + hf hpartialFirst hpartialSecond m hm n hn + have hcoeff : ∀ i, (g.coeff i).natDegree ≤ + (transposeBivariate g).natDegree := by + intro i + have hcoeffK := poweredCoordinateImageRelation_coeff_natDegree_le + hf hpartialSecond m hm n i + have hcoeffDegree : (g.coeff i).natDegree = (gK.coeff i).natDegree := by + dsimp only [g] + rw [Polynomial.coeff_map] + exact Polynomial.natDegree_map_eq_of_injective hι _ + rw [hcoeffDegree, hdegreeTranspose] + exact hcoeffK + have hzero : evalBivariate + ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) g = 0 := by + dsimp only [g] + change evalBivariate + ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) + (gK.map (Polynomial.mapRingHom (algebraMap K F))) = 0 + rw [evalBivariate_map_mapRingHom] + exact evalBivariate_poweredCoordinateImageRelation_eq_zero + hf hpartialSecond m hm n + have hminpoly : + (minpoly F ((planeCurveFunction f 0) ^ m)).natDegree = p := + minpoly_firstCoordinatePow_natDegree_eq_char + hf hpartialSecond m hmPrime + have hxTrans : Transcendental K (planeCurveFunction f 0) := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hxmTrans : Transcendental K ((planeCurveFunction f 0) ^ m) := + hxTrans.pow hm + have hxmOne : (planeCurveFunction f 0) ^ m ≠ 1 := by + intro hxm + apply hxmTrans + rw [hxm] + exact isAlgebraic_one + exact auxiliaryFamily_linearIndependent_of_irreducible_bidegree + g g.natDegree (transposeBivariate g).natDegree h k p + ha hh hk hg rfl rfl hcoeff + ((planeCurveFunction f 1) ^ n) ((planeCurveFunction f 0) ^ m) + hxmOne hminpoly hzero hsize hexcluded + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean new file mode 100644 index 0000000000..72e5360bee --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean @@ -0,0 +1,582 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +import Mathlib.FieldTheory.Galois.Basic +import Mathlib.FieldTheory.KummerExtension +import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed +import Mathlib.Tactic + +/-! +# The source-to-powered-image index over algebraically closed constants + +When the power exponents are nonzero in the constant field, the source +function field is a Galois extension of the field generated by the two powered +coordinates. Its automorphisms act diagonally on the two coordinates. The +resulting pair of roots of unity lies in the support-character stabilizer, so +a rank-two support determinant bounds the extension degree. +-/ + +namespace BGS.CorvajaZannier +noncomputable section + +private def autUnitRatio {B L : Type*} [Field B] [Field L] [Algebra B L] + (σ : L ≃ₐ[B] L) (x : L) (hx : x ≠ 0) : Lˣ := + Units.mk0 (σ x / x) (div_ne_zero ((map_ne_zero σ).2 hx) hx) + +private theorem autUnitRatio_pow_eq_one + {B L : Type*} [Field B] [Field L] [Algebra B L] + (σ : L ≃ₐ[B] L) (x : L) (hx : x ≠ 0) (d : ℕ) + (hfix : σ (x ^ d) = x ^ d) : + autUnitRatio σ x hx ^ d = 1 := by + apply Units.ext + change (σ x / x) ^ d = 1 + rw [div_pow, ← map_pow, hfix, div_self (pow_ne_zero d hx)] + +private def descendedRootUnit + {F L : Type*} [Field F] [Field L] [Algebra F L] + {d : ℕ} [NeZero d] + (hμ : (primitiveRoots d F).Nonempty) + (u : Lˣ) (hu : u ^ d = 1) : Fˣ := + ((rootsOfUnityEquivOfPrimitiveRoots (algebraMap F L).injective hμ).symm + (⟨u, hu⟩ : rootsOfUnity d L)).1 + +private theorem algebraMap_descendedRootUnit + {F L : Type*} [Field F] [Field L] [Algebra F L] + {d : ℕ} [NeZero d] + (hμ : (primitiveRoots d F).Nonempty) + (u : Lˣ) (hu : u ^ d = 1) : + algebraMap F L (descendedRootUnit hμ u hu : F) = (u : L) := by + exact rootsOfUnityEquivOfPrimitiveRoots_symm_apply + (algebraMap F L).injective hμ (⟨u, hu⟩ : rootsOfUnity d L) + +theorem poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero + {F : Type*} [Field F] {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + IntermediateField.adjoin B + ({planeCurveFunction f 0, planeCurveFunction f 1} : Set L) = ⊤ ∧ + planeCurveFunction f 0 ≠ 0 ∧ planeCurveFunction f 1 ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + have hxtrans : Transcendental F (planeCurveFunction f 0) := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hytrans : Transcendental F (planeCurveFunction f 1) := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hx0 : planeCurveFunction f 0 ≠ 0 := by + intro hx + apply hxtrans + rw [hx] + exact isAlgebraic_zero + have hy0 : planeCurveFunction f 1 ≠ 0 := by + intro hy + apply hytrans + rw [hy] + exact isAlgebraic_zero + refine ⟨?_, hx0, hy0⟩ + apply IntermediateField.restrictScalars_injective F + rw [IntermediateField.restrictScalars_top] + rw [IntermediateField.restrictScalars_adjoin_eq_sup] + have hxy : IntermediateField.adjoin F + ({planeCurveFunction f 0, planeCurveFunction f 1} : Set L) = ⊤ := by + rw [← range_planeCurveFunction f] + exact adjoin_planeCurveFunctions_eq_top + rw [hxy] + exact sup_eq_right.mpr le_top + +theorem finiteDimensional_poweredCoordinateImageField + {F : Type*} [Field F] {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + FiniteDimensional (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let E0 := FirstPoweredCoordinateSubfield f m + let B := PoweredCoordinateImageField f m n + letI : FiniteDimensional E0 L := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hE0B : E0 ≤ B := by + apply IntermediateField.adjoin.mono F + intro z hz + simp only [Set.mem_singleton_iff] at hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + exact Or.inl hz + letI : Algebra E0 B := + (IntermediateField.inclusion hE0B).toRingHom.toAlgebra + letI : IsScalarTower E0 B L := by + apply IsScalarTower.of_algebraMap_eq' + ext z + rfl + exact Module.Finite.of_restrictScalars_finite E0 B L + +theorem firstCoordinate_isSeparable_over_poweredCoordinateImageField + {F : Type*} [Field F] {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hmF : (m : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + IsSeparable (PoweredCoordinateImageField f m n) + (planeCurveFunction f 0) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let x : L := planeCurveFunction f 0 + have hxtrans : Transcendental F x := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hx0 : x ≠ 0 := by + intro hx + apply hxtrans + rw [hx] + exact isAlgebraic_zero + let bx : B := ⟨x ^ m, by + apply IntermediateField.subset_adjoin F + simp [x]⟩ + let P : Polynomial B := Polynomial.X ^ m - Polynomial.C bx + have hP : Polynomial.aeval x P = 0 := by + simp only [P, map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C] + change x ^ m - (algebraMap B L) bx = 0 + rw [IntermediateField.algebraMap_apply] + simp [bx] + have hdvd : minpoly B x ∣ P := minpoly.dvd B x hP + have hmB : (m : B) ≠ 0 := by + intro h + apply hmF + apply (algebraMap F B).injective + simpa using h + have hbx0 : bx ≠ 0 := by + intro h + apply pow_ne_zero m hx0 + exact congrArg Subtype.val h + exact Polynomial.Separable.of_dvd + (Polynomial.separable_X_pow_sub_C bx hmB hbx0) + hdvd + +theorem firstCoordinate_minpoly_splits_over_poweredCoordinateImageField + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (m n : ℕ) (hm : 0 < m) (hmF : (m : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (Polynomial.map + (algebraMap (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f)) + (minpoly (PoweredCoordinateImageField f m n) + (planeCurveFunction f 0))).Splits := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let x : L := planeCurveFunction f 0 + let bx : B := ⟨x ^ m, by + apply IntermediateField.subset_adjoin F + simp [x]⟩ + let P : Polynomial B := Polynomial.X ^ m - Polynomial.C bx + have hP : Polynomial.aeval x P = 0 := by + simp only [P, map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C] + change x ^ m - (algebraMap B L) bx = 0 + rw [IntermediateField.algebraMap_apply] + simp [bx] + have hdvd : minpoly B x ∣ P := minpoly.dvd B x hP + letI : NeZero m := ⟨Nat.ne_of_gt hm⟩ + letI : NeZero (m : F) := ⟨hmF⟩ + obtain ⟨ζ, hζ⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F m + have hζL : IsPrimitiveRoot (algebraMap F L ζ) m := + hζ.map_of_injective (algebraMap F L).injective + have hsplits : (Polynomial.X ^ m - Polynomial.C (x ^ m)).Splits := + X_pow_sub_C_splits_of_isPrimitiveRoot hζL rfl + apply Polynomial.Splits.of_dvd hsplits + (Polynomial.X_pow_sub_C_ne_zero hm (x ^ m)) + have hmap := Polynomial.map_dvd (algebraMap B L) hdvd + have hbx : (algebraMap B L) bx = x ^ m := by + rw [IntermediateField.algebraMap_apply] + rw [show P = Polynomial.X ^ m - Polynomial.C bx from rfl, + Polynomial.map_sub, Polynomial.map_pow, Polynomial.map_X, + Polynomial.map_C, hbx] at hmap + exact hmap + +theorem secondCoordinate_isSeparable_over_poweredCoordinateImageField + {F : Type*} [Field F] {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + IsSeparable (PoweredCoordinateImageField f m n) + (planeCurveFunction f 1) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let y : L := planeCurveFunction f 1 + have hytrans : Transcendental F y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro hy + apply hytrans + rw [hy] + exact isAlgebraic_zero + let by' : B := ⟨y ^ n, by + apply IntermediateField.subset_adjoin F + simp [y]⟩ + let P : Polynomial B := Polynomial.X ^ n - Polynomial.C by' + have hP : Polynomial.aeval y P = 0 := by + simp only [P, map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C] + change y ^ n - (algebraMap B L) by' = 0 + rw [IntermediateField.algebraMap_apply] + simp [by'] + have hdvd : minpoly B y ∣ P := minpoly.dvd B y hP + have hnB : (n : B) ≠ 0 := by + intro h + apply hnF + apply (algebraMap F B).injective + simpa using h + have hby0 : by' ≠ 0 := by + intro h + apply pow_ne_zero n hy0 + exact congrArg Subtype.val h + exact Polynomial.Separable.of_dvd + (Polynomial.separable_X_pow_sub_C by' hnB hby0) + hdvd + +theorem secondCoordinate_minpoly_splits_over_poweredCoordinateImageField + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (m n : ℕ) (hn : 0 < n) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + (Polynomial.map + (algebraMap (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f)) + (minpoly (PoweredCoordinateImageField f m n) + (planeCurveFunction f 1))).Splits := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let y : L := planeCurveFunction f 1 + let by' : B := ⟨y ^ n, by + apply IntermediateField.subset_adjoin F + simp [y]⟩ + let P : Polynomial B := Polynomial.X ^ n - Polynomial.C by' + have hP : Polynomial.aeval y P = 0 := by + simp only [P, map_sub, map_pow, Polynomial.aeval_X, Polynomial.aeval_C] + change y ^ n - (algebraMap B L) by' = 0 + rw [IntermediateField.algebraMap_apply] + simp [by'] + have hdvd : minpoly B y ∣ P := minpoly.dvd B y hP + letI : NeZero n := ⟨Nat.ne_of_gt hn⟩ + letI : NeZero (n : F) := ⟨hnF⟩ + obtain ⟨η, hη⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F n + have hηL : IsPrimitiveRoot (algebraMap F L η) n := + hη.map_of_injective (algebraMap F L).injective + have hsplits : (Polynomial.X ^ n - Polynomial.C (y ^ n)).Splits := + X_pow_sub_C_splits_of_isPrimitiveRoot hηL rfl + apply Polynomial.Splits.of_dvd hsplits + (Polynomial.X_pow_sub_C_ne_zero hn (y ^ n)) + have hmap := Polynomial.map_dvd (algebraMap B L) hdvd + have hby : (algebraMap B L) by' = y ^ n := by + rw [IntermediateField.algebraMap_apply] + rw [show P = Polynomial.X ^ n - Polynomial.C by' from rfl, + Polynomial.map_sub, Polynomial.map_pow, Polynomial.map_X, + Polynomial.map_C, hby] at hmap + exact hmap + +theorem isGalois_over_poweredCoordinateImageField + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmF : (m : F) ≠ 0) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + IsGalois (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let E0 := FirstPoweredCoordinateSubfield f m + letI : FiniteDimensional E0 L := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hE0B : E0 ≤ B := by + apply IntermediateField.adjoin.mono F + intro z hz + simp only [Set.mem_singleton_iff] at hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] + exact Or.inl hz + letI : Algebra E0 B := + (IntermediateField.inclusion hE0B).toRingHom.toAlgebra + letI : IsScalarTower E0 B L := by + apply IsScalarTower.of_algebraMap_eq' + ext z + rfl + letI : FiniteDimensional B L := + Module.Finite.of_restrictScalars_finite E0 B L + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hbasic := poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero hf hpartialFirst + hpartialSecond m n + have hgen : IntermediateField.adjoin B ({x, y} : Set L) = ⊤ := hbasic.1 + have hxsep : IsSeparable B x := + firstCoordinate_isSeparable_over_poweredCoordinateImageField hf hpartialSecond m n hmF + have hysep : IsSeparable B y := + secondCoordinate_isSeparable_over_poweredCoordinateImageField hf hpartialFirst m n hnF + letI : Algebra.IsSeparable B L := ⟨fun z => by + letI : Algebra.IsSeparable B (IntermediateField.adjoin B ({x, y} : Set L)) := + IntermediateField.isSeparable_adjoin_pair_of_isSeparable B L hxsep hysep + have hz : z ∈ IntermediateField.adjoin B ({x, y} : Set L) := by + rw [hgen] + exact Set.mem_univ z + exact IntermediateField.isSeparable_of_mem_isSeparable B L hz⟩ + have hxsplits : + (Polynomial.map (algebraMap B L) (minpoly B x)).Splits := + firstCoordinate_minpoly_splits_over_poweredCoordinateImageField hf m n hm hmF + have hysplits : + (Polynomial.map (algebraMap B L) (minpoly B y)).Splits := + secondCoordinate_minpoly_splits_over_poweredCoordinateImageField hf m n hn hnF + letI : Normal B L := normal_iff.mpr fun z => by + refine ⟨Algebra.IsIntegral.isIntegral z, ?_⟩ + have hz : z ∈ IntermediateField.adjoin B ({x, y} : Set L) := by + rw [hgen] + exact Set.mem_univ z + apply IntermediateField.splits_of_mem_adjoin B L _ hz + intro q hq + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl + · exact ⟨IsSeparable.isIntegral hxsep, hxsplits⟩ + · exact ⟨IsSeparable.isIntegral hysep, hysplits⟩ + exact IsGalois.mk + +theorem exists_support_stabilizer_scaling_of_poweredImage_aut + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmF : (m : F) ≠ 0) (hnF : (n : F) ≠ 0) + (σ : + letI := planeCurveCoordinateRing_isDomain hf + (PlaneCurveFunctionField f) ≃ₐ[PoweredCoordinateImageField f m n] + (PlaneCurveFunctionField f)) : + letI := planeCurveCoordinateRing_isDomain hf + ∃ z : Fˣ × Fˣ, + algebraMap F (PlaneCurveFunctionField f) z.1 * planeCurveFunction f 0 = + σ (planeCurveFunction f 0) ∧ + algebraMap F (PlaneCurveFunctionField f) z.2 * planeCurveFunction f 1 = + σ (planeCurveFunction f 1) ∧ + (∀ r ∈ f.support, ∀ s ∈ f.support, + z.1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * + z.2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + have hbasic := poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero hf hpartialFirst + hpartialSecond m n + have hx0 : x ≠ 0 := hbasic.2.1 + have hy0 : y ≠ 0 := hbasic.2.2 + let bx : B := ⟨x ^ m, by + apply IntermediateField.subset_adjoin F + simp [x]⟩ + let by' : B := ⟨y ^ n, by + apply IntermediateField.subset_adjoin F + simp [y]⟩ + have hbx : (algebraMap B L) bx = x ^ m := by + rw [IntermediateField.algebraMap_apply] + have hby : (algebraMap B L) by' = y ^ n := by + rw [IntermediateField.algebraMap_apply] + have hfixx : σ (x ^ m) = x ^ m := by + rw [← hbx, σ.commutes] + have hfixy : σ (y ^ n) = y ^ n := by + rw [← hby, σ.commutes] + have hux : autUnitRatio σ x hx0 ^ m = 1 := + autUnitRatio_pow_eq_one σ x hx0 m hfixx + have huy : autUnitRatio σ y hy0 ^ n = 1 := + autUnitRatio_pow_eq_one σ y hy0 n hfixy + letI : NeZero m := ⟨Nat.ne_of_gt hm⟩ + letI : NeZero n := ⟨Nat.ne_of_gt hn⟩ + letI : NeZero (m : F) := ⟨hmF⟩ + letI : NeZero (n : F) := ⟨hnF⟩ + obtain ⟨ζ, hζ⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F m + obtain ⟨η, hη⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F n + have hμm : (primitiveRoots m F).Nonempty := + ⟨ζ, (mem_primitiveRoots hm).2 hζ⟩ + have hμn : (primitiveRoots n F).Nonempty := + ⟨η, (mem_primitiveRoots hn).2 hη⟩ + let zx : Fˣ := descendedRootUnit hμm (autUnitRatio σ x hx0) hux + let zy : Fˣ := descendedRootUnit hμn (autUnitRatio σ y hy0) huy + have hzxMap : algebraMap F L (zx : F) = (autUnitRatio σ x hx0 : L) := + algebraMap_descendedRootUnit hμm (autUnitRatio σ x hx0) hux + have hzyMap : algebraMap F L (zy : F) = (autUnitRatio σ y hy0 : L) := + algebraMap_descendedRootUnit hμn (autUnitRatio σ y hy0) huy + have hzx : algebraMap F L zx * x = σ x := by + rw [hzxMap] + exact div_mul_cancel₀ (σ x) hx0 + have hzy : algebraMap F L zy * y = σ y := by + rw [hzyMap] + exact div_mul_cancel₀ (σ y) hy0 + refine ⟨(zx, zy), hzx, hzy, ?_⟩ + apply planeCurveSupportCharacterStabilizer_of_diagonalScale_eval_zero hf + have hxyfun : planeCurveFunction f = ![x, y] := by + funext i + fin_cases i <;> rfl + rw [hxyfun] + rw [eval₂_diagonalScale] + have hcoeff : σ.toRingHom.comp (algebraMap F L) = algebraMap F L := by + ext c + rw [RingHom.comp_apply, IsScalarTower.algebraMap_apply F B L] + change σ ((algebraMap B L) ((algebraMap F B) c)) = + (algebraMap B L) ((algebraMap F B) c) + exact σ.commutes ((algebraMap F B) c) + have hmap := MvPolynomial.map_eval₂Hom (algebraMap F L) + (planeCurveFunction f) σ.toRingHom f + rw [hcoeff] at hmap + have hgeneric := eval₂_planeCurveFunction_eq_zero f + have hzero : MvPolynomial.eval₂ (algebraMap F L) + (fun i => σ (planeCurveFunction f i)) f = 0 := by + change (MvPolynomial.eval₂Hom (algebraMap F L) + (fun i => σ.toRingHom (planeCurveFunction f i))) f = 0 + change (MvPolynomial.eval₂Hom (algebraMap F L) + (planeCurveFunction f)) f = 0 at hgeneric + rw [← hmap, hgeneric, map_zero] + have hcoords : ![algebraMap F L zx * x, algebraMap F L zy * y] = + fun i => σ (planeCurveFunction f i) := by + funext i + fin_cases i <;> simp [x, y, hzx, hzy] + rw [hcoords] + exact hzero + +theorem finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hrank : PlaneCurveSupportHasRankTwo f) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmF : (m : F) ≠ 0) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let B := PoweredCoordinateImageField f m n + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + letI : FiniteDimensional B L := + finiteDimensional_poweredCoordinateImageField hf hpartialSecond m n hm + letI : IsGalois B L := + isGalois_over_poweredCoordinateImageField hf hpartialFirst hpartialSecond m n hm hn hmF hnF + have hbasic := poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero hf hpartialFirst + hpartialSecond m n + have hgen : IntermediateField.adjoin B ({x, y} : Set L) = ⊤ := hbasic.1 + have hgenAlg : Algebra.adjoin B ({x, y} : Set L) = ⊤ := by + rw [← IntermediateField.adjoin_toSubalgebra] + rw [hgen] + rfl + have hrank' := hrank + obtain ⟨r₀, s₀, t₀, hr₀, hs₀, ht₀, hdet₀⟩ := hrank' + let a : ℤ := (s₀ 0 : ℤ) - (r₀ 0 : ℤ) + let b : ℤ := (s₀ 1 : ℤ) - (r₀ 1 : ℤ) + let c : ℤ := (t₀ 0 : ℤ) - (r₀ 0 : ℤ) + let d : ℤ := (t₀ 1 : ℤ) - (r₀ 1 : ℤ) + have hdet' : a * d - b * c ≠ 0 := by + simpa [a, b, c, d, planeCurveSupportDifferenceDet] using hdet₀ + letI : Finite (torusCharacterKernel F a b c d) := + finite_torusCharacterKernel_of_det_ne_zero a b c d hdet' + let supportToKernel : planeCurveSupportCharacterStabilizer F f → + torusCharacterKernel F a b c d := fun z => + ⟨z.1, z.2 r₀ hr₀ s₀ hs₀, z.2 r₀ hr₀ t₀ ht₀⟩ + have supportToKernel_injective : Function.Injective supportToKernel := by + intro z w hzw + apply Subtype.ext + exact congrArg (fun u : torusCharacterKernel F a b c d => u.1) hzw + letI : Finite (planeCurveSupportCharacterStabilizer F f) := + Finite.of_injective supportToKernel supportToKernel_injective + have hscale (σ : L ≃ₐ[B] L) := + exists_support_stabilizer_scaling_of_poweredImage_aut hf hpartialFirst hpartialSecond + m n hm hn hmF hnF σ + let scalePair : (L ≃ₐ[B] L) → Fˣ × Fˣ := fun σ => + Classical.choose (hscale σ) + have scalePair_spec (σ : L ≃ₐ[B] L) : + algebraMap F L (scalePair σ).1 * x = σ x ∧ + algebraMap F L (scalePair σ).2 * y = σ y ∧ + ∀ r ∈ f.support, ∀ s ∈ f.support, + (scalePair σ).1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * + (scalePair σ).2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1 := + Classical.choose_spec (hscale σ) + let e : (L ≃ₐ[B] L) → planeCurveSupportCharacterStabilizer F f := + fun σ => ⟨scalePair σ, (scalePair_spec σ).2.2⟩ + have he : Function.Injective e := by + intro σ τ hστ + have hpairs : scalePair σ = scalePair τ := + congrArg Subtype.val hστ + have hx : σ x = τ x := by + rw [← (scalePair_spec σ).1, ← (scalePair_spec τ).1, hpairs] + have hy : σ y = τ y := by + rw [← (scalePair_spec σ).2.1, ← (scalePair_spec τ).2.1, hpairs] + apply AlgEquiv.ext + have hhom : σ.toAlgHom = τ.toAlgHom := by + apply AlgHom.ext_of_adjoin_eq_top hgenAlg + intro q hq + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl + · exact hx + · exact hy + exact fun z => DFunLike.congr_fun hhom z + calc + Module.finrank B L = Nat.card (L ≃ₐ[B] L) := + (IsGalois.card_aut_eq_finrank B L).symm + _ ≤ Nat.card (planeCurveSupportCharacterStabilizer F f) := + Nat.card_le_card_of_injective e he + _ ≤ 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := + natCard_planeCurveSupportCharacterStabilizer_le_twice_bidegree hrank + +/-- The same algebraically closed bound in the first-coordinate presentation +used by the Corvaja--Zannier endpoint. -/ +theorem finrank_poweredImageOverFirst_le_twice_bidegree_isAlgClosed + {F : Type*} [Field F] [IsAlgClosed F] + {f : MvPolynomial (Fin 2) F} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hrank : PlaneCurveSupportHasRankTwo f) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmF : (m : F) ≠ 0) (hnF : (n : F) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + rw [finrank_poweredImageOverFirst_eq_imageField] + exact finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed + hf hpartialFirst hpartialSecond hrank m n hm hn hmF hnF + +end +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean new file mode 100644 index 0000000000..37175fa742 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve + +/-! +# The source-to-powered-image degree factor + +The bidegrees of `poweredCoordinateImageRelation` are degrees on the powered +image curve, whereas the divisor argument computes coordinate heights on the +source curve. The discrepancy is exactly the degree of the finite map from +the source curve to its powered image. These tower identities expose that +factor explicitly. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The source degree over the powered first coordinate is the powered-image +relation's degree in the second coordinate times the source-to-image degree. -/ +theorem poweredCoordinateImageRelation_natDegree_mul_imageIndex + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree * + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + rw [poweredCoordinateImageRelation_natDegree_eq_finrank + hf hpartialSecond m hm n] + exact Module.finrank_mul_finrank + (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) + +/-- The source degree over the powered second coordinate is the powered-image +relation's degree in the first coordinate times the same geometric +source-to-image degree, written in the second-coordinate presentation. -/ +theorem poweredCoordinateImageRelation_transpose_natDegree_mul_imageIndex + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + (transposeBivariate + (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree * + Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) = + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := + finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn + rw [poweredCoordinateImageRelation_transpose_natDegree_eq_finrank + hf hpartialFirst hpartialSecond m hm n hn] + exact Module.finrank_mul_finrank + (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean new file mode 100644 index 0000000000..b8c29f6079 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +import Mathlib.Tactic + +/-! +# The common source-to-powered-image index + +The powered image field is presented twice, once over each powered coordinate. +Although these presentations have different base fields, their underlying +intermediate field in the source function field is the same. This file +transports finrank across `IntermediateField.restrictScalars`, identifies the +two source-to-image indices, and records the elementary projection bounds. + +These statements do not identify image-curve degrees with source heights. +The missing exponent-independent bound on the common index is a genuinely +additional logarithmic-geometric input. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +private theorem finrank_restrictScalars_intermediateField + {K E L : Type*} [Field K] [Field E] [Field L] + [Algebra K E] [Algebra K L] [Algebra E L] [IsScalarTower K E L] + (A : IntermediateField E L) : + Module.finrank (A.restrictScalars K) L = Module.finrank A L := by + let e : (A.restrictScalars K) ≃+* A := + { toFun := fun z => ⟨z.1, z.2⟩ + invFun := fun z => ⟨z.1, z.2⟩ + left_inv := fun _ => rfl + right_inv := fun _ => rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + exact Algebra.finrank_eq_of_equiv_equiv e (RingEquiv.refl L) + (by ext z; rfl) + +/-- The first-coordinate presentation has the same source degree as the +common powered image field `K(x^m,y^n)`. -/ +theorem finrank_poweredImageOverFirst_eq_imageField + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) : + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) := by + let A := PoweredImageOverFirst f m n + have htransport : Module.finrank (A.restrictScalars K) + (PlaneCurveFunctionField f) = + Module.finrank A (PlaneCurveFunctionField f) := + finrank_restrictScalars_intermediateField A + have hfield := restrictScalars_poweredImageOverFirst_eq f m n + have hrank := congrArg + (fun E : IntermediateField K (PlaneCurveFunctionField f) => + Module.finrank E (PlaneCurveFunctionField f)) hfield + exact htransport.symm.trans hrank + +/-- The second-coordinate presentation has the same source degree as the +common powered image field `K(x^m,y^n)`. -/ +theorem finrank_poweredImageOverSecond_eq_imageField + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) : + Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) := by + let A := PoweredImageOverSecond f m n + have htransport : Module.finrank (A.restrictScalars K) + (PlaneCurveFunctionField f) = + Module.finrank A (PlaneCurveFunctionField f) := + finrank_restrictScalars_intermediateField A + have hfield := restrictScalars_poweredImageOverSecond_eq f m n + have hrank := congrArg + (fun E : IntermediateField K (PlaneCurveFunctionField f) => + Module.finrank E (PlaneCurveFunctionField f)) hfield + exact htransport.symm.trans hrank + +/-- Both relative presentations compute one and the same geometric degree of +the source-to-powered-image map. -/ +theorem finrank_poweredImageOverFirst_eq_poweredImageOverSecond + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + [IsDomain (PlaneCurveCoordinateRing f)] (m n : ℕ) : + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) := by + rw [finrank_poweredImageOverFirst_eq_imageField, + finrank_poweredImageOverSecond_eq_imageField] + +/-- The common powered-image index is at most the source degree over the +powered first coordinate, hence at most `m * degreeOf 1 f`. -/ +theorem finrank_poweredImageOverFirst_le_firstProjectionPowerDegree + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have htower := Module.finrank_mul_finrank + (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) + have hfactor : 0 < Module.finrank (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) := Module.finrank_pos + have hindexSource : Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := by + calc + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) * + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) := by + exact Nat.le_mul_of_pos_left _ hfactor + _ = Module.finrank (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := htower + exact hindexSource.trans + (finrank_over_firstPoweredCoordinate_le hf hpartialSecond m hm) + +/-- The common powered-image index is at most the source degree over the +powered second coordinate, hence at most `n * degreeOf 0 f`. -/ +theorem finrank_poweredImageOverSecond_le_secondProjectionPowerDegree + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (m n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) ≤ + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := + finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn + have htower := Module.finrank_mul_finrank + (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) + have hfactor : 0 < Module.finrank (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) := Module.finrank_pos + have hindexSource : Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) ≤ + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := by + calc + Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) ≤ + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) * + Module.finrank (PoweredImageOverSecond f m n) + (PlaneCurveFunctionField f) := by + exact Nat.le_mul_of_pos_left _ hfactor + _ = Module.finrank (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) := htower + exact hindexSource.trans + (finrank_over_secondPoweredCoordinate_le hf hpartialFirst n hn) + +end + + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean new file mode 100644 index 0000000000..9dfac3994c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound +import Mathlib.Tactic + +/-! +# The Corvaja--Zannier source-to-powered-image index bound + +This module transports the Galois stabilizer count from algebraically closed +constants back to the original constant field. Absolute irreducibility makes +the powered-image degree invariant under this extension of constants, while +the semantic non-subtorus hypothesis supplies the rank-two support determinant. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The exact source-to-powered-image bound, with separability of the two power +maps expressed by nonvanishing of the exponent casts. -/ +theorem finrank_poweredImageOverFirst_le_twice_bidegree_of_nonzero_natCast + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hnot : BGS.External.TorusCurveNotSubtorusTranslate f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmK : (m : K) ≠ 0) (hnK : (n : K) ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + let A := AlgebraicClosure K + let fA : MvPolynomial (Fin 2) A := + MvPolynomial.map (algebraMap K A) f + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + have hfA : Irreducible fA := habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fA) := + planeCurveCoordinateRing_isDomain hfA + have hpartialFirstA : MvPolynomial.pderiv 0 fA ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hzero + apply hpartialFirst + exact MvPolynomial.map_injective (algebraMap K A) + (algebraMap K A).injective (by simpa using hzero) + have hpartialSecondA : MvPolynomial.pderiv 1 fA ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hzero + apply hpartialSecond + exact MvPolynomial.map_injective (algebraMap K A) + (algebraMap K A).injective (by simpa using hzero) + have hrank : PlaneCurveSupportHasRankTwo f := + planeCurveSupportHasRankTwo_of_absoluteIrreducible_notSubtorusTranslate + habsolute hnot + have hsupp : fA.support = f.support := + MvPolynomial.support_map_of_injective f (algebraMap K A).injective + have hrankA : PlaneCurveSupportHasRankTwo fA := by + obtain ⟨r, s, t, hr, hs, ht, hdet⟩ := hrank + refine ⟨r, s, t, ?_, ?_, ?_, hdet⟩ + · rwa [hsupp] + · rwa [hsupp] + · rwa [hsupp] + have hmA : (m : A) ≠ 0 := by + rw [← map_natCast (algebraMap K A)] + simpa using (algebraMap K A).injective.ne hmK + have hnA : (n : A) ≠ 0 := by + rw [← map_natCast (algebraMap K A)] + simpa using (algebraMap K A).injective.ne hnK + have hindexBaseChange : + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField fA m n) + (PlaneCurveFunctionField fA) := + finrank_poweredCoordinateImageField_eq_baseChange + (E := A) habsolute hf hpartialSecond m hm n + have hdegreeFirst : MvPolynomial.degreeOf 0 fA = + MvPolynomial.degreeOf 0 f := + degreeOf_map_eq_of_injective (algebraMap K A) + (algebraMap K A).injective 0 f + have hdegreeSecond : MvPolynomial.degreeOf 1 fA = + MvPolynomial.degreeOf 1 f := + degreeOf_map_eq_of_injective (algebraMap K A) + (algebraMap K A).injective 1 f + change Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f + rw [finrank_poweredImageOverFirst_eq_imageField] + calc + Module.finrank (PoweredCoordinateImageField f m n) + (PlaneCurveFunctionField f) = + Module.finrank (PoweredCoordinateImageField fA m n) + (PlaneCurveFunctionField fA) := hindexBaseChange + _ ≤ 2 * MvPolynomial.degreeOf 0 fA * MvPolynomial.degreeOf 1 fA := + finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed + hfA hpartialFirstA hpartialSecondA hrankA m n hm hn hmA hnA + _ = 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + rw [hdegreeFirst, hdegreeSecond] + +/-- Prime-to-characteristic powers satisfy the exact Corvaja--Zannier +source-to-powered-image index bound. -/ +theorem finrank_poweredImageOverFirst_le_twice_bidegree + {p : ℕ} [Fact p.Prime] + {K : Type*} [Field K] [CharP K p] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hnot : BGS.External.TorusCurveNotSubtorusTranslate f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + apply finrank_poweredImageOverFirst_le_twice_bidegree_of_nonzero_natCast + habsolute hnot hpartialFirst hpartialSecond m n hm hn + · rwa [ne_eq, CharP.cast_eq_zero_iff K p] + · rwa [ne_eq, CharP.cast_eq_zero_iff K p] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean new file mode 100644 index 0000000000..398b874b13 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +import Mathlib.Tactic + +/-! +# Enlarging the degree data in Corvaja--Zannier Proposition 2 + +The actual coordinate degrees of a plane curve can be strictly smaller than +the public bidegree bounds used by the final theorem. The degree alternative +in Proposition 2 is not itself monotone in those bounds. Nevertheless, once +the gcd quantity satisfies its trivial bound by the first actual degree, an +actual degree alternative implies the numerical alternative for every larger +pair of degrees: its Euler term already dominates the first degree. + +This is the exact numerical bridge needed between a Proposition 2 proof at +the curve's actual degrees and the public min/max degree convention. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- Proposition 2 remains valid after enlarging both degrees and the Euler +budget, provided the gcd quantity has the trivial bound by the first original +degree. + +The old degree alternative cannot in general be transported to the larger +degrees. In that case both parameters are positive, and +`2 * k <= h * k + h + k - 1`; hence the new Euler term (whose Euler budget is +positive) is at least `k`, and therefore at least the gcd quantity. -/ +theorem propositionTwoNumericalAlternatives_mono_degreeBounds + (a b A B p chi Chi : ℕ) (G : ℝ) + (ha : 0 < a) (hb : 0 < b) + (haA : a ≤ A) (hbB : b ≤ B) + (hchi : chi ≤ Chi) (hChi : 0 < Chi) + (hG : G ≤ (a : ℝ)) + (hactual : PropositionTwoNumericalAlternatives a b p chi G) : + PropositionTwoNumericalAlternatives A B p Chi G := by + intro h k hadmissible + have hadmissibleActual : + PropositionTwoParametersAreAdmissible a b p h k := by + refine ⟨hadmissible.1, ?_⟩ + have hweighted : a * h + b * k ≤ A * h + B * k := + Nat.add_le_add (Nat.mul_le_mul_right h haA) + (Nat.mul_le_mul_right k hbB) + exact hweighted.trans_lt hadmissible.2 + rcases hactual h k hadmissibleActual with hdegree | hbound + · right + let n : ℕ := h * k + h + k + have hkPos : 0 < k := lt_of_lt_of_le ha hdegree.1 + have hhPos : 0 < h := lt_of_lt_of_le hb hdegree.2 + have hnSub : 2 * k ≤ n - 1 := by + obtain ⟨h', rfl⟩ := Nat.exists_eq_succ_of_ne_zero hhPos.ne' + simp only [n, Nat.succ_mul, Nat.succ_eq_add_one] + omega + have hnSubReal : (2 * k : ℝ) ≤ (n : ℝ) - 1 := by + have hnOne : 1 ≤ n := by dsimp only [n]; omega + have hnSubCast : ((2 * k : ℕ) : ℝ) ≤ ((n - 1 : ℕ) : ℝ) := by + exact_mod_cast hnSub + rw [Nat.cast_sub hnOne] at hnSubCast + norm_num at hnSubCast ⊢ + exact hnSubCast + have hkEulerHalf : (k : ℝ) ≤ ((n : ℝ) - 1) / 2 := by + linarith + have hEulerHalfNonneg : 0 ≤ ((n : ℝ) - 1) / 2 := + (Nat.cast_nonneg k).trans hkEulerHalf + have hChiReal : (1 : ℝ) ≤ (Chi : ℝ) := by + exact_mod_cast (Nat.one_le_iff_ne_zero.mpr hChi.ne') + have hkEuler : + (k : ℝ) ≤ (((n : ℝ) - 1) / 2) * (Chi : ℝ) := by + calc + (k : ℝ) ≤ ((n : ℝ) - 1) / 2 := hkEulerHalf + _ = (((n : ℝ) - 1) / 2) * 1 := by ring + _ ≤ (((n : ℝ) - 1) / 2) * (Chi : ℝ) := + mul_le_mul_of_nonneg_left hChiReal hEulerHalfNonneg + have hGa : G ≤ (k : ℝ) := + hG.trans (by exact_mod_cast hdegree.1) + have hnPosReal : 0 < (n : ℝ) := by + exact_mod_cast hadmissible.1 + have hfirstNonneg : + 0 ≤ (((h + 2 * k : ℕ) : ℝ) / (n : ℝ)) * (A : ℝ) := + mul_nonneg (div_nonneg (Nat.cast_nonneg _) hnPosReal.le) + (Nat.cast_nonneg _) + have hsecondNonneg : + 0 ≤ ((k : ℝ) / (n : ℝ)) * (B : ℝ) := + mul_nonneg (div_nonneg (Nat.cast_nonneg _) hnPosReal.le) + (Nat.cast_nonneg _) + calc + G ≤ (k : ℝ) := hGa + _ ≤ (((n : ℝ) - 1) / 2) * (Chi : ℝ) := hkEuler + _ ≤ + (((h + 2 * k : ℕ) : ℝ) / (n : ℝ)) * (A : ℝ) + + ((k : ℝ) / (n : ℝ)) * (B : ℝ) + + (((n : ℝ) - 1) / 2) * (Chi : ℝ) := by + linarith + _ = + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * (A : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (B : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * + (Chi : ℝ) := by + rfl + · right + let n : ℕ := h * k + h + k + have hnPosReal : 0 < (n : ℝ) := by + exact_mod_cast hadmissible.1 + have hfirstCoefficient : + 0 ≤ ((h + 2 * k : ℕ) : ℝ) / (n : ℝ) := + div_nonneg (Nat.cast_nonneg _) hnPosReal.le + have hsecondCoefficient : 0 ≤ (k : ℝ) / (n : ℝ) := + div_nonneg (Nat.cast_nonneg _) hnPosReal.le + have hnOne : 1 ≤ n := by + exact Nat.one_le_iff_ne_zero.mpr (Nat.ne_of_gt hadmissible.1) + have hthirdCoefficient : 0 ≤ ((n : ℝ) - 1) / 2 := by + have : (1 : ℝ) ≤ (n : ℝ) := by exact_mod_cast hnOne + positivity + have haReal : (a : ℝ) ≤ (A : ℝ) := by exact_mod_cast haA + have hbReal : (b : ℝ) ≤ (B : ℝ) := by exact_mod_cast hbB + have hchiReal : (chi : ℝ) ≤ (Chi : ℝ) := by exact_mod_cast hchi + have hfirst := mul_le_mul_of_nonneg_left haReal hfirstCoefficient + have hsecond := mul_le_mul_of_nonneg_left hbReal hsecondCoefficient + have hthird := mul_le_mul_of_nonneg_left hchiReal hthirdCoefficient + calc + G ≤ + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * (a : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (b : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * + (chi : ℝ) := hbound + _ ≤ + (((h + 2 * k : ℕ) : ℝ) / (n : ℝ)) * (A : ℝ) + + ((k : ℝ) / (n : ℝ)) * (B : ℝ) + + (((n : ℝ) - 1) / 2) * (Chi : ℝ) := by + dsimp only [n] at hfirst hsecond hthird ⊢ + linarith + _ = + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * (A : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (B : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * + (Chi : ℝ) := by + rfl + +/-- Convert an auxiliary degree alternative on a finite image curve into the +numerical alternative at the source-curve heights. + +Here `a` and `b` are the two image-curve degrees, `A` is the first source +height, and `d` is the source-to-image degree. In the intended application +`A = d * a`. The hypothesis `d ≤ Chi` is the precise extra input needed to +absorb the image degree alternative into the source Euler term. Merely knowing +`a ≤ A` is not enough. + +The hypothesis `hauxiliary` deliberately keeps the numerical branch already +at the source degrees `A`, `B`: this is the shape produced by the canonical +Wronskian sum, whose divisor degrees are computed on the source curve. -/ +theorem propositionTwoNumericalAlternatives_of_scaledAuxiliaryDegreeAlternative + (a b d A B p Chi : ℕ) (G : ℝ) + (ha : 0 < a) (hb : 0 < b) + (hA : A ≤ d * a) (hdChi : d ≤ Chi) + (hG : G ≤ (A : ℝ)) + (hauxiliary : ∀ h k : ℕ, + PropositionTwoParametersAreAdmissible A B p h k → + (a ≤ k ∧ b ≤ h) ∨ + G ≤ + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * (A : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (B : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * + (Chi : ℝ)) : + PropositionTwoNumericalAlternatives A B p Chi G := by + intro h k hadmissible + rcases hauxiliary h k hadmissible with hdegree | hbound + · right + let n : ℕ := h * k + h + k + have hkPos : 0 < k := lt_of_lt_of_le ha hdegree.1 + have hhPos : 0 < h := lt_of_lt_of_le hb hdegree.2 + have hnSub : 2 * k ≤ n - 1 := by + obtain ⟨h', rfl⟩ := Nat.exists_eq_succ_of_ne_zero hhPos.ne' + simp only [n, Nat.succ_mul, Nat.succ_eq_add_one] + omega + have hnOne : 1 ≤ n := by dsimp only [n]; omega + have hnSubReal : (2 * k : ℝ) ≤ (n : ℝ) - 1 := by + have hnSubCast : ((2 * k : ℕ) : ℝ) ≤ ((n - 1 : ℕ) : ℝ) := by + exact_mod_cast hnSub + rw [Nat.cast_sub hnOne] at hnSubCast + norm_num at hnSubCast ⊢ + exact hnSubCast + have hkEulerHalf : (k : ℝ) ≤ ((n : ℝ) - 1) / 2 := by + linarith + have hEulerHalfNonneg : 0 ≤ ((n : ℝ) - 1) / 2 := + (Nat.cast_nonneg k).trans hkEulerHalf + have hdChiReal : (d : ℝ) ≤ (Chi : ℝ) := by exact_mod_cast hdChi + have hkEuler : (d : ℝ) * (k : ℝ) ≤ + (((n : ℝ) - 1) / 2) * (Chi : ℝ) := by + calc + (d : ℝ) * (k : ℝ) ≤ (Chi : ℝ) * (k : ℝ) := + mul_le_mul_of_nonneg_right hdChiReal (Nat.cast_nonneg _) + _ = (k : ℝ) * (Chi : ℝ) := by ring + _ ≤ (((n : ℝ) - 1) / 2) * (Chi : ℝ) := + mul_le_mul_of_nonneg_right hkEulerHalf (Nat.cast_nonneg _) + have hAk : A ≤ d * k := + hA.trans (Nat.mul_le_mul_left d hdegree.1) + have hGdk : G ≤ (d : ℝ) * (k : ℝ) := by + calc + G ≤ (A : ℝ) := hG + _ ≤ ((d * k : ℕ) : ℝ) := by exact_mod_cast hAk + _ = (d : ℝ) * (k : ℝ) := by norm_num + have hnPosReal : 0 < (n : ℝ) := by exact_mod_cast hadmissible.1 + have hfirstNonneg : + 0 ≤ (((h + 2 * k : ℕ) : ℝ) / (n : ℝ)) * (A : ℝ) := + mul_nonneg (div_nonneg (Nat.cast_nonneg _) hnPosReal.le) + (Nat.cast_nonneg _) + have hsecondNonneg : + 0 ≤ ((k : ℝ) / (n : ℝ)) * (B : ℝ) := + mul_nonneg (div_nonneg (Nat.cast_nonneg _) hnPosReal.le) + (Nat.cast_nonneg _) + calc + G ≤ (d : ℝ) * (k : ℝ) := hGdk + _ ≤ (((n : ℝ) - 1) / 2) * (Chi : ℝ) := hkEuler + _ ≤ + (((h + 2 * k : ℕ) : ℝ) / (n : ℝ)) * (A : ℝ) + + ((k : ℝ) / (n : ℝ)) * (B : ℝ) + + (((n : ℝ) - 1) / 2) * (Chi : ℝ) := by + linarith + _ = + (((h + 2 * k : ℕ) : ℝ) / + ((h * k + h + k : ℕ) : ℝ)) * (A : ℝ) + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * (B : ℝ) + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * + (Chi : ℝ) := by + rfl + · exact Or.inr hbound + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean new file mode 100644 index 0000000000..07c7f28f14 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +import Mathlib.RingTheory.UniqueFactorizationDomain.Finsupp + +/-! +# The exhaustive finite-place product formula for the rational function field + +This file packages the principal fractional ideal of a nonzero element of +`K(X)` as a `Finsupp` on the full `HeightOneSpectrum K[X]`. Each height-one +prime is identified with its canonical normalized prime-polynomial generator, +so the degree-weighted sum can be reindexed to normalized polynomial +factorization. The resulting exhaustive finite-place sum is `f.intDegree`; +after adding Mathlib's order at infinity, the total is zero. +-/ + +open scoped nonZeroDivisors +open IsDedekindDomain Polynomial UniqueFactorizationMonoid + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Normalized prime polynomials, i.e. the canonical polynomial representatives +of finite places of `K(X)`. -/ +abbrev NormalizedPrimePolynomial (K : Type*) [Field K] [DecidableEq K] := + {r : K[X] // Prime r ∧ normalize r = r} + +/-- The normalized prime polynomial generating a finite place of `K(X)`. -/ +def finitePlaceNormalizedPrime [DecidableEq K] + (v : HeightOneSpectrum K[X]) : NormalizedPrimePolynomial K := by + let g := Submodule.IsPrincipal.generator v.asIdeal + refine ⟨normalize g, ?_, normalize_idem g⟩ + exact (normalize_associated g).symm.prime + (Submodule.IsPrincipal.prime_generator_of_isPrime v.asIdeal v.ne_bot) + +/-- The finite place cut out by a normalized prime polynomial. -/ +def normalizedPrimeFinitePlace [DecidableEq K] (r : NormalizedPrimePolynomial K) : + HeightOneSpectrum K[X] := + polynomialFinitePlace r r.property.1 + +@[simp] +theorem normalizedPrimeFinitePlace_finitePlaceNormalizedPrime + [DecidableEq K] (v : HeightOneSpectrum K[X]) : + normalizedPrimeFinitePlace (K := K) (finitePlaceNormalizedPrime v) = v := by + apply HeightOneSpectrum.ext + change Ideal.span {normalize (Submodule.IsPrincipal.generator v.asIdeal)} = v.asIdeal + calc + Ideal.span {normalize (Submodule.IsPrincipal.generator v.asIdeal)} = + Ideal.span {Submodule.IsPrincipal.generator v.asIdeal} := + Ideal.span_singleton_eq_span_singleton.mpr (normalize_associated _) + _ = v.asIdeal := Ideal.span_singleton_generator v.asIdeal + +@[simp] +theorem finitePlaceNormalizedPrime_normalizedPrimeFinitePlace + [DecidableEq K] (r : NormalizedPrimePolynomial K) : + finitePlaceNormalizedPrime (normalizedPrimeFinitePlace (K := K) r) = r := by + apply Subtype.ext + change normalize (Submodule.IsPrincipal.generator (Ideal.span {(r : K[X])})) = r + calc + normalize (Submodule.IsPrincipal.generator (Ideal.span {(r : K[X])})) = + normalize (r : K[X]) := by + exact normalize_eq_normalize_iff_associated.mpr + (Submodule.IsPrincipal.associated_generator_span_self (r : K[X])) + _ = r := r.property.2 + +/-- Normalized prime polynomials are equivalent to all finite places of `K(X)`. -/ +def normalizedPrimePolynomialEquivFinitePlace [DecidableEq K] : + NormalizedPrimePolynomial K ≃ HeightOneSpectrum K[X] where + toFun := fun r => normalizedPrimeFinitePlace (K := K) r + invFun := fun v => finitePlaceNormalizedPrime (K := K) v + left_inv := finitePlaceNormalizedPrime_normalizedPrimeFinitePlace + right_inv := normalizedPrimeFinitePlace_finitePlaceNormalizedPrime + +/-- The finitely supported principal divisor at all finite places. -/ +def ratFuncFiniteDivisor (f : RatFunc K) : HeightOneSpectrum K[X] →₀ ℤ := + let h := FractionalIdeal.finite_factors + (FractionalIdeal.spanSingleton (K[X])⁰ f) + Finsupp.mk h.toFinset (fun v => ratFuncFiniteOrder v f) + (fun _ => h.mem_toFinset) + +@[simp] +theorem ratFuncFiniteDivisor_apply (f : RatFunc K) (v : HeightOneSpectrum K[X]) : + ratFuncFiniteDivisor f v = ratFuncFiniteOrder v f := rfl + +/-- Degree of a finite place, defined using its canonical normalized prime generator. -/ +def ratFuncFinitePlaceDegree [DecidableEq K] (v : HeightOneSpectrum K[X]) : ℕ := + (finitePlaceNormalizedPrime v : K[X]).natDegree + +@[simp] +theorem ratFuncFinitePlaceDegree_normalizedPrimeFinitePlace [DecidableEq K] + (r : NormalizedPrimePolynomial K) : + ratFuncFinitePlaceDegree (normalizedPrimeFinitePlace (K := K) r) = + (r : K[X]).natDegree := by + simp [ratFuncFinitePlaceDegree] + +/-- Factorization of a polynomial, restricted to normalized prime polynomials. -/ +def normalizedPrimeFactorization [DecidableEq K] (p : K[X]) : + NormalizedPrimePolynomial K →₀ ℕ := + Finsupp.comapDomain Subtype.val (factorization p) Subtype.val_injective.injOn + +@[simp] +theorem normalizedPrimeFactorization_apply [DecidableEq K] + (p : K[X]) (r : NormalizedPrimePolynomial K) : + normalizedPrimeFactorization p r = (normalizedFactors p).count (r : K[X]) := by + simp [normalizedPrimeFactorization, factorization_eq_count] + +/-- The coefficient of the finite principal divisor is the difference of the +normalized-prime multiplicities in numerator and denominator. -/ +theorem ratFuncFiniteOrder_eq_normalizedPrimeFactorization_sub + [DecidableEq K] (f : RatFunc K) (hf : f ≠ 0) + (v : HeightOneSpectrum K[X]) : + ratFuncFiniteOrder v f = + (normalizedPrimeFactorization f.num (finitePlaceNormalizedPrime v) : ℤ) - + normalizedPrimeFactorization f.denom (finitePlaceNormalizedPrime v) := by + let r := finitePlaceNormalizedPrime v + have h := ratFuncFiniteOrder_polynomialFinitePlace (K := K) f hf + (r : K[X]) r.property.1 r.property.2 + have hrplace : polynomialFinitePlace (r : K[X]) r.property.1 = v := by + change normalizedPrimeFinitePlace (K := K) r = v + exact normalizedPrimeFinitePlace_finitePlaceNormalizedPrime v + rw [hrplace] at h + simpa only [normalizedPrimeFactorization_apply] using h + +/-- The numerator-minus-denominator factorization on canonical normalized +prime polynomial representatives. -/ +def ratFuncNormalizedPrimeDivisor [DecidableEq K] (f : RatFunc K) : + NormalizedPrimePolynomial K →₀ ℤ := + Finsupp.mapRange (fun n : ℕ => (n : ℤ)) (Nat.cast_zero) + (normalizedPrimeFactorization f.num) - + Finsupp.mapRange (fun n : ℕ => (n : ℤ)) (Nat.cast_zero) + (normalizedPrimeFactorization f.denom) + +@[simp] +theorem ratFuncNormalizedPrimeDivisor_apply [DecidableEq K] + (f : RatFunc K) (r : NormalizedPrimePolynomial K) : + ratFuncNormalizedPrimeDivisor f r = + (normalizedPrimeFactorization f.num r : ℤ) - + normalizedPrimeFactorization f.denom r := by + simp [ratFuncNormalizedPrimeDivisor] + +/-- The count-defined finite principal divisor agrees with the transported +normalized polynomial factorization. -/ +theorem ratFuncFiniteDivisor_eq_equivMapDomain_normalizedPrimeDivisor + [DecidableEq K] (f : RatFunc K) (hf : f ≠ 0) : + ratFuncFiniteDivisor f = + Finsupp.equivMapDomain normalizedPrimePolynomialEquivFinitePlace + (ratFuncNormalizedPrimeDivisor f) := by + ext v + rw [ratFuncFiniteDivisor_apply, Finsupp.equivMapDomain_apply, + ratFuncNormalizedPrimeDivisor_apply] + exact ratFuncFiniteOrder_eq_normalizedPrimeFactorization_sub f hf v + +private theorem factorization_support_subset_normalizedPrimePolynomial_range + [DecidableEq K] (p : K[X]) : + ((factorization p).support : Set K[X]) ⊆ + Set.range (Subtype.val : NormalizedPrimePolynomial K → K[X]) := by + intro r hr + have hr' : r ∈ normalizedFactors p := by + simpa only [support_factorization, Finset.mem_coe, Multiset.mem_toFinset] using hr + exact ⟨⟨r, prime_of_normalized_factor r hr', normalize_normalized_factor r hr'⟩, rfl⟩ + +private theorem normalizedPrimePolynomial_bijOn_factorizationSupport + [DecidableEq K] (p : K[X]) : + Set.BijOn (Subtype.val : NormalizedPrimePolynomial K → K[X]) + ((Subtype.val : NormalizedPrimePolynomial K → K[X]) ⁻¹' + ((factorization p).support : Set K[X])) + ((factorization p).support : Set K[X]) := by + refine ⟨?_, Subtype.val_injective.injOn, ?_⟩ + · intro r hr + exact hr + · intro r hr + obtain ⟨r', hr'eq⟩ := + factorization_support_subset_normalizedPrimePolynomial_range p hr + refine ⟨r', ?_, hr'eq⟩ + simpa only [Set.mem_preimage, hr'eq] using hr + +/-- The degree-weighted factorization over canonical normalized prime +representatives has total weight equal to polynomial degree. -/ +theorem normalizedPrimeFactorization_degreeSum [DecidableEq K] + (p : K[X]) (hp : p ≠ 0) : + (normalizedPrimeFactorization p).sum + (fun r n => n * (r : K[X]).natDegree) = p.natDegree := by + calc + (normalizedPrimeFactorization p).sum + (fun r n => n * (r : K[X]).natDegree) = + (factorization p).sum (fun r n => n * r.natDegree) := by + change (Finsupp.comapDomain Subtype.val (factorization p) + Subtype.val_injective.injOn).sum + ((fun r : K[X] => fun n => n * r.natDegree) ∘ Subtype.val) = _ + exact Finsupp.sum_comapDomain + (Subtype.val : NormalizedPrimePolynomial K → K[X]) + (factorization p) (fun r n => n * r.natDegree) + (normalizedPrimePolynomial_bijOn_factorizationSupport p) + _ = ∑ r ∈ (normalizedFactors p).toFinset, + (normalizedFactors p).count r * r.natDegree := by + simp only [Finsupp.sum, support_factorization, factorization_eq_count] + _ = p.natDegree := sum_normalizedFactor_natDegree p hp + +private theorem normalizedPrimeFactorization_intDegreeSum [DecidableEq K] + (p : K[X]) (hp : p ≠ 0) : + (normalizedPrimeFactorization p).sum + (fun r n => (n : ℤ) * ((r : K[X]).natDegree : ℤ)) = + (p.natDegree : ℤ) := by + exact_mod_cast normalizedPrimeFactorization_degreeSum p hp + +private theorem castNormalizedPrimeFactorization_intDegreeSum [DecidableEq K] + (p : K[X]) (hp : p ≠ 0) : + (Finsupp.mapRange (fun n : ℕ => (n : ℤ)) Nat.cast_zero + (normalizedPrimeFactorization p)).sum + (fun r n => n * ((r : K[X]).natDegree : ℤ)) = + (p.natDegree : ℤ) := by + rw [Finsupp.sum_mapRange_index (fun _ => zero_mul _)] + exact normalizedPrimeFactorization_intDegreeSum p hp + +/-- The exhaustive degree-weighted sum over all height-one primes of `K[X]`. +Its finite support is the support of the principal fractional ideal of `f`. -/ +def ratFuncExhaustiveFinitePlaceDegreeSum [DecidableEq K] (f : RatFunc K) : ℤ := + (ratFuncFiniteDivisor f).sum + (fun v n => n * (ratFuncFinitePlaceDegree v : ℤ)) + +private theorem ratFuncNormalizedPrimeDivisor_degreeSum_eq_intDegree + [DecidableEq K] (f : RatFunc K) (hf : f ≠ 0) : + (ratFuncNormalizedPrimeDivisor f).sum + (fun r n => n * ((r : K[X]).natDegree : ℤ)) = f.intDegree := by + rw [ratFuncNormalizedPrimeDivisor, Finsupp.sum_sub_index] + · rw [castNormalizedPrimeFactorization_intDegreeSum f.num (RatFunc.num_ne_zero hf), + castNormalizedPrimeFactorization_intDegreeSum f.denom f.denom_ne_zero] + rfl + · intro r a b + ring + +/-- The actual exhaustive finite-place degree formula for `K(X)`: the +degree-weighted sum of the principal-divisor coefficients over every +`HeightOneSpectrum K[X]` equals the rational-function degree. -/ +theorem ratFuncExhaustiveFinitePlaceDegreeSum_eq_intDegree + [DecidableEq K] (f : RatFunc K) (hf : f ≠ 0) : + ratFuncExhaustiveFinitePlaceDegreeSum f = f.intDegree := by + rw [ratFuncExhaustiveFinitePlaceDegreeSum, + ratFuncFiniteDivisor_eq_equivMapDomain_normalizedPrimeDivisor f hf, + Finsupp.sum_equivMapDomain] + change (ratFuncNormalizedPrimeDivisor f).sum + (fun r n => n * (ratFuncFinitePlaceDegree + (normalizedPrimeFinitePlace (K := K) r) : ℤ)) = f.intDegree + simpa only [ratFuncFinitePlaceDegree_normalizedPrimeFinitePlace] using + ratFuncNormalizedPrimeDivisor_degreeSum_eq_intDegree f hf + +/-- The exhaustive finite-place sum plus the order at infinity is zero. -/ +theorem ratFunc_exhaustiveFinitePlace_plus_infinity_productFormula + [DecidableEq K] (f : RatFunc K) (hf : f ≠ 0) : + ratFuncExhaustiveFinitePlaceDegreeSum f + ratFuncInfinityOrder f = 0 := by + rw [ratFuncExhaustiveFinitePlaceDegreeSum_eq_intDegree f hf] + simp only [ratFuncInfinityOrder, add_neg_cancel] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean new file mode 100644 index 0000000000..5a7843b7a0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean @@ -0,0 +1,220 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import Mathlib.FieldTheory.PurelyInseparable.PerfectClosure + +/-! +# Separating coordinates are not Frobenius powers + +For an irreducible plane curve in characteristic `p`, a nonzero partial +derivative makes the function field separable over the field generated by the +opposite coordinate. This file uses that separability to prove that the +generating coordinate cannot be a `p`-th power in the curve function field. + +The last step is made explicit in the one-variable rational function field: +if `(a / b) ^ p = X`, then `a ^ p = X * b ^ p`, whose degrees would satisfy +`p * degree(a) = 1 + p * degree(b)`. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- A polynomial variable is not a nontrivial power in the fraction field of +a multivariate polynomial ring. -/ +theorem mvPolynomial_variable_not_pow_in_fractionRing + {K σ : Type*} [Field K] (i : σ) (p : ℕ) (hp : 1 < p) : + ¬ ∃ z : FractionRing (MvPolynomial σ K), + z ^ p = algebraMap (MvPolynomial σ K) + (FractionRing (MvPolynomial σ K)) (MvPolynomial.X i) := by + rintro ⟨z, hz⟩ + let R := MvPolynomial σ K + let F := FractionRing R + obtain ⟨a, b, hb, hab⟩ := IsFractionRing.div_surjective R z + have hb0 : b ≠ 0 := nonZeroDivisors.ne_zero hb + have hmapb0 : algebraMap R F b ≠ 0 := by + simpa using (IsFractionRing.injective R F).ne hb0 + have hfield : + algebraMap R F (a ^ p) = algebraMap R F (MvPolynomial.X i * b ^ p) := by + rw [map_mul, map_pow, map_pow, ← hz, ← hab, div_pow] + rw [div_mul_cancel₀ _ (pow_ne_zero p hmapb0)] + have hpoly : a ^ p = MvPolynomial.X i * b ^ p := + IsFractionRing.injective R F hfield + have ha0 : a ≠ 0 := by + intro ha + rw [ha, zero_pow (Nat.ne_zero_of_lt hp), zero_eq_mul] at hpoly + exact pow_ne_zero p hb0 (hpoly.resolve_left (MvPolynomial.X_ne_zero i)) + have hdegree := congrArg (MvPolynomial.degreeOf i) hpoly + rw [MvPolynomial.degreeOf_pow_eq i a p ha0, + MvPolynomial.degreeOf_mul_eq (MvPolynomial.X_ne_zero i) (pow_ne_zero p hb0), + MvPolynomial.degreeOf_X_self, + MvPolynomial.degreeOf_pow_eq i b p hb0] at hdegree + have hmod := congrArg (fun n : ℕ => n % p) hdegree + simp [Nat.add_mod, Nat.mod_eq_of_lt hp] at hmod + +/-- The first coordinate has no nontrivial power root in the field it +generates over the constant field. -/ +theorem firstCoordinateInSubfield_not_pow + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (p : ℕ) (hp : 1 < p) : + letI := planeCurveCoordinateRing_isDomain hf + ¬ ∃ z : FirstCoordinateSubfield f, + z ^ p = firstCoordinateInSubfield f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let remaining := {i : Fin 2 // i ≠ 1} + let i0 : remaining := ⟨0, by decide⟩ + have htrans : Transcendental K (planeCurveFunction f 0) := + firstCoordinate_transcendental hf hsecond + let e := firstCoordinateFractionEquiv f htrans + rintro ⟨z, hz⟩ + apply mvPolynomial_variable_not_pow_in_fractionRing + (K := K) (σ := remaining) i0 p hp + refine ⟨e.symm z, ?_⟩ + apply e.injective + rw [map_pow, e.apply_symm_apply, hz, + firstCoordinateFractionEquiv_algebraMap] + apply Subtype.ext + simp [firstCoordinateCoefficientEval, firstCoordinateInSubfield, i0] + +/-- The second coordinate has no nontrivial power root in the field it +generates over the constant field. -/ +theorem secondCoordinateInSubfield_not_pow + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hfirst : 0 < MvPolynomial.degreeOf 0 f) + (p : ℕ) (hp : 1 < p) : + letI := planeCurveCoordinateRing_isDomain hf + ¬ ∃ z : SecondCoordinateSubfield f, + z ^ p = secondCoordinateInSubfield f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let remaining := {i : Fin 2 // i ≠ 0} + let i1 : remaining := ⟨1, by decide⟩ + have htrans : Transcendental K (planeCurveFunction f 1) := + secondCoordinate_transcendental hf hfirst + let e := secondCoordinateFractionEquiv f htrans + rintro ⟨z, hz⟩ + apply mvPolynomial_variable_not_pow_in_fractionRing + (K := K) (σ := remaining) i1 p hp + refine ⟨e.symm z, ?_⟩ + apply e.injective + rw [map_pow, e.apply_symm_apply, hz, + secondCoordinateFractionEquiv_algebraMap] + apply Subtype.ext + simp [secondCoordinateCoefficientEval, secondCoordinateInSubfield, i1] + +/-- A first coordinate that is separating (equivalently here, the other +partial derivative is nonzero) is not a `p`-th power in the plane-curve +function field. -/ +theorem firstCoordinate_not_mem_frobeniusSubfield + {K : Type*} [Field K] {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + planeCurveFunction f 0 ∉ + frobeniusSubfield (PlaneCurveFunctionField f) p := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := FirstCoordinateSubfield f + have hseparable := + (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 + letI : Algebra.IsSeparable F L := hseparable + intro hx + rcases hx with ⟨y, hy⟩ + have hypow : y ^ p = planeCurveFunction f 0 := by + simpa [frobenius_def] using hy + let E : IntermediateField F L := IntermediateField.adjoin F {y} + letI : IsPurelyInseparable F E := + (IntermediateField.isPurelyInseparable_adjoin_simple_iff_pow_mem F L p).2 (by + refine ⟨1, ?_⟩ + rw [pow_one] + refine ⟨firstCoordinateInSubfield f, ?_⟩ + change planeCurveFunction f 0 = y ^ p + exact hypow.symm) + letI : Algebra.IsSeparable F E := + (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable F L).2 + (Algebra.IsSeparable.isSeparable F y) + have hE : E = ⊥ := + IntermediateField.eq_bot_of_isPurelyInseparable_of_isSeparable E + have hyE : y ∈ E := IntermediateField.mem_adjoin_simple_self F y + rw [hE] at hyE + rw [IntermediateField.mem_bot] at hyE + rcases hyE with ⟨z, hz⟩ + apply firstCoordinateInSubfield_not_pow hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) p + (Fact.out : p.Prime).one_lt + refine ⟨z, ?_⟩ + apply Subtype.ext + change (z : L) ^ p = planeCurveFunction f 0 + have hz' : (z : L) = y := by simpa [L] using hz + rw [hz'] + exact hypow + +/-- A second coordinate that is separating (equivalently here, the other +partial derivative is nonzero) is not a `p`-th power in the plane-curve +function field. -/ +theorem secondCoordinate_not_mem_frobeniusSubfield + {K : Type*} [Field K] {p : ℕ} [Fact p.Prime] [CharP K p] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + letI : CharP (PlaneCurveFunctionField f) p := + charP_of_injective_algebraMap + (algebraMap K (PlaneCurveFunctionField f)).injective p + planeCurveFunction f 1 ∉ + frobeniusSubfield (PlaneCurveFunctionField f) p := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := SecondCoordinateSubfield f + have hseparable := + (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).2 + letI : Algebra.IsSeparable F L := hseparable + intro hx + rcases hx with ⟨y, hy⟩ + have hypow : y ^ p = planeCurveFunction f 1 := by + simpa [frobenius_def] using hy + let E : IntermediateField F L := IntermediateField.adjoin F {y} + letI : IsPurelyInseparable F E := + (IntermediateField.isPurelyInseparable_adjoin_simple_iff_pow_mem F L p).2 (by + refine ⟨1, ?_⟩ + rw [pow_one] + refine ⟨secondCoordinateInSubfield f, ?_⟩ + change planeCurveFunction f 1 = y ^ p + exact hypow.symm) + letI : Algebra.IsSeparable F E := + (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable F L).2 + (Algebra.IsSeparable.isSeparable F y) + have hE : E = ⊥ := + IntermediateField.eq_bot_of_isPurelyInseparable_of_isSeparable E + have hyE : y ∈ E := IntermediateField.mem_adjoin_simple_self F y + rw [hE] at hyE + rw [IntermediateField.mem_bot] at hyE + rcases hyE with ⟨z, hz⟩ + apply secondCoordinateInSubfield_not_pow hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) p + (Fact.out : p.Prime).one_lt + refine ⟨z, ?_⟩ + apply Subtype.ext + change (z : L) ^ p = planeCurveFunction f 1 + have hz' : (z : L) = y := by simpa [L] using hz + rw [hz'] + exact hypow + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean new file mode 100644 index 0000000000..cbc33f1614 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +import Mathlib.RingTheory.RootsOfUnity.Basic +import Mathlib.Tactic + +/-! +# Bidegree bounds for finite torus-curve intersections + +For an irreducible bivariate curve with positive degree in both coordinates, +every coordinate fiber is cut out by a nonzero univariate polynomial. Counting +roots in each fiber gives the sharp elementary estimates +`firstOrder * secondDegree` and `secondOrder * firstDegree`; their minimum is +the elementary divisor bound used at the Corvaja--Zannier endpoint. + +The irreducibility and positive-coordinate-degree hypotheses are essential: +a polynomial with a vertical or horizontal component can contain an entire row +or column of the torsion grid. +-/ + +open Polynomial + +namespace BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Specialize the first coordinate of a bivariate polynomial, leaving a +univariate polynomial in the second coordinate. -/ +def secondCoordinateSpecialization + (f : MvPolynomial (Fin 2) K) (x : K) : Polynomial K := + (planeCurvePolynomialInSecondCoordinate f).map (Polynomial.evalRingHom x) + +@[simp] +theorem secondCoordinateSpecialization_eval + (f : MvPolynomial (Fin 2) K) (x y : K) : + (secondCoordinateSpecialization f x).eval y = + MvPolynomial.eval ![x, y] f := by + let g := MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f + let Q := MvPolynomial.finSuccEquiv K 1 g + let e := MvPolynomial.uniqueAlgEquiv K (Fin 1) + have hevalHom : + (Polynomial.evalRingHom x).comp e.toRingEquiv.toRingHom = + MvPolynomial.eval ![x] := by + apply MvPolynomial.ringHom_ext + · intro c + simp [e] + · intro i + fin_cases i + simp [e, MvPolynomial.uniqueAlgEquiv_apply] + have hiterated := MvPolynomial.eval_eq_eval_mv_eval' ![x] y g + change Polynomial.eval y + (Polynomial.map (Polynomial.evalRingHom x) + (Polynomial.map e.toRingEquiv.toRingHom Q)) = _ + rw [Polynomial.map_map, hevalHom] + rw [← hiterated] + simp [g, MvPolynomial.eval_rename] + +/-- An irreducible curve of positive second-coordinate degree has no +identically zero fiber over a fixed first coordinate. -/ +theorem secondCoordinateSpecialization_ne_zero_of_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) (x : K) : + secondCoordinateSpecialization f x ≠ 0 := by + let F : Polynomial (Polynomial K) := planeCurvePolynomialInSecondCoordinate f + have hF : Irreducible F := + hf.map planeCurvePolynomialInSecondCoordinate + have hFdegree : 0 < F.natDegree := by + simpa [F] using hsecond + intro hspecialization + have hcoeffEval : ∀ i, (F.coeff i).eval x = 0 := by + intro i + have hi := congrArg (fun P : Polynomial K => P.coeff i) hspecialization + simpa [secondCoordinateSpecialization, F] using hi + have hcoeffDvd : ∀ i, Polynomial.X - Polynomial.C x ∣ F.coeff i := by + intro i + exact Polynomial.dvd_iff_isRoot.mpr (hcoeffEval i) + have hdvd : Polynomial.C (Polynomial.X - Polynomial.C x) ∣ F := + Polynomial.C_dvd_iff_dvd_coeff _ _ |>.mpr hcoeffDvd + obtain ⟨q, hfactor⟩ := hdvd + have hfactor' : F = Polynomial.C (Polynomial.X - Polynomial.C x) * q := + hfactor + rcases hF.isUnit_or_isUnit hfactor' with hunit | hqunit + · exact (Polynomial.not_isUnit_X_sub_C x) + (Polynomial.isUnit_C.mp hunit) + · have hdegreeZero : F.natDegree = 0 := by + rw [hfactor'] + apply Nat.eq_zero_of_le_zero + calc + (Polynomial.C (Polynomial.X - Polynomial.C x) * q).natDegree + ≤ (Polynomial.C (Polynomial.X - Polynomial.C x)).natDegree + + q.natDegree := Polynomial.natDegree_mul_le + _ = 0 := by rw [Polynomial.natDegree_C, + Polynomial.natDegree_eq_zero_of_isUnit hqunit] + exact (Nat.ne_of_gt hFdegree) hdegreeZero + +/-- A support-wise bidegree bound controls every specialized fiber degree. -/ +theorem secondCoordinateSpecialization_natDegree_le + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (x : K) : + (secondCoordinateSpecialization f x).natDegree ≤ secondDegree := by + calc + (secondCoordinateSpecialization f x).natDegree ≤ + (planeCurvePolynomialInSecondCoordinate f).natDegree := + Polynomial.natDegree_map_le + _ = MvPolynomial.degreeOf 1 f := + planeCurvePolynomialInSecondCoordinate_natDegree f + _ ≤ secondDegree := + degreeOf_second_le_of_hasBidegreeAtMost hdegree + +/-- Specialization cannot increase the second-coordinate degree. -/ +theorem secondCoordinateSpecialization_natDegree_le_degreeOf_second + (f : MvPolynomial (Fin 2) K) (x : K) : + (secondCoordinateSpecialization f x).natDegree ≤ + MvPolynomial.degreeOf 1 f := by + calc + (secondCoordinateSpecialization f x).natDegree ≤ + (planeCurvePolynomialInSecondCoordinate f).natDegree := + Polynomial.natDegree_map_le + _ = MvPolynomial.degreeOf 1 f := + planeCurvePolynomialInSecondCoordinate_natDegree f + +private theorem evalZeroSubtype_card_le_natDegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (P : Polynomial K) (hP : P ≠ 0) : + Fintype.card {x : K // P.eval x = 0} ≤ P.natDegree := by + classical + let rootEmbedding : {x : K // P.eval x = 0} ↪ P.roots.toFinset := + { toFun := fun x => ⟨x, by + rw [Multiset.mem_toFinset, Polynomial.mem_roots hP] + exact x.2⟩ + inj' := by + intro x y h + apply Subtype.ext + exact congrArg (fun z : P.roots.toFinset => (z : K)) h } + calc + Fintype.card {x : K // P.eval x = 0} ≤ P.roots.toFinset.card := + by + simpa only [Fintype.card_coe] using + Fintype.card_le_of_injective rootEmbedding rootEmbedding.injective + _ ≤ P.roots.card := Multiset.toFinset_card_le _ + _ ≤ P.natDegree := Polynomial.card_roots' P + +/-- Fiber counting over first-coordinate roots of unity, stated using an +explicit second-coordinate degree bound. -/ +theorem torusCurveTorsionIntersection_card_le_firstOrder_mul_of_degreeOf_second_le + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (secondDegree firstOrder secondOrder : ℕ) + (hdegreeSecond : MvPolynomial.degreeOf 1 f ≤ secondDegree) + (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (hfirstOrder : 0 < firstOrder) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card ≤ firstOrder * secondDegree := by + classical + let S := BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder + letI : NeZero firstOrder := ⟨hfirstOrder.ne'⟩ + letI : Fintype (rootsOfUnity firstOrder K) := Fintype.ofFinite _ + let T := fun x : rootsOfUnity firstOrder K => + {y : K // (secondCoordinateSpecialization f (x.1 : K)).eval y = 0} + let embedding : {z // z ∈ S} ↪ Sigma T := + { toFun := fun z => + ⟨⟨z.1.1, (mem_rootsOfUnity firstOrder z.1.1).2 + (BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2).2.1⟩, + ⟨(z.1.2 : K), by + rw [secondCoordinateSpecialization_eval] + exact (BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2).1⟩⟩ + inj' := by + intro z w hzw + apply Subtype.ext + apply Prod.ext + · exact congrArg (fun q : Sigma T => (q.1 : Kˣ)) hzw + · apply Units.ext + exact congrArg (fun q : Sigma T => (q.2.1 : K)) hzw } + have hFiber (x : rootsOfUnity firstOrder K) : + Fintype.card (T x) ≤ secondDegree := by + exact (evalZeroSubtype_card_le_natDegree + (secondCoordinateSpecialization f (x.1 : K)) + (secondCoordinateSpecialization_ne_zero_of_irreducible + hf hsecond (x.1 : K))).trans + ((secondCoordinateSpecialization_natDegree_le_degreeOf_second + f (x.1 : K)).trans hdegreeSecond) + calc + S.card = Fintype.card {z // z ∈ S} := by simp + _ ≤ Fintype.card (Sigma T) := + Fintype.card_le_of_injective embedding embedding.injective + _ = ∑ x, Fintype.card (T x) := Fintype.card_sigma + _ ≤ ∑ _x : rootsOfUnity firstOrder K, secondDegree := by + exact Finset.sum_le_sum fun x _ => hFiber x + _ = Fintype.card (rootsOfUnity firstOrder K) * secondDegree := by + simp + _ ≤ firstOrder * secondDegree := + Nat.mul_le_mul_right secondDegree (by + simpa only [Nat.card_eq_fintype_card] using + card_rootsOfUnity K firstOrder) + +/-- The torsion intersection has at most `firstOrder * secondDegree` points. -/ +theorem torusCurveTorsionIntersection_card_le_firstOrder_mul_secondDegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (hfirstOrder : 0 < firstOrder) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card ≤ firstOrder * secondDegree := + torusCurveTorsionIntersection_card_le_firstOrder_mul_of_degreeOf_second_le + f secondDegree firstOrder secondOrder + (degreeOf_second_le_of_hasBidegreeAtMost hdegree) + hf hsecond hfirstOrder + +/-- Swap the two coordinates of a bivariate polynomial. -/ +def swapPlaneCurveCoordinates (f : MvPolynomial (Fin 2) K) : + MvPolynomial (Fin 2) K := + MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f + +@[simp] +theorem eval_swapPlaneCurveCoordinates (f : MvPolynomial (Fin 2) K) + (x y : K) : + MvPolynomial.eval ![y, x] (swapPlaneCurveCoordinates f) = + MvPolynomial.eval ![x, y] f := by + simp [swapPlaneCurveCoordinates, MvPolynomial.eval_rename] + +/-- Swapping both curve coordinates and torsion orders preserves the torsion +intersection. -/ +def torusCurveTorsionIntersectionSwapEquiv + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) : + {z // z ∈ BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder} ≃ + {z // z ∈ BGS.External.torusCurveTorsionIntersection + K (swapPlaneCurveCoordinates f) secondOrder firstOrder} := by + classical + let swapPoint : Kˣ × Kˣ → Kˣ × Kˣ := fun z => (z.2, z.1) + refine + { toFun := fun z => ⟨swapPoint z.1, ?_⟩ + invFun := fun z => ⟨swapPoint z.1, ?_⟩ + left_inv := ?_ + right_inv := ?_ } + · rw [BGS.External.mem_torusCurveTorsionIntersection_iff] + have hz := BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2 + exact ⟨by + simpa [swapPoint] using hz.1, + hz.2.2, hz.2.1⟩ + · rw [BGS.External.mem_torusCurveTorsionIntersection_iff] + have hz := BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2 + exact ⟨by + simpa [swapPoint] using hz.1, + hz.2.2, hz.2.1⟩ + · intro z + apply Subtype.ext + rfl + · intro z + apply Subtype.ext + rfl + +/-- Coordinate swapping preserves the torsion-intersection cardinality. -/ +theorem torusCurveTorsionIntersection_card_swap + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card = + (BGS.External.torusCurveTorsionIntersection K + (swapPlaneCurveCoordinates f) secondOrder firstOrder).card := by + classical + calc + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card = + Fintype.card {z // z ∈ BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder} := + (Fintype.card_coe + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder)).symm + _ = Fintype.card {z // z ∈ BGS.External.torusCurveTorsionIntersection K + (swapPlaneCurveCoordinates f) secondOrder firstOrder} := + Fintype.card_congr + (torusCurveTorsionIntersectionSwapEquiv f firstOrder secondOrder) + _ = (BGS.External.torusCurveTorsionIntersection K + (swapPlaneCurveCoordinates f) secondOrder firstOrder).card := + Fintype.card_coe + (BGS.External.torusCurveTorsionIntersection K + (swapPlaneCurveCoordinates f) secondOrder firstOrder) + +/-- The torsion intersection has at most `secondOrder * firstDegree` points. -/ +theorem torusCurveTorsionIntersection_card_le_secondOrder_mul_firstDegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hfirst : 0 < MvPolynomial.degreeOf 0 f) + (hsecondOrder : 0 < secondOrder) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card ≤ secondOrder * firstDegree := by + let fSwap := swapPlaneCurveCoordinates f + have hfSwap : Irreducible fSwap := by + exact hf.map (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1)) + have hdegreeSwap : MvPolynomial.degreeOf 1 fSwap ≤ firstDegree := by + have hdegreeEq := MvPolynomial.degreeOf_rename_of_injective + (Equiv.swap (0 : Fin 2) 1).injective (0 : Fin 2) (p := f) + rw [show (Equiv.swap (0 : Fin 2) 1) 0 = 1 by decide] at hdegreeEq + exact hdegreeEq.le.trans + (degreeOf_first_le_of_hasBidegreeAtMost hdegree) + have hpositiveSwap : 0 < MvPolynomial.degreeOf 1 fSwap := by + have hdegreeEq := MvPolynomial.degreeOf_rename_of_injective + (Equiv.swap (0 : Fin 2) 1).injective (0 : Fin 2) (p := f) + rw [show (Equiv.swap (0 : Fin 2) 1) 0 = 1 by decide] at hdegreeEq + exact hdegreeEq.symm ▸ hfirst + rw [torusCurveTorsionIntersection_card_swap] + exact torusCurveTorsionIntersection_card_le_firstOrder_mul_of_degreeOf_second_le + fSwap firstDegree secondOrder firstOrder hdegreeSwap hfSwap + hpositiveSwap hsecondOrder + +/-- The sharp elementary bidegree/order bound under the precise algebraic +hypotheses needed for fiber counting. -/ +theorem torusCurveTorsionIntersection_card_le_min_bidegree_order_of_irreducible + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hfirst : 0 < MvPolynomial.degreeOf 0 f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card ≤ + min (firstOrder * secondDegree) (secondOrder * firstDegree) := by + apply le_min + · exact torusCurveTorsionIntersection_card_le_firstOrder_mul_secondDegree + f firstDegree secondDegree firstOrder secondOrder hdegree hf + hsecond hfirstOrder + · exact torusCurveTorsionIntersection_card_le_secondOrder_mul_firstDegree + f firstDegree secondDegree firstOrder secondOrder hdegree hf + hfirst hsecondOrder + +/-- The sharp elementary bidegree/order bound for an admissible torus curve. -/ +theorem torusCurveTorsionIntersection_card_le_min_bidegree_order + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hcurve : BGS.External.IsCorvajaZannierPlaneCurve f) + (hfirstOrder : 0 < firstOrder) (hsecondOrder : 0 < secondOrder) : + (BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder).card ≤ + min (firstOrder * secondDegree) (secondOrder * firstDegree) := by + have hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure hcurve.1 + exact torusCurveTorsionIntersection_card_le_min_bidegree_order_of_irreducible + f firstDegree secondDegree firstOrder secondOrder hdegree hf + (degreeOf_first_pos_of_pderiv_ne_zero hcurve.2.2.1) + (degreeOf_second_pos_of_pderiv_ne_zero hcurve.2.2.2) + hfirstOrder hsecondOrder + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean new file mode 100644 index 0000000000..c3c8896c92 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -0,0 +1,872 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +import Mathlib.RingTheory.Valuation.LocalSubring + +/-! +# Torsion points and the exhaustive gcd divisor + +The affine normalization used in `TorsionGcdDivisorBound` need not be finite +over the polynomial ring defining the selected `K(X)`-model. This file +bridges that mismatch without assuming an algebra map between the two +normalizations. A valuation subring dominating the affine local ring of a +torsion point determines a height-one prime in the finite integral closure of +`K[X]`. Distinct affine points determine distinct valuation subrings, hence +distinct finite places. Both powered coordinate functions have positive +order there. + +Consequently rational torsion points inject into the finite part of the +exhaustive place type. Each selected place contributes at least one to the +degree-weighted positive gcd divisor used by the global Wronskian argument. +-/ + +open IsDedekindDomain +open Multiplicative WithZero + +namespace BGS.CorvajaZannier + +noncomputable section + +section DominatingValuationSubring + +variable {A L : Type*} [CommRing A] [IsDomain A] [Field L] + [Algebra A L] [IsFractionRing A L] + +/-- The fraction-field embedding, with codomain restricted to its range. -/ +private noncomputable def fractionEmbeddingRangeEquiv : + A ≃+* (algebraMap A L).range := + RingEquiv.ofBijective (algebraMap A L).rangeRestrict + ⟨fun x y hxy => IsFractionRing.injective A L (congrArg Subtype.val hxy), + fun y => by + obtain ⟨x, hx⟩ := y.2 + exact ⟨x, Subtype.ext hx⟩⟩ + +/-- The image of a maximal ideal inside the embedded copy of `A` in `L`. -/ +private noncomputable def maximalIdealInFractionEmbeddingRange + (m : MaximalSpectrum A) : Ideal (algebraMap A L).range := + m.asIdeal.map (fractionEmbeddingRangeEquiv (A := A) (L := L)).toRingHom + +private theorem maximalIdealInFractionEmbeddingRange_ne_top + (m : MaximalSpectrum A) : + maximalIdealInFractionEmbeddingRange (A := A) (L := L) m ≠ ⊤ := by + rw [maximalIdealInFractionEmbeddingRange] + intro htop + apply m.isMaximal.ne_top + let e := fractionEmbeddingRangeEquiv (A := A) (L := L) + calc + m.asIdeal = Ideal.comap e.toRingHom + (Ideal.map e.toRingHom m.asIdeal) := by + symm + calc + Ideal.comap e.toRingHom (Ideal.map e.toRingHom m.asIdeal) = + m.asIdeal ⊔ Ideal.comap e.toRingHom ⊥ := + Ideal.comap_map_of_surjective e.toRingHom e.surjective m.asIdeal + _ = m.asIdeal := by + have hker : Ideal.comap e.toRingHom ⊥ = ⊥ := + (RingHom.injective_iff_ker_eq_bot e.toRingHom).mp e.injective + rw [hker, sup_eq_left] + exact bot_le + _ = Ideal.comap e.toRingHom ⊤ := by rw [htop] + _ = ⊤ := Ideal.comap_top + +/-- A valuation subring of the fraction field dominating the affine local +ring at `m`. -/ +noncomputable def dominatingValuationSubring (m : MaximalSpectrum A) : + ValuationSubring L := + Classical.choose (Ideal.image_subset_nonunits_valuationSubring + (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) + (maximalIdealInFractionEmbeddingRange_ne_top m)) + +theorem range_le_dominatingValuationSubring (m : MaximalSpectrum A) : + (algebraMap A L).range ≤ + (dominatingValuationSubring (A := A) (L := L) m).toSubring := + (Classical.choose_spec (Ideal.image_subset_nonunits_valuationSubring + (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) + (maximalIdealInFractionEmbeddingRange_ne_top m))).1 + +theorem algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (m : MaximalSpectrum A) (r : A) (hr : r ∈ m.asIdeal) : + algebraMap A L r ∈ + (dominatingValuationSubring (A := A) (L := L) m).nonunits := by + let e := fractionEmbeddingRangeEquiv (A := A) (L := L) + have himage : e r ∈ + maximalIdealInFractionEmbeddingRange (A := A) (L := L) m := by + exact Ideal.mem_map_of_mem e.toRingHom hr + have hnonunits := + (Classical.choose_spec (Ideal.image_subset_nonunits_valuationSubring + (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) + (maximalIdealInFractionEmbeddingRange_ne_top m))).2 + apply hnonunits + refine ⟨e r, himage, ?_⟩ + rfl + +/-- The affine ring map into its dominating valuation subring. -/ +noncomputable def coordinateRingToDominatingValuationSubring + (m : MaximalSpectrum A) : + A →+* dominatingValuationSubring (A := A) (L := L) m := + (Subring.inclusion (range_le_dominatingValuationSubring m)).comp + (algebraMap A L).rangeRestrict + +theorem pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (m : MaximalSpectrum A) : + m.asIdeal = Ideal.comap (coordinateRingToDominatingValuationSubring m) + (IsLocalRing.maximalIdeal + (dominatingValuationSubring (A := A) (L := L) m)) := by + apply m.isMaximal.eq_of_le + · intro htop + have hmaxTop : IsLocalRing.maximalIdeal + (dominatingValuationSubring (A := A) (L := L) m) = ⊤ := + Ideal.comap_eq_top_iff.mp htop + exact (IsLocalRing.maximalIdeal.isMaximal + (dominatingValuationSubring (A := A) (L := L) m)).ne_top hmaxTop + · intro r hr + have hnonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := L) m r hr + exact ValuationSubring.coe_mem_nonunits_iff.mp hnonunits + +/-- Equality of the chosen dominating valuation subrings forces equality of +the affine centers. -/ +theorem pointIdeal_eq_of_dominatingValuationSubring_eq + {m n : MaximalSpectrum A} + (h : dominatingValuationSubring (A := A) (L := L) m = + dominatingValuationSubring (A := A) (L := L) n) : + m.asIdeal = n.asIdeal := by + apply le_antisymm + · intro r hr + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := L) n] + have hnonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := L) m r hr + rw [h] at hnonunits + exact ValuationSubring.coe_mem_nonunits_iff.mp hnonunits + · intro r hr + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := L) m] + have hnonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := L) n r hr + rw [← h] at hnonunits + exact ValuationSubring.coe_mem_nonunits_iff.mp hnonunits + +section IntegralClosure + +variable {P : Type*} [CommRing P] [Algebra P L] + +theorem integralClosure_le_dominatingValuationSubring + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) : + (integralClosure P L).toSubring ≤ + (dominatingValuationSubring (A := A) (L := L) m).toSubring := by + let V := dominatingValuationSubring (A := A) (L := L) m + letI : IsIntegrallyClosedIn V.toSubring L := + inferInstanceAs (IsIntegrallyClosedIn V L) + rw [Subring.integralClosure_le_iff] + intro p + exact range_le_dominatingValuationSubring m (hbase p) + +/-- The finite integral closure maps into the valuation subring because the +selected polynomial base is already contained in the affine ring. -/ +noncomputable def integralClosureToDominatingValuationSubring + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) : + integralClosure P L →+* + dominatingValuationSubring (A := A) (L := L) m := + Subring.inclusion (integralClosure_le_dominatingValuationSubring m hbase) + +/-- The center of the dominating valuation on the finite integral closure. -/ +noncomputable def dominatingIntegralClosurePrime + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) : + Ideal (integralClosure P L) := + Ideal.comap (integralClosureToDominatingValuationSubring m hbase) + (IsLocalRing.maximalIdeal + (dominatingValuationSubring (A := A) (L := L) m)) + +theorem dominatingIntegralClosurePrime_isPrime + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) : + (dominatingIntegralClosurePrime m hbase).IsPrime := by + exact Ideal.comap_isPrime _ _ + +variable [IsDedekindDomain (integralClosure P L)] + [IsFractionRing (integralClosure P L) L] + +/-- A nonzero center in the finite integral closure, regarded as a finite +place. -/ +noncomputable def dominatingIntegralClosurePlace + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) + (hne : dominatingIntegralClosurePrime m hbase ≠ ⊥) : + HeightOneSpectrum (integralClosure P L) := + ⟨dominatingIntegralClosurePrime m hbase, + dominatingIntegralClosurePrime_isPrime m hbase, hne⟩ + +theorem valuationSubringAt_dominatingIntegralClosurePlace_le + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) + (hne : dominatingIntegralClosurePrime m hbase ≠ ⊥) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L + (dominatingIntegralClosurePlace m hbase hne) ≤ + dominatingValuationSubring (A := A) (L := L) m := by + let V := dominatingValuationSubring (A := A) (L := L) m + let q := dominatingIntegralClosurePlace m hbase hne + let φ : integralClosure P L →+* V := + integralClosureToDominatingValuationSubring m hbase + rintro x ⟨a, s, hs, rfl⟩ + have hsNotMem : s ∉ q.asIdeal := hs + have hsUnit : IsUnit (φ s) := by + rw [← IsLocalRing.notMem_maximalIdeal] + exact hsNotMem + obtain ⟨u, hu⟩ := hsUnit + let t : V := φ a * ↑(u⁻¹) + have ht : algebraMap (integralClosure P L) L a * + (algebraMap (integralClosure P L) L s)⁻¹ = (t : L) := by + dsimp only [t] + have hφa : ((φ a : V) : L) = + algebraMap (integralClosure P L) L a := rfl + have hφs : ((φ s : V) : L) = + algebraMap (integralClosure P L) L s := rfl + rw [← hφa, ← hφs, ← hu] + change ((φ a : V) : L) * ((((u : V) : L))⁻¹) = + ((φ a : V) : L) * (((↑(u⁻¹) : V) : L)) + congr 1 + exact (map_units_inv V.toSubring.subtype u).symm + rw [ht] + exact t.property + +theorem valuationSubringAt_dominatingIntegralClosurePlace_eq + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) + (hne : dominatingIntegralClosurePrime m hbase ≠ ⊥) + (hV : dominatingValuationSubring (A := A) (L := L) m ≠ ⊤) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L + (dominatingIntegralClosurePlace m hbase hne) = + dominatingValuationSubring (A := A) (L := L) m := by + exact ValuationSubring.eq_of_le_of_ne_top _ + (valuationSubringAt_dominatingIntegralClosurePlace_le m hbase hne) hV + +theorem dominatingIntegralClosurePlace_valuation_isEquiv + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) + (hne : dominatingIntegralClosurePrime m hbase ≠ ⊥) + (hV : dominatingValuationSubring (A := A) (L := L) m ≠ ⊤) : + ((dominatingIntegralClosurePlace m hbase hne).valuation L).IsEquiv + (dominatingValuationSubring (A := A) (L := L) m).valuation := by + rw [Valuation.isEquiv_iff_valuationSubring, + ← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + ValuationSubring.valuationSubring_valuation] + exact valuationSubringAt_dominatingIntegralClosurePlace_eq m hbase hne hV + +theorem finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) + (hne : dominatingIntegralClosurePrime m hbase ≠ ⊥) + (hV : dominatingValuationSubring (A := A) (L := L) m ≠ ⊤) + (r : A) (hr : r ∈ m.asIdeal) (hr0 : algebraMap A L r ≠ 0) : + 0 < finitePlaceOrder (dominatingIntegralClosurePlace m hbase hne) + (algebraMap A L r) := by + have hnonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := L) m r hr + have hVlt : + (dominatingValuationSubring (A := A) (L := L) m).valuation + (algebraMap A L r) < 1 := hnonunits + have hequiv := dominatingIntegralClosurePlace_valuation_isEquiv + m hbase hne hV + have hqlt : + (dominatingIntegralClosurePlace m hbase hne).valuation L + (algebraMap A L r) < 1 := hequiv.lt_one_iff_lt_one.mpr hVlt + have horder := valuation_eq_exp_neg_finitePlaceOrder + (dominatingIntegralClosurePlace m hbase hne) (algebraMap A L r) hr0 + rw [horder, ← exp_zero, exp_lt_exp] at hqlt + omega + +end IntegralClosure + +end DominatingValuationSubring + +section FiniteExtensionGcdDivisor + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) exhaustiveGcdPolynomialAlgebra : + Algebra (Polynomial K) L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap (Polynomial K) (RatFunc K))) + +local instance exhaustiveGcdPolynomialScalarTower : + IsScalarTower (Polynomial K) (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance exhaustiveGcdFiniteIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) L + +local instance exhaustiveGcdFiniteIntegralClosureIsFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) L + +local instance exhaustiveGcdFiniteIntegralClosureModuleFinite : + Module.Finite (Polynomial K) (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite (Polynomial K) + (RatFuncFiniteIntegralClosure K L) + +/-- Common finite support of the two principal divisors on the exhaustive +place type. -/ +noncomputable def finiteExtensionGcdSupport (x y : L) : + Finset (FiniteExtensionPlace K L) := by + classical + exact (finiteExtensionPrincipalDivisor K L x).support ∪ + (finiteExtensionPrincipalDivisor K L y).support + +/-- Positive local gcd multiplicity of two nonzero rational functions. -/ +def finiteExtensionGcdMultiplicity (x y : L) + (v : FiniteExtensionPlace K L) : ℕ := + Int.toNat (min + (finiteExtensionPrincipalDivisor K L x v) + (finiteExtensionPrincipalDivisor K L y v)) + +/-- Degree of the positive gcd divisor on the exhaustive place type. -/ +def finiteExtensionGcdWeightedDegree (x y : L) : ℕ := + ∑ v ∈ finiteExtensionGcdSupport K L x y, + finiteExtensionGcdMultiplicity K L x y v * + finiteExtensionPlaceDegree K L v + +/-- On a finite place, the exhaustive principal-divisor coefficient is the +normalized order computed directly in `L`. -/ +theorem finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder + (x : L) (q : FiniteExtensionFinitePlace K L) : + finiteExtensionPrincipalDivisor K L x (.inl q) = + finitePlaceOrder q x := by + rw [finiteExtensionPrincipalDivisor_inl] + have h := fractionRingAlgEquiv_finitePlaceOrder_eq + (L := L) q ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) + simpa [ratFuncFiniteIntegralClosureFractionRingEquiv] using h.symm + +theorem finiteExtensionPlaceDegree_inl_pos + (q : FiniteExtensionFinitePlace K L) : + 0 < finiteExtensionPlaceDegree K L (.inl q) := by + rw [finiteExtensionPlaceDegree] + apply Nat.mul_pos + · exact Ideal.inertiaDeg_pos q.asIdeal (Polynomial K) + · exact (finitePlaceNormalizedPrime + (HeightOneSpectrum.under (Polynomial K) q)).property.1.irreducible.natDegree_pos + +theorem inl_mem_finiteExtensionGcdSupport_of_orders_positive + (x y : L) (q : FiniteExtensionFinitePlace K L) + (hxpos : 0 < finitePlaceOrder q x) : + (.inl q : FiniteExtensionPlace K L) ∈ + finiteExtensionGcdSupport K L x y := by + classical + rw [finiteExtensionGcdSupport] + apply Finset.mem_union_left + rw [Finsupp.mem_support_iff, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder K L x q] + omega + +theorem one_le_finiteExtensionGcdMultiplicity_mul_degree_inl_of_orders_positive + (x y : L) (q : FiniteExtensionFinitePlace K L) + (hxpos : 0 < finitePlaceOrder q x) + (hypos : 0 < finitePlaceOrder q y) : + 1 ≤ finiteExtensionGcdMultiplicity K L x y (.inl q) * + finiteExtensionPlaceDegree K L (.inl q) := by + have hxD : 0 < finiteExtensionPrincipalDivisor K L x (.inl q) := by + rw [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder K L x q] + exact hxpos + have hyD : 0 < finiteExtensionPrincipalDivisor K L y (.inl q) := by + rw [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder K L y q] + exact hypos + have hmult : 0 < finiteExtensionGcdMultiplicity K L x y (.inl q) := by + unfold finiteExtensionGcdMultiplicity + omega + exact Nat.mul_pos hmult (finiteExtensionPlaceDegree_inl_pos K L q) + +end FiniteExtensionGcdDivisor + +section PlaneCurveExhaustiveFinitePlaces + +variable {K : Type*} [Field K] +variable {f : MvPolynomial (Fin 2) K} + +/-- The selected polynomial parameter belongs to the affine coordinate ring +inside the curve's function field. -/ +theorem polynomial_algebraMap_mem_planeCurveCoordinateRing_range + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (P : Polynomial K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + algebraMap (Polynomial K) (PlaneCurveFunctionField f) P ∈ + (algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)).range := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + refine ⟨planeCurveQuotientMap f (polynomialInFirstCoordinate P), ?_⟩ + change algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + (planeCurveQuotientMap f (polynomialInFirstCoordinate P)) = + algebraMap (Polynomial K) (PlaneCurveFunctionField f) P + rw [show algebraMap (Polynomial K) (PlaneCurveFunctionField f) P = + algebraMap (RatFunc K) (PlaneCurveFunctionField f) + (algebraMap (Polynomial K) (RatFunc K) P) by rfl] + change ((algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f)).comp (planeCurveQuotientMap f)) + (polynomialInFirstCoordinate P) = _ + rw [← eval₂_planeCurveFunction f] + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + change MvPolynomial.eval₂ (algebraMap K (PlaneCurveFunctionField f)) + ![planeCurveFunction f 0, planeCurveFunction f 1] + (polynomialInFirstCoordinate P) = _ + rw [eval₂_polynomialInFirstCoordinate] + have hcomp := congrArg + (fun h : Polynomial K →+* PlaneCurveFunctionField f => h P) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + exact hcomp.symm + +variable [Fintype K] [DecidableEq K] + +/-- Every rational torsion point produces an actual finite place of the +`K[X]` integral-closure model at which both powered coordinate functions have +positive order. The valuation-subring equality records its affine center and +will make the choice injective. -/ +theorem exists_torsionPoint_exhaustiveFinitePlace_orders_positive + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsDedekindDomain + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) + letI : IsFractionRing + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) + (PlaneCurveFunctionField f) := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) + (PlaneCurveFunctionField f) + ∃ q : HeightOneSpectrum + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)), + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) q = + dominatingValuationSubring + (torsionPointMaximalIdeal f firstOrder secondOrder z) ∧ + 0 < finitePlaceOrder q + (planeCurveFunction f 0 ^ firstOrder - 1) ∧ + 0 < finitePlaceOrder q + (planeCurveFunction f 1 ^ secondOrder - 1) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsDedekindDomain + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) + letI : IsFractionRing + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) + (PlaneCurveFunctionField f) := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) + (PlaneCurveFunctionField f) + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + let B := integralClosure (Polynomial K) E + let m := torsionPointMaximalIdeal f firstOrder secondOrder z + let hbase : ∀ P : Polynomial K, + algebraMap (Polynomial K) E P ∈ (algebraMap A E).range := + polynomial_algebraMap_mem_planeCurveCoordinateRing_range hf hpartialSecond + let V := dominatingValuationSubring (A := A) (L := E) m + let rfirst : A := planeCurveCoordinate f 0 ^ firstOrder - 1 + let rsecond : A := planeCurveCoordinate f 1 ^ secondOrder - 1 + let Pfirst : Polynomial K := Polynomial.X ^ firstOrder - 1 + let bfirst : B := algebraMap (Polynomial K) B Pfirst + have hrfirst : rfirst ∈ m.asIdeal := + first_torsionFunction_mem_torsionPointMaximalIdeal + f firstOrder secondOrder z + have hrsecond : rsecond ∈ m.asIdeal := + second_torsionFunction_mem_torsionPointMaximalIdeal + f firstOrder secondOrder z + have hrfirstMap : algebraMap A E rfirst = + planeCurveFunction f 0 ^ firstOrder - 1 := by + simp only [rfirst, map_sub, map_pow, map_one] + rfl + have hrsecondMap : algebraMap A E rsecond = + planeCurveFunction f 1 ^ secondOrder - 1 := by + simp only [rsecond, map_sub, map_pow, map_one] + rfl + have hPfirstMap : algebraMap (Polynomial K) E Pfirst = + planeCurveFunction f 0 ^ firstOrder - 1 := by + simp only [Pfirst, map_sub, map_pow, map_one] + change algebraMap (RatFunc K) E + (algebraMap (Polynomial K) (RatFunc K) Polynomial.X) ^ firstOrder - 1 = _ + rw [show algebraMap (Polynomial K) (RatFunc K) Polynomial.X = + RatFunc.X by simp] + rw [planeCurveFirstCoordinateRatFuncAlgebra_X f hx] + have hbfirstMap : algebraMap B E bfirst = + planeCurveFunction f 0 ^ firstOrder - 1 := by + rw [show algebraMap B E bfirst = + algebraMap (Polynomial K) E Pfirst by + exact IsScalarTower.algebraMap_apply (Polynomial K) B E Pfirst] + exact hPfirstMap + have hbfirst0 : bfirst ≠ 0 := by + intro hb + apply hfirstNonzero + rw [← hbfirstMap, hb, map_zero] + have hfirstNonunits : + planeCurveFunction f 0 ^ firstOrder - 1 ∈ V.nonunits := by + rw [← hrfirstMap] + exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) m rfirst hrfirst + have hsecondNonunits : + planeCurveFunction f 1 ^ secondOrder - 1 ∈ V.nonunits := by + rw [← hrsecondMap] + exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) m rsecond hrsecond + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨planeCurveFunction f 0 ^ firstOrder - 1, + hfirstNonzero, hfirstNonunits⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hbfirstMem : + bfirst ∈ dominatingIntegralClosurePrime m hbase := by + change integralClosureToDominatingValuationSubring m hbase bfirst ∈ + IsLocalRing.maximalIdeal V + apply ValuationSubring.coe_mem_nonunits_iff.mp + have hcoe : + ((integralClosureToDominatingValuationSubring + m hbase bfirst : V) : E) = algebraMap B E bfirst := by + rfl + rw [hcoe, hbfirstMap] + exact hfirstNonunits + have hqne : dominatingIntegralClosurePrime m hbase ≠ ⊥ := by + intro hbot + have : bfirst = 0 := by simpa [hbot] using hbfirstMem + exact hbfirst0 this + let q : HeightOneSpectrum B := + dominatingIntegralClosurePlace m hbase hqne + have hrfirstMap0 : algebraMap A E rfirst ≠ 0 := by + rw [hrfirstMap] + exact hfirstNonzero + have hrsecondMap0 : algebraMap A E rsecond ≠ 0 := by + rw [hrsecondMap] + exact hsecondNonzero + refine ⟨q, ?_, ?_, ?_⟩ + · exact valuationSubringAt_dominatingIntegralClosurePlace_eq + m hbase hqne hV + · rw [← hrfirstMap] + exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem + m hbase hqne hV rfirst hrfirst hrfirstMap0 + · rw [← hrsecondMap] + exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem + m hbase hqne hV rsecond hrsecond hrsecondMap0 + +/-- The finite place in the exhaustive `K[X]`-integral-closure model selected +above a rational torsion point. -/ +def torsionPointExhaustiveFinitePlace + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + FiniteExtensionFinitePlace K (PlaneCurveFunctionField f) := by + exact Classical.choose + (exists_torsionPoint_exhaustiveFinitePlace_orders_positive + hf hpartialSecond firstOrder secondOrder + hfirstNonzero hsecondNonzero z) + +/-- The selected exhaustive finite place is centered at the given affine +torsion point, and both powered coordinate functions have positive order +there. -/ +theorem torsionPointExhaustiveFinitePlace_spec + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z) = + dominatingValuationSubring + (torsionPointMaximalIdeal f firstOrder secondOrder z) ∧ + 0 < finitePlaceOrder + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z) + (planeCurveFunction f 0 ^ firstOrder - 1) ∧ + 0 < finitePlaceOrder + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z) + (planeCurveFunction f 1 ^ secondOrder - 1) := by + exact Classical.choose_spec + (exists_torsionPoint_exhaustiveFinitePlace_orders_positive + hf hpartialSecond firstOrder secondOrder + hfirstNonzero hsecondNonzero z) + +/-- Distinct rational torsion points have distinct selected finite places in +the exhaustive `K[X]`-model. -/ +theorem torsionPointExhaustiveFinitePlace_injective + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + Function.Injective + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change Function.Injective + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero) + intro z w hzw + apply torsionPointMaximalIdeal_injective f firstOrder secondOrder + apply MaximalSpectrum.ext + apply pointIdeal_eq_of_dominatingValuationSubring_eq + (A := PlaneCurveCoordinateRing f) + (L := PlaneCurveFunctionField f) + calc + dominatingValuationSubring + (torsionPointMaximalIdeal f firstOrder secondOrder z) = + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z) := + (torsionPointExhaustiveFinitePlace_spec hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z).1.symm + _ = IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero w) := by + rw [hzw] + _ = dominatingValuationSubring + (torsionPointMaximalIdeal f firstOrder secondOrder w) := + (torsionPointExhaustiveFinitePlace_spec hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero w).1 + +/-- Degree of the positive gcd divisor of the two powered coordinate +functions, taken on the exhaustive finite-and-infinite place model attached to +the first coordinate. -/ +noncomputable def planeCurveExhaustiveTorsionGcdWeightedDegree + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (firstOrder secondOrder : ℕ) : ℕ := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + exact finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) + (planeCurveFunction f 0 ^ firstOrder - 1) + (planeCurveFunction f 1 ^ secondOrder - 1) + +/-- Rational torsion points inject into the positive gcd divisor on the +exhaustive place model. The residue-degree weight of every selected place is +positive, so each point contributes at least one to its weighted degree. -/ +theorem torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) : + Fintype.card (TorusCurveTorsionPoint f firstOrder secondOrder) ≤ + planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let x : PlaneCurveFunctionField f := + planeCurveFunction f 0 ^ firstOrder - 1 + let y : PlaneCurveFunctionField f := + planeCurveFunction f 1 ^ secondOrder - 1 + let finitePlace : TorusCurveTorsionPoint f firstOrder secondOrder → + FiniteExtensionFinitePlace K (PlaneCurveFunctionField f) := + torsionPointExhaustiveFinitePlace hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero + let place : TorusCurveTorsionPoint f firstOrder secondOrder → + FiniteExtensionPlace K (PlaneCurveFunctionField f) := + fun z => .inl (finitePlace z) + have hFinitePlaceInjective : Function.Injective finitePlace := + torsionPointExhaustiveFinitePlace_injective hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero + have hPlaceInjective : Function.Injective place := by + intro z w hzw + apply hFinitePlaceInjective + exact Sum.inl_injective hzw + have hImageSubset : Finset.univ.image place ⊆ + finiteExtensionGcdSupport K (PlaneCurveFunctionField f) x y := by + intro v hv + obtain ⟨z, -, rfl⟩ := Finset.mem_image.mp hv + have hz := torsionPointExhaustiveFinitePlace_spec hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z + exact inl_mem_finiteExtensionGcdSupport_of_orders_positive + K (PlaneCurveFunctionField f) x y (finitePlace z) hz.2.1 + calc + Fintype.card (TorusCurveTorsionPoint f firstOrder secondOrder) = + (Finset.univ.image place).card := by + rw [Finset.card_image_of_injective _ hPlaceInjective, + Finset.card_univ] + _ = ∑ v ∈ Finset.univ.image place, 1 := by simp + _ ≤ ∑ v ∈ Finset.univ.image place, + finiteExtensionGcdMultiplicity K (PlaneCurveFunctionField f) x y v * + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) v := by + apply Finset.sum_le_sum + intro v hv + obtain ⟨z, -, rfl⟩ := Finset.mem_image.mp hv + have hz := torsionPointExhaustiveFinitePlace_spec hf hpartialSecond + firstOrder secondOrder hfirstNonzero hsecondNonzero z + exact + one_le_finiteExtensionGcdMultiplicity_mul_degree_inl_of_orders_positive + K (PlaneCurveFunctionField f) x y (finitePlace z) hz.2.1 hz.2.2 + _ ≤ ∑ v ∈ finiteExtensionGcdSupport K (PlaneCurveFunctionField f) x y, + finiteExtensionGcdMultiplicity K (PlaneCurveFunctionField f) x y v * + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) v := by + exact Finset.sum_le_sum_of_subset_of_nonneg hImageSubset (by omega) + _ = planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond firstOrder secondOrder := by + rfl + +end PlaneCurveExhaustiveFinitePlaces diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean new file mode 100644 index 0000000000..4bb93426f9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean @@ -0,0 +1,309 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization + +/-! +# Torsion points contribute to the normalization gcd divisor + +This file upgrades the pointwise normalization result to a finite divisor +inequality. For any Dedekind normalization model of the plane-curve function +field, one branch is chosen over each rational torsion point. Distinct points +give distinct branches, both torsion functions have positive order there, and +therefore the number of torsion points is bounded by the sum of the local gcd +multiplicities. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open IsDedekindDomain + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] +variable {f : MvPolynomial (Fin 2) K} +variable [IsDomain (PlaneCurveCoordinateRing f)] + +/-- Choose a branch in an arbitrary Dedekind integral-closure model above the +maximal ideal defined by a torsion point. -/ +def liftedTorsionPointNormalizationBranch + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + MaximalSpectrum B := by + let hex := Ideal.exists_maximal_ideal_liesOver_of_isIntegral + (S := B) (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal + exact ⟨Classical.choose hex, (Classical.choose_spec hex).1⟩ + +theorem liftedTorsionPointNormalizationBranch_liesOver + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z).asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := by + let hex := Ideal.exists_maximal_ideal_liesOver_of_isIntegral + (S := B) (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal + exact (Classical.choose_spec hex).2 + +/-- Chosen branches above distinct torsion points are distinct because their +contractions to the affine coordinate ring are distinct. -/ +theorem liftedTorsionPointNormalizationBranch_injective + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) : + Function.Injective + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder) := by + intro z w hzw + apply torsionPointMaximalIdeal_injective f firstOrder secondOrder + apply MaximalSpectrum.ext + letI hz : + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z).asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := + liftedTorsionPointNormalizationBranch_liesOver (f := f) firstOrder secondOrder z + letI hw : + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder w).asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder w).asIdeal := + liftedTorsionPointNormalizationBranch_liesOver (f := f) firstOrder secondOrder w + calc + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal = + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z).asIdeal.under (PlaneCurveCoordinateRing f) := + Ideal.over_def + (P := (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z).asIdeal) + (p := (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal) + _ = (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder w).asIdeal.under (PlaneCurveCoordinateRing f) := by + rw [hzw] + _ = (torsionPointMaximalIdeal f firstOrder secondOrder w).asIdeal := + (Ideal.over_def + (P := (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder w).asIdeal) + (p := (torsionPointMaximalIdeal f firstOrder secondOrder w).asIdeal)).symm + +/-- The finite place selected above a torsion point. It is obtained from the +positive-order branch theorem, so its defining prime is the chosen branch. -/ +def torsionPointFinitePlace + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + HeightOneSpectrum B := + Classical.choose (liftedNormalizationBranch_torsion_orders_positive + f firstOrder secondOrder hfirstNonzero hsecondNonzero z + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z) + (liftedTorsionPointNormalizationBranch_liesOver (f := f) firstOrder secondOrder z)) + +theorem torsionPointFinitePlace_spec + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z).asIdeal = + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z).asIdeal ∧ + (1 : ℤ) ≤ finitePlaceOrder + (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z) + (planeCurveFunction f 0 ^ firstOrder - 1) ∧ + (1 : ℤ) ≤ finitePlaceOrder + (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z) + (planeCurveFunction f 1 ^ secondOrder - 1) ∧ + (1 : ℤ) ≤ min + (finitePlaceOrder + (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z) + (planeCurveFunction f 0 ^ firstOrder - 1)) + (finitePlaceOrder + (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z) + (planeCurveFunction f 1 ^ secondOrder - 1)) := + Classical.choose_spec (liftedNormalizationBranch_torsion_orders_positive + f firstOrder secondOrder hfirstNonzero hsecondNonzero z + (liftedTorsionPointNormalizationBranch (f := f) (B := B) + firstOrder secondOrder z) + (liftedTorsionPointNormalizationBranch_liesOver (f := f) firstOrder secondOrder z)) + +theorem torsionPointFinitePlace_injective + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) : + Function.Injective (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero) := by + intro z w hzw + apply liftedTorsionPointNormalizationBranch_injective + (f := f) (B := B) firstOrder secondOrder + apply MaximalSpectrum.ext + rw [← (torsionPointFinitePlace_spec (f := f) (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z).1, + ← (torsionPointFinitePlace_spec (f := f) (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero w).1, + hzw] + +/-- The finite support containing every chosen torsion place. -/ +def torsionGcdPlaceSupport + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra B (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) : Finset (HeightOneSpectrum B) := by + classical + exact (finitePrincipalDivisor (R := B) + (planeCurveFunction f 0 ^ firstOrder - 1)).support ∪ + (finitePrincipalDivisor (R := B) + (planeCurveFunction f 1 ^ secondOrder - 1)).support + +theorem torsionPointFinitePlace_mem_torsionGcdPlaceSupport + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z ∈ + torsionGcdPlaceSupport (f := f) (B := B) firstOrder secondOrder := by + classical + apply Finset.mem_union_left + rw [Finsupp.mem_support_iff, finitePrincipalDivisor_apply] + have h := (torsionPointFinitePlace_spec (f := f) (B := B) + firstOrder secondOrder hfirstNonzero hsecondNonzero z).2.1 + omega + +/-- The natural-number local gcd multiplicity of the two torsion functions. -/ +def torsionGcdMultiplicity + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra B (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) (v : HeightOneSpectrum B) : ℕ := + Int.toNat (min + (finitePlaceOrder v (planeCurveFunction f 0 ^ firstOrder - 1)) + (finitePlaceOrder v (planeCurveFunction f 1 ^ secondOrder - 1))) + +/-- Every chosen torsion branch contributes at least one to the local gcd +multiplicity. -/ +theorem one_le_torsionGcdMultiplicity_torsionPointFinitePlace + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + 1 ≤ torsionGcdMultiplicity (f := f) (B := B) firstOrder secondOrder + (torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z) := by + unfold torsionGcdMultiplicity + have h := (torsionPointFinitePlace_spec (f := f) (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero z).2.2.2 + omega + +/-- The torsion-point count is bounded by the finite sum of local gcd +multiplicities on any Dedekind normalization model. -/ +theorem torsionPoint_card_le_torsionGcdMultiplicity_sum + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [Algebra.IsIntegral (PlaneCurveCoordinateRing f) B] + [FaithfulSMul (PlaneCurveCoordinateRing f) B] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + [IsFractionRing B (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) : + Fintype.card (TorusCurveTorsionPoint f firstOrder secondOrder) ≤ + ∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) firstOrder secondOrder v := by + classical + let place : TorusCurveTorsionPoint f firstOrder secondOrder → HeightOneSpectrum B := + torsionPointFinitePlace (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero + have hPlaceInjective : Function.Injective place := + torsionPointFinitePlace_injective (B := B) firstOrder secondOrder + hfirstNonzero hsecondNonzero + have hImageSubset : Finset.univ.image place ⊆ + torsionGcdPlaceSupport (f := f) (B := B) firstOrder secondOrder := by + intro v hv + obtain ⟨z, -, rfl⟩ := Finset.mem_image.mp hv + exact torsionPointFinitePlace_mem_torsionGcdPlaceSupport (f := f) firstOrder secondOrder + hfirstNonzero hsecondNonzero z + calc + Fintype.card (TorusCurveTorsionPoint f firstOrder secondOrder) = + (Finset.univ.image place).card := by + rw [Finset.card_image_of_injective _ hPlaceInjective, + Finset.card_univ] + _ = ∑ v ∈ Finset.univ.image place, 1 := by simp + _ ≤ ∑ v ∈ Finset.univ.image place, + torsionGcdMultiplicity (f := f) (B := B) firstOrder secondOrder v := by + apply Finset.sum_le_sum + intro v hv + obtain ⟨z, -, rfl⟩ := Finset.mem_image.mp hv + exact one_le_torsionGcdMultiplicity_torsionPointFinitePlace + firstOrder secondOrder hfirstNonzero hsecondNonzero z + _ ≤ ∑ v ∈ torsionGcdPlaceSupport (f := f) (B := B) + firstOrder secondOrder, + torsionGcdMultiplicity (f := f) (B := B) firstOrder secondOrder v := by + exact Finset.sum_le_sum_of_subset_of_nonneg hImageSubset (by omega) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean new file mode 100644 index 0000000000..d2d7d85c66 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean @@ -0,0 +1,418 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import Mathlib.RingTheory.Ideal.GoingUp +import Mathlib.RingTheory.Localization.Integral + +namespace BGS.CorvajaZannier + +noncomputable section + +open IsDedekindDomain Multiplicative WithZero + +variable {K : Type*} [Field K] + +/-- An affine rational point of the plane curve `f = 0`. -/ +abbrev AffinePlaneCurvePoint (f : MvPolynomial (Fin 2) K) := + {z : K × K // MvPolynomial.eval ![z.1, z.2] f = 0} + +/-- Evaluation at an affine rational point, descended to the coordinate ring. -/ +def planeCurvePointEval (f : MvPolynomial (Fin 2) K) + (z : AffinePlaneCurvePoint f) : PlaneCurveCoordinateRing f →+* K := + Ideal.Quotient.lift (Ideal.span {f}) + (MvPolynomial.eval₂Hom (RingHom.id K) ![z.1.1, z.1.2]) (by + intro g hg + obtain ⟨a, rfl⟩ := Ideal.mem_span_singleton.mp hg + rw [map_mul] + have hfzero : + (MvPolynomial.eval₂Hom (RingHom.id K) ![z.1.1, z.1.2]) f = 0 := by + change (MvPolynomial.eval ![z.1.1, z.1.2]) f = 0 + exact z.2 + rw [hfzero, zero_mul]) + +@[simp] +theorem planeCurvePointEval_coordinate (f : MvPolynomial (Fin 2) K) + (z : AffinePlaneCurvePoint f) (i : Fin 2) : + planeCurvePointEval f z (planeCurveCoordinate f i) = ![z.1.1, z.1.2] i := by + simp [planeCurvePointEval, planeCurveCoordinate, planeCurveQuotientMap] + +@[simp] +theorem planeCurvePointEval_algebraMap (f : MvPolynomial (Fin 2) K) + (z : AffinePlaneCurvePoint f) (c : K) : + planeCurvePointEval f z (algebraMap K (PlaneCurveCoordinateRing f) c) = c := by + change planeCurvePointEval f z + (Ideal.Quotient.mk (Ideal.span {f}) (MvPolynomial.C c)) = c + simp [planeCurvePointEval] + +theorem planeCurvePointEval_surjective (f : MvPolynomial (Fin 2) K) + (z : AffinePlaneCurvePoint f) : Function.Surjective (planeCurvePointEval f z) := by + intro c + exact ⟨algebraMap K (PlaneCurveCoordinateRing f) c, + planeCurvePointEval_algebraMap f z c⟩ + +/-- The maximal ideal of the affine coordinate ring attached to a rational point. -/ +def affinePlaneCurvePointMaximalIdeal (f : MvPolynomial (Fin 2) K) + (z : AffinePlaneCurvePoint f) : MaximalSpectrum (PlaneCurveCoordinateRing f) where + asIdeal := RingHom.ker (planeCurvePointEval f z) + isMaximal := RingHom.ker_isMaximal_of_surjective _ + (planeCurvePointEval_surjective f z) + +/-- Distinct rational affine points define distinct maximal ideals. -/ +theorem affinePlaneCurvePointMaximalIdeal_injective (f : MvPolynomial (Fin 2) K) : + Function.Injective (affinePlaneCurvePointMaximalIdeal f) := by + intro z w hzw + have hker : RingHom.ker (planeCurvePointEval f z) = + RingHom.ker (planeCurvePointEval f w) := + congrArg MaximalSpectrum.asIdeal hzw + apply Subtype.ext + apply Prod.ext + · have hzmem : planeCurveCoordinate f 0 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.1 ∈ + RingHom.ker (planeCurvePointEval f z) := by + change planeCurvePointEval f z + (planeCurveCoordinate f 0 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.1) = 0 + simp + have hwmem : planeCurveCoordinate f 0 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.1 ∈ + RingHom.ker (planeCurvePointEval f w) := by + rw [← hker] + exact hzmem + change planeCurvePointEval f w + (planeCurveCoordinate f 0 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.1) = 0 at hwmem + have heval : w.1.1 - z.1.1 = 0 := by simpa using hwmem + exact (sub_eq_zero.mp heval).symm + · have hzmem : planeCurveCoordinate f 1 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.2 ∈ + RingHom.ker (planeCurvePointEval f z) := by + change planeCurvePointEval f z + (planeCurveCoordinate f 1 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.2) = 0 + simp + have hwmem : planeCurveCoordinate f 1 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.2 ∈ + RingHom.ker (planeCurvePointEval f w) := by + rw [← hker] + exact hzmem + change planeCurvePointEval f w + (planeCurveCoordinate f 1 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.2) = 0 at hwmem + have heval : w.1.2 - z.1.2 = 0 := by simpa using hwmem + exact (sub_eq_zero.mp heval).symm + +variable [Fintype K] [DecidableEq K] + +/-- A torsion point in the finite-field intersection, as a finite subtype. -/ +abbrev TorusCurveTorsionPoint (f : MvPolynomial (Fin 2) K) + (firstOrder secondOrder : ℕ) := + {z : Kˣ × Kˣ // z ∈ BGS.External.torusCurveTorsionIntersection + K f firstOrder secondOrder} + +/-- Forget the unit witnesses and regard a torsion point as an affine point of +the plane curve. -/ +def torsionPointToAffinePlaneCurvePoint + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + AffinePlaneCurvePoint f := + ⟨((z.1.1 : K), (z.1.2 : K)), + (BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2).1⟩ + +theorem torsionPointToAffinePlaneCurvePoint_injective + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) : + Function.Injective + (torsionPointToAffinePlaneCurvePoint f firstOrder secondOrder) := by + intro z w hzw + apply Subtype.ext + apply Prod.ext <;> apply Units.ext + · exact congrArg Prod.fst (congrArg Subtype.val hzw) + · exact congrArg Prod.snd (congrArg Subtype.val hzw) + +/-- A finite-field torsion point determines a maximal ideal of the affine +coordinate ring. -/ +def torsionPointMaximalIdeal + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + MaximalSpectrum (PlaneCurveCoordinateRing f) := + affinePlaneCurvePointMaximalIdeal f + (torsionPointToAffinePlaneCurvePoint f firstOrder secondOrder z) + +theorem torsionPointMaximalIdeal_injective + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) : + Function.Injective (torsionPointMaximalIdeal f firstOrder secondOrder) := + (affinePlaneCurvePointMaximalIdeal_injective f).comp + (torsionPointToAffinePlaneCurvePoint_injective f firstOrder secondOrder) + +/-- The first torsion function belongs to the maximal ideal of its point. -/ +theorem first_torsionFunction_mem_torsionPointMaximalIdeal + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + planeCurveCoordinate f 0 ^ firstOrder - 1 ∈ + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := by + change planeCurvePointEval f + (torsionPointToAffinePlaneCurvePoint f firstOrder secondOrder z) + (planeCurveCoordinate f 0 ^ firstOrder - 1) = 0 + rw [map_sub, map_pow, map_one, planeCurvePointEval_coordinate] + have hpow := + (BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2).2.1 + exact sub_eq_zero.mpr (congrArg Units.val hpow) + +/-- The second torsion function belongs to the maximal ideal of its point. -/ +theorem second_torsionFunction_mem_torsionPointMaximalIdeal + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + planeCurveCoordinate f 1 ^ secondOrder - 1 ∈ + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := by + change planeCurvePointEval f + (torsionPointToAffinePlaneCurvePoint f firstOrder secondOrder z) + (planeCurveCoordinate f 1 ^ secondOrder - 1) = 0 + rw [map_sub, map_pow, map_one, planeCurvePointEval_coordinate] + have hpow := + (BGS.External.mem_torusCurveTorsionIntersection_iff.mp z.2).2.2 + exact sub_eq_zero.mpr (congrArg Units.val hpow) + +variable {f : MvPolynomial (Fin 2) K} +variable [IsDomain (PlaneCurveCoordinateRing f)] + +/-- The affine normalization of the plane-curve coordinate ring inside its +fraction field. -/ +abbrev PlaneCurveNormalization (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] := + integralClosure (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) + +/-- Choose one normalization branch above an affine maximal ideal. Lying over +guarantees that such a branch exists; no smoothness is assumed. -/ +def planeCurveNormalizationBranch + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + (m : MaximalSpectrum (PlaneCurveCoordinateRing f)) : + MaximalSpectrum (PlaneCurveNormalization f) := by + let hex := Ideal.exists_maximal_ideal_liesOver_of_isIntegral + (S := PlaneCurveNormalization f) m.asIdeal + exact ⟨Classical.choose hex, (Classical.choose_spec hex).1⟩ + +omit [Fintype K] [DecidableEq K] in +theorem planeCurveNormalizationBranch_liesOver + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + (m : MaximalSpectrum (PlaneCurveCoordinateRing f)) : + (planeCurveNormalizationBranch f m).asIdeal.LiesOver m.asIdeal := by + let hex := Ideal.exists_maximal_ideal_liesOver_of_isIntegral + (S := PlaneCurveNormalization f) m.asIdeal + exact (Classical.choose_spec hex).2 + +omit [Fintype K] [DecidableEq K] in +/-- Chosen normalization branches above distinct affine maximal ideals remain +distinct, because their contractions are distinct. -/ +theorem planeCurveNormalizationBranch_injective + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] : + Function.Injective (planeCurveNormalizationBranch f) := by + intro m n hmn + apply MaximalSpectrum.ext + letI hm : (planeCurveNormalizationBranch f m).asIdeal.LiesOver m.asIdeal := + planeCurveNormalizationBranch_liesOver f m + letI hn : (planeCurveNormalizationBranch f n).asIdeal.LiesOver n.asIdeal := + planeCurveNormalizationBranch_liesOver f n + calc + m.asIdeal = (planeCurveNormalizationBranch f m).asIdeal.under + (PlaneCurveCoordinateRing f) := + Ideal.over_def + (P := (planeCurveNormalizationBranch f m).asIdeal) (p := m.asIdeal) + _ = (planeCurveNormalizationBranch f n).asIdeal.under + (PlaneCurveCoordinateRing f) := by rw [hmn] + _ = n.asIdeal := + (Ideal.over_def + (P := (planeCurveNormalizationBranch f n).asIdeal) (p := n.asIdeal)).symm + +/-- The chosen branch of the normalization above a torsion point. -/ +def torsionPointNormalizationBranch + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + MaximalSpectrum (PlaneCurveNormalization f) := + planeCurveNormalizationBranch f + (torsionPointMaximalIdeal f firstOrder secondOrder z) + +theorem torsionPointNormalizationBranch_injective + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + (firstOrder secondOrder : ℕ) : + Function.Injective + (torsionPointNormalizationBranch f firstOrder secondOrder) := + (planeCurveNormalizationBranch_injective f).comp + (torsionPointMaximalIdeal_injective f firstOrder secondOrder) + +/-- The first torsion function vanishes on the chosen normalization branch. -/ +theorem first_torsionFunction_mem_normalizationBranch + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveNormalization f) + (planeCurveCoordinate f 0 ^ firstOrder - 1) ∈ + (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal := by + letI : + (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := + planeCurveNormalizationBranch_liesOver f + (torsionPointMaximalIdeal f firstOrder secondOrder z) + exact (Ideal.mem_of_liesOver + (P := (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal) + (p := (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal) _).mp + (first_torsionFunction_mem_torsionPointMaximalIdeal + f firstOrder secondOrder z) + +/-- The second torsion function vanishes on the chosen normalization branch. -/ +theorem second_torsionFunction_mem_normalizationBranch + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + (firstOrder secondOrder : ℕ) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) : + algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveNormalization f) + (planeCurveCoordinate f 1 ^ secondOrder - 1) ∈ + (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal := by + letI : + (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := + planeCurveNormalizationBranch_liesOver f + (torsionPointMaximalIdeal f firstOrder secondOrder z) + exact (Ideal.mem_of_liesOver + (P := (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal) + (p := (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal) _).mp + (second_torsionFunction_mem_torsionPointMaximalIdeal + f firstOrder secondOrder z) + +/-- An integral-closure model of the plane-curve function field has that +function field as its fraction field. -/ +private noncomputable instance planeCurveIntegralClosureIsFractionRing + {B : Type*} [CommRing B] [IsDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] : + IsFractionRing B (PlaneCurveFunctionField f) := by + letI : Algebra.IsAlgebraic (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) := + (IsFractionRing.comap_isAlgebraic_iff + (A := PlaneCurveCoordinateRing f) + (K := PlaneCurveFunctionField f) + (C := PlaneCurveFunctionField f)).mpr inferInstance + exact IsIntegralClosure.isFractionRing_of_algebraic + (PlaneCurveCoordinateRing f) B + (fun x hx => IsFractionRing.injective + (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) (by simpa using hx)) + +/-- Membership in a height-one prime gives at least one unit of additive +finite-place order. -/ +theorem one_le_finitePlaceOrder_of_mem + {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + (v : HeightOneSpectrum R) (a : R) (ha : a ∈ v.asIdeal) (ha0 : a ≠ 0) : + (1 : ℤ) ≤ finitePlaceOrder v (algebraMap R L a) := by + have hmap : algebraMap R L a ≠ 0 := + fun h ↦ ha0 ((IsFractionRing.injective R L) (by simpa using h)) + have hvaluation := valuation_eq_exp_neg_finitePlaceOrder + v (algebraMap R L a) hmap + rw [IsDedekindDomain.HeightOneSpectrum.valuation_of_algebraMap] at hvaluation + have hlt : exp (-finitePlaceOrder v (algebraMap R L a)) < 1 := by + rw [← hvaluation] + exact (v.intValuation_lt_one_iff_mem a).2 ha + rw [← exp_zero, exp_lt_exp] at hlt + omega + +/-- Generic local bridge for any Dedekind integral-closure model `B` of the +curve's function field. A maximal ideal of `B` lying over the torsion point +is a finite place, and both torsion functions have order at least one there. + +The branch is an explicit parameter, so a later global normalization or +projective model can supply its own chosen lift. -/ +theorem liftedNormalizationBranch_torsion_orders_positive + (f : MvPolynomial (Fin 2) K) + [IsDomain (PlaneCurveCoordinateRing f)] + {B : Type*} [CommRing B] [IsDedekindDomain B] + [Algebra (PlaneCurveCoordinateRing f) B] + [Algebra B (PlaneCurveFunctionField f)] + [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] + [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] + (firstOrder secondOrder : ℕ) + (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) + (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) + (z : TorusCurveTorsionPoint f firstOrder secondOrder) + (branch : MaximalSpectrum B) + (hbranch : branch.asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal) : + ∃ v : HeightOneSpectrum B, + v.asIdeal = branch.asIdeal ∧ + (1 : ℤ) ≤ finitePlaceOrder v + (planeCurveFunction f 0 ^ firstOrder - 1) ∧ + (1 : ℤ) ≤ finitePlaceOrder v + (planeCurveFunction f 1 ^ secondOrder - 1) ∧ + (1 : ℤ) ≤ min + (finitePlaceOrder v (planeCurveFunction f 0 ^ firstOrder - 1)) + (finitePlaceOrder v (planeCurveFunction f 1 ^ secondOrder - 1)) := by + let A := PlaneCurveCoordinateRing f + let L := PlaneCurveFunctionField f + let firstRegular : B := + algebraMap A B (planeCurveCoordinate f 0 ^ firstOrder - 1) + let secondRegular : B := + algebraMap A B (planeCurveCoordinate f 1 ^ secondOrder - 1) + have hfirstMap : algebraMap B L firstRegular = + planeCurveFunction f 0 ^ firstOrder - 1 := by + simp only [firstRegular, map_sub, map_pow, map_one] + rw [← IsScalarTower.algebraMap_apply A B L] + rfl + have hsecondMap : algebraMap B L secondRegular = + planeCurveFunction f 1 ^ secondOrder - 1 := by + simp only [secondRegular, map_sub, map_pow, map_one] + rw [← IsScalarTower.algebraMap_apply A B L] + rfl + have hfirstRegular : firstRegular ≠ 0 := by + intro hzero + apply hfirstNonzero + rw [← hfirstMap, hzero, map_zero] + have hsecondRegular : secondRegular ≠ 0 := by + intro hzero + apply hsecondNonzero + rw [← hsecondMap, hzero, map_zero] + letI : branch.asIdeal.LiesOver + (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := hbranch + have hfirstMem : firstRegular ∈ branch.asIdeal := by + exact (Ideal.mem_of_liesOver + (P := branch.asIdeal) + (p := (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal) _).mp + (first_torsionFunction_mem_torsionPointMaximalIdeal + f firstOrder secondOrder z) + have hsecondMem : secondRegular ∈ branch.asIdeal := by + exact (Ideal.mem_of_liesOver + (P := branch.asIdeal) + (p := (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal) _).mp + (second_torsionFunction_mem_torsionPointMaximalIdeal + f firstOrder secondOrder z) + have hbranchNeBot : branch.asIdeal ≠ ⊥ := by + intro hbot + have : firstRegular = 0 := by + simpa [hbot] using hfirstMem + exact hfirstRegular this + let v : HeightOneSpectrum B := + ⟨branch.asIdeal, branch.isMaximal.isPrime, hbranchNeBot⟩ + have hfirstOrder : (1 : ℤ) ≤ + finitePlaceOrder v (planeCurveFunction f 0 ^ firstOrder - 1) := by + rw [← hfirstMap] + exact one_le_finitePlaceOrder_of_mem v firstRegular hfirstMem hfirstRegular + have hsecondOrder : (1 : ℤ) ≤ + finitePlaceOrder v (planeCurveFunction f 1 ^ secondOrder - 1) := by + rw [← hsecondMap] + exact one_le_finitePlaceOrder_of_mem v secondRegular hsecondMem hsecondRegular + exact ⟨v, rfl, hfirstOrder, hsecondOrder, le_min hfirstOrder hsecondOrder⟩ + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean new file mode 100644 index 0000000000..685ff01052 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean @@ -0,0 +1,325 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +import Mathlib.Data.Int.GCD +import Mathlib.RingTheory.RootsOfUnity.Basic +import Mathlib.SetTheory.Cardinal.Finite +import Mathlib.Tactic + +/-! +# Rank-two character kernels in a two-dimensional torus + +Two independent integer characters cut out a finite subgroup of a +two-dimensional torus. This file proves the sharp elementary bound: the +number of common kernel points is at most the absolute determinant of the +two character vectors. The proof is valid over an arbitrary field and does +not assume that all roots of unity are present. + +Applied to three monomials in the support of a plane curve, this bounds the +diagonal support stabilizer by the corresponding support determinant and +hence by twice the product of the two coordinate degrees. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +/-- The fiber of the `g`-th power map on units. -/ +def unitPowerFiber {F : Type*} [Field F] (g : ℕ) (c : Fˣ) := + {z : Fˣ // z ^ g = c} + +instance unitPowerFiber_finite {F : Type*} [Field F] + (g : ℕ) [NeZero g] (c : Fˣ) : Finite (unitPowerFiber g c) := by + classical + let e : unitPowerFiber g c → + {x : F // x ∈ Polynomial.nthRoots g (c : F)} := fun z => + ⟨z.1.1, (Polynomial.mem_nthRoots (NeZero.pos g)).mpr + (congrArg (fun u : Fˣ => (u : F)) z.2)⟩ + exact Finite.of_injective e (fun z w h => by + apply Subtype.ext + apply Units.ext + exact congrArg Subtype.val h) + +/-- A nonzero power equation in one unit has at most its exponent many +solutions. -/ +theorem natCard_unitPowerFiber_le {F : Type*} [Field F] + (g : ℕ) (hg : 0 < g) (c : Fˣ) : + Nat.card (unitPowerFiber g c) ≤ g := by + classical + by_cases h : Nonempty (unitPowerFiber g c) + · let z₀ : unitPowerFiber g c := Classical.choice h + let e : unitPowerFiber g c → rootsOfUnity g F := fun z => + ⟨z.1 * z₀.1⁻¹, by + rw [mem_rootsOfUnity, mul_pow, inv_pow, z.2, z₀.2] + simp⟩ + have he : Function.Injective e := by + intro z w hzw + apply Subtype.ext + have hval := congrArg (fun u : rootsOfUnity g F => (u.1 : Fˣ)) hzw + dsimp only [e] at hval + exact mul_right_cancel hval + haveI : NeZero g := ⟨hg.ne'⟩ + exact (Nat.card_le_card_of_injective e he).trans + (card_rootsOfUnity F g) + · letI : IsEmpty (unitPowerFiber g c) := ⟨fun z => h ⟨z⟩⟩ + simp + +/-- The common kernel of two integer characters of a two-dimensional +algebraic torus. -/ +def torusCharacterKernel (F : Type*) [Field F] + (a b c d : ℤ) := + {z : Fˣ × Fˣ // + z.1 ^ a * z.2 ^ b = 1 ∧ z.1 ^ c * z.2 ^ d = 1} + +private theorem pow_natAbs_eq_one_of_zpow_eq_one + {F : Type*} [Field F] (z : Fˣ) (k : ℤ) (h : z ^ k = 1) : + z ^ k.natAbs = 1 := by + rcases (Int.natAbs_eq_iff.mp + (rfl : k.natAbs = k.natAbs)) with hk | hk + · rw [← zpow_natCast, ← hk] + exact h + · have hinv := congrArg Inv.inv h + rw [hk] at hinv + simpa [← zpow_neg] using hinv + +/-- A nonzero determinant makes the common character kernel finite. This +coarse finiteness proof embeds it into a product of two root-of-unity groups; +the sharper cardinal estimate below uses Hermite reduction. -/ +theorem finite_torusCharacterKernel_of_det_ne_zero + {F : Type*} [Field F] (a b c d : ℤ) + (hdet : a * d - b * c ≠ 0) : + Finite (torusCharacterKernel F a b c d) := by + classical + let D := a * d - b * c + have hD : D ≠ 0 := hdet + have hDpos : 0 < D.natAbs := Int.natAbs_pos.mpr hD + have hfirst (z : torusCharacterKernel F a b c d) : + z.1.1 ^ D = 1 := by + rcases z.2 with ⟨h₁, h₂⟩ + have hprod : + (z.1.1 ^ a * z.1.2 ^ b) ^ d * + (z.1.1 ^ c * z.1.2 ^ d) ^ (-b) = + z.1.1 ^ (a * d + c * (-b)) * + z.1.2 ^ (b * d + d * (-b)) := by + simp only [mul_zpow, zpow_mul, zpow_add] + ac_rfl + have hx : a * d + c * (-b) = D := by dsimp only [D]; ring + have hy : b * d + d * (-b) = 0 := by ring + calc + z.1.1 ^ D = z.1.1 ^ (a * d + c * (-b)) * + z.1.2 ^ (b * d + d * (-b)) := by rw [hx, hy]; simp + _ = (z.1.1 ^ a * z.1.2 ^ b) ^ d * + (z.1.1 ^ c * z.1.2 ^ d) ^ (-b) := hprod.symm + _ = 1 := by rw [h₁, h₂]; simp + have hsecond (z : torusCharacterKernel F a b c d) : + z.1.2 ^ D = 1 := by + rcases z.2 with ⟨h₁, h₂⟩ + have hprod : + (z.1.1 ^ a * z.1.2 ^ b) ^ (-c) * + (z.1.1 ^ c * z.1.2 ^ d) ^ a = + z.1.1 ^ (a * (-c) + c * a) * + z.1.2 ^ (b * (-c) + d * a) := by + simp only [mul_zpow, zpow_mul, zpow_add] + ac_rfl + have hx : a * (-c) + c * a = 0 := by ring + have hy : b * (-c) + d * a = D := by dsimp only [D]; ring + calc + z.1.2 ^ D = z.1.1 ^ (a * (-c) + c * a) * + z.1.2 ^ (b * (-c) + d * a) := by rw [hx, hy]; simp + _ = (z.1.1 ^ a * z.1.2 ^ b) ^ (-c) * + (z.1.1 ^ c * z.1.2 ^ d) ^ a := hprod.symm + _ = 1 := by rw [h₁, h₂]; simp + haveI : NeZero D.natAbs := ⟨hDpos.ne'⟩ + let e : torusCharacterKernel F a b c d → + rootsOfUnity D.natAbs F × rootsOfUnity D.natAbs F := fun z => + ⟨⟨z.1.1, by + rw [mem_rootsOfUnity] + exact pow_natAbs_eq_one_of_zpow_eq_one z.1.1 D (hfirst z)⟩, + ⟨z.1.2, by + rw [mem_rootsOfUnity] + exact pow_natAbs_eq_one_of_zpow_eq_one z.1.2 D (hsecond z)⟩⟩ + exact Finite.of_injective e (fun z w hzw => by + apply Subtype.ext + apply Prod.ext + · exact congrArg (fun u => u.1.1) hzw + · exact congrArg (fun u => u.2.1) hzw) + +/-- The sharp determinant bound for the common kernel of two characters. -/ +theorem natCard_torusCharacterKernel_le_det + {F : Type*} [Field F] (a b c d : ℤ) + (hdet : a * d - b * c ≠ 0) : + Nat.card (torusCharacterKernel F a b c d) ≤ + (a * d - b * c).natAbs := by + classical + let g : ℕ := Int.gcd a c + have hg : 0 < g := by + rw [Int.gcd_pos_iff] + by_contra h + push Not at h + rcases h with ⟨rfl, rfl⟩ + simp at hdet + obtain ⟨a', ha'⟩ := Int.gcd_dvd_left a c + obtain ⟨c', hc'⟩ := Int.gcd_dvd_right a c + have ha : a = (g : ℤ) * a' := ha' + have hc : c = (g : ℤ) * c' := hc' + let q : ℤ := b * c' - d * a' + have hdetq : a * d - b * c = -(g : ℤ) * q := by + dsimp only [q] + rw [ha, hc] + ring + have hq : q ≠ 0 := by + intro h + apply hdet + rw [hdetq, h, mul_zero] + have hqpos : 0 < q.natAbs := Int.natAbs_pos.mpr hq + let base := rootsOfUnity q.natAbs F + let fiber (η : base) := unitPowerFiber g + (η.1 ^ (-(b * Int.gcdA a c + d * Int.gcdB a c))) + have hηq (z : torusCharacterKernel F a b c d) : + z.1.2 ^ q = 1 := by + rcases z.2 with ⟨h₁, h₂⟩ + have hx : a * c' + c * (-a') = 0 := by + rw [ha, hc] + ring + have hy : b * c' + d * (-a') = q := by + dsimp only [q] + ring + have hprod : + (z.1.1 ^ a * z.1.2 ^ b) ^ c' * + (z.1.1 ^ c * z.1.2 ^ d) ^ (-a') = + z.1.1 ^ (a * c' + c * (-a')) * + z.1.2 ^ (b * c' + d * (-a')) := by + simp only [mul_zpow, zpow_mul, zpow_add] + ac_rfl + calc + z.1.2 ^ q = z.1.1 ^ (a * c' + c * (-a')) * + z.1.2 ^ (b * c' + d * (-a')) := by rw [hx, hy]; simp + _ = (z.1.1 ^ a * z.1.2 ^ b) ^ c' * + (z.1.1 ^ c * z.1.2 ^ d) ^ (-a') := hprod.symm + _ = 1 := by rw [h₁, h₂]; simp + have hηabs (z : torusCharacterKernel F a b c d) : + z.1.2 ^ q.natAbs = 1 := by + rcases (Int.natAbs_eq_iff.mp + (rfl : q.natAbs = q.natAbs)) with hqcast | hqcast + · rw [← zpow_natCast, ← hqcast] + exact hηq z + · have hinv := congrArg Inv.inv (hηq z) + rw [hqcast] at hinv + simpa [← zpow_neg] using hinv + have hfirst (z : torusCharacterKernel F a b c d) : + z.1.1 ^ g = + z.1.2 ^ (-(b * Int.gcdA a c + d * Int.gcdB a c)) := by + rcases z.2 with ⟨h₁, h₂⟩ + have hbez : (g : ℤ) = a * Int.gcdA a c + c * Int.gcdB a c := + Int.gcd_eq_gcd_ab a c + let A := Int.gcdA a c + let B := Int.gcdB a c + let w := b * A + d * B + have hprod : + (z.1.1 ^ a * z.1.2 ^ b) ^ A * + (z.1.1 ^ c * z.1.2 ^ d) ^ B = + z.1.1 ^ (a * A + c * B) * z.1.2 ^ w := by + dsimp only [w] + simp only [mul_zpow, zpow_mul, zpow_add] + ac_rfl + have hone : z.1.1 ^ (g : ℤ) * z.1.2 ^ w = 1 := by + rw [hbez] + rw [← hprod, h₁, h₂] + simp + have hinv : z.1.1 ^ (g : ℤ) = (z.1.2 ^ w)⁻¹ := + (mul_eq_one_iff_eq_inv).mp hone + rw [← zpow_natCast] + simpa [w, A, B, ← zpow_neg] using hinv + let e : torusCharacterKernel F a b c d → Sigma fiber := fun z => + ⟨⟨z.1.2, by + rw [mem_rootsOfUnity] + exact hηabs z⟩, + ⟨z.1.1, hfirst z⟩⟩ + have he : Function.Injective e := by + intro z w hzw + apply Subtype.ext + apply Prod.ext + · exact congrArg (fun s : Sigma fiber => s.2.1) hzw + · exact congrArg (fun s : Sigma fiber => s.1.1) hzw + haveI : NeZero q.natAbs := ⟨hqpos.ne'⟩ + haveI : NeZero g := ⟨hg.ne'⟩ + letI : Fintype base := Fintype.ofFinite base + letI (η : base) : Finite (fiber η) := unitPowerFiber_finite g _ + have hbase : Nat.card base ≤ q.natAbs := card_rootsOfUnity F q.natAbs + have hfiber : ∀ η : base, Nat.card (fiber η) ≤ g := by + intro η + exact natCard_unitPowerFiber_le g hg _ + calc + Nat.card (torusCharacterKernel F a b c d) ≤ Nat.card (Sigma fiber) := + Nat.card_le_card_of_injective e he + _ = ∑ η : base, Nat.card (fiber η) := Nat.card_sigma + _ ≤ ∑ _η : base, g := Finset.sum_le_sum fun _ _ => hfiber _ + _ = Nat.card base * g := by simp + _ ≤ q.natAbs * g := Nat.mul_le_mul_right g hbase + _ = (a * d - b * c).natAbs := by + rw [hdetq, Int.natAbs_mul] + simp [Nat.mul_comm] + +/-- Diagonal scalings on which every support character of `f` has the same +value. These are precisely the possible diagonal stabilizers detected from +the monomial support. -/ +def planeCurveSupportCharacterStabilizer + (F : Type*) [Field F] {K : Type*} [Field K] + (f : MvPolynomial (Fin 2) K) := + {z : Fˣ × Fˣ // ∀ r ∈ f.support, ∀ s ∈ f.support, + z.1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * + z.2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1} + +/-- A nonzero support determinant bounds every diagonal support stabilizer. -/ +theorem natCard_planeCurveSupportCharacterStabilizer_le_supportDet + {F K : Type*} [Field F] [Field K] + {f : MvPolynomial (Fin 2) K} + {r s t : Fin 2 →₀ ℕ} + (hr : r ∈ f.support) (hs : s ∈ f.support) (ht : t ∈ f.support) + (hdet : planeCurveSupportDifferenceDet r s t ≠ 0) : + Nat.card (planeCurveSupportCharacterStabilizer F f) ≤ + (planeCurveSupportDifferenceDet r s t).natAbs := by + let a : ℤ := (s 0 : ℤ) - (r 0 : ℤ) + let b : ℤ := (s 1 : ℤ) - (r 1 : ℤ) + let c : ℤ := (t 0 : ℤ) - (r 0 : ℤ) + let d : ℤ := (t 1 : ℤ) - (r 1 : ℤ) + have hdet' : a * d - b * c ≠ 0 := by + simpa [a, b, c, d, planeCurveSupportDifferenceDet] using hdet + letI : Finite (torusCharacterKernel F a b c d) := + finite_torusCharacterKernel_of_det_ne_zero a b c d hdet' + let e : planeCurveSupportCharacterStabilizer F f → + torusCharacterKernel F a b c d := fun z => + ⟨z.1, z.2 r hr s hs, z.2 r hr t ht⟩ + have he : Function.Injective e := by + intro z w hzw + apply Subtype.ext + exact congrArg (fun u : torusCharacterKernel F a b c d => u.1) hzw + calc + Nat.card (planeCurveSupportCharacterStabilizer F f) ≤ + Nat.card (torusCharacterKernel F a b c d) := + Nat.card_le_card_of_injective e he + _ ≤ (a * d - b * c).natAbs := + natCard_torusCharacterKernel_le_det a b c d hdet' + _ = (planeCurveSupportDifferenceDet r s t).natAbs := by + simp [a, b, c, d, planeCurveSupportDifferenceDet] + +/-- Rank-two support gives the public bidegree bound for every diagonal +support stabilizer. -/ +theorem natCard_planeCurveSupportCharacterStabilizer_le_twice_bidegree + {F K : Type*} [Field F] [Field K] + {f : MvPolynomial (Fin 2) K} + (hrank : PlaneCurveSupportHasRankTwo f) : + Nat.card (planeCurveSupportCharacterStabilizer F f) ≤ + 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by + obtain ⟨r, s, t, hr, hs, ht, hdet⟩ := hrank + exact (natCard_planeCurveSupportCharacterStabilizer_le_supportDet + (F := F) hr hs ht hdet).trans + (natAbs_planeCurveSupportDifferenceDet_le_twice_bidegree hr hs ht) + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean new file mode 100644 index 0000000000..d6ef12dbb4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import Mathlib.RingTheory.Polynomial.Eisenstein.Basic +import Mathlib.Tactic + +/-! +# Exact degree of a transcendental power map + +For a transcendental element `z`, the extension `K(z)/K(z^m)` has exact +degree `m`. The key polynomial is Eisenstein at the rational parameter. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Polynomial +open Polynomial + +private theorem polynomial_X_pow_sub_C_X_irreducible + {K : Type*} [Field K] (m : ℕ) (hm : 0 < m) : + Irreducible + (Polynomial.X ^ m - Polynomial.C (Polynomial.X : Polynomial K) : + Polynomial (Polynomial K)) := by + let R := Polynomial K + let q : Polynomial R := + Polynomial.X ^ m - Polynomial.C (Polynomial.X : R) + let P : Ideal R := Ideal.span {(Polynomial.X : R)} + have hX : Irreducible (Polynomial.X : R) := Polynomial.irreducible_X + have hP : P.IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr hX.prime + have hqMonic : q.Monic := + Polynomial.monic_X_pow_sub_C (Polynomial.X : R) hm.ne' + have hqDegree : q.natDegree = m := by + simpa only [q] using + (Polynomial.natDegree_X_pow_sub_C + (R := R) (n := m) (r := (Polynomial.X : R))) + have hqEisenstein : q.IsEisensteinAt P := by + refine { + leading := ?_ + mem := ?_ + notMem := ?_ } + · rw [hqMonic.leadingCoeff, Ideal.mem_span_singleton] + exact hX.not_dvd_one + · intro i hi + rw [hqDegree] at hi + by_cases hi0 : i = 0 + · subst i + have hq0 : q.coeff 0 = -(Polynomial.X : R) := by + simp [q, Ne.symm hm.ne'] + rw [hq0] + exact P.neg_mem (Ideal.subset_span (Set.mem_singleton _)) + · have him : i ≠ m := ne_of_lt hi + simp only [q, Polynomial.coeff_sub, Polynomial.coeff_X_pow, + Polynomial.coeff_C, if_neg him, if_neg hi0, sub_zero] + exact P.zero_mem + · have hcoeff : q.coeff 0 = -(Polynomial.X : R) := by + simp [q, Ne.symm hm.ne'] + rw [hcoeff, Ideal.span_singleton_pow, + Ideal.mem_span_singleton] + intro hdvd + have hle := Polynomial.natDegree_le_of_dvd hdvd + (neg_ne_zero.mpr Polynomial.X_ne_zero) + rw [Polynomial.natDegree_pow, Polynomial.natDegree_X] at hle + norm_num at hle + exact hqEisenstein.irreducible hP hqMonic.isPrimitive + (by rw [hqDegree]; exact hm) + +/-- A transcendental element has minimal polynomial of degree `m` over the +field generated by its `m`-th power. -/ +theorem minpoly_natDegree_over_adjoin_pow_eq + {K L : Type*} [Field K] [Field L] [Algebra K L] + (z : L) (hz : Transcendental K z) (m : ℕ) (hm : 0 < m) : + (minpoly (IntermediateField.adjoin K {z ^ m}) z).natDegree = m := by + let E0 := IntermediateField.adjoin K {z ^ m} + let c : E0 := + ⟨z ^ m, IntermediateField.subset_adjoin K {z ^ m} + (Set.mem_singleton (z ^ m))⟩ + let q : Polynomial E0 := Polynomial.X ^ m - Polynomial.C c + have hzmTrans : Transcendental K (z ^ m) := hz.pow hm + let e : RatFunc K ≃ₐ[K] E0 := + RatFunc.algEquivOfTranscendental (z ^ m) hzmTrans + have hec : e RatFunc.X = c := by + apply Subtype.ext + simpa only [e, c] using + (RatFunc.algEquivOfTranscendental_X + (f := z ^ m) (h := hzmTrans)) + have hecinv : e.symm c = RatFunc.X := by + rw [← hec, e.symm_apply_apply] + have hqMap : (Polynomial.mapEquiv e.symm.toRingEquiv) q = + (Polynomial.X ^ m - Polynomial.C RatFunc.X : + Polynomial (RatFunc K)) := by + simp [Polynomial.mapEquiv_apply, q, hecinv] + let q0 : Polynomial (Polynomial K) := + Polynomial.X ^ m - Polynomial.C (Polynomial.X : Polynomial K) + have hq0 : Irreducible q0 := by + exact polynomial_X_pow_sub_C_X_irreducible m hm + have hq0Monic : q0.Monic := + Polynomial.monic_X_pow_sub_C (Polynomial.X : Polynomial K) hm.ne' + have hqRat : Irreducible + (q0.map (algebraMap (Polynomial K) (RatFunc K))) := + hq0Monic.isPrimitive.irreducible_iff_irreducible_map_fraction_map.mp hq0 + have hqMapIrred : Irreducible + ((Polynomial.mapEquiv e.symm.toRingEquiv) q) := by + rw [hqMap] + simpa [q0] using hqRat + have hqIrred : Irreducible q := by + apply Irreducible.of_map + (f := Polynomial.mapEquiv e.symm.toRingEquiv) + exact hqMapIrred + have hqMonic : q.Monic := + Polynomial.monic_X_pow_sub_C c hm.ne' + have hqRoot : Polynomial.aeval z q = 0 := by + simp [q, c] + have hminpoly : minpoly E0 z = q := + (minpoly.eq_of_irreducible_of_monic hqIrred hqRoot hqMonic).symm + rw [hminpoly] + simp [q] + +/-- The simple extension generated by a transcendental element over the +field generated by its power has exact degree `m`. -/ +theorem finrank_adjoin_over_adjoin_pow_eq + {K L : Type*} [Field K] [Field L] [Algebra K L] + (z : L) (hz : Transcendental K z) (m : ℕ) (hm : 0 < m) : + Module.finrank (IntermediateField.adjoin K {z ^ m}) + (IntermediateField.adjoin + (IntermediateField.adjoin K {z ^ m}) {z}) = m := by + let E0 := IntermediateField.adjoin K {z ^ m} + let c : E0 := + ⟨z ^ m, IntermediateField.subset_adjoin K {z ^ m} + (Set.mem_singleton (z ^ m))⟩ + let q : Polynomial E0 := Polynomial.X ^ m - Polynomial.C c + have hqMonic : q.Monic := + Polynomial.monic_X_pow_sub_C c hm.ne' + have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] + have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ + rw [IntermediateField.adjoin.finrank hzIntegral, + minpoly_natDegree_over_adjoin_pow_eq z hz m hm] + +/-- Passing from `K(z)` to `K(z^m)` multiplies the degree of any finite top +extension by exactly `m`. -/ +theorem finrank_over_adjoin_pow_eq_mul + {K L : Type*} [Field K] [Field L] [Algebra K L] + (z : L) (hz : Transcendental K z) (m : ℕ) (hm : 0 < m) + [FiniteDimensional (IntermediateField.adjoin K {z}) L] : + Module.finrank (IntermediateField.adjoin K {z ^ m}) L = + m * Module.finrank (IntermediateField.adjoin K {z}) L := by + let E0 := IntermediateField.adjoin K {z ^ m} + let A := IntermediateField.adjoin E0 {z} + let AK : IntermediateField K L := A.restrictScalars K + have hAK : AK = IntermediateField.adjoin K {z} := + restrictScalars_adjoin_over_adjoin_pow_eq_adjoin z m + let c : E0 := + ⟨z ^ m, IntermediateField.subset_adjoin K {z ^ m} + (Set.mem_singleton (z ^ m))⟩ + let q : Polynomial E0 := Polynomial.X ^ m - Polynomial.C c + have hqMonic : q.Monic := + Polynomial.monic_X_pow_sub_C c hm.ne' + have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] + have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ + letI : FiniteDimensional E0 A := + IntermediateField.adjoin.finiteDimensional hzIntegral + letI : FiniteDimensional A L := by + change FiniteDimensional AK L + rw [hAK] + infer_instance + calc + Module.finrank E0 L = Module.finrank E0 A * Module.finrank A L := by + rw [Module.finrank_mul_finrank] + _ = m * Module.finrank A L := by + rw [finrank_adjoin_over_adjoin_pow_eq z hz m hm] + _ = m * Module.finrank (IntermediateField.adjoin K {z}) L := by + congr 1 + change Module.finrank AK L = _ + rw [hAK] + +/-- Exact source degree over the powered first coordinate. -/ +theorem finrank_over_firstPoweredCoordinate_eq + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) = + m * MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let x := planeCurveFunction f 0 + have hx : Transcendental K x := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : FiniteDimensional (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstCoordinate_of_irreducible hf hpartialSecond + rw [finrank_over_adjoin_pow_eq_mul x hx m hm, + finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible + hf hpartialSecond] + +/-- Exact source degree over the powered second coordinate. -/ +theorem finrank_over_secondPoweredCoordinate_eq + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (n : ℕ) (hn : 0 < n) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (SecondPoweredCoordinateSubfield f n) + (PlaneCurveFunctionField f) = + n * MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let y := planeCurveFunction f 1 + have hy : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + letI : FiniteDimensional (SecondCoordinateSubfield f) + (PlaneCurveFunctionField f) := + (finiteSeparable_over_secondCoordinate_of_irreducible + hf hpartialFirst).1 + rw [finrank_over_adjoin_pow_eq_mul y hy n hn, + finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible + hf hpartialFirst] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean new file mode 100644 index 0000000000..c6b1b606a7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +import Mathlib.LinearAlgebra.Matrix.Block + +/-! +# Change of parameter for ordinary Wronskians + +If two derivations on a field satisfy `D = a • E`, then the `i`-th iterate of +`D` is `a^i` times the `i`-th iterate of `E`, up to lower-order iterates of +`E`. Thus the corresponding Wronskian matrices differ by a lower-triangular +matrix whose diagonal is `1, a, a^2, ...`. This file records that argument; +in particular it does not make the false simplification `(a • E)^i = a^i • E^i`. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped Matrix +open Finset + +variable {C L : Type*} [Field C] [Field L] [Algebra C L] + +/-- Coefficients expressing the iterates of `a • E` in terms of the iterates +of `E`. The recurrence is the Leibniz rule written coefficientwise. -/ +private def changeParameterCoeff (E : Derivation C L L) (a : L) : ℕ → ℕ → L + | 0, k => if k = 0 then 1 else 0 + | n + 1, k => + a * (E (changeParameterCoeff E a n k) + + if k = 0 then 0 else changeParameterCoeff E a n (k - 1)) + +private lemma changeParameterCoeff_of_lt (E : Derivation C L L) (a : L) + {n k : ℕ} (h : n < k) : changeParameterCoeff E a n k = 0 := by + induction n generalizing k with + | zero => + simp [changeParameterCoeff, Nat.ne_of_gt h] + | succ n ih => + have hk : k ≠ 0 := by omega + have hnk : n < k := by omega + have hnkp : n < k - 1 := by omega + rw [changeParameterCoeff] + simp [hk, ih hnk, ih hnkp] + +private lemma changeParameterCoeff_diag (E : Derivation C L L) (a : L) (n : ℕ) : + changeParameterCoeff E a n n = a ^ n := by + induction n with + | zero => simp [changeParameterCoeff] + | succ n ih => + rw [changeParameterCoeff] + simp [changeParameterCoeff_of_lt E a (Nat.lt_succ_self n), ih, pow_succ, + mul_comm] + +private lemma derivation_iterate_succ (E : Derivation C L L) (n : ℕ) (x : L) : + E ((E.toLinearMap ^ n) x) = (E.toLinearMap ^ (n + 1)) x := by + rw [pow_succ', Module.End.mul_apply] + rfl + +private lemma changeParameterCoeff_sum_succ (E : Derivation C L L) (a x : L) (n : ℕ) : + ∑ k ∈ range (n + 2), + changeParameterCoeff E a (n + 1) k * (E.toLinearMap ^ k) x = + (∑ k ∈ range (n + 1), + (a * E (changeParameterCoeff E a n k)) * (E.toLinearMap ^ k) x) + + ∑ k ∈ range (n + 1), + (a * changeParameterCoeff E a n k) * (E.toLinearMap ^ (k + 1)) x := by + simp_rw [changeParameterCoeff] + have hsplit (k : ℕ) : + (a * + (E (changeParameterCoeff E a n k) + + if k = 0 then 0 else changeParameterCoeff E a n (k - 1))) * + (E.toLinearMap ^ k) x = + (a * E (changeParameterCoeff E a n k)) * (E.toLinearMap ^ k) x + + (a * (if k = 0 then 0 else changeParameterCoeff E a n (k - 1))) * + (E.toLinearMap ^ k) x := by + ring + simp_rw [hsplit, sum_add_distrib] + congr 1 + · rw [sum_range_succ] + simp [changeParameterCoeff_of_lt E a (Nat.lt_succ_self n)] + · rw [sum_range_succ'] + simp + +private lemma derivation_iterate_eq_changeParameterCoeff_sum + (D E : Derivation C L L) (a : L) (hD : D = a • E) (n : ℕ) (x : L) : + (D.toLinearMap ^ n) x = + ∑ k ∈ range (n + 1), + changeParameterCoeff E a n k * (E.toLinearMap ^ k) x := by + induction n with + | zero => simp [changeParameterCoeff] + | succ n ih => + calc + (D.toLinearMap ^ (n + 1)) x = D ((D.toLinearMap ^ n) x) := by + rw [pow_succ', Module.End.mul_apply] + rfl + _ = D (∑ k ∈ range (n + 1), + changeParameterCoeff E a n k * (E.toLinearMap ^ k) x) := by rw [ih] + _ = a * E (∑ k ∈ range (n + 1), + changeParameterCoeff E a n k * (E.toLinearMap ^ k) x) := by + rw [hD] + rfl + _ = ∑ k ∈ range (n + 1), + ((a * E (changeParameterCoeff E a n k)) * + (E.toLinearMap ^ k) x + + (a * changeParameterCoeff E a n k) * + (E.toLinearMap ^ (k + 1)) x) := by + rw [map_sum, mul_sum] + apply sum_congr rfl + intro k hk + rw [E.leibniz, derivation_iterate_succ] + simp only [smul_eq_mul] + ring + _ = (∑ k ∈ range (n + 1), + (a * E (changeParameterCoeff E a n k)) * + (E.toLinearMap ^ k) x) + + ∑ k ∈ range (n + 1), + (a * changeParameterCoeff E a n k) * + (E.toLinearMap ^ (k + 1)) x := by + rw [sum_add_distrib] + _ = ∑ k ∈ range (n + 2), + changeParameterCoeff E a (n + 1) k * + (E.toLinearMap ^ k) x := + (changeParameterCoeff_sum_succ E a x n).symm + +/-- The lower-triangular matrix relating the two lists of iterated +derivations. -/ +private def changeParameterMatrix (E : Derivation C L L) (a : L) (n : ℕ) : + Matrix (Fin n) (Fin n) L := + fun i k => changeParameterCoeff E a i k + +private lemma derivation_iterate_eq_changeParameterMatrix_sum + (D E : Derivation C L L) (a : L) (hD : D = a • E) {n : ℕ} + (i : Fin n) (x : L) : + (D.toLinearMap ^ (i : ℕ)) x = + ∑ k : Fin n, changeParameterMatrix E a n i k * + (E.toLinearMap ^ (k : ℕ)) x := by + let g : ℕ → L := fun k => + changeParameterCoeff E a (i : ℕ) k * (E.toLinearMap ^ k) x + have hsubset : range ((i : ℕ) + 1) ⊆ range n := + range_subset_range.mpr (Nat.succ_le_iff.mpr i.isLt) + have hsum : ∑ k ∈ range ((i : ℕ) + 1), g k = ∑ k ∈ range n, g k := by + apply sum_subset hsubset + intro k hkn hki + have hik : (i : ℕ) < k := by + rw [mem_range] at hkn + rw [mem_range] at hki + omega + simp [g, changeParameterCoeff_of_lt E a hik] + calc + (D.toLinearMap ^ (i : ℕ)) x = ∑ k ∈ range ((i : ℕ) + 1), g k := + derivation_iterate_eq_changeParameterCoeff_sum D E a hD i x + _ = ∑ k ∈ range n, g k := hsum + _ = ∑ k : Fin n, changeParameterMatrix E a n i k * + (E.toLinearMap ^ (k : ℕ)) x := by + simpa [g, changeParameterMatrix] using + (Fin.sum_univ_eq_sum_range g n).symm + +private lemma changeParameterMatrix_lowerTriangular + (E : Derivation C L L) (a : L) (n : ℕ) : + (changeParameterMatrix E a n).BlockTriangular OrderDual.toDual := by + intro i k hik + apply changeParameterCoeff_of_lt E a + exact OrderDual.toDual_lt_toDual.mp hik + +private lemma changeParameterMatrix_det + (E : Derivation C L L) (a : L) (n : ℕ) : + (changeParameterMatrix E a n).det = a ^ n.choose 2 := by + rw [Matrix.det_of_lowerTriangular _ (changeParameterMatrix_lowerTriangular E a n)] + simp only [changeParameterMatrix, changeParameterCoeff_diag] + calc + ∏ i : Fin n, a ^ (i : ℕ) = a ^ ∑ i : Fin n, (i : ℕ) := by + simpa using (prod_pow_eq_pow_sum univ (fun i : Fin n => (i : ℕ)) a) + _ = a ^ n.choose 2 := by + congr 1 + rw [show (∑ i : Fin n, (i : ℕ)) = ∑ i ∈ range n, i from + Fin.sum_univ_eq_sum_range (fun i => i) n] + rw [sum_range_id, Nat.choose_two_right] + +private lemma derivationWronskian_eq_changeParameterMatrix_mul + (D E : Derivation C L L) (a : L) (hD : D = a • E) + {n : ℕ} (f : Fin n → L) : + BGS.Algebra.derivationWronskian D f = + changeParameterMatrix E a n * BGS.Algebra.derivationWronskian E f := by + ext i j + rw [Matrix.mul_apply] + simpa [BGS.Algebra.derivationWronskian] using + derivation_iterate_eq_changeParameterMatrix_sum D E a hD i (f j) + +/-- Change-of-parameter formula for an ordinary Wronskian. + +The triangular exponent is `n.choose 2 = 0 + 1 + ... + (n - 1)`. The proof +keeps all lower-order terms arising from differentiating `a`; they form the +strictly lower-triangular part of `changeParameterMatrix` and hence do not +affect its determinant. -/ +theorem derivationWronskian_det_changeParameter + (D E : Derivation C L L) (a : L) (hD : D = a • E) + {n : ℕ} (f : Fin n → L) : + (BGS.Algebra.derivationWronskian D f).det = + a ^ n.choose 2 * (BGS.Algebra.derivationWronskian E f).det := by + rw [derivationWronskian_eq_changeParameterMatrix_mul D E a hD f, + Matrix.det_mul, changeParameterMatrix_det] + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean b/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean new file mode 100644 index 0000000000..c3106efd59 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean @@ -0,0 +1,49 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Data.Set.Finite.Basic +import Mathlib.Logic.Function.Iterate + +/-! +# Finite forward orbits of injective maps + +An injective self-map cannot have a finite forward orbit with a nonperiodic initial point. The +injectivity hypothesis is what lets us cancel the transient part of a repeated pair of iterates. +-/ + +namespace BGS + +universe u + +variable {X : Type u} {f : X → X} {x : X} + +/-- If the forward orbit of `x` under an injective self-map is finite, then a positive iterate +returns to `x`. -/ +theorem exists_positive_iterate_eq_self_of_finite_forwardOrbit + (hf : Function.Injective f) + (horbit : (Set.range fun n : ℕ ↦ (f^[n]) x).Finite) : + ∃ n : ℕ, 0 < n ∧ (f^[n]) x = x := by + let orbitMap : ℕ → X := fun n ↦ (f^[n]) x + obtain ⟨m, -, n, -, hmn, hcollision⟩ := + Set.infinite_univ.exists_ne_map_eq_of_mapsTo + (f := orbitMap) (t := Set.range orbitMap) + (fun k _ ↦ ⟨k, rfl⟩) horbit + rcases lt_or_gt_of_ne hmn with hmn | hnm + · refine ⟨n - m, Nat.sub_pos_of_lt hmn, ?_⟩ + exact Function.iterate_cancel hf hcollision.symm + · refine ⟨m - n, Nat.sub_pos_of_lt hnm, ?_⟩ + exact Function.iterate_cancel hf hcollision + +/-- A finite set containing every forward iterate forces a positive return for an injective +self-map. This form is convenient when an orbit has already been bounded by a concrete finite +set. -/ +theorem exists_positive_iterate_eq_self_of_forwardOrbit_subset + (hf : Function.Injective f) {s : Set X} (hs : s.Finite) + (horbit : Set.range (fun n : ℕ ↦ (f^[n]) x) ⊆ s) : + ∃ n : ℕ, 0 < n ∧ (f^[n]) x = x := + exists_positive_iterate_eq_self_of_finite_forwardOrbit hf (hs.subset horbit) + +end BGS diff --git a/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean b/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean new file mode 100644 index 0000000000..4bac71feef --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean @@ -0,0 +1,33 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Logic.Relation +import Mathlib.Data.Nat.Order.Lemmas +import Mathlib.Tactic + +namespace BGS + +universe u + + +/-- If every state below a target measure admits a relation step that strictly raises the +measure, then finitely many such steps reach the target. -/ +theorem exists_reflTransGen_measure_ge + {X : Type u} (r : X → X → Prop) (measure : X → ℕ) (target : ℕ) + (step : ∀ x, measure x < target → ∃ y, r x y ∧ measure x < measure y) + (x : X) : + ∃ y, Relation.ReflTransGen r x y ∧ target ≤ measure y := by + by_cases hx : target ≤ measure x + · exact ⟨x, Relation.ReflTransGen.refl, hx⟩ + · have hxlt : measure x < target := Nat.lt_of_not_ge hx + obtain ⟨y, hxy, hmeasure⟩ := step x hxlt + obtain ⟨z, hyz, hz⟩ := + exists_reflTransGen_measure_ge r measure target step y + exact ⟨z, Relation.ReflTransGen.head hxy hyz, hz⟩ +termination_by target - measure x +decreasing_by omega + +end BGS diff --git a/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean b/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean new file mode 100644 index 0000000000..099518ec8a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +import Mathlib.FieldTheory.IsAlgClosed.Basic +import Mathlib.RingTheory.MvPolynomial.Basic + +/-! +# General curve-theorem interfaces + +These propositions are deliberately independent of the Markoff surface and +of every split, nonsplit, or cage family. Downstream code must construct the +relevant plane curve, prove its geometric hypotheses and bidegree bounds, and +then apply one of these two general statements. Both interfaces now have +in-repository inhabitants; keeping the propositions separate makes their +Markoff-specific applications explicit. +-/ + +namespace BGS.External + +noncomputable section + +/-- A bivariate polynomial has coordinate degrees bounded by `firstDegree` +and `secondDegree`. -/ +def HasBidegreeAtMost {K : Type*} [CommSemiring K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ) : Prop := + ∀ monomial : Fin 2 →₀ ℕ, monomial ∈ f.support → + monomial 0 ≤ firstDegree ∧ monomial 1 ≤ secondDegree + +/-- Affine rational zeros of a bivariate polynomial. -/ +noncomputable def affinePlaneCurveZeros + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) : Finset (K × K) := by + classical + exact Finset.univ.filter fun z => + MvPolynomial.eval ![z.1, z.2] f = 0 + +@[simp] +theorem mem_affinePlaneCurveZeros_iff + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {z : K × K} : + z ∈ affinePlaneCurveZeros K f ↔ + MvPolynomial.eval ![z.1, z.2] f = 0 := by + classical + simp [affinePlaneCurveZeros] + +/-- A general affine plane-curve Hasse--Weil estimate with its coefficient +fixed in the type. Keeping this layer separate from the existential wrapper +makes numerical specializations auditable. -/ +def BivariateAffineHasseWeilBound (coefficient : ℕ) : Prop := + ∀ (K : Type) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ), + 0 < firstDegree → + 0 < secondDegree → + HasBidegreeAtMost (K := K) f firstDegree secondDegree → + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f) → + |((affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) + +/-- The general affine plane-curve Hasse--Weil interface used by the Markoff +applications. + +This is the standard bidegree corollary of Hasse--Weil: normalization and the +boundary of a geometrically irreducible curve of positive bidegree contribute +only a universal multiple of `firstDegree * secondDegree`. -/ +def GeneralBivariateAffineHasseWeilTheorem : Prop := + ∃ coefficient : ℕ, 0 < coefficient ∧ + BivariateAffineHasseWeilBound coefficient + +/-- Torsion points of a general bivariate torus curve. -/ +noncomputable def torusCurveTorsionIntersection + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstOrder secondOrder : ℕ) : + Finset (Kˣ × Kˣ) := by + classical + exact Finset.univ.filter fun z => + MvPolynomial.eval ![(z.1 : K), (z.2 : K)] f = 0 ∧ + z.1 ^ firstOrder = 1 ∧ z.2 ^ secondOrder = 1 + +@[simp] +theorem mem_torusCurveTorsionIntersection_iff + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstOrder secondOrder : ℕ} + {z : Kˣ × Kˣ} : + z ∈ torusCurveTorsionIntersection K f firstOrder secondOrder ↔ + MvPolynomial.eval ![(z.1 : K), (z.2 : K)] f = 0 ∧ + z.1 ^ firstOrder = 1 ∧ z.2 ^ secondOrder = 1 := by + classical + simp [torusCurveTorsionIntersection] + +/-- No nontrivial character is constant on the geometric torus curve. -/ +def TorusCurveNotSubtorusTranslate + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) : Prop := + ∀ (a b : ℤ), (a ≠ 0 ∨ b ≠ 0) → + ∀ c : (AlgebraicClosure K)ˣ, + ∃ x y : (AlgebraicClosure K)ˣ, + MvPolynomial.eval ![(x : AlgebraicClosure K), + (y : AlgebraicClosure K)] + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f) = 0 ∧ + x ^ a * y ^ b ≠ c + +/-- A general plane torus curve satisfies the geometric hypotheses of the +Corvaja--Zannier theorem. Nonzero partial derivatives express that both +coordinate functions are separating; prime-to-characteristic torsion orders +then retain nonzero differentials. -/ +def IsCorvajaZannierPlaneCurve + {K : Type*} [Field K] (f : MvPolynomial (Fin 2) K) : Prop := + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f) ∧ + TorusCurveNotSubtorusTranslate f ∧ + MvPolynomial.pderiv 0 f ≠ 0 ∧ MvPolynomial.pderiv 1 f ≠ 0 + +/-- A general bidegree-only upper bound for the Euler characteristic of the +normalization of a torus plane curve. For bidegree `(d₁,d₂)`, genus is at +most `(d₁-1)(d₂-1)` and the toric boundary has at most `2d₁+2d₂` points. -/ +def planeTorusEulerCharacteristicBound + (firstDegree secondDegree : ℕ) : ℝ := + 2 * firstDegree * secondDegree + +/-- The Corvaja--Zannier plane-curve interface, stated for every admissible +bivariate torus curve rather than for the weighted Markoff trace family. The +in-repository proof is `BGS.CorvajaZannier.generalCorvajaZannierPlaneCurveTheorem`; +the source proof and its formal dependency path are tracked in the dedicated +Blueprint chapter. -/ +def GeneralCorvajaZannierPlaneCurveTheorem : Prop := + ∀ (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] + (f : MvPolynomial (Fin 2) K) + (firstDegree secondDegree firstOrder secondOrder : ℕ), + 0 < firstDegree → + 0 < secondDegree → + HasBidegreeAtMost (K := K) f firstDegree secondDegree → + IsCorvajaZannierPlaneCurve f → + 0 < firstOrder → + 0 < secondOrder → + ¬ p ∣ firstOrder → + ¬ p ∣ secondOrder → + ((torusCurveTorsionIntersection + K f firstOrder secondOrder).card : ℝ) ≤ + BGS.Markoff.corvajaZannierCorollaryTwoNumericalBound + p firstOrder secondOrder firstDegree secondDegree + (planeTorusEulerCharacteristicBound firstDegree secondDegree) + +end + +end BGS.External diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean b/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean new file mode 100644 index 0000000000..957fb55fbf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic +import Mathlib.AlgebraicGeometry.EllipticCurve.Affine.Point +import Mathlib.SetTheory.Cardinal.NatCard + +/-! +# The explicit elliptic character sum needed by the incidence argument + +This file reduces the needed Legendre character-sum estimate to a narrow +point-cardinality target. The target is an explicit proposition parameter, +not a `sorry` or axiom; the selected Theorem 1 route does not use it. +-/ + +namespace BGS.FiniteField + +open Finset + +variable {F : Type*} [Field F] [Fintype F] [DecidableEq F] + +/-- The quadratic-character trace sum of `Y² = X (X - u) (X - v)`. -/ +def ellipticCubicCharacterSum (u v : F) : ℤ := + ∑ x : F, quadraticChar F (x * (x - u) * (x - v)) + +/-- The Weierstrass model `Y² = X (X - u) (X - v)`. -/ +def legendreWeierstrassCurve (u v : F) : WeierstrassCurve F := + ⟨0, -(u + v), 0, u * v, 0⟩ + +omit [Fintype F] [DecidableEq F] in +lemma legendreWeierstrassCurve_equation_iff (u v x y : F) : + (legendreWeierstrassCurve u v).toAffine.Equation x y ↔ + y ^ 2 = x * (x - u) * (x - v) := by + rw [WeierstrassCurve.Affine.equation_iff] + simp only [legendreWeierstrassCurve, zero_mul, neg_mul, add_mul] + constructor <;> intro h + · linear_combination h + · linear_combination h + +omit [Fintype F] [DecidableEq F] in +lemma legendreWeierstrassCurve_discriminant (u v : F) : + (legendreWeierstrassCurve u v).Δ = 16 * u ^ 2 * v ^ 2 * (u - v) ^ 2 := by + simp only [legendreWeierstrassCurve, WeierstrassCurve.Δ, WeierstrassCurve.b₂, + WeierstrassCurve.b₄, WeierstrassCurve.b₆, WeierstrassCurve.b₈] + ring + +omit [Fintype F] [DecidableEq F] in +lemma legendreWeierstrassCurve_discriminant_ne_zero {u v : F} + (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) (hF : ringChar F ≠ 2) : + (legendreWeierstrassCurve u v).Δ ≠ 0 := by + rw [legendreWeierstrassCurve_discriminant] + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + have hsixteen : (16 : F) ≠ 0 := by + rw [show (16 : F) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 htwo + exact mul_ne_zero (mul_ne_zero (mul_ne_zero hsixteen (pow_ne_zero 2 hu)) + (pow_ne_zero 2 hv)) (pow_ne_zero 2 (sub_ne_zero.mpr huv)) + +/-- Affine solutions, rearranged into fibers of the `X`-coordinate. -/ +def affineCubicSolutionEquivSigma (u v : F) : + {xy : F × F // xy.2 ^ 2 = xy.1 * (xy.1 - u) * (xy.1 - v)} ≃ + Σ x : F, {y : F // y ^ 2 = x * (x - u) * (x - v)} where + toFun xy := ⟨xy.1.1, xy.1.2, xy.2⟩ + invFun xy := ⟨(xy.1, xy.2.1), xy.2.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- The affine Weierstrass equation is exactly the displayed cubic equation. -/ +def legendreAffineEquationEquiv (u v : F) : + {xy : F × F // (legendreWeierstrassCurve u v).toAffine.Equation xy.1 xy.2} ≃ + {xy : F × F // xy.2 ^ 2 = xy.1 * (xy.1 - u) * (xy.1 - v)} where + toFun xy := ⟨xy.1, (legendreWeierstrassCurve_equation_iff u v xy.1.1 xy.1.2).mp xy.2⟩ + invFun xy := ⟨xy.1, (legendreWeierstrassCurve_equation_iff u v xy.1.1 xy.1.2).mpr xy.2⟩ + left_inv _ := rfl + right_inv _ := rfl + +lemma affineCubicSolution_card_eq_card_add_characterSum + (hF : ringChar F ≠ 2) (u v : F) : + (Fintype.card {xy : F × F // xy.2 ^ 2 = xy.1 * (xy.1 - u) * (xy.1 - v)} : ℤ) = + Fintype.card F + ellipticCubicCharacterSum u v := by + rw [Fintype.card_congr (affineCubicSolutionEquivSigma u v), Fintype.card_sigma] + push_cast + calc + ∑ x : F, (Fintype.card {y : F // y ^ 2 = x * (x - u) * (x - v)} : ℤ) = + ∑ x : F, (quadraticChar F (x * (x - u) * (x - v)) + 1) := by + apply sum_congr rfl + intro x _ + calc + (Fintype.card {y : F // y ^ 2 = x * (x - u) * (x - v)} : ℤ) = + ((({y : F | y ^ 2 = x * (x - u) * (x - v)} : Set F).toFinset.card : ℕ) : ℤ) := by + rw [Set.toFinset_card] + exact_mod_cast Fintype.card_congr + (Equiv.refl {y : F // y ^ 2 = x * (x - u) * (x - v)}) + _ = quadraticChar F (x * (x - u) * (x - v)) + 1 := + quadraticChar_card_sqrts hF (x * (x - u) * (x - v)) + _ = Fintype.card F + ellipticCubicCharacterSum u v := by + simp [ellipticCubicCharacterSum, sum_add_distrib, add_comm] + +omit [Fintype F] [DecidableEq F] in +/-- The nonsingularity hypotheses give an honest elliptic-curve instance for the Legendre model. -/ +theorem legendreWeierstrassCurveIsElliptic {u v : F} + (hF : ringChar F ≠ 2) (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + (legendreWeierstrassCurve u v).IsElliptic := + ⟨isUnit_iff_ne_zero.mpr (legendreWeierstrassCurve_discriminant_ne_zero hu hv huv hF)⟩ + +/-- The exact rational-point identity behind the cubic character sum. -/ +theorem legendreWeierstrassCurve_point_card_eq_card_add_one_add_characterSum + (hF : ringChar F ≠ 2) {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + (Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) = + Fintype.card F + 1 + ellipticCubicCharacterSum u v := by + let W := legendreWeierstrassCurve u v + letI : W.IsElliptic := legendreWeierstrassCurveIsElliptic hF hu hv huv + calc + (Nat.card W.toAffine.Point : ℤ) = + Nat.card (WithZero {xy : F × F // W.toAffine.Equation xy.1 xy.2}) := by + exact_mod_cast Nat.card_congr W.toAffine.pointEquiv + _ = Nat.card {xy : F × F // W.toAffine.Equation xy.1 xy.2} + 1 := by + change (Nat.card (Option {xy : F × F // W.toAffine.Equation xy.1 xy.2}) : ℤ) = _ + rw [Finite.card_option] + norm_num + _ = Nat.card {xy : F × F // xy.2 ^ 2 = xy.1 * (xy.1 - u) * (xy.1 - v)} + 1 := by + exact_mod_cast congrArg (fun n : ℕ => n + 1) + (Nat.card_congr (legendreAffineEquationEquiv u v)) + _ = Fintype.card {xy : F × F // xy.2 ^ 2 = xy.1 * (xy.1 - u) * (xy.1 - v)} + 1 := by + rw [Nat.card_eq_fintype_card] + _ = Fintype.card F + ellipticCubicCharacterSum u v + 1 := by + rw [affineCubicSolution_card_eq_card_add_characterSum hF u v] + _ = Fintype.card F + 1 + ellipticCubicCharacterSum u v := by ring + +/-- The cubic sum is the negative of the usual Frobenius trace `q + 1 - #E(F)`. -/ +theorem ellipticCubicCharacterSum_eq_point_card_sub_card_sub_one + (hF : ringChar F ≠ 2) {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + ellipticCubicCharacterSum u v = + (Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) - Fintype.card F - 1 := by + have hcount := legendreWeierstrassCurve_point_card_eq_card_add_one_add_characterSum + hF hu hv huv + linarith + +/-- The desired character-sum estimate is exactly the Hasse rational-point bound for this model. -/ +theorem ellipticCubicCharacterSum_sq_le_four_mul_card_iff_point_card_hasse + (hF : ringChar F ≠ 2) {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + ellipticCubicCharacterSum u v ^ 2 ≤ 4 * (Fintype.card F : ℤ) ↔ + ((Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) - + Fintype.card F - 1) ^ 2 ≤ 4 * (Fintype.card F : ℤ) := by + rw [ellipticCubicCharacterSum_eq_point_card_sub_card_sub_one hF hu hv huv] + +/-- The exact Legendre-family Hasse target. It is retained only as an +explicit premise for the optional incidence-diameter route. -/ +def LegendrePointCardHasseBound (F : Type*) + [Field F] [Fintype F] [DecidableEq F] : Prop := + ∀ {u v : F}, u ≠ 0 → v ≠ 0 → u ≠ v → + ((Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) - + Fintype.card F - 1) ^ 2 ≤ 4 * (Fintype.card F : ℤ) + +/-- +The exact Hasse character-sum input needed in Proposition 6. Unlike the point-cardinality bound +above, this is now a proved reduction rather than a second gap. +-/ +theorem ellipticCubicCharacterSum_sq_le_four_mul_card + (hHasse : LegendrePointCardHasseBound F) + (hF : ringChar F ≠ 2) {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + ellipticCubicCharacterSum u v ^ 2 ≤ 4 * (Fintype.card F : ℤ) := by + exact (ellipticCubicCharacterSum_sq_le_four_mul_card_iff_point_card_hasse + hF hu hv huv).2 (hHasse hu hv huv) + +/-- For fields of cardinality at least `26`, Hasse's square bound is strong enough to leave more +than twelve points after the three forbidden fibers are removed. -/ +theorem fifteen_sub_card_lt_ellipticCubicCharacterSum + (hHasse : LegendrePointCardHasseBound F) + (hF : ringChar F ≠ 2) (hcard : 26 ≤ Fintype.card F) + {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + (15 : ℤ) - Fintype.card F < ellipticCubicCharacterSum u v := by + let q : ℤ := Fintype.card F + let trace : ℤ := ellipticCubicCharacterSum u v + have hq : (26 : ℤ) ≤ q := by + dsimp [q] + exact_mod_cast hcard + have hHasse : trace ^ 2 ≤ 4 * q := by + simpa [q, trace] using + ellipticCubicCharacterSum_sq_le_four_mul_card hHasse hF hu hv huv + by_contra hbound + have htrace : trace ≤ 15 - q := by omega + have hleftNonnegative : 0 ≤ -trace - (q - 15) := by omega + have hrightNonnegative : 0 ≤ -trace + (q - 15) := by omega + have hsquareLower : (q - 15) ^ 2 ≤ trace ^ 2 := by + nlinarith [mul_nonneg hleftNonnegative hrightNonnegative] + have hfactorPositive : 0 < (q - 9) * (q - 25) := + mul_pos (by omega) (by omega) + nlinarith + +end BGS.FiniteField diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean b/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean new file mode 100644 index 0000000000..9b9b4dced8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean @@ -0,0 +1,343 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +import Mathlib.FieldTheory.Finite.Basic + +/-! +# Frobenius setup for the explicit Hasse bound + +This work file develops the Frobenius--norm route to Hasse's bound for the explicit curve +`Y² = X (X - u) (X - v)`. It contains no replacement assumption for Hasse's theorem: the aim is +to isolate, in Mathlib's actual elliptic-point API, the first geometric degree calculation that is +still missing. +-/ + +noncomputable section + +namespace BGS.FiniteField + +open Polynomial + +variable {F : Type*} [Field F] + +local instance algebraicClosureDecidableEq : + DecidableEq (AlgebraicClosure F) := Classical.decEq _ + +/-- The Legendre affine model after base change to an extension field. -/ +abbrev legendreAffineOver (u v : F) (K : Type*) [Field K] [Algebra F K] : + WeierstrassCurve.Affine K := + WeierstrassCurve.Affine.baseChange (legendreWeierstrassCurve u v).toAffine + K + +/-- Coordinatewise transport of a Legendre point along a field-extension homomorphism. + +Mathlib's bundled point map requires elliptic-curve group instances. This underlying map does not: +nonsingular points transport along every injective field homomorphism, including before we have +installed the nonsingularity hypotheses on the Legendre model. -/ +def mapLegendrePointCoordinates {K L : Type*} [Field K] [Field L] + [Algebra F K] [Algebra F L] (u v : F) (f : K →ₐ[F] L) : + (legendreAffineOver u v K).Point → (legendreAffineOver u v L).Point + | .zero => .zero + | .some x y h => .some (f x) (f y) + (((legendreWeierstrassCurve u v).toAffine.baseChange_nonsingular f.injective x y).mpr h) + +/-- The Legendre affine model over a fixed algebraic closure. -/ +abbrev legendreAffineOverClosure (u v : F) : WeierstrassCurve.Affine (AlgebraicClosure F) := + legendreAffineOver u v (AlgebraicClosure F) + +/-- Base change of an `F`-rational Legendre point to the algebraic closure. -/ +def legendrePointBaseChange (u v : F) : + (legendreWeierstrassCurve u v).toAffine.Point → + (legendreAffineOverClosure u v).Point + | .zero => .zero + | .some x y h => .some (algebraMap F (AlgebraicClosure F) x) + (algebraMap F (AlgebraicClosure F) y) + (((legendreWeierstrassCurve u v).toAffine.baseChange_nonsingular + (Algebra.ofId F (AlgebraicClosure F)).injective x y).mpr h) + +/-- Base change into the algebraic closure is injective on Legendre points. -/ +theorem legendrePointBaseChange_injective (u v : F) : + Function.Injective (legendrePointBaseChange u v) := by + rintro (_ | _) (_ | _) h + any_goals contradiction + · rfl + · simpa only [WeierstrassCurve.Affine.Point.some.injEq] using + And.intro + ((algebraMap F (AlgebraicClosure F)).injective + (WeierstrassCurve.Affine.Point.some.inj h).1) + ((algebraMap F (AlgebraicClosure F)).injective + (WeierstrassCurve.Affine.Point.some.inj h).2) + +section FiniteBaseField + +variable [Fintype F] + +/-- The `#F`-power Frobenius acting on points of the Legendre curve over an algebraic closure. -/ +def legendrePointFrobenius (u v : F) : + (legendreAffineOverClosure u v).Point → + (legendreAffineOverClosure u v).Point := + mapLegendrePointCoordinates u v (FiniteField.frobeniusAlgHom F (AlgebraicClosure F)) + +/-- The endomorphism `Frob - 1`; its kernel is the group of `F`-rational points. -/ +def legendreFrobeniusMinusIdentity (u v : F) : + (legendreAffineOverClosure u v).Point → + (legendreAffineOverClosure u v).Point := by + classical + exact fun P ↦ (legendrePointFrobenius u v P).add (-P) + +@[simp] +theorem legendrePointFrobenius_zero (u v : F) : + legendrePointFrobenius u v 0 = 0 := rfl + +/-- An algebraic-closure element fixed by the `#F`-power Frobenius comes from `F`. + +This is the coordinate descent input for identifying the kernel of `Frob - 1`: it is proved from +the complete root multiset of `X ^ #F - X`, rather than assumed as a fixed-field theorem. -/ +theorem exists_eq_algebraMap_of_frobenius_eq (z : AlgebraicClosure F) + (hz : FiniteField.frobeniusAlgHom F (AlgebraicClosure F) z = z) : + ∃ x : F, algebraMap F (AlgebraicClosure F) x = z := by + let P : F[X] := X ^ Fintype.card F - X + have hP0 : P ≠ 0 := by + exact FiniteField.X_pow_card_sub_X_ne_zero F Fintype.one_lt_card + have hsplit : P.Splits := by + rw [Polynomial.splits_iff_card_roots] + dsimp [P] + rw [FiniteField.roots_X_pow_card_sub_X, ← Finset.card_def, Finset.card_univ, + FiniteField.X_pow_card_sub_X_natDegree_eq F Fintype.one_lt_card] + have hzroot : (P.map (algebraMap F (AlgebraicClosure F))).IsRoot z := by + rw [Polynomial.IsRoot.def] + rw [Polynomial.eval_map] + dsimp [P] + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X] + exact sub_eq_zero.mpr hz + exact hsplit.mem_range_of_isRoot hP0 hzroot + +@[simp] +theorem legendrePointFrobenius_baseChange (u v : F) + (P : (legendreWeierstrassCurve u v).toAffine.Point) : + legendrePointFrobenius u v (legendrePointBaseChange u v P) = + legendrePointBaseChange u v P := by + cases P with + | zero => rfl + | some x y h => + simp only [legendrePointFrobenius, legendrePointBaseChange, + mapLegendrePointCoordinates, WeierstrassCurve.Affine.Point.some.injEq] + exact ⟨(FiniteField.frobeniusAlgHom F (AlgebraicClosure F)).commutes x, + (FiniteField.frobeniusAlgHom F (AlgebraicClosure F)).commutes y⟩ + +/-- Every Frobenius-fixed algebraic-closure point descends to an `F`-rational point. -/ +theorem exists_baseChange_eq_of_legendrePointFrobenius_eq (u v : F) + (P : (legendreAffineOverClosure u v).Point) + (hP : legendrePointFrobenius u v P = P) : + ∃ P₀ : (legendreWeierstrassCurve u v).toAffine.Point, + legendrePointBaseChange u v P₀ = P := by + cases P with + | zero => exact ⟨.zero, rfl⟩ + | some x y h => + have hxy : + FiniteField.frobeniusAlgHom F (AlgebraicClosure F) x = x ∧ + FiniteField.frobeniusAlgHom F (AlgebraicClosure F) y = y := by + simpa only [legendrePointFrobenius, mapLegendrePointCoordinates, + WeierstrassCurve.Affine.Point.some.injEq] using hP + obtain ⟨x₀, hx₀⟩ := exists_eq_algebraMap_of_frobenius_eq x hxy.1 + obtain ⟨y₀, hy₀⟩ := exists_eq_algebraMap_of_frobenius_eq y hxy.2 + have hmapped : + (legendreAffineOverClosure u v).Nonsingular + (algebraMap F (AlgebraicClosure F) x₀) + (algebraMap F (AlgebraicClosure F) y₀) := by + simpa only [hx₀, hy₀] using h + have hbase : (legendreWeierstrassCurve u v).toAffine.Nonsingular x₀ y₀ := + ((legendreWeierstrassCurve u v).toAffine.baseChange_nonsingular + (Algebra.ofId F (AlgebraicClosure F)).injective x₀ y₀).mp hmapped + refine ⟨.some x₀ y₀ hbase, ?_⟩ + simpa only [legendrePointBaseChange, WeierstrassCurve.Affine.Point.some.injEq] + using And.intro hx₀ hy₀ + +/-- `F`-rational Legendre points are exactly the Frobenius-fixed algebraic-closure points. -/ +def legendreRationalPointEquivFrobeniusFixed (u v : F) : + (legendreWeierstrassCurve u v).toAffine.Point ≃ + {P : (legendreAffineOverClosure u v).Point // legendrePointFrobenius u v P = P} := + Equiv.ofBijective + (fun P ↦ ⟨legendrePointBaseChange u v P, legendrePointFrobenius_baseChange u v P⟩) + ⟨fun P Q h ↦ legendrePointBaseChange_injective u v (congrArg Subtype.val h), + fun P ↦ by + obtain ⟨P₀, hP₀⟩ := + exists_baseChange_eq_of_legendrePointFrobenius_eq u v P.1 P.2 + exact ⟨P₀, Subtype.ext hP₀⟩⟩ + +/-- Point cardinality is the cardinality of the Frobenius fixed-point subtype. -/ +theorem legendre_point_card_eq_frobeniusFixed_card (u v : F) : + Nat.card (legendreWeierstrassCurve u v).toAffine.Point = + Nat.card {P : (legendreAffineOverClosure u v).Point // + legendrePointFrobenius u v P = P} := + Nat.card_congr (legendreRationalPointEquivFrobeniusFixed u v) + +section FrobeniusEndomorphism + +variable {u v : F} [(legendreWeierstrassCurve u v).IsElliptic] + +/-- The coordinate Frobenius as an endomorphism of the algebraic-closure point group. -/ +def legendrePointFrobeniusHom (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] : + (legendreAffineOverClosure u v).Point →+ + (legendreAffineOverClosure u v).Point := + WeierstrassCurve.Affine.Point.map + (W' := (legendreWeierstrassCurve u v).toAffine) + (FiniteField.frobeniusAlgHom F (AlgebraicClosure F)) + +@[simp] +theorem legendrePointFrobeniusHom_apply (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] + (P : (legendreAffineOverClosure u v).Point) : + legendrePointFrobeniusHom u v P = legendrePointFrobenius u v P := by + cases P <;> rfl + +/-- The group endomorphism `Frob - 1`. -/ +def legendreFrobeniusMinusIdentityHom (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] : + (legendreAffineOverClosure u v).Point →+ + (legendreAffineOverClosure u v).Point := + legendrePointFrobeniusHom u v - AddMonoidHom.id _ + +/-- The usual Frobenius trace `q + 1 - #E(F)`. This is the negative of the cubic character sum +used elsewhere in the incidence count. -/ +def legendreFrobeniusTrace (u v : F) : ℤ := + (Fintype.card F : ℤ) + 1 - Nat.card (legendreWeierstrassCurve u v).toAffine.Point + +/-- The single endomorphism used by the integral discriminant proof of Hasse's inequality: +`[t] - [2]Frob`, where `t = q + 1 - #E(F)` is the usual Frobenius trace. + +The remaining geometric wall is to construct an isogeny-degree theory strong enough to compute +the degree of this endomorphism as `frobeniusNormForm q t t 2 = 4q - t²`. -/ +def legendreHasseWitnessEndomorphism (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] : + (legendreAffineOverClosure u v).Point →+ + (legendreAffineOverClosure u v).Point := + legendreFrobeniusTrace u v • AddMonoidHom.id _ - + (2 : ℤ) • legendrePointFrobeniusHom u v + +/-- The rational-point fixed subtype is literally the kernel of `Frob - 1`. -/ +def legendreFrobeniusFixedEquivKernel (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] : + {P : (legendreAffineOverClosure u v).Point // legendrePointFrobenius u v P = P} ≃ + (legendreFrobeniusMinusIdentityHom u v).ker where + toFun P := ⟨P.1, by + change legendrePointFrobeniusHom u v P.1 - P.1 = 0 + rw [legendrePointFrobeniusHom_apply, P.2, sub_self]⟩ + invFun P := ⟨P.1, by + have hP := P.2 + change legendrePointFrobeniusHom u v P.1 - P.1 = 0 at hP + exact legendrePointFrobeniusHom_apply u v P.1 ▸ sub_eq_zero.mp hP⟩ + left_inv P := Subtype.ext rfl + right_inv P := Subtype.ext rfl + +/-- Rational points are equivalent to the kernel of `Frob - 1`. -/ +def legendreRationalPointEquivFrobeniusKernel (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] : + (legendreWeierstrassCurve u v).toAffine.Point ≃ + (legendreFrobeniusMinusIdentityHom u v).ker := + (legendreRationalPointEquivFrobeniusFixed u v).trans + (legendreFrobeniusFixedEquivKernel u v) + +/-- The point cardinality is the kernel cardinality of `Frob - 1`. -/ +theorem legendre_point_card_eq_frobeniusMinusIdentity_ker_card (u v : F) + [(legendreWeierstrassCurve u v).IsElliptic] : + Nat.card (legendreWeierstrassCurve u v).toAffine.Point = + Nat.card (legendreFrobeniusMinusIdentityHom u v).ker := + Nat.card_congr (legendreRationalPointEquivFrobeniusKernel u v) + +end FrobeniusEndomorphism + +@[simp] +theorem legendreFrobeniusMinusIdentity_baseChange (u v : F) + (P : (legendreWeierstrassCurve u v).toAffine.Point) : + legendreFrobeniusMinusIdentity u v + (legendrePointBaseChange u v P) = 0 := by + classical + change (legendrePointFrobenius u v (legendrePointBaseChange u v P)).add + (-(legendrePointBaseChange u v P)) = 0 + rw [legendrePointFrobenius_baseChange] + cases P with + | zero => rfl + | some x y h => + simp only [legendrePointBaseChange, WeierstrassCurve.Affine.Point.neg_some] + exact WeierstrassCurve.Affine.Point.add_of_Y_eq rfl + (WeierstrassCurve.Affine.negY_negY _ _).symm + +/-- The integer quadratic form which Hasse identifies with the degree of `m - n·Frob`. -/ +def frobeniusNormForm (q t m n : ℤ) : ℤ := + m ^ 2 - t * m * n + q * n ^ 2 + +/-- The norm-form value of Hasse's witness endomorphism is exactly the discriminant gap. -/ +theorem frobeniusNormForm_hasseWitness (q t : ℤ) : + frobeniusNormForm q t t 2 = 4 * q - t ^ 2 := by + simp only [frobeniusNormForm] + ring + +/-- A single nonnegative value of Hasse's norm form, at `(m,n) = (t,2)`, forces the +discriminant inequality. -/ +theorem sq_le_four_mul_of_frobeniusNormForm_nonnegative {q t : ℤ} + (hnorm : 0 ≤ frobeniusNormForm q t t 2) : t ^ 2 ≤ 4 * q := by + rw [frobeniusNormForm_hasseWitness] at hnorm + omega + +/-- The norm-form value which must be identified with the degree of +`legendreHasseWitnessEndomorphism`. This definition does not assume that identification. -/ +def legendreHasseNormWitness (u v : F) : ℤ := + let q : ℤ := Fintype.card F + let t : ℤ := legendreFrobeniusTrace u v + frobeniusNormForm q t t 2 + +/-! +### Exact remaining geometric statement + +The next theorem must construct a natural-valued algebraic degree for +`legendreHasseWitnessEndomorphism u v` and prove that its integer cast is +`legendreHasseNormWitness u v`. Nonnegativity would then be automatic and the theorem below would +close Hasse's bound. + +This cannot honestly be replaced by the cardinality of the kernel of the underlying abstract group +homomorphism: identifying kernel cardinality with algebraic degree already requires separability, +and the quadratic degree law is geometry, not abstract group theory. In the current Mathlib API, +the division polynomials are not connected to scalar multiplication on `Affine.Point`, the +`ωₙ` polynomial needed for the `Y`-coordinate is still absent, and no rational-map/isogeny degree or +parallelogram law is available. Thus even the minimal witness degree requires constructing those +interfaces in-repository. +-/ + +/-- Once the missing geometric degree calculation proves the norm witness nonnegative, the +arithmetic reduction gives exactly the desired point-cardinality bound. -/ +theorem legendreWeierstrassCurve_point_card_hasse_of_normWitness_nonnegative + {u v : F} (hnorm : 0 ≤ legendreHasseNormWitness u v) : + ((Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) - + Fintype.card F - 1) ^ 2 ≤ 4 * (Fintype.card F : ℤ) := by + have htrace : legendreFrobeniusTrace u v ^ 2 ≤ 4 * (Fintype.card F : ℤ) := + sq_le_four_mul_of_frobeniusNormForm_nonnegative hnorm + convert htrace using 1 + simp only [legendreFrobeniusTrace] + ring + +/-- Nonnegativity of the explicit Frobenius norm witness is exactly the Hasse point-cardinality +inequality. Thus the missing algebraic-degree calculation is not merely sufficient: it is the +whole remaining Hasse wall. -/ +theorem legendreHasseNormWitness_nonnegative_iff_point_card_hasse (u v : F) : + 0 ≤ legendreHasseNormWitness u v ↔ + ((Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) - + Fintype.card F - 1) ^ 2 ≤ 4 * (Fintype.card F : ℤ) := by + constructor + · exact legendreWeierstrassCurve_point_card_hasse_of_normWitness_nonnegative + · intro hhasse + simp only [legendreHasseNormWitness, frobeniusNormForm_hasseWitness, + legendreFrobeniusTrace] + nlinarith [sq_nonneg + ((Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) - + Fintype.card F - 1)] + +end FiniteBaseField + +end BGS.FiniteField diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean new file mode 100644 index 0000000000..d12b236183 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean @@ -0,0 +1,185 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.NumberTheory.JacobiSum.Basic +import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic + +namespace BGS.FiniteField + +open Finset + +variable {F : Type*} [Field F] [Fintype F] [DecidableEq F] + +/-- Sum a function over the square map, with fiber sizes expressed by the quadratic character. -/ +theorem sum_comp_sq_eq_sum_quadraticChar_add_one + (hF : ringChar F ≠ 2) (f : F → ℤ) : + ∑ y : F, f (y ^ 2) = ∑ x : F, (quadraticChar F x + 1) * f x := by + classical + rw [← sum_fiberwise (s := univ) (g := fun y : F => y ^ 2) (f := fun y => f (y ^ 2))] + apply sum_congr rfl + intro x _ + have hcard : + ((#{y ∈ (univ : Finset F) | y ^ 2 = x} : ℕ) : ℤ) = quadraticChar F x + 1 := by + simpa [Set.toFinset_setOf] using quadraticChar_card_sqrts hF x + calc + ∑ y ∈ (univ : Finset F) with y ^ 2 = x, f (y ^ 2) = + ∑ _y ∈ (univ : Finset F) with _y ^ 2 = x, f x := by + apply sum_congr rfl + intro y hy + rw [(mem_filter.mp hy).2] + _ = ((#{y ∈ (univ : Finset F) | y ^ 2 = x} : ℕ) : ℤ) * f x := by + simp + _ = (quadraticChar F x + 1) * f x := by rw [hcard] + +/-- The quadratic-character sum of `1 - d * y²` is a Jacobi sum. -/ +theorem sum_quadraticChar_one_sub_mul_sq + (hF : ringChar F ≠ 2) {d : F} (hd : d ≠ 0) : + ∑ y : F, quadraticChar F (1 - d * y ^ 2) = + -quadraticChar F d * quadraticChar F (-1) := by + let chi := quadraticChar F + have hzero : ∑ x : F, chi (1 - d * x) = 0 := by + let e : F ≃ F := (Equiv.mulLeft₀ d hd).trans (Equiv.subLeft 1) + calc + ∑ x : F, chi (1 - d * x) = ∑ x : F, chi (e x) := by + apply sum_congr rfl + intro x _ + simp [e] + _ = ∑ x : F, chi x := e.sum_comp chi + _ = 0 := quadraticChar_sum_zero hF + have hJacobi : jacobiSum chi chi = -chi (-1) := by + have hinv : chi⁻¹ = chi := by + dsimp [chi] + exact (quadraticChar_isQuadratic F).inv + calc + jacobiSum chi chi = jacobiSum chi chi⁻¹ := by rw [hinv] + _ = -chi (-1) := by + dsimp [chi] + exact jacobiSum_nontrivial_inv (quadraticChar_ne_one hF) + have hscaled : + chi d * (∑ x : F, chi x * chi (1 - d * x)) = jacobiSum chi chi := by + rw [mul_sum] + let e : F ≃ F := Equiv.mulLeft₀ d hd + calc + ∑ x : F, chi d * (chi x * chi (1 - d * x)) = + ∑ x : F, chi (e x) * chi (1 - e x) := by + apply sum_congr rfl + intro x _ + simp [e, mul_assoc] + _ = ∑ x : F, chi x * chi (1 - x) := + e.sum_comp (fun x => chi x * chi (1 - x)) + _ = jacobiSum chi chi := rfl + have hchi_sq : chi d ^ 2 = 1 := quadraticChar_sq_one hd + calc + ∑ y : F, chi (1 - d * y ^ 2) = + ∑ x : F, (chi x + 1) * chi (1 - d * x) := by + simpa [chi] using + sum_comp_sq_eq_sum_quadraticChar_add_one hF (fun x => chi (1 - d * x)) + _ = (∑ x : F, chi x * chi (1 - d * x)) + ∑ x : F, chi (1 - d * x) := by + simp_rw [add_mul, one_mul, sum_add_distrib] + _ = ∑ x : F, chi x * chi (1 - d * x) := by rw [hzero, add_zero] + _ = + chi d ^ 2 * ∑ x : F, chi x * chi (1 - d * x) := by rw [hchi_sq, one_mul] + _ = chi d * (chi d * ∑ x : F, chi x * chi (1 - d * x)) := by ring + _ = chi d * jacobiSum chi chi := by rw [hscaled] + _ = -chi d * chi (-1) := by rw [hJacobi]; ring + +/-- A nondegenerate quadratic polynomial has quadratic-character sum `-chi(A)`. -/ +theorem sum_quadraticChar_mul_sq_sub + (hF : ringChar F ≠ 2) {A C : F} (hA : A ≠ 0) (hC : C ≠ 0) : + ∑ y : F, quadraticChar F (A * y ^ 2 - C) = -quadraticChar F A := by + let chi := quadraticChar F + have hd : A / C ≠ 0 := div_ne_zero hA hC + have hinv : chi⁻¹ = chi := by + dsimp [chi] + exact (quadraticChar_isQuadratic F).inv + have hchiCinv : chi C⁻¹ = chi C := by + rw [← MulChar.inv_apply' chi C, hinv] + have hchiC_sq : chi C ^ 2 = 1 := quadraticChar_sq_one hC + have hchiNegOne_sq : chi (-1) ^ 2 = 1 := quadraticChar_sq_one (neg_ne_zero.mpr one_ne_zero) + calc + ∑ y : F, chi (A * y ^ 2 - C) = + ∑ y : F, chi ((-C) * (1 - (A / C) * y ^ 2)) := by + apply sum_congr rfl + intro y _ + congr 1 + field_simp [hC] + ring + _ = ∑ y : F, chi (-C) * chi (1 - (A / C) * y ^ 2) := by + simp only [map_mul] + _ = chi (-C) * ∑ y : F, chi (1 - (A / C) * y ^ 2) := by rw [mul_sum] + _ = chi (-C) * (-chi (A / C) * chi (-1)) := by + rw [sum_quadraticChar_one_sub_mul_sq hF hd] + _ = -chi A := by + rw [show -C = (-1) * C by ring, map_mul, div_eq_mul_inv, map_mul, hchiCinv] + calc + chi (-1) * chi C * (-(chi A * chi C) * chi (-1)) = + -(chi A) * (chi C ^ 2) * (chi (-1) ^ 2) := by ring + _ = -chi A := by rw [hchiC_sq, hchiNegOne_sq, mul_one, mul_one] + +/-- A nondegenerate affine conic has a point outside any set of at most three forbidden first +coordinates once the field has at least eight elements. -/ +theorem exists_quadratic_conic_point_away_from_three + (hF : ringChar F ≠ 2) (hcard : 8 ≤ Fintype.card F) + {A C : F} (hA : A ≠ 0) (hC : C ≠ 0) (bad : Finset F) (hbad : #bad ≤ 3) : + ∃ y, y ∉ bad ∧ ∃ lambda, lambda ^ 2 = A * y ^ 2 - C := by + classical + let roots (y : F) : Finset F := univ.filter fun lambda => lambda ^ 2 = A * y ^ 2 - C + let rootCount (y : F) : ℤ := #(roots y) + have hrootCount (y : F) : + rootCount y = quadraticChar F (A * y ^ 2 - C) + 1 := by + dsimp [rootCount, roots] + simpa [Set.toFinset_setOf] using + quadraticChar_card_sqrts hF (A * y ^ 2 - C) + have hsum : + ∑ y : F, rootCount y = (Fintype.card F : ℤ) - quadraticChar F A := by + calc + ∑ y : F, rootCount y = + ∑ y : F, (quadraticChar F (A * y ^ 2 - C) + 1) := by + apply sum_congr rfl + intro y _ + exact hrootCount y + _ = (∑ y : F, quadraticChar F (A * y ^ 2 - C)) + ∑ _y : F, 1 := by + simp_rw [sum_add_distrib] + _ = -quadraticChar F A + (Fintype.card F : ℤ) := by + rw [sum_quadraticChar_mul_sq_sub hF hA hC] + simp + _ = (Fintype.card F : ℤ) - quadraticChar F A := by ring + have hrootCount_le (y : F) : rootCount y ≤ 2 := by + rw [hrootCount] + by_cases hzero : A * y ^ 2 - C = 0 + · rw [hzero, quadraticChar_zero] + norm_num + · rcases quadraticChar_dichotomy hzero with h | h <;> rw [h] <;> norm_num + by_contra hExists + have hzeroOutside (y : F) (hy : y ∉ bad) : rootCount y = 0 := by + have hnone : ∀ lambda : F, lambda ^ 2 ≠ A * y ^ 2 - C := by + intro lambda hlambda + exact hExists ⟨y, hy, lambda, hlambda⟩ + have hempty : roots y = ∅ := by + ext lambda + simp [roots, hnone lambda] + simp [rootCount, hempty] + have hrestrict : ∑ y ∈ bad, rootCount y = ∑ y : F, rootCount y := by + apply sum_subset (subset_univ bad) + intro y _ hy + exact hzeroOutside y hy + have hupper : ∑ y : F, rootCount y ≤ 6 := by + rw [← hrestrict] + calc + ∑ y ∈ bad, rootCount y ≤ ∑ _y ∈ bad, (2 : ℤ) := by + exact sum_le_sum fun y _ => hrootCount_le y + _ = (#bad : ℤ) * 2 := by simp + _ ≤ 6 := by exact_mod_cast Nat.mul_le_mul_right 2 hbad + have hchi_le : quadraticChar F A ≤ 1 := by + rcases quadraticChar_dichotomy hA with h | h + · omega + · omega + have hlower : 7 ≤ ∑ y : F, rootCount y := by + rw [hsum] + omega + omega + +end BGS.FiniteField diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean new file mode 100644 index 0000000000..746367cd5d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean @@ -0,0 +1,584 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound + +/-! +# Finite places centered at affine rational points + +For an irreducible plane curve with both coordinates separating, this file +chooses an exhaustive finite place centered at each affine rational point. +Both coordinate differences have positive order at the selected place, and +distinct affine points give distinct places. + +The construction records the affine center through equality of valuation +subrings. It deliberately makes no residue-degree-one claim: above a +singular rational point, a chosen normalization branch need not be rational. +-/ + +open IsDedekindDomain +open Multiplicative WithZero + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] +variable {f : MvPolynomial (Fin 2) K} + +/-- The first coordinate minus its value at an affine point belongs to the +point's maximal ideal. -/ +theorem firstCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal + (z : AffinePlaneCurvePoint f) : + planeCurveCoordinate f 0 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.1 ∈ + (affinePlaneCurvePointMaximalIdeal f z).asIdeal := by + change planeCurvePointEval f z + (planeCurveCoordinate f 0 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.1) = 0 + simp + +/-- The second coordinate minus its value at an affine point belongs to the +point's maximal ideal. -/ +theorem secondCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal + (z : AffinePlaneCurvePoint f) : + planeCurveCoordinate f 1 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.2 ∈ + (affinePlaneCurvePointMaximalIdeal f z).asIdeal := by + change planeCurvePointEval f z + (planeCurveCoordinate f 1 - + algebraMap K (PlaneCurveCoordinateRing f) z.1.2) = 0 + simp + +/-- A separating first coordinate cannot equal the constant first coordinate +of an affine point in the function field. -/ +theorem firstCoordinate_sub_affinePoint_ne_zero + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffinePlaneCurvePoint f) : + letI := planeCurveCoordinateRing_isDomain hf + planeCurveFunction f 0 - + algebraMap K (PlaneCurveFunctionField f) z.1.1 ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have htrans : Transcendental K (planeCurveFunction f 0) := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + intro hzero + apply htrans + rw [sub_eq_zero.mp hzero] + exact isAlgebraic_algebraMap z.1.1 + +/-- A separating second coordinate cannot equal the constant second +coordinate of an affine point in the function field. -/ +theorem secondCoordinate_sub_affinePoint_ne_zero + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (z : AffinePlaneCurvePoint f) : + letI := planeCurveCoordinateRing_isDomain hf + planeCurveFunction f 1 - + algebraMap K (PlaneCurveFunctionField f) z.1.2 ≠ 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have htrans : Transcendental K (planeCurveFunction f 1) := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + intro hzero + apply htrans + rw [sub_eq_zero.mp hzero] + exact isAlgebraic_algebraMap z.1.2 + +/-- Every affine rational point has an exhaustive finite place centered at +that point where both coordinate differences have positive order. -/ +theorem exists_affinePoint_exhaustiveFinitePlace_orders_positive + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffinePlaneCurvePoint f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsDedekindDomain + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) + letI : IsFractionRing + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) + (PlaneCurveFunctionField f) := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) + (PlaneCurveFunctionField f) + ∃ q : HeightOneSpectrum + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)), + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) q = + dominatingValuationSubring + (affinePlaneCurvePointMaximalIdeal f z) ∧ + 0 < finitePlaceOrder q + (planeCurveFunction f 0 - + algebraMap K (PlaneCurveFunctionField f) z.1.1) ∧ + 0 < finitePlaceOrder q + (planeCurveFunction f 1 - + algebraMap K (PlaneCurveFunctionField f) z.1.2) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsDedekindDomain + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) + letI : IsFractionRing + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) + (PlaneCurveFunctionField f) := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) + (PlaneCurveFunctionField f) + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + let B := integralClosure (Polynomial K) E + let m := affinePlaneCurvePointMaximalIdeal f z + let hbase : ∀ P : Polynomial K, + algebraMap (Polynomial K) E P ∈ (algebraMap A E).range := + polynomial_algebraMap_mem_planeCurveCoordinateRing_range hf hpartialSecond + let V := dominatingValuationSubring (A := A) (L := E) m + let rfirst : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 + let rsecond : A := planeCurveCoordinate f 1 - algebraMap K A z.1.2 + let Pfirst : Polynomial K := Polynomial.X - Polynomial.C z.1.1 + let bfirst : B := algebraMap (Polynomial K) B Pfirst + have hfirstNonzero : + planeCurveFunction f 0 - algebraMap K E z.1.1 ≠ 0 := + firstCoordinate_sub_affinePoint_ne_zero hf hpartialSecond z + have hsecondNonzero : + planeCurveFunction f 1 - algebraMap K E z.1.2 ≠ 0 := + secondCoordinate_sub_affinePoint_ne_zero hf hpartialFirst z + have hrfirst : rfirst ∈ m.asIdeal := + firstCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal z + have hrsecond : rsecond ∈ m.asIdeal := + secondCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal z + have hrfirstMap : algebraMap A E rfirst = + planeCurveFunction f 0 - algebraMap K E z.1.1 := by + simp only [rfirst, map_sub] + rfl + have hrsecondMap : algebraMap A E rsecond = + planeCurveFunction f 1 - algebraMap K E z.1.2 := by + simp only [rsecond, map_sub] + rfl + have hPfirstMap : algebraMap (Polynomial K) E Pfirst = + planeCurveFunction f 0 - algebraMap K E z.1.1 := by + change ratFuncSpecialization (planeCurveFunction f 0) hx + (algebraMap (Polynomial K) (RatFunc K) Pfirst) = _ + have hcomp := congrArg + (fun h : Polynomial K →+* E => h Pfirst) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [Pfirst] using hcomp + have hbfirstMap : algebraMap B E bfirst = + planeCurveFunction f 0 - algebraMap K E z.1.1 := by + rw [show algebraMap B E bfirst = + algebraMap (Polynomial K) E Pfirst by + exact IsScalarTower.algebraMap_apply (Polynomial K) B E Pfirst] + exact hPfirstMap + have hbfirst0 : bfirst ≠ 0 := by + intro hb + apply hfirstNonzero + rw [← hbfirstMap, hb, map_zero] + have hfirstNonunits : + planeCurveFunction f 0 - algebraMap K E z.1.1 ∈ V.nonunits := by + rw [← hrfirstMap] + exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) m rfirst hrfirst + have hsecondNonunits : + planeCurveFunction f 1 - algebraMap K E z.1.2 ∈ V.nonunits := by + rw [← hrsecondMap] + exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) m rsecond hrsecond + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨planeCurveFunction f 0 - algebraMap K E z.1.1, + hfirstNonzero, hfirstNonunits⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hbfirstMem : bfirst ∈ dominatingIntegralClosurePrime m hbase := by + change integralClosureToDominatingValuationSubring m hbase bfirst ∈ + IsLocalRing.maximalIdeal V + apply ValuationSubring.coe_mem_nonunits_iff.mp + have hcoe : + ((integralClosureToDominatingValuationSubring + m hbase bfirst : V) : E) = algebraMap B E bfirst := by + rfl + rw [hcoe, hbfirstMap] + exact hfirstNonunits + have hqne : dominatingIntegralClosurePrime m hbase ≠ ⊥ := by + intro hbot + have : bfirst = 0 := by simpa [hbot] using hbfirstMem + exact hbfirst0 this + let q : HeightOneSpectrum B := + dominatingIntegralClosurePlace m hbase hqne + have hrfirstMap0 : algebraMap A E rfirst ≠ 0 := by + rw [hrfirstMap] + exact hfirstNonzero + have hrsecondMap0 : algebraMap A E rsecond ≠ 0 := by + rw [hrsecondMap] + exact hsecondNonzero + refine ⟨q, ?_, ?_, ?_⟩ + · exact valuationSubringAt_dominatingIntegralClosurePlace_eq + m hbase hqne hV + · rw [← hrfirstMap] + exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem + m hbase hqne hV rfirst hrfirst hrfirstMap0 + · rw [← hrsecondMap] + exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem + m hbase hqne hV rsecond hrsecond hrsecondMap0 + +variable [DecidableEq K] + +/-- The exhaustive finite place selected above an affine rational point. -/ +def affinePointExhaustiveFinitePlace + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffinePlaneCurvePoint f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + FiniteExtensionFinitePlace K (PlaneCurveFunctionField f) := by + exact Classical.choose + (exists_affinePoint_exhaustiveFinitePlace_orders_positive + hf hpartialFirst hpartialSecond z) + +omit [DecidableEq K] in +/-- The selected finite place has the prescribed affine center, and both +coordinate differences have positive order there. -/ +theorem affinePointExhaustiveFinitePlace_spec + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffinePlaneCurvePoint f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z) = + dominatingValuationSubring (affinePlaneCurvePointMaximalIdeal f z) ∧ + 0 < finitePlaceOrder + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z) + (planeCurveFunction f 0 - + algebraMap K (PlaneCurveFunctionField f) z.1.1) ∧ + 0 < finitePlaceOrder + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z) + (planeCurveFunction f 1 - + algebraMap K (PlaneCurveFunctionField f) z.1.2) := by + exact Classical.choose_spec + (exists_affinePoint_exhaustiveFinitePlace_orders_positive + hf hpartialFirst hpartialSecond z) + +omit [DecidableEq K] in +/-- Distinct affine rational points have distinct selected exhaustive finite +places. The proof uses equality of affine centers, not residue degrees. -/ +theorem affinePointExhaustiveFinitePlace_injective + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + Function.Injective + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change Function.Injective + (affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond) + intro z w hzw + apply affinePlaneCurvePointMaximalIdeal_injective f + apply MaximalSpectrum.ext + apply pointIdeal_eq_of_dominatingValuationSubring_eq + (A := PlaneCurveCoordinateRing f) + (L := PlaneCurveFunctionField f) + calc + dominatingValuationSubring (affinePlaneCurvePointMaximalIdeal f z) = + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z) := + (affinePointExhaustiveFinitePlace_spec + hf hpartialFirst hpartialSecond z).1.symm + _ = IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond w) := by + rw [hzw] + _ = dominatingValuationSubring + (affinePlaneCurvePointMaximalIdeal f w) := + (affinePointExhaustiveFinitePlace_spec + hf hpartialFirst hpartialSecond w).1 + +omit [DecidableEq K] in +/-- Any nonzero regular function vanishing at an affine point has positive +order at that point's selected finite place. -/ +theorem finitePlaceOrder_affinePointExhaustiveFinitePlace_pos_of_mem + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffinePlaneCurvePoint f) + (r : PlaneCurveCoordinateRing f) + (hr : r ∈ (affinePlaneCurvePointMaximalIdeal f z).asIdeal) + (hr0 : algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) r ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + 0 < finitePlaceOrder + (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z) + (algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) r) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let E := PlaneCurveFunctionField f + let q := affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z + let V := dominatingValuationSubring + (A := PlaneCurveCoordinateRing f) (L := E) + (affinePlaneCurvePointMaximalIdeal f z) + have hnonunits : + algebraMap (PlaneCurveCoordinateRing f) E r ∈ V.nonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := PlaneCurveCoordinateRing f) + (L := E) (affinePlaneCurvePointMaximalIdeal f z) r hr + have hVlt : V.valuation + (algebraMap (PlaneCurveCoordinateRing f) E r) < 1 := + hnonunits + have hequiv : (q.valuation E).IsEquiv V.valuation := by + rw [Valuation.isEquiv_iff_valuationSubring, + ← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + ValuationSubring.valuationSubring_valuation] + exact (affinePointExhaustiveFinitePlace_spec + hf hpartialFirst hpartialSecond z).1 + have hqlt : q.valuation E + (algebraMap (PlaneCurveCoordinateRing f) E r) < 1 := + hequiv.lt_one_iff_lt_one.mpr hVlt + have horder := valuation_eq_exp_neg_finitePlaceOrder q + (algebraMap (PlaneCurveCoordinateRing f) E r) hr0 + rw [horder, ← exp_zero, exp_lt_exp] at hqlt + have hpos : 0 < finitePlaceOrder q + (algebraMap (PlaneCurveCoordinateRing f) E r) := by + omega + simpa [q, E] using hpos + +/-- A finite family of distinct affine rational points at which two fixed +nonzero regular functions vanish is bounded by their degree-weighted positive +gcd divisor. Positive place degree suffices; no selected place is asserted +to have degree one. -/ +theorem affinePointFamily_card_le_finiteExtensionGcdWeightedDegree + {ι : Type*} [Fintype ι] + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (point : ι → AffinePlaneCurvePoint f) + (hpoint : Function.Injective point) + (r s : PlaneCurveCoordinateRing f) + (hr : ∀ i, r ∈ (affinePlaneCurvePointMaximalIdeal f (point i)).asIdeal) + (hs : ∀ i, s ∈ (affinePlaneCurvePointMaximalIdeal f (point i)).asIdeal) + (hr0 : algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) r ≠ 0) + (hs0 : algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) s ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + Fintype.card ι ≤ finiteExtensionGcdWeightedDegree K + (PlaneCurveFunctionField f) + (algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) r) + (algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) s) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let E := PlaneCurveFunctionField f + let x : E := algebraMap (PlaneCurveCoordinateRing f) E r + let y : E := algebraMap (PlaneCurveCoordinateRing f) E s + let finitePlace : ι → FiniteExtensionFinitePlace K E := fun i => + affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond (point i) + let place : ι → FiniteExtensionPlace K E := fun i => .inl (finitePlace i) + have hFinitePlaceInjective : Function.Injective finitePlace := + (affinePointExhaustiveFinitePlace_injective + hf hpartialFirst hpartialSecond).comp hpoint + have hPlaceInjective : Function.Injective place := by + intro i j hij + apply hFinitePlaceInjective + exact Sum.inl_injective hij + have hImageSubset : Finset.univ.image place ⊆ + finiteExtensionGcdSupport K E x y := by + intro v hv + obtain ⟨i, -, rfl⟩ := Finset.mem_image.mp hv + have hri : 0 < finitePlaceOrder (finitePlace i) x := + finitePlaceOrder_affinePointExhaustiveFinitePlace_pos_of_mem + hf hpartialFirst hpartialSecond (point i) r (hr i) hr0 + exact inl_mem_finiteExtensionGcdSupport_of_orders_positive + K E x y (finitePlace i) hri + calc + Fintype.card ι = (Finset.univ.image place).card := by + rw [Finset.card_image_of_injective _ hPlaceInjective, + Finset.card_univ] + _ = ∑ v ∈ Finset.univ.image place, 1 := by simp + _ ≤ ∑ v ∈ Finset.univ.image place, + finiteExtensionGcdMultiplicity K E x y v * + finiteExtensionPlaceDegree K E v := by + apply Finset.sum_le_sum + intro v hv + obtain ⟨i, -, rfl⟩ := Finset.mem_image.mp hv + have hri : 0 < finitePlaceOrder (finitePlace i) x := + finitePlaceOrder_affinePointExhaustiveFinitePlace_pos_of_mem + hf hpartialFirst hpartialSecond (point i) r (hr i) hr0 + have hsi : 0 < finitePlaceOrder (finitePlace i) y := + finitePlaceOrder_affinePointExhaustiveFinitePlace_pos_of_mem + hf hpartialFirst hpartialSecond (point i) s (hs i) hs0 + exact one_le_finiteExtensionGcdMultiplicity_mul_degree_inl_of_orders_positive + K E x y (finitePlace i) hri hsi + _ ≤ ∑ v ∈ finiteExtensionGcdSupport K E x y, + finiteExtensionGcdMultiplicity K E x y v * + finiteExtensionPlaceDegree K E v := by + exact Finset.sum_le_sum_of_subset_of_nonneg hImageSubset (by omega) + _ = finiteExtensionGcdWeightedDegree K E x y := by + rfl + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean new file mode 100644 index 0000000000..c67d14a7dc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas +import Mathlib.LinearAlgebra.Isomorphisms + +/-! +# The linear-algebra inequality in the Cech proof of Riemann's inequality + +Let `A ≤ A'` and `B` be subspaces of a vector space `V`. The canonical map + +`A' / A → V / (A ⊔ B)` + +has kernel canonically represented by + +`(A' ⊓ B) / (A ⊓ B)`. + +Rank--nullity therefore gives + +`finrank (A' / A) ≤ finrank ((A' ⊓ B) / (A ⊓ B)) + finrank (V / (A ⊔ B))`. + +Only the three quotient spaces occurring in this argument need to be +finite-dimensional; the ambient space `V` and the subspaces themselves may +be infinite-dimensional. This is the abstract finite-dimensional step used +by the Cech proof of Riemann's inequality. +-/ + +namespace BGS.HasseWeil + +open Submodule + +noncomputable section + +variable {K V : Type*} [Field K] [AddCommGroup V] [Module K V] + +/-- The copy of `A` inside `A'`. When `A ≤ A'`, this is the denominator in +the relative quotient `A' / A`. -/ +abbrev relativeSubmodule (A A' : Submodule K V) : Submodule K A' := + A.comap A'.subtype + +/-- The canonical map `A' / A → V / (A ⊔ B)` used in the Cech argument. -/ +def cechRelativeQuotientMap (A A' B : Submodule K V) : + (A' ⧸ relativeSubmodule A A') →ₗ[K] V ⧸ (A ⊔ B) := + (relativeSubmodule A A').mapQ (A ⊔ B) A'.subtype + (comap_mono le_sup_left) + +/-- The quotient `(A' ⊓ B) / (A ⊓ B)` maps naturally into `A' / A`. -/ +def cechIntersectionQuotientMap (A A' B : Submodule K V) : + (↥(A' ⊓ B) ⧸ (A ⊓ B).comap (A' ⊓ B).subtype) →ₗ[K] + A' ⧸ relativeSubmodule A A' := + let sourceDenominator := (A ⊓ B).comap (A' ⊓ B).subtype + let targetDenominator := relativeSubmodule A A' + let inclusion : ↥(A' ⊓ B) →ₗ[K] A' := Submodule.inclusion inf_le_left + sourceDenominator.liftQ (targetDenominator.mkQ.comp inclusion) <| by + intro x hx + rw [LinearMap.mem_ker, LinearMap.comp_apply, Submodule.mkQ_apply, + Submodule.Quotient.mk_eq_zero] + change (x : V) ∈ A + exact hx.1 + +theorem cechIntersectionQuotientMap_injective (A A' B : Submodule K V) : + Function.Injective (cechIntersectionQuotientMap A A' B) := by + rw [← LinearMap.ker_eq_bot] + apply Submodule.ker_liftQ_eq_bot + intro x hx + change (x : V) ∈ A ⊓ B + have hxA : (x : V) ∈ A := by + simpa [cechIntersectionQuotientMap, relativeSubmodule] using hx + exact ⟨hxA, x.property.2⟩ + +private theorem comap_sup_eq_sup_comap_of_le + (A A' B : Submodule K V) (hAA' : A ≤ A') : + (A ⊔ B).comap A'.subtype = + relativeSubmodule A A' ⊔ B.comap A'.subtype := by + apply le_antisymm + · intro x hx + have hx' : (x : V) ∈ A' ⊓ (A ⊔ B) := ⟨x.property, hx⟩ + have hmodular : A' ⊓ (A ⊔ B) = A ⊔ (A' ⊓ B) := by + calc + A' ⊓ (A ⊔ B) = A' ⊓ (B ⊔ A) := by rw [sup_comm A B] + _ = (A' ⊓ B) ⊔ A := (inf_sup_assoc_of_le B hAA').symm + _ = A ⊔ (A' ⊓ B) := sup_comm _ _ + rw [hmodular] at hx' + obtain ⟨a, ha, b, hb, hab⟩ := Submodule.mem_sup.mp hx' + refine Submodule.mem_sup.mpr + ⟨⟨a, hAA' ha⟩, ha, ⟨b, hb.1⟩, hb.2, ?_⟩ + exact Subtype.ext hab + · exact sup_le (comap_mono le_sup_left) (comap_mono le_sup_right) + +/-- The intersection quotient identifies exactly with the kernel of the Cech +relative quotient map. -/ +theorem range_cechIntersectionQuotientMap_eq_ker + (A A' B : Submodule K V) (hAA' : A ≤ A') : + LinearMap.range (cechIntersectionQuotientMap A A' B) = + LinearMap.ker (cechRelativeQuotientMap A A' B) := by + rw [cechIntersectionQuotientMap, Submodule.range_liftQ, + LinearMap.range_comp, Submodule.range_inclusion] + simp only [comap_inf, comap_subtype_self, top_inf_eq] + rw [cechRelativeQuotientMap, Submodule.ker_mapQ, + comap_sup_eq_sup_comap_of_le A A' B hAA', Submodule.map_sup, + Submodule.mkQ_map_self, bot_sup_eq] + +/-- Rank--nullity with the Cech kernel written as the intersection quotient. +This equality is the strongest finite-dimensional form of the abstract +linear-algebra argument. -/ +theorem finrank_relativeQuotient_eq_infQuotient_add_range + (A A' B : Submodule K V) (hAA' : A ≤ A') + [Module.Finite K (A' ⧸ relativeSubmodule A A')] : + Module.finrank K (A' ⧸ relativeSubmodule A A') = + Module.finrank K (↥(A' ⊓ B) ⧸ (A ⊓ B).comap (A' ⊓ B).subtype) + + Module.finrank K (LinearMap.range (cechRelativeQuotientMap A A' B)) := by + have hker := range_cechIntersectionQuotientMap_eq_ker A A' B hAA' + have hinj := cechIntersectionQuotientMap_injective A A' B + calc + Module.finrank K (A' ⧸ relativeSubmodule A A') = + Module.finrank K (LinearMap.range (cechRelativeQuotientMap A A' B)) + + Module.finrank K (LinearMap.ker (cechRelativeQuotientMap A A' B)) := + (LinearMap.finrank_range_add_finrank_ker _).symm + _ = Module.finrank K (LinearMap.range (cechRelativeQuotientMap A A' B)) + + Module.finrank K + (↥(A' ⊓ B) ⧸ (A ⊓ B).comap (A' ⊓ B).subtype) := by + rw [← hker, LinearMap.finrank_range_of_inj hinj] + _ = Module.finrank K + (↥(A' ⊓ B) ⧸ (A ⊓ B).comap (A' ⊓ B).subtype) + + Module.finrank K (LinearMap.range (cechRelativeQuotientMap A A' B)) := + Nat.add_comm _ _ + +/-- The abstract finite-dimensional inequality behind the Cech proof of +Riemann's inequality. No finite-dimensionality hypothesis is imposed on +the ambient vector space. -/ +theorem finrank_relativeQuotient_le_infQuotient_add_supQuotient + (A A' B : Submodule K V) (hAA' : A ≤ A') + [Module.Finite K (A' ⧸ relativeSubmodule A A')] + [Module.Finite K (V ⧸ (A ⊔ B))] : + Module.finrank K (A' ⧸ relativeSubmodule A A') ≤ + Module.finrank K (↥(A' ⊓ B) ⧸ (A ⊓ B).comap (A' ⊓ B).subtype) + + Module.finrank K (V ⧸ (A ⊔ B)) := by + rw [finrank_relativeQuotient_eq_infQuotient_add_range A A' B hAA'] + exact Nat.add_le_add_left + (LinearMap.range (cechRelativeQuotientMap A A' B)).finrank_le _ + +/-- Subtractive form of +`finrank_relativeQuotient_le_infQuotient_add_supQuotient`, convenient when +the intersection quotient is the desired lower bound. -/ +theorem finrank_relativeQuotient_sub_supQuotient_le_infQuotient + (A A' B : Submodule K V) (hAA' : A ≤ A') + [Module.Finite K (A' ⧸ relativeSubmodule A A')] + [Module.Finite K (V ⧸ (A ⊔ B))] : + Module.finrank K (A' ⧸ relativeSubmodule A A') - + Module.finrank K (V ⧸ (A ⊔ B)) ≤ + Module.finrank K (↥(A' ⊓ B) ⧸ (A ⊓ B).comap (A' ⊓ B).subtype) := by + apply Nat.sub_le_iff_le_add.mpr + simpa [Nat.add_comm] using + finrank_relativeQuotient_le_infQuotient_add_supQuotient A A' B hAA' + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean new file mode 100644 index 0000000000..c04d7e9b88 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean @@ -0,0 +1,610 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +import Mathlib.Data.Finsupp.Weight + +/-! +# The closed-place Euler recurrence + +For a finite family of positive integral weights, an effective divisor is a +finitely supported family of multiplicities. Marking one occurrence of one +place, together with one of as many labels as the place's weight, gives the +coefficient recurrence obtained by logarithmically differentiating the Euler +product. + +This file proves that recurrence by an explicit bijection. It then uses the +local finiteness of bounded-degree places to apply the finite combinatorial +result to all exhaustive places of a finite extension of `K(X)`. +-/ + +namespace BGS.HasseWeil + +open scoped BigOperators + +noncomputable section + +section FiniteWeightedFamily + +variable {I : Type*} [Fintype I] [DecidableEq I] + +private abbrev WeightedEffectiveDivisor (w : I → ℕ) (n : ℕ) := + {D : I →₀ ℕ // Finsupp.weight w D = n} + +@[reducible] private noncomputable def weightedEffectiveDivisorFintype + (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : + Fintype (WeightedEffectiveDivisor w n) := + Set.Finite.fintype (Finsupp.finite_of_nat_weight_eq w hw n) + +@[ext] +private structure WeightedMarkedEffectiveDivisor (w : I → ℕ) (n : ℕ) where + divisor : I →₀ ℕ + place : I + occurrence : ℕ + label : ℕ + weight_eq : Finsupp.weight w divisor = n + occurrence_lt : occurrence < divisor place + label_lt : label < w place + +@[ext] +private structure WeightedEulerDecomposition (w : I → ℕ) (n : ℕ) where + leftDegree : ℕ + rightDegree : ℕ + split_eq : leftDegree + rightDegree = n + divisor : I →₀ ℕ + divisor_weight : Finsupp.weight w divisor = leftDegree + place : I + divides : w place ∣ rightDegree + 1 + label : ℕ + label_lt : label < w place + +private def weightedMarkedToEulerDecomposition + (w : I → ℕ) (hw : ∀ i, 0 < w i) (n : ℕ) : + WeightedMarkedEffectiveDivisor w (n + 1) → + WeightedEulerDecomposition w n := by + intro x + let t := x.occurrence + 1 + let r := t * w x.place + have htpos : 0 < t := by simp [t] + have hrpos : 0 < r := Nat.mul_pos htpos (hw x.place) + have htcoeff : t ≤ x.divisor x.place := by + dsimp [t] + exact x.occurrence_lt + have hsingle : Finsupp.single x.place t ≤ x.divisor := + Finsupp.single_le_iff.mpr htcoeff + let E := x.divisor - Finsupp.single x.place t + have hrestore : E + Finsupp.single x.place t = x.divisor := + tsub_add_cancel_of_le hsingle + have hweight : Finsupp.weight w E + r = n + 1 := by + have h := congrArg (Finsupp.weight w) hrestore + simpa [E, r, Finsupp.weight_single, add_comm] using + h.trans x.weight_eq + have hrle : r ≤ n + 1 := by omega + have hEweight : Finsupp.weight w E = n + 1 - r := by omega + refine { + leftDegree := n + 1 - r + rightDegree := r - 1 + split_eq := ?_ + divisor := E + divisor_weight := hEweight + place := x.place + divides := ⟨t, ?_⟩ + label := x.label + label_lt := x.label_lt } + · omega + · rw [Nat.sub_add_cancel hrpos] + simp [r, Nat.mul_comm] + +private def weightedEulerDecompositionToMarked + (w : I → ℕ) (_hw : ∀ i, 0 < w i) (n : ℕ) : + WeightedEulerDecomposition w n → + WeightedMarkedEffectiveDivisor w (n + 1) := by + intro x + let r := x.rightDegree + 1 + let t := r / w x.place + have htprod : t * w x.place = r := Nat.div_mul_cancel x.divides + have htpos : 0 < t := by + by_contra ht + have htzero : t = 0 := Nat.eq_zero_of_not_pos ht + rw [htzero, zero_mul] at htprod + simp [r] at htprod + let D := x.divisor + Finsupp.single x.place t + have hweight : Finsupp.weight w D = n + 1 := by + rw [show Finsupp.weight w D = + Finsupp.weight w x.divisor + t * w x.place by + simp [D, Finsupp.weight_single]] + rw [x.divisor_weight, htprod] + dsimp [r] + have hsplit := x.split_eq + omega + have htD : t - 1 < D x.place := by + simp only [D, Finsupp.add_apply, Finsupp.single_eq_same] + omega + exact { + divisor := D + place := x.place + occurrence := t - 1 + label := x.label + weight_eq := hweight + occurrence_lt := htD + label_lt := x.label_lt } + +private def weightedMarkedEffectiveDivisorEquivEulerDecomposition + (w : I → ℕ) (hw : ∀ i, 0 < w i) (n : ℕ) : + WeightedMarkedEffectiveDivisor w (n + 1) ≃ + WeightedEulerDecomposition w n where + toFun := weightedMarkedToEulerDecomposition w hw n + invFun := weightedEulerDecompositionToMarked w hw n + left_inv := by + intro x + apply WeightedMarkedEffectiveDivisor.ext + · dsimp [weightedEulerDecompositionToMarked, + weightedMarkedToEulerDecomposition] + rw [Nat.sub_add_cancel (Nat.mul_pos (by omega) (hw x.place))] + rw [Nat.mul_div_cancel (x.occurrence + 1) (hw x.place)] + exact tsub_add_cancel_of_le + (Finsupp.single_le_iff.mpr x.occurrence_lt) + · rfl + · dsimp [weightedEulerDecompositionToMarked, + weightedMarkedToEulerDecomposition] + rw [Nat.sub_add_cancel (Nat.mul_pos (by omega) (hw x.place))] + rw [Nat.mul_div_cancel (x.occurrence + 1) (hw x.place)] + omega + · rfl + right_inv := by + intro x + have htpos : 0 < (x.rightDegree + 1) / w x.place := by + have hprod := Nat.div_mul_cancel x.divides + by_contra ht + have hzero : (x.rightDegree + 1) / w x.place = 0 := + Nat.eq_zero_of_not_pos ht + rw [hzero, zero_mul] at hprod + omega + apply WeightedEulerDecomposition.ext + · dsimp [weightedMarkedToEulerDecomposition, + weightedEulerDecompositionToMarked] + rw [Nat.sub_add_cancel htpos] + rw [Nat.div_mul_cancel x.divides] + have hsplit := x.split_eq + omega + · dsimp [weightedMarkedToEulerDecomposition, + weightedEulerDecompositionToMarked] + rw [Nat.sub_add_cancel htpos] + rw [Nat.div_mul_cancel x.divides] + exact Nat.add_sub_cancel x.rightDegree 1 + · dsimp [weightedMarkedToEulerDecomposition, + weightedEulerDecompositionToMarked] + rw [Nat.sub_add_cancel htpos] + exact add_tsub_cancel_right _ _ + · rfl + · rfl + +private def weightedMarkedEffectiveDivisorEquivSigma + (w : I → ℕ) (n : ℕ) : + WeightedMarkedEffectiveDivisor w n ≃ + Σ D : WeightedEffectiveDivisor w n, + Σ P : I, Fin (D.1 P) × Fin (w P) where + toFun x := + ⟨⟨x.divisor, x.weight_eq⟩, x.place, + ⟨x.occurrence, x.occurrence_lt⟩, + ⟨x.label, x.label_lt⟩⟩ + invFun x := { + divisor := x.1.1 + place := x.2.1 + occurrence := x.2.2.1.1 + label := x.2.2.2.1 + weight_eq := x.1.2 + occurrence_lt := x.2.2.1.2 + label_lt := x.2.2.2.2 } + left_inv := by intro x; ext <;> rfl + right_inv := by intro x; rcases x with ⟨D, P, k, l⟩; rfl + +@[reducible] private noncomputable def weightedMarkedEffectiveDivisorFintype + (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : + Fintype (WeightedMarkedEffectiveDivisor w n) := by + letI := weightedEffectiveDivisorFintype w hw n + exact Fintype.ofEquiv _ (weightedMarkedEffectiveDivisorEquivSigma w n).symm + +/-- The number of natural-valued divisors having weighted degree `n` in a +finite family of nonzero weights. -/ +noncomputable def weightedEffectiveDivisorCount + (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : ℕ := + @Fintype.card _ (weightedEffectiveDivisorFintype w hw n) + +omit [DecidableEq I] in +private theorem weightedMarkedEffectiveDivisor_card + (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : + @Fintype.card (WeightedMarkedEffectiveDivisor w n) + (weightedMarkedEffectiveDivisorFintype w hw n) = + weightedEffectiveDivisorCount w hw n * n := by + letI := weightedEffectiveDivisorFintype w hw n + letI := weightedMarkedEffectiveDivisorFintype w hw n + rw [Fintype.card_congr (weightedMarkedEffectiveDivisorEquivSigma w n)] + rw [Fintype.card_sigma] + simp only [Fintype.card_sigma, Fintype.card_prod, Fintype.card_fin] + simp_rw [show ∀ D : WeightedEffectiveDivisor w n, + ∑ P : I, D.1 P * w P = n by + intro D + calc + ∑ P : I, D.1 P * w P = Finsupp.weight w D.1 := by + rw [Finsupp.weight_apply] + simpa using + (Finsupp.sum_fintype D.1 (fun i c => c • w i) (by simp)).symm + _ = n := D.2] + simp [weightedEffectiveDivisorCount] + +private def weightedEulerDecompositionEquivSigma + (w : I → ℕ) (n : ℕ) : + WeightedEulerDecomposition w n ≃ + Σ ij : {ij : ℕ × ℕ // + ij ∈ Finset.HasAntidiagonal.antidiagonal n}, + WeightedEffectiveDivisor w ij.1.1 × + Σ P : {P : I // w P ∣ ij.1.2 + 1}, Fin (w P.1) where + toFun x := + ⟨⟨(x.leftDegree, x.rightDegree), by + simpa only [Finset.HasAntidiagonal.mem_antidiagonal] using x.split_eq⟩, + ⟨⟨x.divisor, x.divisor_weight⟩, + ⟨⟨x.place, x.divides⟩, ⟨x.label, x.label_lt⟩⟩⟩⟩ + invFun x := { + leftDegree := x.1.1.1 + rightDegree := x.1.1.2 + split_eq := by + simpa only [Finset.HasAntidiagonal.mem_antidiagonal] using x.1.2 + divisor := x.2.1.1 + divisor_weight := x.2.1.2 + place := x.2.2.1.1 + divides := x.2.2.1.2 + label := x.2.2.2.1 + label_lt := x.2.2.2.2 } + left_inv := by intro x; ext <;> rfl + right_inv := by intro x; rcases x with ⟨ij, D, P, l⟩; rfl + +@[reducible] private noncomputable def weightedEulerDecompositionFintype + (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : + Fintype (WeightedEulerDecomposition w n) := by + letI (m : ℕ) := weightedEffectiveDivisorFintype w hw m + exact Fintype.ofEquiv _ (weightedEulerDecompositionEquivSigma w n).symm + +/-- The degree-weighted sum of the places whose weights divide `r`. -/ +def weightedClosedPlaceExtensionCount (w : I → ℕ) (r : ℕ) : ℕ := + ∑ P : I, if w P ∣ r then w P else 0 + +omit [DecidableEq I] in +private theorem weightedEulerDecomposition_card + (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : + @Fintype.card (WeightedEulerDecomposition w n) + (weightedEulerDecompositionFintype w hw n) = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + weightedEffectiveDivisorCount w hw ij.1 * + weightedClosedPlaceExtensionCount w (ij.2 + 1) := by + letI (m : ℕ) := weightedEffectiveDivisorFintype w hw m + letI := weightedEulerDecompositionFintype w hw n + rw [Fintype.card_congr (weightedEulerDecompositionEquivSigma w n)] + rw [Fintype.card_sigma] + simp only [Fintype.card_prod, Fintype.card_sigma, Fintype.card_fin] + simp only [weightedEffectiveDivisorCount] + have hplace (r : ℕ) : + (∑ P : {P : I // w P ∣ r}, w P.1) = + ∑ P : I, if w P ∣ r then w P else 0 := by + calc + (∑ P : {P : I // w P ∣ r}, w P.1) = + ∑ P ∈ Finset.univ.filter (fun P : I => w P ∣ r), w P := by + symm + exact Finset.sum_subtype _ (by simp) _ + _ = ∑ P ∈ Finset.univ, if w P ∣ r then w P else 0 := + Finset.sum_filter _ _ + _ = ∑ P : I, if w P ∣ r then w P else 0 := by rfl + simp_rw [hplace] + rw [Finset.univ_eq_attach] + simpa only [weightedClosedPlaceExtensionCount] using + (Finset.sum_attach (Finset.HasAntidiagonal.antidiagonal n) + (fun ij : ℕ × ℕ => + @Fintype.card (WeightedEffectiveDivisor w ij.1) + (weightedEffectiveDivisorFintype w hw ij.1) * + ∑ P : I, if w P ∣ ij.2 + 1 then w P else 0)) + +omit [DecidableEq I] in +/-- The logarithmic-derivative Euler recurrence for any finite family of +positive integral place weights. -/ +theorem weightedEffectiveDivisorPointCountRecurrence + (w : I → ℕ) (hw : ∀ i, 0 < w i) : + HasEffectiveDivisorPointCountRecurrence + (weightedEffectiveDivisorCount w (fun i => (hw i).ne')) + (weightedClosedPlaceExtensionCount w) := by + intro n + letI := weightedMarkedEffectiveDivisorFintype w + (fun i => (hw i).ne') (n + 1) + letI := weightedEulerDecompositionFintype w + (fun i => (hw i).ne') n + calc + weightedEffectiveDivisorCount w (fun i => (hw i).ne') (n + 1) * + (n + 1) = + Fintype.card (WeightedMarkedEffectiveDivisor w (n + 1)) := + (weightedMarkedEffectiveDivisor_card w (fun i => (hw i).ne') + (n + 1)).symm + _ = Fintype.card (WeightedEulerDecomposition w n) := + Fintype.card_congr + (weightedMarkedEffectiveDivisorEquivEulerDecomposition w hw n) + _ = ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + weightedEffectiveDivisorCount w (fun i => (hw i).ne') ij.1 * + weightedClosedPlaceExtensionCount w (ij.2 + 1) := + weightedEulerDecomposition_card w (fun i => (hw i).ne') n + +end FiniteWeightedFamily + +section LocalRestriction + +variable {J : Type*} [DecidableEq J] + +omit [DecidableEq J] in +private theorem weightedEffectiveDivisor_support_subset_degreeLE + (w : J → ℕ) (n bound : ℕ) (hn : n ≤ bound) + (D : WeightedEffectiveDivisor w n) : + (D.1.support : Set J) ⊆ + Set.range (Function.Embedding.subtype fun P : J => w P ≤ bound) := by + intro P hP + have hne : D.1 P ≠ 0 := Finsupp.mem_support_iff.mp hP + have hle : w P ≤ bound := by + calc + w P ≤ Finsupp.weight w D.1 := + Finsupp.le_weight_of_ne_zero' w hne + _ = n := D.2 + _ ≤ bound := hn + exact ⟨⟨P, hle⟩, rfl⟩ + +omit [DecidableEq J] in +private theorem weightedEffectiveDivisor_embDomain_weight + (w : J → ℕ) (bound : ℕ) + (E : {P : J // w P ≤ bound} →₀ ℕ) : + Finsupp.weight w + (Finsupp.embDomain + (Function.Embedding.subtype fun P : J => w P ≤ bound) E) = + Finsupp.weight (fun P : {P : J // w P ≤ bound} => w P.1) E := by + rw [Finsupp.weight_apply, Finsupp.sum_embDomain, + Finsupp.weight_apply] + apply Finsupp.sum_congr + intro P _ + rfl + +private def weightedEffectiveDivisorRestrictEquiv + (w : J → ℕ) (n bound : ℕ) (hn : n ≤ bound) : + WeightedEffectiveDivisor w n ≃ + WeightedEffectiveDivisor + (fun P : {P : J // w P ≤ bound} => w P.1) n where + toFun D := by + let e := Function.Embedding.subtype fun P : J => w P ≤ bound + let E := Finsupp.comapDomain e D.1 e.injective.injOn + have hrecover : Finsupp.embDomain e E = D.1 := + Finsupp.embDomain_comapDomain + (weightedEffectiveDivisor_support_subset_degreeLE w n bound hn D) + exact ⟨E, by + rw [← weightedEffectiveDivisor_embDomain_weight w bound E, + hrecover] + exact D.2⟩ + invFun E := by + let e := Function.Embedding.subtype fun P : J => w P ≤ bound + exact ⟨Finsupp.embDomain e E.1, + (weightedEffectiveDivisor_embDomain_weight w bound E.1).trans E.2⟩ + left_inv D := by + apply Subtype.ext + dsimp + exact Finsupp.embDomain_comapDomain + (weightedEffectiveDivisor_support_subset_degreeLE w n bound hn D) + right_inv E := by + apply Subtype.ext + exact Finsupp.comapDomain_embDomain + (Function.Embedding.subtype fun P : J => w P ≤ bound) E.1 + +end LocalRestriction + +section FiniteExtension + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- The repository's effective-divisor degree is `Finsupp.weight` for the +closed-place degree function. -/ +theorem finiteExtensionEffectiveDivisorDegree_eq_weight + (D : FiniteExtensionEffectiveDivisor K L) : + finiteExtensionEffectiveDivisorDegree K L D = + Finsupp.weight (finiteExtensionPlaceDegree K L) D := by + rw [finiteExtensionEffectiveDivisorDegree, Finsupp.weight_apply] + apply Finsupp.sum_congr + intro P _ + simp + +private def finiteExtensionEffectiveDivisorWeightEquiv (n : ℕ) : + {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} ≃ + WeightedEffectiveDivisor (finiteExtensionPlaceDegree K L) n where + toFun D := ⟨D.1, + (finiteExtensionEffectiveDivisorDegree_eq_weight K L D.1).symm.trans D.2⟩ + invFun D := ⟨D.1, + (finiteExtensionEffectiveDivisorDegree_eq_weight K L D.1).trans D.2⟩ + left_inv D := by apply Subtype.ext; rfl + right_inv D := by apply Subtype.ext; rfl + +private def finiteExtensionEffectiveDivisorRestrictEquiv + (n bound : ℕ) (hn : n ≤ bound) : + {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} ≃ + WeightedEffectiveDivisor + (fun P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ bound} => + finiteExtensionPlaceDegree K L P.1) n := by + classical + exact (finiteExtensionEffectiveDivisorWeightEquiv K L n).trans + (weightedEffectiveDivisorRestrictEquiv + (finiteExtensionPlaceDegree K L) n bound hn) + +private theorem weightedEffectiveDivisorCount_degreeLE_eq_finiteExtensionCount + (n bound : ℕ) (hn : n ≤ bound) : + letI := finiteExtensionPlaceDegreeLEFintype K L bound + weightedEffectiveDivisorCount + (fun P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ bound} => + finiteExtensionPlaceDegree K L P.1) + (fun P => (finiteExtensionPlaceDegree_pos K L P.1).ne') n = + finiteExtensionEffectiveDivisorCount K L n := by + letI := finiteExtensionPlaceDegreeLEFintype K L bound + letI := weightedEffectiveDivisorFintype + (fun P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ bound} => + finiteExtensionPlaceDegree K L P.1) + (fun P => (finiteExtensionPlaceDegree_pos K L P.1).ne') n + exact Fintype.card_congr + (finiteExtensionEffectiveDivisorRestrictEquiv K L n bound hn).symm + +/-- The extension point count encoded by closed places: a closed place of +degree `d` contributes `d` exactly when `d ∣ r`. -/ +noncomputable def finiteExtensionClosedPlaceExtensionCount (r : ℕ) : ℕ := by + letI := finiteExtensionPlaceDegreeLEFintype K L r + exact ∑ P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ r}, + if finiteExtensionPlaceDegree K L P.1 ∣ r then + finiteExtensionPlaceDegree K L P.1 else 0 + +/-- The closed-place extension count is equivalently the sum of the degrees +over the bounded subtype of places whose degrees divide the level. -/ +theorem finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd + (r : ℕ) : + finiteExtensionClosedPlaceExtensionCount K L r = + letI := finiteExtensionPlaceDegreeLEFintype K L r + ∑ P : {P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ r} // + finiteExtensionPlaceDegree K L P.1 ∣ r}, + finiteExtensionPlaceDegree K L P.1.1 := by + letI := finiteExtensionPlaceDegreeLEFintype K L r + let PlaceLE := {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ r} + let PlaceDvd := {P : PlaceLE // + finiteExtensionPlaceDegree K L P.1 ∣ r} + let degree : PlaceLE → ℕ := fun P => + finiteExtensionPlaceDegree K L P.1 + change (∑ P : PlaceLE, if degree P ∣ r then degree P else 0) = + ∑ P : PlaceDvd, degree P.1 + calc + (∑ P : PlaceLE, if degree P ∣ r then degree P else 0) = + ∑ P ∈ Finset.univ.filter (fun P : PlaceLE => degree P ∣ r), + degree P := by + symm + exact Finset.sum_filter _ _ + _ = ∑ P : PlaceDvd, degree P.1 := by + exact Finset.sum_subtype _ (by intro P; simp [degree]) degree + +@[simp] +theorem finiteExtensionClosedPlaceExtensionCount_zero : + finiteExtensionClosedPlaceExtensionCount K L 0 = 0 := by + rw [finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd] + apply Finset.sum_eq_zero + intro P _ + have hpos := finiteExtensionPlaceDegree_pos K L P.1.1 + have hle := P.1.2 + omega + +private theorem weightedClosedPlaceExtensionCount_degreeLE_eq_finiteExtensionCount + (bound r : ℕ) (hr : 0 < r) (hrb : r ≤ bound) : + letI := finiteExtensionPlaceDegreeLEFintype K L bound + weightedClosedPlaceExtensionCount + (fun P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ bound} => + finiteExtensionPlaceDegree K L P.1) r = + finiteExtensionClosedPlaceExtensionCount K L r := by + letI := finiteExtensionPlaceDegreeLEFintype K L bound + letI := finiteExtensionPlaceDegreeLEFintype K L r + let Big := {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ bound} + let Small := {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ r} + let SmallInBig := {P : Big // + finiteExtensionPlaceDegree K L P.1 ≤ r} + let e : SmallInBig ≃ Small := { + toFun := fun P => ⟨P.1.1, P.2⟩ + invFun := fun P => ⟨⟨P.1, P.2.trans hrb⟩, P.2⟩ + left_inv := by intro P; rcases P with ⟨⟨P, hPb⟩, hPr⟩; rfl + right_inv := by intro P; rcases P with ⟨P, hPr⟩; rfl } + let f : Big → ℕ := fun P => + if finiteExtensionPlaceDegree K L P.1 ∣ r then + finiteExtensionPlaceDegree K L P.1 else 0 + let g : Small → ℕ := fun P => + if finiteExtensionPlaceDegree K L P.1 ∣ r then + finiteExtensionPlaceDegree K L P.1 else 0 + change (∑ P : Big, f P) = ∑ P : Small, g P + calc + (∑ P : Big, f P) = + ∑ P : Big, + if finiteExtensionPlaceDegree K L P.1 ≤ r then f P else 0 := by + apply Finset.sum_congr rfl + intro P _ + by_cases hle : finiteExtensionPlaceDegree K L P.1 ≤ r + · simp [hle] + · have hndiv : ¬ finiteExtensionPlaceDegree K L P.1 ∣ r := by + intro hdiv + exact hle (Nat.le_of_dvd hr hdiv) + simp [f, hle, hndiv] + _ = ∑ P ∈ Finset.univ.filter + (fun P : Big => finiteExtensionPlaceDegree K L P.1 ≤ r), f P := by + symm + exact Finset.sum_filter _ _ + _ = ∑ P : SmallInBig, f P.1 := by + exact Finset.sum_subtype _ (by simp) f + _ = ∑ P : Small, g P := by + exact Fintype.sum_equiv e (fun P : SmallInBig => f P.1) g (by + intro P + rfl) + +/-- The effective-divisor coefficients for the exhaustive closed places of a +finite extension satisfy the exact closed-place Euler recurrence. -/ +theorem finiteExtensionEffectiveDivisorPointCountRecurrence : + HasEffectiveDivisorPointCountRecurrence + (finiteExtensionEffectiveDivisorCount K L) + (finiteExtensionClosedPlaceExtensionCount K L) := by + classical + intro n + let PlaceLE := {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ n + 1} + let w : PlaceLE → ℕ := fun P => finiteExtensionPlaceDegree K L P.1 + letI := finiteExtensionPlaceDegreeLEFintype K L (n + 1) + have hw : ∀ P : PlaceLE, 0 < w P := fun P => + finiteExtensionPlaceDegree_pos K L P.1 + have hlocal := weightedEffectiveDivisorPointCountRecurrence w hw n + calc + finiteExtensionEffectiveDivisorCount K L (n + 1) * (n + 1) = + weightedEffectiveDivisorCount w (fun P => (hw P).ne') (n + 1) * + (n + 1) := by + rw [weightedEffectiveDivisorCount_degreeLE_eq_finiteExtensionCount + K L (n + 1) (n + 1) le_rfl] + _ = ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + weightedEffectiveDivisorCount w (fun P => (hw P).ne') ij.1 * + weightedClosedPlaceExtensionCount w (ij.2 + 1) := hlocal + _ = ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + finiteExtensionEffectiveDivisorCount K L ij.1 * + finiteExtensionClosedPlaceExtensionCount K L (ij.2 + 1) := by + apply Finset.sum_congr rfl + intro ij hij + have hsplit : ij.1 + ij.2 = n := by + simpa only [Finset.HasAntidiagonal.mem_antidiagonal] using hij + have hleft : ij.1 ≤ n + 1 := by omega + have hright : ij.2 + 1 ≤ n + 1 := by omega + rw [weightedEffectiveDivisorCount_degreeLE_eq_finiteExtensionCount + K L ij.1 (n + 1) hleft] + rw [weightedClosedPlaceExtensionCount_degreeLE_eq_finiteExtensionCount + K L (n + 1) (ij.2 + 1) (by omega) hright] + +end FiniteExtension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean new file mode 100644 index 0000000000..b322536ad0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean @@ -0,0 +1,420 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge + +/-! +# Closed places and rational places after extension of constants + +For an exact extension of constants `S / C`, the existing finite and +infinity normalization bridges both prove the residue-degree formula + +`deg_S(Q) = deg_C(P) / gcd([S : C], deg_C(P))`. + +This file combines the two branches into one presented-place type and proves +that an upstairs presented place is rational exactly when its downstairs +degree divides `[S : C]`. Thus it identifies, place by place, the support of +the closed-place extension coefficient with rationality after constant +extension. + +The global cardinality identity needs one further splitting theorem: the +fiber over a downstairs place of degree `d` must have cardinality +`gcd([S : C], d)`. That multiplicity is not supplied by the current +finite/infinity bridge APIs, so no global count equality is asserted here. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +/-- Elementary arithmetic behind rationality after extension of constants. -/ +theorem div_gcd_eq_one_iff_dvd (r d : ℕ) (hd : 0 < d) : + d / Nat.gcd r d = 1 ↔ d ∣ r := by + constructor + · intro h + have heq : d = Nat.gcd r d * 1 := + Nat.eq_mul_of_div_eq_right (Nat.gcd_dvd_right r d) h + have hgcd : Nat.gcd r d = d := by simpa using heq.symm + exact Nat.gcd_eq_right_iff_dvd.mp hgcd + · intro h + rw [Nat.gcd_eq_right_iff_dvd.mpr h] + exact Nat.div_self hd + +/-- The degree after extending constants divides an extension level exactly +when the original closed-place degree divides the multiplied level. -/ +theorem div_gcd_dvd_iff_dvd_mul + (extensionDegree placeDegree level : ℕ) + (hextension : 0 < extensionDegree) : + placeDegree / Nat.gcd extensionDegree placeDegree ∣ level ↔ + placeDegree ∣ extensionDegree * level := by + let g := Nat.gcd extensionDegree placeDegree + have hgpos : 0 < g := Nat.gcd_pos_of_pos_left placeDegree hextension + have hgPlace : g ∣ placeDegree := Nat.gcd_dvd_right _ _ + have hgExtension : g ∣ extensionDegree := Nat.gcd_dvd_left _ _ + have hplace : g * (placeDegree / g) = placeDegree := + Nat.mul_div_cancel' hgPlace + have hext : g * (extensionDegree / g) = extensionDegree := + Nat.mul_div_cancel' hgExtension + have hcoprime : + (placeDegree / g).Coprime (extensionDegree / g) := + (Nat.coprime_div_gcd_div_gcd hgpos).symm + constructor + · intro h + have hdiv : placeDegree / g ∣ (extensionDegree / g) * level := + hcoprime.dvd_mul_left.mpr h + have hmul : g * (placeDegree / g) ∣ + g * ((extensionDegree / g) * level) := + (Nat.mul_dvd_mul_iff_left hgpos).mpr hdiv + simpa only [hplace, ← Nat.mul_assoc, hext] using hmul + · intro h + have hmul : g * (placeDegree / g) ∣ + g * ((extensionDegree / g) * level) := by + simpa only [hplace, ← Nat.mul_assoc, hext] using h + have hdiv : placeDegree / g ∣ (extensionDegree / g) * level := + (Nat.mul_dvd_mul_iff_left hgpos).mp hmul + exact hcoprime.dvd_mul_left.mp hdiv + +/-- Abstract finite-fiber form of the constant-extension contribution +identity. If every object above `P` has degree `deg(P) / gcd(r, deg(P))` +and there are exactly `gcd(r, deg(P))` such objects, then the total degrees +in the two finite families agree. -/ +theorem sum_degree_eq_sum_degree_of_div_gcd_and_fiber_card + {Base Up : Type*} [Fintype Base] [Fintype Up] + (down : Up → Base) (baseDegree : Base → ℕ) (upDegree : Up → ℕ) + (extensionDegree : ℕ) + (hdegree : ∀ Q, upDegree Q = + baseDegree (down Q) / + Nat.gcd extensionDegree (baseDegree (down Q))) + (hfiber : ∀ P, Nat.card {Q : Up // down Q = P} = + Nat.gcd extensionDegree (baseDegree P)) : + (∑ Q, upDegree Q) = ∑ P, baseDegree P := by + classical + letI : DecidableEq Base := Classical.decEq Base + calc + (∑ Q, upDegree Q) = + ∑ z : Σ P, {Q : Up // down Q = P}, upDegree z.2.1 := by + apply Fintype.sum_equiv (Equiv.sigmaFiberEquiv down).symm + intro Q + rfl + _ = ∑ P, ∑ Q : {Q : Up // down Q = P}, upDegree Q.1 := + Fintype.sum_sigma _ + _ = ∑ P, Fintype.card {Q : Up // down Q = P} * + (baseDegree P / + Nat.gcd extensionDegree (baseDegree P)) := by + apply Finset.sum_congr rfl + intro P _ + apply Finset.sum_const_nat + intro Q _ + rw [hdegree, Q.2] + _ = ∑ P, Nat.gcd extensionDegree (baseDegree P) * + (baseDegree P / + Nat.gcd extensionDegree (baseDegree P)) := by + simp_rw [← Nat.card_eq_fintype_card, hfiber] + _ = ∑ P, baseDegree P := by + apply Finset.sum_congr rfl + intro P _ + exact Nat.mul_div_cancel' (Nat.gcd_dvd_right _ _) + +/-- Bounded divisor-support form of the preceding fiber identity. It is the +exact combinatorial interface used by closed-place extension counts: the map +between all places need not have finite domain, because the two degree-bounded +families are supplied as finite types. -/ +theorem sum_degree_dvd_eq_sum_degree_dvd_of_div_gcd_fibers + {Base Up : Type*} + (down : Up → Base) (baseDegree : Base → ℕ) (upDegree : Up → ℕ) + (extensionDegree level : ℕ) + (hextension : 0 < extensionDegree) (hlevel : 0 < level) + [Fintype {P : Base // baseDegree P ≤ extensionDegree * level}] + [Fintype {Q : Up // upDegree Q ≤ level}] + (hdegree : ∀ Q, upDegree Q = + baseDegree (down Q) / + Nat.gcd extensionDegree (baseDegree (down Q))) + (hfiber : ∀ P, Nat.card {Q : Up // down Q = P} = + Nat.gcd extensionDegree (baseDegree P)) : + (∑ Q : {Q : {Q : Up // upDegree Q ≤ level} // + upDegree Q.1 ∣ level}, upDegree Q.1.1) = + ∑ P : {P : {P : Base // + baseDegree P ≤ extensionDegree * level} // + baseDegree P.1 ∣ extensionDegree * level}, + baseDegree P.1.1 := by + classical + let BaseLE := {P : Base // baseDegree P ≤ extensionDegree * level} + let UpLE := {Q : Up // upDegree Q ≤ level} + let BaseDvd := {P : BaseLE // + baseDegree P.1 ∣ extensionDegree * level} + let UpDvd := {Q : UpLE // upDegree Q.1 ∣ level} + let downDvd : UpDvd → BaseDvd := fun Q => by + have hdiv : baseDegree (down Q.1.1) ∣ extensionDegree * level := + (div_gcd_dvd_iff_dvd_mul extensionDegree + (baseDegree (down Q.1.1)) level hextension).mp (by + rw [← hdegree Q.1.1] + exact Q.2) + exact ⟨⟨down Q.1.1, + Nat.le_of_dvd (Nat.mul_pos hextension hlevel) hdiv⟩, hdiv⟩ + have hdownDvd (Q : UpDvd) : (downDvd Q).1.1 = down Q.1.1 := rfl + have hfiberDvd (P : BaseDvd) : + Nat.card {Q : UpDvd // downDvd Q = P} = + Nat.gcd extensionDegree (baseDegree P.1.1) := by + let e : {Q : UpDvd // downDvd Q = P} ≃ + {Q : Up // down Q = P.1.1} := + { toFun := fun Q => ⟨Q.1.1.1, by + have h := congrArg (fun R : BaseDvd => R.1.1) Q.2 + exact h⟩ + invFun := fun Q => by + have hbaseDiv : baseDegree (down Q.1) ∣ + extensionDegree * level := by + simpa only [Q.2] using P.2 + have hupDiv : upDegree Q.1 ∣ level := by + rw [hdegree] + exact (div_gcd_dvd_iff_dvd_mul extensionDegree + (baseDegree (down Q.1)) level hextension).mpr hbaseDiv + let qDvd : UpDvd := ⟨⟨Q.1, + Nat.le_of_dvd hlevel hupDiv⟩, hupDiv⟩ + refine ⟨qDvd, ?_⟩ + apply Subtype.ext + apply Subtype.ext + exact Q.2 + left_inv := fun Q => by + apply Subtype.ext + apply Subtype.ext + apply Subtype.ext + rfl + right_inv := fun Q => by + apply Subtype.ext + rfl } + calc + Nat.card {Q : UpDvd // downDvd Q = P} = + Nat.card {Q : Up // down Q = P.1.1} := Nat.card_congr e + _ = Nat.gcd extensionDegree (baseDegree P.1.1) := hfiber P.1.1 + apply sum_degree_eq_sum_degree_of_div_gcd_and_fiber_card + downDvd (fun P : BaseDvd => baseDegree P.1.1) + (fun Q : UpDvd => upDegree Q.1.1) extensionDegree + · intro Q + simpa only [hdownDvd] using hdegree Q.1.1 + · exact hfiberDvd + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +-- The infinity bridge fixes classical decidable equality locally. Reusing +-- the same definitions keeps its dependent place types definitionally equal +-- to the exhaustive place types in this file. +local instance (priority := 10000) closedPlaceRatFuncBaseDecidableEq : + DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + +local instance (priority := 10000) closedPlaceRatFuncConstantsDecidableEq : + DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + +local instance closedPlaceBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance closedPlaceTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +/-- Reciprocal-affine primes used to present places above infinity. The +local algebra structure sends the polynomial variable to `X⁻¹`, exactly as +in `ConstantExtensionInfinityPlaceBridge`. -/ +abbrev ExactConstantExtensionPresentedInfinityPlace := + letI : Algebra C[X] N := + infinityBridgeBaseReciprocalPolynomialAlgebra C N + letI : IsScalarTower C C[X] N := + infinityBridgeBaseConstantPolynomialTower C N + letI : Algebra C (integralClosure C[X] N) := + infinityBridgeOldNormalizationConstantAlgebra C N + letI : IsScalarTower C C[X] (integralClosure C[X] N) := + infinityBridgeOldNormalizationConstantPolynomialTower C N + letI : Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + infinityBridgeTensorPolynomialAlgebra C S N + {q : IsDedekindDomain.HeightOneSpectrum + (S ⊗[C] integralClosure C[X] N) // + q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])} + +/-- A common presentation of finite and infinity places in the explicit +normalizations used by the two constant-extension bridge files. -/ +abbrev ExactConstantExtensionPresentedPlace := + Sum + (IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) + (ExactConstantExtensionPresentedInfinityPlace C S N) + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The actual upstairs exhaustive place represented by a finite or +reciprocal-infinity normalization prime. -/ +noncomputable def exactConstantExtensionPresentedUpstairsPlace + (q : ExactConstantExtensionPresentedPlace C S N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + FiniteExtensionPlace S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + cases q with + | inl q => + exact .inl (exactConstantExtensionUpstairsFinitePlace + C S N hExact q) + | inr q => + exact .inr (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2) + +/-- The actual downstairs exhaustive place obtained by contraction. -/ +noncomputable def exactConstantExtensionPresentedDownstairsPlace + (q : ExactConstantExtensionPresentedPlace C S N) : + FiniteExtensionPlace C N := by + cases q with + | inl q => + exact .inl (exactConstantExtensionDownstairsFinitePlace + C S N hExact q) + | inr q => + exact .inr (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2) + +/-- The finite and infinity residue-degree formulas combine into one formula +on presented exhaustive places. -/ +theorem exactConstantExtensionPresentedPlace_degree_eq_div_gcd + (q : ExactConstantExtensionPresentedPlace C S N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (exactConstantExtensionPresentedUpstairsPlace C S N hExact q) = + finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) / + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace + C S N hExact q)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + cases q with + | inl q => + exact exactConstantExtensionFinitePlace_degree_eq_div_gcd + C S N hExact q + | inr q => + exact exactConstantExtensionInfinityPlace_degree_eq_div_gcd + C S N hExact q.1 q.2 + +/-- A presented upstairs place is rational over `S` exactly when its +downstairs degree divides the constant-extension degree. -/ +theorem exactConstantExtensionPresentedPlace_degree_eq_one_iff_dvd + (q : ExactConstantExtensionPresentedPlace C S N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (exactConstantExtensionPresentedUpstairsPlace C S N hExact q) = 1 ↔ + finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) ∣ + Module.finrank C S := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + rw [exactConstantExtensionPresentedPlace_degree_eq_div_gcd] + exact div_gcd_eq_one_iff_dvd + (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q)) + (finiteExtensionPlaceDegree_pos C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q)) + +/-- Presented rational places are the same subtype as presented places whose +downstairs degree contributes to the closed-place extension coefficient. -/ +def exactConstantExtensionPresentedRationalPlaceEquivDegreeDvd : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + {q : ExactConstantExtensionPresentedPlace C S N // + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (exactConstantExtensionPresentedUpstairsPlace C S N hExact q) = 1} ≃ + {q : ExactConstantExtensionPresentedPlace C S N // + finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) ∣ + Module.finrank C S} := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exact Equiv.subtypeEquivRight fun q => + exactConstantExtensionPresentedPlace_degree_eq_one_iff_dvd + C S N hExact q + +/-- Pointwise equality between the closed-place contribution and the +rational-presented-place indicator. -/ +theorem exactConstantExtensionPresentedPlace_closedContribution_eq + (q : ExactConstantExtensionPresentedPlace C S N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + (if finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (exactConstantExtensionPresentedUpstairsPlace C S N hExact q) = 1 + then finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) + else 0) = + (if finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) ∣ + Module.finrank C S + then finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) + else 0) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + by_cases hrat : finiteExtensionPlaceDegree S + (ExactConstantExtension C N S) + (exactConstantExtensionPresentedUpstairsPlace C S N hExact q) = 1 + · have hdiv := + (exactConstantExtensionPresentedPlace_degree_eq_one_iff_dvd + C S N hExact q).mp hrat + simp [hrat, hdiv] + · have hndiv : ¬ finiteExtensionPlaceDegree C N + (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) ∣ + Module.finrank C S := by + intro hdiv + exact hrat + ((exactConstantExtensionPresentedPlace_degree_eq_one_iff_dvd + C S N hExact q).mpr hdiv) + simp [hrat, hndiv] + +/-- Public unfolding of the closed-place extension coefficient. -/ +theorem finiteExtensionClosedPlaceExtensionCount_eq_degreeDvdSum + (r : ℕ) : + finiteExtensionClosedPlaceExtensionCount C N r = + letI := finiteExtensionPlaceDegreeLEFintype C N r + ∑ P : {P : FiniteExtensionPlace C N // + finiteExtensionPlaceDegree C N P ≤ r}, + if finiteExtensionPlaceDegree C N P.1 ∣ r then + finiteExtensionPlaceDegree C N P.1 else 0 := by + rfl + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean new file mode 100644 index 0000000000..4827edbd41 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean @@ -0,0 +1,755 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower + +/-! +# Closed-place splitting formula for an exact extension of constants + +This file supplies the exhaustive presentation equivalences needed to sum +the local constant-extension splitting laws over all closed places. + +The finite branch is recorded first, then the reciprocal-infinity branch is +transported to actual places. Their exact sum-branch fiber equivalence gives +the global gcd splitting law and the closed-place degree-extension identity. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +section FinitePresentation + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance splittingFormulaBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance splittingFormulaBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance splittingFormulaTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The explicit `S[X]`-normalization presentation exhausts the actual +finite places over the enlarged rational function field `S(X)`. + +The first equivalence presents the same primes as places over `C(X)`; the +second is the finite-normalization base-change equivalence from `C` to `S`. +-/ +noncomputable def exactConstantExtensionPresentedUpstairsFinitePlaceEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) ≃ + FiniteExtensionFinitePlace S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + let first := exactConstantExtensionPresentedFinitePlaceEquiv + C S N hExact + let second := IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact)) + exact first.trans second + +/-- The exhaustive finite-place equivalence is definitionally the existing +upstairs finite-place construction on presented primes. -/ +@[simp] +theorem exactConstantExtensionPresentedUpstairsFinitePlaceEquiv_apply + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exactConstantExtensionPresentedUpstairsFinitePlaceEquiv + C S N hExact q = + exactConstantExtensionUpstairsFinitePlace C S N hExact q := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + change IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact)) + (exactConstantExtensionPresentedFinitePlaceEquiv C S N hExact q) = _ + rw [exactConstantExtensionPresentedFinitePlaceEquiv_apply] + exact exactConstantExtensionCompatibleBaseFinitePlace_baseChange + C S N hExact q + +/-- Every downstairs finite place has the standard gcd number of presented +finite places above it. Unlike the selected-prime form of the splitting +theorem, this statement is indexed by an arbitrary downstairs place and is +therefore ready for fiberwise summation. -/ +theorem exactConstantExtensionPresentedFinitePlaceFiber_natCard_eq_gcd_of_downstairs + (P : FiniteExtensionFinitePlace C N) : + Nat.card {q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) // + exactConstantExtensionDownstairsFinitePlace C S N hExact q = P} = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inl P)) := by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : SMul N E := Algebra.toSMul + letI : Module N E := Algebra.toModule + letI : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective C N E P + let Q₀ : FinitePlaceUnderFiber C N E P := ⟨Q, hQ⟩ + let e := exactConstantExtensionPresentedFinitePlaceFiberEquiv + C S N hExact P + let q₀ := e.symm Q₀ + have hselected := + exactConstantExtensionPresentedFinitePlaceFiber_natCard_eq_gcd + C S N hExact q₀.1 + simpa only [q₀.2] using hselected + +end FinitePresentation + +section InfinityPresentation + + +private theorem splittingFormulaReciprocalPolynomialAlgebra_map + (K L : Type*) [Field K] [Field L] + [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) L] (p : K[X]) : + letI : Algebra K[X] L := + ratFuncExtensionReciprocalPolynomialAlgebra K L + algebraMap K[X] L p = algebraMap (RatFunc K) L + (((reciprocalPolynomialRingHom K p : + RatFuncInfinityIntegers K) : RatFunc K)) := by + letI : Algebra K[X] L := + ratFuncExtensionReciprocalPolynomialAlgebra K L + change algebraMap (RatFuncInfinityIntegers K) L + (reciprocalPolynomialRingHom K p) = _ + exact IsScalarTower.algebraMap_apply + (RatFuncInfinityIntegers K) (RatFunc K) L _ + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) splittingFormulaBaseRatFuncDecidableEq : + DecidableEq (RatFunc C) := + closedPlaceRatFuncBaseDecidableEq C + +local instance (priority := 10000) splittingFormulaTargetRatFuncDecidableEq : + DecidableEq (RatFunc S) := + closedPlaceRatFuncConstantsDecidableEq S + +local instance splittingFormulaInfinityBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance splittingFormulaInfinityBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance splittingFormulaBaseReciprocalPolynomialAlgebra : + Algebra C[X] N := + infinityBridgeBaseReciprocalPolynomialAlgebra C N + +local instance splittingFormulaBaseReciprocalConstantTower : + IsScalarTower C C[X] N := + infinityBridgeBaseConstantPolynomialTower C N + +local instance splittingFormulaOldNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + infinityBridgeOldNormalizationConstantAlgebra C N + +local instance splittingFormulaOldNormalizationConstantTower : + IsScalarTower C C[X] (integralClosure C[X] N) := + infinityBridgeOldNormalizationConstantPolynomialTower C N + +local instance splittingFormulaTensorReciprocalPolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + infinityBridgeTensorPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The reciprocal-normalization presentation exhausts the actual infinity +places of the exact constant extension over the enlarged constant field +`S`. The equivalence first transports the reciprocal affine prime to the +`S[X]`-normalization, then localizes at the reciprocal origin. -/ +noncomputable def exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv : + ExactConstantExtensionPresentedInfinityPlace C S N ≃ + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + FiniteExtensionInfinityPlace S (ExactConstantExtension C N S) := by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + let R := S ⊗[C] integralClosure C[X] N + let A := integralClosure S[X] E + let V := RatFuncInfinityIntegers S + let B := RatFuncInfinityIntegralClosure S E + let o := Ideal.span ({Polynomial.X} : Set S[X]) + let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + let eH := heightOneSpectrumEquivOfAlgEquiv e + let first : ExactConstantExtensionPresentedInfinityPlace C S N ≃ + {q : IsDedekindDomain.HeightOneSpectrum A // + q.asIdeal.under S[X] = o} := by + apply eH.subtypeEquiv + intro q + change q.asIdeal.under S[X] = o ↔ + (eH q).asIdeal.under S[X] = o + have hUnder : (eH q).asIdeal.under S[X] = + q.asIdeal.under S[X] := by + ext p + change e.symm _ ∈ q.asIdeal ↔ _ ∈ q.asIdeal + rw [e.symm.commutes] + rw [hUnder] + have ho : o ≠ ⊥ := by + exact fun h => Polynomial.X_ne_zero + (Ideal.span_singleton_eq_bot.mp h) + letI : o.IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr + Polynomial.prime_X + letI : Algebra S[X] (RatFunc S) := + ratFuncExtensionReciprocalPolynomialAlgebra S (RatFunc S) + letI : SMul S[X] (RatFunc S) := Algebra.toSMul + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq fun p => by + calc + algebraMap S[X] E p = + algebraMap (RatFunc S) E + (((reciprocalPolynomialRingHom S p : + RatFuncInfinityIntegers S) : RatFunc S)) := + splittingFormulaReciprocalPolynomialAlgebra_map S E p + _ = algebraMap (RatFunc S) E + (algebraMap S[X] (RatFunc S) p) := by + rw [splittingFormulaReciprocalPolynomialAlgebra_map + S (RatFunc S) p] + exact congrArg (algebraMap (RatFunc S) E) + (Algebra.algebraMap_self_apply _).symm + letI : IsFractionRing S[X] (RatFunc S) := + ratFunc_isFractionRing_reciprocalPolynomial S + letI : IsDedekindDomain A := + IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E A + letI : Module S[X] A := Algebra.toModule + letI : Module.IsTorsionFree S[X] E := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro x y hxy + apply IsFractionRing.injective S[X] (RatFunc S) + apply (algebraMap (RatFunc S) E).injective + simpa only [IsScalarTower.algebraMap_apply S[X] (RatFunc S) E] + using hxy + letI : IsScalarTower S[X] A E := by infer_instance + letI : Module.IsTorsionFree S[X] A := + IsIntegralClosure.isTorsionFree S[X] E + let origin : IsDedekindDomain.HeightOneSpectrum S[X] := + ⟨o, inferInstance, ho⟩ + let second : {q : IsDedekindDomain.HeightOneSpectrum A // + q.asIdeal.under S[X] = o} ≃ o.primesOver A := + { toFun := fun q => ⟨q.1.asIdeal, q.1.isPrime, ⟨q.2.symm⟩⟩ + invFun := fun P => ⟨primeOverHeightOne origin P, by + exact (Ideal.over_def P.1 o).symm⟩ + left_inv := by + intro q + apply Subtype.ext + apply IsDedekindDomain.HeightOneSpectrum.ext + rfl + right_inv := by + intro P + apply Subtype.ext + rfl } + letI : Algebra S[X] V := + ratFuncInfinityReciprocalPolynomialAlgebra S + letI : IsLocalization o.primeCompl V := + ratFuncInfinityIntegers_isLocalization_reciprocal S + letI : Algebra A B := + ratFuncInfinityReciprocalIntegralClosureAlgebra S E + letI : SMul A B := Algebra.toSMul + letI : IsLocalization + (Algebra.algebraMapSubmonoid A o.primeCompl) B := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal S E + letI : Algebra S[X] B := + RingHom.toAlgebra + ((algebraMap V B).comp (algebraMap S[X] V)) + letI : IsScalarTower S[X] V B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower S[X] A B := + IsScalarTower.of_algebraMap_eq fun p => by + apply Subtype.ext + rfl + let third : o.primesOver A ≃ FiniteExtensionInfinityPlace S E := by + change o.primesOver A ≃ + (IsLocalRing.maximalIdeal V).primesOver B + exact (IsDedekindDomain.primesOverEquivPrimesOver + o V B ho).toEquiv + exact first.trans (second.trans third) + +omit [DecidableEq C] in +/-- On a reciprocal affine prime, the exhaustive equivalence is exactly the +existing upstairs infinity-place construction. -/ +@[simp] +theorem exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv_apply + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv + C S N hExact q = + exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2 := by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + apply Subtype.ext + rfl + +include hExact + +omit [DecidableEq C] [DecidableEq S] in +/-- Every downstairs infinity place has the standard gcd number of presented +reciprocal-normalization places above it. This removes the selected-prime +index from the infinity splitting theorem and makes it ready for global +fiberwise summation. -/ +theorem exactConstantExtensionPresentedInfinityPlaceFiber_natCard_eq_gcd_of_downstairs : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + (P : FiniteExtensionInfinityPlace C N) → + Nat.card {q : ExactConstantExtensionPresentedInfinityPlace C S N // + exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 = P} = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inr P)) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + intro P + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : SMul N E := Algebra.toSMul + letI : Module N E := Algebra.toModule + letI : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective C N E P + let Q₀ : InfinityPlaceUnderFiber C N E P := ⟨Q, hQ⟩ + let e := exactConstantExtensionPresentedInfinityPlaceFiberEquiv + C S N hExact P + let q₀ := e.symm Q₀ + have hselected := + exactConstantExtensionPresentedInfinityPlaceFiber_natCard_eq_gcd + C S N hExact q₀.1 + simpa only [q₀.2] using hselected + +end InfinityPresentation + +section GlobalPresentation + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) globalPresentationBaseRatFuncDecidableEq : + DecidableEq (RatFunc C) := + closedPlaceRatFuncBaseDecidableEq C + +local instance (priority := 10000) globalPresentationTargetRatFuncDecidableEq : + DecidableEq (RatFunc S) := + closedPlaceRatFuncConstantsDecidableEq S + +local instance globalPresentationBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance globalPresentationBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance globalPresentationTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The finite-normalization and reciprocal-normalization presentations +together exhaust all actual closed places of the exact constant extension +over `S`. -/ +noncomputable def exactConstantExtensionPresentedUpstairsPlaceEquiv : + ExactConstantExtensionPresentedPlace C S N ≃ + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + FiniteExtensionPlace S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exact Equiv.sumCongr + (exactConstantExtensionPresentedUpstairsFinitePlaceEquiv + C S N hExact) + (exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv + C S N hExact) + +/-- The global exhaustive equivalence agrees branchwise with the existing +presented-upstairs-place construction. -/ +@[simp] +theorem exactConstantExtensionPresentedUpstairsPlaceEquiv_apply + (q : ExactConstantExtensionPresentedPlace C S N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exactConstantExtensionPresentedUpstairsPlaceEquiv C S N hExact q = + exactConstantExtensionPresentedUpstairsPlace C S N hExact q := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + cases q with + | inl q => + change Sum.inl + (exactConstantExtensionPresentedUpstairsFinitePlaceEquiv + C S N hExact q) = + Sum.inl + (exactConstantExtensionUpstairsFinitePlace C S N hExact q) + exact congrArg Sum.inl + (exactConstantExtensionPresentedUpstairsFinitePlaceEquiv_apply + C S N hExact q) + | inr q => + change Sum.inr + (exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv + C S N hExact q) = + Sum.inr + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2) + exact congrArg Sum.inr + (exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv_apply + C S N hExact q) + +include hExact + +omit [DecidableEq C] [DecidableEq S] in +/-- The contraction fiber of the combined finite-plus-infinity presentation +over an arbitrary downstairs closed place has the standard gcd cardinality. +The proof is an exact branchwise fiber equivalence, so finite and infinity +places cannot be mixed by the presentation map. -/ +theorem exactConstantExtensionPresentedPlaceFiber_natCard_eq_gcd_of_downstairs : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + (P : FiniteExtensionPlace C N) → + Nat.card {q : ExactConstantExtensionPresentedPlace C S N // + exactConstantExtensionPresentedDownstairsPlace + C S N hExact q = P} = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N P) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + intro P + cases P with + | inl P => + let e : {q : ExactConstantExtensionPresentedPlace C S N // + exactConstantExtensionPresentedDownstairsPlace + C S N hExact q = .inl P} ≃ + {q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) // + exactConstantExtensionDownstairsFinitePlace + C S N hExact q = P} := + { toFun := fun q => by + rcases q with ⟨q, hq⟩ + cases q with + | inl q => + refine ⟨q, ?_⟩ + exact Sum.inl.inj hq + | inr q => + change Sum.inr _ = Sum.inl P at hq + exact (Sum.inr_ne_inl hq).elim + invFun := fun q => + ⟨.inl q.1, congrArg Sum.inl q.2⟩ + left_inv := by + intro q + apply Subtype.ext + rcases q with ⟨q, hq⟩ + cases q with + | inl q => rfl + | inr q => + change Sum.inr _ = Sum.inl P at hq + exact (Sum.inr_ne_inl hq).elim + right_inv := by + intro q + apply Subtype.ext + rfl } + calc + Nat.card {q : ExactConstantExtensionPresentedPlace C S N // + exactConstantExtensionPresentedDownstairsPlace + C S N hExact q = .inl P} = + Nat.card {q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) // + exactConstantExtensionDownstairsFinitePlace + C S N hExact q = P} := Nat.card_congr e + _ = Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inl P)) := + exactConstantExtensionPresentedFinitePlaceFiber_natCard_eq_gcd_of_downstairs + C S N hExact P + | inr P => + let e : {q : ExactConstantExtensionPresentedPlace C S N // + exactConstantExtensionPresentedDownstairsPlace + C S N hExact q = .inr P} ≃ + {q : ExactConstantExtensionPresentedInfinityPlace C S N // + exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 = P} := + { toFun := fun q => by + rcases q with ⟨q, hq⟩ + cases q with + | inl q => + change Sum.inl _ = Sum.inr P at hq + exact (Sum.inl_ne_inr hq).elim + | inr q => + refine ⟨q, ?_⟩ + exact Sum.inr.inj hq + invFun := fun q => + ⟨.inr q.1, congrArg Sum.inr q.2⟩ + left_inv := by + intro q + apply Subtype.ext + rcases q with ⟨q, hq⟩ + cases q with + | inl q => + change Sum.inl _ = Sum.inr P at hq + exact (Sum.inl_ne_inr hq).elim + | inr q => rfl + right_inv := by + intro q + apply Subtype.ext + rfl } + calc + Nat.card {q : ExactConstantExtensionPresentedPlace C S N // + exactConstantExtensionPresentedDownstairsPlace + C S N hExact q = .inr P} = + Nat.card {q : ExactConstantExtensionPresentedInfinityPlace C S N // + exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 = P} := Nat.card_congr e + _ = Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inr P)) := + exactConstantExtensionPresentedInfinityPlaceFiber_natCard_eq_gcd_of_downstairs + C S N hExact P + +omit [DecidableEq C] [DecidableEq S] in +/-- Exact closed-place count identity for an extension of constants. At +level `n`, the exhaustive closed-place count over `S` is the original count +at level `[S : C] * n`. The proof transfers the bounded upstairs family +through the exhaustive presentation equivalence and sums the degree and gcd +fiber formulas. -/ +theorem exactConstantExtensionClosedPlaceExtensionCount_eq + (level : ℕ) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Fintype S := Fintype.ofFinite S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + finiteExtensionClosedPlaceExtensionCount S + (ExactConstantExtension C N S) level = + finiteExtensionClosedPlaceExtensionCount C N + (Module.finrank C S * level) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Fintype S := Fintype.ofFinite S + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + by_cases hlevel : level = 0 + · subst level + simp + have hlevelPos : 0 < level := Nat.pos_of_ne_zero hlevel + let Base := FiniteExtensionPlace C N + let Up := ExactConstantExtensionPresentedPlace C S N + let Actual := FiniteExtensionPlace S E + let down : Up → Base := + exactConstantExtensionPresentedDownstairsPlace C S N hExact + let baseDegree : Base → ℕ := finiteExtensionPlaceDegree C N + let e : Up ≃ Actual := + exactConstantExtensionPresentedUpstairsPlaceEquiv C S N hExact + let upDegree : Up → ℕ := fun q => + finiteExtensionPlaceDegree S E (e q) + let BaseLE := {P : Base // + baseDegree P ≤ Module.finrank C S * level} + let UpLE := {q : Up // upDegree q ≤ level} + let ActualLE := {Q : Actual // + finiteExtensionPlaceDegree S E Q ≤ level} + letI : Fintype BaseLE := + finiteExtensionPlaceDegreeLEFintype C N + (Module.finrank C S * level) + letI : Fintype ActualLE := + finiteExtensionPlaceDegreeLEFintype S E level + let eLE : UpLE ≃ ActualLE := + Equiv.subtypeEquiv e (fun _ => Iff.rfl) + letI : Fintype UpLE := Fintype.ofEquiv ActualLE eLE.symm + let UpDvd := {q : UpLE // upDegree q.1 ∣ level} + let ActualDvd := {Q : ActualLE // + finiteExtensionPlaceDegree S E Q.1 ∣ level} + let eDvd : UpDvd ≃ ActualDvd := + Equiv.subtypeEquiv eLE (fun _ => Iff.rfl) + have hsumPresented : + (∑ q : UpDvd, upDegree q.1.1) = + ∑ P : {P : BaseLE // + baseDegree P.1 ∣ Module.finrank C S * level}, + baseDegree P.1.1 := by + apply sum_degree_dvd_eq_sum_degree_dvd_of_div_gcd_fibers + down baseDegree upDegree (Module.finrank C S) level + Module.finrank_pos hlevelPos + · intro q + change finiteExtensionPlaceDegree S E (e q) = + finiteExtensionPlaceDegree C N (down q) / + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (down q)) + dsimp [e, down] + rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] + exact exactConstantExtensionPresentedPlace_degree_eq_div_gcd + C S N hExact q + · intro P + exact exactConstantExtensionPresentedPlaceFiber_natCard_eq_gcd_of_downstairs + C S N hExact P + have hsumEquiv : + (∑ q : UpDvd, upDegree q.1.1) = + ∑ Q : ActualDvd, + finiteExtensionPlaceDegree S E Q.1.1 := by + apply Fintype.sum_equiv eDvd + intro q + rfl + rw [finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd, + finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd] + exact hsumEquiv.symm.trans hsumPresented + +end GlobalPresentation + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean new file mode 100644 index 0000000000..31c67800a0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +/-! +# Finite places in an exact constant extension + +Let `N / C(X)` be finite separable with exact constant field `C`, and let `S / C` +be finite Galois. This file connects maximal ideals in the explicit +normalization of `S ⊗[C] N` to the project's finite-place types over `S` and +`C`. It proves that the upstairs residue field is finite, packages the +downstairs contraction as an actual finite place of `N`, and expresses the +constant-extension residue formula as + +`deg_S(Q) = deg_C(P) / gcd([S : C], deg_C(P))`. + +No maximality or residue-finiteness hypothesis is left to downstream users. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance bridgeBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance (priority := 10000) bridgeBasePolynomialAlgebra : Algebra C[X] N := + ratFuncInducedPolynomialAlgebra C N + +local instance bridgeBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' (by + ext c + rfl) + +local instance (priority := 10000) bridgeTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + constantExtensionTensorPolynomialAlgebra C S N + +local instance (priority := 10000) bridgeTensorNormalizationPolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + constantExtensionNormalizationTensorPolynomialAlgebra C S N + +local instance bridgeUpstairsConstantAlgebra : + Algebra S + (integralClosure S[X] (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] + (integralClosure S[X] (ExactConstantExtension C N S))).comp + (algebraMap S S[X])) + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- A ring equivalence transports the residue field of a height-one ideal. -/ +private noncomputable def heightOneResidueFieldRingEquiv + {A B : Type*} [CommRing A] [CommRing B] + (e : A ≃+* B) (q : IsDedekindDomain.HeightOneSpectrum A) : + q.asIdeal.ResidueField ≃+* + (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q).asIdeal.ResidueField := + Ideal.residueFieldRingEquiv q.asIdeal + (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q).asIdeal e + (by + change q.asIdeal = (q.asIdeal.comap e.symm).comap e + exact (Ideal.comap_of_equiv e).symm) + +/-- Pull an ideal in the explicit base-changed normalization back to the +constant tensor of the original normalization. -/ +noncomputable def exactConstantExtensionTensorNormalizationHeightOne + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + IsDedekindDomain.HeightOneSpectrum + (S ⊗[C] integralClosure C[X] N) := + heightOneSpectrumEquivOfAlgEquiv + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).symm q + +/-- Package a height-one ideal of the explicit normalization as an actual +finite place over `S`. -/ +noncomputable def exactConstantExtensionUpstairsFinitePlace + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + FiniteExtensionFinitePlace S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exact finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv + S (ExactConstantExtension C N S) + (S ⊗[C] integralClosure C[X] N) + (exactConstantExtensionNormalizationAlgEquiv C S N hExact) + (exactConstantExtensionTensorNormalizationHeightOne C S N q) + +include hExact + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] in +/-- The residue field of an upstairs height-one ideal is finite. -/ +theorem exactConstantExtensionUpstairsResidueField_finite + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + Finite q.asIdeal.ResidueField := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Fintype S := Fintype.ofFinite S + let qTensor := exactConstantExtensionTensorNormalizationHeightOne C S N q + let e₂ := exactConstantExtensionNormalizationAlgEquiv C S N hExact + let Q : FiniteExtensionFinitePlace S (ExactConstantExtension C N S) := + IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + e₂.toRingEquiv qTensor + letI : Finite Q.asIdeal.ResidueField := + finiteExtensionFinitePlaceResidueField_finite S + (ExactConstantExtension C N S) Q + let e₁ := finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N + let r₁ := heightOneResidueFieldRingEquiv e₁.symm.toRingEquiv q + let r₂ := heightOneResidueFieldRingEquiv e₂.toRingEquiv qTensor + exact Finite.of_injective (r₂ ∘ r₁) (r₂.injective.comp r₁.injective) + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] in +/-- Every upstairs height-one ideal is maximal. -/ +theorem exactConstantExtensionUpstairsIdeal_isMaximal + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + q.asIdeal.IsMaximal := by + letI : Finite q.asIdeal.ResidueField := + exactConstantExtensionUpstairsResidueField_finite C S N hExact q + letI : Finite + (integralClosure S[X] (ExactConstantExtension C N S) ⧸ q.asIdeal) := + Finite.of_injective + (algebraMap + (integralClosure S[X] (ExactConstantExtension C N S) ⧸ q.asIdeal) + q.asIdeal.ResidueField) + q.asIdeal.injective_algebraMap_quotient_residueField + exact (Ideal.Quotient.maximal_ideal_iff_isField_quotient q.asIdeal).mpr + (Finite.isField_of_domain + (integralClosure S[X] (ExactConstantExtension C N S) ⧸ q.asIdeal)) + +/-- Package the downstairs contraction as an actual finite place of `N/C(X)`. -/ +noncomputable def exactConstantExtensionDownstairsFinitePlace + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + FiniteExtensionFinitePlace C N := by + letI : Finite q.asIdeal.ResidueField := + exactConstantExtensionUpstairsResidueField_finite C S N hExact q + letI : q.asIdeal.IsMaximal := + exactConstantExtensionUpstairsIdeal_isMaximal C S N hExact q + let p := finiteFieldConstantExtensionDownstairsIdeal C S N q.asIdeal + letI : p.IsMaximal := + finiteFieldConstantExtensionDownstairsIdeal_isMaximal C S N q.asIdeal + change IsDedekindDomain.HeightOneSpectrum (integralClosure C[X] N) + exact + { asIdeal := p + isPrime := Ideal.IsMaximal.isPrime + (show p.IsMaximal from inferInstance) + ne_bot := Ring.ne_bot_of_isMaximal_of_not_isField + (show p.IsMaximal from inferInstance) + (by + intro hfield + have hinj : Function.Injective + (algebraMap C[X] (integralClosure C[X] N)) := by + intro x y hxy + apply RatFunc.algebraMap_injective C + apply (algebraMap (RatFunc C) N).injective + exact congrArg Subtype.val hxy + exact Polynomial.not_isField C + (isField_of_isIntegral_of_isField hinj hfield)) } + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] in +@[simp] +theorem exactConstantExtensionDownstairsFinitePlace_asIdeal + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + (exactConstantExtensionDownstairsFinitePlace C S N hExact q).asIdeal = + finiteFieldConstantExtensionDownstairsIdeal C S N q.asIdeal := + rfl + +/-- Constant extension changes the degree of an actual finite place by the +standard division-by-gcd formula. -/ +theorem exactConstantExtensionFinitePlace_degree_eq_div_gcd + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inl (exactConstantExtensionUpstairsFinitePlace C S N hExact q)) = + finiteExtensionPlaceDegree C N + (.inl (exactConstantExtensionDownstairsFinitePlace C S N hExact q)) / + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inl (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Finite q.asIdeal.ResidueField := + exactConstantExtensionUpstairsResidueField_finite C S N hExact q + letI : q.asIdeal.IsMaximal := + exactConstantExtensionUpstairsIdeal_isMaximal C S N hExact q + let A := S ⊗[C] integralClosure C[X] N + let T := ExactConstantExtension C N S + letI : Algebra S[X] A := + bridgeTensorNormalizationPolynomialAlgebra C S N + letI : Algebra S A := Algebra.TensorProduct.leftAlgebra + letI : Algebra S (RatFuncFiniteIntegralClosure S T) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S T)).comp + (algebraMap S S[X])) + letI : SMul S A := Algebra.toSMul + letI : SMul S (RatFuncFiniteIntegralClosure S T) := Algebra.toSMul + letI : SMul S[X] (RatFuncFiniteIntegralClosure S T) := Algebra.toSMul + letI : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S T) := + IsScalarTower.of_algebraMap_eq' rfl + let qTensor := exactConstantExtensionTensorNormalizationHeightOne C S N q + let Q := exactConstantExtensionUpstairsFinitePlace C S N hExact q + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + letI : (finiteFieldConstantExtensionTensorIdeal + C S N q.asIdeal).IsPrime := by + change qTensor.asIdeal.IsPrime + exact qTensor.isPrime + let p := finiteFieldConstantExtensionDownstairsIdeal C S N q.asIdeal + letI : p.IsMaximal := + finiteFieldConstantExtensionDownstairsIdeal_isMaximal C S N q.asIdeal + letI : p.IsPrime := Ideal.IsMaximal.isPrime + (show p.IsMaximal from inferInstance) + let e₂ := exactConstantExtensionNormalizationAlgEquiv C S N hExact + let e₂S : A ≃ₐ[S] RatFuncFiniteIntegralClosure S T := + { e₂.toRingEquiv with + commutes' := fun s => by + change e₂ (s ⊗ₜ[C] (1 : integralClosure C[X] N)) = + algebraMap S[X] (RatFuncFiniteIntegralClosure S T) (Polynomial.C s) + rw [← e₂.commutes (Polynomial.C s)] + congr 1 + change s ⊗ₜ[C] (1 : integralClosure C[X] N) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S + (integralClosure C[X] N)) (Polynomial.C s) + simp } + have hTensorToUpstairs : + Module.finrank S qTensor.asIdeal.ResidueField = + Module.finrank S q.asIdeal.ResidueField := by + change Module.finrank S + (finiteFieldConstantExtensionTensorIdeal C S N q.asIdeal).ResidueField = + Module.finrank S q.asIdeal.ResidueField + exact (finiteFieldConstantExtensionResidueFieldAlgEquiv + C S N q.asIdeal).toLinearEquiv.finrank_eq + have hTensorToPlace : + Module.finrank S qTensor.asIdeal.ResidueField = + Module.finrank S Q.asIdeal.ResidueField := by + exact heightOneSpectrum_residueField_finrank_eq e₂S qTensor + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField S T Q, + finiteExtensionFinitePlace_degree_eq_finrank_residueField C N P] + calc + Module.finrank S Q.asIdeal.ResidueField = + Module.finrank S qTensor.asIdeal.ResidueField := hTensorToPlace.symm + _ = Module.finrank S q.asIdeal.ResidueField := hTensorToUpstairs + _ = Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal C S N q.asIdeal).ResidueField / + Nat.gcd (Module.finrank C S) + (Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal + C S N q.asIdeal).ResidueField) := + finiteFieldConstantExtensionResidue_finrank_over_constants_eq_div_gcd + C S N q.asIdeal + _ = Module.finrank C P.asIdeal.ResidueField / + Nat.gcd (Module.finrank C S) + (Module.finrank C P.asIdeal.ResidueField) := by + rfl + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean new file mode 100644 index 0000000000..4e7b14db8b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean @@ -0,0 +1,982 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient + +/-! +# Infinity places in an exact constant extension + +This file localizes the reciprocal affine normalizations used by the exact +constant-extension model. A height-one prime of + +`S ⊗[C] integralClosure C[X] N` + +above the reciprocal origin gives actual places above infinity in both the +extended function field and the original function field. Their residue +degrees satisfy the usual division-by-gcd formula. +-/ + +open scoped Polynomial TensorProduct nonZeroDivisors + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain + + +section ReciprocalFractionField + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + +@[reducible] private noncomputable def canonicalRatFuncPolynomialAlgebra : + Algebra K[X] (RatFunc K) := inferInstance + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +private theorem canonicalRatFuncPolynomialFractionRing : + letI := canonicalRatFuncPolynomialAlgebra K + IsFractionRing K[X] (RatFunc K) := by + letI := canonicalRatFuncPolynomialAlgebra K + infer_instance + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +private theorem canonicalRatFuncPolynomialAlgebraMap_injective : + Function.Injective + (@algebraMap K[X] (RatFunc K) _ _ + (canonicalRatFuncPolynomialAlgebra K)) := by + letI := canonicalRatFuncPolynomialAlgebra K + exact RatFunc.algebraMap_injective K + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +private theorem canonicalRatFunc_div_surjective (z : RatFunc K) : + ∃ p q : K[X], q ≠ 0 ∧ z = + @algebraMap K[X] (RatFunc K) _ _ + (canonicalRatFuncPolynomialAlgebra K) p / + @algebraMap K[X] (RatFunc K) _ _ + (canonicalRatFuncPolynomialAlgebra K) q := by + letI := canonicalRatFuncPolynomialAlgebra K + letI : IsFractionRing K[X] (RatFunc K) := + canonicalRatFuncPolynomialFractionRing K + obtain ⟨p, q, hq, h⟩ := IsFractionRing.div_surjective K[X] z + exact ⟨p, q, nonZeroDivisors.ne_zero hq, h.symm⟩ + +local instance reciprocalRatFuncPolynomialAlgebra : + Algebra K[X] (RatFunc K) := + ratFuncExtensionReciprocalPolynomialAlgebra K (RatFunc K) + +local instance reciprocalRatFuncPolynomialSMul : SMul K[X] (RatFunc K) := + Algebra.toSMul + +local instance reciprocalRatFuncPolynomialModule : Module K[X] (RatFunc K) := + Algebra.toModule + +local instance reciprocalRatFuncPolynomialFaithful : + FaithfulSMul K[X] (RatFunc K) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro p q hpq + apply reciprocalPolynomialRingHom_injective K + apply Subtype.ext + exact hpq + +private theorem reciprocalRatFunc_algebraMap_eq_eval (p : K[X]) : + algebraMap K[X] (RatFunc K) p = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p := by + change algebraMap (RatFuncInfinityIntegers K) (RatFunc K) + (reciprocalPolynomialRingHom K p) = _ + change (((reciprocalPolynomialRingHom K p : + RatFuncInfinityIntegers K) : RatFunc K)) = _ + rw [reciprocalPolynomialRingHom_coe] + +/-- The reciprocal polynomial embedding `K[X] → K(X)`, sending the +polynomial variable to `X⁻¹`, still has `K(X)` as its fraction field. -/ +theorem ratFunc_isFractionRing_reciprocalPolynomial : + IsFractionRing K[X] (RatFunc K) := by + apply IsFractionRing.of_field K[X] (RatFunc K) + intro z + obtain ⟨p, q, hq0, hz⟩ := canonicalRatFunc_div_surjective K z + let x := p.reverse * Polynomial.X ^ q.natDegree + let y := q.reverse * Polynomial.X ^ p.natDegree + refine ⟨x, y, ?_⟩ + rw [reciprocalRatFunc_algebraMap_eq_eval K x, + reciprocalRatFunc_algebraMap_eq_eval K y] + dsimp only [x, y] + simp only [Polynomial.eval₂_mul, Polynomial.eval₂_pow, + Polynomial.eval₂_X] + have hp := eval_reciprocal_reverse_mul_X_pow K p + have hq := eval_reciprocal_reverse_mul_X_pow K q + let can : K[X] →+* RatFunc K := + @algebraMap K[X] (RatFunc K) _ _ + (canonicalRatFuncPolynomialAlgebra K) + have hcanq : can q ≠ 0 := by + simpa [can] using + (canonicalRatFuncPolynomialAlgebraMap_injective K).ne hq0 + have hevalq : + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) q.reverse ≠ 0 := by + intro hzero + apply hcanq + rw [← hq, hzero, zero_mul] + calc + z = can p / can q := hz + _ = (Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p.reverse * + (1 / RatFunc.X) ^ q.natDegree) / + (Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) q.reverse * + (1 / RatFunc.X) ^ p.natDegree) := by + rw [← hp, ← hq] + field_simp [RatFunc.X_ne_zero, hevalq] + simp [RatFunc.X_ne_zero] + +end ReciprocalFractionField + +section LocalizationHelpers + +private noncomputable def heightOneResidueFieldRingEquiv + {A B : Type*} [CommRing A] [CommRing B] + (e : A ≃+* B) (q : HeightOneSpectrum A) : + q.asIdeal.ResidueField ≃+* + (HeightOneSpectrum.equivOfRingEquiv e q).asIdeal.ResidueField := + Ideal.residueFieldRingEquiv q.asIdeal + (HeightOneSpectrum.equivOfRingEquiv e q).asIdeal e + (by + change q.asIdeal = (q.asIdeal.comap e.symm).comap e + exact (Ideal.comap_of_equiv e).symm) + +private theorem mappedPrimeCompl_disjoint_of_under_eq + (R A : Type*) [CommRing R] [CommRing A] [Algebra R A] + (p : Ideal R) [p.IsPrime] (q : Ideal A) + (hq : q.under R = p) : + Disjoint + ((Algebra.algebraMapSubmonoid A p.primeCompl : Submonoid A) : Set A) + (q : Set A) := by + rw [Set.disjoint_left] + intro x hxM hxq + obtain ⟨r, hr, rfl⟩ := hxM + exact hr (hq ▸ hxq) + +private theorem localizationMap_liesOver_maximalIdeal + (R V A B : Type*) + [CommRing R] [CommRing V] [CommRing A] [CommRing B] + [Algebra R V] [Algebra R A] [Algebra R B] + [Algebra V B] [Algebra A B] + [IsScalarTower R V B] [IsScalarTower R A B] + (p : Ideal R) [p.IsPrime] + [IsLocalization p.primeCompl V] [IsLocalRing V] + (q : Ideal A) (hqPrime : q.IsPrime) (hqUnder : q.under R = p) + [IsLocalization (Algebra.algebraMapSubmonoid A p.primeCompl) B] : + (Ideal.map (algebraMap A B) q).LiesOver + (IsLocalRing.maximalIdeal V) := by + let M := Algebra.algebraMapSubmonoid A p.primeCompl + have hdisj : Disjoint (M : Set A) (q : Set A) := + mappedPrimeCompl_disjoint_of_under_eq R A p q hqUnder + let Q := Ideal.map (algebraMap A B) q + have hQA : Q.under A = q := + IsLocalization.under_map_of_isPrime_disjoint M B hqPrime hdisj + rw [Ideal.liesOver_iff] + apply (IsLocalization.orderEmbedding p.primeCompl V).injective + calc + (IsLocalRing.maximalIdeal V).under R = p := + IsLocalization.AtPrime.under_maximalIdeal V p + _ = q.under R := hqUnder.symm + _ = Q.under R := + (congrArg (Ideal.under R) hQA).symm.trans (Ideal.under_under Q) + _ = (Q.under V).under R := Ideal.under_under Q |>.symm + +private noncomputable def localizationResidueFieldAlgEquiv + (K A B : Type*) + [Field K] [CommRing A] [CommRing B] + [Algebra K A] [Algebra K B] [Algebra A B] + [IsScalarTower K A B] + (M : Submonoid A) [IsLocalization M B] + (q : Ideal A) [q.IsPrime] + (hdisj : Disjoint (M : Set A) (q : Set A)) : + let Q := Ideal.map (algebraMap A B) q + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj + q.ResidueField ≃ₐ[K] Q.ResidueField := by + let Q := Ideal.map (algebraMap A B) q + letI hQPrime : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj + have hcomap : q = Q.under A := + (IsLocalization.under_map_of_isPrime_disjoint M B inferInstance hdisj).symm + let f : A →ₐ[K] B := IsScalarTower.toAlgHom K A B + let rf : q.ResidueField →ₐ[K] Q.ResidueField := + Ideal.ResidueField.mapₐ q Q f hcomap + apply AlgEquiv.ofBijective rf + exact (RingHom.surjectiveOnStalks_of_isLocalization M B) + |>.residueFieldMap_bijective q Q hcomap + +private noncomputable def localizationResidueFieldRingEquiv + (A B : Type*) [CommRing A] [CommRing B] [Algebra A B] + (M : Submonoid A) [IsLocalization M B] + (q : Ideal A) [q.IsPrime] + (hdisj : Disjoint (M : Set A) (q : Set A)) : + let Q := Ideal.map (algebraMap A B) q + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj + q.ResidueField ≃+* Q.ResidueField := by + let Q := Ideal.map (algebraMap A B) q + letI hQPrime : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj + have hcomap : q = Q.under A := + (IsLocalization.under_map_of_isPrime_disjoint M B inferInstance hdisj).symm + let f : q.ResidueField →+* Q.ResidueField := + Ideal.ResidueField.map q Q (algebraMap A B) hcomap + apply RingEquiv.ofBijective f + exact (RingHom.surjectiveOnStalks_of_isLocalization M B) + |>.residueFieldMap_bijective q Q hcomap + +private theorem finrank_eq_of_finite_ringEquiv + (K E F : Type*) [Field K] [Fintype K] + [Field E] [Field F] [Algebra K E] [Algebra K F] + [Finite E] [Finite F] (e : E ≃+* F) : + Module.finrank K E = Module.finrank K F := by + letI : Fintype E := Fintype.ofFinite E + letI : Fintype F := Fintype.ofFinite F + have hcard : Fintype.card E = Fintype.card F := + Fintype.card_congr e.toEquiv + rw [Module.card_eq_pow_finrank (K := K) (V := E), + Module.card_eq_pow_finrank (K := K) (V := F)] at hcard + exact Nat.pow_right_injective + (show 2 ≤ Fintype.card K from Fintype.one_lt_card) hcard + +private theorem actualInfinityPlaceResidueField_finite + (K L : Type*) [Field K] [Field L] + [DecidableEq K] [DecidableEq (RatFunc K)] + [Fintype K] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + (P : FiniteExtensionInfinityPlace K L) : + Finite P.1.ResidueField := by + letI : Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + letI : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + let p := (ratFuncInfinityPlace K).asIdeal + letI : Finite p.ResidueField := + Finite.of_injective (ratFuncInfinityPlaceResidueEquiv K) + (ratFuncInfinityPlaceResidueEquiv K).injective + letI : P.1.LiesOver p := by + simpa [p] using Ideal.primesOver.liesOver + (ratFuncInfinityPlace K).asIdeal P + letI := Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := + inferInstance + letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + exact Module.finite_of_finite p.ResidueField + +end LocalizationHelpers + +section TensorReciprocalNormalization + +/-- Extending polynomial coefficients carries the reciprocal origin back to +the reciprocal origin. -/ +theorem coefficientPolynomial_under_span_X + (C S : Type*) [Field C] [Field S] [Algebra C S] : + letI : Algebra C[X] S[X] := Polynomial.algebra C S + (Ideal.span ({Polynomial.X} : Set S[X])).under C[X] = + Ideal.span ({Polynomial.X} : Set C[X]) := by + letI : Algebra C[X] S[X] := Polynomial.algebra C S + ext p + change algebraMap C[X] S[X] p ∈ + Ideal.span ({Polynomial.X} : Set S[X]) ↔ + p ∈ Ideal.span ({Polynomial.X} : Set C[X]) + rw [Ideal.mem_span_singleton, Ideal.mem_span_singleton] + rw [Polynomial.X_dvd_iff, Polynomial.X_dvd_iff] + simp + +/-- In the polynomial-cancellation model, coefficient extension of a +polynomial acts as the right pure tensor of its old action. -/ +theorem polynomialTensorCancel_algebraMap_coefficient + (C S A : Type*) [Field C] [Field S] [CommRing A] + [Algebra C S] [Algebra C[X] A] + [Algebra C A] [IsScalarTower C C[X] A] + (p : C[X]) : + letI : Algebra C[X] S[X] := Polynomial.algebra C S + letI : Algebra S[X] (S ⊗[C] A) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S A + algebraMap S[X] (S ⊗[C] A) (algebraMap C[X] S[X] p) = + (1 : S) ⊗ₜ[C] algebraMap C[X] A p := by + letI : Algebra C[X] S[X] := Polynomial.algebra C S + letI : Algebra S[X] (S ⊗[C] A) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S A + let e := polynomialTensorCancelOverCoefficientPolynomial C S A + have hsource : + (algebraMap C[X] S[X] p) ⊗ₜ[C[X]] (1 : A) = + (1 : S[X]) ⊗ₜ[C[X]] (algebraMap C[X] A p) := + Algebra.TensorProduct.tmul_one_eq_one_tmul p + calc + algebraMap S[X] (S ⊗[C] A) (algebraMap C[X] S[X] p) = + e ((algebraMap C[X] S[X] p) ⊗ₜ[C[X]] (1 : A)) := + (e.commutes (algebraMap C[X] S[X] p)).symm + _ = e ((1 : S[X]) ⊗ₜ[C[X]] (algebraMap C[X] A p)) := + congrArg e hsource + _ = (1 : S) ⊗ₜ[C] algebraMap C[X] A p := by + rw [polynomialTensorCancelOverCoefficientPolynomial_apply, + polynomialTensorCancel_tmul] + simp + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance infinityBridgeDecidableEqBase : DecidableEq C := Classical.decEq C +local instance infinityBridgeDecidableEqConstants : DecidableEq S := Classical.decEq S +local instance infinityBridgeDecidableEqRatFuncBase : DecidableEq (RatFunc C) := + Classical.decEq (RatFunc C) +local instance infinityBridgeDecidableEqRatFuncConstants : DecidableEq (RatFunc S) := + Classical.decEq (RatFunc S) + +local instance infinityBridgeBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance infinityBridgeBaseReciprocalPolynomialAlgebra : Algebra C[X] N := + ratFuncExtensionReciprocalPolynomialAlgebra C N + +local instance infinityBridgeBaseConstantPolynomialTower : + IsScalarTower C C[X] N := by + exact IsScalarTower.of_algebraMap_eq' (by + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap (RatFunc C) N + (((reciprocalPolynomialRingHom C (Polynomial.C c) : + RatFuncInfinityIntegers C) : RatFunc C)) + rw [reciprocalPolynomialRingHom_coe] + simp) + +local instance infinityBridgeOldNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + +local instance infinityBridgeOldNormalizationConstantPolynomialTower : + IsScalarTower C C[X] (integralClosure C[X] N) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinityBridgeTensorPolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + +local instance infinityBridgeTensorConstantAlgebra : + Algebra S (S ⊗[C] integralClosure C[X] N) := + Algebra.TensorProduct.leftAlgebra + +local instance infinityBridgeTensorOldNormalizationAlgebra : + Algebra (integralClosure C[X] N) + (S ⊗[C] integralClosure C[X] N) := + Algebra.TensorProduct.rightAlgebra + +/-- Contract a reciprocal tensor-normalization prime to the old reciprocal +normalization. -/ +def exactConstantExtensionInfinityDownstairsIdeal + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) : + Ideal (integralClosure C[X] N) := + q.asIdeal.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom + +omit [Fintype C] [Finite S] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] in +@[simp] +theorem exactConstantExtensionInfinityDownstairsIdeal_eq + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) : + exactConstantExtensionInfinityDownstairsIdeal C S N q = + q.asIdeal.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom := + rfl + +omit [Fintype C] [Finite S] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] in +/-- A tensor-normalization prime above the reciprocal origin contracts to a +prime above the reciprocal origin in the old normalization. -/ +theorem exactConstantExtensionInfinityDownstairsIdeal_under + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + (exactConstantExtensionInfinityDownstairsIdeal C S N q).under C[X] = + Ideal.span ({Polynomial.X} : Set C[X]) := by + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + let oS := Ideal.span ({Polynomial.X} : Set S[X]) + let oC := Ideal.span ({Polynomial.X} : Set C[X]) + letI : Algebra C[X] S[X] := Polynomial.algebra C S + ext r + change + (1 : S) ⊗ₜ[C] + algebraMap C[X] (integralClosure C[X] N) r ∈ q.asIdeal ↔ + r ∈ oC + rw [← polynomialTensorCancel_algebraMap_coefficient C S + (integralClosure C[X] N) r] + change algebraMap C[X] S[X] r ∈ q.asIdeal.under S[X] ↔ r ∈ oC + rw [hqOrigin] + exact SetLike.ext_iff.mp (coefficientPolynomial_under_span_X C S) r + +local instance infinityBridgeBaseInfinityPolynomialAlgebra : + Algebra C[X] (RatFuncInfinityIntegers C) := + ratFuncInfinityReciprocalPolynomialAlgebra C + +local instance infinityBridgeBaseInfinityConstantAlgebra : + Algebra C (RatFuncInfinityIntegers C) := + (ratFuncInfinityConstantRingHom C).toAlgebra + +local instance infinityBridgeBaseOriginPrime : + (Ideal.span ({Polynomial.X} : Set C[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +local instance infinityBridgeBaseInfinityLocalization : + IsLocalization + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl + (RatFuncInfinityIntegers C) := + ratFuncInfinityIntegers_isLocalization_reciprocal C + +local instance infinityBridgeOldNormalizationInfinityAlgebra : + Algebra (integralClosure C[X] N) (RatFuncInfinityIntegralClosure C N) := + ratFuncInfinityReciprocalIntegralClosureAlgebra C N + +local instance infinityBridgeOldNormalizationInfinitySMul : + SMul (integralClosure C[X] N) (RatFuncInfinityIntegralClosure C N) := + Algebra.toSMul + +local instance infinityBridgeOldNormalizationInfinityLocalization : + IsLocalization + (Algebra.algebraMapSubmonoid (integralClosure C[X] N) + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) + (RatFuncInfinityIntegralClosure C N) := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal C N + +local instance infinityBridgeBasePolynomialInfinityAlgebra : + Algebra C[X] (RatFuncInfinityIntegralClosure C N) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegralClosure C N)).comp + (algebraMap C[X] (RatFuncInfinityIntegers C))) + +local instance infinityBridgeInfinityConstantAlgebra : + Algebra C (RatFuncInfinityIntegralClosure C N) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegralClosure C N)).comp + (algebraMap C (RatFuncInfinityIntegers C))) + +local instance infinityBridgeOldNormalizationInfinityConstantTower : + IsScalarTower C (integralClosure C[X] N) + (RatFuncInfinityIntegralClosure C N) := + IsScalarTower.of_algebraMap_eq fun c => by + apply Subtype.ext + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap (RatFunc C) N + (((reciprocalPolynomialRingHom C (Polynomial.C c) : + RatFuncInfinityIntegers C) : RatFunc C)) + rw [reciprocalPolynomialRingHom_coe] + simp + +local instance infinityBridgeBasePolynomialInfinityTower : + IsScalarTower C[X] (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegralClosure C N) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinityBridgeOldNormalizationInfinityTower : + IsScalarTower C[X] (integralClosure C[X] N) + (RatFuncInfinityIntegralClosure C N) := + IsScalarTower.of_algebraMap_eq fun p => by + apply Subtype.ext + rfl + +/-- The contraction of a reciprocal tensor prime, localized at the old +reciprocal origin, is an actual place of `N` above infinity. -/ +noncomputable def exactConstantExtensionDownstairsInfinityPlace + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + FiniteExtensionInfinityPlace C N := by + let A := integralClosure C[X] N + let B := RatFuncInfinityIntegralClosure C N + let o := Ideal.span ({Polynomial.X} : Set C[X]) + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + let M := Algebra.algebraMapSubmonoid A o.primeCompl + have hpPrime : p.IsPrime := by + exact Ideal.comap_isPrime + (f := (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom) + (K := q.asIdeal) + have hpUnder : p.under C[X] = o := + exactConstantExtensionInfinityDownstairsIdeal_under C S N q hqOrigin + have hdisj : Disjoint (M : Set A) (p : Set A) := by + letI : o.IsPrime := infinityBridgeBaseOriginPrime C + exact mappedPrimeCompl_disjoint_of_under_eq C[X] A o p hpUnder + let P := Ideal.map (algebraMap A B) p + letI : p.IsPrime := hpPrime + letI : P.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B p hpPrime hdisj + have hOver : P.LiesOver (ratFuncInfinityPlace C).asIdeal := by + exact localizationMap_liesOver_maximalIdeal C[X] + (RatFuncInfinityIntegers C) A B o p hpPrime hpUnder + exact ⟨P, inferInstance, hOver⟩ + +omit [Fintype C] [Finite S] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] in +@[simp] +theorem exactConstantExtensionDownstairsInfinityPlace_asIdeal + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + (exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin).1 = + Ideal.map + (algebraMap (integralClosure C[X] N) + (RatFuncInfinityIntegralClosure C N)) + (exactConstantExtensionInfinityDownstairsIdeal C S N q) := + rfl + +/-- Localization at the reciprocal origin does not change the residue field +of the contracted downstairs prime. -/ +noncomputable def exactConstantExtensionDownstairsResidueFieldAlgEquiv + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + let i := (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + letI : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) + p.ResidueField ≃ₐ[C] + (exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin).1.ResidueField := by + let A := integralClosure C[X] N + let B := RatFuncInfinityIntegralClosure C N + let o := Ideal.span ({Polynomial.X} : Set C[X]) + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + let M := Algebra.algebraMapSubmonoid A o.primeCompl + have hpPrime : p.IsPrime := by + exact Ideal.comap_isPrime + (f := (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom) + (K := q.asIdeal) + letI : p.IsPrime := hpPrime + have hpUnder : p.under C[X] = o := + exactConstantExtensionInfinityDownstairsIdeal_under C S N q hqOrigin + have hdisj : Disjoint (M : Set A) (p : Set A) := + mappedPrimeCompl_disjoint_of_under_eq C[X] A o p hpUnder + let P := Ideal.map (algebraMap A B) p + letI : P.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B p hpPrime hdisj + change p.ResidueField ≃ₐ[C] + P.ResidueField + exact localizationResidueFieldAlgEquiv C A B M p hdisj + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- Localizing the corresponding prime in the reciprocal affine +normalization of the exact constant extension produces an actual upstairs +place above infinity. -/ +noncomputable def exactConstantExtensionUpstairsInfinityPlace + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + FiniteExtensionInfinityPlace S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + let R := S ⊗[C] integralClosure C[X] N + let A := integralClosure S[X] (ExactConstantExtension C N S) + let V := RatFuncInfinityIntegers S + let B := RatFuncInfinityIntegralClosure S (ExactConstantExtension C N S) + let o := Ideal.span ({Polynomial.X} : Set S[X]) + let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + let qA : HeightOneSpectrum A := heightOneSpectrumEquivOfAlgEquiv e q + have hqAOrigin : qA.asIdeal.under S[X] = o := by + calc + qA.asIdeal.under S[X] = q.asIdeal.under S[X] := by + ext p + change e.symm (algebraMap S[X] A p) ∈ q.asIdeal ↔ + algebraMap S[X] R p ∈ q.asIdeal + rw [e.symm.commutes] + _ = o := hqOrigin + letI : Algebra S[X] V := ratFuncInfinityReciprocalPolynomialAlgebra S + letI : o.IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + letI : IsLocalization o.primeCompl V := + ratFuncInfinityIntegers_isLocalization_reciprocal S + letI : Algebra A B := + ratFuncInfinityReciprocalIntegralClosureAlgebra S + (ExactConstantExtension C N S) + letI : SMul A B := Algebra.toSMul + letI : IsLocalization (Algebra.algebraMapSubmonoid A o.primeCompl) B := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal S + (ExactConstantExtension C N S) + letI : Algebra S[X] B := + RingHom.toAlgebra + ((algebraMap V B).comp (algebraMap S[X] V)) + letI : IsScalarTower S[X] V B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower S[X] A B := + IsScalarTower.of_algebraMap_eq fun p => by + apply Subtype.ext + rfl + let M := Algebra.algebraMapSubmonoid A o.primeCompl + have hdisj : Disjoint (M : Set A) (qA.asIdeal : Set A) := + mappedPrimeCompl_disjoint_of_under_eq S[X] A o qA.asIdeal hqAOrigin + let Q := Ideal.map (algebraMap A B) qA.asIdeal + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B qA.asIdeal qA.isPrime hdisj + have hOver : Q.LiesOver (ratFuncInfinityPlace S).asIdeal := by + exact localizationMap_liesOver_maximalIdeal S[X] V A B o + qA.asIdeal qA.isPrime hqAOrigin + exact ⟨Q, inferInstance, hOver⟩ + +/-- The reciprocal affine prime and the corresponding actual upstairs +infinity place have canonically ring-equivalent residue fields. -/ +noncomputable def exactConstantExtensionUpstairsResidueFieldRingEquiv + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + q.asIdeal.ResidueField ≃+* + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin).1.ResidueField := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + let R := S ⊗[C] integralClosure C[X] N + let A := integralClosure S[X] (ExactConstantExtension C N S) + let V := RatFuncInfinityIntegers S + let B := RatFuncInfinityIntegralClosure S (ExactConstantExtension C N S) + let o := Ideal.span ({Polynomial.X} : Set S[X]) + let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + let qA : HeightOneSpectrum A := heightOneSpectrumEquivOfAlgEquiv e q + have hqAOrigin : qA.asIdeal.under S[X] = o := by + calc + qA.asIdeal.under S[X] = q.asIdeal.under S[X] := by + ext p + change e.symm (algebraMap S[X] A p) ∈ q.asIdeal ↔ + algebraMap S[X] R p ∈ q.asIdeal + rw [e.symm.commutes] + _ = o := hqOrigin + let affineResidue : q.asIdeal.ResidueField ≃+* + qA.asIdeal.ResidueField := + heightOneResidueFieldRingEquiv e.toRingEquiv q + letI : Algebra S[X] V := ratFuncInfinityReciprocalPolynomialAlgebra S + letI : o.IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + letI : IsLocalization o.primeCompl V := + ratFuncInfinityIntegers_isLocalization_reciprocal S + letI : Algebra A B := + ratFuncInfinityReciprocalIntegralClosureAlgebra S + (ExactConstantExtension C N S) + letI : SMul A B := Algebra.toSMul + letI : IsLocalization (Algebra.algebraMapSubmonoid A o.primeCompl) B := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal S + (ExactConstantExtension C N S) + letI : Algebra S[X] B := + RingHom.toAlgebra ((algebraMap V B).comp (algebraMap S[X] V)) + letI : IsScalarTower S[X] V B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower S[X] A B := + IsScalarTower.of_algebraMap_eq fun p => by + apply Subtype.ext + rfl + let M := Algebra.algebraMapSubmonoid A o.primeCompl + have hdisj : Disjoint (M : Set A) (qA.asIdeal : Set A) := + mappedPrimeCompl_disjoint_of_under_eq S[X] A o qA.asIdeal hqAOrigin + let Q := Ideal.map (algebraMap A B) qA.asIdeal + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B qA.asIdeal qA.isPrime hdisj + let localResidue : qA.asIdeal.ResidueField ≃+* Q.ResidueField := + localizationResidueFieldRingEquiv A B M qA.asIdeal hdisj + change q.asIdeal.ResidueField ≃+* Q.ResidueField + exact affineResidue.trans localResidue + +/-- The residue field of the actual upstairs infinity place is finite. -/ +theorem exactConstantExtensionUpstairsInfinityResidueField_finite + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + Finite (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin).1.ResidueField := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Fintype S := Fintype.ofFinite S + exact actualInfinityPlaceResidueField_finite S + (ExactConstantExtension C N S) + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin) + +include hExact + +/-- The residue field of the reciprocal tensor-normalization prime is finite. -/ +theorem exactConstantExtensionInfinityTensorResidueField_finite + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + Finite q.asIdeal.ResidueField := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Finite + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin).1.ResidueField := + exactConstantExtensionUpstairsInfinityResidueField_finite + C S N hExact q hqOrigin + let e := exactConstantExtensionUpstairsResidueFieldRingEquiv + C S N hExact q hqOrigin + exact Finite.of_injective e e.injective + +/-- A reciprocal tensor-normalization height-one prime above the origin is +maximal; no maximality hypothesis is left to the residue calculation. -/ +theorem exactConstantExtensionInfinityTensorIdeal_isMaximal + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + q.asIdeal.IsMaximal := by + letI : Finite q.asIdeal.ResidueField := + exactConstantExtensionInfinityTensorResidueField_finite + C S N hExact q hqOrigin + letI : Finite + (HasQuotient.Quotient + (S ⊗[C] integralClosure C[X] N) q.asIdeal) := + Finite.of_injective + (algebraMap + (HasQuotient.Quotient + (S ⊗[C] integralClosure C[X] N) q.asIdeal) + q.asIdeal.ResidueField) + q.asIdeal.injective_algebraMap_quotient_residueField + exact (Ideal.Quotient.maximal_ideal_iff_isField_quotient q.asIdeal).mpr + (Finite.isField_of_domain + (HasQuotient.Quotient + (S ⊗[C] integralClosure C[X] N) q.asIdeal)) + +omit [Finite S] [FiniteDimensional C S] [IsGalois C S] hExact in +/-- The residue field of the contracted downstairs reciprocal prime is finite. -/ +theorem exactConstantExtensionInfinityDownstairsResidueField_finite + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + let i := (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom + letI : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) + Finite p.ResidueField := by + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + let i := (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom + letI : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) + let P := exactConstantExtensionDownstairsInfinityPlace C S N q hqOrigin + letI : Finite P.1.ResidueField := + actualInfinityPlaceResidueField_finite C N P + let e := exactConstantExtensionDownstairsResidueFieldAlgEquiv + C S N q hqOrigin + exact Finite.of_injective e e.injective + +omit [Field C] [Field N] [Fintype C] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] hExact in +private theorem constantTensorResidue_finrank_over_constants_eq_div_gcd + (C R S : Type*) + [Field C] [CommRing R] [Field S] + [Algebra C R] [Algebra C S] + [Finite C] [Finite S] + (q : Ideal (S ⊗[C] R)) [q.IsMaximal] + [Finite ((q.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom).ResidueField)] + [Finite q.ResidueField] : + let p := q.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + Module.finrank S q.ResidueField = + Module.finrank C p.ResidueField / + Nat.gcd (Module.finrank C S) + (Module.finrank C p.ResidueField) := by + let p := q.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + let m := Module.finrank C S + let n := Module.finrank C p.ResidueField + let d := Nat.gcd m n + let l := Nat.lcm m n + let r := Module.finrank S q.ResidueField + have htotal : Module.finrank C q.ResidueField = l := + constantTensorResidue_finrank_eq_lcm C R S q + have hmr : m * r = l := by + exact (Module.finrank_mul_finrank C S q.ResidueField).trans htotal + have hdr : d * r = n := by + apply Nat.mul_left_cancel + (Module.finrank_pos (R := C) (M := S)) + calc + m * (d * r) = d * (m * r) := by ac_rfl + _ = d * l := by rw [hmr] + _ = m * n := Nat.gcd_mul_lcm m n + have hdpos : 0 < d := Nat.gcd_pos_of_pos_left n + (Module.finrank_pos (R := C) (M := S)) + change r = n / d + symm + apply Nat.div_eq_of_eq_mul_left hdpos + simpa [mul_comm] using hdr.symm + +/-- Exact extension of constants changes the degree of an actual infinity +place by the standard division-by-gcd formula. -/ +theorem exactConstantExtensionInfinityPlace_degree_eq_div_gcd + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inr (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin)) = + finiteExtensionPlaceDegree C N + (.inr (exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin)) / + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inr (exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin))) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Fintype S := Fintype.ofFinite S + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q + let i := (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom + letI : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) + letI : Finite p.ResidueField := + exactConstantExtensionInfinityDownstairsResidueField_finite + C S N q hqOrigin + letI : Finite + (q.asIdeal.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom).ResidueField := by + change Finite p.ResidueField + infer_instance + letI : Finite q.asIdeal.ResidueField := + exactConstantExtensionInfinityTensorResidueField_finite + C S N hExact q hqOrigin + letI : q.asIdeal.IsMaximal := + exactConstantExtensionInfinityTensorIdeal_isMaximal + C S N hExact q hqOrigin + let Q := exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin + let P := exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin + letI : Finite Q.1.ResidueField := + exactConstantExtensionUpstairsInfinityResidueField_finite + C S N hExact q hqOrigin + letI : Finite P.1.ResidueField := + actualInfinityPlaceResidueField_finite C N P + have hUp : Module.finrank S q.asIdeal.ResidueField = + Module.finrank S Q.1.ResidueField := + finrank_eq_of_finite_ringEquiv S q.asIdeal.ResidueField + Q.1.ResidueField + (exactConstantExtensionUpstairsResidueFieldRingEquiv + C S N hExact q hqOrigin) + have hDown : Module.finrank C p.ResidueField = + Module.finrank C P.1.ResidueField := + (exactConstantExtensionDownstairsResidueFieldAlgEquiv + C S N q hqOrigin).toLinearEquiv.finrank_eq + rw [finiteExtensionInfinityPlace_degree_eq_finrank_residueField S + (ExactConstantExtension C N S) Q, + finiteExtensionInfinityPlace_degree_eq_finrank_residueField C N P] + calc + Module.finrank S Q.1.ResidueField = + Module.finrank S q.asIdeal.ResidueField := hUp.symm + _ = Module.finrank C p.ResidueField / + Nat.gcd (Module.finrank C S) + (Module.finrank C p.ResidueField) := + constantTensorResidue_finrank_over_constants_eq_div_gcd + C (integralClosure C[X] N) S q.asIdeal + _ = Module.finrank C P.1.ResidueField / + Nat.gcd (Module.finrank C S) + (Module.finrank C P.1.ResidueField) := by rw [hDown] + +/-- If the downstairs infinity-place degree divides the extension degree of +the constants, the corresponding upstairs infinity place has degree one. -/ +theorem exactConstantExtensionInfinityPlace_degree_eq_one_of_dvd + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) + (hqOrigin : q.asIdeal.under S[X] = + Ideal.span ({Polynomial.X} : Set S[X])) + (hdiv : finiteExtensionPlaceDegree C N + (.inr (exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin)) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inr (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q hqOrigin)) = 1 := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + rw [exactConstantExtensionInfinityPlace_degree_eq_div_gcd + C S N hExact q hqOrigin] + rw [Nat.gcd_eq_right_iff_dvd.mpr hdiv] + let P := exactConstantExtensionDownstairsInfinityPlace + C S N q hqOrigin + letI : Finite P.1.ResidueField := + actualInfinityPlaceResidueField_finite C N P + apply Nat.div_self + rw [finiteExtensionInfinityPlace_degree_eq_finrank_residueField C N P] + exact Module.finrank_pos + +end TensorReciprocalNormalization + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean new file mode 100644 index 0000000000..56a9c07b0c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean @@ -0,0 +1,583 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity + +/-! +# Absolute degrees of constant-extension places at infinity + +This file compares the degree of an infinity place in the original constant +field presentation with its degree after extending the constants. Both +degrees are computed from the same reciprocal-normalization residue field, so +the comparison is just the residue-field dimension tower. +-/ + +open scoped Polynomial TensorProduct nonZeroDivisors + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain + + +/-- A ring equivalence between finite field extensions of a finite field +preserves their dimensions, even when it is not presented as an algebra +equivalence. -/ +private theorem finrank_eq_of_finite_ringEquiv + (K E F : Type*) [Field K] [Fintype K] + [Field E] [Field F] [Algebra K E] [Algebra K F] + [Finite E] [Finite F] (e : E ≃+* F) : + Module.finrank K E = Module.finrank K F := by + letI : Fintype E := Fintype.ofFinite E + letI : Fintype F := Fintype.ofFinite F + have hcard : Fintype.card E = Fintype.card F := + Fintype.card_congr e.toEquiv + rw [Module.card_eq_pow_finrank (K := K) (V := E), + Module.card_eq_pow_finrank (K := K) (V := F)] at hcard + exact Nat.pow_right_injective + (show 2 ≤ Fintype.card K from Fintype.one_lt_card) hcard + +/-- Arithmetic cancellation recovering a relative residue degree from the +two absolute degree formulas. -/ +private theorem eq_div_gcd_of_mul_eq_mul_div_gcd + (r d f : ℕ) (hd : 0 < d) + (h : d * f = r * (d / Nat.gcd r d)) : + f = r / Nat.gcd r d := by + apply Nat.eq_of_mul_eq_mul_left hd + calc + d * f = r * (d / Nat.gcd r d) := h + _ = (Nat.gcd r d * (r / Nat.gcd r d)) * + (d / Nat.gcd r d) := by + rw [Nat.mul_div_cancel' (Nat.gcd_dvd_left r d)] + _ = (Nat.gcd r d * (d / Nat.gcd r d)) * + (r / Nat.gcd r d) := by ac_rfl + _ = d * (r / Nat.gcd r d) := by + rw [Nat.mul_div_cancel' (Nat.gcd_dvd_right r d)] + +/-- Arithmetic cancellation recovering the number of split places after the +relative residue degree is known. -/ +private theorem eq_gcd_of_mul_div_gcd_eq + (r d a : ℕ) (hr : 0 < r) + (h : a * (r / Nat.gcd r d) = r) : + a = Nat.gcd r d := by + have hquot : 0 < r / Nat.gcd r d := + Nat.div_pos + (Nat.le_of_dvd hr (Nat.gcd_dvd_left r d)) + (Nat.gcd_pos_of_pos_left d hr) + apply Nat.eq_of_mul_eq_mul_right hquot + calc + a * (r / Nat.gcd r d) = r := h + _ = Nat.gcd r d * (r / Nat.gcd r d) := + (Nat.mul_div_cancel' (Nat.gcd_dvd_left r d)).symm + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) infinityDegreeTowerDecidableEqBase : + DecidableEq C := + infinityBridgeDecidableEqConstants C + +local instance (priority := 10000) infinityDegreeTowerDecidableEqRatFuncBase : + DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + +local instance (priority := 10000) infinityDegreeTowerDecidableEqConstants : + DecidableEq S := + infinityBridgeDecidableEqConstants S + +local instance (priority := 10000) + infinityDegreeTowerDecidableEqRatFuncConstants : + DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + +@[reducible] local instance infinityDegreeTowerBaseConstantAlgebra : + Algebra C N := + infinityConstantAlgebra C N + +local instance infinityDegreeTowerBaseRatFuncTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The degree over the original constants of a presented infinity place is +the constant-field degree times the degree of its upstairs `S`-place. -/ +theorem exactConstantExtensionPresentedInfinityPlace_degree_baseChange + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) + (.inr (exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q)) = + Module.finrank C S * + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inr (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2)) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Fintype S := Fintype.ofFinite S + letI : Finite q.1.asIdeal.ResidueField := + exactConstantExtensionInfinityTensorResidueField_finite + C S N hExact q.1 q.2 + letI : q.1.asIdeal.IsMaximal := + exactConstantExtensionInfinityTensorIdeal_isMaximal + C S N hExact q.1 q.2 + let QC := exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q + let QS := exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2 + let BC := RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S) + let BS := RatFuncInfinityIntegralClosure S + (ExactConstantExtension C N S) + letI : Algebra C BC := + onePointInfinityClosureConstantAlgebra C + (ExactConstantExtension C N S) + letI : Algebra S BS := + onePointInfinityClosureConstantAlgebra S + (ExactConstantExtension C N S) + letI : Algebra C QC.1.ResidueField := by infer_instance + letI : Algebra S QS.1.ResidueField := by infer_instance + let eC := exactConstantExtensionPresentedInfinityResidueFieldRingEquiv + C S N hExact q + letI : Finite QC.1.ResidueField := + Finite.of_injective eC.symm eC.symm.injective + letI : Finite QS.1.ResidueField := + exactConstantExtensionUpstairsInfinityResidueField_finite + C S N hExact q.1 q.2 + have hC : Module.finrank C q.1.asIdeal.ResidueField = + Module.finrank C QC.1.ResidueField := + finrank_eq_of_finite_ringEquiv C q.1.asIdeal.ResidueField + QC.1.ResidueField eC + have hS : Module.finrank S q.1.asIdeal.ResidueField = + Module.finrank S QS.1.ResidueField := + finrank_eq_of_finite_ringEquiv S q.1.asIdeal.ResidueField + QS.1.ResidueField + (exactConstantExtensionUpstairsResidueFieldRingEquiv + C S N hExact q.1 q.2) + rw [finiteExtensionInfinityPlace_degree_eq_finrank_residueField C + (ExactConstantExtension C N S) QC, + finiteExtensionInfinityPlace_degree_eq_finrank_residueField S + (ExactConstantExtension C N S) QS] + calc + Module.finrank C QC.1.ResidueField = + Module.finrank C q.1.asIdeal.ResidueField := hC.symm + _ = Module.finrank C S * + Module.finrank S q.1.asIdeal.ResidueField := + (Module.finrank_mul_finrank C S q.1.asIdeal.ResidueField).symm + _ = Module.finrank C S * Module.finrank S QS.1.ResidueField := by + rw [hS] + +/-- The relative residue degree over the original function field is the +constant extension degree divided by the same gcd that controls splitting. -/ +theorem exactConstantExtensionPresentedInfinityPlace_relativeInertiaDeg_eq_div_gcd + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + infinityPlaceRelativeInertiaDeg C N (ExactConstantExtension C N S) + (exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q) = + Module.finrank C S / + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inr (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2))) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + let P := exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 + let Q := exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q + let QS := exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2 + let r := Module.finrank C S + let d := finiteExtensionPlaceDegree C N (.inr P) + have hUnder : infinityPlaceUnder C N (ExactConstantExtension C N S) Q = P := + exactConstantExtensionPresentedInfinityPlaceEquiv_under + C S N hExact q + have hUpstairs : finiteExtensionPlaceDegree S + (ExactConstantExtension C N S) (.inr QS) = + d / Nat.gcd r d := by + exact exactConstantExtensionInfinityPlace_degree_eq_div_gcd + C S N hExact q.1 q.2 + have hTop : finiteExtensionPlaceDegree C + (ExactConstantExtension C N S) (.inr Q) = + r * (d / Nat.gcd r d) := by + exact (exactConstantExtensionPresentedInfinityPlace_degree_baseChange + C S N hExact q).trans (congrArg (fun n => r * n) hUpstairs) + have hTower := finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg + C N (ExactConstantExtension C N S) Q + rw [hUnder] at hTower + have hd : 0 < d := finiteExtensionPlaceDegree_pos C N (.inr P) + exact eq_div_gcd_of_mul_eq_mul_div_gcd r d _ hd + (hTower.symm.trans hTop) + +/-- A downstairs infinity place of degree `d` has exactly +`gcd([S : C], d)` places above it in an exact extension of constants. -/ +theorem exactConstantExtensionInfinityPlace_fiber_card_eq_gcd + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + Fintype.card (InfinityPlaceUnderFiber C N + (ExactConstantExtension C N S) + (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2)) = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inr (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2))) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + let P := exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 + let Q := exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q + let r := Module.finrank C S + let d := finiteExtensionPlaceDegree C N (.inr P) + have hUnder : infinityPlaceUnder C N (ExactConstantExtension C N S) Q = P := + exactConstantExtensionPresentedInfinityPlaceEquiv_under + C S N hExact q + let Q0 : InfinityPlaceUnderFiber C N + (ExactConstantExtension C N S) P := ⟨Q, hUnder⟩ + have hFund := + infinityPlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + C N (ExactConstantExtension C N S) P Q0 + have hRam : infinityPlaceRelativeRamificationIdx C N + (ExactConstantExtension C N S) Q = 1 := + exactConstantExtensionInfinityPlace_ramificationIdx_eq_one + C S N hExact Q + have hInertia : infinityPlaceRelativeInertiaDeg C N + (ExactConstantExtension C N S) Q = r / Nat.gcd r d := + exactConstantExtensionPresentedInfinityPlace_relativeInertiaDeg_eq_div_gcd + C S N hExact q + rw [exactConstantExtension_finrank C N S] at hFund + have hCount : Fintype.card (InfinityPlaceUnderFiber C N + (ExactConstantExtension C N S) P) * (r / Nat.gcd r d) = r := by + simpa [Q0, hRam, hInertia, r] using hFund + exact eq_gcd_of_mul_div_gcd_eq r d _ Module.finrank_pos hCount + +/-- Restricting the global reciprocal presentation equivalence to a fixed +downstairs infinity place identifies the presented contraction fiber with the +entire actual place-restriction fiber. -/ +noncomputable def exactConstantExtensionPresentedInfinityPlaceFiberEquiv : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + (P : FiniteExtensionInfinityPlace C N) → + {q : ExactConstantExtensionPresentedInfinityPlace C S N // + exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 = P} ≃ + InfinityPlaceUnderFiber C N (ExactConstantExtension C N S) P := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + intro P + let e := exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact + exact + { toFun := fun q => + ⟨e q.1, by + rw [exactConstantExtensionPresentedInfinityPlaceEquiv_under] + exact q.2⟩ + invFun := fun Q => + ⟨e.symm Q.1, by + have hUnder := + exactConstantExtensionPresentedInfinityPlaceEquiv_under + C S N hExact (e.symm Q.1) + have he : e (e.symm Q.1) = Q.1 := e.apply_symm_apply Q.1 + rw [he] at hUnder + exact hUnder.symm.trans Q.2⟩ + left_inv := fun q => by + apply Subtype.ext + exact e.symm_apply_apply q.1 + right_inv := fun Q => by + apply Subtype.ext + exact e.apply_symm_apply Q.1 } + +include hExact + +/-- The presented reciprocal infinity fiber itself has the standard gcd +cardinality. This is the presentation-level exhaustiveness form of the +constant-extension splitting law at infinity. -/ +theorem exactConstantExtensionPresentedInfinityPlaceFiber_natCard_eq_gcd + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + Nat.card {q' : ExactConstantExtensionPresentedInfinityPlace C S N // + exactConstantExtensionDownstairsInfinityPlace + C S N q'.1 q'.2 = + exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2} = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inr (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2))) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + let P := exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2 + calc + Nat.card {q' : ExactConstantExtensionPresentedInfinityPlace C S N // + exactConstantExtensionDownstairsInfinityPlace C S N q'.1 q'.2 = P} = + Nat.card (InfinityPlaceUnderFiber C N + (ExactConstantExtension C N S) P) := + Nat.card_congr + (exactConstantExtensionPresentedInfinityPlaceFiberEquiv + C S N hExact P) + _ = Fintype.card (InfinityPlaceUnderFiber C N + (ExactConstantExtension C N S) P) := + Nat.card_eq_fintype_card + _ = Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inr P)) := + exactConstantExtensionInfinityPlace_fiber_card_eq_gcd + C S N hExact q + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean new file mode 100644 index 0000000000..52b73d8ab3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -0,0 +1,1382 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity + +/-! +# Splitting multiplicity at infinity in an exact extension of constants + +This file identifies the reciprocal-normalization presentation of the places +at infinity with the actual places over the original constant field. It then +proves that an exact extension of constants is unramified at those places. + +The comparison is noncircular: reciprocal affine normalizations are first +compared over `C[X]`, and only then localized to the valuation ring at +infinity. +-/ + +open scoped Polynomial TensorProduct nonZeroDivisors + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain + + +private noncomputable def infinitySplittingHeightOneResidueFieldRingEquiv + {A B : Type*} [CommRing A] [CommRing B] + (e : A ≃+* B) (q : IsDedekindDomain.HeightOneSpectrum A) : + q.asIdeal.ResidueField ≃+* + (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q).asIdeal.ResidueField := + Ideal.residueFieldRingEquiv q.asIdeal + (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q).asIdeal e + (by + change q.asIdeal = (q.asIdeal.comap e.symm).comap e + exact (Ideal.comap_of_equiv e).symm) + +private theorem infinitySplittingMappedPrimeCompl_disjoint_of_under_eq + (R A : Type*) [CommRing R] [CommRing A] [Algebra R A] + (p : Ideal R) [p.IsPrime] (q : Ideal A) + (hq : q.under R = p) : + Disjoint + ((Algebra.algebraMapSubmonoid A p.primeCompl : Submonoid A) : Set A) + (q : Set A) := by + rw [Set.disjoint_left] + intro x hxM hxq + obtain ⟨r, hr, rfl⟩ := hxM + exact hr (hq ▸ hxq) + +private noncomputable def infinitySplittingLocalizationResidueFieldRingEquiv + (A B : Type*) [CommRing A] [CommRing B] [Algebra A B] + (M : Submonoid A) [IsLocalization M B] + (q : Ideal A) [q.IsPrime] + (hdisj : Disjoint (M : Set A) (q : Set A)) : + let Q := Ideal.map (algebraMap A B) q + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj + q.ResidueField ≃+* Q.ResidueField := by + let Q := Ideal.map (algebraMap A B) q + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj + have hcomap : q = Q.under A := + (IsLocalization.under_map_of_isPrime_disjoint + M B inferInstance hdisj).symm + let f : q.ResidueField →+* Q.ResidueField := + Ideal.ResidueField.map q Q (algebraMap A B) hcomap + apply RingEquiv.ofBijective f + exact (RingHom.surjectiveOnStalks_of_isLocalization M B) + |>.residueFieldMap_bijective q Q hcomap + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) infinitySplittingDecidableEqBase : + DecidableEq C := infinityBridgeDecidableEqConstants C + +local instance (priority := 10000) infinitySplittingDecidableEqRatFuncBase : + DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C + +local instance (priority := 10000) infinitySplittingDecidableEqConstants : + DecidableEq S := infinityBridgeDecidableEqConstants S + +local instance (priority := 10000) infinitySplittingDecidableEqRatFuncConstants : + DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S + +@[reducible] local instance infinitySplittingBaseConstantAlgebra : Algebra C N := + infinityConstantAlgebra C N + +@[reducible] local instance infinitySplittingBaseReciprocalPolynomialAlgebra : + Algebra C[X] N := + infinityReciprocalPolynomialAlgebra C N + +local instance infinitySplittingBaseConstantReciprocalPolynomialTower : + IsScalarTower C C[X] N := + infinityReciprocalPolynomialTower C N + +local instance infinitySplittingBaseRatFuncTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinitySplittingOldNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + +local instance infinitySplittingOldNormalizationConstantPolynomialTower : + IsScalarTower C C[X] (integralClosure C[X] N) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinitySplittingCoefficientPolynomialAlgebra : + Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance infinitySplittingCoefficientPolynomialSMul : + SMul C[X] S[X] := Algebra.toSMul + +local instance infinitySplittingCoefficientPolynomialModule : + Module C[X] S[X] := Algebra.toModule + +local instance infinitySplittingCOriginPrime : + (Ideal.span ({Polynomial.X} : Set C[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +local instance infinitySplittingSOriginPrime : + (Ideal.span ({Polynomial.X} : Set S[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The reciprocal `C[X]`-action on the exact constant extension. -/ +@[reducible] noncomputable def exactConstantExtensionCReciprocalPolynomialAlgebra : + Algebra C[X] (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N)).toRingHom.comp + (algebraMap C[X] N)) + +@[reducible] local instance infinitySplittingExactCPolynomialAlgebra : + Algebra C[X] (ExactConstantExtension C N S) := + exactConstantExtensionCReciprocalPolynomialAlgebra C S N + +@[reducible] local instance infinitySplittingExactSPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + +local instance infinitySplittingExactCPolynomialSMul : + SMul C[X] (ExactConstantExtension C N S) := Algebra.toSMul + +local instance infinitySplittingExactCPolynomialModule : + Module C[X] (ExactConstantExtension C N S) := Algebra.toModule + +local instance infinitySplittingExactSPolynomialSMul : + SMul S[X] (ExactConstantExtension C N S) := Algebra.toSMul + +@[reducible] local instance infinitySplittingPresentedSPolynomialAlgebra : + Algebra S[X] (TensorProduct C S (integralClosure C[X] N)) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + +@[reducible] local instance infinitySplittingPresentedCPolynomialAlgebra : + Algebra C[X] (TensorProduct C S (integralClosure C[X] N)) := + RingHom.toAlgebra + ((Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom.comp + (algebraMap C[X] (integralClosure C[X] N))) + +local instance infinitySplittingPresentedSPolynomialSMul : + SMul S[X] (TensorProduct C S (integralClosure C[X] N)) := Algebra.toSMul + +local instance infinitySplittingPresentedCPolynomialSMul : + SMul C[X] (TensorProduct C S (integralClosure C[X] N)) := Algebra.toSMul + +/-- The reciprocal polynomial actions on the exact constant extension form +the expected scalar tower. -/ +theorem exactConstantExtensionReciprocalPolynomialTower : + IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := by + apply IsScalarTower.of_algebraMap_eq + intro p + rw [polynomialTensorCancel_algebraMap_coefficient C S N p] + rfl + +/-- Integral closure is unchanged when the integral coefficient extension +`C[X] -> S[X]` is inserted into the reciprocal normalization. -/ +noncomputable def exactConstantExtensionReciprocalIntegralClosureTowerEquiv : + integralClosure C[X] (ExactConstantExtension C N S) ≃+* + @integralClosure S[X] (ExactConstantExtension C N S) _ _ + (polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N) := by + letI : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := + exactConstantExtensionReciprocalPolynomialTower C S N + exact integralClosureRingEquivOfIntegralTower C[X] S[X] + (ExactConstantExtension C N S) + +/-- The presented reciprocal normalization is the normalization of the exact +constant extension over the original reciprocal polynomial ring `C[X]`. -/ +noncomputable def exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv : + TensorProduct C S (integralClosure C[X] N) ≃+* + integralClosure C[X] (ExactConstantExtension C N S) := by + letI : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := + exactConstantExtensionReciprocalPolynomialTower C S N + let eS := finiteFieldReciprocalNormalizationAlgEquiv C S N + let eC := exactConstantExtensionReciprocalIntegralClosureTowerEquiv C S N + exact eS.toRingEquiv.trans eC.symm + +/-- Coefficient extension commutes with evaluation in the reciprocal +coordinate. -/ +private theorem ratFuncCoefficientAlgHom_reciprocalPolynomialRingHom + (p : C[X]) : + ratFuncCoefficientAlgHom C S + (((reciprocalPolynomialRingHom C p : + RatFuncInfinityIntegers C) : RatFunc C)) = + ((reciprocalPolynomialRingHom S (algebraMap C[X] S[X] p) : + RatFuncInfinityIntegers S) : RatFunc S) := by + rw [reciprocalPolynomialRingHom_coe, + reciprocalPolynomialRingHom_coe] + change (ratFuncCoefficientAlgHom C S).toRingHom + (Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p) = _ + rw [Polynomial.hom_eval₂] + have hX : ratFuncCoefficientAlgHom C S RatFunc.X = RatFunc.X := by + have h := ratFuncCoefficientAlgHom_algebraMap C S Polynomial.X + simpa using h + have hcoeff : + (ratFuncCoefficientAlgHom C S).toRingHom.comp RatFunc.C = + RatFunc.C.comp (algebraMap C S) := by + ext c + change ratFuncCoefficientAlgHom C S + (algebraMap C (RatFunc C) c) = + algebraMap S (RatFunc S) (algebraMap C S c) + rw [(ratFuncCoefficientAlgHom C S).commutes] + exact IsScalarTower.algebraMap_apply C S (RatFunc S) c + have hrecip : (ratFuncCoefficientAlgHom C S).toRingHom + (1 / RatFunc.X) = 1 / RatFunc.X := by + rw [one_div, map_inv₀] + have hX' : (ratFuncCoefficientAlgHom C S).toRingHom RatFunc.X = + RatFunc.X := hX + simpa [hX'] + rw [hcoeff, hrecip] + change Polynomial.eval₂ (RatFunc.C.comp (algebraMap C S)) + (1 / RatFunc.X) p = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) + (Polynomial.map (algebraMap C S) p) + rw [Polynomial.eval₂_map] + +/-- The reciprocal polynomial algebra map is the composite through the +rational-function field. -/ +private theorem ratFuncExtensionReciprocalPolynomialAlgebra_map + (K L : Type*) [Field K] [Field L] + [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) L] (p : K[X]) : + letI : Algebra K[X] L := + ratFuncExtensionReciprocalPolynomialAlgebra K L + algebraMap K[X] L p = algebraMap (RatFunc K) L + (((reciprocalPolynomialRingHom K p : + RatFuncInfinityIntegers K) : RatFunc K)) := by + letI : Algebra K[X] L := + ratFuncExtensionReciprocalPolynomialAlgebra K L + change algebraMap (RatFuncInfinityIntegers K) L + (reciprocalPolynomialRingHom K p) = _ + exact IsScalarTower.algebraMap_apply + (RatFuncInfinityIntegers K) (RatFunc K) L _ + +/-- Version of reciprocal polynomial compatibility elaborated with the +instances used in this file. -/ +private theorem exactConstantExtensionSReciprocalPolynomialAlgebra_eq : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N = + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + apply Algebra.algebra_ext + intro p + change Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) p = + algebraMap (RatFunc S) (ExactConstantExtension C N S) + (((reciprocalPolynomialRingHom S p : + RatFuncInfinityIntegers S) : RatFunc S)) + rw [reciprocalPolynomialRingHom_coe, Polynomial.hom_eval₂] + have hcoeff : + (algebraMap (RatFunc S) + (ExactConstantExtension C N S)).comp RatFunc.C = + algebraMap S (ExactConstantExtension C N S) := by + ext s + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + rw [hcoeff] + change Polynomial.eval₂ + (algebraMap S (ExactConstantExtension C N S)) + (polynomialTensorCancelEvaluationPoint C S N) p = + Polynomial.eval₂ + (algebraMap S (ExactConstantExtension C N S)) + (ratFuncToExactConstantExtension C S N hExact + (1 / RatFunc.X)) p + rw [ratFuncToExactConstantExtension_reciprocal_X C S N hExact] + +/-- The transported reciprocal `C[X]`-action is the actual action induced by +the canonical embedding of `C(X)` into the exact constant extension. -/ +private theorem exactConstantExtensionCReciprocalPolynomialAlgebra_eq : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + exactConstantExtensionCReciprocalPolynomialAlgebra C S N = + ratFuncExtensionReciprocalPolynomialAlgebra C + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra C[X] (ExactConstantExtension C N S) := + exactConstantExtensionCReciprocalPolynomialAlgebra C S N + letI : Algebra S[X] (ExactConstantExtension C N S) := + infinitySplittingExactSPolynomialAlgebra C S N + letI : SMul C[X] (ExactConstantExtension C N S) := + infinitySplittingExactCPolynomialSMul C S N + letI : SMul S[X] (ExactConstantExtension C N S) := + infinitySplittingExactSPolynomialSMul C S N + letI : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := + exactConstantExtensionReciprocalPolynomialTower C S N + apply Algebra.algebra_ext + intro p + let pS := algebraMap C[X] S[X] p + let yC := ((reciprocalPolynomialRingHom C p : + RatFuncInfinityIntegers C) : RatFunc C) + let yS := ((reciprocalPolynomialRingHom S pS : + RatFuncInfinityIntegers S) : RatFunc S) + have hSAlg := exactConstantExtensionSReciprocalPolynomialAlgebra_eq + C S N hExact + have hRat := rationalBase_algebraMap_eq C S N hExact + calc + algebraMap C[X] (ExactConstantExtension C N S) p = + algebraMap S[X] (ExactConstantExtension C N S) pS := + IsScalarTower.algebraMap_apply C[X] S[X] + (ExactConstantExtension C N S) p + _ = @algebraMap S[X] (ExactConstantExtension C N S) _ _ + (ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S)) pS := by + change @algebraMap S[X] (ExactConstantExtension C N S) _ _ + (polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N) pS = _ + exact DFunLike.congr_fun + (congrArg (fun a : Algebra S[X] (ExactConstantExtension C N S) => + @algebraMap S[X] (ExactConstantExtension C N S) _ _ a) hSAlg) pS + _ = algebraMap (RatFunc S) (ExactConstantExtension C N S) yS := + ratFuncExtensionReciprocalPolynomialAlgebra_map S + (ExactConstantExtension C N S) pS + _ = algebraMap (RatFunc S) (ExactConstantExtension C N S) + (algebraMap (RatFunc C) (RatFunc S) yC) := by + congr 1 + exact (ratFuncCoefficientAlgHom_reciprocalPolynomialRingHom C S p).symm + _ = algebraMap (RatFunc C) (ExactConstantExtension C N S) yC := by + exact (DFunLike.congr_fun hRat yC).symm + _ = @algebraMap C[X] (ExactConstantExtension C N S) _ _ + (ratFuncExtensionReciprocalPolynomialAlgebra C + (ExactConstantExtension C N S)) p := + (ratFuncExtensionReciprocalPolynomialAlgebra_map C + (ExactConstantExtension C N S) p).symm + +/-- Replace the transported reciprocal polynomial action by the definitionally +actual action induced from `C(X)`. -/ +noncomputable def exactConstantExtensionCReciprocalNormalizationRingEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + @integralClosure C[X] (ExactConstantExtension C N S) _ _ + (exactConstantExtensionCReciprocalPolynomialAlgebra C S N) ≃+* + @integralClosure C[X] (ExactConstantExtension C N S) _ _ + (ratFuncExtensionReciprocalPolynomialAlgebra C + (ExactConstantExtension C N S)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + rw [exactConstantExtensionCReciprocalPolynomialAlgebra_eq C S N hExact] + +/-- Localization at the reciprocal origin identifies affine primes with the +actual places of the exact constant extension above `C`-infinity. -/ +noncomputable def exactConstantExtensionCReciprocalPrimesEquivInfinityPlace : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra C[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra C + (ExactConstantExtension C N S) + (Ideal.span ({Polynomial.X} : Set C[X])).primesOver + (integralClosure C[X] (ExactConstantExtension C N S)) ≃ + FiniteExtensionInfinityPlace C (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra C[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra C + (ExactConstantExtension C N S) + letI : SMul C[X] (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module C[X] (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra C[X] (RatFunc C) := + ratFuncExtensionReciprocalPolynomialAlgebra C (RatFunc C) + letI : SMul C[X] (RatFunc C) := Algebra.toSMul + letI : IsScalarTower C[X] (RatFunc C) + (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq fun p => by + calc + algebraMap C[X] (ExactConstantExtension C N S) p = + algebraMap (RatFunc C) (ExactConstantExtension C N S) + (((reciprocalPolynomialRingHom C p : + RatFuncInfinityIntegers C) : RatFunc C)) := + ratFuncExtensionReciprocalPolynomialAlgebra_map C + (ExactConstantExtension C N S) p + _ = algebraMap (RatFunc C) (ExactConstantExtension C N S) + (algebraMap C[X] (RatFunc C) p) := by + rw [ratFuncExtensionReciprocalPolynomialAlgebra_map C (RatFunc C) p] + exact congrArg (algebraMap (RatFunc C) + (ExactConstantExtension C N S)) + (Algebra.algebraMap_self_apply _).symm + letI : IsFractionRing C[X] (RatFunc C) := + ratFunc_isFractionRing_reciprocalPolynomial C + let A := integralClosure C[X] (ExactConstantExtension C N S) + let V := RatFuncInfinityIntegers C + let B := RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S) + let o := Ideal.span ({Polynomial.X} : Set C[X]) + letI : Algebra C[X] V := ratFuncInfinityReciprocalPolynomialAlgebra C + letI : o.IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + letI : IsLocalization o.primeCompl V := + ratFuncInfinityIntegers_isLocalization_reciprocal C + letI : Algebra A B := + ratFuncInfinityReciprocalIntegralClosureAlgebra C + (ExactConstantExtension C N S) + letI : SMul A B := Algebra.toSMul + letI : IsLocalization (Algebra.algebraMapSubmonoid A o.primeCompl) B := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal C + (ExactConstantExtension C N S) + letI : Algebra C[X] B := + RingHom.toAlgebra ((algebraMap V B).comp (algebraMap C[X] V)) + letI : IsScalarTower C[X] V B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower C[X] A B := + IsScalarTower.of_algebraMap_eq fun p => by + apply Subtype.ext + rfl + letI : IsDedekindDomain A := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) + (ExactConstantExtension C N S) A + letI : Module C[X] A := Algebra.toModule + letI : Module.IsTorsionFree C[X] + (ExactConstantExtension C N S) := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro x y hxy + apply IsFractionRing.injective C[X] (RatFunc C) + apply (algebraMap (RatFunc C) + (ExactConstantExtension C N S)).injective + simpa only [IsScalarTower.algebraMap_apply C[X] (RatFunc C) + (ExactConstantExtension C N S)] using hxy + letI : IsScalarTower C[X] A (ExactConstantExtension C N S) := by + infer_instance + letI : Module.IsTorsionFree C[X] A := + IsIntegralClosure.isTorsionFree C[X] + (ExactConstantExtension C N S) + have ho : o ≠ ⊥ := by + exact fun h => Polynomial.X_ne_zero (Ideal.span_singleton_eq_bot.mp h) + change o.primesOver A ≃ + (IsLocalRing.maximalIdeal V).primesOver B + exact (IsDedekindDomain.primesOverEquivPrimesOver o V B ho).toEquiv + +private theorem exactConstantExtensionPresentedReciprocalPolynomialTower : + IsScalarTower C[X] S[X] + (S ⊗[C] integralClosure C[X] N) := by + apply IsScalarTower.of_algebraMap_eq + intro p + rw [polynomialTensorCancel_algebraMap_coefficient C S + (integralClosure C[X] N) p] + rfl + +/-- The old reciprocal normalization maps into the reciprocal normalization +of the exact constant extension through the right tensor factor. -/ +private noncomputable def exactConstantExtensionOldToCReciprocalNormalizationMap : + integralClosure C[X] N →ₐ[C[X]] + integralClosure C[X] (ExactConstantExtension C N S) := by + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : IsScalarTower C[X] N (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' rfl + exact (IsScalarTower.toAlgHom C[X] N + (ExactConstantExtension C N S)).mapIntegralClosure + +/-- The normalization equivalence carries the old normalization embedded in +the right tensor factor to its canonical map into the exact extension. -/ +private theorem + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv_includeRight + (x : integralClosure C[X] N) : + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv + C S N + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N) x) = + exactConstantExtensionOldToCReciprocalNormalizationMap C S N x := by + apply Subtype.ext + change ((finiteFieldReciprocalNormalizationAlgEquiv C S N + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N) x) : + integralClosure S[X] (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + (1 : S) ⊗ₜ[C] (x : N) + simp only [finiteFieldReciprocalNormalizationAlgEquiv, + AlgEquiv.trans_apply, + Algebra.TensorProduct.includeRight_apply, + polynomialTensorCancelOverCoefficientPolynomial_symm_apply, + polynomialTensorCancel_symm_tmul, + finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, + AlgEquiv.ofBijective_apply, + AlgEquiv.coe_mapIntegralClosure] + rw [polynomialTensorCancelOverCoefficientPolynomial_apply] + change polynomialTensorCancel C S N + (Polynomial.C 1 ⊗ₜ[C[X]] (x : N)) = + (1 : S) ⊗ₜ[C] (x : N) + rw [polynomialTensorCancel_tmul] + simp + +/-- The reciprocal origin is the unique prime of `S[X]` above the reciprocal +origin of `C[X]`. -/ +private theorem primeUnderReciprocalOrigin_eq_origin + (p : Ideal S[X]) [p.IsPrime] + (hunder : p.under C[X] = + Ideal.span ({Polynomial.X} : Set C[X])) : + p = Ideal.span ({Polynomial.X} : Set S[X]) := by + let oS := Ideal.span ({Polynomial.X} : Set S[X]) + have hXC : (Polynomial.X : C[X]) ∈ p.under C[X] := by + rw [hunder] + exact Ideal.subset_span (Set.mem_singleton Polynomial.X) + have hXS : (Polynomial.X : S[X]) ∈ p := by + change algebraMap C[X] S[X] (Polynomial.X : C[X]) ∈ p at hXC + simpa using hXC + have hle : oS ≤ p := by + rw [Ideal.span_le] + exact Set.singleton_subset_iff.mpr hXS + have hoPrime : oS.IsPrime := by + exact (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr + Polynomial.prime_X + have hoNeBot : oS ≠ ⊥ := by + rw [ne_eq, Ideal.span_singleton_eq_bot] + exact Polynomial.X_ne_zero + exact ((hoPrime.isMaximal hoNeBot).eq_of_le + (inferInstance : p.IsPrime).ne_top hle).symm + +private theorem + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv_commutes + (p : C[X]) : + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv C S N + (algebraMap C[X] (S ⊗[C] integralClosure C[X] N) p) = + algebraMap C[X] + (integralClosure C[X] (ExactConstantExtension C N S)) p := by + letI : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := + exactConstantExtensionReciprocalPolynomialTower C S N + let eS := finiteFieldReciprocalNormalizationAlgEquiv C S N + let eC := exactConstantExtensionReciprocalIntegralClosureTowerEquiv C S N + change eC.symm (eS + (algebraMap C[X] (S ⊗[C] integralClosure C[X] N) p)) = _ + rw [show algebraMap C[X] (S ⊗[C] integralClosure C[X] N) p = + algebraMap S[X] (S ⊗[C] integralClosure C[X] N) + (algebraMap C[X] S[X] p) by + rw [polynomialTensorCancel_algebraMap_coefficient C S + (integralClosure C[X] N) p] + rfl] + rw [eS.commutes] + apply Subtype.ext + change algebraMap S[X] (ExactConstantExtension C N S) + (algebraMap C[X] S[X] p) = + algebraMap C[X] (ExactConstantExtension C N S) p + rw [polynomialTensorCancel_algebraMap_coefficient C S N p] + rfl + +private noncomputable def + exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv : + HeightOneSpectrum (S ⊗[C] integralClosure C[X] N) ≃ + HeightOneSpectrum + (integralClosure C[X] (ExactConstantExtension C N S)) := + HeightOneSpectrum.equivOfRingEquiv + (exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv C S N) + +private theorem + exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv_under + (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) : + ((exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv + C S N) q).asIdeal.under C[X] = + q.asIdeal.under C[X] := by + let e := exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv + C S N + ext p + change e.symm + (algebraMap C[X] + (integralClosure C[X] (ExactConstantExtension C N S)) p) ∈ + q.asIdeal ↔ + algebraMap C[X] (S ⊗[C] integralClosure C[X] N) p ∈ q.asIdeal + rw [← + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv_commutes + C S N p] + simp only [e, RingEquiv.symm_apply_apply] + +private noncomputable def + exactConstantExtensionPresentedInfinityHeightOneEquiv : + ExactConstantExtensionPresentedInfinityPlace C S N ≃ + {q : HeightOneSpectrum + (integralClosure C[X] (ExactConstantExtension C N S)) // + q.asIdeal.under C[X] = + Ideal.span ({Polynomial.X} : Set C[X])} := by + letI : IsScalarTower C[X] S[X] + (S ⊗[C] integralClosure C[X] N) := + exactConstantExtensionPresentedReciprocalPolynomialTower C S N + let e := + exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv + C S N + apply e.subtypeEquiv + intro q + constructor + · intro hq + rw [ + exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv_under + C S N q] + calc + q.asIdeal.under C[X] = + (q.asIdeal.under S[X]).under C[X] := + (Ideal.under_under q.asIdeal).symm + _ = (Ideal.span ({Polynomial.X} : Set S[X])).under C[X] := by + rw [hq] + _ = Ideal.span ({Polynomial.X} : Set C[X]) := + coefficientPolynomial_under_span_X C S + · intro hq + have hqC : q.asIdeal.under C[X] = + Ideal.span ({Polynomial.X} : Set C[X]) := by + rw [← + exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv_under + C S N q] + exact hq + let p := q.asIdeal.under S[X] + letI : q.asIdeal.IsPrime := q.isPrime + letI : p.IsPrime := inferInstance + apply primeUnderReciprocalOrigin_eq_origin C S p + calc + p.under C[X] = q.asIdeal.under C[X] := Ideal.under_under q.asIdeal + _ = Ideal.span ({Polynomial.X} : Set C[X]) := hqC + +private noncomputable def + exactConstantExtensionCReciprocalHeightOneEquivPrimesOver : + {q : HeightOneSpectrum + (integralClosure C[X] (ExactConstantExtension C N S)) // + q.asIdeal.under C[X] = + Ideal.span ({Polynomial.X} : Set C[X])} ≃ + (Ideal.span ({Polynomial.X} : Set C[X])).primesOver + (integralClosure C[X] (ExactConstantExtension C N S)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + exact + { toFun := fun q => ⟨q.1.asIdeal, q.1.isPrime, ⟨q.2.symm⟩⟩ + invFun := fun P => by + let oC := Ideal.span ({Polynomial.X} : Set C[X]) + have hNX : algebraMap C[X] N (Polynomial.X : C[X]) ≠ 0 := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + have hNX' : @algebraMap C[X] N _ _ + (ratFuncExtensionReciprocalPolynomialAlgebra C N) + (Polynomial.X : C[X]) ≠ 0 := by + rw [ratFuncExtensionReciprocalPolynomialAlgebra_map C N] + rw [reciprocalPolynomialRingHom_X] + change algebraMap (RatFunc C) N (1 / RatFunc.X) ≠ 0 + intro hzero + have hzero' : (1 / RatFunc.X : RatFunc C) = 0 := by + apply (algebraMap (RatFunc C) N).injective + simpa only [map_zero] using hzero + exact (one_div_ne_zero RatFunc.X_ne_zero) hzero' + change @algebraMap C[X] N _ _ + (infinitySplittingBaseReciprocalPolynomialAlgebra C N) + (Polynomial.X : C[X]) ≠ 0 + unfold infinitySplittingBaseReciprocalPolynomialAlgebra + unfold infinityReciprocalPolynomialAlgebra + exact hNX' + have hEX : algebraMap C[X] (ExactConstantExtension C N S) + (Polynomial.X : C[X]) ≠ 0 := by + change Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N) + (algebraMap C[X] N (Polynomial.X : C[X])) ≠ 0 + let f := Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N) + intro hx + apply hNX + apply f.injective + exact hx.trans (map_zero f).symm + have hAX : algebraMap C[X] + (integralClosure C[X] (ExactConstantExtension C N S)) + (Polynomial.X : C[X]) ≠ 0 := by + intro hzero + apply hEX + exact congrArg Subtype.val hzero + letI : P.1.LiesOver oC := P.2.2 + have hXmem : algebraMap C[X] + (integralClosure C[X] (ExactConstantExtension C N S)) + (Polynomial.X : C[X]) ∈ P.1 := + (Ideal.mem_of_liesOver P.1 oC Polynomial.X).mp + (Ideal.mem_span_singleton_self Polynomial.X) + have hPNeBot : P.1 ≠ ⊥ := by + intro hbot + apply hAX + rw [hbot] at hXmem + change algebraMap C[X] + (integralClosure C[X] (ExactConstantExtension C N S)) + (Polynomial.X : C[X]) = 0 at hXmem + exact hXmem + let q : HeightOneSpectrum + (integralClosure C[X] (ExactConstantExtension C N S)) := + ⟨P.1, P.2.1, hPNeBot⟩ + refine ⟨q, ?_⟩ + exact (Ideal.over_def P.1 oC).symm + left_inv := by + intro q + apply Subtype.ext + apply HeightOneSpectrum.ext + rfl + right_inv := by + intro P + apply Subtype.ext + rfl } + +/-- Presented infinity places, before changing the transported reciprocal +action to the actual one, are precisely the affine primes above `(X)`. -/ +private noncomputable def + exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes : + ExactConstantExtensionPresentedInfinityPlace C S N ≃ + (Ideal.span ({Polynomial.X} : Set C[X])).primesOver + (integralClosure C[X] (ExactConstantExtension C N S)) := + (exactConstantExtensionPresentedInfinityHeightOneEquiv C S N).trans + (exactConstantExtensionCReciprocalHeightOneEquivPrimesOver + C S N) + +/-- Contracting the transported reciprocal affine prime to the old +normalization recovers the contraction used in the presented downstairs +place. -/ +private theorem + exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes_under_old + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : Algebra (integralClosure C[X] N) + (integralClosure C[X] (ExactConstantExtension C N S)) := + (exactConstantExtensionOldToCReciprocalNormalizationMap C S N).toAlgebra + ((exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes + C S N q).1).under (integralClosure C[X] N) = + exactConstantExtensionInfinityDownstairsIdeal C S N q.1 := by + let e := exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv + C S N + let f := exactConstantExtensionOldToCReciprocalNormalizationMap C S N + letI : Algebra (integralClosure C[X] N) + (integralClosure C[X] (ExactConstantExtension C N S)) := + f.toAlgebra + ext x + change e.symm (f x) ∈ q.1.asIdeal ↔ + Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N) x ∈ + q.1.asIdeal + have hx : e.symm (f x) = + Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N) x := by + apply e.injective + rw [e.apply_symm_apply, + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv_includeRight] + rw [hx] + +/-- Changing from the transported reciprocal action to the actual action does +not change the affine prime fiber. -/ +private noncomputable def integralClosureAlgHomOfAlgebraEq + (R L A : Type*) [CommRing R] [Field L] [CommRing A] [Algebra R A] + (a b : Algebra R L) (h : a = b) + (f : A →ₐ[R] @integralClosure R L _ _ a) : + A →ₐ[R] @integralClosure R L _ _ b := by + rw [← h] + exact f + +private noncomputable def primesOverEquivOfAlgebraEq + (R L : Type*) [CommRing R] [Field L] + (a b : Algebra R L) (h : a = b) (p : Ideal R) : + @Ideal.primesOver R _ p (@integralClosure R L _ _ a) _ _ ≃ + @Ideal.primesOver R _ p (@integralClosure R L _ _ b) _ _ := by + rw [h] + +private theorem primesOverEquivOfAlgebraEq_under + (R L A : Type*) [CommRing R] [Field L] [CommRing A] [Algebra R A] + (a b : Algebra R L) (h : a = b) (p : Ideal R) + (f : A →ₐ[R] @integralClosure R L _ _ a) + (P : @Ideal.primesOver R _ p (@integralClosure R L _ _ a) _ _) : + let g := integralClosureAlgHomOfAlgebraEq R L A a b h f + letI : Algebra A (@integralClosure R L _ _ a) := f.toAlgebra + letI : Algebra A (@integralClosure R L _ _ b) := g.toAlgebra + ((primesOverEquivOfAlgebraEq R L a b h p P).1).under A = + P.1.under A := by + subst b + rfl + +private noncomputable def + exactConstantExtensionCReciprocalPrimesEquivActual : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + @Ideal.primesOver C[X] _ + (Ideal.span ({Polynomial.X} : Set C[X])) + (@integralClosure C[X] (ExactConstantExtension C N S) _ _ + (exactConstantExtensionCReciprocalPolynomialAlgebra C S N)) _ _ ≃ + @Ideal.primesOver C[X] _ + (Ideal.span ({Polynomial.X} : Set C[X])) + (@integralClosure C[X] (ExactConstantExtension C N S) _ _ + (ratFuncExtensionReciprocalPolynomialAlgebra C + (ExactConstantExtension C N S))) _ _ := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + rw [exactConstantExtensionCReciprocalPolynomialAlgebra_eq C S N hExact] + +/-- The reciprocal-normalization presentation of infinity places is exactly +the actual infinity-place type of the exact constant extension over `C`. -/ +noncomputable def exactConstantExtensionPresentedInfinityPlaceEquiv : + ExactConstantExtensionPresentedInfinityPlace C S N ≃ + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + FiniteExtensionInfinityPlace C (ExactConstantExtension C N S) := + (exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes + C S N).trans + ((exactConstantExtensionCReciprocalPrimesEquivActual + C S N hExact).trans + (exactConstantExtensionCReciprocalPrimesEquivInfinityPlace + C S N hExact)) + +/-- The reciprocal presentation equivalence respects restriction to the +original function field. -/ +@[simp] +theorem exactConstantExtensionPresentedInfinityPlaceEquiv_under + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + infinityPlaceUnder C N (ExactConstantExtension C N S) + (exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q) = + exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + apply Subtype.ext + rw [infinityPlaceUnder_asIdeal, + exactConstantExtensionDownstairsInfinityPlace_asIdeal] + let E := ExactConstantExtension C N S + letI : Algebra C[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra C E + let A₀ := integralClosure C[X] N + let B₀ := RatFuncInfinityIntegralClosure C N + let A := integralClosure C[X] E + let B := RatFuncInfinityIntegralClosure C E + let P := (exactConstantExtensionCReciprocalPrimesEquivActual + C S N hExact) + (exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes + C S N q) + let a := exactConstantExtensionCReciprocalPolynomialAlgebra C S N + let b := ratFuncExtensionReciprocalPolynomialAlgebra C E + let h : a = b := + exactConstantExtensionCReciprocalPolynomialAlgebra_eq C S N hExact + let f₀ := exactConstantExtensionOldToCReciprocalNormalizationMap C S N + let g := integralClosureAlgHomOfAlgebraEq C[X] E A₀ a b h f₀ + letI : Algebra A B := + ratFuncInfinityReciprocalIntegralClosureAlgebra C E + letI : SMul A B := Algebra.toSMul + letI : Algebra A₀ B₀ := + ratFuncInfinityReciprocalIntegralClosureAlgebra C N + letI : SMul A₀ B₀ := Algebra.toSMul + letI : Algebra A₀ A := + g.toAlgebra + letI : SMul A₀ A := Algebra.toSMul + letI : Algebra B₀ B := + (infinityIntegralClosureMap C N E).toAlgebra + letI : SMul B₀ B := Algebra.toSMul + change (Ideal.map (algebraMap A B) P.1).under + B₀ = + Ideal.map + (algebraMap A₀ B₀) + (exactConstantExtensionInfinityDownstairsIdeal C S N q.1) + have hAffine : P.1.under A₀ = + exactConstantExtensionInfinityDownstairsIdeal C S N q.1 := by + let P₀ := + exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes + C S N q + have hTransport : P.1.under A₀ = P₀.1.under A₀ := by + exact primesOverEquivOfAlgebraEq_under + C[X] E A₀ a b h + (Ideal.span ({Polynomial.X} : Set C[X])) f₀ P₀ + have hOld := + exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes_under_old + C S N q + exact hTransport.trans hOld + letI : Algebra A₀ B := + RingHom.toAlgebra + ((algebraMap B₀ B).comp (algebraMap A₀ B₀)) + letI : SMul A₀ B := Algebra.toSMul + letI : IsScalarTower A₀ B₀ B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower A₀ A B := + IsScalarTower.of_algebraMap_eq fun x => by + apply Subtype.ext + rfl + have hMax : + (Ideal.map (algebraMap A₀ B₀) (P.1.under A₀)).IsMaximal := by + rw [hAffine] + change (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2).1.IsMaximal + infer_instance + have hNe : Ideal.map (algebraMap A B) P.1 ≠ ⊤ := by + change (exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q).1 ≠ ⊤ + exact (exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q).2.1.ne_top + rw [Ideal.under_map_eq_map_under P.1 hMax hNe, hAffine] + +/-- The residue field of a presented reciprocal prime is the residue field of +the corresponding actual `C`-infinity place. -/ +noncomputable def exactConstantExtensionPresentedInfinityResidueFieldRingEquiv + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + q.1.asIdeal.ResidueField ≃+* + (exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact q).1.ResidueField := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let e₀ := + exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv + C S N + let e₁ := exactConstantExtensionCReciprocalNormalizationRingEquiv + C S N hExact + let e := e₀.trans e₁ + let qA : IsDedekindDomain.HeightOneSpectrum + (@integralClosure C[X] E _ _ + (ratFuncExtensionReciprocalPolynomialAlgebra C E)) := + IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q.1 + let P := (exactConstantExtensionCReciprocalPrimesEquivActual + C S N hExact) + (exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes + C S N q) + have hqA : qA.asIdeal = P.1 := by + rfl + let affineResidue : q.1.asIdeal.ResidueField ≃+* + qA.asIdeal.ResidueField := + infinitySplittingHeightOneResidueFieldRingEquiv e q.1 + letI : Algebra C[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra C E + let A := integralClosure C[X] E + let idealResidue : qA.asIdeal.ResidueField ≃+* P.1.ResidueField := + Ideal.residueFieldRingEquiv qA.asIdeal P.1 (RingEquiv.refl A) + (by + change qA.asIdeal = P.1.comap (RingHom.id A) + rw [Ideal.comap_id, hqA]) + let affineResidue' : q.1.asIdeal.ResidueField ≃+* P.1.ResidueField := + affineResidue.trans idealResidue + let B := RatFuncInfinityIntegralClosure C E + let o := Ideal.span ({Polynomial.X} : Set C[X]) + letI : Algebra A B := + ratFuncInfinityReciprocalIntegralClosureAlgebra C E + letI : SMul A B := Algebra.toSMul + letI : IsLocalization + (Algebra.algebraMapSubmonoid A o.primeCompl) B := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal C E + let M := Algebra.algebraMapSubmonoid A o.primeCompl + have hPUnder : P.1.under C[X] = o := P.2.2.over.symm + have hdisj : Disjoint (M : Set A) (P.1 : Set A) := + infinitySplittingMappedPrimeCompl_disjoint_of_under_eq + C[X] A o P.1 hPUnder + let Q := Ideal.map (algebraMap A B) P.1 + letI : Q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint M B P.1 P.2.1 hdisj + let localResidue : P.1.ResidueField ≃+* Q.ResidueField := + infinitySplittingLocalizationResidueFieldRingEquiv A B M P.1 hdisj + change q.1.asIdeal.ResidueField ≃+* Q.ResidueField + exact affineResidue'.trans localResidue + +section InfinityRamification + + +private theorem infinitySplitting_eq_of_algebraMap_sub_mem_prime + (K R : Type*) [Field K] [CommRing R] [Algebra K R] + (P : Ideal R) [P.IsPrime] (a b : K) + (h : algebraMap K R a - algebraMap K R b ∈ P) : + a = b := by + by_contra hab + have hne : a - b ≠ 0 := sub_ne_zero.mpr hab + have hunit : IsUnit (algebraMap K R (a - b)) := + (isUnit_iff_ne_zero.mpr hne).map (algebraMap K R) + have hmem : algebraMap K R (a - b) ∈ P := by simpa using h + exact (inferInstance : P.IsPrime).ne_top + (P.eq_top_of_isUnit_mem hmem hunit) + +private theorem + infinitySplitting_constantQuotient_eq_one_imp_eq_one + (C N S : Type*) [Field C] [Field N] [Field S] + [Algebra C N] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S] + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) + (hg : letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + exactConstantExtensionConstantQuotient C N N S hExact g = 1) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + g = 1 := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + have hker : g ∈ + (exactConstantExtensionConstantQuotient C N N S hExact).ker := + MonoidHom.mem_ker.mpr hg + rw [exactConstantExtensionConstantQuotient_ker C N N S hExact] at hker + obtain ⟨u, hu⟩ := hker + have huOne : u = 1 := Subsingleton.elim _ _ + calc + g = exactConstantExtensionFunctionAutHom C N N S u := hu.symm + _ = exactConstantExtensionFunctionAutHom C N N S 1 := + congrArg (exactConstantExtensionFunctionAutHom C N N S) huOne + _ = 1 := map_one (exactConstantExtensionFunctionAutHom C N N S) + +@[reducible] local instance infinitySplittingInfinityBaseRatFuncAlgebra : + Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + RingHom.toAlgebra + (SubringClass.subtype ((RatFunc.inftyValuation C).integer)) + +local instance infinitySplittingInfinityBaseRatFuncSMul : + SMul (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toSMul + +local instance infinitySplittingInfinityBaseRatFuncModule : + Module (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toModule + +@[reducible] local instance infinitySplittingInfinityBaseNAlgebra : + Algebra (RatFuncInfinityIntegers C) N := + RingHom.toAlgebra + ((algebraMap (RatFunc C) N).comp + (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) + +local instance infinitySplittingInfinityBaseNSMul : + SMul (RatFuncInfinityIntegers C) N := Algebra.toSMul + +local instance infinitySplittingInfinityBaseNModule : + Module (RatFuncInfinityIntegers C) N := Algebra.toModule + +local instance infinitySplittingInfinityBaseNTower : + IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Galois action on the infinity normalization restricts to the expected +constant-field quotient action. -/ +theorem exactConstantExtensionConstantQuotient_action_on_infinityNormalization : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + letI : Algebra (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) + letI : SMul (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) + (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionInfinityIntegralClosureConstantAlgebra + C S N hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) + (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + infinityIntegralClosureGalAction C N (ExactConstantExtension C N S) + ∀ (g : ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) (s : S), + g • algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) s = + algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) + (exactConstantExtensionConstantQuotient C N N S hExact g s) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + letI : Algebra (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) + letI : SMul (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) + (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionInfinityIntegralClosureConstantAlgebra + C S N hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) + (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + infinityIntegralClosureGalAction C N (ExactConstantExtension C N S) + intro g s + apply Subtype.ext + calc + ((g • algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) s : + RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + g ((algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) s : + RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + exact algebraMap.smul' + (B := RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) + g + (algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) s) + (ExactConstantExtension C N S) + _ = (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N)) + (exactConstantExtensionConstantQuotient C N N S hExact g s) := by + change g ((Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N)) s) = _ + exact exactConstantExtensionConstantQuotient_action_on_constants + C N N S hExact g s + _ = ((algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) + (exactConstantExtensionConstantQuotient C N N S hExact g s) : + RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := rfl + +/-- Every infinity place is unramified in an exact extension of constants. -/ +theorem exactConstantExtensionInfinityPlace_ramificationIdx_eq_one + (Q : letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + FiniteExtensionInfinityPlace C (ExactConstantExtension C N S)) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + infinityPlaceRelativeRamificationIdx C N + (ExactConstantExtension C N S) Q = 1 := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + letI : Algebra (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) + letI : SMul (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) + (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionInfinityIntegralClosureConstantAlgebra + C S N hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) + (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + infinityIntegralClosureGalAction C N (ExactConstantExtension C N S) + rw [← infinityPlaceInertiaGroup_card_eq_ramificationIdx C N + (ExactConstantExtension C N S) Q] + have hsubsingleton : + Subsingleton (infinityPlaceInertiaGroup C N + (ExactConstantExtension C N S) Q) := by + constructor + intro g h + apply Subtype.ext + have inertiaElement_eq_one + (u : infinityPlaceInertiaGroup C N + (ExactConstantExtension C N S) Q) : u.1 = 1 := by + have hquot : exactConstantExtensionConstantQuotient + C N N S hExact u.1 = 1 := by + apply AlgEquiv.ext + intro s + have hinertia := AddSubgroup.mem_inertia.mp u.2 + (algebraMap S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) s) + rw [exactConstantExtensionConstantQuotient_action_on_infinityNormalization + C S N hExact] at hinertia + letI : Q.1.IsPrime := Q.2.1 + exact infinitySplitting_eq_of_algebraMap_sub_mem_prime S + (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) Q.1 _ _ hinertia + exact infinitySplitting_constantQuotient_eq_one_imp_eq_one + C N S hExact u.1 hquot + have hgOne := inertiaElement_eq_one g + have hhOne := inertiaElement_eq_one h + exact hgOne.trans hhOne.symm + letI := hsubsingleton + exact Nat.card_unique + +end InfinityRamification + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean new file mode 100644 index 0000000000..7f91f865e9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean @@ -0,0 +1,666 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility + +/-! +# Splitting multiplicity in an exact extension of constants + +This file proves the finite-place multiplicity in the standard splitting law +for an exact extension of constants. The proof does not assume the splitting +law: it proves that inertia is trivial by restricting an inertia element to +the embedded enlarged constant field, computes the relative residue degree +from the already established absolute degree formula, and applies the Galois +fiber identity. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +/-- A prime ideal in an algebra over a field cannot identify two distinct +elements of that field. -/ +private theorem eq_of_algebraMap_sub_mem_prime + (K R : Type*) [Field K] [CommRing R] [Algebra K R] + (P : Ideal R) [P.IsPrime] (a b : K) + (h : algebraMap K R a - algebraMap K R b ∈ P) : + a = b := by + by_contra hab + have hne : a - b ≠ 0 := sub_ne_zero.mpr hab + have hunit : IsUnit (algebraMap K R (a - b)) := + (isUnit_iff_ne_zero.mpr hne).map (algebraMap K R) + have hmem : algebraMap K R (a - b) ∈ P := by + simpa using h + exact (inferInstance : P.IsPrime).ne_top + (P.eq_top_of_isUnit_mem hmem hunit) + +/-- If the intermediate field is the original function field itself, the +constant quotient is faithful. This is the exactness input used to kill +inertia. -/ +private theorem exactConstantExtensionConstantQuotient_eq_one_imp_eq_one + (C N S : Type*) [Field C] [Field N] [Field S] + [Algebra C N] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S] + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) + (hg : letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + exactConstantExtensionConstantQuotient C N N S hExact g = 1) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + g = 1 := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C N N S + have hker : g ∈ + (exactConstantExtensionConstantQuotient C N N S hExact).ker := + MonoidHom.mem_ker.mpr hg + rw [exactConstantExtensionConstantQuotient_ker C N N S hExact] at hker + obtain ⟨u, hu⟩ := hker + have huOne : u = 1 := Subsingleton.elim _ _ + calc + g = exactConstantExtensionFunctionAutHom C N N S u := hu.symm + _ = exactConstantExtensionFunctionAutHom C N N S 1 := + congrArg (exactConstantExtensionFunctionAutHom C N N S) huOne + _ = 1 := map_one (exactConstantExtensionFunctionAutHom C N N S) + +/-- Arithmetic cancellation used to recover the relative residue degree from +the two absolute degree formulas. -/ +private theorem eq_div_gcd_of_mul_eq_mul_div_gcd + (r d f : ℕ) (hd : 0 < d) + (h : d * f = r * (d / Nat.gcd r d)) : + f = r / Nat.gcd r d := by + apply Nat.eq_of_mul_eq_mul_left hd + calc + d * f = r * (d / Nat.gcd r d) := h + _ = (Nat.gcd r d * (r / Nat.gcd r d)) * + (d / Nat.gcd r d) := by + rw [Nat.mul_div_cancel' (Nat.gcd_dvd_left r d)] + _ = (Nat.gcd r d * (d / Nat.gcd r d)) * + (r / Nat.gcd r d) := by ac_rfl + _ = d * (r / Nat.gcd r d) := by + rw [Nat.mul_div_cancel' (Nat.gcd_dvd_right r d)] + +/-- Cancelling the nonzero complementary factor in the gcd decomposition of +`r`. -/ +private theorem eq_gcd_of_mul_div_gcd_eq + (r d a : ℕ) (hr : 0 < r) + (h : a * (r / Nat.gcd r d) = r) : + a = Nat.gcd r d := by + have hquot : 0 < r / Nat.gcd r d := + Nat.div_pos + (Nat.le_of_dvd hr (Nat.gcd_dvd_left r d)) + (Nat.gcd_pos_of_pos_left d hr) + apply Nat.eq_of_mul_eq_mul_right hquot + calc + a * (r / Nat.gcd r d) = r := h + _ = Nat.gcd r d * (r / Nat.gcd r d) := + (Nat.mul_div_cancel' (Nat.gcd_dvd_left r d)).symm + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance splittingBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance splittingBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance splittingBasePolynomialAlgebra : Algebra C[X] N := + bridgeBasePolynomialAlgebra C N + +local instance splittingTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- Every finite place is unramified in an exact extension of constants. -/ +theorem exactConstantExtensionFinitePlace_ramificationIdx_eq_one + (Q : letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + FiniteExtensionFinitePlace C (ExactConstantExtension C N S)) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + finitePlaceRelativeRamificationIdx C N + (ExactConstantExtension C N S) Q = 1 := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra + C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[N] + ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C N + (ExactConstantExtension C N S) + rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C N + (ExactConstantExtension C N S) Q] + have hsubsingleton : + Subsingleton (finitePlaceInertiaGroup C N + (ExactConstantExtension C N S) Q) := by + constructor + intro g h + apply Subtype.ext + have inertiaElement_eq_one + (u : finitePlaceInertiaGroup C N + (ExactConstantExtension C N S) Q) : u.1 = 1 := by + have hquot : exactConstantExtensionConstantQuotient + C N N S hExact u.1 = 1 := by + apply AlgEquiv.ext + intro s + have hinertia := + AddSubgroup.mem_inertia.mp u.2 + (algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) s) + rw [exactConstantExtensionConstantQuotient_action_on_finiteNormalization + C N S hExact N] at hinertia + exact eq_of_algebraMap_sub_mem_prime S + (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) Q.asIdeal _ _ hinertia + exact exactConstantExtensionConstantQuotient_eq_one_imp_eq_one + C N S hExact u.1 hquot + have hgOne := inertiaElement_eq_one g + have hhOne := inertiaElement_eq_one h + exact hgOne.trans hhOne.symm + letI := hsubsingleton + exact Nat.card_unique + +/-- A downstairs finite place of degree `d` has exactly +`gcd([S : C], d)` finite places above it in the exact extension of constants. + +The chosen explicit normalization prime supplies one point of the fiber; the +cardinality is that of the entire actual restriction fiber, not merely a +cardinality of a selected presentation. -/ +theorem exactConstantExtensionFinitePlace_fiber_card_eq_gcd + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + Fintype.card (FinitePlaceUnderFiber C N + (ExactConstantExtension C N S) + (exactConstantExtensionDownstairsFinitePlace + C S N hExact q)) = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inl (exactConstantExtensionDownstairsFinitePlace + C S N hExact q))) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q + let Qs := exactConstantExtensionUpstairsFinitePlace C S N hExact q + let r := Module.finrank C S + let d := finiteExtensionPlaceDegree C N (.inl P) + have hUnder : finitePlaceUnder C N + (ExactConstantExtension C N S) Q = P := + exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact q + have hBase := finiteExtensionFinitePlace_degree_baseChange + C S (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact) Q + rw [exactConstantExtensionCompatibleBaseFinitePlace_baseChange] + at hBase + have hUpstairs : finiteExtensionPlaceDegree S + (ExactConstantExtension C N S) (.inl Qs) = + d / Nat.gcd r d := by + exact exactConstantExtensionFinitePlace_degree_eq_div_gcd + C S N hExact q + have hTop : finiteExtensionPlaceDegree C + (ExactConstantExtension C N S) (.inl Q) = + r * (d / Nat.gcd r d) := by + exact hBase.trans (congrArg (fun n => r * n) hUpstairs) + have hTower := finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg + C N (ExactConstantExtension C N S) Q + rw [hUnder] at hTower + have hd : 0 < d := finiteExtensionPlaceDegree_pos C N (.inl P) + have hInertia : finitePlaceRelativeInertiaDeg C N + (ExactConstantExtension C N S) Q = r / Nat.gcd r d := + eq_div_gcd_of_mul_eq_mul_div_gcd r d _ hd + (hTower.symm.trans hTop) + let Q0 : FinitePlaceUnderFiber C N + (ExactConstantExtension C N S) P := ⟨Q, hUnder⟩ + have hFund := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + C N (ExactConstantExtension C N S) P Q0 + have hRam : finitePlaceRelativeRamificationIdx C N + (ExactConstantExtension C N S) Q = 1 := + exactConstantExtensionFinitePlace_ramificationIdx_eq_one + C S N hExact Q + rw [exactConstantExtension_finrank C N S] at hFund + have hCount : Fintype.card (FinitePlaceUnderFiber C N + (ExactConstantExtension C N S) P) * (r / Nat.gcd r d) = r := by + simpa [Q0, hRam, hInertia, r] using hFund + exact eq_gcd_of_mul_div_gcd_eq r d _ Module.finrank_pos hCount + +/-- The explicit `S[X]`-normalization presentation exhausts the actual finite +places of the constant extension, viewed over the original constant field +`C`. -/ +noncomputable def exactConstantExtensionPresentedFinitePlaceEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) ≃ + FiniteExtensionFinitePlace C (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + letI : IsScalarTower C C[X] (integralClosure C[X] N) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + bridgeTensorNormalizationPolynomialAlgebra C S N + letI : Algebra S (integralClosure S[X] + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (integralClosure S[X] + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + let first := heightOneSpectrumEquivOfAlgEquiv + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).symm + let second := finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv + S (ExactConstantExtension C N S) + (S ⊗[C] integralClosure C[X] N) + (exactConstantExtensionNormalizationAlgEquiv C S N hExact) + let third := (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact))).symm + exact first.trans (second.trans third) + +@[simp] +theorem exactConstantExtensionPresentedFinitePlaceEquiv_apply + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exactConstantExtensionPresentedFinitePlaceEquiv C S N hExact q = + exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q := by + rfl + +/-- Restricting the global presentation equivalence to a fixed downstairs +place identifies the presented contraction fiber with the entire actual +place-restriction fiber. -/ +noncomputable def exactConstantExtensionPresentedFinitePlaceFiberEquiv + (P : FiniteExtensionFinitePlace C N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + {q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) // + exactConstantExtensionDownstairsFinitePlace + C S N hExact q = P} ≃ + FinitePlaceUnderFiber C N (ExactConstantExtension C N S) P := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + let e := exactConstantExtensionPresentedFinitePlaceEquiv + C S N hExact + exact + { toFun := fun q => + ⟨e q.1, by + rw [exactConstantExtensionPresentedFinitePlaceEquiv_apply] + exact (exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact q.1).trans q.2⟩ + invFun := fun Q => + ⟨e.symm Q.1, by + have hUnder := + exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact (e.symm Q.1) + have he : exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact (e.symm Q.1) = Q.1 := by + calc + _ = e (e.symm Q.1) := + (exactConstantExtensionPresentedFinitePlaceEquiv_apply + C S N hExact (e.symm Q.1)).symm + _ = Q.1 := e.apply_symm_apply Q.1 + rw [he] at hUnder + exact hUnder.symm.trans Q.2⟩ + left_inv := fun q => by + apply Subtype.ext + exact e.symm_apply_apply q.1 + right_inv := fun Q => by + apply Subtype.ext + exact e.apply_symm_apply Q.1 } + +/-- The presented finite contraction fiber itself has the standard gcd +cardinality. This is the presentation-level exhaustiveness form of the +constant-extension splitting law. -/ +theorem exactConstantExtensionPresentedFinitePlaceFiber_natCard_eq_gcd + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + Nat.card {q' : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) // + exactConstantExtensionDownstairsFinitePlace C S N hExact q' = + exactConstantExtensionDownstairsFinitePlace C S N hExact q} = + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N + (.inl (exactConstantExtensionDownstairsFinitePlace + C S N hExact q))) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + calc + Nat.card {q' : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)) // + exactConstantExtensionDownstairsFinitePlace C S N hExact q' = P} = + Nat.card (FinitePlaceUnderFiber C N + (ExactConstantExtension C N S) P) := + Nat.card_congr + (exactConstantExtensionPresentedFinitePlaceFiberEquiv + C S N hExact P) + _ = Fintype.card (FinitePlaceUnderFiber C N + (ExactConstantExtension C N S) P) := + Nat.card_eq_fintype_card + _ = Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inl P)) := + exactConstantExtensionFinitePlace_fiber_card_eq_gcd + C S N hExact q + +section InfinityConstantEmbedding + +local instance splittingInfinityBaseConstantAlgebra : + Algebra C (RatFuncInfinityIntegers C) := + (ratFuncInfinityConstantRingHom C).toAlgebra + +local instance splittingInfinityBaseRatFuncAlgebra : + Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + RingHom.toAlgebra + (SubringClass.subtype ((RatFunc.inftyValuation C).integer)) + +local instance splittingInfinityExactBaseAlgebra : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Algebra (RatFuncInfinityIntegers C) + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + exact RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) + +/-- The enlarged constants map into the infinity normalization over the +original constant field. -/ +noncomputable def exactConstantExtensionConstantToInfinityIntegralClosureRingHom : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + S →+* RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Fintype S := Fintype.ofFinite S + let f : S →ₐ[C] ExactConstantExtension C N S := + Algebra.TensorProduct.includeLeft + exact + { toFun := fun s => + ⟨f s, by + refine ⟨Polynomial.X ^ Nat.card S - Polynomial.X, ?_, ?_⟩ + · apply Polynomial.monic_X_pow_sub + rw [Polynomial.degree_X] + exact_mod_cast + (lt_of_lt_of_le Nat.one_lt_two + (Finite.one_lt_card : 2 ≤ Nat.card S)) + · simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, + Polynomial.eval₂_X] + change (f s) ^ Nat.card S - f s = 0 + rw [← map_pow, Nat.card_eq_fintype_card, + FiniteField.pow_card s, sub_self]⟩ + map_one' := by ext; exact map_one f + map_mul' := fun x y => by ext; exact map_mul f x y + map_zero' := by ext; exact map_zero f + map_add' := fun x y => by ext; exact map_add f x y } + +/-- The enlarged-constant algebra structure on the infinity normalization. -/ +@[reducible] noncomputable def + exactConstantExtensionInfinityIntegralClosureConstantAlgebra : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Algebra S (RatFuncInfinityIntegralClosure C + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + (exactConstantExtensionConstantToInfinityIntegralClosureRingHom + C S N hExact) + +end InfinityConstantEmbedding + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean new file mode 100644 index 0000000000..457bf9b4fe --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean @@ -0,0 +1,125 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge + +/-! +# Rational finite places after exact constant extension + +For a finite Galois function-field extension, the degree of a place above a +rational base place divides the relative field degree. Combining this fact +with the constant-extension degree formula shows that an extension of +constants whose degree is divisible by the Galois degree makes every such +lifted place rational. + +This is the numerical-to-geometric bridge used when Stichtenoth chooses the +constant-extension degree to be divisible by the Galois-group order. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (M : Type*) [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra M L] [IsScalarTower (RatFunc K) M L] [IsGalois M L] + +/-- In a finite Galois tower, a finite place over a degree-one intermediate +place has degree dividing the relative field degree. -/ +theorem finiteExtensionFinitePlace_degree_dvd_relative_finrank_of_under_degree_one + (Q : FiniteExtensionFinitePlace K L) + (hUnder : finiteExtensionPlaceDegree K M + (.inl (finitePlaceUnder K M L Q)) = 1) : + finiteExtensionPlaceDegree K L (.inl Q) ∣ Module.finrank M L := by + let P := finitePlaceUnder K M L Q + let Q₀ : FinitePlaceUnderFiber K M L P := ⟨Q, rfl⟩ + have hfiber := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M L P Q₀ + have hdegree := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M L Q + rw [hUnder, one_mul] at hdegree + rw [hdegree, ← hfiber] + exact dvd_mul_left _ _ + +section ExactConstantExtension + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance exactRationalBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance (priority := 10000) exactRationalBasePolynomialAlgebra : + Algebra C[X] N := + bridgeBasePolynomialAlgebra C N + +local instance (priority := 10000) exactRationalTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- If the constant-extension degree is divisible by the Galois degree, then +an upstairs finite place whose contraction lies over a rational base place +has degree one over the enlarged constants. -/ +theorem exactConstantExtensionUpstairsFinitePlace_degree_eq_one_of_under_degree_one + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) + (hUnder : finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) N + (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) = 1) + (hDegree : Module.finrank (RatFunc C) N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inl (exactConstantExtensionUpstairsFinitePlace C S N hExact q)) = 1 := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + have hPdiv : finiteExtensionPlaceDegree C N (.inl P) ∣ + Module.finrank (RatFunc C) N := + finiteExtensionFinitePlace_degree_dvd_relative_finrank_of_under_degree_one + C (RatFunc C) N P hUnder + have hPdivS : finiteExtensionPlaceDegree C N (.inl P) ∣ + Module.finrank C S := hPdiv.trans hDegree + rw [exactConstantExtensionFinitePlace_degree_eq_div_gcd C S N hExact q, + Nat.gcd_eq_right_iff_dvd.mpr hPdivS] + apply Nat.div_self + apply Nat.pos_of_ne_zero + intro hzero + have hzeroP : finiteExtensionPlaceDegree C N (.inl P) = 0 := by + simpa [P] using hzero + obtain ⟨c, hc⟩ := hPdiv + have hfinrankZero : Module.finrank (RatFunc C) N = 0 := by + simpa [hzeroP] using hc + exact (Module.finrank_pos.ne' hfinrankZero) + +end ExactConstantExtension + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean new file mode 100644 index 0000000000..21f374b459 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean @@ -0,0 +1,434 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +import Mathlib.FieldTheory.Finite.Extension +import Mathlib.FieldTheory.Galois.Basic + +/-! +# Automorphisms of plane-curve constant extensions + +For an algebraic extension `E / K`, this file transports every element of +`Gal(E/K)` to the scalar extension of a plane-curve function field. The +transported automorphisms act on `E` in the prescribed way and fix the +original function field pointwise. + +When `K` and `E` are finite, the scalar-extended function field has degree +`[E : K]`, is Galois over the original function field, and its full Galois +group is identified with `Gal(E/K)`. The finite-field Frobenius therefore +acts with exact order `[E : K]` on the base-changed function field. + +This file does not identify fixed points or rational places; those are the +next local-geometric layer. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +section Tensor + +variable (K E L : Type*) [Field K] [Field E] [CommRing L] + [Algebra K E] [Algebra K L] + +noncomputable def tensorConstantAlgEquiv (σ : E ≃ₐ[K] E) : + E ⊗[K] L ≃ₐ[K] E ⊗[K] L := + Algebra.TensorProduct.congr σ (AlgEquiv.refl : L ≃ₐ[K] L) + +@[simp] +theorem tensorConstantAlgEquiv_tmul (σ : E ≃ₐ[K] E) (e : E) (x : L) : + tensorConstantAlgEquiv K E L σ (e ⊗ₜ[K] x) = σ e ⊗ₜ[K] x := by + rfl + +@[simp] +theorem tensorConstantAlgEquiv_includeRight (σ : E ≃ₐ[K] E) (x : L) : + tensorConstantAlgEquiv K E L σ + (Algebra.TensorProduct.includeRight (R := K) (A := E) (B := L) x) = + Algebra.TensorProduct.includeRight (R := K) (A := E) (B := L) x := by + simp [Algebra.TensorProduct.includeRight_apply] + +noncomputable def tensorConstantAutHom : + (E ≃ₐ[K] E) →* (E ⊗[K] L ≃ₐ[K] E ⊗[K] L) where + toFun := tensorConstantAlgEquiv K E L + map_one' := by + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul e x => simp + | add x y hx hy => simp [hx, hy] + map_mul' σ τ := by + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul e x => simp + | add x y hx hy => simp [hx, hy] + +theorem tensorConstantAutHom_injective [Nontrivial L] : + Function.Injective (tensorConstantAutHom K E L) := by + intro σ τ h + ext e + have h' := DFunLike.congr_fun h (e ⊗ₜ[K] (1 : L)) + change tensorConstantAlgEquiv K E L σ (e ⊗ₜ[K] (1 : L)) = + tensorConstantAlgEquiv K E L τ (e ⊗ₜ[K] (1 : L)) at h' + have hinc : + Algebra.TensorProduct.includeLeft (R := K) (S := K) (A := E) (B := L) (σ e) = + Algebra.TensorProduct.includeLeft (R := K) (S := K) (A := E) (B := L) (τ e) := by + simpa [Algebra.TensorProduct.includeLeft_apply] using h' + exact (Algebra.TensorProduct.includeLeft_injective + (R := K) (S := K) (A := E) (B := L) (algebraMap K L).injective) hinc + +end Tensor + +section Plane + +open BGS.CorvajaZannier + +variable (K E : Type*) [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + [Algebra.IsAlgebraic K E] + +noncomputable def planeCurveConstantAlgEquiv (σ : E ≃ₐ[K] E) : + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) ≃ₐ[K] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) := by + let φ := (planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE).restrictScalars K + exact φ.symm.trans ((tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) σ).trans φ) + +noncomputable def planeCurveFunctionFieldBaseChangeAlgHom : + PlaneCurveFunctionField f →ₐ[K] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) := + ((planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE).restrictScalars K).toAlgHom.comp + (Algebra.TensorProduct.includeRight + (R := K) (A := E) (B := PlaneCurveFunctionField f)) + +@[simp] +theorem planeCurveConstantAlgEquiv_baseChange + (σ : E ≃ₐ[K] E) (x : PlaneCurveFunctionField f) : + planeCurveConstantAlgEquiv K E f hf hfE σ + (planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE x) = + planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE x := by + simp [planeCurveConstantAlgEquiv, planeCurveFunctionFieldBaseChangeAlgHom] + +@[simp] +theorem planeCurveConstantAlgEquiv_algebraMap + (σ : E ≃ₐ[K] E) (e : E) : + planeCurveConstantAlgEquiv K E f hf hfE σ + (algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) e) = + algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) (σ e) := by + let φ := planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE + change φ ((tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) σ) + (φ.symm (algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) e))) = _ + have hpre : + φ.symm (algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) e) = + e ⊗ₜ[K] (1 : PlaneCurveFunctionField f) := by + simpa only [φ, AlgEquiv.symm_apply_apply] using congrArg φ.symm + (planeCurveFunctionFieldBaseChangeAlgEquiv_tmul_one + K E f hf hfE e).symm + rw [hpre] + rw [tensorConstantAlgEquiv_tmul] + exact planeCurveFunctionFieldBaseChangeAlgEquiv_tmul_one K E f hf hfE (σ e) + +noncomputable def planeCurveConstantAutHom : + (E ≃ₐ[K] E) →* + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) ≃ₐ[K] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) where + toFun := planeCurveConstantAlgEquiv K E f hf hfE + map_one' := by + apply AlgEquiv.ext + intro x + change (planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE) + ((tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) 1) + ((planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE).symm x)) = x + rw [show tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) 1 = 1 from + (tensorConstantAutHom K E (PlaneCurveFunctionField f)).map_one] + simp + map_mul' σ τ := by + apply AlgEquiv.ext + intro x + change (planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE) + ((tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) (σ * τ)) + ((planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE).symm x)) = _ + rw [show tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) (σ * τ) = + tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) σ * + tensorConstantAlgEquiv K E (PlaneCurveFunctionField f) τ from + (tensorConstantAutHom K E (PlaneCurveFunctionField f)).map_mul σ τ] + simp [planeCurveConstantAlgEquiv] + +theorem planeCurveConstantAutHom_injective : + Function.Injective (planeCurveConstantAutHom K E f hf hfE) := by + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + intro σ τ h + ext e + have h' := DFunLike.congr_fun h + (algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) e) + change planeCurveConstantAlgEquiv K E f hf hfE σ _ = + planeCurveConstantAlgEquiv K E f hf hfE τ _ at h' + rw [planeCurveConstantAlgEquiv_algebraMap, + planeCurveConstantAlgEquiv_algebraMap] at h' + exact (algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f))).injective h' + +/-- The algebra structure on the base-changed function field induced by the +canonical embedding of the original function field. -/ +@[reducible] noncomputable def planeCurveFunctionFieldBaseChangeAlgebra : + Algebra (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + (planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE).toAlgebra + +/-- The base-changed function field has the expected dimension over the +original function field. -/ +noncomputable def planeCurveFunctionFieldBaseChangeLinearEquiv : + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + (PlaneCurveFunctionField f) ⊗[K] E ≃ₗ[PlaneCurveFunctionField f] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let φ := planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE + let ψ := (Algebra.TensorProduct.comm K (PlaneCurveFunctionField f) E).toRingEquiv.trans + φ.toRingEquiv + exact + { toEquiv := ψ.toEquiv + map_add' := map_add ψ + map_smul' := by + intro x z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul y e => + change φ (e ⊗ₜ[K] (x * y)) = + φ (1 ⊗ₜ[K] x) * φ (e ⊗ₜ[K] y) + rw [← map_mul] + simp + | add z w hz hw => + rw [smul_add] + calc + ψ (x • z + x • w) = ψ (x • z) + ψ (x • w) := map_add ψ _ _ + _ = x • ψ z + x • ψ w := congrArg₂ (· + ·) hz hw + _ = x • ψ (z + w) := by rw [map_add, smul_add] } + +theorem planeCurveFunctionFieldBaseChange_finrank : + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + Module.finrank (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) = + Module.finrank K E := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + calc + Module.finrank (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) = + Module.finrank (PlaneCurveFunctionField f) + ((PlaneCurveFunctionField f) ⊗[K] E) := + (planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE).finrank_eq.symm + _ = Module.finrank K E := Module.finrank_baseChange + +/-- A constant-field automorphism, viewed as an automorphism over the +embedded original function field. -/ +noncomputable def planeCurveConstantAlgEquivOverBase (σ : E ≃ₐ[K] E) : + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) ≃ₐ[ + PlaneCurveFunctionField f] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) := by + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + exact + { planeCurveConstantAlgEquiv K E f hf hfE σ with + commutes' := fun x => by + change planeCurveConstantAlgEquiv K E f hf hfE σ + (planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE x) = + planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE x + exact planeCurveConstantAlgEquiv_baseChange K E f hf hfE σ x } + +noncomputable def planeCurveConstantAutOverBaseHom : + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + (E ≃ₐ[K] E) →* + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) ≃ₐ[ + PlaneCurveFunctionField f] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + exact + { toFun := planeCurveConstantAlgEquivOverBase K E f hf hfE + map_one' := by + apply AlgEquiv.ext + intro x + exact DFunLike.congr_fun + (planeCurveConstantAutHom K E f hf hfE).map_one x + map_mul' := by + intro σ τ + apply AlgEquiv.ext + intro x + exact DFunLike.congr_fun + ((planeCurveConstantAutHom K E f hf hfE).map_mul σ τ) x } + +theorem planeCurveConstantAutOverBaseHom_injective : + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + Function.Injective (planeCurveConstantAutOverBaseHom K E f hf hfE) := by + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + intro σ τ h + apply planeCurveConstantAutHom_injective K E f hf hfE + apply AlgEquiv.ext + intro x + exact DFunLike.congr_fun h x + +theorem planeCurveFunctionFieldBaseChange_isGalois + [Fintype K] [Finite E] : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + IsGalois (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE + letI : Module.Finite (PlaneCurveFunctionField f) + ((PlaneCurveFunctionField f) ⊗[K] E) := + Module.Finite.base_change K (PlaneCurveFunctionField f) E + letI : Module.Finite (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + Module.Finite.equiv e + apply IsGalois.of_card_aut_eq_finrank + apply Nat.le_antisymm + · calc + Nat.card (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f) ≃ₐ[PlaneCurveFunctionField f] + PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) = + Nat.card (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f) →ₐ[PlaneCurveFunctionField f] + PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := + Nat.card_congr (algEquivEquivAlgHom + (PlaneCurveFunctionField f) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f))) + _ ≤ Module.finrank (PlaneCurveFunctionField f) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := + card_algHom_le_finrank _ _ _ + · rw [planeCurveFunctionFieldBaseChange_finrank K E f hf hfE, + ← IsGalois.card_aut_eq_finrank K E] + exact Nat.card_le_card_of_injective + (planeCurveConstantAutOverBaseHom K E f hf hfE) + (planeCurveConstantAutOverBaseHom_injective K E f hf hfE) + +/-- The Galois group of the constant extension is exactly the Galois group of +the enlarged constants. -/ +noncomputable def planeCurveConstantAutOverBaseMulEquiv + [Fintype K] [Finite E] : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + (E ≃ₐ[K] E) ≃* + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) ≃ₐ[ + PlaneCurveFunctionField f] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE + letI : Module.Finite (PlaneCurveFunctionField f) + ((PlaneCurveFunctionField f) ⊗[K] E) := + Module.Finite.base_change K (PlaneCurveFunctionField f) E + letI : Module.Finite (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + Module.Finite.equiv e + letI : IsGalois (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + planeCurveFunctionFieldBaseChange_isGalois K E f hf hfE + let h := planeCurveConstantAutOverBaseHom K E f hf hfE + let hinj := planeCurveConstantAutOverBaseHom_injective K E f hf hfE + apply MulEquiv.ofBijective h + apply hinj.bijective_of_nat_card_le + rw [IsGalois.card_aut_eq_finrank, + planeCurveFunctionFieldBaseChange_finrank K E f hf hfE, + IsGalois.card_aut_eq_finrank K E] + +section Frobenius + +variable [Fintype K] + +/-- Frobenius on the enlarged constant field, transported to the +base-changed plane-curve function field. -/ +noncomputable def planeCurveConstantFrobeniusAlgEquiv : + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) ≃ₐ[K] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) := + planeCurveConstantAlgEquiv K E f hf hfE + (FiniteField.frobeniusAlgEquivOfAlgebraic K E) + +@[simp] +theorem planeCurveConstantFrobeniusAlgEquiv_algebraMap (e : E) : + planeCurveConstantFrobeniusAlgEquiv K E f hf hfE + (algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) e) = + algebraMap E + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) + (e ^ Fintype.card K) := by + rw [planeCurveConstantFrobeniusAlgEquiv, + planeCurveConstantAlgEquiv_algebraMap] + rfl + +@[simp] +theorem planeCurveConstantFrobeniusAlgEquiv_baseChange + (x : PlaneCurveFunctionField f) : + planeCurveConstantFrobeniusAlgEquiv K E f hf hfE + (planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE x) = + planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE x := by + exact planeCurveConstantAlgEquiv_baseChange K E f hf hfE _ x + +variable [Finite E] + +theorem orderOf_planeCurveConstantFrobeniusAlgEquiv : + orderOf (planeCurveConstantFrobeniusAlgEquiv K E f hf hfE) = + Module.finrank K E := by + change orderOf ((planeCurveConstantAutHom K E f hf hfE) + (FiniteField.frobeniusAlgEquivOfAlgebraic K E)) = _ + rw [orderOf_injective (planeCurveConstantAutHom K E f hf hfE) + (planeCurveConstantAutHom_injective K E f hf hfE)] + exact FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic K E + +theorem natCard_zpowers_planeCurveConstantFrobeniusAlgEquiv : + Nat.card (Subgroup.zpowers + (planeCurveConstantFrobeniusAlgEquiv K E f hf hfE)) = + Module.finrank K E := by + rw [Nat.card_zpowers, orderOf_planeCurveConstantFrobeniusAlgEquiv] + +end Frobenius + +end Plane + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean new file mode 100644 index 0000000000..822bbc453e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean @@ -0,0 +1,191 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas + +/-! +# Finite places under constant-field extension + +If `R → S` is integral and both rings act compatibly on a common overring +`L`, then an element of `L` is integral over `R` exactly when it is integral +over `S`. Thus the two integral closures are canonically ring-equivalent by +the identity on `L`. + +For a plane-curve constant extension this identifies the integral closure of +`K[X]` in the enlarged function field with the integral closure of `E[X]` in +that same field. It therefore gives an equivalence between the finite-place +types based on `K(X)` and `E(X)`. + +This file concerns only finite places. The valuation rings at infinity and +the comparison of place degrees are separate boundaries. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +/-- Integral closures in a common overring agree after enlarging the base by +an integral extension. The equivalence is the identity on the overring. -/ +def integralClosureRingEquivOfIntegralTower + (R S L : Type*) [CommRing R] [CommRing S] [CommRing L] + [Algebra R S] [Algebra R L] [Algebra S L] [IsScalarTower R S L] + [Algebra.IsIntegral R S] : + integralClosure R L ≃+* integralClosure S L where + toFun x := ⟨x.1, x.2.tower_top⟩ + invFun x := ⟨x.1, isIntegral_trans (R := R) (x : L) x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl + +/-- Algebra-equivalence form of the integral-closure identity. -/ +def integralClosureAlgEquivOfIntegralTower + (R S L : Type*) [CommRing R] [CommRing S] [CommRing L] + [Algebra R S] [Algebra R L] [Algebra S L] [IsScalarTower R S L] + [Algebra.IsIntegral R S] : + integralClosure R L ≃ₐ[R] integralClosure S L := + { integralClosureRingEquivOfIntegralTower R S L with + commutes' := fun _ => rfl } + +@[simp] +theorem integralClosureRingEquivOfIntegralTower_coe + (R S L : Type*) [CommRing R] [CommRing S] [CommRing L] + [Algebra R S] [Algebra R L] [Algebra S L] [IsScalarTower R S L] + [Algebra.IsIntegral R S] (x : integralClosure R L) : + ((integralClosureRingEquivOfIntegralTower R S L x : + integralClosure S L) : L) = x := rfl + +variable (K E L : Type*) [Field K] [Field E] [Field L] + [Algebra K E] [Algebra (RatFunc K) L] [Algebra (RatFunc E) L] + +local instance constantFieldFinitePolynomialCoefficientAlgebra : + Algebra K[X] E[X] := + (Polynomial.mapRingHom (algebraMap K E)).toAlgebra + +local instance finiteBasePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance finiteExtensionPolynomialAlgebra : Algebra E[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc E) L).comp + (algebraMap E[X] (RatFunc E))) + +/-- Compatible coefficient extension identifies the two finite integral +closures inside the common top function field. -/ +def ratFuncFiniteIntegralClosureRingEquiv + [Algebra.IsIntegral K E] + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) : + RatFuncFiniteIntegralClosure K L ≃+* + RatFuncFiniteIntegralClosure E L := by + letI : IsScalarTower K[X] E[X] L := + IsScalarTower.of_algebraMap_eq hcomm + exact integralClosureRingEquivOfIntegralTower K[X] E[X] L + +variable (f : MvPolynomial (Fin 2) K) + +/-- The finite integral closures for a plane curve before and after constant +extension are canonically ring-equivalent inside the enlarged function +field. -/ +def planeCurveFiniteIntegralClosureBaseChangeRingEquiv + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] : + let fE := MvPolynomial.map (algebraMap K E) f + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + RatFuncFiniteIntegralClosure K (PlaneCurveFunctionField fE) ≃+* + RatFuncFiniteIntegralClosure E (PlaneCurveFunctionField fE) := by + let fE := MvPolynomial.map (algebraMap K E) f + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + apply ratFuncFiniteIntegralClosureRingEquiv K E + (PlaneCurveFunctionField fE) + intro p + change planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE + (algebraMap (RatFunc K) (PlaneCurveFunctionField f) p) = _ + rw [planeCurveFunctionFieldBaseChange_ratFunc_commutes + K E f hf hfE hpartialSecond] + apply congrArg (algebraMap (RatFunc E) (PlaneCurveFunctionField fE)) + exact ratFuncCoefficientAlgHom_algebraMap K E p + +/-- The identity equivalence of finite integral closures transports their +height-one spectra, giving the finite-place base-change equivalence. -/ +def planeCurveFinitePlaceBaseChangeEquiv + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] : + let fE := MvPolynomial.map (algebraMap K E) f + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + FiniteExtensionFinitePlace K (PlaneCurveFunctionField fE) ≃ + FiniteExtensionFinitePlace E (PlaneCurveFunctionField fE) := by + exact IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (planeCurveFiniteIntegralClosureBaseChangeRingEquiv + K E f hf hfE hpartialSecond) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean new file mode 100644 index 0000000000..f9559a6a3f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean @@ -0,0 +1,209 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient + +/-! +# Finite-place degrees under constant-field extension + +The finite integral closures before and after constant extension are the same +subring of the enlarged function field. This file upgrades that ring +equivalence to an equivalence over the original constant field and transports +it to residue fields. Consequently, if `Q_E` is the finite place obtained +from `Q` after replacing `K` by `E`, then + +`deg_K(Q) = [E : K] * deg_E(Q_E)`. + +This is the arithmetic content missing from a bare equivalence of finite-place +types: an `E`-rational place is a place of degree `[E : K]` over `K`. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +attribute [local instance high] Module.Free.of_divisionRing + +variable (K E L : Type*) [Field K] [Field E] [Field L] + [DecidableEq K] [DecidableEq E] + [DecidableEq (RatFunc K)] [DecidableEq (RatFunc E)] + [Algebra K E] + [Algebra (RatFunc K) L] [Algebra (RatFunc E) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [FiniteDimensional (RatFunc E) L] + [Algebra.IsSeparable (RatFunc E) L] + +local instance degreePolynomialCoefficientAlgebra : Algebra K[X] E[X] := + (Polynomial.mapRingHom (algebraMap K E)).toAlgebra + +local instance degreeBasePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance degreeExtensionPolynomialAlgebra : Algebra E[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc E) L).comp + (algebraMap E[X] (RatFunc E))) + +local instance degreeBaseFiniteClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance degreeExtensionFiniteClosureConstantAlgebra : + Algebra E (RatFuncFiniteIntegralClosure E L) := + RingHom.toAlgebra ((algebraMap E[X] + (RatFuncFiniteIntegralClosure E L)).comp (algebraMap E E[X])) + +local instance degreeExtensionFiniteClosureBaseConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure E L) := + RingHom.toAlgebra ((algebraMap E + (RatFuncFiniteIntegralClosure E L)).comp (algebraMap K E)) + +local instance degreeExtensionFiniteClosureConstantTower : + IsScalarTower K E (RatFuncFiniteIntegralClosure E L) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The identity equivalence between the two finite integral closures respects +the original constants. -/ +def ratFuncFiniteIntegralClosureBaseChangeAlgEquiv + [Algebra.IsIntegral K E] + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) : + RatFuncFiniteIntegralClosure K L ≃ₐ[K] + RatFuncFiniteIntegralClosure E L := + { ratFuncFiniteIntegralClosureRingEquiv K E L hcomm with + commutes' := fun k => by + apply Subtype.ext + change algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) (Polynomial.C k)) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (Polynomial.C (algebraMap K E k))) + simpa using hcomm (Polynomial.C k) } + +/-- The finite-integral-closure equivalence transports residue fields as +`K`-algebras. -/ +def finitePlaceResidueFieldBaseChangeAlgEquiv + [Algebra.IsIntegral K E] + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) + (Q : FiniteExtensionFinitePlace K L) : + Q.asIdeal.ResidueField ≃ₐ[K] + ((IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) Q).asIdeal).ResidueField := + Ideal.residueFieldAlgEquiv Q.asIdeal + ((IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) Q).asIdeal) + (ratFuncFiniteIntegralClosureBaseChangeAlgEquiv K E L hcomm) + (by + change Q.asIdeal = + (Q.asIdeal.comap + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm).symm).comap + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) + exact (Ideal.comap_of_equiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm)).symm) + +/-- A finite place in the common top function field has base-field degree +equal to the constant-extension degree times its extended-field degree. -/ +theorem finiteExtensionFinitePlace_degree_baseChange + [Algebra.IsIntegral K E] + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) + (Q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K L (.inl Q) = + Module.finrank K E * + finiteExtensionPlaceDegree E L (.inl + (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) Q)) := by + let QE : FiniteExtensionFinitePlace E L := + IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) Q + let e := finitePlaceResidueFieldBaseChangeAlgEquiv K E L hcomm Q + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K L Q] + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField E L QE] + calc + Module.finrank K Q.asIdeal.ResidueField = + Module.finrank K QE.asIdeal.ResidueField := + e.toLinearEquiv.finrank_eq + _ = Module.finrank K E * Module.finrank E QE.asIdeal.ResidueField := + (Module.finrank_mul_finrank K E QE.asIdeal.ResidueField).symm + +/-- A place is rational over the extended constant field exactly when its +degree over the original constant field is the degree of the constant +extension. -/ +theorem finiteExtensionFinitePlace_baseChange_rational_iff + [Algebra.IsIntegral K E] [FiniteDimensional K E] + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) + (Q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree E L (.inl + (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) Q)) = 1 ↔ + finiteExtensionPlaceDegree K L (.inl Q) = Module.finrank K E := by + rw [finiteExtensionFinitePlace_degree_baseChange K E L hcomm Q] + constructor + · intro h + rw [h, Nat.mul_one] + · intro h + apply Nat.eq_of_mul_eq_mul_left + (Module.finrank_pos : 0 < Module.finrank K E) + simpa using h + +/-- Base change identifies the finite places of degree `[E : K]` with the +rational finite places over `E`. -/ +def finiteExtensionFinitePlaceDegreeEquivRationalBaseChange + [Algebra.IsIntegral K E] [FiniteDimensional K E] + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) : + {Q : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl Q) = Module.finrank K E} ≃ + FiniteExtensionRationalFinitePlace E L := + let e := IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv K E L hcomm) + e.subtypeEquiv fun Q => + (finiteExtensionFinitePlace_baseChange_rational_iff + K E L hcomm Q).symm + +/-- Cardinal form of the finite rational-place base-change correspondence. -/ +theorem natCard_finiteExtensionRationalFinitePlace_eq_degree_baseChange + [Algebra.IsIntegral K E] [FiniteDimensional K E] : + (hcomm : ∀ p : K[X], + algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) p) = + algebraMap (RatFunc E) L + (algebraMap E[X] (RatFunc E) + (algebraMap K[X] E[X] p))) → + Nat.card (FiniteExtensionRationalFinitePlace E L) = + Nat.card {Q : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl Q) = Module.finrank K E} := by + intro hcomm + exact Nat.card_congr + (finiteExtensionFinitePlaceDegreeEquivRationalBaseChange + K E L hcomm).symm + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean new file mode 100644 index 0000000000..6889cc5e78 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace + +/-! +# The rational-function place at infinity under coefficient extension + +Coefficient extension `K(X) → E(X)` preserves the integer degree of every +rational function, hence preserves the valuation at infinity exactly. It +therefore restricts to an injective local homomorphism between the two +infinity valuation rings. The maximal ideal of the enlarged valuation ring +contracts to the original maximal ideal. + +This is the base-place comparison. It does not identify the integral +closures of these valuation rings inside a further function field. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K E : Type*) [Field K] [Field E] [Algebra K E] + +/-- Injective coefficient extension preserves rational-function integer +degree. -/ +theorem ratFuncCoefficientAlgHom_intDegree (z : RatFunc K) : + RatFunc.intDegree (ratFuncCoefficientAlgHom K E z) = + RatFunc.intDegree z := by + by_cases hz : z = 0 + · simp [hz] + rw [← z.num_div_denom, map_div₀] + have hnumK : algebraMap K[X] (RatFunc K) z.num ≠ 0 := by + simpa using + (IsFractionRing.injective K[X] (RatFunc K)).ne + (RatFunc.num_ne_zero hz) + have hdenK : algebraMap K[X] (RatFunc K) z.denom ≠ 0 := by + simpa using + (IsFractionRing.injective K[X] (RatFunc K)).ne z.denom_ne_zero + have hnumE : ratFuncCoefficientAlgHom K E + (algebraMap K[X] (RatFunc K) z.num) ≠ 0 := by + simpa using (ratFuncCoefficientAlgHom_injective K E).ne hnumK + have hdenE : ratFuncCoefficientAlgHom K E + (algebraMap K[X] (RatFunc K) z.denom) ≠ 0 := by + simpa using (ratFuncCoefficientAlgHom_injective K E).ne hdenK + rw [RatFunc.intDegree_div hnumE hdenE, + RatFunc.intDegree_div hnumK hdenK] + rw [ratFuncCoefficientAlgHom_algebraMap, + ratFuncCoefficientAlgHom_algebraMap] + simp only [RatFunc.intDegree_polynomial] + change ((Polynomial.map (algebraMap K E) z.num).natDegree : ℤ) - + ((Polynomial.map (algebraMap K E) z.denom).natDegree : ℤ) = _ + rw [Polynomial.natDegree_map_eq_of_injective + (algebraMap K E).injective z.num, + Polynomial.natDegree_map_eq_of_injective + (algebraMap K E).injective z.denom] + +/-- Coefficient extension has the expected value on constants. -/ +theorem ratFuncCoefficientAlgHom_C (c : K) : + ratFuncCoefficientAlgHom K E (RatFunc.C c) = + RatFunc.C (algebraMap K E c) := by + change ratFuncCoefficientAlgHom K E + (algebraMap K[X] (RatFunc K) (Polynomial.C c)) = _ + rw [ratFuncCoefficientAlgHom_algebraMap] + simp + +variable [DecidableEq (RatFunc K)] [DecidableEq (RatFunc E)] + +/-- Coefficient extension preserves the valuation at infinity exactly. -/ +theorem ratFuncCoefficientAlgHom_inftyValuation (z : RatFunc K) : + RatFunc.inftyValuation E (ratFuncCoefficientAlgHom K E z) = + RatFunc.inftyValuation K z := by + by_cases hz : z = 0 + · simp [hz] + have hmap : ratFuncCoefficientAlgHom K E z ≠ 0 := by + simpa using (ratFuncCoefficientAlgHom_injective K E).ne hz + rw [RatFunc.inftyValuation_apply, RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero E hmap, + RatFunc.inftyValuation_of_nonzero K hz, + ratFuncCoefficientAlgHom_intDegree K E z] + +/-- Coefficient extension restricted to the infinity valuation rings. -/ +def ratFuncInfinityIntegersRingHom : + RatFuncInfinityIntegers K →+* RatFuncInfinityIntegers E where + toFun z := ⟨ratFuncCoefficientAlgHom K E z.1, by + change RatFunc.inftyValuation E (ratFuncCoefficientAlgHom K E z.1) ≤ 1 + rw [ratFuncCoefficientAlgHom_inftyValuation K E z.1] + exact z.2⟩ + map_one' := Subtype.ext (map_one (ratFuncCoefficientAlgHom K E)) + map_mul' x y := + Subtype.ext (map_mul (ratFuncCoefficientAlgHom K E) x.1 y.1) + map_zero' := Subtype.ext (map_zero (ratFuncCoefficientAlgHom K E)) + map_add' x y := + Subtype.ext (map_add (ratFuncCoefficientAlgHom K E) x.1 y.1) + +@[simp] +theorem ratFuncInfinityIntegersRingHom_coe + (z : RatFuncInfinityIntegers K) : + ((ratFuncInfinityIntegersRingHom K E z : + RatFuncInfinityIntegers E) : RatFunc E) = + ratFuncCoefficientAlgHom K E z.1 := rfl + +theorem ratFuncInfinityIntegersRingHom_injective : + Function.Injective (ratFuncInfinityIntegersRingHom K E) := by + intro x y hxy + apply Subtype.ext + exact (ratFuncCoefficientAlgHom_injective K E) + (congrArg Subtype.val hxy) + +/-- The map of infinity valuation rings is local because it reflects the +valuation-one unit condition. -/ +noncomputable instance ratFuncInfinityIntegersRingHom_isLocalHom : + IsLocalHom (ratFuncInfinityIntegersRingHom K E) where + map_nonunit x hx := by + apply (Valuation.Integers.isUnit_iff_valuation_eq_one + (Valuation.integer.integers (RatFunc.inftyValuation K))).mpr + have hx' := (Valuation.Integers.isUnit_iff_valuation_eq_one + (Valuation.integer.integers (RatFunc.inftyValuation E))).mp hx + change RatFunc.inftyValuation E + (ratFuncCoefficientAlgHom K E x.1) = 1 at hx' + rw [ratFuncCoefficientAlgHom_inftyValuation K E x.1] at hx' + exact hx' + +/-- The maximal ideal at infinity over `E` contracts to the maximal ideal at +infinity over `K`. -/ +theorem ratFuncInfinityIntegersRingHom_comap_maximalIdeal : + (IsLocalRing.maximalIdeal (RatFuncInfinityIntegers E)).comap + (ratFuncInfinityIntegersRingHom K E) = + IsLocalRing.maximalIdeal (RatFuncInfinityIntegers K) := + IsLocalRing.maximalIdeal_comap (ratFuncInfinityIntegersRingHom K E) + +/-- Height-one-place form of maximal-ideal contraction. -/ +theorem ratFuncInfinityIntegersRingHom_comap_infinityPlace : + (ratFuncInfinityPlace E).asIdeal.comap + (ratFuncInfinityIntegersRingHom K E) = + (ratFuncInfinityPlace K).asIdeal := by + exact ratFuncInfinityIntegersRingHom_comap_maximalIdeal K E + +/-- The induced map between the two infinity residue fields. -/ +def ratFuncInfinityResidueFieldRingHom : + (ratFuncInfinityPlace K).asIdeal.ResidueField →+* + (ratFuncInfinityPlace E).asIdeal.ResidueField := + Ideal.ResidueField.map (ratFuncInfinityPlace K).asIdeal + (ratFuncInfinityPlace E).asIdeal + (ratFuncInfinityIntegersRingHom K E) + (ratFuncInfinityIntegersRingHom_comap_infinityPlace K E).symm + +theorem ratFuncInfinityResidueFieldRingHom_injective : + Function.Injective (ratFuncInfinityResidueFieldRingHom K E) := + RingHom.injective _ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean new file mode 100644 index 0000000000..93797f47d5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean @@ -0,0 +1,409 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension + +/-! +# Rational-function models under constant extension + +This file proves that the scalar extension of a plane-curve function field is +compatible with coefficient extension of its rational-function base. With +the first coordinate as separating variable, the square + +`K(X) → K(C)` + +`↓ ↓` + +`E(X) → E(C_E)` + +commutes exactly. The induced `K(X)`-algebra on `E(C_E)` factors both through +`K(C)` and through `E(X)`. For finite constant extensions it is finite and +separable over `K(X)`, so the existing exhaustive place-tower API can be +applied to `K(C) ⊂ E(C_E)`. + +No fixed-point or rational-place correspondence is asserted here. +-/ + +open scoped TensorProduct Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K E : Type*) [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) + +theorem planeCurveCoordinateRingBaseChangeAlgEquiv_includeRight + (a : PlaneCurveCoordinateRing f) : + planeCurveCoordinateRingBaseChangeAlgEquiv K E f + (Algebra.TensorProduct.includeRight + (R := K) (A := E) (B := PlaneCurveCoordinateRing f) a) = + planeCurveCoordinateRingMap (E := E) f a := by + let Φ : PlaneCurveCoordinateRing f →ₐ[K] + PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f) := + ((planeCurveCoordinateRingBaseChangeAlgEquiv K E f).restrictScalars K).toAlgHom.comp + (Algebra.TensorProduct.includeRight + (R := K) (A := E) (B := PlaneCurveCoordinateRing f)) + change Φ a = planeCurveCoordinateRingMap (E := E) f a + suffices Φ = planeCurveCoordinateRingMap (E := E) f by + exact DFunLike.congr_fun this a + apply Ideal.Quotient.algHom_ext K + apply MvPolynomial.algHom_ext + intro i + simp [Φ, planeCurveCoordinateRingBaseChangeAlgEquiv, + planeCurveCoordinateRingMap] + +theorem planeCurveFunctionFieldBaseChangeAlgHom_function + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + [Algebra.IsAlgebraic K E] (i : Fin 2) : + planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE + (planeCurveFunction f i) = + planeCurveFunction (MvPolynomial.map (algebraMap K E) f) i := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := + planeCurveCoordinateRingBaseChange_isDomain K E f hfE + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + letI : IsFractionRing + (E ⊗[K] PlaneCurveCoordinateRing f) + (E ⊗[K] PlaneCurveFunctionField f) := + tensorFraction_isFractionRing K E (PlaneCurveCoordinateRing f) + change planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE + (1 ⊗ₜ[K] algebraMap (PlaneCurveCoordinateRing f) + (PlaneCurveFunctionField f) (planeCurveCoordinate f i)) = _ + rw [← tensorBaseTensorFraction_algebraMap_tmul] + rw [show planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE = + IsFractionRing.algEquivOfAlgEquiv + (planeCurveCoordinateRingBaseChangeAlgEquiv K E f) by rfl] + rw [IsFractionRing.algEquivOfAlgEquiv_algebraMap] + change algebraMap _ _ + (planeCurveCoordinateRingBaseChangeAlgEquiv K E f + (Algebra.TensorProduct.includeRight + (R := K) (A := E) (B := PlaneCurveCoordinateRing f) + (planeCurveCoordinate f i))) = _ + rw [planeCurveCoordinateRingBaseChangeAlgEquiv_includeRight] + rw [planeCurveCoordinateRingMap_coordinate] + rfl + +theorem planeCurveFunctionFieldBaseChange_ratFunc_commutes + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] : + let fE := MvPolynomial.map (algebraMap K E) f + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + ∀ z : RatFunc K, + planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE + (algebraMap (RatFunc K) (PlaneCurveFunctionField f) z) = + algebraMap (RatFunc E) (PlaneCurveFunctionField fE) + (ratFuncCoefficientAlgHom K E z) := by + let fE := MvPolynomial.map (algebraMap K E) f + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + letI : Algebra K[X] E[X] := + (Polynomial.mapRingHom (algebraMap K E)).toAlgebra + change ∀ z : RatFunc K, + planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE + (algebraMap (RatFunc K) (PlaneCurveFunctionField f) z) = + algebraMap (RatFunc E) (PlaneCurveFunctionField fE) + (ratFuncCoefficientAlgHom K E z) + let left : RatFunc K →+* PlaneCurveFunctionField fE := + (planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE).toRingHom.comp + (algebraMap (RatFunc K) (PlaneCurveFunctionField f)) + let right : RatFunc K →+* PlaneCurveFunctionField fE := + (algebraMap (RatFunc E) (PlaneCurveFunctionField fE)).comp + (ratFuncCoefficientAlgHom K E).toRingHom + have hhom : left = right := by + apply IsFractionRing.ringHom_ext (A := K[X]) + intro p + suffices + left (algebraMap K[X] (RatFunc K) Polynomial.X) = + right (algebraMap K[X] (RatFunc K) Polynomial.X) by + let lpoly : K[X] →+* PlaneCurveFunctionField fE := + left.comp (algebraMap K[X] (RatFunc K)) + let rpoly : K[X] →+* PlaneCurveFunctionField fE := + right.comp (algebraMap K[X] (RatFunc K)) + have hpoly : lpoly = rpoly := by + apply Polynomial.ringHom_ext + · intro c + have hspecK : + ratFuncSpecialization (planeCurveFunction f 0) hx (RatFunc.C c) = + algebraMap K (PlaneCurveFunctionField f) c := by + have h := DFunLike.congr_fun + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) (Polynomial.C c) + simpa using h + have hspecE : + ratFuncSpecialization (planeCurveFunction fE 0) hxE + (RatFunc.C (algebraMap K E c)) = + algebraMap E (PlaneCurveFunctionField fE) (algebraMap K E c) := by + have h := DFunLike.congr_fun + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction fE 0) hxE) + (Polynomial.C (algebraMap K E c)) + simpa using h + have hcoeff : + ratFuncCoefficientAlgHom K E (RatFunc.C c) = + RatFunc.C (algebraMap K E c) := by + change ratFuncCoefficientAlgHom K E + (algebraMap K[X] (RatFunc K) (Polynomial.C c)) = _ + rw [ratFuncCoefficientAlgHom_algebraMap] + simp + change planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE + (ratFuncSpecialization (planeCurveFunction f 0) hx (RatFunc.C c)) = + ratFuncSpecialization (planeCurveFunction fE 0) hxE + (ratFuncCoefficientAlgHom K E (RatFunc.C c)) + rw [hspecK, hcoeff, hspecE] + exact (planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE).commutes c + · exact this + exact DFunLike.congr_fun hpoly p + change planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE + (algebraMap (RatFunc K) (PlaneCurveFunctionField f) RatFunc.X) = + algebraMap (RatFunc E) (PlaneCurveFunctionField fE) + (ratFuncCoefficientAlgHom K E RatFunc.X) + rw [planeCurveFirstCoordinateRatFuncAlgebra_X, + planeCurveFunctionFieldBaseChangeAlgHom_function] + rw [show RatFunc.X = algebraMap K[X] (RatFunc K) Polynomial.X by rfl, + ratFuncCoefficientAlgHom_algebraMap] + rw [show algebraMap K[X] E[X] Polynomial.X = Polynomial.X by simp] + change planeCurveFunction fE 0 = + algebraMap (RatFunc E) (PlaneCurveFunctionField fE) RatFunc.X + rw [planeCurveFirstCoordinateRatFuncAlgebra_X] + intro z + exact DFunLike.congr_fun hhom z + +/-- The `K(X)`-algebra structure on the base-changed function field obtained +through the original function field. -/ +@[reducible] noncomputable def planeCurveFunctionFieldBaseChangeRatFuncAlgebra + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + [Algebra.IsAlgebraic K E] + (hx : Transcendental K (planeCurveFunction f 0)) : + Algebra (RatFunc K) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + exact RingHom.toAlgebra + ((planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE).toRingHom.comp + (ratFuncSpecialization (planeCurveFunction f 0) hx)) + +theorem planeCurveFunctionFieldBaseChangeRatFunc_isScalarTower + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + exact IsScalarTower.of_algebraMap_eq' rfl + +theorem planeCurveFunctionFieldBaseChangeCoefficientRatFunc_isScalarTower + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] : + let fE := MvPolynomial.map (algebraMap K E) f + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := ratFuncCoefficientAlgebra K E + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + IsScalarTower (RatFunc K) (RatFunc E) + (PlaneCurveFunctionField fE) := by + let fE := MvPolynomial.map (algebraMap K E) f + let hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing fE) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let hxE := firstCoordinate_transcendental hfE + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) + letI := ratFuncCoefficientAlgebra K E + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + apply IsScalarTower.of_algebraMap_eq' + ext z + exact (planeCurveFunctionFieldBaseChange_ratFunc_commutes + K E f hf hfE hpartialSecond z) + +theorem finiteDimensional_planeCurveFunctionFieldBaseChange_over_ratFunc + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] [FiniteDimensional K E] : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + FiniteDimensional (RatFunc K) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + letI : IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveFunctionFieldBaseChangeRatFunc_isScalarTower + K E f hf hfE hpartialSecond + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE + letI : Module.Finite (PlaneCurveFunctionField f) + ((PlaneCurveFunctionField f) ⊗[K] E) := + Module.Finite.base_change K (PlaneCurveFunctionField f) E + letI : Module.Finite (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + Module.Finite.equiv e + exact FiniteDimensional.trans (RatFunc K) (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) + +theorem separable_planeCurveFunctionFieldBaseChange_over_ratFunc + (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + [Algebra.IsAlgebraic K E] [Fintype K] [Finite E] : + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + Algebra.IsSeparable (RatFunc K) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + letI : IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveFunctionFieldBaseChangeRatFunc_isScalarTower + K E f hf hfE hpartialSecond + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE + letI : Module.Finite (PlaneCurveFunctionField f) + ((PlaneCurveFunctionField f) ⊗[K] E) := + Module.Finite.base_change K (PlaneCurveFunctionField f) E + letI : Module.Finite (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + Module.Finite.equiv e + letI : IsGalois (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := + planeCurveFunctionFieldBaseChange_isGalois K E f hf hfE + exact Algebra.IsSeparable.trans (RatFunc K) (PlaneCurveFunctionField f) + (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean new file mode 100644 index 0000000000..10f34d7f0d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +import Mathlib.RingTheory.LocalRing.ResidueField.Fiber + +/-! +# Residue fields of constant tensor extensions + +For a maximal ideal `q` of `S ⊗[C] R`, let `p` be its contraction to `R`. +Reduction gives a canonical map + +`S ⊗[C] κ(p) → κ(q)`. + +This file proves that the map is surjective. For finite fields, the residue +degree is therefore the least common multiple of the degrees of `S` and +`κ(p)` over `C`. The result is ring-theoretic; applying it to places in a +constant extension additionally requires identifying the normalization after +base change with the corresponding tensor ring. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +/-- The scalar extension of a commutative `C`-algebra `R` to a commutative +`C`-algebra `S`. -/ +abbrev ConstantTensorRing (C R S : Type*) + [CommRing C] [CommRing R] [CommRing S] + [Algebra C R] [Algebra C S] := + S ⊗[C] R + +section General + +variable (C R S : Type*) + [CommRing C] [CommRing R] [CommRing S] + [Algebra C R] [Algebra C S] + +local instance constantTensorRingAlgebra : + Algebra R (ConstantTensorRing C R S) := + Algebra.TensorProduct.rightAlgebra + +/-- The canonical map from the tensor product of the enlarged constants and +the contracted residue field to the upstairs residue field. -/ +def constantTensorResidueAlgHom + (q : Ideal (ConstantTensorRing C R S)) [q.IsMaximal] : + let p := q.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + S ⊗[C] p.ResidueField →ₐ[C] q.ResidueField := by + let p := q.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + let iR := Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R) + let iS := Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := R) + let fS : S →ₐ[C] q.ResidueField := + (IsScalarTower.toAlgHom C (ConstantTensorRing C R S) + q.ResidueField).comp iS + let fp : p.ResidueField →ₐ[C] q.ResidueField := + Ideal.ResidueField.mapₐ p q iR rfl + exact Algebra.TensorProduct.lift fS fp fun _ _ => Commute.all _ _ + +/-- The canonical residue-field map of a constant tensor extension is +surjective. -/ +theorem constantTensorResidueAlgHom_surjective + (q : Ideal (ConstantTensorRing C R S)) [q.IsMaximal] : + Function.Surjective (constantTensorResidueAlgHom C R S q) := by + let p := q.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + intro z + obtain ⟨a, rfl⟩ := q.algebraMap_residueField_surjective z + induction a using TensorProduct.induction_on with + | zero => + refine ⟨0, ?_⟩ + rw [map_zero, map_zero] + | tmul s r => + refine ⟨s ⊗ₜ[C] algebraMap R p.ResidueField r, ?_⟩ + simp only [constantTensorResidueAlgHom, + Algebra.TensorProduct.lift_tmul, AlgHom.coe_comp, + Function.comp_apply, Ideal.ResidueField.mapₐ_apply, + Algebra.TensorProduct.includeLeft_apply] + have hpmap : + (Ideal.ResidueField.map p q + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom rfl) + (algebraMap R p.ResidueField r) = + algebraMap (ConstantTensorRing C R S) q.ResidueField + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R) r) := by + exact Ideal.ResidueField.map_algebraMap p q + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom rfl r + rw [hpmap] + change + algebraMap (ConstantTensorRing C R S) q.ResidueField + (s ⊗ₜ[C] (1 : R)) * + algebraMap (ConstantTensorRing C R S) q.ResidueField + ((1 : S) ⊗ₜ[C] r) = + algebraMap (ConstantTensorRing C R S) q.ResidueField + (s ⊗ₜ[C] r) + rw [← map_mul] + simp + | add x y hx hy => + obtain ⟨x', hx'⟩ := hx + obtain ⟨y', hy'⟩ := hy + refine ⟨x' + y', ?_⟩ + rw [map_add, map_add, hx', hy'] + +end General + +section FiniteFields + +variable (C R S : Type*) + [Field C] [CommRing R] [Field S] + [Algebra C R] [Algebra C S] + +local instance finiteConstantTensorRingAlgebra : + Algebra R (ConstantTensorRing C R S) := + Algebra.TensorProduct.rightAlgebra + +/-- For finite fields, the residue field of a constant tensor extension has +degree equal to the least common multiple of the new-constant degree and the +contracted residue degree. -/ +theorem constantTensorResidue_finrank_eq_lcm + (q : Ideal (ConstantTensorRing C R S)) [q.IsMaximal] + [Finite C] [Finite S] + [Finite ((q.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom).ResidueField)] + [Finite q.ResidueField] : + let p := q.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + Module.finrank C q.ResidueField = + Nat.lcm (Module.finrank C S) + (Module.finrank C p.ResidueField) := by + let p := q.comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R)).toRingHom + let iS := Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := R) + let iR := Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R) + let fS : S →ₐ[C] q.ResidueField := + (IsScalarTower.toAlgHom C (ConstantTensorRing C R S) + q.ResidueField).comp iS + let fp : p.ResidueField →ₐ[C] q.ResidueField := + Ideal.ResidueField.mapₐ p q iR rfl + change Module.finrank C q.ResidueField = + Nat.lcm (Module.finrank C S) + (Module.finrank C p.ResidueField) + apply finiteField_finrank_eq_lcm_of_tensorLift_surjective + C S p.ResidueField q.ResidueField fS fp + (fun _ _ => Commute.all _ _) + simpa only [constantTensorResidueAlgHom, p, iS, iR, fS, fp] using + (constantTensorResidueAlgHom_surjective C R S q) + +end FiniteFields + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean new file mode 100644 index 0000000000..cd45210219 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder + +/-! +# Local pole spaces and valuation order + +The denominator presentation of `localPoleSpace` agrees with the usual +valuation-order condition when its denominator is a power of a uniformizer. +This is the bridge from the exact DVR quotient to exhaustive function-field +places. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped nonZeroDivisors + +noncomputable section + +variable {K R L : Type*} [Field K] [CommRing R] + [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Field L] [Algebra K R] [Algebra R L] [Algebra K L] + [IsScalarTower K R L] [IsFractionRing R L] + +/-- Membership in the local denominator filtration is exactly the expected +lower bound on the discrete valuation. -/ +theorem mem_localPoleSpace_iff_finitePlaceOrder + (π : R) (hπ : Irreducible π) + (hπIdeal : (IsDiscreteValuationRing.maximalIdeal R).asIdeal = + Ideal.span {π}) (n : ℕ) (x : L) : + x ∈ localPoleSpace (K := K) (L := L) π n ↔ + x = 0 ∨ (x ≠ 0 ∧ + -(n : ℤ) ≤ finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) x) := by + let v := IsDiscreteValuationRing.maximalIdeal R + have hπMap : algebraMap R L π ≠ 0 := by + simpa using (IsFractionRing.injective R L).ne hπ.ne_zero + have hπPowMap : algebraMap R L (π ^ n) ≠ 0 := by + rw [map_pow] + exact pow_ne_zero n hπMap + have hπPowOrder : + finitePlaceOrderTop v (algebraMap R L (π ^ n)) = + ((n : ℤ) : WithTop ℤ) := by + rw [map_pow] + simpa only [zpow_natCast] using + (finitePlaceOrderTop_uniformizer_zpow + (L := L) v π hπ hπIdeal (n : ℤ)) + constructor + · intro hx + rw [mem_localPoleSpace_iff] at hx + by_cases hx0 : x = 0 + · exact Or.inl hx0 + obtain ⟨r, hr⟩ := hx + refine Or.inr ⟨hx0, ?_⟩ + have hregular := + finitePlaceOrderTop_algebraMap_nonnegative (L := L) v r + rw [← hr, finitePlaceOrderTop_mul, hπPowOrder, + finitePlaceOrderTop_eq_coe v x hx0] at hregular + have hregularInt : 0 ≤ (n : ℤ) + finitePlaceOrder v x := by + exact_mod_cast hregular + change -(n : ℤ) ≤ finitePlaceOrder v x + omega + · rintro (rfl | ⟨hx0, hx⟩) + · exact (localPoleSpace (K := K) (L := L) π n).zero_mem + change -(n : ℤ) ≤ finitePlaceOrder v x at hx + rw [mem_localPoleSpace_iff] + let y : L := algebraMap R L (π ^ n) * x + have hy0 : y ≠ 0 := mul_ne_zero hπPowMap hx0 + have hyOrderTop : (0 : WithTop ℤ) ≤ finitePlaceOrderTop v y := by + dsimp only [y] + rw [finitePlaceOrderTop_mul, hπPowOrder, + finitePlaceOrderTop_eq_coe v x hx0] + exact_mod_cast (show 0 ≤ (n : ℤ) + finitePlaceOrder v x by omega) + have hyOrder : 0 ≤ finitePlaceOrder v y := by + rw [finitePlaceOrderTop_eq_coe v y hy0] at hyOrderTop + exact_mod_cast hyOrderTop + have hyValuation : v.valuation L y ≤ 1 := by + rw [valuation_eq_exp_neg_finitePlaceOrder v y hy0] + simpa only [← WithZero.exp_zero] using + (WithZero.exp_le_exp.mpr (by omega : -finitePlaceOrder v y ≤ 0)) + obtain ⟨r, hr⟩ := IsDiscreteValuationRing.exists_lift_of_le_one hyValuation + exact ⟨r, hr.symm⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean new file mode 100644 index 0000000000..10ab08f68d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.DedekindDomain.Different +import Mathlib.RingTheory.DedekindDomain.Factorization +import Mathlib.RingTheory.DedekindDomain.AdicValuation + +open scoped nonZeroDivisors + +open Set Function UniqueFactorizationMonoid IsDedekindDomain + IsDedekindDomain.HeightOneSpectrum + +noncomputable section + +variable {R : Type*} [CommRing R] [IsDedekindDomain R] +variable {K : Type*} [Field K] [Algebra R K] [IsFractionRing R K] + +namespace FractionalIdeal + +theorem le_iff_count_ge {I J : FractionalIdeal R⁰ K} (hI : I ≠ 0) (hJ : J ≠ 0) : + I ≤ J ↔ ∀ v : HeightOneSpectrum R, count K v J ≤ count K v I := by + constructor + · intro h v + exact count_mono K v hI h + · intro h + rw [← finprod_heightOneSpectrum_factorization' (K := K) hI, + ← finprod_heightOneSpectrum_factorization' (K := K) hJ] + have hfinite (A : FractionalIdeal R⁰ K) : + (fun v : HeightOneSpectrum R ↦ + (v.asIdeal : FractionalIdeal R⁰ K) ^ count K v A).HasFiniteMulSupport := by + have hcount : Set.Finite {v : HeightOneSpectrum R | count K v A ≠ 0} := by + simpa only [Filter.eventually_cofinite] using finite_factors (K := K) A + exact hcount.subset fun v hv hzero ↦ by + apply hv + simpa [hzero] + apply finprod_le_finprod + · exact hfinite I + · exact fun _ ↦ zero_le _ + · exact hfinite J + · intro v + exact zpow_le_zpow_right_of_le_one₀ + (show 0 < (v.asIdeal : FractionalIdeal R⁰ K) from bot_lt_iff_ne_bot.mpr + (coeIdeal_ne_zero.mpr v.ne_bot)) + coeIdeal_le_one (h v) + +theorem count_coeIdeal_eq_multiplicity (I : Ideal R) (hI : I ≠ ⊥) + (v : HeightOneSpectrum R) : + count K v (I : FractionalIdeal R⁰ K) = (multiplicity v.asIdeal I : ℤ) := by + rw [count_coe K v hI, + Ideal.count_associates_factors_eq hI v.isPrime v.ne_bot, + HeightOneSpectrum.count_normalizedFactors_eq_multiplicity hI] + +theorem mem_iff_count_ge {I : FractionalIdeal R⁰ K} (hI : I ≠ 0) + {x : K} (hx : x ≠ 0) : + x ∈ I ↔ ∀ v : HeightOneSpectrum R, + count K v I ≤ count K v (spanSingleton R⁰ x) := by + rw [← spanSingleton_le_iff_mem, + le_iff_count_ge (spanSingleton_ne_zero_iff.mpr hx) hI] + +end FractionalIdeal + +universe u + +variable (A K₀ : Type*) {L : Type u} {B : Type*} +variable [CommRing A] [Field K₀] [CommRing B] [Field L] +variable [Algebra A K₀] [Algebra B L] [Algebra A B] [Algebra K₀ L] [Algebra A L] +variable [IsScalarTower A K₀ L] [IsScalarTower A B L] +variable [IsDomain A] [IsFractionRing A K₀] +variable [FiniteDimensional K₀ L] [Algebra.IsSeparable K₀ L] +variable [IsIntegralClosure B A L] [IsFractionRing B L] [IsIntegrallyClosed A] +variable [IsDedekindDomain B] +variable [Module.IsTorsionFree A B] +variable [Algebra.IsIntegral A B] + +namespace HeightOneSpectrum + +theorem algebraMap_mem_pow_of_mem_under_pow + (q : HeightOneSpectrum B) (c : A) (n : ℕ) + (hc : c ∈ (q.under A).asIdeal ^ n) : + algebraMap A B c ∈ q.asIdeal ^ n := by + have hmap : + algebraMap A B c ∈ + Ideal.map (algebraMap A B) ((q.under A).asIdeal ^ n) := + Ideal.mem_map_of_mem (algebraMap A B) hc + rw [Ideal.map_pow] at hmap + exact (pow_le_pow_left' + (Ideal.map_le_iff_le_comap.mpr (show + (q.under A).asIdeal ≤ q.asIdeal.comap (algebraMap A B) from le_rfl)) n) hmap + +theorem natCast_le_count_spanSingleton_algebraMap_of_mem_under_pow + (q : HeightOneSpectrum B) (c : A) (n : ℕ) (hc0 : c ≠ 0) + (hc : c ∈ (q.under A).asIdeal ^ n) : + (n : ℤ) ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap A L c)) := by + have hcB : algebraMap A B c ∈ q.asIdeal ^ n := + algebraMap_mem_pow_of_mem_under_pow A q c n hc + have hcL : algebraMap A L c ∈ + ((q.asIdeal ^ n : Ideal B) : FractionalIdeal B⁰ L) := by + rw [FractionalIdeal.mem_coeIdeal] + refine ⟨algebraMap A B c, hcB, ?_⟩ + exact (IsScalarTower.algebraMap_apply A B L c).symm + have hle : + FractionalIdeal.spanSingleton B⁰ (algebraMap A L c) ≤ + ((q.asIdeal ^ n : Ideal B) : FractionalIdeal B⁰ L) := + FractionalIdeal.spanSingleton_le_iff_mem.mpr hcL + have hcount := FractionalIdeal.count_mono L q + (FractionalIdeal.spanSingleton_ne_zero_iff.mpr + (by + rw [IsScalarTower.algebraMap_apply A B L] + simpa using (IsFractionRing.injective B L).ne + ((FaithfulSMul.algebraMap_injective A B).ne hc0))) hle + simpa [FractionalIdeal.coeIdeal_pow, FractionalIdeal.count_pow, + FractionalIdeal.count_self] using hcount + +end HeightOneSpectrum + +namespace BGS.HasseWeil + +theorem count_dual_one_eq_neg_different_multiplicity + (q : HeightOneSpectrum B) : + FractionalIdeal.count L q + (FractionalIdeal.dual A K₀ (1 : FractionalIdeal B⁰ L)) = + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) := by + have hdiff : differentIdeal A B ≠ ⊥ := by + apply (FractionalIdeal.coeIdeal_ne_zero (K := L)).mp + rw [coeIdeal_differentIdeal A K₀ L B] + exact inv_ne_zero (FractionalIdeal.dual_ne_zero A K₀ + (by exact one_ne_zero : (1 : FractionalIdeal B⁰ L) ≠ 0)) + have hdual : + FractionalIdeal.dual A K₀ (1 : FractionalIdeal B⁰ L) = + ((differentIdeal A B : Ideal B) : FractionalIdeal B⁰ L)⁻¹ := by + apply inv_injective + rw [inv_inv, ← coeIdeal_differentIdeal A K₀ L B] + rw [hdual, FractionalIdeal.count_inv, + FractionalIdeal.count_coeIdeal_eq_multiplicity (K := L) _ hdiff] + +theorem mem_dual_one_iff_different_multiplicity_le_count + {x : L} (hx : x ≠ 0) : + x ∈ FractionalIdeal.dual A K₀ (1 : FractionalIdeal B⁰ L) ↔ + ∀ q : HeightOneSpectrum B, + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ x) := by + rw [FractionalIdeal.mem_iff_count_ge + (FractionalIdeal.dual_ne_zero A K₀ + (by exact one_ne_zero : (1 : FractionalIdeal B⁰ L) ≠ 0)) hx] + exact forall_congr' fun q ↦ by + rw [count_dual_one_eq_neg_different_multiplicity A K₀ q] + +theorem trace_mem_algebraMap_range_of_different_multiplicity_le_count + {z : L} (hz : z ≠ 0) + (hcount : ∀ q : HeightOneSpectrum B, + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ z)) : + Algebra.trace K₀ L z ∈ (algebraMap A K₀).range := by + have hzdual : z ∈ + FractionalIdeal.dual A K₀ (1 : FractionalIdeal B⁰ L) := + (mem_dual_one_iff_different_multiplicity_le_count A K₀ hz).mpr hcount + have htrace := (FractionalIdeal.mem_dual + (A := A) (K := K₀) (I := (1 : FractionalIdeal B⁰ L)) + (by exact one_ne_zero)).mp hzdual (1 : L) (by simp) + simpa [Algebra.traceForm_apply] using htrace + +theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L) : + Set.Finite {q : HeightOneSpectrum B | + ¬ (-(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y))} := by + have hdiffFinite : Set.Finite {q : HeightOneSpectrum B | + FractionalIdeal.count L q + ((differentIdeal A B : Ideal B) : FractionalIdeal B⁰ L) ≠ 0} := by + simpa only [Filter.eventually_cofinite] using + FractionalIdeal.finite_factors + (K := L) ((differentIdeal A B : Ideal B) : FractionalIdeal B⁰ L) + have hyFinite : Set.Finite {q : HeightOneSpectrum B | + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y) ≠ 0} := by + simpa only [Filter.eventually_cofinite] using + FractionalIdeal.finite_factors + (K := L) (FractionalIdeal.spanSingleton B⁰ y) + refine (hdiffFinite.union hyFinite).subset ?_ + intro q hbad + by_contra hq + have hqdiff : FractionalIdeal.count L q + ((differentIdeal A B : Ideal B) : FractionalIdeal B⁰ L) = 0 := by + by_contra hne + exact hq (by + rw [Set.mem_union, Set.mem_setOf_eq, Set.mem_setOf_eq] + exact Or.inl hne) + have hqy : FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ y) = 0 := by + by_contra hne + exact hq (by + rw [Set.mem_union, Set.mem_setOf_eq, Set.mem_setOf_eq] + exact Or.inr hne) + apply hbad + rw [← FractionalIdeal.count_coeIdeal_eq_multiplicity + (K := L) (differentIdeal A B) hdiff, hqdiff, hqy] + simp + +theorem exists_base_multiplier_clearing_different_counts + [IsDedekindDomain A] + (hdiff : differentIdeal A B ≠ ⊥) + (p : HeightOneSpectrum A) {y : L} (hy : y ≠ 0) + (hlocal : ∀ q : HeightOneSpectrum B, + q.under A = p → + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y)) : + ∃ c : A, c ∉ p.asIdeal ∧ + ∀ q : HeightOneSpectrum B, + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap A L c * y)) := by + classical + let bad : Finset (HeightOneSpectrum B) := + (finite_badDifferentCount_set (A := A) (B := B) (L := L) hdiff y).toFinset + have hbad_iff (q : HeightOneSpectrum B) : q ∈ bad ↔ + ¬ (-(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y)) := by + simp [bad] + let need : HeightOneSpectrum B → ℕ := fun q => + Int.toNat (-(multiplicity q.asIdeal (differentIdeal A B) : ℤ) - + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y)) + let N : ℕ := ∑ q ∈ bad, need q + have hbelow_ne (q : HeightOneSpectrum B) (hq : q ∈ bad) : + (q.under A).asIdeal ≠ p.asIdeal := by + intro heq + have heq' : q.under A = p := + HeightOneSpectrum.ext heq + exact (hbad_iff q).mp hq (hlocal q heq') + let selected : Finset (Ideal A) := + insert p.asIdeal + (bad.image fun q => (q.under A).asIdeal) + have hselectedPrime : ∀ P ∈ selected, Prime P := by + intro P hP + rw [Finset.mem_insert] at hP + rcases hP with rfl | hP + · exact p.prime + · rcases Finset.mem_image.mp hP with ⟨q, hq, rfl⟩ + exact (q.under A).prime + let exponent : Ideal A → ℕ := fun P => if P = p.asIdeal then 1 else N + let target : selected → A := fun P => if (P : Ideal A) = p.asIdeal then 1 else 0 + obtain ⟨c, hc⟩ := IsDedekindDomain.exists_forall_sub_mem_ideal + (s := selected) (fun P : Ideal A => P) exponent hselectedPrime + (by + intro P hP Q hQ hPQ + simpa using hPQ) + target + have hpSelected : p.asIdeal ∈ selected := Finset.mem_insert_self _ _ + have hcpow := hc p.asIdeal hpSelected + have hcp : c - 1 ∈ p.asIdeal := by + simpa [target, exponent] using hcpow + have hcnot : c ∉ p.asIdeal := by + intro hcP + have hone : (1 : A) ∈ p.asIdeal := by + have hsub := p.asIdeal.sub_mem hcP hcp + convert hsub using 1 <;> ring + exact p.isPrime.ne_top ((Ideal.eq_top_iff_one p.asIdeal).mpr hone) + have hc0 : c ≠ 0 := fun hcZero => hcnot (hcZero.symm ▸ p.asIdeal.zero_mem) + refine ⟨c, hcnot, ?_⟩ + intro q + have hcL0 : algebraMap A L c ≠ 0 := by + rw [IsScalarTower.algebraMap_apply A B L] + simpa using (IsFractionRing.injective B L).ne + ((FaithfulSMul.algebraMap_injective A B).ne hc0) + have hspanCount : + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap A L c * y)) = + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap A L c)) + + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y) := by + rw [← FractionalIdeal.spanSingleton_mul_spanSingleton, + FractionalIdeal.count_mul] + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hcL0 + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hy + rw [hspanCount] + by_cases hq : q ∈ bad + · have hqSelected : (q.under A).asIdeal ∈ selected := by + change (q.under A).asIdeal ∈ + insert p.asIdeal + (bad.image fun r => (r.under A).asIdeal) + exact Finset.mem_insert.mpr <| Or.inr <| + Finset.mem_image.mpr ⟨q, hq, rfl⟩ + have hcqpow := hc (q.under A).asIdeal hqSelected + have hrne : q.asIdeal.comap (algebraMap A B) ≠ p.asIdeal := by + simpa using hbelow_ne q hq + have hcq : c ∈ (q.under A).asIdeal ^ N := by + simpa [target, exponent, hrne] using hcqpow + have hNcount : (N : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap A L c)) := + HeightOneSpectrum.natCast_le_count_spanSingleton_algebraMap_of_mem_under_pow + (A := A) (B := B) (L := L) q c N hc0 hcq + have hneedNonneg : 0 ≤ + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) - + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y) := by + have := (hbad_iff q).mp hq + omega + have hneedCast : (need q : ℤ) = + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) - + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y) := by + exact Int.toNat_of_nonneg hneedNonneg + have hneedN : need q ≤ N := by + dsimp [N] + exact Finset.single_le_sum (fun i _ => Nat.zero_le (need i)) hq + omega + · have hgood : + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y) := by + by_contra hnot + exact hq ((hbad_iff q).mpr hnot) + have hzeroCount : (0 : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap A L c)) := + HeightOneSpectrum.natCast_le_count_spanSingleton_algebraMap_of_mem_under_pow + (A := A) (B := B) (L := L) q c 0 hc0 (by simp) + omega + +theorem valuation_trace_le_one_of_different_count_bounds_over + [IsDedekindDomain A] + (p : HeightOneSpectrum A) {y : L} (hy : y ≠ 0) + (hlocal : ∀ q : HeightOneSpectrum B, + q.under A = p → + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y)) : + p.valuation K₀ (Algebra.trace K₀ L y) ≤ 1 := by + have hdiff : differentIdeal A B ≠ ⊥ := by + apply (FractionalIdeal.coeIdeal_ne_zero (K := L)).mp + rw [coeIdeal_differentIdeal A K₀ L B] + exact inv_ne_zero (FractionalIdeal.dual_ne_zero A K₀ + (by exact one_ne_zero : (1 : FractionalIdeal B⁰ L) ≠ 0)) + obtain ⟨c, hcnot, hcount⟩ := + exists_base_multiplier_clearing_different_counts + (A := A) (B := B) (L := L) hdiff p hy hlocal + have hc0 : c ≠ 0 := fun hcZero => hcnot (hcZero.symm ▸ p.asIdeal.zero_mem) + have hcL0 : algebraMap A L c ≠ 0 := by + rw [IsScalarTower.algebraMap_apply A B L] + simpa using (IsFractionRing.injective B L).ne + ((FaithfulSMul.algebraMap_injective A B).ne hc0) + have hcy0 : algebraMap A L c * y ≠ 0 := mul_ne_zero hcL0 hy + have htraceRange : + Algebra.trace K₀ L (algebraMap A L c * y) ∈ (algebraMap A K₀).range := + trace_mem_algebraMap_range_of_different_multiplicity_le_count + (A := A) (K₀ := K₀) (B := B) (L := L) hcy0 hcount + obtain ⟨a, ha⟩ := htraceRange + have htraceSmul : + Algebra.trace K₀ L (algebraMap A L c * y) = + algebraMap A K₀ c * Algebra.trace K₀ L y := by + rw [IsScalarTower.algebraMap_apply A K₀ L] + simpa [Algebra.smul_def] using + (Algebra.trace K₀ L).map_smul (algebraMap A K₀ c) y + have hcVal : p.valuation K₀ (algebraMap A K₀ c) = 1 := + (HeightOneSpectrum.valuation_eq_one_iff_notMem (K := K₀) p).mpr hcnot + calc + p.valuation K₀ (Algebra.trace K₀ L y) = + p.valuation K₀ (algebraMap A K₀ c) * + p.valuation K₀ (Algebra.trace K₀ L y) := by rw [hcVal, one_mul] + _ = p.valuation K₀ + (algebraMap A K₀ c * Algebra.trace K₀ L y) := by + rw [map_mul] + _ = p.valuation K₀ + (Algebra.trace K₀ L (algebraMap A L c * y)) := by rw [htraceSmul] + _ = p.valuation K₀ (algebraMap A K₀ a) := by rw [← ha] + _ ≤ 1 := p.valuation_le_one a + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean new file mode 100644 index 0000000000..af4895b3e7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.LinearDisjoint +import Mathlib.LinearAlgebra.Dimension.OrzechProperty + +/-! +# Exact constants and finite constant extensions + +Let `N / C` be a field extension whose exact constant field is `C`, meaning +that no element of `N \ C` is algebraic over `C`. If `S / C` is finite +Galois, then `S` and `N` are linearly disjoint over `C`. Consequently the +tensor product `S ⊗[C] N` is a field, and its degree over `N` is `[S : C]`. + +Mathlib's finite-Galois intersection criterion assumes both intermediate +fields are finite over the base. The first theorem below proves the variant +needed here: only the Galois field on the left must be finite. This is the +algebraic foundation for the constant-extension twists in Stichtenoth, +Proposition 5.2.8. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +universe u v + +section LinearDisjoint + +variable {F : Type u} {E : Type v} [Field F] [Field E] [Algebra F E] + +private theorem linearDisjoint_of_inf_eq_bot_of_sup_eq_top + (A B : IntermediateField F E) + [IsGalois F A] [FiniteDimensional F A] + (hsup : A ⊔ B = ⊤) (hinf : A ⊓ B = ⊥) : A.LinearDisjoint B := by + let ι := Module.Free.ChooseBasisIndex F A + let a : Module.Basis ι F A := Module.Free.chooseBasis F A + letI : Fintype ι := Fintype.ofFinite ι + have hAspan : A.toSubalgebra.toSubmodule = + Submodule.span F (Set.range (A.val ∘ a)) := by + calc + A.toSubalgebra.toSubmodule = + Submodule.map A.val.toLinearMap (⊤ : Submodule F A) := by + ext x + simp + _ = Submodule.map A.val.toLinearMap + (Submodule.span F (Set.range a)) := by rw [Module.Basis.span_eq a] + _ = Submodule.span F (Set.range (A.val ∘ a)) := by + rw [Submodule.map_span] + congr 1 + ext x + simp [Function.comp_apply] + have hAdjoinField : IntermediateField.adjoin B (A : Set E) = ⊤ := by + apply IntermediateField.restrictScalars_injective F + rw [IntermediateField.restrictScalars_adjoin_eq_sup] + simpa [sup_comm] using hsup + have hAdjoin : Algebra.adjoin B (A : Set E) = ⊤ := by + rw [← IntermediateField.adjoin_intermediateField_toSubalgebra_of_isAlgebraic_right B A, + hAdjoinField] + rfl + have hspan : Submodule.span B (Set.range (A.val ∘ a)) = ⊤ := by + have hAdjoin' : Algebra.adjoin B (A.toSubalgebra : Set E) = ⊤ := by + simpa only [IntermediateField.coe_toSubalgebra] using hAdjoin + rw [← A.toSubalgebra.adjoin_eq_span_of_eq_span B hAspan, hAdjoin'] + rfl + letI : FiniteDimensional B E := by + have hfinite : Module.Finite B + (Submodule.span B (Set.range (A.val ∘ a))) := + Module.Finite.span_of_finite B (Set.toFinite _) + rw [hspan] at hfinite + exact Module.Finite.equiv (Submodule.topEquiv (R := B) (M := E)) + letI : IsGalois B E := IsGalois.sup_right A B hsup + have hfinrank : Module.finrank B E = Module.finrank F A := by + rw [← IsGalois.card_aut_eq_finrank, ← IsGalois.card_aut_eq_finrank] + exact Nat.card_congr <| Equiv.ofBijective + (IntermediateField.restrictRestrictAlgEquivMapHom F A B E) + ⟨IntermediateField.restrictRestrictAlgEquivMapHom_injective A B hsup, + IntermediateField.restrictRestrictAlgEquivMapHom_surjective A B hinf⟩ + apply IntermediateField.LinearDisjoint.of_basis_left a + apply linearIndependent_of_top_le_span_of_card_eq_finrank + · exact hspan.ge + · rw [hfinrank] + exact (Module.finrank_eq_card_basis a).symm + +/-- A finite Galois intermediate field is linearly disjoint from any other +intermediate field having trivial intersection with it. Unlike Mathlib's +finite intersection criterion, the field on the right need not be finite over +the base. -/ +theorem linearDisjoint_of_inf_eq_bot_of_finite_galois_left + (A B : IntermediateField F E) + [IsGalois F A] [FiniteDimensional F A] + (hinf : A ⊓ B = ⊥) : A.LinearDisjoint B := by + let D : IntermediateField F E := A ⊔ B + let A' : IntermediateField F D := A.restrict le_sup_left + let B' : IntermediateField F D := B.restrict le_sup_right + have hA : IntermediateField.map D.val A' = A := + IntermediateField.lift_restrict le_sup_left + have hB : IntermediateField.map D.val B' = B := + IntermediateField.lift_restrict le_sup_right + suffices A'.LinearDisjoint B' from + hA ▸ hB ▸ IntermediateField.LinearDisjoint.map this D.val + have hsup : A' ⊔ B' = ⊤ := by + rw [← IntermediateField.lift_inj, IntermediateField.lift_top, + IntermediateField.lift_sup, IntermediateField.lift_restrict le_sup_left, + IntermediateField.lift_restrict le_sup_right] + have hinf' : A' ⊓ B' = ⊥ := by + rw [← IntermediateField.lift_inj, IntermediateField.lift_bot, + IntermediateField.lift_inf, IntermediateField.lift_restrict le_sup_left, + IntermediateField.lift_restrict le_sup_right, hinf] + let eA : A ≃ₐ[F] A' := IntermediateField.restrict_algEquiv .. + letI : FiniteDimensional F A' := Module.Finite.equiv eA.toLinearEquiv + haveI : IsGalois F A' := IsGalois.of_algEquiv eA + exact linearDisjoint_of_inf_eq_bot_of_sup_eq_top A' B' hsup hinf' + +end LinearDisjoint + +section Constants + +variable (C N S : Type*) [Field C] [Field N] [Field S] + [Algebra C N] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S] + +/-- Inside a common algebraic closure, a finite Galois constant extension and +a field with exact constant field `C` are linearly disjoint over `C`. -/ +theorem exactConstantExtensionImages_linearDisjoint + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + let Ω := AlgebraicClosure N + let fS : S →ₐ[C] Ω := IsAlgClosed.lift + fS.fieldRange.LinearDisjoint + (IsScalarTower.toAlgHom C N Ω).fieldRange := by + let Ω := AlgebraicClosure N + let fS : S →ₐ[C] Ω := IsAlgClosed.lift + letI : Algebra S Ω := fS.toAlgebra + letI : IsScalarTower C S Ω := IsScalarTower.of_algebraMap_eq' (by + ext c + exact (fS.commutes c).symm) + let A := fS.fieldRange + let B := (IsScalarTower.toAlgHom C N Ω).fieldRange + have hInf : A ⊓ B = (⊥ : IntermediateField C Ω) := by + refine eq_bot_iff.mpr ?_ + intro x hx + obtain ⟨s, hs⟩ := hx.1 + obtain ⟨n, hn⟩ := hx.2 + have hxAlg : IsAlgebraic C x := by + rw [← hs] + exact (Algebra.IsIntegral.isIntegral s).map fS |>.isAlgebraic + have hnAlg : IsAlgebraic C n := by + apply (isAlgebraic_algHom_iff + (IsScalarTower.toAlgHom C N Ω) + (IsScalarTower.toAlgHom C N Ω).injective).mp + have hn' : (IsScalarTower.toAlgHom C N Ω) n = x := hn + rw [hn'] + exact hxAlg + have hnBot : n ∈ (⊥ : IntermediateField C N) := by + rw [← hExact] + exact mem_algebraicClosure_iff.mpr hnAlg + obtain ⟨c, hc⟩ := IntermediateField.mem_bot.mp hnBot + apply IntermediateField.mem_bot.mpr + refine ⟨c, ?_⟩ + rw [← hn, ← hc] + rfl + let eA : S ≃ₐ[C] A := AlgEquiv.ofInjectiveField fS + letI : FiniteDimensional C A := Module.Finite.equiv eA.toLinearEquiv + haveI : IsGalois C A := IsGalois.of_algEquiv eA + exact linearDisjoint_of_inf_eq_bot_of_finite_galois_left A B hInf + +/-- If `C` is the exact constant field of `N`, adjoining any finite Galois +extension `S / C` by tensor product produces a field. -/ +theorem exactConstantExtensionTensor_isField + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + IsField (S ⊗[C] N) := by + exact IntermediateField.LinearDisjoint.isField_of_isAlgebraic' + (exactConstantExtensionImages_linearDisjoint C N S hExact) + (Or.inl (Algebra.IsAlgebraic.of_finite C S)) + +/-- The algebra structure on `S ⊗[C] N` induced by the copy of `N` in the +right tensor factor. -/ +@[reducible] noncomputable def exactConstantExtensionAlgebra : + Algebra N (S ⊗[C] N) := + (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := N)).toAlgebra + +/-- Commuting the tensor factors identifies the constant extension with the +usual scalar extension of `S` from `C` to `N`. -/ +noncomputable def exactConstantExtensionLinearEquiv : + letI := exactConstantExtensionAlgebra C N S + N ⊗[C] S ≃ₗ[N] S ⊗[C] N := by + letI := exactConstantExtensionAlgebra C N S + let e := (Algebra.TensorProduct.comm C N S).toRingEquiv + exact + { toEquiv := e.toEquiv + map_add' := map_add e + map_smul' := by + intro x z + refine TensorProduct.induction_on z (by simp) (fun y s => ?_) + (fun z w hz hw => ?_) + · change e ((x * y) ⊗ₜ[C] s) = + e (x ⊗ₜ[C] (1 : S)) * e (y ⊗ₜ[C] s) + rw [← map_mul] + simp + · rw [smul_add] + calc + e (x • z + x • w) = e (x • z) + e (x • w) := map_add e _ _ + _ = x • e z + x • e w := congrArg₂ (· + ·) hz hw + _ = x • e (z + w) := by rw [map_add, smul_add] } + +omit [FiniteDimensional C S] [IsGalois C S] in +/-- A finite constant extension has the expected degree over the original +field. -/ +theorem exactConstantExtension_finrank : + letI := exactConstantExtensionAlgebra C N S + Module.finrank N (S ⊗[C] N) = Module.finrank C S := by + letI := exactConstantExtensionAlgebra C N S + calc + Module.finrank N (S ⊗[C] N) = Module.finrank N (N ⊗[C] S) := + (exactConstantExtensionLinearEquiv C N S).finrank_eq.symm + _ = Module.finrank C S := Module.finrank_baseChange + +end Constants + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean new file mode 100644 index 0000000000..5deec59623 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean @@ -0,0 +1,329 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +import Mathlib.GroupTheory.NoncommCoprod + +/-! +# Galois groups of exact constant extensions + +For a tower `C ⊆ L ⊆ N` and a finite Galois extension `S / C`, the tensor +compositum `S ⊗[C] N` carries two commuting actions: constants act on the left +factor and `Gal(N/L)` acts on the right factor. The actions are jointly +faithful without any exact-constant hypothesis. + +If `C` is the exact constant field of `N`, the tensor product is a field. A +degree count then proves that the combined action exhausts its full Galois +group over `L`: + +`Gal((S ⊗[C] N) / L) ≃ Gal(S/C) × Gal(N/L)`. + +This is the direct-product statement used in Stichtenoth, Proposition 5.2.8. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +/-- The tensor compositum of a field `N` and a constant extension `S / C`. -/ +abbrev ExactConstantExtension (C N S : Type*) [CommRing C] [CommRing N] + [CommRing S] [Algebra C N] [Algebra C S] := + S ⊗[C] N + +section Algebra + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra L N] [Algebra C N] [Algebra C S] + +/-- The field structure on the tensor compositum supplied by exact constants +and finite Galois constant extension. -/ +@[reducible] noncomputable def exactConstantExtensionField + [FiniteDimensional C S] [IsGalois C S] + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + Field (ExactConstantExtension C N S) := + (exactConstantExtensionTensor_isField C N S hExact).toField + +/-- The `L`-algebra structure on the tensor compositum induced by the right +factor `N`. -/ +@[reducible] noncomputable def exactConstantExtensionBaseAlgebra : + Algebra L (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N)).toRingHom.comp (algebraMap L N)) + +/-- The `L ⊆ N ⊆ S ⊗[C] N` scalar tower. -/ +theorem exactConstantExtensionBaseTower : + letI := exactConstantExtensionBaseAlgebra C L N S + letI := exactConstantExtensionAlgebra C N S + IsScalarTower L N (ExactConstantExtension C N S) := by + letI := exactConstantExtensionBaseAlgebra C L N S + letI := exactConstantExtensionAlgebra C N S + exact IsScalarTower.of_algebraMap_eq' rfl + +end Algebra + +section Actions + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] + +/-- A constant-field automorphism acting on the left tensor factor and fixing +`N`, viewed as an automorphism over `L`. -/ +noncomputable def exactConstantExtensionConstantAlgEquivOverBase + (σ : S ≃ₐ[C] S) : + letI := exactConstantExtensionBaseAlgebra C L N S + ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S := by + letI := exactConstantExtensionBaseAlgebra C L N S + exact + { tensorConstantAlgEquiv C S N σ with + commutes' := fun l => by + change tensorConstantAlgEquiv C S N σ + (Algebra.TensorProduct.includeRight (algebraMap L N l)) = + Algebra.TensorProduct.includeRight (algebraMap L N l) + simp } + +/-- A function-field automorphism acting on the right tensor factor and +fixing `S`, viewed as an automorphism over `L`. -/ +noncomputable def exactConstantExtensionFunctionAlgEquivOverBase + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionBaseAlgebra C L N S + ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S := by + letI := exactConstantExtensionBaseAlgebra C L N S + let gC : N ≃ₐ[C] N := g.restrictScalars C + let eC : ExactConstantExtension C N S ≃ₐ[C] + ExactConstantExtension C N S := + Algebra.TensorProduct.congr (AlgEquiv.refl : S ≃ₐ[C] S) gC + exact + { eC with + commutes' := fun l => by + change eC (Algebra.TensorProduct.includeRight (algebraMap L N l)) = + Algebra.TensorProduct.includeRight (algebraMap L N l) + simp [eC, gC, Algebra.TensorProduct.includeRight_apply] } + +/-- The constant-field action as a homomorphism into automorphisms over +`L`. -/ +noncomputable def exactConstantExtensionConstantAutHom : + letI := exactConstantExtensionBaseAlgebra C L N S + (S ≃ₐ[C] S) →* + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) := by + letI := exactConstantExtensionBaseAlgebra C L N S + exact + { toFun := exactConstantExtensionConstantAlgEquivOverBase C L N S + map_one' := by + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul s n => simp [exactConstantExtensionConstantAlgEquivOverBase] + | add x y hx hy => simp [hx, hy] + map_mul' := by + intro σ τ + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul s n => simp [exactConstantExtensionConstantAlgEquivOverBase] + | add x y hx hy => simp [hx, hy] } + +/-- The function-field action as a homomorphism into automorphisms over +`L`. -/ +noncomputable def exactConstantExtensionFunctionAutHom : + letI := exactConstantExtensionBaseAlgebra C L N S + (N ≃ₐ[L] N) →* + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) := by + letI := exactConstantExtensionBaseAlgebra C L N S + exact + { toFun := exactConstantExtensionFunctionAlgEquivOverBase C L N S + map_one' := by + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul s n => simp [exactConstantExtensionFunctionAlgEquivOverBase] + | add x y hx hy => simp [hx, hy] + map_mul' := by + intro g h + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul s n => simp [exactConstantExtensionFunctionAlgEquivOverBase] + | add x y hx hy => simp [hx, hy] } + +/-- Constant-field and function-field automorphisms commute on the tensor +compositum. -/ +theorem exactConstantExtension_constant_function_commute + (σ : S ≃ₐ[C] S) (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionBaseAlgebra C L N S + Commute + (exactConstantExtensionConstantAutHom C L N S σ) + (exactConstantExtensionFunctionAutHom C L N S g) := by + letI := exactConstantExtensionBaseAlgebra C L N S + rw [Commute] + apply AlgEquiv.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | tmul s n => simp [exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] + | add x y hx hy => + simp only [map_add] + exact congrArg₂ (· + ·) hx hy + +/-- The product of the commuting constant and function-field actions. -/ +noncomputable def exactConstantExtensionCombinedAutHom : + letI := exactConstantExtensionBaseAlgebra C L N S + (S ≃ₐ[C] S) × (N ≃ₐ[L] N) →* + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := by + letI := exactConstantExtensionBaseAlgebra C L N S + exact (exactConstantExtensionConstantAutHom C L N S).noncommCoprod + (exactConstantExtensionFunctionAutHom C L N S) + (exactConstantExtension_constant_function_commute C L N S) + +/-- The two tensor-factor actions are jointly faithful. -/ +theorem exactConstantExtensionCombinedAutHom_injective : + letI := exactConstantExtensionBaseAlgebra C L N S + Function.Injective (exactConstantExtensionCombinedAutHom C L N S) := by + letI := exactConstantExtensionBaseAlgebra C L N S + intro p q hpq + apply Prod.ext + · ext s + have h := DFunLike.congr_fun hpq (s ⊗ₜ[C] (1 : N)) + have hinc : + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) (p.1 s) = + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) (q.1 s) := by + simpa [Algebra.TensorProduct.includeLeft_apply, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] using h + exact Algebra.TensorProduct.includeLeft_injective + (R := C) (S := C) (A := S) (B := N) (algebraMap C N).injective hinc + · ext n + have h := DFunLike.congr_fun hpq ((1 : S) ⊗ₜ[C] n) + have hinc : + Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N) (p.2 n) = + Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N) (q.2 n) := by + simpa [Algebra.TensorProduct.includeRight_apply, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] using h + exact Algebra.TensorProduct.includeRight_injective + (R := C) (A := S) (B := N) (algebraMap C S).injective hinc + +end Actions + +section Galois + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] + +omit [Algebra C L] [IsScalarTower C L N] + [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] in +/-- The tensor compositum has degree `[N : L] [S : C]` over `L`. -/ +theorem exactConstantExtension_finrank_over_base : + letI := exactConstantExtensionBaseAlgebra C L N S + Module.finrank L (ExactConstantExtension C N S) = + Module.finrank L N * Module.finrank C S := by + letI := exactConstantExtensionBaseAlgebra C L N S + letI := exactConstantExtensionAlgebra C N S + letI := exactConstantExtensionBaseTower C L N S + change Module.finrank L (S ⊗[C] N) = + Module.finrank L N * Module.finrank C S + rw [← Module.finrank_mul_finrank L N (ExactConstantExtension C N S), + exactConstantExtension_finrank C N S] + +/-- With exact constants, the tensor compositum is Galois over `L`. -/ +theorem exactConstantExtension_isGalois + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + IsGalois L (ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI := exactConstantExtensionAlgebra C N S + letI := exactConstantExtensionBaseTower C L N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e + letI : Module.Finite L (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + apply IsGalois.of_card_aut_eq_finrank + apply Nat.le_antisymm + · calc + Nat.card (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) = + Nat.card (ExactConstantExtension C N S →ₐ[L] + ExactConstantExtension C N S) := + Nat.card_congr + (algEquivEquivAlgHom L (ExactConstantExtension C N S)) + _ ≤ Module.finrank L (ExactConstantExtension C N S) := + card_algHom_le_finrank L (ExactConstantExtension C N S) + (ExactConstantExtension C N S) + · calc + Module.finrank L (ExactConstantExtension C N S) = + Module.finrank L N * Module.finrank C S := + exactConstantExtension_finrank_over_base C L N S + _ = Nat.card (N ≃ₐ[L] N) * Nat.card (S ≃ₐ[C] S) := by + rw [IsGalois.card_aut_eq_finrank, IsGalois.card_aut_eq_finrank] + _ = Nat.card ((S ≃ₐ[C] S) × (N ≃ₐ[L] N)) := by + rw [Nat.card_prod, mul_comm] + _ ≤ Nat.card (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := + Nat.card_le_card_of_injective + (exactConstantExtensionCombinedAutHom C L N S) + (exactConstantExtensionCombinedAutHom_injective C L N S) + +/-- The full Galois group of an exact finite constant extension is the direct +product of the constant and function-field Galois groups. -/ +noncomputable def exactConstantExtensionAutMulEquiv + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + (S ≃ₐ[C] S) × (N ≃ₐ[L] N) ≃* + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI := exactConstantExtensionAlgebra C N S + letI := exactConstantExtensionBaseTower C L N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e + letI : Module.Finite L (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + let h := exactConstantExtensionCombinedAutHom C L N S + let hinj := exactConstantExtensionCombinedAutHom_injective C L N S + apply MulEquiv.ofBijective h + apply hinj.bijective_of_nat_card_le + rw [Nat.card_prod, IsGalois.card_aut_eq_finrank, + exactConstantExtension_finrank_over_base C L N S, + IsGalois.card_aut_eq_finrank, IsGalois.card_aut_eq_finrank, mul_comm] + +end Galois + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean new file mode 100644 index 0000000000..c3eb1e9e42 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean @@ -0,0 +1,174 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import Mathlib.FieldTheory.Finite.Extension + +/-! +# Exact constants after a finite constant extension + +Let `N / C` have exact constant field `C`, and let `S / C` be a finite +Galois extension of finite fields. This file proves that the tensor +compositum `S ⊗[C] N` has exact constant field `S`. + +For an element algebraic over `S`, adjoin it to `C` inside the compositum. +This finite field is linearly disjoint from `N`, since its intersection with +`N` is contained in the exact constants `C`. Its degree over `C` therefore +divides `[S : C]`. The finite-field embedding criterion supplies an embedding +into `S`; uniqueness of the roots of `X ^ #K - X` inside the common +compositum then shows that the original element already belongs to `S`. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +universe u v w + +variable (C N S : Type*) [Field C] [Field N] [Field S] + [Algebra C N] [Algebra C S] + [Finite C] [Finite S] + [FiniteDimensional C S] [IsGalois C S] + +/-- A finite Galois extension of the exact finite constant field remains the +exact constant field after tensor base change. -/ +theorem exactConstantExtension_algebraicClosure_eq_bot + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra S (ExactConstantExtension C N S) := + Algebra.TensorProduct.leftAlgebra + algebraicClosure S (ExactConstantExtension C N S) = + (⊥ : IntermediateField S (ExactConstantExtension C N S)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra C (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C C N S + letI : SMul C (ExactConstantExtension C N S) := Algebra.toSMul + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + haveI : IsScalarTower C N (ExactConstantExtension C N S) := by + exact exactConstantExtensionBaseTower C C N S + letI : Algebra S (ExactConstantExtension C N S) := + Algebra.TensorProduct.leftAlgebra + letI : SMul S (ExactConstantExtension C N S) := Algebra.toSMul + have hSN : algebraMap C (ExactConstantExtension C N S) = + (algebraMap S (ExactConstantExtension C N S)).comp (algebraMap C S) := by + ext c + change (1 : S) ⊗ₜ algebraMap C N c = + algebraMap C S c ⊗ₜ (1 : N) + exact (Algebra.TensorProduct.tmul_one_eq_one_tmul c).symm + letI : IsScalarTower C S (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' hSN + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + haveI : IsGalois N (ExactConstantExtension C N S) := by + exact exactConstantExtension_isGalois C N N S hExact + apply eq_bot_iff.mpr + intro z hz + have hzS : IsAlgebraic S z := mem_algebraicClosure_iff.mp hz + have hzInt : IsIntegral C z := isIntegral_trans z hzS.isIntegral + let K : IntermediateField C (ExactConstantExtension C N S) := + IntermediateField.adjoin C {z} + letI : FiniteDimensional C K := by + dsimp [K] + exact IntermediateField.adjoin.finiteDimensional hzInt + letI : Finite K := Module.finite_of_finite C + letI : Fintype K := Fintype.ofFinite K + letI : Algebra.IsAlgebraic C K := Algebra.IsAlgebraic.of_finite C K + haveI : IsGalois C K := inferInstance + let iN : N →ₐ[C] ExactConstantExtension C N S := + IsScalarTower.toAlgHom C N (ExactConstantExtension C N S) + let N' : IntermediateField C (ExactConstantExtension C N S) := + iN.fieldRange + have hInf : K ⊓ N' = + (⊥ : IntermediateField C (ExactConstantExtension C N S)) := by + apply eq_bot_iff.mpr + intro x hx + obtain ⟨n, hn⟩ := hx.2 + have hxAlg : IsAlgebraic C (x : ExactConstantExtension C N S) := by + have hxK : IsAlgebraic C (⟨x, hx.1⟩ : K) := + Algebra.IsAlgebraic.isAlgebraic (R := C) (A := K) + (⟨x, hx.1⟩ : K) + exact IsAlgebraic.algHom K.val hxK + have hnAlg : IsAlgebraic C n := by + apply (isAlgebraic_algHom_iff iN iN.injective).mp + change IsAlgebraic C (iN.toRingHom n) + rw [hn] + exact hxAlg + have hnBot : n ∈ (⊥ : IntermediateField C N) := by + rw [← hExact] + exact mem_algebraicClosure_iff.mpr hnAlg + obtain ⟨c, hc⟩ := IntermediateField.mem_bot.mp hnBot + apply IntermediateField.mem_bot.mpr + refine ⟨c, ?_⟩ + calc + algebraMap C (ExactConstantExtension C N S) c = + iN (algebraMap C N c) := (iN.commutes c).symm + _ = iN n := congrArg iN hc + _ = x := hn + have hLD' : K.LinearDisjoint N' := + linearDisjoint_of_inf_eq_bot_of_finite_galois_left K N' hInf + have hLD : K.LinearDisjoint N := by + change K.toSubalgebra.LinearDisjoint iN.range + have hLDsub : K.toSubalgebra.LinearDisjoint N'.toSubalgebra := + (IntermediateField.linearDisjoint_iff' (A := K) (B := N')).mp hLD' + simpa only [N', AlgHom.fieldRange_toSubalgebra] using hLDsub + let A : IntermediateField N (ExactConstantExtension C N S) := + IntermediateField.adjoin N (K : Set (ExactConstantExtension C N S)) + have hrank : Module.rank N A = Module.rank C K := by + simpa [A] using + hLD.adjoin_rank_eq_rank_left_of_isAlgebraic_left + have hfinrank : Module.finrank N A = Module.finrank C K := by + simpa only [Module.finrank] using congrArg Cardinal.toNat hrank + have hdvdTop : Module.finrank N A ∣ + Module.finrank N (ExactConstantExtension C N S) := by + simpa using + (IntermediateField.finrank_dvd_of_le_right + (show A ≤ + (⊤ : IntermediateField N (ExactConstantExtension C N S)) from le_top)) + have hdvd : Module.finrank C K ∣ Module.finrank C S := by + rw [← exactConstantExtension_finrank C N S, ← hfinrank] + exact hdvdTop + let φ : K →ₐ[C] S := + Classical.choice (FiniteField.nonempty_algHom_of_finrank_dvd hdvd) + let iKS : K →ₐ[C] ExactConstantExtension C N S := + (IsScalarTower.toAlgHom C S + (ExactConstantExtension C N S)).comp φ + let zk : K := ⟨z, IntermediateField.subset_adjoin C {z} + (Set.mem_singleton z)⟩ + have hzpow : z ^ Fintype.card K = z := by + calc + z ^ Fintype.card K = ((zk ^ Fintype.card K : K) : + ExactConstantExtension C N S) := rfl + _ = (zk : ExactConstantExtension C N S) := + congrArg Subtype.val (FiniteField.pow_card zk) + _ = z := rfl + let p : K[X] := Polynomial.X ^ Fintype.card K - Polynomial.X + have hpSplit : p.Splits := by + dsimp [p] + simpa [Nat.card_eq_fintype_card] using + (Polynomial.splits_X_pow_nat_card_sub_X (K := K)) + have hp0 : p ≠ 0 := by + dsimp [p] + exact FiniteField.X_pow_card_sub_X_ne_zero K Fintype.one_lt_card + have hroot : (p.map iKS).IsRoot z := by + simp [p, hzpow] + obtain ⟨k, hk⟩ := hpSplit.mem_range_of_isRoot hp0 hroot + apply IntermediateField.mem_bot.mpr + refine ⟨φ k, ?_⟩ + simpa [iKS] using hk + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean new file mode 100644 index 0000000000..4e7299aed2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean @@ -0,0 +1,1045 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap + +/-! +# Local different coefficients under exact constant extension + +The finite and reciprocal-infinity different ideals commute with exact +extension of finite constants. Since every place in a constant extension +has ramification index one, their multiplicities agree place by place. This +discharges the local hypothesis of the global different-degree and genus +transport theorems. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) + exactConstantDifferentCoefficientConstantsDecidableEq + (K : Type*) [Field K] : DecidableEq K := + infinityBridgeDecidableEqConstants K + +local instance (priority := 10001) + exactConstantDifferentCoefficientRatFuncDecidableEq + (K : Type*) [Field K] : DecidableEq (RatFunc K) := + infinityBridgeDecidableEqRatFuncConstants K + +local instance exactConstantDifferentCoefficientBaseConstantAlgebra : + Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance exactConstantDifferentCoefficientBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) + exactConstantDifferentCoefficientBasePolynomialAlgebra : Algebra C[X] N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + +local instance exactConstantDifferentCoefficientBasePolynomialTower : + IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance exactConstantDifferentCoefficientBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance exactConstantDifferentCoefficientTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + constantExtensionTensorPolynomialAlgebra C S N + +@[reducible] private noncomputable def + exactConstantDifferentCoefficientCanonicalFractionRingAlgebra + (R : Type*) [CommRing R] [IsDomain R] : + Algebra R (FractionRing R) := inferInstance + +private theorem exactConstantDifferentCoefficientCanonicalFractionRing + (R : Type*) [CommRing R] [IsDomain R] : + letI := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R + IsFractionRing R (FractionRing R) := by + letI := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R + infer_instance + +private theorem integralClosureAlgEquivRatFuncFiniteOfEq_coe + {k T : Type*} [Field k] [Field T] [Algebra (RatFunc k) T] + (a : Algebra k[X] T) + (h : ratFuncInducedPolynomialAlgebra k T = a) + (x : letI := a; integralClosure k[X] T) : + letI := a + (((integralClosureAlgEquivRatFuncFiniteOfEq k T a h) x : + RatFuncFiniteIntegralClosure k T) : T) = x := by + subst a + rfl + +/-- Changing only the presentation of a finite normalization does not change +the multiplicity of its different. The equivalence here is the equality +transport from a chosen compatible polynomial action to the action induced +by the fixed rational-function-field embedding. -/ +private def idealMapMulEquiv {R T : Type*} [CommSemiring R] [CommSemiring T] + (e : R ≃+* T) : Ideal R ≃* Ideal T where + toFun I := I.map e + invFun I := I.map e.symm + left_inv I := Ideal.map_of_equiv e + right_inv I := Ideal.map_of_equiv e.symm + map_mul' I J := Ideal.map_mul e I J + +private theorem finiteNormalization_multiplicity_map_eq + {k T : Type*} [Field k] [Field T] [Algebra (RatFunc k) T] + (a : Algebra k[X] T) + (h : ratFuncInducedPolynomialAlgebra k T = a) + (q : letI := a + IsDedekindDomain.HeightOneSpectrum (integralClosure k[X] T)) + (I : letI := a; Ideal (integralClosure k[X] T)) : + letI := a + let e := integralClosureAlgEquivRatFuncFiniteOfEq k T a h + multiplicity (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal + (Ideal.map e I) = + multiplicity q.asIdeal I := by + dsimp only + rw [heightOneSpectrumEquivOfAlgEquiv_asIdeal] + let e := integralClosureAlgEquivRatFuncFiniteOfEq k T a h + rw [show Ideal.comap e.symm q.asIdeal = Ideal.map e q.asIdeal by + exact (Ideal.map_comap_of_equiv e.toRingEquiv).symm] + exact multiplicity_map_eq + (idealMapMulEquiv e.toRingEquiv) + +private theorem finiteNormalization_differentIdeal_eq_map + {k T : Type*} [Field k] [Finite k] [Field T] + [Algebra (RatFunc k) T] [FiniteDimensional (RatFunc k) T] + [Algebra.IsSeparable (RatFunc k) T] + (a : Algebra k[X] T) + (h : ratFuncInducedPolynomialAlgebra k T = a) + (hDedekind : letI := a + IsDedekindDomain (integralClosure k[X] T)) + (hTorsionFree : letI := a + Module.IsTorsionFree k[X] (integralClosure k[X] T)) : + letI := a + letI : IsDedekindDomain (integralClosure k[X] T) := hDedekind + letI : Module.IsTorsionFree k[X] (integralClosure k[X] T) := + hTorsionFree + let e := integralClosureAlgEquivRatFuncFiniteOfEq k T a h + differentIdeal k[X] (RatFuncFiniteIntegralClosure k T) = + Ideal.map e (differentIdeal k[X] (integralClosure k[X] T)) := by + subst a + dsimp only + change differentIdeal k[X] (RatFuncFiniteIntegralClosure k T) = + Ideal.map (AlgEquiv.refl : + RatFuncFiniteIntegralClosure k T ≃ₐ[k[X]] + RatFuncFiniteIntegralClosure k T) + (differentIdeal k[X] (RatFuncFiniteIntegralClosure k T)) + exact (Ideal.map_id _).symm + +/-- Ramification indices are unchanged by an equivalence of the upper +Dedekind domains that is linear over the lower Dedekind domain. -/ +private theorem ramificationIdx_algEquiv + {R A B : Type*} [CommRing R] [CommRing A] [CommRing B] + [IsDomain R] [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra R A] [Algebra R B] + [Module.IsTorsionFree R A] [Module.IsTorsionFree R B] + (e : A ≃ₐ[R] B) (p : HeightOneSpectrum R) + (q : HeightOneSpectrum A) + [q.asIdeal.LiesOver p.asIdeal] + [(heightOneSpectrumEquivOfAlgEquiv e q).asIdeal.LiesOver p.asIdeal] : + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal.ramificationIdx R = + q.asIdeal.ramificationIdx R := by + let q' := heightOneSpectrumEquivOfAlgEquiv e q + have hIdeal : q'.asIdeal = Ideal.map e.toRingHom q.asIdeal := by + dsimp only [q'] + rw [heightOneSpectrumEquivOfAlgEquiv_asIdeal] + exact (Ideal.map_comap_of_equiv e.toRingEquiv).symm + calc + q'.asIdeal.ramificationIdx R = + p.asIdeal.ramificationIdx' q'.asIdeal := + (Ideal.ramificationIdx'_eq_ramificationIdx + p.asIdeal q'.asIdeal p.ne_bot).symm + _ = p.asIdeal.ramificationIdx' q.asIdeal := by + rw [hIdeal] + exact Ideal.ramificationIdx'_map_eq p.asIdeal q.asIdeal e + _ = q.asIdeal.ramificationIdx R := + Ideal.ramificationIdx'_eq_ramificationIdx + p.asIdeal q.asIdeal p.ne_bot + +/-- A prime in the explicit `S[X]`-normalization is unramified over its +contracted prime in the original `C[X]`-normalization. The proof transports +the prime to the canonical `C[X]`-normalization used by the place tower and +then invokes unramifiedness of exact constant extensions. -/ +theorem exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + let R2 := RatFuncFiniteIntegralClosure C N + let B := integralClosure S[X] E + letI : Algebra R2 B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + q.asIdeal.ramificationIdx R2 = 1 := by + dsimp only + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + letI : Algebra S[X] (RatFunc S) := inferInstance + letI : IsFractionRing S[X] (RatFunc S) := inferInstance + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + let R2 := RatFuncFiniteIntegralClosure C N + let B := integralClosure S[X] E + let CC := RatFuncFiniteIntegralClosure C E + let CS := RatFuncFiniteIntegralClosure S E + letI : Algebra C[X] (RatFunc C) := inferInstance + letI : IsFractionRing C[X] (RatFunc C) := inferInstance + letI : IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsDedekindDomain R2 := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R2 + letI : Module.IsTorsionFree C[X] N := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + ((algebraMap (RatFunc C) N).comp (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) N).injective.comp + (RatFunc.algebraMap_injective C) + letI : Module.IsTorsionFree C[X] R2 := + IsIntegralClosure.isTorsionFree C[X] N + letI : Algebra C R2 := + RingHom.toAlgebra + ((algebraMap C[X] R2).comp (algebraMap C C[X])) + letI : SMul C R2 := Algebra.toSMul + letI : Module C R2 := Algebra.toModule + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E B + letI : Algebra R2 B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + letI : SMul R2 B := Algebra.toSMul + letI : Module R2 B := Algebra.toModule + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : SMul N E := Algebra.toSMul + letI : Module N E := Algebra.toModule + letI : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra C[X] E := + RingHom.toAlgebra + ((algebraMap (RatFunc C) E).comp (algebraMap C[X] (RatFunc C))) + letI : SMul C[X] E := Algebra.toSMul + letI : Module C[X] E := Algebra.toModule + letI : IsScalarTower C[X] (RatFunc C) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra C[X] S[X] := Polynomial.algebra C S + letI : IsScalarTower C[X] S[X] E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap (RatFunc C) E + (algebraMap C[X] (RatFunc C) p) = + algebraMap S[X] E (algebraMap C[X] S[X] p) + rw [IsScalarTower.algebraMap_apply S[X] (RatFunc S) E] + rw [rationalBase_algebraMap_eq C S N hExact] + apply congrArg (algebraMap (RatFunc S) E) + exact ratFuncCoefficientAlgHom_algebraMap C S p) + letI : Algebra R2 CC := (finiteIntegralClosureMap C N E).toAlgebra + letI : SMul R2 CC := Algebra.toSMul + letI : Module R2 CC := Algebra.toModule + letI : IsDedekindDomain CC := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) E CC + letI : Algebra S CC := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : Algebra S CS := + RingHom.toAlgebra + ((algebraMap S[X] CS).comp (algebraMap S S[X])) + let eS := integralClosureAlgEquivRatFuncFiniteOfAlgebraMap + S E (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncToExactConstantExtension_algebraMap C S N hExact) + let eBase := exactConstantExtensionFiniteClosureBaseChangeAlgEquiv + C S N hExact + let eRing : B ≃+* CC := eS.toRingEquiv.trans eBase.toRingEquiv.symm + let e : B ≃ₐ[R2] CC := + { eRing with + commutes' := fun x => by + apply Subtype.ext + have heBaseCoe (y : CC) : + ((eBase y : CS) : E) = y := by + exact integralClosureRingEquivOfIntegralTower_coe C[X] S[X] E y + have heBaseSymmCoe (z : CS) : + ((eBase.symm z : CC) : E) = z := by + calc + ((eBase.symm z : CC) : E) = + ((eBase (eBase.symm z) : CS) : E) := + (heBaseCoe (eBase.symm z)).symm + _ = (z : E) := congrArg Subtype.val (eBase.apply_symm_apply z) + calc + ((eRing ((algebraMap R2 B) x) : CC) : E) = + ((eS ((algebraMap R2 B) x) : CS) : E) := + heBaseSymmCoe (eS ((algebraMap R2 B) x)) + _ = (((algebraMap R2 B) x : B) : E) := + integralClosureAlgEquivRatFuncFiniteOfEq_coe + (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncInducedPolynomialAlgebra_eq S E + (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncToExactConstantExtension_algebraMap C S N hExact)) + ((algebraMap R2 B) x) + _ = (((algebraMap R2 CC) x : CC) : E) := by + change + (((finiteFieldConstantExtensionIntegralClosureRingEquiv C S N) + (1 ⊗ₜ[C] x) : B) : E) = + algebraMap N E (x : N) + exact finiteFieldConstantExtensionIntegralClosureRingEquiv_tmul + C S N 1 x } + have hTargetInjective : Function.Injective (algebraMap R2 CC) := by + intro x y hxy + apply Subtype.ext + apply (algebraMap N E).injective + exact congrArg Subtype.val hxy + letI : Module.IsTorsionFree R2 CC := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact hTargetInjective + letI : Module.IsTorsionFree R2 B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro x y hxy + apply hTargetInjective + rw [← e.commutes x, ← e.commutes y, hxy] + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q + have hQ : heightOneSpectrumEquivOfAlgEquiv e q = Q := by + apply (HeightOneSpectrum.equivOfRingEquiv eBase.toRingEquiv).injective + calc + HeightOneSpectrum.equivOfRingEquiv eBase.toRingEquiv + (heightOneSpectrumEquivOfAlgEquiv e q) = + heightOneSpectrumEquivOfAlgEquiv eS q := by + rfl + _ = exactConstantExtensionUpstairsFinitePlace C S N hExact q := by + exact + (exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTransport + C S N hExact q).symm + _ = HeightOneSpectrum.equivOfRingEquiv eBase.toRingEquiv Q := by + exact + (exactConstantExtensionCompatibleBaseFinitePlace_baseChange + C S N hExact q).symm + let q' := heightOneSpectrumEquivOfAlgEquiv e q + letI : q.asIdeal.LiesOver P.asIdeal := ⟨by + change P.asIdeal = q.asIdeal.comap (algebraMap R2 B) + rfl⟩ + letI : q'.asIdeal.LiesOver P.asIdeal := ⟨by + change P.asIdeal = q'.asIdeal.comap (algebraMap R2 CC) + rw [show q' = Q by exact hQ] + exact congrArg HeightOneSpectrum.asIdeal + (exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact q).symm⟩ + calc + q.asIdeal.ramificationIdx R2 = + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal.ramificationIdx R2 := + (ramificationIdx_algEquiv e P q).symm + _ = Q.asIdeal.ramificationIdx R2 := by rw [hQ] + _ = 1 := by + exact exactConstantExtensionFinitePlace_ramificationIdx_eq_one + C S N hExact Q + +/-- Every prime in the explicit extended infinity normalization is unramified +over the original infinity normalization. -/ +theorem exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + let R2 := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S E + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2).1.ramificationIdx R2 = 1 := by + dsimp only + let E := ExactConstantExtension C N S + let A := RatFuncInfinityIntegers C + let R1 := RatFuncInfinityIntegers S + let R2 := RatFuncInfinityIntegralClosure C N + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : SMul N E := Algebra.toSMul + letI : Module N E := Algebra.toModule + letI : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : DistribMulAction (RatFunc S) E := Module.toDistribMulAction + letI : MulAction (RatFunc S) E := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + let B := RatFuncInfinityIntegralClosure S E + let CC := RatFuncInfinityIntegralClosure C E + letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + letI : SMul A (RatFunc C) := Algebra.toSMul + letI : Module A (RatFunc C) := Algebra.toModule + letI : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 + letI : SMul R1 (RatFunc S) := Algebra.toSMul + letI : Module R1 (RatFunc S) := Algebra.toModule + letI : IsFractionRing A (RatFunc C) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) + letI : IsFractionRing R1 (RatFunc S) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) + letI : Algebra A N := Algebra.ofSubsemiring A + letI : SMul A N := Algebra.toSMul + letI : Module A N := Algebra.toModule + letI : IsScalarTower A (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra A E := Algebra.ofSubsemiring A + letI : SMul A E := Algebra.toSMul + letI : Module A E := Algebra.toModule + letI : Module.IsTorsionFree A E := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap (RatFunc C) E).injective.comp + (IsFractionRing.injective A (RatFunc C)) + letI : IsScalarTower A (RatFunc C) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra R1 E := Algebra.ofSubsemiring R1 + letI : SMul R1 E := Algebra.toSMul + letI : Module R1 E := Algebra.toModule + letI : Algebra A R1 := + RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : SMul A R1 := Algebra.toSMul + letI : Module A R1 := Algebra.toModule + letI : Module.Finite A R1 := + ratFuncInfinityIntegers_coefficient_moduleFinite C S + letI : Algebra.IsIntegral A R1 := by infer_instance + letI : IsScalarTower A R1 E := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap (RatFunc C) E z.1 = + algebraMap (RatFunc S) E (ratFuncCoefficientAlgHom C S z.1) + exact DFunLike.congr_fun + (rationalBase_algebraMap_eq C S N hExact) z.1) + letI : IsDedekindDomain R2 := + integralClosure.isDedekindDomain A (RatFunc C) N + letI : IsDedekindDomain B := + integralClosure.isDedekindDomain R1 (RatFunc S) E + letI : IsDedekindDomain CC := + integralClosure.isDedekindDomain A (RatFunc C) E + letI : Algebra A R2 := inferInstance + letI : SMul A R2 := Algebra.toSMul + letI : Module A R2 := Algebra.toModule + letI : Module.IsTorsionFree A R2 := + IsIntegralClosure.isTorsionFree A N + letI : Algebra A CC := inferInstance + letI : SMul A CC := Algebra.toSMul + letI : Module A CC := Algebra.toModule + letI : Module.IsTorsionFree A CC := + IsIntegralClosure.isTorsionFree A E + letI : Module.IsTorsionFree R1 E := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap (RatFunc S) E).injective.comp + (IsFractionRing.injective R1 (RatFunc S)) + letI : Module.IsTorsionFree R1 B := + IsIntegralClosure.isTorsionFree R1 E + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + letI : SMul R2 B := Algebra.toSMul + letI : Module R2 B := Algebra.toModule + letI : Algebra R2 CC := (infinityIntegralClosureMap C N E).toAlgebra + letI : SMul R2 CC := Algebra.toSMul + letI : Module R2 CC := Algebra.toModule + letI : IsScalarTower A R2 CC := + IsScalarTower.of_algebraMap_eq' (by + ext z + rfl) + let eRing : CC ≃+* B := + integralClosureRingEquivOfIntegralTower A R1 E + let e : CC ≃ₐ[R2] B := + { eRing with + commutes' := fun x => by + apply Subtype.ext + calc + ((eRing ((algebraMap R2 CC) x) : B) : E) = + ((algebraMap R2 CC) x : CC) := + integralClosureRingEquivOfIntegralTower_coe A R1 E _ + _ = algebraMap N E (x : N) := rfl + _ = ((algebraMap R2 B) x : B) := + (exactConstantExtensionInfinityNormalizationAlgebra_coe + C S N hExact x).symm } + have hTargetInjective : Function.Injective (algebraMap R2 CC) := by + intro x y hxy + apply Subtype.ext + apply (algebraMap N E).injective + exact congrArg Subtype.val hxy + letI : Module.IsTorsionFree R2 CC := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact hTargetInjective + letI : Module.IsTorsionFree R2 B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro x y hxy + apply hTargetInjective + rw [← e.commutes x, ← e.commutes y] at hxy + exact e.injective hxy + let w := exactConstantExtensionUpstairsInfinityPlace C S N hExact q.1 q.2 + let QI : Ideal CC := Ideal.comap eRing.toRingHom w.1 + have hQIPrime : QI.IsPrime := by + dsimp only [QI] + exact Ideal.comap_isPrime (f := eRing.toRingHom) (K := w.1) + have hQIOver : QI.LiesOver (ratFuncInfinityPlace C).asIdeal := ⟨by + ext x + change x ∈ (ratFuncInfinityPlace C).asIdeal ↔ + eRing (algebraMap A CC x) ∈ w.1 + have heMap : eRing (algebraMap A CC x) = + algebraMap R1 B (ratFuncInfinityIntegersRingHom C S x) := by + apply Subtype.ext + calc + ((eRing (algebraMap A CC x) : B) : E) = + ((algebraMap A CC x : CC) : E) := + integralClosureRingEquivOfIntegralTower_coe A R1 E _ + _ = algebraMap (RatFunc C) E x.1 := rfl + _ = algebraMap (RatFunc S) E + (ratFuncCoefficientAlgHom C S x.1) := + DFunLike.congr_fun + (rationalBase_algebraMap_eq C S N hExact) x.1 + _ = ((algebraMap R1 B + (ratFuncInfinityIntegersRingHom C S x) : B) : E) := rfl + rw [heMap] + have hCoeff := congrArg + (fun I : Ideal A => x ∈ I) + (ratFuncInfinityIntegersRingHom_comap_infinityPlace C S) + have hCoeffMem : x ∈ (ratFuncInfinityPlace C).asIdeal ↔ + ratFuncInfinityIntegersRingHom C S x ∈ + (ratFuncInfinityPlace S).asIdeal := by + change x ∈ (ratFuncInfinityPlace C).asIdeal ↔ + x ∈ Ideal.comap (ratFuncInfinityIntegersRingHom C S) + (ratFuncInfinityPlace S).asIdeal + exact iff_of_eq hCoeff.symm + have hWMem := congrArg + (fun I : Ideal R1 => ratFuncInfinityIntegersRingHom C S x ∈ I) + w.2.2.over + change x ∈ (ratFuncInfinityPlace C).asIdeal ↔ + ratFuncInfinityIntegersRingHom C S x ∈ Ideal.under R1 w.1 + exact hCoeffMem.trans (iff_of_eq hWMem)⟩ + let Q : FiniteExtensionInfinityPlace C E := + ⟨QI, hQIPrime, hQIOver⟩ + let qH := primeOverHeightOne (ratFuncInfinityPlace C) Q + let wH := primeOverHeightOne (ratFuncInfinityPlace S) w + have hCompat : heightOneSpectrumEquivOfAlgEquiv e qH = wH := by + apply HeightOneSpectrum.ext + rw [heightOneSpectrumEquivOfAlgEquiv_asIdeal] + dsimp only [qH, wH, primeOverHeightOne, Q, QI] + exact Ideal.comap_of_equiv eRing.symm + let P := infinityPlaceUnder C N E Q + let pH := primeOverHeightOne (ratFuncInfinityPlace C) P + letI : qH.asIdeal.LiesOver pH.asIdeal := ⟨by + dsimp only [qH, pH, primeOverHeightOne] + change P.1 = Q.1.comap (algebraMap R2 CC) + exact infinityPlaceUnder_asIdeal C N E Q⟩ + letI : (heightOneSpectrumEquivOfAlgEquiv e qH).asIdeal.LiesOver + pH.asIdeal := ⟨by + rw [hCompat] + dsimp only [wH, pH, primeOverHeightOne] + change P.1 = w.1.comap (algebraMap R2 B) + rw [show P.1 = Q.1.comap (algebraMap R2 CC) by + exact infinityPlaceUnder_asIdeal C N E Q] + ext x + change eRing (algebraMap R2 CC x) ∈ w.1 ↔ + algebraMap R2 B x ∈ w.1 + have he := e.commutes x + change eRing (algebraMap R2 CC x) = algebraMap R2 B x at he + rw [he]⟩ + change w.1.ramificationIdx R2 = 1 + calc + w.1.ramificationIdx R2 = + (heightOneSpectrumEquivOfAlgEquiv e qH).asIdeal.ramificationIdx R2 := by + rw [hCompat] + rfl + _ = qH.asIdeal.ramificationIdx R2 := + ramificationIdx_algEquiv e pH qH + _ = 1 := by + exact exactConstantExtensionInfinityPlace_ramificationIdx_eq_one + C S N hExact Q + +/-- Exact constant extension preserves the total-different coefficient at +every presented finite or infinity place. -/ +theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : ExactConstantExtensionPresentedPlace C S N) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + finiteExtensionTotalDifferentEffectiveDivisor S E + (exactConstantExtensionPresentedUpstairsPlaceEquiv + C S N hExact q) = + finiteExtensionTotalDifferentEffectiveDivisor C N + (exactConstantExtensionPresentedDownstairsPlace + C S N hExact q) := by + dsimp only + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + cases q with + | inl q => + letI : Algebra S[X] (RatFunc S) := + inferInstance + letI : IsFractionRing S[X] (RatFunc S) := + inferInstance + letI : Module.IsTorsionFree S[X] E := + Module.IsTorsionFree.trans_faithfulSMul S[X] (RatFunc S) E + letI : IsDedekindDomain (integralClosure S[X] E) := + IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E + (integralClosure S[X] E) + letI : Module.IsTorsionFree S[X] (integralClosure S[X] E) := + IsIntegralClosure.isTorsionFree S[X] E + let R2 := RatFuncFiniteIntegralClosure C N + let B := integralClosure S[X] E + letI : Algebra C[X] (RatFunc C) := inferInstance + letI : IsFractionRing C[X] (RatFunc C) := inferInstance + letI : IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsDedekindDomain R2 := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R2 + letI : Module.IsTorsionFree C[X] N := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) N).injective.comp + (RatFunc.algebraMap_injective C) + letI : Module.IsTorsionFree C[X] R2 := + IsIntegralClosure.isTorsionFree C[X] N + letI : Algebra R2 B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + letI : SMul R2 B := Algebra.toSMul + letI : Module R2 B := Algebra.toModule + let eNorm : S ⊗[C] R2 ≃+* B := + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + letI : Module.IsTorsionFree R2 B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + (eNorm.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R2)).toRingHom) + exact eNorm.injective.comp + (Algebra.TensorProduct.includeRight_injective + (R := C) (A := S) (B := R2) (algebraMap C S).injective) + let a : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + have hAlgebra : ratFuncInducedPolynomialAlgebra S E = a := + ratFuncInducedPolynomialAlgebra_eq S E a + (ratFuncToExactConstantExtension_algebraMap C S N hExact) + let e := integralClosureAlgEquivRatFuncFiniteOfEq + S E a hAlgebra + have hDifferent : + differentIdeal S[X] (RatFuncFiniteIntegralClosure S E) = + Ideal.map e + (differentIdeal S[X] (integralClosure S[X] E)) := + finiteNormalization_differentIdeal_eq_map + a hAlgebra inferInstance inferInstance + have hUpstairs : + exactConstantExtensionUpstairsFinitePlace C S N hExact q = + heightOneSpectrumEquivOfAlgEquiv e q := by + simpa [e, a, hAlgebra, + integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] using + (exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTransport + C S N hExact q) + rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] + simp only [exactConstantExtensionPresentedUpstairsPlace, + exactConstantExtensionPresentedDownstairsPlace, + finiteExtensionTotalDifferentEffectiveDivisor_inl] + rw [hUpstairs, hDifferent] + rw [finiteNormalization_multiplicity_map_eq + a hAlgebra q + (differentIdeal S[X] (integralClosure S[X] E))] + rw [exactConstantExtension_finiteDifferent_eq_map C S N hExact] + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + letI : q.asIdeal.LiesOver P.asIdeal := ⟨by + change P.asIdeal = q.asIdeal.comap (algebraMap R2 B) + rfl⟩ + have hDifferentBase : + differentIdeal C[X] R2 ≠ ⊥ := + finiteExtensionFiniteDifferentIdeal_ne_bot C N + calc + multiplicity q.asIdeal + (Ideal.map (algebraMap R2 B) + (differentIdeal C[X] R2)) = + q.asIdeal.ramificationIdx R2 * + multiplicity P.asIdeal (differentIdeal C[X] R2) := + multiplicity_map_eq_ramificationIdx_mul + (R := R2) (S := B) P q + (differentIdeal C[X] R2) hDifferentBase + _ = multiplicity P.asIdeal (differentIdeal C[X] R2) := by + have hRam : q.asIdeal.ramificationIdx R2 = 1 := by + exact exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one + C S N hExact q + rw [hRam] + simpa only [one_mul] + | inr q => + rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] + simp only [exactConstantExtensionPresentedUpstairsPlace, + exactConstantExtensionPresentedDownstairsPlace, + finiteExtensionTotalDifferentEffectiveDivisor_inr] + let A := RatFuncInfinityIntegers C + let R1 := RatFuncInfinityIntegers S + let R2 := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S E + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : SMul N E := Algebra.toSMul + letI : Module N E := Algebra.toModule + letI : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + letI : SMul A (RatFunc C) := Algebra.toSMul + letI : Module A (RatFunc C) := Algebra.toModule + letI : IsFractionRing A (RatFunc C) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) + letI : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 + letI : SMul R1 (RatFunc S) := Algebra.toSMul + letI : Module R1 (RatFunc S) := Algebra.toModule + letI : IsFractionRing R1 (RatFunc S) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) + letI : Algebra A N := Algebra.ofSubsemiring A + letI : SMul A N := Algebra.toSMul + letI : Module A N := Algebra.toModule + letI : IsScalarTower A (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra R1 E := Algebra.ofSubsemiring R1 + letI : SMul R1 E := Algebra.toSMul + letI : Module R1 E := Algebra.toModule + letI : IsScalarTower R1 (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra A R1 := + RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : SMul A R1 := Algebra.toSMul + letI : Module A R1 := Algebra.toModule + letI : IsDedekindDomain R2 := + integralClosure.isDedekindDomain A (RatFunc C) N + letI : IsDedekindDomain B := + integralClosure.isDedekindDomain R1 (RatFunc S) E + letI : Algebra A R2 := inferInstance + letI : SMul A R2 := Algebra.toSMul + letI : Module A R2 := Algebra.toModule + letI : Algebra R2 N := Algebra.ofSubsemiring R2 + letI : SMul R2 N := Algebra.toSMul + letI : Module R2 N := Algebra.toModule + letI : IsScalarTower A R2 N := + IsScalarTower.of_algebraMap_eq' (by ext z; rfl) + letI : IsIntegralClosure R2 A N := + integralClosure.isIntegralClosure A N + letI : Module.Finite A R2 := + IsIntegralClosure.finite A (RatFunc C) N R2 + letI : Module.IsTorsionFree A R2 := + IsIntegralClosure.isTorsionFree A N + letI : Module.IsTorsionFree R1 E := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap (RatFunc S) E).injective.comp + (IsFractionRing.injective R1 (RatFunc S)) + letI : Module.IsTorsionFree R1 B := + IsIntegralClosure.isTorsionFree R1 E + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + letI : SMul R2 B := Algebra.toSMul + letI : Module R2 B := Algebra.toModule + letI : Module.IsTorsionFree R2 B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro x y hxy + apply Subtype.ext + apply (algebraMap N E).injective + have hxy' := congrArg Subtype.val hxy + calc + algebraMap N E x.1 = + ((algebraMap R2 B x : B) : E) := + (exactConstantExtensionInfinityNormalizationAlgebra_coe + C S N hExact x).symm + _ = ((algebraMap R2 B y : B) : E) := hxy' + _ = algebraMap N E y.1 := + exactConstantExtensionInfinityNormalizationAlgebra_coe + C S N hExact y + letI : IsFractionRing R2 N := + IsIntegralClosure.isFractionRing_of_finite_extension + A (RatFunc C) N R2 + letI : Algebra R2 (FractionRing R2) := + exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R2 + letI : SMul R2 (FractionRing R2) := Algebra.toSMul + letI : IsFractionRing R2 (FractionRing R2) := + exactConstantDifferentCoefficientCanonicalFractionRing R2 + letI : Algebra A (FractionRing R2) := + RingHom.toAlgebra + ((algebraMap R2 (FractionRing R2)).comp (algebraMap A R2)) + letI : SMul A (FractionRing R2) := Algebra.toSMul + letI : IsScalarTower A R2 (FractionRing R2) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FaithfulSMul A (FractionRing R2) := by + rw [faithfulSMul_iff_algebraMap_injective] + exact (IsFractionRing.injective R2 (FractionRing R2)).comp + (Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree A R2 from inferInstance)) + letI : Algebra (FractionRing A) (FractionRing R2) := + FractionRing.liftAlgebra A (FractionRing R2) + letI : Algebra.IsSeparable (FractionRing A) (FractionRing R2) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncInfinityFractionRingEquiv C).symm.toRingEquiv + (FractionRing.algEquiv R2 N).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (A := A) (B := R2) + (K₁ := RatFunc C) (K₂ := FractionRing A) + (L₁ := N) (L₂ := FractionRing R2) + (ratFuncInfinityFractionRingEquiv C).symm + (FractionRing.algEquiv R2 N).symm z + rw [exactConstantExtension_infinityDifferent_eq_map C S N hExact] + let w := exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2 + let wH := primeOverHeightOne (ratFuncInfinityPlace S) w + let P := exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 + let pH := primeOverHeightOne (ratFuncInfinityPlace C) P + letI : wH.asIdeal.LiesOver pH.asIdeal := ⟨by + change P.1 = w.1.comap (algebraMap R2 B) + exact (exactConstantExtensionUpstairsInfinityPlace_under + C S N hExact q).symm⟩ + have hDifferentBase : + differentIdeal (RatFuncInfinityIntegers C) R2 ≠ ⊥ := + differentIdeal_ne_bot + calc + multiplicity w.1 + (Ideal.map (algebraMap R2 B) + (differentIdeal (RatFuncInfinityIntegers C) R2)) = + w.1.ramificationIdx R2 * + multiplicity pH.asIdeal + (differentIdeal (RatFuncInfinityIntegers C) R2) := by + exact multiplicity_map_eq_ramificationIdx_mul + (R := R2) (S := B) pH wH + (differentIdeal (RatFuncInfinityIntegers C) R2) hDifferentBase + _ = multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers C) R2) := by + change w.1.ramificationIdx R2 * + multiplicity P.1 (differentIdeal A R2) = + multiplicity P.1 (differentIdeal A R2) + have hRam : w.1.ramificationIdx R2 = 1 := + exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one + C S N hExact q + rw [hRam] + simpa only [one_mul] + +/-- Exact finite extension of the full constant field preserves intrinsic +function-field genus. -/ +theorem exactConstantExtension_genus_eq + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + FunctionField.genus S E = FunctionField.genus C N := by + dsimp only + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + let extendedConstantAlgebra : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + let tensorConstantAlgebra : Algebra S E := + Algebra.TensorProduct.leftAlgebra + have hconstantMap (s : S) : + (@algebraMap S E _ _ extendedConstantAlgebra) s = + (@algebraMap S E _ _ tensorConstantAlgebra) s := by + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + have hConstantAlgebra : + tensorConstantAlgebra = extendedConstantAlgebra := by + apply Algebra.algebra_ext + intro s + exact (hconstantMap s).symm + have hIntrinsicGenus : + @FunctionField.genus S E _ _ tensorConstantAlgebra = + @FunctionField.genus S E _ _ extendedConstantAlgebra := by + rw [hConstantAlgebra] + have htensorPolynomialMap (s : S) : + (@algebraMap S E _ _ tensorConstantAlgebra) s = + (@algebraMap S[X] E _ _ + (constantExtensionTensorPolynomialAlgebra C S N)) + (algebraMap S S[X] s) := by + change (s ⊗ₜ[C] (1 : N)) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) + (Polynomial.C s) + simp + letI : Algebra S E := extendedConstantAlgebra + letI : SMul S E := Algebra.toSMul + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : IsScalarTower S S[X] E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro s + exact (hconstantMap s).trans (htensorPolynomialMap s)) + letI : FunctionField.IsFullConstantField C N := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C N).2 + hExact + letI : FunctionField.IsFullConstantField S E := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot S E).2 + (by + simpa only [E] using + (exactConstantExtension_extended_algebraicClosure_eq_bot + C S N hExact)) + calc + @FunctionField.genus S E _ _ tensorConstantAlgebra = + @FunctionField.genus S E _ _ extendedConstantAlgebra := + hIntrinsicGenus + _ = FunctionField.Chart.genus S E := + FunctionField.genus_eq_genusChart S E + _ = FunctionField.Chart.genus C N := + exactConstantExtension_chart_genus_eq_of_presentedMultiplicity + C S N hExact + (exactConstantExtension_presented_totalDifferentMultiplicity_eq + C S N hExact) + _ = FunctionField.genus C N := + (FunctionField.genus_eq_genusChart C N).symm + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean new file mode 100644 index 0000000000..0c34f62239 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean @@ -0,0 +1,646 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +import Mathlib.RingTheory.DedekindDomain.LinearDisjoint + +/-! +# The finite different after exact constant extension + +This file supplies the field-theoretic input for transporting the finite +different through an exact finite constant extension. Inside +`ExactConstantExtension C N S`, the copies of `S(X)` and `N` generate the +whole tensor field and are linearly disjoint over `C(X)`. The proof uses the +explicit tensor generation and the extension-degree formulas already proved +for rational-function and exact constant extensions. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +@[reducible] private noncomputable def + finiteDifferentCanonicalRatFuncPolynomialAlgebra + (K : Type*) [Field K] : Algebra K[X] (RatFunc K) := inferInstance + +private theorem finiteDifferentCanonicalRatFuncPolynomialFractionRing + (K : Type*) [Field K] : + letI := finiteDifferentCanonicalRatFuncPolynomialAlgebra K + IsFractionRing K[X] (RatFunc K) := by + letI := finiteDifferentCanonicalRatFuncPolynomialAlgebra K + infer_instance + +@[reducible] private noncomputable def + finiteDifferentCanonicalFractionRingAlgebra + (R : Type*) [CommRing R] [IsDomain R] : + Algebra R (FractionRing R) := inferInstance + +private theorem finiteDifferentCanonicalFractionRing + (R : Type*) [CommRing R] [IsDomain R] : + letI := finiteDifferentCanonicalFractionRingAlgebra R + IsFractionRing R (FractionRing R) := by + letI := finiteDifferentCanonicalFractionRingAlgebra R + infer_instance + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance finiteDifferentBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance finiteDifferentBasePolynomialAlgebra : Algebra C[X] N := + ratFuncInducedPolynomialAlgebra C N + +local instance finiteDifferentBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' (by ext c; rfl) + +local instance finiteDifferentCoefficientPolynomialAlgebra : + Algebra C[X] S[X] := Polynomial.algebra C S + +local instance finiteDifferentTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + constantExtensionTensorPolynomialAlgebra C S N + +local instance finiteDifferentTensorNormalizationPolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + constantExtensionNormalizationTensorPolynomialAlgebra C S N + +/-- The original finite normalization acts on the finite normalization after +constant extension through the right tensor factor and the canonical +normalization equivalence. -/ +@[reducible] noncomputable def + exactConstantExtensionFiniteNormalizationAlgebra + [Fintype C] [Finite S] : + Algebra (integralClosure C[X] N) + (integralClosure S[X] (ExactConstantExtension C N S)) := + by + let eNorm : + S ⊗[C] integralClosure C[X] N ≃+* + integralClosure S[X] (ExactConstantExtension C N S) := + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + exact RingHom.toAlgebra + (eNorm.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom) + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- In an exact constant extension, the embedded copies of `S(X)` and `N` +are linearly disjoint over `C(X)` and generate the whole tensor field. -/ +theorem exactConstantExtension_rationalFunctionRanges_linearDisjoint : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : Module (RatFunc C) L := Algebra.toModule + letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : SMul N L := Algebra.toSMul + letI : Module N L := Algebra.toModule + letI : IsScalarTower (RatFunc C) N L := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc S) L := + rationalBase_scalarTower C S N hExact + let f₁ : RatFunc S →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L + let f₂ : N →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) N L + let F₁ : IntermediateField (RatFunc C) L := f₁.fieldRange + let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange + F₁.LinearDisjoint F₂ ∧ F₁ ⊔ F₂ = ⊤ := by + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : Module (RatFunc C) L := Algebra.toModule + letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : SMul N L := Algebra.toSMul + letI : Module N L := Algebra.toModule + letI : IsScalarTower (RatFunc C) N L := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc S) L := + rationalBase_scalarTower C S N hExact + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := + Module.Finite.base_change C N S + letI : Module.Finite N L := Module.Finite.equiv e + letI : FiniteDimensional (RatFunc C) L := + Module.Finite.trans N L + let f₁ : RatFunc S →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L + let f₂ : N →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) N L + let F₁ : IntermediateField (RatFunc C) L := f₁.fieldRange + let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange + have hsup : F₁ ⊔ F₂ = ⊤ := by + apply top_unique + intro z _ + induction z using TensorProduct.induction_on with + | zero => exact (F₁ ⊔ F₂).zero_mem + | tmul s n => + rw [show s ⊗ₜ[C] n = (s ⊗ₜ[C] 1) * (1 ⊗ₜ[C] n) by simp] + apply (F₁ ⊔ F₂).mul_mem + · apply (show F₁ ≤ F₁ ⊔ F₂ from le_sup_left) + exact ⟨algebraMap S (RatFunc S) s, by + change f₁ (algebraMap S (RatFunc S) s) = s ⊗ₜ[C] 1 + exact (ratFuncToExactConstantExtension C S N hExact).commutes s⟩ + · apply (show F₂ ≤ F₁ ⊔ F₂ from le_sup_right) + exact ⟨n, rfl⟩ + | add x y hx hy => + exact (F₁ ⊔ F₂).add_mem (hx (by simp)) (hy (by simp)) + let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange + let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange + letI : FiniteDimensional (RatFunc C) F₁ := by + letI : Module.Finite (RatFunc C) (RatFunc S) := + ratFuncCoefficient_moduleFinite C S + exact Module.Finite.equiv e₁.toLinearEquiv + letI : FiniteDimensional (RatFunc C) F₂ := + Module.Finite.equiv e₂.toLinearEquiv + have hfinL : + Module.finrank (RatFunc C) L = + Module.finrank (RatFunc C) F₁ * + Module.finrank (RatFunc C) F₂ := by + calc + Module.finrank (RatFunc C) L = + Module.finrank (RatFunc C) N * Module.finrank N L := by + rw [Module.finrank_mul_finrank] + _ = Module.finrank (RatFunc C) N * Module.finrank C S := by + rw [exactConstantExtension_finrank C N S] + _ = Module.finrank C S * Module.finrank (RatFunc C) N := by + rw [mul_comm] + _ = Module.finrank (RatFunc C) (RatFunc S) * + Module.finrank (RatFunc C) N := by + rw [ratFuncCoefficient_finrank C S] + _ = Module.finrank (RatFunc C) F₁ * + Module.finrank (RatFunc C) F₂ := by + rw [e₁.toLinearEquiv.finrank_eq, e₂.toLinearEquiv.finrank_eq] + have hdisjoint : F₁.LinearDisjoint F₂ := by + apply IntermediateField.LinearDisjoint.of_finrank_sup + rw [hsup, IntermediateField.finrank_top'] + exact hfinL + exact ⟨hdisjoint, hsup⟩ + +/-- In an exact finite constant extension, the different of the extended +finite normalization is the extension of the original finite different. +The map on ideals is the right-factor map supplied by +`exactConstantExtensionFiniteNormalizationAlgebra`. -/ +theorem exactConstantExtension_finiteDifferent_eq_map + [Fintype C] [Finite S] : + let L := ExactConstantExtension C N S + let R₂ := integralClosure C[X] N + let B := integralClosure S[X] L + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra S[X] L := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] L := Algebra.toSMul + letI : Module S[X] L := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : Algebra S[X] (RatFunc S) := + finiteDifferentCanonicalRatFuncPolynomialAlgebra S + letI : IsFractionRing S[X] (RatFunc S) := + finiteDifferentCanonicalRatFuncPolynomialFractionRing S + letI : IsScalarTower S[X] (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] L p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : Module.IsTorsionFree S[X] L := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro p q hpq + apply RatFunc.algebraMap_injective S + apply (algebraMap (RatFunc S) L).injective + simpa only [IsScalarTower.algebraMap_apply S[X] (RatFunc S) L] + using hpq + letI : FiniteDimensional (RatFunc S) L := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) L := + isSeparable_over_extendedRatFunc C S N hExact + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) L B + letI : Module.IsTorsionFree S[X] B := + IsIntegralClosure.isTorsionFree S[X] L + letI : Algebra C[X] (RatFunc C) := + finiteDifferentCanonicalRatFuncPolynomialAlgebra C + letI : IsFractionRing C[X] (RatFunc C) := + finiteDifferentCanonicalRatFuncPolynomialFractionRing C + letI : IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsDedekindDomain R₂ := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R₂ + letI : Module.IsTorsionFree C[X] N := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) N).injective.comp + (RatFunc.algebraMap_injective C) + letI : Module.IsTorsionFree C[X] R₂ := + IsIntegralClosure.isTorsionFree C[X] N + letI : Algebra R₂ B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + differentIdeal S[X] B = + Ideal.map (algebraMap R₂ B) (differentIdeal C[X] R₂) := by + let L := ExactConstantExtension C N S + let R₂ := integralClosure C[X] N + let B := integralClosure S[X] L + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra S[X] L := + constantExtensionTensorPolynomialAlgebra C S N + letI : IsDomain R₂ := inferInstance + letI : IsDomain B := inferInstance + letI : SMul S[X] L := Algebra.toSMul + letI : Module S[X] L := Algebra.toModule + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : Module (RatFunc C) L := Algebra.toModule + letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : SMul N L := Algebra.toSMul + letI : Module N L := Algebra.toModule + letI : IsScalarTower (RatFunc C) N L := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc S) L := + rationalBase_scalarTower C S N hExact + letI : Algebra C[X] (RatFunc C) := + finiteDifferentCanonicalRatFuncPolynomialAlgebra C + letI : IsFractionRing C[X] (RatFunc C) := + finiteDifferentCanonicalRatFuncPolynomialFractionRing C + letI : IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra C[X] L := + RingHom.toAlgebra + ((algebraMap (RatFunc C) L).comp + (algebraMap C[X] (RatFunc C))) + letI : SMul C[X] L := Algebra.toSMul + letI : Module C[X] L := Algebra.toModule + letI : IsScalarTower C[X] (RatFunc C) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra C[X] B := + RingHom.toAlgebra + ((algebraMap S[X] B).comp (algebraMap C[X] S[X])) + letI : SMul C[X] B := Algebra.toSMul + letI : Module C[X] B := Algebra.toModule + letI : IsScalarTower C[X] S[X] B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower S[X] B L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S[X] (RatFunc S) := + finiteDifferentCanonicalRatFuncPolynomialAlgebra S + letI : IsFractionRing S[X] (RatFunc S) := + finiteDifferentCanonicalRatFuncPolynomialFractionRing S + letI : IsScalarTower S[X] (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] L p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : IsScalarTower C[X] S[X] L := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap (RatFunc C) L + (algebraMap C[X] (RatFunc C) p) = + algebraMap S[X] L (algebraMap C[X] S[X] p) + rw [IsScalarTower.algebraMap_apply S[X] (RatFunc S) L] + rw [rationalBase_algebraMap_eq C S N hExact] + apply congrArg (algebraMap (RatFunc S) L) + exact ratFuncCoefficientAlgHom_algebraMap C S p) + letI : IsScalarTower C[X] B L := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap C[X] L p = + algebraMap S[X] L (algebraMap C[X] S[X] p) + exact IsScalarTower.algebraMap_apply C[X] S[X] L p) + letI : SMul C[X] S[X] := Algebra.toSMul + letI : Module C[X] S[X] := Algebra.toModule + letI : Module.Finite C[X] (C[X] ⊗[C] S) := + Module.Finite.base_change C C[X] S + letI : Module.Finite C[X] S[X] := + Module.Finite.equiv + (Algebra.IsPushout.equiv C C[X] S S[X]).toLinearEquiv + letI : Module.IsTorsionFree C[X] S[X] := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective (Polynomial.map (algebraMap C S)) + exact Polynomial.map_injective (algebraMap C S) (algebraMap C S).injective + letI : Module.Free C[X] S[X] := + Module.free_of_finite_type_torsion_free' + letI : Module.IsTorsionFree S[X] L := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro p q hpq + apply RatFunc.algebraMap_injective S + apply (algebraMap (RatFunc S) L).injective + simpa only [IsScalarTower.algebraMap_apply S[X] (RatFunc S) L] + using hpq + letI : FiniteDimensional (RatFunc S) L := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) L := + isSeparable_over_extendedRatFunc C S N hExact + let eNL := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := + Module.Finite.base_change C N S + letI : Module.Finite N L := Module.Finite.equiv eNL + letI : FiniteDimensional (RatFunc C) L := + Module.Finite.trans N L + letI : Algebra.IsSeparable (RatFunc C) L := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let f₁ : RatFunc S →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L + let f₂ : N →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) N L + let F₁ : IntermediateField (RatFunc C) L := f₁.fieldRange + let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange + let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange + let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange + letI : Algebra S[X] F₁ := + RingHom.toAlgebra + (e₁.toRingEquiv.toRingHom.comp (algebraMap S[X] (RatFunc S))) + letI : SMul S[X] F₁ := Algebra.toSMul + letI : Module S[X] F₁ := Algebra.toModule + let e₁poly : RatFunc S ≃ₐ[S[X]] F₁ := + { e₁.toRingEquiv with commutes' := fun _ => rfl } + letI : IsFractionRing S[X] F₁ := + IsFractionRing.of_algEquiv e₁poly + letI : Module.IsTorsionFree S[X] F₁ := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact IsFractionRing.injective S[X] F₁ + letI : Algebra R₂ F₂ := + RingHom.toAlgebra + (e₂.toRingEquiv.toRingHom.comp (algebraMap R₂ N)) + letI : SMul R₂ F₂ := Algebra.toSMul + letI : Module R₂ F₂ := Algebra.toModule + let e₂norm : N ≃ₐ[R₂] F₂ := + { e₂.toRingEquiv with commutes' := fun _ => rfl } + letI : Algebra R₂ L := + RingHom.toAlgebra + ((algebraMap F₂ L).comp (algebraMap R₂ F₂)) + letI : SMul R₂ L := Algebra.toSMul + letI : Module R₂ L := Algebra.toModule + letI : IsScalarTower R₂ F₂ L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing R₂ N := + IsIntegralClosure.isFractionRing_of_finite_extension + C[X] (RatFunc C) N R₂ + letI : IsFractionRing R₂ F₂ := + IsFractionRing.of_algEquiv e₂norm + letI : Algebra C[X] F₂ := IntermediateField.algebra' F₂ + letI : SMul C[X] F₂ := Algebra.toSMul + letI : IsScalarTower C[X] R₂ F₂ := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + apply Subtype.ext + change algebraMap (RatFunc C) L + (algebraMap C[X] (RatFunc C) p) = + algebraMap N L (algebraMap C[X] N p) + rw [IsScalarTower.algebraMap_apply C[X] (RatFunc C) N] + exact IsScalarTower.algebraMap_apply (RatFunc C) N L _) + letI : IsScalarTower C[X] F₂ L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower C[X] R₂ L := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap C[X] L p = + algebraMap F₂ L + (algebraMap R₂ F₂ (algebraMap C[X] R₂ p)) + rw [← IsScalarTower.algebraMap_apply C[X] R₂ F₂] + exact IsScalarTower.algebraMap_apply C[X] F₂ L p) + letI : IsLocalization + (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors C[X])) N := + IsIntegralClosure.isLocalization C[X] (RatFunc C) N R₂ + letI : IsLocalization + (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors C[X])) F₂ := + IsLocalization.isLocalization_of_algEquiv _ e₂norm + letI : Algebra R₂ (S ⊗[C] R₂) := + Algebra.TensorProduct.rightAlgebra + letI : SMul R₂ (S ⊗[C] R₂) := Algebra.toSMul + letI : Module R₂ (S ⊗[C] R₂) := Algebra.toModule + letI : Algebra R₂ (R₂ ⊗[C] S) := + Algebra.TensorProduct.leftAlgebra + letI : SMul R₂ (R₂ ⊗[C] S) := Algebra.toSMul + letI : Module R₂ (R₂ ⊗[C] S) := Algebra.toModule + let eSwap : R₂ ⊗[C] S ≃ₐ[R₂] S ⊗[C] R₂ := + { (Algebra.TensorProduct.comm C R₂ S).toRingEquiv with + commutes' := fun r => by + change (Algebra.TensorProduct.comm C R₂ S) + (r ⊗ₜ[C] (1 : S)) = (1 : S) ⊗ₜ[C] r + rfl } + letI : Module.Finite R₂ (R₂ ⊗[C] S) := + Module.Finite.base_change C R₂ S + letI : Module.Finite R₂ (S ⊗[C] R₂) := + Module.Finite.equiv eSwap.toLinearEquiv + let eNorm : S ⊗[C] R₂ ≃+* B := + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + letI : Algebra R₂ B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + letI : SMul R₂ B := Algebra.toSMul + letI : Module R₂ B := Algebra.toModule + let eNormR₂ : S ⊗[C] R₂ ≃ₐ[R₂] B := + { eNorm with + commutes' := fun r => by + change eNorm (1 ⊗ₜ[C] r) = + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + (1 ⊗ₜ[C] r) + rfl } + letI : Module.Finite R₂ B := + Module.Finite.equiv eNormR₂.toLinearEquiv + letI : Module.IsTorsionFree R₂ B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + (eNorm.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R₂)).toRingHom) + exact eNorm.injective.comp + (Algebra.TensorProduct.includeRight_injective + (R := C) (A := S) (B := R₂) (algebraMap C S).injective) + have hR₂BL : + (algebraMap R₂ L) = + (algebraMap B L).comp (algebraMap R₂ B) := by + ext r + change (1 : S) ⊗ₜ[C] (r : N) = + (((finiteFieldConstantExtensionIntegralClosureRingEquiv + C S N) (1 ⊗ₜ[C] r) : B) : L) + exact + (finiteFieldConstantExtensionIntegralClosureRingEquiv_tmul + C S N 1 r).symm + letI : IsScalarTower R₂ B L := + IsScalarTower.of_algebraMap_eq' hR₂BL + letI : IsScalarTower C[X] R₂ B := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + apply Subtype.ext + calc + algebraMap B L (algebraMap C[X] B p) = + algebraMap B L + (algebraMap S[X] B (algebraMap C[X] S[X] p)) := rfl + _ = algebraMap S[X] L (algebraMap C[X] S[X] p) := + (IsScalarTower.algebraMap_apply S[X] B L _).symm + _ = algebraMap C[X] L p := + (IsScalarTower.algebraMap_apply C[X] S[X] L p).symm + _ = algebraMap R₂ L (algebraMap C[X] R₂ p) := + IsScalarTower.algebraMap_apply C[X] R₂ L p + _ = algebraMap B L + (algebraMap R₂ B (algebraMap C[X] R₂ p)) := + IsScalarTower.algebraMap_apply R₂ B L _) + letI : Module.Finite C[X] R₂ := + IsIntegralClosure.finite C[X] (RatFunc C) N R₂ + letI : Module.IsTorsionFree C[X] N := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) N).injective.comp + (RatFunc.algebraMap_injective C) + letI : Module.IsTorsionFree C[X] R₂ := + IsIntegralClosure.isTorsionFree C[X] N + letI : Module.Free C[X] R₂ := + Module.free_of_finite_type_torsion_free' + letI : Module.Finite C[X] B := Module.Finite.trans R₂ B + letI : Module.IsTorsionFree C[X] B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + intro p q hpq + have hinj : Function.Injective (algebraMap C[X] L) := by + change Function.Injective + ((algebraMap (RatFunc C) L).comp + (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) L).injective.comp + (RatFunc.algebraMap_injective C) + apply hinj + simpa only [IsScalarTower.algebraMap_apply C[X] B L] + using congrArg (algebraMap B L) hpq + letI : FaithfulSMul C[X] B := by + rw [faithfulSMul_iff_algebraMap_injective] + exact Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree C[X] B from inferInstance) + letI : IsScalarTower S[X] F₁ L := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] L p = f₁ (algebraMap S[X] (RatFunc S) p) + exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : Algebra.IsSeparable (RatFunc C) F₂ := inferInstance + letI : Algebra.IsSeparable F₁ L := inferInstance + letI : IsIntegralClosure B S[X] L := inferInstance + letI : IsFractionRing B L := + IsIntegralClosure.isFractionRing_of_finite_extension S[X] F₁ L B + letI : Algebra C[X] (FractionRing C[X]) := + finiteDifferentCanonicalFractionRingAlgebra C[X] + letI : SMul C[X] (FractionRing C[X]) := Algebra.toSMul + letI : IsFractionRing C[X] (FractionRing C[X]) := + finiteDifferentCanonicalFractionRing C[X] + letI : Algebra B (FractionRing B) := + finiteDifferentCanonicalFractionRingAlgebra B + letI : SMul B (FractionRing B) := Algebra.toSMul + letI : IsFractionRing B (FractionRing B) := + finiteDifferentCanonicalFractionRing B + letI : Algebra C[X] (FractionRing B) := + RingHom.toAlgebra + ((algebraMap B (FractionRing B)).comp (algebraMap C[X] B)) + letI : SMul C[X] (FractionRing B) := Algebra.toSMul + letI : IsScalarTower C[X] B (FractionRing B) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FaithfulSMul C[X] (FractionRing B) := by + rw [faithfulSMul_iff_algebraMap_injective] + change Function.Injective + ((algebraMap B (FractionRing B)).comp (algebraMap C[X] B)) + exact (IsFractionRing.injective B (FractionRing B)).comp + (FaithfulSMul.algebraMap_injective C[X] B) + letI : Algebra (FractionRing C[X]) (FractionRing B) := + FractionRing.liftAlgebra C[X] (FractionRing B) + letI : SMul (FractionRing C[X]) (FractionRing B) := Algebra.toSMul + letI : IsScalarTower C[X] (FractionRing C[X]) (FractionRing B) := + FractionRing.isScalarTower_liftAlgebra C[X] (FractionRing B) + letI : Algebra.IsSeparable (FractionRing C[X]) (FractionRing B) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv C[X] (RatFunc C)).symm.toRingEquiv + (FractionRing.algEquiv B L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv C[X] (RatFunc C)).symm + (FractionRing.algEquiv B L).symm z + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain S[X] F₁ L B + letI : IsDedekindDomain R₂ := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R₂ + letI : Module.Finite S[X] B := + IsIntegralClosure.finite S[X] F₁ L B + letI : Module.IsTorsionFree S[X] B := + IsIntegralClosure.isTorsionFree S[X] L + have hranges := + exactConstantExtension_rationalFunctionRanges_linearDisjoint C S N hExact + have hdisjoint : F₁.LinearDisjoint F₂ := by + exact hranges.1 + have hsup : F₁ ⊔ F₂ = ⊤ := by + exact hranges.2 + have hcoprime : + IsCoprime + ((differentIdeal C[X] S[X]).map (algebraMap S[X] B)) + ((differentIdeal C[X] R₂).map (algebraMap R₂ B)) := by + rw [finiteFieldPolynomial_differentIdeal_eq_top C S] + rw [Ideal.map_top] + apply Ideal.isCoprime_iff_sup_eq.mpr + exact top_sup_eq + (Ideal.map (algebraMap R₂ B) (differentIdeal C[X] R₂)) + letI : IsScalarTower C[X] F₂ L := + IsScalarTower.of_algebraMap_eq' rfl + exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal + (K := RatFunc C) (L := L) (F₁ := F₁) (F₂ := F₂) + C[X] B S[X] R₂ hdisjoint hsup hcoprime + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean new file mode 100644 index 0000000000..063a6d40f0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean @@ -0,0 +1,453 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality + +/-! +# Finite places of an exact constant extension + +This file embeds the enlarged constant field into the finite normalization +over the original polynomial ring. The canonical constant quotient is +compatible with the resulting Galois action. Consequently, at every finite +place whose residue field has degree one over the enlarged constants, the +kernel of constant restriction on the decomposition group is exactly inertia. +-/ + +open scoped Pointwise Polynomial TensorProduct + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable (C N S : Type*) [Field C] [Field N] [Field S] + [Algebra C N] [Algebra (RatFunc C) N] + [IsScalarTower C (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +section Exact + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +omit [FiniteDimensional C S] [IsGalois C S] in +private theorem exactConstantExtension_polynomialTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra C[X] (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap C[X] (RatFunc C))) + IsScalarTower C C[X] (ExactConstantExtension C N S) := by + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra C[X] (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap C[X] (RatFunc C))) + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap C (S ⊗[C] N) c = (1 : S) ⊗ₜ[C] + algebraMap (RatFunc C) N + (algebraMap C[X] (RatFunc C) (Polynomial.C c)) + rw [RatFunc.algebraMap_C] + change algebraMap C S c ⊗ₜ[C] (1 : N) = + (1 : S) ⊗ₜ[C] + algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) + rw [← IsScalarTower.algebraMap_apply C (RatFunc C) N] + exact Algebra.TensorProduct.tmul_one_eq_one_tmul c + +/-- The enlarged constants map into the finite normalization. -/ +noncomputable def exactConstantExtensionConstantToFiniteIntegralClosureRingHom : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + S →+* RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra C[X] (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C C[X] (ExactConstantExtension C N S) := + exactConstantExtension_polynomialTower C N S + let f : S →ₐ[C] ExactConstantExtension C N S := + Algebra.TensorProduct.includeLeft + exact + { toFun := fun s => + ⟨f s, by + have hs : IsIntegral C s := Algebra.IsIntegral.isIntegral s + exact (hs.map f).tower_top⟩ + map_one' := by ext; exact map_one f + map_mul' := fun x y => by ext; exact map_mul f x y + map_zero' := by ext; exact map_zero f + map_add' := fun x y => by ext; exact map_add f x y + } + +/-- The `S`-algebra structure on the finite normalization induced by the +embedded enlarged constants. -/ +@[reducible] noncomputable def exactConstantExtensionFiniteIntegralClosureConstantAlgebra : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + (exactConstantExtensionConstantToFiniteIntegralClosureRingHom C N S hExact) + +theorem exactConstantExtensionFiniteIntegralClosure_algebraMap_val (s : S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + ((algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) s) : ExactConstantExtension C N S) = + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N)) s := by + rfl + +section FullGroup + +variable (L : Type*) [Field L] + [Algebra C L] [Algebra L N] [IsScalarTower C L N] + [Algebra (RatFunc C) L] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [IsScalarTower (RatFunc C) L N] + [FiniteDimensional L N] [IsGalois L N] + +omit [IsScalarTower C (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] + [Algebra C L] [IsScalarTower C L N] + [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional L N] [IsGalois L N] in +private theorem exactConstantExtension_ratFuncBaseTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + apply IsScalarTower.of_algebraMap_eq' + ext x + change (1 : S) ⊗ₜ[C] algebraMap (RatFunc C) N x = + (1 : S) ⊗ₜ[C] algebraMap L N (algebraMap (RatFunc C) L x) + congr 1 + exact IsScalarTower.algebraMap_apply (RatFunc C) L N x + +omit [Algebra.IsSeparable (RatFunc C) L] in +theorem exactConstantExtensionConstantQuotient_action_on_finiteNormalization + : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtension_ratFuncBaseTower C N S L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + ∀ (g : ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) (s : S), + g • algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) s = + algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) + (exactConstantExtensionConstantQuotient C L N S hExact g s) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + exactConstantExtension_ratFuncBaseTower C N S L + letI : Algebra C[X] L := + RingHom.toAlgebra + ((algebraMap (RatFunc C) L).comp (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C[X] (RatFunc C) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra C[X] (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C[X] (RatFunc C) + (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + letI : Algebra (RatFuncFiniteIntegralClosure C L) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + (finiteIntegralClosureMap C L (ExactConstantExtension C N S)).toAlgebra + letI : IsScalarTower (RatFuncFiniteIntegralClosure C L) L + (ExactConstantExtension C N S) := inferInstance + letI : Algebra.IsIntegral C[X] (RatFuncFiniteIntegralClosure C L) := + IsIntegralClosure.isIntegral_algebra C[X] L + letI : IsScalarTower C[X] (RatFuncFiniteIntegralClosure C L) + (ExactConstantExtension C N S) := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc C) (ExactConstantExtension C N S) + (algebraMap C[X] (RatFunc C) x) = + algebraMap L (ExactConstantExtension C N S) + (algebraMap (RatFunc C) L (algebraMap C[X] (RatFunc C) x)) + exact IsScalarTower.algebraMap_apply (RatFunc C) L + (ExactConstantExtension C N S) _ + letI : IsScalarTower (RatFuncFiniteIntegralClosure C L) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) + (ExactConstantExtension C N S) := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) + (ExactConstantExtension C N S) + (algebraMap (RatFuncFiniteIntegralClosure C L) + (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) r) = + algebraMap (RatFuncFiniteIntegralClosure C L) + (ExactConstantExtension C N S) r by rfl] + ring⟩ + letI : IsIntegralClosure + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) + (RatFuncFiniteIntegralClosure C L) + (ExactConstantExtension C N S) := + IsIntegralClosure.tower_top (R := C[X]) + intro g s + apply Subtype.ext + calc + ((g • algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) s : + RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + g ((algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) s : + RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + exact algebraMap_galRestrict'_apply + (RatFuncFiniteIntegralClosure C L) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) + g.toAlgHom _ + _ = (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N)) + (exactConstantExtensionConstantQuotient C L N S hExact g s) := by + rw [exactConstantExtensionFiniteIntegralClosure_algebraMap_val] + exact exactConstantExtensionConstantQuotient_action_on_constants + C L N S hExact g s + _ = ((algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) + (exactConstantExtensionConstantQuotient C L N S hExact g s) : + RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + rw [exactConstantExtensionFiniteIntegralClosure_algebraMap_val] + +/-- On a residue-degree-one finite place, the kernel of constant restriction +on the decomposition group is inertia. -/ +theorem exactConstantExtensionFinitePlace_stabilizerRestriction_ker_eq_inertia + : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtension_ratFuncBaseTower C N S L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + ∀ (Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S)), + Module.finrank S Q.asIdeal.ResidueField = 1 → + ((exactConstantExtensionConstantQuotient C L N S hExact).comp + (MulAction.stabilizer + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) Q.asIdeal).subtype).ker = + Q.asIdeal.inertia + (MulAction.stabilizer + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) Q.asIdeal) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + exactConstantExtension_ratFuncBaseTower C N S L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Module.Finite (RatFunc C) N := Module.Finite.trans L N + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := + Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + letI : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + letI : Algebra C[X] (ExactConstantExtension C N S) := + RingHom.toAlgebra + ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp + (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C[X] (RatFunc C) + (ExactConstantExtension C N S) := + IsScalarTower.of_algebraMap_eq' rfl + intro Q hdegree + letI : Algebra.IsSeparable L (ExactConstantExtension C N S) := + IsGalois.to_isSeparable + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + Algebra.IsSeparable.trans (RatFunc C) L + (ExactConstantExtension C N S) + letI : IsDedekindDomain (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := inferInstance + letI : Q.asIdeal.IsMaximal := Q.isMaximal + exact stabilizerRestriction_ker_eq_inertia_of_residue_finrank_one + Q.asIdeal (exactConstantExtensionConstantQuotient C L N S hExact) + (exactConstantExtensionConstantQuotient_action_on_finiteNormalization + C N S hExact L) hdegree + +section FiniteConstants + +variable [Fintype C] [DecidableEq C] [DecidableEq (RatFunc C)] + +/-- The decomposition-group cardinality required by Frobenius-coset +averaging, specialized to the exact constant extension. -/ +theorem exactConstantExtensionFinitePlace_decompositionGroup_card + : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtension_ratFuncBaseTower C N S L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + ∀ (Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S)), + Module.finrank S Q.asIdeal.ResidueField = 1 → + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = + Module.finrank C S → + finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L (ExactConstantExtension C N S) Q)) = 1 → + Nat.card (finitePlaceDecompositionGroup C L + (ExactConstantExtension C N S) Q) = + Nat.card + ((exactConstantExtensionConstantQuotient C L N S hExact).comp + (finitePlaceDecompositionGroup C L + (ExactConstantExtension C N S) Q).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + exactConstantExtension_ratFuncBaseTower C N S L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Module.Finite (RatFunc C) N := Module.Finite.trans L N + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := + Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + letI : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + letI : Algebra.IsSeparable L (ExactConstantExtension C N S) := + IsGalois.to_isSeparable + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + Algebra.IsSeparable.trans (RatFunc C) L + (ExactConstantExtension C N S) + intro Q hResidue hTop hBase + have hker := + exactConstantExtensionFinitePlace_stabilizerRestriction_ker_eq_inertia + C N S hExact L Q hResidue + exact + finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut + C L (ExactConstantExtension C N S) S + (exactConstantExtensionConstantQuotient C L N S hExact) + Q hTop hBase hker + +end FiniteConstants + +end FullGroup + +end Exact + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean new file mode 100644 index 0000000000..ab473f051a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -0,0 +1,952 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting + +/-! +# Compatibility of the two finite-place models in a constant extension + +The explicit constant-extension normalization is naturally a normalization +over `S[X]`, whereas the relative Galois action is implemented on the +normalization over `C[X]`. This file identifies the corresponding finite +places and their residue fields. In particular, an `S`-rational place has +absolute `C`-degree `[S : C]`, in precisely the model used by the +decomposition-group theorem. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +/-- The equality-transport normalization equivalence does not change the +underlying element of the ambient function field. -/ +private theorem integralClosureAlgEquivRatFuncFiniteOfEq_coe + {k T : Type*} [Field k] [Field T] [Algebra (RatFunc k) T] + (a : Algebra k[X] T) + (h : ratFuncInducedPolynomialAlgebra k T = a) + (x : letI := a; integralClosure k[X] T) : + letI := a + (((integralClosureAlgEquivRatFuncFiniteOfEq k T a h) x : + RatFuncFiniteIntegralClosure k T) : T) = x := by + subst a + rfl + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance compatibilityBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance compatibilityBasePolynomialAlgebra : Algebra C[X] N := + bridgeBasePolynomialAlgebra C N + +local instance compatibilityBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance compatibilityBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + bridgeBaseConstantPolynomialTower C N + +local instance compatibilityPolynomialCoefficientAlgebra : + Algebra C[X] S[X] := + (Polynomial.mapRingHom (algebraMap C S)).toAlgebra + +local instance compatibilityRatFuncCoefficientAlgebra : + Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + +local instance compatibilityTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +local instance compatibilityTensorNormalizationPolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + bridgeTensorNormalizationPolynomialAlgebra C S N + +local instance compatibilityOldNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + +/-- The two normalization equivalences used by the residue and polynomial +models have the same underlying map. -/ +private theorem finiteFieldConstantExtensionIntegralClosureAlgEquiv_apply_eq_polynomial + (z : S ⊗[C] integralClosure C[X] N) : + finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N z = + finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N z := by + induction z using TensorProduct.induction_on with + | zero => exact map_zero _ + | tmul s a => + apply Subtype.ext + rw [finiteFieldConstantExtensionIntegralClosureAlgEquiv_tmul, + finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv_tmul] + | add x y hx hy => + calc + finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N (x + y) = + finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N x + + finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N y := + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).map_add x y + _ = finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N x + + finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N y := by + rw [hx, hy] + _ = finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N (x + y) := + ((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N).map_add x y).symm + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +include hExact + +/-- The exact constant extension is finite over the original rational +function field. This is the finite-dimensional input needed to compare its +`C[X]`- and `S[X]`-normalizations. -/ +theorem finiteDimensional_exactConstantExtension_over_baseRatFunc : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + exact Module.Finite.trans N (ExactConstantExtension C N S) + +/-- Polynomial coefficient extension is compatible with the two canonical +rational-function embeddings into the exact constant extension. -/ +theorem exactConstantExtension_ratFunc_polynomialCompatibility + (p : C[X]) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + algebraMap (RatFunc C) (ExactConstantExtension C N S) + (algebraMap C[X] (RatFunc C) p) = + algebraMap (RatFunc S) (ExactConstantExtension C N S) + (algebraMap S[X] (RatFunc S) (algebraMap C[X] S[X] p)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + rw [rationalBase_algebraMap_eq C S N hExact] + apply congrArg (algebraMap (RatFunc S) (ExactConstantExtension C N S)) + exact ratFuncCoefficientAlgHom_algebraMap C S p + +/-- The finite place over `C` corresponding to a place in the explicit +`S[X]`-normalization. Extending its constants back to `S` recovers the +finite place constructed in `ConstantExtensionFinitePlaceBridge`. -/ +noncomputable def exactConstantExtensionCompatibleBaseFinitePlace + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + FiniteExtensionFinitePlace C (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exact (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact))).symm + (exactConstantExtensionUpstairsFinitePlace C S N hExact q) + +@[simp] +theorem exactConstantExtensionCompatibleBaseFinitePlace_baseChange + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact)) + (exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q) = + exactConstantExtensionUpstairsFinitePlace C S N hExact q := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + exact Equiv.apply_symm_apply _ _ + +/-- The identity equivalence between the `C[X]`- and `S[X]`-normalizations +is linear over the enlarged constant field. -/ +noncomputable def exactConstantExtensionFiniteClosureBaseChangeAlgEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra + C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S) ≃ₐ[S] + RatFuncFiniteIntegralClosure S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + exact { ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact) with + commutes' := fun s => by + apply Subtype.ext + change + ((algebraMap S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) s : + RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + ((algebraMap S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) s : + RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) + rw [exactConstantExtensionFiniteIntegralClosure_algebraMap_val] + change (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N)) s = + algebraMap (RatFunc S) (ExactConstantExtension C N S) + (algebraMap S[X] (RatFunc S) (Polynomial.C s)) + change (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N)) s = + (ratFuncToExactConstantExtension C S N hExact) + (algebraMap S (RatFunc S) s) + exact (ratFuncToExactConstantExtension C S N hExact).commutes s |>.symm } + +/-- The actual upstairs finite place is exactly the transport of the +presented prime along the equality bridge from the compatible polynomial +normalization to the canonical rational-function normalization. -/ +theorem exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTransport + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + let e := integralClosureAlgEquivRatFuncFiniteOfAlgebraMap + S (ExactConstantExtension C N S) + (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncToExactConstantExtension_algebraMap C S N hExact) + exactConstantExtensionUpstairsFinitePlace C S N hExact q = + heightOneSpectrumEquivOfAlgEquiv e q := by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + let e := integralClosureAlgEquivRatFuncFiniteOfAlgebraMap + S E (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncToExactConstantExtension_algebraMap C S N hExact) + let eNorm := exactConstantExtensionNormalizationAlgEquiv C S N hExact + let qTensor := exactConstantExtensionTensorNormalizationHeightOne C S N q + have hNormalizationToPolynomial + (z : S ⊗[C] integralClosure C[X] N) : + ((eNorm z : RatFuncFiniteIntegralClosure S E) : E) = + ((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv + C S N z : integralClosure S[X] E) : E) := by + simp [eNorm, exactConstantExtensionNormalizationAlgEquiv, + normalizationAlgEquivRatFuncFiniteOfAlgebraMap, + integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] + rw [integralClosureAlgEquivRatFuncFiniteOfEq_coe] + rfl + apply IsDedekindDomain.HeightOneSpectrum.ext + have hActualIdeal : + (exactConstantExtensionUpstairsFinitePlace + C S N hExact q).asIdeal = + qTensor.asIdeal.comap eNorm.symm := rfl + have hDirectIdeal : + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal = + q.asIdeal.comap e.symm := rfl + rw [hActualIdeal, hDirectIdeal] + rw [show qTensor.asIdeal = q.asIdeal.comap + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N) by rfl] + ext x + change finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N + (eNorm.symm x) ∈ q.asIdeal ↔ e.symm x ∈ q.asIdeal + rw [show finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N + (eNorm.symm x) = e.symm x by + apply Subtype.ext + calc + ((finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N + (eNorm.symm x) : integralClosure S[X] E) : E) = + ((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv + C S N (eNorm.symm x) : integralClosure S[X] E) : E) := + congrArg Subtype.val + (finiteFieldConstantExtensionIntegralClosureAlgEquiv_apply_eq_polynomial + C S N (eNorm.symm x)) + _ = ((eNorm (eNorm.symm x) : RatFuncFiniteIntegralClosure S E) : E) := + (hNormalizationToPolynomial (eNorm.symm x)).symm + _ = (x : E) := congrArg Subtype.val (eNorm.apply_symm_apply x) + _ = ((e.symm x : integralClosure S[X] E) : E) := by + calc + (x : E) = ((e (e.symm x) : RatFuncFiniteIntegralClosure S E) : E) := + congrArg Subtype.val (e.apply_symm_apply x).symm + _ = ((e.symm x : integralClosure S[X] E) : E) := + integralClosureAlgEquivRatFuncFiniteOfEq_coe + (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncInducedPolynomialAlgebra_eq S E + (constantExtensionTensorPolynomialAlgebra C S N) + (ratFuncToExactConstantExtension_algebraMap C S N hExact)) + (e.symm x)] + +/-- Corresponding finite places have equivalent residue fields as +`S`-algebras, even though the source place is represented in the +`C[X]`-normalization. -/ +noncomputable def exactConstantExtensionCompatibleResidueFieldAlgEquiv + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra + C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + (exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q).asIdeal.ResidueField + ≃ₐ[S] + (exactConstantExtensionUpstairsFinitePlace C S N hExact q).asIdeal.ResidueField := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + let e := exactConstantExtensionFiniteClosureBaseChangeAlgEquiv + C S N hExact + let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q + apply Ideal.residueFieldAlgEquiv Q.asIdeal + (exactConstantExtensionUpstairsFinitePlace C S N hExact q).asIdeal e + change Q.asIdeal = + (exactConstantExtensionUpstairsFinitePlace C S N hExact q).asIdeal.comap e + rfl + +/-- The two representations of the upstairs place have the same residue +degree over the enlarged constants. -/ +theorem exactConstantExtensionCompatibleResidueField_finrank_eq + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra + C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + Module.finrank S + (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q).asIdeal.ResidueField = + Module.finrank S + (exactConstantExtensionUpstairsFinitePlace + C S N hExact q).asIdeal.ResidueField := + by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + exact (exactConstantExtensionCompatibleResidueFieldAlgEquiv + C S N hExact q).toLinearEquiv.finrank_eq + +/-- An `S`-rational place in the explicit normalization has absolute +`C`-degree `[S : C]` in the finite-place model used by the Galois action. -/ +theorem exactConstantExtensionCompatibleBaseFinitePlace_degree_eq + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) + : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + finiteExtensionPlaceDegree S + (ExactConstantExtension C N S) + (.inl (exactConstantExtensionUpstairsFinitePlace + C S N hExact q)) = 1 → + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) + (.inl (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q)) = Module.finrank C S := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + intro hRational + rw [finiteExtensionFinitePlace_degree_baseChange C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility + C S N hExact)] + rw [exactConstantExtensionCompatibleBaseFinitePlace_baseChange, + hRational, Nat.mul_one] + +/-- Restricting the compatible `C[X]`-place to the original function field +recovers the downstairs place obtained by contracting the explicit constant +extension ideal. -/ +theorem exactConstantExtensionCompatibleBaseFinitePlace_under_original + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + finitePlaceUnder C N (ExactConstantExtension C N S) + (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q) = + exactConstantExtensionDownstairsFinitePlace C S N hExact q := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + apply IsDedekindDomain.HeightOneSpectrum.ext + ext x + rw [finitePlaceUnder_asIdeal, + exactConstantExtensionDownstairsFinitePlace_asIdeal] + change finiteIntegralClosureMap C N (ExactConstantExtension C N S) x ∈ + (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q).asIdeal ↔ + finiteFieldConstantExtensionIntegralClosureRingHom C S N x ∈ q.asIdeal + let eBase := ratFuncFiniteIntegralClosureRingEquiv C S + (ExactConstantExtension C N S) + (exactConstantExtension_ratFunc_polynomialCompatibility C S N hExact) + let Qs := exactConstantExtensionUpstairsFinitePlace C S N hExact q + have hBaseIdeal : + (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q).asIdeal = Qs.asIdeal.comap eBase := rfl + rw [hBaseIdeal] + change eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x) ∈ Qs.asIdeal ↔ + finiteFieldConstantExtensionIntegralClosureRingHom C S N x ∈ q.asIdeal + let qTensor := exactConstantExtensionTensorNormalizationHeightOne C S N q + let eNorm := exactConstantExtensionNormalizationAlgEquiv C S N hExact + have hTargetIdeal : Qs.asIdeal = qTensor.asIdeal.comap eNorm.symm := rfl + rw [hTargetIdeal] + change eNorm.symm (eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x)) ∈ qTensor.asIdeal ↔ + finiteFieldConstantExtensionIntegralClosureRingHom C S N x ∈ q.asIdeal + let eTensor := finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N + have hTensorIdeal : qTensor.asIdeal = q.asIdeal.comap eTensor := rfl + rw [hTensorIdeal] + change eTensor (eNorm.symm (eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x))) ∈ q.asIdeal ↔ + finiteFieldConstantExtensionIntegralClosureRingHom C S N x ∈ q.asIdeal + have hNormalizationToPolynomial + (z : S ⊗[C] integralClosure C[X] N) : + ((eNorm z : RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + ((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv + C S N z : integralClosure S[X] + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + simp [eNorm, exactConstantExtensionNormalizationAlgEquiv, + normalizationAlgEquivRatFuncFiniteOfAlgebraMap, + integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] + rw [integralClosureAlgEquivRatFuncFiniteOfEq_coe] + rfl + have hNormalizationMapsAgree + (z : S ⊗[C] integralClosure C[X] N) : + ((eTensor z : integralClosure S[X] (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + ((eNorm z : RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + calc + ((eTensor z : integralClosure S[X] + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + ((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv + C S N z : integralClosure S[X] + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := + congrArg Subtype.val + (finiteFieldConstantExtensionIntegralClosureAlgEquiv_apply_eq_polynomial + C S N z) + _ = ((eNorm z : RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := (hNormalizationToPolynomial z).symm + rw [show eTensor (eNorm.symm (eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x))) = + finiteFieldConstantExtensionIntegralClosureRingHom C S N x by + apply Subtype.ext + calc + ((eTensor (eNorm.symm (eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x))) : + integralClosure S[X] (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + ((eNorm (eNorm.symm (eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x))) : + RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := + hNormalizationMapsAgree _ + _ = ((eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x) : + RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + rw [eNorm.apply_symm_apply] + _ = ((finiteFieldConstantExtensionIntegralClosureRingHom C S N x : + integralClosure S[X] (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + calc + ((eBase (finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x) : + RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) = + ((finiteIntegralClosureMap C N + (ExactConstantExtension C N S) x : + RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := by + rfl + _ = (1 : S) ⊗ₜ[C] (x : N) := by rfl + _ = ((finiteFieldConstantExtensionIntegralClosureRingHom C S N x : + integralClosure S[X] (ExactConstantExtension C N S)) : + ExactConstantExtension C N S) := + (finiteFieldConstantExtensionIntegralClosureRingHom_coe + C S N x).symm] + +section IntermediateField + +variable (L : Type*) [Field L] + [Algebra (RatFunc C) L] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [Algebra L N] [IsScalarTower (RatFunc C) L N] + [FiniteDimensional L N] [IsGalois L N] + +local instance compatibilityIntermediateConstantAlgebra : Algebra C L := + RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp + (algebraMap C (RatFunc C))) + +local instance compatibilityConstantIntermediateTopTower : + IsScalarTower C L N := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap L N + (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) + exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ + +/-- The rational-function base, an intermediate field, and the exact +constant extension form the tower used by the relative Galois action. -/ +private theorem exactConstantExtensionCompatibility_ratFuncBaseTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + apply IsScalarTower.of_algebraMap_eq' + ext x + change (1 : S) ⊗ₜ[C] algebraMap (RatFunc C) N x = + (1 : S) ⊗ₜ[C] algebraMap L N (algebraMap (RatFunc C) L x) + congr 1 + exact IsScalarTower.algebraMap_apply (RatFunc C) L N x + +/-- For an actual finite place in the constant-extended normalization, a +rational restriction to `L` and divisibility `[N : L] ∣ [S : C]` imply the +decomposition-group cardinality identity. The residue-degree-one, absolute +top-degree, and rational-base hypotheses of the generic theorem are all +derived internally. -/ +theorem exactConstantExtensionFinitePlace_decompositionGroup_card_of_rational_base + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) + (hBase : finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L N + (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) = 1) + (hDegreeDiv : Module.finrank L N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionCompatibility_ratFuncBaseTower C S N hExact L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + let Q := exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q + Nat.card (finitePlaceDecompositionGroup C L + (ExactConstantExtension C N S) Q) = + Nat.card + ((exactConstantExtensionConstantQuotient C L N S hExact).comp + (finitePlaceDecompositionGroup C L + (ExactConstantExtension C N S) Q).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionCompatibility_ratFuncBaseTower C S N hExact L + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsScalarTower L N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C L N S + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc S) + (ExactConstantExtension C N S) := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) + (ExactConstantExtension C N S) := + isSeparable_over_extendedRatFunc C S N hExact + letI : Algebra S (RatFuncFiniteIntegralClosure C + (ExactConstantExtension C N S)) := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : Algebra S (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S)) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S + (ExactConstantExtension C N S))).comp (algebraMap S S[X])) + letI : MulSemiringAction + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := + finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + let P₀ := finitePlaceUnder C L N P + let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q + let Qs := exactConstantExtensionUpstairsFinitePlace C S N hExact q + have hInertiaDiv : finitePlaceRelativeInertiaDeg C L N P ∣ + Module.finrank L N := by + let PInFiber : FinitePlaceUnderFiber C L N P₀ := ⟨P, rfl⟩ + have hFiber := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + C L N P₀ PInFiber + refine ⟨Fintype.card (FinitePlaceUnderFiber C L N P₀) * + finitePlaceRelativeRamificationIdx C L N P, ?_⟩ + simpa [PInFiber, Nat.mul_comm, Nat.mul_left_comm, Nat.mul_assoc] + using hFiber.symm + have hDownDegreeEq : finiteExtensionPlaceDegree C N (.inl P) = + finitePlaceRelativeInertiaDeg C L N P := by + have hDegree := finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg + C L N P + simpa [P₀, P, hBase] using hDegree + have hDownDegreeDiv : finiteExtensionPlaceDegree C N (.inl P) ∣ + Module.finrank C S := by + rw [hDownDegreeEq] + exact hInertiaDiv.trans hDegreeDiv + have hUpstairsRational : + finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inl Qs) = 1 := by + rw [show finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inl Qs) = + finiteExtensionPlaceDegree C N (.inl P) / + Nat.gcd (Module.finrank C S) + (finiteExtensionPlaceDegree C N (.inl P)) by + exact exactConstantExtensionFinitePlace_degree_eq_div_gcd + C S N hExact q] + rw [(Nat.gcd_eq_right_iff_dvd).2 hDownDegreeDiv] + exact Nat.div_self + (finiteExtensionPlaceDegree_pos C N (.inl P)) + have hResidue : Module.finrank S Q.asIdeal.ResidueField = 1 := by + calc + Module.finrank S Q.asIdeal.ResidueField = + Module.finrank S Qs.asIdeal.ResidueField := + exactConstantExtensionCompatibleResidueField_finrank_eq + C S N hExact q + _ = finiteExtensionPlaceDegree S (ExactConstantExtension C N S) + (.inl Qs) := + (finiteExtensionFinitePlace_degree_eq_finrank_residueField + S (ExactConstantExtension C N S) Qs).symm + _ = 1 := hUpstairsRational + have hTop : finiteExtensionPlaceDegree C + (ExactConstantExtension C N S) (.inl Q) = Module.finrank C S := + exactConstantExtensionCompatibleBaseFinitePlace_degree_eq + C S N hExact q hUpstairsRational + let R₀ := RatFuncFiniteIntegralClosure C L + let R₁ := RatFuncFiniteIntegralClosure C N + let R₂ := RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S) + letI : Algebra R₀ R₁ := (finiteIntegralClosureMap C L N).toAlgebra + letI : Algebra R₁ R₂ := + (finiteIntegralClosureMap C N (ExactConstantExtension C N S)).toAlgebra + letI : Algebra R₀ R₂ := + (finiteIntegralClosureMap C L (ExactConstantExtension C N S)).toAlgebra + letI : SMul R₀ R₁ := Algebra.toSMul + letI : Module R₀ R₁ := Algebra.toModule + letI : SMul R₁ R₂ := Algebra.toSMul + letI : Module R₁ R₂ := Algebra.toModule + letI : SMul R₀ R₂ := Algebra.toSMul + letI : Module R₀ R₂ := Algebra.toModule + letI : IsScalarTower R₀ R₁ R₂ := by + apply IsScalarTower.of_algebraMap_eq' + ext x + change algebraMap L (ExactConstantExtension C N S) (x : L) = + algebraMap N (ExactConstantExtension C N S) + (algebraMap L N (x : L)) + exact IsScalarTower.algebraMap_apply L N + (ExactConstantExtension C N S) _ + have hUnderOriginal : finitePlaceUnder C N + (ExactConstantExtension C N S) Q = P := + exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact q + have hUnder : finitePlaceUnder C L + (ExactConstantExtension C N S) Q = finitePlaceUnder C L N P := by + apply IsDedekindDomain.HeightOneSpectrum.ext + change Q.asIdeal.under R₀ = P.asIdeal.under R₀ + calc + Q.asIdeal.under R₀ = (Q.asIdeal.under R₁).under R₀ := + (Ideal.under_under Q.asIdeal).symm + _ = P.asIdeal.under R₀ := by + rw [show Q.asIdeal.under R₁ = P.asIdeal by + exact congrArg IsDedekindDomain.HeightOneSpectrum.asIdeal + hUnderOriginal] + have hBaseTop : finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L (ExactConstantExtension C N S) Q)) = 1 := by + rw [hUnder] + exact hBase + exact exactConstantExtensionFinitePlace_decompositionGroup_card + C N S hExact L Q hResidue hTop hBaseTop + +end IntermediateField + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean new file mode 100644 index 0000000000..a75199cd6c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean @@ -0,0 +1,336 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility + +/-! +# Frobenius-coset averaging at finite places of an exact constant extension + +This file composes the actual constant-extension finite-place construction +with the Frobenius-coset form of Burnside's lemma. A rational place below +one explicit constant-extended finite place supplies the decomposition-group +cardinality at that place. Transitivity of the relative Galois action and +cyclicity of the finite-field Galois group propagate surjectivity of the +constant quotient to every stabilizer in the same restriction fiber. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +/-- In a transitive action, surjectivity of a homomorphism on one stabilizer +propagates to every stabilizer when the target is cyclic. Stabilizers in the +same orbit are conjugate, and conjugation disappears in a cyclic target. -/ +theorem MonoidHom.stabilizer_surjective_of_isPretransitive_of_isCyclic + {G A X : Type*} [Group G] [Group A] [IsCyclic A] + [MulAction G X] [MulAction.IsPretransitive G X] + (pi : G →* A) (x₀ : X) + (h₀ : Function.Surjective + (pi.comp (MulAction.stabilizer G x₀).subtype)) : + ∀ x : X, Function.Surjective + (pi.comp (MulAction.stabilizer G x).subtype) := by + letI : CommGroup A := IsCyclic.commGroup + intro x c + obtain ⟨g, hg⟩ := MulAction.exists_smul_eq G x₀ x + obtain ⟨h, hh⟩ := h₀ c + change pi (h : G) = c at hh + let h' : MulAction.stabilizer G x := + MulAction.stabilizerEquivStabilizer hg.symm h + refine ⟨h', ?_⟩ + change pi (h' : G) = c + rw [show (h' : G) = MulAut.conj g (h : G) by + exact MulAction.stabilizerEquivStabilizer_apply hg.symm h] + simpa [MulAut.conj_apply, map_mul] using hh + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance averageBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance averageBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance averageTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +section IntermediateField + +variable (L : Type*) [Field L] + [Algebra (RatFunc C) L] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [Algebra L N] [IsScalarTower (RatFunc C) L N] + [FiniteDimensional L N] [IsGalois L N] + +local instance averageIntermediateConstantAlgebra : Algebra C L := + RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp + (algebraMap C (RatFunc C))) + +local instance averageConstantIntermediateTopTower : + IsScalarTower C L N := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap L N + (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) + exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ + +/-- The rational-function base, the intermediate field, and the exact +constant extension form the tower used by the finite-place action. -/ +private theorem exactConstantExtensionFrobeniusAverage_ratFuncBaseTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + apply IsScalarTower.of_algebraMap_eq' + ext x + change (1 : S) ⊗ₜ[C] algebraMap (RatFunc C) N x = + (1 : S) ⊗ₜ[C] algebraMap L N (algebraMap (RatFunc C) L x) + congr 1 + exact IsScalarTower.algebraMap_apply (RatFunc C) L N x + +/-- The exact constant extension is finite-dimensional over the chosen +intermediate field. -/ +private theorem finiteDimensional_exactConstantExtension_over_intermediate + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + FiniteDimensional L (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower L N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C L N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + letI : Module.Finite L (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + infer_instance + +/-- Local Frobenius-coset Burnside identity for an actual finite place of an +exact constant extension. The assumptions say only that its restriction to +`L` is rational and that `[N : L]` divides the constant-extension degree. +The exact decomposition-group cardinality, stabilizer surjectivity, and the +fixed-point total are all derived internally. -/ +theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum + (q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) + (hBase : finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L N + (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) = 1) + (hDegreeDiv : Module.finrank L N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionFrobeniusAverage_ratFuncBaseTower C S N L + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_intermediate + (C := C) (S := S) (N := N) (L := L) hExact + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let Q := exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q + let P := finitePlaceUnder C L (ExactConstantExtension C N S) Q + let pi := exactConstantExtensionConstantQuotient C L N S hExact + letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + letI : Fintype + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := Fintype.ofFinite _ + letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + letI : Fintype + (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ + letI := finiteIntegralClosureGalAction C L + (ExactConstantExtension C N S) + letI := finitePlaceUnderFiberGalAction C L + (ExactConstantExtension C N S) P + (∑ g : pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S)), + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) g.1)) = + Nat.card (N ≃ₐ[L] N) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionFrobeniusAverage_ratFuncBaseTower C S N L + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsScalarTower L N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C L N S + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_intermediate + (C := C) (S := S) (N := N) (L := L) hExact + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q + let P := finitePlaceUnder C L (ExactConstantExtension C N S) Q + let pi := exactConstantExtensionConstantQuotient C L N S hExact + letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + letI : Fintype + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := Fintype.ofFinite _ + letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + letI : Fintype + (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ + letI := finiteIntegralClosureGalAction C L + (ExactConstantExtension C N S) + letI := finitePlaceUnderFiberGalAction C L + (ExactConstantExtension C N S) P + letI : MulAction.IsPretransitive + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) := + finitePlaceUnderFiberGalAction_isPretransitive C L + (ExactConstantExtension C N S) P + let Q₀ : FinitePlaceUnderFiber C L + (ExactConstantExtension C N S) P := ⟨Q, rfl⟩ + letI : Nonempty (FinitePlaceUnderFiber C L + (ExactConstantExtension C N S) P) := ⟨Q₀⟩ + have hdecomp := + exactConstantExtensionFinitePlace_decompositionGroup_card_of_rational_base + C S N hExact L q hBase hDegreeDiv + have hcard₀ : + Nat.card (MulAction.stabilizer + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) Q₀) = + Nat.card + (pi.comp (MulAction.stabilizer + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) Q₀).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + rw [finitePlaceUnderFiber_stabilizer_eq_decompositionGroup + C L (ExactConstantExtension C N S) P Q₀] + exact hdecomp + have hsurj₀ : Function.Surjective + (pi.comp (MulAction.stabilizer + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) Q₀).subtype) := + MonoidHom.surjective_of_card_eq_card_ker_mul_card _ hcard₀ + have hsurj : ∀ x : FinitePlaceUnderFiber C L + (ExactConstantExtension C N S) P, + Function.Surjective + (pi.comp (MulAction.stabilizer + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) x).subtype) := + MonoidHom.stabilizer_surjective_of_isPretransitive_of_isCyclic + pi Q₀ hsurj₀ + have hburnside := sum_card_fixedBy_quotientFiber_eq_card_ker + pi hsurj (FiniteField.frobeniusAlgEquivOfAlgebraic C S) + calc + (∑ g : pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S)), + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) + g.1)) = + Nat.card pi.ker := hburnside + _ = Nat.card (N ≃ₐ[L] N) := by + rw [exactConstantExtensionConstantQuotient_ker C L N S hExact] + have hinjective : Function.Injective + (exactConstantExtensionFunctionAutHom C L N S) := by + intro g h hgh + have hp := exactConstantExtensionCombinedAutHom_injective C L N S + (show exactConstantExtensionCombinedAutHom C L N S + (1, g) = + exactConstantExtensionCombinedAutHom C L N S + (1, h) by + simpa [exactConstantExtensionCombinedAutHom] using hgh) + exact congrArg Prod.snd hp + exact Nat.card_congr (Equiv.ofInjective + (exactConstantExtensionFunctionAutHom C L N S) + hinjective).symm + +end IntermediateField + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean new file mode 100644 index 0000000000..a9b50f2b52 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean @@ -0,0 +1,368 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup + +/-! +# Fixed fields of Frobenius twists + +Let `C ⊆ L ⊆ N`, let `C` be algebraically closed in `N`, and let +`S / C` be a finite Galois extension of finite fields. The exact constant +extension `T = S ⊗[C] N` has Galois group + +`Gal(T/L) ≃ Gal(S/C) × Gal(N/L)`. + +For `g ∈ Gal(N/L)`, this file constructs the automorphism of `T` represented +by `(Frob, g)`, its cyclic subgroup, and its fixed field. If +`|Gal(N/L)|` divides `[S : C]`, the cyclic subgroup has order `[S : C]` +and meets the original function-field factor trivially. Consequently `T` +is a finite Galois extension of the twist field of degree `[S : C]`, while +the twist field has degree `[N : L]` over `L`. + +These are the structural assertions in the setup of Stichtenoth, +Proposition 5.2.8. Exactness of the constant field of the twist requires, +in addition, stability of relative algebraic closedness under finite +separable base change; that separate regular-base-change lemma is not +assumed here. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] + +section FiniteConstants + +variable [Fintype C] [Finite S] + +/-- The automorphism of the exact constant extension represented by +`(Frob, g)` under the direct-product description of its Galois group. -/ +noncomputable def exactConstantExtensionFrobeniusTwist + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact exactConstantExtensionCombinedAutHom C L N S + (FiniteField.frobeniusAlgEquivOfAlgebraic C S, g) + +/-- The cyclic subgroup generated by a Frobenius twist. -/ +noncomputable def exactConstantExtensionFrobeniusTwistSubgroup + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Subgroup (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact Subgroup.zpowers + (exactConstantExtensionFrobeniusTwist C L N S hExact g) + +/-- The fixed field of the cyclic subgroup generated by a Frobenius twist. -/ +noncomputable def exactConstantExtensionFrobeniusTwistField + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + IntermediateField L (ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact IntermediateField.fixedField + (exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g) + +/-- The extended base inside the exact constant extension, characterized as +the fixed field of the original function-field factor. In the rational +function specialization this is the copy of `S(X)`. -/ +noncomputable def exactConstantExtensionExtendedBaseField + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + IntermediateField L (ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact IntermediateField.fixedField + (exactConstantExtensionConstantQuotient C L N S hExact).ker + +omit [Algebra C L] [IsScalarTower C L N] + [IsGalois L N] [Fintype C] [Finite S] in +/-- The exact constant extension is finite-dimensional over the original +base. This local bridge makes the finite Galois correspondence available +for the twist fields. -/ +private theorem finiteDimensional_exactConstantExtension_over_base + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + FiniteDimensional L (ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI := exactConstantExtensionAlgebra C N S + letI := exactConstantExtensionBaseTower C L N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e + letI : Module.Finite L (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + infer_instance + +omit [FiniteDimensional C S] [FiniteDimensional L N] [IsGalois L N] in +/-- Every Frobenius twist has order `[S : C]` when the order of the original +function-field Galois group divides `[S : C]`. -/ +theorem orderOf_exactConstantExtensionFrobeniusTwist + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + orderOf (exactConstantExtensionFrobeniusTwist C L N S hExact g) = + Module.finrank C S := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + change orderOf (exactConstantExtensionCombinedAutHom C L N S + (FiniteField.frobeniusAlgEquivOfAlgebraic C S, g)) = _ + rw [orderOf_injective (exactConstantExtensionCombinedAutHom C L N S) + (exactConstantExtensionCombinedAutHom_injective C L N S)] + rw [orderOf_prod_eq_left_of_natCard_dvd] + · exact FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S + · rwa [FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S] + +omit [FiniteDimensional C S] [FiniteDimensional L N] [IsGalois L N] in +/-- The cyclic subgroup generated by a Frobenius twist has cardinality +`[S : C]`. -/ +theorem natCard_exactConstantExtensionFrobeniusTwistSubgroup + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Nat.card + (exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g) = + Module.finrank C S := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + rw [show exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g = + Subgroup.zpowers + (exactConstantExtensionFrobeniusTwist C L N S hExact g) by rfl, + Nat.card_zpowers, + orderOf_exactConstantExtensionFrobeniusTwist C L N S hExact g hdiv] + +/-- The twist subgroup meets the kernel of restriction to the enlarged +constants trivially. -/ +theorem exactConstantExtensionFrobeniusTwistSubgroup_inf_quotientKer + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g ⊓ + (exactConstantExtensionConstantQuotient C L N S hExact).ker = ⊥ := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + apply le_antisymm + · intro x hx + rw [Subgroup.mem_bot] + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp hx.1 + rw [show exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g = + Subgroup.zpowers + (exactConstantExtensionFrobeniusTwist C L N S hExact g) by rfl] at hx + rw [← hk] + have hFrob : + (FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k = 1 := by + have hker := MonoidHom.mem_ker.mp hx.2 + rw [← hk, map_zpow] at hker + simpa [exactConstantExtensionFrobeniusTwist, + exactConstantExtensionConstantQuotient_combined] using hker + have hkdiv : (Module.finrank C S : ℤ) ∣ k := by + rw [← FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S] + exact orderOf_dvd_iff_zpow_eq_one.mpr hFrob + rw [← orderOf_dvd_iff_zpow_eq_one, + orderOf_exactConstantExtensionFrobeniusTwist C L N S hExact g hdiv] + exact hkdiv + · exact bot_le + +/-- Equivalently, the twist subgroup meets the embedded original +function-field Galois group trivially. -/ +theorem exactConstantExtensionFrobeniusTwistSubgroup_inf_functionRange + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g ⊓ + (exactConstantExtensionFunctionAutHom C L N S).range = ⊥ := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + rw [← exactConstantExtensionConstantQuotient_ker C L N S hExact] + exact exactConstantExtensionFrobeniusTwistSubgroup_inf_quotientKer + C L N S hExact g hdiv + +/-- A twist field and the extended base generate the entire exact constant +extension. This is the fixed-field form of `T = T_g S` in Stichtenoth, +Proposition 5.2.8(b). -/ +theorem frobeniusTwistField_sup_extendedBaseField_eq_top + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exactConstantExtensionFrobeniusTwistField C L N S hExact g ⊔ + exactConstantExtensionExtendedBaseField C L N S hExact = ⊤ := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_base C L N S hExact + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + let B := exactConstantExtensionExtendedBaseField C L N S hExact + have hfix : (F ⊔ B).fixingSubgroup = ⊥ := by + rw [IntermediateField.fixingSubgroup_sup] + change + (IntermediateField.fixedField + (exactConstantExtensionFrobeniusTwistSubgroup + C L N S hExact g)).fixingSubgroup ⊓ + (IntermediateField.fixedField + (exactConstantExtensionConstantQuotient + C L N S hExact).ker).fixingSubgroup = ⊥ + rw [IntermediateField.fixingSubgroup_fixedField, + IntermediateField.fixingSubgroup_fixedField] + exact exactConstantExtensionFrobeniusTwistSubgroup_inf_quotientKer + C L N S hExact g hdiv + calc + F ⊔ B = IntermediateField.fixedField (F ⊔ B).fixingSubgroup := + (IsGalois.fixedField_fixingSubgroup (F ⊔ B)).symm + _ = IntermediateField.fixedField (⊥ : Subgroup + (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S)) := by rw [hfix] + _ = ⊤ := IntermediateField.fixedField_bot + +omit [IsGalois L N] in +/-- The exact constant extension has degree `[S : C]` over the Frobenius +twist field. -/ +theorem finrank_exactConstantExtension_over_frobeniusTwistField + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Module.finrank + (exactConstantExtensionFrobeniusTwistField C L N S hExact g) + (ExactConstantExtension C N S) = Module.finrank C S := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_base C L N S hExact + rw [show exactConstantExtensionFrobeniusTwistField C L N S hExact g = + IntermediateField.fixedField + (exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g) by + rfl, + IntermediateField.finrank_fixedField_eq_card, + natCard_exactConstantExtensionFrobeniusTwistSubgroup + C L N S hExact g hdiv] + +omit [IsGalois L N] [Finite S] in +/-- The exact constant extension is finite-dimensional over every Frobenius +twist field. -/ +theorem finiteDimensional_exactConstantExtension_over_frobeniusTwistField + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + FiniteDimensional + (exactConstantExtensionFrobeniusTwistField C L N S hExact g) + (ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_base C L N S hExact + infer_instance + +omit [IsGalois L N] [Finite S] in +/-- The exact constant extension is Galois over every Frobenius twist field. +This only uses the general theorem that a field is Galois over the fixed +field of a finite group action. -/ +theorem isGalois_exactConstantExtension_over_frobeniusTwistField + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + IsGalois + (exactConstantExtensionFrobeniusTwistField C L N S hExact g) + (ExactConstantExtension C N S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_base C L N S hExact + let H := exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g + change IsGalois (IntermediateField.fixedField H) + (ExactConstantExtension C N S) + exact IsGalois.of_fixed_field (ExactConstantExtension C N S) H + +omit [IsGalois L N] in +/-- Every Frobenius twist field has the same degree over `L` as the original +function field `N`. -/ +theorem finrank_frobeniusTwistField_over_base + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Module.finrank L + (exactConstantExtensionFrobeniusTwistField C L N S hExact g) = + Module.finrank L N := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_base C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + have hmul := Module.finrank_mul_finrank L F + (ExactConstantExtension C N S) + rw [finrank_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g hdiv, + exactConstantExtension_finrank_over_base C L N S] at hmul + exact Nat.mul_right_cancel (Module.finrank_pos (R := C) (M := S)) hmul + +omit [IsGalois L N] in +/-- The Galois group over a Frobenius twist field has cardinality `[S : C]`. -/ +theorem natCard_aut_exactConstantExtension_over_frobeniusTwistField + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Nat.card + (ExactConstantExtension C N S ≃ₐ[ + exactConstantExtensionFrobeniusTwistField C L N S hExact g] + ExactConstantExtension C N S) = Module.finrank C S := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_base C L N S hExact + letI : IsGalois + (exactConstantExtensionFrobeniusTwistField C L N S hExact g) + (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + rw [IsGalois.card_aut_eq_finrank, + finrank_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g hdiv] + +end FiniteConstants + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean new file mode 100644 index 0000000000..bac11d38fb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage + +/-! +# Two-sided Frobenius-twist errors from the bounded average + +The exact average of the infinity-place contributions is not needed to obtain +a two-sided estimate for an individual Frobenius twist. The already-proved +bounded aggregate error, together with a common one-sided Stepanov bound for +all twists, suffices by finite averaging. + +This is the direct function-field specialization of +`abs_le_of_uniform_upper_and_abs_sum_le`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped BigOperators + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance boundedErrorBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance boundedErrorBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A common upper bound for all Frobenius-twist point-count errors gives a +two-sided bound for every twist. The additive term is uniform in the +auxiliary constant extension `S`: it depends only on the original Galois +group and the degree of `N / C(X)`. + +Consequently, the exact infinity-place average is not a prerequisite for the +two-sided estimate used in a Hasse--Weil argument. -/ +theorem abs_frobeniusTwistFieldRationalPlaceError_le_of_uniform_upper + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (g : N ≃ₐ[RatFunc C] N) (B : ℝ) + (hB : 0 ≤ B) + (hupper : ∀ τ : N ≃ₐ[RatFunc C] N, + (frobeniusTwistFieldRationalPlaceCount C S N hExact τ : ℝ) - + (Nat.card C : ℝ) - 1 ≤ B) : + |(frobeniusTwistFieldRationalPlaceCount C S N hExact g : ℝ) - + (Nat.card C : ℝ) - 1| ≤ + (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + Module.finrank (RatFunc C) N + + (Nat.card (N ≃ₐ[RatFunc C] N) - 1 : ℕ) * B := by + classical + have hsum := abs_sum_frobeniusTwistFieldRationalPlaceError_le + C S N hExact hdiv + have hbound := abs_le_of_uniform_upper_and_abs_sum_le + (fun τ : N ≃ₐ[RatFunc C] N ↦ + (frobeniusTwistFieldRationalPlaceCount C S N hExact τ : ℝ) - + (Nat.card C : ℝ) - 1) + g + ((Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + Module.finrank (RatFunc C) N) + B hB hupper hsum + simpa only [Nat.card_eq_fintype_card] using hbound + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean new file mode 100644 index 0000000000..e712a14f18 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist + +/-! +# Exact constants of Frobenius-twist fields + +Let `T = S ⊗[C] N` be an exact finite constant extension and let `F_g` +be the fixed field of the cyclic group generated by `(Frob, g)`. This file +proves that `C` is the exact constant field of every `F_g`. + +Indeed, an element of `F_g` algebraic over `C` is algebraic over `S` in `T`, +so exactness of the constants of `T` puts it in the embedded copy of `S`. +Since the element is fixed by `(Frob, g)`, its representative in `S` is fixed +by Frobenius and hence belongs to `C`. + +The order calculation for `(Frob, g)` is not needed for this descent, so the +result is stronger than the version with the usual divisibility hypothesis. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] + [Fintype C] [Finite S] + +omit [FiniteDimensional L N] [IsGalois L N] in +/-- Every Frobenius-twist fixed field has exact constant field `C`. + +No divisibility condition on the order of `Gal(N/L)` is required: only the +restriction of the twist generator to `S`, which is the `C`-Frobenius, enters +the proof. -/ +theorem exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra C F := Algebra.restrictScalars C L F + algebraicClosure C F = (⊥ : IntermediateField C F) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : Algebra C T := Algebra.restrictScalars C L T + letI : SMul C T := Algebra.toSMul + letI : IsScalarTower C L T := IsScalarTower.of_algebraMap_eq' rfl + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra C F := Algebra.restrictScalars C L F + letI : IsScalarTower C L F := IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S T := Algebra.TensorProduct.leftAlgebra + letI : SMul S T := Algebra.toSMul + have hCS : algebraMap C T = + (algebraMap S T).comp (algebraMap C S) := by + ext c + change (1 : S) ⊗ₜ algebraMap L N (algebraMap C L c) = + algebraMap C S c ⊗ₜ (1 : N) + rw [← IsScalarTower.algebraMap_apply C L N] + exact (Algebra.TensorProduct.tmul_one_eq_one_tmul c).symm + letI : IsScalarTower C S T := IsScalarTower.of_algebraMap_eq' hCS + have hTopExact : algebraicClosure S T = + (⊥ : IntermediateField S T) := + exactConstantExtension_algebraicClosure_eq_bot C N S hExact + apply eq_bot_iff.mpr + intro z hz + have hzC : IsAlgebraic C z := mem_algebraicClosure_iff.mp hz + have hzCT : IsAlgebraic C (z : T) := by + exact IsAlgebraic.algHom (F.val.restrictScalars C) hzC + have hzST : IsAlgebraic S (z : T) := + IsAlgebraic.tower_top S hzCT + have hzBotS : (z : T) ∈ (⊥ : IntermediateField S T) := by + rw [← hTopExact] + exact mem_algebraicClosure_iff.mpr hzST + obtain ⟨s, hs⟩ := IntermediateField.mem_bot.mp hzBotS + let τ := exactConstantExtensionFrobeniusTwist C L N S hExact g + have hzFix : τ (z : T) = (z : T) := by + apply (IntermediateField.mem_fixedField_iff + (exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g) + (z : T)).mp z.property + exact Subgroup.mem_zpowers τ + have hsFix : FiniteField.frobeniusAlgEquivOfAlgebraic C S s = s := by + apply (algebraMap S T).injective + calc + algebraMap S T (FiniteField.frobeniusAlgEquivOfAlgebraic C S s) = + τ (algebraMap S T s) := by + change + (FiniteField.frobeniusAlgEquivOfAlgebraic C S s) ⊗ₜ (1 : N) = + τ (s ⊗ₜ (1 : N)) + simp [τ, exactConstantExtensionFrobeniusTwist, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] + _ = τ (z : T) := congrArg τ hs + _ = (z : T) := hzFix + _ = algebraMap S T s := hs.symm + have hspow : s ^ Fintype.card C = s := by + simpa [FiniteField.coe_frobeniusAlgEquivOfAlgebraic] using hsFix + let p : C[X] := Polynomial.X ^ Fintype.card C - Polynomial.X + have hpSplit : p.Splits := by + dsimp [p] + simpa [Nat.card_eq_fintype_card] using + (Polynomial.splits_X_pow_nat_card_sub_X (K := C)) + have hp0 : p ≠ 0 := by + dsimp [p] + exact FiniteField.X_pow_card_sub_X_ne_zero C Fintype.one_lt_card + have hroot : (p.map (algebraMap C S)).IsRoot s := by + simp [p, hspow] + obtain ⟨c, hc⟩ := hpSplit.mem_range_of_isRoot hp0 hroot + apply IntermediateField.mem_bot.mpr + refine ⟨c, ?_⟩ + apply Subtype.ext + change algebraMap C T c = (z : T) + rw [hCS] + change algebraMap S T (algebraMap C S c) = (z : T) + rw [hc, hs] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean new file mode 100644 index 0000000000..653c513c9a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount + +/-! +# Degrees of exact-constant Frobenius twists + +For an exact constant extension `S \otimes[C] N`, every Frobenius-twist +fixed field has the same degree over `C(X)` as the original function field +`N`. This file records the rational-function specialization used by the +Hasse--Weil averaging argument and combines it with the general bound on +rational places above infinity. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (C N S : Type*) [Field C] [Fintype C] [DecidableEq C] + [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] [Algebra C N] + [IsScalarTower C (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [Algebra.IsSeparable (RatFunc C) N] in +/-- A Frobenius-twist fixed field has the same `C(X)`-degree as the original +function field. -/ +theorem finrank_frobeniusTwistField_over_ratFunc_eq_original + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Module.finrank (RatFunc C) + (exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g) = + Module.finrank (RatFunc C) N := by + exact finrank_frobeniusTwistField_over_base + C (RatFunc C) N S hExact g hdiv + +/-- The number of rational infinity places on a Frobenius-twist fixed field +is bounded uniformly by the degree of the original function field. -/ +theorem rationalInfinityPlace_card_frobeniusTwistField_le_original_finrank + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ + Module.finrank (RatFunc C) N := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + calc + Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ + Module.finrank (RatFunc C) F := + rationalInfinityPlace_card_le_finrank C F + _ = Module.finrank (RatFunc C) N := + finrank_frobeniusTwistField_over_ratFunc_eq_original + C N S hExact g hdiv + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean new file mode 100644 index 0000000000..dd4d93dc4d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -0,0 +1,848 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower + +/-! +# Global finite-place averaging for Frobenius twists + +This file removes the presentation choice from the local Frobenius-coset +fixed-point identity and assembles the rational finite places of all +Frobenius-twist fields without duplication. +-/ + +open scoped Polynomial TensorProduct BigOperators + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +/-- Restricting a finite place first to an intermediate function field and +then to `K(X)` agrees with direct restriction to `K(X)`. This is the +finite-extension-place version of `Ideal.under_under`; unlike the raw chart +statement `finitePlaceUnder_under`, both sides live in the normalized +finite-place model of `K(X)`. -/ +theorem finitePlaceUnder_ratFunc_under + (K M L : Type*) [Field K] [Field M] [Field L] + [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) M] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra M L] [IsScalarTower (RatFunc K) M L] + (Q : FiniteExtensionFinitePlace K L) : + finitePlaceUnder K (RatFunc K) M (finitePlaceUnder K M L Q) = + finitePlaceUnder K (RatFunc K) L Q := by + letI : Algebra (RatFuncFiniteIntegralClosure K (RatFunc K)) + (RatFuncFiniteIntegralClosure K M) := + (finiteIntegralClosureMap K (RatFunc K) M).toAlgebra + letI : Algebra (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + (finiteIntegralClosureMap K M L).toAlgebra + letI : Algebra (RatFuncFiniteIntegralClosure K (RatFunc K)) + (RatFuncFiniteIntegralClosure K L) := + (finiteIntegralClosureMap K (RatFunc K) L).toAlgebra + letI : SMul (RatFuncFiniteIntegralClosure K (RatFunc K)) + (RatFuncFiniteIntegralClosure K M) := Algebra.toSMul + letI : SMul (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := Algebra.toSMul + letI : SMul (RatFuncFiniteIntegralClosure K (RatFunc K)) + (RatFuncFiniteIntegralClosure K L) := Algebra.toSMul + letI : IsScalarTower (RatFuncFiniteIntegralClosure K (RatFunc K)) + (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq fun x => by + apply Subtype.ext + change algebraMap (RatFunc K) L x.1 = + algebraMap M L (algebraMap (RatFunc K) M x.1) + exact IsScalarTower.algebraMap_apply (RatFunc K) M L x.1 + apply IsDedekindDomain.HeightOneSpectrum.ext + exact Ideal.under_under Q.asIdeal + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance finiteAverageRatFuncRationalFinitePlaceFintype : + Fintype (RatFuncRationalFinitePlace C) := Fintype.ofFinite _ + +local instance finiteAverageBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance finiteAverageBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finiteAverageTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +local instance finiteAverageRatFuncClosureConstantAlgebra : + Algebra C (RatFuncFiniteIntegralClosure C (RatFunc C)) := + RingHom.toAlgebra + ((algebraMap C[X] (RatFuncFiniteIntegralClosure C (RatFunc C))).comp + (algebraMap C C[X])) + +local instance finiteAverageRatFuncClosureConstantTower : + IsScalarTower C C[X] + (RatFuncFiniteIntegralClosure C (RatFunc C)) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The chart-normalization equivalence over the polynomial base ring. -/ +noncomputable def ratFuncFiniteBasePolynomialAlgEquivChart : + C[X] ≃ₐ[C[X]] RatFuncFiniteIntegralClosure C (RatFunc C) := + { ratFuncFiniteBaseRingEquivChart C with + commutes' := fun r => by + apply Subtype.ext + change algebraMap (FunctionField.ringOfIntegers C (RatFunc C)) + (RatFunc C) + (ratFuncFiniteBaseRingEquivChart C r) = + algebraMap (FunctionField.ringOfIntegers C (RatFunc C)) + (RatFunc C) + (algebraMap C[X] (FunctionField.ringOfIntegers C (RatFunc C)) r) + rw [ratFuncFiniteBaseRingEquivChart_algebraMap] + rfl } + +/-- The same equivalence over the constant field. -/ +noncomputable def ratFuncFiniteBaseAlgEquivChart : + C[X] ≃ₐ[C] RatFuncFiniteIntegralClosure C (RatFunc C) := + (ratFuncFiniteBasePolynomialAlgEquivChart C).restrictScalars C + +local instance finiteAverageRatFuncClosureModuleFinite : + Module.Finite C[X] (RatFuncFiniteIntegralClosure C (RatFunc C)) := + Module.Finite.equiv + (ratFuncFiniteBasePolynomialAlgEquivChart C).toLinearEquiv + +/-- The finite-chart normalization of `C[X]` in `C(X)` is canonically +equivalent to `C[X]` itself, hence their finite-place models agree. -/ +noncomputable def ratFuncFinitePlaceEquivFiniteExtension : + IsDedekindDomain.HeightOneSpectrum C[X] ≃ + FiniteExtensionFinitePlace C (RatFunc C) := + heightOneSpectrumEquivOfAlgEquiv + (ratFuncFiniteBasePolynomialAlgEquivChart C) + +/-- A finite-place degree is the dimension of its residue field over the +constant field. -/ +private theorem finiteExtensionPlaceDegree_inl_eq_finrank_residueField_ratFunc + (Q : FiniteExtensionFinitePlace C (RatFunc C)) : + finiteExtensionPlaceDegree C (RatFunc C) (.inl Q) = + Module.finrank C Q.asIdeal.ResidueField := by + let P := IsDedekindDomain.HeightOneSpectrum.under C[X] Q + letI : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver P.asIdeal Q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra P.asIdeal Q.asIdeal := + ⟨rfl⟩ + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq P.asIdeal Q.asIdeal] + rw [ratFuncFinitePlaceDegree_eq_finrank_residueField C P] + rw [mul_comm, Module.finrank_mul_finrank] + +/-- The chart-normalization equivalence preserves finite-place degree. -/ +@[simp] +theorem finiteExtensionPlaceDegree_ratFuncFinitePlaceEquivFiniteExtension + (P : IsDedekindDomain.HeightOneSpectrum C[X]) : + finiteExtensionPlaceDegree C (RatFunc C) + (.inl (ratFuncFinitePlaceEquivFiniteExtension C P)) = + ratFuncFinitePlaceDegree P := by + let Q := ratFuncFinitePlaceEquivFiniteExtension C P + have hres := heightOneSpectrum_residueField_finrank_eq + (ratFuncFiniteBaseAlgEquivChart C) P + calc + finiteExtensionPlaceDegree C (RatFunc C) (.inl Q) = + Module.finrank C Q.asIdeal.ResidueField := + finiteExtensionPlaceDegree_inl_eq_finrank_residueField_ratFunc C Q + _ = Module.finrank C P.asIdeal.ResidueField := hres.symm + _ = ratFuncFinitePlaceDegree P := + (ratFuncFinitePlaceDegree_eq_finrank_residueField C P).symm + +/-- Degree-one finite places in the direct `C[X]` chart and in the generic +finite-extension place model of `C(X)` are canonically equivalent. -/ +noncomputable def ratFuncRationalFinitePlaceEquivFiniteExtension : + RatFuncRationalFinitePlace C ≃ + FiniteExtensionRationalFinitePlace C (RatFunc C) := + Equiv.subtypeEquiv (ratFuncFinitePlaceEquivFiniteExtension C) (by + intro P + rw [finiteExtensionPlaceDegree_ratFuncFinitePlaceEquivFiniteExtension]) + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- Choose the explicit `S[X]` presentation of an actual top finite place, +while transporting rationality of its restriction to the downstairs place. +This is the only point where the nested integral-closure contraction tower is +expanded in this file. -/ +private theorem exists_presentedFinitePlace_of_under_rational : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) + (ExactConstantExtension C N S) Q)) = 1 → + ∃ q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)), + exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q = Q ∧ + finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) N + (exactConstantExtensionDownstairsFinitePlace + C S N hExact q))) = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) T := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + intro Q hBase + let e := exactConstantExtensionPresentedFinitePlaceEquiv C S N hExact + let q := e.symm Q + have heq : exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q = Q := by + calc + exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q = + e q := + (exactConstantExtensionPresentedFinitePlaceEquiv_apply + C S N hExact q).symm + _ = Q := e.apply_symm_apply Q + have hDownstairs : finitePlaceUnder C N T Q = + exactConstantExtensionDownstairsFinitePlace C S N hExact q := by + calc + finitePlaceUnder C N T Q = + finitePlaceUnder C N T + (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q) := congrArg _ heq.symm + _ = exactConstantExtensionDownstairsFinitePlace C S N hExact q := + exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact q + have hUnderTower : finitePlaceUnder C (RatFunc C) N + (finitePlaceUnder C N T Q) = + finitePlaceUnder C (RatFunc C) T Q := + finitePlaceUnder_ratFunc_under C N T Q + refine ⟨q, heq, ?_⟩ + rw [← hDownstairs, hUnderTower] + exact hBase + +/-- Every actual top finite place over a rational finite place of `C(X)` has +ambient degree `[S : C]`, provided the constant-extension degree is divisible +by the original Galois degree. -/ +theorem exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_rational + (hDegreeDiv : Module.finrank (RatFunc C) N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) + (ExactConstantExtension C N S) Q)) = 1 → + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = + Module.finrank C S := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) T := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) T := Algebra.toSMul + letI : Module (RatFunc S) T := Algebra.toModule + letI : FiniteDimensional (RatFunc S) T := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) T := + isSeparable_over_extendedRatFunc C S N hExact + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + intro Q hBase + obtain ⟨q, heq, hBaseQ⟩ := + exists_presentedFinitePlace_of_under_rational C S N hExact Q hBase + have hS : finiteExtensionPlaceDegree S T + (.inl (exactConstantExtensionUpstairsFinitePlace C S N hExact q)) = 1 := + exactConstantExtensionUpstairsFinitePlace_degree_eq_one_of_under_degree_one + C S N hExact q hBaseQ hDegreeDiv + have hDegree := exactConstantExtensionCompatibleBaseFinitePlace_degree_eq + C S N hExact q hS + rw [heq] at hDegree + exact hDegree + +/-- Presentation-free local Frobenius-coset identity above an arbitrary +rational finite base place. -/ +theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under_rational + (hDegreeDiv : Module.finrank (RatFunc C) N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + ∀ (Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S)), + finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) + (ExactConstantExtension C N S) Q)) = 1 → + let P := finitePlaceUnder C (RatFunc C) + (ExactConstantExtension C N S) Q + let pi := exactConstantExtensionConstantQuotient + C (RatFunc C) N S hExact + letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + letI : Fintype + (ExactConstantExtension C N S ≃ₐ[RatFunc C] + ExactConstantExtension C N S) := Fintype.ofFinite _ + letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + letI : Fintype + (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ + letI := finiteIntegralClosureGalAction C (RatFunc C) + (ExactConstantExtension C N S) + letI := finitePlaceUnderFiberGalAction C (RatFunc C) + (ExactConstantExtension C N S) P + (∑ g : pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S)), + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C (RatFunc C) + (ExactConstantExtension C N S) P) g.1)) = + Nat.card (N ≃ₐ[RatFunc C] N) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra (RatFunc S) T := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + intro Q hBase + obtain ⟨q, heq, hBaseQ⟩ := + exists_presentedFinitePlace_of_under_rational C S N hExact Q hBase + rw [← heq] + exact exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum + C S N hExact (RatFunc C) q hBaseQ hDegreeDiv + +/-- The Frobenius-fiber parametrization sends `g` to the ambient +Frobenius-twist automorphism `(Frob, g)`. -/ +@[simp] +theorem exactConstantExtensionFrobeniusFiberEquiv_apply_val + (g : N ≃ₐ[RatFunc C] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + ((exactConstantExtensionFrobeniusFiberEquiv + C (RatFunc C) N S hExact) g).1 = + exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + rfl + +/-- Above one rational finite place of `C(X)`, summing fixed top places over +all canonical Frobenius twists contributes exactly `|Gal(N/C(X))|`. -/ +theorem sum_card_finitePlaceUnderFiber_fixedBy_frobeniusTwist_eq_card_galois + (hDegreeDiv : Module.finrank (RatFunc C) N ∣ Module.finrank C S) + (P : RatFuncRationalFinitePlace C) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let P₀ := ratFuncRationalFinitePlaceEquivFiniteExtension C P + letI := finiteIntegralClosureGalAction C (RatFunc C) + (ExactConstantExtension C N S) + letI := finitePlaceUnderFiberGalAction C (RatFunc C) + (ExactConstantExtension C N S) P₀.1 + (∑ g : N ≃ₐ[RatFunc C] N, + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C (RatFunc C) + (ExactConstantExtension C N S) P₀.1) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g))) = + Nat.card (N ≃ₐ[RatFunc C] N) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let P₀ := ratFuncRationalFinitePlaceEquivFiniteExtension C P + letI := finiteIntegralClosureGalAction C (RatFunc C) T + letI := finitePlaceUnderFiberGalAction C (RatFunc C) T P₀.1 + let pi := exactConstantExtensionConstantQuotient + C (RatFunc C) N S hExact + letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + letI : Fintype (T ≃ₐ[RatFunc C] T) := Fintype.ofFinite _ + letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + letI : Fintype + (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ + obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective C (RatFunc C) T P₀.1 + have hBase : finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) T Q)) = 1 := by + rw [hQ] + exact P₀.2 + have hlocal := + exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under_rational + C S N hExact hDegreeDiv Q hBase + rw [hQ] at hlocal + let e := exactConstantExtensionFrobeniusFiberEquiv + C (RatFunc C) N S hExact + calc + (∑ g : N ≃ₐ[RatFunc C] N, + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C (RatFunc C) T P₀.1) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g))) = + ∑ g : N ≃ₐ[RatFunc C] N, + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C (RatFunc C) T P₀.1) (e g).1) := by + apply Finset.sum_congr rfl + intro g _ + rw [exactConstantExtensionFrobeniusFiberEquiv_apply_val] + _ = ∑ x : pi ⁻¹' + ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S)), + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C (RatFunc C) T P₀.1) x.1) := + e.sum_comp (fun x => Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C (RatFunc C) T P₀.1) x.1)) + _ = Nat.card (N ≃ₐ[RatFunc C] N) := hlocal + +/-- Fixed top finite places in the restriction fiber above one rational +finite place of `C(X)`, for one canonical Frobenius twist. -/ +abbrev FrobeniusTwistFinitePlaceFiberFixedBy + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) (P : RatFuncRationalFinitePlace C) : + Type _ := + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let P₀ := ratFuncRationalFinitePlaceEquivFiniteExtension C P + @MulAction.fixedBy + (ExactConstantExtension C N S ≃ₐ[RatFunc C] + ExactConstantExtension C N S) + (FinitePlaceUnderFiber C (RatFunc C) + (ExactConstantExtension C N S) P₀.1) + _ + (finitePlaceUnderFiberGalAction C (RatFunc C) + (ExactConstantExtension C N S) P₀.1) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) + +/-- Rational finite places of one Frobenius-twist field are the disjoint +union, over rational finite places of `C(X)`, of the ambient fixed top places +in the corresponding restriction fiber. -/ +noncomputable def + frobeniusTwistField_rationalFinitePlace_equiv_sigma_fiberFixedBy + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (g : N ≃ₐ[RatFunc C] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + FiniteExtensionRationalFinitePlace C F ≃ + Σ P : RatFuncRationalFinitePlace C, + FrobeniusTwistFinitePlaceFiberFixedBy C S N hExact g P := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + let sigma := exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g + let baseEquiv := ratFuncRationalFinitePlaceEquivFiniteExtension C + have hDegreeDiv : Module.finrank (RatFunc C) N ∣ Module.finrank C S := by + rw [← IsGalois.card_aut_eq_finrank] + exact hdiv + let AmbientFixed := + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank C S ∧ + finitePlaceGalSmul C (RatFunc C) T sigma Q = Q} + let SigmaFixed := Σ P : RatFuncRationalFinitePlace C, + FrobeniusTwistFinitePlaceFiberFixedBy C S N hExact g P + let toAmbient : SigmaFixed → AmbientFixed := fun x => by + let P₀ := baseEquiv x.1 + let Q := x.2.1.1 + have hBase : finiteExtensionPlaceDegree C (RatFunc C) + (.inl (finitePlaceUnder C (RatFunc C) T Q)) = 1 := by + rw [x.2.1.2] + exact P₀.2 + refine ⟨Q, + exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_rational + C S N hExact hDegreeDiv Q hBase, ?_⟩ + exact congrArg Subtype.val x.2.2 + have hInjective : Function.Injective toAmbient := by + rintro ⟨P, x⟩ ⟨R, y⟩ hxy + have hQ : x.1.1 = y.1.1 := congrArg Subtype.val hxy + have hBase : (baseEquiv P).1 = (baseEquiv R).1 := by + calc + (baseEquiv P).1 = finitePlaceUnder C (RatFunc C) T x.1.1 := x.1.2.symm + _ = finitePlaceUnder C (RatFunc C) T y.1.1 := congrArg _ hQ + _ = (baseEquiv R).1 := y.1.2 + have hP : P = R := baseEquiv.injective (Subtype.ext hBase) + subst R + apply Sigma.ext (by rfl) + apply heq_of_eq + apply Subtype.ext + apply Subtype.ext + exact hQ + have hSurjective : Function.Surjective toAmbient := by + intro z + let Q := z.1 + have hFdegree : finiteExtensionPlaceDegree C F + (.inl (finitePlaceUnder C F T Q)) = 1 := + frobeniusTwistField_ambientFixed_finitePlace_under_degree_eq_one + C N S hExact g hdiv Q z.2.1 z.2.2 + let R₀ : FiniteExtensionRationalFinitePlace C F := + ⟨finitePlaceUnder C F T Q, hFdegree⟩ + let P₀ : FiniteExtensionRationalFinitePlace C (RatFunc C) := + rationalFinitePlaceUnder C (RatFunc C) F R₀ + let P : RatFuncRationalFinitePlace C := baseEquiv.symm P₀ + have hP : baseEquiv P = P₀ := baseEquiv.apply_symm_apply P₀ + have hFiber : finitePlaceUnder C (RatFunc C) T Q = (baseEquiv P).1 := by + calc + finitePlaceUnder C (RatFunc C) T Q = + finitePlaceUnder C (RatFunc C) F (finitePlaceUnder C F T Q) := + (finitePlaceUnder_ratFunc_under C F T Q).symm + _ = P₀.1 := rfl + _ = (baseEquiv P).1 := congrArg Subtype.val hP.symm + let xFiber : FinitePlaceUnderFiber C (RatFunc C) T (baseEquiv P).1 := + ⟨Q, hFiber⟩ + let xFixed : FrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact g P := ⟨xFiber, by + apply Subtype.ext + exact z.2.2⟩ + refine ⟨⟨P, xFixed⟩, ?_⟩ + apply Subtype.ext + change Q = z.1 + rfl + let eSigma : SigmaFixed ≃ AmbientFixed := + Equiv.ofBijective toAmbient ⟨hInjective, hSurjective⟩ + exact (frobeniusTwistField_rationalFinitePlace_equiv_ambientFixedFinitePlace + C N S hExact g hdiv).trans eSigma.symm + +/-- The number of rational finite places of the fixed field attached to one +canonical Frobenius twist. The instances are fixed explicitly so that this +number can be summed over the original Galois group. -/ +noncomputable def frobeniusTwistFieldRationalFinitePlaceCount + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : ℕ := + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + Nat.card (FiniteExtensionRationalFinitePlace C F) + +/-- For one twist, rational finite places split as the finite sum of fixed +restriction fibers above the rational finite places of `C(X)`. -/ +theorem frobeniusTwistFieldRationalFinitePlaceCount_eq_sum_fiberFixedBy + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (g : N ≃ₐ[RatFunc C] N) : + frobeniusTwistFieldRationalFinitePlaceCount C S N hExact g = + ∑ P : RatFuncRationalFinitePlace C, + Nat.card (FrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact g P) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + change Nat.card (FiniteExtensionRationalFinitePlace C F) = _ + rw [Nat.card_congr + (frobeniusTwistField_rationalFinitePlace_equiv_sigma_fiberFixedBy + C S N hExact hdiv g), Nat.card_sigma] + +/-- Summed over all canonical Frobenius twists, the number of rational +finite places is exactly the order of the original Galois group times the +number of constants. -/ +theorem sum_frobeniusTwistFieldRationalFinitePlaceCount_eq_card_galois_mul_card + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[RatFunc C] N, + frobeniusTwistFieldRationalFinitePlaceCount C S N hExact g) = + Nat.card (N ≃ₐ[RatFunc C] N) * Nat.card C := by + have hDegreeDiv : + Module.finrank (RatFunc C) N ∣ Module.finrank C S := by + rw [← IsGalois.card_aut_eq_finrank] + exact hdiv + calc + (∑ g : N ≃ₐ[RatFunc C] N, + frobeniusTwistFieldRationalFinitePlaceCount C S N hExact g) = + ∑ g : N ≃ₐ[RatFunc C] N, + ∑ P : RatFuncRationalFinitePlace C, + Nat.card (FrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact g P) := by + apply Finset.sum_congr rfl + intro g _ + exact frobeniusTwistFieldRationalFinitePlaceCount_eq_sum_fiberFixedBy + C S N hExact hdiv g + _ = ∑ P : RatFuncRationalFinitePlace C, + ∑ g : N ≃ₐ[RatFunc C] N, + Nat.card (FrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact g P) := by + rw [Finset.sum_comm] + _ = ∑ _P : RatFuncRationalFinitePlace C, + Nat.card (N ≃ₐ[RatFunc C] N) := by + apply Finset.sum_congr rfl + intro P _ + simpa only [FrobeniusTwistFinitePlaceFiberFixedBy] using + (sum_card_finitePlaceUnderFiber_fixedBy_frobeniusTwist_eq_card_galois + C S N hExact hDegreeDiv P) + _ = Nat.card (RatFuncRationalFinitePlace C) * + Nat.card (N ≃ₐ[RatFunc C] N) := by + simp [Nat.card_eq_fintype_card] + _ = Nat.card C * Nat.card (N ≃ₐ[RatFunc C] N) := by + rw [Nat.card_congr (ratFuncRationalFinitePlaceEquiv C)] + _ = Nat.card (N ≃ₐ[RatFunc C] N) * Nat.card C := Nat.mul_comm _ _ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean new file mode 100644 index 0000000000..925c9b0eef --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean @@ -0,0 +1,468 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower + +/-! +# Finite places of Frobenius-twist fields + +This file connects the fixed finite places occurring in Frobenius-coset +averaging with finite places of the corresponding Frobenius-twist fixed +field. The first step is the arithmetic core of that comparison: every +rational finite place of a twist field has a unique finite place above it in +the exact constant extension. + +Indeed, the top residue field contains the enlarged constant field `S`, so +its degree over `C` is divisible by `[S : C]`. Multiplicativity of place +degree identifies that degree with the relative residue degree above a +rational twist-field place. Since the entire extension has degree +`[S : C]`, the Galois decomposition formula forces both the number of places +above the rational place and the ramification index to be one. + +Only this rational-place-to-fixed-lift direction is asserted here. The +reverse implication for an arbitrary twist-fixed top place additionally +requires the unramified residue-field descent for the constant extension; +that result is not hidden in the interface below. +-/ + +open scoped Pointwise Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +variable (C N S : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] + +local instance twistBridgeConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance twistBridgeConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +section GenericUniqueFiber + +variable (K M T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field M] [Field T] + [Algebra (RatFunc K) M] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Algebra (RatFunc K) T] [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M T] [IsScalarTower (RatFunc K) M T] + [FiniteDimensional M T] [IsGalois M T] + +/-- If every top finite-place degree is divisible by the relative field +degree, then every rational finite place downstairs has a unique place above +it. The proof uses only degree multiplicativity and the Galois +decomposition formula. -/ +theorem rationalFinitePlace_fiber_card_eq_one_of_finrank_dvd_degree + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) + (P : FiniteExtensionRationalFinitePlace K M) : + Fintype.card (FinitePlaceUnderFiber K M T P.1) = 1 := by + obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective K M T P.1 + let Q₀ : FinitePlaceUnderFiber K M T P.1 := ⟨Q, hQ⟩ + have hplaceDegree := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M T Q + have hrelative : finitePlaceRelativeInertiaDeg K M T Q = + finiteExtensionPlaceDegree K T (.inl Q) := by + rw [hQ] at hplaceDegree + simpa [P.2] using hplaceDegree.symm + have hm_dvd_f : Module.finrank M T ∣ + finitePlaceRelativeInertiaDeg K M T Q := by + rw [hrelative] + exact hdegree Q + have hfiber := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M T P.1 Q₀ + dsimp [Q₀] at hfiber + have hf_dvd_m : finitePlaceRelativeInertiaDeg K M T Q ∣ + Module.finrank M T := by + rw [← hfiber] + exact dvd_mul_left _ _ + have hf : finitePlaceRelativeInertiaDeg K M T Q = + Module.finrank M T := Nat.dvd_antisymm hf_dvd_m hm_dvd_f + have hmpos : 0 < Module.finrank M T := Module.finrank_pos + have hproduct : + Fintype.card (FinitePlaceUnderFiber K M T P.1) * + finitePlaceRelativeRamificationIdx K M T Q = 1 := by + apply Nat.eq_of_mul_eq_mul_right hmpos + simpa [Nat.mul_assoc, hf] using hfiber + exact Nat.eq_one_of_dvd_one + ⟨finitePlaceRelativeRamificationIdx K M T Q, hproduct.symm⟩ + +/-- Under the same degree-divisibility hypothesis, every relative Galois +automorphism fixes every finite place above a rational finite place. This is +the action form of the singleton-fiber theorem. -/ +theorem finitePlaceGalSmul_eq_self_over_rationalFinitePlace_of_finrank_dvd_degree + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) + (P : FiniteExtensionRationalFinitePlace K M) + (Q : FiniteExtensionFinitePlace K T) + (hQ : finitePlaceUnder K M T Q = P.1) + (sigma : T ≃ₐ[M] T) : + finitePlaceGalSmul K M T sigma Q = Q := by + letI := finiteIntegralClosureGalAction K M T + letI := finitePlaceUnderFiberGalAction K M T P.1 + have hcard := + rationalFinitePlace_fiber_card_eq_one_of_finrank_dvd_degree + K M T hdegree P + obtain ⟨Q₀, hQ₀⟩ := Fintype.card_eq_one_iff.mp hcard + let x : FinitePlaceUnderFiber K M T P.1 := ⟨Q, hQ⟩ + let y : FinitePlaceUnderFiber K M T P.1 := + ⟨finitePlaceGalSmul K M T sigma Q, by + rw [finitePlaceUnder_finitePlaceGalSmul, hQ]⟩ + have hxy : x = y := (hQ₀ x).trans (hQ₀ y).symm + exact congrArg Subtype.val hxy |>.symm + +end GenericUniqueFiber + +/-- Every finite place of the exact constant extension, viewed over the +original constants `C`, has degree divisible by `[S : C]`. This is the +degree-theoretic expression of the inclusion of `S` in every top residue +field. -/ +theorem exactConstantExtensionFinitePlace_finrank_constants_dvd_degree + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (Q : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + FiniteExtensionFinitePlace C (ExactConstantExtension C N S)) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Module.finrank C S ∣ finiteExtensionPlaceDegree C + (ExactConstantExtension C N S) (.inl Q) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) T := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : SMul (RatFunc S) T := Algebra.toSMul + letI : Module (RatFunc S) T := Algebra.toModule + letI : FiniteDimensional (RatFunc S) T := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) T := + isSeparable_over_extendedRatFunc C S N hExact + rw [finiteExtensionFinitePlace_degree_baseChange C S T + (exactConstantExtension_ratFunc_polynomialCompatibility C S N hExact) + Q] + exact dvd_mul_right _ _ + +/-- The Frobenius-twist generator, regarded as an automorphism over its own +fixed field. Its underlying field automorphism is definitionally the same +twist used in the Frobenius fiber over `C(X)`. -/ +noncomputable def exactConstantExtensionFrobeniusTwistOverFixedField + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + ExactConstantExtension C N S ≃ₐ[ + exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g] + ExactConstantExtension C N S := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + let sigma := exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup + C (RatFunc C) N S hExact g + exact IntermediateField.subgroupEquivAlgEquiv H + ⟨sigma, Subgroup.mem_zpowers sigma⟩ + +@[simp] +theorem exactConstantExtensionFrobeniusTwistOverFixedField_apply + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (x : ExactConstantExtension C N S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g x = + exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g x := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + change + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g).toEquiv x = + exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g x + rfl + +/-- A rational finite place of a Frobenius-twist field has exactly one finite +place above it in the exact constant extension. -/ +theorem frobeniusTwistField_rationalFinitePlace_fiber_card_eq_one + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ P : FiniteExtensionRationalFinitePlace C F, + Fintype.card (FinitePlaceUnderFiber C F + (ExactConstantExtension C N S) P.1) = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro P + apply rationalFinitePlace_fiber_card_eq_one_of_finrank_dvd_degree + C F T ?_ P + intro Q + rw [finrank_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g hdiv] + exact exactConstantExtensionFinitePlace_finrank_constants_dvd_degree + C N S hExact Q + +/-- Every finite-place lift of a rational Frobenius-twist-field place is +fixed by the canonical twist generator over its fixed field. -/ +theorem frobeniusTwistField_rationalFinitePlace_lift_fixed + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ (P : FiniteExtensionRationalFinitePlace C F) + (Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S)), + finitePlaceUnder C F (ExactConstantExtension C N S) Q = P.1 → + finitePlaceGalSmul C F (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g) Q = Q := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro P Q hQ + apply + finitePlaceGalSmul_eq_self_over_rationalFinitePlace_of_finrank_dvd_degree + C F T ?_ P Q hQ + intro R + rw [finrank_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g hdiv] + exact exactConstantExtensionFinitePlace_finrank_constants_dvd_degree + C N S hExact R + +section RationalFinitePlaceLifts + +variable (K M T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field M] [Field T] + [Algebra (RatFunc K) M] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Algebra (RatFunc K) T] [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M T] [IsScalarTower (RatFunc K) M T] + [FiniteDimensional M T] [IsGalois M T] + +/-- A rational finite place together with a finite place above it. -/ +abbrev RationalFinitePlaceLift := + Σ P : FiniteExtensionRationalFinitePlace K M, + FinitePlaceUnderFiber K M T P.1 + +/-- If the relative degree divides every top place degree, projection from +rational finite-place lifts is an equivalence. Equivalently, every rational +finite place has exactly one top lift. -/ +noncomputable def rationalFinitePlaceEquivLift + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) : + FiniteExtensionRationalFinitePlace K M ≃ + RationalFinitePlaceLift K M T := by + let projection : RationalFinitePlaceLift K M T → + FiniteExtensionRationalFinitePlace K M := fun x => x.1 + refine (Equiv.ofBijective projection ⟨?_, ?_⟩).symm + · rintro ⟨P, Q⟩ ⟨P', Q'⟩ h + dsimp only [projection] at h + subst P' + have hcard := + rationalFinitePlace_fiber_card_eq_one_of_finrank_dvd_degree + K M T hdegree P + obtain ⟨Q₀, hQ₀⟩ := Fintype.card_eq_one_iff.mp hcard + exact Sigma.ext rfl <| heq_of_eq <| + (hQ₀ Q).trans (hQ₀ Q').symm + · intro P + obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective K M T P.1 + exact ⟨⟨P, Q, hQ⟩, rfl⟩ + +/-- Every top lift of a rational finite place is fixed by every relative +Galois automorphism under the degree-divisibility hypothesis. -/ +theorem rationalFinitePlaceLift_fixed + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) + (sigma : T ≃ₐ[M] T) (x : RationalFinitePlaceLift K M T) : + finitePlaceGalSmul K M T sigma x.2.1 = x.2.1 := + finitePlaceGalSmul_eq_self_over_rationalFinitePlace_of_finrank_dvd_degree + K M T hdegree x.1 x.2.1 x.2.2 sigma + +/-- Cardinal form of the rational-place/unique-lift correspondence. -/ +theorem natCard_rationalFinitePlaceLift_eq + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) : + Nat.card (RationalFinitePlaceLift K M T) = + Nat.card (FiniteExtensionRationalFinitePlace K M) := + Nat.card_congr (rationalFinitePlaceEquivLift K M T hdegree).symm + +end RationalFinitePlaceLifts + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean new file mode 100644 index 0000000000..66fc552134 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean @@ -0,0 +1,1063 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge + +/-! +# Unramified finite places over Frobenius-twist fields + +The Galois group of the exact constant extension over a Frobenius-twist +field is the cyclic subgroup generated by the twist. Restriction to the +enlarged constants is injective on this subgroup. An inertia automorphism +acts trivially on every residue class, hence in particular on the embedded +constant field. It therefore lies in the kernel of constant restriction and +must be the identity. Thus every finite place is unramified in the exact +constant extension over a twist field. +-/ + +open scoped Pointwise Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain + + +variable (C N S : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] + +local instance unramifiedConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance unramifiedConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Finite S] + [DecidableEq S] [DecidableEq (RatFunc S)] in +/-- A power of the canonical twist acts on the enlarged constants by the +same power of finite-field Frobenius. This is the constant-factor part of +the tensor-product action and does not require `N / C(X)` to be normal. -/ +private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) (k : ℤ) (s : S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + ((exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) ^ k) + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + (((FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k) s) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + change + ((exactConstantExtensionCombinedAutHom C (RatFunc C) N S + (FiniteField.frobeniusAlgEquivOfAlgebraic C S, g)) ^ k) + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = _ + rw [← map_zpow] + simp [Algebra.TensorProduct.includeLeft_apply, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] + +/-- The canonical twist generates the full Galois group over its fixed +field. This is a direct consequence of defining that fixed field from the +cyclic subgroup generated by the ambient twist. -/ +theorem exactConstantExtensionFrobeniusTwistOverFixedField_zpowers_eq_top + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Subgroup.zpowers + (exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g) = ⊤ := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + let sigma := exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup + C (RatFunc C) N S hExact g + let e := IntermediateField.subgroupEquivAlgEquiv H + let u : H := ⟨sigma, Subgroup.mem_zpowers sigma⟩ + change Subgroup.zpowers (e u) = ⊤ + apply (Subgroup.eq_top_iff' _).mpr + intro tau + let h : H := e.symm tau + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp h.2 + apply Subgroup.mem_zpowers_iff.mpr + refine ⟨k, ?_⟩ + calc + (e u) ^ k = e (u ^ k) := (map_zpow e u k).symm + _ = e h := congrArg e (Subtype.ext hk) + _ = tau := e.apply_symm_apply tau + +/-- If one generator of a relative Galois group fixes a top finite place, +then generation, unramifiedness, and maximal possible top degree force the +restricted finite place to have degree one. -/ +theorem finitePlaceUnder_degree_eq_one_of_generator_fixed + (K M T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Field T] [Algebra (RatFunc K) T] + [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M T] [IsScalarTower (RatFunc K) M T] + [FiniteDimensional M T] [IsGalois M T] + (sigma : T ≃ₐ[M] T) + (hgen : Subgroup.zpowers sigma = ⊤) + (Q : FiniteExtensionFinitePlace K T) + (hfixed : finitePlaceGalSmul K M T sigma Q = Q) + (hunramified : finitePlaceRelativeRamificationIdx K M T Q = 1) + (htopDegree : finiteExtensionPlaceDegree K T (.inl Q) = + Module.finrank M T) : + finiteExtensionPlaceDegree K M + (.inl (finitePlaceUnder K M T Q)) = 1 := by + let P := finitePlaceUnder K M T Q + let Q₀ : FinitePlaceUnderFiber K M T P := ⟨Q, rfl⟩ + letI := finitePlaceGalAction K M T + have hsigma : sigma ∈ + MulAction.stabilizer (T ≃ₐ[M] T) Q := by + rw [MulAction.mem_stabilizer_iff] + exact hfixed + have hall (tau : T ≃ₐ[M] T) : + finitePlaceGalSmul K M T tau Q = Q := by + have hle : Subgroup.zpowers sigma ≤ + MulAction.stabilizer (T ≃ₐ[M] T) Q := + Subgroup.zpowers_le.mpr hsigma + have htau : tau ∈ MulAction.stabilizer (T ≃ₐ[M] T) Q := by + apply hle + rw [hgen] + exact Subgroup.mem_top tau + have hfix := MulAction.mem_stabilizer_iff.mp htau + change finitePlaceGalSmul K M T tau Q = Q at hfix + exact hfix + letI := finitePlaceUnderFiberGalAction K M T P + letI : MulAction.IsPretransitive (T ≃ₐ[M] T) + (FinitePlaceUnderFiber K M T P) := + finitePlaceUnderFiberGalAction_isPretransitive K M T P + have hcard : Fintype.card (FinitePlaceUnderFiber K M T P) = 1 := by + apply Fintype.card_eq_one_iff.mpr + refine ⟨Q₀, ?_⟩ + intro R + obtain ⟨tau, htau⟩ := + MulAction.exists_smul_eq (T ≃ₐ[M] T) Q₀ R + calc + R = tau • Q₀ := htau.symm + _ = Q₀ := by + apply Subtype.ext + exact hall tau + have hfundamental := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M T P Q₀ + dsimp [Q₀] at hfundamental + have hinertia : finitePlaceRelativeInertiaDeg K M T Q = + Module.finrank M T := by + simpa only [hcard, hunramified, one_mul] using hfundamental + have htower := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M T Q + rw [htopDegree, hinertia] at htower + apply Nat.eq_of_mul_eq_mul_right (Module.finrank_pos (R := M) (M := T)) + simpa only [one_mul] using htower.symm + +/-- Conversely, under the same degree-divisibility hypothesis used for the +unique-lift theorem, every lift of a rational finite place has top degree +equal to the relative field degree. -/ +theorem rationalFinitePlace_lift_degree_eq_finrank_of_finrank_dvd_degree + (K M T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Field T] [Algebra (RatFunc K) T] + [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M T] [IsScalarTower (RatFunc K) M T] + [FiniteDimensional M T] [IsGalois M T] + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) + (P : FiniteExtensionRationalFinitePlace K M) + (Q : FiniteExtensionFinitePlace K T) + (hQ : finitePlaceUnder K M T Q = P.1) : + finiteExtensionPlaceDegree K T (.inl Q) = Module.finrank M T := by + let Q₀ : FinitePlaceUnderFiber K M T P.1 := ⟨Q, hQ⟩ + have htower := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M T Q + have hrelative : finitePlaceRelativeInertiaDeg K M T Q = + finiteExtensionPlaceDegree K T (.inl Q) := by + rw [hQ] at htower + simpa only [P.2, one_mul] using htower.symm + have hm_dvd_f : Module.finrank M T ∣ + finitePlaceRelativeInertiaDeg K M T Q := by + rw [hrelative] + exact hdegree Q + have hfundamental := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M T P.1 Q₀ + dsimp [Q₀] at hfundamental + have hf_dvd_m : finitePlaceRelativeInertiaDeg K M T Q ∣ + Module.finrank M T := by + rw [← hfundamental] + exact dvd_mul_left _ _ + exact hrelative.symm.trans (Nat.dvd_antisymm hf_dvd_m hm_dvd_f) + +/-- Rational finite places are equivalent to generator-fixed top finite +places of relative-degree-sized absolute degree, once the relative extension +is unramified and every top degree is divisible by the relative degree. -/ +noncomputable def rationalFinitePlaceEquivGeneratorFixedPlace + (K M T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Field T] [Algebra (RatFunc K) T] + [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M T] [IsScalarTower (RatFunc K) M T] + [FiniteDimensional M T] [IsGalois M T] + (hdegree : ∀ Q : FiniteExtensionFinitePlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inl Q)) + (sigma : T ≃ₐ[M] T) + (hgen : Subgroup.zpowers sigma = ⊤) + (hunramified : ∀ Q : FiniteExtensionFinitePlace K T, + finitePlaceRelativeRamificationIdx K M T Q = 1) : + FiniteExtensionRationalFinitePlace K M ≃ + {Q : FiniteExtensionFinitePlace K T // + finiteExtensionPlaceDegree K T (.inl Q) = Module.finrank M T ∧ + finitePlaceGalSmul K M T sigma Q = Q} := by + let e := rationalFinitePlaceEquivLift K M T hdegree + refine + { toFun := fun P => by + let x := e P + exact ⟨x.2.1, + rationalFinitePlace_lift_degree_eq_finrank_of_finrank_dvd_degree + K M T hdegree x.1 x.2.1 x.2.2, + rationalFinitePlaceLift_fixed K M T hdegree sigma x⟩ + invFun := fun Q => + ⟨finitePlaceUnder K M T Q.1, + finitePlaceUnder_degree_eq_one_of_generator_fixed K M T sigma + hgen Q.1 Q.2.2 (hunramified Q.1) Q.2.1⟩ + left_inv := ?_ + right_inv := ?_ } + · intro P + apply Subtype.ext + let x := e P + have hx1 : x.1 = P := by + change e.symm (e P) = P + exact e.symm_apply_apply P + exact x.2.2.trans (congrArg Subtype.val hx1) + · intro Q + apply Subtype.ext + let P : FiniteExtensionRationalFinitePlace K M := + ⟨finitePlaceUnder K M T Q.1, + finitePlaceUnder_degree_eq_one_of_generator_fixed K M T sigma + hgen Q.1 Q.2.2 (hunramified Q.1) Q.2.1⟩ + let x := e P + have hx1 : x.1 = P := by + change e.symm (e P) = P + exact e.symm_apply_apply P + let xFiber : FinitePlaceUnderFiber K M T P.1 := + ⟨x.2.1, x.2.2.trans (congrArg Subtype.val hx1)⟩ + let qFiber : FinitePlaceUnderFiber K M T P.1 := ⟨Q.1, rfl⟩ + have hcard := + rationalFinitePlace_fiber_card_eq_one_of_finrank_dvd_degree + K M T hdegree P + obtain ⟨z, hz⟩ := Fintype.card_eq_one_iff.mp hcard + have hxy : xFiber = qFiber := (hz xFiber).trans (hz qFiber).symm + change x.2.1 = Q.1 + exact congrArg Subtype.val hxy + +/-- Relative automorphisms over two intermediate fields induce the same +action on top finite places when their underlying top-field maps agree. -/ +theorem finitePlaceGalSmul_eq_of_apply_eq + (K M₁ M₂ T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field M₁] [Algebra (RatFunc K) M₁] + [FiniteDimensional (RatFunc K) M₁] + [Algebra.IsSeparable (RatFunc K) M₁] + [Field M₂] [Algebra (RatFunc K) M₂] + [FiniteDimensional (RatFunc K) M₂] + [Algebra.IsSeparable (RatFunc K) M₂] + [Field T] [Algebra (RatFunc K) T] + [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M₁ T] [IsScalarTower (RatFunc K) M₁ T] + [FiniteDimensional M₁ T] [IsGalois M₁ T] + [Algebra M₂ T] [IsScalarTower (RatFunc K) M₂ T] + [FiniteDimensional M₂ T] [IsGalois M₂ T] + (g₁ : T ≃ₐ[M₁] T) (g₂ : T ≃ₐ[M₂] T) + (happly : ∀ x : T, g₁ x = g₂ x) + (Q : FiniteExtensionFinitePlace K T) : + finitePlaceGalSmul K M₁ T g₁ Q = + finitePlaceGalSmul K M₂ T g₂ Q := by + let A := RatFuncFiniteIntegralClosure K T + let A₁ := RatFuncFiniteIntegralClosure K M₁ + let A₂ := RatFuncFiniteIntegralClosure K M₂ + letI : Algebra K[X] M₁ := + RingHom.toAlgebra + ((algebraMap (RatFunc K) M₁).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) M₁ := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K[X] M₂ := + RingHom.toAlgebra + ((algebraMap (RatFunc K) M₂).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) M₂ := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K[X] T := + RingHom.toAlgebra + ((algebraMap (RatFunc K) T).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) T := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra A₁ A := (finiteIntegralClosureMap K M₁ T).toAlgebra + letI : SMul A₁ A := Algebra.toSMul + letI : Module A₁ A := Algebra.toModule + letI : IsScalarTower A₁ M₁ T := inferInstance + letI : Algebra.IsIntegral K[X] A₁ := + IsIntegralClosure.isIntegral_algebra K[X] M₁ + letI : IsScalarTower K[X] A₁ T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc K) T + (algebraMap K[X] (RatFunc K) x) = + algebraMap M₁ T + (algebraMap (RatFunc K) M₁ + (algebraMap K[X] (RatFunc K) x)) + exact IsScalarTower.algebraMap_apply (RatFunc K) M₁ T _ + letI : IsScalarTower A₁ A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap A₁ A r) = + algebraMap A₁ T r by rfl] + ring⟩ + letI : IsIntegralClosure A A₁ T := + IsIntegralClosure.tower_top (R := K[X]) + letI : Algebra A₂ A := (finiteIntegralClosureMap K M₂ T).toAlgebra + letI : SMul A₂ A := Algebra.toSMul + letI : Module A₂ A := Algebra.toModule + letI : IsScalarTower A₂ M₂ T := inferInstance + letI : Algebra.IsIntegral K[X] A₂ := + IsIntegralClosure.isIntegral_algebra K[X] M₂ + letI : IsScalarTower K[X] A₂ T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc K) T + (algebraMap K[X] (RatFunc K) x) = + algebraMap M₂ T + (algebraMap (RatFunc K) M₂ + (algebraMap K[X] (RatFunc K) x)) + exact IsScalarTower.algebraMap_apply (RatFunc K) M₂ T _ + letI : IsScalarTower A₂ A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap A₂ A r) = + algebraMap A₂ T r by rfl] + ring⟩ + letI : IsIntegralClosure A A₂ T := + IsIntegralClosure.tower_top (R := K[X]) + letI : MulSemiringAction (T ≃ₐ[M₁] T) A := + finiteIntegralClosureGalAction K M₁ T + letI : MulSemiringAction (T ≃ₐ[M₂] T) A := + finiteIntegralClosureGalAction K M₂ T + have hsmul (a₁ : T ≃ₐ[M₁] T) (a₂ : T ≃ₐ[M₂] T) + (ha : ∀ x : T, a₁ x = a₂ x) (x : A) : a₁ • x = a₂ • x := by + apply Subtype.ext + calc + ((a₁ • x : A) : T) = a₁ (x : T) := by + change algebraMap A T ((galRestrict A₁ M₁ T A a₁) x) = + a₁ (algebraMap A T x) + exact algebraMap_galRestrict_apply A₁ a₁ x + _ = a₂ (x : T) := ha _ + _ = ((a₂ • x : A) : T) := by + change a₂ (algebraMap A T x) = + algebraMap A T ((galRestrict A₂ M₂ T A a₂) x) + exact (algebraMap_galRestrict_apply A₂ a₂ x).symm + have happly_inv (x : T) : g₁⁻¹ x = g₂⁻¹ x := by + apply g₂.injective + calc + g₂ (g₁⁻¹ x) = g₁ (g₁⁻¹ x) := (happly _).symm + _ = x := g₁.apply_symm_apply x + _ = g₂ (g₂⁻¹ x) := (g₂.apply_symm_apply x).symm + apply HeightOneSpectrum.ext + change g₁ • Q.asIdeal = g₂ • Q.asIdeal + ext x + rw [Ideal.mem_pointwise_smul_iff_inv_smul_mem, + Ideal.mem_pointwise_smul_iff_inv_smul_mem, + hsmul g₁⁻¹ g₂⁻¹ happly_inv x] + +/-- Every finite place of the exact constant extension is unramified over a +Frobenius-twist fixed field, provided the twist has the full +constant-extension order. -/ +theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finitePlaceRelativeRamificationIdx C F + (ExactConstantExtension C N S) Q = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra C[X] T := + RingHom.toAlgebra + ((algebraMap (RatFunc C) T).comp (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C[X] (RatFunc C) T := + IsScalarTower.of_algebraMap_eq' rfl + let A := RatFuncFiniteIntegralClosure C T + let AF := RatFuncFiniteIntegralClosure C F + letI : Algebra AF A := (finiteIntegralClosureMap C F T).toAlgebra + letI : SMul AF A := Algebra.toSMul + letI : Module AF A := Algebra.toModule + letI : Algebra S A := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : IsScalarTower AF F T := inferInstance + letI : Algebra.IsIntegral C[X] AF := + IsIntegralClosure.isIntegral_algebra C[X] F + letI : IsScalarTower C[X] AF T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc C) T + (algebraMap C[X] (RatFunc C) x) = + algebraMap F T + (algebraMap (RatFunc C) F + (algebraMap C[X] (RatFunc C) x)) + exact IsScalarTower.algebraMap_apply (RatFunc C) F T _ + letI : IsScalarTower AF A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap AF A r) = + algebraMap AF T r by rfl] + ring⟩ + letI : IsIntegralClosure A AF T := + IsIntegralClosure.tower_top (R := C[X]) + letI : IsDedekindDomain A := inferInstance + letI : MulSemiringAction (T ≃ₐ[F] T) A := + finiteIntegralClosureGalAction C F T + dsimp only + intro Q + letI : Q.asIdeal.IsMaximal := Q.isMaximal + rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C F T Q] + have hInertia : finitePlaceInertiaGroup C F T Q = ⊥ := by + ext tau + constructor + · intro htau + rw [Subgroup.mem_bot] + let sigma := exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup + C (RatFunc C) N S hExact g + let e := IntermediateField.subgroupEquivAlgEquiv H + let h : H := e.symm tau + have he_apply (z : H) (x : T) : e z x = z.1 x := by + change z.1.toEquiv x = z.1 x + rfl + have htau_apply (x : T) : tau x = h.1 x := by + calc + tau x = e h x := by + exact congrArg (fun z : T ≃ₐ[F] T => z x) + (e.apply_symm_apply tau).symm + _ = h.1 x := he_apply h x + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp h.2 + let frob := FiniteField.frobeniusAlgEquivOfAlgebraic C S + have hfrob_apply (s : S) : (frob ^ k) s = s := by + let a : A := algebraMap S A s + have haction : tau • a = algebraMap S A ((frob ^ k) s) := by + apply Subtype.ext + calc + ((tau • a : A) : T) = tau (a : T) := by + change algebraMap A T ((galRestrict AF F T A tau) a) = + tau (algebraMap A T a) + exact algebraMap_galRestrict_apply AF tau a + _ = h.1 (a : T) := htau_apply (a : T) + _ = h.1 (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) := by + exact congrArg h.1 + (exactConstantExtensionFiniteIntegralClosure_algebraMap_val + C N S hExact s) + _ = (sigma ^ k) (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) := by + exact congrArg + (fun z : T ≃ₐ[RatFunc C] T => + z (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s)) + hk |>.symm + _ = Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + ((frob ^ k) s) := by + exact exactConstantExtensionFrobeniusTwist_zpow_includeLeft + C N S hExact g k s + _ = ((algebraMap S A ((frob ^ k) s) : A) : T) := by + exact + (exactConstantExtensionFiniteIntegralClosure_algebraMap_val + C N S hExact ((frob ^ k) s)).symm + have hmem : tau • a - a ∈ Q.asIdeal := htau a + have hmem' : algebraMap S A ((frob ^ k) s - s) ∈ Q.asIdeal := by + have heq : algebraMap S A ((frob ^ k) s - s) = tau • a - a := by + calc + algebraMap S A ((frob ^ k) s - s) = + algebraMap S A ((frob ^ k) s) - algebraMap S A s := + map_sub (algebraMap S A) _ _ + _ = algebraMap S A ((frob ^ k) s) - a := rfl + _ = tau • a - a := congrArg (fun z : A => z - a) haction.symm + exact heq.symm ▸ hmem + let J : Ideal S := Q.asIdeal.comap (algebraMap S A) + have hmemJ : (frob ^ k) s - s ∈ J := hmem' + have hJne : J ≠ ⊤ := by + exact Ideal.comap_ne_top (algebraMap S A) Q.isPrime.ne_top + have hJ : J = ⊥ := (Ideal.eq_bot_or_top J).resolve_right hJne + have hs : (frob ^ k) s - s = 0 := by + rw [hJ] at hmemJ + simpa only [Ideal.mem_bot] using hmemJ + exact sub_eq_zero.mp hs + have hFrob : frob ^ k = 1 := by + ext s + exact hfrob_apply s + have hkdiv : (Module.finrank C S : ℤ) ∣ k := by + rw [← FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S] + exact orderOf_dvd_iff_zpow_eq_one.mpr hFrob + have hsigma : sigma ^ k = 1 := by + rw [← orderOf_dvd_iff_zpow_eq_one, + orderOf_exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g hdiv] + exact hkdiv + have hambient : (h.1 : T ≃ₐ[RatFunc C] T) = 1 := by + calc + (h.1 : T ≃ₐ[RatFunc C] T) = sigma ^ k := hk.symm + _ = 1 := hsigma + have hh : h = 1 := Subtype.ext hambient + calc + tau = e h := (e.apply_symm_apply tau).symm + _ = e 1 := congrArg e hh + _ = 1 := map_one e + · intro htau + rw [Subgroup.mem_bot] at htau + simp [htau] + rw [hInertia] + exact Nat.card_unique + +/-- A top finite place of degree `[S : C]` fixed by the canonical twist +descends to a rational finite place of the Frobenius-twist fixed field. -/ +theorem frobeniusTwistField_fixed_finitePlace_under_degree_eq_one + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = + Module.finrank C S → + finitePlaceGalSmul C F (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g) Q = Q → + finiteExtensionPlaceDegree C F + (.inl (finitePlaceUnder C F + (ExactConstantExtension C N S) Q)) = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro Q hdegree hfixed + apply finitePlaceUnder_degree_eq_one_of_generator_fixed + C F T + (exactConstantExtensionFrobeniusTwistOverFixedField C N S hExact g) + (exactConstantExtensionFrobeniusTwistOverFixedField_zpowers_eq_top + C N S hExact g) + Q hfixed + · exact frobeniusTwistField_finitePlace_ramificationIdx_eq_one + C N S hExact g hdiv Q + · calc + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank C S := hdegree + _ = Module.finrank F T := + (finrank_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g hdiv).symm + +/-- The canonical twist over its fixed field and the ambient twist over +`C(X)` induce exactly the same action on finite places. -/ +theorem exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedField + [IsGalois (RatFunc C) N] + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finitePlaceGalSmul C F (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g) Q = + finitePlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro Q + apply finitePlaceGalSmul_eq_of_apply_eq C F (RatFunc C) T + intro x + exact exactConstantExtensionFrobeniusTwistOverFixedField_apply + C N S hExact g x + +/-- Ambient fixedness by the Frobenius twist is therefore the exact +fixedness condition needed for descent to a rational twist-field place. -/ +theorem frobeniusTwistField_ambientFixed_finitePlace_under_degree_eq_one + [IsGalois (RatFunc C) N] + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = + Module.finrank C S → + finitePlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q = Q → + finiteExtensionPlaceDegree C F + (.inl (finitePlaceUnder C F + (ExactConstantExtension C N S) Q)) = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro Q hdegree hfixed + apply frobeniusTwistField_fixed_finitePlace_under_degree_eq_one + C N S hExact g hdiv Q hdegree + rw [exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedField + C N S hExact g Q] + exact hfixed + +/-- Rational finite places of the Frobenius-twist field are exactly the +degree-`[S : C]` top finite places fixed by the ambient Frobenius twist. -/ +noncomputable def + frobeniusTwistField_rationalFinitePlace_equiv_ambientFixedFinitePlace + [IsGalois (RatFunc C) N] + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + FiniteExtensionRationalFinitePlace C F ≃ + {Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S) // + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = + Module.finrank C S ∧ + finitePlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q = Q} := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + have hfinrank : Module.finrank F T = Module.finrank C S := + finrank_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g hdiv + have hdegree : ∀ Q : FiniteExtensionFinitePlace C T, + Module.finrank F T ∣ finiteExtensionPlaceDegree C T (.inl Q) := by + intro Q + rw [hfinrank] + exact exactConstantExtensionFinitePlace_finrank_constants_dvd_degree + C N S hExact Q + let sigmaF := + exactConstantExtensionFrobeniusTwistOverFixedField C N S hExact g + let eFixed := rationalFinitePlaceEquivGeneratorFixedPlace + C F T hdegree sigmaF + (exactConstantExtensionFrobeniusTwistOverFixedField_zpowers_eq_top + C N S hExact g) + (frobeniusTwistField_finitePlace_ramificationIdx_eq_one + C N S hExact g hdiv) + let eCompare : + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank F T ∧ + finitePlaceGalSmul C F T sigmaF Q = Q} ≃ + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank C S ∧ + finitePlaceGalSmul C (RatFunc C) T + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q = Q} := + { toFun := fun Q => ⟨Q.1, + Q.2.1.trans hfinrank, + (exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedField + C N S hExact g Q.1).symm.trans Q.2.2⟩ + invFun := fun Q => ⟨Q.1, + Q.2.1.trans hfinrank.symm, + (exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedField + C N S hExact g Q.1).trans Q.2.2⟩ + left_inv := fun Q => Subtype.ext rfl + right_inv := fun Q => Subtype.ext rfl } + exact eFixed.trans eCompare + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean new file mode 100644 index 0000000000..671575f640 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv + +/-! +# Genus of Frobenius-twist fixed fields + +Extending the constants of a Frobenius-twist fixed field gives the common +exact constant extension. Genus invariance under exact extension of finite +constants therefore identifies the genus of every twist with the genus of +the original function field. This is Proposition 5.2.8(b) in the form used +by the uniform Stepanov estimate. +-/ + +namespace BGS.HasseWeil + +noncomputable section + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance twistGenusBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance twistGenusBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Every canonical Frobenius-twist fixed field has the genus of the +original exact-constant Galois function field. The equality is independent +of the auxiliary constant extension. -/ +theorem genus_frobeniusTwistField_eq_original + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (g : N ≃ₐ[RatFunc C] N) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra + FunctionField.genus C F = FunctionField.genus C N := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + letI : IsScalarTower C (RatFunc C) F := + IsScalarTower.of_algebraMap_eq' rfl + have hExactF : algebraicClosure C F = + (⊥ : IntermediateField C F) := + exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C (RatFunc C) N S hExact g + let U := ExactConstantExtension C F S + letI : Field U := exactConstantExtensionField C F S hExactF + letI : Algebra S U := Algebra.TensorProduct.leftAlgebra + letI : Algebra S T := Algebra.TensorProduct.leftAlgebra + let e : U ≃ₐ[S] T := + exactConstantExtensionFrobeniusTwistMultiplicationAlgEquivOverConstants + C (RatFunc C) N S hExact g hdiv + have hF : FunctionField.genus S U = FunctionField.genus C F := + exactConstantExtension_genus_eq C S F hExactF + have hN : FunctionField.genus S T = FunctionField.genus C N := + exactConstantExtension_genus_eq C S N hExact + calc + FunctionField.genus C F = FunctionField.genus S U := hF.symm + _ = FunctionField.genus S T := FunctionField.genus_eq_of_algEquiv e + _ = FunctionField.genus C N := hN + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean new file mode 100644 index 0000000000..686609f6ce --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean @@ -0,0 +1,799 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified + +/-! +# Infinity places of Frobenius-twist fields + +This file proves the infinity-place counterpart of the finite-place descent +used in Frobenius-coset averaging. The generic part first identifies rational +infinity places of an intermediate function field with the unique top places +above them. Under unramifiedness, a top infinity place of maximal possible +degree fixed by a generator of the relative Galois group descends to a +rational infinity place. + +For an exact constant extension, every top infinity-place degree is divisible +by the constant-field degree. This is obtained from the reciprocal +normalization presentation, whose equivalence with the actual infinity-place +type is already exhaustive. +-/ + +open scoped Pointwise Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +section GenericInfinityDescent + +variable (K M T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field M] [Field T] + [Algebra (RatFunc K) M] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] + [Algebra (RatFunc K) T] [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M T] [IsScalarTower (RatFunc K) M T] + [FiniteDimensional M T] [IsGalois M T] + +/-- If every top infinity-place degree is divisible by the relative field +degree, then every rational infinity place downstairs has a unique top place +above it. -/ +theorem rationalInfinityPlace_fiber_card_eq_one_of_finrank_dvd_degree + (hdegree : ∀ Q : FiniteExtensionInfinityPlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inr Q)) + (P : FiniteExtensionRationalInfinityPlace K M) : + Fintype.card (InfinityPlaceUnderFiber K M T P.1) = 1 := by + obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective K M T P.1 + let Q₀ : InfinityPlaceUnderFiber K M T P.1 := ⟨Q, hQ⟩ + have hplaceDegree := + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M T Q + have hrelative : infinityPlaceRelativeInertiaDeg K M T Q = + finiteExtensionPlaceDegree K T (.inr Q) := by + rw [hQ] at hplaceDegree + simpa [P.2] using hplaceDegree.symm + have hm_dvd_f : Module.finrank M T ∣ + infinityPlaceRelativeInertiaDeg K M T Q := by + rw [hrelative] + exact hdegree Q + have hfiber := + infinityPlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M T P.1 Q₀ + dsimp [Q₀] at hfiber + have hf_dvd_m : infinityPlaceRelativeInertiaDeg K M T Q ∣ + Module.finrank M T := by + rw [← hfiber] + exact dvd_mul_left _ _ + have hf : infinityPlaceRelativeInertiaDeg K M T Q = + Module.finrank M T := Nat.dvd_antisymm hf_dvd_m hm_dvd_f + have hmpos : 0 < Module.finrank M T := Module.finrank_pos + have hproduct : + Fintype.card (InfinityPlaceUnderFiber K M T P.1) * + infinityPlaceRelativeRamificationIdx K M T Q = 1 := by + apply Nat.eq_of_mul_eq_mul_right hmpos + simpa [Nat.mul_assoc, hf] using hfiber + exact Nat.eq_one_of_dvd_one + ⟨infinityPlaceRelativeRamificationIdx K M T Q, hproduct.symm⟩ + +/-- Under the same degree-divisibility hypothesis, every relative Galois +automorphism fixes every infinity place above a rational infinity place. -/ +theorem infinityPlaceGalSmul_eq_self_over_rationalInfinityPlace_of_finrank_dvd_degree + (hdegree : ∀ Q : FiniteExtensionInfinityPlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inr Q)) + (P : FiniteExtensionRationalInfinityPlace K M) + (Q : FiniteExtensionInfinityPlace K T) + (hQ : infinityPlaceUnder K M T Q = P.1) + (sigma : T ≃ₐ[M] T) : + infinityPlaceGalSmul K M T sigma Q = Q := by + letI := infinityIntegralClosureGalAction K M T + letI := infinityPlaceUnderFiberGalAction K M T P.1 + have hcard := + rationalInfinityPlace_fiber_card_eq_one_of_finrank_dvd_degree + K M T hdegree P + obtain ⟨Q₀, hQ₀⟩ := Fintype.card_eq_one_iff.mp hcard + let x : InfinityPlaceUnderFiber K M T P.1 := ⟨Q, hQ⟩ + let y : InfinityPlaceUnderFiber K M T P.1 := + ⟨infinityPlaceGalSmul K M T sigma Q, by + rw [infinityPlaceUnder_infinityPlaceGalSmul, hQ]⟩ + have hxy : x = y := (hQ₀ x).trans (hQ₀ y).symm + exact congrArg Subtype.val hxy |>.symm + +/-- A rational infinity place together with its top infinity-place lift. -/ +abbrev RationalInfinityPlaceLift := + Σ P : FiniteExtensionRationalInfinityPlace K M, + InfinityPlaceUnderFiber K M T P.1 + +/-- Projection from rational infinity-place lifts is an equivalence when +every top degree is divisible by the relative degree. -/ +noncomputable def rationalInfinityPlaceEquivLift + (hdegree : ∀ Q : FiniteExtensionInfinityPlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inr Q)) : + FiniteExtensionRationalInfinityPlace K M ≃ + RationalInfinityPlaceLift K M T := by + let projection : RationalInfinityPlaceLift K M T → + FiniteExtensionRationalInfinityPlace K M := fun x => x.1 + refine (Equiv.ofBijective projection ⟨?_, ?_⟩).symm + · rintro ⟨P, Q⟩ ⟨P', Q'⟩ h + dsimp only [projection] at h + subst P' + have hcard := + rationalInfinityPlace_fiber_card_eq_one_of_finrank_dvd_degree + K M T hdegree P + obtain ⟨Q₀, hQ₀⟩ := Fintype.card_eq_one_iff.mp hcard + exact Sigma.ext rfl <| heq_of_eq <| + (hQ₀ Q).trans (hQ₀ Q').symm + · intro P + obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective K M T P.1 + exact ⟨⟨P, Q, hQ⟩, rfl⟩ + +/-- Every lift of a rational infinity place is fixed by every relative +Galois automorphism under the degree-divisibility hypothesis. -/ +theorem rationalInfinityPlaceLift_fixed + (hdegree : ∀ Q : FiniteExtensionInfinityPlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inr Q)) + (sigma : T ≃ₐ[M] T) (x : RationalInfinityPlaceLift K M T) : + infinityPlaceGalSmul K M T sigma x.2.1 = x.2.1 := + infinityPlaceGalSmul_eq_self_over_rationalInfinityPlace_of_finrank_dvd_degree + K M T hdegree x.1 x.2.1 x.2.2 sigma + +/-- If a generator fixes a top infinity place, then generation, +unramifiedness, and maximal top degree force its restriction to have degree +one. -/ +theorem infinityPlaceUnder_degree_eq_one_of_generator_fixed + (sigma : T ≃ₐ[M] T) + (hgen : Subgroup.zpowers sigma = ⊤) + (Q : FiniteExtensionInfinityPlace K T) + (hfixed : infinityPlaceGalSmul K M T sigma Q = Q) + (hunramified : infinityPlaceRelativeRamificationIdx K M T Q = 1) + (htopDegree : finiteExtensionPlaceDegree K T (.inr Q) = + Module.finrank M T) : + finiteExtensionPlaceDegree K M + (.inr (infinityPlaceUnder K M T Q)) = 1 := by + let P := infinityPlaceUnder K M T Q + let Q₀ : InfinityPlaceUnderFiber K M T P := ⟨Q, rfl⟩ + letI := infinityPlaceGalAction K M T + have hsigma : sigma ∈ + MulAction.stabilizer (T ≃ₐ[M] T) Q := by + rw [MulAction.mem_stabilizer_iff] + exact hfixed + have hall (tau : T ≃ₐ[M] T) : + infinityPlaceGalSmul K M T tau Q = Q := by + have hle : Subgroup.zpowers sigma ≤ + MulAction.stabilizer (T ≃ₐ[M] T) Q := + Subgroup.zpowers_le.mpr hsigma + have htau : tau ∈ MulAction.stabilizer (T ≃ₐ[M] T) Q := by + apply hle + rw [hgen] + exact Subgroup.mem_top tau + have hfix := MulAction.mem_stabilizer_iff.mp htau + change infinityPlaceGalSmul K M T tau Q = Q at hfix + exact hfix + letI := infinityPlaceUnderFiberGalAction K M T P + letI : MulAction.IsPretransitive (T ≃ₐ[M] T) + (InfinityPlaceUnderFiber K M T P) := + infinityPlaceUnderFiberGalAction_isPretransitive K M T P + have hcard : Fintype.card (InfinityPlaceUnderFiber K M T P) = 1 := by + apply Fintype.card_eq_one_iff.mpr + refine ⟨Q₀, ?_⟩ + intro R + obtain ⟨tau, htau⟩ := + MulAction.exists_smul_eq (T ≃ₐ[M] T) Q₀ R + calc + R = tau • Q₀ := htau.symm + _ = Q₀ := by + apply Subtype.ext + exact hall tau + have hfundamental := + infinityPlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M T P Q₀ + dsimp [Q₀] at hfundamental + have hinertia : infinityPlaceRelativeInertiaDeg K M T Q = + Module.finrank M T := by + simpa only [hcard, hunramified, one_mul] using hfundamental + have htower := + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M T Q + rw [htopDegree, hinertia] at htower + apply Nat.eq_of_mul_eq_mul_right (Module.finrank_pos (R := M) (M := T)) + simpa only [one_mul] using htower.symm + +/-- Every lift of a rational infinity place has top degree equal to the +relative field degree under the degree-divisibility hypothesis. -/ +theorem rationalInfinityPlace_lift_degree_eq_finrank_of_finrank_dvd_degree + (hdegree : ∀ Q : FiniteExtensionInfinityPlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inr Q)) + (P : FiniteExtensionRationalInfinityPlace K M) + (Q : FiniteExtensionInfinityPlace K T) + (hQ : infinityPlaceUnder K M T Q = P.1) : + finiteExtensionPlaceDegree K T (.inr Q) = Module.finrank M T := by + let Q₀ : InfinityPlaceUnderFiber K M T P.1 := ⟨Q, hQ⟩ + have htower := + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M T Q + have hrelative : infinityPlaceRelativeInertiaDeg K M T Q = + finiteExtensionPlaceDegree K T (.inr Q) := by + rw [hQ] at htower + simpa only [P.2, one_mul] using htower.symm + have hm_dvd_f : Module.finrank M T ∣ + infinityPlaceRelativeInertiaDeg K M T Q := by + rw [hrelative] + exact hdegree Q + have hfundamental := + infinityPlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + K M T P.1 Q₀ + dsimp [Q₀] at hfundamental + have hf_dvd_m : infinityPlaceRelativeInertiaDeg K M T Q ∣ + Module.finrank M T := by + rw [← hfundamental] + exact dvd_mul_left _ _ + exact hrelative.symm.trans (Nat.dvd_antisymm hf_dvd_m hm_dvd_f) + +/-- Rational infinity places are equivalent to generator-fixed top infinity +places of relative-degree-sized absolute degree, once the relative extension +is unramified and every top degree is divisible by the relative degree. -/ +noncomputable def rationalInfinityPlaceEquivGeneratorFixedPlace + (hdegree : ∀ Q : FiniteExtensionInfinityPlace K T, + Module.finrank M T ∣ finiteExtensionPlaceDegree K T (.inr Q)) + (sigma : T ≃ₐ[M] T) + (hgen : Subgroup.zpowers sigma = ⊤) + (hunramified : ∀ Q : FiniteExtensionInfinityPlace K T, + infinityPlaceRelativeRamificationIdx K M T Q = 1) : + FiniteExtensionRationalInfinityPlace K M ≃ + {Q : FiniteExtensionInfinityPlace K T // + finiteExtensionPlaceDegree K T (.inr Q) = Module.finrank M T ∧ + infinityPlaceGalSmul K M T sigma Q = Q} := by + let e := rationalInfinityPlaceEquivLift K M T hdegree + refine + { toFun := fun P => by + let x := e P + exact ⟨x.2.1, + rationalInfinityPlace_lift_degree_eq_finrank_of_finrank_dvd_degree + K M T hdegree x.1 x.2.1 x.2.2, + rationalInfinityPlaceLift_fixed K M T hdegree sigma x⟩ + invFun := fun Q => + ⟨infinityPlaceUnder K M T Q.1, + infinityPlaceUnder_degree_eq_one_of_generator_fixed K M T sigma + hgen Q.1 Q.2.2 (hunramified Q.1) Q.2.1⟩ + left_inv := ?_ + right_inv := ?_ } + · intro P + apply Subtype.ext + let x := e P + have hx1 : x.1 = P := by + change e.symm (e P) = P + exact e.symm_apply_apply P + exact x.2.2.trans (congrArg Subtype.val hx1) + · intro Q + apply Subtype.ext + let P : FiniteExtensionRationalInfinityPlace K M := + ⟨infinityPlaceUnder K M T Q.1, + infinityPlaceUnder_degree_eq_one_of_generator_fixed K M T sigma + hgen Q.1 Q.2.2 (hunramified Q.1) Q.2.1⟩ + let x := e P + have hx1 : x.1 = P := by + change e.symm (e P) = P + exact e.symm_apply_apply P + let xFiber : InfinityPlaceUnderFiber K M T P.1 := + ⟨x.2.1, x.2.2.trans (congrArg Subtype.val hx1)⟩ + let qFiber : InfinityPlaceUnderFiber K M T P.1 := ⟨Q.1, rfl⟩ + have hcard := + rationalInfinityPlace_fiber_card_eq_one_of_finrank_dvd_degree + K M T hdegree P + obtain ⟨z, hz⟩ := Fintype.card_eq_one_iff.mp hcard + have hxy : xFiber = qFiber := (hz xFiber).trans (hz qFiber).symm + change x.2.1 = Q.1 + exact congrArg Subtype.val hxy + +/-- Relative automorphisms over two intermediate fields induce the same +action on top infinity places when their underlying top-field maps agree. -/ +theorem infinityPlaceGalSmul_eq_of_apply_eq + (K M₁ M₂ T : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field M₁] [Algebra (RatFunc K) M₁] + [FiniteDimensional (RatFunc K) M₁] + [Algebra.IsSeparable (RatFunc K) M₁] + [Field M₂] [Algebra (RatFunc K) M₂] + [FiniteDimensional (RatFunc K) M₂] + [Algebra.IsSeparable (RatFunc K) M₂] + [Field T] [Algebra (RatFunc K) T] + [FiniteDimensional (RatFunc K) T] + [Algebra.IsSeparable (RatFunc K) T] + [Algebra M₁ T] [IsScalarTower (RatFunc K) M₁ T] + [FiniteDimensional M₁ T] [IsGalois M₁ T] + [Algebra M₂ T] [IsScalarTower (RatFunc K) M₂ T] + [FiniteDimensional M₂ T] [IsGalois M₂ T] + (g₁ : T ≃ₐ[M₁] T) (g₂ : T ≃ₐ[M₂] T) + (happly : ∀ x : T, g₁ x = g₂ x) + (Q : FiniteExtensionInfinityPlace K T) : + infinityPlaceGalSmul K M₁ T g₁ Q = + infinityPlaceGalSmul K M₂ T g₂ Q := by + let V := RatFuncInfinityIntegers K + let A := RatFuncInfinityIntegralClosure K T + let A₁ := RatFuncInfinityIntegralClosure K M₁ + let A₂ := RatFuncInfinityIntegralClosure K M₂ + letI : Algebra V (RatFunc K) := + RingHom.toAlgebra + (SubringClass.subtype ((RatFunc.inftyValuation K).integer)) + letI : SMul V (RatFunc K) := Algebra.toSMul + letI : Module V (RatFunc K) := Algebra.toModule + letI : IsFractionRing V (RatFunc K) := + (Valuation.integer.integers (RatFunc.inftyValuation K)).isFractionRing + letI : Algebra V M₁ := + RingHom.toAlgebra + ((algebraMap (RatFunc K) M₁).comp (algebraMap V (RatFunc K))) + letI : SMul V M₁ := Algebra.toSMul + letI : Module V M₁ := Algebra.toModule + letI : IsScalarTower V (RatFunc K) M₁ := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra V M₂ := + RingHom.toAlgebra + ((algebraMap (RatFunc K) M₂).comp (algebraMap V (RatFunc K))) + letI : SMul V M₂ := Algebra.toSMul + letI : Module V M₂ := Algebra.toModule + letI : IsScalarTower V (RatFunc K) M₂ := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra V T := + RingHom.toAlgebra + ((algebraMap (RatFunc K) T).comp (algebraMap V (RatFunc K))) + letI : SMul V T := Algebra.toSMul + letI : Module V T := Algebra.toModule + letI : IsScalarTower V (RatFunc K) T := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsIntegralClosure A₁ V M₁ := + integralClosure.isIntegralClosure V M₁ + letI : IsScalarTower V A₁ M₁ := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing A₁ M₁ := + IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc K) M₁ A₁ + letI : IsIntegralClosure A₂ V M₂ := + integralClosure.isIntegralClosure V M₂ + letI : IsScalarTower V A₂ M₂ := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing A₂ M₂ := + IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc K) M₂ A₂ + letI : IsIntegralClosure A V T := + integralClosure.isIntegralClosure V T + letI : IsScalarTower V A T := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing A T := + IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc K) T A + letI : Algebra A₁ A := (infinityIntegralClosureMap K M₁ T).toAlgebra + letI : SMul A₁ A := Algebra.toSMul + letI : Module A₁ A := Algebra.toModule + letI : IsScalarTower A₁ M₁ T := inferInstance + letI : Algebra.IsIntegral V A₁ := + IsIntegralClosure.isIntegral_algebra V M₁ + letI : IsScalarTower V A₁ T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc K) T + (algebraMap V (RatFunc K) x) = + algebraMap M₁ T + (algebraMap (RatFunc K) M₁ + (algebraMap V (RatFunc K) x)) + exact IsScalarTower.algebraMap_apply (RatFunc K) M₁ T _ + letI : IsScalarTower A₁ A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap A₁ A r) = + algebraMap A₁ T r by rfl] + ring⟩ + letI : IsIntegralClosure A A₁ T := + IsIntegralClosure.tower_top (R := V) + letI : Algebra A₂ A := (infinityIntegralClosureMap K M₂ T).toAlgebra + letI : SMul A₂ A := Algebra.toSMul + letI : Module A₂ A := Algebra.toModule + letI : IsScalarTower A₂ M₂ T := inferInstance + letI : Algebra.IsIntegral V A₂ := + IsIntegralClosure.isIntegral_algebra V M₂ + letI : IsScalarTower V A₂ T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc K) T + (algebraMap V (RatFunc K) x) = + algebraMap M₂ T + (algebraMap (RatFunc K) M₂ + (algebraMap V (RatFunc K) x)) + exact IsScalarTower.algebraMap_apply (RatFunc K) M₂ T _ + letI : IsScalarTower A₂ A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap A₂ A r) = + algebraMap A₂ T r by rfl] + ring⟩ + letI : IsIntegralClosure A A₂ T := + IsIntegralClosure.tower_top (R := V) + letI : MulSemiringAction (T ≃ₐ[M₁] T) A := + infinityIntegralClosureGalAction K M₁ T + letI : MulSemiringAction (T ≃ₐ[M₂] T) A := + infinityIntegralClosureGalAction K M₂ T + have hsmul (a₁ : T ≃ₐ[M₁] T) (a₂ : T ≃ₐ[M₂] T) + (ha : ∀ x : T, a₁ x = a₂ x) (x : A) : a₁ • x = a₂ • x := by + apply Subtype.ext + calc + ((a₁ • x : A) : T) = a₁ (x : T) := by + change algebraMap A T ((galRestrict A₁ M₁ T A a₁) x) = + a₁ (algebraMap A T x) + exact algebraMap_galRestrict_apply A₁ a₁ x + _ = a₂ (x : T) := ha _ + _ = ((a₂ • x : A) : T) := by + change a₂ (algebraMap A T x) = + algebraMap A T ((galRestrict A₂ M₂ T A a₂) x) + exact (algebraMap_galRestrict_apply A₂ a₂ x).symm + have happly_inv (x : T) : g₁⁻¹ x = g₂⁻¹ x := by + apply g₂.injective + calc + g₂ (g₁⁻¹ x) = g₁ (g₁⁻¹ x) := (happly _).symm + _ = x := g₁.apply_symm_apply x + _ = g₂ (g₂⁻¹ x) := (g₂.apply_symm_apply x).symm + apply Subtype.ext + change g₁ • Q.1 = g₂ • Q.1 + ext x + rw [Ideal.mem_pointwise_smul_iff_inv_smul_mem, + Ideal.mem_pointwise_smul_iff_inv_smul_mem, + hsmul g₁⁻¹ g₂⁻¹ happly_inv x] + +end GenericInfinityDescent + +variable (C N S : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] + +local instance twistInfinityConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance twistInfinityConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +section ExactConstantExtensionInfinityDegree + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- Every infinity place of the exact constant extension, viewed over the +original constants `C`, has degree divisible by `[S : C]`. -/ +theorem exactConstantExtensionInfinityPlace_finrank_constants_dvd_degree + (Q : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + FiniteExtensionInfinityPlace C (ExactConstantExtension C N S)) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Module.finrank C S ∣ finiteExtensionPlaceDegree C + (ExactConstantExtension C N S) (.inr Q) := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) T := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) T := Algebra.toSMul + letI : Module (RatFunc S) T := Algebra.toModule + letI : FiniteDimensional (RatFunc S) T := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) T := + isSeparable_over_extendedRatFunc C S N hExact + let e := exactConstantExtensionPresentedInfinityPlaceEquiv + C S N hExact + let q := e.symm Q + have hdegree := + exactConstantExtensionPresentedInfinityPlace_degree_baseChange + C S N hExact q + have heq : e q = Q := e.apply_symm_apply Q + rw [heq] at hdegree + rw [hdegree] + exact dvd_mul_right _ _ + +end ExactConstantExtensionInfinityDegree + +section FrobeniusTwistInfinityUnramified + +/-- Powers of the ambient twist act on enlarged constants by the +corresponding powers of finite-field Frobenius. -/ +private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft_infinity + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) (k : ℤ) (s : S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + ((exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) ^ k) + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + (((FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k) s) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + change + ((exactConstantExtensionCombinedAutHom C (RatFunc C) N S + (FiniteField.frobeniusAlgEquivOfAlgebraic C S, g)) ^ k) + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = _ + rw [← map_zpow] + simp [Algebra.TensorProduct.includeLeft_apply, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] + +/-- Every infinity place of the exact constant extension is unramified over a +Frobenius-twist fixed field, provided the twist has the full +constant-extension order. -/ +theorem frobeniusTwistField_infinityPlace_ramificationIdx_eq_one + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S), + infinityPlaceRelativeRamificationIdx C F + (ExactConstantExtension C N S) Q = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + let V := RatFuncInfinityIntegers C + letI : Algebra V (RatFunc C) := + RingHom.toAlgebra + (SubringClass.subtype ((RatFunc.inftyValuation C).integer)) + letI : SMul V (RatFunc C) := Algebra.toSMul + letI : Module V (RatFunc C) := Algebra.toModule + letI : IsFractionRing V (RatFunc C) := + (Valuation.integer.integers (RatFunc.inftyValuation C)).isFractionRing + letI : Algebra V T := + RingHom.toAlgebra + ((algebraMap (RatFunc C) T).comp (algebraMap V (RatFunc C))) + letI : SMul V T := Algebra.toSMul + letI : Module V T := Algebra.toModule + letI : IsScalarTower V (RatFunc C) T := + IsScalarTower.of_algebraMap_eq' rfl + let A := RatFuncInfinityIntegralClosure C T + let AF := RatFuncInfinityIntegralClosure C F + letI : IsIntegralClosure AF V F := + integralClosure.isIntegralClosure V F + letI : IsScalarTower V AF F := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing AF F := + IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc C) F AF + letI : IsIntegralClosure A V T := + integralClosure.isIntegralClosure V T + letI : IsScalarTower V A T := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing A T := + IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc C) T A + letI : Algebra AF A := (infinityIntegralClosureMap C F T).toAlgebra + letI : SMul AF A := Algebra.toSMul + letI : Module AF A := Algebra.toModule + letI : Algebra S A := + exactConstantExtensionInfinityIntegralClosureConstantAlgebra C S N hExact + letI : IsScalarTower AF F T := inferInstance + letI : Algebra.IsIntegral V AF := + IsIntegralClosure.isIntegral_algebra V F + letI : IsScalarTower V AF T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc C) T + (algebraMap V (RatFunc C) x) = + algebraMap F T + (algebraMap (RatFunc C) F + (algebraMap V (RatFunc C) x)) + exact IsScalarTower.algebraMap_apply (RatFunc C) F T _ + letI : IsScalarTower AF A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap AF A r) = + algebraMap AF T r by rfl] + ring⟩ + letI : IsIntegralClosure A AF T := + IsIntegralClosure.tower_top (R := V) + letI : IsDedekindDomain A := + IsIntegralClosure.isDedekindDomain V (RatFunc C) T A + letI : MulSemiringAction (T ≃ₐ[F] T) A := + infinityIntegralClosureGalAction C F T + dsimp only + intro Q + rw [← infinityPlaceInertiaGroup_card_eq_ramificationIdx C F T Q] + have hInertia : infinityPlaceInertiaGroup C F T Q = ⊥ := by + ext tau + constructor + · intro htau + rw [Subgroup.mem_bot] + let sigma := exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup + C (RatFunc C) N S hExact g + let e := IntermediateField.subgroupEquivAlgEquiv H + let h : H := e.symm tau + have he_apply (z : H) (x : T) : e z x = z.1 x := by + change z.1.toEquiv x = z.1 x + rfl + have htau_apply (x : T) : tau x = h.1 x := by + calc + tau x = e h x := by + exact congrArg (fun z : T ≃ₐ[F] T => z x) + (e.apply_symm_apply tau).symm + _ = h.1 x := he_apply h x + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp h.2 + let frob := FiniteField.frobeniusAlgEquivOfAlgebraic C S + have hfrob_apply (s : S) : (frob ^ k) s = s := by + let a : A := algebraMap S A s + have haction : tau • a = algebraMap S A ((frob ^ k) s) := by + apply Subtype.ext + calc + ((tau • a : A) : T) = tau (a : T) := by + change algebraMap A T ((galRestrict AF F T A tau) a) = + tau (algebraMap A T a) + exact algebraMap_galRestrict_apply AF tau a + _ = h.1 (a : T) := htau_apply (a : T) + _ = h.1 (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) := by + rfl + _ = (sigma ^ k) (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) := by + exact congrArg + (fun z : T ≃ₐ[RatFunc C] T => + z (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s)) + hk |>.symm + _ = Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + ((frob ^ k) s) := by + exact exactConstantExtensionFrobeniusTwist_zpow_includeLeft_infinity + C N S hExact g k s + _ = ((algebraMap S A ((frob ^ k) s) : A) : T) := by + rfl + have hmem : tau • a - a ∈ Q.1 := htau a + have hmem' : algebraMap S A ((frob ^ k) s - s) ∈ Q.1 := by + have heq : algebraMap S A ((frob ^ k) s - s) = tau • a - a := by + calc + algebraMap S A ((frob ^ k) s - s) = + algebraMap S A ((frob ^ k) s) - algebraMap S A s := + map_sub (algebraMap S A) _ _ + _ = algebraMap S A ((frob ^ k) s) - a := rfl + _ = tau • a - a := congrArg (fun z : A => z - a) haction.symm + exact heq.symm ▸ hmem + let J : Ideal S := Q.1.comap (algebraMap S A) + have hmemJ : (frob ^ k) s - s ∈ J := hmem' + have hJne : J ≠ ⊤ := by + exact Ideal.comap_ne_top (algebraMap S A) Q.2.1.ne_top + have hJ : J = ⊥ := (Ideal.eq_bot_or_top J).resolve_right hJne + have hs : (frob ^ k) s - s = 0 := by + rw [hJ] at hmemJ + simpa only [Ideal.mem_bot] using hmemJ + exact sub_eq_zero.mp hs + have hFrob : frob ^ k = 1 := by + ext s + exact hfrob_apply s + have hkdiv : (Module.finrank C S : ℤ) ∣ k := by + rw [← FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S] + exact orderOf_dvd_iff_zpow_eq_one.mpr hFrob + have hsigma : sigma ^ k = 1 := by + rw [← orderOf_dvd_iff_zpow_eq_one, + orderOf_exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g hdiv] + exact hkdiv + have hambient : (h.1 : T ≃ₐ[RatFunc C] T) = 1 := by + calc + (h.1 : T ≃ₐ[RatFunc C] T) = sigma ^ k := hk.symm + _ = 1 := hsigma + have hh : h = 1 := Subtype.ext hambient + calc + tau = e h := (e.apply_symm_apply tau).symm + _ = e 1 := congrArg e hh + _ = 1 := map_one e + · intro htau + rw [Subgroup.mem_bot] at htau + simp [htau] + rw [hInertia] + exact Nat.card_unique + +end FrobeniusTwistInfinityUnramified + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean new file mode 100644 index 0000000000..073e173045 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean @@ -0,0 +1,568 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent + +/-! +# Exact Frobenius-twist descent for infinity places + +This file specializes the generic infinity-place descent theory to an exact +constant extension. It identifies rational infinity places of the +Frobenius-twist fixed field with degree-`[S : C]` infinity places upstairs +fixed by the ambient Frobenius twist. +-/ + +open scoped Pointwise Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +variable (C N S : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] + +local instance twistInfinityEquivalenceConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance twistInfinityEquivalenceConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +section FrobeniusTwistInfinitySpecialization + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) +variable (g : N ≃ₐ[RatFunc C] N) + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [DecidableEq S] [DecidableEq (RatFunc S)] in +/-- A top infinity place of degree `[S : C]` fixed by the canonical twist +descends to a rational infinity place of the Frobenius-twist fixed field. -/ +theorem frobeniusTwistField_fixed_infinityPlace_under_degree_eq_one + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : DistribMulAction F (ExactConstantExtension C N S) := + Module.toDistribMulAction + letI : MulAction F (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ (Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S)), + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inr Q) = + Module.finrank C S → + infinityPlaceGalSmul C F (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g) Q = Q → + finiteExtensionPlaceDegree C F + (.inr (infinityPlaceUnder C F + (ExactConstantExtension C N S) Q)) = 1 := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : DistribMulAction F T := Module.toDistribMulAction + letI : MulAction F T := DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro Q hdegree hfixed + apply infinityPlaceUnder_degree_eq_one_of_generator_fixed + C F T + (exactConstantExtensionFrobeniusTwistOverFixedField C N S hExact g) + (exactConstantExtensionFrobeniusTwistOverFixedField_zpowers_eq_top + C N S hExact g) + Q hfixed + · exact frobeniusTwistField_infinityPlace_ramificationIdx_eq_one + C N S hExact g hdiv Q + · calc + finiteExtensionPlaceDegree C T (.inr Q) = Module.finrank C S := hdegree + _ = Module.finrank F T := + (finrank_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g hdiv).symm + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [DecidableEq S] [DecidableEq (RatFunc S)] in +/-- The canonical twist over its fixed field and the ambient twist over +`C(X)` induce the same action on infinity places. -/ +theorem exactConstantExtensionFrobeniusTwist_infinityPlaceGalSmul_eq_overFixedField + [IsGalois (RatFunc C) N] : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : DistribMulAction F (ExactConstantExtension C N S) := + Module.toDistribMulAction + letI : MulAction F (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S), + infinityPlaceGalSmul C F (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwistOverFixedField + C N S hExact g) Q = + infinityPlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : DistribMulAction F T := Module.toDistribMulAction + letI : MulAction F T := DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro Q + apply infinityPlaceGalSmul_eq_of_apply_eq C F (RatFunc C) T + intro x + exact exactConstantExtensionFrobeniusTwistOverFixedField_apply + C N S hExact g x + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [DecidableEq S] [DecidableEq (RatFunc S)] in +/-- Ambient fixedness by the Frobenius twist is exactly the fixedness +condition needed for infinity-place descent. -/ +theorem frobeniusTwistField_ambientFixed_infinityPlace_under_degree_eq_one + [IsGalois (RatFunc C) N] + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : DistribMulAction F (ExactConstantExtension C N S) := + Module.toDistribMulAction + letI : MulAction F (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + ∀ (Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S)), + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inr Q) = + Module.finrank C S → + infinityPlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q = Q → + finiteExtensionPlaceDegree C F + (.inr (infinityPlaceUnder C F + (ExactConstantExtension C N S) Q)) = 1 := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : DistribMulAction F T := Module.toDistribMulAction + letI : MulAction F T := DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + intro Q hdegree hfixed + apply frobeniusTwistField_fixed_infinityPlace_under_degree_eq_one + C N S hExact g hdiv Q hdegree + rw [exactConstantExtensionFrobeniusTwist_infinityPlaceGalSmul_eq_overFixedField + C N S hExact g Q] + exact hfixed + +/-- Rational infinity places of the Frobenius-twist field are exactly the +degree-`[S : C]` top infinity places fixed by the ambient Frobenius twist. -/ +noncomputable def + frobeniusTwistField_rationalInfinityPlace_equiv_ambientFixedInfinityPlace + [IsGalois (RatFunc C) N] + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : DistribMulAction (RatFunc C) + (ExactConstantExtension C N S) := Module.toDistribMulAction + letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : DistribMulAction F (ExactConstantExtension C N S) := + Module.toDistribMulAction + letI : MulAction F (ExactConstantExtension C N S) := + DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := inferInstance + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + FiniteExtensionRationalInfinityPlace C F ≃ + {Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S) // + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inr Q) = + Module.finrank C S ∧ + infinityPlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q = Q} := by + letI : DecidableEq C := infinityBridgeDecidableEqConstants C + letI : DecidableEq (RatFunc C) := + infinityBridgeDecidableEqRatFuncConstants C + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + infinityBridgeDecidableEqRatFuncConstants S + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : DistribMulAction F T := Module.toDistribMulAction + letI : MulAction F T := DistribMulAction.toMulAction + letI : IsScalarTower (RatFunc C) F T := inferInstance + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g + dsimp only + have hfinrank : Module.finrank F T = Module.finrank C S := + finrank_exactConstantExtension_over_frobeniusTwistField + C (RatFunc C) N S hExact g hdiv + have hdegree : ∀ Q : FiniteExtensionInfinityPlace C T, + Module.finrank F T ∣ finiteExtensionPlaceDegree C T (.inr Q) := by + intro Q + rw [hfinrank] + exact exactConstantExtensionInfinityPlace_finrank_constants_dvd_degree + C N S hExact Q + let sigmaF := + exactConstantExtensionFrobeniusTwistOverFixedField C N S hExact g + let eFixed := rationalInfinityPlaceEquivGeneratorFixedPlace + C F T hdegree sigmaF + (exactConstantExtensionFrobeniusTwistOverFixedField_zpowers_eq_top + C N S hExact g) + (frobeniusTwistField_infinityPlace_ramificationIdx_eq_one + C N S hExact g hdiv) + let eCompare : + {Q : FiniteExtensionInfinityPlace C T // + finiteExtensionPlaceDegree C T (.inr Q) = Module.finrank F T ∧ + infinityPlaceGalSmul C F T sigmaF Q = Q} ≃ + {Q : FiniteExtensionInfinityPlace C T // + finiteExtensionPlaceDegree C T (.inr Q) = Module.finrank C S ∧ + infinityPlaceGalSmul C (RatFunc C) T + (exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact g) Q = Q} := + { toFun := fun Q => ⟨Q.1, + Q.2.1.trans hfinrank, + (exactConstantExtensionFrobeniusTwist_infinityPlaceGalSmul_eq_overFixedField + C N S hExact g Q.1).symm.trans Q.2.2⟩ + invFun := fun Q => ⟨Q.1, + Q.2.1.trans hfinrank.symm, + (exactConstantExtensionFrobeniusTwist_infinityPlaceGalSmul_eq_overFixedField + C N S hExact g Q.1).trans Q.2.2⟩ + left_inv := fun Q => Subtype.ext rfl + right_inv := fun Q => Subtype.ext rfl } + exact eFixed.trans eCompare + +end FrobeniusTwistInfinitySpecialization + + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean new file mode 100644 index 0000000000..f143dd9fea --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree + +/-! +# Multiplication presentation of Frobenius-twist constant extensions + +Let `T = S ⊗[C] N`, and let `F_g` be a Frobenius-twist fixed field in +`T`. The multiplication map from `S ⊗[C] F_g` to `T` is an equivalence +over the original function-field base. Thus every twist becomes the same +top field after extending constants from `C` to `S`. + +This is the field-level transport needed to compare the differents, genera, +and Riemann budgets of all twists without identifying the twist fields over +`C(X)` themselves. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] + [Fintype C] [Finite S] + +/-- Multiplication identifies the constant extension of a Frobenius-twist +field with the common exact constant extension. -/ +noncomputable def exactConstantExtensionFrobeniusTwistMultiplicationAlgEquiv + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra C F := Algebra.restrictScalars C L F + let hExactF := + exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C L N S hExact g + letI := exactConstantExtensionField C F S hExactF + letI := exactConstantExtensionBaseAlgebra C L F S + ExactConstantExtension C F S ≃ₐ[L] ExactConstantExtension C N S := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + have hCLT : algebraMap C T = + (algebraMap L T).comp (algebraMap C L) := by + ext c + change algebraMap C S c ⊗ₜ[C] (1 : N) = + (1 : S) ⊗ₜ[C] algebraMap L N (algebraMap C L c) + rw [← IsScalarTower.algebraMap_apply C L N] + exact Algebra.TensorProduct.tmul_one_eq_one_tmul c + letI : IsScalarTower C L T := IsScalarTower.of_algebraMap_eq' hCLT + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra C F := Algebra.restrictScalars C L F + letI : SMul C F := Algebra.toSMul + letI : Module C F := Algebra.toModule + letI : IsScalarTower C L F := IsScalarTower.of_algebraMap_eq' rfl + have hExactF : algebraicClosure C F = + (⊥ : IntermediateField C F) := + exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C L N S hExact g + let U := ExactConstantExtension C F S + letI : Field U := exactConstantExtensionField C F S hExactF + letI : Algebra L U := exactConstantExtensionBaseAlgebra C L F S + let fS : S →ₐ[C] T := Algebra.TensorProduct.includeLeft + let fF : F →ₐ[C] T := F.val.restrictScalars C + let fC : U →ₐ[C] T := Algebra.TensorProduct.productMap fS fF + let f : U →ₐ[L] T := + { fC.toRingHom with + commutes' := fun l => by + change fC ((1 : S) ⊗ₜ[C] algebraMap L F l) = + (1 : S) ⊗ₜ[C] algebraMap L N l + rw [Algebra.TensorProduct.productMap_right_apply] + rfl } + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S + let eT := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N T := Module.Finite.equiv eT + letI : Module.Finite L T := Module.Finite.trans N T + letI : Module.Finite L F := Module.Finite.left L F T + letI : Algebra F U := exactConstantExtensionAlgebra C F S + letI : IsScalarTower L F U := exactConstantExtensionBaseTower C L F S + let eU := exactConstantExtensionLinearEquiv C F S + letI : Module.Finite F (F ⊗[C] S) := Module.Finite.base_change C F S + letI : Module.Finite F U := Module.Finite.equiv eU + letI : Module.Finite L U := Module.Finite.trans F U + have hdim : Module.finrank L U = Module.finrank L T := by + calc + Module.finrank L U = Module.finrank L F * Module.finrank C S := + exactConstantExtension_finrank_over_base C L F S + _ = Module.finrank L N * Module.finrank C S := by + rw [finrank_frobeniusTwistField_over_base + C L N S hExact g hdiv] + _ = Module.finrank L T := + (exactConstantExtension_finrank_over_base C L N S).symm + have hinj : Function.Injective f := f.injective + have hsurj : Function.Surjective f := + (LinearMap.injective_iff_surjective_of_finrank_eq_finrank + (f := f.toLinearMap) hdim).mp hinj + exact AlgEquiv.ofBijective f ⟨hinj, hsurj⟩ + +/-- Multiplication also identifies the constant extension of a +Frobenius-twist field with the common top field as an algebra over the +enlarged constant field `S`. This is the scalar structure used to transport +the intrinsic genus. -/ +noncomputable def + exactConstantExtensionFrobeniusTwistMultiplicationAlgEquivOverConstants + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra C F := Algebra.restrictScalars C L F + let hExactF := + exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C L N S hExact g + letI := exactConstantExtensionField C F S hExactF + letI : Algebra S (ExactConstantExtension C F S) := + Algebra.TensorProduct.leftAlgebra + letI : Algebra S (ExactConstantExtension C N S) := + Algebra.TensorProduct.leftAlgebra + ExactConstantExtension C F S ≃ₐ[S] ExactConstantExtension C N S := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + have hCLT : algebraMap C T = + (algebraMap L T).comp (algebraMap C L) := by + ext c + change algebraMap C S c ⊗ₜ[C] (1 : N) = + (1 : S) ⊗ₜ[C] algebraMap L N (algebraMap C L c) + rw [← IsScalarTower.algebraMap_apply C L N] + exact Algebra.TensorProduct.tmul_one_eq_one_tmul c + letI : IsScalarTower C L T := IsScalarTower.of_algebraMap_eq' hCLT + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra C F := Algebra.restrictScalars C L F + letI : SMul C F := Algebra.toSMul + letI : Module C F := Algebra.toModule + letI : IsScalarTower C L F := IsScalarTower.of_algebraMap_eq' rfl + have hExactF : algebraicClosure C F = + (⊥ : IntermediateField C F) := + exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C L N S hExact g + let U := ExactConstantExtension C F S + letI : Field U := exactConstantExtensionField C F S hExactF + letI : Algebra L U := exactConstantExtensionBaseAlgebra C L F S + let fConst : S →ₐ[C] T := Algebra.TensorProduct.includeLeft + let fTwist : F →ₐ[C] T := F.val.restrictScalars C + let fC : U →ₐ[C] T := + Algebra.TensorProduct.productMap fConst fTwist + let fL : U →ₐ[L] T := + { fC.toRingHom with + commutes' := fun l => by + change fC ((1 : S) ⊗ₜ[C] algebraMap L F l) = + (1 : S) ⊗ₜ[C] algebraMap L N l + rw [Algebra.TensorProduct.productMap_right_apply] + rfl } + letI : Algebra S U := Algebra.TensorProduct.leftAlgebra + letI : Algebra S T := Algebra.TensorProduct.leftAlgebra + let fS : U →ₐ[S] T := + { fC.toRingHom with + commutes' := fun s => by + change fC (s ⊗ₜ[C] (1 : F)) = s ⊗ₜ[C] (1 : N) + rw [Algebra.TensorProduct.productMap_left_apply] + rfl } + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S + let eT := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N T := Module.Finite.equiv eT + letI : Module.Finite L T := Module.Finite.trans N T + letI : Module.Finite L F := Module.Finite.left L F T + letI : Algebra F U := exactConstantExtensionAlgebra C F S + letI : IsScalarTower L F U := exactConstantExtensionBaseTower C L F S + let eU := exactConstantExtensionLinearEquiv C F S + letI : Module.Finite F (F ⊗[C] S) := Module.Finite.base_change C F S + letI : Module.Finite F U := Module.Finite.equiv eU + letI : Module.Finite L U := Module.Finite.trans F U + have hdim : Module.finrank L U = Module.finrank L T := by + calc + Module.finrank L U = Module.finrank L F * Module.finrank C S := + exactConstantExtension_finrank_over_base C L F S + _ = Module.finrank L N * Module.finrank C S := by + rw [finrank_frobeniusTwistField_over_base + C L N S hExact g hdiv] + _ = Module.finrank L T := + (exactConstantExtension_finrank_over_base C L N S).symm + have hinjL : Function.Injective fL := fL.injective + have hsurjL : Function.Surjective fL := + (LinearMap.injective_iff_surjective_of_finrank_eq_finrank + (f := fL.toLinearMap) hdim).mp hinjL + have hinjS : Function.Injective fS := by + intro x y hxy + apply hinjL + exact hxy + have hsurjS : Function.Surjective fS := by + intro y + obtain ⟨x, hx⟩ := hsurjL y + exact ⟨x, hx⟩ + exact AlgEquiv.ofBijective fS ⟨hinjS, hsurjS⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean new file mode 100644 index 0000000000..aaf321b6ca --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean @@ -0,0 +1,307 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage + +/-! +# Complete rational-place averaging for Frobenius twists + +The finite-place Frobenius average is exact, including above ramified base +places. Passing from finite rational places to the complete rational-place +count therefore introduces only the places above infinity. Their number on +each twist is bounded by the degree of the original function field, uniformly +in the auxiliary constant extension. + +This file records both the exact aggregate identity and the resulting uniform +bound for the centered aggregate error. No branch-locus estimate is needed at +this boundary. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped BigOperators TensorProduct + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance rationalPlaceAverageBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance rationalPlaceAverageBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The number of rational places above infinity on one Frobenius-twist +field. -/ +noncomputable def frobeniusTwistFieldRationalInfinityPlaceCount + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : ℕ := + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + Nat.card (FiniteExtensionRationalInfinityPlace C F) + +/-- The complete rational-place count of one Frobenius-twist field, split +into its finite and infinity parts. -/ +noncomputable def frobeniusTwistFieldRationalPlaceCount + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : ℕ := + frobeniusTwistFieldRationalFinitePlaceCount C S N hExact g + + frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g + +/-- The split definition is the actual complete degree-one place count of +the twist field. -/ +theorem frobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCount + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + frobeniusTwistFieldRationalPlaceCount C S N hExact g = + finiteExtensionRationalPlaceCount C F := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Finite (FiniteExtensionRationalFinitePlace C F) := inferInstance + letI : Finite (FiniteExtensionRationalInfinityPlace C F) := inferInstance + unfold frobeniusTwistFieldRationalPlaceCount + rw [frobeniusTwistFieldRationalFinitePlaceCount, + frobeniusTwistFieldRationalInfinityPlaceCount] + change Nat.card (FiniteExtensionRationalFinitePlace C F) + + Nat.card (FiniteExtensionRationalInfinityPlace C F) = + Nat.card (FiniteExtensionRationalFinitePlace C F ⊕ + FiniteExtensionRationalInfinityPlace C F) + exact Nat.card_sum.symm + +/-- The infinity contribution of each twist is bounded by the degree of the +original function field, independently of the auxiliary constant extension. +-/ +theorem frobeniusTwistFieldRationalInfinityPlaceCount_le_original_finrank + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g ≤ + Module.finrank (RatFunc C) N := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : IsGalois (RatFunc C) T := + exactConstantExtension_isGalois C (RatFunc C) N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + change Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ + Module.finrank (RatFunc C) N + calc + Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ + Module.finrank (RatFunc C) F := + rationalInfinityPlace_card_le_finrank C F + _ = Module.finrank (RatFunc C) N := + finrank_frobeniusTwistField_over_ratFunc_eq_original + C N S hExact g hdiv + +/-- The total infinity contribution of all twists is uniformly bounded by +the Galois-group order times the original function-field degree. -/ +theorem sum_frobeniusTwistFieldRationalInfinityPlaceCount_le + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[RatFunc C] N, + frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g) ≤ + Nat.card (N ≃ₐ[RatFunc C] N) * + Module.finrank (RatFunc C) N := by + calc + (∑ g : N ≃ₐ[RatFunc C] N, + frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g) ≤ + ∑ _g : N ≃ₐ[RatFunc C] N, + Module.finrank (RatFunc C) N := by + exact Finset.sum_le_sum fun g _ => + frobeniusTwistFieldRationalInfinityPlaceCount_le_original_finrank + C S N hExact g hdiv + _ = Nat.card (N ≃ₐ[RatFunc C] N) * + Module.finrank (RatFunc C) N := by + simp [Nat.card_eq_fintype_card] + +/-- Exact finite-plus-infinity aggregate identity. All finite rational +places contribute exactly `|Gal(N/C(X))| * |C|`; the displayed infinity sum +is the entire correction to the complete rational-place count. -/ +theorem sum_frobeniusTwistFieldRationalPlaceCount_eq + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[RatFunc C] N, + frobeniusTwistFieldRationalPlaceCount C S N hExact g) = + Nat.card (N ≃ₐ[RatFunc C] N) * Nat.card C + + ∑ g : N ≃ₐ[RatFunc C] N, + frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g := by + simp_rw [frobeniusTwistFieldRationalPlaceCount] + rw [Finset.sum_add_distrib, + sum_frobeniusTwistFieldRationalFinitePlaceCount_eq_card_galois_mul_card + C S N hExact hdiv] + +/-- Exact centered aggregate-error identity over the reals. It makes +explicit that the complete-place error is the infinity contribution minus +one point for each twist. -/ +theorem sum_frobeniusTwistFieldRationalPlaceError_eq + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[RatFunc C] N, + ((frobeniusTwistFieldRationalPlaceCount C S N hExact g : ℝ) - + (Nat.card C : ℝ) - 1)) = + (∑ g : N ≃ₐ[RatFunc C] N, + (frobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact g : ℝ)) - + (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) := by + have htotal := sum_frobeniusTwistFieldRationalPlaceCount_eq + C S N hExact hdiv + have htotalReal : + (∑ g : N ≃ₐ[RatFunc C] N, + (frobeniusTwistFieldRationalPlaceCount C S N hExact g : ℝ)) = + (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + (Nat.card C : ℝ) + + ∑ g : N ≃ₐ[RatFunc C] N, + (frobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact g : ℝ) := by + exact_mod_cast htotal + rw [Finset.sum_sub_distrib, Finset.sum_sub_distrib, htotalReal] + simp only [Finset.sum_const, Finset.card_univ, nsmul_eq_mul, + mul_one, Nat.card_eq_fintype_card] + ring + +/-- The centered aggregate error is bounded uniformly in the auxiliary +constant extension. The sharper factor `finrank`, rather than +`finrank + 1`, follows because the original function-field degree is positive. +-/ +theorem abs_sum_frobeniusTwistFieldRationalPlaceError_le + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + |∑ g : N ≃ₐ[RatFunc C] N, + ((frobeniusTwistFieldRationalPlaceCount C S N hExact g : ℝ) - + (Nat.card C : ℝ) - 1)| ≤ + (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + Module.finrank (RatFunc C) N := by + rw [sum_frobeniusTwistFieldRationalPlaceError_eq C S N hExact hdiv] + let infinitySum : ℝ := + ∑ g : N ≃ₐ[RatFunc C] N, + (frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g : ℝ) + let groupCard : ℝ := Nat.card (N ≃ₐ[RatFunc C] N) + let degree : ℝ := Module.finrank (RatFunc C) N + have hinfinity_nonneg : 0 ≤ infinitySum := by + dsimp only [infinitySum] + positivity + have hgroup_nonneg : 0 ≤ groupCard := by + dsimp only [groupCard] + positivity + have hdegree_one : 1 ≤ degree := by + dsimp only [degree] + exact_mod_cast (Module.finrank_pos (R := RatFunc C) (M := N)) + have hinfinity_le : infinitySum ≤ groupCard * degree := by + dsimp only [infinitySum, groupCard, degree] + exact_mod_cast + (sum_frobeniusTwistFieldRationalInfinityPlaceCount_le + C S N hExact hdiv) + apply abs_le.mpr + constructor <;> nlinarith + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean new file mode 100644 index 0000000000..883d67d84d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower + +/-! +# A common Riemann budget for Frobenius-twist fields + +For a fixed finite constant extension `S / C`, there are only finitely many +Frobenius-twist fields attached to the elements of `Gal(N / C(X))`. The +primitive-element Riemann inequality supplies a finite-place budget for each +twist. Summing these finitely many budgets gives one budget which works for +every twist field simultaneously. + +This file also records that the same twist fields have exact constant field +`C`, so the common budget and the constant-field input needed by the intrinsic +Stepanov estimate are available at the same boundary. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped TensorProduct + +noncomputable section + + +variable (C N S : Type*) [Field C] [Fintype C] [DecidableEq C] + [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] [Algebra C N] + [IsScalarTower C (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [Algebra.IsSeparable (RatFunc C) N] [Finite S] in +/-- A twist fixed field is finite-dimensional over the rational-function +base because it embeds into the finite exact constant extension. -/ +theorem finiteDimensional_frobeniusTwistField_over_ratFunc + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + FiniteDimensional (RatFunc C) F := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + let tensorEquiv := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N T := Module.Finite.equiv tensorEquiv + letI : Module.Finite (RatFunc C) T := Module.Finite.trans N T + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + exact Module.Finite.left (RatFunc C) F T + +omit [DecidableEq C] [DecidableEq (RatFunc C)] + [FiniteDimensional (RatFunc C) N] [Finite S] in +/-- Separability descends from the finite separable exact constant extension +to each intermediate twist fixed field. -/ +theorem isSeparable_frobeniusTwistField_over_ratFunc + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + Algebra.IsSeparable (RatFunc C) F := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N T := + exactConstantExtension_isGalois C N N S hExact + letI : Algebra.IsSeparable (RatFunc C) T := + Algebra.IsSeparable.trans (RatFunc C) N T + exact Algebra.isSeparable_tower_bot_of_isSeparable (RatFunc C) F T + +omit [Finite S] in +/-- Each Frobenius-twist field is a finite separable function field over +`C(X)`, hence has a finite-place Riemann budget. -/ +private theorem exists_frobeniusTwistField_finitePlace_riemann_lower_budget + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (g : N ≃ₐ[RatFunc C] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + ∃ budget : ℕ, + ∀ (q : FiniteExtensionFinitePlace C F) (poleOrder : ℕ), + poleOrder * finiteExtensionPlaceDegree C F (.inl q) + 1 ≤ + Module.finrank C + (finiteExtensionOnePointRiemannSpace C F (.inl q) poleOrder) + + budget := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + exact exists_finitePlace_riemann_lower_budget C F + +omit [Finite S] in +/-- For one fixed finite extension of the constants, a single natural-number +budget works for the finite-place Riemann inequality in every Frobenius-twist +field. -/ +theorem exists_common_frobeniusTwistField_finitePlace_riemann_lower_budget + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + ∃ budget : ℕ, + ∀ (g : N ≃ₐ[RatFunc C] N), + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + ∀ (q : FiniteExtensionFinitePlace C F) (poleOrder : ℕ), + poleOrder * finiteExtensionPlaceDegree C F (.inl q) + 1 ≤ + Module.finrank C + (finiteExtensionOnePointRiemannSpace C F (.inl q) poleOrder) + + budget := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + choose twistBudget htwistBudget using fun g : N ≃ₐ[RatFunc C] N => + exists_frobeniusTwistField_finitePlace_riemann_lower_budget + C N S hExact g + let budget : ℕ := ∑ g : N ≃ₐ[RatFunc C] N, twistBudget g + refine ⟨budget, ?_⟩ + intro g + dsimp only + have hle : twistBudget g ≤ budget := by + dsimp only [budget] + exact Finset.single_le_sum (fun _ _ => Nat.zero_le _) (Finset.mem_univ g) + intro q poleOrder + exact (htwistBudget g q poleOrder).trans + (Nat.add_le_add_left hle _) + +/-- The common Riemann budget can be chosen simultaneously with the statement +that every Frobenius-twist field has exact constant field `C`. -/ +theorem exists_common_frobeniusTwistField_exactConstants_and_riemann_budget + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + ∃ budget : ℕ, + ∀ (g : N ≃ₐ[RatFunc C] N), + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + algebraicClosure C F = (⊥ : IntermediateField C F) ∧ + ∀ (q : FiniteExtensionFinitePlace C F) (poleOrder : ℕ), + poleOrder * finiteExtensionPlaceDegree C F (.inl q) + 1 ≤ + Module.finrank C + (finiteExtensionOnePointRiemannSpace C F (.inl q) poleOrder) + + budget := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + obtain ⟨budget, hbudget⟩ := + exists_common_frobeniusTwistField_finitePlace_riemann_lower_budget + C N S hExact + refine ⟨budget, ?_⟩ + intro g + dsimp only + refine ⟨?_, hbudget g⟩ + exact exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C (RatFunc C) N S hExact g + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean new file mode 100644 index 0000000000..d3e2774ae3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean @@ -0,0 +1,254 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount + +/-! +# A uniform Stepanov upper bound for exact-constant Frobenius twists + +For one fixed exact extension of the constants, the Frobenius-twist fixed +fields have a common finite-place Riemann budget and exact constant field. +When the ground constant field is a square, the intrinsic one-point +Stepanov theorem therefore applies to every twist with the same numerical +budget. The degree theorem for the twists replaces the residual +function-field degree term by the degree of the original field. + +This is the uniform upper estimate used in the fixed-field averaging route to +Hasse--Weil. It does not require a separate genus-invariance hypothesis: the +common Riemann budget is the exact input consumed by the Stepanov theorem. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +variable (K C N S : Type*) + [Field K] [Fintype K] + [Field C] [Fintype C] [DecidableEq C] [Algebra K C] + [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [IsGalois (RatFunc C) N] + [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Finite S] + +local instance twistStepanovBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance twistStepanovBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10000) twistStepanovFieldDecidableEq + (F : Type*) [Field F] : DecidableEq F := Classical.decEq _ + +local instance (priority := 10001) twistStepanovRatFuncDecidableEq + (F : Type*) [Field F] : DecidableEq (RatFunc F) := Classical.decEq _ + +/-- A single Stepanov budget gives the square-field rational-place upper +bound for every Frobenius-twist fixed field. The final degree term is uniform: +it is the degree of the original function field `N / C(X)`. + +The divisibility condition is exactly the one used to prove that every twist +has the same degree as `N`; in the Stichtenoth construction it is ensured by +the chosen constant-extension degree. -/ +theorem exists_uniform_frobeniusTwistField_squareFieldStepanov_budget + (hcard : Fintype.card C = (Fintype.card K) ^ 2) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + ∃ budget : ℕ, + ∀ (g : N ≃ₐ[RatFunc C] N), + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc + C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc + C N S hExact g + (budget + 1) * (budget + 2) ≤ Fintype.card K → + finiteExtensionRationalPlaceCount C F ≤ + Fintype.card C + (2 * budget + 1) * Fintype.card K + + Module.finrank (RatFunc C) N := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + obtain ⟨budget, hbudget⟩ := + exists_common_frobeniusTwistField_exactConstants_and_riemann_budget + C N S hExact + refine ⟨budget, ?_⟩ + intro g + dsimp only + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := + SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc + C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc + C N S hExact g + letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + intro hlarge + have hstepanov := + finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann + K C F budget hcard (hbudget g).1 (fun Q poleOrder => by + have h := (hbudget g).2 Q.1 poleOrder + have hdeg : finiteExtensionPlaceDegree C F (.inl Q.1) = 1 := Q.2 + change poleOrder * finiteExtensionPlaceDegree C F (.inl Q.1) + 1 ≤ _ at h + rw [hdeg, Nat.mul_one] at h + exact h) hlarge + calc + finiteExtensionRationalPlaceCount C F ≤ + Fintype.card C + (2 * budget + 1) * Fintype.card K + + Module.finrank (RatFunc C) F := hstepanov + _ = Fintype.card C + (2 * budget + 1) * Fintype.card K + + Module.finrank (RatFunc C) N := by + rw [finrank_frobeniusTwistField_over_ratFunc_eq_original + C N S hExact g hdiv] + +/-- The uniform twist estimate with the intrinsic genus of the original +field as its fixed budget. Unlike the existential compatibility theorem +above, every constant in this statement is independent of the auxiliary +constant extension `S`. -/ +theorem frobeniusTwistFieldRationalPlaceCount_le_squareField_of_genus + (hcard : Fintype.card C = (Fintype.card K) ^ 2) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (g : N ≃ₐ[RatFunc C] N) + (hlarge : (FunctionField.genus C N + 1) * + (FunctionField.genus C N + 2) ≤ Fintype.card K) : + frobeniusTwistFieldRationalPlaceCount C S N hExact g ≤ + Fintype.card C + (2 * FunctionField.genus C N + 1) * + Fintype.card K + Module.finrank (RatFunc C) N := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let F := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact g + letI : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g + letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + letI : IsScalarTower C (RatFunc C) F := + IsScalarTower.of_algebraMap_eq' rfl + have hExactF : algebraicClosure C F = + (⊥ : IntermediateField C F) := + exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot + C (RatFunc C) N S hExact g + letI : FunctionField.IsFullConstantField C F := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C F).2 + hExactF + have hgenus : FunctionField.genus C F = FunctionField.genus C N := + genus_frobeniusTwistField_eq_original C S N hExact hdiv g + have hriemann : ∀ (Q : FiniteExtensionRationalFinitePlace C F) m, + m + 1 ≤ Module.finrank C + (finiteExtensionOnePointRiemannSpace C F (.inl Q.1) m) + + FunctionField.genus C N := by + intro Q m + have h := finiteExtension_onePoint_riemann_lower_of_genus + C F (.inl Q.1) m + simpa only [Q.2, Nat.mul_one, hgenus] using h + have hstepanov := + finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann + K C F (FunctionField.genus C N) hcard hExactF hriemann hlarge + rw [← frobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCount + C S N hExact g] at hstepanov + calc + frobeniusTwistFieldRationalPlaceCount C S N hExact g ≤ + Fintype.card C + (2 * FunctionField.genus C N + 1) * + Fintype.card K + Module.finrank (RatFunc C) F := hstepanov + _ = Fintype.card C + (2 * FunctionField.genus C N + 1) * + Fintype.card K + Module.finrank (RatFunc C) N := by + rw [finrank_frobeniusTwistField_over_ratFunc_eq_original + C N S hExact g hdiv] + +/-- Combining the genus-uniform Stepanov upper bound with the bounded +complete-place average gives a two-sided estimate for every rational-base +twist. All constants shown here are independent of `S`. -/ +theorem abs_frobeniusTwistFieldRationalPlaceError_le_squareField_of_genus + (hcard : Fintype.card C = (Fintype.card K) ^ 2) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (hlarge : (FunctionField.genus C N + 1) * + (FunctionField.genus C N + 2) ≤ Fintype.card K) + (g : N ≃ₐ[RatFunc C] N) : + |(frobeniusTwistFieldRationalPlaceCount C S N hExact g : ℝ) - + (Nat.card C : ℝ) - 1| ≤ + (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + Module.finrank (RatFunc C) N + + (Nat.card (N ≃ₐ[RatFunc C] N) - 1 : ℕ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) := by + let B : ℝ := + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) + apply abs_frobeniusTwistFieldRationalPlaceError_le_of_uniform_upper + C S N hExact hdiv g B + · dsimp only [B] + positivity + · intro τ + have hnat := + frobeniusTwistFieldRationalPlaceCount_le_squareField_of_genus + K C N S hcard hExact hdiv τ hlarge + have hreal : + (frobeniusTwistFieldRationalPlaceCount C S N hExact τ : ℝ) ≤ + (Fintype.card C : ℝ) + + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) := by + have hnat' : + frobeniusTwistFieldRationalPlaceCount C S N hExact τ ≤ + Fintype.card C + + ((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N) := by + simpa only [Nat.add_assoc] using hnat + exact_mod_cast hnat' + dsimp only [B] + rw [Nat.card_eq_fintype_card] + linarith + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean new file mode 100644 index 0000000000..2ee8b00ac4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +/-! +# Genus and extension degree under exact constant extension + +This file records two numerical consequences needed to compare a function +field with an exact finite extension of its constants. First, cotrace +canonicality identifies the total finite-and-infinite trace-different degree +with the Riemann--Hurwitz expression. Second, extending the constants from +`C` to `S` preserves the degree over the corresponding rational function +field. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +section RiemannHurwitzDegree + +variable (K : Type*) [Field K] [Finite K] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance genusDegreeFintype : Fintype K := Fintype.ofFinite K +local instance genusDegreeDecidableEq : DecidableEq K := Classical.decEq K +local instance genusDegreeRatFuncDecidableEq : DecidableEq (RatFunc K) := + Classical.decEq (RatFunc K) +local instance genusDegreeConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) +local instance genusDegreeConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl +local instance (priority := 10) genusDegreePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) +local instance genusDegreePolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl +local instance genusDegreeConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Cotrace canonicality gives the Riemann--Hurwitz equality for the weighted +finite and infinite trace-different degrees. -/ +theorem finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two + [FunctionField.IsFullConstantField K L] : + (finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) : ℤ) + + (infinityDifferentDegree K L : ℤ) = + 2 * (Module.finrank (RatFunc K) L : ℤ) + + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + apply + (finiteExtensionCanonicalDifferent_degree_eq_two_genus_sub_two_iff K L).mp + rw [finiteExtensionDivisorDegree_eq_chart] + exact FunctionField.Chart.deg_canonical K L + (finiteExtensionCanonicalDifferent_isCanonical_of_cotrace K L) + +/-- The same Riemann--Hurwitz identity stated with the intrinsic genus. This +form no longer remembers which compatible polynomial chart was installed. -/ +theorem finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two_intrinsic + [FunctionField.IsFullConstantField K L] : + (finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) : ℤ) + + (infinityDifferentDegree K L : ℤ) = + 2 * (Module.finrank (RatFunc K) L : ℤ) + + 2 * (FunctionField.genus K L : ℤ) - 2 := by + rw [FunctionField.genus_eq_genusChart K L] + exact finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two K L + +end RiemannHurwitzDegree + +section RiemannHurwitzDegreeCompatibleChart + +variable (K : Type*) [Field K] [Finite K] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra K[X] L] [IsScalarTower K[X] (RatFunc K) L] + +local instance compatibleGenusDegreeFintype : Fintype K := Fintype.ofFinite K +local instance compatibleGenusDegreeDecidableEq : DecidableEq K := Classical.decEq K +local instance compatibleGenusDegreeRatFuncDecidableEq : DecidableEq (RatFunc K) := + Classical.decEq (RatFunc K) +local instance compatibleGenusDegreeConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) +local instance compatibleGenusDegreeConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +variable [IsScalarTower K K[X] L] + +/-- Riemann--Hurwitz for any polynomial chart whose action is compatible +with the fixed rational-function-field action. This is the same statement +as `finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two`, +but it keeps an explicitly installed chart instead of replacing it by the +induced one. -/ +theorem finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two_of_compatibleChart + [FunctionField.IsFullConstantField K L] : + (finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) : ℤ) + + (infinityDifferentDegree K L : ℤ) = + 2 * (Module.finrank (RatFunc K) L : ℤ) + + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [← FunctionField.genus_eq_genusChart K L] + exact + finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two_intrinsic K L + +end RiemannHurwitzDegreeCompatibleChart + +section ExactConstantExtensionConstants + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Finite C] [Finite S] + [Algebra (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance exactConstantExtensionGenusConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +/-- Exactness of the extended constants for the constant algebra induced by +the canonical `S(X)`-algebra structure on the exact constant extension. -/ +theorem exactConstantExtension_extended_algebraicClosure_eq_bot + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + algebraicClosure S L = (⊥ : IntermediateField S L) := by + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + let extendedConstantAlgebra : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + let tensorConstantAlgebra : Algebra S L := + Algebra.TensorProduct.leftAlgebra + have hconstantMap (s : S) : + (@algebraMap S L _ _ extendedConstantAlgebra) s = + (@algebraMap S L _ _ tensorConstantAlgebra) s := by + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + have hAlgebraicTransfer (z : L) + (hz : @IsAlgebraic S L _ _ extendedConstantAlgebra z) : + @IsAlgebraic S L _ _ tensorConstantAlgebra z := by + rcases hz with ⟨p, hp, hpz⟩ + refine ⟨p, hp, ?_⟩ + have hmapEq : + (@algebraMap S L _ _ extendedConstantAlgebra) = + (@algebraMap S L _ _ tensorConstantAlgebra) := by + ext s + exact hconstantMap s + change Polynomial.eval₂ + (@algebraMap S L _ _ extendedConstantAlgebra) z p = 0 at hpz + change Polynomial.eval₂ + (@algebraMap S L _ _ tensorConstantAlgebra) z p = 0 + rw [← hmapEq] + exact hpz + have hTensorRange (z : L) + (hz : @IsAlgebraic S L _ _ tensorConstantAlgebra z) : + z ∈ Set.range (@algebraMap S L _ _ tensorConstantAlgebra) := by + letI : Algebra S L := tensorConstantAlgebra + have hTensorExact : algebraicClosure S L = + (⊥ : IntermediateField S L) := + exactConstantExtension_algebraicClosure_eq_bot C N S hExact + have hzClosure : z ∈ algebraicClosure S L := + mem_algebraicClosure_iff.mpr hz + have hzBot : z ∈ (⊥ : IntermediateField S L) := by + rw [← hTensorExact] + exact hzClosure + exact hzBot + letI : Algebra S L := extendedConstantAlgebra + apply eq_bot_iff.mpr + intro z hz + have hzExtended : @IsAlgebraic S L _ _ extendedConstantAlgebra z := + mem_algebraicClosure_iff.mp hz + obtain ⟨s, hs⟩ := hTensorRange z + (hAlgebraicTransfer z hzExtended) + exact ⟨s, (hconstantMap s).trans hs⟩ + +end ExactConstantExtensionConstants + +section ExactConstantExtensionDegree + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance exactConstantExtensionDegreeConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +/-- Exact finite extension of the constants preserves the function-field +degree: `[S ⊗_C N : S(X)] = [N : C(X)]`. -/ +theorem exactConstantExtension_finrank_over_extendedRatFunc_eq + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + Module.finrank (RatFunc S) L = Module.finrank (RatFunc C) N := by + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule + letI : Module (RatFunc C) L := Algebra.toModule + letI : Module (RatFunc S) L := Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc S) L := + rationalBase_scalarTower C S N hExact + letI : FiniteDimensional (RatFunc S) L := + finiteDimensional_over_extendedRatFunc C S N hExact + have hdegree : + Module.finrank (RatFunc C) (RatFunc S) * + Module.finrank (RatFunc S) L = + Module.finrank (RatFunc C) N * Module.finrank C S := by + calc + Module.finrank (RatFunc C) (RatFunc S) * + Module.finrank (RatFunc S) L = + Module.finrank (RatFunc C) L := + Module.finrank_mul_finrank (RatFunc C) (RatFunc S) L + _ = Module.finrank (RatFunc C) N * Module.finrank C S := + exactConstantExtension_finrank_over_base + C (RatFunc C) N S + have hcancel : + Module.finrank C S * Module.finrank (RatFunc S) L = + Module.finrank C S * Module.finrank (RatFunc C) N := by + simpa only [ratFuncCoefficient_finrank, mul_comm] using hdegree + exact Nat.mul_left_cancel + (Module.finrank_pos (R := C) (M := S)) hcancel + +end ExactConstantExtensionDegree + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean new file mode 100644 index 0000000000..d157ccaa6c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean @@ -0,0 +1,237 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree + +/-! +# Genus invariance under exact constant extension + +Equality of the presented total-different multiplicities preserves the total +different degree. Riemann--Hurwitz and preservation of the rational-function +extension degree then identify the two chart genera. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) + exactConstantGenusInvarianceConstantsDecidableEq + (K : Type*) [Field K] : DecidableEq K := + infinityBridgeDecidableEqConstants K + +local instance (priority := 10001) + exactConstantGenusInvarianceRatFuncDecidableEq + (K : Type*) [Field K] : DecidableEq (RatFunc K) := + infinityBridgeDecidableEqRatFuncConstants K + +local instance exactConstantGenusInvarianceBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance exactConstantGenusInvarianceBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) + exactConstantGenusInvarianceBasePolynomialAlgebra : Algebra C[X] N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + +local instance exactConstantGenusInvarianceBasePolynomialTower : + IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance exactConstantGenusInvarianceBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Exact finite extension of constants preserves chart genus once the +pointwise total-different multiplicity compatibility is known. -/ +theorem exactConstantExtension_chart_genus_eq_of_presentedMultiplicity + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + let extendedConstantAlgebra : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + let tensorConstantAlgebra : Algebra S E := + Algebra.TensorProduct.leftAlgebra + let hconstantMap : ∀ s : S, + (@algebraMap S E _ _ extendedConstantAlgebra) s = + (@algebraMap S E _ _ tensorConstantAlgebra) s := by + intro s + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + let htensorPolynomialMap : ∀ s : S, + (@algebraMap S E _ _ tensorConstantAlgebra) s = + (@algebraMap S[X] E _ _ + (constantExtensionTensorPolynomialAlgebra C S N)) + (algebraMap S S[X] s) := by + intro s + change (s ⊗ₜ[C] (1 : N)) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) + (Polynomial.C s) + simp + letI : Algebra S E := extendedConstantAlgebra + letI : SMul S E := Algebra.toSMul + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : IsScalarTower S S[X] E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro s + exact (hconstantMap s).trans (htensorPolynomialMap s)) + letI : FunctionField.IsFullConstantField C N := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C N).2 + hExact + letI : FunctionField.IsFullConstantField S E := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot S E).2 + (exactConstantExtension_extended_algebraicClosure_eq_bot + C S N hExact) + (∀ q : ExactConstantExtensionPresentedPlace C S N, + finiteExtensionTotalDifferentEffectiveDivisor S E + (exactConstantExtensionPresentedUpstairsPlaceEquiv + C S N hExact q) = + finiteExtensionTotalDifferentEffectiveDivisor C N + (exactConstantExtensionPresentedDownstairsPlace + C S N hExact q)) → + FunctionField.Chart.genus S E = FunctionField.Chart.genus C N := by + dsimp only + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + let extendedConstantAlgebra : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + let tensorConstantAlgebra : Algebra S E := + Algebra.TensorProduct.leftAlgebra + have hconstantMap (s : S) : + (@algebraMap S E _ _ extendedConstantAlgebra) s = + (@algebraMap S E _ _ tensorConstantAlgebra) s := by + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + have htensorPolynomialMap (s : S) : + (@algebraMap S E _ _ tensorConstantAlgebra) s = + (@algebraMap S[X] E _ _ + (constantExtensionTensorPolynomialAlgebra C S N)) + (algebraMap S S[X] s) := by + change (s ⊗ₜ[C] (1 : N)) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) + (Polynomial.C s) + simp + letI : Algebra S E := extendedConstantAlgebra + letI : SMul S E := Algebra.toSMul + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : IsScalarTower S S[X] E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro s + exact (hconstantMap s).trans (htensorPolynomialMap s)) + intro hPresentedMultiplicity + letI : FunctionField.IsFullConstantField C N := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C N).2 + hExact + have hExtendedExact : algebraicClosure S E = + (⊥ : IntermediateField S E) := + exactConstantExtension_extended_algebraicClosure_eq_bot C S N hExact + letI : FunctionField.IsFullConstantField S E := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot S E).2 + hExtendedExact + have hTotalNat := + exactConstantExtension_totalDifferentDegree_eq_of_presentedMultiplicity + C S N hExact hPresentedMultiplicity + have hTotalInt : + (finiteExtensionFiniteDifferentDegree S E + (finiteExtensionFiniteDifferentIdeal_ne_bot S E) : ℤ) + + (infinityDifferentDegree S E : ℤ) = + (finiteExtensionFiniteDifferentDegree C N + (finiteExtensionFiniteDifferentIdeal_ne_bot C N) : ℤ) + + (infinityDifferentDegree C N : ℤ) := by + exact_mod_cast hTotalNat + have hUp := + finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two_of_compatibleChart + S E + have hDown := + finiteExtension_totalDifferentDegree_eq_two_finrank_add_two_genus_sub_two_of_compatibleChart + C N + have hRank : Module.finrank (RatFunc S) E = + Module.finrank (RatFunc C) N := + exactConstantExtension_finrank_over_extendedRatFunc_eq C S N hExact + dsimp only [E] at hTotalInt hUp hDown hRank ⊢ + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean new file mode 100644 index 0000000000..53eb2b2385 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean @@ -0,0 +1,643 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent + +/-! +# The infinity different after exact constant extension + +For an exact finite extension of constants, the old infinity normalization +maps into the new infinity normalization through the canonical embedding of +the original function field. The two rational-function subfields remain +linearly disjoint, while the coefficient extension of infinity valuation +rings has unit different. The linear-disjoint different theorem therefore +identifies the new infinity different with the extension of the old one. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance exactConstantExtensionInfinityDifferentBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance exactConstantExtensionInfinityDifferentDecidableEqBaseRatFunc : + DecidableEq (RatFunc C) := Classical.decEq _ +local instance exactConstantExtensionInfinityDifferentDecidableEqExtendedRatFunc : + DecidableEq (RatFunc S) := Classical.decEq _ + +@[reducible] private noncomputable def + exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra + (R : Type*) [CommRing R] [IsDomain R] : + Algebra R (FractionRing R) := inferInstance + +private theorem exactConstantExtensionInfinityDifferentCanonicalFractionRing + (R : Type*) [CommRing R] [IsDomain R] : + letI := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R + IsFractionRing R (FractionRing R) := by + letI := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R + infer_instance + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +private noncomputable def + exactConstantExtensionInfinityDifferentNormalizationRingHom + [Fintype C] [Finite S] : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : Algebra (RatFuncInfinityIntegers C) N := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers C) L := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers S) L := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : Algebra (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + RatFuncInfinityIntegralClosure C N →+* + RatFuncInfinityIntegralClosure S L := by + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : Module (RatFunc C) L := Algebra.toModule + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : SMul N L := Algebra.toSMul + letI : Module N L := Algebra.toModule + letI : IsScalarTower (RatFunc C) N L := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : SMul (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toModule + letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : SMul (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.toModule + letI : Algebra (RatFuncInfinityIntegers C) N := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : SMul (RatFuncInfinityIntegers C) N := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) N := Algebra.toModule + letI : Algebra (RatFuncInfinityIntegers C) L := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : SMul (RatFuncInfinityIntegers C) L := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) L := Algebra.toModule + letI : Algebra (RatFuncInfinityIntegers S) L := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : SMul (RatFuncInfinityIntegers S) L := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers S) L := Algebra.toModule + letI : Algebra (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : SMul (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := Algebra.toSMul + letI : Module (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := Algebra.toModule + letI : Module.Finite (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := + ratFuncInfinityIntegers_coefficient_moduleFinite C S + letI : IsScalarTower (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) L := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap (RatFunc C) L z.1 = + algebraMap (RatFunc S) L + (ratFuncCoefficientAlgHom C S z.1) + exact DFunLike.congr_fun + (rationalBase_algebraMap_eq C S N hExact) z.1) + letI : IsScalarTower (RatFuncInfinityIntegers C) N L := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap (RatFunc C) L z.1 = + algebraMap N L (algebraMap (RatFunc C) N z.1) + exact IsScalarTower.algebraMap_apply (RatFunc C) N L z.1) + let f : N →ₐ[RatFuncInfinityIntegers C] L := + IsScalarTower.toAlgHom (RatFuncInfinityIntegers C) N L + let e : integralClosure (RatFuncInfinityIntegers C) L ≃+* + integralClosure (RatFuncInfinityIntegers S) L := + integralClosureRingEquivOfIntegralTower + (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) L + exact e.toRingHom.comp f.mapIntegralClosure.toRingHom + +/-- The original infinity normalization acts on the infinity normalization +after exact constant extension through the canonical embedding of the +original function field. -/ +@[reducible] noncomputable def + exactConstantExtensionInfinityNormalizationAlgebra + [Fintype C] [Finite S] : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : Algebra (RatFuncInfinityIntegers C) N := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + Algebra (RatFuncInfinityIntegralClosure C N) + (RatFuncInfinityIntegralClosure S L) := + RingHom.toAlgebra + (exactConstantExtensionInfinityDifferentNormalizationRingHom C S N hExact) + +omit [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] in +/-- The infinity-normalization algebra map is the ambient embedding of the +original function field into the exact constant extension. -/ +theorem exactConstantExtensionInfinityNormalizationAlgebra_coe + [Fintype C] [Finite S] + (x : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : Algebra (RatFuncInfinityIntegers C) N := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + RatFuncInfinityIntegralClosure C N) : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : Algebra (RatFuncInfinityIntegers C) N := + Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : Algebra (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : Algebra (RatFuncInfinityIntegralClosure C N) + (RatFuncInfinityIntegralClosure S L) := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + ((algebraMap (RatFuncInfinityIntegralClosure C N) + (RatFuncInfinityIntegralClosure S L) x : + RatFuncInfinityIntegralClosure S L) : L) = + algebraMap N L x.1 := by + rfl + +/-- Changing the infinity coefficient valuation ring from `C` to `S` does +not change the integral closure inside an exact constant extension. The +underlying ring equivalence is the identity on the ambient function field. -/ +noncomputable def exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv + [Fintype C] [Finite S] : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + RatFuncInfinityIntegralClosure C L ≃+* + RatFuncInfinityIntegralClosure S L := by + let L := ExactConstantExtension C N S + let A := RatFuncInfinityIntegers C + let R₁ := RatFuncInfinityIntegers S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : Module (RatFunc C) L := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + letI : SMul A (RatFunc C) := Algebra.toSMul + letI : Module A (RatFunc C) := Algebra.toModule + letI : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring R₁ + letI : SMul R₁ (RatFunc S) := Algebra.toSMul + letI : Module R₁ (RatFunc S) := Algebra.toModule + letI : Algebra A L := Algebra.ofSubsemiring A + letI : SMul A L := Algebra.toSMul + letI : Module A L := Algebra.toModule + letI : Algebra R₁ L := Algebra.ofSubsemiring R₁ + letI : SMul R₁ L := Algebra.toSMul + letI : Module R₁ L := Algebra.toModule + letI : Algebra A R₁ := + RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : SMul A R₁ := Algebra.toSMul + letI : Module A R₁ := Algebra.toModule + letI : Module.Finite A R₁ := + ratFuncInfinityIntegers_coefficient_moduleFinite C S + letI : Algebra.IsIntegral A R₁ := by infer_instance + letI : IsScalarTower A R₁ L := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap (RatFunc C) L z.1 = + algebraMap (RatFunc S) L (ratFuncCoefficientAlgHom C S z.1) + exact DFunLike.congr_fun + (rationalBase_algebraMap_eq C S N hExact) z.1) + exact integralClosureRingEquivOfIntegralTower A R₁ L + +/-- The infinity-normalization base-change equivalence preserves the ambient +function-field element. -/ +theorem exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv_coe + [Fintype C] [Finite S] + (x : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + RatFuncInfinityIntegralClosure C L) : + let L := ExactConstantExtension C N S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + (((exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv + C S N hExact) x : RatFuncInfinityIntegralClosure S L) : L) = x := by + rfl + +/-- In an exact finite constant extension, the infinity different of the +extended normalization is the extension of the original infinity different. -/ +theorem exactConstantExtension_infinityDifferent_eq_map + [Fintype C] [Finite S] : + let L := ExactConstantExtension C N S + let A := RatFuncInfinityIntegers C + let R₁ := RatFuncInfinityIntegers S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : SMul A (RatFunc C) := Algebra.toSMul + letI : Module A (RatFunc C) := Algebra.toModule + letI : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : SMul R₁ (RatFunc S) := Algebra.toSMul + letI : Module R₁ (RatFunc S) := Algebra.toModule + letI : IsFractionRing A (RatFunc C) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) + letI : IsFractionRing R₁ (RatFunc S) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) + letI : Algebra A N := + Algebra.ofSubsemiring A + letI : SMul A N := Algebra.toSMul + letI : Module A N := Algebra.toModule + letI : IsScalarTower A (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra A R₁ := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : Algebra R₁ L := + Algebra.ofSubsemiring R₁ + letI : SMul R₁ L := Algebra.toSMul + letI : Module R₁ L := Algebra.toModule + letI : IsScalarTower R₁ (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + let R₂ := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S L + letI : IsIntegralClosure R₂ A N := + integralClosure.isIntegralClosure A N + letI : IsIntegralClosure B R₁ L := + integralClosure.isIntegralClosure R₁ L + letI : FiniteDimensional (RatFunc S) L := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) L := + isSeparable_over_extendedRatFunc C S N hExact + letI : IsDedekindDomain R₂ := + integralClosure.isDedekindDomain A (RatFunc C) N + letI : IsDedekindDomain B := + integralClosure.isDedekindDomain R₁ (RatFunc S) L + letI : Algebra R₂ B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + differentIdeal R₁ B = + Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by + let L := ExactConstantExtension C N S + let A := RatFuncInfinityIntegers C + let R₁ := RatFuncInfinityIntegers S + letI : Field L := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) L := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) L := Algebra.toSMul + letI : Module (RatFunc C) L := Algebra.toModule + letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction + letI : Algebra N L := exactConstantExtensionAlgebra C N S + letI : SMul N L := Algebra.toSMul + letI : Module N L := Algebra.toModule + letI : IsScalarTower (RatFunc C) N L := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule + letI : Algebra (RatFunc S) L := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) L := Algebra.toSMul + letI : Module (RatFunc S) L := Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc S) L := + rationalBase_scalarTower C S N hExact + letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + letI : SMul A (RatFunc C) := Algebra.toSMul + letI : Module A (RatFunc C) := Algebra.toModule + letI : IsFractionRing A (RatFunc C) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) + letI : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + letI : SMul R₁ (RatFunc S) := Algebra.toSMul + letI : Module R₁ (RatFunc S) := Algebra.toModule + letI : IsFractionRing R₁ (RatFunc S) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) + letI : Algebra A R₁ := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + letI : SMul A R₁ := Algebra.toSMul + letI : Module A R₁ := Algebra.toModule + letI : Module.Finite A R₁ := + ratFuncInfinityIntegers_coefficient_moduleFinite C S + letI : Module.IsTorsionFree A R₁ := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective (ratFuncInfinityIntegersRingHom C S) + exact ratFuncInfinityIntegersRingHom_injective C S + letI : Algebra.IsIntegral A R₁ := by infer_instance + letI : Algebra A N := + Algebra.ofSubsemiring A + letI : SMul A N := Algebra.toSMul + letI : Module A N := Algebra.toModule + letI : IsScalarTower A (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra A L := + Algebra.ofSubsemiring A + letI : SMul A L := Algebra.toSMul + letI : Module A L := Algebra.toModule + letI : IsScalarTower A (RatFunc C) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra R₁ L := + Algebra.ofSubsemiring R₁ + letI : SMul R₁ L := Algebra.toSMul + letI : Module R₁ L := Algebra.toModule + letI : DistribMulAction R₁ L := Module.toDistribMulAction + letI : MulAction R₁ L := DistribMulAction.toMulAction + letI : IsScalarTower R₁ (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower A R₁ L := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap (RatFunc C) L z.1 = + algebraMap (RatFunc S) L (ratFuncCoefficientAlgHom C S z.1) + exact DFunLike.congr_fun + (rationalBase_algebraMap_eq C S N hExact) z.1) + let R₂ := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S L + letI := Subalgebra.algebra R₂ + letI : SMul A R₂ := Algebra.toSMul + letI : Module A R₂ := Algebra.toModule + letI : Algebra R₂ N := Algebra.ofSubsemiring R₂ + letI : SMul R₂ N := Algebra.toSMul + letI : Module R₂ N := Algebra.toModule + letI : IsScalarTower A R₂ N := + IsScalarTower.of_algebraMap_eq' (by ext z; rfl) + letI := Subalgebra.algebra B + letI : SMul R₁ B := Algebra.toSMul + letI : Module R₁ B := Algebra.toModule + letI : Algebra B L := Algebra.ofSubsemiring B + letI : SMul B L := Algebra.toSMul + letI : Module B L := Algebra.toModule + letI : IsScalarTower R₁ B L := + IsScalarTower.of_algebraMap_eq' (by ext z; rfl) + letI : IsIntegralClosure R₂ A N := + integralClosure.isIntegralClosure A N + letI : IsIntegralClosure B R₁ L := + integralClosure.isIntegralClosure R₁ L + letI : IsDomain R₂ := inferInstance + letI : IsDomain B := inferInstance + letI : Module.IsTorsionFree R₁ L := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap (RatFunc S) L).injective.comp + (IsFractionRing.injective R₁ (RatFunc S)) + letI : FiniteDimensional (RatFunc S) L := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) L := + isSeparable_over_extendedRatFunc C S N hExact + let eNL := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N L := Module.Finite.equiv eNL + letI : FiniteDimensional (RatFunc C) L := Module.Finite.trans N L + letI : Algebra.IsSeparable (RatFunc C) L := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let f₁ : RatFunc S →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L + let f₂ : N →ₐ[RatFunc C] L := + IsScalarTower.toAlgHom (RatFunc C) N L + let F₁ : IntermediateField (RatFunc C) L := f₁.fieldRange + let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange + let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange + let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange + letI : Algebra R₁ F₁ := + RingHom.toAlgebra + (e₁.toRingEquiv.toRingHom.comp (algebraMap R₁ (RatFunc S))) + letI : SMul R₁ F₁ := Algebra.toSMul + letI : Module R₁ F₁ := Algebra.toModule + let e₁inf : RatFunc S ≃ₐ[R₁] F₁ := + { e₁.toRingEquiv with commutes' := fun _ => rfl } + letI : IsFractionRing R₁ F₁ := IsFractionRing.of_algEquiv e₁inf + letI : Module.IsTorsionFree R₁ F₁ := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact IsFractionRing.injective R₁ F₁ + letI : IsScalarTower R₁ F₁ L := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap R₁ L z = f₁ (algebraMap R₁ (RatFunc S) z) + rfl) + letI : Algebra R₂ F₂ := + RingHom.toAlgebra + (e₂.toRingEquiv.toRingHom.comp (algebraMap R₂ N)) + letI : SMul R₂ F₂ := Algebra.toSMul + letI : Module R₂ F₂ := Algebra.toModule + let e₂norm : N ≃ₐ[R₂] F₂ := + { e₂.toRingEquiv with commutes' := fun _ => rfl } + letI : Algebra R₂ L := + RingHom.toAlgebra ((algebraMap F₂ L).comp (algebraMap R₂ F₂)) + letI : SMul R₂ L := Algebra.toSMul + letI : Module R₂ L := Algebra.toModule + letI : IsScalarTower R₂ F₂ L := IsScalarTower.of_algebraMap_eq' rfl + letI : IsFractionRing R₂ N := + IsIntegralClosure.isFractionRing_of_finite_extension A (RatFunc C) N R₂ + letI : IsFractionRing R₂ F₂ := IsFractionRing.of_algEquiv e₂norm + letI : Module.IsTorsionFree R₂ L := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap F₂ L).injective.comp + (IsFractionRing.injective R₂ F₂) + letI : Algebra A F₂ := IntermediateField.algebra' F₂ + letI : SMul A F₂ := Algebra.toSMul + letI : IsScalarTower A R₂ F₂ := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap (RatFunc C) L z.1 = + algebraMap N L (algebraMap (RatFunc C) N z.1) + exact IsScalarTower.algebraMap_apply (RatFunc C) N L z.1) + letI : IsScalarTower A F₂ L := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower A R₂ L := + IsScalarTower.of_algebraMap_eq' (by + ext z + change algebraMap A L z = + algebraMap F₂ L (algebraMap R₂ F₂ (algebraMap A R₂ z)) + rw [← IsScalarTower.algebraMap_apply A R₂ F₂] + exact IsScalarTower.algebraMap_apply A F₂ L z) + letI : IsLocalization + (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) N := + IsIntegralClosure.isLocalization A (RatFunc C) N R₂ + letI : IsLocalization + (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂ := + IsLocalization.isLocalization_of_algEquiv _ e₂norm + letI : Algebra R₂ B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + letI : SMul R₂ B := Algebra.toSMul + letI : Module R₂ B := Algebra.toModule + letI : IsScalarTower R₂ B L := + IsScalarTower.of_algebraMap_eq' (by + ext x + exact exactConstantExtensionInfinityNormalizationAlgebra_coe + C S N hExact x) + letI : IsScalarTower A R₂ B := + IsScalarTower.of_algebraMap_eq' (by + ext z + calc + ((algebraMap A B z : B) : L) = algebraMap A L z := rfl + _ = algebraMap R₂ L (algebraMap A R₂ z) := + IsScalarTower.algebraMap_apply A R₂ L z + _ = algebraMap B L (algebraMap R₂ B (algebraMap A R₂ z)) := + IsScalarTower.algebraMap_apply R₂ B L _) + letI : Module.Finite A R₂ := + IsIntegralClosure.finite A (RatFunc C) N R₂ + letI : Module.IsTorsionFree A R₂ := + IsIntegralClosure.isTorsionFree A N + letI : Module.Free A R₂ := Module.free_of_finite_type_torsion_free' + letI : IsDedekindDomain R₂ := + integralClosure.isDedekindDomain A (RatFunc C) N + letI : IsDedekindDomain B := + integralClosure.isDedekindDomain R₁ (RatFunc S) L + letI : IsIntegralClosure B R₂ L := by + refine ⟨?_, ?_⟩ + · exact fun x y h => Subtype.ext h + · intro x + constructor + · intro hx + have hxA : IsIntegral A x := isIntegral_trans (R := A) x hx + have hxR₁ : IsIntegral R₁ x := hxA.tower_top + exact ⟨⟨x, hxR₁⟩, rfl⟩ + · rintro ⟨y, rfl⟩ + have hyA : IsIntegral A (y : L) := + isIntegral_trans (R := A) (y : L) y.2 + exact hyA.tower_top + letI : Module.Finite R₂ B := + IsIntegralClosure.finite R₂ F₂ L B + letI : Module.IsTorsionFree R₂ B := + IsIntegralClosure.isTorsionFree R₂ L + letI : Module.Finite R₁ B := + IsIntegralClosure.finite R₁ F₁ L B + letI : Module.IsTorsionFree R₁ B := + IsIntegralClosure.isTorsionFree R₁ L + letI : Module.Finite A B := Module.Finite.trans R₂ B + letI : Module.IsTorsionFree A B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + have hR₂B : Function.Injective (algebraMap R₂ B) := + Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree R₂ B from inferInstance) + have hAR₂ : Function.Injective (algebraMap A R₂) := + Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree A R₂ from inferInstance) + exact hR₂B.comp hAR₂ + letI : IsIntegralClosure B R₁ L := inferInstance + letI : IsFractionRing B L := + IsIntegralClosure.isFractionRing_of_finite_extension R₁ F₁ L B + letI : Algebra.IsSeparable (RatFunc C) F₂ := inferInstance + letI : Algebra.IsSeparable F₁ L := inferInstance + letI : Algebra A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra A + letI : SMul A (FractionRing A) := Algebra.toSMul + letI : IsFractionRing A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRing A + letI : Algebra B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra B + letI : SMul B (FractionRing B) := Algebra.toSMul + letI : IsFractionRing B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRing B + letI : Algebra A (FractionRing B) := + RingHom.toAlgebra + ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + letI : SMul A (FractionRing B) := Algebra.toSMul + letI : IsScalarTower A B (FractionRing B) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FaithfulSMul A (FractionRing B) := by + rw [faithfulSMul_iff_algebraMap_injective] + exact (IsFractionRing.injective B (FractionRing B)).comp + (Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree A B from inferInstance)) + letI : Algebra (FractionRing A) (FractionRing B) := + FractionRing.liftAlgebra A (FractionRing B) + letI : SMul (FractionRing A) (FractionRing B) := Algebra.toSMul + letI : IsScalarTower A (FractionRing A) (FractionRing B) := + FractionRing.isScalarTower_liftAlgebra A (FractionRing B) + letI : Algebra.IsSeparable (FractionRing A) (FractionRing B) := by + refine Algebra.IsSeparable.of_equiv_equiv + (ratFuncInfinityFractionRingEquiv C).symm.toRingEquiv + (FractionRing.algEquiv B L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (ratFuncInfinityFractionRingEquiv C).symm + (FractionRing.algEquiv B L).symm z + have hranges := + exactConstantExtension_rationalFunctionRanges_linearDisjoint C S N hExact + have hdisjoint : F₁.LinearDisjoint F₂ := hranges.1 + have hsup : F₁ ⊔ F₂ = ⊤ := hranges.2 + have hcoprime : + IsCoprime + ((differentIdeal A R₁).map (algebraMap R₁ B)) + ((differentIdeal A R₂).map (algebraMap R₂ B)) := by + rw [ratFuncInfinityIntegers_coefficient_differentIdeal_eq_top C S] + rw [Ideal.map_top] + apply Ideal.isCoprime_iff_sup_eq.mpr + exact top_sup_eq + (Ideal.map (algebraMap R₂ B) (differentIdeal A R₂)) + exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal + (K := RatFunc C) (L := L) (F₁ := F₁) (F₂ := F₂) + A B R₁ R₂ hdisjoint hsup hcoprime + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean new file mode 100644 index 0000000000..8cf9022cc7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean @@ -0,0 +1,314 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization + +/-! +# Normalization at infinity in an exact constant extension + +The affine coordinate at infinity is the reciprocal variable `X⁻¹`. This +file checks that the copy of `S(X)` in the exact constant extension +`S ⊗[C] N` sends that reciprocal variable to the tensor extension of the +reciprocal coordinate on `N`. + +Smooth base change and polynomial tensor cancellation then identify the +constant extension of the reciprocal affine normalization with the +reciprocal affine normalization over `S`. Localizing away from the origin +gives a ring equivalence with the actual infinity integral closure. Thus no +comparison with the finite-place coordinate is used or assumed. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Algebra (RatFunc C) N] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S] + +local instance infinityDecidableEqBase : DecidableEq C := Classical.decEq C +local instance infinityDecidableEqRatFuncBase : DecidableEq (RatFunc C) := + Classical.decEq (RatFunc C) +local instance infinityDecidableEqConstants : DecidableEq S := Classical.decEq S +local instance infinityDecidableEqRatFuncConstants : DecidableEq (RatFunc S) := + Classical.decEq (RatFunc S) + +local instance infinityConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance infinityReciprocalPolynomialAlgebra : Algebra C[X] N := + ratFuncExtensionReciprocalPolynomialAlgebra C N + +local instance infinityReciprocalPolynomialTower : + IsScalarTower C C[X] N := by + exact IsScalarTower.of_algebraMap_eq' (by + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap (RatFunc C) N + (((reciprocalPolynomialRingHom C (Polynomial.C c) : + RatFuncInfinityIntegers C) : RatFunc C)) + rw [reciprocalPolynomialRingHom_coe] + simp) + +local instance infinityReciprocalNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + +local instance infinityReciprocalNormalizationPolynomialTower : + IsScalarTower C C[X] (integralClosure C[X] N) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinityCoefficientPolynomialAlgebra : Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance infinitySpanXPrime : + (Ideal.span ({Polynomial.X} : Set S[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The reciprocal coordinate in the exact constant extension is the tensor +extension of the reciprocal coordinate on `N`. -/ +theorem ratFuncToExactConstantExtension_reciprocal_X : + ratFuncToExactConstantExtension C S N hExact (1 / RatFunc.X) = + polynomialTensorCancelEvaluationPoint C S N := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + rw [one_div] + have hrecip : polynomialTensorCancelEvaluationPoint C S N = + (Algebra.TensorProduct.includeRight : + N →ₐ[C] ExactConstantExtension C N S) + (algebraMap (RatFunc C) N (RatFunc.X⁻¹)) := by + unfold polynomialTensorCancelEvaluationPoint + congr 1 + change algebraMap (RatFunc C) N + (((reciprocalPolynomialRingHom C Polynomial.X : + RatFuncInfinityIntegers C) : RatFunc C)) = + algebraMap (RatFunc C) N (RatFunc.X⁻¹) + rw [reciprocalPolynomialRingHom_coe] + simp + rw [hrecip] + rw [map_inv₀, map_inv₀, map_inv₀, + ratFuncToExactConstantExtension_X] + rfl + +/-- The tensor-product polynomial action in the reciprocal coordinate is +exactly the reciprocal polynomial action induced from `S(X)`. -/ +theorem exactConstantExtensionReciprocalPolynomialAlgebra_eq : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N = + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + apply Algebra.algebra_ext + intro p + change Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) p = + algebraMap (RatFunc S) (ExactConstantExtension C N S) + (((reciprocalPolynomialRingHom S p : + RatFuncInfinityIntegers S) : RatFunc S)) + rw [reciprocalPolynomialRingHom_coe, Polynomial.hom_eval₂] + have hcoeff : + (algebraMap (RatFunc S) + (ExactConstantExtension C N S)).comp RatFunc.C = + algebraMap S (ExactConstantExtension C N S) := by + ext s + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + rw [hcoeff] + change Polynomial.eval₂ + (algebraMap S (ExactConstantExtension C N S)) + (polynomialTensorCancelEvaluationPoint C S N) p = + Polynomial.eval₂ + (algebraMap S (ExactConstantExtension C N S)) + (ratFuncToExactConstantExtension C S N hExact + (1 / RatFunc.X)) p + rw [ratFuncToExactConstantExtension_reciprocal_X C S N hExact] + +section FiniteConstants + +variable [Fintype C] [Finite S] + +/-- Smooth base change in the reciprocal coordinate, before identifying the +target polynomial action with the one induced from `S(X)`. -/ +noncomputable def finiteFieldReciprocalNormalizationAlgEquiv : + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + S ⊗[C] integralClosure C[X] N ≃ₐ[S[X]] + integralClosure S[X] (ExactConstantExtension C N S) := by + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + exact (polynomialTensorCancelOverCoefficientPolynomial C S + (integralClosure C[X] N)).symm |>.trans + (finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv C S N) |>.trans + (polynomialTensorCancelOverCoefficientPolynomial C S N).mapIntegralClosure + +/-- The constant extension of the reciprocal affine normalization is the +actual reciprocal affine normalization of the exact constant extension. -/ +noncomputable def exactConstantExtensionInfinityAffineNormalizationAlgEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + S ⊗[C] integralClosure C[X] N ≃ₐ[S[X]] + integralClosure S[X] (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + have h := exactConstantExtensionReciprocalPolynomialAlgebra_eq + C S N hExact + rw [← h] + exact finiteFieldReciprocalNormalizationAlgEquiv C S N + +/-- The reciprocal affine normalization equivalence carries the natural +localization set away from `X = 0` to the corresponding target set. -/ +theorem exactConstantExtensionInfinityAffineNormalization_map_primeCompl : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + Submonoid.map e + (Algebra.algebraMapSubmonoid + (S ⊗[C] integralClosure C[X] N) + (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl) = + Algebra.algebraMapSubmonoid + (integralClosure S[X] (ExactConstantExtension C N S)) + (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + dsimp only + unfold Algebra.algebraMapSubmonoid + ext x + constructor + · rintro ⟨y, ⟨p, hp, rfl⟩, rfl⟩ + exact ⟨p, hp, (e.commutes p).symm⟩ + · rintro ⟨p, hp, rfl⟩ + refine ⟨algebraMap S[X] + (S ⊗[C] integralClosure C[X] N) p, ⟨p, hp, rfl⟩, ?_⟩ + exact e.commutes p + +/-- Localizing the constant extension of the reciprocal normalization gives +the actual integral closure of the infinity valuation ring in the exact +constant extension. As a ring equivalence, this directly transports prime +ideals, local rings, and residue rings. -/ +noncomputable def exactConstantExtensionInfinityNormalizationLocalizationRingEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + Localization + (Algebra.algebraMapSubmonoid + (S ⊗[C] integralClosure C[X] N) + (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl) ≃+* + RatFuncInfinityIntegralClosure S + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] (ExactConstantExtension C N S) := + ratFuncExtensionReciprocalPolynomialAlgebra S + (ExactConstantExtension C N S) + let R := S ⊗[C] integralClosure C[X] N + let M := Algebra.algebraMapSubmonoid R + (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl + let Tm := Algebra.algebraMapSubmonoid + (integralClosure S[X] (ExactConstantExtension C N S)) + (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl + let L := Localization M + letI : Algebra + (integralClosure S[X] (ExactConstantExtension C N S)) + (RatFuncInfinityIntegralClosure S + (ExactConstantExtension C N S)) := + ratFuncInfinityReciprocalIntegralClosureAlgebra S + (ExactConstantExtension C N S) + letI : IsLocalization Tm + (RatFuncInfinityIntegralClosure S + (ExactConstantExtension C N S)) := + ratFuncInfinityIntegralClosure_isLocalization_reciprocal S + (ExactConstantExtension C N S) + let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + have hmap : Submonoid.map e M = Tm := + exactConstantExtensionInfinityAffineNormalization_map_primeCompl + C S N hExact + exact IsLocalization.ringEquivOfRingEquiv L + (RatFuncInfinityIntegralClosure S + (ExactConstantExtension C N S)) e.toRingEquiv hmap + +end FiniteConstants + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean new file mode 100644 index 0000000000..e2faee5847 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean @@ -0,0 +1,423 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent + +/-! +# Compatibility of infinity places with exact constant extension + +The reciprocal affine normalization of an exact constant extension may be +viewed either over the original constants or over the extended constants. +This module proves that these two presentations commute with localization at +infinity. Consequently, the explicit upstairs infinity prime contracts to the +explicit downstairs infinity prime under the canonical algebra on infinity +normalizations. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Fintype C] [Finite S] + +local instance infinityPlaceCompatibilityBaseConstantAlgebra : Algebra C N := + infinityConstantAlgebra C N + +local instance infinityPlaceCompatibilityBaseReciprocalPolynomialAlgebra : + Algebra C[X] N := infinityReciprocalPolynomialAlgebra C N + +local instance infinityPlaceCompatibilityBaseConstantReciprocalTower : + IsScalarTower C C[X] N := infinityReciprocalPolynomialTower C N + +local instance infinityPlaceCompatibilityOldNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + +local instance + infinityPlaceCompatibilityOldNormalizationConstantPolynomialTower : + IsScalarTower C C[X] (integralClosure C[X] N) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinityPlaceCompatibilityCoefficientPolynomialAlgebra : + Algebra C[X] S[X] := Polynomial.algebra C S + +local instance infinityPlaceCompatibilityCoefficientPolynomialSMul : + SMul C[X] S[X] := Algebra.toSMul + +local instance infinityPlaceCompatibilityCoefficientPolynomialModule : + Module C[X] S[X] := Algebra.toModule + +local instance (priority := 10000) + infinityPlaceCompatibilityDecidableEqBaseRatFunc : + DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C + +local instance (priority := 10000) + infinityPlaceCompatibilityDecidableEqExtendedRatFunc : + DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S + +local instance (priority := 10000) infinityPlaceCompatibilityDecidableEqBase : + DecidableEq C := infinityBridgeDecidableEqConstants C + +local instance (priority := 10000) + infinityPlaceCompatibilityDecidableEqExtended : + DecidableEq S := infinityBridgeDecidableEqConstants S + +private theorem + infinityPlaceCompatibility_integralClosureAlgEquivOfAlgebraEq_coe + {R L T : Type*} [CommRing R] [Field L] [CommRing T] [Algebra R T] + (a b : Algebra R L) (h : a = b) + (e : T ≃ₐ[R] @integralClosure R L _ _ a) (x : T) : + let e' : T ≃ₐ[R] @integralClosure R L _ _ b := by + rw [← h] + exact e + ((e' x : @integralClosure R L _ _ b) : L) = + ((e x : @integralClosure R L _ _ a) : L) := by + subst b + rfl + +/-- The reciprocal affine normalization equivalence sends the old +normalization embedded in the right tensor factor to the same element of the +ambient exact constant extension. -/ +private theorem + exactConstantExtensionInfinityAffineNormalization_includeRight_coe + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (x : integralClosure C[X] N) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + ((exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact) + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N) x) : E) = + Algebra.TensorProduct.includeRight (R := C) (A := S) (B := N) x.1 := by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] + (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + let a := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + let b := ratFuncExtensionReciprocalPolynomialAlgebra S E + let h : a = b := + exactConstantExtensionReciprocalPolynomialAlgebra_eq C S N hExact + let y := Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N) x + have hTransport := + infinityPlaceCompatibility_integralClosureAlgEquivOfAlgebraEq_coe + a b h (finiteFieldReciprocalNormalizationAlgEquiv C S N) y + have hFinite : + (((finiteFieldReciprocalNormalizationAlgEquiv C S N) y : + @integralClosure S[X] E _ _ a) : E) = + (1 : S) ⊗ₜ[C] (x : N) := by + dsimp only [y, a] + simp only [finiteFieldReciprocalNormalizationAlgEquiv, + AlgEquiv.trans_apply, + Algebra.TensorProduct.includeRight_apply, + polynomialTensorCancelOverCoefficientPolynomial_symm_apply, + polynomialTensorCancel_symm_tmul, + finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, + AlgEquiv.ofBijective_apply, + AlgEquiv.coe_mapIntegralClosure] + rw [polynomialTensorCancelOverCoefficientPolynomial_apply] + change polynomialTensorCancel C S N + (Polynomial.C 1 ⊗ₜ[C[X]] (x : N)) = + (1 : S) ⊗ₜ[C] (x : N) + rw [polynomialTensorCancel_tmul] + simp + have hExactTransport : + ((exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact y : @integralClosure S[X] E _ _ b) : E) = + (((finiteFieldReciprocalNormalizationAlgEquiv C S N) y : + @integralClosure S[X] E _ _ a) : E) := by + simpa only [a, b, h, + exactConstantExtensionInfinityAffineNormalizationAlgEquiv] using + hTransport + exact hExactTransport.trans hFinite + +/-- The affine-to-infinity localization square commutes on elements of the +old reciprocal normalization. -/ +private theorem exactConstantExtensionInfinityAffineLocalizationSquare_coe + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (x : integralClosure C[X] N) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + let R0 := integralClosure C[X] N + let AS := integralClosure S[X] E + let R2 := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S E + letI : Algebra S[X] (S ⊗[C] R0) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 + let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + letI : Algebra R0 R2 := + ratFuncInfinityReciprocalIntegralClosureAlgebra C N + letI : Algebra AS B := + ratFuncInfinityReciprocalIntegralClosureAlgebra S E + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + (((algebraMap R2 B) ((algebraMap R0 R2) x) : B) : E) = + (((algebraMap AS B) + (eAff (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x)) : B) : E) := by + dsimp only + let E := ExactConstantExtension C N S + let R0 := integralClosure C[X] N + let R2 := RatFuncInfinityIntegralClosure C N + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + let AS := integralClosure S[X] E + letI : Algebra S[X] (S ⊗[C] R0) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 + let B := RatFuncInfinityIntegralClosure S E + let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + letI : Algebra R0 R2 := + ratFuncInfinityReciprocalIntegralClosureAlgebra C N + letI : Algebra AS B := + ratFuncInfinityReciprocalIntegralClosureAlgebra S E + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + calc + (((algebraMap R2 B) ((algebraMap R0 R2) x) : B) : E) = + algebraMap N E x.1 := by + change + (((algebraMap R2 B (algebraMap R0 R2 x) : B) : E)) = + algebraMap N E ((algebraMap R0 R2 x : R2) : N) + exact exactConstantExtensionInfinityNormalizationAlgebra_coe + C S N hExact (algebraMap R0 R2 x) + _ = Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := N) x.1 := rfl + _ = ((eAff (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x) : AS) : E) := by + exact + (exactConstantExtensionInfinityAffineNormalization_includeRight_coe + C S N hExact x).symm + _ = (((algebraMap AS B) + (eAff (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x)) : B) : E) := rfl + +/-- The extended reciprocal affine prime contracts to the reciprocal affine +prime obtained from the old normalization. -/ +private theorem exactConstantExtensionInfinityAffinePrime_under + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + let R0 := integralClosure C[X] N + let AS := integralClosure S[X] E + letI : Algebra S[X] (S ⊗[C] R0) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 + let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + let qA : IsDedekindDomain.HeightOneSpectrum AS := + heightOneSpectrumEquivOfAlgEquiv eAff q.1 + let oldToAffine : R0 →+* AS := + eAff.toRingEquiv.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0)).toRingHom + letI : Algebra R0 AS := oldToAffine.toAlgebra + qA.asIdeal.under R0 = + exactConstantExtensionInfinityDownstairsIdeal C S N q.1 := by + dsimp only + let E := ExactConstantExtension C N S + let R0 := integralClosure C[X] N + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + let AS := integralClosure S[X] E + letI : Algebra S[X] (S ⊗[C] R0) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 + let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + let qA : IsDedekindDomain.HeightOneSpectrum AS := + heightOneSpectrumEquivOfAlgEquiv eAff q.1 + let oldToAffine : R0 →+* AS := + eAff.toRingEquiv.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0)).toRingHom + letI : Algebra R0 AS := oldToAffine.toAlgebra + ext x + change eAff + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x) ∈ qA.asIdeal ↔ + Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x ∈ q.1.asIdeal + rw [show qA.asIdeal = q.1.asIdeal.comap eAff.symm by rfl] + change eAff.symm (eAff + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x)) ∈ q.1.asIdeal ↔ + Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x ∈ q.1.asIdeal + rw [eAff.symm_apply_apply] + +private theorem + exactConstantExtensionDownstairsInfinityMappedIdeal_isMaximal + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + let R0 := integralClosure C[X] N + let R2 := RatFuncInfinityIntegralClosure C N + letI : Algebra R0 R2 := + ratFuncInfinityReciprocalIntegralClosureAlgebra C N + (Ideal.map (algebraMap R0 R2) + (exactConstantExtensionInfinityDownstairsIdeal C S N q.1)).IsMaximal := by + dsimp only + change (exactConstantExtensionDownstairsInfinityPlace + C S N q.1 q.2).1.IsMaximal + infer_instance + +/-- The explicit upstairs infinity prime of an exact constant extension +contracts, through the canonical algebra on infinity normalizations, to its +explicit downstairs infinity prime. -/ +theorem exactConstantExtensionUpstairsInfinityPlace_under + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + let R2 := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S E + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2).1.under R2 = + (exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2).1 := by + dsimp only + let E := ExactConstantExtension C N S + let R0 := integralClosure C[X] N + let R2 := RatFuncInfinityIntegralClosure C N + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra N E := exactConstantExtensionAlgebra C N S + letI : SMul N E := Algebra.toSMul + letI : Module N E := Algebra.toModule + letI : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : Algebra S[X] E := + ratFuncExtensionReciprocalPolynomialAlgebra S E + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + let AS := integralClosure S[X] E + letI : Algebra S[X] (S ⊗[C] R0) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 + letI : SMul S[X] (S ⊗[C] R0) := Algebra.toSMul + let B := RatFuncInfinityIntegralClosure S E + let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv + C S N hExact + let qA : IsDedekindDomain.HeightOneSpectrum AS := + heightOneSpectrumEquivOfAlgEquiv eAff q.1 + let p := exactConstantExtensionInfinityDownstairsIdeal C S N q.1 + let oldToAffine : R0 →+* AS := + eAff.toRingEquiv.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0)).toRingHom + letI : Algebra R0 AS := oldToAffine.toAlgebra + letI : SMul R0 AS := Algebra.toSMul + letI : Algebra R0 R2 := + ratFuncInfinityReciprocalIntegralClosureAlgebra C N + letI : SMul R0 R2 := Algebra.toSMul + letI : Algebra AS B := + ratFuncInfinityReciprocalIntegralClosureAlgebra S E + letI : SMul AS B := Algebra.toSMul + letI : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + letI : SMul R2 B := Algebra.toSMul + letI : Module R2 B := Algebra.toModule + letI : Algebra R0 B := + RingHom.toAlgebra + ((algebraMap R2 B).comp (algebraMap R0 R2)) + letI : SMul R0 B := Algebra.toSMul + letI : IsScalarTower R0 R2 B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower R0 AS B := + IsScalarTower.of_algebraMap_eq' (by + ext x + change + (((algebraMap R2 B) ((algebraMap R0 R2) x) : B) : E) = + (((algebraMap AS B) + (eAff (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R0) x)) : B) : E) + exact exactConstantExtensionInfinityAffineLocalizationSquare_coe + C S N hExact x) + have hAffine : qA.asIdeal.under R0 = p := by + exact exactConstantExtensionInfinityAffinePrime_under C S N hExact q + have hMaxExplicit := + exactConstantExtensionDownstairsInfinityMappedIdeal_isMaximal C S N q + have hUpstairsNe := + (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2).2.1.ne_top + change (Ideal.map (algebraMap AS B) qA.asIdeal).under R2 = + Ideal.map (algebraMap R0 R2) p + rw [Ideal.under_map_eq_map_under + (A := R0) (B := AS) (C := R2) (D := B) qA.asIdeal + (by rw [hAffine]; exact hMaxExplicit) + (by + change (exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2).1 ≠ ⊤ + exact hUpstairsNe), hAffine] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean new file mode 100644 index 0000000000..9f502dc058 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -0,0 +1,1786 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower + +/-! +# Finite-place Frobenius-twist averaging over an intermediate base + +This file proves the finite-place part of Stichtenoth's Frobenius-twist +average for `C(X) \subseteq L \subseteq N`. +-/ + +open scoped BigOperators Pointwise Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance intermediateAverageTopConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance intermediateAverageTopConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance intermediateAverageTargetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + bridgeTargetPolynomialAlgebra C S N + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +section IntermediateBase + +variable (L : Type*) [Field L] + [Algebra (RatFunc C) L] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [Algebra L N] [IsScalarTower (RatFunc C) L N] + [FiniteDimensional L N] [IsGalois L N] + +local instance intermediateAverageBaseConstantAlgebra : Algebra C L := + RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp + (algebraMap C (RatFunc C))) + +local instance intermediateAverageConstantTower : IsScalarTower C L N := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap L N + (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) + exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ + +local instance intermediateAverageRationalFinitePlaceFintype : + Fintype (FiniteExtensionRationalFinitePlace C L) := Fintype.ofFinite _ + +/-- The exact constant extension is finite-dimensional over every +intermediate function field `L`. -/ +private theorem finiteDimensional_exactConstantExtension_over_intermediateBase + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + FiniteDimensional L (ExactConstantExtension C N S) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower L N T := + exactConstantExtensionBaseTower C L N S + let tensorEquiv := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + letI : Module.Finite N T := Module.Finite.equiv tensorEquiv + letI : Module.Finite L T := Module.Finite.trans N T + infer_instance + +/-- Compatibility of the rational-function and intermediate-base algebra +maps on the exact constant extension. -/ +private theorem exactConstantExtensionIntermediate_ratFuncBaseTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + let T := ExactConstantExtension C N S + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + apply IsScalarTower.of_algebraMap_eq' + ext x + change (1 : S) ⊗ₜ algebraMap (RatFunc C) N x = + (1 : S) ⊗ₜ algebraMap L N (algebraMap (RatFunc C) L x) + congr 1 + exact IsScalarTower.algebraMap_apply (RatFunc C) L N x + +/-- The rational-function algebra on an intermediate-base Frobenius-twist +field is obtained through `C(X) → L → F_g`. -/ +@[implicit_reducible] +noncomputable def intermediateFrobeniusTwistFieldRatFuncAlgebra + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + Algebra (RatFunc C) + (exactConstantExtensionFrobeniusTwistField C L N S hExact g) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + exact RingHom.toAlgebra + ((show L →+* F from algebraMap L F).comp + (show RatFunc C →+* L from algebraMap (RatFunc C) L)) + +/-- The induced rational-function algebra is compatible with the inclusion +of the twist field into the exact constant extension. -/ +private theorem intermediateFrobeniusTwistField_ratFunc_tower + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl + apply IsScalarTower.of_algebraMap_eq' + ext x + calc + algebraMap (RatFunc C) T x = + algebraMap L T (algebraMap (RatFunc C) L x) := + IsScalarTower.algebraMap_apply (RatFunc C) L T x + _ = algebraMap F T (algebraMap L F (algebraMap (RatFunc C) L x)) := + IsScalarTower.algebraMap_apply L F T _ + _ = algebraMap F T (algebraMap (RatFunc C) F x) := rfl + +/-- Every intermediate-base Frobenius-twist field is a finite function field +over `C(X)`. -/ +theorem finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + FiniteDimensional (RatFunc C) F := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + exact Module.Finite.left (RatFunc C) F T + +/-- Separability of the exact constant extension descends to every +intermediate-base Frobenius-twist field. -/ +theorem isSeparable_intermediateFrobeniusTwistField_over_ratFunc + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + Algebra.IsSeparable (RatFunc C) F := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + exact Algebra.isSeparable_tower_bot_of_isSeparable (RatFunc C) F T + +/-- The ambient Frobenius twist regarded as an automorphism over its own +fixed field. -/ +noncomputable def intermediateFrobeniusTwistOverFixedField + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + ExactConstantExtension C N S ≃ₐ[ + exactConstantExtensionFrobeniusTwistField C L N S hExact g] + ExactConstantExtension C N S := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + let sigma := exactConstantExtensionFrobeniusTwist C L N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g + exact IntermediateField.subgroupEquivAlgEquiv H + ⟨sigma, Subgroup.mem_zpowers sigma⟩ + +@[simp] +theorem intermediateFrobeniusTwistOverFixedField_apply + (g : N ≃ₐ[L] N) (x : ExactConstantExtension C N S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + intermediateFrobeniusTwistOverFixedField C S N hExact L g x = + exactConstantExtensionFrobeniusTwist C L N S hExact g x := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + change (exactConstantExtensionFrobeniusTwist + C L N S hExact g).toEquiv x = _ + rfl + +/-- The twist over its fixed field generates the full relative Galois +group. -/ +theorem intermediateFrobeniusTwistOverFixedField_zpowers_eq_top + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + Subgroup.zpowers + (intermediateFrobeniusTwistOverFixedField C S N hExact L g) = ⊤ := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + let sigma := exactConstantExtensionFrobeniusTwist C L N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g + let e := IntermediateField.subgroupEquivAlgEquiv H + let u : H := ⟨sigma, Subgroup.mem_zpowers sigma⟩ + change Subgroup.zpowers (e u) = ⊤ + apply (Subgroup.eq_top_iff' _).mpr + intro tau + let h : H := e.symm tau + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp h.2 + apply Subgroup.mem_zpowers_iff.mpr + refine ⟨k, ?_⟩ + calc + (e u) ^ k = e (u ^ k) := (map_zpow e u k).symm + _ = e h := congrArg e (Subtype.ext hk) + _ = tau := e.apply_symm_apply tau + +omit [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional L N] [IsGalois L N] in +/-- A power of the generic intermediate-base twist acts on the enlarged +constants by the same power of finite-field Frobenius. -/ +private theorem intermediateFrobeniusTwist_zpow_includeLeft + (g : N ≃ₐ[L] N) (k : ℤ) (s : S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + ((exactConstantExtensionFrobeniusTwist C L N S hExact g) ^ k) + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + (((FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k) s) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + change + ((exactConstantExtensionCombinedAutHom C L N S + (FiniteField.frobeniusAlgEquivOfAlgebraic C S, g)) ^ k) + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = _ + rw [← map_zpow] + simp [Algebra.TensorProduct.includeLeft_apply, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] + +/-- Every finite place of the exact constant extension is unramified over an +intermediate-base Frobenius-twist fixed field. -/ +theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module F (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) F + (ExactConstantExtension C N S) := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional F (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F (ExactConstantExtension C N S) := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finitePlaceRelativeRamificationIdx C F + (ExactConstantExtension C N S) Q = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : Algebra C[X] F := + RingHom.toAlgebra + ((algebraMap (RatFunc C) F).comp (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C[X] (RatFunc C) F := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra C[X] T := + RingHom.toAlgebra + ((algebraMap (RatFunc C) T).comp (algebraMap C[X] (RatFunc C))) + letI : IsScalarTower C[X] (RatFunc C) T := + IsScalarTower.of_algebraMap_eq' rfl + let A := RatFuncFiniteIntegralClosure C T + let AF := RatFuncFiniteIntegralClosure C F + letI : Algebra AF A := (finiteIntegralClosureMap C F T).toAlgebra + letI : SMul AF A := Algebra.toSMul + letI : Module AF A := Algebra.toModule + letI : Algebra S A := + exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact + letI : IsScalarTower AF F T := inferInstance + letI : Algebra.IsIntegral C[X] AF := + IsIntegralClosure.isIntegral_algebra C[X] F + letI : IsScalarTower C[X] AF T := by + apply IsScalarTower.of_algebraMap_eq + intro x + change algebraMap (RatFunc C) T + (algebraMap C[X] (RatFunc C) x) = + algebraMap F T + (algebraMap (RatFunc C) F (algebraMap C[X] (RatFunc C) x)) + exact IsScalarTower.algebraMap_apply (RatFunc C) F T _ + letI : IsScalarTower AF A T := + ⟨fun r t x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap A T (algebraMap AF A r) = + algebraMap AF T r by rfl] + ring⟩ + letI : IsIntegralClosure A AF T := + IsIntegralClosure.tower_top (R := C[X]) + letI : IsDedekindDomain A := inferInstance + letI : MulSemiringAction (T ≃ₐ[F] T) A := + finiteIntegralClosureGalAction C F T + dsimp only + intro Q + letI : Q.asIdeal.IsMaximal := Q.isMaximal + rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C F T Q] + have hInertia : finitePlaceInertiaGroup C F T Q = ⊥ := by + ext tau + constructor + · intro htau + rw [Subgroup.mem_bot] + let sigma := exactConstantExtensionFrobeniusTwist C L N S hExact g + let H := exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g + let e := IntermediateField.subgroupEquivAlgEquiv H + let h : H := e.symm tau + have he_apply (z : H) (x : T) : e z x = z.1 x := by + change z.1.toEquiv x = z.1 x + rfl + have htau_apply (x : T) : tau x = h.1 x := by + calc + tau x = e h x := by + exact congrArg (fun z : T ≃ₐ[F] T => z x) + (e.apply_symm_apply tau).symm + _ = h.1 x := he_apply h x + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp h.2 + let frob := FiniteField.frobeniusAlgEquivOfAlgebraic C S + have hfrob_apply (s : S) : (frob ^ k) s = s := by + let a : A := algebraMap S A s + have haction : tau • a = algebraMap S A ((frob ^ k) s) := by + apply Subtype.ext + calc + ((tau • a : A) : T) = tau (a : T) := by + change algebraMap A T ((galRestrict AF F T A tau) a) = + tau (algebraMap A T a) + exact algebraMap_galRestrict_apply AF tau a + _ = h.1 (a : T) := htau_apply (a : T) + _ = h.1 (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) := by + exact congrArg h.1 + (exactConstantExtensionFiniteIntegralClosure_algebraMap_val + C N S hExact s) + _ = (sigma ^ k) (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) := by + exact congrArg + (fun z : T ≃ₐ[L] T => z (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s)) hk |>.symm + _ = Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) ((frob ^ k) s) := + intermediateFrobeniusTwist_zpow_includeLeft + C S N hExact L g k s + _ = ((algebraMap S A ((frob ^ k) s) : A) : T) := + (exactConstantExtensionFiniteIntegralClosure_algebraMap_val + C N S hExact ((frob ^ k) s)).symm + have hmem : tau • a - a ∈ Q.asIdeal := htau a + have hmem' : algebraMap S A ((frob ^ k) s - s) ∈ Q.asIdeal := by + have heq : algebraMap S A ((frob ^ k) s - s) = tau • a - a := by + calc + algebraMap S A ((frob ^ k) s - s) = + algebraMap S A ((frob ^ k) s) - algebraMap S A s := + map_sub (algebraMap S A) _ _ + _ = algebraMap S A ((frob ^ k) s) - a := rfl + _ = tau • a - a := congrArg (fun z : A => z - a) haction.symm + exact heq.symm ▸ hmem + let J : Ideal S := Q.asIdeal.comap (algebraMap S A) + have hmemJ : (frob ^ k) s - s ∈ J := hmem' + have hJne : J ≠ ⊤ := + Ideal.comap_ne_top (algebraMap S A) Q.isPrime.ne_top + have hJ : J = ⊥ := (Ideal.eq_bot_or_top J).resolve_right hJne + have hs : (frob ^ k) s - s = 0 := by + rw [hJ] at hmemJ + simpa only [Ideal.mem_bot] using hmemJ + exact sub_eq_zero.mp hs + have hFrob : frob ^ k = 1 := by + ext s + exact hfrob_apply s + have hkdiv : (Module.finrank C S : ℤ) ∣ k := by + rw [← FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S] + exact orderOf_dvd_iff_zpow_eq_one.mpr hFrob + have hsigma : sigma ^ k = 1 := by + rw [← orderOf_dvd_iff_zpow_eq_one, + orderOf_exactConstantExtensionFrobeniusTwist + C L N S hExact g hdiv] + exact hkdiv + have hambient : (h.1 : T ≃ₐ[L] T) = 1 := by + calc + (h.1 : T ≃ₐ[L] T) = sigma ^ k := hk.symm + _ = 1 := hsigma + have hh : h = 1 := Subtype.ext hambient + calc + tau = e h := (e.apply_symm_apply tau).symm + _ = e 1 := congrArg e hh + _ = 1 := map_one e + · intro htau + rw [Subgroup.mem_bot] at htau + simp [htau] + rw [hInertia] + exact Nat.card_unique + +/-- Restriction of an exact-constant-extension finite place through `N` +agrees with direct restriction to the intermediate field `L`. -/ +private theorem finitePlaceUnder_intermediate_original + : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finitePlaceUnder C L N + (finitePlaceUnder C N (ExactConstantExtension C N S) Q) = + finitePlaceUnder C L (ExactConstantExtension C N S) Q := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsScalarTower L N T := + exactConstantExtensionBaseTower C L N S + let R₀ := RatFuncFiniteIntegralClosure C L + let R₁ := RatFuncFiniteIntegralClosure C N + let R₂ := RatFuncFiniteIntegralClosure C T + letI : Algebra R₀ R₁ := (finiteIntegralClosureMap C L N).toAlgebra + letI : Algebra R₁ R₂ := (finiteIntegralClosureMap C N T).toAlgebra + letI : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra + letI : SMul R₀ R₁ := Algebra.toSMul + letI : Module R₀ R₁ := Algebra.toModule + letI : SMul R₁ R₂ := Algebra.toSMul + letI : Module R₁ R₂ := Algebra.toModule + letI : SMul R₀ R₂ := Algebra.toSMul + letI : Module R₀ R₂ := Algebra.toModule + letI : IsScalarTower R₀ R₁ R₂ := by + apply IsScalarTower.of_algebraMap_eq' + ext x + change algebraMap L T (x : L) = + algebraMap N T (algebraMap L N (x : L)) + exact IsScalarTower.algebraMap_apply L N T _ + intro Q + apply IsDedekindDomain.HeightOneSpectrum.ext + exact Ideal.under_under Q.asIdeal + +/-- Choose an `S[X]`-presentation of a top finite place while transporting +rationality of its restriction to the intermediate field `L`. -/ +private theorem exists_presentedFinitePlace_of_under_intermediate_rational : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L (ExactConstantExtension C N S) Q)) = 1 → + ∃ q : IsDedekindDomain.HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S)), + exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q = Q ∧ + finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L N + (exactConstantExtensionDownstairsFinitePlace + C S N hExact q))) = 1 := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + intro Q hBase + let e := exactConstantExtensionPresentedFinitePlaceEquiv C S N hExact + let q := e.symm Q + have heq : exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q = Q := by + calc + exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q = e q := + (exactConstantExtensionPresentedFinitePlaceEquiv_apply + C S N hExact q).symm + _ = Q := e.apply_symm_apply Q + have hDownstairs : finitePlaceUnder C N T Q = + exactConstantExtensionDownstairsFinitePlace C S N hExact q := by + calc + finitePlaceUnder C N T Q = + finitePlaceUnder C N T + (exactConstantExtensionCompatibleBaseFinitePlace + C S N hExact q) := congrArg _ heq.symm + _ = exactConstantExtensionDownstairsFinitePlace C S N hExact q := + exactConstantExtensionCompatibleBaseFinitePlace_under_original + C S N hExact q + refine ⟨q, heq, ?_⟩ + rw [← hDownstairs, + finitePlaceUnder_intermediate_original C S N hExact L Q] + exact hBase + +/-- Every top finite place over a rational finite place of `L` has absolute +degree `[S : C]` when `[N : L]` divides the constant-extension degree. -/ +theorem exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_intermediate_rational + (hDegreeDiv : Module.finrank L N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L (ExactConstantExtension C N S) Q)) = 1 → + finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = + Module.finrank C S := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul N T := Algebra.toSMul + letI : Module N T := Algebra.toModule + letI : IsScalarTower (RatFunc C) N T := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S + letI : Algebra (RatFunc S) T := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) T := Algebra.toSMul + letI : Module (RatFunc S) T := Algebra.toModule + letI : FiniteDimensional (RatFunc S) T := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) T := + isSeparable_over_extendedRatFunc C S N hExact + intro Q hBase + obtain ⟨q, heq, hBaseQ⟩ := + exists_presentedFinitePlace_of_under_intermediate_rational + C S N hExact L Q hBase + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + let P₀ := finitePlaceUnder C L N P + have hInertiaDiv : finitePlaceRelativeInertiaDeg C L N P ∣ + Module.finrank L N := by + let PInFiber : FinitePlaceUnderFiber C L N P₀ := ⟨P, rfl⟩ + have hFiber := + finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + C L N P₀ PInFiber + refine ⟨Fintype.card (FinitePlaceUnderFiber C L N P₀) * + finitePlaceRelativeRamificationIdx C L N P, ?_⟩ + simpa [PInFiber, Nat.mul_comm, Nat.mul_left_comm, Nat.mul_assoc] + using hFiber.symm + have hDownDegreeEq : finiteExtensionPlaceDegree C N (.inl P) = + finitePlaceRelativeInertiaDeg C L N P := by + have hDegree := finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg + C L N P + simpa [P₀, P, hBaseQ] using hDegree + have hDownDegreeDiv : finiteExtensionPlaceDegree C N (.inl P) ∣ + Module.finrank C S := by + rw [hDownDegreeEq] + exact hInertiaDiv.trans hDegreeDiv + have hUpstairsRational : + finiteExtensionPlaceDegree S T + (.inl (exactConstantExtensionUpstairsFinitePlace C S N hExact q)) = 1 := by + rw [exactConstantExtensionFinitePlace_degree_eq_div_gcd + C S N hExact q, + (Nat.gcd_eq_right_iff_dvd).2 hDownDegreeDiv] + exact Nat.div_self (finiteExtensionPlaceDegree_pos C N (.inl P)) + have hTop := exactConstantExtensionCompatibleBaseFinitePlace_degree_eq + C S N hExact q hUpstairsRational + rw [heq] at hTop + exact hTop + +/-- Presentation-free local Frobenius-coset identity over a rational finite +place of the intermediate field `L`. -/ +theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under_intermediate_rational + (hDegreeDiv : Module.finrank L N ∣ Module.finrank C S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : FiniteDimensional (RatFunc C) + (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) + (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L + (ExactConstantExtension C N S) := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L (ExactConstantExtension C N S) := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C L N S hExact + ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), + finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L (ExactConstantExtension C N S) Q)) = 1 → + let P := finitePlaceUnder C L (ExactConstantExtension C N S) Q + let pi := exactConstantExtensionConstantQuotient C L N S hExact + letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + letI : Fintype (ExactConstantExtension C N S ≃ₐ[L] + ExactConstantExtension C N S) := Fintype.ofFinite _ + letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + letI : Fintype + (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ + letI := finiteIntegralClosureGalAction C L + (ExactConstantExtension C N S) + letI := finitePlaceUnderFiberGalAction C L + (ExactConstantExtension C N S) P + (∑ g : pi ⁻¹' + ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S)), + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) + g.1)) = + Nat.card (N ≃ₐ[L] N) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + intro Q hBase + obtain ⟨q, heq, hBaseQ⟩ := + exists_presentedFinitePlace_of_under_intermediate_rational + C S N hExact L Q hBase + rw [← heq] + exact exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum + C S N hExact L q hBaseQ hDegreeDiv + +/-- The Frobenius-fiber parametrization sends `g` to the ambient twist +`(Frob, g)` over the intermediate field. -/ +@[simp] +theorem intermediate_exactConstantExtensionFrobeniusFiberEquiv_apply_val + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + ((exactConstantExtensionFrobeniusFiberEquiv + C L N S hExact) g).1 = + exactConstantExtensionFrobeniusTwist C L N S hExact g := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + rfl + +/-- Fixed top finite places in the restriction fiber above one rational +finite place of `L`, for one intermediate-base Frobenius twist. -/ +abbrev IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + (g : N ≃ₐ[L] N) (P : FiniteExtensionRationalFinitePlace C L) : Type _ := + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + @MulAction.fixedBy (T ≃ₐ[L] T) (FinitePlaceUnderFiber C L T P.1) _ + (finitePlaceUnderFiberGalAction C L T P.1) + (exactConstantExtensionFrobeniusTwist C L N S hExact g) + +/-- Above one rational finite place of `L`, summing fixed top places over all +intermediate-base Frobenius twists contributes exactly `|Gal(N/L)|`. -/ +theorem sum_card_finitePlaceUnderFiber_fixedBy_intermediateFrobeniusTwist_eq_card_galois + (hDegreeDiv : Module.finrank L N ∣ Module.finrank C S) + (P : FiniteExtensionRationalFinitePlace C L) : + (∑ g : N ≃ₐ[L] N, + Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P)) = Nat.card (N ≃ₐ[L] N) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + letI : Fintype (T ≃ₐ[L] T) := Fintype.ofFinite _ + letI := finiteIntegralClosureGalAction C L T + letI := finitePlaceUnderFiberGalAction C L T P.1 + let pi := exactConstantExtensionConstantQuotient C L N S hExact + letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + letI : Fintype + (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ + obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective C L T P.1 + have hBase : finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L T Q)) = 1 := by + rw [hQ] + exact P.2 + have hlocal := + exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under_intermediate_rational + C S N hExact L hDegreeDiv Q hBase + rw [hQ] at hlocal + let e := exactConstantExtensionFrobeniusFiberEquiv C L N S hExact + calc + (∑ g : N ≃ₐ[L] N, + Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P)) = + ∑ g : N ≃ₐ[L] N, + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C L T P.1) (e g).1) := by + apply Finset.sum_congr rfl + intro g _ + rw [intermediate_exactConstantExtensionFrobeniusFiberEquiv_apply_val] + _ = ∑ x : pi ⁻¹' + ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S)), + Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C L T P.1) x.1) := + e.sum_comp (fun x ↦ Nat.card (MulAction.fixedBy + (FinitePlaceUnderFiber C L T P.1) x.1)) + _ = Nat.card (N ≃ₐ[L] N) := hlocal + +/-- Rational finite places of an intermediate-base twist field are exactly +the degree-`[S : C]` top finite places fixed by its ambient Frobenius twist. -/ +noncomputable def + intermediateFrobeniusTwistField_rationalFinitePlace_equiv_ambientFixedFinitePlace + (g : N ≃ₐ[L] N) + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + FiniteExtensionRationalFinitePlace C F ≃ + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank C S ∧ + finitePlaceGalSmul C L T + (exactConstantExtensionFrobeniusTwist C L N S hExact g) Q = Q} := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul L F := Algebra.toSMul + letI : Module L F := Algebra.toModule + letI : IsScalarTower (RatFunc C) L F := + IsScalarTower.of_algebraMap_eq' rfl + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + have hfinrank : Module.finrank F T = Module.finrank C S := + finrank_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g hdiv + have hdegree : ∀ Q : FiniteExtensionFinitePlace C T, + Module.finrank F T ∣ finiteExtensionPlaceDegree C T (.inl Q) := by + intro Q + rw [hfinrank] + exact exactConstantExtensionFinitePlace_finrank_constants_dvd_degree + C N S hExact Q + let sigmaF := intermediateFrobeniusTwistOverFixedField + C S N hExact L g + let sigmaL := exactConstantExtensionFrobeniusTwist C L N S hExact g + let eFixed := rationalFinitePlaceEquivGeneratorFixedPlace + C F T hdegree sigmaF + (intermediateFrobeniusTwistOverFixedField_zpowers_eq_top + C S N hExact L g) + (intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one + C S N hExact L g hdiv) + let eCompare : + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank F T ∧ + finitePlaceGalSmul C F T sigmaF Q = Q} ≃ + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank C S ∧ + finitePlaceGalSmul C L T sigmaL Q = Q} := + { toFun := fun Q ↦ ⟨Q.1, Q.2.1.trans hfinrank, + (finitePlaceGalSmul_eq_of_apply_eq C F L T sigmaF sigmaL + (fun x ↦ intermediateFrobeniusTwistOverFixedField_apply + C S N hExact L g x) Q.1).symm.trans Q.2.2⟩ + invFun := fun Q ↦ ⟨Q.1, Q.2.1.trans hfinrank.symm, + (finitePlaceGalSmul_eq_of_apply_eq C F L T sigmaF sigmaL + (fun x ↦ intermediateFrobeniusTwistOverFixedField_apply + C S N hExact L g x) Q.1).trans Q.2.2⟩ + left_inv := fun Q ↦ Subtype.ext rfl + right_inv := fun Q ↦ Subtype.ext rfl } + exact eFixed.trans eCompare + +/-- Restriction through an intermediate Frobenius-twist field agrees with +direct restriction to `L`. -/ +private theorem finitePlaceUnder_intermediateFrobeniusTwist_under + (g : N ≃ₐ[L] N) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul L F := Algebra.toSMul + letI : Module L F := Algebra.toModule + letI : IsScalarTower (RatFunc C) L F := + IsScalarTower.of_algebraMap_eq' rfl + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + ∀ Q : FiniteExtensionFinitePlace C T, + finitePlaceUnder C L F (finitePlaceUnder C F T Q) = + finitePlaceUnder C L T Q := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul L F := Algebra.toSMul + letI : Module L F := Algebra.toModule + letI : IsScalarTower (RatFunc C) L F := + IsScalarTower.of_algebraMap_eq' rfl + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl + let R₀ := RatFuncFiniteIntegralClosure C L + let R₁ := RatFuncFiniteIntegralClosure C F + let R₂ := RatFuncFiniteIntegralClosure C T + letI : Algebra R₀ R₁ := (finiteIntegralClosureMap C L F).toAlgebra + letI : Algebra R₁ R₂ := (finiteIntegralClosureMap C F T).toAlgebra + letI : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra + letI : SMul R₀ R₁ := Algebra.toSMul + letI : Module R₀ R₁ := Algebra.toModule + letI : SMul R₁ R₂ := Algebra.toSMul + letI : Module R₁ R₂ := Algebra.toModule + letI : SMul R₀ R₂ := Algebra.toSMul + letI : Module R₀ R₂ := Algebra.toModule + letI : IsScalarTower R₀ R₁ R₂ := by + apply IsScalarTower.of_algebraMap_eq' + ext x + change algebraMap L T (x : L) = + algebraMap F T (algebraMap L F (x : L)) + exact IsScalarTower.algebraMap_apply L F T _ + dsimp only + intro Q + apply IsDedekindDomain.HeightOneSpectrum.ext + exact Ideal.under_under Q.asIdeal + +/-- Rational finite places of one intermediate-base twist field are the +disjoint union, over rational finite places of `L`, of fixed top places in +the corresponding restriction fiber. -/ +noncomputable def + intermediateFrobeniusTwistField_rationalFinitePlace_equiv_sigma_fiberFixedBy + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) + (g : N ≃ₐ[L] N) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul L F := Algebra.toSMul + letI : Module L F := Algebra.toModule + letI : IsScalarTower (RatFunc C) L F := + IsScalarTower.of_algebraMap_eq' rfl + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + FiniteExtensionRationalFinitePlace C F ≃ + Σ P : FiniteExtensionRationalFinitePlace C L, + IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul L F := Algebra.toSMul + letI : Module L F := Algebra.toModule + letI : IsScalarTower (RatFunc C) L F := + IsScalarTower.of_algebraMap_eq' rfl + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + have hDegreeDiv : Module.finrank L N ∣ Module.finrank C S := by + rw [← IsGalois.card_aut_eq_finrank] + exact hdiv + have hfinrank : Module.finrank F T = Module.finrank C S := + finrank_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g hdiv + let sigmaF := intermediateFrobeniusTwistOverFixedField + C S N hExact L g + let sigmaL := exactConstantExtensionFrobeniusTwist C L N S hExact g + let AmbientFixed := + {Q : FiniteExtensionFinitePlace C T // + finiteExtensionPlaceDegree C T (.inl Q) = Module.finrank C S ∧ + finitePlaceGalSmul C L T sigmaL Q = Q} + let SigmaFixed := Σ P : FiniteExtensionRationalFinitePlace C L, + IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P + let toAmbient : SigmaFixed → AmbientFixed := fun x ↦ by + let Q := x.2.1.1 + have hBase : finiteExtensionPlaceDegree C L + (.inl (finitePlaceUnder C L T Q)) = 1 := by + rw [x.2.1.2] + exact x.1.2 + refine ⟨Q, + exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_intermediate_rational + C S N hExact L hDegreeDiv Q hBase, ?_⟩ + exact congrArg Subtype.val x.2.2 + have hInjective : Function.Injective toAmbient := by + rintro ⟨P, x⟩ ⟨R, y⟩ hxy + have hQ : x.1.1 = y.1.1 := congrArg Subtype.val hxy + have hBase : P.1 = R.1 := by + calc + P.1 = finitePlaceUnder C L T x.1.1 := x.1.2.symm + _ = finitePlaceUnder C L T y.1.1 := congrArg _ hQ + _ = R.1 := y.1.2 + have hP : P = R := Subtype.ext hBase + subst R + apply Sigma.ext (by rfl) + apply heq_of_eq + apply Subtype.ext + apply Subtype.ext + exact hQ + have hSurjective : Function.Surjective toAmbient := by + intro z + let Q := z.1 + have hfixedF : finitePlaceGalSmul C F T sigmaF Q = Q := + (finitePlaceGalSmul_eq_of_apply_eq C F L T sigmaF sigmaL + (fun x ↦ intermediateFrobeniusTwistOverFixedField_apply + C S N hExact L g x) Q).trans z.2.2 + have hFdegree : finiteExtensionPlaceDegree C F + (.inl (finitePlaceUnder C F T Q)) = 1 := + finitePlaceUnder_degree_eq_one_of_generator_fixed C F T sigmaF + (intermediateFrobeniusTwistOverFixedField_zpowers_eq_top + C S N hExact L g) Q hfixedF + (intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one + C S N hExact L g hdiv Q) + (z.2.1.trans hfinrank.symm) + let R₀ : FiniteExtensionRationalFinitePlace C F := + ⟨finitePlaceUnder C F T Q, hFdegree⟩ + let P : FiniteExtensionRationalFinitePlace C L := + rationalFinitePlaceUnder C L F R₀ + have hFiber : finitePlaceUnder C L T Q = P.1 := by + calc + finitePlaceUnder C L T Q = + finitePlaceUnder C L F (finitePlaceUnder C F T Q) := + (finitePlaceUnder_intermediateFrobeniusTwist_under + C S N hExact L g Q).symm + _ = P.1 := rfl + let xFiber : FinitePlaceUnderFiber C L T P.1 := ⟨Q, hFiber⟩ + let xFixed : IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P := ⟨xFiber, by + apply Subtype.ext + exact z.2.2⟩ + refine ⟨⟨P, xFixed⟩, ?_⟩ + apply Subtype.ext + change Q = z.1 + rfl + let eSigma : SigmaFixed ≃ AmbientFixed := + Equiv.ofBijective toAmbient ⟨hInjective, hSurjective⟩ + exact + (intermediateFrobeniusTwistField_rationalFinitePlace_equiv_ambientFixedFinitePlace + C S N hExact L g hdiv).trans eSigma.symm + +/-- The rational finite-place count of one intermediate-base Frobenius-twist +field, with its rational-function algebra fixed explicitly. -/ +noncomputable def intermediateFrobeniusTwistFieldRationalFinitePlaceCount + (g : N ≃ₐ[L] N) : ℕ := + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + Nat.card (FiniteExtensionRationalFinitePlace C F) + +/-- For one twist, rational finite places split as the finite sum of fixed +restriction fibers above the rational finite places of `L`. -/ +theorem intermediateFrobeniusTwistFieldRationalFinitePlaceCount_eq_sum_fiberFixedBy + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) + (g : N ≃ₐ[L] N) : + intermediateFrobeniusTwistFieldRationalFinitePlaceCount + C S N hExact L g = + ∑ P : FiniteExtensionRationalFinitePlace C L, + Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : FiniteDimensional (RatFunc C) T := + finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc C) T := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + letI : FiniteDimensional L T := + finiteDimensional_exactConstantExtension_over_intermediateBase + C S N L hExact + letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra F T := F.toAlgebra + letI : SMul F T := Algebra.toSMul + letI : Module F T := Algebra.toModule + letI : IsScalarTower (RatFunc C) F T := + intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + letI : FiniteDimensional F T := + finiteDimensional_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + letI : IsGalois F T := + isGalois_exactConstantExtension_over_frobeniusTwistField + C L N S hExact g + change Nat.card (FiniteExtensionRationalFinitePlace C F) = _ + rw [Nat.card_congr + (intermediateFrobeniusTwistField_rationalFinitePlace_equiv_sigma_fiberFixedBy + C S N hExact L hdiv g), Nat.card_sigma] + +/-- Summed over all intermediate-base Frobenius twists, the rational finite +place count is exactly `|Gal(N/L)|` times the rational finite-place count of +`L`. -/ +theorem sum_intermediateFrobeniusTwistFieldRationalFinitePlaceCount_eq_card_galois_mul_card + (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalFinitePlaceCount + C S N hExact L g) = + Nat.card (N ≃ₐ[L] N) * + Nat.card (FiniteExtensionRationalFinitePlace C L) := by + have hDegreeDiv : Module.finrank L N ∣ Module.finrank C S := by + rw [← IsGalois.card_aut_eq_finrank] + exact hdiv + calc + (∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalFinitePlaceCount + C S N hExact L g) = + ∑ g : N ≃ₐ[L] N, + ∑ P : FiniteExtensionRationalFinitePlace C L, + Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P) := by + apply Finset.sum_congr rfl + intro g _ + exact + intermediateFrobeniusTwistFieldRationalFinitePlaceCount_eq_sum_fiberFixedBy + C S N hExact L hdiv g + _ = ∑ P : FiniteExtensionRationalFinitePlace C L, + ∑ g : N ≃ₐ[L] N, + Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy + C S N hExact L g P) := by + rw [Finset.sum_comm] + _ = ∑ _P : FiniteExtensionRationalFinitePlace C L, + Nat.card (N ≃ₐ[L] N) := by + apply Finset.sum_congr rfl + intro P _ + exact + sum_card_finitePlaceUnderFiber_fixedBy_intermediateFrobeniusTwist_eq_card_galois + C S N hExact L hDegreeDiv P + _ = Nat.card (FiniteExtensionRationalFinitePlace C L) * + Nat.card (N ≃ₐ[L] N) := by + simp [Nat.card_eq_fintype_card] + _ = Nat.card (N ≃ₐ[L] N) * + Nat.card (FiniteExtensionRationalFinitePlace C L) := Nat.mul_comm _ _ + +/-- Viewing an intermediate-base Frobenius twist over `C(X)` does not change +its underlying automorphism of the exact constant extension. -/ +theorem exactConstantExtensionFrobeniusTwist_restrictScalars_apply + (g : N ≃ₐ[L] N) (x : ExactConstantExtension C N S) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact + (g.restrictScalars (RatFunc C)) x = + exactConstantExtensionFrobeniusTwist C L N S hExact g x := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + induction x using TensorProduct.induction_on with + | zero => simp + | tmul s n => + simp [exactConstantExtensionFrobeniusTwist, + exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase] + | add x y hx hy => simp [hx, hy] + +/-- Equality of the two twists as `C(X)`-automorphisms. -/ +theorem exactConstantExtensionFrobeniusTwist_restrictScalars + (g : N ≃ₐ[L] N) : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + (exactConstantExtensionFrobeniusTwist C L N S hExact g).restrictScalars + (RatFunc C) = + exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact + (g.restrictScalars (RatFunc C)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + ext x + exact (exactConstantExtensionFrobeniusTwist_restrictScalars_apply + C S N hExact L g x).symm + +/-- The fixed field constructed over `L` is the same function field as the +rational-base twist attached to `g.restrictScalars C(X)`. -/ +noncomputable def + intermediateFrobeniusTwistField_algEquiv_rationalBaseFrobeniusTwistField + (g : N ≃ₐ[L] N) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + let Fₗ := exactConstantExtensionFrobeniusTwistField C L N S hExact g + let Fᵣ := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) + letI : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra + letI : Algebra (RatFunc C) Fₗ := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : Algebra (RatFunc C) Fᵣ := + SubalgebraClass.toAlgebra Fᵣ.toSubalgebra + Fₗ ≃ₐ[RatFunc C] Fᵣ := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + exactConstantExtensionIntermediate_ratFuncBaseTower C S N L + let sigmaₗ := exactConstantExtensionFrobeniusTwist C L N S hExact g + let sigmaᵣ := exactConstantExtensionFrobeniusTwist + C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) + let Fₗ := exactConstantExtensionFrobeniusTwistField C L N S hExact g + let Fᵣ := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) + letI : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra + letI : Algebra (RatFunc C) Fₗ := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : Algebra (RatFunc C) Fᵣ := + SubalgebraClass.toAlgebra Fᵣ.toSubalgebra + have hsigma : sigmaₗ.restrictScalars (RatFunc C) = sigmaᵣ := + exactConstantExtensionFrobeniusTwist_restrictScalars + C S N hExact L g + have hto (x : Fₗ) : (x.1 : T) ∈ Fᵣ := by + change x.1 ∈ IntermediateField.fixedField (Subgroup.zpowers sigmaᵣ) + rw [IntermediateField.mem_fixedField_iff] + intro tau htau + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp htau + have hxmem : x.1 ∈ + IntermediateField.fixedField (Subgroup.zpowers sigmaₗ) := x.2 + rw [IntermediateField.mem_fixedField_iff] at hxmem + have hx := hxmem (sigmaₗ ^ k) + (Subgroup.mem_zpowers_iff.mpr ⟨k, rfl⟩) + calc + tau x.1 = (sigmaᵣ ^ k) x.1 := congrArg (fun a ↦ a x.1) hk.symm + _ = ((sigmaₗ.restrictScalars (RatFunc C)) ^ k) x.1 := by rw [hsigma] + _ = ((sigmaₗ ^ k).restrictScalars (RatFunc C)) x.1 := by + exact congrArg (fun a ↦ a x.1) + (map_zpow (AlgEquiv.restrictScalarsHom (RatFunc C)) sigmaₗ k).symm + _ = (sigmaₗ ^ k) x.1 := rfl + _ = x.1 := hx + have hfrom (x : Fᵣ) : (x.1 : T) ∈ Fₗ := by + change x.1 ∈ IntermediateField.fixedField (Subgroup.zpowers sigmaₗ) + rw [IntermediateField.mem_fixedField_iff] + intro tau htau + obtain ⟨k, hk⟩ := Subgroup.mem_zpowers_iff.mp htau + have hxmem : x.1 ∈ + IntermediateField.fixedField (Subgroup.zpowers sigmaᵣ) := x.2 + rw [IntermediateField.mem_fixedField_iff] at hxmem + have hx := hxmem (sigmaᵣ ^ k) + (Subgroup.mem_zpowers_iff.mpr ⟨k, rfl⟩) + calc + tau x.1 = (sigmaₗ ^ k) x.1 := congrArg (fun a ↦ a x.1) hk.symm + _ = ((sigmaₗ ^ k).restrictScalars (RatFunc C)) x.1 := rfl + _ = ((sigmaₗ.restrictScalars (RatFunc C)) ^ k) x.1 := by + exact congrArg (fun a ↦ a x.1) + (map_zpow (AlgEquiv.restrictScalarsHom (RatFunc C)) sigmaₗ k) + _ = (sigmaᵣ ^ k) x.1 := by rw [hsigma] + _ = x.1 := hx + exact + { toFun := fun x ↦ ⟨x.1, hto x⟩ + invFun := fun x ↦ ⟨x.1, hfrom x⟩ + left_inv := fun x ↦ Subtype.ext rfl + right_inv := fun x ↦ Subtype.ext rfl + map_mul' := fun _ _ ↦ Subtype.ext rfl + map_add' := fun _ _ ↦ Subtype.ext rfl + commutes' := fun r ↦ by + apply Subtype.ext + change algebraMap L T (algebraMap (RatFunc C) L r) = + algebraMap (RatFunc C) T r + exact (IsScalarTower.algebraMap_apply (RatFunc C) L T r).symm } + +end IntermediateBase + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean new file mode 100644 index 0000000000..272ac52a6c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean @@ -0,0 +1,330 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree + +/-! +# A fixed-tower Hasse bound from intermediate Frobenius twists + +The complete intermediate-base twist average is combined with the uniform +square-field Stepanov estimate for the corresponding rational-base twists. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped BigOperators + + +variable (K C S N : Type*) + [Field K] [Fintype K] + [Field C] [Fintype C] [DecidableEq C] [Algebra K C] + [Field S] [Finite S] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance intermediateHasseBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance intermediateHasseBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + +section IntermediateBase + +variable (L : Type*) [Field L] + [Algebra (RatFunc C) L] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [Algebra L N] [IsScalarTower (RatFunc C) L N] + [FiniteDimensional L N] [IsGalois L N] + +local instance intermediateHasseConstantAlgebra : Algebra C L := + RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp + (algebraMap C (RatFunc C))) + +local instance intermediateHasseConstantTower : IsScalarTower C L N := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap L N (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) + exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ + +private theorem intermediateHasseRatFuncBaseTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + let T := ExactConstantExtension C N S + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + apply IsScalarTower.of_algebraMap_eq' + ext x + change (1 : S) ⊗ₜ algebraMap (RatFunc C) N x = + (1 : S) ⊗ₜ algebraMap L N (algebraMap (RatFunc C) L x) + congr 1 + exact IsScalarTower.algebraMap_apply (RatFunc C) L N x + +/-- The complete point count of an intermediate-base twist agrees with that +of its rational-base incarnation. -/ +theorem intermediateFrobeniusTwistFieldRationalPlaceCount_eq_rationalBase + (g : N ≃ₐ[L] N) : + intermediateFrobeniusTwistFieldRationalPlaceCount C S N hExact L g = + frobeniusTwistFieldRationalPlaceCount C S N hExact + (g.restrictScalars (RatFunc C)) := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + intermediateHasseRatFuncBaseTower C S N L + let Fₗ := exactConstantExtensionFrobeniusTwistField C L N S hExact g + let Fᵣ := exactConstantExtensionFrobeniusTwistField + C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) + letI : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra + letI : SMul L Fₗ := Algebra.toSMul + letI : Module L Fₗ := Algebra.toModule + letI : Algebra (RatFunc C) Fₗ := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) Fₗ := Algebra.toSMul + letI : Module (RatFunc C) Fₗ := Algebra.toModule + letI : FiniteDimensional (RatFunc C) Fₗ := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) Fₗ := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra (RatFunc C) Fᵣ := SubalgebraClass.toAlgebra Fᵣ.toSubalgebra + letI : SMul (RatFunc C) Fᵣ := Algebra.toSMul + letI : Module (RatFunc C) Fᵣ := Algebra.toModule + let e := + intermediateFrobeniusTwistField_algEquiv_rationalBaseFrobeniusTwistField + C S N hExact L g + letI : FiniteDimensional (RatFunc C) Fᵣ := + Module.Finite.equiv (e.toLinearEquiv : Fₗ ≃ₗ[RatFunc C] Fᵣ) + letI : Algebra.IsSeparable (RatFunc C) Fᵣ := + isSeparable_frobeniusTwistField_over_ratFunc + C N S hExact (g.restrictScalars (RatFunc C)) + calc + intermediateFrobeniusTwistFieldRationalPlaceCount C S N hExact L g = + finiteExtensionRationalPlaceCount C Fₗ := + intermediateFrobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCount + C S N hExact L g + _ = finiteExtensionRationalPlaceCount C Fᵣ := + finiteExtensionRationalPlaceCount_eq_of_algEquiv C Fₗ Fᵣ e + _ = frobeniusTwistFieldRationalPlaceCount C S N hExact + (g.restrictScalars (RatFunc C)) := + (frobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCount + C S N hExact (g.restrictScalars (RatFunc C))).symm + +/-- The complete twist average and the pointwise Stepanov estimate give a +two-sided rational-place bound for the fixed intermediate field. -/ +theorem abs_intermediateBaseRationalPlaceError_le_squareField_of_genus_exact + (hcard : Fintype.card C = (Fintype.card K) ^ 2) + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (hdivL : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) + (hdivBase : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (hlarge : (FunctionField.genus C N + 1) * + (FunctionField.genus C N + 2) ≤ Fintype.card K) : + |(finiteExtensionRationalPlaceCount C L : ℝ) - + (Nat.card C : ℝ) - 1| ≤ + 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 2 + + (Nat.card (N ≃ₐ[L] N) : ℝ) * + ((Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + Module.finrank (RatFunc C) N + + (Nat.card (N ≃ₐ[RatFunc C] N) - 1 : ℕ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ)) := by + letI : DecidableEq (N ≃ₐ[L] N) := Classical.decEq _ + let A : ℝ := 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 2 + let B : ℝ := + (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * + Module.finrank (RatFunc C) N + + (Nat.card (N ≃ₐ[RatFunc C] N) - 1 : ℕ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) + have haverage : + |∑ g : N ≃ₐ[L] N, + (intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g : ℝ) - + (Fintype.card (N ≃ₐ[L] N) : ℝ) * + finiteExtensionRationalPlaceCount C L| ≤ A := by + simpa only [A, Nat.card_eq_fintype_card] using + abs_sum_intermediateFrobeniusTwistFieldRationalPlaceCount_sub_card_mul_base_le + C S N hExact L hdivL + have hpointwise : ∀ g : N ≃ₐ[L] N, + |(intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g : ℝ) - ((Nat.card C : ℝ) + 1)| ≤ B := by + intro g + rw [intermediateFrobeniusTwistFieldRationalPlaceCount_eq_rationalBase + C S N hExact L g] + have h := + abs_frobeniusTwistFieldRationalPlaceError_le_squareField_of_genus + K C N S hcard hExact hdivBase hlarge + (g.restrictScalars (RatFunc C)) + dsimp only [B] + have hcenter : + (frobeniusTwistFieldRationalPlaceCount C S N hExact + (g.restrictScalars (RatFunc C)) : ℝ) - + ((Nat.card C : ℝ) + 1) = + (frobeniusTwistFieldRationalPlaceCount C S N hExact + (g.restrictScalars (RatFunc C)) : ℝ) - + (Nat.card C : ℝ) - 1 := by + ring + rw [hcenter] + exact h + have hbound := abs_base_sub_center_le_of_average_and_pointwise + (x := fun g : N ≃ₐ[L] N ↦ + (intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g : ℝ)) + (base := (finiteExtensionRationalPlaceCount C L : ℝ)) + (center := (Nat.card C : ℝ) + 1) (A := A) (B := B) + (by dsimp only [A]; positivity) (by dsimp only [B]; positivity) + haverage hpointwise + dsimp only [A, B] at hbound ⊢ + have hcardGal : Nat.card (N ≃ₐ[L] N) = + Fintype.card (N ≃ₐ[L] N) := Nat.card_eq_fintype_card + rw [← hcardGal] at hbound + have hcenter : + (finiteExtensionRationalPlaceCount C L : ℝ) - + ((Nat.card C : ℝ) + 1) = + (finiteExtensionRationalPlaceCount C L : ℝ) - + (Nat.card C : ℝ) - 1 := by + ring + rw [hcenter] at hbound + exact hbound + +/-- A degree-only version of the fixed-tower estimate. Both Galois-group +orders in the exact bound are at most the degree of the top field over +`C(X)`; this deliberately looser polynomial bound is the form used by the +normal-closure argument. -/ +theorem abs_intermediateBaseRationalPlaceError_le_squareField_of_genus + (hcard : Fintype.card C = (Fintype.card K) ^ 2) + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (hdivL : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) + (hdivBase : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) + (hlarge : (FunctionField.genus C N + 1) * + (FunctionField.genus C N + 2) ≤ Fintype.card K) : + |(finiteExtensionRationalPlaceCount C L : ℝ) - + (Nat.card C : ℝ) - 1| ≤ + 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 2 + + 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 3 + + (Module.finrank (RatFunc C) N : ℝ) ^ 2 * + (((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) := by + have hbound := + abs_intermediateBaseRationalPlaceError_le_squareField_of_genus_exact + K C S N L hcard hExact hdivL hdivBase hlarge + have hL : + (Nat.card (N ≃ₐ[L] N) : ℝ) ≤ + (Module.finrank (RatFunc C) N : ℝ) := by + exact_mod_cast natCard_aut_le_finrank_of_tower (RatFunc C) L N + have hD : + (1 : ℝ) ≤ (Module.finrank (RatFunc C) N : ℝ) := by + exact_mod_cast Module.finrank_pos (R := RatFunc C) (M := N) + rw [IsGalois.card_aut_eq_finrank (RatFunc C) N] at hbound + have hsub : + ((Module.finrank (RatFunc C) N - 1 : ℕ) : ℝ) ≤ + (Module.finrank (RatFunc C) N : ℝ) := by + exact_mod_cast Nat.sub_le (Module.finrank (RatFunc C) N) 1 + have hsum : + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) = + (((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) + + (Module.finrank (RatFunc C) N : ℝ) := by + norm_num + have hinnerNonneg : + 0 ≤ + (Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + ((Module.finrank (RatFunc C) N - 1 : ℕ) : ℝ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) := by + positivity + have hsumNonneg : + 0 ≤ + (((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) + + (Module.finrank (RatFunc C) N : ℝ) := + add_nonneg (Nat.cast_nonneg _) (Nat.cast_nonneg _) + have hinner : + (Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + ((Module.finrank (RatFunc C) N - 1 : ℕ) : ℝ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ) ≤ + (Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + (Module.finrank (RatFunc C) N : ℝ) * + ((((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) + + Module.finrank (RatFunc C) N) := by + rw [hsum] + exact add_le_add_right + (mul_le_mul_of_nonneg_right hsub hsumNonneg) _ + have houter : + (Nat.card (N ≃ₐ[L] N) : ℝ) * + ((Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + ((Module.finrank (RatFunc C) N - 1 : ℕ) : ℝ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ)) ≤ + 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 3 + + (Module.finrank (RatFunc C) N : ℝ) ^ 2 * + (((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) := by + calc + (Nat.card (N ≃ₐ[L] N) : ℝ) * + ((Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + ((Module.finrank (RatFunc C) N - 1 : ℕ) : ℝ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ)) ≤ + (Module.finrank (RatFunc C) N : ℝ) * + ((Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + ((Module.finrank (RatFunc C) N - 1 : ℕ) : ℝ) * + (((2 * FunctionField.genus C N + 1) * Fintype.card K + + Module.finrank (RatFunc C) N : ℕ) : ℝ)) := + mul_le_mul_of_nonneg_right hL hinnerNonneg + _ ≤ (Module.finrank (RatFunc C) N : ℝ) * + ((Module.finrank (RatFunc C) N : ℝ) * + Module.finrank (RatFunc C) N + + (Module.finrank (RatFunc C) N : ℝ) * + ((((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) + + Module.finrank (RatFunc C) N)) := + mul_le_mul_of_nonneg_left hinner (by positivity) + _ = 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 3 + + (Module.finrank (RatFunc C) N : ℝ) ^ 2 * + (((2 * FunctionField.genus C N + 1) * Fintype.card K : ℕ) : ℝ) := by + ring + nlinarith + +end IntermediateBase + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean new file mode 100644 index 0000000000..fc438ef90a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean @@ -0,0 +1,326 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage + +/-! +# Complete rational-place averaging over an intermediate base + +The finite-place average over `Gal(N/L)` is exact. Complete rational-place +counts differ from it only at infinity, and both the twists and `L` have at +most the original degree `[N : C(X)]` rational infinity places. This gives a +uniform aggregate error independent of the auxiliary constant extension. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped BigOperators + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [IsGalois (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance intermediateRationalAverageBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance intermediateRationalAverageBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + +section IntermediateBase + +variable (L : Type*) [Field L] + [Algebra (RatFunc C) L] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [Algebra L N] [IsScalarTower (RatFunc C) L N] + [FiniteDimensional L N] [IsGalois L N] + +local instance intermediateRationalAverageConstantAlgebra : Algebra C L := + RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp + (algebraMap C (RatFunc C))) + +local instance intermediateRationalAverageConstantTower : IsScalarTower C L N := by + apply IsScalarTower.of_algebraMap_eq' + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap L N (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) + exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ + +/-- Compatibility of the rational-function and intermediate-base algebra maps +on the exact constant extension. -/ +private theorem intermediateRationalAverageRatFuncBaseTower : + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + letI : Algebra L (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C L N S + letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + let T := ExactConstantExtension C N S + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : Algebra N T := exactConstantExtensionAlgebra C N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + apply IsScalarTower.of_algebraMap_eq' + ext x + change (1 : S) ⊗ₜ algebraMap (RatFunc C) N x = + (1 : S) ⊗ₜ algebraMap L N (algebraMap (RatFunc C) L x) + congr 1 + exact IsScalarTower.algebraMap_apply (RatFunc C) L N x + +/-- The rational infinity-place count of one intermediate-base twist. -/ +noncomputable def intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + (g : N ≃ₐ[L] N) : ℕ := + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + Nat.card (FiniteExtensionRationalInfinityPlace C F) + +/-- The complete rational-place count of one intermediate-base twist, split +into finite and infinity parts. -/ +noncomputable def intermediateFrobeniusTwistFieldRationalPlaceCount + (g : N ≃ₐ[L] N) : ℕ := + intermediateFrobeniusTwistFieldRationalFinitePlaceCount + C S N hExact L g + + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact L g + +/-- The split definition is the actual complete rational-place count. -/ +theorem intermediateFrobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCount + (g : N ≃ₐ[L] N) : + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + intermediateFrobeniusTwistFieldRationalPlaceCount C S N hExact L g = + finiteExtensionRationalPlaceCount C F := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + letI : Algebra (RatFunc C) F := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) F := Algebra.toSMul + letI : Module (RatFunc C) F := Algebra.toModule + letI : FiniteDimensional (RatFunc C) F := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) F := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Finite (FiniteExtensionRationalFinitePlace C F) := inferInstance + letI : Finite (FiniteExtensionRationalInfinityPlace C F) := inferInstance + unfold intermediateFrobeniusTwistFieldRationalPlaceCount + rw [intermediateFrobeniusTwistFieldRationalFinitePlaceCount, + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount] + change Nat.card (FiniteExtensionRationalFinitePlace C F) + + Nat.card (FiniteExtensionRationalInfinityPlace C F) = + Nat.card (FiniteExtensionRationalFinitePlace C F ⊕ + FiniteExtensionRationalInfinityPlace C F) + exact Nat.card_sum.symm + +/-- Each intermediate twist has at most `[N : C(X)]` rational infinity +places, provided its intermediate Galois order divides the constant degree. -/ +theorem intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le_original_finrank + (hdivL : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) + (g : N ≃ₐ[L] N) : + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact L g ≤ Module.finrank (RatFunc C) N := by + let T := ExactConstantExtension C N S + letI : Field T := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) T := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) T := Algebra.toSMul + letI : Module (RatFunc C) T := Algebra.toModule + letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + letI : SMul L T := Algebra.toSMul + letI : Module L T := Algebra.toModule + letI : IsScalarTower (RatFunc C) L T := + intermediateRationalAverageRatFuncBaseTower C S N L + let Fₗ := exactConstantExtensionFrobeniusTwistField C L N S hExact g + letI : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra + letI : SMul L Fₗ := Algebra.toSMul + letI : Module L Fₗ := Algebra.toModule + letI : Algebra (RatFunc C) Fₗ := + intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g + letI : SMul (RatFunc C) Fₗ := Algebra.toSMul + letI : Module (RatFunc C) Fₗ := Algebra.toModule + letI : FiniteDimensional (RatFunc C) Fₗ := + finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : Algebra.IsSeparable (RatFunc C) Fₗ := + isSeparable_intermediateFrobeniusTwistField_over_ratFunc + C S N hExact L g + letI : IsScalarTower (RatFunc C) L Fₗ := + IsScalarTower.of_algebraMap_eq' rfl + letI : Module.Finite L Fₗ := + Module.Finite.of_restrictScalars_finite (RatFunc C) L Fₗ + change Nat.card (FiniteExtensionRationalInfinityPlace C Fₗ) ≤ _ + calc + Nat.card (FiniteExtensionRationalInfinityPlace C Fₗ) ≤ + Module.finrank (RatFunc C) Fₗ := + rationalInfinityPlace_card_le_finrank C Fₗ + _ = Module.finrank (RatFunc C) L * Module.finrank L Fₗ := + (Module.finrank_mul_finrank (RatFunc C) L Fₗ).symm + _ = Module.finrank (RatFunc C) L * Module.finrank L N := by + rw [finrank_frobeniusTwistField_over_base C L N S hExact g hdivL] + _ = Module.finrank (RatFunc C) N := + Module.finrank_mul_finrank (RatFunc C) L N + +/-- Rational infinity places of the intermediate field itself are bounded by +the original degree. -/ +theorem intermediateBaseRationalInfinityPlaceCount_le_original_finrank : + Nat.card (FiniteExtensionRationalInfinityPlace C L) ≤ + Module.finrank (RatFunc C) N := by + calc + Nat.card (FiniteExtensionRationalInfinityPlace C L) ≤ + Module.finrank (RatFunc C) L := rationalInfinityPlace_card_le_finrank C L + _ ≤ Module.finrank (RatFunc C) N := by + apply Nat.le_of_dvd Module.finrank_pos + rw [← Module.finrank_mul_finrank (RatFunc C) L N] + exact dvd_mul_right _ _ + +/-- The total infinity contribution of the twists is bounded by the group +order times the original degree. -/ +theorem sum_intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le + (hdivL : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact L g) ≤ + Nat.card (N ≃ₐ[L] N) * Module.finrank (RatFunc C) N := by + calc + (∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact L g) ≤ + ∑ _g : N ≃ₐ[L] N, Module.finrank (RatFunc C) N := by + exact Finset.sum_le_sum fun g _ ↦ + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le_original_finrank + C S N hExact L hdivL g + _ = Nat.card (N ≃ₐ[L] N) * Module.finrank (RatFunc C) N := by + simp [Nat.card_eq_fintype_card] + +/-- Exact finite-plus-infinity aggregate identity over `Gal(N/L)`. -/ +theorem sum_intermediateFrobeniusTwistFieldRationalPlaceCount_eq + (hdivL : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + (∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g) = + Nat.card (N ≃ₐ[L] N) * + Nat.card (FiniteExtensionRationalFinitePlace C L) + + ∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact L g := by + simp_rw [intermediateFrobeniusTwistFieldRationalPlaceCount] + rw [Finset.sum_add_distrib, + sum_intermediateFrobeniusTwistFieldRationalFinitePlaceCount_eq_card_galois_mul_card + C S N hExact L hdivL] + +/-- The complete rational-place aggregate is uniformly close to the group +order times the complete rational-place count of `L`. -/ +theorem abs_sum_intermediateFrobeniusTwistFieldRationalPlaceCount_sub_card_mul_base_le + (hdivL : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : + |∑ g : N ≃ₐ[L] N, + (intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g : ℝ) - + (Nat.card (N ≃ₐ[L] N) : ℝ) * + finiteExtensionRationalPlaceCount C L| ≤ + 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 2 := by + let G : ℕ := Nat.card (N ≃ₐ[L] N) + let D : ℕ := Module.finrank (RatFunc C) N + let Iₗ : ℕ := ∑ g : N ≃ₐ[L] N, + intermediateFrobeniusTwistFieldRationalInfinityPlaceCount + C S N hExact L g + let Iₒ : ℕ := Nat.card (FiniteExtensionRationalInfinityPlace C L) + have htotal := sum_intermediateFrobeniusTwistFieldRationalPlaceCount_eq + C S N hExact L hdivL + have hbase : finiteExtensionRationalPlaceCount C L = + Nat.card (FiniteExtensionRationalFinitePlace C L) + Iₒ := by + unfold finiteExtensionRationalPlaceCount + rw [Nat.card_sum] + have herr : + (∑ g : N ≃ₐ[L] N, + (intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g : ℝ)) - + (G : ℝ) * finiteExtensionRationalPlaceCount C L = + (Iₗ : ℝ) - (G : ℝ) * Iₒ := by + have htotalReal : + (∑ g : N ≃ₐ[L] N, + (intermediateFrobeniusTwistFieldRationalPlaceCount + C S N hExact L g : ℝ)) = + (G : ℝ) * Nat.card (FiniteExtensionRationalFinitePlace C L) + + (Iₗ : ℝ) := by + exact_mod_cast htotal + rw [htotalReal, hbase] + push_cast + ring + have hIₗ : Iₗ ≤ G * D := by + exact sum_intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le + C S N hExact L hdivL + have hIₒ : Iₒ ≤ D := + intermediateBaseRationalInfinityPlaceCount_le_original_finrank C N L + have hG : G ≤ D := by + dsimp only [G, D] + rw [IsGalois.card_aut_eq_finrank] + apply Nat.le_of_dvd Module.finrank_pos + rw [← Module.finrank_mul_finrank (RatFunc C) L N] + exact dvd_mul_left _ _ + rw [herr] + have hIₗ' : (Iₗ : ℝ) ≤ (G : ℝ) * D := by exact_mod_cast hIₗ + have hIₒ' : (Iₒ : ℝ) ≤ D := by exact_mod_cast hIₒ + have hG' : (G : ℝ) ≤ D := by exact_mod_cast hG + have hD : (0 : ℝ) ≤ D := by positivity + have hGnonneg : (0 : ℝ) ≤ G := by positivity + have hIₗnonneg : (0 : ℝ) ≤ Iₗ := by positivity + have hIₒnonneg : (0 : ℝ) ≤ Iₒ := by positivity + apply abs_le.mpr + constructor <;> nlinarith + +end IntermediateBase + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean new file mode 100644 index 0000000000..f79ad362d7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -0,0 +1,1000 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum + +/-! +# The exact constant-extension tower of a function-field normal closure + +Let `F / K(X)` have exact constant field `K`, let `N` be the chosen normal +closure, let `C` be the full algebraic constant field of `N`, and let +`M = CF ⊆ N` be the original compositum. For a finite Galois extension +`S / C`, this file specializes the generic exact-constant-extension tower to + +`S ⊗[C] M ⊆ S ⊗[C] N`. + +It packages the canonical `S(X)`-linear inclusion, the finite Galois +structure of the top over the bottom, and preservation of both the relative +degree and the two rational-function-field degrees. This is a structural +consumer of the exact constant-extension API; it deliberately does not use +the genus-invariance layer. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +variable (K F : Type*) [Field K] [Field F] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra K F] [Algebra (RatFunc K) F] + [IsScalarTower K (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +/-- The `C(X)`-algebra on the constant-base field `C K(X)`, transported +through its canonical rational-function presentation. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureConstantBaseConstantRatFuncAlgebra : + Algebra (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureConstantBase K F) := + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F).toAlgHom.toAlgebra + +/-- The canonical rational-function presentation of the constant-base field, +viewed as an equivalence over `C(X)` itself. -/ +noncomputable def + functionFieldNormalClosureConstantBaseRatFuncSelfAlgEquiv : + RatFunc (FunctionFieldNormalClosureConstantField K F) ≃ₐ[ + RatFunc (FunctionFieldNormalClosureConstantField K F)] + FunctionFieldNormalClosureConstantBase K F := + { functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F with + commutes' := fun _ => rfl } + +/-- The constant-base field is one-dimensional, hence finite, over its +canonical `C(X)` presentation. -/ +noncomputable instance + functionFieldNormalClosureConstantBase_finiteDimensional_over_constantRatFunc : + FiniteDimensional + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureConstantBase K F) := by + let e := functionFieldNormalClosureConstantBaseRatFuncSelfAlgEquiv K F + exact Module.Finite.equiv e.toLinearEquiv + +/-- The canonical `C(X)`-algebra on the normal closure, obtained by including +the constant-base field `C K(X)` into the normal closure. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureConstantRatFuncAlgebra : + Algebra (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := + RingHom.toAlgebra + ((algebraMap (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosure K F)).comp + (algebraMap (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureConstantBase K F))) + +/-- The canonical `C(X)` map to the normal closure factors through the +constant-base field. -/ +noncomputable instance + functionFieldNormalClosureConstantRatFuncBaseTower : + IsScalarTower + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosure K F) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The normal closure is finite over the canonical copy of `C(X)`. -/ +noncomputable instance + functionFieldNormalClosure_finiteDimensional_over_constantRatFunc : + FiniteDimensional + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := by + exact Module.Finite.trans (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosure K F) + +omit [Algebra K F] [IsScalarTower K (RatFunc K) F] in +/-- The normal closure remains Galois after replacing the constant-base fixed +field by its canonical rational-function presentation `C(X)`. -/ +theorem functionFieldNormalClosure_isGalois_over_constantRatFunc : + IsGalois (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := by + let C := FunctionFieldNormalClosureConstantField K F + let B := FunctionFieldNormalClosureConstantBase K F + let N := FunctionFieldNormalClosure K F + let e : RatFunc C ≃ₐ[RatFunc C] B := + functionFieldNormalClosureConstantBaseRatFuncSelfAlgEquiv K F + letI : IsGalois B N := + functionFieldNormalClosure_isGalois_over_constantBase K F + refine IsGalois.of_equiv_equiv (F := B) (E := N) + (f := e.symm.toRingEquiv) (g := RingEquiv.refl N) ?_ + ext x + simp only [RingHom.comp_apply] + rw [IsScalarTower.algebraMap_apply (RatFunc C) B N] + rw [← e.commutes] + simp + +/-- Exactness of the full normal-closure constant field, stated for the +constant algebra obtained by restricting the canonical `C(X)` presentation. +This is the exact instance expected by the generic tower API. -/ +theorem functionFieldNormalClosureConstantField_isExact_for_constantRatFunc : + let C := FunctionFieldNormalClosureConstantField K F + let N := FunctionFieldNormalClosure K F + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + algebraicClosure C N = (⊥ : IntermediateField C N) := by + let C := FunctionFieldNormalClosureConstantField K F + let B := FunctionFieldNormalClosureConstantBase K F + let N := FunctionFieldNormalClosure K F + let old : Algebra C N := inferInstance + let fresh : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + have hfresh : fresh = old := by + apply Algebra.algebra_ext + intro c + letI : Algebra C N := old + change algebraMap B N + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F + (algebraMap C (RatFunc C) c)) = algebraMap C N c + rw [(functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F).commutes] + exact (IsScalarTower.algebraMap_apply C B N c).symm + let exactFor : Algebra C N → Prop := fun a => + letI : Algebra C N := a + algebraicClosure C N = (⊥ : IntermediateField C N) + have hOld : exactFor old := + functionFieldNormalClosureConstantField_isExact K F + have hFresh : exactFor fresh := + Eq.mp (congrArg exactFor hfresh).symm hOld + letI : Algebra C N := fresh + exact hFresh + +section OriginalCompositum + +variable (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) + +/-- The constant-base field embeds into the original compositum `CF`. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureConstantBaseOriginalCompositumAlgebra : + Algebra (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + (functionFieldNormalClosureConstantBaseToOriginalCompositum + K F hExact).toAlgebra + +/-- The embeddings of the constant base into `CF` and then into the normal +closure agree with its direct inclusion. -/ +noncomputable instance + functionFieldNormalClosureConstantBaseOriginalCompositumTower : + IsScalarTower (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := by + apply IsScalarTower.of_algebraMap_eq' + ext b + rfl + +/-- The existing `C(X)` structure on `CF` factors through the constant-base +field. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositumConstantRatFuncBaseTower : + IsScalarTower + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := by + apply IsScalarTower.of_algebraMap_eq' + ext r + rfl + +/-- The canonical `C(X)` structures on `CF` and on the normal closure are +compatible with the inclusion `CF ⊆ N`. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower : + IsScalarTower + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := by + apply IsScalarTower.of_algebraMap_eq' + ext r + rfl + +/-- The original compositum is finite over its canonical copy of `C(X)`. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositum_finiteDimensional_over_constantRatFunc : + FiniteDimensional + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := by + let B := FunctionFieldNormalClosureConstantBase K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Module.Finite B M := + Module.Finite.of_injective + (IsScalarTower.toAlgHom B M N).toLinearMap + (IsScalarTower.toAlgHom B M N).injective + exact Module.Finite.trans B M + +end OriginalCompositum + +end + +noncomputable section + +section CanonicalNormalClosureTower + + +variable (K F : Type*) [Field K] [Field F] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +local instance canonicalOriginalConstantAlgebra : Algebra K F := + functionFieldCanonicalConstantAlgebra K F + +local instance canonicalOriginalConstantTower : + IsScalarTower K (RatFunc K) F := + IsScalarTower.of_algebraMap_eq' rfl + +/-- In the canonical `C(X)` presentation, `C` is also the exact constant +field of the original compositum `CF`. -/ +theorem + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + algebraicClosure C M = (⊥ : IntermediateField C M) := by + let C := FunctionFieldNormalClosureConstantField K F + let B := FunctionFieldNormalClosureConstantBase K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + let old : Algebra C M := + functionFieldNormalClosureOriginalCompositumConstantAlgebra K F hExact + let fresh : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + have hfresh : fresh = old := by + apply Algebra.algebra_ext + intro c + letI : Algebra C M := old + letI : Algebra B M := + functionFieldNormalClosureConstantBaseOriginalCompositumAlgebra + K F hExact + change algebraMap B M + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F + (algebraMap C (RatFunc C) c)) = algebraMap C M c + rw [(functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F).commutes] + rfl + let exactFor : Algebra C M → Prop := fun a => + letI : Algebra C M := a + algebraicClosure C M = (⊥ : IntermediateField C M) + have hOld : exactFor old := + functionFieldNormalClosureOriginalCompositumConstantField_isExact + K F hExact + have hFresh : exactFor fresh := + Eq.mp (congrArg exactFor hfresh).symm hOld + letI : Algebra C M := fresh + exact hFresh + +/-- The original compositum remains separable over the canonical rational +function field of the full constant field. This is transported from the +original function field after exact extension of constants. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + Algebra.IsSeparable + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := by + let N := FunctionFieldNormalClosure K F + letI : Algebra K N := functionFieldNormalClosureConstantAlgebra K F + let C := FunctionFieldNormalClosureConstantField K F + letI : Algebra K C := + SubalgebraClass.toAlgebra (algebraicClosure K N) + let E := ExactConstantExtension K F C + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Field E := exactConstantExtensionField K F C hExact + letI : Algebra (RatFunc C) E := + ratFuncExactConstantExtensionAlgebra K C F hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_over_extendedRatFunc K C F hExact + let e : E ≃ₐ[RatFunc C] M := + exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv + K F hExact + constructor + intro x + have hx : IsSeparable (RatFunc C) (e.symm x) := + Algebra.IsSeparable.isSeparable (RatFunc C) (e.symm x) + have hex : IsSeparable (RatFunc C) (e (e.symm x)) := + (AlgEquiv.isSeparable_iff e).mpr hx + simpa using hex + +section ConstantExtension + +variable (S : Type*) [Field S] + [Algebra (FunctionFieldNormalClosureConstantField K F) S] + +local instance normalClosureConstantExtensionModule : + Module (FunctionFieldNormalClosureConstantField K F) S := + Algebra.toModule + +variable [Module.Finite (FunctionFieldNormalClosureConstantField K F) S] + [IsGalois (FunctionFieldNormalClosureConstantField K F) S] + +/-- The field structure on `S ⊗[C] CF` used by the normal-closure tower. -/ +@[reducible] noncomputable def + functionFieldNormalClosureOriginalCompositumConstantExtensionField + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + Field (ExactConstantExtension C M S) := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + exact exactConstantExtensionField C M S + (functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact) + +/-- The field structure on `S ⊗[C] N` in the same canonical +`C(X)` presentation. -/ +@[reducible] noncomputable def + functionFieldNormalClosureConstantExtensionFieldForTower : + let C := FunctionFieldNormalClosureConstantField K F + let N := FunctionFieldNormalClosure K F + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + Field (ExactConstantExtension C N S) := by + let C := FunctionFieldNormalClosureConstantField K F + let N := FunctionFieldNormalClosure K F + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + exact exactConstantExtensionField C N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- The canonical `S(X)`-algebra on `S ⊗[C] CF`. -/ +@[reducible] noncomputable def + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + Algebra (RatFunc S) (ExactConstantExtension C M S) := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Field (ExactConstantExtension C M S) := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + exact ratFuncExactConstantExtensionAlgebra C S M + (functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact) + +/-- The canonical `S(X)`-algebra on `S ⊗[C] N`. -/ +@[reducible] noncomputable def + functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower : + let C := FunctionFieldNormalClosureConstantField K F + let N := FunctionFieldNormalClosure K F + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + Algebra (RatFunc S) (ExactConstantExtension C N S) := by + let C := FunctionFieldNormalClosureConstantField K F + let N := FunctionFieldNormalClosure K F + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : Field (ExactConstantExtension C N S) := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + exact ratFuncExactConstantExtensionAlgebra C S N + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- The canonical `S(X)`-linear inclusion +`S ⊗[C] CF → S ⊗[C] N`. -/ +noncomputable def functionFieldNormalClosureConstantExtensionTowerAlgHom + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Algebra (RatFunc S) E_N := + functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower K F S + E_M →ₐ[RatFunc S] E_N := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Algebra (RatFunc S) E_N := + functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower K F S + exact exactConstantExtensionTowerRatFuncAlgHom C M N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- The algebra structure underlying the specialized tensor inclusion. -/ +@[reducible] noncomputable def + functionFieldNormalClosureConstantExtensionTowerAlgebra + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + exact exactConstantExtensionTowerRatFuncAlgebra C M N S + +/-- The specialized inclusion and the canonical `S(X)` structures form a +scalar tower. -/ +theorem functionFieldNormalClosureConstantExtension_ratFuncScalarTower + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Algebra (RatFunc S) E_N := + functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : SMul (RatFunc S) E_M := Algebra.toSMul + letI : SMul (RatFunc S) E_N := Algebra.toSMul + letI : SMul E_M E_N := Algebra.toSMul + IsScalarTower (RatFunc S) E_M E_N := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Algebra (RatFunc S) E_N := + functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : SMul (RatFunc S) E_M := Algebra.toSMul + letI : SMul (RatFunc S) E_N := Algebra.toSMul + letI : SMul E_M E_N := Algebra.toSMul + exact exactConstantExtensionTower_ratFuncScalarTower C M N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- The extended normal closure is finite-dimensional over the extended +original compositum. -/ +theorem + functionFieldNormalClosureConstantExtension_finiteDimensional + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : Module E_M E_N := Algebra.toModule + Module.Finite E_M E_N := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : SMul C M := Algebra.toSMul + letI : SMul C N := Algebra.toSMul + letI : SMul M N := Algebra.toSMul + letI : IsScalarTower C M N := + exactConstantExtensionTowerCanonicalConstantScalarTower C M N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : Module E_M E_N := Algebra.toModule + letI : FiniteDimensional M N := + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + K F hExact + letI : IsGalois M N := + functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact + exact exactConstantExtensionTower_finiteDimensional C M N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- The extended normal closure remains Galois over the extended original +compositum. -/ +theorem functionFieldNormalClosureConstantExtension_isGalois + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + IsGalois E_M E_N := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : SMul C M := Algebra.toSMul + letI : SMul C N := Algebra.toSMul + letI : SMul M N := Algebra.toSMul + letI : IsScalarTower C M N := + exactConstantExtensionTowerCanonicalConstantScalarTower C M N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : FiniteDimensional M N := + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + K F hExact + letI : IsGalois M N := + functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact + exact exactConstantExtensionTower_isGalois C M N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- Extending the full constant field preserves the degree of the normal +closure over the original compositum. -/ +theorem functionFieldNormalClosureConstantExtension_finrank + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : Module E_M E_N := Algebra.toModule + letI : Module.Finite E_M E_N := + functionFieldNormalClosureConstantExtension_finiteDimensional + K F S hExact + Module.finrank E_M E_N = Module.finrank M N := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : SMul C M := Algebra.toSMul + letI : SMul C N := Algebra.toSMul + letI : SMul M N := Algebra.toSMul + letI : IsScalarTower C M N := + exactConstantExtensionTowerCanonicalConstantScalarTower C M N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : Module E_M E_N := Algebra.toModule + letI : Module.Finite E_M E_N := + functionFieldNormalClosureConstantExtension_finiteDimensional + K F S hExact + letI : FiniteDimensional M N := + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + K F hExact + letI : IsGalois M N := + functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact + exact exactConstantExtensionTower_finrank C M N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- Consequently the specialized tower Galois group has the same +cardinality as the normal-closure group over the original compositum. -/ +theorem functionFieldNormalClosureConstantExtension_card_aut_eq + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : Module E_M E_N := Algebra.toModule + letI : Module.Finite E_M E_N := + functionFieldNormalClosureConstantExtension_finiteDimensional + K F S hExact + letI : IsGalois E_M E_N := + functionFieldNormalClosureConstantExtension_isGalois K F S hExact + Nat.card (E_N ≃ₐ[E_M] E_N) = Nat.card (N ≃ₐ[M] N) := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra (RatFunc C) N := + functionFieldNormalClosureConstantRatFuncAlgebra K F + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : SMul C M := Algebra.toSMul + letI : SMul C N := Algebra.toSMul + letI : SMul M N := Algebra.toSMul + letI : IsScalarTower C M N := + exactConstantExtensionTowerCanonicalConstantScalarTower C M N + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F S + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact + letI : Module E_M E_N := Algebra.toModule + letI : Module.Finite E_M E_N := + functionFieldNormalClosureConstantExtension_finiteDimensional + K F S hExact + letI : IsGalois E_M E_N := + functionFieldNormalClosureConstantExtension_isGalois K F S hExact + letI : FiniteDimensional M N := + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + K F hExact + letI : IsGalois M N := + functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact + exact exactConstantExtensionTower_card_aut_eq C M N S + (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) + +/-- The rational-place count of the extended original compositum is the +packaged level-one exact constant-extension count of that compositum. -/ +theorem + functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_exactConstantExtensionCount + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + let hExactM := + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact + let E_M := ExactConstantExtension C M S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Module (RatFunc S) E_M := Algebra.toModule + letI : Module.Finite (RatFunc S) E_M := + finiteDimensional_over_extendedRatFunc C S M hExactM + letI : Algebra.IsSeparable (RatFunc S) E_M := + isSeparable_over_extendedRatFunc C S M hExactM + letI : Fintype C := Fintype.ofFinite C + letI : Finite S := Module.finite_of_finite C + letI : Fintype S := + Fintype.ofFinite S + letI : DecidableEq C := Classical.decEq C + letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + letI : DecidableEq S := Classical.decEq S + letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + finiteExtensionRationalPlaceCount S E_M = + exactConstantExtensionClosedPlaceExtensionCount C S M hExactM 1 := by + let C := FunctionFieldNormalClosureConstantField K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + let hExactM := + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact + let E_M := ExactConstantExtension C M S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Module (RatFunc S) E_M := Algebra.toModule + letI : Module.Finite (RatFunc S) E_M := + finiteDimensional_over_extendedRatFunc C S M hExactM + letI : Algebra.IsSeparable (RatFunc S) E_M := + isSeparable_over_extendedRatFunc C S M hExactM + letI : Fintype C := Fintype.ofFinite C + letI : Finite S := Module.finite_of_finite C + letI : Fintype S := + Fintype.ofFinite S + letI : DecidableEq C := Classical.decEq C + letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + letI : DecidableEq S := Classical.decEq S + letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + exact + (exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount + C S M hExactM).symm + +/-- Combining the exact splitting formula with the canonical +`C(X)`-equivalence `C ⊗[K] F ≃ CF` identifies the same rational-place count +with the packaged exact-extension count of the original function field at +level `[S : C]`. -/ +theorem + functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_originalExactConstantExtensionCount + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + let N := FunctionFieldNormalClosure K F + letI : Algebra K N := functionFieldNormalClosureConstantAlgebra K F + let C := FunctionFieldNormalClosureConstantField K F + letI : Algebra K C := + SubalgebraClass.toAlgebra (algebraicClosure K N) + letI : Module.Finite K C := + functionFieldConstantField_finiteDimensional K N + letI : IsGalois K C := functionFieldConstantField_isGalois K N + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + let hExactM := + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact + let E_M := ExactConstantExtension C M S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Module (RatFunc S) E_M := Algebra.toModule + letI : Module.Finite (RatFunc S) E_M := + finiteDimensional_over_extendedRatFunc C S M hExactM + letI : Algebra.IsSeparable (RatFunc S) E_M := + isSeparable_over_extendedRatFunc C S M hExactM + letI : Finite C := functionFieldConstantField_finite K N + letI : Fintype C := Fintype.ofFinite C + letI : Finite S := Module.finite_of_finite C + letI : Fintype S := Fintype.ofFinite S + letI : DecidableEq C := Classical.decEq C + letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + letI : DecidableEq S := Classical.decEq S + letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + finiteExtensionRationalPlaceCount S E_M = + exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (Module.finrank C S) := by + classical + let N := FunctionFieldNormalClosure K F + letI : Algebra K N := functionFieldNormalClosureConstantAlgebra K F + let C := FunctionFieldNormalClosureConstantField K F + letI : Algebra K C := + SubalgebraClass.toAlgebra (algebraicClosure K N) + letI : Module.Finite K C := + functionFieldConstantField_finiteDimensional K N + letI : IsGalois K C := functionFieldConstantField_isGalois K N + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + let hExactM := + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact + let E_M := ExactConstantExtension C M S + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F S hExact + letI : Algebra (RatFunc S) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F S hExact + letI : Module (RatFunc S) E_M := Algebra.toModule + letI : Module.Finite (RatFunc S) E_M := + finiteDimensional_over_extendedRatFunc C S M hExactM + letI : Algebra.IsSeparable (RatFunc S) E_M := + isSeparable_over_extendedRatFunc C S M hExactM + letI : Finite C := functionFieldConstantField_finite K N + letI : Fintype C := Fintype.ofFinite C + letI : Finite S := Module.finite_of_finite C + letI : Fintype S := Fintype.ofFinite S + letI : DecidableEq C := Classical.decEq C + letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + letI : DecidableEq S := Classical.decEq S + letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + let E := ExactConstantExtension K F C + letI : Field E := exactConstantExtensionField K F C hExact + letI : Algebra (RatFunc C) E := + ratFuncExactConstantExtensionAlgebra K C F hExact + letI : Module (RatFunc C) E := Algebra.toModule + letI : Module.Finite (RatFunc C) E := + finiteDimensional_over_extendedRatFunc K C F hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_over_extendedRatFunc K C F hExact + let e : E ≃ₐ[RatFunc C] M := + exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv + K F hExact + calc + finiteExtensionRationalPlaceCount S E_M = + exactConstantExtensionClosedPlaceExtensionCount + C S M hExactM 1 := + functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_exactConstantExtensionCount + K F S hExact + _ = finiteExtensionClosedPlaceExtensionCount C M + (Module.finrank C S) := by + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + have h := exactConstantExtensionClosedPlaceExtensionCount_eq + C S M hExactM 1 + simpa using h + _ = finiteExtensionClosedPlaceExtensionCount C E + (Module.finrank C S) := by + symm + exact finiteExtensionClosedPlaceExtensionCount_eq_of_algEquiv + C E M e (Module.finrank C S) + _ = exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (Module.finrank C S) := by + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + +end ConstantExtension + +end CanonicalNormalClosureTower + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean new file mode 100644 index 0000000000..2b04a1f57a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism + +/-! +# The Frobenius quotient of an exact constant extension + +The direct-product description of the constant extension gives a canonical +quotient from its full Galois group to the Galois group of the enlarged +constants. Its kernel is exactly the original function-field Galois group. +When the constants are finite, the Frobenius fiber is explicitly equivalent +to that kernel; these are the twists used in the lower-bound argument. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] + +/-- Restriction to the enlarged constants, defined through the proved +direct-product description of the full Galois group. -/ +noncomputable def exactConstantExtensionConstantQuotient + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) →* + (S ≃ₐ[C] S) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact (MonoidHom.fst (S ≃ₐ[C] S) (N ≃ₐ[L] N)).comp + (exactConstantExtensionAutMulEquiv C L N S hExact).symm.toMonoidHom + +/-- On an automorphism assembled from its two tensor factors, the constant +quotient returns the first factor. -/ +theorem exactConstantExtensionConstantQuotient_combined + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (σ : S ≃ₐ[C] S) (g : N ≃ₐ[L] N) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exactConstantExtensionConstantQuotient C L N S hExact + (exactConstantExtensionCombinedAutHom C L N S (σ, g)) = σ := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let e := exactConstantExtensionAutMulEquiv C L N S hExact + change (e.symm (e (σ, g))).1 = σ + rw [e.symm_apply_apply] + +/-- The constant quotient records exactly how a full automorphism acts on +the embedded enlarged constant field. -/ +theorem exactConstantExtensionConstantQuotient_action_on_constants + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (g : letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) + (s : S) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + g (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + (exactConstantExtensionConstantQuotient C L N S hExact g s) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let e := exactConstantExtensionAutMulEquiv C L N S hExact + let p := e.symm g + have hgp : e p = g := e.apply_symm_apply g + rw [← hgp] + have hq := exactConstantExtensionConstantQuotient_combined + C L N S hExact p.1 p.2 + change exactConstantExtensionCombinedAutHom C L N S p + (Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) s) = + Algebra.TensorProduct.includeLeft + (R := C) (S := C) (A := S) (B := N) + (exactConstantExtensionConstantQuotient C L N S hExact (e p) s) + rw [show e p = exactConstantExtensionCombinedAutHom C L N S p by rfl] + rw [hq] + simp [exactConstantExtensionCombinedAutHom, + exactConstantExtensionConstantAutHom, + exactConstantExtensionFunctionAutHom, + exactConstantExtensionConstantAlgEquivOverBase, + exactConstantExtensionFunctionAlgEquivOverBase, + Algebra.TensorProduct.includeLeft_apply] + +/-- The constant quotient is onto. -/ +theorem exactConstantExtensionConstantQuotient_surjective + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Function.Surjective + (exactConstantExtensionConstantQuotient C L N S hExact) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + intro σ + refine ⟨exactConstantExtensionCombinedAutHom C L N S + (σ, (1 : N ≃ₐ[L] N)), ?_⟩ + exact exactConstantExtensionConstantQuotient_combined + C L N S hExact σ 1 + +/-- The kernel of the constant quotient is precisely the image of the +function-field action. -/ +theorem exactConstantExtensionConstantQuotient_ker : + ∀ (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)), + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + (exactConstantExtensionConstantQuotient C L N S hExact).ker = + (exactConstantExtensionFunctionAutHom C L N S).range := by + intro hExact + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + ext x + constructor + · intro hx + let e := exactConstantExtensionAutMulEquiv C L N S hExact + let p := e.symm x + have hpFirst : p.1 = 1 := by + have hx' := (MonoidHom.mem_ker.mp hx) + change p.1 = 1 at hx' + exact hx' + refine ⟨p.2, ?_⟩ + have hp : (1, p.2) = p := by + apply Prod.ext + · exact hpFirst.symm + · rfl + change exactConstantExtensionFunctionAutHom C L N S p.2 = x + calc + exactConstantExtensionFunctionAutHom C L N S p.2 = + exactConstantExtensionCombinedAutHom C L N S (1, p.2) := by + simp [exactConstantExtensionCombinedAutHom] + _ = e (1, p.2) := rfl + _ = e p := congrArg e hp + _ = x := e.apply_symm_apply x + · rintro ⟨g, rfl⟩ + apply MonoidHom.mem_ker.mpr + have h := exactConstantExtensionConstantQuotient_combined + C L N S hExact (1 : S ≃ₐ[C] S) g + simpa [exactConstantExtensionCombinedAutHom] using h + +omit [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] in +/-- The constant-factor action is faithful. -/ +theorem exactConstantExtensionConstantAutHom_injective : + letI := exactConstantExtensionBaseAlgebra C L N S + Function.Injective (exactConstantExtensionConstantAutHom C L N S) := by + letI := exactConstantExtensionBaseAlgebra C L N S + intro σ τ h + have hpair := exactConstantExtensionCombinedAutHom_injective C L N S + (show exactConstantExtensionCombinedAutHom C L N S + (σ, (1 : N ≃ₐ[L] N)) = + exactConstantExtensionCombinedAutHom C L N S + (τ, (1 : N ≃ₐ[L] N)) by + simpa [exactConstantExtensionCombinedAutHom] using h) + exact congrArg Prod.fst hpair + +section Finite + +variable [Fintype C] [Finite S] + +/-- Frobenius on `S / C`, lifted to the tensor compositum while fixing `N`. -/ +noncomputable def exactConstantExtensionFrobenius : + letI := exactConstantExtensionBaseAlgebra C L N S + ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S := by + letI := exactConstantExtensionBaseAlgebra C L N S + exact exactConstantExtensionConstantAutHom C L N S + (FiniteField.frobeniusAlgEquivOfAlgebraic C S) + +omit [FiniteDimensional C S] [FiniteDimensional L N] [IsGalois L N] in +/-- The lifted Frobenius has order `[S : C]`. -/ +theorem orderOf_exactConstantExtensionFrobenius : + letI := exactConstantExtensionBaseAlgebra C L N S + orderOf (exactConstantExtensionFrobenius C L N S) = + Module.finrank C S := by + letI := exactConstantExtensionBaseAlgebra C L N S + change orderOf ((exactConstantExtensionConstantAutHom C L N S) + (FiniteField.frobeniusAlgEquivOfAlgebraic C S)) = _ + rw [orderOf_injective (exactConstantExtensionConstantAutHom C L N S) + (exactConstantExtensionConstantAutHom_injective C L N S)] + exact FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic C S + +omit [Finite S] in +/-- The constant quotient sends the lifted Frobenius to finite-field +Frobenius. -/ +theorem exactConstantExtensionConstantQuotient_frobenius + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exactConstantExtensionConstantQuotient C L N S hExact + (exactConstantExtensionFrobenius C L N S) = + FiniteField.frobeniusAlgEquivOfAlgebraic C S := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + have h := exactConstantExtensionConstantQuotient_combined + C L N S hExact (FiniteField.frobeniusAlgEquivOfAlgebraic C S) + (1 : N ≃ₐ[L] N) + simpa [exactConstantExtensionFrobenius, + exactConstantExtensionCombinedAutHom] using h + +omit [Finite S] in +/-- The Frobenius fiber of the constant quotient is parametrized exactly by +the original function-field Galois group. -/ +noncomputable def exactConstantExtensionFrobeniusFiberEquiv + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + (N ≃ₐ[L] N) ≃ + (exactConstantExtensionConstantQuotient C L N S hExact ⁻¹' + ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : Set (S ≃ₐ[C] S))) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let e := exactConstantExtensionAutMulEquiv C L N S hExact + let φ := FiniteField.frobeniusAlgEquivOfAlgebraic C S + exact + { toFun := fun g => + ⟨e (φ, g), exactConstantExtensionConstantQuotient_combined + C L N S hExact φ g⟩ + invFun := fun x => (e.symm x.1).2 + left_inv := fun g => by simp + right_inv := fun x => by + apply Subtype.ext + have hfirst : (e.symm x.1).1 = φ := x.2 + have hp : (φ, (e.symm x.1).2) = e.symm x.1 := by + apply Prod.ext + · exact hfirst.symm + · rfl + calc + e (φ, (e.symm x.1).2) = e (e.symm x.1) := congrArg e hp + _ = x.1 := e.apply_symm_apply x.1 } + +omit [Finite S] in +/-- Consequently the Frobenius fiber has the same cardinality as +`Gal(N/L)`. -/ +theorem natCard_exactConstantExtensionFrobeniusFiber + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Nat.card + (exactConstantExtensionConstantQuotient C L N S hExact ⁻¹' + ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : + Set (S ≃ₐ[C] S))) = + Nat.card (N ≃ₐ[L] N) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact Nat.card_congr + (exactConstantExtensionFrobeniusFiberEquiv C L N S hExact).symm + +end Finite + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean new file mode 100644 index 0000000000..26824d15eb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean @@ -0,0 +1,77 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta + +/-! +# Rational-place count of an exact constant extension + +The packaged exact constant-extension count at level one is definitionally +the complete rational-place count of the scalar-extended function field. +This small bridge keeps the instance choices used by the global splitting +formula explicit. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (C S N : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field S] [Fintype S] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + +local instance rationalCountBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance rationalCountBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The packaged level-one exact-extension count is the complete rational +place count of the extended function field. -/ +theorem exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + exactConstantExtensionClosedPlaceExtensionCount C S N hExact 1 = + (by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + letI : DecidableEq S := Classical.decEq S + letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + exact finiteExtensionRationalPlaceCount S E) := by + classical + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + change exactConstantExtensionClosedPlaceExtensionCount + C S N hExact 1 = finiteExtensionRationalPlaceCount S E + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + exact finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount + S E + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean new file mode 100644 index 0000000000..68bc7c396a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean @@ -0,0 +1,187 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase + +/-! +# Regular constant extensions + +An exact constant field makes finite Galois extensions of the constants +linearly disjoint from the function field. The existing tensor-product +construction therefore remains a field and its full Galois group is a direct +product. This file records the corresponding intrinsic statement: the +original function-field Galois group is exactly the subgroup acting trivially +on the enlarged constants. + +The final declarations specialize these facts to the normal closure used in +the Hasse--Weil development. They concern the proved constant base `C(t)`; +they do not assert compatibility with the not-yet-defined compositum `C F` of +an arbitrary intermediate function field `F`. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C L N S : Type*) [Field C] [Field L] [Field N] [Field S] + [Algebra C L] [Algebra L N] [Algebra C N] [IsScalarTower C L N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional L N] [IsGalois L N] + +/-- The action of the original function-field Galois group, regarded as an +automorphism of the constant extension that acts trivially on the enlarged +constants. -/ +noncomputable def exactConstantExtensionFunctionAutHomToConstantKernel + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + (N ≃ₐ[L] N) →* + (exactConstantExtensionConstantQuotient C L N S hExact).ker := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + let f := exactConstantExtensionFunctionAutHom C L N S + exact + { toFun := fun g => ⟨f g, by + rw [exactConstantExtensionConstantQuotient_ker C L N S hExact] + exact ⟨g, rfl⟩⟩ + map_one' := by + apply Subtype.ext + exact map_one f + map_mul' := by + intro g h + apply Subtype.ext + exact map_mul f g h } + +theorem exactConstantExtensionFunctionAutHomToConstantKernel_injective + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Function.Injective + (exactConstantExtensionFunctionAutHomToConstantKernel C L N S hExact) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + intro g h hgh + have hfun : exactConstantExtensionFunctionAutHom C L N S g = + exactConstantExtensionFunctionAutHom C L N S h := + congrArg Subtype.val hgh + have hp := exactConstantExtensionCombinedAutHom_injective C L N S + (show exactConstantExtensionCombinedAutHom C L N S (1, g) = + exactConstantExtensionCombinedAutHom C L N S (1, h) by + simpa [exactConstantExtensionCombinedAutHom] using hfun) + exact congrArg Prod.snd hp + +theorem exactConstantExtensionFunctionAutHomToConstantKernel_surjective + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + Function.Surjective + (exactConstantExtensionFunctionAutHomToConstantKernel C L N S hExact) := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + intro x + have hx : x.1 ∈ (exactConstantExtensionFunctionAutHom C L N S).range := by + rw [← exactConstantExtensionConstantQuotient_ker C L N S hExact] + exact x.property + obtain ⟨g, hg⟩ := hx + refine ⟨g, ?_⟩ + apply Subtype.ext + exact hg + +/-- Exact finite constant extension preserves the function-field Galois group: +it is canonically the kernel of restriction from the full extended Galois +group to the Galois group of the enlarged constants. -/ +noncomputable def exactConstantExtensionFunctionAutMulEquiv + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + (N ≃ₐ[L] N) ≃* + (exactConstantExtensionConstantQuotient C L N S hExact).ker := by + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C L N S + exact MulEquiv.ofBijective + (exactConstantExtensionFunctionAutHomToConstantKernel C L N S hExact) + ⟨exactConstantExtensionFunctionAutHomToConstantKernel_injective + C L N S hExact, + exactConstantExtensionFunctionAutHomToConstantKernel_surjective + C L N S hExact⟩ + +section NormalClosure + +variable (K F S : Type*) [Field K] [Field F] [Field S] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) F] [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + [Algebra (FunctionFieldNormalClosureConstantField K F) S] + [FiniteDimensional (FunctionFieldNormalClosureConstantField K F) S] + [IsGalois (FunctionFieldNormalClosureConstantField K F) S] + +/-- A finite Galois extension of the exact constants has field-valued tensor +product with the function-field normal closure. -/ +theorem functionFieldNormalClosureConstantExtensionTensor_isField : + IsField (ExactConstantExtension + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S) := + exactConstantExtensionTensor_isField + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S + (functionFieldNormalClosureConstantField_isExact K F) + +/-- The constant extension has the expected degree over the original normal +closure. -/ +theorem functionFieldNormalClosureConstantExtension_finrank_over_normalClosure : + letI := exactConstantExtensionAlgebra + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S + Module.finrank (FunctionFieldNormalClosure K F) + (ExactConstantExtension + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S) = + Module.finrank (FunctionFieldNormalClosureConstantField K F) S := by + exact exactConstantExtension_finrank + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S + +/-- The normal closure remains Galois over its proved constant base after a +finite Galois extension of the exact constants. -/ +theorem functionFieldNormalClosureConstantExtension_isGalois_over_constantBase : + let C := FunctionFieldNormalClosureConstantField K F + let B := FunctionFieldNormalClosureConstantBase K F + let N := FunctionFieldNormalClosure K F + let hExact := functionFieldNormalClosureConstantField_isExact K F + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C B N S + IsGalois B (ExactConstantExtension C N S) := by + exact exactConstantExtension_isGalois + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosure K F) S + (functionFieldNormalClosureConstantField_isExact K F) + +/-- In the normal-closure setting, the original geometric Galois group is the +kernel of restriction to the enlarged constants. -/ +noncomputable def + functionFieldNormalClosureConstantExtensionFunctionAutMulEquiv : + let C := FunctionFieldNormalClosureConstantField K F + let B := FunctionFieldNormalClosureConstantBase K F + let N := FunctionFieldNormalClosure K F + let hExact := functionFieldNormalClosureConstantField_isExact K F + letI := exactConstantExtensionField C N S hExact + letI := exactConstantExtensionBaseAlgebra C B N S + (N ≃ₐ[B] N) ≃* + (exactConstantExtensionConstantQuotient C B N S hExact).ker := by + exact exactConstantExtensionFunctionAutMulEquiv + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosure K F) S + (functionFieldNormalClosureConstantField_isExact K F) + +end NormalClosure + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean new file mode 100644 index 0000000000..fea0ac4586 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean @@ -0,0 +1,218 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor + +/-! +# Total different degree under exact constant extension + +This file separates the global weighted-degree cancellation from the local +normalization compatibility needed for invariance of the different under an +exact extension of finite constants. + +The theorem below assumes only pointwise equality of the total-different +multiplicity on a presented upstairs place and its contracted downstairs +place. The exhaustive presented-place equivalence, the division-by-gcd +degree formula, and the matching gcd fiber cardinality then prove equality of +the total finite-plus-infinity different degrees. The remaining pointwise +hypothesis is intended to be discharged branchwise by the finite and +reciprocal-infinity different-map theorems. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance (priority := 10000) + exactConstantTotalDifferentConstantsDecidableEq + (K : Type*) [Field K] : DecidableEq K := + infinityBridgeDecidableEqConstants K + +local instance (priority := 10001) + exactConstantTotalDifferentRatFuncDecidableEq + (K : Type*) [Field K] : DecidableEq (RatFunc K) := + infinityBridgeDecidableEqRatFuncConstants K + +local instance exactConstantTotalDifferentBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance exactConstantTotalDifferentBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) + exactConstantTotalDifferentBasePolynomialAlgebra : Algebra C[X] N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + +local instance exactConstantTotalDifferentBasePolynomialTower : + IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- If the total-different multiplicity is preserved at every presented +place, then an exact extension of finite constants preserves the total +finite-plus-infinity different degree. -/ +theorem exactConstantExtension_totalDifferentDegree_eq_of_presentedMultiplicity + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + (∀ q : ExactConstantExtensionPresentedPlace C S N, + finiteExtensionTotalDifferentEffectiveDivisor S E + (exactConstantExtensionPresentedUpstairsPlaceEquiv + C S N hExact q) = + finiteExtensionTotalDifferentEffectiveDivisor C N + (exactConstantExtensionPresentedDownstairsPlace + C S N hExact q)) → + finiteExtensionFiniteDifferentDegree S E + (finiteExtensionFiniteDifferentIdeal_ne_bot S E) + + infinityDifferentDegree S E = + finiteExtensionFiniteDifferentDegree C N + (finiteExtensionFiniteDifferentIdeal_ne_bot C N) + + infinityDifferentDegree C N := by + dsimp only + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) E := Algebra.toSMul + letI : Module (RatFunc C) E := Algebra.toModule + letI : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + letI : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + letI : SMul S[X] E := Algebra.toSMul + letI : Module S[X] E := Algebra.toModule + letI : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + intro hPresentedMultiplicity + let Base := FiniteExtensionPlace C N + let Up := ExactConstantExtensionPresentedPlace C S N + let Actual := FiniteExtensionPlace S E + let down : Up → Base := + exactConstantExtensionPresentedDownstairsPlace C S N hExact + let e : Up ≃ Actual := + exactConstantExtensionPresentedUpstairsPlaceEquiv C S N hExact + let Dbase : Base →₀ ℕ := + finiteExtensionTotalDifferentEffectiveDivisor C N + let Dactual : Actual →₀ ℕ := + finiteExtensionTotalDifferentEffectiveDivisor S E + let Dup : Up →₀ ℕ := (Finsupp.domCongr e).symm Dactual + have hDup (q : Up) : Dup q = Dactual (e q) := by + simp [Dup, Finsupp.domCongr_apply] + have hWeighted : + Dup.sum (fun q m => + m * finiteExtensionPlaceDegree S E (e q)) = + Dbase.sum (fun P m => + m * finiteExtensionPlaceDegree C N P) := by + apply Finsupp.sum_mul_degree_eq_of_div_gcd_fibers + down (finiteExtensionPlaceDegree C N) + (fun q => finiteExtensionPlaceDegree S E (e q)) + Dbase Dup (Module.finrank C S) + · intro q + rw [hDup] + exact hPresentedMultiplicity q + · intro q + dsimp [e, down] + rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] + exact exactConstantExtensionPresentedPlace_degree_eq_div_gcd + C S N hExact q + · intro P + exact + exactConstantExtensionPresentedPlaceFiber_natCard_eq_gcd_of_downstairs + C S N hExact P + have hReindex : + Dactual.sum (fun Q m => + m * finiteExtensionPlaceDegree S E Q) = + Dup.sum (fun q m => + m * finiteExtensionPlaceDegree S E (e q)) := by + dsimp [Dup] + rw [Finsupp.domCongr_symm] + change Dactual.sum _ = + (Finsupp.equivMapDomain e.symm Dactual).sum _ + rw [Finsupp.sum_equivMapDomain] + simp only [Equiv.apply_symm_apply] + calc + finiteExtensionFiniteDifferentDegree S E + (finiteExtensionFiniteDifferentIdeal_ne_bot S E) + + infinityDifferentDegree S E = + finiteExtensionEffectiveDivisorDegree S E Dactual := + (finiteExtensionTotalDifferentEffectiveDivisor_degree S E).symm + _ = Dactual.sum (fun Q m => + m * finiteExtensionPlaceDegree S E Q) := rfl + _ = Dup.sum (fun q m => + m * finiteExtensionPlaceDegree S E (e q)) := hReindex + _ = Dbase.sum (fun P m => + m * finiteExtensionPlaceDegree C N P) := hWeighted + _ = finiteExtensionEffectiveDivisorDegree C N Dbase := rfl + _ = finiteExtensionFiniteDifferentDegree C N + (finiteExtensionFiniteDifferentIdeal_ne_bot C N) + + infinityDifferentDegree C N := + finiteExtensionTotalDifferentEffectiveDivisor_degree C N + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean new file mode 100644 index 0000000000..aafa15f8ee --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean @@ -0,0 +1,542 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +/-! +# Towers of exact constant extensions + +Let `C` be the exact constant field of `N`, let `M` be an intermediate field +in a tower `C ⊆ M ⊆ N`, and let `S / C` be finite Galois. Tensoring the +inclusion `M → N` with the identity of `S` gives + +`S ⊗[C] M → S ⊗[C] N`. + +This file packages that map as the algebra structure needed by the +constant-extension place and Frobenius APIs. It proves that the extended +top is finite Galois over the extended intermediate field, with the same +degree and hence the same Galois-group cardinality as `N / M`. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +variable (C M N S : Type*) [Field C] [Field M] [Field N] [Field S] + [Algebra C M] [Algebra C N] [Algebra M N] [IsScalarTower C M N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +/-- Exact constants descend from a field to every intermediate field in a +compatible scalar tower. -/ +theorem algebraicClosure_eq_bot_of_tower + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : + algebraicClosure C M = (⊥ : IntermediateField C M) := by + let i : M →ₐ[C] N := IsScalarTower.toAlgHom C M N + apply eq_bot_iff.mpr + intro x hx + have hxi : i x ∈ algebraicClosure C N := + (map_mem_algebraicClosure_iff i).mpr hx + rw [hExactN] at hxi + obtain ⟨c, hc⟩ := IntermediateField.mem_bot.mp hxi + apply IntermediateField.mem_bot.mpr + refine ⟨c, ?_⟩ + exact i.injective (by simpa using hc) + +/-- Tensor the inclusion `M → N` with the identity on the enlarged +constant field. -/ +noncomputable def exactConstantExtensionTowerAlgHom : + ExactConstantExtension C M S →ₐ[C] ExactConstantExtension C N S := + Algebra.TensorProduct.map (AlgHom.id C S) + (IsScalarTower.toAlgHom C M N) + +@[simp] +theorem exactConstantExtensionTowerAlgHom_tmul (s : S) (m : M) : + exactConstantExtensionTowerAlgHom C M N S (s ⊗ₜ[C] m) = + s ⊗ₜ[C] algebraMap M N m := by + rw [exactConstantExtensionTowerAlgHom, + Algebra.TensorProduct.map_tmul] + rfl + +/-- The algebra structure on the extended top induced by the tensor map. -/ +@[reducible] noncomputable def exactConstantExtensionTowerAlgebra : + Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + (exactConstantExtensionTowerAlgHom C M N S).toAlgebra + +/-- The tensor map preserves the enlarged constants on the left factor. -/ +theorem exactConstantExtensionTower_leftScalarTower : + letI : Algebra S (ExactConstantExtension C M S) := + Algebra.TensorProduct.leftAlgebra + letI : Algebra S (ExactConstantExtension C N S) := + Algebra.TensorProduct.leftAlgebra + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + IsScalarTower S (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := by + letI : Algebra S (ExactConstantExtension C M S) := + Algebra.TensorProduct.leftAlgebra + letI : Algebra S (ExactConstantExtension C N S) := + Algebra.TensorProduct.leftAlgebra + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + apply IsScalarTower.of_algebraMap_eq' + ext s + change s ⊗ₜ[C] (1 : N) = + exactConstantExtensionTowerAlgHom C M N S (s ⊗ₜ[C] (1 : M)) + rw [exactConstantExtensionTowerAlgHom_tmul, map_one] + +/-- The tensor map also preserves the original right factor `M`. -/ +theorem exactConstantExtensionTower_rightScalarTower + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + IsScalarTower M (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := by + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + apply IsScalarTower.of_algebraMap_eq' + ext m + change (1 : S) ⊗ₜ[C] algebraMap M N m = + exactConstantExtensionTowerAlgHom C M N S ((1 : S) ⊗ₜ[C] m) + rw [exactConstantExtensionTowerAlgHom_tmul] + +section Galois + +variable [FiniteDimensional M N] [IsGalois M N] + +/-- The extended top is finite-dimensional over the extended intermediate +field. -/ +theorem exactConstantExtensionTower_finiteDimensional + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + FiniteDimensional (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := by + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + letI : IsScalarTower M (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_rightScalarTower C M N S hExactN + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : IsScalarTower M N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C M N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := + Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + letI : Module.Finite M (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + exact Module.Finite.of_restrictScalars_finite M + (ExactConstantExtension C M S) (ExactConstantExtension C N S) + +/-- Base change by finite constants preserves the Galois extension. -/ +theorem exactConstantExtensionTower_isGalois + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + IsGalois (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := by + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + letI : IsScalarTower M (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_rightScalarTower C M N S hExactN + letI : IsGalois M (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C M N S hExactN + exact IsGalois.tower_top_of_isGalois M + (ExactConstantExtension C M S) (ExactConstantExtension C N S) + +/-- Finite constant base change preserves the relative extension degree. -/ +theorem exactConstantExtensionTower_finrank + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + letI : FiniteDimensional (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_finiteDimensional C M N S hExactN + Module.finrank (ExactConstantExtension C M S) + (ExactConstantExtension C N S) = Module.finrank M N := by + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + letI : IsScalarTower M (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_rightScalarTower C M N S hExactN + letI : FiniteDimensional (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_finiteDimensional C M N S hExactN + apply Nat.eq_of_mul_eq_mul_left (Module.finrank_pos (R := C) (M := S)) + calc + Module.finrank C S * Module.finrank (ExactConstantExtension C M S) + (ExactConstantExtension C N S) = + Module.finrank M (ExactConstantExtension C M S) * + Module.finrank (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := by + rw [exactConstantExtension_finrank C M S] + _ = Module.finrank M (ExactConstantExtension C N S) := + Module.finrank_mul_finrank M (ExactConstantExtension C M S) + (ExactConstantExtension C N S) + _ = Module.finrank M N * Module.finrank C S := + exactConstantExtension_finrank_over_base C M N S + _ = Module.finrank C S * Module.finrank M N := Nat.mul_comm _ _ + +/-- Consequently the Galois group has the same finite cardinality after +constant base change. -/ +theorem exactConstantExtensionTower_card_aut_eq + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + letI : FiniteDimensional (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_finiteDimensional C M N S hExactN + letI : IsGalois (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_isGalois C M N S hExactN + Nat.card (ExactConstantExtension C N S ≃ₐ[ + ExactConstantExtension C M S] ExactConstantExtension C N S) = + Nat.card (N ≃ₐ[M] N) := by + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + letI : Field (ExactConstantExtension C M S) := + exactConstantExtensionField C M S hExactM + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExactN + letI : Algebra M (ExactConstantExtension C M S) := + exactConstantExtensionAlgebra C M S + letI : Algebra M (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C M N S + letI : Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTowerAlgebra C M N S + letI : FiniteDimensional (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_finiteDimensional C M N S hExactN + letI : IsGalois (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + exactConstantExtensionTower_isGalois C M N S hExactN + rw [IsGalois.card_aut_eq_finrank, IsGalois.card_aut_eq_finrank, + exactConstantExtensionTower_finrank C M N S hExactN] + +end Galois + +end + +noncomputable section + +section RatFuncCompatibility + + +variable (C M N S : Type*) [Field C] [Field M] [Field N] [Field S] + [Algebra (RatFunc C) M] [Algebra (RatFunc C) N] + [Algebra M N] [IsScalarTower (RatFunc C) M N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +/-- The constant algebra obtained by restricting a rational-function-field +algebra along `C → C(X)`. Naming this definition makes the canonical +constant structures in the source and target definitionally transparent. -/ +@[reducible] noncomputable def + exactConstantExtensionTowerCanonicalConstantAlgebra + (C T : Type*) [Field C] [Field T] [Algebra (RatFunc C) T] : + Algebra C T := + RingHom.toAlgebra + ((algebraMap (RatFunc C) T).comp (algebraMap C (RatFunc C))) + +/-- Restricting a compatible `C(X)`-tower along `C → C(X)` gives the +canonical constant scalar tower used by exact constant extensions. -/ +theorem exactConstantExtensionTowerCanonicalConstantScalarTower : + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + IsScalarTower C M N := by + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + apply IsScalarTower.of_algebraMap_eq' + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c) + +/-- The tensor map between two exact constant extensions is linear over the +enlarged rational-function field `S(X)` for the canonical structures on both +extensions. -/ +noncomputable def exactConstantExtensionTowerRatFuncAlgHom : + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c)) + ∀ (hExactN : algebraicClosure C N = + (⊥ : IntermediateField C N)), + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := exactConstantExtensionField C M S hExactM + letI : Field E_N := exactConstantExtensionField C N S hExactN + letI : Algebra (RatFunc S) E_M := + ratFuncExactConstantExtensionAlgebra C S M hExactM + letI : Algebra (RatFunc S) E_N := + ratFuncExactConstantExtensionAlgebra C S N hExactN + E_M →ₐ[RatFunc S] E_N := by + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c)) + intro hExactN + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := exactConstantExtensionField C M S hExactM + letI : Field E_N := exactConstantExtensionField C N S hExactN + letI : Algebra S E_M := Algebra.TensorProduct.leftAlgebra + letI : Algebra S E_N := Algebra.TensorProduct.leftAlgebra + letI : Algebra (RatFunc S) E_M := + ratFuncExactConstantExtensionAlgebra C S M hExactM + letI : Algebra (RatFunc S) E_N := + ratFuncExactConstantExtensionAlgebra C S N hExactN + letI : Algebra C[X] M := + RingHom.toAlgebra + ((algebraMap (RatFunc C) M).comp + (algebraMap C[X] (RatFunc C))) + letI : Algebra C[X] N := + RingHom.toAlgebra + ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + let φS : E_M →ₐ[S] E_N := + { exactConstantExtensionTowerAlgHom C M N S with + commutes' := by + intro s + change exactConstantExtensionTowerAlgHom C M N S + (s ⊗ₜ[C] (1 : M)) = s ⊗ₜ[C] (1 : N) + rw [exactConstantExtensionTowerAlgHom_tmul, map_one] } + let f : RatFunc S →ₐ[S] E_N := + φS.comp (ratFuncToExactConstantExtension C S M hExactM) + let g : RatFunc S →ₐ[S] E_N := + ratFuncToExactConstantExtension C S N hExactN + have hX : f RatFunc.X = g RatFunc.X := by + change exactConstantExtensionTowerAlgHom C M N S + (ratFuncToExactConstantExtension C S M hExactM RatFunc.X) = + ratFuncToExactConstantExtension C S N hExactN RatFunc.X + rw [ratFuncToExactConstantExtension_X, + ratFuncToExactConstantExtension_X] + simp only [polynomialTensorCancelEvaluationPoint, + Algebra.TensorProduct.includeRight_apply] + rw [exactConstantExtensionTowerAlgHom_tmul] + congr 1 + exact (IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C[X] (RatFunc C) Polynomial.X)).symm + have hRing : f.toRingHom = g.toRingHom := by + apply IsFractionRing.ringHom_ext (A := S[X]) + intro p + induction p using Polynomial.induction_on' with + | add p q hp hq => + simpa only [map_add] using congrArg₂ (fun x y => x + y) hp hq + | monomial n s => + rw [← Polynomial.C_mul_X_pow_eq_monomial] + simp only [map_mul, map_pow, RatFunc.algebraMap_C, + RatFunc.algebraMap_X] + rw [← RatFunc.algebraMap_eq_C] + have hfs : f.toRingHom (algebraMap S (RatFunc S) s) = + algebraMap S E_N s := f.commutes s + have hgs : g.toRingHom (algebraMap S (RatFunc S) s) = + algebraMap S E_N s := g.commutes s + have hX' : f.toRingHom RatFunc.X = g.toRingHom RatFunc.X := hX + rw [hfs, hgs, hX'] + have hfg : f = g := + DFunLike.ext _ _ (fun r => DFunLike.congr_fun hRing r) + refine { φS with commutes' := ?_ } + intro r + exact DFunLike.congr_fun hfg r + +/-- The algebra structure underlying the `S(X)`-linear tensor map. Its +underlying ring homomorphism is the same tensor map as +`exactConstantExtensionTowerAlgebra`; the separate name records the intended +canonical rational-function-field interface. -/ +@[reducible] noncomputable def exactConstantExtensionTowerRatFuncAlgebra : + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c)) + Algebra (ExactConstantExtension C M S) + (ExactConstantExtension C N S) := + by + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c)) + exact exactConstantExtensionTowerAlgebra C M N S + +/-- The canonical `S(X)`-algebras on the two exact constant extensions and +the tensor inclusion form a scalar tower. -/ +theorem exactConstantExtensionTower_ratFuncScalarTower + (hExactN : + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + algebraicClosure C N = (⊥ : IntermediateField C N)) : + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c)) + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := exactConstantExtensionField C M S hExactM + letI : Field E_N := exactConstantExtensionField C N S hExactN + letI : Algebra (RatFunc S) E_M := + ratFuncExactConstantExtensionAlgebra C S M hExactM + letI : Algebra (RatFunc S) E_N := + ratFuncExactConstantExtensionAlgebra C S N hExactN + letI : Algebra E_M E_N := + exactConstantExtensionTowerRatFuncAlgebra C M N S + IsScalarTower (RatFunc S) E_M E_N := by + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + ext c + exact IsScalarTower.algebraMap_apply (RatFunc C) M N + (algebraMap C (RatFunc C) c)) + let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN + let E_M := ExactConstantExtension C M S + let E_N := ExactConstantExtension C N S + letI : Field E_M := exactConstantExtensionField C M S hExactM + letI : Field E_N := exactConstantExtensionField C N S hExactN + letI : Algebra (RatFunc S) E_M := + ratFuncExactConstantExtensionAlgebra C S M hExactM + letI : Algebra (RatFunc S) E_N := + ratFuncExactConstantExtensionAlgebra C S N hExactN + letI : Algebra E_M E_N := + exactConstantExtensionTowerRatFuncAlgebra C M N S + apply IsScalarTower.of_algebraMap_eq' + ext r + change ratFuncToExactConstantExtension C S N hExactN r = + exactConstantExtensionTowerAlgHom C M N S + (ratFuncToExactConstantExtension C S M hExactM r) + exact (exactConstantExtensionTowerRatFuncAlgHom C M N S hExactN).commutes r + |>.symm + +end RatFuncCompatibility + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean new file mode 100644 index 0000000000..9a3163448c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +import Mathlib.Tactic + +/-! +# A Stepanov upper bound along the even-degree extension sequence + +Let `K_n = FiniteField.Extension K p n` and +`K_{2n} = FiniteField.Extension K p (2 * n)`. Since `n ∣ 2 * n`, finite-field +theory supplies a `K`-algebra embedding `K_n → K_{2n}`. With this algebra +structure the latter is a quadratic extension of the former, so the +square-field Stepanov estimate applies directly to the canonical degree +`2 * n` point count. + +This is only a one-sided affine estimate. It does not assert the missing +lower bound, the sharp Hasse--Weil constant, or a two-sided zeta estimate. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +/-- An injective extension of coefficients preserves a support-wise +bidegree bound. -/ +theorem hasBidegreeAtMost_map_of_injective + {R S : Type*} [CommSemiring R] [CommSemiring S] + (φ : R →+* S) (hφ : Function.Injective φ) + {f : MvPolynomial (Fin 2) R} {firstDegree secondDegree : Nat} + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) : + BGS.External.HasBidegreeAtMost + (MvPolynomial.map φ f) firstDegree secondDegree := by + intro monomial hmonomial + apply hdegree monomial + rwa [MvPolynomial.support_map_of_injective f hφ] at hmonomial + +/-- An injective extension of coefficients preserves the exact coarse genus +budget used by the plane Stepanov argument. -/ +theorem planeCurveBidegreeGenusBudget_map_of_injective + {R S : Type*} [CommSemiring R] [CommSemiring S] + (φ : R →+* S) (hφ : Function.Injective φ) + (f : MvPolynomial (Fin 2) R) : + planeCurveBidegreeGenusBudget (MvPolynomial.map φ f) = + planeCurveBidegreeGenusBudget f := by + simp only [planeCurveBidegreeGenusBudget, + degreeOf_map_eq_of_injective φ hφ] + +variable (K : Type*) [Field K] [Fintype K] +variable (p n : Nat) [Fact p.Prime] [CharP K p] [NeZero n] + +/-- A chosen `K`-algebra embedding from the degree-`n` extension into the +degree-`2n` extension. Its existence is the finite-field divisibility +criterion `n ∣ 2n`. -/ +def halfExtensionToEvenExtensionAlgHom : + FiniteField.Extension K p n →ₐ[K] + FiniteField.Extension K p (2 * n) := + (FiniteField.nonempty_algHom_of_finrank_dvd (by + rw [FiniteField.finrank_extension K p n, + FiniteField.finrank_extension K p (2 * n)] + exact ⟨2, by omega⟩)).some + +/-- The canonical degree-`2n` finite extension, viewed through the chosen +degree-`n` subfield, has relative degree two. -/ +theorem finrank_evenExtension_over_halfExtension : + let E := FiniteField.Extension K p n + let S := FiniteField.Extension K p (2 * n) + let ι : E →ₐ[K] S := halfExtensionToEvenExtensionAlgHom K p n + letI : Algebra E S := ι.toAlgebra + Module.finrank E S = 2 := by + classical + let E := FiniteField.Extension K p n + let S := FiniteField.Extension K p (2 * n) + let ι : E →ₐ[K] S := halfExtensionToEvenExtensionAlgHom K p n + letI : Algebra E S := ι.toAlgebra + letI : IsScalarTower K E S := IsScalarTower.of_algebraMap_eq' (by + ext c + exact (ι.commutes c).symm) + letI : Module.Finite E S := Module.Finite.of_finite + have hmul : Module.finrank K E * Module.finrank E S = + Module.finrank K S := Module.finrank_mul_finrank K E S + rw [FiniteField.finrank_extension K p n, + FiniteField.finrank_extension K p (2 * n)] at hmul + have hn : 0 < n := NeZero.pos n + apply Nat.eq_of_mul_eq_mul_left hn + calc + n * Module.finrank E S = 2 * n := hmul + _ = n * 2 := Nat.mul_comm 2 n + +/-- The automatic plane Stepanov estimate on the canonical even-degree +extension sequence. The main error term is exactly +`(2 * genusBudget + 1) * (#K)^n`; the final displayed term is the explicit +critical-locus bound coming from the supplied bidegree. + +This theorem is intentionally one-sided and should not be called a +Hasse--Weil theorem. -/ +theorem extensionAffinePointCount_two_mul_le_stepanov + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : Nat} + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hlarge : + (planeCurveBidegreeGenusBudget f + 1) * + (planeCurveBidegreeGenusBudget f + 2) ≤ + (Fintype.card K) ^ n) : + extensionAffinePointCount K p (2 * n) f ≤ + (Fintype.card K) ^ (2 * n) + + (2 * planeCurveBidegreeGenusBudget f + 1) * + (Fintype.card K) ^ n + + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by + classical + let E := FiniteField.Extension K p n + let S := FiniteField.Extension K p (2 * n) + let ι : E →ₐ[K] S := halfExtensionToEvenExtensionAlgHom K p n + letI : Algebra E S := ι.toAlgebra + letI : IsScalarTower K E S := IsScalarTower.of_algebraMap_eq' (by + ext c + exact (ι.commutes c).symm) + letI : Module.Finite E S := Module.Finite.of_finite + letI : Fintype E := Fintype.ofFinite E + letI : Fintype S := Fintype.ofFinite S + let fS : MvPolynomial (Fin 2) S := + extensionPlaneCurvePolynomial K p (2 * n) f + have hfinrank : Module.finrank E S = 2 := + finrank_evenExtension_over_halfExtension K p n + have hcardE : Fintype.card E = (Fintype.card K) ^ n := by + rw [Fintype.card_eq_nat_card, Fintype.card_eq_nat_card] + exact FiniteField.natCard_extension K p n + have hcardS : Fintype.card S = (Fintype.card E) ^ 2 := by + rw [Module.card_eq_pow_finrank (K := E), hfinrank] + have hcardSbase : Fintype.card S = (Fintype.card K) ^ (2 * n) := by + rw [Fintype.card_eq_nat_card, Fintype.card_eq_nat_card] + exact FiniteField.natCard_extension K p (2 * n) + have hfS : Irreducible fS := by + exact irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K S) f habsolute + have hpartialFirstS : MvPolynomial.pderiv 0 fS ≠ 0 := by + exact extensionPlaneCurvePolynomial_pderiv_ne_zero + K p (2 * n) f 0 hpartialFirst + have hpartialSecondS : MvPolynomial.pderiv 1 fS ≠ 0 := by + exact extensionPlaneCurvePolynomial_pderiv_ne_zero + K p (2 * n) f 1 hpartialSecond + have hdegreeS : BGS.External.HasBidegreeAtMost + fS firstDegree secondDegree := by + exact hasBidegreeAtMost_map_of_injective + (algebraMap K S) (algebraMap K S).injective hdegree + have hgenus : planeCurveBidegreeGenusBudget fS = + planeCurveBidegreeGenusBudget f := by + exact planeCurveBidegreeGenusBudget_map_of_injective + (algebraMap K S) (algebraMap K S).injective f + have hlargeS : + (planeCurveBidegreeGenusBudget fS + 1) * + (planeCurveBidegreeGenusBudget fS + 2) ≤ Fintype.card E := by + simpa only [hgenus, hcardE] using hlarge + have habsoluteS : Irreducible + (MvPolynomial.map (algebraMap S (AlgebraicClosure S)) fS) := by + exact extensionPlaneCurvePolynomial_absolutelyIrreducible + K p (2 * n) f habsolute + letI : IsDomain (PlaneCurveCoordinateRing fS) := + planeCurveCoordinateRing_isDomain hfS + let hx := firstCoordinate_transcendental hfS + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondS) + let L := PlaneCurveFunctionField fS + letI : Algebra (RatFunc S) L := + planeCurveFirstCoordinateRatFuncAlgebra fS hx + let canonicalAlg : Algebra S L := inferInstance + let constantAlg : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + have hconstantAlg : constantAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization S L _ _ canonicalAlg + (planeCurveFunction fS 0) hx) (RatFunc.C c) = + @algebraMap S L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + S L _ _ canonicalAlg (planeCurveFunction fS 0) hx) + (Polynomial.C c) + simpa using h + have hconstantsCanonical : + @algebraicClosure S L _ _ canonicalAlg = ⊥ := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + fS habsoluteS hpartialSecondS + have hconstants : + @algebraicClosure S L _ _ constantAlg = ⊥ := by + rw [hconstantAlg] + exact hconstantsCanonical + have hbound := planeCurve_affinePoint_card_le_squareField_bidegree + E S hdegreeS hfS hpartialFirstS hpartialSecondS hcardS hlargeS + dsimp only at hbound + specialize hbound hconstants + simpa only [extensionAffinePointCount, affineBivariatePointCount, + fS, hgenus, hcardE, hcardSbase, Fintype.card_eq_nat_card] using hbound + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean new file mode 100644 index 0000000000..70ae066675 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import Mathlib.FieldTheory.Finite.Extension +import Mathlib.Tactic + +/-! +# Affine point counts over canonical finite-field extensions + +For a finite field `K` of characteristic `p`, Mathlib provides a chosen +degree-`n` extension `FiniteField.Extension K p n`. This file base-changes a +bivariate polynomial to that field and counts its affine zeros. It also +records the cardinality of the extension, compatibility with degree one, and +the geometric hypotheses preserved by this base change. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +/-- Affine zeros of a bivariate polynomial, represented by ordered pairs. -/ +abbrev AffineBivariatePoint + {F : Type*} [CommRing F] (f : MvPolynomial (Fin 2) F) := + {z : F × F // MvPolynomial.eval ![z.1, z.2] f = 0} + +/-- The number of affine zeros of a bivariate polynomial over a finite +coefficient ring. -/ +def affineBivariatePointCount + {F : Type*} [CommRing F] [Finite F] + (f : MvPolynomial (Fin 2) F) : ℕ := + Nat.card (AffineBivariatePoint f) + +/-- Transport affine zeros along a coefficient-ring equivalence. -/ +def affineBivariatePointMapEquiv + {E F : Type*} [CommRing E] [CommRing F] + (e : E ≃+* F) (f : MvPolynomial (Fin 2) E) : + AffineBivariatePoint f ≃ + AffineBivariatePoint (MvPolynomial.map e.toRingHom f) := + Equiv.subtypeEquiv (e.toEquiv.prodCongr e.toEquiv) (fun z => by + have heval : + MvPolynomial.eval ![e z.1, e z.2] + (MvPolynomial.map e.toRingHom f) = + e (MvPolynomial.eval ![z.1, z.2] f) := by + have hcoordinates : + ![e z.1, e z.2] = e ∘ ![z.1, z.2] := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + exact (MvPolynomial.map_eval e.toRingHom ![z.1, z.2] f).symm + change MvPolynomial.eval ![z.1, z.2] f = 0 ↔ + MvPolynomial.eval ![e z.1, e z.2] + (MvPolynomial.map e.toRingHom f) = 0 + rw [heval, e.map_eq_zero_iff]) + +section Extension + +variable (K : Type*) [Field K] [Finite K] +variable (p n : ℕ) [Fact p.Prime] [CharP K p] [NeZero n] + +/-- The plane polynomial after extension of constants from `K` to the chosen +degree-`n` finite-field extension. -/ +def extensionPlaneCurvePolynomial + (f : MvPolynomial (Fin 2) K) : + MvPolynomial (Fin 2) (FiniteField.Extension K p n) := + MvPolynomial.map (algebraMap K (FiniteField.Extension K p n)) f + +/-- The number of affine zeros after extension of constants to degree `n`. -/ +def extensionAffinePointCount + (f : MvPolynomial (Fin 2) K) : ℕ := + affineBivariatePointCount (extensionPlaneCurvePolynomial K p n f) + +/-- The chosen degree-`n` extension has exactly `(#K)^n` elements. -/ +theorem extensionField_natCard : + Nat.card (FiniteField.Extension K p n) = Nat.card K ^ n := + FiniteField.natCard_extension K p n + +section DegreeOne + +omit [NeZero n] in +/-- The chosen degree-one extension is noncanonically equivalent to its base +field as a `K`-algebra. -/ +def extensionOneAlgEquiv : + FiniteField.Extension K p 1 ≃ₐ[K] K := + (FiniteField.algEquivExtension K p 1 K (by simp)).symm + +omit [NeZero n] in +/-- Affine zeros over the chosen degree-one extension correspond exactly to +affine zeros over the base field. -/ +def extensionOneAffinePointEquiv + (f : MvPolynomial (Fin 2) K) : + AffineBivariatePoint (extensionPlaneCurvePolynomial K p 1 f) ≃ + AffineBivariatePoint f := by + let e := extensionOneAlgEquiv K p + have hpoly : + MvPolynomial.map e.toRingHom + (extensionPlaneCurvePolynomial K p 1 f) = f := by + rw [extensionPlaneCurvePolynomial, MvPolynomial.map_map] + have hcomp : + e.toRingHom.comp + (algebraMap K (FiniteField.Extension K p 1)) = + RingHom.id K := by + ext c + simp [e, extensionOneAlgEquiv] + rw [hcomp, MvPolynomial.map_id] + simpa only [hpoly] using + affineBivariatePointMapEquiv e.toRingEquiv + (extensionPlaneCurvePolynomial K p 1 f) + +omit [NeZero n] in +/-- The degree-one extension point count is the original base-field point +count. -/ +@[simp] +theorem extensionAffinePointCount_one + (f : MvPolynomial (Fin 2) K) : + extensionAffinePointCount K p 1 f = + affineBivariatePointCount f := by + exact Nat.card_congr (extensionOneAffinePointEquiv K p f) + +end DegreeOne + +/-- Absolute irreducibility is preserved after passing to the chosen finite +extension. -/ +theorem extensionPlaneCurvePolynomial_absolutelyIrreducible + (f : MvPolynomial (Fin 2) K) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) : + Irreducible + (MvPolynomial.map + (algebraMap (FiniteField.Extension K p n) + (AlgebraicClosure (FiniteField.Extension K p n))) + (extensionPlaneCurvePolynomial K p n f)) := by + have h := irreducible_map_of_irreducible_map_algebraicClosure + ((algebraMap (FiniteField.Extension K p n) + (AlgebraicClosure (FiniteField.Extension K p n))).comp + (algebraMap K (FiniteField.Extension K p n))) f habsolute + simpa only [extensionPlaneCurvePolynomial, MvPolynomial.map_map] using h + +/-- Partial differentiation commutes with extension of constants. -/ +@[simp] +theorem extensionPlaneCurvePolynomial_pderiv + (f : MvPolynomial (Fin 2) K) (i : Fin 2) : + MvPolynomial.pderiv i (extensionPlaneCurvePolynomial K p n f) = + extensionPlaneCurvePolynomial K p n (MvPolynomial.pderiv i f) := by + rw [extensionPlaneCurvePolynomial, extensionPlaneCurvePolynomial, + MvPolynomial.pderiv_map] + +/-- A nonzero partial derivative remains nonzero after extension of +constants. -/ +theorem extensionPlaneCurvePolynomial_pderiv_ne_zero + (f : MvPolynomial (Fin 2) K) (i : Fin 2) + (hpartial : MvPolynomial.pderiv i f ≠ 0) : + MvPolynomial.pderiv i (extensionPlaneCurvePolynomial K p n f) ≠ 0 := by + rw [extensionPlaneCurvePolynomial_pderiv] + intro hz + apply hpartial + apply MvPolynomial.map_injective + (algebraMap K (FiniteField.Extension K p n)) + (algebraMap K (FiniteField.Extension K p n)).injective + rw [map_zero] + simpa only [extensionPlaneCurvePolynomial] using hz + +/-- The function field of the base-changed absolutely irreducible plane +curve has the chosen extension as its exact constant field. -/ +theorem extensionPlaneCurveFunctionField_algebraicClosure_eq_bot + (f : MvPolynomial (Fin 2) K) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let fE := MvPolynomial.map + (algebraMap K (FiniteField.Extension K p n)) f + let hfE := irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K (FiniteField.Extension K p n)) f habsolute + letI := planeCurveCoordinateRing_isDomain hfE + algebraicClosure (FiniteField.Extension K p n) + (PlaneCurveFunctionField fE) = ⊥ := + planeCurveBaseChangeFunctionField_algebraicClosure_eq_bot + (E := FiniteField.Extension K p n) f habsolute hpartialSecond + +end Extension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean new file mode 100644 index 0000000000..128fcfc8e2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas + +/-! +# Dimension growth in a one-point filtration + +This file isolates the reusable linear-algebra step in the one-point +filtration used in Stepanov-style arguments. If every element of a larger +subspace is congruent modulo the preceding subspace to a scalar multiple of +one pivot, then adjoining that pivot generates the larger subspace. Hence a +single filtration step increases dimension by at most one. +-/ + +namespace BGS.HasseWeil + +variable {K L : Type*} [Field K] [AddCommGroup L] [Module K L] + +/-- If every element of `T` is congruent modulo `S` to a scalar multiple of +`y`, then `T` is generated by `S` and `y`. -/ +theorem eq_sup_span_singleton_of_exists_sub_smul_mem + {S T : Submodule K L} {y : L} + (hST : S ≤ T) (hy : y ∈ T) + (hmod : ∀ x ∈ T, ∃ c : K, x - c • y ∈ S) : + T = S ⊔ K ∙ y := by + apply le_antisymm + · intro x hx + obtain ⟨c, hc⟩ := hmod x hx + rw [← sub_add_cancel x (c • y)] + exact (S ⊔ K ∙ y).add_mem + ((show S ≤ S ⊔ K ∙ y from le_sup_left) hc) + ((show K ∙ y ≤ S ⊔ K ∙ y from le_sup_right) + (Submodule.smul_mem _ c (Submodule.mem_span_singleton_self y))) + · exact sup_le hST ((Submodule.span_singleton_le_iff_mem y T).mpr hy) + +/-- A one-pivot extension of a finite-dimensional subspace is again +finite-dimensional. -/ +theorem moduleFinite_of_exists_sub_smul_mem + {S T : Submodule K L} {y : L} + (hST : S ≤ T) (hy : y ∈ T) + (hmod : ∀ x ∈ T, ∃ c : K, x - c • y ∈ S) + [Module.Finite K S] : + Module.Finite K T := by + rw [eq_sup_span_singleton_of_exists_sub_smul_mem hST hy hmod] + infer_instance + +/-- A one-pivot extension increases finrank by at most one. -/ +theorem finrank_le_add_one_of_exists_sub_smul_mem + {S T : Submodule K L} {y : L} + (hST : S ≤ T) (hy : y ∈ T) + (hmod : ∀ x ∈ T, ∃ c : K, x - c • y ∈ S) + [Module.Finite K S] : + Module.finrank K T ≤ Module.finrank K S + 1 := by + have hspan : Module.finrank K (K ∙ y) ≤ 1 := by + classical + simpa using (finrank_span_le_card (R := K) ({y} : Set L)) + rw [eq_sup_span_singleton_of_exists_sub_smul_mem hST hy hmod] + exact (Submodule.finrank_add_le_finrank_add_finrank S (K ∙ y)).trans + (Nat.add_le_add_left hspan (Module.finrank K S)) + +/-- Along a nested filtration whose successive quotients are generated by one +pivot, every stage is finite-dimensional and stage `n` has finrank at most +the initial finrank plus `n`. -/ +theorem onePointFiltration_moduleFinite_and_finrank_le + (R : ℕ → Submodule K L) (y : ℕ → L) + (hnested : ∀ n, R n ≤ R (n + 1)) + (hpivot : ∀ n, y n ∈ R (n + 1)) + (hmod : ∀ n x, x ∈ R (n + 1) → + ∃ c : K, x - c • y n ∈ R n) + [Module.Finite K (R 0)] : + ∀ n, Module.Finite K (R n) ∧ + Module.finrank K (R n) ≤ Module.finrank K (R 0) + n := by + intro n + induction n with + | zero => + exact ⟨inferInstance, by simp⟩ + | succ n ih => + letI : Module.Finite K (R n) := ih.1 + have hfinite : Module.Finite K (R (n + 1)) := + moduleFinite_of_exists_sub_smul_mem + (hnested n) (hpivot n) (hmod n) + letI : Module.Finite K (R (n + 1)) := hfinite + refine ⟨hfinite, ?_⟩ + calc + Module.finrank K (R (n + 1)) ≤ Module.finrank K (R n) + 1 := + finrank_le_add_one_of_exists_sub_smul_mem + (hnested n) (hpivot n) (hmod n) + _ ≤ (Module.finrank K (R 0) + n) + 1 := + Nat.add_le_add_right ih.2 1 + _ = Module.finrank K (R 0) + (n + 1) := by + rw [Nat.add_assoc] + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean new file mode 100644 index 0000000000..0de6c4b078 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean @@ -0,0 +1,402 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower + +/-! +# Finiteness of the branch locus + +For a finite separable extension of Dedekind domains, a height-one prime is +ramified exactly when it divides the different. The different is nonzero and +has finite prime support, so both the ramification locus upstairs and its image +in the base are finite. This is the algebraic branch-locus finiteness used for +finite separable morphisms of curves. + +The final theorems attach to every exhaustive closed place its residue-degree +weight over the constant field. The branch support is finite, and the +degree-weighted sum over any selected part of it is at most the full branch +sum. Passing from this closed-place bound to a uniform count of geometric +branch points after constant-field extension still requires an explicit +closed-place/geometric-point comparison. +-/ + +open scoped BigOperators +open IsDedekindDomain + +namespace BGS.HasseWeil + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +section Dedekind + +variable (A B : Type*) [CommRing A] [CommRing B] + [IsDedekindDomain A] [IsDedekindDomain B] + [Algebra A B] + [Module.Finite A B] [Module.IsTorsionFree A B] + [Algebra.IsSeparable (FractionRing A) (FractionRing B)] + +/-- The height-one primes upstairs at which a finite separable Dedekind +extension is ramified. -/ +def dedekindRamificationLocus : Set (HeightOneSpectrum B) := + {Q | ¬ Algebra.IsUnramifiedAt A Q.asIdeal} + +/-- The ramification locus is contained in the finite support of the +different, and is therefore finite. -/ +theorem dedekindRamificationLocus_finite : + (dedekindRamificationLocus A B).Finite := by + let hDifferent : differentIdeal A B ≠ ⊥ := differentIdeal_ne_bot + let D := BGS.CorvajaZannier.differentMultiplicityDivisor A B hDifferent + refine D.support.finite_toSet.subset ?_ + intro Q hQ + rw [Finset.mem_coe, Finsupp.mem_support_iff] + have hdiv : Q.asIdeal ∣ differentIdeal A B := + dvd_differentIdeal_iff.mpr hQ + simpa [D, BGS.CorvajaZannier.differentMultiplicityDivisor_apply] using + (multiplicity_pos_of_dvd hdiv).ne' + +/-- The branch locus downstairs is the image of the ramification locus under +contraction of height-one primes. -/ +def dedekindBranchLocus : Set (HeightOneSpectrum A) := + HeightOneSpectrum.under A '' dedekindRamificationLocus A B + +/-- The branch locus of a finite separable Dedekind extension is finite. -/ +theorem dedekindBranchLocus_finite : + (dedekindBranchLocus A B).Finite := by + exact (dedekindRamificationLocus_finite A B).image + (HeightOneSpectrum.under A) + +/-- Any distinguished subset of the closed-place branch locus has cardinality +at most the full closed-place branch locus. -/ +theorem dedekindBranchLocus_selected_ncard_le + (isSelected : HeightOneSpectrum A → Prop) : + (dedekindBranchLocus A B ∩ {P | isSelected P}).ncard ≤ + (dedekindBranchLocus A B).ncard := by + exact Set.ncard_le_ncard Set.inter_subset_left + (dedekindBranchLocus_finite A B) + +end Dedekind + +section FunctionField + +open BGS.CorvajaZannier Polynomial + +variable (K : Type*) [Field K] [DecidableEq (RatFunc K)] +variable (M : Type*) [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra M L] [IsScalarTower (RatFunc K) M L] + +local instance (priority := 10) branchPolynomialAlgebraM : Algebra K[X] M := + RingHom.toAlgebra ((algebraMap (RatFunc K) M).comp + (algebraMap K[X] (RatFunc K))) + +local instance (priority := 10) branchPolynomialAlgebraL : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance branchPolynomialTowerM : IsScalarTower K[X] (RatFunc K) M := + IsScalarTower.of_algebraMap_eq' rfl + +local instance branchPolynomialTowerL : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance branchPolynomialFieldTower : IsScalarTower K[X] M L := + IsScalarTower.of_algebraMap_eq fun x => by + change algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) x) = + algebraMap M L + (algebraMap (RatFunc K) M (algebraMap K[X] (RatFunc K) x)) + exact IsScalarTower.algebraMap_apply (RatFunc K) M L _ + +local instance branchFiniteClosureAlgebra : + Algebra (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + (finiteIntegralClosureMap K M L).toAlgebra + +local instance branchFiniteIntermediateIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isIntegral_algebra K[X] M + +local instance branchFiniteTopIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance branchFiniteIntermediateModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K M) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K M) + +local instance branchFiniteTopModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance branchFiniteIntermediateTorsionFree : + Module.IsTorsionFree K[X] M := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) M + +local instance branchFiniteTopTorsionFree : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance branchFiniteIntermediateClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isTorsionFree K[X] M + +local instance branchFiniteTopClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance branchFiniteIntermediateDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) M + (RatFuncFiniteIntegralClosure K M) + +local instance branchFiniteTopDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance branchFiniteClosuresTower : + IsScalarTower K[X] (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq fun _ => by + apply Subtype.ext + change algebraMap K[X] L _ = algebraMap M L (algebraMap K[X] M _) + exact IsScalarTower.algebraMap_apply K[X] M L _ + +local instance branchFiniteRelativeIntegral : + Algebra.IsIntegral (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + Algebra.IsIntegral.tower_top K[X] + +local instance branchFiniteRelativeFaithful : + FaithfulSMul (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + apply Subtype.ext + apply (algebraMap M L).injective + exact congrArg Subtype.val hxy + +local instance branchFiniteRelativeModuleFinite : + Module.Finite (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + Module.Finite.of_restrictScalars_finite K[X] + (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) + +local instance branchFiniteIntermediateClosureFieldTower : + IsScalarTower (RatFuncFiniteIntegralClosure K M) M L := + inferInstance + +local instance branchFiniteTopClosureFieldTower : + IsScalarTower (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) L := + ⟨fun r s x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap (RatFuncFiniteIntegralClosure K L) L + (algebraMap (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) r) = + algebraMap (RatFuncFiniteIntegralClosure K M) L r by rfl] + ring⟩ + +local instance branchFiniteIntermediateFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K M) M := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) M (RatFuncFiniteIntegralClosure K M) + +local instance branchFiniteTopFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) + +local instance branchFiniteFractionRingSeparable : + Algebra.IsSeparable + (FractionRing (RatFuncFiniteIntegralClosure K M)) + (FractionRing (RatFuncFiniteIntegralClosure K L)) := by + letI : Algebra.IsSeparable M L := + Algebra.isSeparable_tower_top_of_isSeparable (RatFunc K) M L + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv (RatFuncFiniteIntegralClosure K M) M).symm.toRingEquiv + (FractionRing.algEquiv (RatFuncFiniteIntegralClosure K L) L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv (RatFuncFiniteIntegralClosure K M) M).symm + (FractionRing.algEquiv (RatFuncFiniteIntegralClosure K L) L).symm z + +local instance branchInfinityClosureAlgebra : + Algebra (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + (infinityIntegralClosureMap K M L).toAlgebra + +local instance branchInfinityIntermediateIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) M + +local instance branchInfinityIntermediateModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) M + (RatFuncInfinityIntegralClosure K M) + +local instance branchInfinityIntermediateDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) M (RatFuncInfinityIntegralClosure K M) + +local instance branchInfinityPlaceFintype : + Fintype (FiniteExtensionInfinityPlace K M) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K M)) + +/-- The exhaustive branch locus of the finite separable function-field tower +`L / M / K(t)`. The finite chart is the contraction of the different support; +the infinity chart records the base infinity places admitting a ramified lift. +-/ +def finiteExtensionBranchLocus : Set (FiniteExtensionPlace K M) := + Sum.inl '' dedekindBranchLocus + (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) ∪ + Sum.inr '' {P : FiniteExtensionInfinityPlace K M | + ∃ Q : FiniteExtensionInfinityPlace K L, + infinityPlaceUnder K M L Q = P ∧ + ¬ Algebra.IsUnramifiedAt + (RatFuncInfinityIntegralClosure K M) Q.1} + +/-- The exhaustive branch locus of a finite separable function-field +extension is finite. -/ +theorem finiteExtensionBranchLocus_finite : + (finiteExtensionBranchLocus K M L).Finite := by + apply Set.Finite.union + · exact (dedekindBranchLocus_finite + (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L)).image Sum.inl + · exact (Set.toFinite _).image Sum.inr + +section DegreeWeight + +variable [DecidableEq K] + +/-- The nonnegative weight of an exhaustive closed place is its degree over +the constant field `K`. On the finite chart this is the relative residue +degree times the degree of the contracted polynomial place; above infinity it +is the relative residue degree, since the base infinity place has degree one. +-/ +def finiteExtensionClosedPlaceWeight + (P : FiniteExtensionPlace K M) : ℕ := + finiteExtensionPlaceDegree K M P + +omit [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] in +@[simp] +theorem finiteExtensionClosedPlaceWeight_inl + (P : FiniteExtensionFinitePlace K M) : + finiteExtensionClosedPlaceWeight K M (.inl P) = + P.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] P) := by + rfl + +omit [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] in +@[simp] +theorem finiteExtensionClosedPlaceWeight_inr + (P : FiniteExtensionInfinityPlace K M) : + finiteExtensionClosedPlaceWeight K M (.inr P) = + P.1.inertiaDeg (RatFuncInfinityIntegers K) := by + rfl + +/-- The finite support on which the branch-locus degree sum is taken. -/ +def finiteExtensionBranchLocusSupport : + Finset (FiniteExtensionPlace K M) := + (finiteExtensionBranchLocus_finite K M L).toFinset + +omit [DecidableEq K] in +@[simp] +theorem mem_finiteExtensionBranchLocusSupport_iff + (P : FiniteExtensionPlace K M) : + P ∈ finiteExtensionBranchLocusSupport K M L ↔ + P ∈ finiteExtensionBranchLocus K M L := by + simp [finiteExtensionBranchLocusSupport] + +/-- The support finset represents exactly the finite branch locus. -/ +theorem finiteExtensionBranchLocusSupport_coe : + (finiteExtensionBranchLocusSupport K M L : + Set (FiniteExtensionPlace K M)) = + finiteExtensionBranchLocus K M L := by + ext P + simp + +/-- In set form, the exact branch support is finite. -/ +theorem finiteExtensionBranchLocusSupport_finite : + ((finiteExtensionBranchLocusSupport K M L : + Finset (FiniteExtensionPlace K M)) : + Set (FiniteExtensionPlace K M)).Finite := + Finset.finite_toSet _ + +/-- The total residue-degree weight of the exhaustive branch locus. -/ +def finiteExtensionBranchLocusDegreeSum : ℕ := + ∑ P ∈ finiteExtensionBranchLocusSupport K M L, + finiteExtensionClosedPlaceWeight K M P + +/-- The finite branch support restricted by an arbitrary predicate. -/ +def finiteExtensionBranchLocusSelectedSupport + (isSelected : FiniteExtensionPlace K M → Prop) : + Finset (FiniteExtensionPlace K M) := by + classical + exact (finiteExtensionBranchLocusSupport K M L).filter isSelected + +@[simp] +theorem mem_finiteExtensionBranchLocusSelectedSupport_iff + (isSelected : FiniteExtensionPlace K M → Prop) + (P : FiniteExtensionPlace K M) : + P ∈ finiteExtensionBranchLocusSelectedSupport K M L isSelected ↔ + P ∈ finiteExtensionBranchLocus K M L ∧ isSelected P := by + classical + simp [finiteExtensionBranchLocusSelectedSupport] + +/-- The residue-degree weight of a selected part of the finite branch +support. -/ +def finiteExtensionBranchLocusSelectedDegreeSum + (isSelected : FiniteExtensionPlace K M → Prop) : ℕ := + ∑ P ∈ finiteExtensionBranchLocusSelectedSupport K M L isSelected, + finiteExtensionClosedPlaceWeight K M P + +/-- Every selected part of the branch locus has residue-degree weight at most +the total residue-degree weight of the full finite branch support. -/ +theorem finiteExtensionBranchLocus_selected_degreeSum_le + (isSelected : FiniteExtensionPlace K M → Prop) : + finiteExtensionBranchLocusSelectedDegreeSum K M L isSelected ≤ + finiteExtensionBranchLocusDegreeSum K M L := by + classical + rw [finiteExtensionBranchLocusSelectedDegreeSum, + finiteExtensionBranchLocusDegreeSum, + finiteExtensionBranchLocusSelectedSupport] + exact Finset.sum_le_sum_of_subset (Finset.filter_subset _ _) + +end DegreeWeight + +/-- Any distinguished subset of the exhaustive closed-place branch locus has +cardinality at most the full closed-place branch locus. -/ +theorem finiteExtensionBranchLocus_selected_ncard_le + (isSelected : FiniteExtensionPlace K M → Prop) : + (finiteExtensionBranchLocus K M L ∩ {P | isSelected P}).ncard ≤ + (finiteExtensionBranchLocus K M L).ncard := by + exact Set.ncard_le_ncard Set.inter_subset_left + (finiteExtensionBranchLocus_finite K M L) + +end FunctionField + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean new file mode 100644 index 0000000000..1e814dc83a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +import Mathlib.NumberTheory.ClassNumber.FunctionField +import Mathlib.RingTheory.Ideal.Quotient.HasFiniteQuotients + +/-! +# Affine ideal degrees in a finite function field + +The finite class group of the normalization of `K[X]` controls ideal classes, +but an affine ideal zeta series also needs finite coefficient sets. This file +provides that missing finiteness layer for a finite separable extension of +`K(X)` over a finite field `K`. + +First, every nonzero quotient of `K[X]` is finite: a nonzero ideal contains a +monic polynomial up to multiplication by a unit, and its quotient maps onto +the original quotient. Module finiteness transfers this property to the +normalization of `K[X]` in the function field. For a nonzero ideal `I`, its +affine degree is then the `K`-dimension of the quotient by `I`. Consequently + +`cardQuot I = |K| ^ degree(I)`, + +and Mathlib's bounded-quotient-cardinality theorem makes the ideals of each +fixed degree into a finite type. No Riemann--Roch or Hasse--Weil input is used. +-/ + +open scoped Polynomial nonZeroDivisors + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [Fintype K] + +/-- The polynomial ring over a finite field has finite quotients. -/ +theorem ratFuncPolynomial_hasFiniteQuotients : + Ring.HasFiniteQuotients K[X] := by + constructor + intro I hI + obtain ⟨f, hfI, hf0⟩ := Submodule.exists_mem_ne_zero_of_ne_bot hI + let g : K[X] := f * Polynomial.C f.leadingCoeff⁻¹ + have hgmonic : g.Monic := Polynomial.monic_mul_leadingCoeff_inv hf0 + have hgI : g ∈ I := by + exact I.mul_mem_right (Polynomial.C f.leadingCoeff⁻¹) hfI + have hspan : Ideal.span ({g} : Set K[X]) ≤ I := by + rw [Ideal.span_le, Set.singleton_subset_iff] + exact hgI + letI : Module.Finite K (K[X] ⧸ Ideal.span ({g} : Set K[X])) := + hgmonic.finite_quotient + letI : Finite (K[X] ⧸ Ideal.span ({g} : Set K[X])) := + Module.finite_of_finite K + exact Finite.of_surjective (Ideal.Quotient.factor hspan) + (Ideal.Quotient.factor_surjective hspan) + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) affineIdealPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance affineIdealPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance affineIdealClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance affineIdealClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance affineIdealClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The normalization of `K[X]` in a finite separable extension of `K(X)` has +finite quotients. -/ +theorem ratFuncFiniteIntegralClosure_hasFiniteQuotients : + Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := by + letI : Ring.HasFiniteQuotients K[X] := + ratFuncPolynomial_hasFiniteQuotients K + exact Ring.HasFiniteQuotients.of_module_finite K[X] + (RatFuncFiniteIntegralClosure K L) + +/-- The affine ideal class group is finite. This is the function-field class +number theorem from Mathlib, stated at the normalization used by BGS. -/ +theorem finiteExtensionAffineClassGroup_finite : + Finite (ClassGroup (RatFuncFiniteIntegralClosure K L)) := by + letI : Fintype (ClassGroup (RatFuncFiniteIntegralClosure K L)) := + inferInstance + exact Fintype.finite inferInstance + +/-- Nonzero affine ideals in the normalization of `K[X]` in `L`. -/ +abbrev FiniteExtensionAffineIdeal := + (Ideal (RatFuncFiniteIntegralClosure K L))⁰ + +/-- The degree of a nonzero affine ideal is the `K`-dimension of its quotient. -/ +def finiteExtensionAffineIdealDegree + (I : FiniteExtensionAffineIdeal K L) : ℕ := by + letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + ratFuncFiniteIntegralClosure_hasFiniteQuotients K L + have hI : (I : Ideal (RatFuncFiniteIntegralClosure K L)) ≠ ⊥ := by + rw [← Ideal.zero_eq_bot] + exact mem_nonZeroDivisors_iff_ne_zero.mp I.property + letI : Finite (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) := + Ring.HasFiniteQuotients.finiteQuotient hI + letI : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) := + Module.Finite.of_finite + exact Module.finrank K (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) + +/-- Quotient cardinality is the cardinality of the constant field raised to +the affine ideal degree. -/ +theorem finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree + (I : FiniteExtensionAffineIdeal K L) : + (I : Ideal (RatFuncFiniteIntegralClosure K L)).cardQuot = + Fintype.card K ^ finiteExtensionAffineIdealDegree K L I := by + letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + ratFuncFiniteIntegralClosure_hasFiniteQuotients K L + have hI : (I : Ideal (RatFuncFiniteIntegralClosure K L)) ≠ ⊥ := by + rw [← Ideal.zero_eq_bot] + exact mem_nonZeroDivisors_iff_ne_zero.mp I.property + letI : Finite (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) := + Ring.HasFiniteQuotients.finiteQuotient hI + letI : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) := + Module.Finite.of_finite + rw [Submodule.cardQuot_apply, finiteExtensionAffineIdealDegree, + ← Nat.card_eq_fintype_card] + exact Module.natCard_eq_pow_finrank + +/-- An affine ideal has degree zero exactly when it is the unit ideal. -/ +theorem finiteExtensionAffineIdealDegree_eq_zero_iff + (I : FiniteExtensionAffineIdeal K L) : + finiteExtensionAffineIdealDegree K L I = 0 ↔ + (I : Ideal (RatFuncFiniteIntegralClosure K L)) = ⊤ := by + constructor + · intro hdegree + apply Submodule.cardQuot_eq_one_iff.mp + rw [finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree K L I, + hdegree, pow_zero] + · intro hI + letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + ratFuncFiniteIntegralClosure_hasFiniteQuotients K L + have hne : (I : Ideal (RatFuncFiniteIntegralClosure K L)) ≠ ⊥ := by + rw [← Ideal.zero_eq_bot] + exact mem_nonZeroDivisors_iff_ne_zero.mp I.property + letI : Finite (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) := + Ring.HasFiniteQuotients.finiteQuotient hne + letI : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ + (I : Ideal (RatFuncFiniteIntegralClosure K L))) := + Module.Finite.of_finite + rw [finiteExtensionAffineIdealDegree, hI] + exact Module.finrank_zero_of_subsingleton + +/-- There are only finitely many nonzero affine ideals of any prescribed +degree. -/ +theorem finite_setOf_finiteExtensionAffineIdealDegree_eq (n : ℕ) : + {I : FiniteExtensionAffineIdeal K L | + finiteExtensionAffineIdealDegree K L I = n}.Finite := by + letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + ratFuncFiniteIntegralClosure_hasFiniteQuotients K L + apply Set.Finite.of_injOn + (f := fun I : FiniteExtensionAffineIdeal K L => + (I : Ideal (RatFuncFiniteIntegralClosure K L))) + (t := {J : Ideal (RatFuncFiniteIntegralClosure K L) | + J.cardQuot ≤ Fintype.card K ^ n}) + · intro I hI + simp only [Set.mem_setOf_eq] at hI ⊢ + rw [finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree K L I, hI] + · intro I _ J _ hIJ + exact Subtype.ext hIJ + · exact Ring.HasFiniteQuotients.finite_cardQuot_le _ + +/-- A finite indexing type for nonzero affine ideals of degree `n`. -/ +noncomputable instance finiteExtensionAffineIdealsOfDegree_fintype (n : ℕ) : + Fintype {I : FiniteExtensionAffineIdeal K L // + finiteExtensionAffineIdealDegree K L I = n} := + (finite_setOf_finiteExtensionAffineIdealDegree_eq K L n).fintype + +/-- The number of nonzero affine ideals of degree `n`; this is the natural +coefficient sequence for the affine ideal zeta series. -/ +noncomputable def finiteExtensionAffineIdealCount (n : ℕ) : ℕ := + Fintype.card {I : FiniteExtensionAffineIdeal K L // + finiteExtensionAffineIdealDegree K L I = n} + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean new file mode 100644 index 0000000000..4c05a6ab41 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean @@ -0,0 +1,480 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor + +/-! +# Nonzero affine ideals as effective finite divisors + +In a Dedekind domain, a nonzero ideal is uniquely determined by the +multiplicity of every height-one prime in its factorization. This file +packages that factorization as an equivalence between nonzero ideals and +effective, finitely supported divisors. + +Specializing to the normalization of `K[X]` in a finite separable extension +of `K(X)` identifies nonzero affine ideals with effective divisors on the +finite places of the function field. The equivalence is purely Dedekind +factorization: it does not use Riemann--Roch or a zeta-function argument. +-/ + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +section DedekindDomain + +variable {R : Type*} [CommRing R] [IsDedekindDomain R] + +/-- The ideal represented by an effective divisor on the height-one primes of +a Dedekind domain. -/ +def effectiveDivisorIdeal (D : HeightOneSpectrum R →₀ ℕ) : Ideal R := + D.prod fun v e => v.asIdeal ^ e + +@[simp] +theorem effectiveDivisorIdeal_zero : + effectiveDivisorIdeal (0 : HeightOneSpectrum R →₀ ℕ) = ⊤ := by + simp [effectiveDivisorIdeal] + +@[simp] +theorem effectiveDivisorIdeal_single + (v : HeightOneSpectrum R) (e : ℕ) : + effectiveDivisorIdeal (Finsupp.single v e) = v.asIdeal ^ e := by + classical + simp [effectiveDivisorIdeal, Finsupp.prod_single_index] + +theorem effectiveDivisorIdeal_add + (D E : HeightOneSpectrum R →₀ ℕ) : + effectiveDivisorIdeal (D + E) = + effectiveDivisorIdeal D * effectiveDivisorIdeal E := by + classical + unfold effectiveDivisorIdeal + apply Finsupp.prod_add_index + · intro v _ + exact pow_zero v.asIdeal + · intro v _ a b + exact pow_add v.asIdeal a b + +/-- A height-one prime outside the support of an effective divisor is +coprime to the ideal represented by that divisor. -/ +theorem isCoprime_effectiveDivisorIdeal_of_not_mem_support + (v : HeightOneSpectrum R) (D : HeightOneSpectrum R →₀ ℕ) + (hv : v ∉ D.support) : IsCoprime v.asIdeal (effectiveDivisorIdeal D) := by + classical + induction D using Finsupp.induction with + | zero => + rw [effectiveDivisorIdeal_zero, ← Ideal.one_eq_top] + exact isCoprime_one_right + | single_add a b E ha hb ih => + rw [effectiveDivisorIdeal_add, effectiveDivisorIdeal_single] + apply IsCoprime.mul_right + · have hva : v ≠ a := by + intro hva + apply hv + rw [Finsupp.support_single_add ha hb] + simp [hva] + exact (HeightOneSpectrum.isCoprime_of_ne v a hva).pow_right + · apply ih + intro hvE + apply hv + rw [Finsupp.support_single_add ha hb] + simp [hvE] + +/-- The quotient cardinality of the ideal represented by an effective divisor +is the product of the quotient cardinalities of its prime powers. -/ +theorem cardQuot_effectiveDivisorIdeal_eq_prod + (D : HeightOneSpectrum R →₀ ℕ) : + (effectiveDivisorIdeal D).cardQuot = + D.prod fun v e => v.asIdeal.cardQuot ^ e := by + classical + induction D using Finsupp.induction with + | zero => simp + | single_add a b E ha hb ih => + calc + (effectiveDivisorIdeal (Finsupp.single a b + E)).cardQuot = + (a.asIdeal ^ b).cardQuot * + (effectiveDivisorIdeal E).cardQuot := by + rw [effectiveDivisorIdeal_add, effectiveDivisorIdeal_single, + cardQuot_mul_of_coprime + ((isCoprime_effectiveDivisorIdeal_of_not_mem_support + a E ha).pow_left)] + _ = (a.asIdeal ^ b).cardQuot * + E.prod (fun v e => v.asIdeal.cardQuot ^ e) := by rw [ih] + _ = a.asIdeal.cardQuot ^ b * + E.prod (fun v e => v.asIdeal.cardQuot ^ e) := by + rw [cardQuot_pow_of_prime a.ne_bot] + _ = (Finsupp.single a b).prod + (fun v e => v.asIdeal.cardQuot ^ e) * + E.prod (fun v e => v.asIdeal.cardQuot ^ e) := by + rw [Finsupp.prod_single_index] + simp + _ = (Finsupp.single a b + E).prod + (fun v e => v.asIdeal.cardQuot ^ e) := by + symm + apply Finsupp.prod_add_index + · intro v _ + simp + · intro v _ m n + exact pow_add v.asIdeal.cardQuot m n + +/-- A product of powers of height-one primes is a nonzero ideal. -/ +theorem effectiveDivisorIdeal_ne_bot (D : HeightOneSpectrum R →₀ ℕ) : + effectiveDivisorIdeal D ≠ ⊥ := by + rw [effectiveDivisorIdeal, ← Ideal.zero_eq_bot, + Finsupp.prod_ne_zero_iff] + intro v _ + exact pow_ne_zero _ v.ne_bot + +/-- Reconstructing a nonzero ideal from its prime multiplicities returns the +original ideal. -/ +theorem effectiveDivisorIdeal_idealMultiplicityDivisor + (I : Ideal R) (hI : I ≠ ⊥) : + effectiveDivisorIdeal + (BGS.CorvajaZannier.idealMultiplicityDivisor I hI) = I := by + change + (BGS.CorvajaZannier.idealMultiplicityDivisor I hI).prod + (fun v e => v.asIdeal ^ e) = I + calc + _ = ∏ᶠ v : HeightOneSpectrum R, + v.asIdeal ^ multiplicity v.asIdeal I := by + apply (finprod_eq_prod_of_mulSupport_subset + (fun v : HeightOneSpectrum R => + v.asIdeal ^ multiplicity v.asIdeal I) + (s := (BGS.CorvajaZannier.idealMultiplicityDivisor I hI).support) + ?_).symm + intro v hv + simp only [Function.mem_mulSupport, ne_eq] at hv + apply Finsupp.mem_support_iff.mpr + rw [BGS.CorvajaZannier.idealMultiplicityDivisor_apply] + exact fun hzero => hv (by simp [hzero]) + _ = I := Ideal.finprod_heightOneSpectrum_pow_multiplicity hI + +/-- The multiplicity of a prime in the ideal represented by an effective +divisor is its coefficient in that divisor. -/ +theorem multiplicity_effectiveDivisorIdeal + (D : HeightOneSpectrum R →₀ ℕ) (v : HeightOneSpectrum R) : + multiplicity v.asIdeal (effectiveDivisorIdeal D) = D v := by + let DInt : HeightOneSpectrum R →₀ ℤ := + D.mapRange (fun n : ℕ => (n : ℤ)) (by simp) + let F := FractionalIdeal R⁰ (FractionRing R) + have hcoe : + ((effectiveDivisorIdeal D : Ideal R) : F) = + D.prod (fun w e => (w.asIdeal : F) ^ e) := by + change + (FractionalIdeal.coeIdealHom R⁰ (FractionRing R)) + (D.prod fun w e => w.asIdeal ^ e) = _ + rw [map_finsuppProd] + apply Finsupp.prod_congr + intro w _ + exact FractionalIdeal.coeIdeal_pow R⁰ (FractionRing R) w.asIdeal (D w) + have hcast : + DInt.prod (fun w e => (w.asIdeal : F) ^ e) = + D.prod (fun w e => (w.asIdeal : F) ^ e) := by + dsimp [DInt] + rw [Finsupp.prod_mapRange_index] + · apply Finsupp.prod_congr + intro w _ + exact zpow_natCast (w.asIdeal : F) (D w) + · intro w + exact zpow_zero (w.asIdeal : F) + have hcount := FractionalIdeal.count_finsuppProd + (FractionRing R) v DInt + rw [hcast, ← hcoe, + FractionalIdeal.count_coe (FractionRing R) v + (effectiveDivisorIdeal_ne_bot D)] at hcount + rw [Ideal.count_associates_factors_eq + (effectiveDivisorIdeal_ne_bot D) v.isPrime v.ne_bot, + IsDedekindDomain.HeightOneSpectrum.count_normalizedFactors_eq_multiplicity + (effectiveDivisorIdeal_ne_bot D), Finsupp.mapRange_apply] at hcount + exact Int.ofNat_injective hcount + +/-- Taking prime multiplicities after constructing the ideal represented by +an effective divisor recovers the divisor. -/ +theorem idealMultiplicityDivisor_effectiveDivisorIdeal + (D : HeightOneSpectrum R →₀ ℕ) : + BGS.CorvajaZannier.idealMultiplicityDivisor + (effectiveDivisorIdeal D) (effectiveDivisorIdeal_ne_bot D) = D := by + ext v + rw [BGS.CorvajaZannier.idealMultiplicityDivisor_apply, + multiplicity_effectiveDivisorIdeal] + +/-- A nonzero ideal, regarded as an element of the non-zero-divisors +submonoid, is not the bottom ideal. -/ +theorem nonzeroIdeal_ne_bot (I : (Ideal R)⁰) : (I : Ideal R) ≠ ⊥ := by + rw [← Ideal.zero_eq_bot] + exact mem_nonZeroDivisors_iff_ne_zero.mp I.property + +/-- Dedekind factorization as an equivalence between nonzero ideals and +effective finitely supported divisors on height-one primes. -/ +def nonzeroIdealEffectiveDivisorEquiv : + (Ideal R)⁰ ≃ (HeightOneSpectrum R →₀ ℕ) where + toFun I := BGS.CorvajaZannier.idealMultiplicityDivisor + (I : Ideal R) (nonzeroIdeal_ne_bot I) + invFun D := ⟨effectiveDivisorIdeal D, by + apply mem_nonZeroDivisors_iff_ne_zero.mpr + simpa only [Ideal.zero_eq_bot] using effectiveDivisorIdeal_ne_bot D⟩ + left_inv I := by + apply Subtype.ext + exact effectiveDivisorIdeal_idealMultiplicityDivisor + (I : Ideal R) (nonzeroIdeal_ne_bot I) + right_inv D := idealMultiplicityDivisor_effectiveDivisorIdeal D + +@[simp] +theorem nonzeroIdealEffectiveDivisorEquiv_apply + (I : (Ideal R)⁰) (v : HeightOneSpectrum R) : + nonzeroIdealEffectiveDivisorEquiv I v = + multiplicity v.asIdeal (I : Ideal R) := by + simp [nonzeroIdealEffectiveDivisorEquiv, + BGS.CorvajaZannier.idealMultiplicityDivisor_apply] + +@[simp] +theorem nonzeroIdealEffectiveDivisorEquiv_symm_coe + (D : HeightOneSpectrum R →₀ ℕ) : + ((nonzeroIdealEffectiveDivisorEquiv.symm D : (Ideal R)⁰) : Ideal R) = + effectiveDivisorIdeal D := rfl + +end DedekindDomain + +section FunctionField + +variable (K : Type*) [Field K] [Fintype K] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) affineDivisorPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance affineDivisorPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance affineDivisorFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance affineDivisorFiniteClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp + (algebraMap K K[X])) + +local instance affineDivisorFiniteClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance affineDivisorFiniteClosureIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance affineDivisorPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance affineDivisorFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance affineDivisorFiniteClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +/-- The degree of an effective finite divisor is the sum of its +multiplicities weighted by the dimensions of the residue fields over the +constant field. -/ +def finiteExtensionEffectiveFiniteDivisorDegree + (D : FiniteExtensionFinitePlace K L →₀ ℕ) : ℕ := + D.sum fun v e => e * Module.finrank K v.asIdeal.ResidueField + +/-- The quotient cardinality of a finite-place prime is the cardinality of +the constant field raised to the residue-field degree. -/ +theorem finiteExtensionFinitePlace_cardQuot_eq_card_pow_degree + (v : FiniteExtensionFinitePlace K L) : + v.asIdeal.cardQuot = Fintype.card K ^ + Module.finrank K v.asIdeal.ResidueField := by + letI : DecidableEq K := Classical.decEq K + letI : Finite v.asIdeal.ResidueField := + finiteExtensionFinitePlaceResidueField_finite K L v + letI : Module.Finite K v.asIdeal.ResidueField := + Module.Finite.of_finite + calc + v.asIdeal.cardQuot = + Nat.card (RatFuncFiniteIntegralClosure K L ⧸ v.asIdeal) := + Submodule.cardQuot_apply v.asIdeal + _ = Nat.card v.asIdeal.ResidueField := + Nat.card_congr + (RingEquiv.ofBijective + (algebraMap + (RatFuncFiniteIntegralClosure K L ⧸ v.asIdeal) + v.asIdeal.ResidueField) + v.asIdeal.bijective_algebraMap_quotient_residueField).toEquiv + _ = Nat.card K ^ Module.finrank K v.asIdeal.ResidueField := + Module.natCard_eq_pow_finrank + _ = Fintype.card K ^ Module.finrank K v.asIdeal.ResidueField := by + rw [Nat.card_eq_fintype_card] + +/-- Quotient cardinality is the constant-field cardinality raised to the +degree of the represented effective finite divisor. -/ +theorem effectiveDivisorIdeal_cardQuot_eq_card_pow_degree + (D : FiniteExtensionFinitePlace K L →₀ ℕ) : + (effectiveDivisorIdeal D).cardQuot = Fintype.card K ^ + finiteExtensionEffectiveFiniteDivisorDegree K L D := by + rw [cardQuot_effectiveDivisorIdeal_eq_prod] + unfold finiteExtensionEffectiveFiniteDivisorDegree Finsupp.prod Finsupp.sum + calc + D.support.prod (fun v => v.asIdeal.cardQuot ^ D v) = + D.support.prod (fun v => + Fintype.card K ^ + (D v * Module.finrank K v.asIdeal.ResidueField)) := by + apply Finset.prod_congr rfl + intro v _ + rw [finiteExtensionFinitePlace_cardQuot_eq_card_pow_degree] + calc + (Fintype.card K ^ Module.finrank K v.asIdeal.ResidueField) ^ D v = + Fintype.card K ^ + (Module.finrank K v.asIdeal.ResidueField * D v) := + (pow_mul (Fintype.card K) + (Module.finrank K v.asIdeal.ResidueField) (D v)).symm + _ = Fintype.card K ^ + (D v * Module.finrank K v.asIdeal.ResidueField) := by + rw [Nat.mul_comm] + _ = Fintype.card K ^ + D.support.sum (fun v => + D v * Module.finrank K v.asIdeal.ResidueField) := + Finset.prod_pow_eq_pow_sum D.support + (fun v => D v * Module.finrank K v.asIdeal.ResidueField) + (Fintype.card K) + +/-- Nonzero affine ideals in the normalization of `K[X]` are exactly +effective divisors on the finite places of the function field. -/ +def finiteExtensionAffineIdealEffectiveDivisorEquiv : + FiniteExtensionAffineIdeal K L ≃ + (FiniteExtensionFinitePlace K L →₀ ℕ) := + nonzeroIdealEffectiveDivisorEquiv + +@[simp] +theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_apply + (I : FiniteExtensionAffineIdeal K L) + (v : FiniteExtensionFinitePlace K L) : + finiteExtensionAffineIdealEffectiveDivisorEquiv K L I v = + multiplicity v.asIdeal + (I : Ideal (RatFuncFiniteIntegralClosure K L)) := by + simpa [finiteExtensionAffineIdealEffectiveDivisorEquiv] using + (nonzeroIdealEffectiveDivisorEquiv_apply I v) + +@[simp] +theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_symm_coe + (D : FiniteExtensionFinitePlace K L →₀ ℕ) : + (((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D : + FiniteExtensionAffineIdeal K L) : + Ideal (RatFuncFiniteIntegralClosure K L)) = + effectiveDivisorIdeal D := by + simpa [finiteExtensionAffineIdealEffectiveDivisorEquiv] using + (nonzeroIdealEffectiveDivisorEquiv_symm_coe D) + +/-- The affine ideal degree of the ideal represented by an effective finite +divisor is its residue-degree-weighted divisor degree. -/ +theorem finiteExtensionAffineIdealDegree_equiv_symm + (D : FiniteExtensionFinitePlace K L →₀ ℕ) : + finiteExtensionAffineIdealDegree K L + ((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D) = + finiteExtensionEffectiveFiniteDivisorDegree K L D := by + apply Nat.pow_right_injective (by + simpa [Nat.succ_le_iff] using Fintype.one_lt_card (α := K)) + calc + Fintype.card K ^ finiteExtensionAffineIdealDegree K L + ((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D) = + (((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D : + FiniteExtensionAffineIdeal K L) : + Ideal (RatFuncFiniteIntegralClosure K L)).cardQuot := + (finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree K L + ((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D)).symm + _ = (effectiveDivisorIdeal D).cardQuot := by + rw [finiteExtensionAffineIdealEffectiveDivisorEquiv_symm_coe] + _ = Fintype.card K ^ + finiteExtensionEffectiveFiniteDivisorDegree K L D := + effectiveDivisorIdeal_cardQuot_eq_card_pow_degree K L D + +/-- The degree of a nonzero affine ideal is the residue-degree-weighted sum of +its finite-place prime multiplicities. -/ +theorem finiteExtensionAffineIdealDegree_eq_divisorDegree + (I : FiniteExtensionAffineIdeal K L) : + finiteExtensionAffineIdealDegree K L I = + finiteExtensionEffectiveFiniteDivisorDegree K L + (finiteExtensionAffineIdealEffectiveDivisorEquiv K L I) := by + simpa using finiteExtensionAffineIdealDegree_equiv_symm K L + (finiteExtensionAffineIdealEffectiveDivisorEquiv K L I) + +/-- Expanded pointwise form of the affine ideal degree formula. -/ +theorem finiteExtensionAffineIdealDegree_eq_sum_multiplicity_mul_residueDegree + (I : FiniteExtensionAffineIdeal K L) : + finiteExtensionAffineIdealDegree K L I = + (finiteExtensionAffineIdealEffectiveDivisorEquiv K L I).sum + (fun v e => e * Module.finrank K v.asIdeal.ResidueField) := by + exact finiteExtensionAffineIdealDegree_eq_divisorDegree K L I + +/-- The ideal/divisor equivalence restricts to each degree. -/ +def finiteExtensionAffineIdealsOfDegreeEquivEffectiveFiniteDivisorsOfDegree + (n : ℕ) : + {I : FiniteExtensionAffineIdeal K L // + finiteExtensionAffineIdealDegree K L I = n} ≃ + {D : FiniteExtensionFinitePlace K L →₀ ℕ // + finiteExtensionEffectiveFiniteDivisorDegree K L D = n} where + toFun I := ⟨finiteExtensionAffineIdealEffectiveDivisorEquiv K L I.1, by + rw [← finiteExtensionAffineIdealDegree_eq_divisorDegree K L I.1] + exact I.2⟩ + invFun D := ⟨(finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D.1, by + rw [finiteExtensionAffineIdealDegree_equiv_symm K L D.1] + exact D.2⟩ + left_inv I := by + apply Subtype.ext + exact (finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm_apply_apply I.1 + right_inv D := by + apply Subtype.ext + exact (finiteExtensionAffineIdealEffectiveDivisorEquiv K L).apply_symm_apply D.1 + +/-- Effective finite divisors of a fixed degree form a finite type, transported +from the already-finite type of affine ideals of that degree. -/ +noncomputable instance finiteExtensionEffectiveFiniteDivisorsOfDegree_fintype + (n : ℕ) : + Fintype {D : FiniteExtensionFinitePlace K L →₀ ℕ // + finiteExtensionEffectiveFiniteDivisorDegree K L D = n} := + Fintype.ofEquiv + {I : FiniteExtensionAffineIdeal K L // + finiteExtensionAffineIdealDegree K L I = n} + (finiteExtensionAffineIdealsOfDegreeEquivEffectiveFiniteDivisorsOfDegree + K L n) + +/-- The effective-finite-divisor coefficient of degree `n`. -/ +noncomputable def finiteExtensionEffectiveFiniteDivisorCount (n : ℕ) : ℕ := + Fintype.card {D : FiniteExtensionFinitePlace K L →₀ ℕ // + finiteExtensionEffectiveFiniteDivisorDegree K L D = n} + +/-- The affine ideal coefficient sequence is exactly the effective +finite-divisor coefficient sequence. -/ +theorem finiteExtensionAffineIdealCount_eq_effectiveFiniteDivisorCount + (n : ℕ) : + finiteExtensionAffineIdealCount K L n = + finiteExtensionEffectiveFiniteDivisorCount K L n := by + exact Fintype.card_congr + (finiteExtensionAffineIdealsOfDegreeEquivEffectiveFiniteDivisorsOfDegree + K L n) + +end FunctionField + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean new file mode 100644 index 0000000000..76f16f9501 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean @@ -0,0 +1,258 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound + +/-! +# Canonicality criterion for the finite-extension different divisor + +The Corvaja--Zannier development constructs the divisor of the separating +differential `dX` place by place: its finite coefficients are trace-different +multiplicities, and its coefficients above infinity are the different +multiplicity minus twice the ramification index. The Riemann--Roch library, +on the other hand, defines canonical divisors as maximal vanishing divisors +of nonzero adelic Weil functionals. + +This module gives the exact theorem-level reduction between those two +presentations. It does not assume or package canonicality. The target is +equivalent to: + +* the Riemann--Hurwitz identity for the total trace different; and +* the dimension statement + + `genus K L ≤ finrank K (finiteExtensionRiemannSpace K L Ddiff)`. + +Once the degree identity is known, Riemann--Roch proves that this finrank is +already between `g - 1` and `g`. Thus the exact remaining +trace-residue/Kähler-to-Weil theorem is the displayed lower bound: construct +the Weil functional attached to `dX`, identify its local annihilator with the +trace-different/Kähler module, and thereby close the last one-dimensional +gap. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance canonicalCriterionConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance canonicalCriterionConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) canonicalCriterionPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance canonicalCriterionPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance canonicalCriterionConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- A degree-zero chart divisor has a Riemann--Roch space of dimension at +most one. -/ +theorem chart_ell_le_one_of_degree_eq_zero + [FunctionField.IsFullConstantField K L] + (D : FunctionField.Chart.DivisorA K L) + (hdegree : FunctionField.Chart.deg K L D = 0) : + FunctionField.Chart.ell K L D ≤ 1 := by + by_cases hell : FunctionField.Chart.ell K L D = 0 + · omega + · have hpositive : 0 < FunctionField.Chart.ell K L D := + Nat.pos_of_ne_zero hell + obtain ⟨x, heffective⟩ := + FunctionField.Chart.exists_effective_add_principal_of_ell_pos + K L D hpositive + let P := FunctionField.Chart.principalDivisorA K L (Additive.ofMul x) + have hdegreeZero : FunctionField.Chart.deg K L (D + P) = 0 := by + rw [FunctionField.Chart.deg_add, + FunctionField.Chart.deg_principalDivisorA_eq_zero, hdegree] + omega + have hzero : D + P = 0 := + FunctionField.Chart.eq_zero_of_effective_deg_zero K L + heffective hdegreeZero + have hellAdd := FunctionField.Chart.ell_add_principal K L D x + change FunctionField.Chart.ell K L (D + P) = + FunctionField.Chart.ell K L D at hellAdd + rw [hzero, FunctionField.Chart.ell_zero] at hellAdd + omega + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- At canonical degree, Riemann--Roch leaves at most a one-dimensional +defect from canonicality. -/ +theorem chart_ell_le_genus_of_degree_eq_two_genus_sub_two + [FunctionField.IsFullConstantField K L] + (D : FunctionField.Chart.DivisorA K L) + (hdegree : FunctionField.Chart.deg K L D = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2) : + FunctionField.Chart.ell K L D ≤ FunctionField.Chart.genus K L := by + obtain ⟨W, hW⟩ := FunctionField.Chart.exists_isCanonical K L + have hdegreeDiff : FunctionField.Chart.deg K L (W - D) = 0 := by + rw [FunctionField.Chart.deg_sub, + FunctionField.Chart.deg_canonical K L hW, hdegree] + omega + have hellDiff : FunctionField.Chart.ell K L (W - D) ≤ 1 := + chart_ell_le_one_of_degree_eq_zero K L (W - D) hdegreeDiff + have hRR := FunctionField.Chart.riemann_roch K L hW D + rw [hdegree] at hRR + omega + +/-- Canonicality of the explicit different divisor is equivalent to its +canonical degree and canonical Riemann--Roch dimension. Both conditions are +stated entirely in the exhaustive BGS divisor model. -/ +theorem finiteExtensionCanonicalDifferent_isCanonical_iff_degree_finrank + [FunctionField.IsFullConstantField K L] : + FunctionField.Chart.IsCanonical K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) ↔ + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 ∧ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) = + FunctionField.Chart.genus K L := by + let D := finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + rw [FunctionField.chart_isCanonical_iff_degree_ell] + rw [← finiteExtensionDivisorDegree_eq_chart K L D] + change finiteExtensionDivisorDegree K L D = _ ∧ + Module.finrank K (FunctionField.Chart.RRspace K L + (finiteExtensionDivisorEquivChart K L D)) = _ ↔ _ + rw [← finiteExtensionRiemannSpace_eq_chart K L D] + +/-- Once Riemann--Hurwitz supplies the degree identity, canonicality is +equivalent to closing the single remaining Riemann--Roch dimension gap. -/ +theorem finiteExtensionCanonicalDifferent_isCanonical_iff_genus_le_finrank_of_degree_eq + [FunctionField.IsFullConstantField K L] + (hdegree : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2) : + FunctionField.Chart.IsCanonical K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) ↔ + FunctionField.Chart.genus K L ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) := by + let D := finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + have hdegreeChart : FunctionField.Chart.deg K L + (finiteExtensionDivisorEquivChart K L D) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [← finiteExtensionDivisorDegree_eq_chart K L D] + exact hdegree + have hupperChart : FunctionField.Chart.ell K L + (finiteExtensionDivisorEquivChart K L D) ≤ + FunctionField.Chart.genus K L := + chart_ell_le_genus_of_degree_eq_two_genus_sub_two K L + (finiteExtensionDivisorEquivChart K L D) hdegreeChart + have hupper : Module.finrank K (finiteExtensionRiemannSpace K L D) ≤ + FunctionField.Chart.genus K L := by + rw [finiteExtensionRiemannSpace_eq_chart] + exact hupperChart + rw [finiteExtensionCanonicalDifferent_isCanonical_iff_degree_finrank K L] + constructor + · rintro ⟨_hdegree, hfinrank⟩ + simpa only [D] using hfinrank.ge + · intro hlower + refine ⟨hdegree, ?_⟩ + apply Nat.le_antisymm + · simpa only [D] using hupper + · exact hlower + +/-- The degree identity leaves at most one unit of uncertainty in the +Riemann--Roch dimension of the explicit different divisor. -/ +theorem finiteExtensionCanonicalDifferent_finrank_bounds_of_degree_eq + [FunctionField.IsFullConstantField K L] + (hdegree : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2) : + (FunctionField.Chart.genus K L : ℤ) - 1 ≤ + (Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) : ℤ) ∧ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) ≤ + FunctionField.Chart.genus K L := by + let D := finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + have hdegreeChart : FunctionField.Chart.deg K L + (finiteExtensionDivisorEquivChart K L D) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [← finiteExtensionDivisorDegree_eq_chart K L D] + exact hdegree + have hlowerChart := FunctionField.Chart.riemann_ineq K L + (finiteExtensionDivisorEquivChart K L D) + rw [hdegreeChart] at hlowerChart + have hlowerInt : (FunctionField.Chart.genus K L : ℤ) - 1 ≤ + (FunctionField.Chart.ell K L + (finiteExtensionDivisorEquivChart K L D) : ℤ) := by + omega + have hupperChart := + chart_ell_le_genus_of_degree_eq_two_genus_sub_two K L + (finiteExtensionDivisorEquivChart K L D) hdegreeChart + change (FunctionField.Chart.genus K L : ℤ) - 1 ≤ + (Module.finrank K (finiteExtensionRiemannSpace K L D) : ℤ) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L D) ≤ + FunctionField.Chart.genus K L + have hfinrank : Module.finrank K (finiteExtensionRiemannSpace K L D) = + FunctionField.Chart.ell K L + (finiteExtensionDivisorEquivChart K L D) := by + rw [finiteExtensionRiemannSpace_eq_chart] + rfl + constructor + · rw [hfinrank] + exact hlowerInt + · rw [hfinrank] + exact hupperChart + +omit [Fintype K] in +/-- The degree half of canonicality is exactly the Riemann--Hurwitz identity +for the finite and infinite trace different. -/ +theorem finiteExtensionCanonicalDifferent_degree_eq_two_genus_sub_two_iff + [FunctionField.IsFullConstantField K L] : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 ↔ + (finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) : ℤ) + + (infinityDifferentDegree K L : ℤ) = + 2 * (Module.finrank (RatFunc K) L : ℤ) + + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [finiteExtensionCanonicalDifferentDivisor_degree] + constructor <;> intro h <;> omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean new file mode 100644 index 0000000000..1d794ab995 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean @@ -0,0 +1,1348 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing + +/-! +# Cotrace construction for the finite-extension canonical different + +This file constructs a surjective cotrace on fiber-constant adeles and uses +the trace codifferent bounds to build a nonzero Weil differential whose +maximal vanishing divisor contains the explicit finite-extension different. +Nothing in this file is an assumption. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain Multiplicative WithZero +open scoped Polynomial nonZeroDivisors + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- The exhaustive rational-function places used as the base of the finite +extension place map. -/ +abbrev RatFuncExhaustivePlace := + HeightOneSpectrum K[X] ⊕ HeightOneSpectrum (RatFuncInfinityIntegers K) + +/-- The polynomial ring is the integral closure of itself in its fraction +field, so its height-one primes are exactly the finite chart places of +`K(X)`. -/ +def ratFuncFiniteBaseRingEquivChart : + K[X] ≃+* FunctionField.ringOfIntegers K (RatFunc K) := + (IsIntegralClosure.equiv K[X] K[X] (RatFunc K) + (FunctionField.ringOfIntegers K (RatFunc K))).toRingEquiv + +@[simp] +theorem ratFuncFiniteBaseRingEquivChart_algebraMap + (r : K[X]) : + algebraMap (FunctionField.ringOfIntegers K (RatFunc K)) + (RatFunc K) (ratFuncFiniteBaseRingEquivChart K r) = + algebraMap K[X] (RatFunc K) r := + IsIntegralClosure.algebraMap_equiv K[X] K[X] + (RatFunc K) (FunctionField.ringOfIntegers K (RatFunc K)) r + +/-- The BGS infinity valuation ring and the chart infinity integral closure +inside `K(X)` are canonically equivalent. -/ +def ratFuncInfinityBaseRingEquivChart : + RatFuncInfinityIntegers K ≃+* + FunctionField.Chart.infiniteIntegers K (RatFunc K) := + (finiteExtensionInfinityBaseRingEquiv K).trans + (IsIntegralClosure.equiv + (FunctionField.Chart.inftyValuationSubring K) + (FunctionField.Chart.inftyValuationSubring K) (RatFunc K) + (FunctionField.Chart.infiniteIntegers K (RatFunc K))).toRingEquiv + +@[simp] +theorem ratFuncInfinityBaseRingEquivChart_algebraMap + (r : RatFuncInfinityIntegers K) : + algebraMap (FunctionField.Chart.infiniteIntegers K (RatFunc K)) + (RatFunc K) (ratFuncInfinityBaseRingEquivChart K r) = + algebraMap (RatFuncInfinityIntegers K) (RatFunc K) r := by + calc + _ = algebraMap (FunctionField.Chart.inftyValuationSubring K) + (RatFunc K) (finiteExtensionInfinityBaseRingEquiv K r) := + IsIntegralClosure.algebraMap_equiv + (FunctionField.Chart.inftyValuationSubring K) + (FunctionField.Chart.inftyValuationSubring K) (RatFunc K) + (FunctionField.Chart.infiniteIntegers K (RatFunc K)) + (finiteExtensionInfinityBaseRingEquiv K r) + _ = (r : RatFunc K) := rfl + _ = algebraMap (RatFuncInfinityIntegers K) (RatFunc K) r := rfl + +/-- Reindex the exhaustive BGS rational-function places as chart places. -/ +def ratFuncExhaustivePlaceEquivChart : + RatFuncExhaustivePlace K ≃ FunctionField.Chart.PlaceA K (RatFunc K) := + Equiv.sumCongr + (HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteBaseRingEquivChart K)) + (HeightOneSpectrum.equivOfRingEquiv + (ratFuncInfinityBaseRingEquivChart K)) + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance cotraceConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance cotraceConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) cotracePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance cotracePolynomialTower : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance cotraceConstantPolynomialTower : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance cotraceFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.finite K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance cotraceFiniteClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance cotraceFiniteBaseTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance cotraceFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance cotraceInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance cotraceInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance cotraceInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance cotraceInfinityClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance cotraceInfinityClosureIsDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance cotraceInfinityClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- Transport the condition of belonging to a height-one valuation ring +across an identity-on-fraction-field ring equivalence. -/ +theorem heightOneValuation_le_one_of_ringEquiv + {R S F : Type*} [CommRing R] [CommRing S] [Field F] + [Algebra R F] [Algebra S F] [IsFractionRing R F] + [IsFractionRing S F] [IsDedekindDomain R] [IsDedekindDomain S] + (e : R ≃+* S) + (halg : ∀ r : R, algebraMap S F (e r) = algebraMap R F r) + (q : HeightOneSpectrum R) (q' : HeightOneSpectrum S) + (hideal : q'.asIdeal = q.asIdeal.comap e.symm) + {x : F} (hx : q.valuation F x ≤ 1) : q'.valuation F x ≤ 1 := by + obtain ⟨n, d, hnd⟩ := q.exists_primeCompl_mul_eq_of_integer x hx + have hd' : e d.1 ∉ q'.asIdeal := by + intro hmem + have hd : (d.1 : R) ∉ q.asIdeal := d.2 + apply hd + rw [hideal] at hmem + change e.symm (e d.1) ∈ q.asIdeal at hmem + simpa using hmem + have hnd' : + x * algebraMap S F (e d.1) = algebraMap S F (e n) := by + simpa only [halg] using hnd + have hval := congrArg (q'.valuation F) hnd' + rw [map_mul, q'.valuation_eq_one_iff_notMem (K := F).2 hd'] at hval + simp only [mul_one] at hval + rw [hval] + exact q'.valuation_le_one (K := F) (e n) + +/-- Identity-on-fraction-field equivalences identify the valuation rings of +corresponding height-one primes. -/ +theorem heightOneValuation_isEquiv_of_ringEquiv + {R S F : Type*} [CommRing R] [CommRing S] [Field F] + [Algebra R F] [Algebra S F] [IsFractionRing R F] + [IsFractionRing S F] [IsDedekindDomain R] [IsDedekindDomain S] + (e : R ≃+* S) + (halg : ∀ r : R, algebraMap S F (e r) = algebraMap R F r) + (q : HeightOneSpectrum R) (q' : HeightOneSpectrum S) + (hideal : q'.asIdeal = q.asIdeal.comap e.symm) : + (q.valuation F).IsEquiv (q'.valuation F) := by + apply Valuation.isEquiv_of_val_le_one + intro x + constructor + · exact heightOneValuation_le_one_of_ringEquiv + e halg q q' hideal + · intro hx + have halg' : ∀ s : S, + algebraMap R F (e.symm s) = algebraMap S F s := by + intro s + rw [← halg (e.symm s), e.apply_symm_apply] + have hideal' : q.asIdeal = q'.asIdeal.comap e := by + ext r + rw [Ideal.mem_comap, hideal, Ideal.mem_comap] + simp + exact heightOneValuation_le_one_of_ringEquiv + e.symm halg' q' q hideal' hx + +/-- Equivalent surjective valuations with value group `ℤᵐ⁰` have the same +normalization. -/ +theorem normalizedIntValuation_eq_of_isEquiv_of_surjective + {F : Type*} [Field F] (v w : Valuation F ℤᵐ⁰) + (hvw : v.IsEquiv w) (hv : Function.Surjective v) + (hw : Function.Surjective w) : v = w := by + obtain ⟨π, hvπ⟩ := hv (WithZero.exp (-1 : ℤ)) + have hπ : π ≠ 0 := by + apply (Valuation.ne_zero_iff v).mp + rw [hvπ] + exact WithZero.exp_ne_zero + have hwπ0 : w π ≠ 0 := + (hvw.eq_zero.ne).mp ((Valuation.ne_zero_iff v).2 hπ) + let m : ℤ := -WithZero.log (w π) + have hmpos : 0 < m := by + have hvπlt : v π < 1 := by + rw [hvπ, ← WithZero.exp_zero, WithZero.exp_lt_exp] + omega + have hwπlt : w π < 1 := hvw.lt_one_iff_lt_one.mp hvπlt + have hlog : WithZero.log (w π) < 0 := by + rw [← WithZero.log_one] + exact (WithZero.log_lt_log hwπ0 one_ne_zero).2 hwπlt + dsimp only [m] + omega + have hformula (x : F) (hx : x ≠ 0) : + w x = WithZero.exp (m * WithZero.log (v x)) := by + have hvx0 : v x ≠ 0 := (Valuation.ne_zero_iff v).2 hx + let n : ℤ := WithZero.log (v x) + have hvpow : v (π ^ (-n)) = v x := by + rw [map_zpow₀, hvπ, ← WithZero.exp_zsmul] + rw [← WithZero.exp_log hvx0] + congr 1 + dsimp only [n] + simp + have hwpow : w (π ^ (-n)) = w x := hvw.eq_iff.mp hvpow + calc + w x = w (π ^ (-n)) := hwpow.symm + _ = (w π) ^ (-n) := by rw [map_zpow₀] + _ = WithZero.exp ((-n) • WithZero.log (w π)) := by + rw [WithZero.exp_zsmul, WithZero.exp_log hwπ0] + _ = WithZero.exp (m * WithZero.log (v x)) := by + congr 1 + dsimp only [m, n] + ring + obtain ⟨y, hwy⟩ := hw (WithZero.exp (1 : ℤ)) + have hy : y ≠ 0 := by + apply (Valuation.ne_zero_iff w).mp + rw [hwy] + exact WithZero.exp_ne_zero + have hm : m * WithZero.log (v y) = 1 := by + apply WithZero.exp_injective + rw [← hformula y hy, hwy] + have hm1 : m = 1 := by + rcases Int.mul_eq_one_iff_eq_one_or_neg_one.mp hm with h | h + · exact h.1 + · omega + ext x + by_cases hx : x = 0 + · subst x + simp + · rw [hformula x hx, hm1, one_mul, + WithZero.exp_log ((Valuation.ne_zero_iff v).2 hx)] + +/-- Corresponding height-one primes have exactly the same normalized +`ℤᵐ⁰`-valued valuation under an identity-on-fraction-field equivalence. -/ +theorem heightOneValuation_eq_of_ringEquiv + {R S F : Type*} [CommRing R] [CommRing S] [Field F] + [Algebra R F] [Algebra S F] [IsFractionRing R F] + [IsFractionRing S F] [IsDedekindDomain R] [IsDedekindDomain S] + (e : R ≃+* S) + (halg : ∀ r : R, algebraMap S F (e r) = algebraMap R F r) + (q : HeightOneSpectrum R) (q' : HeightOneSpectrum S) + (hideal : q'.asIdeal = q.asIdeal.comap e.symm) : + q.valuation F = q'.valuation F := by + apply normalizedIntValuation_eq_of_isEquiv_of_surjective + · exact heightOneValuation_isEquiv_of_ringEquiv e halg q q' hideal + · exact HeightOneSpectrum.valuation_surjective (K := F) q + · exact HeightOneSpectrum.valuation_surjective (K := F) q' + +/-- Integrality at a height-one prime pulls up along a finite extension to +every prime above it. -/ +theorem heightOneValuation_algebraMap_le_one_of_under + {R S F E : Type*} [CommRing R] [CommRing S] [Field F] [Field E] + [Algebra R S] [Algebra R F] [Algebra R E] [Algebra S E] + [Algebra F E] [IsScalarTower R S E] [IsScalarTower R F E] + [Algebra.IsIntegral R S] + [IsFractionRing R F] [IsFractionRing S E] + [IsDedekindDomain R] [IsDedekindDomain S] + (q : HeightOneSpectrum S) (p : HeightOneSpectrum R) + (hunder : q.under R = p) {x : F} + (hx : p.valuation F x ≤ 1) : + q.valuation E (algebraMap F E x) ≤ 1 := by + obtain ⟨n, d, hnd⟩ := p.exists_primeCompl_mul_eq_of_integer x hx + have hunderIdeal : q.asIdeal.under R = p.asIdeal := + congrArg HeightOneSpectrum.asIdeal hunder + have hdq : algebraMap R S d.1 ∉ q.asIdeal := by + intro hdq + have hdUnder : (d.1 : R) ∈ q.asIdeal.under R := hdq + have hdP : (d.1 : R) ∈ p.asIdeal := by + simpa only [hunderIdeal] using hdUnder + exact d.2 hdP + have hndE := congrArg (algebraMap F E) hnd + have hndE' : algebraMap F E x * algebraMap S E (algebraMap R S d.1) = + algebraMap S E (algebraMap R S n) := by + simpa only [map_mul, ← IsScalarTower.algebraMap_apply R F E, + ← IsScalarTower.algebraMap_apply R S E] using hndE + have hval := congrArg (q.valuation E) hndE' + have hdval : q.valuation E (algebraMap S E (algebraMap R S d.1)) = 1 := + q.valuation_eq_one_iff_notMem (K := E).2 hdq + rw [map_mul, hdval, mul_one] at hval + rw [hval] + exact q.valuation_le_one (K := E) (algebraMap R S n) + +/-- Integrality at a height-one place is the nonnegativity of its principal +fractional-ideal count. -/ +theorem zero_le_count_spanSingleton_of_valuation_le_one + {R F : Type*} [CommRing R] [Field F] [Algebra R F] + [IsFractionRing R F] [IsDedekindDomain R] + (q : HeightOneSpectrum R) {x : F} (hx : x ≠ 0) + (hval : q.valuation F x ≤ 1) : + 0 ≤ FractionalIdeal.count F q + (FractionalIdeal.spanSingleton R⁰ x) := by + have hvaluation := FractionalIdeal.valuation_eq_exp_neg_count + q (Units.mk0 x hx) + have hval' : q.valuation F (↑(Units.mk0 x hx) : F) ≤ 1 := by + simpa using hval + rw [hvaluation, ← WithZero.exp_zero] at hval' + exact neg_nonpos.mp (WithZero.exp_le_exp.mp hval') + +/-- Forget an extension place down to its rational-function place. -/ +def finiteExtensionUnderPlace : + FiniteExtensionPlace K L → RatFuncExhaustivePlace K + | .inl q => .inl (q.under K[X]) + | .inr _ => .inr (ratFuncInfinityPlace K) + +/-- Every rational-function place has an extension place above it. -/ +theorem finiteExtensionUnderPlace_surjective : + Function.Surjective (finiteExtensionUnderPlace K L) := by + intro p + rcases p with p | p + · obtain ⟨P, hP, hunder⟩ := + p.asIdeal.exists_ideal_over_prime_of_isIntegral_of_isDomain + (S := RatFuncFiniteIntegralClosure K L) (by simp) + have hPbot : P ≠ ⊥ := by + intro hbot + have hpbot : p.asIdeal = ⊥ := by + calc + p.asIdeal = Ideal.comap + (algebraMap K[X] (RatFuncFiniteIntegralClosure K L)) P := + hunder.symm + _ = Ideal.comap + (algebraMap K[X] (RatFuncFiniteIntegralClosure K L)) ⊥ := by + rw [hbot] + _ = ⊥ := Ideal.comap_bot_of_injective _ + (FaithfulSMul.algebraMap_injective K[X] + (RatFuncFiniteIntegralClosure K L)) + exact p.ne_bot hpbot + let q : HeightOneSpectrum (RatFuncFiniteIntegralClosure K L) := + ⟨P, hP, hPbot⟩ + refine ⟨.inl q, ?_⟩ + apply congrArg Sum.inl + apply HeightOneSpectrum.ext + exact hunder + · have hpEq : p = ratFuncInfinityPlace K := by + apply HeightOneSpectrum.ext + exact (IsLocalRing.eq_maximalIdeal + (p.isPrime.isMaximal p.ne_bot)).trans + (IsLocalRing.eq_maximalIdeal + ((ratFuncInfinityPlace K).isPrime.isMaximal + (ratFuncInfinityPlace K).ne_bot)).symm + obtain ⟨P, hPmax, hPover⟩ := + (ratFuncInfinityPlace K).asIdeal.exists_maximal_ideal_liesOver_of_isIntegral + (S := RatFuncInfinityIntegralClosure K L) + let P' : FiniteExtensionInfinityPlace K L := + ⟨P, hPmax.isPrime, hPover⟩ + refine ⟨.inr P', ?_⟩ + simp only [finiteExtensionUnderPlace] + exact congrArg Sum.inr hpEq.symm + +/-- Every fiber of the exhaustive place map is finite. -/ +theorem finiteExtensionUnderPlace_finite_preimage_singleton + (p : RatFuncExhaustivePlace K) : + Set.Finite ((finiteExtensionUnderPlace K L) ⁻¹' {p}) := by + rcases p with p | p + · have hfiber : Set.Finite {q : FiniteExtensionFinitePlace K L | + q.under K[X] = p} := by + rw [← Set.finite_coe_iff] + letI : Finite + (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := + Set.finite_coe_iff.mpr + (IsDedekindDomain.primesOver_finite p.asIdeal + (RatFuncFiniteIntegralClosure K L)) + exact Finite.of_equiv + (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) + (finitePlaceFiberEquivPrimesOver K L p).symm + refine (hfiber.image (fun q => + (Sum.inl q : FiniteExtensionPlace K L))).subset ?_ + intro q hq + rcases q with q | q + · refine ⟨q, ?_, rfl⟩ + change q.under K[X] = p + simpa only [Set.mem_preimage, Set.mem_singleton_iff, + finiteExtensionUnderPlace, Sum.inl.injEq] using hq + · simp only [Set.mem_preimage, Set.mem_singleton_iff, + finiteExtensionUnderPlace, Sum.inr.injEq, reduceCtorEq] at hq + · letI : Finite (FiniteExtensionInfinityPlace K L) := + Set.finite_coe_iff.mpr + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + refine (Set.finite_range (fun q : FiniteExtensionInfinityPlace K L => + (Sum.inr q : FiniteExtensionPlace K L))).subset ?_ + intro q hq + rcases q with q | q + · simp only [Set.mem_preimage, Set.mem_singleton_iff, + finiteExtensionUnderPlace, Sum.inl.injEq, reduceCtorEq] at hq + · exact Set.mem_range_self q + +/-- Pullback along the exhaustive place map preserves cofinite eventual +properties. -/ +theorem finiteExtensionUnderPlace_tendstoCofinite : + Filter.TendstoCofinite (finiteExtensionUnderPlace K L) := + (Filter.tendstoCofinite_iff_finite_preimage_singleton + (finiteExtensionUnderPlace K L)).mpr + (finiteExtensionUnderPlace_finite_preimage_singleton K L) + +/-- The place below a top chart place, expressed in the base chart. -/ +def finiteExtensionUnderPlaceChart + (q : FunctionField.Chart.PlaceA K L) : + FunctionField.Chart.PlaceA K (RatFunc K) := + ratFuncExhaustivePlaceEquivChart K + (finiteExtensionUnderPlace K L + ((finiteExtensionPlaceEquivChart K L).symm q)) + +/-- Every rational-function chart place has an upstairs chart place. -/ +theorem finiteExtensionUnderPlaceChart_surjective : + Function.Surjective (finiteExtensionUnderPlaceChart K L) := by + intro p + let p' := (ratFuncExhaustivePlaceEquivChart K).symm p + obtain ⟨q, hq⟩ := finiteExtensionUnderPlace_surjective K L p' + refine ⟨finiteExtensionPlaceEquivChart K L q, ?_⟩ + simp only [finiteExtensionUnderPlaceChart, Equiv.symm_apply_apply, hq, p'] + exact (ratFuncExhaustivePlaceEquivChart K).apply_symm_apply p + +/-- Pullback along the chart place map preserves cofinite eventual +properties. -/ +theorem finiteExtensionUnderPlaceChart_tendstoCofinite : + Filter.TendstoCofinite (finiteExtensionUnderPlaceChart K L) := by + letI : Filter.TendstoCofinite (finiteExtensionUnderPlace K L) := + finiteExtensionUnderPlace_tendstoCofinite K L + change Filter.TendstoCofinite + ((ratFuncExhaustivePlaceEquivChart K) ∘ + (finiteExtensionUnderPlace K L) ∘ + (finiteExtensionPlaceEquivChart K L).symm) + infer_instance + +/-- A base element integral at a chart place remains integral at every +upstairs chart place above it. -/ +theorem finiteExtension_placeValuation_algebraMap_le_one + (q : FunctionField.Chart.PlaceA K L) {x : RatFunc K} + (hx : FunctionField.Chart.placeValuation K (RatFunc K) + (finiteExtensionUnderPlaceChart K L q) x ≤ 1) : + FunctionField.Chart.placeValuation K L q + (algebraMap (RatFunc K) L x) ≤ 1 := by + let P := (finiteExtensionPlaceEquivChart K L).symm q + have hP : finiteExtensionPlaceEquivChart K L P = q := + (finiteExtensionPlaceEquivChart K L).apply_symm_apply q + rw [← hP] at hx ⊢ + rcases P with q | P + · let p₀ := q.under K[X] + let pChart := HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteBaseRingEquivChart K) p₀ + have hbaseEq : p₀.valuation (RatFunc K) = + pChart.valuation (RatFunc K) := + heightOneValuation_eq_of_ringEquiv + (ratFuncFiniteBaseRingEquivChart K) + (ratFuncFiniteBaseRingEquivChart_algebraMap K) + p₀ pChart rfl + have hunderChart : finiteExtensionUnderPlaceChart K L + (finiteExtensionPlaceEquivChart K L (.inl q)) = + Sum.inl pChart := by + simp only [finiteExtensionUnderPlaceChart, Equiv.symm_apply_apply, + finiteExtensionUnderPlace] + rfl + have hx₀ : p₀.valuation (RatFunc K) x ≤ 1 := by + rw [hbaseEq] + rw [hunderChart] at hx + exact hx + exact heightOneValuation_algebraMap_le_one_of_under + q p₀ rfl hx₀ + · let p₀ := ratFuncInfinityPlace K + let pChart := HeightOneSpectrum.equivOfRingEquiv + (ratFuncInfinityBaseRingEquivChart K) p₀ + let q₀ := primeOverHeightOne (ratFuncInfinityPlace K) P + have hbaseEq : p₀.valuation (RatFunc K) = + pChart.valuation (RatFunc K) := + heightOneValuation_eq_of_ringEquiv + (ratFuncInfinityBaseRingEquivChart K) + (ratFuncInfinityBaseRingEquivChart_algebraMap K) + p₀ pChart rfl + have hunderChart : finiteExtensionUnderPlaceChart K L + (finiteExtensionPlaceEquivChart K L (.inr P)) = + Sum.inr pChart := by + simp only [finiteExtensionUnderPlaceChart, Equiv.symm_apply_apply, + finiteExtensionUnderPlace] + rfl + have hx₀ : p₀.valuation (RatFunc K) x ≤ 1 := by + rw [hbaseEq] + rw [hunderChart] at hx + exact hx + have hqUnder : q₀.under (RatFuncInfinityIntegers K) = p₀ := by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P.1 (ratFuncInfinityPlace K).asIdeal).symm + have htop : q₀.valuation L (algebraMap (RatFunc K) L x) ≤ 1 := + heightOneValuation_algebraMap_le_one_of_under q₀ p₀ hqUnder hx₀ + have htopEq := congrArg + (fun v : Valuation L ℤᵐ⁰ => v (algebraMap (RatFunc K) L x)) + (finiteExtensionPlaceValuation_eq_chart K L (.inr P)) + rw [← htopEq] + exact htop + +/-- A chosen place of `L` above each rational-function chart place. -/ +def finiteExtensionPlaceSectionChart + (p : FunctionField.Chart.PlaceA K (RatFunc K)) : + FunctionField.Chart.PlaceA K L := + Classical.choose (finiteExtensionUnderPlaceChart_surjective K L p) + +@[simp] +theorem finiteExtensionUnderPlaceChart_section + (p : FunctionField.Chart.PlaceA K (RatFunc K)) : + finiteExtensionUnderPlaceChart K L + (finiteExtensionPlaceSectionChart K L p) = p := + Classical.choose_spec (finiteExtensionUnderPlaceChart_surjective K L p) + +/-- Adeles whose components are constant on every fiber over a base place. -/ +def finiteExtensionFiberConstantAdeleSubmodule : + Submodule K (FunctionField.Chart.AdeleSpace K L) where + carrier := {a | ∀ q r, + finiteExtensionUnderPlaceChart K L q = + finiteExtensionUnderPlaceChart K L r → a.1 q = a.1 r} + zero_mem' := by simp + add_mem' {a b} ha hb q r hqr := by + change a.1 q + b.1 q = a.1 r + b.1 r + rw [ha q r hqr, hb q r hqr] + smul_mem' c a ha q r hqr := by + change c • a.1 q = c • a.1 r + rw [ha q r hqr] + +/-- A fiber-constant adele has the chosen component at the base place of +every upstairs place. -/ +theorem fiberConstant_component_eq_section + (a : finiteExtensionFiberConstantAdeleSubmodule K L) + (q : FunctionField.Chart.PlaceA K L) : + a.1.1 q = a.1.1 (finiteExtensionPlaceSectionChart K L + (finiteExtensionUnderPlaceChart K L q)) := by + apply a.2 + rw [finiteExtensionUnderPlaceChart_section] + +/-- Componentwise field trace of a fiber-constant adele, before proving that +the resulting tuple is a rational-function adele. -/ +def finiteExtensionFiberTraceRaw : + finiteExtensionFiberConstantAdeleSubmodule K L →ₗ[K] + (FunctionField.Chart.PlaceA K (RatFunc K) → RatFunc K) where + toFun a p := Algebra.trace (RatFunc K) L + (a.1.1 (finiteExtensionPlaceSectionChart K L p)) + map_add' a b := by + funext p + exact map_add (Algebra.trace (RatFunc K) L) _ _ + map_smul' c a := by + funext p + simp only [Submodule.coe_smul, Pi.smul_apply] + rw [Algebra.smul_def, Algebra.smul_def] + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + simp only [RingHom.id_apply] + simpa [Algebra.smul_def] using + (Algebra.trace (RatFunc K) L).map_smul + (algebraMap K (RatFunc K) c) + (a.1.1 (finiteExtensionPlaceSectionChart K L p)) + +/-- Top chart places at which a given adele is not integral. -/ +def finiteExtensionAdeleExceptionalSet + (a : FunctionField.Chart.AdeleSpace K L) : + Set (FunctionField.Chart.PlaceA K L) := + {q | a.1 q ∉ FunctionField.Chart.placeValuationSubring K L q} + +theorem finiteExtensionAdeleExceptionalSet_finite + (a : FunctionField.Chart.AdeleSpace K L) : + (finiteExtensionAdeleExceptionalSet K L a).Finite := by + have ha := a.2 + change ∀ᶠ q : FunctionField.Chart.PlaceA K L in Filter.cofinite, + a.1 q ∈ FunctionField.Chart.placeValuationSubring K L q at ha + simpa only [Filter.eventually_cofinite, + finiteExtensionAdeleExceptionalSet] using ha + +/-- Finite chart places in the support of the finite different. -/ +def finiteExtensionDifferentExceptionalSet : + Set (FunctionField.Chart.PlaceA K L) := + finiteExtensionPlaceEquivChart K L '' + (Sum.inl '' {q : FiniteExtensionFinitePlace K L | + multiplicity q.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) ≠ 0}) + +theorem finiteExtensionDifferentExceptionalSet_finite : + (finiteExtensionDifferentExceptionalSet K L).Finite := by + have hdiff : differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L) ≠ ⊥ := + finiteExtensionFiniteDifferentIdeal_ne_bot K L + have hcountFinite : Set.Finite {q : FiniteExtensionFinitePlace K L | + FractionalIdeal.count L q + ((differentIdeal K[X] (RatFuncFiniteIntegralClosure K L) : + Ideal (RatFuncFiniteIntegralClosure K L)) : + FractionalIdeal (RatFuncFiniteIntegralClosure K L)⁰ L) ≠ 0} := by + simpa only [Filter.eventually_cofinite] using + FractionalIdeal.finite_factors (K := L) + ((differentIdeal K[X] (RatFuncFiniteIntegralClosure K L) : + Ideal (RatFuncFiniteIntegralClosure K L)) : + FractionalIdeal (RatFuncFiniteIntegralClosure K L)⁰ L) + have hmultFinite : Set.Finite {q : FiniteExtensionFinitePlace K L | + multiplicity q.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) ≠ 0} := by + refine hcountFinite.subset ?_ + intro q hq + change FractionalIdeal.count L q + ((differentIdeal K[X] (RatFuncFiniteIntegralClosure K L) : + Ideal (RatFuncFiniteIntegralClosure K L)) : + FractionalIdeal (RatFuncFiniteIntegralClosure K L)⁰ L) ≠ 0 + rw [FractionalIdeal.count_coeIdeal_eq_multiplicity + (K := L) (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) hdiff] + exact_mod_cast hq + exact (hmultFinite.image Sum.inl).image + (finiteExtensionPlaceEquivChart K L) + +/-- The unique base infinity chart place, expressed through the exhaustive +place equivalence. -/ +def ratFuncInfinityPlaceChart : + FunctionField.Chart.PlaceA K (RatFunc K) := + ratFuncExhaustivePlaceEquivChart K (.inr (ratFuncInfinityPlace K)) + +/-- The finite exceptional set outside which the componentwise trace is +integral. -/ +def finiteExtensionCotraceBadBaseSet + (a : FunctionField.Chart.AdeleSpace K L) : + Set (FunctionField.Chart.PlaceA K (RatFunc K)) := + finiteExtensionUnderPlaceChart K L '' + (finiteExtensionAdeleExceptionalSet K L a ∪ + finiteExtensionDifferentExceptionalSet K L) ∪ + {ratFuncInfinityPlaceChart K} + +theorem finiteExtensionCotraceBadBaseSet_finite + (a : FunctionField.Chart.AdeleSpace K L) : + (finiteExtensionCotraceBadBaseSet K L a).Finite := by + apply Set.Finite.union + · exact ((finiteExtensionAdeleExceptionalSet_finite K L a).union + (finiteExtensionDifferentExceptionalSet_finite K L)).image + (finiteExtensionUnderPlaceChart K L) + · exact Set.finite_singleton _ + +/-- The infinity component of the rational-function chart contains only the +place transported from the BGS infinity valuation ring. -/ +theorem ratFunc_infinite_chart_place_eq + (p : HeightOneSpectrum + (FunctionField.Chart.infiniteIntegers K (RatFunc K))) : + (Sum.inr p : FunctionField.Chart.PlaceA K (RatFunc K)) = + ratFuncInfinityPlaceChart K := by + let e := HeightOneSpectrum.equivOfRingEquiv + (ratFuncInfinityBaseRingEquivChart K) + have hsource : e.symm p = ratFuncInfinityPlace K := by + apply HeightOneSpectrum.ext + exact (IsLocalRing.eq_maximalIdeal + ((e.symm p).isPrime.isMaximal (e.symm p).ne_bot)).trans + (IsLocalRing.eq_maximalIdeal + ((ratFuncInfinityPlace K).isPrime.isMaximal + (ratFuncInfinityPlace K).ne_bot)).symm + change Sum.inr p = Sum.inr (e (ratFuncInfinityPlace K)) + apply congrArg Sum.inr + rw [← hsource, e.apply_symm_apply] + +/-- Outside the explicit finite exceptional set, the raw componentwise trace +is integral at the base chart place. -/ +theorem finiteExtensionFiberTraceRaw_mem_placeValuationSubring_of_not_bad + (a : finiteExtensionFiberConstantAdeleSubmodule K L) + (p : FunctionField.Chart.PlaceA K (RatFunc K)) + (hp : p ∉ finiteExtensionCotraceBadBaseSet K L a.1) : + finiteExtensionFiberTraceRaw K L a p ∈ + FunctionField.Chart.placeValuationSubring K (RatFunc K) p := by + rcases p with p | p + · let e := HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteBaseRingEquivChart K) + let p₀ : HeightOneSpectrum K[X] := e.symm p + let q₀ := finiteExtensionPlaceSectionChart K L + (Sum.inl p : FunctionField.Chart.PlaceA K (RatFunc K)) + let y : L := a.1.1 q₀ + by_cases hy : y = 0 + · change Algebra.trace (RatFunc K) L y ∈ _ + rw [hy, map_zero] + exact zero_mem _ + have hnotTop (q : FunctionField.Chart.PlaceA K L) + (hq : finiteExtensionUnderPlaceChart K L q = Sum.inl p) : + q ∉ finiteExtensionAdeleExceptionalSet K L a.1 ∪ + finiteExtensionDifferentExceptionalSet K L := by + intro hqbad + apply hp + apply Or.inl + exact ⟨q, hqbad, hq⟩ + have hlocal : ∀ q : HeightOneSpectrum + (RatFuncFiniteIntegralClosure K L), + q.under K[X] = p₀ → + -(multiplicity q.asIdeal + (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton + (RatFuncFiniteIntegralClosure K L)⁰ y) := by + intro q hqUnder + let qChart : FunctionField.Chart.PlaceA K L := + finiteExtensionPlaceEquivChart K L (.inl q) + have hpImage : e p₀ = p := e.apply_symm_apply p + have hqBelow : finiteExtensionUnderPlaceChart K L qChart = + Sum.inl p := by + change ratFuncExhaustivePlaceEquivChart K + (Sum.inl (q.under K[X])) = Sum.inl p + rw [hqUnder] + change Sum.inl (e p₀) = Sum.inl p + rw [hpImage] + have hqGood := hnotTop qChart hqBelow + have hqAdele : qChart ∉ + finiteExtensionAdeleExceptionalSet K L a.1 := by + exact fun h => hqGood (Or.inl h) + have hqDifferent : qChart ∉ + finiteExtensionDifferentExceptionalSet K L := by + exact fun h => hqGood (Or.inr h) + have hyEq : a.1.1 qChart = y := by + have hcomponent := fiberConstant_component_eq_section K L a qChart + rw [hqBelow] at hcomponent + exact hcomponent + have hqMem : a.1.1 qChart ∈ + FunctionField.Chart.placeValuationSubring K L qChart := by + exact Classical.not_not.mp hqAdele + have hqValChart : FunctionField.Chart.placeValuation K L qChart + (a.1.1 qChart) ≤ 1 := by + rwa [← Valuation.mem_valuationSubring_iff] + have hqVal : q.valuation L y ≤ 1 := by + rw [← hyEq] + simpa [qChart, finiteExtensionPlaceEquivChart, + FunctionField.Chart.placeValuation] using hqValChart + have hqCount : 0 ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton + (RatFuncFiniteIntegralClosure K L)⁰ y) := + zero_le_count_spanSingleton_of_valuation_le_one q hy hqVal + have hqMultiplicity : multiplicity q.asIdeal + (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) = 0 := by + by_contra hne + apply hqDifferent + exact ⟨Sum.inl q, ⟨q, hne, rfl⟩, rfl⟩ + rw [hqMultiplicity] + simpa using hqCount + have htraceBase : p₀.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ 1 := + valuation_trace_le_one_of_different_count_bounds_over + (A := K[X]) (K₀ := RatFunc K) + (B := RatFuncFiniteIntegralClosure K L) (L := L) + p₀ hy hlocal + have htraceChart : (e p₀).valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ 1 := by + apply heightOneValuation_le_one_of_ringEquiv + (ratFuncFiniteBaseRingEquivChart K) + (ratFuncFiniteBaseRingEquivChart_algebraMap K) + p₀ (e p₀) rfl htraceBase + change p.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ 1 + have hpImage : e p₀ = p := e.apply_symm_apply p + rw [hpImage] at htraceChart + exact htraceChart + · exfalso + apply hp + apply Or.inr + exact Set.mem_singleton_iff.mpr (ratFunc_infinite_chart_place_eq K p) + +/-- Componentwise field trace as an actual rational-function adele. -/ +def finiteExtensionFiberTrace : + finiteExtensionFiberConstantAdeleSubmodule K L →ₗ[K] + FunctionField.Chart.AdeleSpace K (RatFunc K) where + toFun a := ⟨finiteExtensionFiberTraceRaw K L a, by + change ∀ᶠ p : FunctionField.Chart.PlaceA K (RatFunc K) in + Filter.cofinite, + finiteExtensionFiberTraceRaw K L a p ∈ + FunctionField.Chart.placeValuationSubring K (RatFunc K) p + rw [Filter.eventually_cofinite] + refine (finiteExtensionCotraceBadBaseSet_finite K L a.1).subset ?_ + intro p hp + by_contra hpBad + exact hp (finiteExtensionFiberTraceRaw_mem_placeValuationSubring_of_not_bad + K L a p hpBad)⟩ + map_add' a b := by + apply Subtype.ext + exact congrArg (fun f => f) ((finiteExtensionFiberTraceRaw K L).map_add a b) + map_smul' c a := by + apply Subtype.ext + exact congrArg (fun f => f) ((finiteExtensionFiberTraceRaw K L).map_smul c a) + +/-- Lift a base adele to a fiber-constant upstairs adele after multiplying by +a fixed extension-field element. -/ +def finiteExtensionFiberLift (z : L) + (b : FunctionField.Chart.AdeleSpace K (RatFunc K)) : + finiteExtensionFiberConstantAdeleSubmodule K L := by + letI : Filter.TendstoCofinite (finiteExtensionUnderPlaceChart K L) := + finiteExtensionUnderPlaceChart_tendstoCofinite K L + let a : FunctionField.Chart.AdeleSpace K L := + ⟨fun q => z * algebraMap (RatFunc K) L + (b.1 (finiteExtensionUnderPlaceChart K L q)), by + have hz := FunctionField.Chart.eventually_mem_placeValuationSubring K L z + have hb : ∀ᶠ q : FunctionField.Chart.PlaceA K L in Filter.cofinite, + b.1 (finiteExtensionUnderPlaceChart K L q) ∈ + FunctionField.Chart.placeValuationSubring K (RatFunc K) + (finiteExtensionUnderPlaceChart K L q) := + Filter.TendstoCofinite.tendsto_cofinite + (finiteExtensionUnderPlaceChart K L) b.2 + filter_upwards [hz, hb] with q hzq hbq + apply mul_mem hzq + exact finiteExtension_placeValuation_algebraMap_le_one K L q hbq⟩ + refine ⟨a, ?_⟩ + intro q r hqr + change z * algebraMap (RatFunc K) L + (b.1 (finiteExtensionUnderPlaceChart K L q)) = + z * algebraMap (RatFunc K) L + (b.1 (finiteExtensionUnderPlaceChart K L r)) + rw [hqr] + +/-- Cotrace of the lifted adele is scalar multiplication by `Tr(z)`. -/ +theorem finiteExtensionFiberTrace_lift (z : L) + (b : FunctionField.Chart.AdeleSpace K (RatFunc K)) : + finiteExtensionFiberTrace K L (finiteExtensionFiberLift K L z b) = + (Algebra.trace (RatFunc K) L z) • b := by + apply Subtype.ext + funext p + change Algebra.trace (RatFunc K) L + ((finiteExtensionFiberLift K L z b).1.1 + (finiteExtensionPlaceSectionChart K L p)) = + Algebra.trace (RatFunc K) L z * b.1 p + change Algebra.trace (RatFunc K) L + (z * algebraMap (RatFunc K) L + (b.1 (finiteExtensionUnderPlaceChart K L + (finiteExtensionPlaceSectionChart K L p)))) = _ + rw [finiteExtensionUnderPlaceChart_section] + simpa [Algebra.smul_def, mul_comm] using + (Algebra.trace (RatFunc K) L).map_smul (b.1 p) z + +/-- Componentwise cotrace is onto the base adele space. -/ +theorem finiteExtensionFiberTrace_surjective : + Function.Surjective (finiteExtensionFiberTrace K L) := by + intro b + obtain ⟨z, hz⟩ := Algebra.trace_surjective (RatFunc K) L (1 : RatFunc K) + refine ⟨finiteExtensionFiberLift K L z b, ?_⟩ + rw [finiteExtensionFiberTrace_lift K L z b, hz, one_smul] + +/-- At a finite base place, the componentwise trace of a fiber-constant +adele in the explicit different filtration is integral. -/ +theorem finiteExtensionFiberTrace_finite_valuation_le_one + (a : finiteExtensionFiberConstantAdeleSubmodule K L) + (ha : a.1 ∈ FunctionField.Chart.adeleFilt K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)))) + (p : HeightOneSpectrum + (FunctionField.ringOfIntegers K (RatFunc K))) : + p.valuation (RatFunc K) + ((finiteExtensionFiberTrace K L a).1 (.inl p)) ≤ 1 := by + let e := HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteBaseRingEquivChart K) + let p₀ : HeightOneSpectrum K[X] := e.symm p + let q₀ := finiteExtensionPlaceSectionChart K L + (Sum.inl p : FunctionField.Chart.PlaceA K (RatFunc K)) + let y : L := a.1.1 q₀ + by_cases hy : y = 0 + · change p.valuation (RatFunc K) (Algebra.trace (RatFunc K) L y) ≤ 1 + rw [hy, map_zero, Valuation.map_zero] + exact zero_le + have hlocal : ∀ q : HeightOneSpectrum + (RatFuncFiniteIntegralClosure K L), + q.under K[X] = p₀ → + -(multiplicity q.asIdeal + (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton + (RatFuncFiniteIntegralClosure K L)⁰ y) := by + intro q hqUnder + let qChart : FunctionField.Chart.PlaceA K L := + finiteExtensionPlaceEquivChart K L (.inl q) + have hpImage : e p₀ = p := e.apply_symm_apply p + have hqBelow : finiteExtensionUnderPlaceChart K L qChart = + Sum.inl p := by + change ratFuncExhaustivePlaceEquivChart K + (Sum.inl (q.under K[X])) = Sum.inl p + rw [hqUnder] + change Sum.inl (e p₀) = Sum.inl p + rw [hpImage] + have hyEq : a.1.1 qChart = y := by + have hcomponent := fiberConstant_component_eq_section K L a qChart + rw [hqBelow] at hcomponent + exact hcomponent + have hqFilter := ha qChart + have hqFilter' : q.valuation L y ≤ + WithZero.exp + (multiplicity q.asIdeal + (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) : ℤ) := by + rw [← hyEq] + simpa [qChart, finiteExtensionPlaceEquivChart, + FunctionField.Chart.placeValuation, + finiteExtensionDivisorEquivChart, Finsupp.domCongr_apply, + finiteExtensionCanonicalDifferentDivisor_inl] using hqFilter + have hqValuation := valuation_eq_exp_neg_finitePlaceOrder q y hy + rw [hqValuation] at hqFilter' + have hqExp := WithZero.exp_le_exp.mp hqFilter' + change -FractionalIdeal.count L q + (FractionalIdeal.spanSingleton + (RatFuncFiniteIntegralClosure K L)⁰ y) ≤ + (multiplicity q.asIdeal + (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) : ℤ) at hqExp + omega + have htraceBase : p₀.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ 1 := + valuation_trace_le_one_of_different_count_bounds_over + (A := K[X]) (K₀ := RatFunc K) + (B := RatFuncFiniteIntegralClosure K L) (L := L) + p₀ hy hlocal + have htraceChart : (e p₀).valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ 1 := by + apply heightOneValuation_le_one_of_ringEquiv + (ratFuncFiniteBaseRingEquivChart K) + (ratFuncFiniteBaseRingEquivChart_algebraMap K) + p₀ (e p₀) rfl htraceBase + have hpImage : e p₀ = p := e.apply_symm_apply p + change p.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ 1 + rw [hpImage] at htraceChart + exact htraceChart + +/-- At the infinite base place, the componentwise trace of a fiber-constant +adele in the explicit different filtration has order at least two. -/ +theorem finiteExtensionFiberTrace_infinite_valuation_le_exp_neg_two + (a : finiteExtensionFiberConstantAdeleSubmodule K L) + (ha : a.1 ∈ FunctionField.Chart.adeleFilt K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)))) + (p : HeightOneSpectrum + (FunctionField.Chart.infiniteIntegers K (RatFunc K))) : + p.valuation (RatFunc K) + ((finiteExtensionFiberTrace K L a).1 (.inr p)) ≤ + WithZero.exp (-2 : ℤ) := by + let pInf := ratFuncInfinityPlace K + let pChart := HeightOneSpectrum.equivOfRingEquiv + (ratFuncInfinityBaseRingEquivChart K) pInf + have hpChart : p = pChart := by + apply Sum.inr_injective + calc + Sum.inr p = ratFuncInfinityPlaceChart K := + ratFunc_infinite_chart_place_eq K p + _ = Sum.inr pChart := rfl + let q₀ := finiteExtensionPlaceSectionChart K L + (Sum.inr p : FunctionField.Chart.PlaceA K (RatFunc K)) + let y : L := a.1.1 q₀ + by_cases hy : y = 0 + · change p.valuation (RatFunc K) (Algebra.trace (RatFunc K) L y) ≤ _ + rw [hy, map_zero, Valuation.map_zero] + exact zero_le + let s := ratFuncInfinityUniformizer K + have hs : s ≠ 0 := by + intro h + have hcoe := congrArg Subtype.val h + exact (one_div_ne_zero RatFunc.X_ne_zero) hcoe + let t : RatFunc K := algebraMap (RatFuncInfinityIntegers K) (RatFunc K) s + let tL : L := algebraMap (RatFuncInfinityIntegers K) L s + have htL : tL ≠ 0 := by + simpa only [tL, map_zero] using + (FaithfulSMul.algebraMap_injective + (RatFuncInfinityIntegers K) L).ne hs + let z : L := (tL ^ 2)⁻¹ * y + have hz : z ≠ 0 := mul_ne_zero (inv_ne_zero (pow_ne_zero 2 htL)) hy + have hlocal : ∀ q : HeightOneSpectrum + (RatFuncInfinityIntegralClosure K L), + q.under (RatFuncInfinityIntegers K) = pInf → + -(multiplicity q.asIdeal + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton + (RatFuncInfinityIntegralClosure K L)⁰ z) := by + intro q hqUnder + letI : q.asIdeal.LiesOver pInf.asIdeal := ⟨by + have hideal := congrArg HeightOneSpectrum.asIdeal hqUnder + exact hideal.symm⟩ + let P : FiniteExtensionInfinityPlace K L := + (finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm q + have hPq : primeOverHeightOne (ratFuncInfinityPlace K) P = q := + (finiteExtensionInfinityPrimesOverEquivHeightOne K L).apply_symm_apply q + let qChart : FunctionField.Chart.PlaceA K L := + finiteExtensionPlaceEquivChart K L (.inr P) + have hqBelow : finiteExtensionUnderPlaceChart K L qChart = + Sum.inr p := by + calc + finiteExtensionUnderPlaceChart K L qChart = + ratFuncInfinityPlaceChart K := by rfl + _ = Sum.inr p := (ratFunc_infinite_chart_place_eq K p).symm + have hyEq : a.1.1 qChart = y := by + have hcomponent := fiberConstant_component_eq_section K L a qChart + rw [hqBelow] at hcomponent + exact hcomponent + have hqFilter := ha qChart + have hcoeff : + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) qChart = + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P.1.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) := by + simp [qChart, finiteExtensionDivisorEquivChart, + Finsupp.domCongr_apply, + finiteExtensionCanonicalDifferentDivisor_inr] + rw [hcoeff] at hqFilter + have hvaluationEq : + (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L y = + FunctionField.Chart.placeValuation K L qChart y := by + simpa only [finiteExtensionPlaceValuation, qChart] using + congrArg (fun v : Valuation L ℤᵐ⁰ => v y) + (finiteExtensionPlaceValuation_eq_chart K L (.inr P)) + have hqFilterBGS : + (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L y ≤ + WithZero.exp + ((multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P.1.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ)) := by + rw [hvaluationEq] + simpa only [hyEq] using hqFilter + rw [hPq] at hqFilterBGS + have hqValuation := valuation_eq_exp_neg_finitePlaceOrder q y hy + rw [hqValuation] at hqFilterBGS + have hqOrderBound := WithZero.exp_le_exp.mp hqFilterBGS + change -finitePlaceOrder q y ≤ + (multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P.1.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) at hqOrderBound + have htOrder : finitePlaceOrder q tL = + (q.asIdeal.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) := by + simpa only [tL, IsScalarTower.algebraMap_apply + (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) L] using + finitePlaceOrder_algebraMap_uniformizer_eq_ramificationIdx + (R := RatFuncInfinityIntegers K) + (A := RatFuncInfinityIntegralClosure K L) (F := L) + pInf q s hs (ratFuncInfinityPlace_span_uniformizer K) + have htSquareOrder := finitePlaceOrder_mul_eq_add q tL tL htL htL + rw [← pow_two] at htSquareOrder + have htInvOrder := finitePlaceOrder_inv_eq_neg' q (tL ^ 2) + (pow_ne_zero 2 htL) + have hzOrder := finitePlaceOrder_mul_eq_add q (tL ^ 2)⁻¹ y + (inv_ne_zero (pow_ne_zero 2 htL)) hy + have hram : P.1.ramificationIdx (RatFuncInfinityIntegers K) = + q.asIdeal.ramificationIdx (RatFuncInfinityIntegers K) := by + rw [← hPq] + rfl + have hPideal : P.1 = q.asIdeal := by + rw [← hPq] + rfl + change -(multiplicity q.asIdeal + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) ≤ + finitePlaceOrder q ((tL ^ 2)⁻¹ * y) + rw [hzOrder, htInvOrder, htSquareOrder, htOrder] + rw [hPideal] at hqOrderBound + omega + have htraceScaled : pInf.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L z) ≤ 1 := + valuation_trace_le_one_of_different_count_bounds_over + (A := RatFuncInfinityIntegers K) (K₀ := RatFunc K) + (B := RatFuncInfinityIntegralClosure K L) (L := L) + pInf hz hlocal + have htTower : tL = algebraMap (RatFunc K) L t := by + exact (IsScalarTower.algebraMap_apply + (RatFuncInfinityIntegers K) (RatFunc K) L s).symm + have htraceZ : Algebra.trace (RatFunc K) L z = + (t ^ 2)⁻¹ * Algebra.trace (RatFunc K) L y := by + have hscalar : (tL ^ 2)⁻¹ * y = ((t ^ 2)⁻¹) • y := by + rw [Algebra.smul_def, htTower, map_inv₀, map_pow] + change Algebra.trace (RatFunc K) L ((tL ^ 2)⁻¹ * y) = + ((t ^ 2)⁻¹) • Algebra.trace (RatFunc K) L y + rw [hscalar] + exact (Algebra.trace (RatFunc K) L).map_smul ((t ^ 2)⁻¹) y + rw [htraceZ, map_mul, map_inv₀, map_pow] at htraceScaled + have htVal : pInf.valuation (RatFunc K) t = WithZero.exp (-1 : ℤ) := by + change pInf.valuation (RatFunc K) + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K) s) = _ + rw [HeightOneSpectrum.valuation_of_algebraMap] + exact pInf.intValuation_singleton hs + (ratFuncInfinityPlace_span_uniformizer K) + rw [htVal] at htraceScaled + have hbase : pInf.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ WithZero.exp (-2 : ℤ) := by + apply le_of_mul_le_mul_left ?_ (WithZero.exp_pos : + 0 < WithZero.exp (2 : ℤ)) + calc + WithZero.exp (2 : ℤ) * pInf.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) = + ((WithZero.exp (-1 : ℤ)) ^ 2)⁻¹ * + pInf.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) := by norm_num + _ ≤ 1 := htraceScaled + _ = WithZero.exp (2 : ℤ) * WithZero.exp (-2 : ℤ) := by + rw [← WithZero.exp_add] + norm_num + have hchart : pChart.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ WithZero.exp (-2 : ℤ) := by + have hvaluation : pInf.valuation (RatFunc K) = + pChart.valuation (RatFunc K) := + heightOneValuation_eq_of_ringEquiv + (ratFuncInfinityBaseRingEquivChart K) + (ratFuncInfinityBaseRingEquivChart_algebraMap K) + pInf pChart rfl + rw [← hvaluation] + exact hbase + change p.valuation (RatFunc K) + (Algebra.trace (RatFunc K) L y) ≤ WithZero.exp (-2 : ℤ) + rw [hpChart] + exact hchart + +/-- The infinity place selected for the identity extension is the unique +infinity place in the base chart. -/ +theorem ratFuncInfinityChartPlace_eq_baseChart : + ratFuncInfinityChartPlace K = ratFuncInfinityPlaceChart K := by + let p : HeightOneSpectrum + (FunctionField.Chart.infiniteIntegers K (RatFunc K)) := + finiteExtensionInfinityPlaceEquivChart K (RatFunc K) + (ratFuncIdentityInfinityPlace K) + change Sum.inr p = ratFuncInfinityPlaceChart K + exact ratFunc_infinite_chart_place_eq K p + +/-- The cotrace sends the explicit different filtration into the canonical +`-2∞` filtration on the rational function field. -/ +theorem finiteExtensionFiberTrace_mem_ratFuncCanonicalInfinityAdeleFilt + (a : finiteExtensionFiberConstantAdeleSubmodule K L) + (ha : a.1 ∈ FunctionField.Chart.adeleFilt K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)))) : + finiteExtensionFiberTrace K L a ∈ + FunctionField.Chart.adeleFilt K (RatFunc K) + (ratFuncCanonicalInfinityDivisor K) := by + intro v + rcases v with p | p + · have h := finiteExtensionFiberTrace_finite_valuation_le_one K L a ha p + have hcoeff : ratFuncCanonicalInfinityDivisor K (Sum.inl p) = 0 := by + rw [ratFuncCanonicalInfinityDivisor, + Finsupp.single_eq_of_ne] + change Sum.inl p ≠ Sum.inr _ + exact Sum.inl_ne_inr + rw [hcoeff, WithZero.exp_zero] + exact h + · have h := finiteExtensionFiberTrace_infinite_valuation_le_exp_neg_two + K L a ha p + have hp : (Sum.inr p : FunctionField.Chart.PlaceA K (RatFunc K)) = + ratFuncInfinityChartPlace K := by + rw [ratFuncInfinityChartPlace_eq_baseChart K] + exact ratFunc_infinite_chart_place_eq K p + have hcoeff : ratFuncCanonicalInfinityDivisor K (Sum.inr p) = -2 := by + rw [ratFuncCanonicalInfinityDivisor, hp, Finsupp.single_eq_same] + rw [hcoeff] + exact h + +/-- Principal adeles are fiber-constant. -/ +theorem finiteExtension_diagonal_mem_fiberConstant (x : L) : + FunctionField.Chart.diagonal K L x ∈ + finiteExtensionFiberConstantAdeleSubmodule K L := by + intro q r _hqr + rfl + +/-- Cotrace carries a principal adele to the principal adele of the field +trace. -/ +theorem finiteExtensionFiberTrace_diagonal (x : L) : + finiteExtensionFiberTrace K L + ⟨FunctionField.Chart.diagonal K L x, + finiteExtension_diagonal_mem_fiberConstant K L x⟩ = + FunctionField.Chart.diagonal K (RatFunc K) + (Algebra.trace (RatFunc K) L x) := by + apply Subtype.ext + funext p + rfl + +/-- The base canonical functional composed with cotrace vanishes on the +intersection of fiber-constant adeles with the explicit different +filtration plus principal adeles. -/ +theorem finiteExtensionFiberCotrace_vanishes_on_intersection + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (hωvan : ratFuncCanonicalInfinityDivisor K ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ω) + (x : ↥(finiteExtensionFiberConstantAdeleSubmodule K L ⊓ + (FunctionField.Chart.adeleFilt K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) + + FunctionField.Chart.diagonalSubmodule K L))) : + (ω.toFun.comp (finiteExtensionFiberTrace K L)) + ⟨x.1, x.2.1⟩ = 0 := by + let U := finiteExtensionFiberConstantAdeleSubmodule K L + let D := finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + have hxsum : x.1 ∈ FunctionField.Chart.adeleFilt K L D ⊔ + FunctionField.Chart.diagonalSubmodule K L := by + rw [← Submodule.add_eq_sup] + exact x.2.2 + rcases Submodule.mem_sup.mp hxsum with ⟨a, ha, d, hd, had⟩ + obtain ⟨y, rfl⟩ := hd + let dU : U := + ⟨FunctionField.Chart.diagonal K L y, + finiteExtension_diagonal_mem_fiberConstant K L y⟩ + have haUmem : a ∈ U := by + have hsub := U.sub_mem x.2.1 dU.2 + have haEq : x.1 - FunctionField.Chart.diagonal K L y = a := by + rw [← had] + abel + rw [haEq] at hsub + exact hsub + let aU : U := ⟨a, haUmem⟩ + have hxEq : (⟨x.1, x.2.1⟩ : U) = aU + dU := by + apply Subtype.ext + exact had.symm + have htraceA : finiteExtensionFiberTrace K L aU ∈ + FunctionField.Chart.adeleFilt K (RatFunc K) + (ratFuncCanonicalInfinityDivisor K) := + finiteExtensionFiberTrace_mem_ratFuncCanonicalInfinityAdeleFilt + K L aU ha + have htraceD : finiteExtensionFiberTrace K L dU ∈ + FunctionField.Chart.diagonalSubmodule K (RatFunc K) := by + rw [finiteExtensionFiberTrace_diagonal K L y] + exact ⟨Algebra.trace (RatFunc K) L y, rfl⟩ + apply hωvan + rw [hxEq, map_add] + rw [Submodule.add_eq_sup] + exact Submodule.add_mem_sup htraceA htraceD + +/-- A nonzero base Weil functional stays nonzero after composition with the +surjective fiber cotrace. -/ +theorem finiteExtensionFiberCotrace_ne_zero + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (hω : ω.toFun ≠ 0) : + ω.toFun.comp (finiteExtensionFiberTrace K L) ≠ 0 := by + intro hzero + apply hω + apply LinearMap.ext + intro b + obtain ⟨a, ha⟩ := finiteExtensionFiberTrace_surjective K L b + have hz := LinearMap.congr_fun hzero a + change ω.toFun ((finiteExtensionFiberTrace K L) a) = 0 at hz + rw [ha] at hz + exact hz + +/-- The explicit finite-extension different divisor is a vanishing divisor +of a nonzero Weil differential. Consequently it is bounded above by the +maximal divisor of that differential. -/ +theorem finiteExtensionCanonicalDifferent_le_divOmega + [FunctionField.IsFullConstantField K L] : + ∃ (ωTop : FunctionField.Chart.WeilDifferential K L) + (hωTop : FunctionField.Chart.WeilDifferential.IsNonzero ωTop), + finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + FunctionField.Chart.WeilDifferential.divOmega ωTop hωTop := by + obtain ⟨ωBase, hωBase, hdivBase⟩ := + ratFuncCanonicalInfinityDivisor_isCanonical K + have hmaxBase : + FunctionField.Chart.WeilDifferential.divOmega ωBase hωBase ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωBase ∧ + ∀ D ∈ FunctionField.Chart.WeilDifferential.vanishingDivisors ωBase, + D ≤ FunctionField.Chart.WeilDifferential.divOmega ωBase hωBase := by + simpa only [FunctionField.Chart.WeilDifferential.divOmega] using + (Classical.choose_spec + (FunctionField.Chart.WeilDifferential.exists_max_vanishingDivisor + (k := K) (K := RatFunc K) hωBase)).1 + have hbaseVan : ratFuncCanonicalInfinityDivisor K ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωBase := by + rw [hdivBase] at hmaxBase + exact hmaxBase.1 + let U := finiteExtensionFiberConstantAdeleSubmodule K L + let D := finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + let V := FunctionField.Chart.adeleFilt K L D + + FunctionField.Chart.diagonalSubmodule K L + let f := ωBase.toFun.comp (finiteExtensionFiberTrace K L) + have hfVan : ∀ x : ↥(U ⊓ V), f ⟨x, x.property.1⟩ = 0 := by + intro x + exact finiteExtensionFiberCotrace_vanishes_on_intersection + K L ωBase hbaseVan x + have hfNe : f ≠ 0 := + finiteExtensionFiberCotrace_ne_zero K L ωBase hωBase + obtain ⟨g, hgU, hgV, hgNe⟩ := + exists_ne_zero_linearMap_extending_eq_zero_on_inf U V f hfVan hfNe + let ωTop : FunctionField.Chart.WeilDifferential K L := + ⟨g, ⟨D, fun a ha => LinearMap.mem_ker.mp (hgV ha)⟩⟩ + have hωTop : FunctionField.Chart.WeilDifferential.IsNonzero ωTop := by + exact hgNe + have hDvan : D ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop := by + intro a ha + exact LinearMap.mem_ker.mp (hgV ha) + have hmaxTop : + FunctionField.Chart.WeilDifferential.divOmega ωTop hωTop ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop ∧ + ∀ D' ∈ FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop, + D' ≤ FunctionField.Chart.WeilDifferential.divOmega ωTop hωTop := by + simpa only [FunctionField.Chart.WeilDifferential.divOmega] using + (Classical.choose_spec + (FunctionField.Chart.WeilDifferential.exists_max_vanishingDivisor + (k := K) (K := L) hωTop)).1 + exact ⟨ωTop, hωTop, hmaxTop.2 D hDvan⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean new file mode 100644 index 0000000000..7d22bf802d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion + +/-! +# Canonicality from cotrace and the different degree + +The cotrace construction proves that the explicit different divisor is a +vanishing divisor of a nonzero Weil differential. This file records the +exact consequence of that inclusion: once the Riemann--Hurwitz degree identity +is known, equality of degrees forces equality with the maximal vanishing +divisor. Thus canonicality no longer needs a separate Riemann--Roch dimension +hypothesis. + +The degree identity remains an explicit premise; it is not derived or hidden +here. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance cotraceCanonicalityConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance cotraceCanonicalityConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) cotraceCanonicalityPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance cotraceCanonicalityPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance cotraceCanonicalityConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The cotrace inclusion and the Riemann--Hurwitz degree identity identify +the explicit different divisor with a canonical divisor. -/ +theorem finiteExtensionCanonicalDifferent_isCanonical_of_degree_eq + [FunctionField.IsFullConstantField K L] + (hdegree : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2) : + FunctionField.Chart.IsCanonical K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) := by + let D := finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + obtain ⟨ω, hω, hDle⟩ := + finiteExtensionCanonicalDifferent_le_divOmega K L + have hcanonicalOmega : FunctionField.Chart.IsCanonical K L + (FunctionField.Chart.WeilDifferential.divOmega ω hω) := + ⟨ω, hω, rfl⟩ + have hdegOmega : FunctionField.Chart.deg K L + (FunctionField.Chart.WeilDifferential.divOmega ω hω) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := + FunctionField.Chart.deg_canonical K L hcanonicalOmega + have hdegD : FunctionField.Chart.deg K L D = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [← finiteExtensionDivisorDegree_eq_chart] + exact hdegree + have heq : D = FunctionField.Chart.WeilDifferential.divOmega ω hω := + FunctionField.Chart.eq_of_le_of_deg_le K L hDle (by + rw [hdegOmega, hdegD]) + exact ⟨ω, hω, heq.symm⟩ + +/-- Consequently, a degree upper bound gives a genus upper bound once the +Riemann--Hurwitz degree identity is supplied. -/ +theorem finiteExtension_genus_le_budget_of_cotrace_and_degree_eq + [FunctionField.IsFullConstantField K L] + (budget : ℕ) + (hdegreeEq : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2) + (hdegreeLe : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + 2 * (budget : ℤ) - 2) : + FunctionField.genus K L ≤ budget := by + exact finiteExtension_genus_le_budget_of_canonicalDifferent_isCanonical + K L budget + (finiteExtensionCanonicalDifferent_isCanonical_of_degree_eq + K L hdegreeEq) + hdegreeLe + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean new file mode 100644 index 0000000000..74f8ef374a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower + +/-! +# Canonical-different genus bridge + +The explicit different divisor used by the Corvaja--Zannier development has +the correct degree bound under only one separating coordinate. This module +isolates the exact remaining bridge to the intrinsic Riemann--Roch genus: +after transporting that divisor to the Riemann--Roch chart, it must be shown +to be canonical. + +No canonicality premise is hidden in a definition. The generic theorem +below takes `FunctionField.Chart.IsCanonical` explicitly, while the plane +theorem proves the complete degree estimate available below that boundary. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance canonicalGenusConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance canonicalGenusConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) canonicalGenusPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance canonicalGenusPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance canonicalGenusConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Identifying the explicit different divisor with a canonical divisor +turns any upper bound for its degree into a genus bound. -/ +theorem finiteExtension_genus_le_budget_of_canonicalDifferent_isCanonical + [FunctionField.IsFullConstantField K L] + (budget : ℕ) + (hcanonical : FunctionField.Chart.IsCanonical K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)))) + (hdegree : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + 2 * (budget : ℤ) - 2) : + FunctionField.genus K L ≤ budget := by + let D := finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + have hcanonicalDegree : finiteExtensionDivisorDegree K L D = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [finiteExtensionDivisorDegree_eq_chart] + exact FunctionField.Chart.deg_canonical K L hcanonical + have hchart : FunctionField.Chart.genus K L ≤ budget := by + have hdegree' : finiteExtensionDivisorDegree K L D ≤ + 2 * (budget : ℤ) - 2 := by + simpa only [D] using hdegree + have hcast : (FunctionField.Chart.genus K L : ℤ) ≤ budget := by + omega + exact_mod_cast hcast + rw [FunctionField.genus_eq_genusChart K L] + exact hchart + +end + +noncomputable section + +open BGS.CorvajaZannier + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- The one-separating-coordinate canonical-degree estimate already has +exactly the degree shape needed for the bidegree genus budget. -/ +theorem planeCurve_canonicalDifferentDivisor_degree_le_two_genusBudget_sub_two + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) ≤ + 2 * (planeCurveBidegreeGenusBudget f : ℤ) - 2 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hcanonical := + planeCurve_canonicalDifferentDivisor_degree_le + hf hpartialSecond hcardK + have hb : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + change finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) ≤ + 2 * (((MvPolynomial.degreeOf 0 f - 1) * + (MvPolynomial.degreeOf 1 f - 1) : ℕ) : ℤ) - 2 + by_cases ha : MvPolynomial.degreeOf 0 f = 0 + · rw [ha] at hcanonical ⊢ + simp only [Nat.zero_sub, zero_mul, Nat.cast_zero, zero_mul] + omega + · have ha' : 1 ≤ MvPolynomial.degreeOf 0 f := + Nat.one_le_iff_ne_zero.mpr ha + have hb' : 1 ≤ MvPolynomial.degreeOf 1 f := by omega + rw [Nat.cast_mul, Nat.cast_sub ha', Nat.cast_sub hb'] + push_cast + nlinarith [hcanonical] + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean new file mode 100644 index 0000000000..dd214decdd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean @@ -0,0 +1,782 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion + +/-! +# Local maximality of the canonical different by cotrace + +This file connects the generic trace-image theorem formalizing Stichtenoth, +Theorem 3.4.6, Step (b1), to the explicit `-2∞` base differential and the +extension-place filtration. A one-place witness detects every divisor not +bounded by the trace-different divisor. Applied to the glued cotrace Weil +functional, this proves that the trace-different divisor is its exact maximal +vanishing divisor, without assuming a Riemann--Hurwitz degree identity. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain Multiplicative WithZero +open scoped Polynomial nonZeroDivisors + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- At every base chart place, maximality of the canonical `-2∞` +differential supplies a one-component adele at the first filtration step on +which the differential is nonzero. -/ +theorem ratFuncCanonicalWeil_exists_singlePlace_witness + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (hω : FunctionField.Chart.WeilDifferential.IsNonzero ω) + (hdiv : FunctionField.Chart.WeilDifferential.divOmega ω hω = + ratFuncCanonicalInfinityDivisor K) + (p : FunctionField.Chart.PlaceA K (RatFunc K)) : + ∃ a : FunctionField.Chart.AdeleSpace K (RatFunc K), + a ∈ FunctionField.Chart.adeleFilt K (RatFunc K) + (ratFuncCanonicalInfinityDivisor K + Finsupp.single p 1) ∧ + ω.toFun a ≠ 0 ∧ + (∀ v ≠ p, a.1 v = 0) ∧ + FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p) = + WithZero.exp (ratFuncCanonicalInfinityDivisor K p + 1) := by + classical + let D := ratFuncCanonicalInfinityDivisor K + let E := D + Finsupp.single p 1 + have hmax : + FunctionField.Chart.WeilDifferential.divOmega ω hω ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ω ∧ + ∀ D' ∈ FunctionField.Chart.WeilDifferential.vanishingDivisors ω, + D' ≤ FunctionField.Chart.WeilDifferential.divOmega ω hω := by + simpa only [FunctionField.Chart.WeilDifferential.divOmega] using + (Classical.choose_spec + (FunctionField.Chart.WeilDifferential.exists_max_vanishingDivisor + (k := K) (K := RatFunc K) hω)).1 + rw [hdiv] at hmax + have hEnot : E ∉ + FunctionField.Chart.WeilDifferential.vanishingDivisors ω := by + intro hE + have hle := hmax.2 E hE p + simp only [E, D, Finsupp.add_apply, Finsupp.single_eq_same] at hle + omega + change ¬ ∀ a, a ∈ + FunctionField.Chart.adeleFilt K (RatFunc K) E + + FunctionField.Chart.diagonalSubmodule K (RatFunc K) → + ω.toFun a = 0 at hEnot + push Not at hEnot + obtain ⟨x, hx, hωx⟩ := hEnot + rw [Submodule.add_eq_sup] at hx + rcases Submodule.mem_sup.mp hx with ⟨b, hb, d, hd, hbd⟩ + have hωd : ω.toFun d = 0 := by + apply hmax.1 + rw [Submodule.add_eq_sup] + exact Submodule.mem_sup_right hd + have hωb : ω.toFun b ≠ 0 := by + intro hzero + apply hωx + rw [← hbd, map_add, hzero, hωd, add_zero] + let a := FunctionField.Chart.adeleUpdate K (RatFunc K) + (FunctionField.Chart.zeroAdele K (RatFunc K)) p (b.1 p) + have haE : a ∈ FunctionField.Chart.adeleFilt K (RatFunc K) E := by + intro v + by_cases hv : v = p + · subst v + simpa [a, FunctionField.Chart.adeleUpdate] using hb p + · simp [a, FunctionField.Chart.adeleUpdate, + FunctionField.Chart.zeroAdele, hv] + have hsubD : b - a ∈ + FunctionField.Chart.adeleFilt K (RatFunc K) D := by + intro v + by_cases hv : v = p + · subst v + simp [a, FunctionField.Chart.adeleUpdate, + FunctionField.Chart.zeroAdele] + · have hbv := hb v + simpa [E, D, a, FunctionField.Chart.adeleUpdate, + FunctionField.Chart.zeroAdele, hv] using hbv + have hωsub : ω.toFun (b - a) = 0 := by + apply hmax.1 + rw [Submodule.add_eq_sup] + exact Submodule.mem_sup_left hsubD + have hωa : ω.toFun a ≠ 0 := by + intro hzero + apply hωb + have hmap := ω.toFun.map_sub b a + rw [hωsub, hzero, sub_zero] at hmap + exact hmap.symm + have haSupport : ∀ v ≠ p, a.1 v = 0 := by + intro v hv + simp [a, FunctionField.Chart.adeleUpdate, + FunctionField.Chart.zeroAdele, hv] + have hap0 : a.1 p ≠ 0 := by + intro hzero + apply hωa + have haZero : a = 0 := by + apply Subtype.ext + funext v + by_cases hv : v = p + · subst v + exact hzero + · exact haSupport v hv + rw [haZero, map_zero] + have haUpper : FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p) ≤ + WithZero.exp (D p + 1) := by + have := haE p + simpa [E, Finsupp.add_apply, Finsupp.single_eq_same] using this + have haNotLower : ¬ FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p) ≤ + WithZero.exp (D p) := by + intro hlower + apply hωa + apply hmax.1 + rw [Submodule.add_eq_sup] + apply Submodule.mem_sup_left + intro v + by_cases hv : v = p + · subst v + exact hlower + · simp [haSupport v hv] + have haLower : WithZero.exp (D p) < + FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p) := + lt_of_not_ge haNotLower + let m : ℤ := WithZero.log + (FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p)) + have hval0 : FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p) ≠ 0 := + (Valuation.ne_zero_iff _).mpr hap0 + have hvalExp : WithZero.exp m = + FunctionField.Chart.placeValuation K (RatFunc K) p (a.1 p) := by + exact WithZero.exp_log hval0 + have hmLower : D p < m := by + rw [← hvalExp, WithZero.exp_lt_exp] at haLower + exact haLower + have hmUpper : m ≤ D p + 1 := by + rw [← hvalExp, WithZero.exp_le_exp] at haUpper + exact haUpper + have hm : m = D p + 1 := by omega + refine ⟨a, ?_, hωa, haSupport, ?_⟩ + · simpa only [E, D] using haE + · rw [← hvalExp, hm] + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance detectionConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance detectionConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) detectionPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance detectionPolynomialTower : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance detectionConstantPolynomialTower : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance detectionFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.finite K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance detectionFiniteClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance detectionFiniteBaseTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance detectionFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance detectionInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance detectionInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance detectionInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance detectionInfinityClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance detectionInfinityClosureIsDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance detectionInfinityClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- A fiber lift supported over one base place lies in an arbitrary divisor +filtration once its common nonzero fiber value satisfies the local bounds. -/ +theorem finiteExtensionFiberLift_mem_adeleFilt_of_supported + (Btop : FunctionField.Chart.DivisorA K L) + (p : FunctionField.Chart.PlaceA K (RatFunc K)) + (b : FunctionField.Chart.AdeleSpace K (RatFunc K)) + (z : L) + (hbp : b.1 p = 1) + (hbAway : ∀ v ≠ p, b.1 v = 0) + (hz : ∀ q, finiteExtensionUnderPlaceChart K L q = p → + FunctionField.Chart.placeValuation K L q z ≤ + WithZero.exp (Btop q)) : + (finiteExtensionFiberLift K L z b).1 ∈ + FunctionField.Chart.adeleFilt K L Btop := by + intro q + by_cases hq : finiteExtensionUnderPlaceChart K L q = p + · change FunctionField.Chart.placeValuation K L q + (z * algebraMap (RatFunc K) L + (b.1 (finiteExtensionUnderPlaceChart K L q))) ≤ _ + rw [hq, hbp, map_one, mul_one] + exact hz q hq + · change FunctionField.Chart.placeValuation K L q + (z * algebraMap (RatFunc K) L + (b.1 (finiteExtensionUnderPlaceChart K L q))) ≤ _ + rw [hbAway _ hq, map_zero, mul_zero, Valuation.map_zero] + exact zero_le + +/-- Normalize a one-component base adele and lift a trace preimage without +changing its cotrace. -/ +theorem finiteExtensionFiberLift_normalized_trace + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (p : FunctionField.Chart.PlaceA K (RatFunc K)) + (a : FunctionField.Chart.AdeleSpace K (RatFunc K)) + (haNonzero : ω.toFun a ≠ 0) + (haAway : ∀ v ≠ p, a.1 v = 0) + (x : RatFunc K) (hx : x = a.1 p) (hx0 : x ≠ 0) + (z : L) (hzTrace : Algebra.trace (RatFunc K) L z = x) : + let b := x⁻¹ • a + (b.1 p = 1) ∧ + (∀ v ≠ p, b.1 v = 0) ∧ + ω.toFun (finiteExtensionFiberTrace K L + (finiteExtensionFiberLift K L z b)) ≠ 0 := by + dsimp only + have hbp : (x⁻¹ • a).1 p = 1 := by + change x⁻¹ * a.1 p = 1 + rw [← hx, inv_mul_cancel₀ hx0] + have hbAway : ∀ v ≠ p, (x⁻¹ • a).1 v = 0 := by + intro v hv + change x⁻¹ * a.1 v = 0 + rw [haAway v hv, mul_zero] + refine ⟨hbp, hbAway, ?_⟩ + rw [finiteExtensionFiberTrace_lift K L z (x⁻¹ • a), hzTrace, + smul_smul, mul_inv_cancel₀ hx0, one_smul] + exact haNonzero + +/-- Step (b1), finite-place branch: any coefficient strictly above the finite +different is detected by the cotrace functional on a fiber-constant adele in +that divisor filtration. -/ +theorem finiteExtensionFiberCotrace_detects_finite_excess + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (hω : FunctionField.Chart.WeilDifferential.IsNonzero ω) + (hdiv : FunctionField.Chart.WeilDifferential.divOmega ω hω = + ratFuncCanonicalInfinityDivisor K) + (Btop : FunctionField.Chart.DivisorA K L) + (q₀ : HeightOneSpectrum (RatFuncFiniteIntegralClosure K L)) + (hbad : + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) + (finiteExtensionPlaceEquivChart K L (.inl q₀)) < + Btop (finiteExtensionPlaceEquivChart K L (.inl q₀))) : + ∃ β : finiteExtensionFiberConstantAdeleSubmodule K L, + β.1 ∈ FunctionField.Chart.adeleFilt K L Btop ∧ + ω.toFun (finiteExtensionFiberTrace K L β) ≠ 0 := by + classical + let e := HeightOneSpectrum.equivOfRingEquiv + (ratFuncFiniteBaseRingEquivChart K) + let p₀ : HeightOneSpectrum K[X] := q₀.under K[X] + let pChart : HeightOneSpectrum + (FunctionField.ringOfIntegers K (RatFunc K)) := e p₀ + let p : FunctionField.Chart.PlaceA K (RatFunc K) := .inl pChart + obtain ⟨a, haFilt, hωa, haAway, haVal⟩ := + ratFuncCanonicalWeil_exists_singlePlace_witness K ω hω hdiv p + let x : RatFunc K := a.1 p + have hpCoeff : ratFuncCanonicalInfinityDivisor K p = 0 := by + rw [ratFuncCanonicalInfinityDivisor, Finsupp.single_eq_of_ne] + change Sum.inl pChart ≠ Sum.inr _ + exact Sum.inl_ne_inr + have hx0 : x ≠ 0 := by + apply (Valuation.ne_zero_iff + (FunctionField.Chart.placeValuation K (RatFunc K) p)).mp + rw [show FunctionField.Chart.placeValuation K (RatFunc K) p x = + WithZero.exp (1 : ℤ) by + simpa [x, hpCoeff] using haVal] + exact WithZero.exp_ne_zero + have hxValChart : pChart.valuation (RatFunc K) x = + WithZero.exp (1 : ℤ) := by + simpa [x, p, FunctionField.Chart.placeValuation, + hpCoeff] using haVal + have hbaseEq : p₀.valuation (RatFunc K) = + pChart.valuation (RatFunc K) := + heightOneValuation_eq_of_ringEquiv + (ratFuncFiniteBaseRingEquivChart K) + (ratFuncFiniteBaseRingEquivChart_algebraMap K) + p₀ pChart rfl + have hxVal : p₀.valuation (RatFunc K) x = + WithZero.exp (1 : ℤ) := by + rw [hbaseEq] + exact hxValChart + let n : HeightOneSpectrum (RatFuncFiniteIntegralClosure K L) → ℤ := + fun q => -Btop (finiteExtensionPlaceEquivChart K L (.inl q)) + have hbad' : n q₀ < + -(multiplicity q₀.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) : ℤ) := by + have hcoeff : + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) + (finiteExtensionPlaceEquivChart K L (.inl q₀)) = + (multiplicity q₀.asIdeal + (differentIdeal K[X] + (RatFuncFiniteIntegralClosure K L)) : ℤ) := by + simp [finiteExtensionDivisorEquivChart, Finsupp.domCongr_apply, + finiteExtensionCanonicalDifferentDivisor_inl] + rw [hcoeff] at hbad + dsimp only [n] + omega + obtain ⟨z, hz0, hzTrace, hzCount⟩ := + exists_trace_eq_of_count_threshold_lt_neg_different + (A := K[X]) (K₀ := RatFunc K) + (B := RatFuncFiniteIntegralClosure K L) (L := L) + p₀ n q₀ rfl hbad' x hx0 hxVal + let b : FunctionField.Chart.AdeleSpace K (RatFunc K) := x⁻¹ • a + have hnorm := finiteExtensionFiberLift_normalized_trace + K L ω p a hωa haAway x rfl hx0 z hzTrace + have hbp : b.1 p = 1 := by simpa only [b] using hnorm.1 + have hbAway : ∀ v ≠ p, b.1 v = 0 := by + simpa only [b] using hnorm.2.1 + let β := finiteExtensionFiberLift K L z b + have hβFilt : β.1 ∈ FunctionField.Chart.adeleFilt K L Btop := by + apply finiteExtensionFiberLift_mem_adeleFilt_of_supported + K L Btop p b z hbp hbAway + intro q hq + let Q := (finiteExtensionPlaceEquivChart K L).symm q + have hQq : finiteExtensionPlaceEquivChart K L Q = q := + (finiteExtensionPlaceEquivChart K L).apply_symm_apply q + rcases Q with r | P + · have hrUnder : r.under K[X] = p₀ := by + rw [← hQq] at hq + change ratFuncExhaustivePlaceEquivChart K + (.inl (r.under K[X])) = .inl pChart at hq + change Sum.inl (e (r.under K[X])) = Sum.inl (e p₀) at hq + exact e.injective (Sum.inl.inj hq) + have hrCount := hzCount r hrUnder + have hrVal : r.valuation L z ≤ + WithZero.exp + (Btop (finiteExtensionPlaceEquivChart K L (.inl r))) := by + rw [valuation_eq_exp_neg_finitePlaceOrder r z hz0, + WithZero.exp_le_exp] + change -FractionalIdeal.count L r + (FractionalIdeal.spanSingleton + (RatFuncFiniteIntegralClosure K L)⁰ z) ≤ _ + dsimp only [n] at hrCount + omega + rw [← hQq] + simpa [FunctionField.Chart.placeValuation, + finiteExtensionPlaceEquivChart] using hrVal + · rw [← hQq] at hq + change ratFuncExhaustivePlaceEquivChart K + (.inr (ratFuncInfinityPlace K)) = .inl pChart at hq + change Sum.inr _ = Sum.inl pChart at hq + cases hq + refine ⟨β, hβFilt, ?_⟩ + simpa only [β, b] using hnorm.2.2 + +/-- Step (b1), infinity-place branch: after compensating the `-2e` term by +the square of the base infinity uniformizer, any coefficient strictly above +the infinity different is detected by cotrace. -/ +theorem finiteExtensionFiberCotrace_detects_infinity_excess + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (hω : FunctionField.Chart.WeilDifferential.IsNonzero ω) + (hdiv : FunctionField.Chart.WeilDifferential.divOmega ω hω = + ratFuncCanonicalInfinityDivisor K) + (Btop : FunctionField.Chart.DivisorA K L) + (P₀ : FiniteExtensionInfinityPlace K L) + (hbad : + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) + (finiteExtensionPlaceEquivChart K L (.inr P₀)) < + Btop (finiteExtensionPlaceEquivChart K L (.inr P₀))) : + ∃ β : finiteExtensionFiberConstantAdeleSubmodule K L, + β.1 ∈ FunctionField.Chart.adeleFilt K L Btop ∧ + ω.toFun (finiteExtensionFiberTrace K L β) ≠ 0 := by + classical + let pInf := ratFuncInfinityPlace K + let e := HeightOneSpectrum.equivOfRingEquiv + (ratFuncInfinityBaseRingEquivChart K) + let pChart : HeightOneSpectrum + (FunctionField.Chart.infiniteIntegers K (RatFunc K)) := e pInf + let p : FunctionField.Chart.PlaceA K (RatFunc K) := .inr pChart + have hpBase : p = ratFuncInfinityPlaceChart K := by rfl + have hpCanonical : p = ratFuncInfinityChartPlace K := + hpBase.trans (ratFuncInfinityChartPlace_eq_baseChart K).symm + obtain ⟨a, haFilt, hωa, haAway, haVal⟩ := + ratFuncCanonicalWeil_exists_singlePlace_witness K ω hω hdiv p + have hpCoeff : ratFuncCanonicalInfinityDivisor K p = -2 := by + rw [hpCanonical, ratFuncCanonicalInfinityDivisor, + Finsupp.single_eq_same] + let x : RatFunc K := a.1 p + have hx0 : x ≠ 0 := by + apply (Valuation.ne_zero_iff + (FunctionField.Chart.placeValuation K (RatFunc K) p)).mp + rw [show FunctionField.Chart.placeValuation K (RatFunc K) p x = + WithZero.exp (-1 : ℤ) by + simpa [x, hpCoeff] using haVal] + exact WithZero.exp_ne_zero + have hxValChart : pChart.valuation (RatFunc K) x = + WithZero.exp (-1 : ℤ) := by + simpa [x, p, FunctionField.Chart.placeValuation, + hpCoeff] using haVal + have hbaseEq : pInf.valuation (RatFunc K) = + pChart.valuation (RatFunc K) := + heightOneValuation_eq_of_ringEquiv + (ratFuncInfinityBaseRingEquivChart K) + (ratFuncInfinityBaseRingEquivChart_algebraMap K) + pInf pChart rfl + have hxValInf : pInf.valuation (RatFunc K) x = + WithZero.exp (-1 : ℤ) := by + rw [hbaseEq] + exact hxValChart + let s := ratFuncInfinityUniformizer K + have hs : s ≠ 0 := by + intro h + have hcoe := congrArg Subtype.val h + exact (one_div_ne_zero RatFunc.X_ne_zero) hcoe + let t : RatFunc K := algebraMap (RatFuncInfinityIntegers K) (RatFunc K) s + have ht0 : t ≠ 0 := by + simpa only [t, map_zero] using + (FaithfulSMul.algebraMap_injective + (RatFuncInfinityIntegers K) (RatFunc K)).ne hs + have htVal : pInf.valuation (RatFunc K) t = + WithZero.exp (-1 : ℤ) := by + change pInf.valuation (RatFunc K) + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K) s) = _ + rw [HeightOneSpectrum.valuation_of_algebraMap] + exact pInf.intValuation_singleton hs + (ratFuncInfinityPlace_span_uniformizer K) + let w : RatFunc K := (t ^ 2)⁻¹ * x + have hw0 : w ≠ 0 := + mul_ne_zero (inv_ne_zero (pow_ne_zero 2 ht0)) hx0 + have hwVal : pInf.valuation (RatFunc K) w = + WithZero.exp (1 : ℤ) := by + change pInf.valuation (RatFunc K) ((t ^ 2)⁻¹ * x) = _ + rw [map_mul, map_inv₀, map_pow, htVal, hxValInf] + norm_num [← WithZero.exp_neg, ← WithZero.exp_add] + let q₀ : HeightOneSpectrum (RatFuncInfinityIntegralClosure K L) := + primeOverHeightOne pInf P₀ + have hq₀Under : q₀.under (RatFuncInfinityIntegers K) = pInf := by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P₀.1 pInf.asIdeal).symm + let n : HeightOneSpectrum (RatFuncInfinityIntegralClosure K L) → ℤ := + fun q => + -2 * ((((finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm q).1.ramificationIdx + (RatFuncInfinityIntegers K)) : ℤ) - + Btop (finiteExtensionPlaceEquivChart K L + (.inr ((finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm q))) + have hbad' : n q₀ < + -(multiplicity q₀.asIdeal + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) := by + have hcoeff : + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) + (finiteExtensionPlaceEquivChart K L (.inr P₀)) = + (multiplicity P₀.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) : ℤ) - + 2 * (P₀.1.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) := by + simp [finiteExtensionDivisorEquivChart, Finsupp.domCongr_apply, + finiteExtensionCanonicalDifferentDivisor_inr] + rw [hcoeff] at hbad + have hsymm : + (finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm q₀ = P₀ := by + exact (finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm_apply_apply P₀ + have hqIdeal : q₀.asIdeal = P₀.1 := rfl + dsimp only [n] + rw [hsymm, hqIdeal] + omega + obtain ⟨z₀, hz₀0, hz₀Trace, hz₀Count⟩ := + exists_trace_eq_of_count_threshold_lt_neg_different + (A := RatFuncInfinityIntegers K) (K₀ := RatFunc K) + (B := RatFuncInfinityIntegralClosure K L) (L := L) + pInf n q₀ hq₀Under hbad' w hw0 hwVal + let tL : L := algebraMap (RatFuncInfinityIntegers K) L s + have htL0 : tL ≠ 0 := by + simpa only [tL, map_zero] using + (FaithfulSMul.algebraMap_injective + (RatFuncInfinityIntegers K) L).ne hs + have htTower : tL = algebraMap (RatFunc K) L t := by + exact (IsScalarTower.algebraMap_apply + (RatFuncInfinityIntegers K) (RatFunc K) L s).symm + let z : L := tL ^ 2 * z₀ + have hz0 : z ≠ 0 := mul_ne_zero (pow_ne_zero 2 htL0) hz₀0 + have hzTrace : Algebra.trace (RatFunc K) L z = x := by + have hscalar : tL ^ 2 * z₀ = (t ^ 2) • z₀ := by + rw [Algebra.smul_def, htTower, map_pow] + change Algebra.trace (RatFunc K) L (tL ^ 2 * z₀) = x + rw [hscalar, map_smul, hz₀Trace] + change t ^ 2 * ((t ^ 2)⁻¹ * x) = x + rw [← mul_assoc, mul_inv_cancel₀ (pow_ne_zero 2 ht0), one_mul] + let b : FunctionField.Chart.AdeleSpace K (RatFunc K) := x⁻¹ • a + have hnorm := finiteExtensionFiberLift_normalized_trace + K L ω p a hωa haAway x rfl hx0 z hzTrace + have hbp : b.1 p = 1 := by simpa only [b] using hnorm.1 + have hbAway : ∀ v ≠ p, b.1 v = 0 := by + simpa only [b] using hnorm.2.1 + let β := finiteExtensionFiberLift K L z b + have hβFilt : β.1 ∈ FunctionField.Chart.adeleFilt K L Btop := by + apply finiteExtensionFiberLift_mem_adeleFilt_of_supported + K L Btop p b z hbp hbAway + intro q hq + let Q := (finiteExtensionPlaceEquivChart K L).symm q + have hQq : finiteExtensionPlaceEquivChart K L Q = q := + (finiteExtensionPlaceEquivChart K L).apply_symm_apply q + rcases Q with r | P + · rw [← hQq] at hq + change ratFuncExhaustivePlaceEquivChart K + (.inl (r.under K[X])) = p at hq + rw [hpBase] at hq + change Sum.inl _ = Sum.inr _ at hq + cases hq + · let qH : HeightOneSpectrum + (RatFuncInfinityIntegralClosure K L) := + primeOverHeightOne pInf P + have hqHUnder : qH.under (RatFuncInfinityIntegers K) = pInf := by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P.1 pInf.asIdeal).symm + letI : qH.asIdeal.LiesOver pInf.asIdeal := ⟨by + have hideal := congrArg HeightOneSpectrum.asIdeal hqHUnder + exact hideal.symm⟩ + have hqCount := hz₀Count qH hqHUnder + have hsymm : + (finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm qH = P := by + exact (finiteExtensionInfinityPrimesOverEquivHeightOne K L).symm_apply_apply P + have hqCount' : + -2 * (P.1.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) - + Btop (finiteExtensionPlaceEquivChart K L (.inr P)) ≤ + finitePlaceOrder qH z₀ := by + simpa only [n, hsymm, finitePlaceOrder] using hqCount + have htOrder : finitePlaceOrder qH tL = + (qH.asIdeal.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) := by + simpa only [tL, IsScalarTower.algebraMap_apply + (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) L] using + finitePlaceOrder_algebraMap_uniformizer_eq_ramificationIdx + (R := RatFuncInfinityIntegers K) + (A := RatFuncInfinityIntegralClosure K L) (F := L) + pInf qH s hs (ratFuncInfinityPlace_span_uniformizer K) + have htSquareOrder := + finitePlaceOrder_mul_eq_add qH tL tL htL0 htL0 + rw [← pow_two] at htSquareOrder + have hzOrder := finitePlaceOrder_mul_eq_add qH (tL ^ 2) z₀ + (pow_ne_zero 2 htL0) hz₀0 + have hideal : qH.asIdeal = P.1 := rfl + have horderBound : -finitePlaceOrder qH z ≤ + Btop (finiteExtensionPlaceEquivChart K L (.inr P)) := by + dsimp only [z] + rw [hzOrder, htSquareOrder, htOrder, hideal] + omega + have hval : qH.valuation L z ≤ + WithZero.exp + (Btop (finiteExtensionPlaceEquivChart K L (.inr P))) := by + rw [valuation_eq_exp_neg_finitePlaceOrder qH z hz0, + WithZero.exp_le_exp] + exact horderBound + rw [← hQq] + have hvaluationEq : + qH.valuation L z = + FunctionField.Chart.placeValuation K L + (finiteExtensionPlaceEquivChart K L (.inr P)) z := by + simpa only [finiteExtensionPlaceValuation] using + congrArg (fun v : Valuation L ℤᵐ⁰ => v z) + (finiteExtensionPlaceValuation_eq_chart K L (.inr P)) + rw [← hvaluationEq] + exact hval + refine ⟨β, hβFilt, ?_⟩ + simpa only [β, b] using hnorm.2.2 + +/-- Stichtenoth, Theorem 3.4.6, Step (b1), in the project chart model: every +divisor not bounded by the explicit canonical different is detected by the +base canonical functional after cotrace. -/ +theorem finiteExtensionFiberCotrace_detects_not_le + (ω : FunctionField.Chart.WeilDifferential K (RatFunc K)) + (hω : FunctionField.Chart.WeilDifferential.IsNonzero ω) + (hdiv : FunctionField.Chart.WeilDifferential.divOmega ω hω = + ratFuncCanonicalInfinityDivisor K) + (Btop : FunctionField.Chart.DivisorA K L) + (hB : ¬ Btop ≤ + finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) : + ∃ β : finiteExtensionFiberConstantAdeleSubmodule K L, + β.1 ∈ FunctionField.Chart.adeleFilt K L Btop ∧ + ω.toFun (finiteExtensionFiberTrace K L β) ≠ 0 := by + classical + have hB' : ∃ q : FunctionField.Chart.PlaceA K L, + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) q < Btop q := by + by_contra hnone + apply hB + intro q + have hnot : ¬ + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) q < Btop q := by + intro hlt + exact hnone ⟨q, hlt⟩ + exact le_of_not_gt hnot + obtain ⟨q, hq⟩ := hB' + let Q := (finiteExtensionPlaceEquivChart K L).symm q + have hQq : finiteExtensionPlaceEquivChart K L Q = q := + (finiteExtensionPlaceEquivChart K L).apply_symm_apply q + rcases Q with r | P + · apply finiteExtensionFiberCotrace_detects_finite_excess + K L ω hω hdiv Btop r + simpa only [hQq] using hq + · apply finiteExtensionFiberCotrace_detects_infinity_excess + K L ω hω hdiv Btop P + simpa only [hQq] using hq + +/-- The trace-different divisor is exactly the maximal vanishing divisor of +the Weil functional obtained by gluing cotrace to zero. This is the direct +local-maximality conclusion of Stichtenoth, Theorem 3.4.6, Step (b1), and does +not assume a Riemann--Hurwitz degree identity. -/ +theorem finiteExtensionCanonicalDifferent_isCanonical_of_cotrace + [FunctionField.IsFullConstantField K L] : + FunctionField.Chart.IsCanonical K L + (finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) := by + obtain ⟨ωBase, hωBase, hdivBase⟩ := + ratFuncCanonicalInfinityDivisor_isCanonical K + have hmaxBase : + FunctionField.Chart.WeilDifferential.divOmega ωBase hωBase ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωBase ∧ + ∀ D ∈ FunctionField.Chart.WeilDifferential.vanishingDivisors ωBase, + D ≤ FunctionField.Chart.WeilDifferential.divOmega ωBase hωBase := by + simpa only [FunctionField.Chart.WeilDifferential.divOmega] using + (Classical.choose_spec + (FunctionField.Chart.WeilDifferential.exists_max_vanishingDivisor + (k := K) (K := RatFunc K) hωBase)).1 + have hbaseVan : ratFuncCanonicalInfinityDivisor K ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωBase := by + rw [hdivBase] at hmaxBase + exact hmaxBase.1 + let U := finiteExtensionFiberConstantAdeleSubmodule K L + let D := finiteExtensionDivisorEquivChart K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) + let V := FunctionField.Chart.adeleFilt K L D + + FunctionField.Chart.diagonalSubmodule K L + let f := ωBase.toFun.comp (finiteExtensionFiberTrace K L) + have hfVan : ∀ x : ↥(U ⊓ V), f ⟨x, x.property.1⟩ = 0 := by + intro x + exact finiteExtensionFiberCotrace_vanishes_on_intersection + K L ωBase hbaseVan x + have hfNe : f ≠ 0 := + finiteExtensionFiberCotrace_ne_zero K L ωBase hωBase + obtain ⟨g, hgU, hgV, hgNe⟩ := + exists_ne_zero_linearMap_extending_eq_zero_on_inf U V f hfVan hfNe + let ωTop : FunctionField.Chart.WeilDifferential K L := + ⟨g, ⟨D, fun a ha => LinearMap.mem_ker.mp (hgV ha)⟩⟩ + have hωTop : FunctionField.Chart.WeilDifferential.IsNonzero ωTop := hgNe + have hDvan : D ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop := by + intro a ha + exact LinearMap.mem_ker.mp (hgV ha) + have hDmax : ∀ B ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop, + B ≤ D := by + intro B hBvan + by_contra hBle + obtain ⟨β, hβFilt, hdetect⟩ := + finiteExtensionFiberCotrace_detects_not_le + K L ωBase hωBase hdivBase B hBle + have hβsum : β.1 ∈ FunctionField.Chart.adeleFilt K L B + + FunctionField.Chart.diagonalSubmodule K L := by + rw [Submodule.add_eq_sup] + exact Submodule.mem_sup_left hβFilt + have hgβ0 : g β.1 = 0 := hBvan β.1 hβsum + have hgfβ : g β.1 = f β := by + change (g.comp U.subtype) β = f β + exact LinearMap.congr_fun hgU β + have hfβ : f β ≠ 0 := by + simpa only [f, LinearMap.coe_comp, Function.comp_apply] using hdetect + exact hfβ (hgfβ.symm.trans hgβ0) + have hmaxTop : + FunctionField.Chart.WeilDifferential.divOmega ωTop hωTop ∈ + FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop ∧ + ∀ B ∈ FunctionField.Chart.WeilDifferential.vanishingDivisors ωTop, + B ≤ FunctionField.Chart.WeilDifferential.divOmega ωTop hωTop := by + simpa only [FunctionField.Chart.WeilDifferential.divOmega] using + (Classical.choose_spec + (FunctionField.Chart.WeilDifferential.exists_max_vanishingDivisor + (k := K) (K := L) hωTop)).1 + have heq : FunctionField.Chart.WeilDifferential.divOmega ωTop hωTop = D := + le_antisymm (hDmax _ hmaxTop.1) (hmaxTop.2 D hDvan) + exact ⟨ωTop, hωTop, heq⟩ + +/-- The remaining trace-residue lower bound follows from the direct cotrace +canonicality theorem, with no degree premise. -/ +theorem finiteExtension_genus_le_canonicalDifferent_finrank_of_cotrace + [FunctionField.IsFullConstantField K L] : + FunctionField.Chart.genus K L ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L))) := by + have hcanonical := finiteExtensionCanonicalDifferent_isCanonical_of_cotrace K L + have hcharacterization := + (finiteExtensionCanonicalDifferent_isCanonical_iff_degree_finrank K L).mp + hcanonical + exact hcharacterization.2.ge + +/-- Any upper bound for the explicit different degree gives the corresponding +genus bound directly from cotrace canonicality. -/ +theorem finiteExtension_genus_le_budget_of_cotrace + [FunctionField.IsFullConstantField K L] + (budget : ℕ) + (hdegree : finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + 2 * (budget : ℤ) - 2) : + FunctionField.genus K L ≤ budget := by + exact finiteExtension_genus_le_budget_of_canonicalDifferent_isCanonical + K L budget + (finiteExtensionCanonicalDifferent_isCanonical_of_cotrace K L) + hdegree + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean new file mode 100644 index 0000000000..c66288acc8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv + +/-! +# Closed-place counts across function-field equivalences + +The closed-place extension-count sequence is a weighted sum depending only +on absolute place degrees. Hence the degree-preserving place equivalence +induced by a `K(X)`-algebra equivalence preserves the entire sequence. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K L M : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field L] [Field M] + [Algebra (RatFunc K) L] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) M] + +/-- Places of degree at most `r` are preserved by a function-field +equivalence. -/ +noncomputable def finiteExtensionPlaceDegreeLEEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) (r : ℕ) : + {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ r} ≃ + {P : FiniteExtensionPlace K M // + finiteExtensionPlaceDegree K M P ≤ r} := + Equiv.subtypeEquiv (finiteExtensionPlaceEquivOfAlgEquiv K L M e) (by + intro P + rw [finiteExtensionPlaceEquivOfAlgEquiv_degree K L M e P]) + +/-- Within a bounded family, the places whose degrees divide `r` are also +preserved. -/ +noncomputable def finiteExtensionPlaceDegreeDvdEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) (r : ℕ) : + {P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ r} // + finiteExtensionPlaceDegree K L P.1 ∣ r} ≃ + {P : {P : FiniteExtensionPlace K M // + finiteExtensionPlaceDegree K M P ≤ r} // + finiteExtensionPlaceDegree K M P.1 ∣ r} := + Equiv.subtypeEquiv + (finiteExtensionPlaceDegreeLEEquivOfAlgEquiv K L M e r) (by + intro P + change finiteExtensionPlaceDegree K L P.1 ∣ r ↔ + finiteExtensionPlaceDegree K M + (finiteExtensionPlaceEquivOfAlgEquiv K L M e P.1) ∣ r + rw [finiteExtensionPlaceEquivOfAlgEquiv_degree K L M e P.1]) + +/-- Every closed-place extension count is invariant under an equivalence of +finite `K(X)`-algebras. -/ +theorem finiteExtensionClosedPlaceExtensionCount_eq_of_algEquiv + (e : L ≃ₐ[RatFunc K] M) (r : ℕ) : + finiteExtensionClosedPlaceExtensionCount K L r = + finiteExtensionClosedPlaceExtensionCount K M r := by + letI := finiteExtensionPlaceDegreeLEFintype K L r + letI := finiteExtensionPlaceDegreeLEFintype K M r + rw [finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd, + finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd] + apply Fintype.sum_equiv + (finiteExtensionPlaceDegreeDvdEquivOfAlgEquiv K L M e r) + intro P + change finiteExtensionPlaceDegree K L P.1.1 = + finiteExtensionPlaceDegree K M + (finiteExtensionPlaceEquivOfAlgEquiv K L M e P.1.1) + exact (finiteExtensionPlaceEquivOfAlgEquiv_degree K L M e P.1.1).symm + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean new file mode 100644 index 0000000000..089fded6be --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean @@ -0,0 +1,367 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation + +/-! +# Local trace image for cotrace maximality + +This file formalizes the exact local trace-image argument in Stichtenoth, +Theorem 3.4.6, Step (b1). Weak approximation creates an element just outside +the complementary module at an offending extension place; trace duality then +shows that any prescribed base element of order `-1` is a trace without losing +the required lower bounds at the places over the chosen base place. +-/ + +namespace BGS.HasseWeil + +open Set Function UniqueFactorizationMonoid IsDedekindDomain + IsDedekindDomain.HeightOneSpectrum +open scoped nonZeroDivisors + +noncomputable section + +universe u + +variable (A K₀ : Type*) {L : Type u} {B : Type*} +variable [CommRing A] [Field K₀] [CommRing B] [Field L] +variable [Algebra A K₀] [Algebra B L] [Algebra A B] [Algebra K₀ L] [Algebra A L] +variable [IsScalarTower A K₀ L] [IsScalarTower A B L] +variable [IsDedekindDomain A] [IsFractionRing A K₀] +variable [FiniteDimensional K₀ L] [Algebra.IsSeparable K₀ L] +variable [IsIntegralClosure B A L] [IsFractionRing B L] +variable [IsDedekindDomain B] +variable [Module.IsTorsionFree A B] +variable [Algebra.IsIntegral A B] + +/-- Rebuild a height-one prime from an ideal in the finite primes-over set. -/ +def heightOneOfPrimesOverFinset (p : HeightOneSpectrum A) + (Q : Ideal B) (hQ : Q ∈ IsDedekindDomain.primesOverFinset p.asIdeal B) : + HeightOneSpectrum B := by + have hQover : Q ∈ p.asIdeal.primesOver B := + (IsDedekindDomain.mem_primesOverFinset_iff p.ne_bot B).mp hQ + exact ⟨Q, hQover.1, + Ideal.ne_bot_of_mem_primesOver p.ne_bot hQover⟩ + +@[simp] +theorem heightOneOfPrimesOverFinset_asIdeal (p : HeightOneSpectrum A) + (Q : Ideal B) (hQ : Q ∈ IsDedekindDomain.primesOverFinset p.asIdeal B) : + (heightOneOfPrimesOverFinset (B := B) A p Q hQ).asIdeal = Q := rfl + +/-- Membership in the finite primes-over set is equivalent to contraction to +the selected height-one prime. -/ +theorem mem_primesOverFinset_iff_under_eq (p : HeightOneSpectrum A) + (q : HeightOneSpectrum B) : + q.asIdeal ∈ IsDedekindDomain.primesOverFinset p.asIdeal B ↔ + q.under A = p := by + rw [IsDedekindDomain.mem_primesOverFinset_iff p.ne_bot B] + constructor + · rintro ⟨_, h⟩ + apply HeightOneSpectrum.ext + rw [Ideal.liesOver_iff] at h + exact h.symm + · intro h + refine ⟨q.isPrime, ?_⟩ + rw [Ideal.liesOver_iff] + exact (congrArg HeightOneSpectrum.asIdeal h).symm + +/-- Every ideal selected by `primesOverFinset` is prime in the factorization +monoid sense required by the weak-approximation theorem. -/ +theorem prime_of_mem_primesOverFinset (p : HeightOneSpectrum A) + (Q : Ideal B) + (hQ : Q ∈ IsDedekindDomain.primesOverFinset p.asIdeal B) : + Prime Q := by + exact Ideal.prime_of_mem_primesOver p.ne_bot + ((IsDedekindDomain.mem_primesOverFinset_iff p.ne_bot B).mp hQ) + +/-- A valuation bound on a nonzero element gives the corresponding lower +bound for its principal fractional-ideal coefficient. -/ +theorem le_count_spanSingleton_of_valuation_le_exp_neg + (q : HeightOneSpectrum B) {x : L} (hx : x ≠ 0) (n : ℤ) + (hval : q.valuation L x ≤ WithZero.exp (-n)) : + n ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ x) := by + have hvaluation : q.valuation L x = + WithZero.exp (-FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ x)) := by + simpa using (FractionalIdeal.valuation_eq_exp_neg_count + (R := B) (K := L) q (Units.mk0 x hx)) + rw [hvaluation] at hval + have := WithZero.exp_le_exp.mp hval + omega + +/-- Weak approximation realizes simultaneous lower order bounds over one +base prime and realizes a prescribed negative order exactly at one chosen +prime. -/ +theorem exists_element_with_counts_over_and_exact_at + (p : HeightOneSpectrum A) (n : HeightOneSpectrum B → ℤ) + (q₀ : HeightOneSpectrum B) (hq₀ : q₀.under A = p) + (hn₀ : n q₀ < 0) : + ∃ u : L, u ≠ 0 ∧ + (∀ q : HeightOneSpectrum B, q.under A = p → + n q ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ u)) ∧ + FractionalIdeal.count L q₀ + (FractionalIdeal.spanSingleton B⁰ u) = n q₀ ∧ + ∀ q : HeightOneSpectrum B, q.under A ≠ p → + 0 ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ u) := by + classical + let selected := IsDedekindDomain.primesOverFinset p.asIdeal B + let qOf : ∀ Q : Ideal B, Q ∈ selected → HeightOneSpectrum B := + fun Q hQ ↦ heightOneOfPrimesOverFinset (B := B) A p Q hQ + let target : Ideal B → L := fun Q ↦ + if Q = q₀.asIdeal then + (Classical.choose (q₀.valuation_exists_uniformizer L)) ^ (n q₀) + else 0 + let precision : Ideal B → ℕ := fun Q ↦ + if hQ : Q ∈ selected then Int.toNat (n (qOf Q hQ)) else 0 + obtain ⟨u, huSelected, huElse⟩ := + exists_fraction_approximating_at_finitePlaces_regular_elsewhere + (R := B) (L := L) selected + (fun Q hQ ↦ prime_of_mem_primesOverFinset (B := B) A p Q hQ) + target precision + have hq₀Selected : q₀.asIdeal ∈ selected := + (mem_primesOverFinset_iff_under_eq (B := B) A p q₀).mpr hq₀ + have hq₀Of : qOf q₀.asIdeal hq₀Selected = q₀ := by + apply HeightOneSpectrum.ext + rfl + have hprecisionq₀ : precision q₀.asIdeal = 0 := by + simp only [precision, hq₀Selected, dite_true, qOf, hq₀Of] + exact Int.toNat_of_nonpos hn₀.le + let π : L := Classical.choose (q₀.valuation_exists_uniformizer L) + have hπ : q₀.valuation L π = WithZero.exp (-1) := + Classical.choose_spec (q₀.valuation_exists_uniformizer L) + have hπne : π ≠ 0 := by + intro hzero + rw [hzero, Valuation.map_zero] at hπ + exact WithZero.exp_ne_zero hπ.symm + have htargetq₀ : target q₀.asIdeal = π ^ (n q₀) := by + simp [target, π] + have huApprox : q₀.valuation L (u - π ^ (n q₀)) ≤ 1 := by + simpa [hprecisionq₀, htargetq₀, WithZero.exp_zero] using + huSelected q₀ hq₀Selected + have htargetVal : q₀.valuation L (π ^ (n q₀)) = + WithZero.exp (-(n q₀)) := by + rw [map_zpow₀, hπ, ← WithZero.exp_zsmul] + congr 1 + simp + have herrorLt : q₀.valuation L (u - π ^ (n q₀)) < + q₀.valuation L (π ^ (n q₀)) := by + rw [htargetVal] + apply lt_of_le_of_lt huApprox + rw [← WithZero.exp_zero, WithZero.exp_lt_exp] + omega + have huVal : q₀.valuation L u = WithZero.exp (-(n q₀)) := by + rw [← htargetVal] + exact Valuation.map_eq_of_sub_lt (q₀.valuation L) herrorLt + have hu0 : u ≠ 0 := by + intro hzero + rw [hzero, Valuation.map_zero] at huVal + exact WithZero.exp_ne_zero huVal.symm + have huCountExact : FractionalIdeal.count L q₀ + (FractionalIdeal.spanSingleton B⁰ u) = n q₀ := by + have hvaluation : q₀.valuation L u = + WithZero.exp (-FractionalIdeal.count L q₀ + (FractionalIdeal.spanSingleton B⁰ u)) := by + simpa using (FractionalIdeal.valuation_eq_exp_neg_count + (R := B) (K := L) q₀ (Units.mk0 u hu0)) + rw [huVal] at hvaluation + exact neg_injective (WithZero.exp_injective hvaluation.symm) + refine ⟨u, hu0, ?_, huCountExact, ?_⟩ + · intro q hq + have hqSelected : q.asIdeal ∈ selected := + (mem_primesOverFinset_iff_under_eq (B := B) A p q).mpr hq + have hqOf : qOf q.asIdeal hqSelected = q := by + apply HeightOneSpectrum.ext + rfl + have hprecision : precision q.asIdeal = Int.toNat (n q) := by + simp only [precision, hqSelected, dite_true, qOf, hqOf] + have htarget : target q.asIdeal = + if q.asIdeal = q₀.asIdeal then π ^ (n q₀) else 0 := by + rfl + by_cases hqq₀ : q = q₀ + · subst q + exact huCountExact.ge + · have hideal : q.asIdeal ≠ q₀.asIdeal := by + intro h + exact hqq₀ (HeightOneSpectrum.ext h) + have hval : q.valuation L u ≤ + WithZero.exp (-(Int.toNat (n q) : ℤ)) := by + have h := huSelected q hqSelected + simpa [hprecision, target, hideal] using h + have hnle : n q ≤ (Int.toNat (n q) : ℤ) := by + by_cases hn : 0 ≤ n q + · simpa [Int.toNat_of_nonneg hn] + · rw [Int.toNat_of_nonpos (le_of_not_ge hn)] + exact le_of_not_ge hn + exact hnle.trans + (le_count_spanSingleton_of_valuation_le_exp_neg + (B := B) q hu0 (Int.toNat (n q)) hval) + · intro q hq + have hqNotSelected : q.asIdeal ∉ selected := by + intro hmem + exact hq ((mem_primesOverFinset_iff_under_eq (B := B) A p q).mp hmem) + exact zero_le_count_spanSingleton_of_valuation_le_one q hu0 + (huElse q hqNotSelected) + +/-- If one local order bound is strictly below the complementary-module +threshold, then every element of base order `-1` occurs as a trace while all +the prescribed order bounds over the chosen base prime are retained. + +This is the algebraic core of Stichtenoth, Theorem 3.4.6, Step 1(b). -/ +theorem exists_trace_eq_of_count_threshold_lt_neg_different + (p : HeightOneSpectrum A) (n : HeightOneSpectrum B → ℤ) + (q₀ : HeightOneSpectrum B) (hq₀ : q₀.under A = p) + (hbad : n q₀ < + -(multiplicity q₀.asIdeal (differentIdeal A B) : ℤ)) + (w : K₀) (hw : w ≠ 0) + (hwVal : p.valuation K₀ w = WithZero.exp (1 : ℤ)) : + ∃ z : L, z ≠ 0 ∧ Algebra.trace K₀ L z = w ∧ + ∀ q : HeightOneSpectrum B, q.under A = p → + n q ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ z) := by + classical + have hn₀ : n q₀ < 0 := by + have hmult : 0 ≤ + (multiplicity q₀.asIdeal (differentIdeal A B) : ℤ) := by + exact_mod_cast (Nat.zero_le + (multiplicity q₀.asIdeal (differentIdeal A B))) + omega + obtain ⟨u, hu0, huOver, huExact, huAway⟩ := + exists_element_with_counts_over_and_exact_at + (A := A) (B := B) (L := L) p n q₀ hq₀ hn₀ + have huNotDual : u ∉ + FractionalIdeal.dual A K₀ (1 : FractionalIdeal B⁰ L) := by + intro hu + have hcounts := + (mem_dual_one_iff_different_multiplicity_le_count + (A := A) (K₀ := K₀) hu0).mp hu + have hq₀Count := hcounts q₀ + rw [huExact] at hq₀Count + exact (not_lt_of_ge hq₀Count) hbad + rw [FractionalIdeal.mem_dual (A := A) (K := K₀) + (I := (1 : FractionalIdeal B⁰ L)) one_ne_zero] at huNotDual + push Not at huNotDual + obtain ⟨s, hs, husNot⟩ := huNotDual + have hs0 : s ≠ 0 := by + intro hsZero + subst s + simp [Algebra.traceForm_apply] at husNot + let z₀ : L := u * s + have hz₀0 : z₀ ≠ 0 := mul_ne_zero hu0 hs0 + have htraceNot : Algebra.trace K₀ L z₀ ∉ (algebraMap A K₀).range := by + simpa only [Algebra.traceForm_apply, z₀] using husNot + have hsCount : ∀ q : HeightOneSpectrum B, + 0 ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ s) := by + have hsCounts := (FractionalIdeal.mem_iff_count_ge + (I := (1 : FractionalIdeal B⁰ L)) one_ne_zero hs0).mp hs + intro q + simpa only [FractionalIdeal.count_one] using hsCounts q + have hz₀Count : ∀ q : HeightOneSpectrum B, + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ z₀) = + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ u) + + FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ s) := by + intro q + change FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (u * s)) = _ + rw [← FractionalIdeal.spanSingleton_mul_spanSingleton, + FractionalIdeal.count_mul] + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hu0 + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hs0 + have hz₀Away : ∀ q : HeightOneSpectrum B, q.under A ≠ p → + 0 ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ z₀) := by + intro q hq + rw [hz₀Count q] + exact add_nonneg (huAway q hq) (hsCount q) + let t : K₀ := Algebra.trace K₀ L z₀ + have ht0 : t ≠ 0 := by + intro ht + apply htraceNot + rw [show Algebra.trace K₀ L z₀ = t from rfl, ht] + exact ⟨0, map_zero (algebraMap A K₀)⟩ + have hpNotIntegral : ¬ p.valuation K₀ t ≤ 1 := by + intro hp + apply htraceNot + apply HeightOneSpectrum.mem_integers_of_valuation_le_one + intro v + by_cases hv : v = p + · simpa [t, hv] using hp + · have hlocal : ∀ q : HeightOneSpectrum B, + q.under A = v → + -(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ z₀) := by + intro q hq + have hqAway : q.under A ≠ p := by + rw [hq] + exact hv + have hnonneg := hz₀Away q hqAway + have hmult : 0 ≤ + (multiplicity q.asIdeal (differentIdeal A B) : ℤ) := by + exact_mod_cast (Nat.zero_le + (multiplicity q.asIdeal (differentIdeal A B))) + omega + simpa [t] using + valuation_trace_le_one_of_different_count_bounds_over + (A := A) (K₀ := K₀) (B := B) (L := L) v hz₀0 hlocal + have hpGt : 1 < p.valuation K₀ t := lt_of_not_ge hpNotIntegral + have htVal : p.valuation K₀ t = + WithZero.exp (-FractionalIdeal.count K₀ p + (FractionalIdeal.spanSingleton A⁰ t)) := by + simpa using (FractionalIdeal.valuation_eq_exp_neg_count + (R := A) (K := K₀) p (Units.mk0 t ht0)) + have hwLeTrace : p.valuation K₀ w ≤ p.valuation K₀ t := by + rw [hwVal, htVal, WithZero.exp_le_exp] + rw [htVal, ← WithZero.exp_zero, WithZero.exp_lt_exp] at hpGt + omega + let r : K₀ := w / t + have hr0 : r ≠ 0 := div_ne_zero hw ht0 + have hrIntegral : p.valuation K₀ r ≤ 1 := by + change p.valuation K₀ (w / t) ≤ 1 + rw [(p.valuation K₀).map_div] + exact (div_le_one₀ (show 0 < p.valuation K₀ t by + rw [htVal] + exact WithZero.exp_pos)).mpr hwLeTrace + let z : L := r • z₀ + have hz0 : z ≠ 0 := smul_ne_zero hr0 hz₀0 + have htraceZ : Algebra.trace K₀ L z = w := by + change Algebra.trace K₀ L (r • z₀) = w + rw [map_smul] + change (w / t) * t = w + exact div_mul_cancel₀ w ht0 + refine ⟨z, hz0, htraceZ, ?_⟩ + intro q hq + have hrTopVal : q.valuation L (algebraMap K₀ L r) ≤ 1 := + heightOneValuation_algebraMap_le_one_of_under + q p hq hrIntegral + have hrTop0 : algebraMap K₀ L r ≠ 0 := + by simpa using (algebraMap K₀ L).injective.ne hr0 + have hrCount : 0 ≤ FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap K₀ L r)) := + zero_le_count_spanSingleton_of_valuation_le_one q hrTop0 hrTopVal + have hzCount : FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ z) = + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ (algebraMap K₀ L r)) + + FractionalIdeal.count L q + (FractionalIdeal.spanSingleton B⁰ z₀) := by + rw [show z = r • z₀ from rfl, Algebra.smul_def, + ← FractionalIdeal.spanSingleton_mul_spanSingleton, + FractionalIdeal.count_mul] + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hrTop0 + · exact FractionalIdeal.spanSingleton_ne_zero_iff.mpr hz₀0 + rw [hzCount, hz₀Count q] + have huq := huOver q hq + have hsq := hsCount q + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean new file mode 100644 index 0000000000..7e63dbdfdb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions + +/-! +# Divisible-even errors from one enlarged constant field + +Let `F / K(X)` have exact constant field `K`, and let `C / K` be finite +Galois of degree `r`. Exact constant-extension splitting identifies the +closed-place count of `C F` at level `m` with the count of `F` at level +`r m`. Since `#C = (#K)^r`, a square-root-scale estimate for `C F` along +the levels `2 H n` is therefore exactly such an estimate for `F` along the +fixed divisible-even subsequence `2 (r H) n`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open Filter Asymptotics + + +variable (K C F : Type*) + [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Field C] [Fintype C] [Algebra K C] + [FiniteDimensional K C] [IsGalois K C] + [Field F] [Algebra (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +local instance divisibleErrorBaseConstantAlgebra : Algebra K F := + bridgeBaseConstantAlgebra K F + +local instance divisibleErrorBaseConstantTower : + IsScalarTower K (RatFunc K) F := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Pointwise error transport from the scalar extension `C F` to `F`. +The multiplier `r H`, where `r = [C : K]`, is independent of `n`. -/ +theorem finiteExtensionClosedPlace_divisibleEvenError_bound_of_constantBase + (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) + (H : ℕ) (A B : ℝ) + (hbound : ∀ n, 0 < n → + |(exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (2 * H * n) : ℝ) - + (Nat.card C : ℝ) ^ (2 * H * n) - 1| ≤ + A + B * (Nat.card C : ℝ) ^ (H * n)) : + ∀ n, 0 < n → + |(finiteExtensionClosedPlaceExtensionCount K F + (2 * (Module.finrank K C * H) * n) : ℝ) - + (Nat.card K : ℝ) ^ + (2 * (Module.finrank K C * H) * n) - 1| ≤ + A + B * (((Nat.card K : ℝ) ^ + (Module.finrank K C * H)) ^ n) := by + intro n hn + have hcount : + exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (2 * H * n) = + finiteExtensionClosedPlaceExtensionCount K F + (2 * (Module.finrank K C * H) * n) := by + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + have h := exactConstantExtensionClosedPlaceExtensionCount_eq + K C F hExact (2 * H * n) + convert h using 1 + all_goals congr 1 <;> ring + have hcard : Nat.card C = Nat.card K ^ Module.finrank K C := + Module.natCard_eq_pow_finrank + have hcenter : + (Nat.card C : ℝ) ^ (2 * H * n) = + (Nat.card K : ℝ) ^ + (2 * (Module.finrank K C * H) * n) := by + rw [hcard, Nat.cast_pow] + calc + ((Nat.card K : ℝ) ^ Module.finrank K C) ^ (2 * H * n) = + (Nat.card K : ℝ) ^ + (Module.finrank K C * (2 * H * n)) := by + exact (pow_mul (Nat.card K : ℝ) + (Module.finrank K C) (2 * H * n)).symm + _ = (Nat.card K : ℝ) ^ + (2 * (Module.finrank K C * H) * n) := by + congr 1 + ring + have hscale : + (Nat.card C : ℝ) ^ (H * n) = + ((Nat.card K : ℝ) ^ (Module.finrank K C * H)) ^ n := by + rw [hcard, Nat.cast_pow] + calc + ((Nat.card K : ℝ) ^ Module.finrank K C) ^ (H * n) = + (Nat.card K : ℝ) ^ + (Module.finrank K C * (H * n)) := by + exact (pow_mul (Nat.card K : ℝ) + (Module.finrank K C) (H * n)).symm + _ = (Nat.card K : ℝ) ^ + ((Module.finrank K C * H) * n) := by + congr 1 + ring + _ = ((Nat.card K : ℝ) ^ + (Module.finrank K C * H)) ^ n := by + exact pow_mul (Nat.card K : ℝ) + (Module.finrank K C * H) n + have h := hbound n hn + rw [hcount, hcenter, hscale] at h + exact h + +/-- The preceding pointwise transport immediately supplies the +divisible-even `IsBigO` premise used by the spectral Hasse argument. -/ +theorem finiteExtensionClosedPlace_divisibleEvenError_isBigO_of_constantBase + (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) + (H : ℕ) (A B : ℝ) (hA : 0 ≤ A) + (hbound : ∀ n, 0 < n → + |(exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (2 * H * n) : ℝ) - + (Nat.card C : ℝ) ^ (2 * H * n) - 1| ≤ + A + B * (Nat.card C : ℝ) ^ (H * n)) : + (fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount K F + (2 * (Module.finrank K C * H) * n) : ℂ) - + (Nat.card K : ℂ) ^ + (2 * (Module.finrank K C * H) * n) - 1) =O[atTop] + fun n : ℕ ↦ + ((Nat.card K : ℝ) ^ (Module.finrank K C * H)) ^ n := by + apply divisibleEvenExtensionError_isBigO_of_pointwise_bound + (Nat.card K) (Module.finrank K C * H) + (finiteExtensionClosedPlaceExtensionCount K F) A B + Nat.card_pos hA + exact finiteExtensionClosedPlace_divisibleEvenError_bound_of_constantBase + K C F hExact H A B hbound + +/-- Closed Hasse--Weil over `K` from one fixed enlarged constant field. +The geometric work is isolated in `hbound`; exact splitting and the spectral +argument discharge every remaining count and zeta-function step. -/ +theorem finiteExtensionClosedPlaceHasseBound_of_constantBase_bound + (budget : ℕ) + (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) + (hgenus : FunctionField.genus K F ≤ budget) + (H : ℕ) (hH : 0 < H) (A B : ℝ) (hA : 0 ≤ A) + (hbound : ∀ n, 0 < n → + |(exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (2 * H * n) : ℝ) - + (Nat.card C : ℝ) ^ (2 * H * n) - 1| ≤ + A + B * (Nat.card C : ℝ) ^ (H * n)) : + |(finiteExtensionClosedPlaceExtensionCount K F 1 : ℝ) - + Nat.card K - 1| ≤ + (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card K) := by + apply + finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_divisibleEvenError + K F budget (Module.finrank K C * H) hExact hgenus + (Nat.mul_pos Module.finrank_pos hH) + exact + finiteExtensionClosedPlace_divisibleEvenError_isBigO_of_constantBase + K C F hExact H A B hA hbound + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean new file mode 100644 index 0000000000..c6a97d148e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean @@ -0,0 +1,540 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization + +/-! +# Divisor classes and the indexed eventual recurrence + +This file builds the exhaustive divisor-class quotient and partitions the +effective divisors of a fixed degree into its class fibers. Under exact +constants, each fiber is the projectivization of the corresponding Riemann +space. + +The final recurrence is conditional on one explicit geometric input: +the uniform eventual Riemann formula for *arbitrary* exhaustive divisors, +not merely divisors on one effective ray. This is the remaining theorem +needed to turn the existing one-ray stabilization results into the global +divisor-count recurrence. In particular, no finiteness of a projective +divisor class group is assumed: it follows, in every sufficiently large +degree, from the uniform formula and the already proved finiteness of the +effective divisors of that degree. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance divisorClassConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance divisorClassConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The additive subgroup of exhaustive principal divisors. -/ +def finiteExtensionPrincipalDivisorSubgroup : + AddSubgroup (FiniteExtensionDivisor K L) where + carrier := {D | ∃ x : L, x ≠ 0 ∧ finiteExtensionPrincipalDivisor K L x = D} + zero_mem' := ⟨1, one_ne_zero, finiteExtensionPrincipalDivisor_one K L⟩ + add_mem' := by + rintro D E ⟨x, hx, rfl⟩ ⟨y, hy, rfl⟩ + exact ⟨x * y, mul_ne_zero hx hy, + finiteExtensionPrincipalDivisor_mul K L x y hx hy⟩ + neg_mem' := by + rintro D ⟨x, hx, rfl⟩ + exact ⟨x⁻¹, inv_ne_zero hx, + finiteExtensionPrincipalDivisor_inv K L x hx⟩ + +/-- The exhaustive divisor class group. -/ +abbrev FiniteExtensionDivisorClass := + FiniteExtensionDivisor K L ⧸ finiteExtensionPrincipalDivisorSubgroup K L + +/-- The quotient map from exhaustive divisors to divisor classes. -/ +def finiteExtensionDivisorClassMap : + FiniteExtensionDivisor K L →+ FiniteExtensionDivisorClass K L := + QuotientAddGroup.mk' (finiteExtensionPrincipalDivisorSubgroup K L) + +@[simp] +theorem finiteExtensionDivisorClassMap_principal + (x : L) (hx : x ≠ 0) : + finiteExtensionDivisorClassMap K L + (finiteExtensionPrincipalDivisor K L x) = 0 := by + change + ((finiteExtensionPrincipalDivisor K L x : FiniteExtensionDivisor K L) : + FiniteExtensionDivisor K L ⧸ finiteExtensionPrincipalDivisorSubgroup K L) = 0 + exact QuotientAddGroup.eq_zero_iff _ |>.2 ⟨x, hx, rfl⟩ + +private theorem finiteExtensionPrincipalDivisorSubgroup_le_degreeKernel : + finiteExtensionPrincipalDivisorSubgroup K L ≤ + (finiteExtensionDivisorDegreeHom K L).ker := by + rintro D ⟨x, hx, rfl⟩ + exact finiteExtensionDivisorDegree_principal K L x hx + +/-- Divisor degree descends to divisor classes because principal divisors +have degree zero. -/ +def finiteExtensionDivisorClassDegree : + FiniteExtensionDivisorClass K L →+ ℤ := + QuotientAddGroup.lift (finiteExtensionPrincipalDivisorSubgroup K L) + (finiteExtensionDivisorDegreeHom K L) + (finiteExtensionPrincipalDivisorSubgroup_le_degreeKernel K L) + +@[simp] +theorem finiteExtensionDivisorClassDegree_mk + (D : FiniteExtensionDivisor K L) : + finiteExtensionDivisorClassDegree K L + (finiteExtensionDivisorClassMap K L D) = + finiteExtensionDivisorDegree K L D := + by + rfl + +/-- Divisor classes of a prescribed integer degree. -/ +abbrev FiniteExtensionDivisorClassOfDegree (n : ℤ) := + {c : FiniteExtensionDivisorClass K L // + finiteExtensionDivisorClassDegree K L c = n} + +/-- A chosen divisor representative of a class. -/ +def finiteExtensionDivisorClassRepresentative + (c : FiniteExtensionDivisorClass K L) : FiniteExtensionDivisor K L := + Quotient.out c + +@[simp] +theorem finiteExtensionDivisorClassMap_representative + (c : FiniteExtensionDivisorClass K L) : + finiteExtensionDivisorClassMap K L + (finiteExtensionDivisorClassRepresentative K L c) = c := + Quotient.out_eq c + +theorem finiteExtensionDivisorClassRepresentative_degree + {n : ℤ} (c : FiniteExtensionDivisorClassOfDegree K L n) : + finiteExtensionDivisorDegree K L + (finiteExtensionDivisorClassRepresentative K L c.1) = n := by + calc + finiteExtensionDivisorDegree K L + (finiteExtensionDivisorClassRepresentative K L c.1) = + finiteExtensionDivisorClassDegree K L + (finiteExtensionDivisorClassMap K L + (finiteExtensionDivisorClassRepresentative K L c.1)) := by + rw [finiteExtensionDivisorClassDegree_mk] + _ = finiteExtensionDivisorClassDegree K L c.1 := by + rw [finiteExtensionDivisorClassMap_representative] + _ = n := c.2 + +/-- Translation by a divisor of degree `d` identifies the degree-`n` and +degree-`n+d` class fibers. -/ +def finiteExtensionDivisorClassOfDegreeTranslateEquiv + (H : FiniteExtensionDivisor K L) (n d : ℤ) + (hH : finiteExtensionDivisorDegree K L H = d) : + FiniteExtensionDivisorClassOfDegree K L n ≃ + FiniteExtensionDivisorClassOfDegree K L (n + d) where + toFun c := ⟨c.1 + finiteExtensionDivisorClassMap K L H, by + rw [map_add, c.2, finiteExtensionDivisorClassDegree_mk, hH]⟩ + invFun c := ⟨c.1 - finiteExtensionDivisorClassMap K L H, by + rw [map_sub, c.2, finiteExtensionDivisorClassDegree_mk, hH] + omega⟩ + left_inv c := by + apply Subtype.ext + simp + right_inv c := by + apply Subtype.ext + simp + +/-- The divisor class of an effective divisor of natural degree `n`. -/ +def finiteExtensionEffectiveDivisorClassOfDegree (n : ℕ) + (D : {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n}) : + FiniteExtensionDivisorClassOfDegree K L (n : ℤ) := by + refine ⟨finiteExtensionDivisorClassMap K L + (finiteExtensionEffectiveDivisorToDivisor K L D.1), ?_⟩ + rw [finiteExtensionDivisorClassDegree_mk] + rw [← finiteExtensionEffectiveDivisorDegree_cast K L D.1, D.2] + +/-- The fixed-degree effective divisors lying in one divisor class. -/ +abbrev FiniteExtensionEffectiveDivisorClassFiber (n : ℕ) + (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + {D : {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} // + finiteExtensionEffectiveDivisorClassOfDegree K L n D = c} + +private theorem finiteExtensionEffectiveDivisorToDivisor_of_symm + (D : {D : FiniteExtensionDivisor K L // ∀ P, 0 ≤ D P}) : + finiteExtensionEffectiveDivisorToDivisor K L + ((finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).symm D) = + D.1 := by + exact congrArg Subtype.val + ((finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).apply_symm_apply D) + +/-- A fixed-degree class fiber is exactly the effective divisors in the +principal class of its chosen representative. -/ +def finiteExtensionEffectiveDivisorClassFiberEquiv + (n : ℕ) (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) : + FiniteExtensionEffectiveDivisorClassFiber K L n c ≃ + EffectiveDivisorInPrincipalClass K L + (finiteExtensionDivisorClassRepresentative K L c.1) where + toFun E := by + let D := finiteExtensionEffectiveDivisorToDivisor K L E.1.1 + let R := finiteExtensionDivisorClassRepresentative K L c.1 + have hclass : finiteExtensionDivisorClassMap K L D = + finiteExtensionDivisorClassMap K L R := by + calc + finiteExtensionDivisorClassMap K L D = c.1 := by + exact congrArg Subtype.val E.2 + _ = finiteExtensionDivisorClassMap K L R := + (finiteExtensionDivisorClassMap_representative K L c.1).symm + refine ⟨D, finiteExtensionEffectiveDivisorToDivisor_effective K L E.1.1, ?_⟩ + obtain ⟨x, hx, hdiv⟩ := + (QuotientAddGroup.eq_iff_sub_mem.mp hclass : + D - R ∈ finiteExtensionPrincipalDivisorSubgroup K L) + refine ⟨x, hx, ?_⟩ + rw [hdiv] + exact (sub_add_cancel D R).symm + invFun E := by + let D : FiniteExtensionEffectiveDivisor K L := + (finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).symm + ⟨E.1, E.2.1⟩ + have hDcast : finiteExtensionEffectiveDivisorToDivisor K L D = E.1 := + finiteExtensionEffectiveDivisorToDivisor_of_symm K L ⟨E.1, E.2.1⟩ + have hdegreeInt : finiteExtensionDivisorDegree K L E.1 = (n : ℤ) := by + obtain ⟨x, hx, hE⟩ := E.2.2 + rw [hE, finiteExtensionDivisorDegree_add, + finiteExtensionDivisorDegree_principal K L x hx, + finiteExtensionDivisorClassRepresentative_degree K L c] + simp + have hdegreeNat : finiteExtensionEffectiveDivisorDegree K L D = n := by + have hcast := finiteExtensionEffectiveDivisorDegree_cast K L D + rw [hDcast, hdegreeInt] at hcast + exact_mod_cast hcast + refine ⟨⟨D, hdegreeNat⟩, ?_⟩ + apply Subtype.ext + change finiteExtensionDivisorClassMap K L + (finiteExtensionEffectiveDivisorToDivisor K L D) = c.1 + rw [hDcast] + obtain ⟨x, hx, hE⟩ := E.2.2 + rw [hE, map_add, finiteExtensionDivisorClassMap_principal K L x hx, + zero_add, finiteExtensionDivisorClassMap_representative] + left_inv E := by + apply Subtype.ext + apply Subtype.ext + change + (finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).symm + ((finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L) E.1.1) = E.1.1 + exact (finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).symm_apply_apply E.1.1 + right_inv E := by + apply Subtype.ext + exact finiteExtensionEffectiveDivisorToDivisor_of_symm K L ⟨E.1, E.2.1⟩ + +/-- Uniform eventual Riemann formula for arbitrary exhaustive divisors. +This is the single geometric input not supplied by the current one-ray +stabilization files. -/ +def HasFiniteExtensionUniformEventualRiemannFormula + (genus threshold : ℕ) : Prop := + genus ≤ threshold ∧ + ∀ (D : FiniteExtensionDivisor K L) (n : ℕ), threshold ≤ n → + finiteExtensionDivisorDegree K L D = (n : ℤ) → + Module.Finite K (finiteExtensionRiemannSpace K L D) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L D) = + n + 1 - genus + +/-- The uniform eventual formula makes every sufficiently large divisor +class effective. -/ +theorem finiteExtensionEffectiveDivisorClassOfDegree_surjective_of_uniformRiemann + (genus threshold n : ℕ) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) : + Function.Surjective + (finiteExtensionEffectiveDivisorClassOfDegree K L n) := by + intro c + let R := finiteExtensionDivisorClassRepresentative K L c.1 + have hRdegree : finiteExtensionDivisorDegree K L R = (n : ℤ) := + finiteExtensionDivisorClassRepresentative_degree K L c + have hdata := hRiemann.2 R n hn hRdegree + letI : Module.Finite K (finiteExtensionRiemannSpace K L R) := hdata.1 + have hpositive : + 0 < Module.finrank K (finiteExtensionRiemannSpace K L R) := by + rw [hdata.2] + have hg := hRiemann.1 + omega + letI : Nontrivial (finiteExtensionRiemannSpace K L R) := + Module.finrank_pos_iff.mp hpositive + obtain ⟨x, hx⟩ := exists_ne (0 : finiteExtensionRiemannSpace K L R) + let E : EffectiveDivisorInPrincipalClass K L R := + effectiveDivisorInPrincipalClassOfNonzeroSection K L R ⟨x, hx⟩ + let F := (finiteExtensionEffectiveDivisorClassFiberEquiv K L n c).symm E + exact ⟨F.1, F.2⟩ + +/-- Hence the set of divisor classes of every sufficiently large admissible +degree is finite. -/ +theorem finiteExtensionDivisorClassOfDegree_finite_of_uniformRiemann + (genus threshold n : ℕ) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) : + Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := by + exact Finite.of_surjective + (finiteExtensionEffectiveDivisorClassOfDegree K L n) + (finiteExtensionEffectiveDivisorClassOfDegree_surjective_of_uniformRiemann + K L genus threshold n hRiemann hn) + +/-- Under exact constants, every sufficiently large fixed-degree class fiber +is finite. -/ +theorem finiteExtensionEffectiveDivisorClassFiber_finite_of_uniformRiemann + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) + (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) : + Finite (FiniteExtensionEffectiveDivisorClassFiber K L n c) := by + let R := finiteExtensionDivisorClassRepresentative K L c.1 + have hRdegree : finiteExtensionDivisorDegree K L R = (n : ℤ) := + finiteExtensionDivisorClassRepresentative_degree K L c + have hdata := hRiemann.2 R n hn hRdegree + letI : Module.Finite K (finiteExtensionRiemannSpace K L R) := hdata.1 + letI : Finite (finiteExtensionRiemannSpace K L R) := + Module.finite_of_finite K + exact Finite.of_equiv + (Projectivization K (finiteExtensionRiemannSpace K L R)) + ((projectiveRiemannSectionEquivEffectiveDivisorInPrincipalClass + K L R hconstants).trans + (finiteExtensionEffectiveDivisorClassFiberEquiv K L n c).symm) + +/-- Every large degree-`n` class fiber has the same geometric-sum +cardinality. -/ +theorem finiteExtensionEffectiveDivisorClassFiber_card_eq_geomSum_of_uniformRiemann + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) + (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) : + Nat.card (FiniteExtensionEffectiveDivisorClassFiber K L n c) = + ∑ i ∈ Finset.range (n + 1 - genus), Nat.card K ^ i := by + let R := finiteExtensionDivisorClassRepresentative K L c.1 + have hRdegree : finiteExtensionDivisorDegree K L R = (n : ℤ) := + finiteExtensionDivisorClassRepresentative_degree K L c + have hdata := hRiemann.2 R n hn hRdegree + rw [Nat.card_congr (finiteExtensionEffectiveDivisorClassFiberEquiv K L n c)] + rw [effectiveDivisorInPrincipalClass_card_eq_geomSum K L R hconstants] + rw [hdata.2] + +/-- The global effective-divisor coefficient is the number of degree-`n` +classes times the common projective Riemann-space count. -/ +theorem finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_uniformRiemann + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) : + finiteExtensionEffectiveDivisorCount K L n = + Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) * + ∑ i ∈ Finset.range (n + 1 - genus), Nat.card K ^ i := by + letI : Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + finiteExtensionDivisorClassOfDegree_finite_of_uniformRiemann + K L genus threshold n hRiemann hn + letI : Fintype (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + Fintype.ofFinite _ + letI (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) : + Finite (FiniteExtensionEffectiveDivisorClassFiber K L n c) := + finiteExtensionEffectiveDivisorClassFiber_finite_of_uniformRiemann + K L genus threshold n hconstants hRiemann hn c + let f := finiteExtensionEffectiveDivisorClassOfDegree K L n + calc + finiteExtensionEffectiveDivisorCount K L n = + Nat.card {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} := by + rw [finiteExtensionEffectiveDivisorCount, Nat.card_eq_fintype_card] + _ = Nat.card (Σ c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ), + FiniteExtensionEffectiveDivisorClassFiber K L n c) := by + exact (Nat.card_congr (Equiv.sigmaFiberEquiv f)).symm + _ = ∑ c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ), + Nat.card (FiniteExtensionEffectiveDivisorClassFiber K L n c) := + Nat.card_sigma + _ = ∑ _c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ), + (∑ i ∈ Finset.range (n + 1 - genus), Nat.card K ^ i) := by + apply Finset.sum_congr rfl + intro c _ + exact finiteExtensionEffectiveDivisorClassFiber_card_eq_geomSum_of_uniformRiemann + K L genus threshold n hconstants hRiemann hn c + _ = Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) * + ∑ i ∈ Finset.range (n + 1 - genus), Nat.card K ^ i := by + rw [Finset.sum_const, nsmul_eq_mul] + simp [Nat.card_eq_fintype_card] + +/-- A canonical signed divisor whose degree is the divisor-degree index. It +need not be effective; this is why translation is carried out in the class +group rather than by adding an effective divisor. -/ +def finiteExtensionDivisorIndexRepresentative : + FiniteExtensionDivisor K L := + Classical.choose (exists_finiteExtensionDivisor_degree_eq_index K L) + +@[simp] +theorem finiteExtensionDivisorIndexRepresentative_degree : + finiteExtensionDivisorDegree K L + (finiteExtensionDivisorIndexRepresentative K L) = + (finiteExtensionDivisorDegreeIndex K L : ℤ) := + Classical.choose_spec (exists_finiteExtensionDivisor_degree_eq_index K L) + +/-- Translation by the signed index representative preserves the number of +classes when the degree is advanced by the index. -/ +theorem finiteExtensionDivisorClassOfDegree_natCard_add_index (n : ℕ) : + Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) = + Nat.card (FiniteExtensionDivisorClassOfDegree K L + ((n + finiteExtensionDivisorDegreeIndex K L : ℕ) : ℤ)) := by + let e := finiteExtensionDivisorClassOfDegreeTranslateEquiv K L + (finiteExtensionDivisorIndexRepresentative K L) + (n : ℤ) (finiteExtensionDivisorDegreeIndex K L : ℤ) + (finiteExtensionDivisorIndexRepresentative_degree K L) + have h := Nat.card_congr e + convert h using 1 <;> norm_num + +private theorem geomSum_add (q a b : ℕ) : + (∑ i ∈ Finset.range (a + b), q ^ i) = + (∑ i ∈ Finset.range a, q ^ i) + + q ^ a * ∑ i ∈ Finset.range b, q ^ i := by + rw [Finset.sum_range_add, Finset.mul_sum] + apply congrArg₂ (.+.) rfl + apply Finset.sum_congr rfl + intro i _ + rw [pow_add] + +/-- The finite geometric sums satisfy the indexed curve-zeta recurrence. -/ +theorem geomSum_indexed_recurrence (q ell d : ℕ) : + (∑ i ∈ Finset.range (ell + 2 * d), q ^ i) + + q ^ d * (∑ i ∈ Finset.range ell, q ^ i) = + (q ^ d + 1) * ∑ i ∈ Finset.range (ell + d), q ^ i := by + rw [show ell + 2 * d = (ell + d) + d by omega] + rw [geomSum_add q (ell + d) d, geomSum_add q ell d, pow_add] + ring + +private theorem mul_geomSum_indexed_recurrence (h q ell d : ℕ) : + h * (∑ i ∈ Finset.range (ell + 2 * d), q ^ i) + + q ^ d * (h * (∑ i ∈ Finset.range ell, q ^ i)) = + (q ^ d + 1) * + (h * ∑ i ∈ Finset.range (ell + d), q ^ i) := by + calc + h * (∑ i ∈ Finset.range (ell + 2 * d), q ^ i) + + q ^ d * (h * (∑ i ∈ Finset.range ell, q ^ i)) = + h * ((∑ i ∈ Finset.range (ell + 2 * d), q ^ i) + + q ^ d * (∑ i ∈ Finset.range ell, q ^ i)) := by ring + _ = h * ((q ^ d + 1) * + ∑ i ∈ Finset.range (ell + d), q ^ i) := by + rw [geomSum_indexed_recurrence] + _ = (q ^ d + 1) * + (h * ∑ i ∈ Finset.range (ell + d), q ^ i) := by ring + +/-- The actual eventual indexed recurrence for exhaustive effective-divisor +counts. The only unproved input is the explicitly stated uniform eventual +Riemann formula. -/ +theorem finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) : + finiteExtensionEffectiveDivisorCount K L + (n + 2 * finiteExtensionDivisorDegreeIndex K L) + + Nat.card K ^ finiteExtensionDivisorDegreeIndex K L * + finiteExtensionEffectiveDivisorCount K L n = + (Nat.card K ^ finiteExtensionDivisorDegreeIndex K L + 1) * + finiteExtensionEffectiveDivisorCount K L + (n + finiteExtensionDivisorDegreeIndex K L) := by + let d := finiteExtensionDivisorDegreeIndex K L + let q := Nat.card K + have hn1 : threshold ≤ n + d := by omega + have hn2 : threshold ≤ n + 2 * d := by omega + have hcount0 := + finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_uniformRiemann + K L genus threshold n hconstants hRiemann hn + have hcount1 := + finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_uniformRiemann + K L genus threshold (n + d) hconstants hRiemann hn1 + have hcount2 := + finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_uniformRiemann + K L genus threshold (n + 2 * d) hconstants hRiemann hn2 + have hclass01 : + Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) = + Nat.card (FiniteExtensionDivisorClassOfDegree K L ((n + d : ℕ) : ℤ)) := by + simpa [d] using + (finiteExtensionDivisorClassOfDegree_natCard_add_index K L n) + have hclass12 : + Nat.card (FiniteExtensionDivisorClassOfDegree K L ((n + d : ℕ) : ℤ)) = + Nat.card (FiniteExtensionDivisorClassOfDegree K L + ((n + 2 * d : ℕ) : ℤ)) := by + simpa [d, Nat.add_assoc, two_mul] using + (finiteExtensionDivisorClassOfDegree_natCard_add_index K L (n + d)) + have hgenus : genus ≤ n := hRiemann.1.trans hn + have hlength1 : n + d + 1 - genus = (n + 1 - genus) + d := by omega + have hlength2 : n + 2 * d + 1 - genus = (n + 1 - genus) + 2 * d := by omega + change + finiteExtensionEffectiveDivisorCount K L (n + 2 * d) + + q ^ d * finiteExtensionEffectiveDivisorCount K L n = + (q ^ d + 1) * finiteExtensionEffectiveDivisorCount K L (n + d) + rw [hcount0, hcount1, hcount2] + rw [← hclass12, ← hclass01] + rw [hlength1, hlength2] + exact mul_geomSum_indexed_recurrence + (Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ))) + q (n + 1 - genus) d + +/-- Subtractive integer form of the indexed recurrence, matching the +coefficient hypothesis used by formal zeta rationality. -/ +theorem finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence_int + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) : + (finiteExtensionEffectiveDivisorCount K L + (n + 2 * finiteExtensionDivisorDegreeIndex K L) : ℤ) = + ((Nat.card K ^ finiteExtensionDivisorDegreeIndex K L + 1 : ℕ) : ℤ) * + finiteExtensionEffectiveDivisorCount K L + (n + finiteExtensionDivisorDegreeIndex K L) - + (Nat.card K ^ finiteExtensionDivisorDegreeIndex K L : ℕ) * + finiteExtensionEffectiveDivisorCount K L n := by + have h := congrArg (fun m : ℕ ↦ (m : ℤ)) + (finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence + K L genus threshold n hconstants hRiemann hn) + push_cast at h ⊢ + apply eq_sub_iff_add_eq.mpr + simpa [add_comm, add_left_comm, add_assoc] using h + +/-- Complex form used directly by `FormalZetaRationality`. -/ +theorem finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence_complex + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) : + (finiteExtensionEffectiveDivisorCount K L + (n + 2 * finiteExtensionDivisorDegreeIndex K L) : ℂ) = + ((Nat.card K : ℂ) ^ finiteExtensionDivisorDegreeIndex K L + 1) * + finiteExtensionEffectiveDivisorCount K L + (n + finiteExtensionDivisorDegreeIndex K L) - + (Nat.card K : ℂ) ^ finiteExtensionDivisorDegreeIndex K L * + finiteExtensionEffectiveDivisorCount K L n := by + have h := congrArg (fun m : ℕ ↦ (m : ℂ)) + (finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence + K L genus threshold n hconstants hRiemann hn) + push_cast at h ⊢ + apply eq_sub_iff_add_eq.mpr + simpa [add_comm, add_left_comm, add_assoc] using h + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean new file mode 100644 index 0000000000..57378920f7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean @@ -0,0 +1,322 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +import Mathlib.GroupTheory.Archimedean + +/-! +# The divisor-degree index + +For a finite separable extension of `K(X)`, divisor degree is an additive map +from the exhaustive divisor group to `ℤ`. Its image is a nonzero subgroup of +`ℤ`, hence is generated by one positive natural number. This file defines +that generator and proves its two equivalent universal properties: + +* it generates every divisor degree; and +* it is the greatest common divisor of the degrees of all exhaustive places. + +This is the integer `δ` introduced in Stichtenoth, Lemma 5.1.4 (printed +p. 187). The zeta-function rationality argument initially works with `δ` +arbitrary. The later theorem `δ = 1` is F. K. Schmidt's theorem (Corollary +5.1.11, printed p. 191); Stichtenoth proves it only after rationality and the +constant-extension identity for zeta functions. Consequently no implication +from exact constants to `δ = 1` is asserted here: doing so at this stage would +make the intended zeta proof circular. The exact missing conclusion is +isolated by the degree-one criterion at the end of the file. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance divisorDegreeIndexInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance divisorDegreeIndexInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance divisorDegreeIndexInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance divisorDegreeIndexInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +private theorem finiteExtensionDivisorDegree_add_index + (D E : FiniteExtensionPlace K L →₀ ℤ) : + finiteExtensionDivisorDegree K L (D + E) = + finiteExtensionDivisorDegree K L D + + finiteExtensionDivisorDegree K L E := by + classical + simpa only [finiteExtensionDivisorDegree] using + (Finsupp.sum_add_index (f := D) (g := E) + (h := fun v e ↦ e * (finiteExtensionPlaceDegree K L v : ℤ)) + (by simp) (by intros; ring)) + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +private theorem finiteExtensionDivisorDegree_single_index + (P : FiniteExtensionPlace K L) (z : ℤ) : + finiteExtensionDivisorDegree K L (Finsupp.single P z) = + z * (finiteExtensionPlaceDegree K L P : ℤ) := by + classical + simp [finiteExtensionDivisorDegree] + +/-- Divisor degree as an additive homomorphism to `ℤ`. -/ +def finiteExtensionDivisorDegreeHom : + (FiniteExtensionPlace K L →₀ ℤ) →+ ℤ where + toFun := finiteExtensionDivisorDegree K L + map_zero' := by simp [finiteExtensionDivisorDegree] + map_add' := finiteExtensionDivisorDegree_add_index K L + +private noncomputable def finiteExtensionDivisorDegreeGenerator : ℤ := + Classical.choose + (Int.subgroup_cyclic (finiteExtensionDivisorDegreeHom K L).range) + +/-- The positive generator of the image of divisor degree. Equivalently, +this is the gcd of the degrees of all exhaustive places. -/ +def finiteExtensionDivisorDegreeIndex : ℕ := + (finiteExtensionDivisorDegreeGenerator K L).natAbs + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +private theorem finiteExtensionDivisorDegreeHom_range_eq_zmultiples : + (finiteExtensionDivisorDegreeHom K L).range = + AddSubgroup.zmultiples + (finiteExtensionDivisorDegreeIndex K L : ℤ) := by + let a := finiteExtensionDivisorDegreeGenerator K L + have ha : (finiteExtensionDivisorDegreeHom K L).range = + AddSubgroup.closure {a} := + Classical.choose_spec + (Int.subgroup_cyclic (finiteExtensionDivisorDegreeHom K L).range) + calc + (finiteExtensionDivisorDegreeHom K L).range = + AddSubgroup.closure {a} := ha + _ = AddSubgroup.zmultiples a := + (AddSubgroup.zmultiples_eq_closure a).symm + _ = AddSubgroup.zmultiples + (finiteExtensionDivisorDegreeIndex K L : ℤ) := by + rw [finiteExtensionDivisorDegreeIndex] + exact (Int.zmultiples_natAbs a).symm + +omit [Fintype K] in +private theorem finiteExtensionDivisorDegreeHom_range_ne_bot : + (finiteExtensionDivisorDegreeHom K L).range ≠ ⊥ := by + let P : FiniteExtensionInfinityPlace K L := + Classical.choice (inferInstance : Nonempty (FiniteExtensionInfinityPlace K L)) + let D : FiniteExtensionPlace K L →₀ ℤ := Finsupp.single (.inr P) 1 + have hmem : finiteExtensionDivisorDegree K L D ∈ + (finiteExtensionDivisorDegreeHom K L).range := ⟨D, rfl⟩ + have hdegree : finiteExtensionDivisorDegree K L D = + (finiteExtensionPlaceDegree K L (.inr P) : ℤ) := by + rw [finiteExtensionDivisorDegree_single_index] + simp + intro hrange + rw [hrange, AddSubgroup.mem_bot, hdegree] at hmem + have hzero : finiteExtensionPlaceDegree K L (.inr P) = 0 := by + exact_mod_cast hmem + exact (finiteExtensionPlaceDegree_pos K L (.inr P)).ne' hzero + +omit [Fintype K] in +/-- The divisor-degree index is strictly positive. -/ +theorem finiteExtensionDivisorDegreeIndex_pos : + 0 < finiteExtensionDivisorDegreeIndex K L := by + apply Nat.pos_of_ne_zero + intro hzero + apply finiteExtensionDivisorDegreeHom_range_ne_bot K L + rw [finiteExtensionDivisorDegreeHom_range_eq_zmultiples K L, hzero] + simp + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- Every divisor degree is an integer multiple of the index. -/ +theorem finiteExtensionDivisorDegreeIndex_dvd_divisorDegree + (D : FiniteExtensionPlace K L →₀ ℤ) : + (finiteExtensionDivisorDegreeIndex K L : ℤ) ∣ + finiteExtensionDivisorDegree K L D := by + rw [← Int.mem_zmultiples_iff, + ← finiteExtensionDivisorDegreeHom_range_eq_zmultiples K L] + exact ⟨D, rfl⟩ + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- The index itself occurs as the degree of an exhaustive divisor. -/ +theorem exists_finiteExtensionDivisor_degree_eq_index : + ∃ D : FiniteExtensionPlace K L →₀ ℤ, + finiteExtensionDivisorDegree K L D = + (finiteExtensionDivisorDegreeIndex K L : ℤ) := by + have hmem : (finiteExtensionDivisorDegreeIndex K L : ℤ) ∈ + AddSubgroup.zmultiples + (finiteExtensionDivisorDegreeIndex K L : ℤ) := + AddSubgroup.mem_zmultiples _ + rw [← finiteExtensionDivisorDegreeHom_range_eq_zmultiples K L] at hmem + rcases hmem with ⟨D, hD⟩ + exact ⟨D, hD⟩ + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- The image of divisor degree is exactly the subgroup of multiples of the +index. -/ +theorem finiteExtensionDivisorDegree_mem_range_iff + (n : ℤ) : + n ∈ (finiteExtensionDivisorDegreeHom K L).range ↔ + (finiteExtensionDivisorDegreeIndex K L : ℤ) ∣ n := by + rw [finiteExtensionDivisorDegreeHom_range_eq_zmultiples K L, + Int.mem_zmultiples_iff] + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- An integer occurs as a divisor degree exactly when it is a multiple of +the index. -/ +theorem exists_finiteExtensionDivisor_degree_eq_iff + (n : ℤ) : + (∃ D : FiniteExtensionPlace K L →₀ ℤ, + finiteExtensionDivisorDegree K L D = n) ↔ + (finiteExtensionDivisorDegreeIndex K L : ℤ) ∣ n := by + rw [← finiteExtensionDivisorDegree_mem_range_iff K L n] + rfl + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- Natural-valued form of index divisibility, used for zeta coefficients. -/ +theorem finiteExtensionDivisorDegreeIndex_dvd_nat_of_degree_eq + (D : FiniteExtensionPlace K L →₀ ℤ) (n : ℕ) + (hD : finiteExtensionDivisorDegree K L D = (n : ℤ)) : + finiteExtensionDivisorDegreeIndex K L ∣ n := by + have hdiv : (finiteExtensionDivisorDegreeIndex K L : ℤ) ∣ (n : ℤ) := by + rw [← hD] + exact finiteExtensionDivisorDegreeIndex_dvd_divisorDegree K L D + exact_mod_cast hdiv + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- If the index does not divide `n`, there is no divisor (and hence no +effective divisor) of degree `n`. -/ +theorem not_exists_finiteExtensionDivisor_degree_eq_of_not_dvd + (n : ℕ) (hn : ¬ finiteExtensionDivisorDegreeIndex K L ∣ n) : + ¬ ∃ D : FiniteExtensionPlace K L →₀ ℤ, + finiteExtensionDivisorDegree K L D = (n : ℤ) := by + rintro ⟨D, hD⟩ + exact hn + (finiteExtensionDivisorDegreeIndex_dvd_nat_of_degree_eq K L D n hD) + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- The index divides the degree of each exhaustive place. -/ +theorem finiteExtensionDivisorDegreeIndex_dvd_placeDegree + (P : FiniteExtensionPlace K L) : + finiteExtensionDivisorDegreeIndex K L ∣ + finiteExtensionPlaceDegree K L P := by + have hdiv := finiteExtensionDivisorDegreeIndex_dvd_divisorDegree K L + (Finsupp.single P 1) + rw [finiteExtensionDivisorDegree_single_index] at hdiv + simp only [one_mul] at hdiv + exact_mod_cast hdiv + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +private theorem integer_dvd_finiteExtensionDivisorDegree_of_dvd_placeDegree + (d : ℕ) (hd : ∀ P : FiniteExtensionPlace K L, + d ∣ finiteExtensionPlaceDegree K L P) + (D : FiniteExtensionPlace K L →₀ ℤ) : + (d : ℤ) ∣ finiteExtensionDivisorDegree K L D := by + classical + induction D using Finsupp.induction with + | zero => simp [finiteExtensionDivisorDegree] + | single_add P z D hPD hz ih => + rw [finiteExtensionDivisorDegree_add_index, + finiteExtensionDivisorDegree_single_index] + apply dvd_add + · obtain ⟨c, hc⟩ := hd P + refine ⟨z * (c : ℤ), ?_⟩ + rw [hc] + push_cast + ring + · exact ih + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- Any natural number dividing every place degree also divides the divisor +degree index. Together with `finiteExtensionDivisorDegreeIndex_dvd_placeDegree`, +this is the gcd universal property. -/ +theorem dvd_finiteExtensionDivisorDegreeIndex_of_dvd_placeDegree + (d : ℕ) (hd : ∀ P : FiniteExtensionPlace K L, + d ∣ finiteExtensionPlaceDegree K L P) : + d ∣ finiteExtensionDivisorDegreeIndex K L := by + obtain ⟨D, hD⟩ := exists_finiteExtensionDivisor_degree_eq_index K L + have hdiv : (d : ℤ) ∣ finiteExtensionDivisorDegree K L D := + integer_dvd_finiteExtensionDivisorDegree_of_dvd_placeDegree K L d hd D + rw [hD] at hdiv + exact_mod_cast hdiv + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- Universal characterization of the divisor-degree index as the gcd of all +exhaustive place degrees. -/ +theorem finiteExtensionDivisorDegreeIndex_isGCD : + (∀ P : FiniteExtensionPlace K L, + finiteExtensionDivisorDegreeIndex K L ∣ + finiteExtensionPlaceDegree K L P) ∧ + ∀ d : ℕ, (∀ P : FiniteExtensionPlace K L, + d ∣ finiteExtensionPlaceDegree K L P) → + d ∣ finiteExtensionDivisorDegreeIndex K L := by + exact ⟨finiteExtensionDivisorDegreeIndex_dvd_placeDegree K L, + dvd_finiteExtensionDivisorDegreeIndex_of_dvd_placeDegree K L⟩ + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- A positive divisor degree is at least the index. -/ +theorem finiteExtensionDivisorDegreeIndex_le_of_degree_eq_nat + (D : FiniteExtensionPlace K L →₀ ℤ) (n : ℕ) (hn : 0 < n) + (hD : finiteExtensionDivisorDegree K L D = (n : ℤ)) : + finiteExtensionDivisorDegreeIndex K L ≤ n := by + have hdivNat : finiteExtensionDivisorDegreeIndex K L ∣ n := + finiteExtensionDivisorDegreeIndex_dvd_nat_of_degree_eq K L D n hD + exact Nat.le_of_dvd hn hdivNat + +omit [Fintype K] in +/-- The index is one exactly when there exists an exhaustive divisor of +degree one. Thus an exact-constants-to-index-one proof must genuinely +construct (or otherwise imply) such a degree-one divisor; exact constants by +themselves only control the kernel of principal divisor, not this image. -/ +theorem finiteExtensionDivisorDegreeIndex_eq_one_iff : + finiteExtensionDivisorDegreeIndex K L = 1 ↔ + ∃ D : FiniteExtensionPlace K L →₀ ℤ, + finiteExtensionDivisorDegree K L D = 1 := by + constructor + · intro hindex + obtain ⟨D, hD⟩ := exists_finiteExtensionDivisor_degree_eq_index K L + exact ⟨D, by simpa [hindex] using hD⟩ + · rintro ⟨D, hD⟩ + have hle : finiteExtensionDivisorDegreeIndex K L ≤ 1 := + finiteExtensionDivisorDegreeIndex_le_of_degree_eq_nat K L D 1 + Nat.zero_lt_one (by simpa using hD) + have hpos := finiteExtensionDivisorDegreeIndex_pos K L + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean new file mode 100644 index 0000000000..eeb2ac1165 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean @@ -0,0 +1,399 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import Mathlib.Data.Finsupp.Fintype + +/-! +# Splitting effective exhaustive divisors at infinity + +An effective divisor on the exhaustive place type of a finite extension of +`K(X)` is a finitely supported natural-number-valued function. Since that +place type is a sum of finite and above-infinity places, such a divisor +splits canonically into its finite and infinity parts. + +This file records the inverse equivalence, degree additivity, the conversion +to the repository's integer-valued effective divisors, and the resulting +fixed-degree convolution. The finite component is also identified with a +nonzero ideal in the normalization of `K[X]`. +-/ + +open scoped nonZeroDivisors Polynomial BigOperators + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- Effective divisors on all exhaustive places. -/ +abbrev FiniteExtensionEffectiveDivisor := + FiniteExtensionPlace K L →₀ ℕ + +/-- Effective divisors supported above the place at infinity. -/ +abbrev FiniteExtensionEffectiveInfinityDivisor := + FiniteExtensionInfinityPlace K L →₀ ℕ + +/-- Natural-number degree of an effective exhaustive divisor. -/ +def finiteExtensionEffectiveDivisorDegree + (D : FiniteExtensionEffectiveDivisor K L) : ℕ := + D.sum fun P e => e * finiteExtensionPlaceDegree K L P + +/-- Natural-number degree of an effective divisor supported at infinity. -/ +def finiteExtensionEffectiveInfinityDivisorDegree + (D : FiniteExtensionEffectiveInfinityDivisor K L) : ℕ := + D.sum fun P e => e * finiteExtensionPlaceDegree K L (.inr P) + +/-- An effective exhaustive divisor is exactly a pair consisting of its +finite-place and infinity-place components. -/ +def finiteExtensionEffectiveDivisorSplitEquiv : + FiniteExtensionEffectiveDivisor K L ≃ + (FiniteExtensionFinitePlace K L →₀ ℕ) × + FiniteExtensionEffectiveInfinityDivisor K L := + Finsupp.sumFinsuppEquivProdFinsupp + +@[simp] +theorem finiteExtensionEffectiveDivisorSplitEquiv_finite_apply + (D : FiniteExtensionEffectiveDivisor K L) + (P : FiniteExtensionFinitePlace K L) : + (finiteExtensionEffectiveDivisorSplitEquiv K L D).1 P = D (.inl P) := + rfl + +@[simp] +theorem finiteExtensionEffectiveDivisorSplitEquiv_infinity_apply + (D : FiniteExtensionEffectiveDivisor K L) + (P : FiniteExtensionInfinityPlace K L) : + (finiteExtensionEffectiveDivisorSplitEquiv K L D).2 P = D (.inr P) := + rfl + +@[simp] +theorem finiteExtensionEffectiveDivisorSplitEquiv_symm_inl + (D : (FiniteExtensionFinitePlace K L →₀ ℕ) × + FiniteExtensionEffectiveInfinityDivisor K L) + (P : FiniteExtensionFinitePlace K L) : + (finiteExtensionEffectiveDivisorSplitEquiv K L).symm D (.inl P) = D.1 P := + rfl + +@[simp] +theorem finiteExtensionEffectiveDivisorSplitEquiv_symm_inr + (D : (FiniteExtensionFinitePlace K L →₀ ℕ) × + FiniteExtensionEffectiveInfinityDivisor K L) + (P : FiniteExtensionInfinityPlace K L) : + (finiteExtensionEffectiveDivisorSplitEquiv K L).symm D (.inr P) = D.2 P := + rfl + +/-- The existing finite-divisor degree is the restriction of exhaustive +place degree to the finite branch. -/ +theorem finiteExtensionEffectiveFiniteDivisorDegree_eq_placeDegree + (D : FiniteExtensionFinitePlace K L →₀ ℕ) : + finiteExtensionEffectiveFiniteDivisorDegree K L D = + D.sum (fun P e => e * finiteExtensionPlaceDegree K L (.inl P)) := by + apply Finsupp.sum_congr + intro P _ + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K L P] + +/-- Degree is additive across the finite/infinity split. -/ +theorem finiteExtensionEffectiveDivisorDegree_split + (D : FiniteExtensionEffectiveDivisor K L) : + finiteExtensionEffectiveDivisorDegree K L D = + finiteExtensionEffectiveFiniteDivisorDegree K L + (finiteExtensionEffectiveDivisorSplitEquiv K L D).1 + + finiteExtensionEffectiveInfinityDivisorDegree K L + (finiteExtensionEffectiveDivisorSplitEquiv K L D).2 := by + rw [finiteExtensionEffectiveDivisorDegree, + finiteExtensionEffectiveFiniteDivisorDegree_eq_placeDegree, + finiteExtensionEffectiveInfinityDivisorDegree] + let e := finiteExtensionEffectiveDivisorSplitEquiv K L + let g := fun P : FiniteExtensionPlace K L => fun n : ℕ => + n * finiteExtensionPlaceDegree K L P + change D.sum g = + (e D).1.sum (g ∘ Sum.inl) + (e D).2.sum (g ∘ Sum.inr) + calc + D.sum g = (e.symm (e D)).sum g := by + rw [e.symm_apply_apply] + _ = (e D).1.sum (g ∘ Sum.inl) + (e D).2.sum (g ∘ Sum.inr) := by + change (Finsupp.sumElim (e D).1 (e D).2).sum g = _ + exact Finsupp.sum_sumElim _ _ _ + +/-- Cast an effective natural-number divisor to the integer-valued divisor +type used by Riemann spaces and divisor classes. -/ +def finiteExtensionEffectiveDivisorToDivisor + (D : FiniteExtensionEffectiveDivisor K L) : FiniteExtensionDivisor K L := + D.mapRange (fun n : ℕ => (n : ℤ)) (by simp) + +@[simp] +theorem finiteExtensionEffectiveDivisorToDivisor_apply + (D : FiniteExtensionEffectiveDivisor K L) + (P : FiniteExtensionPlace K L) : + finiteExtensionEffectiveDivisorToDivisor K L D P = D P := by + simp [finiteExtensionEffectiveDivisorToDivisor] + +/-- The cast divisor is effective. -/ +theorem finiteExtensionEffectiveDivisorToDivisor_effective + (D : FiniteExtensionEffectiveDivisor K L) (P : FiniteExtensionPlace K L) : + 0 ≤ finiteExtensionEffectiveDivisorToDivisor K L D P := by + simp + +/-- Natural degree casts to the integer degree of the associated exhaustive +divisor. -/ +theorem finiteExtensionEffectiveDivisorDegree_cast + (D : FiniteExtensionEffectiveDivisor K L) : + (finiteExtensionEffectiveDivisorDegree K L D : ℤ) = + finiteExtensionDivisorDegree K L + (finiteExtensionEffectiveDivisorToDivisor K L D) := by + rw [finiteExtensionEffectiveDivisorDegree, finiteExtensionDivisorDegree, + finiteExtensionEffectiveDivisorToDivisor] + rw [Finsupp.sum_mapRange_index (fun _ => by simp)] + push_cast + rfl + +/-- Natural effective exhaustive divisors are equivalent to the subtype of +pointwise-effective integer-valued exhaustive divisors. -/ +def finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor : + FiniteExtensionEffectiveDivisor K L ≃ + {D : FiniteExtensionDivisor K L // ∀ P, 0 ≤ D P} where + toFun D := ⟨finiteExtensionEffectiveDivisorToDivisor K L D, + finiteExtensionEffectiveDivisorToDivisor_effective K L D⟩ + invFun D := D.1.mapRange Int.toNat (by simp) + left_inv D := by + ext P + simp [finiteExtensionEffectiveDivisorToDivisor] + right_inv D := by + apply Subtype.ext + ext P + simp [finiteExtensionEffectiveDivisorToDivisor, + Int.toNat_of_nonneg (D.2 P)] + +/-- Splitting an effective exhaustive divisor and replacing its finite part +by the corresponding nonzero affine ideal. -/ +def finiteExtensionEffectiveDivisorAffineInfinityEquiv : + FiniteExtensionEffectiveDivisor K L ≃ + FiniteExtensionAffineIdeal K L × + FiniteExtensionEffectiveInfinityDivisor K L := + (finiteExtensionEffectiveDivisorSplitEquiv K L).trans + ((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm.prodCongr + (Equiv.refl _)) + +/-- Under the ideal/infinity equivalence, exhaustive degree is affine ideal +degree plus infinity degree. -/ +theorem finiteExtensionEffectiveDivisorDegree_eq_affine_add_infinity + (D : FiniteExtensionEffectiveDivisor K L) : + finiteExtensionEffectiveDivisorDegree K L D = + finiteExtensionAffineIdealDegree K L + (finiteExtensionEffectiveDivisorAffineInfinityEquiv K L D).1 + + finiteExtensionEffectiveInfinityDivisorDegree K L + (finiteExtensionEffectiveDivisorAffineInfinityEquiv K L D).2 := by + rw [finiteExtensionEffectiveDivisorDegree_split] + rw [finiteExtensionAffineIdealDegree_eq_divisorDegree] + simp [finiteExtensionEffectiveDivisorAffineInfinityEquiv] + +private local instance effectiveDivisorInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +private local instance effectiveDivisorInfinityClosureIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +private local instance effectiveDivisorInfinityTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +private local instance effectiveDivisorInfinityClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +private local instance effectiveDivisorInfinityClosureDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) L (RatFuncInfinityIntegralClosure K L) + +private noncomputable local instance effectiveDivisorInfinityPlaceFintype : + Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + +/-- Every infinity coefficient is bounded by the weighted degree. -/ +theorem finiteExtensionEffectiveInfinityDivisor_apply_le_degree + (D : FiniteExtensionEffectiveInfinityDivisor K L) + (P : FiniteExtensionInfinityPlace K L) : + D P ≤ finiteExtensionEffectiveInfinityDivisorDegree K L D := by + apply le_trans (Nat.le_mul_of_pos_right (D P) + (finiteExtensionPlaceDegree_pos K L (.inr P))) + simpa [finiteExtensionEffectiveInfinityDivisorDegree] using + (Finsupp.single_le_sum D + (g := fun Q e => e * finiteExtensionPlaceDegree K L (.inr Q)) + (fun _ _ => Nat.zero_le _) P) + +/-- Effective infinity divisors of a fixed degree form a finite type. -/ +noncomputable instance finiteExtensionEffectiveInfinityDivisorsOfDegree_fintype + (n : ℕ) : + Fintype {D : FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveInfinityDivisorDegree K L D = n} := by + let encode : + {D : FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveInfinityDivisorDegree K L D = n} → + (FiniteExtensionInfinityPlace K L → Fin (n + 1)) := + fun D P => ⟨D.1 P, by + rw [Nat.lt_succ_iff] + exact (finiteExtensionEffectiveInfinityDivisor_apply_le_degree + K L D.1 P).trans_eq D.2⟩ + letI : Finite + (FiniteExtensionInfinityPlace K L → Fin (n + 1)) := inferInstance + letI : Finite + {D : FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveInfinityDivisorDegree K L D = n} := + Finite.of_injective encode (by + intro D E h + apply Subtype.ext + ext P + exact congrArg Fin.val (congrFun h P)) + exact Fintype.ofFinite _ + +/-- The effective-infinity-divisor coefficient of degree `n`. -/ +noncomputable def finiteExtensionEffectiveInfinityDivisorCount (n : ℕ) : ℕ := + Fintype.card {D : FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveInfinityDivisorDegree K L D = n} + +/-- Fixed-degree effective exhaustive divisors split according to the degree +of their finite component. -/ +def finiteExtensionEffectiveDivisorsOfDegreeSplitEquiv (n : ℕ) : + {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} ≃ + Σ m : Fin (n + 1), + {D : (FiniteExtensionFinitePlace K L →₀ ℕ) × + FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveFiniteDivisorDegree K L D.1 = m.1 ∧ + finiteExtensionEffectiveInfinityDivisorDegree K L D.2 = + n - m.1} where + toFun D := by + let parts := finiteExtensionEffectiveDivisorSplitEquiv K L D.1 + have hsum : + finiteExtensionEffectiveFiniteDivisorDegree K L parts.1 + + finiteExtensionEffectiveInfinityDivisorDegree K L parts.2 = n := by + rw [← finiteExtensionEffectiveDivisorDegree_split K L D.1, D.2] + have hle : finiteExtensionEffectiveFiniteDivisorDegree K L parts.1 ≤ n := by + omega + exact ⟨⟨finiteExtensionEffectiveFiniteDivisorDegree K L parts.1, + Nat.lt_succ_iff.mpr hle⟩, + ⟨parts, rfl, by + change finiteExtensionEffectiveInfinityDivisorDegree K L parts.2 = + n - finiteExtensionEffectiveFiniteDivisorDegree K L parts.1 + omega⟩⟩ + invFun D := by + let E := (finiteExtensionEffectiveDivisorSplitEquiv K L).symm + D.2.1 + refine ⟨E, ?_⟩ + rw [finiteExtensionEffectiveDivisorDegree_split] + dsimp [E] + rw [(finiteExtensionEffectiveDivisorSplitEquiv K L).apply_symm_apply] + rw [D.2.2.1, D.2.2.2] + exact Nat.add_sub_of_le (Nat.le_of_lt_succ D.1.2) + left_inv D := by + apply Subtype.ext + exact (finiteExtensionEffectiveDivisorSplitEquiv K L).symm_apply_apply D.1 + right_inv D := by + apply Sigma.subtype_ext + · apply Fin.ext + change finiteExtensionEffectiveFiniteDivisorDegree K L + ((finiteExtensionEffectiveDivisorSplitEquiv K L) + ((finiteExtensionEffectiveDivisorSplitEquiv K L).symm D.2.1)).1 = + D.1.1 + rw [(finiteExtensionEffectiveDivisorSplitEquiv K L).apply_symm_apply] + exact D.2.2.1 + · exact (finiteExtensionEffectiveDivisorSplitEquiv K L).apply_symm_apply D.2.1 + +/-- Each fixed split-degree fiber is the product of its finite and infinity +fixed-degree components. -/ +def finiteExtensionEffectiveDivisorSplitFiberEquiv (n : ℕ) (m : Fin (n + 1)) : + {D : (FiniteExtensionFinitePlace K L →₀ ℕ) × + FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveFiniteDivisorDegree K L D.1 = m.1 ∧ + finiteExtensionEffectiveInfinityDivisorDegree K L D.2 = n - m.1} ≃ + {D : FiniteExtensionFinitePlace K L →₀ ℕ // + finiteExtensionEffectiveFiniteDivisorDegree K L D = m.1} × + {D : FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveInfinityDivisorDegree K L D = n - m.1} where + toFun D := ⟨⟨D.1.1, D.2.1⟩, ⟨D.1.2, D.2.2⟩⟩ + invFun D := ⟨(D.1.1, D.2.1), D.1.2, D.2.2⟩ + left_inv D := by + apply Subtype.ext + rfl + right_inv D := by + apply Prod.ext <;> apply Subtype.ext <;> rfl + +noncomputable instance finiteExtensionEffectiveDivisorSplitFiber_fintype + (n : ℕ) (m : Fin (n + 1)) : + Fintype {D : (FiniteExtensionFinitePlace K L →₀ ℕ) × + FiniteExtensionEffectiveInfinityDivisor K L // + finiteExtensionEffectiveFiniteDivisorDegree K L D.1 = m.1 ∧ + finiteExtensionEffectiveInfinityDivisorDegree K L D.2 = n - m.1} := + Fintype.ofEquiv _ + (finiteExtensionEffectiveDivisorSplitFiberEquiv K L n m).symm + +/-- Effective exhaustive divisors of fixed degree form a finite type. -/ +noncomputable instance finiteExtensionEffectiveDivisorsOfDegree_fintype + (n : ℕ) : + Fintype {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} := + Fintype.ofEquiv _ + (finiteExtensionEffectiveDivisorsOfDegreeSplitEquiv K L n).symm + +/-- The effective-exhaustive-divisor coefficient of degree `n`. -/ +noncomputable def finiteExtensionEffectiveDivisorCount (n : ℕ) : ℕ := + Fintype.card {D : FiniteExtensionEffectiveDivisor K L // + finiteExtensionEffectiveDivisorDegree K L D = n} + +/-- Fixed-degree exhaustive divisor counts are the convolution of the affine +ideal coefficients with the infinity-divisor coefficients. -/ +theorem finiteExtensionEffectiveDivisorCount_eq_sum_mul_infinityCount + (n : ℕ) : + finiteExtensionEffectiveDivisorCount K L n = + ∑ m : Fin (n + 1), + finiteExtensionEffectiveFiniteDivisorCount K L m.1 * + finiteExtensionEffectiveInfinityDivisorCount K L (n - m.1) := by + rw [finiteExtensionEffectiveDivisorCount] + rw [Fintype.card_congr + (finiteExtensionEffectiveDivisorsOfDegreeSplitEquiv K L n)] + rw [Fintype.card_sigma] + apply Finset.sum_congr rfl + intro m _ + rw [Fintype.card_congr + (finiteExtensionEffectiveDivisorSplitFiberEquiv K L n m)] + rw [Fintype.card_prod] + rfl + +/-- The same convolution with the finite coefficient written as the affine +ideal count in the normalization of `K[X]`. -/ +theorem finiteExtensionEffectiveDivisorCount_eq_sum_affineIdealCount_mul_infinityCount + (n : ℕ) : + finiteExtensionEffectiveDivisorCount K L n = + ∑ m : Fin (n + 1), + finiteExtensionAffineIdealCount K L m.1 * + finiteExtensionEffectiveInfinityDivisorCount K L (n - m.1) := by + rw [finiteExtensionEffectiveDivisorCount_eq_sum_mul_infinityCount] + apply Finset.sum_congr rfl + intro m _ + rw [← finiteExtensionAffineIdealCount_eq_effectiveFiniteDivisorCount] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean new file mode 100644 index 0000000000..4d15adeddf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence + +/-! +# Bounding the Riemann--Roch genus from a one-point inequality + +Once the uniform Riemann--Roch formula is known, any coarse one-point +Riemann inequality bounds its genus parameter. This is the bridge that will +turn the existing bidegree monomial budget into a numerator-degree bound. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance genusBoundConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance genusBoundConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A one-point lower Riemann inequality with budget `budget`, together with +the uniform eventual Riemann--Roch formula, forces `genus ≤ budget`. -/ +theorem genus_le_budget_of_uniformRiemann_onePoint + (genus threshold budget : ℕ) + (P : FiniteExtensionPlace K L) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hLower : ∀ N : ℕ, + N * finiteExtensionPlaceDegree K L P + 1 ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P N) + budget) : + genus ≤ budget := by + let d := finiteExtensionPlaceDegree K L P + let D : FiniteExtensionDivisor K L := + Finsupp.single P (threshold : ℤ) + have hd : 0 < d := finiteExtensionPlaceDegree_pos K L P + have hthreshold : threshold ≤ threshold * d := by + by_cases ht : threshold = 0 + · simp [ht] + · exact Nat.le_mul_of_pos_right _ hd + have hdegree : finiteExtensionDivisorDegree K L D = + (threshold * d : ℕ) := by + dsimp only [D, d] + rw [finiteExtensionDivisorDegree_single] + norm_num + have hdata := hRiemann.2 D (threshold * d) hthreshold hdegree + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := hdata.1 + have hspace : finiteExtensionRiemannSpace K L D = + finiteExtensionOnePointRiemannSpace K L P threshold := by + rfl + have hrank : Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P threshold) = + threshold * d + 1 - genus := by + rw [← hspace] + exact hdata.2 + have hlower := hLower threshold + have hgenusThreshold := hRiemann.1 + have hgenusDegree : genus ≤ threshold * d + 1 := by + exact hgenusThreshold.trans (by omega) + have hrankAdd : + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P threshold) + genus = + threshold * d + 1 := by + rw [hrank, Nat.sub_add_cancel hgenusDegree] + have hcancel : + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P threshold) + genus ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P threshold) + budget := by + rw [hrankAdd] + exact hlower + exact Nat.le_of_add_le_add_left hcancel + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean new file mode 100644 index 0000000000..4dce0b8b80 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean @@ -0,0 +1,265 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound + +/-! +# Hasse bounds from even exact constant-extension estimates + +This file connects the exact constant-extension closed-place identity to the +completed zeta-function and spectral arguments. A uniform two-sided estimate +for degree-one places on the exact degree-`2n` constant extensions becomes the +even-extension `IsBigO` premise used by the power-sum argument. Exact +constants then provide the zeta numerator and its degree bound automatically. + +The geometric two-sided estimate itself is deliberately left as an explicit +hypothesis. Proving it is the remaining Galois-twist boundary; no one-sided +Stepanov estimate can replace it. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics + +noncomputable section + +/-- Pointwise two-sided square-root estimates at every positive even-extension +index imply the asymptotic estimate used by the zeta spectral argument. -/ +theorem evenExtensionError_isBigO_of_pointwise_bound + (q : ℕ) (pointCount : ℕ → ℕ) (A : ℝ) + (hbound : ∀ n, 0 < n → + |(pointCount (2 * n) : ℝ) - (q : ℝ) ^ (2 * n) - 1| ≤ + A * (q : ℝ) ^ n) : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n := by + apply IsBigO.of_bound A + filter_upwards [eventually_ge_atTop 1] with n hn + have hqn : 0 ≤ (q : ℝ) ^ n := by positivity + rw [Real.norm_eq_abs, abs_of_nonneg hqn] + have heq : + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1 = + (((pointCount (2 * n) : ℝ) - (q : ℝ) ^ (2 * n) - 1 : ℝ) : ℂ) := by + norm_num + rw [heq, Complex.norm_real, Real.norm_eq_abs] + exact hbound n hn + +/-- A pointwise two-sided square-root estimate along one fixed divisible-even +subsequence, with a bounded additive error, gives the asymptotic estimate +used by the rank-general spectral argument. -/ +theorem divisibleEvenExtensionError_isBigO_of_pointwise_bound + (q δ : ℕ) (pointCount : ℕ → ℕ) (A B : ℝ) + (hq : 0 < q) (hA : 0 ≤ A) + (hbound : ∀ n, 0 < n → + |(pointCount (2 * δ * n) : ℝ) - + (q : ℝ) ^ (2 * δ * n) - 1| ≤ + A + B * (((q : ℝ) ^ δ) ^ n)) : + (fun n : ℕ ↦ + (pointCount (2 * δ * n) : ℂ) - + (q : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n := by + apply IsBigO.of_bound (A + B) + filter_upwards [eventually_ge_atTop 1] with n hn + have hnpos : 0 < n := by omega + have hqOneNat : 1 ≤ q := Nat.one_le_iff_ne_zero.mpr hq.ne' + have hqOne : (1 : ℝ) ≤ q := by exact_mod_cast hqOneNat + have hrhoOne : (1 : ℝ) ≤ ((q : ℝ) ^ δ) ^ n := + one_le_pow₀ (one_le_pow₀ hqOne) + have hpoint := hbound n hnpos + have heq : + (pointCount (2 * δ * n) : ℂ) - + (q : ℂ) ^ (2 * δ * n) - 1 = + (((pointCount (2 * δ * n) : ℝ) - + (q : ℝ) ^ (2 * δ * n) - 1 : ℝ) : ℂ) := by + norm_num + have hrhoNonneg : 0 ≤ (((q : ℝ) ^ δ) ^ n) := by positivity + rw [heq, Complex.norm_real, Real.norm_eq_abs, + Real.norm_eq_abs, abs_of_nonneg hrhoNonneg] + calc + |(pointCount (2 * δ * n) : ℝ) - + (q : ℝ) ^ (2 * δ * n) - 1| ≤ + A + B * (((q : ℝ) ^ δ) ^ n) := hpoint + _ ≤ (A + B) * (((q : ℝ) ^ δ) ^ n) := by nlinarith + +variable (C N : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + +local instance evenConstantExtensionBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance evenConstantExtensionBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The exact constant-extension count identity transports a pointwise +two-sided estimate for rational places on every canonical degree-`2n` +constant extension to the even-extension `IsBigO` estimate for the original +closed-place count sequence. -/ +theorem finiteExtensionClosedPlaceEvenError_isBigO_of_exactConstantExtension_bound + (p : ℕ) [Fact p.Prime] [CharP C p] + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (A : ℝ) + (hbound : ∀ n (hn : 0 < n), + letI : NeZero (2 * n) := ⟨by omega⟩ + let S := FiniteField.Extension C p (2 * n) + letI : Fintype S := Fintype.ofFinite S + |(exactConstantExtensionClosedPlaceExtensionCount + C S N hExact 1 : ℝ) - (Nat.card S : ℝ) - 1| ≤ + A * (Nat.card C : ℝ) ^ n) : + (fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount C N (2 * n) : ℂ) - + (Nat.card C : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (Nat.card C : ℝ) ^ n := by + apply evenExtensionError_isBigO_of_pointwise_bound + intro n hn + letI : NeZero (2 * n) := ⟨by omega⟩ + let S := FiniteField.Extension C p (2 * n) + letI : Fintype S := Fintype.ofFinite S + have hcount : + exactConstantExtensionClosedPlaceExtensionCount C S N hExact 1 = + finiteExtensionClosedPlaceExtensionCount C N (2 * n) := by + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + have h := exactConstantExtensionClosedPlaceExtensionCount_eq + C S N hExact 1 + have hfinrank : Module.finrank C S = 2 * n := by + simpa [S] using FiniteField.finrank_extension C p (2 * n) + rw [hfinrank, Nat.mul_one] at h + convert h using 1 + all_goals congr 1 + have hcard : Nat.card S = Nat.card C ^ (2 * n) := by + simpa [S] using FiniteField.natCard_extension C p (2 * n) + have hreal := hbound n hn + dsimp only [S] at hreal + rw [hcount, hcard] at hreal + simpa only [Nat.cast_pow] using hreal + +/-- Exact constants make the standard zeta numerator automatic. Hence the +even-extension error estimate is the only analytic premise left for the +closed-place Hasse bound, apart from the stated genus budget. -/ +theorem finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_evenError + (budget : ℕ) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hgenus : FunctionField.genus C N ≤ budget) + (herror : + (fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount C N (2 * n) : ℂ) - + (Nat.card C : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (Nat.card C : ℝ) ^ n) : + |(finiteExtensionClosedPlaceExtensionCount C N 1 : ℝ) - + Nat.card C - 1| ≤ + (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card C) := by + obtain ⟨P, hPzero, _hPone, hPdegree, hPrational, _hPtrace⟩ := + exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget_of_exactConstants + C N budget hExact hgenus + have hbound := + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_evenError_isBigO + (Nat.card C) (finiteExtensionClosedPlaceExtensionCount C N) P + hPzero hPrational herror + calc + |(finiteExtensionClosedPlaceExtensionCount C N 1 : ℝ) - + Nat.card C - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt (Nat.card C) := hbound + _ ≤ (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card C) := by + gcongr + exact_mod_cast hPdegree + +/-- Exact constants make the zeta package automatic also when the geometric +error estimate is available only along one fixed positive divisible-even +subsequence. -/ +theorem + finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_divisibleEvenError + (budget δ : ℕ) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hgenus : FunctionField.genus C N ≤ budget) + (hδ : 0 < δ) + (herror : + (fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount C N (2 * δ * n) : ℂ) - + (Nat.card C : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((Nat.card C : ℝ) ^ δ) ^ n) : + |(finiteExtensionClosedPlaceExtensionCount C N 1 : ℝ) - + Nat.card C - 1| ≤ + (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card C) := by + obtain ⟨P, hPzero, _hPone, hPdegree, hPrational, _hPtrace⟩ := + exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget_of_exactConstants + C N budget hExact hgenus + have hbound := + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_divisibleEvenError_isBigO + (Nat.card C) δ (finiteExtensionClosedPlaceExtensionCount C N) P + Nat.card_pos hδ hPzero hPrational herror + calc + |(finiteExtensionClosedPlaceExtensionCount C N 1 : ℝ) - + Nat.card C - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt (Nat.card C) := hbound + _ ≤ (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card C) := by + gcongr + exact_mod_cast hPdegree + +/-- The selected Lorenzini endpoint at the spectral boundary. A uniform +pointwise two-sided estimate along one positive divisible-even subsequence, +allowing a fixed additive error, implies the degree-one closed-place Hasse +bound. Exact constants supply the zeta numerator, index one, and the trace +formula internally. -/ +theorem + finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_divisibleEvenError_bound + (budget δ : ℕ) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hgenus : FunctionField.genus C N ≤ budget) + (hδ : 0 < δ) + (A B : ℝ) + (hA : 0 ≤ A) + (hbound : ∀ n, 0 < n → + |(finiteExtensionClosedPlaceExtensionCount C N (2 * δ * n) : ℝ) - + (Nat.card C : ℝ) ^ (2 * δ * n) - 1| ≤ + A + B * (((Nat.card C : ℝ) ^ δ) ^ n)) : + |(finiteExtensionClosedPlaceExtensionCount C N 1 : ℝ) - + Nat.card C - 1| ≤ + (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card C) := by + apply + finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_divisibleEvenError + C N budget δ hExact hgenus hδ + exact divisibleEvenExtensionError_isBigO_of_pointwise_bound + (Nat.card C) δ (finiteExtensionClosedPlaceExtensionCount C N) + A B Nat.card_pos hA hbound + +/-- The fully connected conditional endpoint: a uniform two-sided estimate +for rational places on the canonical even exact constant extensions implies +the base closed-place Hasse bound. Zeta rationality, the trace formula, and +degree index one are all discharged internally. -/ +theorem finiteExtensionClosedPlaceHasseBound_of_evenExactConstantExtension_bound + (p : ℕ) [Fact p.Prime] [CharP C p] + (budget : ℕ) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hgenus : FunctionField.genus C N ≤ budget) + (A : ℝ) + (hbound : ∀ n (hn : 0 < n), + letI : NeZero (2 * n) := ⟨by omega⟩ + let S := FiniteField.Extension C p (2 * n) + letI : Fintype S := Fintype.ofFinite S + |(exactConstantExtensionClosedPlaceExtensionCount + C S N hExact 1 : ℝ) - (Nat.card S : ℝ) - 1| ≤ + A * (Nat.card C : ℝ) ^ n) : + |(finiteExtensionClosedPlaceExtensionCount C N 1 : ℝ) - + Nat.card C - 1| ≤ + (2 * budget + 1 : ℝ) * Real.sqrt (Nat.card C) := by + apply finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_evenError + C N budget hExact hgenus + exact + finiteExtensionClosedPlaceEvenError_isBigO_of_exactConstantExtension_bound + C N p hExact A hbound + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean new file mode 100644 index 0000000000..29c5b60709 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean @@ -0,0 +1,409 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension + +/-! +# Hasse--Weil for finite separable function-field extensions + +The normal closure supplies one finite enlargement of the constant field over +which the extension is geometric. At every sufficiently divisible even +constant-field degree, a quadratic subfield and an auxiliary extension of +factorial degree put the fixed-tower Frobenius-twist estimate into a uniform +form. Exact constant-extension splitting and the spectral argument then +transport that estimate back to the original function field. +-/ + +namespace BGS.HasseWeil + +noncomputable section + + +variable (K F : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field F] [Algebra (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +local instance finiteExtensionHasseBaseConstantAlgebra : Algebra K F := + bridgeBaseConstantAlgebra K F + +local instance finiteExtensionHasseBaseConstantTower : + IsScalarTower K (RatFunc K) F := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finiteExtensionHasseNormalClosureConstantFintype : + Fintype (FunctionFieldNormalClosureConstantField K F) := + Fintype.ofFinite _ + +local instance finiteExtensionHasseNormalClosureConstantAlgebra : + Algebra K (FunctionFieldNormalClosureConstantField K F) := + SubalgebraClass.toAlgebra + (algebraicClosure K (FunctionFieldNormalClosure K F)) + +local instance finiteExtensionHasseNormalClosureConstantSmul : + SMul K (FunctionFieldNormalClosureConstantField K F) := + Algebra.toSMul + +local instance finiteExtensionHasseNormalClosureConstantModule : + Module K (FunctionFieldNormalClosureConstantField K F) := + Algebra.toModule + +local instance finiteExtensionHasseNormalClosureConstantFiniteDimensional : + FiniteDimensional K (FunctionFieldNormalClosureConstantField K F) := + functionFieldConstantField_finiteDimensional K + (FunctionFieldNormalClosure K F) + +local instance finiteExtensionHasseNormalClosureConstantIsGalois : + IsGalois K (FunctionFieldNormalClosureConstantField K F) := + functionFieldConstantField_isGalois K (FunctionFieldNormalClosure K F) + +local instance finiteExtensionHasseNormalClosureConstantDecidableEq : + DecidableEq (FunctionFieldNormalClosureConstantField K F) := + Classical.decEq _ + +local instance finiteExtensionHasseNormalClosureRatFuncDecidableEq : + DecidableEq (RatFunc (FunctionFieldNormalClosureConstantField K F)) := + Classical.decEq _ + +local instance finiteExtensionHasseNormalClosureRatFuncSmul : + SMul (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := + Algebra.toSMul + +local instance finiteExtensionHasseNormalClosureRatFuncModule : + Module (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := + Algebra.toModule + +local instance finiteExtensionHasseNormalClosureRatFuncTorsionFree : + Module.IsTorsionFree + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F)).injective + +local instance finiteExtensionHasseNormalClosureFiniteDimensional : + FiniteDimensional + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) := + functionFieldNormalClosure_finiteDimensional_over_constantRatFunc K F + +local instance finiteExtensionHasseNormalClosureCanonicalConstantAlgebra : + Algebra (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) := + exactConstantExtensionTowerCanonicalConstantAlgebra _ _ + +/-- The genus of the chosen normal closure over its full constant field. -/ +noncomputable def functionFieldNormalClosureGenus : ℕ := + FunctionField.genus (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) + +/-- The degree of the chosen normal closure over the canonical rational +function field of its full constant field. -/ +noncomputable def functionFieldNormalClosureRatFuncDegree : ℕ := + Module.finrank (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosure K F) + +/-- The Stepanov threshold attached to the chosen normal closure. -/ +def functionFieldNormalClosureStepanovThreshold : ℕ := + (functionFieldNormalClosureGenus K F + 1) * + (functionFieldNormalClosureGenus K F + 2) + +theorem functionFieldNormalClosureRatFuncDegree_pos : + 0 < functionFieldNormalClosureRatFuncDegree K F := by + unfold functionFieldNormalClosureRatFuncDegree + exact Module.finrank_pos + +theorem functionFieldNormalClosureStepanovThreshold_pos : + 0 < functionFieldNormalClosureStepanovThreshold K F := by + unfold functionFieldNormalClosureStepanovThreshold + positivity + +/-- The normal-closure constant field gives a uniform square-root-scale bound +for the packaged exact constant extensions of the original function field. + +Here `H = (g + 1)(g + 2)` is the Stepanov threshold for the genus `g` of the +geometric normal closure, while `D` is its degree over the rational function +field of its full constant field. -/ +theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants + (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) : + ∀ n, 0 < n → + |(exactConstantExtensionClosedPlaceExtensionCount + K (FunctionFieldNormalClosureConstantField K F) F hExact + (2 * functionFieldNormalClosureStepanovThreshold K F * n) : ℝ) - + (Nat.card (FunctionFieldNormalClosureConstantField K F) : ℝ) ^ + (2 * functionFieldNormalClosureStepanovThreshold K F * n) - 1| ≤ + 2 * (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 2 + + 2 * (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 3 + + (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 2 * + (2 * functionFieldNormalClosureGenus K F + 1) * + (Nat.card (FunctionFieldNormalClosureConstantField K F) : ℝ) ^ + (functionFieldNormalClosureStepanovThreshold K F * n) := by + classical + intro n hn + let C := FunctionFieldNormalClosureConstantField K F + letI : Fintype C := + finiteExtensionHasseNormalClosureConstantFintype K F + letI : DecidableEq C := + finiteExtensionHasseNormalClosureConstantDecidableEq K F + letI : DecidableEq (RatFunc C) := + finiteExtensionHasseNormalClosureRatFuncDecidableEq K F + let N := FunctionFieldNormalClosure K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + letI : SMul (RatFunc C) M := Algebra.toSMul + letI : Module (RatFunc C) M := Algebra.toModule + letI : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + letI : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + letI : FiniteDimensional (RatFunc C) M := + functionFieldNormalClosureOriginalCompositum_finiteDimensional_over_constantRatFunc + K F hExact + letI : FiniteDimensional M N := + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + K F hExact + letI : IsGalois M N := + functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact + letI : Algebra.IsSeparable (RatFunc C) M := + functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc + K F hExact + letI : IsGalois (RatFunc C) N := + functionFieldNormalClosure_isGalois_over_constantRatFunc K F + letI : Algebra.IsSeparable (RatFunc C) N := + Algebra.IsSeparable.trans (RatFunc C) M N + let g := functionFieldNormalClosureGenus K F + let H := functionFieldNormalClosureStepanovThreshold K F + let D := functionFieldNormalClosureRatFuncDegree K F + have hH : 0 < H := by + exact functionFieldNormalClosureStepanovThreshold_pos K F + have hD : 0 < D := by + exact functionFieldNormalClosureRatFuncDegree_pos K F + let p := ringChar C + letI : CharP C p := by + dsimp only [p] + exact ringChar.charP C + letI : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ + letI : NeZero (H * n) := ⟨Nat.mul_pos hH hn |>.ne'⟩ + letI : NeZero (2 * (H * n)) := ⟨by positivity⟩ + let Ksmall := FiniteField.Extension C p (H * n) + let Cbig := FiniteField.Extension C p (2 * (H * n)) + letI : Fintype Ksmall := Fintype.ofFinite Ksmall + letI : Fintype Cbig := Fintype.ofFinite Cbig + letI : DecidableEq Cbig := Classical.decEq Cbig + letI : DecidableEq (RatFunc Cbig) := Classical.decEq (RatFunc Cbig) + letI : Algebra C Ksmall := + FiniteField.instAlgebraExtension C p (H * n) + letI : Algebra C Cbig := + FiniteField.instAlgebraExtension C p (2 * (H * n)) + letI : SMul C Ksmall := Algebra.toSMul + letI : Module C Ksmall := Algebra.toModule + letI : SMul C Cbig := Algebra.toSMul + letI : Module C Cbig := Algebra.toModule + letI : CharP Cbig p := + charP_of_injective_algebraMap (algebraMap C Cbig).injective p + letI : Algebra Ksmall Cbig := + finiteFieldExtensionAlgebraOfDvd C p (H * n) (2 * (H * n)) + ⟨2, by omega⟩ + letI : SMul Ksmall Cbig := Algebra.toSMul + letI : Module Ksmall Cbig := Algebra.toModule + letI : IsScalarTower C Ksmall Cbig := + finiteFieldExtension_isScalarTower_of_dvd C p + (H * n) (2 * (H * n)) ⟨2, by omega⟩ + have hcard : Fintype.card Cbig = Fintype.card Ksmall ^ 2 := by + simpa only [Fintype.card_eq_nat_card] using + natCard_double_finiteFieldExtension_eq_sq C p (H * n) + have hlargeBase : H ≤ Fintype.card Ksmall := by + simpa only [Fintype.card_eq_nat_card] using + degree_le_natCard_finiteFieldExtension_mul C p H n hn + have hExactN : algebraicClosure C N = + (⊥ : IntermediateField C N) := + functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F + have hExactM : algebraicClosure C M = + (⊥ : IntermediateField C M) := + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact + let E_N := ExactConstantExtension C N Cbig + let E_M := ExactConstantExtension C M Cbig + letI : Field E_N := + functionFieldNormalClosureConstantExtensionFieldForTower K F Cbig + letI : Field E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionField + K F Cbig hExact + letI : Algebra (RatFunc Cbig) E_N := + functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower + K F Cbig + letI : Algebra (RatFunc Cbig) E_M := + functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra + K F Cbig hExact + letI : Module (RatFunc Cbig) E_N := Algebra.toModule + letI : Module (RatFunc Cbig) E_M := Algebra.toModule + letI : FiniteDimensional (RatFunc Cbig) E_N := + finiteDimensional_over_extendedRatFunc C Cbig N hExactN + letI : FiniteDimensional (RatFunc Cbig) E_M := + finiteDimensional_over_extendedRatFunc C Cbig M hExactM + letI : Algebra.IsSeparable (RatFunc Cbig) E_N := + isSeparable_over_extendedRatFunc C Cbig N hExactN + letI : Algebra.IsSeparable (RatFunc Cbig) E_M := + isSeparable_over_extendedRatFunc C Cbig M hExactM + letI : Algebra E_M E_N := + functionFieldNormalClosureConstantExtensionTowerAlgebra K F Cbig hExact + letI : SMul (RatFunc Cbig) E_M := Algebra.toSMul + letI : SMul (RatFunc Cbig) E_N := Algebra.toSMul + letI : SMul E_M E_N := Algebra.toSMul + letI : Module E_M E_N := Algebra.toModule + letI : IsScalarTower (RatFunc Cbig) E_M E_N := + functionFieldNormalClosureConstantExtension_ratFuncScalarTower + K F Cbig hExact + letI : Module.Finite E_M E_N := + functionFieldNormalClosureConstantExtension_finiteDimensional + K F Cbig hExact + letI : IsGalois E_M E_N := + functionFieldNormalClosureConstantExtension_isGalois K F Cbig hExact + letI : Algebra (RatFunc C) (RatFunc Cbig) := + ratFuncCoefficientAlgebra C Cbig + letI : Algebra (RatFunc C) E_N := + exactConstantExtensionBaseAlgebra C (RatFunc C) N Cbig + letI : SMul (RatFunc C) (RatFunc Cbig) := Algebra.toSMul + letI : SMul (RatFunc C) E_N := Algebra.toSMul + letI : Module (RatFunc C) E_N := Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc Cbig) E_N := + rationalBase_scalarTower C Cbig N hExactN + letI : IsGalois (RatFunc C) E_N := + exactConstantExtension_isGalois C (RatFunc C) N Cbig hExactN + letI : IsGalois (RatFunc Cbig) E_N := + IsGalois.tower_top_of_isGalois (RatFunc C) (RatFunc Cbig) E_N + have hConstantAlgebra : + (Algebra.TensorProduct.leftAlgebra : Algebra Cbig E_N) = + bridgeBaseConstantAlgebra Cbig E_N := by + apply Algebra.algebra_ext + intro s + exact (ratFuncToExactConstantExtension C Cbig N hExactN).commutes s |>.symm + have hgenusTensor : + @FunctionField.genus Cbig E_N _ _ + (Algebra.TensorProduct.leftAlgebra : Algebra Cbig E_N) = g := by + simpa only [E_N, g, functionFieldNormalClosureGenus] using + exactConstantExtension_genus_eq C Cbig N hExactN + have hExactEN : + @algebraicClosure Cbig E_N _ _ (bridgeBaseConstantAlgebra Cbig E_N) = + (⊥ : @IntermediateField Cbig E_N _ _ + (bridgeBaseConstantAlgebra Cbig E_N)) := by + exact exactConstantExtension_extended_algebraicClosure_eq_bot + C Cbig N hExactN + have hgenusEN : + @FunctionField.genus Cbig E_N _ _ + (bridgeBaseConstantAlgebra Cbig E_N) = g := by + rw [← hConstantAlgebra] + exact hgenusTensor + have hdegreeEN : Module.finrank (RatFunc Cbig) E_N = D := by + exact exactConstantExtension_finrank_over_extendedRatFunc_eq + C Cbig N hExactN + have hHg : H = (g + 1) * (g + 2) := by + rfl + have hlarge : + (@FunctionField.genus Cbig E_N _ _ + (bridgeBaseConstantAlgebra Cbig E_N) + 1) * + (@FunctionField.genus Cbig E_N _ _ + (bridgeBaseConstantAlgebra Cbig E_N) + 2) ≤ + Fintype.card Ksmall := by + simpa only [hgenusEN, hHg] using hlargeBase + letI : NeZero D.factorial := ⟨Nat.factorial_ne_zero D⟩ + let U := FiniteField.Extension Cbig p D.factorial + letI : DecidableEq U := Classical.decEq U + letI : DecidableEq (RatFunc U) := Classical.decEq (RatFunc U) + letI : Algebra Cbig U := + FiniteField.instAlgebraExtension Cbig p D.factorial + letI : SMul Cbig U := Algebra.toSMul + letI : Module Cbig U := Algebra.toModule + have hauxDegree : Module.finrank Cbig U = D.factorial := by + simpa only [U] using FiniteField.finrank_extension Cbig p D.factorial + have hdivBase : Nat.card (E_N ≃ₐ[RatFunc Cbig] E_N) ∣ + Module.finrank Cbig U := by + rw [hauxDegree, IsGalois.card_aut_eq_finrank, hdegreeEN] + exact Nat.dvd_factorial hD le_rfl + have hdivMOriginal : Nat.card (N ≃ₐ[M] N) ∣ D.factorial := by + exact natCard_aut_dvd_finrank_factorial_of_tower (RatFunc C) M N + have hcardTower : Nat.card (E_N ≃ₐ[E_M] E_N) = + Nat.card (N ≃ₐ[M] N) := by + exact functionFieldNormalClosureConstantExtension_card_aut_eq + K F Cbig hExact + have hdivL : Nat.card (E_N ≃ₐ[E_M] E_N) ∣ + Module.finrank Cbig U := by + rw [hauxDegree, hcardTower] + exact hdivMOriginal + have hfixed := + abs_intermediateBaseRationalPlaceError_le_squareField_of_genus + Ksmall Cbig U E_N E_M hcard hExactEN hdivL hdivBase hlarge + have hcount : finiteExtensionRationalPlaceCount Cbig E_M = + exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (2 * H * n) := by + rw [functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_originalExactConstantExtensionCount + K F Cbig hExact] + congr 2 + simpa only [Cbig, Nat.mul_assoc] using + FiniteField.finrank_extension C p (2 * (H * n)) + have hcardBig : Nat.card Cbig = Nat.card C ^ (2 * H * n) := by + simpa only [Cbig, Nat.mul_assoc] using + FiniteField.natCard_extension C p (2 * (H * n)) + have hcardSmall : Fintype.card Ksmall = Nat.card C ^ (H * n) := by + rw [Fintype.card_eq_nat_card, + FiniteField.natCard_extension C p (H * n)] + rw [hcount, hcardBig, hdegreeEN, hgenusEN, hcardSmall] at hfixed + push_cast at hfixed + simpa only [C, g, H, D, mul_assoc] using hfixed + +/-- The closed Hasse--Weil bound for a finite separable extension of `K(X)` +with exact constant field `K`. -/ +theorem finiteExtensionClosedPlaceHasseWeil + (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) : + |(finiteExtensionClosedPlaceExtensionCount K F 1 : ℝ) - + Nat.card K - 1| ≤ + (2 * FunctionField.genus K F + 1 : ℝ) * + Real.sqrt (Nat.card K) := by + classical + let C := FunctionFieldNormalClosureConstantField K F + letI : Fintype C := + finiteExtensionHasseNormalClosureConstantFintype K F + letI : DecidableEq C := + finiteExtensionHasseNormalClosureConstantDecidableEq K F + letI : DecidableEq (RatFunc C) := + finiteExtensionHasseNormalClosureRatFuncDecidableEq K F + let g := functionFieldNormalClosureGenus K F + let H := functionFieldNormalClosureStepanovThreshold K F + let D := functionFieldNormalClosureRatFuncDegree K F + let A : ℝ := 2 * (D : ℝ) ^ 2 + 2 * (D : ℝ) ^ 3 + let B : ℝ := (D : ℝ) ^ 2 * (2 * g + 1) + have hH : 0 < H := by + exact functionFieldNormalClosureStepanovThreshold_pos K F + have hA : 0 ≤ A := by + dsimp only [A] + positivity + have hbound : ∀ n, 0 < n → + |(exactConstantExtensionClosedPlaceExtensionCount + K C F hExact (2 * H * n) : ℝ) - + (Nat.card C : ℝ) ^ (2 * H * n) - 1| ≤ + A + B * (Nat.card C : ℝ) ^ (H * n) := by + intro n hn + have h := exactConstantExtensionClosedPlaceError_le_normalClosureConstants + K F hExact n hn + simpa only [C, g, H, D, A, B] using h + exact finiteExtensionClosedPlaceHasseBound_of_constantBase_bound + K C F (FunctionField.genus K F) hExact le_rfl H hH A B hA hbound + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean new file mode 100644 index 0000000000..b6567fd0cb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean @@ -0,0 +1,91 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler + +/-! +# Indexed zeta rationality for an exact-constant function field + +This file composes the exhaustive divisor-class recurrence with the proved +closed-place Euler recurrence. The only input at this boundary is the +uniform Riemann--Roch formula for arbitrary divisors. The denominator still +uses the divisor-degree index; replacing it by the standard degree-one +denominator is a separate constant-field theorem. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance indexedZetaConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance indexedZetaConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- There is exactly one effective exhaustive divisor of degree zero. -/ +theorem finiteExtensionEffectiveDivisorCount_zero : + finiteExtensionEffectiveDivisorCount K L 0 = 1 := by + rw [finiteExtensionEffectiveDivisorCount] + apply Fintype.card_eq_one_iff.mpr + refine ⟨⟨0, by simp [finiteExtensionEffectiveDivisorDegree]⟩, ?_⟩ + intro D + apply Subtype.ext + letI : Finsupp.NonTorsionWeight ℕ + (fun P : FiniteExtensionPlace K L => + finiteExtensionPlaceDegree K L P) := + Finsupp.nonTorsionWeight_of ℕ + (w := fun P : FiniteExtensionPlace K L => + finiteExtensionPlaceDegree K L P) + (fun P => (finiteExtensionPlaceDegree_pos K L P).ne') + apply (Finsupp.weight_eq_zero_iff_eq_zero + (fun P : FiniteExtensionPlace K L => + finiteExtensionPlaceDegree K L P)).mp + simpa [finiteExtensionEffectiveDivisorDegree, Finsupp.weight_apply, + nsmul_eq_mul] using D.2 + +/-- Uniform Riemann--Roch, exact constants, and the exhaustive Euler product +give the indexed rational form of the closed-place zeta series. -/ +theorem exists_finiteExtensionClosedPlaceZeta_indexed_rational + (genus threshold : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P := by + apply + exists_formalPointCountZeta_indexed_rational_of_effectiveDivisor_recurrences + (finiteExtensionEffectiveDivisorCount K L) + (finiteExtensionClosedPlaceExtensionCount K L) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) threshold + (finiteExtensionDivisorDegreeIndex_pos K L) + (finiteExtensionEffectiveDivisorCount_zero K L) + (finiteExtensionEffectiveDivisorPointCountRecurrence K L) + intro n hn + exact finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence_complex + K L genus threshold n hconstants hRiemann hn + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean new file mode 100644 index 0000000000..c8ffb648b9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree + +/-! +# Unconditional indexed zeta rationality from exact constants + +This file discharges the uniform Riemann--Roch premise of the indexed zeta +composition by transporting the vendored Riemann--Roch theorem to the +exhaustive BGS divisor model. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance automaticIndexedZetaConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance automaticIndexedZetaConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) automaticIndexedZetaPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance automaticIndexedZetaPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance automaticIndexedZetaConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Exact constants alone supply the indexed rational form of the exhaustive +closed-place zeta series. -/ +theorem exists_finiteExtensionClosedPlaceZeta_indexed_rational_of_constants + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P := by + letI : FunctionField.IsFullConstantField K L := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 + hconstants + exact exists_finiteExtensionClosedPlaceZeta_indexed_rational + K L (FunctionField.Chart.genus K L) + (2 * FunctionField.Chart.genus K L) hconstants + (hasFiniteExtensionUniformEventualRiemannFormula_of_fullConstantField K L) + +/-- The same automatic composition retains the truncation bound on the +indexed numerator. -/ +theorem exists_finiteExtensionClosedPlaceZeta_indexed_rational_with_natDegree_lt_of_constants + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) : + ∃ (genus threshold : ℕ) (P : Polynomial ℂ), + HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold ∧ + P.coeff 0 = 1 ∧ + P.natDegree < + threshold + 2 * finiteExtensionDivisorDegreeIndex K L ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P := by + obtain ⟨genus, threshold, hRiemann⟩ := + exists_hasFiniteExtensionUniformEventualRiemannFormula_of_constants + K L hconstants + obtain ⟨P, hP0, hPdegree, hP⟩ := + exists_formalPointCountZeta_indexed_rational_with_natDegree_lt_of_effectiveDivisor_recurrences + (finiteExtensionEffectiveDivisorCount K L) + (finiteExtensionClosedPlaceExtensionCount K L) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) + threshold + (finiteExtensionDivisorDegreeIndex_pos K L) + (finiteExtensionEffectiveDivisorCount_zero K L) + (finiteExtensionEffectiveDivisorPointCountRecurrence K L) + (fun n hn => + finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence_complex + K L genus threshold n hconstants hRiemann hn) + exact ⟨genus, threshold, P, hRiemann, hP0, hPdegree, hP⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean new file mode 100644 index 0000000000..a115b858b8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean @@ -0,0 +1,501 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement + +/-! +# Exact local principal-part dimensions at exhaustive places + +The abstract DVR calculation in `LocalPoleFiltration` is instantiated at +both the finite and infinity places of a finite separable extension of +`K(X)`. Thus every successive local pole layer has dimension exactly the +degree of the corresponding exhaustive place. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped nonZeroDivisors Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance localQuotientConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance localQuotientConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +section FinitePlace + +local instance (priority := 10) localQuotientPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance localQuotientPolynomialTower : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance localQuotientFiniteClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp + (algebraMap K K[X])) + +local instance localQuotientFiniteClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance localQuotientFiniteClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance localQuotientFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance localQuotientPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance localQuotientFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance localQuotientFiniteClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance localQuotientFiniteClosureFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) + +/-- Every finite-place local principal-part layer has dimension exactly the +degree of that place. -/ +theorem finiteExtensionLocalPoleSpace_inl_step_finrank + (q : FiniteExtensionFinitePlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionLocalPoleSpace K L (.inl q) (n + 1) ⧸ + Submodule.comap + (finiteExtensionLocalPoleSpace K L (.inl q) (n + 1)).subtype + (finiteExtensionLocalPoleSpace K L (.inl q) n)) = + finiteExtensionPlaceDegree K L (.inl q) := by + let A := RatFuncFiniteIntegralClosure K L + let R := FiniteExtensionFinitePlaceLocalRing K L q + letI : Algebra A A := Algebra.id A + let localA : Algebra A R := OreLocalization.instAlgebra + letI := localA + letI : SMul A R := localA.toSMul + letI : Algebra K R := OreLocalization.instAlgebra + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + symm + change finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap K R c) = algebraMap K L c + rw [show algebraMap K R c = algebraMap A R (algebraMap K A c) by rfl] + rw [show finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap A R (algebraMap K A c)) = + algebraMap A L (algebraMap K A c) by + exact DFunLike.congr_fun + (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q) (algebraMap K A c)] + rfl + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A q.ne_bot R + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : + (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + have hspace (m : ℕ) : + finiteExtensionLocalPoleSpace K L (.inl q) m = + localPoleSpace (K := K) (L := L) π m := by + ext x + rw [mem_finiteExtensionLocalPoleSpace_iff, + mem_localPoleSpace_iff_finitePlaceOrder π hπ hπIdeal] + change (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionPrincipalDivisor K L x (.inl q))) ↔ + (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionFinitePlaceLocalOrder + (K := K) (L := L) q x)) + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + ← finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + letI : Finite (IsLocalRing.ResidueField R) := by + simpa [R] using + finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q + letI : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite + rw [hspace (n + 1), hspace n] + calc + Module.finrank K + (localPoleSpace (K := K) (L := L) π (n + 1) ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π (n + 1)).subtype + (localPoleSpace (K := K) (L := L) π n)) = + Module.finrank K (IsLocalRing.ResidueField R) := + localPoleQuotient_finrank π hπ.ne_zero hπIdeal n + _ = finiteExtensionPlaceDegree K L (.inl q) := by + simpa [R] using + (finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q).symm + +/-- The finite-place principal parts through order `n` have dimension +`n` times the degree of the place. -/ +theorem finiteExtensionLocalPoleSpace_inl_cumulative_finrank + (q : FiniteExtensionFinitePlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionLocalPoleSpace K L (.inl q) n ⧸ + Submodule.comap + (finiteExtensionLocalPoleSpace K L (.inl q) n).subtype + (finiteExtensionLocalPoleSpace K L (.inl q) 0)) = + n * finiteExtensionPlaceDegree K L (.inl q) := by + let A := RatFuncFiniteIntegralClosure K L + let R := FiniteExtensionFinitePlaceLocalRing K L q + letI : Algebra A A := Algebra.id A + let localA : Algebra A R := OreLocalization.instAlgebra + letI := localA + letI : SMul A R := localA.toSMul + letI : Algebra K R := OreLocalization.instAlgebra + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + symm + change finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap K R c) = algebraMap K L c + rw [show algebraMap K R c = algebraMap A R (algebraMap K A c) by rfl] + rw [show finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap A R (algebraMap K A c)) = + algebraMap A L (algebraMap K A c) by + exact DFunLike.congr_fun + (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q) (algebraMap K A c)] + rfl + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A q.ne_bot R + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : + (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + have hspace (m : ℕ) : + finiteExtensionLocalPoleSpace K L (.inl q) m = + localPoleSpace (K := K) (L := L) π m := by + ext x + rw [mem_finiteExtensionLocalPoleSpace_iff, + mem_localPoleSpace_iff_finitePlaceOrder π hπ hπIdeal] + change (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionPrincipalDivisor K L x (.inl q))) ↔ + (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionFinitePlaceLocalOrder + (K := K) (L := L) q x)) + rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, + ← finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + letI : Finite (IsLocalRing.ResidueField R) := by + simpa [R] using + finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q + rw [hspace n, hspace 0] + calc + Module.finrank K + (localPoleSpace (K := K) (L := L) π n ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π n).subtype + (localPoleSpace (K := K) (L := L) π 0)) = + n * Module.finrank K (IsLocalRing.ResidueField R) := + localPoleCumulativeQuotient_finrank π hπ.ne_zero hπIdeal n + _ = n * finiteExtensionPlaceDegree K L (.inl q) := by + congr 1 + simpa [R] using + (finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q).symm + +end FinitePlace + +section InfinityPlace + +local instance localQuotientInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance localQuotientInfinityClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance localQuotientInfinityClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance localQuotientInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance localQuotientInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance localQuotientInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance localQuotientInfinityClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance localQuotientInfinityClosureDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance localQuotientInfinityClosureFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance localQuotientInfinityClosureConstantTowerToField : + IsScalarTower K (RatFuncInfinityIntegralClosure K L) L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + simp only [RingHom.comp_apply] + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + +private noncomputable def localQuotientInfinityResidueFieldAlgEquivOfIdealEq + {I J : Ideal (RatFuncInfinityIntegralClosure K L)} + [I.IsPrime] [J.IsPrime] (h : I = J) : + I.ResidueField ≃ₐ[K] J.ResidueField := by + subst J + exact AlgEquiv.refl + +private noncomputable def localQuotientInfinityResidueFieldAlgEquiv + (P : FiniteExtensionInfinityPlace K L) : + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField + ≃ₐ[K] P.1.ResidueField := + localQuotientInfinityResidueFieldAlgEquivOfIdealEq K L + (primeOverHeightOne_asIdeal (ratFuncInfinityPlace K) P) + +/-- Every infinity-place local principal-part layer has dimension exactly +the degree of that place. -/ +theorem finiteExtensionLocalPoleSpace_inr_step_finrank + (P : FiniteExtensionInfinityPlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionLocalPoleSpace K L (.inr P) (n + 1) ⧸ + Submodule.comap + (finiteExtensionLocalPoleSpace K L (.inr P) (n + 1)).subtype + (finiteExtensionLocalPoleSpace K L (.inr P) n)) = + finiteExtensionPlaceDegree K L (.inr P) := by + let A := RatFuncInfinityIntegralClosure K L + let R := FiniteExtensionInfinityPlaceLocalRing K L P + letI : Algebra A A := Algebra.id A + let localA : Algebra A R := OreLocalization.instAlgebra + letI := localA + letI : SMul A R := localA.toSMul + letI : Algebra K R := OreLocalization.instAlgebra + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + symm + change finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P (algebraMap K R c) = algebraMap K L c + rw [show algebraMap K R c = algebraMap A R (algebraMap K A c) by rfl] + rw [show finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P (algebraMap A R (algebraMap K A c)) = + algebraMap A L (algebraMap K A c) by + exact DFunLike.congr_fun + (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) P) (algebraMap K A c)] + exact (IsScalarTower.algebraMap_apply K A L c).symm + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot R + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : + (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + have hspace (m : ℕ) : + finiteExtensionLocalPoleSpace K L (.inr P) m = + localPoleSpace (K := K) (L := L) π m := by + ext x + rw [mem_finiteExtensionLocalPoleSpace_iff, + mem_localPoleSpace_iff_finitePlaceOrder π hπ hπIdeal] + change (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionPrincipalDivisor K L x (.inr P))) ↔ + (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionInfinityPlaceLocalOrder + (K := K) (L := L) P x)) + rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, + ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] + letI : Finite (IsLocalRing.ResidueField R) := by + letI : Finite P.1.ResidueField := + finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P + change Finite + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField + exact Finite.of_injective + (localQuotientInfinityResidueFieldAlgEquiv K L P) + (localQuotientInfinityResidueFieldAlgEquiv K L P).injective + letI : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite + rw [hspace (n + 1), hspace n] + calc + Module.finrank K + (localPoleSpace (K := K) (L := L) π (n + 1) ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π (n + 1)).subtype + (localPoleSpace (K := K) (L := L) π n)) = + Module.finrank K (IsLocalRing.ResidueField R) := + localPoleQuotient_finrank π hπ.ne_zero hπIdeal n + _ = finiteExtensionPlaceDegree K L (.inr P) := by + change Module.finrank K + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField = _ + calc + Module.finrank K + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField = + Module.finrank K P.1.ResidueField := + (localQuotientInfinityResidueFieldAlgEquiv K L P).toLinearEquiv.finrank_eq + _ = finiteExtensionPlaceDegree K L (.inr P) := + (finiteExtensionInfinityPlace_degree_eq_finrank_residueField K L P).symm + +/-- The infinity-place principal parts through order `n` have dimension +`n` times the degree of the place. -/ +theorem finiteExtensionLocalPoleSpace_inr_cumulative_finrank + (P : FiniteExtensionInfinityPlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionLocalPoleSpace K L (.inr P) n ⧸ + Submodule.comap + (finiteExtensionLocalPoleSpace K L (.inr P) n).subtype + (finiteExtensionLocalPoleSpace K L (.inr P) 0)) = + n * finiteExtensionPlaceDegree K L (.inr P) := by + let A := RatFuncInfinityIntegralClosure K L + let R := FiniteExtensionInfinityPlaceLocalRing K L P + letI : Algebra A A := Algebra.id A + let localA : Algebra A R := OreLocalization.instAlgebra + letI := localA + letI : SMul A R := localA.toSMul + letI : Algebra K R := OreLocalization.instAlgebra + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + symm + change finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P (algebraMap K R c) = algebraMap K L c + rw [show algebraMap K R c = algebraMap A R (algebraMap K A c) by rfl] + rw [show finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P (algebraMap A R (algebraMap K A c)) = + algebraMap A L (algebraMap K A c) by + exact DFunLike.congr_fun + (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) P) (algebraMap K A c)] + exact (IsScalarTower.algebraMap_apply K A L c).symm + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot R + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : + (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + have hspace (m : ℕ) : + finiteExtensionLocalPoleSpace K L (.inr P) m = + localPoleSpace (K := K) (L := L) π m := by + ext x + rw [mem_finiteExtensionLocalPoleSpace_iff, + mem_localPoleSpace_iff_finitePlaceOrder π hπ hπIdeal] + change (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionPrincipalDivisor K L x (.inr P))) ↔ + (x = 0 ∨ (x ≠ 0 ∧ + -(m : ℤ) ≤ finiteExtensionInfinityPlaceLocalOrder + (K := K) (L := L) P x)) + rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, + ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] + letI : Finite (IsLocalRing.ResidueField R) := by + letI : Finite P.1.ResidueField := + finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P + change Finite + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField + exact Finite.of_injective + (localQuotientInfinityResidueFieldAlgEquiv K L P) + (localQuotientInfinityResidueFieldAlgEquiv K L P).injective + rw [hspace n, hspace 0] + calc + Module.finrank K + (localPoleSpace (K := K) (L := L) π n ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π n).subtype + (localPoleSpace (K := K) (L := L) π 0)) = + n * Module.finrank K (IsLocalRing.ResidueField R) := + localPoleCumulativeQuotient_finrank π hπ.ne_zero hπIdeal n + _ = n * finiteExtensionPlaceDegree K L (.inr P) := by + congr 1 + change Module.finrank K + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField = _ + calc + Module.finrank K + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField = + Module.finrank K P.1.ResidueField := + (localQuotientInfinityResidueFieldAlgEquiv K L P).toLinearEquiv.finrank_eq + _ = finiteExtensionPlaceDegree K L (.inr P) := + (finiteExtensionInfinityPlace_degree_eq_finrank_residueField K L P).symm + +end InfinityPlace + +/-- At every exhaustive place, each successive local pole layer has exact +dimension equal to the place degree. -/ +theorem finiteExtensionLocalPoleSpace_step_finrank + (P : FiniteExtensionPlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionLocalPoleSpace K L P (n + 1) ⧸ + Submodule.comap + (finiteExtensionLocalPoleSpace K L P (n + 1)).subtype + (finiteExtensionLocalPoleSpace K L P n)) = + finiteExtensionPlaceDegree K L P := by + cases P with + | inl q => exact finiteExtensionLocalPoleSpace_inl_step_finrank K L q n + | inr P => exact finiteExtensionLocalPoleSpace_inr_step_finrank K L P n + +/-- At every exhaustive place, the principal parts through order `n` have +dimension `n` times the place degree. -/ +theorem finiteExtensionLocalPoleSpace_cumulative_finrank + (P : FiniteExtensionPlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionLocalPoleSpace K L P n ⧸ + Submodule.comap + (finiteExtensionLocalPoleSpace K L P n).subtype + (finiteExtensionLocalPoleSpace K L P 0)) = + n * finiteExtensionPlaceDegree K L P := by + cases P with + | inl q => + exact finiteExtensionLocalPoleSpace_inl_cumulative_finrank K L q n + | inr P => + exact finiteExtensionLocalPoleSpace_inr_cumulative_finrank K L P n + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean new file mode 100644 index 0000000000..5f5a3eb2aa --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean @@ -0,0 +1,193 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace + +/-! +# Local and away-regular subspaces of a function field + +For an exhaustive place `P`, the one-point Riemann space is the intersection +of two elementary subspaces: functions with a bounded pole at `P`, and +functions regular at every place away from `P`. This is the two-open-cover +decomposition used by the Cech form of Riemann's inequality. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance localPoleConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance localPoleConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Functions whose pole at `P` has order at most `n`, with no condition at +the other places. -/ +def finiteExtensionLocalPoleSpace + (P : FiniteExtensionPlace K L) (n : ℕ) : Submodule K L where + carrier := {x | x = 0 ∨ + (x ≠ 0 ∧ -(n : ℤ) ≤ finiteExtensionPrincipalDivisor K L x P)} + zero_mem' := Or.inl rfl + add_mem' := by + rintro x y (hx0 | ⟨hx0, hx⟩) (hy0 | ⟨hy0, hy⟩) + · exact Or.inl (by simp [hx0, hy0]) + · subst x + simpa using + (Or.inr ⟨hy0, hy⟩ : y = 0 ∨ + (y ≠ 0 ∧ -(n : ℤ) ≤ finiteExtensionPrincipalDivisor K L y P)) + · subst y + simpa using + (Or.inr ⟨hx0, hx⟩ : x = 0 ∨ + (x ≠ 0 ∧ -(n : ℤ) ≤ finiteExtensionPrincipalDivisor K L x P)) + · by_cases hxy : x + y = 0 + · exact Or.inl hxy + · refine Or.inr ⟨hxy, ?_⟩ + exact le_trans (le_min hx hy) + (finiteExtensionPrincipalDivisor_add_ge_min + K L x y hx0 hy0 hxy P) + smul_mem' := by + intro c x hx + by_cases hc : c = 0 + · subst c + exact Or.inl (zero_smul K x) + rcases hx with hx | ⟨hx, horder⟩ + · subst x + exact Or.inl (smul_zero c) + · have hcL : algebraMap K L c ≠ 0 := by + simpa only [map_zero] using (algebraMap K L).injective.ne hc + have hcx : c • x ≠ 0 := by + rw [Algebra.smul_def] + exact mul_ne_zero hcL hx + refine Or.inr ⟨hcx, ?_⟩ + rw [Algebra.smul_def, + finiteExtensionPrincipalDivisor_mul K L _ _ hcL hx, + finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc] + simpa using horder + +@[simp] +theorem mem_finiteExtensionLocalPoleSpace_iff + (P : FiniteExtensionPlace K L) (n : ℕ) (x : L) : + x ∈ finiteExtensionLocalPoleSpace K L P n ↔ + x = 0 ∨ + (x ≠ 0 ∧ -(n : ℤ) ≤ finiteExtensionPrincipalDivisor K L x P) := + Iff.rfl + +/-- Functions regular at every exhaustive place other than `P`. -/ +def finiteExtensionAwayRegularSpace + (P : FiniteExtensionPlace K L) : Submodule K L where + carrier := {x | x = 0 ∨ + (x ≠ 0 ∧ ∀ v, v ≠ P → 0 ≤ finiteExtensionPrincipalDivisor K L x v)} + zero_mem' := Or.inl rfl + add_mem' := by + rintro x y (hx0 | ⟨hx0, hx⟩) (hy0 | ⟨hy0, hy⟩) + · exact Or.inl (by simp [hx0, hy0]) + · subst x + simpa only [zero_add, Set.mem_setOf_eq] using + (Or.inr ⟨hy0, hy⟩ : y = 0 ∨ + (y ≠ 0 ∧ ∀ v, v ≠ P → + 0 ≤ finiteExtensionPrincipalDivisor K L y v)) + · subst y + simpa only [add_zero, Set.mem_setOf_eq] using + (Or.inr ⟨hx0, hx⟩ : x = 0 ∨ + (x ≠ 0 ∧ ∀ v, v ≠ P → + 0 ≤ finiteExtensionPrincipalDivisor K L x v)) + · by_cases hxy : x + y = 0 + · exact Or.inl hxy + · refine Or.inr ⟨hxy, ?_⟩ + intro v hv + exact le_trans (le_min (hx v hv) (hy v hv)) + (finiteExtensionPrincipalDivisor_add_ge_min + K L x y hx0 hy0 hxy v) + smul_mem' := by + intro c x hx + by_cases hc : c = 0 + · subst c + exact Or.inl (zero_smul K x) + rcases hx with hx | ⟨hx, horders⟩ + · subst x + exact Or.inl (smul_zero c) + · have hcL : algebraMap K L c ≠ 0 := by + simpa only [map_zero] using (algebraMap K L).injective.ne hc + have hcx : c • x ≠ 0 := by + rw [Algebra.smul_def] + exact mul_ne_zero hcL hx + refine Or.inr ⟨hcx, ?_⟩ + intro v hv + rw [Algebra.smul_def, + finiteExtensionPrincipalDivisor_mul K L _ _ hcL hx, + finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc] + simpa using horders v hv + +@[simp] +theorem mem_finiteExtensionAwayRegularSpace_iff + (P : FiniteExtensionPlace K L) (x : L) : + x ∈ finiteExtensionAwayRegularSpace K L P ↔ + x = 0 ∨ + (x ≠ 0 ∧ ∀ v, v ≠ P → + 0 ≤ finiteExtensionPrincipalDivisor K L x v) := + Iff.rfl + +/-- The local pole filtration is increasing. -/ +theorem finiteExtensionLocalPoleSpace_mono + (P : FiniteExtensionPlace K L) {m n : ℕ} (hmn : m ≤ n) : + finiteExtensionLocalPoleSpace K L P m ≤ + finiteExtensionLocalPoleSpace K L P n := by + intro x hx + rw [mem_finiteExtensionLocalPoleSpace_iff] at hx ⊢ + rcases hx with rfl | ⟨hx0, hx⟩ + · exact Or.inl rfl + · have hmnZ : (m : ℤ) ≤ (n : ℤ) := by exact_mod_cast hmn + exact Or.inr ⟨hx0, le_trans (Int.neg_le_neg hmnZ) hx⟩ + +/-- The one-point Riemann space is the intersection of its local pole bound +and its away-regular condition. -/ +theorem finiteExtensionOnePointRiemannSpace_eq_inf + (P : FiniteExtensionPlace K L) (n : ℕ) : + finiteExtensionOnePointRiemannSpace K L P n = + finiteExtensionLocalPoleSpace K L P n ⊓ + finiteExtensionAwayRegularSpace K L P := by + ext x + rw [mem_finiteExtensionOnePointRiemannSpace_iff, + Submodule.mem_inf, mem_finiteExtensionLocalPoleSpace_iff, + mem_finiteExtensionAwayRegularSpace_iff] + constructor + · rintro (rfl | ⟨hx0, hP, hAway⟩) + · exact ⟨Or.inl rfl, Or.inl rfl⟩ + · exact ⟨Or.inr ⟨hx0, hP⟩, Or.inr ⟨hx0, hAway⟩⟩ + · rintro ⟨hlocal, hAway⟩ + rcases hlocal with rfl | ⟨hx0, hP⟩ + · exact Or.inl rfl + · rcases hAway with hzero | ⟨_, hAway⟩ + · exact (hx0 hzero).elim + · exact Or.inr ⟨hx0, hP, hAway⟩ + +/-- At level zero the same intersection is the all-place regular space. -/ +theorem finiteExtensionRiemannSpace_zero_eq_local_inf_away + (P : FiniteExtensionPlace K L) : + finiteExtensionRiemannSpace K L 0 = + finiteExtensionLocalPoleSpace K L P 0 ⊓ + finiteExtensionAwayRegularSpace K L P := by + rw [← finiteExtensionOnePointRiemannSpace_eq_inf K L P 0] + apply congrArg (finiteExtensionRiemannSpace K L) + ext v + by_cases hv : v = P + · subst v + simp + · simp + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean new file mode 100644 index 0000000000..7cd24dcaed --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean @@ -0,0 +1,428 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace + +/-! +# Transporting function-field places across algebra equivalences + +An equivalence of finite extensions over `K(X)` identifies both normalization +charts. This file packages the induced equivalences of finite, infinity, and +exhaustive places and records preservation of absolute place degree. In +particular, rational-place counts depend only on the `K(X)`-algebra up to +equivalence, not on its chosen field presentation. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain + + +section Fiber + +variable (R A : Type*) [CommRing R] [IsDomain R] + [CommRing A] [IsDomain A] [Algebra R A] + [Algebra.IsIntegral R A] [Module.IsTorsionFree R A] + +/-- A height-one prime restriction fiber is the usual type of primes above +the base prime. -/ +def heightOneSpectrumFiberEquivPrimesOver (p : HeightOneSpectrum R) : + {q : HeightOneSpectrum A // HeightOneSpectrum.under R q = p} ≃ + p.asIdeal.primesOver A where + toFun q := ⟨q.1.asIdeal, q.1.isPrime, ⟨by + have h := congrArg HeightOneSpectrum.asIdeal q.2 + exact h.symm⟩⟩ + invFun P := ⟨primeOverHeightOne p P, by + apply HeightOneSpectrum.ext + exact (Ideal.over_def P.1 p.asIdeal).symm⟩ + left_inv q := by + apply Subtype.ext + apply HeightOneSpectrum.ext + rfl + right_inv P := by + apply Subtype.ext + rfl + +end Fiber + +variable (K L M : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] + [Field L] [Field M] + [Algebra (RatFunc K) L] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) M] + +local instance (priority := 10) finiteAlgEquivPolynomialAlgebraLeft : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance (priority := 10) finiteAlgEquivPolynomialAlgebraRight : + Algebra K[X] M := + RingHom.toAlgebra ((algebraMap (RatFunc K) M).comp + (algebraMap K[X] (RatFunc K))) + +local instance finiteAlgEquivPolynomialTowerLeft : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' + (R := K[X]) (S := RatFunc K) (A := L) rfl + +local instance finiteAlgEquivPolynomialTowerRight : + IsScalarTower K[X] (RatFunc K) M := + IsScalarTower.of_algebraMap_eq' + (R := K[X]) (S := RatFunc K) (A := M) rfl + +local instance (priority := 10) finiteAlgEquivInfinityAlgebraLeft : + Algebra (RatFuncInfinityIntegers K) L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K))) + +local instance (priority := 10) finiteAlgEquivInfinityAlgebraRight : + Algebra (RatFuncInfinityIntegers K) M := + RingHom.toAlgebra ((algebraMap (RatFunc K) M).comp + (algebraMap (RatFuncInfinityIntegers K) (RatFunc K))) + +local instance finiteAlgEquivInfinityTowerLeft : + IsScalarTower (RatFuncInfinityIntegers K) (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' + (R := RatFuncInfinityIntegers K) (S := RatFunc K) (A := L) rfl + +local instance finiteAlgEquivInfinityTowerRight : + IsScalarTower (RatFuncInfinityIntegers K) (RatFunc K) M := + IsScalarTower.of_algebraMap_eq' + (R := RatFuncInfinityIntegers K) (S := RatFunc K) (A := M) rfl + +local instance finiteAlgEquivInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance finiteAlgEquivInfinityConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFuncInfinityIntegers K) (A := RatFunc K) rfl + +local instance finiteAlgEquivPolynomialTorsionFreeLeft : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance finiteAlgEquivPolynomialTorsionFreeRight : + Module.IsTorsionFree K[X] M := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) M + +local instance finiteAlgEquivFiniteClosureTorsionFreeLeft : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance finiteAlgEquivFiniteClosureTorsionFreeRight : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isTorsionFree K[X] M + +local instance finiteAlgEquivInfinityClosureTorsionFreeLeft : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance finiteAlgEquivInfinityClosureTorsionFreeRight : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) M + +local instance finiteAlgEquivFiniteClosureConstantAlgebraLeft : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance finiteAlgEquivFiniteClosureConstantAlgebraRight : + Algebra K (RatFuncFiniteIntegralClosure K M) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K M)).comp (algebraMap K K[X])) + +local instance finiteAlgEquivFiniteClosureConstantTowerLeft : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := K[X]) (A := RatFuncFiniteIntegralClosure K L) rfl + +local instance finiteAlgEquivFiniteClosureConstantTowerRight : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K M) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := K[X]) (A := RatFuncFiniteIntegralClosure K M) rfl + +local instance finiteAlgEquivInfinityClosureConstantAlgebraLeft : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance finiteAlgEquivInfinityClosureConstantAlgebraRight : + Algebra K (RatFuncInfinityIntegralClosure K M) := + RingHom.toAlgebra ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance finiteAlgEquivInfinityClosureConstantTowerLeft : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFuncInfinityIntegers K) + (A := RatFuncInfinityIntegralClosure K L) rfl + +local instance finiteAlgEquivInfinityClosureConstantTowerRight : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFuncInfinityIntegers K) + (A := RatFuncInfinityIntegralClosure K M) rfl + +/-- A `K(X)`-algebra equivalence restricts to the finite normalization +charts. -/ +noncomputable def ratFuncFiniteIntegralClosureAlgEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + RatFuncFiniteIntegralClosure K L ≃ₐ[K[X]] + RatFuncFiniteIntegralClosure K M := + (e.restrictScalars K[X]).mapIntegralClosure + +/-- A `K(X)`-algebra equivalence restricts to the infinity normalization +charts. -/ +noncomputable def ratFuncInfinityIntegralClosureAlgEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + RatFuncInfinityIntegralClosure K L ≃ₐ[RatFuncInfinityIntegers K] + RatFuncInfinityIntegralClosure K M := + by + change integralClosure (RatFuncInfinityIntegers K) L ≃ₐ[ + RatFuncInfinityIntegers K] + integralClosure (RatFuncInfinityIntegers K) M + exact (e.restrictScalars + (RatFuncInfinityIntegers K)).mapIntegralClosure + +/-- Finite places are invariant under an equivalence of the ambient +`K(X)`-algebras. -/ +noncomputable def finiteExtensionFinitePlaceEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + FiniteExtensionFinitePlace K L ≃ FiniteExtensionFinitePlace K M := + heightOneSpectrumEquivOfAlgEquiv + (ratFuncFiniteIntegralClosureAlgEquivOfAlgEquiv K L M e) + +/-- The residue fields of corresponding finite places are equivalent over +the constant field. -/ +noncomputable def finiteExtensionFinitePlaceResidueFieldAlgEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) (Q : FiniteExtensionFinitePlace K L) : + Q.asIdeal.ResidueField ≃ₐ[K] + (finiteExtensionFinitePlaceEquivOfAlgEquiv K L M e Q).asIdeal.ResidueField := + heightOneSpectrumResidueFieldAlgEquiv + ((ratFuncFiniteIntegralClosureAlgEquivOfAlgEquiv K L M e).restrictScalars K) + Q + +/-- Infinity places are invariant under an equivalence of the ambient +`K(X)`-algebras. -/ +noncomputable def finiteExtensionInfinityPlaceEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + FiniteExtensionInfinityPlace K L ≃ + FiniteExtensionInfinityPlace K M := by + let R := RatFuncInfinityIntegers K + let A := RatFuncInfinityIntegralClosure K L + let B := RatFuncInfinityIntegralClosure K M + let p := ratFuncInfinityPlace K + let eAB : A ≃ₐ[R] B := + ratFuncInfinityIntegralClosureAlgEquivOfAlgEquiv K L M e + let ePlaces : HeightOneSpectrum A ≃ HeightOneSpectrum B := + heightOneSpectrumEquivOfAlgEquiv eAB + let eFibers : + {q : HeightOneSpectrum A // HeightOneSpectrum.under R q = p} ≃ + {q : HeightOneSpectrum B // HeightOneSpectrum.under R q = p} := + { toFun := fun q => ⟨ePlaces q.1, by + calc + HeightOneSpectrum.under R (ePlaces q.1) = + HeightOneSpectrum.under R q.1 := by + exact heightOneSpectrumEquivOfAlgEquiv_under eAB q.1 + _ = p := q.2⟩ + invFun := fun q => ⟨ePlaces.symm q.1, by + calc + HeightOneSpectrum.under R (ePlaces.symm q.1) = + HeightOneSpectrum.under R q.1 := by + exact heightOneSpectrumEquivOfAlgEquiv_under eAB.symm q.1 + _ = p := q.2⟩ + left_inv := fun q => by + apply Subtype.ext + exact ePlaces.left_inv q.1 + right_inv := fun q => by + apply Subtype.ext + exact ePlaces.right_inv q.1 } + exact + (heightOneSpectrumFiberEquivPrimesOver R A p).symm.trans + (eFibers.trans (heightOneSpectrumFiberEquivPrimesOver R B p)) + +/-- Exhaustive places are invariant under an equivalence of the ambient +`K(X)`-algebras. -/ +noncomputable def finiteExtensionPlaceEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + FiniteExtensionPlace K L ≃ FiniteExtensionPlace K M := + Equiv.sumCongr + (finiteExtensionFinitePlaceEquivOfAlgEquiv K L M e) + (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e) + +/-- The absolute degree of a finite place is the dimension of its residue +field over the constant field. -/ +theorem finiteExtensionFinitePlace_degree_eq_residue_finrank + (Q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K L (.inl Q) = + Module.finrank K Q.asIdeal.ResidueField := by + let P := HeightOneSpectrum.under K[X] Q + letI : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver P.asIdeal Q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra P.asIdeal Q.asIdeal := + ⟨rfl⟩ + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq P.asIdeal Q.asIdeal] + rw [ratFuncFinitePlaceDegree_eq_finrank_residueField K P] + rw [mul_comm, Module.finrank_mul_finrank] + +/-- The absolute degree of an infinity place is the dimension of its residue +field over the constant field. -/ +theorem finiteExtensionInfinityPlace_degree_eq_residue_finrank + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPlaceDegree K L (.inr P) = + Module.finrank K P.1.ResidueField := by + let p := (ratFuncInfinityPlace K).asIdeal + letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra p.ResidueField P.1.ResidueField := + IsLocalRing.ResidueField.instAlgebra + letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p P.1] + have hbase : Module.finrank K p.ResidueField = 1 := + by simpa [p] using + (ratFuncInfinityPlaceResidueEquiv K).toLinearEquiv.finrank_eq + calc + Module.finrank p.ResidueField P.1.ResidueField = + 1 * Module.finrank p.ResidueField P.1.ResidueField := by simp + _ = Module.finrank K p.ResidueField * + Module.finrank p.ResidueField P.1.ResidueField := by rw [hbase] + _ = Module.finrank K P.1.ResidueField := + Module.finrank_mul_finrank K p.ResidueField P.1.ResidueField + +/-- Corresponding finite places have the same absolute degree. -/ +@[simp] +theorem finiteExtensionFinitePlaceEquivOfAlgEquiv_degree + (e : L ≃ₐ[RatFunc K] M) (Q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K M + (.inl (finiteExtensionFinitePlaceEquivOfAlgEquiv K L M e Q)) = + finiteExtensionPlaceDegree K L (.inl Q) := by + calc + finiteExtensionPlaceDegree K M + (.inl (finiteExtensionFinitePlaceEquivOfAlgEquiv K L M e Q)) = + Module.finrank K + (finiteExtensionFinitePlaceEquivOfAlgEquiv K L M e Q).asIdeal.ResidueField := + finiteExtensionFinitePlace_degree_eq_residue_finrank K M _ + _ = Module.finrank K Q.asIdeal.ResidueField := + (finiteExtensionFinitePlaceResidueFieldAlgEquivOfAlgEquiv + K L M e Q).toLinearEquiv.finrank_eq.symm + _ = finiteExtensionPlaceDegree K L (.inl Q) := + (finiteExtensionFinitePlace_degree_eq_residue_finrank K L Q).symm + +@[simp] +theorem finiteExtensionInfinityPlaceEquivOfAlgEquiv_asIdeal + (e : L ≃ₐ[RatFunc K] M) (P : FiniteExtensionInfinityPlace K L) : + (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e P).1 = + P.1.comap + (ratFuncInfinityIntegralClosureAlgEquivOfAlgEquiv K L M e).symm := by + rfl + +/-- The residue fields of corresponding infinity places are equivalent over +the constant field. -/ +noncomputable def finiteExtensionInfinityPlaceResidueFieldAlgEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) (P : FiniteExtensionInfinityPlace K L) : + P.1.ResidueField ≃ₐ[K] + (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e P).1.ResidueField := by + let eInf := ratFuncInfinityIntegralClosureAlgEquivOfAlgEquiv K L M e + change P.1.ResidueField ≃ₐ[K] (P.1.comap eInf.symm).ResidueField + exact Ideal.residueFieldAlgEquiv P.1 (P.1.comap eInf.symm) + (eInf.restrictScalars K) (by + change P.1 = (P.1.comap eInf.symm).comap eInf + exact (Ideal.comap_of_equiv eInf.toRingEquiv).symm) + +/-- Corresponding infinity places have the same absolute degree. -/ +@[simp] +theorem finiteExtensionInfinityPlaceEquivOfAlgEquiv_degree + (e : L ≃ₐ[RatFunc K] M) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPlaceDegree K M + (.inr (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e P)) = + finiteExtensionPlaceDegree K L (.inr P) := by + calc + finiteExtensionPlaceDegree K M + (.inr (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e P)) = + Module.finrank K + (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e P).1.ResidueField := + finiteExtensionInfinityPlace_degree_eq_residue_finrank K M _ + _ = Module.finrank K P.1.ResidueField := + (finiteExtensionInfinityPlaceResidueFieldAlgEquivOfAlgEquiv + K L M e P).toLinearEquiv.finrank_eq.symm + _ = finiteExtensionPlaceDegree K L (.inr P) := + (finiteExtensionInfinityPlace_degree_eq_residue_finrank K L P).symm + +/-- The exhaustive place equivalence preserves absolute degree. -/ +@[simp] +theorem finiteExtensionPlaceEquivOfAlgEquiv_degree + (e : L ≃ₐ[RatFunc K] M) (P : FiniteExtensionPlace K L) : + finiteExtensionPlaceDegree K M + (finiteExtensionPlaceEquivOfAlgEquiv K L M e P) = + finiteExtensionPlaceDegree K L P := by + cases P with + | inl Q => + exact finiteExtensionFinitePlaceEquivOfAlgEquiv_degree K L M e Q + | inr Q => + exact finiteExtensionInfinityPlaceEquivOfAlgEquiv_degree K L M e Q + +/-- Degree-one finite places are invariant under a `K(X)`-algebra +equivalence. -/ +noncomputable def finiteExtensionRationalFinitePlaceEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + FiniteExtensionRationalFinitePlace K L ≃ + FiniteExtensionRationalFinitePlace K M := + Equiv.subtypeEquiv + (finiteExtensionFinitePlaceEquivOfAlgEquiv K L M e) (by + intro Q + rw [finiteExtensionFinitePlaceEquivOfAlgEquiv_degree K L M e Q]) + +/-- Degree-one infinity places are invariant under a `K(X)`-algebra +equivalence. -/ +noncomputable def finiteExtensionRationalInfinityPlaceEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + FiniteExtensionRationalInfinityPlace K L ≃ + FiniteExtensionRationalInfinityPlace K M := + Equiv.subtypeEquiv + (finiteExtensionInfinityPlaceEquivOfAlgEquiv K L M e) (by + intro P + rw [finiteExtensionInfinityPlaceEquivOfAlgEquiv_degree K L M e P]) + +/-- Complete degree-one place types are invariant under a `K(X)`-algebra +equivalence. -/ +noncomputable def finiteExtensionRationalPlaceEquivOfAlgEquiv + (e : L ≃ₐ[RatFunc K] M) : + FiniteExtensionRationalPlace K L ≃ + FiniteExtensionRationalPlace K M := + Equiv.sumCongr + (finiteExtensionRationalFinitePlaceEquivOfAlgEquiv K L M e) + (finiteExtensionRationalInfinityPlaceEquivOfAlgEquiv K L M e) + +/-- Complete rational-place counts are invariant under an equivalence of +finite `K(X)`-algebras. -/ +theorem finiteExtensionRationalPlaceCount_eq_of_algEquiv + (e : L ≃ₐ[RatFunc K] M) : + finiteExtensionRationalPlaceCount K L = + finiteExtensionRationalPlaceCount K M := + Nat.card_congr (finiteExtensionRationalPlaceEquivOfAlgEquiv K L M e) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean new file mode 100644 index 0000000000..e85f411f95 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean @@ -0,0 +1,180 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower + +/-! +# Finiteness of bounded-degree places + +For a finite field `K`, there are only finitely many finite places of `K(X)` +of bounded degree: a place is represented by its normalized prime polynomial, +and a polynomial of bounded degree is determined by finitely many +coefficients. A finite place in a finite function-field extension lies over +one of these base places, with only finitely many primes in each fiber. + +This file proves the corresponding finiteness statements for base finite +places, finite places in an extension, and the exhaustive finite-plus-infinity +place type. These are the local-finiteness inputs needed to define effective +divisor counts and Euler products without assuming zeta rationality. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +/-- Finite fields have only finitely many finite rational-function places of +degree at most `n`. -/ +theorem ratFuncFinitePlace_degree_le_finite + (K : Type*) [Field K] [Fintype K] [DecidableEq K] (n : ℕ) : + Finite {p : IsDedekindDomain.HeightOneSpectrum K[X] // + ratFuncFinitePlaceDegree p ≤ n} := by + let f : {p : IsDedekindDomain.HeightOneSpectrum K[X] // + ratFuncFinitePlaceDegree p ≤ n} → Fin (n + 1) → K := + fun p i => (finitePlaceNormalizedPrime p.1 : K[X]).coeff i + apply Finite.of_injective f + intro p q hpq + apply Subtype.ext + have hr : finitePlaceNormalizedPrime p.1 = + finitePlaceNormalizedPrime q.1 := by + apply Subtype.ext + apply Polynomial.ext + intro m + by_cases hm : m ≤ n + · exact congrFun hpq ⟨m, Nat.lt_succ_iff.mpr hm⟩ + · have hnm : n < m := Nat.lt_of_not_ge hm + rw [Polynomial.coeff_eq_zero_of_natDegree_lt + (lt_of_le_of_lt p.2 hnm), + Polynomial.coeff_eq_zero_of_natDegree_lt + (lt_of_le_of_lt q.2 hnm)] + calc + p.1 = normalizedPrimeFinitePlace (K := K) + (finitePlaceNormalizedPrime p.1) := + (normalizedPrimeFinitePlace_finitePlaceNormalizedPrime p.1).symm + _ = normalizedPrimeFinitePlace (K := K) + (finitePlaceNormalizedPrime q.1) := + congrArg (normalizedPrimeFinitePlace (K := K)) hr + _ = q.1 := normalizedPrimeFinitePlace_finitePlaceNormalizedPrime q.1 + +/-- A finite extension of `K(X)` has only finitely many finite places of +degree at most `n`. -/ +theorem finiteExtensionFinitePlace_degree_le_finite + (K L : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (n : ℕ) : + Finite {q : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl q) ≤ n} := by + letI : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + letI : Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + letI : Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + letI : Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + let Base := {p : IsDedekindDomain.HeightOneSpectrum K[X] // + ratFuncFinitePlaceDegree p ≤ n} + let Fiber : Base → Type _ := fun p => + p.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) + letI : Finite Base := ratFuncFinitePlace_degree_le_finite K n + letI : Fintype Base := Fintype.ofFinite Base + letI (p : Base) : Fintype (Fiber p) := by + dsimp only [Fiber] + exact Set.Finite.fintype + (IsDedekindDomain.primesOver_finite p.1.asIdeal + (RatFuncFiniteIntegralClosure K L)) + let f : {q : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl q) ≤ n} → + Σ p : Base, Fiber p := fun q => by + let p := IsDedekindDomain.HeightOneSpectrum.under K[X] q.1 + have hp : ratFuncFinitePlaceDegree p ≤ n := by + apply (Nat.le_mul_of_pos_left _ + (Ideal.inertiaDeg_pos q.1.asIdeal K[X])).trans + simpa only [finiteExtensionPlaceDegree, p] using q.2 + exact ⟨⟨p, hp⟩, + (finitePlaceFiberEquivPrimesOver K L p) ⟨q.1, by simp [p]⟩⟩ + refine Finite.of_injective f ?_ + intro q r hqr + apply Subtype.ext + exact IsDedekindDomain.HeightOneSpectrum.ext + (congrArg (fun z : Σ p : Base, Fiber p => z.2.1) hqr) + +/-- A finite extension of `K(X)` has only finitely many exhaustive places of +degree at most `n`. The finite branch is the preceding theorem; the branch +above the unique base infinity place is finite without a degree restriction. -/ +theorem finiteExtensionPlace_degree_le_finite + (K L : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (n : ℕ) : + Finite {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ n} := by + let FinitePart := {q : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl q) ≤ n} + letI : Finite FinitePart := + finiteExtensionFinitePlace_degree_le_finite K L n + letI : Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + letI : Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + letI : Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + letI : IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) L (RatFuncInfinityIntegralClosure K L) + letI : Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + let f : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ n} → + FinitePart ⊕ FiniteExtensionInfinityPlace K L + | ⟨.inl q, hq⟩ => .inl ⟨q, hq⟩ + | ⟨.inr Q, _⟩ => .inr Q + refine Finite.of_injective f ?_ + intro P Q h + apply Subtype.ext + cases P with + | mk P hP => + cases Q with + | mk Q hQ => + cases P <;> cases Q <;> simp only [f, Sum.inl.injEq, + Sum.inr.injEq, reduceCtorEq] at h ⊢ + · exact congrArg Subtype.val h + · exact h + +/-- A concrete finite type of exhaustive places of degree at most `n`. -/ +@[implicit_reducible] +noncomputable def finiteExtensionPlaceDegreeLEFintype + (K L : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (n : ℕ) : + Fintype {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ n} := by + letI : Finite {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ n} := + finiteExtensionPlace_degree_le_finite K L n + exact Fintype.ofFinite _ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean new file mode 100644 index 0000000000..8cfe15ee00 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -0,0 +1,1277 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +import Mathlib.NumberTheory.RamificationInertia.Galois +import Mathlib.RingTheory.Invariant.Galois +import Mathlib.RingTheory.RamificationInertia.Basic + +/-! +# Restriction of function-field places in a finite tower + +Stichtenoth's fixed-field proof of the Hasse--Weil lower bound compares +rational places in several intermediate fields of one Galois tower. This file +starts that tower API for the repository's exhaustive place type. It restricts +both finite places and places above infinity by contracting the corresponding +height-one prime through the integral closures. + +The construction is intrinsic to the field tower. It assumes no point-count +bound, zeta theorem, or Hasse--Weil statement. +-/ + +open scoped BigOperators nonZeroDivisors Pointwise Polynomial +open IsDedekindDomain + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (M : Type*) [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra M L] [IsScalarTower (RatFunc K) M L] + +local instance (priority := 10) finitePlaceTowerPolynomialAlgebraM : Algebra K[X] M := + RingHom.toAlgebra ((algebraMap (RatFunc K) M).comp + (algebraMap K[X] (RatFunc K))) + +local instance (priority := 10) finitePlaceTowerPolynomialAlgebraL : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance finitePlaceTowerPolynomialRatFuncM : + IsScalarTower K[X] (RatFunc K) M := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finitePlaceTowerPolynomialRatFuncL : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finitePlaceTowerPolynomialFields : IsScalarTower K[X] M L := + IsScalarTower.of_algebraMap_eq fun x => by + change algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) x) = + algebraMap M L + (algebraMap (RatFunc K) M (algebraMap K[X] (RatFunc K) x)) + exact IsScalarTower.algebraMap_apply (RatFunc K) M L _ + +/-- The field inclusion maps the finite integral closure in an intermediate +field into the finite integral closure in the top field. -/ +def finiteIntegralClosureMap : + RatFuncFiniteIntegralClosure K M →ₐ[K[X]] + RatFuncFiniteIntegralClosure K L := + (IsScalarTower.toAlgHom K[X] M L).mapIntegralClosure + +local instance finitePlaceTowerIntegralClosureAlgebra : + Algebra (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + (finiteIntegralClosureMap K M L).toAlgebra + +local instance finitePlaceTowerIntermediateIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isIntegral_algebra K[X] M + +local instance finitePlaceTowerIntermediateModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K M) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K M) + +local instance finitePlaceTowerIntermediateTorsionFree : + Module.IsTorsionFree K[X] M := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) M + +local instance finitePlaceTowerIntermediateClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isTorsionFree K[X] M + +local instance finitePlaceTowerIntermediateDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K M) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) M + (RatFuncFiniteIntegralClosure K M) + +local instance finitePlaceTowerBaseIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance finitePlaceTowerTopModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance finitePlaceTowerTopTorsionFree : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance finitePlaceTowerTopClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance finitePlaceTowerTopDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance finitePlaceTowerIntegralClosures : + IsScalarTower K[X] (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq fun _ => by + apply Subtype.ext + change algebraMap K[X] L _ = algebraMap M L (algebraMap K[X] M _) + exact IsScalarTower.algebraMap_apply K[X] M L _ + +local instance finitePlaceTowerTopIntegral : + Algebra.IsIntegral (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + Algebra.IsIntegral.tower_top K[X] + +local instance finitePlaceTowerFaithful : + FaithfulSMul (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + apply Subtype.ext + apply (algebraMap M L).injective + exact congrArg Subtype.val hxy + +local instance finitePlaceTowerRelativeModuleFinite : + Module.Finite (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + Module.Finite.of_restrictScalars_finite K[X] + (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) + +local instance finitePlaceTowerIntermediateFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K M) M := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) M (RatFuncFiniteIntegralClosure K M) + +local instance finitePlaceTowerTopFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) + +local instance finitePlaceTowerIntermediateClosureFieldTower : + IsScalarTower (RatFuncFiniteIntegralClosure K M) M L := + inferInstance + +local instance finitePlaceTowerTopClosureFieldTower : + IsScalarTower (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) L := + ⟨fun r s x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap (RatFuncFiniteIntegralClosure K L) L + (algebraMap (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) r) = + algebraMap (RatFuncFiniteIntegralClosure K M) L r by rfl] + ring⟩ + +local instance finitePlaceTowerRelativeIsIntegralClosure : + IsIntegralClosure (RatFuncFiniteIntegralClosure K L) + (RatFuncFiniteIntegralClosure K M) L := + IsIntegralClosure.tower_top (R := K[X]) + +/-- Restriction of a finite place contracts its height-one prime to the +intermediate finite integral closure. -/ +def finitePlaceUnder + (P : FiniteExtensionFinitePlace K L) : + FiniteExtensionFinitePlace K M := + HeightOneSpectrum.under (RatFuncFiniteIntegralClosure K M) P + +@[simp] +theorem finitePlaceUnder_asIdeal + (P : FiniteExtensionFinitePlace K L) : + (finitePlaceUnder K M L P).asIdeal = + P.asIdeal.under (RatFuncFiniteIntegralClosure K M) := rfl + +/-- Restricting a finite place through the intermediate field preserves the +place below it in the rational function field. -/ +@[simp] +theorem finitePlaceUnder_under + (P : FiniteExtensionFinitePlace K L) : + HeightOneSpectrum.under K[X] (finitePlaceUnder K M L P) = + HeightOneSpectrum.under K[X] P := by + apply HeightOneSpectrum.ext + exact Ideal.under_under P.asIdeal + +/-- The field inclusion maps the integral closure of the infinity valuation +ring in an intermediate field into the corresponding top integral closure. -/ +def infinityIntegralClosureMap : + RatFuncInfinityIntegralClosure K M →ₐ[RatFuncInfinityIntegers K] + RatFuncInfinityIntegralClosure K L := + (IsScalarTower.toAlgHom (RatFuncInfinityIntegers K) M L).mapIntegralClosure + +local instance infinityPlaceTowerIntegralClosureAlgebra : + Algebra (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + (infinityIntegralClosureMap K M L).toAlgebra + +local instance infinityPlaceTowerIntermediateIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) M + +local instance infinityPlaceTowerIntermediateModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) M + (RatFuncInfinityIntegralClosure K M) + +local instance infinityPlaceTowerIntermediateClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) M + +local instance infinityPlaceTowerIntermediateDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K M) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) M (RatFuncInfinityIntegralClosure K M) + +local instance infinityPlaceTowerBaseIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance infinityPlaceTowerTopModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityPlaceTowerTopClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance infinityPlaceTowerTopDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) L (RatFuncInfinityIntegralClosure K L) + +local instance infinityPlaceTowerIntegralClosures : + IsScalarTower (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq fun _ => by + apply Subtype.ext + change algebraMap (RatFuncInfinityIntegers K) L _ = + algebraMap M L (algebraMap (RatFuncInfinityIntegers K) M _) + exact IsScalarTower.algebraMap_apply (RatFuncInfinityIntegers K) M L _ + +local instance infinityPlaceTowerTopIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + Algebra.IsIntegral.tower_top (RatFuncInfinityIntegers K) + +local instance infinityPlaceTowerFaithful : + FaithfulSMul (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := by + rw [faithfulSMul_iff_algebraMap_injective] + intro x y hxy + apply Subtype.ext + apply (algebraMap M L).injective + exact congrArg Subtype.val hxy + +local instance infinityPlaceTowerRelativeModuleFinite : + Module.Finite (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + Module.Finite.of_restrictScalars_finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) + +local instance infinityPlaceTowerIntermediateFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K M) M := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) M + (RatFuncInfinityIntegralClosure K M) + +local instance infinityPlaceTowerTopFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance infinityPlaceTowerIntermediateClosureFieldTower : + IsScalarTower (RatFuncInfinityIntegralClosure K M) M L := + inferInstance + +local instance infinityPlaceTowerTopClosureFieldTower : + IsScalarTower (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) L := + ⟨fun r s x => by + simp only [Algebra.smul_def, map_mul] + rw [show algebraMap (RatFuncInfinityIntegralClosure K L) L + (algebraMap (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) r) = + algebraMap (RatFuncInfinityIntegralClosure K M) L r by rfl] + ring⟩ + +local instance infinityPlaceTowerRelativeIsIntegralClosure : + IsIntegralClosure (RatFuncInfinityIntegralClosure K L) + (RatFuncInfinityIntegralClosure K M) L := + IsIntegralClosure.tower_top (R := RatFuncInfinityIntegers K) + +/-- Restriction of a place above infinity contracts its prime to the +intermediate integral closure. The tower law for ideals proves that the +contracted prime still lies above the distinguished infinity place. -/ +def infinityPlaceUnder + (P : FiniteExtensionInfinityPlace K L) : + FiniteExtensionInfinityPlace K M := by + let wL : HeightOneSpectrum (RatFuncInfinityIntegralClosure K L) := + primeOverHeightOne (ratFuncInfinityPlace K) P + let wM : HeightOneSpectrum (RatFuncInfinityIntegralClosure K M) := + HeightOneSpectrum.under (RatFuncInfinityIntegralClosure K M) wL + refine ⟨wM.asIdeal, wM.isPrime, ?_⟩ + have hwM : wM.asIdeal = + wL.asIdeal.under (RatFuncInfinityIntegralClosure K M) := rfl + letI : wL.asIdeal.LiesOver wM.asIdeal := by + rw [hwM] + infer_instance + letI : wL.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by + change P.1.LiesOver (ratFuncInfinityPlace K).asIdeal + infer_instance + exact Ideal.LiesOver.tower_bot wL.asIdeal wM.asIdeal + (ratFuncInfinityPlace K).asIdeal + +@[simp] +theorem infinityPlaceUnder_asIdeal + (P : FiniteExtensionInfinityPlace K L) : + (infinityPlaceUnder K M L P).1 = + P.1.under (RatFuncInfinityIntegralClosure K M) := by + rfl + +/-- Restriction on the exhaustive sum of finite and above-infinity places. -/ +def placeUnder : FiniteExtensionPlace K L → FiniteExtensionPlace K M + | .inl P => .inl (finitePlaceUnder K M L P) + | .inr P => .inr (infinityPlaceUnder K M L P) + +@[simp] +theorem placeUnder_inl + (P : FiniteExtensionFinitePlace K L) : + placeUnder K M L (.inl P) = .inl (finitePlaceUnder K M L P) := rfl + +@[simp] +theorem placeUnder_inr + (P : FiniteExtensionInfinityPlace K L) : + placeUnder K M L (.inr P) = .inr (infinityPlaceUnder K M L P) := rfl + +/-- Every finite place of the intermediate field has a finite place above it +in the top field. This is lying-over for the induced integral-closure map. -/ +theorem finitePlaceUnder_surjective : + Function.Surjective (finitePlaceUnder K M L) := by + intro P + let Q : P.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := + Classical.choice inferInstance + letI : Q.1.LiesOver P.asIdeal := Q.2.2 + have hQ0 : Q.1 ≠ ⊥ := + Ideal.ne_bot_of_mem_primesOver P.ne_bot Q.2 + let q : FiniteExtensionFinitePlace K L := ⟨Q.1, Q.2.1, hQ0⟩ + refine ⟨q, ?_⟩ + apply HeightOneSpectrum.ext + exact (Ideal.over_def Q.1 P.asIdeal).symm + +/-- Every place above infinity in the intermediate field has a place above it +in the top field. -/ +theorem infinityPlaceUnder_surjective : + Function.Surjective (infinityPlaceUnder K M L) := by + intro P + let Q : P.1.primesOver (RatFuncInfinityIntegralClosure K L) := + Classical.choice inferInstance + letI : Q.1.LiesOver P.1 := Q.2.2 + letI : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 + letI : Q.1.LiesOver (ratFuncInfinityPlace K).asIdeal := + Ideal.LiesOver.trans Q.1 P.1 (ratFuncInfinityPlace K).asIdeal + let q : FiniteExtensionInfinityPlace K L := + ⟨Q.1, Q.2.1, inferInstance⟩ + refine ⟨q, ?_⟩ + apply Subtype.ext + exact (Ideal.over_def Q.1 P.1).symm + +/-- Restriction from the top field is surjective on the exhaustive place +type. -/ +theorem placeUnder_surjective : + Function.Surjective (placeUnder K M L) := by + intro P + rcases P with P | P + · obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective K M L P + exact ⟨.inl Q, congrArg Sum.inl hQ⟩ + · obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective K M L P + exact ⟨.inr Q, congrArg Sum.inr hQ⟩ + +/-- The finite places of the top field above a fixed intermediate finite +place. -/ +abbrev FinitePlaceUnderFiber (P : FiniteExtensionFinitePlace K M) := + {Q : FiniteExtensionFinitePlace K L // finitePlaceUnder K M L Q = P} + +/-- A restriction fiber is the usual finite set of primes lying over the +contracted prime ideal. -/ +def finitePlaceUnderFiberEquivPrimesOver + (P : FiniteExtensionFinitePlace K M) : + FinitePlaceUnderFiber K M L P ≃ + P.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) where + toFun Q := ⟨Q.1.asIdeal, Q.1.isPrime, ⟨by + have h := congrArg HeightOneSpectrum.asIdeal Q.2 + exact h.symm⟩⟩ + invFun Q := ⟨primeOverHeightOne P Q, by + apply HeightOneSpectrum.ext + exact (Ideal.over_def Q.1 P.asIdeal).symm⟩ + left_inv Q := by + apply Subtype.ext + apply HeightOneSpectrum.ext + rfl + right_inv Q := by + apply Subtype.ext + rfl + +noncomputable instance finitePlaceUnderFiberFintype + (P : FiniteExtensionFinitePlace K M) : + Fintype (FinitePlaceUnderFiber K M L P) := + Fintype.ofEquiv + (P.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) + (finitePlaceUnderFiberEquivPrimesOver K M L P).symm + +/-- The places of the top field above a fixed intermediate place at +infinity. -/ +abbrev InfinityPlaceUnderFiber (P : FiniteExtensionInfinityPlace K M) := + {Q : FiniteExtensionInfinityPlace K L // + infinityPlaceUnder K M L Q = P} + +/-- The restriction fiber above infinity is likewise the finite set of primes +over the corresponding intermediate prime. -/ +def infinityPlaceUnderFiberEquivPrimesOver + (P : FiniteExtensionInfinityPlace K M) : + InfinityPlaceUnderFiber K M L P ≃ + P.1.primesOver (RatFuncInfinityIntegralClosure K L) where + toFun Q := ⟨Q.1.1, Q.1.2.1, ⟨by + have h := congrArg Subtype.val Q.2 + exact h.symm⟩⟩ + invFun Q := by + letI : Q.1.LiesOver P.1 := Q.2.2 + letI : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 + letI : Q.1.LiesOver (ratFuncInfinityPlace K).asIdeal := + Ideal.LiesOver.trans Q.1 P.1 (ratFuncInfinityPlace K).asIdeal + let q : FiniteExtensionInfinityPlace K L := + ⟨Q.1, Q.2.1, inferInstance⟩ + refine ⟨q, ?_⟩ + apply Subtype.ext + exact (Ideal.over_def Q.1 P.1).symm + left_inv Q := by + apply Subtype.ext + apply Subtype.ext + rfl + right_inv Q := by + apply Subtype.ext + rfl + +noncomputable instance infinityPlaceUnderFiberFintype + (P : FiniteExtensionInfinityPlace K M) : + Fintype (InfinityPlaceUnderFiber K M L P) := + Fintype.ofEquiv + (P.1.primesOver (RatFuncInfinityIntegralClosure K L)) + (infinityPlaceUnderFiberEquivPrimesOver K M L P).symm + +/-- The rank of the relative finite integral-closure extension is the field +degree of the top function field over the intermediate field. -/ +theorem finiteIntegralClosure_relative_finrank_eq_field_finrank : + Module.finrank (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) = + Module.finrank M L := by + exact (Algebra.IsAlgebraic.finrank_of_isFractionRing + (RatFuncFiniteIntegralClosure K M) M + (RatFuncFiniteIntegralClosure K L) L).symm + +/-- The infinity integral-closure model has the same relative rank, namely +the degree of the field extension. -/ +theorem infinityIntegralClosure_relative_finrank_eq_field_finrank : + Module.finrank (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) = + Module.finrank M L := by + exact (Algebra.IsAlgebraic.finrank_of_isFractionRing + (RatFuncInfinityIntegralClosure K M) M + (RatFuncInfinityIntegralClosure K L) L).symm + +/-- Ramification index of a top finite place over the intermediate finite +integral closure. -/ +noncomputable def finitePlaceRelativeRamificationIdx + (Q : FiniteExtensionFinitePlace K L) : ℕ := + Q.asIdeal.ramificationIdx (RatFuncFiniteIntegralClosure K M) + +/-- Inertia degree of a top finite place over the intermediate finite +integral closure. -/ +noncomputable def finitePlaceRelativeInertiaDeg + (Q : FiniteExtensionFinitePlace K L) : ℕ := + Q.asIdeal.inertiaDeg (RatFuncFiniteIntegralClosure K M) + +/-- The fundamental equality for the finite-place restriction fiber. -/ +theorem sum_finitePlaceUnderFiber_ramification_inertia_eq_finrank + (P : FiniteExtensionFinitePlace K M) : + ∑ Q : FinitePlaceUnderFiber K M L P, + finitePlaceRelativeRamificationIdx K M L Q.1 * + finitePlaceRelativeInertiaDeg K M L Q.1 = + Module.finrank (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := by + classical + let e := finitePlaceUnderFiberEquivPrimesOver K M L P + calc + _ = ∑ Q : P.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + Q.1.ramificationIdx (RatFuncFiniteIntegralClosure K M) * + Q.1.inertiaDeg (RatFuncFiniteIntegralClosure K M) := by + apply Fintype.sum_equiv e + intro Q + rfl + _ = _ := Ideal.sum_ramification_inertia_eq_finrank P.asIdeal + (RatFuncFiniteIntegralClosure K L) + +/-- Field-degree form of the finite-place fundamental equality. -/ +theorem sum_finitePlaceUnderFiber_ramification_inertia_eq_field_finrank + (P : FiniteExtensionFinitePlace K M) : + ∑ Q : FinitePlaceUnderFiber K M L P, + finitePlaceRelativeRamificationIdx K M L Q.1 * + finitePlaceRelativeInertiaDeg K M L Q.1 = + Module.finrank M L := by + rw [sum_finitePlaceUnderFiber_ramification_inertia_eq_finrank K M L P, + finiteIntegralClosure_relative_finrank_eq_field_finrank K M L] + +/-- Ramification index of a top place above infinity over the intermediate +infinity integral closure. -/ +noncomputable def infinityPlaceRelativeRamificationIdx + (Q : FiniteExtensionInfinityPlace K L) : ℕ := + Q.1.ramificationIdx (RatFuncInfinityIntegralClosure K M) + +/-- Inertia degree of a top place above infinity over the intermediate +infinity integral closure. -/ +noncomputable def infinityPlaceRelativeInertiaDeg + (Q : FiniteExtensionInfinityPlace K L) : ℕ := + Q.1.inertiaDeg (RatFuncInfinityIntegralClosure K M) + +/-- The fundamental equality for the restriction fiber above infinity. -/ +theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_finrank + (P : FiniteExtensionInfinityPlace K M) : + ∑ Q : InfinityPlaceUnderFiber K M L P, + infinityPlaceRelativeRamificationIdx K M L Q.1 * + infinityPlaceRelativeInertiaDeg K M L Q.1 = + Module.finrank (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := by + classical + letI : P.1.IsPrime := P.2.1 + let e := infinityPlaceUnderFiberEquivPrimesOver K M L P + calc + _ = ∑ Q : P.1.primesOver (RatFuncInfinityIntegralClosure K L), + Q.1.ramificationIdx (RatFuncInfinityIntegralClosure K M) * + Q.1.inertiaDeg (RatFuncInfinityIntegralClosure K M) := by + apply Fintype.sum_equiv e + intro Q + rfl + _ = _ := Ideal.sum_ramification_inertia_eq_finrank P.1 + (RatFuncInfinityIntegralClosure K L) + +/-- Field-degree form of the fundamental equality above infinity. -/ +theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_field_finrank + (P : FiniteExtensionInfinityPlace K M) : + ∑ Q : InfinityPlaceUnderFiber K M L P, + infinityPlaceRelativeRamificationIdx K M L Q.1 * + infinityPlaceRelativeInertiaDeg K M L Q.1 = + Module.finrank M L := by + rw [sum_infinityPlaceUnderFiber_ramification_inertia_eq_finrank K M L P, + infinityIntegralClosure_relative_finrank_eq_field_finrank K M L] + +/-- Place degree is multiplicative when a finite place is restricted through +an intermediate function field. The second factor is the residue-field +degree in the relative extension. -/ +theorem finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg + (Q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K L (.inl Q) = + finiteExtensionPlaceDegree K M + (.inl (finitePlaceUnder K M L Q)) * + finitePlaceRelativeInertiaDeg K M L Q := by + let P := finitePlaceUnder K M L Q + letI : Q.asIdeal.LiesOver P.asIdeal := + ⟨finitePlaceUnder_asIdeal K M L Q⟩ + rw [finiteExtensionPlaceDegree, finiteExtensionPlaceDegree, + finitePlaceRelativeInertiaDeg] + rw [Ideal.inertiaDeg_tower (R := K[X]) P.asIdeal Q.asIdeal] + rw [finitePlaceUnder_under] + ring + +/-- The analogous degree-tower formula for places above infinity. -/ +theorem finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg + (Q : FiniteExtensionInfinityPlace K L) : + finiteExtensionPlaceDegree K L (.inr Q) = + finiteExtensionPlaceDegree K M + (.inr (infinityPlaceUnder K M L Q)) * + infinityPlaceRelativeInertiaDeg K M L Q := by + let P := infinityPlaceUnder K M L Q + letI : Q.1.LiesOver P.1 := + ⟨infinityPlaceUnder_asIdeal K M L Q⟩ + rw [finiteExtensionPlaceDegree, finiteExtensionPlaceDegree, + infinityPlaceRelativeInertiaDeg] + exact Ideal.inertiaDeg_tower P.1 Q.1 + +/-- Exhaustive place degree is multiplicative under restriction through an +intermediate function field. -/ +theorem finiteExtensionPlaceDegree_eq_under_mul_relativeInertiaDeg + (Q : FiniteExtensionPlace K L) : + finiteExtensionPlaceDegree K L Q = + finiteExtensionPlaceDegree K M (placeUnder K M L Q) * + match Q with + | .inl q => finitePlaceRelativeInertiaDeg K M L q + | .inr q => infinityPlaceRelativeInertiaDeg K M L q := by + cases Q with + | inl Q => + exact finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M L Q + | inr Q => + exact finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M L Q + +section Galois + +variable [IsGalois M L] + +/-- The field Galois group acts on the finite integral closure in the top +field, relative to the intermediate finite integral closure. -/ +@[implicit_reducible] +noncomputable def finiteIntegralClosureGalAction : + MulSemiringAction Gal(L/M) (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.MulSemiringAction + (RatFuncFiniteIntegralClosure K M) M L + (RatFuncFiniteIntegralClosure K L) + +/-- The relative Galois action fixes the intermediate finite integral +closure. -/ +theorem finiteIntegralClosureGalSmulComm : + letI := finiteIntegralClosureGalAction K M L + SMulCommClass Gal(L/M) (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := by + letI := finiteIntegralClosureGalAction K M L + constructor + intro g r s + change galRestrict (RatFuncFiniteIntegralClosure K M) M L + (RatFuncFiniteIntegralClosure K L) g + (algebraMap (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) r * s) = + algebraMap (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) r * + galRestrict (RatFuncFiniteIntegralClosure K M) M L + (RatFuncFiniteIntegralClosure K L) g s + rw [map_mul, AlgEquiv.commutes] + +/-- The relative Galois action on a finite place, obtained by acting on its +height-one prime ideal. -/ +noncomputable def finitePlaceGalSmul + (g : Gal(L/M)) (P : FiniteExtensionFinitePlace K L) : + FiniteExtensionFinitePlace K L := by + letI := finiteIntegralClosureGalAction K M L + refine ⟨g • P.asIdeal, P.isPrime.smul g, ?_⟩ + intro hbot + apply P.ne_bot + have h := congrArg + (fun I : Ideal (RatFuncFiniteIntegralClosure K L) => g⁻¹ • I) hbot + simpa [smul_smul] using h + +/-- The relative Galois group acts on finite places of the top function +field. -/ +@[implicit_reducible] +noncomputable def finitePlaceGalAction : + MulAction Gal(L/M) (FiniteExtensionFinitePlace K L) := by + letI := finiteIntegralClosureGalAction K M L + exact + { smul := finitePlaceGalSmul K M L + one_smul := fun P => by + apply HeightOneSpectrum.ext + change (1 : Gal(L/M)) • P.asIdeal = P.asIdeal + simp + mul_smul := fun g h P => by + apply HeightOneSpectrum.ext + change (g * h) • P.asIdeal = g • h • P.asIdeal + rw [mul_smul] } + +/-- Relative Galois conjugation does not change the restricted finite place. -/ +@[simp] +theorem finitePlaceUnder_finitePlaceGalSmul + (g : Gal(L/M)) (P : FiniteExtensionFinitePlace K L) : + finitePlaceUnder K M L (finitePlaceGalSmul K M L g P) = + finitePlaceUnder K M L P := by + letI := finiteIntegralClosureGalAction K M L + letI := finiteIntegralClosureGalSmulComm K M L + apply HeightOneSpectrum.ext + change (g • P.asIdeal).under (RatFuncFiniteIntegralClosure K M) = + P.asIdeal.under (RatFuncFiniteIntegralClosure K M) + exact P.asIdeal.under_smul (RatFuncFiniteIntegralClosure K M) g + +/-- The relative Galois action restricts to every finite-place fiber. -/ +@[implicit_reducible] +noncomputable def finitePlaceUnderFiberGalAction + (P : FiniteExtensionFinitePlace K M) : + MulAction Gal(L/M) (FinitePlaceUnderFiber K M L P) := by + letI := finiteIntegralClosureGalAction K M L + exact + { smul := fun g Q => ⟨finitePlaceGalSmul K M L g Q.1, by + rw [finitePlaceUnder_finitePlaceGalSmul, Q.2]⟩ + one_smul := fun Q => by + apply Subtype.ext + apply HeightOneSpectrum.ext + change (1 : Gal(L/M)) • Q.1.asIdeal = Q.1.asIdeal + simp + mul_smul := fun g h Q => by + apply Subtype.ext + apply HeightOneSpectrum.ext + change (g * h) • Q.1.asIdeal = g • h • Q.1.asIdeal + rw [mul_smul] } + +/-- Galois conjugacy of finite places, expressed on their prime ideals. -/ +def FinitePlacesGaloisConjugate + (P Q : FiniteExtensionFinitePlace K L) : Prop := + letI := finiteIntegralClosureGalAction K M L + ∃ g : Gal(L/M), Q.asIdeal = g • P.asIdeal + +/-- Two finite places above the same intermediate place are conjugate under +the relative field Galois group. -/ +theorem exists_gal_smul_finitePlace_asIdeal_of_same_under + (P Q : FiniteExtensionFinitePlace K L) + (hPQ : finitePlaceUnder K M L P = finitePlaceUnder K M L Q) : + FinitePlacesGaloisConjugate K M L P Q := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := finiteIntegralClosureGalAction K M L + change ∃ g : Gal(L/M), Q.asIdeal = g • P.asIdeal + letI := finiteIntegralClosureGalSmulComm K M L + letI : Algebra.IsInvariant (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) Gal(L/M) := + Algebra.isInvariant_of_isGalois + (RatFuncFiniteIntegralClosure K M) M L + (RatFuncFiniteIntegralClosure K L) + letI : P.asIdeal.IsPrime := P.isPrime + letI : Q.asIdeal.IsPrime := Q.isPrime + apply Algebra.IsInvariant.exists_smul_of_under_eq + (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) Gal(L/M) + simpa only [finitePlaceUnder_asIdeal] using + congrArg HeightOneSpectrum.asIdeal hPQ + +/-- Each finite-place restriction fiber is a transitive relative Galois +set. -/ +theorem finitePlaceUnderFiberGalAction_isPretransitive + (P : FiniteExtensionFinitePlace K M) : + letI := finitePlaceUnderFiberGalAction K M L P + MulAction.IsPretransitive Gal(L/M) (FinitePlaceUnderFiber K M L P) := by + letI := finiteIntegralClosureGalAction K M L + letI := finitePlaceUnderFiberGalAction K M L P + constructor + intro Q R + obtain ⟨g, hg⟩ := + exists_gal_smul_finitePlace_asIdeal_of_same_under + K M L Q.1 R.1 (Q.2.trans R.2.symm) + refine ⟨g, ?_⟩ + apply Subtype.ext + apply HeightOneSpectrum.ext + change g • Q.1.asIdeal = R.1.asIdeal + exact hg.symm + +/-- Finite places in a restriction fiber fixed by one relative Galois +automorphism. -/ +noncomputable def finitePlaceUnderFiberFixedBy + (P : FiniteExtensionFinitePlace K M) (g : Gal(L/M)) : Type _ := + letI := finitePlaceUnderFiberGalAction K M L P + MulAction.fixedBy (FinitePlaceUnderFiber K M L P) g + +/-- The exact local fixed-point trace identity for a finite-place restriction +fiber. -/ +theorem sum_card_finitePlaceUnderFiberFixedBy_eq_card_galoisGroup + (P : FiniteExtensionFinitePlace K M) : + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + (∑ g : Gal(L/M), Nat.card (finitePlaceUnderFiberFixedBy K M L P g)) = + Nat.card Gal(L/M) := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := finitePlaceUnderFiberGalAction K M L P + letI : MulAction.IsPretransitive Gal(L/M) + (FinitePlaceUnderFiber K M L P) := + finitePlaceUnderFiberGalAction_isPretransitive K M L P + letI : Nonempty (FinitePlaceUnderFiber K M L P) := by + obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective K M L P + exact ⟨⟨Q, hQ⟩⟩ + change (∑ g : Gal(L/M), + Nat.card (MulAction.fixedBy (FinitePlaceUnderFiber K M L P) g)) = _ + exact sum_card_fixedBy_eq_card_group_of_isPretransitive + Gal(L/M) (FinitePlaceUnderFiber K M L P) + +/-- The same relative Galois group acts on the integral closure of the +infinity valuation ring. -/ +@[implicit_reducible] +noncomputable def infinityIntegralClosureGalAction : + MulSemiringAction Gal(L/M) (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.MulSemiringAction + (RatFuncInfinityIntegralClosure K M) M L + (RatFuncInfinityIntegralClosure K L) + +/-- The relative Galois action fixes the intermediate infinity integral +closure. -/ +theorem infinityIntegralClosureGalSmulComm : + letI := infinityIntegralClosureGalAction K M L + SMulCommClass Gal(L/M) (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := by + letI := infinityIntegralClosureGalAction K M L + constructor + intro g r s + change galRestrict (RatFuncInfinityIntegralClosure K M) M L + (RatFuncInfinityIntegralClosure K L) g + (algebraMap (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) r * s) = + algebraMap (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) r * + galRestrict (RatFuncInfinityIntegralClosure K M) M L + (RatFuncInfinityIntegralClosure K L) g s + rw [map_mul, AlgEquiv.commutes] + +/-- The relative Galois action also commutes with scalars from the base +infinity valuation ring. -/ +theorem ratFuncInfinityIntegersGalSmulComm : + letI := infinityIntegralClosureGalAction K M L + SMulCommClass Gal(L/M) (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := by + letI := infinityIntegralClosureGalAction K M L + letI := infinityIntegralClosureGalSmulComm K M L + constructor + intro g r s + calc + g • (r • s) = g • ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) r) • s) := by + congr 1 + simp only [Algebra.smul_def, + IsScalarTower.algebraMap_apply (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L)] + _ = (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) r) • (g • s) := + smul_comm g + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) r) s + _ = r • (g • s) := by + simp only [Algebra.smul_def, + IsScalarTower.algebraMap_apply (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L)] + +/-- The relative Galois action on a place above infinity, obtained by acting +on its prime ideal. -/ +noncomputable def infinityPlaceGalSmul + (g : Gal(L/M)) (P : FiniteExtensionInfinityPlace K L) : + FiniteExtensionInfinityPlace K L := by + letI := infinityIntegralClosureGalAction K M L + letI := ratFuncInfinityIntegersGalSmulComm K M L + refine ⟨g • P.1, P.2.1.smul g, ?_⟩ + exact P.2.2.smul g + +/-- The relative Galois group acts on places above infinity of the top +function field. -/ +@[implicit_reducible] +noncomputable def infinityPlaceGalAction : + MulAction Gal(L/M) (FiniteExtensionInfinityPlace K L) := by + letI := infinityIntegralClosureGalAction K M L + exact + { smul := infinityPlaceGalSmul K M L + one_smul := fun P => by + apply Subtype.ext + change (1 : Gal(L/M)) • P.1 = P.1 + simp + mul_smul := fun g h P => by + apply Subtype.ext + change (g * h) • P.1 = g • h • P.1 + rw [mul_smul] } + +/-- Relative Galois conjugation does not change the restricted infinity +place. -/ +@[simp] +theorem infinityPlaceUnder_infinityPlaceGalSmul + (g : Gal(L/M)) (P : FiniteExtensionInfinityPlace K L) : + infinityPlaceUnder K M L (infinityPlaceGalSmul K M L g P) = + infinityPlaceUnder K M L P := by + letI := infinityIntegralClosureGalAction K M L + letI := infinityIntegralClosureGalSmulComm K M L + apply Subtype.ext + change (g • P.1).under (RatFuncInfinityIntegralClosure K M) = + P.1.under (RatFuncInfinityIntegralClosure K M) + exact P.1.under_smul (RatFuncInfinityIntegralClosure K M) g + +/-- The relative Galois action restricts to every infinity-place fiber. -/ +@[implicit_reducible] +noncomputable def infinityPlaceUnderFiberGalAction + (P : FiniteExtensionInfinityPlace K M) : + MulAction Gal(L/M) (InfinityPlaceUnderFiber K M L P) := by + letI := infinityIntegralClosureGalAction K M L + exact + { smul := fun g Q => ⟨infinityPlaceGalSmul K M L g Q.1, by + rw [infinityPlaceUnder_infinityPlaceGalSmul, Q.2]⟩ + one_smul := fun Q => by + apply Subtype.ext + apply Subtype.ext + change (1 : Gal(L/M)) • Q.1.1 = Q.1.1 + simp + mul_smul := fun g h Q => by + apply Subtype.ext + apply Subtype.ext + change (g * h) • Q.1.1 = g • h • Q.1.1 + rw [mul_smul] } + +/-- Galois conjugacy of places above infinity, expressed on their prime +ideals. -/ +def InfinityPlacesGaloisConjugate + (P Q : FiniteExtensionInfinityPlace K L) : Prop := + letI := infinityIntegralClosureGalAction K M L + ∃ g : Gal(L/M), Q.1 = g • P.1 + +/-- Two places above infinity with the same intermediate restriction are +conjugate under the relative field Galois group. -/ +theorem exists_gal_smul_infinityPlace_asIdeal_of_same_under + (P Q : FiniteExtensionInfinityPlace K L) + (hPQ : infinityPlaceUnder K M L P = infinityPlaceUnder K M L Q) : + InfinityPlacesGaloisConjugate K M L P Q := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := infinityIntegralClosureGalAction K M L + change ∃ g : Gal(L/M), Q.1 = g • P.1 + letI := infinityIntegralClosureGalSmulComm K M L + letI : Algebra.IsInvariant (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) Gal(L/M) := + Algebra.isInvariant_of_isGalois + (RatFuncInfinityIntegralClosure K M) M L + (RatFuncInfinityIntegralClosure K L) + letI : P.1.IsPrime := P.2.1 + letI : Q.1.IsPrime := Q.2.1 + apply Algebra.IsInvariant.exists_smul_of_under_eq + (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) Gal(L/M) + simpa only [infinityPlaceUnder_asIdeal] using + congrArg Subtype.val hPQ + +/-- Each infinity-place restriction fiber is a transitive relative Galois +set. -/ +theorem infinityPlaceUnderFiberGalAction_isPretransitive + (P : FiniteExtensionInfinityPlace K M) : + letI := infinityPlaceUnderFiberGalAction K M L P + MulAction.IsPretransitive Gal(L/M) (InfinityPlaceUnderFiber K M L P) := by + letI := infinityIntegralClosureGalAction K M L + letI := infinityPlaceUnderFiberGalAction K M L P + constructor + intro Q R + obtain ⟨g, hg⟩ := + exists_gal_smul_infinityPlace_asIdeal_of_same_under + K M L Q.1 R.1 (Q.2.trans R.2.symm) + refine ⟨g, ?_⟩ + apply Subtype.ext + apply Subtype.ext + change g • Q.1.1 = R.1.1 + exact hg.symm + +/-- Places above infinity in a restriction fiber fixed by one relative Galois +automorphism. -/ +noncomputable def infinityPlaceUnderFiberFixedBy + (P : FiniteExtensionInfinityPlace K M) (g : Gal(L/M)) : Type _ := + letI := infinityPlaceUnderFiberGalAction K M L P + MulAction.fixedBy (InfinityPlaceUnderFiber K M L P) g + +/-- The exact local fixed-point trace identity for an infinity-place +restriction fiber. -/ +theorem sum_card_infinityPlaceUnderFiberFixedBy_eq_card_galoisGroup + (P : FiniteExtensionInfinityPlace K M) : + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + (∑ g : Gal(L/M), Nat.card (infinityPlaceUnderFiberFixedBy K M L P g)) = + Nat.card Gal(L/M) := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := infinityPlaceUnderFiberGalAction K M L P + letI : MulAction.IsPretransitive Gal(L/M) + (InfinityPlaceUnderFiber K M L P) := + infinityPlaceUnderFiberGalAction_isPretransitive K M L P + letI : Nonempty (InfinityPlaceUnderFiber K M L P) := by + obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective K M L P + exact ⟨⟨Q, hQ⟩⟩ + change (∑ g : Gal(L/M), + Nat.card (MulAction.fixedBy (InfinityPlaceUnderFiber K M L P) g)) = _ + exact sum_card_fixedBy_eq_card_group_of_isPretransitive + Gal(L/M) (InfinityPlaceUnderFiber K M L P) + +/-- Ramification index and inertia degree are constant on each finite-place +restriction fiber in a Galois tower. -/ +theorem finitePlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under + (P Q : FiniteExtensionFinitePlace K L) + (hPQ : finitePlaceUnder K M L P = finitePlaceUnder K M L Q) : + finitePlaceRelativeRamificationIdx K M L P = + finitePlaceRelativeRamificationIdx K M L Q ∧ + finitePlaceRelativeInertiaDeg K M L P = + finitePlaceRelativeInertiaDeg K M L Q := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := finiteIntegralClosureGalAction K M L + letI := finiteIntegralClosureGalSmulComm K M L + obtain ⟨g, hg⟩ := + exists_gal_smul_finitePlace_asIdeal_of_same_under K M L P Q hPQ + constructor + · unfold finitePlaceRelativeRamificationIdx + rw [hg, Ideal.ramificationIdx_smul] + · unfold finitePlaceRelativeInertiaDeg + rw [hg, Ideal.inertiaDeg_smul] + +/-- Ramification index and inertia degree are constant on each restriction +fiber above infinity in a Galois tower. -/ +theorem infinityPlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under + (P Q : FiniteExtensionInfinityPlace K L) + (hPQ : infinityPlaceUnder K M L P = infinityPlaceUnder K M L Q) : + infinityPlaceRelativeRamificationIdx K M L P = + infinityPlaceRelativeRamificationIdx K M L Q ∧ + infinityPlaceRelativeInertiaDeg K M L P = + infinityPlaceRelativeInertiaDeg K M L Q := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := infinityIntegralClosureGalAction K M L + letI := infinityIntegralClosureGalSmulComm K M L + obtain ⟨g, hg⟩ := + exists_gal_smul_infinityPlace_asIdeal_of_same_under K M L P Q hPQ + constructor + · unfold infinityPlaceRelativeRamificationIdx + rw [hg, Ideal.ramificationIdx_smul] + · unfold infinityPlaceRelativeInertiaDeg + rw [hg, Ideal.inertiaDeg_smul] + +/-- In a Galois tower, the number of finite places in a restriction fiber +times their common ramification index and inertia degree is the relative field +degree. -/ +theorem finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + (P : FiniteExtensionFinitePlace K M) + (Q₀ : FinitePlaceUnderFiber K M L P) : + Fintype.card (FinitePlaceUnderFiber K M L P) * + finitePlaceRelativeRamificationIdx K M L Q₀.1 * + finitePlaceRelativeInertiaDeg K M L Q₀.1 = + Module.finrank M L := by + rw [← sum_finitePlaceUnderFiber_ramification_inertia_eq_field_finrank K M L P] + calc + _ = Fintype.card (FinitePlaceUnderFiber K M L P) * + (finitePlaceRelativeRamificationIdx K M L Q₀.1 * + finitePlaceRelativeInertiaDeg K M L Q₀.1) := by + rw [Nat.mul_assoc] + _ = ∑ _Q : FinitePlaceUnderFiber K M L P, + (finitePlaceRelativeRamificationIdx K M L Q₀.1 * + finitePlaceRelativeInertiaDeg K M L Q₀.1) := by simp + _ = _ := by + apply Finset.sum_congr rfl + intro Q _ + obtain ⟨he, hf⟩ := + finitePlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under + K M L Q.1 Q₀.1 (Q.2.trans Q₀.2.symm) + rw [he, hf] + +/-- The analogous Galois decomposition formula for a restriction fiber above +infinity. -/ +theorem infinityPlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank + (P : FiniteExtensionInfinityPlace K M) + (Q₀ : InfinityPlaceUnderFiber K M L P) : + Fintype.card (InfinityPlaceUnderFiber K M L P) * + infinityPlaceRelativeRamificationIdx K M L Q₀.1 * + infinityPlaceRelativeInertiaDeg K M L Q₀.1 = + Module.finrank M L := by + rw [← sum_infinityPlaceUnderFiber_ramification_inertia_eq_field_finrank K M L P] + calc + _ = Fintype.card (InfinityPlaceUnderFiber K M L P) * + (infinityPlaceRelativeRamificationIdx K M L Q₀.1 * + infinityPlaceRelativeInertiaDeg K M L Q₀.1) := by + rw [Nat.mul_assoc] + _ = ∑ _Q : InfinityPlaceUnderFiber K M L P, + (infinityPlaceRelativeRamificationIdx K M L Q₀.1 * + infinityPlaceRelativeInertiaDeg K M L Q₀.1) := by simp + _ = _ := by + apply Finset.sum_congr rfl + intro Q _ + obtain ⟨he, hf⟩ := + infinityPlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under + K M L Q.1 Q₀.1 (Q.2.trans Q₀.2.symm) + rw [he, hf] + +/-- The decomposition group of a finite place in the relative Galois group. -/ +noncomputable def finitePlaceDecompositionGroup + (P : FiniteExtensionFinitePlace K L) : Subgroup Gal(L/M) := + letI := finiteIntegralClosureGalAction K M L + MulAction.stabilizer Gal(L/M) P.asIdeal + +/-- The inertia group of a finite place in the relative Galois group. -/ +noncomputable def finitePlaceInertiaGroup + (P : FiniteExtensionFinitePlace K L) : Subgroup Gal(L/M) := + letI := finiteIntegralClosureGalAction K M L + P.asIdeal.inertia Gal(L/M) + +/-- The decomposition group of a place above infinity in the relative Galois +group. -/ +noncomputable def infinityPlaceDecompositionGroup + (P : FiniteExtensionInfinityPlace K L) : Subgroup Gal(L/M) := + letI := infinityIntegralClosureGalAction K M L + MulAction.stabilizer Gal(L/M) P.1 + +/-- The inertia group of a place above infinity in the relative Galois group. -/ +noncomputable def infinityPlaceInertiaGroup + (P : FiniteExtensionInfinityPlace K L) : Subgroup Gal(L/M) := + letI := infinityIntegralClosureGalAction K M L + P.1.inertia Gal(L/M) + +section FiniteConstants + +variable [Fintype K] + +private theorem ratFuncFinitePlaceResidueField_finite + (p : HeightOneSpectrum K[X]) : Finite p.asIdeal.ResidueField := by + let r := finitePlaceNormalizedPrime p + have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero + have hrmonic : (r : K[X]).Monic := + (Polynomial.normalize_eq_self_iff_monic hr0).mp r.property.2 + have hp : p.asIdeal = Ideal.span ({(r : K[X])} : Set K[X]) := by + calc + p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by + rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] + _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl + letI : Module.Finite K (K[X] ⧸ p.asIdeal) := by + rw [hp] + exact hrmonic.finite_quotient + letI : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K + infer_instance + +private theorem finitePlaceResidueField_finite + (P : FiniteExtensionFinitePlace K M) : Finite P.asIdeal.ResidueField := by + let p := HeightOneSpectrum.under K[X] P + letI : Finite p.asIdeal.ResidueField := + ratFuncFinitePlaceResidueField_finite K p + letI : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal P.asIdeal := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance + letI : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := + inferInstance + exact Module.finite_of_finite p.asIdeal.ResidueField + +private theorem infinityPlaceResidueField_finite + (P : FiniteExtensionInfinityPlace K M) : Finite P.1.ResidueField := by + letI : Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + letI : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + .of_algebraMap_eq' rfl + let p := (ratFuncInfinityPlace K).asIdeal + letI : Finite p.ResidueField := + Finite.of_injective (ratFuncInfinityPlaceResidueEquiv K) + (ratFuncInfinityPlaceResidueEquiv K).injective + letI : P.1.LiesOver p := by + simpa [p] using Ideal.primesOver.liesOver + (ratFuncInfinityPlace K).asIdeal P + letI := Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance + letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + exact Module.finite_of_finite p.ResidueField + +/-- The inertia-group cardinality is the ramification index at a finite +place. -/ +theorem finitePlaceInertiaGroup_card_eq_ramificationIdx + (P : FiniteExtensionFinitePlace K L) : + Nat.card (finitePlaceInertiaGroup K M L P) = + finitePlaceRelativeRamificationIdx K M L P := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := finiteIntegralClosureGalAction K M L + letI := finiteIntegralClosureGalSmulComm K M L + letI : IsGaloisGroup Gal(L/M) (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + IsGaloisGroup.of_isFractionRing _ _ _ M L + let p := finitePlaceUnder K M L P + letI : P.asIdeal.LiesOver p.asIdeal := ⟨finitePlaceUnder_asIdeal K M L P⟩ + letI : Finite p.asIdeal.ResidueField := + finitePlaceResidueField_finite K M p + letI : PerfectField p.asIdeal.ResidueField := inferInstance + change Nat.card (P.asIdeal.inertia Gal(L/M)) = + P.asIdeal.ramificationIdx (RatFuncFiniteIntegralClosure K M) + rw [Ideal.card_inertia_eq_ramificationIdxIn p.asIdeal P.asIdeal] + exact Ideal.ramificationIdxIn_eq_ramificationIdx p.asIdeal P.asIdeal Gal(L/M) + +/-- The decomposition-group cardinality is ramification index times inertia +degree at a finite place. -/ +theorem finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg + (P : FiniteExtensionFinitePlace K L) : + Nat.card (finitePlaceDecompositionGroup K M L P) = + finitePlaceRelativeRamificationIdx K M L P * + finitePlaceRelativeInertiaDeg K M L P := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := finiteIntegralClosureGalAction K M L + letI := finiteIntegralClosureGalSmulComm K M L + letI : IsGaloisGroup Gal(L/M) (RatFuncFiniteIntegralClosure K M) + (RatFuncFiniteIntegralClosure K L) := + IsGaloisGroup.of_isFractionRing _ _ _ M L + let p := finitePlaceUnder K M L P + letI : P.asIdeal.LiesOver p.asIdeal := ⟨finitePlaceUnder_asIdeal K M L P⟩ + letI : Finite p.asIdeal.ResidueField := + finitePlaceResidueField_finite K M p + letI : PerfectField p.asIdeal.ResidueField := inferInstance + change Nat.card (MulAction.stabilizer Gal(L/M) P.asIdeal) = + P.asIdeal.ramificationIdx (RatFuncFiniteIntegralClosure K M) * + P.asIdeal.inertiaDeg (RatFuncFiniteIntegralClosure K M) + rw [Ideal.card_stabilizer_eq p.asIdeal P.asIdeal, + Ideal.ramificationIdxIn_eq_ramificationIdx p.asIdeal P.asIdeal Gal(L/M), + Ideal.inertiaDegIn_eq_inertiaDeg p.asIdeal P.asIdeal Gal(L/M)] + +/-- The inertia-group cardinality is the ramification index above infinity. -/ +theorem infinityPlaceInertiaGroup_card_eq_ramificationIdx + (P : FiniteExtensionInfinityPlace K L) : + Nat.card (infinityPlaceInertiaGroup K M L P) = + infinityPlaceRelativeRamificationIdx K M L P := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := infinityIntegralClosureGalAction K M L + letI := infinityIntegralClosureGalSmulComm K M L + letI : IsGaloisGroup Gal(L/M) (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + IsGaloisGroup.of_isFractionRing _ _ _ M L + let p := infinityPlaceUnder K M L P + letI : P.1.LiesOver p.1 := ⟨infinityPlaceUnder_asIdeal K M L P⟩ + letI : Finite p.1.ResidueField := + infinityPlaceResidueField_finite K M p + letI : PerfectField p.1.ResidueField := inferInstance + change Nat.card (P.1.inertia Gal(L/M)) = + P.1.ramificationIdx (RatFuncInfinityIntegralClosure K M) + rw [Ideal.card_inertia_eq_ramificationIdxIn p.1 P.1] + exact Ideal.ramificationIdxIn_eq_ramificationIdx p.1 P.1 Gal(L/M) + +/-- The decomposition-group cardinality is ramification index times inertia +degree above infinity. -/ +theorem infinityPlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg + (P : FiniteExtensionInfinityPlace K L) : + Nat.card (infinityPlaceDecompositionGroup K M L P) = + infinityPlaceRelativeRamificationIdx K M L P * + infinityPlaceRelativeInertiaDeg K M L P := by + letI : Module.Finite M L := + Module.Finite.of_restrictScalars_finite (RatFunc K) M L + letI := infinityIntegralClosureGalAction K M L + letI := infinityIntegralClosureGalSmulComm K M L + letI : IsGaloisGroup Gal(L/M) (RatFuncInfinityIntegralClosure K M) + (RatFuncInfinityIntegralClosure K L) := + IsGaloisGroup.of_isFractionRing _ _ _ M L + let p := infinityPlaceUnder K M L P + letI : P.1.LiesOver p.1 := ⟨infinityPlaceUnder_asIdeal K M L P⟩ + letI : Finite p.1.ResidueField := + infinityPlaceResidueField_finite K M p + letI : PerfectField p.1.ResidueField := inferInstance + change Nat.card (MulAction.stabilizer Gal(L/M) P.1) = + P.1.ramificationIdx (RatFuncInfinityIntegralClosure K M) * + P.1.inertiaDeg (RatFuncInfinityIntegralClosure K M) + rw [Ideal.card_stabilizer_eq p.1 P.1, + Ideal.ramificationIdxIn_eq_ramificationIdx p.1 P.1 Gal(L/M), + Ideal.inertiaDegIn_eq_inertiaDeg p.1 P.1 Gal(L/M)] + +end FiniteConstants + +end Galois + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean new file mode 100644 index 0000000000..b9b2f51f2d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean @@ -0,0 +1,419 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants + +/-! +# Principal parts of an effective exhaustive divisor + +For an effective divisor `D` on the exhaustive places of a finite extension +of `K(X)`, this file forms the product of the local principal-part spaces over +the finite support of `D`. The local cumulative quotient calculation gives +this product dimension equal to `deg D`. + +The Riemann space `L(D)` maps diagonally to those principal parts. Its kernel +is exactly `L(0)`: vanishing of the principal part gives regularity on the +support, while membership in `L(D)` already gives regularity off the support. +Consequently `L(D) / L(0)` is finite-dimensional and has dimension at most +`deg D`. Under the exact-constant-field hypothesis, the denominator is the +space of constants. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open Submodule +open scoped Polynomial BigOperators + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance finitePrincipalPartsConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance finitePrincipalPartsConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Principal parts at a place in the support of an effective exhaustive +divisor. -/ +abbrev finiteExtensionPrincipalPartAt + (D : FiniteExtensionDivisor K L) (P : ↥D.support) := + finiteExtensionLocalPoleSpace K L P.1 (D P.1).toNat ⧸ + relativeSubmodule + (finiteExtensionLocalPoleSpace K L P.1 0) + (finiteExtensionLocalPoleSpace K L P.1 (D P.1).toNat) + +/-- The finite product of local principal parts supported by `D`. -/ +abbrev finiteExtensionPrincipalPartsSpace + (D : FiniteExtensionDivisor K L) := + ∀ P : ↥D.support, finiteExtensionPrincipalPartAt K L D P + +/-- The natural-number weighted degree of an effective exhaustive divisor. -/ +def finiteExtensionEffectiveDivisorNatDegree + (D : FiniteExtensionDivisor K L) : ℕ := + ∑ P : ↥D.support, + (D P.1).toNat * finiteExtensionPlaceDegree K L P.1 + +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- A nonzero effective coefficient has positive natural part. -/ +theorem finiteExtensionDivisor_toNat_pos_of_mem_support + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) + (P : ↥D.support) : + 0 < (D P.1).toNat := by + rw [← Int.pos_iff_toNat_pos] + have hne : D P.1 ≠ 0 := Finsupp.mem_support_iff.mp P.2 + exact lt_of_le_of_ne (hD P.1) (Ne.symm hne) + +/-- Each supported local principal-part quotient is finite-dimensional. -/ +theorem finiteExtensionPrincipalPartAt_moduleFinite + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) + (P : ↥D.support) : + Module.Finite K (finiteExtensionPrincipalPartAt K L D P) := by + apply Module.finite_of_finrank_pos + rw [finiteExtensionLocalPoleSpace_cumulative_finrank K L P.1 + (D P.1).toNat] + exact Nat.mul_pos + (finiteExtensionDivisor_toNat_pos_of_mem_support K L D hD P) + (finiteExtensionPlaceDegree_pos K L P.1) + +/-- The supported product of local principal parts is finite-dimensional. -/ +theorem finiteExtensionPrincipalPartsSpace_moduleFinite + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := by + letI (P : ↥D.support) : Module.Finite K + (finiteExtensionPrincipalPartAt K L D P) := + finiteExtensionPrincipalPartAt_moduleFinite K L D hD P + exact Module.Finite.pi + +/-- The supported product has dimension equal to the natural weighted degree +of `D`. -/ +theorem finiteExtensionPrincipalPartsSpace_finrank + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + Module.finrank K (finiteExtensionPrincipalPartsSpace K L D) = + finiteExtensionEffectiveDivisorNatDegree K L D := by + letI (P : ↥D.support) : Module.Finite K + (finiteExtensionPrincipalPartAt K L D P) := + finiteExtensionPrincipalPartAt_moduleFinite K L D hD P + letI (P : ↥D.support) : Module.Free K + (finiteExtensionPrincipalPartAt K L D P) := + Module.Free.of_divisionRing K (finiteExtensionPrincipalPartAt K L D P) + rw [Module.finrank_pi_fintype] + apply Finset.sum_congr rfl + intro P _ + exact finiteExtensionLocalPoleSpace_cumulative_finrank K L P.1 + (D P.1).toNat + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- For an effective divisor, the natural weighted degree casts to the usual +integer-valued divisor degree. -/ +theorem finiteExtensionEffectiveDivisorNatDegree_cast + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + (finiteExtensionEffectiveDivisorNatDegree K L D : ℤ) = + finiteExtensionDivisorDegree K L D := by + rw [finiteExtensionEffectiveDivisorNatDegree, finiteExtensionDivisorDegree, + Finsupp.sum] + push_cast + calc + (∑ P : ↥D.support, + ((D P.1).toNat : ℤ) * + (finiteExtensionPlaceDegree K L P.1 : ℤ)) = + ∑ P ∈ D.support, + ((D P).toNat : ℤ) * + (finiteExtensionPlaceDegree K L P : ℤ) := + Finset.sum_coe_sort D.support (fun P => + ((D P).toNat : ℤ) * + (finiteExtensionPlaceDegree K L P : ℤ)) + _ = ∑ P ∈ D.support, + D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + apply Finset.sum_congr rfl + intro P _ + rw [Int.toNat_of_nonneg (hD P)] + +/-- Membership in `L(D)` supplies the local pole bound at every place. -/ +theorem finiteExtensionRiemannSpace_le_localPoleSpace + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) + (P : FiniteExtensionPlace K L) : + finiteExtensionRiemannSpace K L D ≤ + finiteExtensionLocalPoleSpace K L P (D P).toNat := by + intro x hx + rw [mem_finiteExtensionRiemannSpace] at hx + rw [mem_finiteExtensionLocalPoleSpace_iff] + rcases hx with rfl | ⟨hx0, hx⟩ + · exact Or.inl rfl + · refine Or.inr ⟨hx0, ?_⟩ + have hcoeff : ((D P).toNat : ℤ) = D P := + Int.toNat_of_nonneg (hD P) + have hP := hx P + omega + +/-- The diagonal principal-parts map from `L(D)`. -/ +def finiteExtensionRiemannPrincipalPartsDiagonalMap + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + finiteExtensionRiemannSpace K L D →ₗ[K] + finiteExtensionPrincipalPartsSpace K L D := + LinearMap.pi fun P => + (relativeSubmodule + (finiteExtensionLocalPoleSpace K L P.1 0) + (finiteExtensionLocalPoleSpace K L P.1 (D P.1).toNat)).mkQ.comp + (Submodule.inclusion + (finiteExtensionRiemannSpace_le_localPoleSpace K L D hD P.1)) + +/-- The kernel of the diagonal map is the copy of `L(0)` inside `L(D)`. -/ +theorem finiteExtensionRiemannPrincipalPartsDiagonalMap_ker + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + LinearMap.ker + (finiteExtensionRiemannPrincipalPartsDiagonalMap K L D hD) = + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D) := by + ext x + rw [LinearMap.mem_ker, Submodule.mem_comap] + constructor + · intro hxker + rw [mem_finiteExtensionRiemannSpace] + have hxD := x.2 + rw [mem_finiteExtensionRiemannSpace] at hxD + rcases hxD with hx0 | ⟨hx0, hxorders⟩ + · exact Or.inl hx0 + · refine Or.inr ⟨hx0, ?_⟩ + intro P + by_cases hP : P ∈ D.support + · let P' : ↥D.support := ⟨P, hP⟩ + have hcomponent := congrFun hxker P' + change Submodule.Quotient.mk + (Submodule.inclusion + (finiteExtensionRiemannSpace_le_localPoleSpace + K L D hD P) x) = 0 at hcomponent + rw [Submodule.Quotient.mk_eq_zero] at hcomponent + change (x : L) ∈ + finiteExtensionLocalPoleSpace K L P 0 at hcomponent + rw [mem_finiteExtensionLocalPoleSpace_iff] at hcomponent + rcases hcomponent with hzero | ⟨_, horder⟩ + · exact (hx0 hzero).elim + · simpa using horder + · have hDP : D P = 0 := by + simpa [Finsupp.mem_support_iff] using hP + have horder := hxorders P + rw [hDP] at horder + simpa using horder + · intro hxzero + funext P + change Submodule.Quotient.mk + (Submodule.inclusion + (finiteExtensionRiemannSpace_le_localPoleSpace + K L D hD P.1) x) = 0 + rw [Submodule.Quotient.mk_eq_zero] + change (x : L) ∈ + finiteExtensionLocalPoleSpace K L P.1 0 + rw [mem_finiteExtensionRiemannSpace] at hxzero + rw [mem_finiteExtensionLocalPoleSpace_iff] + rcases hxzero with hxzero | ⟨hx0, hxorders⟩ + · exact Or.inl hxzero + · exact Or.inr ⟨hx0, by simpa using hxorders P.1⟩ + +/-- The diagonal map descends injectively from `L(D) / L(0)`. -/ +def finiteExtensionRiemannPrincipalPartsQuotientMap + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + (finiteExtensionRiemannSpace K L D ⧸ + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) →ₗ[K] + finiteExtensionPrincipalPartsSpace K L D := by + letI localPrincipalPartModule (P : ↥D.support) : Module K + (finiteExtensionPrincipalPartAt K L D P) := inferInstance + letI finitePrincipalPartsModule : Module K + (finiteExtensionPrincipalPartsSpace K L D) := + Pi.module ↥D.support + (fun P => finiteExtensionPrincipalPartAt K L D P) K + let f : finiteExtensionRiemannSpace K L D →ₗ[K] + finiteExtensionPrincipalPartsSpace K L D := + finiteExtensionRiemannPrincipalPartsDiagonalMap K L D hD + have hfker : f.ker = + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D) := by + simpa [f] using + finiteExtensionRiemannPrincipalPartsDiagonalMap_ker K L D hD + exact quotientLinearMapOfKerEq + (K := K) (V := finiteExtensionRiemannSpace K L D) + (W := finiteExtensionPrincipalPartsSpace K L D) f + (relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) + hfker + +/-- The descended principal-parts map is injective. -/ +theorem finiteExtensionRiemannPrincipalPartsQuotientMap_injective + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + Function.Injective + (finiteExtensionRiemannPrincipalPartsQuotientMap K L D hD) := by + letI localPrincipalPartModule (P : ↥D.support) : Module K + (finiteExtensionPrincipalPartAt K L D P) := inferInstance + letI finitePrincipalPartsModule : Module K + (finiteExtensionPrincipalPartsSpace K L D) := + Pi.module ↥D.support + (fun P => finiteExtensionPrincipalPartAt K L D P) K + let f : finiteExtensionRiemannSpace K L D →ₗ[K] + finiteExtensionPrincipalPartsSpace K L D := + finiteExtensionRiemannPrincipalPartsDiagonalMap K L D hD + have hfker : f.ker = + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D) := by + simpa [f] using + finiteExtensionRiemannPrincipalPartsDiagonalMap_ker K L D hD + exact quotientLinearMapOfKerEq_injective + (K := K) (V := finiteExtensionRiemannSpace K L D) + (W := finiteExtensionPrincipalPartsSpace K L D) f + (relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) + hfker + +/-- For an effective divisor, `L(D) / L(0)` is finite-dimensional. -/ +theorem finiteExtensionRiemannSpace_quotient_zero_moduleFinite + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + Module.Finite K + (finiteExtensionRiemannSpace K L D ⧸ + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) := by + letI localPrincipalPartModule (P : ↥D.support) : Module K + (finiteExtensionPrincipalPartAt K L D P) := inferInstance + letI finitePrincipalPartsModule : Module K + (finiteExtensionPrincipalPartsSpace K L D) := + Pi.module ↥D.support + (fun P => finiteExtensionPrincipalPartAt K L D P) K + letI (P : ↥D.support) : Module.Finite K + (finiteExtensionPrincipalPartAt K L D P) := + finiteExtensionPrincipalPartAt_moduleFinite K L D hD P + letI : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := + Module.Finite.pi + let f : finiteExtensionRiemannSpace K L D →ₗ[K] + finiteExtensionPrincipalPartsSpace K L D := + finiteExtensionRiemannPrincipalPartsDiagonalMap K L D hD + have hfker : f.ker = + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D) := by + simpa [f] using + finiteExtensionRiemannPrincipalPartsDiagonalMap_ker K L D hD + let q := quotientLinearMapOfKerEq + (K := K) (V := finiteExtensionRiemannSpace K L D) + (W := finiteExtensionPrincipalPartsSpace K L D) f + (relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) + hfker + have hq : Function.Injective q := + quotientLinearMapOfKerEq_injective + (K := K) (V := finiteExtensionRiemannSpace K L D) + (W := finiteExtensionPrincipalPartsSpace K L D) f + (relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) + hfker + exact Module.Finite.of_injective q hq + +/-- Riemann's elementary principal-parts upper bound for an effective +exhaustive divisor. -/ +theorem finiteExtensionRiemannSpace_quotient_zero_finrank_le + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + Module.finrank K + (finiteExtensionRiemannSpace K L D ⧸ + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) ≤ + finiteExtensionEffectiveDivisorNatDegree K L D := by + letI localPrincipalPartModule (P : ↥D.support) : Module K + (finiteExtensionPrincipalPartAt K L D P) := inferInstance + letI finitePrincipalPartsModule : Module K + (finiteExtensionPrincipalPartsSpace K L D) := + Pi.module ↥D.support + (fun P => finiteExtensionPrincipalPartAt K L D P) K + letI (P : ↥D.support) : Module.Finite K + (finiteExtensionPrincipalPartAt K L D P) := + finiteExtensionPrincipalPartAt_moduleFinite K L D hD P + letI : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := + Module.Finite.pi + let f : finiteExtensionRiemannSpace K L D →ₗ[K] + finiteExtensionPrincipalPartsSpace K L D := + finiteExtensionRiemannPrincipalPartsDiagonalMap K L D hD + have hfker : f.ker = + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D) := by + simpa [f] using + finiteExtensionRiemannPrincipalPartsDiagonalMap_ker K L D hD + let q := quotientLinearMapOfKerEq + (K := K) (V := finiteExtensionRiemannSpace K L D) + (W := finiteExtensionPrincipalPartsSpace K L D) f + (relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) + hfker + have hq : Function.Injective q := + quotientLinearMapOfKerEq_injective + (K := K) (V := finiteExtensionRiemannSpace K L D) + (W := finiteExtensionPrincipalPartsSpace K L D) f + (relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) + hfker + calc + Module.finrank K + (finiteExtensionRiemannSpace K L D ⧸ + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) ≤ + Module.finrank K (finiteExtensionPrincipalPartsSpace K L D) := + q.finrank_le_finrank_of_injective hq + _ = finiteExtensionEffectiveDivisorNatDegree K L D := + finiteExtensionPrincipalPartsSpace_finrank K L D hD + +/-- Integer-valued form of the principal-parts upper bound. -/ +theorem finiteExtensionRiemannSpace_quotient_zero_finrank_cast_le_degree + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : + (Module.finrank K + (finiteExtensionRiemannSpace K L D ⧸ + relativeSubmodule + (finiteExtensionRiemannSpace K L 0) + (finiteExtensionRiemannSpace K L D)) : ℤ) ≤ + finiteExtensionDivisorDegree K L D := by + rw [← finiteExtensionEffectiveDivisorNatDegree_cast K L D hD] + exact_mod_cast finiteExtensionRiemannSpace_quotient_zero_finrank_le + K L D hD + +/-- With exact constants, the preceding quotient is literally `L(D)` modulo +the constant functions. -/ +theorem finiteExtensionRiemannSpace_mod_constants_finrank_cast_le_degree + (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) + (hconstants : algebraicClosure K L = ⊥) : + (Module.finrank K + (finiteExtensionRiemannSpace K L D ⧸ + relativeSubmodule + (LinearMap.range (Algebra.linearMap K L)) + (finiteExtensionRiemannSpace K L D)) : ℤ) ≤ + finiteExtensionDivisorDegree K L D := by + rw [← finiteExtensionRiemannSpace_zero_eq_range K L hconstants] + exact finiteExtensionRiemannSpace_quotient_zero_finrank_cast_le_degree + K L D hD + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean new file mode 100644 index 0000000000..bb40448105 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +import Mathlib.Order.OrderIsoNat +import Mathlib.Tactic + +/-! +# Eventual exact growth of one-point Riemann spaces + +A coarse Riemann lower bound and the one-place principal-parts upper bound +already force eventual exact linear growth. For a place `P`, define the +surplus + +`dim L(nP) + g - (n deg(P) + 1)`. + +The lower bound makes this a natural number without truncation, while the +one-place increment bound makes it antitone. Since a decreasing sequence of +natural numbers is eventually constant, `dim L((n+1)P) - dim L(nP)` is +eventually exactly `deg(P)`. + +This is the elementary stabilization input used in the divisor-class proof +of zeta rationality; it does not assume Riemann--Roch or a zeta theorem. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The bounded nonnegative error in a one-point Riemann lower bound. -/ +def finiteExtensionOnePointRiemannSurplus + (P : FiniteExtensionPlace K L) (g n : ℕ) : ℕ := + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P n) + g - + (n * finiteExtensionPlaceDegree K L P + 1) + +/-- The Riemann surplus is antitone: adding one copy of the pole place raises +dimension by at most the degree of that place. -/ +theorem finiteExtensionOnePointRiemannSurplus_antitone_of_lower + (P : FiniteExtensionPlace K L) (g : ℕ) + (hLower : ∀ n : ℕ, + n * finiteExtensionPlaceDegree K L P + 1 ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) + g) : + Antitone (finiteExtensionOnePointRiemannSurplus K L P g) := by + apply antitone_nat_of_succ_le + intro n + let D : FiniteExtensionDivisor K L := Finsupp.single P (n : ℤ) + have hD : ∀ v, 0 ≤ D v := by + intro v + by_cases hv : v = P + · subst v + simp [D] + · simp [D, Finsupp.single_eq_of_ne hv] + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + have hinc := finiteExtensionRiemannSpace_place_increment K L D hD P + have hdivisor : D + Finsupp.single P 1 = + Finsupp.single P ((n + 1 : ℕ) : ℤ) := by + ext v + by_cases hv : v = P + · subst v + simp [D] + · simp [D, Finsupp.single_eq_of_ne hv] + have hfinrank : + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (n + 1)) ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) + + finiteExtensionPlaceDegree K L P := by + change Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single P (((n + 1 : ℕ) : ℤ)))) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single P (n : ℤ))) + finiteExtensionPlaceDegree K L P + rw [← hdivisor] + simpa only [D] using hinc.2 + have hn := hLower n + have hsucc := hLower (n + 1) + simp only [finiteExtensionOnePointRiemannSurplus, Nat.succ_mul] at hsucc ⊢ + omega + +/-- Any one-point Riemann lower bound implies that the dimension increment is +eventually exactly the place degree. -/ +theorem finiteExtensionOnePointRiemannSpace_eventually_exact_increment + (P : FiniteExtensionPlace K L) (g : ℕ) + (hLower : ∀ n : ℕ, + n * finiteExtensionPlaceDegree K L P + 1 ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) + g) : + ∃ N : ℕ, ∀ n : ℕ, N ≤ n → + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (n + 1)) = + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) + + finiteExtensionPlaceDegree K L P := by + have hanti := + finiteExtensionOnePointRiemannSurplus_antitone_of_lower + K L P g hLower + obtain ⟨N, hN⟩ := WellFoundedLT.antitone_chain_condition hanti + refine ⟨N, ?_⟩ + intro n hn + have heq : finiteExtensionOnePointRiemannSurplus K L P g n = + finiteExtensionOnePointRiemannSurplus K L P g (n + 1) := + (hN n hn).symm.trans (hN (n + 1) (hn.trans (Nat.le_succ n))) + have hlowN := hLower n + have hlowSucc := hLower (n + 1) + simp only [finiteExtensionOnePointRiemannSurplus, Nat.succ_mul] at heq hlowSucc + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean new file mode 100644 index 0000000000..9f97ceafa3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit + +/-! +# One-point Riemann lower bounds from the intrinsic genus + +Riemann's inequality gives the intrinsic function-field genus itself as a +simultaneous budget for every one-point Riemann space. This applies to the +exhaustive BGS place type, including both finite and infinity places. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance genusRiemannConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance genusRiemannConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) genusRiemannPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance genusRiemannPolynomialRatFuncTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance genusRiemannConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Riemann's inequality gives the intrinsic genus as a simultaneous budget +for every one-point Riemann space in the exhaustive finite/infinity place +model. -/ +theorem finiteExtension_onePoint_riemann_lower_of_genus + [FunctionField.IsFullConstantField K L] + (P : FiniteExtensionPlace K L) (N : Nat) : + N * finiteExtensionPlaceDegree K L P + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P N) + + FunctionField.genus K L := by + let D : FiniteExtensionDivisor K L := Finsupp.single P (N : Int) + let Dchart := finiteExtensionDivisorEquivChart K L D + have hRR := FunctionField.Chart.riemann_ineq K L Dchart + have hdegree : FunctionField.Chart.deg K L Dchart = + (N * finiteExtensionPlaceDegree K L P : Nat) := by + rw [← finiteExtensionDivisorDegree_eq_chart K L D] + dsimp only [D] + rw [finiteExtensionDivisorDegree_single] + norm_num + have hspace : FunctionField.Chart.RRspace K L Dchart = + finiteExtensionOnePointRiemannSpace K L P N := by + rw [← finiteExtensionRiemannSpace_eq_chart K L D] + rfl + rw [FunctionField.Chart.ell, hspace, hdegree, + ← FunctionField.genus_eq_genusChart K L] at hRR + change ((Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P N) : Nat) : Int) ≥ + ((N * finiteExtensionPlaceDegree K L P : Nat) : Int) + 1 - + (FunctionField.genus K L : Int) at hRR + exact_mod_cast (show N * finiteExtensionPlaceDegree K L P + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P N) + + FunctionField.genus K L by omega) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean new file mode 100644 index 0000000000..7c1c93de9e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean @@ -0,0 +1,621 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch + +/-! +# Riemann--Roch for the exhaustive finite-extension place model + +This file identifies the exhaustive finite and infinite places used by the BGS +function-field development with the two-chart place model of the vendored +Riemann--Roch library. The identification transports residue degrees, +divisors, divisor degree, normalized valuations, and Riemann spaces. It then +applies the axiom-clean Riemann--Roch theorem to discharge the eventual uniform +Riemann formula required by the divisor-class recurrence. + +The only non-definitional chart issue is at infinity: the two developments +construct the same valuation subring using different `DecidableEq` instances. +We therefore record the identity-on-elements ring equivalence explicitly and +transport the integral closure and its height-one primes across it. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain Multiplicative WithZero +open scoped Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance riemannRochConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance riemannRochConstantRatFuncTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) riemannRochPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance riemannRochPolynomialRatFuncTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance riemannRochConstantPolynomialTower : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance riemannRochInfinityBaseConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance riemannRochInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance riemannRochInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance riemannRochInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance riemannRochInfinityClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance riemannRochInfinityClosureIsDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance riemannRochInfinityClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance riemannRochInfinityClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance riemannRochInfinityClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The BGS and Riemann--Roch infinity valuation subrings are the same +subring of `RatFunc K`; this equivalence makes the harmless instance-level +difference explicit. -/ +def finiteExtensionInfinityBaseRingEquiv : + RatFuncInfinityIntegers K ≃+* + FunctionField.Chart.inftyValuationSubring K where + toFun x := ⟨x.1, by + have hx := x.2 + unfold RatFuncInfinityIntegers at hx + rw [Valuation.mem_integer_iff] at hx + rw [Valuation.mem_valuationSubring_iff] + have hdec : (inferInstance : DecidableEq (RatFunc K)) = + Classical.decEq (RatFunc K) := Subsingleton.elim _ _ + cases hdec + exact hx⟩ + invFun x := ⟨x.1, by + have hx := x.2 + unfold FunctionField.Chart.inftyValuationSubring at hx + rw [Valuation.mem_valuationSubring_iff] at hx + unfold RatFuncInfinityIntegers + rw [Valuation.mem_integer_iff] + have hdec : (inferInstance : DecidableEq (RatFunc K)) = + Classical.decEq (RatFunc K) := Subsingleton.elim _ _ + cases hdec + exact hx⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl + +@[simp] +theorem finiteExtensionInfinityBaseRingEquiv_apply_coe + (x : RatFuncInfinityIntegers K) : + ((finiteExtensionInfinityBaseRingEquiv K x : + FunctionField.Chart.inftyValuationSubring K) : RatFunc K) = x := + rfl + +private theorem isIntegral_infinityBase_iff (x : L) : + IsIntegral (RatFuncInfinityIntegers K) x ↔ + IsIntegral (FunctionField.Chart.inftyValuationSubring K) x := by + let e := finiteExtensionInfinityBaseRingEquiv K + have hforward : + (algebraMap (FunctionField.Chart.inftyValuationSubring K) L).comp + e.toRingHom = + algebraMap (RatFuncInfinityIntegers K) L := by + ext a + rfl + have hbackward : + (algebraMap (RatFuncInfinityIntegers K) L).comp + e.symm.toRingHom = + algebraMap (FunctionField.Chart.inftyValuationSubring K) L := by + ext a + rfl + constructor + · intro hx + have hx' : + ((algebraMap (FunctionField.Chart.inftyValuationSubring K) L).comp + e.toRingHom).IsIntegralElem x := by + rw [hforward] + exact hx + exact hx'.of_comp + · intro hx + have hx' : + ((algebraMap (RatFuncInfinityIntegers K) L).comp + e.symm.toRingHom).IsIntegralElem x := by + rw [hbackward] + exact hx + exact hx'.of_comp + +/-- Identity-on-`L` equivalence between the two infinity integral closures. -/ +def finiteExtensionInfinityIntegralClosureRingEquiv : + RatFuncInfinityIntegralClosure K L ≃+* + FunctionField.Chart.infiniteIntegers K L where + toFun x := ⟨x.1, (isIntegral_infinityBase_iff K L x.1).mp x.2⟩ + invFun x := ⟨x.1, (isIntegral_infinityBase_iff K L x.1).mpr x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_mul' _ _ := rfl + map_add' _ _ := rfl + +@[simp] +theorem finiteExtensionInfinityIntegralClosureRingEquiv_apply_coe + (x : RatFuncInfinityIntegralClosure K L) : + ((finiteExtensionInfinityIntegralClosureRingEquiv K L x : + FunctionField.Chart.infiniteIntegers K L) : L) = x := + rfl + +/-- Constant-field-linear form of the infinity integral-closure equivalence. -/ +def finiteExtensionInfinityIntegralClosureAlgEquiv : + RatFuncInfinityIntegralClosure K L ≃ₐ[K] + FunctionField.Chart.infiniteIntegers K L where + __ := finiteExtensionInfinityIntegralClosureRingEquiv K L + commutes' c := by + apply Subtype.ext + rfl + +/-- Places above the BGS infinity place are exactly the height-one primes of +the BGS infinity integral closure. -/ +def finiteExtensionInfinityPrimesOverEquivHeightOne : + FiniteExtensionInfinityPlace K L ≃ + HeightOneSpectrum (RatFuncInfinityIntegralClosure K L) where + toFun P := primeOverHeightOne (ratFuncInfinityPlace K) P + invFun q := ⟨q.asIdeal, q.isPrime, ⟨by + let A := RatFuncInfinityIntegers K + letI : q.asIdeal.IsMaximal := q.isPrime.isMaximal q.ne_bot + have hq : q.asIdeal.under A = IsLocalRing.maximalIdeal A := + IsLocalRing.eq_maximalIdeal (Ideal.IsMaximal.under A q.asIdeal) + have hp : (ratFuncInfinityPlace K).asIdeal = + IsLocalRing.maximalIdeal A := + IsLocalRing.eq_maximalIdeal + ((ratFuncInfinityPlace K).isPrime.isMaximal + (ratFuncInfinityPlace K).ne_bot) + exact (hq.trans hp.symm).symm⟩⟩ + left_inv P := by + apply Subtype.ext + rfl + right_inv q := by + apply HeightOneSpectrum.ext + rfl + +/-- Infinity places in the exhaustive BGS model and in the Riemann--Roch chart. -/ +def finiteExtensionInfinityPlaceEquivChart : + FiniteExtensionInfinityPlace K L ≃ + HeightOneSpectrum (FunctionField.Chart.infiniteIntegers K L) := + (finiteExtensionInfinityPrimesOverEquivHeightOne K L).trans + (HeightOneSpectrum.equivOfRingEquiv + (finiteExtensionInfinityIntegralClosureRingEquiv K L)) + +/-- Equivalence from the exhaustive BGS place type to the Riemann--Roch +two-chart place type. -/ +def finiteExtensionPlaceEquivChart : + FiniteExtensionPlace K L ≃ FunctionField.Chart.PlaceA K L := + Equiv.sumCongr (Equiv.refl _) + (finiteExtensionInfinityPlaceEquivChart K L) + +noncomputable def finiteExtensionFiniteQuotientResidueAlgEquiv + (q : FiniteExtensionFinitePlace K L) : + (RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal) ≃ₐ[K] + q.asIdeal.ResidueField := by + letI : q.asIdeal.IsMaximal := q.isPrime.isMaximal q.ne_bot + exact AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K + (RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal) + q.asIdeal.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField q.asIdeal) + +noncomputable def finiteExtensionInfinityQuotientResidueAlgEquiv + (q : HeightOneSpectrum (FunctionField.Chart.infiniteIntegers K L)) : + (FunctionField.Chart.infiniteIntegers K L ⧸ q.asIdeal) ≃ₐ[K] + q.asIdeal.ResidueField := by + letI : q.asIdeal.IsMaximal := q.isPrime.isMaximal q.ne_bot + exact AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K + (FunctionField.Chart.infiniteIntegers K L ⧸ q.asIdeal) + q.asIdeal.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField q.asIdeal) + +noncomputable def finiteExtensionInfinityResidueAlgEquiv + (P : FiniteExtensionInfinityPlace K L) : + P.1.ResidueField ≃ₐ[K] + (finiteExtensionInfinityPlaceEquivChart K L P).asIdeal.ResidueField := by + let e := finiteExtensionInfinityIntegralClosureAlgEquiv K L + apply Ideal.residueFieldAlgEquiv P.1 + (finiteExtensionInfinityPlaceEquivChart K L P).asIdeal e + change P.1 = (P.1.comap e.symm).comap e + exact (Ideal.comap_of_equiv e.toRingEquiv).symm + +/-- The exhaustive place degree agrees with the Riemann--Roch chart degree. -/ +theorem finiteExtensionPlaceDegree_eq_chart + (v : FiniteExtensionPlace K L) : + finiteExtensionPlaceDegree K L v = + FunctionField.Chart.placeDegree K L + (finiteExtensionPlaceEquivChart K L v) := by + rcases v with q | P + · rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q] + change Module.finrank K q.asIdeal.ResidueField = + Module.finrank K (RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal) + exact (finiteExtensionFiniteQuotientResidueAlgEquiv K L q).toLinearEquiv.finrank_eq.symm + · rw [finiteExtensionInfinityPlace_degree_eq_finrank_residueField K L P] + let q := finiteExtensionInfinityPlaceEquivChart K L P + change Module.finrank K P.1.ResidueField = + Module.finrank K (FunctionField.Chart.infiniteIntegers K L ⧸ q.asIdeal) + exact (finiteExtensionInfinityResidueAlgEquiv K L P).toLinearEquiv.finrank_eq.trans + (finiteExtensionInfinityQuotientResidueAlgEquiv K L q).toLinearEquiv.finrank_eq.symm + +private theorem heightOneValuation_le_one_of_ringEquiv_of_asIdeal + {R S F : Type*} [CommRing R] [CommRing S] [Field F] + [Algebra R F] [Algebra S F] [IsFractionRing R F] [IsFractionRing S F] + [IsDedekindDomain R] [IsDedekindDomain S] + (e : R ≃+* S) + (halg : ∀ r : R, algebraMap S F (e r) = algebraMap R F r) + (q : HeightOneSpectrum R) (q' : HeightOneSpectrum S) + (hideal : q'.asIdeal = q.asIdeal.comap e.symm) + (x : F) (hx : q.valuation F x ≤ 1) : q'.valuation F x ≤ 1 := by + obtain ⟨n, d, hnd⟩ := q.exists_primeCompl_mul_eq_of_integer x hx + have hd' : e d.1 ∉ q'.asIdeal := by + intro hmem + have hd : (d.1 : R) ∉ q.asIdeal := d.2 + apply hd + rw [hideal] at hmem + change e.symm (e d.1) ∈ q.asIdeal at hmem + simpa using hmem + have hnd' : + x * algebraMap S F (e d.1) = algebraMap S F (e n) := by + simpa only [halg] using hnd + have hval := congrArg (q'.valuation F) hnd' + rw [map_mul, q'.valuation_eq_one_iff_notMem (K := F).2 hd'] at hval + simp only [mul_one] at hval + rw [hval] + exact q'.valuation_le_one (K := F) (e n) + +private theorem heightOneValuation_isEquiv_of_ringEquiv_of_asIdeal + {R S F : Type*} [CommRing R] [CommRing S] [Field F] + [Algebra R F] [Algebra S F] [IsFractionRing R F] [IsFractionRing S F] + [IsDedekindDomain R] [IsDedekindDomain S] + (e : R ≃+* S) + (halg : ∀ r : R, algebraMap S F (e r) = algebraMap R F r) + (q : HeightOneSpectrum R) (q' : HeightOneSpectrum S) + (hideal : q'.asIdeal = q.asIdeal.comap e.symm) : + (q.valuation F).IsEquiv (q'.valuation F) := by + apply Valuation.isEquiv_of_val_le_one + intro x + constructor + · exact heightOneValuation_le_one_of_ringEquiv_of_asIdeal + e halg q q' hideal x + · intro hx + have halg' : ∀ s : S, + algebraMap R F (e.symm s) = algebraMap S F s := by + intro s + rw [← halg (e.symm s), e.apply_symm_apply] + have hideal' : q.asIdeal = q'.asIdeal.comap e := by + ext r + rw [Ideal.mem_comap, hideal, Ideal.mem_comap] + simp + exact heightOneValuation_le_one_of_ringEquiv_of_asIdeal + e.symm halg' q' q hideal' x hx + +private theorem valuation_eq_of_isEquiv_of_surjective + {F : Type*} [Field F] (v w : Valuation F ℤᵐ⁰) + (hvw : v.IsEquiv w) (hv : Function.Surjective v) + (hw : Function.Surjective w) : v = w := by + obtain ⟨π, hvπ⟩ := hv (WithZero.exp (-1 : ℤ)) + have hπ : π ≠ 0 := by + apply (Valuation.ne_zero_iff v).mp + rw [hvπ] + exact WithZero.exp_ne_zero + have hwπ0 : w π ≠ 0 := + (hvw.eq_zero.ne).mp ((Valuation.ne_zero_iff v).2 hπ) + let m : ℤ := -WithZero.log (w π) + have hmpos : 0 < m := by + have hvπlt : v π < 1 := by + rw [hvπ, ← WithZero.exp_zero, WithZero.exp_lt_exp] + omega + have hwπlt : w π < 1 := hvw.lt_one_iff_lt_one.mp hvπlt + have hlog : WithZero.log (w π) < 0 := by + rw [← WithZero.log_one] + exact (WithZero.log_lt_log hwπ0 one_ne_zero).2 hwπlt + dsimp only [m] + omega + have hformula (x : F) (hx : x ≠ 0) : + w x = WithZero.exp (m * WithZero.log (v x)) := by + have hvx0 : v x ≠ 0 := (Valuation.ne_zero_iff v).2 hx + let n : ℤ := WithZero.log (v x) + have hvpow : v (π ^ (-n)) = v x := by + rw [map_zpow₀, hvπ, ← WithZero.exp_zsmul] + rw [← WithZero.exp_log hvx0] + congr 1 + dsimp only [n] + simp + have hwpow : w (π ^ (-n)) = w x := hvw.eq_iff.mp hvpow + calc + w x = w (π ^ (-n)) := hwpow.symm + _ = (w π) ^ (-n) := by rw [map_zpow₀] + _ = WithZero.exp ((-n) • WithZero.log (w π)) := by + rw [WithZero.exp_zsmul, WithZero.exp_log hwπ0] + _ = WithZero.exp (m * WithZero.log (v x)) := by + congr 1 + dsimp only [m, n] + ring + obtain ⟨y, hwy⟩ := hw (WithZero.exp (1 : ℤ)) + have hy : y ≠ 0 := by + apply (Valuation.ne_zero_iff w).mp + rw [hwy] + exact WithZero.exp_ne_zero + have hm : m * WithZero.log (v y) = 1 := by + apply WithZero.exp_injective + rw [← hformula y hy, hwy] + have hm1 : m = 1 := by + rcases Int.mul_eq_one_iff_eq_one_or_neg_one.mp hm with h | h + · exact h.1 + · omega + ext x + by_cases hx : x = 0 + · subst x + simp + · rw [hformula x hx, hm1, one_mul, + WithZero.exp_log ((Valuation.ne_zero_iff v).2 hx)] + +/-- The normalized infinity valuation is unchanged by the identity-on-`L` +integral-closure transport. -/ +theorem finiteExtensionInfinityPlaceValuation_eq_chart + (P : FiniteExtensionInfinityPlace K L) : + (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L = + (finiteExtensionInfinityPlaceEquivChart K L P).valuation L := by + let q := primeOverHeightOne + (R := RatFuncInfinityIntegers K) + (S := RatFuncInfinityIntegralClosure K L) + (ratFuncInfinityPlace K) P + let e := finiteExtensionInfinityIntegralClosureRingEquiv K L + let q' := finiteExtensionInfinityPlaceEquivChart K L P + have hideal : q'.asIdeal = q.asIdeal.comap e.symm := by + rfl + have hequiv : (q.valuation L).IsEquiv (q'.valuation L) := + heightOneValuation_isEquiv_of_ringEquiv_of_asIdeal + e (fun _ => rfl) q q' hideal + change q.valuation L = q'.valuation L + exact valuation_eq_of_isEquiv_of_surjective + (q.valuation L) (q'.valuation L) hequiv + (show Function.Surjective (q.valuation L) from + HeightOneSpectrum.valuation_surjective (K := L) q) + (show Function.Surjective (q'.valuation L) from + HeightOneSpectrum.valuation_surjective (K := L) q') + +/-- The normalized valuation attached to an exhaustive BGS place. -/ +def finiteExtensionPlaceValuation : + FiniteExtensionPlace K L → Valuation L ℤᵐ⁰ + | .inl q => q.valuation L + | .inr P => + (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L + +/-- Every exhaustive BGS place carries exactly the normalized valuation of +its corresponding Riemann--Roch chart place. -/ +theorem finiteExtensionPlaceValuation_eq_chart + (v : FiniteExtensionPlace K L) : + finiteExtensionPlaceValuation K L v = + FunctionField.Chart.placeValuation K L + (finiteExtensionPlaceEquivChart K L v) := by + rcases v with q | P + · rfl + · exact finiteExtensionInfinityPlaceValuation_eq_chart K L P + +/-- Transport of exhaustive divisors to the two-chart Riemann--Roch model. -/ +def finiteExtensionDivisorEquivChart : + FiniteExtensionDivisor K L ≃+ + FunctionField.Chart.DivisorA K L := + Finsupp.domCongr (finiteExtensionPlaceEquivChart K L) + +/-- Divisor degree is preserved by the exhaustive-place/chart equivalence. -/ +theorem finiteExtensionDivisorDegree_eq_chart + (D : FiniteExtensionDivisor K L) : + finiteExtensionDivisorDegree K L D = + FunctionField.Chart.deg K L + (finiteExtensionDivisorEquivChart K L D) := by + classical + induction D using Finsupp.induction with + | zero => + simp [finiteExtensionDivisorDegree, FunctionField.Chart.deg, + finiteExtensionDivisorEquivChart] + | single_add v n D hv hn ih => + rw [map_add, finiteExtensionDivisorDegree_add, + FunctionField.Chart.deg_add, ih] + congr 1 + simp [finiteExtensionDivisorDegree, FunctionField.Chart.deg, + finiteExtensionDivisorEquivChart, Finsupp.domCongr_apply, + Finsupp.equivMapDomain_single, + finiteExtensionPlaceDegree_eq_chart] + +/-- The valuation of a nonzero function is the exponential of the negative +coefficient of its exhaustive principal divisor. -/ +theorem finiteExtensionPlaceValuation_eq_exp_neg_principalDivisor + (x : L) (hx : x ≠ 0) (v : FiniteExtensionPlace K L) : + finiteExtensionPlaceValuation K L v x = + WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) := by + rcases v with q | P + · change q.valuation L x = _ + rw [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder, + valuation_eq_exp_neg_finitePlaceOrder q x hx] + · change (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L x = _ + rw [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder, + valuation_eq_exp_neg_finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) x hx] + +/-- The BGS all-place Riemann space is the Riemann--Roch chart space after +transporting its divisor. -/ +theorem finiteExtensionRiemannSpace_eq_chart + (D : FiniteExtensionDivisor K L) : + finiteExtensionRiemannSpace K L D = + FunctionField.Chart.RRspace K L + (finiteExtensionDivisorEquivChart K L D) := by + classical + ext x + rw [mem_finiteExtensionRiemannSpace, + FunctionField.Chart.mem_RRspace_iff] + constructor + · rintro (rfl | ⟨hx, horders⟩) + · intro w + rw [Valuation.map_zero] + exact zero_le + · intro w + let v := (finiteExtensionPlaceEquivChart K L).symm w + have horder := horders v + have hInt : + -(finiteExtensionPrincipalDivisor K L x v) ≤ D v := by + omega + have hExp : + WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) ≤ + WithZero.exp (D v) := + WithZero.exp_le_exp.mpr hInt + have hprincipal : finiteExtensionPlaceValuation K L v x = + WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) := + finiteExtensionPlaceValuation_eq_exp_neg_principalDivisor + K L x hx v + have hplace : finiteExtensionPlaceValuation K L v x = + FunctionField.Chart.placeValuation K L + (finiteExtensionPlaceEquivChart K L v) x := by + exact congrArg (fun u : Valuation L ℤᵐ⁰ => u x) + (finiteExtensionPlaceValuation_eq_chart K L v) + have hvw : finiteExtensionPlaceEquivChart K L v = w := + (finiteExtensionPlaceEquivChart K L).apply_symm_apply w + calc + FunctionField.Chart.placeValuation K L w x = + FunctionField.Chart.placeValuation K L + (finiteExtensionPlaceEquivChart K L v) x := by rw [hvw] + _ = finiteExtensionPlaceValuation K L v x := hplace.symm + _ = WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) := + hprincipal + _ ≤ WithZero.exp (D v) := hExp + _ = WithZero.exp ((finiteExtensionDivisorEquivChart K L D) w) := by + simp [finiteExtensionDivisorEquivChart, Finsupp.domCongr_apply, v] + · intro hxchart + by_cases hx : x = 0 + · exact Or.inl hx + · refine Or.inr ⟨hx, ?_⟩ + intro v + have hchart := hxchart (finiteExtensionPlaceEquivChart K L v) + have hprincipal : finiteExtensionPlaceValuation K L v x = + WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) := + finiteExtensionPlaceValuation_eq_exp_neg_principalDivisor + K L x hx v + have hplace : finiteExtensionPlaceValuation K L v x = + FunctionField.Chart.placeValuation K L + (finiteExtensionPlaceEquivChart K L v) x := by + exact congrArg (fun u : Valuation L ℤᵐ⁰ => u x) + (finiteExtensionPlaceValuation_eq_chart K L v) + have hExp : + WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) ≤ + WithZero.exp (D v) := by + calc + WithZero.exp (-(finiteExtensionPrincipalDivisor K L x v)) = + finiteExtensionPlaceValuation K L v x := + hprincipal.symm + _ = FunctionField.Chart.placeValuation K L + (finiteExtensionPlaceEquivChart K L v) x := hplace + _ ≤ WithZero.exp + ((finiteExtensionDivisorEquivChart K L D) + (finiteExtensionPlaceEquivChart K L v)) := hchart + _ = WithZero.exp (D v) := by + simp [finiteExtensionDivisorEquivChart, Finsupp.domCongr_apply] + have hInt := WithZero.exp_le_exp.mp hExp + omega + +/-- Riemann--Roch supplies the uniform eventual formula with genus `g` and +threshold `2g` once the chosen finite constant field is full in `L`. -/ +theorem hasFiniteExtensionUniformEventualRiemannFormula_of_fullConstantField + [FunctionField.IsFullConstantField K L] : + HasFiniteExtensionUniformEventualRiemannFormula K L + (FunctionField.Chart.genus K L) + (2 * FunctionField.Chart.genus K L) := by + refine ⟨by omega, ?_⟩ + intro D n hn hdegree + let Dchart := finiteExtensionDivisorEquivChart K L D + have hspace : finiteExtensionRiemannSpace K L D = + FunctionField.Chart.RRspace K L Dchart := + finiteExtensionRiemannSpace_eq_chart K L D + have hdegreeChart : FunctionField.Chart.deg K L Dchart = (n : ℤ) := by + rw [← finiteExtensionDivisorDegree_eq_chart K L D] + exact hdegree + constructor + · rw [hspace] + exact FunctionField.Chart.finiteDimensional_RRspace K L Dchart + · rw [hspace] + change FunctionField.Chart.ell K L Dchart = + n + 1 - FunctionField.Chart.genus K L + obtain ⟨W, hW⟩ := FunctionField.Chart.exists_isCanonical K L + have hnZ : (2 : ℤ) * (FunctionField.Chart.genus K L : ℤ) ≤ + (n : ℤ) := by + exact_mod_cast hn + have hlarge : FunctionField.Chart.deg K L Dchart ≥ + 2 * (FunctionField.Chart.genus K L : ℤ) - 1 := by + rw [hdegreeChart] + omega + have hRR := FunctionField.Chart.ell_eq_of_deg_ge + K L hW Dchart hlarge + rw [hdegreeChart] at hRR + have hgn : FunctionField.Chart.genus K L ≤ n := by omega + omega + +/-- If the algebraic closure of the finite constant field inside `L` is +exactly the constants, the uniform eventual Riemann formula holds for a +canonical genus and threshold. -/ +theorem exists_hasFiniteExtensionUniformEventualRiemannFormula_of_constants + (hconstants : algebraicClosure K L = ⊥) : + ∃ genus threshold, + HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold := by + letI : FunctionField.IsFullConstantField K L := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 + hconstants + exact ⟨FunctionField.Chart.genus K L, + 2 * FunctionField.Chart.genus K L, + hasFiniteExtensionUniformEventualRiemannFormula_of_fullConstantField K L⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean new file mode 100644 index 0000000000..e7ead233a5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +import Mathlib.Tactic + +/-! +# Eventual growth after an effective divisor shift + +The one-point stabilization theorem is extended here from `L(nP)` to +`L(D + nP)`, where `D` is any effective exhaustive divisor. The hypotheses +retain only the two estimates used in the proof: + +* principal parts bound each one-step dimension increase by `deg(P)`; and +* an arbitrary coarse affine lower bound prevents an unbounded deficit. + +Thus the lower-bound intercept is a parameter rather than a genus formula. +Once the associated natural-number surplus stabilizes, dimensions grow by +exactly `deg(P)` at every subsequent step. Over a finite constant field this +also gives an exact formula for the cardinalities of the shifted Riemann +spaces. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The divisor obtained by adding `n` copies of `P` to `D`. -/ +abbrev finiteExtensionRiemannShiftDivisor + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) + (n : ℕ) : FiniteExtensionDivisor K L := + D + Finsupp.single P (n : ℤ) + +/-- The nonnegative error in an affine lower bound for +`dim L(D + nP)`. -/ +def finiteExtensionShiftedRiemannSurplus + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) + (intercept error n : ℕ) : ℕ := + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + error - + (n * finiteExtensionPlaceDegree K L P + intercept) + +/-- For effective `D`, a coarse affine lower bound makes the shifted +Riemann surplus antitone. -/ +theorem finiteExtensionShiftedRiemannSurplus_antitone_of_lower + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) (intercept error : ℕ) + (hLower : ∀ n : ℕ, + n * finiteExtensionPlaceDegree K L P + intercept ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + error) : + Antitone + (finiteExtensionShiftedRiemannSurplus K L D P intercept error) := by + apply antitone_nat_of_succ_le + intro n + let E : FiniteExtensionDivisor K L := + finiteExtensionRiemannShiftDivisor K L D P n + have hE : ∀ v, 0 ≤ E v := by + intro v + by_cases hv : v = P + · subst v + have hn : (0 : ℤ) ≤ n := by positivity + simpa [E, finiteExtensionRiemannShiftDivisor] using + add_nonneg (hD P) hn + · simpa [E, finiteExtensionRiemannShiftDivisor, + Finsupp.single_eq_of_ne hv] using hD v + letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := + finiteExtensionRiemannSpace_effective_moduleFinite K L E hE + have hinc := finiteExtensionRiemannSpace_place_increment K L E hE P + have hdivisor : E + Finsupp.single P 1 = + finiteExtensionRiemannShiftDivisor K L D P (n + 1) := by + ext v + by_cases hv : v = P + · subst v + simp [E, finiteExtensionRiemannShiftDivisor] + ring + · simp [E, finiteExtensionRiemannShiftDivisor, + Finsupp.single_eq_of_ne hv] + have hfinrank : + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (n + 1))) ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + + finiteExtensionPlaceDegree K L P := by + rw [← hdivisor] + simpa only [E] using hinc.2 + have hn := hLower n + have hsucc := hLower (n + 1) + simp only [finiteExtensionShiftedRiemannSurplus, Nat.succ_mul] at hsucc ⊢ + omega + +/-- A coarse affine lower bound forces the dimensions of `L(D + nP)` to +eventually increase by exactly `deg(P)` at every step. -/ +theorem finiteExtensionRiemannSpace_shift_eventually_exact_increment + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) (intercept error : ℕ) + (hLower : ∀ n : ℕ, + n * finiteExtensionPlaceDegree K L P + intercept ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + error) : + ∃ N : ℕ, ∀ n : ℕ, N ≤ n → + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (n + 1))) = + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + + finiteExtensionPlaceDegree K L P := by + have hanti := + finiteExtensionShiftedRiemannSurplus_antitone_of_lower + K L D hD P intercept error hLower + obtain ⟨N, hN⟩ := WellFoundedLT.antitone_chain_condition hanti + refine ⟨N, ?_⟩ + intro n hn + have heq : + finiteExtensionShiftedRiemannSurplus K L D P intercept error n = + finiteExtensionShiftedRiemannSurplus K L D P intercept error (n + 1) := + (hN n hn).symm.trans (hN (n + 1) (hn.trans (Nat.le_succ n))) + have hlowN := hLower n + have hlowSucc := hLower (n + 1) + simp only [finiteExtensionShiftedRiemannSurplus, Nat.succ_mul] at heq hlowSucc + omega + +/-- Iterating exact successive increments gives the closed dimension formula +from any stabilization index. -/ +theorem finiteExtensionRiemannSpace_shift_closedFormula_of_exact_increment + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) + (N : ℕ) + (hIncrement : ∀ n : ℕ, N ≤ n → + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (n + 1))) = + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + + finiteExtensionPlaceDegree K L P) : + ∀ m : ℕ, + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (N + m))) = + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P N)) + + m * finiteExtensionPlaceDegree K L P := by + intro m + induction m with + | zero => simp + | succ m ih => + have hstep := hIncrement (N + m) (Nat.le_add_right N m) + calc + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (N + (m + 1)))) = + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P ((N + m) + 1))) := by + rw [Nat.add_succ] + _ = Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (N + m))) + + finiteExtensionPlaceDegree K L P := hstep + _ = (Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P N)) + + m * finiteExtensionPlaceDegree K L P) + + finiteExtensionPlaceDegree K L P := by rw [ih] + _ = Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P N)) + + (m + 1) * finiteExtensionPlaceDegree K L P := by + rw [Nat.add_mul, one_mul] + omega + +/-- Eventual exact affine dimension growth for `L(D + nP)`. -/ +theorem finiteExtensionRiemannSpace_shift_eventually_closedFormula + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) (intercept error : ℕ) + (hLower : ∀ n : ℕ, + n * finiteExtensionPlaceDegree K L P + intercept ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + error) : + ∃ N : ℕ, ∀ m : ℕ, + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (N + m))) = + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P N)) + + m * finiteExtensionPlaceDegree K L P := by + obtain ⟨N, hN⟩ := + finiteExtensionRiemannSpace_shift_eventually_exact_increment + K L D hD P intercept error hLower + exact ⟨N, + finiteExtensionRiemannSpace_shift_closedFormula_of_exact_increment + K L D P N hN⟩ + +/-- Cardinality form of eventual exact affine growth. It is stated without +division: after stabilization, adding `mP` multiplies the number of Riemann +space elements by `|K| ^ (m * deg(P))`. -/ +theorem finiteExtensionRiemannSpace_shift_eventually_cardinality_formula + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) (intercept error : ℕ) + (hLower : ∀ n : ℕ, + n * finiteExtensionPlaceDegree K L P + intercept ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P n)) + error) : + ∃ N : ℕ, ∀ m : ℕ, + Nat.card + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (N + m))) = + Nat.card + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P N)) * + Nat.card K ^ (m * finiteExtensionPlaceDegree K L P) := by + obtain ⟨N, hN⟩ := finiteExtensionRiemannSpace_shift_eventually_closedFormula + K L D hD P intercept error hLower + refine ⟨N, ?_⟩ + intro m + have hDN : ∀ v, + 0 ≤ finiteExtensionRiemannShiftDivisor K L D P N v := by + intro v + by_cases hv : v = P + · subst v + have hNnonneg : (0 : ℤ) ≤ N := by positivity + simpa [finiteExtensionRiemannShiftDivisor] using + add_nonneg (hD P) hNnonneg + · simpa [finiteExtensionRiemannShiftDivisor, + Finsupp.single_eq_of_ne hv] using hD v + have hDNm : ∀ v, + 0 ≤ finiteExtensionRiemannShiftDivisor K L D P (N + m) v := by + intro v + by_cases hv : v = P + · subst v + have hNmnonneg : (0 : ℤ) ≤ N + m := by positivity + simpa [finiteExtensionRiemannShiftDivisor] using + add_nonneg (hD P) hNmnonneg + · simpa [finiteExtensionRiemannShiftDivisor, + Finsupp.single_eq_of_ne hv] using hD v + letI : Module.Finite K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P N)) := + finiteExtensionRiemannSpace_effective_moduleFinite K L _ hDN + letI : Module.Finite K + (finiteExtensionRiemannSpace K L + (finiteExtensionRiemannShiftDivisor K L D P (N + m))) := + finiteExtensionRiemannSpace_effective_moduleFinite K L _ hDNm + rw [Module.natCard_eq_pow_finrank (K := K), hN m, pow_add, + ← Module.natCard_eq_pow_finrank (K := K)] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean new file mode 100644 index 0000000000..c3d71d7c75 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +import Mathlib.FieldTheory.Finite.Basic + +/-! +# Riemann spaces for finite extensions of a rational function field + +This file supplies the elementary divisor-linear-algebra layer needed by a +Bombieri--Stepanov proof of Hasse--Weil. For a divisor `D` on the exhaustive +finite and infinite places of a finite separable extension `L / K(X)`, it +defines the Riemann space + +`L(D) = {x : L | x = 0 or div(x) + D is effective}` + +as a `K`-submodule of `L`. It also proves the order-theoretic and +multiplicative properties of these spaces, together with their specialization +to the one-point filtration `L(nP)`. + +The integer-valued principal-divisor API is defined only for nonzero elements, +so zero is an explicit branch of the carrier predicate. Scalar closure uses +that a nonzero constant over the finite constant field has trivial principal +divisor. + +Two substantive stages are deliberately *not* postulated here: + +* finite-dimensionality of every `L(D)` over `K`; +* the Riemann--Roch lower bound, which can be stated without introducing genus + as `2 * deg D - deg K_can <= 2 * finrank_K L(D)`. + +The ambient function field `L` is not finite-dimensional over `K`, so the first +item is a genuine theorem and cannot be obtained by typeclass inference from +the ambient space. Both stages must be proved before `finrank` is used in the +Hasse--Weil argument. +-/ + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped nonZeroDivisors Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance finiteExtensionRiemannSpaceConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance finiteExtensionRiemannSpaceConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A finitely supported divisor on all finite and infinite places of +`L / K(X)`. -/ +abbrev FiniteExtensionDivisor := FiniteExtensionPlace K L →₀ ℤ + +/-- Divisor degree is additive. -/ +theorem finiteExtensionDivisorDegree_add + (D E : FiniteExtensionDivisor K L) : + finiteExtensionDivisorDegree K L (D + E) = + finiteExtensionDivisorDegree K L D + + finiteExtensionDivisorDegree K L E := by + classical + simpa only [finiteExtensionDivisorDegree] using + (Finsupp.sum_add_index (f := D) (g := E) + (h := fun v e ↦ e * (finiteExtensionPlaceDegree K L v : ℤ)) + (by simp) (by intros; ring)) + +/-- The product formula says that every nonzero principal divisor has degree +zero. -/ +theorem finiteExtensionDivisorDegree_principal + (x : L) (hx : x ≠ 0) : + finiteExtensionDivisorDegree K L + (finiteExtensionPrincipalDivisor K L x) = 0 := by + exact finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L x hx + +/-- An effective divisor has nonnegative degree. -/ +theorem finiteExtensionDivisorDegree_nonnegative_of_effective + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) : + 0 ≤ finiteExtensionDivisorDegree K L D := by + apply D.sum_nonneg' + intro v + exact mul_nonneg (hD v) (by positivity) + +/-- Nonzero elements of the finite constant field have trivial exhaustive +principal divisor. -/ +theorem finiteExtensionPrincipalDivisor_algebraMap_constant + (c : K) (hc : c ≠ 0) : + finiteExtensionPrincipalDivisor K L (algebraMap K L c) = 0 := by + let n := Fintype.card K - 1 + have hn : 0 < n := by + dsimp [n] + exact Nat.sub_pos_of_lt Fintype.one_lt_card + have hcL : algebraMap K L c ≠ 0 := by + simpa only [map_zero] using (algebraMap K L).injective.ne hc + have hpow : (algebraMap K L c) ^ n = 1 := by + rw [← map_pow, FiniteField.pow_card_sub_one_eq_one c hc, map_one] + have hdiv := finiteExtensionPrincipalDivisor_pow K L + (algebraMap K L c) hcL n + rw [hpow, finiteExtensionPrincipalDivisor_one K L] at hdiv + ext v + change finiteExtensionPrincipalDivisor K L (algebraMap K L c) v = (0 : ℤ) + have hv := congrArg (fun D : FiniteExtensionDivisor K L ↦ D v) hdiv + simp only [Finsupp.zero_apply, Finsupp.smul_apply, nsmul_eq_mul] at hv + exact (mul_eq_zero.mp hv.symm).resolve_left (by exact_mod_cast hn.ne') + +/-- The all-place Riemann space `L(D)`. Zero is handled separately because +the existing principal-divisor API assigns integer coefficients only to +nonzero functions. -/ +def finiteExtensionRiemannSpace (D : FiniteExtensionDivisor K L) : + Submodule K L where + carrier := {x | x = 0 ∨ (x ≠ 0 ∧ ∀ v, + 0 ≤ finiteExtensionPrincipalDivisor K L x v + D v)} + zero_mem' := Or.inl rfl + add_mem' := by + rintro x y (hx0 | ⟨hx0, hx⟩) (hy0 | ⟨hy0, hy⟩) + · exact Or.inl (by simp [hx0, hy0]) + · subst x + simpa only [zero_add, Set.mem_setOf_eq] using + (Or.inr ⟨hy0, hy⟩ : y = 0 ∨ (y ≠ 0 ∧ ∀ v, + 0 ≤ finiteExtensionPrincipalDivisor K L y v + D v)) + · subst y + simpa only [add_zero, Set.mem_setOf_eq] using + (Or.inr ⟨hx0, hx⟩ : x = 0 ∨ (x ≠ 0 ∧ ∀ v, + 0 ≤ finiteExtensionPrincipalDivisor K L x v + D v)) + · by_cases hxy : x + y = 0 + · exact Or.inl hxy + · refine Or.inr ⟨hxy, ?_⟩ + intro v + have horder := finiteExtensionPrincipalDivisor_add_ge_min + K L x y hx0 hy0 hxy v + have hxmin : -D v ≤ finiteExtensionPrincipalDivisor K L x v := by + have hxv := hx v + omega + have hymin : -D v ≤ finiteExtensionPrincipalDivisor K L y v := by + have hyv := hy v + omega + have hmin : -D v ≤ min + (finiteExtensionPrincipalDivisor K L x v) + (finiteExtensionPrincipalDivisor K L y v) := + le_min hxmin hymin + omega + smul_mem' := by + intro c x hx + by_cases hc : c = 0 + · subst c + exact Or.inl (zero_smul K x) + rcases hx with hx | ⟨hx, horders⟩ + · subst x + exact Or.inl (smul_zero c) + · have hcL : algebraMap K L c ≠ 0 := by + simpa only [map_zero] using (algebraMap K L).injective.ne hc + have hcx : c • x ≠ 0 := by + rw [Algebra.smul_def] + exact mul_ne_zero hcL hx + refine Or.inr ⟨hcx, ?_⟩ + intro v + rw [Algebra.smul_def, + finiteExtensionPrincipalDivisor_mul K L _ _ hcL hx, + finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc] + simpa using horders v + +@[simp] +theorem mem_finiteExtensionRiemannSpace + {D : FiniteExtensionDivisor K L} {x : L} : + x ∈ finiteExtensionRiemannSpace K L D ↔ + x = 0 ∨ (x ≠ 0 ∧ ∀ v, + 0 ≤ finiteExtensionPrincipalDivisor K L x v + D v) := + Iff.rfl + +/-- Increasing the allowed divisor enlarges the Riemann space. -/ +theorem finiteExtensionRiemannSpace_mono + {D E : FiniteExtensionDivisor K L} (hDE : D ≤ E) : + finiteExtensionRiemannSpace K L D ≤ + finiteExtensionRiemannSpace K L E := by + intro x hx + rw [mem_finiteExtensionRiemannSpace] at hx ⊢ + rcases hx with hx | ⟨hx0, hx⟩ + · exact Or.inl hx + · refine Or.inr ⟨hx0, ?_⟩ + intro v + have hv := hDE v + have hxv := hx v + omega + +/-- Every constant belongs to `L(D)` when `D` is effective. -/ +theorem algebraMap_mem_finiteExtensionRiemannSpace_of_effective + {D : FiniteExtensionDivisor K L} (hD : ∀ v, 0 ≤ D v) (c : K) : + algebraMap K L c ∈ finiteExtensionRiemannSpace K L D := by + by_cases hc : c = 0 + · subst c + simpa using (finiteExtensionRiemannSpace K L D).zero_mem + · rw [mem_finiteExtensionRiemannSpace] + refine Or.inr ⟨?_, ?_⟩ + · simpa only [map_zero] using (algebraMap K L).injective.ne hc + intro v + rw [finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc] + simpa using hD v + +/-- The Riemann spaces form a multiplicative divisor filtration. -/ +theorem finiteExtensionRiemannSpace_mul_mem + {D E : FiniteExtensionDivisor K L} {x y : L} + (hx : x ∈ finiteExtensionRiemannSpace K L D) + (hy : y ∈ finiteExtensionRiemannSpace K L E) : + x * y ∈ finiteExtensionRiemannSpace K L (D + E) := by + rw [mem_finiteExtensionRiemannSpace] at hx hy ⊢ + rcases hx with hx | ⟨hx0, hx⟩ + · exact Or.inl (by simp [hx]) + rcases hy with hy | ⟨hy0, hy⟩ + · exact Or.inl (by simp [hy]) + refine Or.inr ⟨mul_ne_zero hx0 hy0, ?_⟩ + intro v + rw [finiteExtensionPrincipalDivisor_mul K L x y hx0 hy0, + Finsupp.add_apply] + have hxv := hx v + have hyv := hy v + simp only [Finsupp.add_apply] at hxv hyv ⊢ + omega + +/-- Powers respect the multiplicative divisor filtration. -/ +theorem finiteExtensionRiemannSpace_pow_mem + {D : FiniteExtensionDivisor K L} {x : L} + (hx : x ∈ finiteExtensionRiemannSpace K L D) (n : ℕ) : + x ^ n ∈ finiteExtensionRiemannSpace K L (n • D) := by + rw [mem_finiteExtensionRiemannSpace] at hx ⊢ + rcases hx with hx | ⟨hx0, hx⟩ + · subst x + by_cases hn : n = 0 + · subst n + simp only [pow_zero, zero_nsmul] + refine Or.inr ⟨one_ne_zero, ?_⟩ + intro v + rw [finiteExtensionPrincipalDivisor_one K L] + simp + · exact Or.inl (zero_pow hn) + refine Or.inr ⟨pow_ne_zero n hx0, ?_⟩ + intro v + rw [finiteExtensionPrincipalDivisor_pow K L x hx0 n] + simp only [Finsupp.smul_apply, nsmul_eq_mul] + have hxv := hx v + have hn : (0 : ℤ) ≤ n := by positivity + nlinarith + +/-- The elementary vanishing half of Riemann--Roch: a divisor of negative +degree has no nonzero section. This uses only effectiveness and the product +formula, not Riemann--Roch. -/ +theorem finiteExtensionRiemannSpace_eq_bot_of_divisorDegree_neg + {D : FiniteExtensionDivisor K L} + (hD : finiteExtensionDivisorDegree K L D < 0) : + finiteExtensionRiemannSpace K L D = ⊥ := by + apply le_antisymm + · intro x hx + rw [Submodule.mem_bot] + rw [mem_finiteExtensionRiemannSpace] at hx + rcases hx with hx | ⟨hx0, hx⟩ + · exact hx + · exfalso + let E := finiteExtensionPrincipalDivisor K L x + D + have hEeffective : ∀ v, 0 ≤ E v := by + intro v + exact hx v + have hEdegree := + finiteExtensionDivisorDegree_nonnegative_of_effective K L E hEeffective + rw [finiteExtensionDivisorDegree_add, + finiteExtensionDivisorDegree_principal K L x hx0, zero_add] at hEdegree + omega + · exact bot_le + +/-- Functions whose only permitted pole is at `P`, with order at most `n`. -/ +def finiteExtensionOnePointRiemannSpace + (P : FiniteExtensionPlace K L) (n : ℕ) : Submodule K L := by + classical + exact finiteExtensionRiemannSpace K L (Finsupp.single P (n : ℤ)) + +/-- Membership in `L(nP)` is the expected pole bound at `P`, together with +regularity at every other place. -/ +theorem mem_finiteExtensionOnePointRiemannSpace_iff + (P : FiniteExtensionPlace K L) (n : ℕ) (x : L) : + x ∈ finiteExtensionOnePointRiemannSpace K L P n ↔ + x = 0 ∨ (x ≠ 0 ∧ + -(n : ℤ) ≤ finiteExtensionPrincipalDivisor K L x P ∧ + ∀ v, v ≠ P → 0 ≤ finiteExtensionPrincipalDivisor K L x v) := by + classical + rw [finiteExtensionOnePointRiemannSpace, + mem_finiteExtensionRiemannSpace] + constructor + · rintro (hx | ⟨hx0, hx⟩) + · exact Or.inl hx + · refine Or.inr ⟨hx0, ?_, ?_⟩ + · have hP := hx P + simp only [Finsupp.single_eq_same] at hP + omega + · intro v hv + have hvOrder := hx v + simp only [Finsupp.single_eq_of_ne hv] at hvOrder + simpa using hvOrder + · rintro (hx | ⟨hx0, hP, hAway⟩) + · exact Or.inl hx + · refine Or.inr ⟨hx0, ?_⟩ + intro v + by_cases hv : v = P + · subst v + simp only [Finsupp.single_eq_same] + omega + · simp only [Finsupp.single_eq_of_ne hv, add_zero] + exact hAway v hv + +/-- Every constant belongs to every one-point Riemann space. -/ +theorem algebraMap_mem_finiteExtensionOnePointRiemannSpace + (P : FiniteExtensionPlace K L) (n : ℕ) (c : K) : + algebraMap K L c ∈ finiteExtensionOnePointRiemannSpace K L P n := by + classical + apply algebraMap_mem_finiteExtensionRiemannSpace_of_effective K L + intro v + by_cases hv : v = P + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + +/-- The one-point Riemann spaces are nested by pole order. -/ +theorem finiteExtensionOnePointRiemannSpace_mono + (P : FiniteExtensionPlace K L) {m n : ℕ} (hmn : m ≤ n) : + finiteExtensionOnePointRiemannSpace K L P m ≤ + finiteExtensionOnePointRiemannSpace K L P n := by + classical + apply finiteExtensionRiemannSpace_mono K L + intro v + by_cases hv : v = P + · subst v + simp only [Finsupp.single_eq_same] + exact_mod_cast hmn + · simp only [Finsupp.single_eq_of_ne hv] + exact le_rfl + +/-- Products add the allowed pole orders in the one-point filtration. -/ +theorem finiteExtensionOnePointRiemannSpace_mul_mem + (P : FiniteExtensionPlace K L) {m n : ℕ} {x y : L} + (hx : x ∈ finiteExtensionOnePointRiemannSpace K L P m) + (hy : y ∈ finiteExtensionOnePointRiemannSpace K L P n) : + x * y ∈ finiteExtensionOnePointRiemannSpace K L P (m + n) := by + classical + change x * y ∈ finiteExtensionRiemannSpace K L + (Finsupp.single P ((m + n : ℕ) : ℤ)) + have hmul := finiteExtensionRiemannSpace_mul_mem K L hx hy + have hdivisor : + Finsupp.single P ((m + n : ℕ) : ℤ) = + Finsupp.single P (m : ℤ) + Finsupp.single P (n : ℤ) := by + ext v + by_cases hv : v = P + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + rw [hdivisor] + exact hmul + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean new file mode 100644 index 0000000000..330b3eb96d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean @@ -0,0 +1,362 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +import Mathlib.LinearAlgebra.Projectivization.Cardinality + +/-! +# Projectivized Riemann-space counts + +For a finite constant field, nonzero vectors in a finite-dimensional vector +space modulo multiplication by nonzero scalars form its projectivization. +This file records the three equivalent cardinality formulas needed in the +function-field zeta argument: + +* the quotient by the scalar action; +* the set of one-dimensional subspaces; and +* the geometric sum `1 + q + ... + q^(l - 1)`. + +The final statements specialize these formulas to every effective exhaustive +divisor, using the already proved finite-dimensionality of its Riemann space. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped LinearAlgebra.Projectivization Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] +variable (V : Type*) [AddCommGroup V] [Module K V] + +/-- One-dimensional subspaces of a finite vector space over `K` are counted +by the geometric sum in the dimension. -/ +theorem finiteVectorSpace_oneDimensionalSubspace_card_eq_geomSum : + Nat.card {W : Submodule K V // Module.finrank K W = 1} = + ∑ i ∈ Finset.range (Module.finrank K V), Nat.card K ^ i := by + rw [Nat.card_congr (Projectivization.equivSubmodule K V).symm] + exact Projectivization.card_of_finrank K V rfl + +/-- The orbit quotient of nonzero vectors by nonzero scalar multiplication is +counted by the same geometric sum. -/ +theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_geomSum : + Nat.card + (Quotient + (MulAction.orbitRel Kˣ {v : V // v ≠ 0})) = + ∑ i ∈ Finset.range (Module.finrank K V), Nat.card K ^ i := by + rw [Nat.card_congr (Projectivization.equivQuotientOrbitRel K V).symm] + exact Projectivization.card_of_finrank K V rfl + +variable [Module.Finite K V] + +/-- Division form of the projective-space cardinality formula. -/ +theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_div : + Nat.card + (Quotient + (MulAction.orbitRel Kˣ {v : V // v ≠ 0})) = + (Nat.card K ^ Module.finrank K V - 1) / (Nat.card K - 1) := by + rw [Nat.card_congr (Projectivization.equivQuotientOrbitRel K V).symm, + Projectivization.card'', Module.natCard_eq_pow_finrank (K := K)] + +variable [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance projectivizedRiemannSpaceConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance projectivizedRiemannSpaceConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Effective exhaustive divisors in the principal-divisor class represented +by `D`. The sign convention matches the Riemann-space definition: +`x \in L(D)` gives the effective divisor `div(x) + D`. -/ +def EffectiveDivisorInPrincipalClass (D : FiniteExtensionDivisor K L) := + {E : FiniteExtensionDivisor K L // + (∀ v, 0 ≤ E v) ∧ + ∃ x : L, x ≠ 0 ∧ + E = finiteExtensionPrincipalDivisor K L x + D} + +/-- A nonzero Riemann-space section determines an effective divisor in the +principal class represented by `D`. -/ +def effectiveDivisorInPrincipalClassOfNonzeroSection + (D : FiniteExtensionDivisor K L) + (x : {x : finiteExtensionRiemannSpace K L D // x ≠ 0}) : + EffectiveDivisorInPrincipalClass K L D := by + have hx0 : (x.1.1 : L) ≠ 0 := Subtype.coe_injective.ne x.2 + refine ⟨finiteExtensionPrincipalDivisor K L x.1.1 + D, ?_, + x.1.1, hx0, rfl⟩ + have hxmem := x.1.2 + rw [mem_finiteExtensionRiemannSpace] at hxmem + rcases hxmem with hx | ⟨_, hx⟩ + · exact (hx0 hx).elim + · simpa only [Finsupp.add_apply] using hx + +/-- Multiplying a nonzero section by a nonzero base-field scalar does not +change its associated effective divisor. -/ +theorem effectiveDivisorInPrincipalClassOfNonzeroSection_smul + (D : FiniteExtensionDivisor K L) + (a b : {x : finiteExtensionRiemannSpace K L D // x ≠ 0}) + (c : K) (hab : a = c • (b : finiteExtensionRiemannSpace K L D)) : + effectiveDivisorInPrincipalClassOfNonzeroSection K L D a = + effectiveDivisorInPrincipalClassOfNonzeroSection K L D b := by + have hc : c ≠ 0 := by + intro hc + apply a.2 + simpa [hc] using hab + have hcL : algebraMap K L c ≠ 0 := + by simpa only [map_zero] using (algebraMap K L).injective.ne hc + have hb0 : (b.1.1 : L) ≠ 0 := Subtype.coe_injective.ne b.2 + apply Subtype.ext + dsimp only [effectiveDivisorInPrincipalClassOfNonzeroSection] + have habL : (a.1.1 : L) = algebraMap K L c * (b.1.1 : L) := by + simpa [Algebra.smul_def] using + congrArg (fun z : finiteExtensionRiemannSpace K L D ↦ (z.1 : L)) hab + rw [habL, finiteExtensionPrincipalDivisor_mul K L _ _ hcL hb0, + finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc, zero_add] + +/-- Projectivizing the nonzero sections makes the associated effective +divisor independent of the chosen representative. -/ +def projectiveRiemannSectionToEffectiveDivisorInPrincipalClass + (D : FiniteExtensionDivisor K L) : + Projectivization K (finiteExtensionRiemannSpace K L D) → + EffectiveDivisorInPrincipalClass K L D := + Projectivization.lift + (effectiveDivisorInPrincipalClassOfNonzeroSection K L D) + (effectiveDivisorInPrincipalClassOfNonzeroSection_smul K L D) + +@[simp] +theorem projectiveRiemannSectionToEffectiveDivisorInPrincipalClass_mk + (D : FiniteExtensionDivisor K L) + (x : finiteExtensionRiemannSpace K L D) (hx : x ≠ 0) : + projectiveRiemannSectionToEffectiveDivisorInPrincipalClass K L D + (Projectivization.mk K x hx) = + effectiveDivisorInPrincipalClassOfNonzeroSection K L D ⟨x, hx⟩ := + rfl + +/-- Every effective divisor in the represented principal class arises from +a projective nonzero section. -/ +theorem projectiveRiemannSectionToEffectiveDivisorInPrincipalClass_surjective + (D : FiniteExtensionDivisor K L) : + Function.Surjective + (projectiveRiemannSectionToEffectiveDivisorInPrincipalClass K L D) := by + intro E + obtain ⟨hEeffective, x, hx0, hE⟩ := E.2 + have hxmem : x ∈ finiteExtensionRiemannSpace K L D := by + rw [mem_finiteExtensionRiemannSpace] + exact Or.inr ⟨hx0, by + intro v + have hv := hEeffective v + rw [hE, Finsupp.add_apply] at hv + exact hv⟩ + let xD : finiteExtensionRiemannSpace K L D := ⟨x, hxmem⟩ + have hxD0 : xD ≠ 0 := by + intro hxD + apply hx0 + exact congrArg Subtype.val hxD + refine ⟨Projectivization.mk K xD hxD0, ?_⟩ + apply Subtype.ext + change finiteExtensionPrincipalDivisor K L x + D = E.1 + exact hE.symm + +/-- Under exact constants, a nonzero function has zero exhaustive principal +divisor exactly when it is a nonzero base-field constant. -/ +theorem finiteExtensionPrincipalDivisor_eq_zero_iff_isBaseConstant + (hconstants : algebraicClosure K L = ⊥) (x : L) (hx0 : x ≠ 0) : + finiteExtensionPrincipalDivisor K L x = 0 ↔ + ∃ c : K, c ≠ 0 ∧ algebraMap K L c = x := by + constructor + · intro hx + have hxmem : x ∈ finiteExtensionRiemannSpace K L 0 := by + rw [mem_finiteExtensionRiemannSpace] + exact Or.inr ⟨hx0, by simp [hx]⟩ + rw [finiteExtensionRiemannSpace_zero_eq_range K L hconstants] at hxmem + obtain ⟨c, hc⟩ := hxmem + refine ⟨c, ?_, hc⟩ + intro hc0 + subst c + exact hx0 (by simpa using hc.symm) + · rintro ⟨c, hc, rfl⟩ + exact finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc + +/-- With exact constants, two nonzero functions have the same exhaustive +principal divisor exactly when they differ by a base-field scalar. -/ +theorem finiteExtensionPrincipalDivisor_eq_iff_exists_smul + (hconstants : algebraicClosure K L = ⊥) + (x y : L) (hx0 : x ≠ 0) (hy0 : y ≠ 0) : + finiteExtensionPrincipalDivisor K L x = + finiteExtensionPrincipalDivisor K L y ↔ + ∃ c : K, c • y = x := by + constructor + · intro hxy + have hquot : finiteExtensionPrincipalDivisor K L (x / y) = 0 := by + rw [finiteExtensionPrincipalDivisor_div K L x y hx0 hy0, hxy, sub_self] + obtain ⟨c, _, hc⟩ := + (finiteExtensionPrincipalDivisor_eq_zero_iff_isBaseConstant + K L hconstants (x / y) (div_ne_zero hx0 hy0)).mp hquot + refine ⟨c, ?_⟩ + rw [Algebra.smul_def, hc, div_mul_cancel₀ x hy0] + · rintro ⟨c, hc⟩ + have hc0 : c ≠ 0 := by + intro hczero + subst c + exact hx0 (hc.symm.trans (zero_smul K y)) + have hcL : algebraMap K L c ≠ 0 := + by simpa only [map_zero] using (algebraMap K L).injective.ne hc0 + rw [← hc, Algebra.smul_def, + finiteExtensionPrincipalDivisor_mul K L _ _ hcL hy0, + finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc0, zero_add] + +/-- Exact constants make the projective-section map injective. -/ +theorem projectiveRiemannSectionToEffectiveDivisorInPrincipalClass_injective + (D : FiniteExtensionDivisor K L) + (hconstants : algebraicClosure K L = ⊥) : + Function.Injective + (projectiveRiemannSectionToEffectiveDivisorInPrincipalClass K L D) := by + intro p q hpq + induction p using Projectivization.ind with + | h x hx => + induction q using Projectivization.ind with + | h y hy => + apply (Projectivization.mk_eq_mk_iff' K x y hx hy).2 + change + effectiveDivisorInPrincipalClassOfNonzeroSection K L D ⟨x, hx⟩ = + effectiveDivisorInPrincipalClassOfNonzeroSection K L D ⟨y, hy⟩ + at hpq + have hdivAdd : + finiteExtensionPrincipalDivisor K L x.1 + D = + finiteExtensionPrincipalDivisor K L y.1 + D := by + exact congrArg Subtype.val hpq + have hdiv : finiteExtensionPrincipalDivisor K L x.1 = + finiteExtensionPrincipalDivisor K L y.1 := add_right_cancel hdivAdd + have hx0 : (x.1 : L) ≠ 0 := by + intro hxzero + apply hx + exact Subtype.ext hxzero + have hy0 : (y.1 : L) ≠ 0 := by + intro hyzero + apply hy + exact Subtype.ext hyzero + obtain ⟨c, hc⟩ := + (finiteExtensionPrincipalDivisor_eq_iff_exists_smul + K L hconstants x.1 y.1 + hx0 hy0).mp hdiv + refine ⟨c, Subtype.ext ?_⟩ + exact hc + +/-- With exact constants, projective nonzero sections are equivalent to the +effective divisors in the represented principal class. -/ +def projectiveRiemannSectionEquivEffectiveDivisorInPrincipalClass + (D : FiniteExtensionDivisor K L) + (hconstants : algebraicClosure K L = ⊥) : + Projectivization K (finiteExtensionRiemannSpace K L D) ≃ + EffectiveDivisorInPrincipalClass K L D := + Equiv.ofBijective + (projectiveRiemannSectionToEffectiveDivisorInPrincipalClass K L D) + ⟨projectiveRiemannSectionToEffectiveDivisorInPrincipalClass_injective + K L D hconstants, + projectiveRiemannSectionToEffectiveDivisorInPrincipalClass_surjective + K L D⟩ + +/-- Nonzero sections of `L(D)` modulo nonzero constant scalars satisfy the +projective-space `Nat.card` identity. The following finiteness theorem turns +this into an ordinary finite count when `D` is effective. -/ +theorem effectiveRiemannSpace_nonzeroScalarOrbitQuotient_card_eq_geomSum + (D : FiniteExtensionDivisor K L) : + Nat.card + (Quotient + (MulAction.orbitRel Kˣ + {x : finiteExtensionRiemannSpace K L D // x ≠ 0})) = + ∑ i ∈ Finset.range + (Module.finrank K (finiteExtensionRiemannSpace K L D)), + Nat.card K ^ i := by + exact finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_geomSum + K (finiteExtensionRiemannSpace K L D) + +/-- For effective `D`, the scalar-orbit quotient of nonzero sections is a +finite type. -/ +theorem effectiveRiemannSpace_nonzeroScalarOrbitQuotient_finite + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) : + Finite + (Quotient + (MulAction.orbitRel Kˣ + {x : finiteExtensionRiemannSpace K L D // x ≠ 0})) := by + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + letI : Finite (finiteExtensionRiemannSpace K L D) := + Module.finite_of_finite K + exact Finite.of_equiv + (Projectivization K (finiteExtensionRiemannSpace K L D)) + (Projectivization.equivQuotientOrbitRel K + (finiteExtensionRiemannSpace K L D)) + +/-- Division form of the projectivized effective Riemann-space count. -/ +theorem effectiveRiemannSpace_nonzeroScalarOrbitQuotient_card_eq_div + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) : + Nat.card + (Quotient + (MulAction.orbitRel Kˣ + {x : finiteExtensionRiemannSpace K L D // x ≠ 0})) = + (Nat.card K ^ + Module.finrank K (finiteExtensionRiemannSpace K L D) - 1) / + (Nat.card K - 1) := by + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + exact finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_div + K (finiteExtensionRiemannSpace K L D) + +/-- Under exact constants, an effective divisor class represented by an +effective `D` is finite. -/ +theorem effectiveDivisorInPrincipalClass_finite + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) + (hconstants : algebraicClosure K L = ⊥) : + Finite (EffectiveDivisorInPrincipalClass K L D) := by + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + letI : Finite (finiteExtensionRiemannSpace K L D) := + Module.finite_of_finite K + exact Finite.of_equiv + (Projectivization K (finiteExtensionRiemannSpace K L D)) + (projectiveRiemannSectionEquivEffectiveDivisorInPrincipalClass + K L D hconstants) + +/-- Cardinality of the effective divisors in a fixed principal class under +the exact-constants hypothesis. -/ +theorem effectiveDivisorInPrincipalClass_card_eq_geomSum + (D : FiniteExtensionDivisor K L) + (hconstants : algebraicClosure K L = ⊥) : + Nat.card (EffectiveDivisorInPrincipalClass K L D) = + ∑ i ∈ Finset.range + (Module.finrank K (finiteExtensionRiemannSpace K L D)), + Nat.card K ^ i := by + rw [Nat.card_congr + (projectiveRiemannSectionEquivEffectiveDivisorInPrincipalClass + K L D hconstants).symm] + exact Projectivization.card_of_finrank K + (finiteExtensionRiemannSpace K L D) rfl + +/-- Division form of the fixed-principal-class count. -/ +theorem effectiveDivisorInPrincipalClass_card_eq_div + (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) + (hconstants : algebraicClosure K L = ⊥) : + Nat.card (EffectiveDivisorInPrincipalClass K L D) = + (Nat.card K ^ + Module.finrank K (finiteExtensionRiemannSpace K L D) - 1) / + (Nat.card K - 1) := by + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + rw [Nat.card_congr + (projectiveRiemannSectionEquivEffectiveDivisorInPrincipalClass + K L D hconstants).symm, + Projectivization.card'', Module.natCard_eq_pow_finrank (K := K)] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean new file mode 100644 index 0000000000..6fc1eea221 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean @@ -0,0 +1,166 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace + +/-! +# Standard zeta rationality after proving degree index one + +This file packages the exact downstream consequence of F. K. Schmidt's +degree-index theorem. Once the exhaustive divisor-degree index is one, the +automatic indexed zeta rational form becomes the standard curve denominator +`(1 - T) (1 - qT)`. The Riemann--Roch construction also retains a concrete +numerator-degree bound and numerator noncancellation at `T = 1`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance standardZetaConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance standardZetaConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) standardZetaPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance standardZetaPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance standardZetaConstantPolynomialTower : + IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- An indexed zeta rational form with index one is exactly a standard curve +zeta rational form. -/ +theorem hasCurveZetaRationalForm_of_indexed_index_one + (Z : PowerSeries ℂ) (q : ℕ) (P : Polynomial ℂ) + (hindexed : HasIndexedCurveZetaRationalForm Z q 1 P) : + HasCurveZetaRationalForm Z q P := by + simpa [HasIndexedCurveZetaRationalForm, indexedCurveZetaDenominator, + HasCurveZetaRationalForm, curveZetaDenominator, linearPowerSeriesFactor] + using hindexed + +/-- Uniform Riemann--Roch and degree index one give a normalized standard +zeta numerator. Its degree is bounded by the same truncation length used in +the indexed recurrence, and its value at `T = 1` is nonzero. -/ +theorem exists_finiteExtensionClosedPlaceZeta_rational_with_natDegree_lt_of_uniformRiemann + (genus threshold : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hindex : finiteExtensionDivisorDegreeIndex K L = 1) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + P.eval 1 ≠ 0 ∧ + P.natDegree < threshold + 2 ∧ + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) P := by + obtain ⟨P, hPzero, hPdegree, hPindexed⟩ := + exists_formalPointCountZeta_indexed_rational_with_natDegree_lt_of_effectiveDivisor_recurrences + (finiteExtensionEffectiveDivisorCount K L) + (finiteExtensionClosedPlaceExtensionCount K L) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) + threshold + (finiteExtensionDivisorDegreeIndex_pos K L) + (finiteExtensionEffectiveDivisorCount_zero K L) + (finiteExtensionEffectiveDivisorPointCountRecurrence K L) + (fun n hn => + finiteExtensionEffectiveDivisorCount_indexed_eventual_recurrence_complex + K L genus threshold n hconstants hRiemann hn) + have hPone : P.eval 1 ≠ 0 := + finiteExtensionClosedPlaceZeta_indexedNumerator_eval_one_ne_zero_of_uniformRiemann + K L genus threshold hconstants hRiemann P hPindexed + have hPdegree' : P.natDegree < threshold + 2 := by + simpa [hindex] using hPdegree + have hPstandard : + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) P := by + rw [hindex] at hPindexed + exact hasCurveZetaRationalForm_of_indexed_index_one _ _ _ hPindexed + exact ⟨P, hPzero, hPone, hPdegree', hPstandard⟩ + +/-- Exact constants and degree index one give the standard curve zeta form +with numerator degree strictly below `2g + 2`, where `g` is the transported +function-field genus. -/ +theorem exists_finiteExtensionClosedPlaceZeta_rational_with_genus_degree_bound + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hindex : finiteExtensionDivisorDegreeIndex K L = 1) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + P.eval 1 ≠ 0 ∧ + P.natDegree < 2 * FunctionField.genus K L + 2 ∧ + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) P := by + letI : FunctionField.IsFullConstantField K L := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 + hconstants + simpa only [FunctionField.genus_eq_genusChart K L] using + exists_finiteExtensionClosedPlaceZeta_rational_with_natDegree_lt_of_uniformRiemann + K L (FunctionField.Chart.genus K L) + (2 * FunctionField.Chart.genus K L) hconstants + (hasFiniteExtensionUniformEventualRiemannFormula_of_fullConstantField K L) + hindex + +/-- If the intrinsic genus is at most `budget`, the standard numerator has at +most `2 * budget + 1` reciprocal roots. The same polynomial carries the +formal extension point-count trace formula. -/ +theorem exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget + (budget : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hindex : finiteExtensionDivisorDegreeIndex K L = 1) + (hgenus : FunctionField.genus K L ≤ budget) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + P.eval 1 ≠ 0 ∧ + P.natDegree ≤ 2 * budget + 1 ∧ + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) P ∧ + HasZetaNumeratorPointCountFormula + (Nat.card K) + (finiteExtensionClosedPlaceExtensionCount K L) P := by + obtain ⟨P, hPzero, hPone, hPdegree, hPform⟩ := + exists_finiteExtensionClosedPlaceZeta_rational_with_genus_degree_bound + K L hconstants hindex + have hdegreeBudget : P.natDegree ≤ 2 * budget + 1 := by + omega + exact ⟨P, hPzero, hPone, hdegreeBudget, hPform, + hasZetaNumeratorPointCountFormula_of_formalPointCountZeta_rational + (Nat.card K) (finiteExtensionClosedPlaceExtensionCount K L) + P hPzero hPform⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean new file mode 100644 index 0000000000..02c06e7215 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean @@ -0,0 +1,154 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor + +/-! +# The total effective different divisor + +This file packages the finite and above-infinity different multiplicities in +one exhaustive effective divisor, and identifies its weighted degree with the +sum of the two numerical different degrees already used by Riemann--Hurwitz. + +Unlike the canonical divisor attached to `dX`, this effective divisor records +the total different itself: its infinity coefficients do not contain the +additional `-2e` correction coming from the pole of `dX`. +-/ + +open scoped BigOperators nonZeroDivisors Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain + +variable (K : Type*) [Field K] [Finite K] + [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance totalDifferentFintype : Fintype K := Fintype.ofFinite K + +local instance (priority := 10) totalDifferentPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance totalDifferentPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance totalDifferentFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance totalDifferentFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance totalDifferentPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance totalDifferentFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance totalDifferentInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance totalDifferentInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance totalDifferentInfinityTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance totalDifferentInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance totalDifferentInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance totalDifferentInfinityPlaceFintype : + Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + +/-- The effective divisor whose coefficient at every exhaustive place is the +local multiplicity of the trace different. -/ +def finiteExtensionTotalDifferentEffectiveDivisor : + FiniteExtensionEffectiveDivisor K L := + (differentMultiplicityDivisor K[X] + (RatFuncFiniteIntegralClosure K L) + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)).sumElim + (Finsupp.equivFunOnFinite.symm fun P => + multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L))) + +omit [Finite K] [DecidableEq K] in +@[simp] +theorem finiteExtensionTotalDifferentEffectiveDivisor_inl + (P : FiniteExtensionFinitePlace K L) : + finiteExtensionTotalDifferentEffectiveDivisor K L (.inl P) = + multiplicity P.asIdeal + (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) := by + simp [finiteExtensionTotalDifferentEffectiveDivisor] + +omit [Finite K] [DecidableEq K] in +@[simp] +theorem finiteExtensionTotalDifferentEffectiveDivisor_inr + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionTotalDifferentEffectiveDivisor K L (.inr P) = + multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) := by + simp [finiteExtensionTotalDifferentEffectiveDivisor] + +omit [Finite K] in +/-- The exhaustive effective different has degree equal to the finite +different degree plus the above-infinity different degree. -/ +theorem finiteExtensionTotalDifferentEffectiveDivisor_degree : + finiteExtensionEffectiveDivisorDegree K L + (finiteExtensionTotalDifferentEffectiveDivisor K L) = + finiteExtensionFiniteDifferentDegree K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L) + + infinityDifferentDegree K L := by + rw [finiteExtensionEffectiveDivisorDegree] + rw [finiteExtensionTotalDifferentEffectiveDivisor, Finsupp.sum_sumElim] + congr 1 + · rw [finiteExtensionFiniteDifferentDegree] + apply Finsupp.sum_congr + intro P _ + simp only [Function.comp_apply, finiteExtensionPlaceDegree] + ac_rfl + · rw [infinityDifferentDegree] + rw [Finsupp.sum_fintype _ _ (fun _ => by simp)] + apply Finset.sum_congr rfl + intro P _ + simp only [Function.comp_apply, finiteExtensionPlaceDegree] + simp + ac_rfl + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean new file mode 100644 index 0000000000..6da11ace0e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import Mathlib.Tactic + +/-! +# Zero counting from principal-divisor height + +This file isolates the divisor-theoretic counting step used after a +Hasse--Weil estimate. Every place has positive degree, so each distinct zero +of a function contributes at least one to the degree of its positive divisor. +The product formula then identifies that degree with the pole height. + +No point-count estimate is used here. In particular, the genuinely +Hasse--Weil input can remain a separate upstream theorem. +-/ + +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) zeroCountingPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance zeroCountingPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance zeroCountingFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance zeroCountingInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- Every finite or above-infinity place of a finite separable function-field +extension has positive degree. -/ +theorem finiteExtensionPlaceDegree_pos + (v : FiniteExtensionPlace K L) : + 0 < finiteExtensionPlaceDegree K L v := by + cases v with + | inl q => + rw [finiteExtensionPlaceDegree] + exact Nat.mul_pos + (Ideal.inertiaDeg_pos q.asIdeal K[X]) + ((finitePlaceNormalizedPrime + (HeightOneSpectrum.under K[X] q)).property.1.irreducible.natDegree_pos) + | inr P => + simpa [finiteExtensionPlaceDegree] using + Ideal.inertiaDeg_pos P.1 (RatFuncInfinityIntegers K) + +/-- The finite set of places where `x` has positive order. -/ +def finiteExtensionZeroPlaces (x : L) : + Finset (FiniteExtensionPlace K L) := + (finiteExtensionPrincipalDivisor K L x).support.filter + (fun v => 0 < finiteExtensionPrincipalDivisor K L x v) + +omit [DecidableEq K] in +@[simp] theorem mem_finiteExtensionZeroPlaces_iff + (x : L) (v : FiniteExtensionPlace K L) : + v ∈ finiteExtensionZeroPlaces K L x ↔ + 0 < finiteExtensionPrincipalDivisor K L x v := by + simp only [finiteExtensionZeroPlaces, Finset.mem_filter, + Finsupp.mem_support_iff] + omega + +/-- The degree of the positive divisor is the weighted sum over the zero +places. -/ +theorem finiteExtensionPositiveDegree_eq_sum_zeroPlaces + (x : L) : + finiteExtensionPositiveDegree K L x = + ∑ v ∈ finiteExtensionZeroPlaces K L x, + (finiteExtensionPrincipalDivisor K L x v).toNat * + finiteExtensionPlaceDegree K L v := by + rfl + +/-- Any finite set of positive-order places has cardinality at most the degree +of the positive divisor. -/ +theorem card_le_finiteExtensionPositiveDegree_of_orders_positive + (x : L) (S : Finset (FiniteExtensionPlace K L)) + (hpositive : ∀ v ∈ S, 0 < finiteExtensionPrincipalDivisor K L x v) : + S.card ≤ finiteExtensionPositiveDegree K L x := by + let weight : FiniteExtensionPlace K L → ℕ := fun v => + (finiteExtensionPrincipalDivisor K L x v).toNat * + finiteExtensionPlaceDegree K L v + have hsubset : S ⊆ finiteExtensionZeroPlaces K L x := by + intro v hv + exact (mem_finiteExtensionZeroPlaces_iff K L x v).2 (hpositive v hv) + calc + S.card = ∑ _v ∈ S, 1 := by simp + _ ≤ ∑ v ∈ S, weight v := by + apply Finset.sum_le_sum + intro v hv + have horder : 0 < (finiteExtensionPrincipalDivisor K L x v).toNat := + Int.pos_iff_toNat_pos.mp (hpositive v hv) + have hdegree : 0 < finiteExtensionPlaceDegree K L v := + finiteExtensionPlaceDegree_pos K L v + simpa [weight] using Nat.one_le_iff_ne_zero.mpr + (Nat.mul_ne_zero (Nat.ne_of_gt horder) (Nat.ne_of_gt hdegree)) + _ ≤ ∑ v ∈ finiteExtensionZeroPlaces K L x, weight v := by + exact Finset.sum_le_sum_of_subset_of_nonneg hsubset (by omega) + _ = finiteExtensionPositiveDegree K L x := by + rw [finiteExtensionPositiveDegree_eq_sum_zeroPlaces K L x] + +/-- Any finite family of positive-order places contributes its full +residue-degree weight to the positive divisor. This is the form needed when +degree-one and degree-two closed points are counted simultaneously over a +quadratic constant-field extension. -/ +theorem sum_placeDegree_le_finiteExtensionPositiveDegree_of_orders_positive + (x : L) (S : Finset (FiniteExtensionPlace K L)) + (hpositive : ∀ v ∈ S, 0 < finiteExtensionPrincipalDivisor K L x v) : + ∑ v ∈ S, finiteExtensionPlaceDegree K L v ≤ + finiteExtensionPositiveDegree K L x := by + let weight : FiniteExtensionPlace K L → ℕ := fun v => + (finiteExtensionPrincipalDivisor K L x v).toNat * + finiteExtensionPlaceDegree K L v + have hsubset : S ⊆ finiteExtensionZeroPlaces K L x := by + intro v hv + exact (mem_finiteExtensionZeroPlaces_iff K L x v).2 (hpositive v hv) + calc + ∑ v ∈ S, finiteExtensionPlaceDegree K L v ≤ + ∑ v ∈ S, weight v := by + apply Finset.sum_le_sum + intro v hv + have horder : 1 ≤ (finiteExtensionPrincipalDivisor K L x v).toNat := by + have horderPositive : + 0 < (finiteExtensionPrincipalDivisor K L x v).toNat := + Int.pos_iff_toNat_pos.mp (hpositive v hv) + omega + exact Nat.le_mul_of_pos_left + (finiteExtensionPlaceDegree K L v) horder + _ ≤ ∑ v ∈ finiteExtensionZeroPlaces K L x, weight v := by + exact Finset.sum_le_sum_of_subset_of_nonneg hsubset (by omega) + _ = finiteExtensionPositiveDegree K L x := by + rw [finiteExtensionPositiveDegree_eq_sum_zeroPlaces K L x] + +/-- Weighted positive-order place counting in terms of pole height. -/ +theorem sum_placeDegree_le_finiteExtensionHeight_of_orders_positive + (x : L) (hx : x ≠ 0) + (S : Finset (FiniteExtensionPlace K L)) + (hpositive : ∀ v ∈ S, 0 < finiteExtensionPrincipalDivisor K L x v) : + ∑ v ∈ S, finiteExtensionPlaceDegree K L v ≤ + finiteExtensionHeight K L x := by + rw [← finiteExtensionPositiveDegree_eq_height K L x hx] + exact sum_placeDegree_le_finiteExtensionPositiveDegree_of_orders_positive + K L x S hpositive + +/-- If a finite type injects into positive-order places of a nonzero function, +then its cardinality is bounded by the pole height of that function. -/ +theorem Fintype.card_le_finiteExtensionHeight_of_injective_orders_positive + {ι : Type*} [Fintype ι] + (x : L) (hx : x ≠ 0) + (place : ι → FiniteExtensionPlace K L) + (hinjective : Function.Injective place) + (hpositive : ∀ i, 0 < finiteExtensionPrincipalDivisor K L x (place i)) : + Fintype.card ι ≤ finiteExtensionHeight K L x := by + classical + let S : Finset (FiniteExtensionPlace K L) := Finset.univ.image place + have hcard : S.card = Fintype.card ι := by + simpa [S] using Finset.card_image_of_injective Finset.univ hinjective + have hSpositive : + ∀ v ∈ S, 0 < finiteExtensionPrincipalDivisor K L x v := by + intro v hv + rcases Finset.mem_image.mp hv with ⟨i, _hi, rfl⟩ + exact hpositive i + calc + Fintype.card ι = S.card := hcard.symm + _ ≤ finiteExtensionPositiveDegree K L x := + card_le_finiteExtensionPositiveDegree_of_orders_positive K L x S hSpositive + _ = finiteExtensionHeight K L x := + finiteExtensionPositiveDegree_eq_height K L x hx + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean new file mode 100644 index 0000000000..2cb040b464 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean @@ -0,0 +1,68 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity + +/-! +# Degree support and the constant-extension zeta identity + +This file specializes the formal constant-extension identity to the exhaustive +closed-place point-count sequence. The divisor-degree index itself supplies +the required divisibility support. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The exhaustive closed-place count vanishes outside multiples of the +divisor-degree index. -/ +theorem finiteExtensionClosedPlaceExtensionCount_eq_zero_of_not_dvd_index + (n : ℕ) + (hn : ¬ finiteExtensionDivisorDegreeIndex K L ∣ n) : + finiteExtensionClosedPlaceExtensionCount K L n = 0 := by + classical + simp only [finiteExtensionClosedPlaceExtensionCount] + apply Finset.sum_eq_zero + intro P _ + split_ifs with hdegree + · exact False.elim (hn + ((finiteExtensionDivisorDegreeIndex_dvd_placeDegree K L P.1).trans + hdegree)) + · rfl + +/-- Once the geometric constant extension supplies its exact point-count +relation, the corresponding zeta identity follows automatically. -/ +theorem finiteExtensionClosedPlaceZeta_hasDegreeExtensionIdentity + (extendedPointCount : ℕ → ℕ) + (hcount : ∀ r, + extendedPointCount r = + finiteExtensionClosedPlaceExtensionCount K L + (finiteExtensionDivisorDegreeIndex K L * r)) : + HasFormalDegreeExtensionZetaIdentity + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (formalPointCountZeta extendedPointCount) + (finiteExtensionDivisorDegreeIndex K L) := by + exact formalPointCountZeta_hasDegreeExtensionIdentity + (finiteExtensionClosedPlaceExtensionCount K L) + extendedPointCount (finiteExtensionDivisorDegreeIndex K L) + (finiteExtensionDivisorDegreeIndex_pos K L) hcount + (finiteExtensionClosedPlaceExtensionCount_eq_zero_of_not_dvd_index K L) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean new file mode 100644 index 0000000000..d22042ea95 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +/-! +# The geometric F. K. Schmidt composition + +This file composes indexed zeta rationality, numerator noncancellation, the +formal constant-extension identity, and indexed rationality after exact +constant extension. The extension is never assumed to have degree index one. + +The only geometric input left explicit is the closed-place count identity for +the constant extension whose degree is the original divisor-degree index. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial TensorProduct + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance degreeIndexOneAutomaticConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance degreeIndexOneAutomaticConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Exact constants automatically give an indexed rational numerator which +does not vanish at `T = 1`. -/ +theorem exists_finiteExtensionClosedPlaceZeta_indexed_rational_nonvanishing_of_constants + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ P.eval 1 ≠ 0 ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P := by + obtain ⟨genus, threshold, hRiemann⟩ := + exists_hasFiniteExtensionUniformEventualRiemannFormula_of_constants + K L hconstants + exact exists_finiteExtensionClosedPlaceZeta_indexed_rational_nonvanishing + K L genus threshold hconstants hRiemann + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Fintype S] [DecidableEq C] [DecidableEq (RatFunc C)] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance degreeIndexOneBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance degreeIndexOneBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The exhaustive closed-place point-count sequence of the exact constant +extension, packaged with its canonical `S(X)`-function-field structure. -/ +noncomputable def exactConstantExtensionClosedPlaceExtensionCount + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) (r : ℕ) : ℕ := by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + closedPlaceRatFuncConstantsDecidableEq S + exact finiteExtensionClosedPlaceExtensionCount S E r + +omit [Fintype C] [DecidableEq C] [DecidableEq (RatFunc C)] in +/-- Replacing the former explicit `Classical.decEq` choices by the canonical +closed-place choices does not change the exact-constant-extension count. -/ +theorem exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) (r : ℕ) : + exactConstantExtensionClosedPlaceExtensionCount C S N hExact r = + (by + let E := ExactConstantExtension C N S + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + letI : DecidableEq S := Classical.decEq S + letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + exact finiteExtensionClosedPlaceExtensionCount S E r) := by + unfold exactConstantExtensionClosedPlaceExtensionCount + congr 1 + +/-- Noncircular geometric F. K. Schmidt theorem. + +`S/C` is required to have degree equal to the original divisor-degree index. +The sole remaining geometric relation says that the closed-place point count +after this constant extension at level `r` is the original count at level +`d*r`. Indexed rationality of both zeta series, including the extension, is +derived internally. -/ +theorem finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstantExtension_closedPlaceCount + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hdegree : Module.finrank C S = + finiteExtensionDivisorDegreeIndex C N) + (hcount : ∀ r, + exactConstantExtensionClosedPlaceExtensionCount C S N hExact r = + finiteExtensionClosedPlaceExtensionCount C N + (finiteExtensionDivisorDegreeIndex C N * r)) : + finiteExtensionDivisorDegreeIndex C N = 1 := by + let E := ExactConstantExtension C N S + let d := finiteExtensionDivisorDegreeIndex C N + letI : Field E := exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) E := Algebra.toSMul + letI : Module (RatFunc S) E := Algebra.toModule + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + letI : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + letI : DecidableEq S := infinityBridgeDecidableEqConstants S + letI : DecidableEq (RatFunc S) := + closedPlaceRatFuncConstantsDecidableEq S + let extendedConstantAlgebra : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + let tensorConstantAlgebra : Algebra S E := + Algebra.TensorProduct.leftAlgebra + have hconstantMap (s : S) : + (@algebraMap S E _ _ extendedConstantAlgebra) s = + (@algebraMap S E _ _ tensorConstantAlgebra) s := by + exact (ratFuncToExactConstantExtension C S N hExact).commutes s + have hAlgebraicTransfer (z : E) + (hz : @IsAlgebraic S E _ _ extendedConstantAlgebra z) : + @IsAlgebraic S E _ _ tensorConstantAlgebra z := by + rcases hz with ⟨p, hp, hpz⟩ + refine ⟨p, hp, ?_⟩ + have hmapEq : + (@algebraMap S E _ _ extendedConstantAlgebra) = + (@algebraMap S E _ _ tensorConstantAlgebra) := by + ext s + exact hconstantMap s + change Polynomial.eval₂ + (@algebraMap S E _ _ extendedConstantAlgebra) z p = 0 at hpz + change Polynomial.eval₂ + (@algebraMap S E _ _ tensorConstantAlgebra) z p = 0 + rw [← hmapEq] + exact hpz + have hTensorRange (z : E) + (hz : @IsAlgebraic S E _ _ tensorConstantAlgebra z) : + z ∈ Set.range (@algebraMap S E _ _ tensorConstantAlgebra) := by + letI : Algebra S E := tensorConstantAlgebra + have hTensorExact : algebraicClosure S E = + (⊥ : IntermediateField S E) := + exactConstantExtension_algebraicClosure_eq_bot C N S hExact + have hzClosure : z ∈ algebraicClosure S E := + mem_algebraicClosure_iff.mpr hz + have hzBot : z ∈ (⊥ : IntermediateField S E) := by + rw [← hTensorExact] + exact hzClosure + exact hzBot + letI : Algebra S E := extendedConstantAlgebra + have hExtendedExact : algebraicClosure S E = + (⊥ : IntermediateField S E) := by + apply eq_bot_iff.mpr + intro z hz + have hzExtended : @IsAlgebraic S E _ _ extendedConstantAlgebra z := + mem_algebraicClosure_iff.mp hz + obtain ⟨s, hs⟩ := hTensorRange z + (hAlgebraicTransfer z hzExtended) + exact ⟨s, (hconstantMap s).trans hs⟩ + obtain ⟨P, _, hPone, hPindexed⟩ := + exists_finiteExtensionClosedPlaceZeta_indexed_rational_nonvanishing_of_constants + C N hExact + obtain ⟨extendedP, _, hExtendedIndexed⟩ := + exists_finiteExtensionClosedPlaceZeta_indexed_rational_of_constants + S E hExtendedExact + have hcard : Nat.card S = Nat.card C ^ d := by + rw [Module.natCard_eq_pow_finrank (K := C) (V := S), hdegree] + have hExtensionIdentity : HasFormalDegreeExtensionZetaIdentity + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount C N)) + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount S E)) d := by + apply finiteExtensionClosedPlaceZeta_hasDegreeExtensionIdentity C N + intro r + rw [← hcount r] + rfl + apply degreeIndex_eq_one_of_two_indexed_rationalForms_and_degreeExtension + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount C N)) + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount S E)) + (Nat.card C) d (finiteExtensionDivisorDegreeIndex S E) + P extendedP + · rw [← Fintype.card_eq_nat_card] + exact Fintype.one_lt_card + · exact finiteExtensionDivisorDegreeIndex_pos C N + · exact finiteExtensionDivisorDegreeIndex_pos S E + · exact hPone + · exact hPindexed + · simpa only [hcard] using hExtendedIndexed + · exact hExtensionIdentity + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean new file mode 100644 index 0000000000..b282b66ee8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean @@ -0,0 +1,97 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality + +/-! +# Automatic divisor-degree index one + +The exact constant-extension splitting formula supplies the sole geometric +hypothesis of the noncircular F. K. Schmidt argument. Consequently a finite +separable function field with exact constants has divisor-degree index one. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +variable (C N : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + +local instance automaticIndexOneBaseConstantAlgebra : Algebra C N := + bridgeBaseConstantAlgebra C N + +local instance automaticIndexOneBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- F. K. Schmidt's divisor-index-one theorem, with the constant-extension +closed-place identity discharged internally. -/ +theorem finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstants + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + finiteExtensionDivisorDegreeIndex C N = 1 := by + apply + finiteExtensionDivisorDegreeIndex_eq_one_of_all_exactConstantExtension_closedPlaceCount + C N hExact + intro S _ _ _ _ _ level + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + have hcount := exactConstantExtensionClosedPlaceExtensionCount_eq + C S N hExact level + convert hcount using 1 <;> congr 1 + +/-- Exact constants now give the standard curve zeta form without a separate +divisor-index hypothesis. -/ +theorem exists_finiteExtensionClosedPlaceZeta_rational_with_genus_degree_bound_of_exactConstants + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + P.eval 1 ≠ 0 ∧ + P.natDegree < 2 * FunctionField.genus C N + 2 ∧ + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount C N)) + (Nat.card C) P := by + exact exists_finiteExtensionClosedPlaceZeta_rational_with_genus_degree_bound + C N hExact + (finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstants + C N hExact) + +/-- Exact constants and an intrinsic genus budget give the standard zeta +trace package with no remaining degree-index premise. -/ +theorem exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget_of_exactConstants + (budget : ℕ) + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (hgenus : FunctionField.genus C N ≤ budget) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + P.eval 1 ≠ 0 ∧ + P.natDegree ≤ 2 * budget + 1 ∧ + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount C N)) + (Nat.card C) P ∧ + HasZetaNumeratorPointCountFormula + (Nat.card C) + (finiteExtensionClosedPlaceExtensionCount C N) P := by + exact exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget + C N budget hExact + (finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstants + C N hExact) + hgenus + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean new file mode 100644 index 0000000000..cd32376cf4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +import Mathlib.FieldTheory.Finite.Extension + +/-! +# Choosing the constant extension of divisor-index degree + +The geometric F. K. Schmidt composition in +`FiniteExtensionZetaDegreeIndexOne` accepts a finite constant extension whose +degree is the divisor-degree index. Finite-field theory supplies such an +extension in every positive degree. This file isolates that final choice: +if the closed-place splitting identity is available for every finite Galois +constant extension, then the divisor-degree index is one. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (C N : Type*) [Field C] [Fintype C] [DecidableEq C] + [DecidableEq (RatFunc C)] + [Field N] [Algebra (RatFunc C) N] + [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + +local instance selectedExtensionBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +local instance selectedExtensionBaseConstantTower : + IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + +/-- It suffices to prove the exact constant-extension closed-place identity +uniformly for finite Galois extensions of the constant field. The required +extension of degree equal to the divisor-degree index is the standard finite +field extension `FiniteField.Extension`. -/ +theorem finiteExtensionDivisorDegreeIndex_eq_one_of_all_exactConstantExtension_closedPlaceCount + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (hcount : ∀ (S : Type) [Field S] [Fintype S] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S], ∀ r, + exactConstantExtensionClosedPlaceExtensionCount C S N hExact r = + finiteExtensionClosedPlaceExtensionCount C N + (Module.finrank C S * r)) : + finiteExtensionDivisorDegreeIndex C N = 1 := by + let d := finiteExtensionDivisorDegreeIndex C N + have hd : 0 < d := finiteExtensionDivisorDegreeIndex_pos C N + let p := ringChar C + letI : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ + letI : NeZero d := ⟨hd.ne'⟩ + letI : Fintype (FiniteField.Extension C p d) := + Fintype.ofFinite (FiniteField.Extension C p d) + apply finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstantExtension_closedPlaceCount + C (FiniteField.Extension C p d) N hExact + · simpa [d] using FiniteField.finrank_extension C p d + · intro r + simpa [d, FiniteField.finrank_extension] using + hcount (FiniteField.Extension C p d) r + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean new file mode 100644 index 0000000000..a736526ce3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean @@ -0,0 +1,385 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +import Mathlib.Algebra.Polynomial.Expand +import Mathlib.RingTheory.PowerSeries.Expand + +/-! +# Noncancellation of the indexed zeta numerator + +The strict divisor-count growth across one degree-index step detects the +uncancelled factor `1 - T^d` in the indexed zeta denominator. This file +proves the formal coefficient statement and then specializes it to the +finite-extension effective-divisor series. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open scoped Polynomial PowerSeries + +/-- The partial sum of the coefficients of +`Z(T) (1 - T) (1 - q T)` is the boundary difference +`Z_{n+1} - q Z_n`. -/ +theorem sum_range_coeff_mul_curveZetaDenominator + (Z : PowerSeries ℂ) (q n : ℕ) : + (∑ k ∈ Finset.range (n + 2), + PowerSeries.coeff k (Z * curveZetaDenominator q)) = + PowerSeries.coeff (n + 1) Z - + (q : ℂ) * PowerSeries.coeff n Z := by + induction n with + | zero => + rw [show 0 + 2 = 2 by omega] + simp only [Finset.sum_range_succ, Finset.sum_range_zero, zero_add] + have hcoeffOne : + PowerSeries.coeff 1 (curveZetaDenominator q) = + -((q : ℂ) + 1) := by + rw [curveZetaDenominator, PowerSeries.coeff_one_mul] + simp [linearPowerSeriesFactor] + rw [PowerSeries.coeff_zero_eq_constantCoeff, map_mul, + PowerSeries.coeff_one_mul, hcoeffOne] + simp [curveZetaDenominator, linearPowerSeriesFactor] + ring + | succ n ih => + rw [show n + 1 + 2 = (n + 2) + 1 by omega, + Finset.sum_range_succ, ih, + coeff_mul_curveZetaDenominator_succ_succ] + ring + +/-- For an ordinary curve denominator, every sufficiently late strict +boundary difference forces the numerator to be nonzero at `T = 1`. -/ +theorem curveZetaNumerator_eval_one_ne_zero_of_boundary + (Z : PowerSeries ℂ) (q n : ℕ) (P : Polynomial ℂ) + (hdegree : P.natDegree < n + 2) + (hboundary : (q : ℂ) * PowerSeries.coeff n Z ≠ + PowerSeries.coeff (n + 1) Z) + (hform : HasCurveZetaRationalForm Z q P) : + P.eval 1 ≠ 0 := by + have heval : P.eval 1 = + PowerSeries.coeff (n + 1) Z - + (q : ℂ) * PowerSeries.coeff n Z := by + rw [Polynomial.eval_eq_sum_range' hdegree] + simp only [one_pow, mul_one] + have hcoeff : ∀ k, + P.coeff k = PowerSeries.coeff k + (Z * curveZetaDenominator q) := by + intro k + have h := congrArg (PowerSeries.coeff k) hform + simpa only [Polynomial.coeff_coe] using h.symm + simp_rw [hcoeff] + exact sum_range_coeff_mul_curveZetaDenominator Z q n + rw [heval, sub_ne_zero] + exact hboundary.symm + +/-- Compress a power series supported in degrees divisible by `d`. -/ +def compressPowerSeries (d : ℕ) (Z : PowerSeries ℂ) : PowerSeries ℂ := + PowerSeries.mk fun n => PowerSeries.coeff (d * n) Z + +/-- Expanding the compressed series recovers a series supported on multiples +of `d`. -/ +theorem expand_compressPowerSeries_eq + (Z : PowerSeries ℂ) (d : ℕ) (hd : 0 < d) + (hsupport : ∀ n, ¬ d ∣ n → PowerSeries.coeff n Z = 0) : + PowerSeries.expand d hd.ne' (compressPowerSeries d Z) = Z := by + ext n + rw [PowerSeries.coeff_expand] + split_ifs with hn + · simp only [compressPowerSeries, PowerSeries.coeff_mk] + rw [show d * (n / d) = n by + rw [mul_comm, Nat.div_mul_cancel hn]] + · exact (hsupport n hn).symm + +/-- Power-series expansion sends the ordinary denominator over `q^d` to the +indexed denominator over `q`. -/ +theorem expand_curveZetaDenominator + (q d : ℕ) (hd : 0 < d) : + PowerSeries.expand d hd.ne' (curveZetaDenominator (q ^ d)) = + indexedCurveZetaDenominator q d := by + simp [curveZetaDenominator, indexedCurveZetaDenominator, + linearPowerSeriesFactor] + +/-- Polynomial and power-series expansion commute with the polynomial +coercion. -/ +theorem coe_polynomial_expand + (P : Polynomial ℂ) (d : ℕ) (hd : 0 < d) : + ((Polynomial.expand ℂ d P : Polynomial ℂ) : PowerSeries ℂ) = + PowerSeries.expand d hd.ne' (P : PowerSeries ℂ) := by + ext n + rw [Polynomial.coeff_coe, Polynomial.coeff_expand hd, + PowerSeries.coeff_expand] + split_ifs <;> simp only [Polynomial.coeff_coe] + +/-- Indexed rationality for a series supported on multiples of `d` compresses +to ordinary rationality, with numerator `P.contract d`. -/ +theorem hasCurveZetaRationalForm_compress_of_indexed + (Z : PowerSeries ℂ) (q d : ℕ) (P : Polynomial ℂ) + (hd : 0 < d) + (hsupport : ∀ n, ¬ d ∣ n → PowerSeries.coeff n Z = 0) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) : + HasCurveZetaRationalForm (compressPowerSeries d Z) (q ^ d) + (P.contract d) := by + let B := compressPowerSeries d Z + have hexpanded : + PowerSeries.expand d hd.ne' + (B * curveZetaDenominator (q ^ d)) = + (P : PowerSeries ℂ) := by + rw [map_mul, expand_compressPowerSeries_eq Z d hd hsupport, + expand_curveZetaDenominator q d hd] + exact hindexed + ext n + have h := congrArg (PowerSeries.coeff (d * n)) hexpanded + simpa only [B, PowerSeries.coeff_expand_mul, + Polynomial.coeff_coe, Polynomial.coeff_contract hd.ne', mul_comm] using h + +/-- Under the same support hypothesis, the indexed polynomial is the +`d`-fold expansion of its contraction. -/ +theorem polynomial_expand_contract_eq_of_indexed + (Z : PowerSeries ℂ) (q d : ℕ) (P : Polynomial ℂ) + (hd : 0 < d) + (hsupport : ∀ n, ¬ d ∣ n → PowerSeries.coeff n Z = 0) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) : + Polynomial.expand ℂ d (P.contract d) = P := by + apply Polynomial.coe_injective ℂ + rw [coe_polynomial_expand (P.contract d) d hd] + let B := compressPowerSeries d Z + have hform := hasCurveZetaRationalForm_compress_of_indexed + Z q d P hd hsupport hindexed + calc + PowerSeries.expand d hd.ne' ((P.contract d : Polynomial ℂ) : + PowerSeries ℂ) = + PowerSeries.expand d hd.ne' + (B * curveZetaDenominator (q ^ d)) := by rw [hform] + _ = Z * indexedCurveZetaDenominator q d := by + rw [map_mul, expand_compressPowerSeries_eq Z d hd hsupport, + expand_curveZetaDenominator q d hd] + _ = (P : PowerSeries ℂ) := hindexed + +/-- A sufficiently late strict growth witness in one admissible degree forces +noncancellation of the indexed numerator at `T = 1`. + +The bound `P.natDegree < n + 2*d` is the exact condition needed after +compressing degrees by `d`; the admissibility condition `d ∣ n` identifies +the boundary coefficients with consecutive compressed coefficients. -/ +theorem indexedCurveZetaNumerator_eval_one_ne_zero_of_growth + (Z : PowerSeries ℂ) (A : ℕ → ℕ) (q d n : ℕ) + (P : Polynomial ℂ) + (hd : 0 < d) + (hcoeff : ∀ m, PowerSeries.coeff m Z = (A m : ℂ)) + (hsupport : ∀ m, ¬ d ∣ m → A m = 0) + (hn : d ∣ n) + (hdegree : P.natDegree < n + 2 * d) + (hgrowth : q ^ d * A n < A (n + d)) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) : + P.eval 1 ≠ 0 := by + let B := compressPowerSeries d Z + let R := P.contract d + have hZsupport : ∀ m, ¬ d ∣ m → PowerSeries.coeff m Z = 0 := by + intro m hm + rw [hcoeff, hsupport m hm] + norm_num + have hform : HasCurveZetaRationalForm B (q ^ d) R := by + exact hasCurveZetaRationalForm_compress_of_indexed + Z q d P hd hZsupport hindexed + have hPexpand : Polynomial.expand ℂ d R = P := by + exact polynomial_expand_contract_eq_of_indexed + Z q d P hd hZsupport hindexed + obtain ⟨k, hk⟩ := hn + have hnEq : n = d * k := by omega + have hdegreeR : R.natDegree < k + 2 := by + have hdegreeExpand : + (Polynomial.expand ℂ d R).natDegree < (k + 2) * d := by + rw [hPexpand] + calc + P.natDegree < n + 2 * d := hdegree + _ = (k + 2) * d := by rw [hnEq]; ring + rw [Polynomial.natDegree_expand] at hdegreeExpand + exact (Nat.mul_lt_mul_right hd).mp hdegreeExpand + have hboundary : ((q ^ d : ℕ) : ℂ) * PowerSeries.coeff k B ≠ + PowerSeries.coeff (k + 1) B := by + intro heq + have hcoeffBoundary : ((q ^ d : ℕ) : ℂ) * (A n : ℂ) = + (A (n + d) : ℂ) := by + simpa only [B, compressPowerSeries, PowerSeries.coeff_mk, + hcoeff, hnEq, Nat.mul_add, Nat.mul_one] using heq + have hNat : q ^ d * A n = A (n + d) := by + exact_mod_cast hcoeffBoundary + exact (Nat.ne_of_lt hgrowth) hNat + have hRone : R.eval 1 ≠ 0 := + curveZetaNumerator_eval_one_ne_zero_of_boundary + B (q ^ d) k R hdegreeR hboundary hform + have heval : P.eval 1 = R.eval 1 := by + rw [← hPexpand, Polynomial.expand_eval] + simp + rwa [heval] + +/-- The coefficient-cast effective-divisor series inherits indexed numerator +noncancellation from any sufficiently late admissible strict-growth witness. -/ +theorem effectiveDivisorCountSeries_indexedNumerator_eval_one_ne_zero_of_growth + (A : ℕ → ℕ) (q d n : ℕ) (P : Polynomial ℂ) + (hd : 0 < d) + (hsupport : ∀ m, ¬ d ∣ m → A m = 0) + (hn : d ∣ n) + (hdegree : P.natDegree < n + 2 * d) + (hgrowth : q ^ d * A n < A (n + d)) + (hindexed : HasIndexedCurveZetaRationalForm + (effectiveDivisorCountSeries A) q d P) : + P.eval 1 ≠ 0 := by + apply indexedCurveZetaNumerator_eval_one_ne_zero_of_growth + (effectiveDivisorCountSeries A) A q d n P hd + · intro m + simp [effectiveDivisorCountSeries] + · exact hsupport + · exact hn + · exact hdegree + · exact hgrowth + · exact hindexed + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance numeratorNoncancellationConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance numeratorNoncancellationConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The finite-extension effective-divisor series is supported precisely in +degrees admissible for the divisor-degree index. -/ +theorem finiteExtensionEffectiveDivisorCount_eq_zero_of_not_dvd_index + (n : ℕ) + (hn : ¬ finiteExtensionDivisorDegreeIndex K L ∣ n) : + finiteExtensionEffectiveDivisorCount K L n = 0 := by + rw [finiteExtensionEffectiveDivisorCount] + apply Fintype.card_eq_zero_iff.mpr + refine ⟨fun D => + (not_exists_finiteExtensionDivisor_degree_eq_of_not_dvd K L n hn) ?_⟩ + refine ⟨finiteExtensionEffectiveDivisorToDivisor K L D.1, ?_⟩ + rw [← finiteExtensionEffectiveDivisorDegree_cast K L D.1, D.2] + +/-- Strict growth witnesses supplied by uniform Riemann--Roch can be chosen +beyond any prescribed lower degree and remain divisible by the canonical +divisor-degree index. -/ +theorem exists_finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index_ge + (genus threshold lowerBound : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) : + ∃ n, lowerBound ≤ n ∧ threshold ≤ n ∧ + finiteExtensionDivisorDegreeIndex K L ∣ n ∧ + Nat.card K ^ finiteExtensionDivisorDegreeIndex K L * + finiteExtensionEffectiveDivisorCount K L n < + finiteExtensionEffectiveDivisorCount K L + (n + finiteExtensionDivisorDegreeIndex K L) := by + let d := finiteExtensionDivisorDegreeIndex K L + let m := lowerBound + threshold + let n := m * d + have hd : 0 < d := finiteExtensionDivisorDegreeIndex_pos K L + have hlower : lowerBound ≤ n := by + dsimp only [n, m] + nlinarith + have hthreshold : threshold ≤ n := by + dsimp only [n, m] + nlinarith + refine ⟨n, hlower, hthreshold, ?_, ?_⟩ + · dsimp only [n, d] + exact dvd_mul_left _ _ + · apply + finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index_of_uniformRiemann + K L genus threshold n hconstants hRiemann hthreshold + exact ⟨by simpa [n, d] using + finiteExtensionDivisorClassOfDegreeIndexMul K L m⟩ + +/-- Uniform Riemann--Roch forces noncancellation for every indexed rational +form of the finite-extension effective-divisor series. -/ +theorem finiteExtensionEffectiveDivisorZeta_indexedNumerator_eval_one_ne_zero_of_uniformRiemann + (genus threshold : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (P : Polynomial ℂ) + (hindexed : HasIndexedCurveZetaRationalForm + (effectiveDivisorCountSeries + (finiteExtensionEffectiveDivisorCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P) : + P.eval 1 ≠ 0 := by + obtain ⟨n, hnDegree, _, hnDvd, hgrowth⟩ := + exists_finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index_ge + K L genus threshold (P.natDegree + 1) hconstants hRiemann + apply + effectiveDivisorCountSeries_indexedNumerator_eval_one_ne_zero_of_growth + (finiteExtensionEffectiveDivisorCount K L) (Nat.card K) + (finiteExtensionDivisorDegreeIndex K L) n P + · exact finiteExtensionDivisorDegreeIndex_pos K L + · intro m hm + exact finiteExtensionEffectiveDivisorCount_eq_zero_of_not_dvd_index + K L m hm + · exact hnDvd + · have hd := finiteExtensionDivisorDegreeIndex_pos K L + omega + · exact hgrowth + · exact hindexed + +/-- Uniform Riemann--Roch also forces noncancellation for every indexed +rational form of the exhaustive closed-place point-count zeta series. -/ +theorem finiteExtensionClosedPlaceZeta_indexedNumerator_eval_one_ne_zero_of_uniformRiemann + (genus threshold : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (P : Polynomial ℂ) + (hindexed : HasIndexedCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P) : + P.eval 1 ≠ 0 := by + apply + finiteExtensionEffectiveDivisorZeta_indexedNumerator_eval_one_ne_zero_of_uniformRiemann + K L genus threshold hconstants hRiemann P + rw [effectiveDivisorCountSeries_eq_formalPointCountZeta + (finiteExtensionEffectiveDivisorCount K L) + (finiteExtensionClosedPlaceExtensionCount K L) + (finiteExtensionEffectiveDivisorCount_zero K L) + (finiteExtensionEffectiveDivisorPointCountRecurrence K L)] + exact hindexed + +/-- The finite-extension closed-place zeta series has an indexed rational +form whose numerator is normalized and does not vanish at `T = 1`. -/ +theorem exists_finiteExtensionClosedPlaceZeta_indexed_rational_nonvanishing + (genus threshold : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ P.eval 1 ≠ 0 ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P := by + obtain ⟨P, hPzero, hPform⟩ := + exists_finiteExtensionClosedPlaceZeta_indexed_rational + K L genus threshold hconstants hRiemann + refine ⟨P, hPzero, ?_, hPform⟩ + exact + finiteExtensionClosedPlaceZeta_indexedNumerator_eval_one_ne_zero_of_uniformRiemann + K L genus threshold hconstants hRiemann P hPform + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean new file mode 100644 index 0000000000..4d23d528ba --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence + +/-! +# A discrete simple-pole witness for the divisor zeta series + +The eventual Riemann--Roch class formula shows that, in every sufficiently +large admissible degree, advancing by the divisor-degree index produces more +effective divisors than multiplication by the corresponding power of the +constant-field cardinality. This is the coefficient-level noncancellation +behind the simple pole at `T = 1`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance simplePoleConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance simplePoleConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +private theorem geomSum_add' (q a b : ℕ) : + (∑ i ∈ Finset.range (a + b), q ^ i) = + (∑ i ∈ Finset.range a, q ^ i) + + q ^ a * ∑ i ∈ Finset.range b, q ^ i := by + rw [Finset.sum_range_add, Finset.mul_sum] + apply congrArg₂ (· + ·) rfl + apply Finset.sum_congr rfl + intro i _ + rw [pow_add] + +/-- Multiples of the canonical index divisor give actual divisor classes in +all integer degrees that are nonnegative multiples of the index. -/ +def finiteExtensionDivisorClassOfDegreeIndexMul (m : ℕ) : + FiniteExtensionDivisorClassOfDegree K L + ((m * finiteExtensionDivisorDegreeIndex K L : ℕ) : ℤ) := by + let D := m • finiteExtensionDivisorIndexRepresentative K L + refine ⟨finiteExtensionDivisorClassMap K L D, ?_⟩ + rw [finiteExtensionDivisorClassDegree_mk] + change finiteExtensionDivisorDegreeHom K L D = _ + rw [map_nsmul] + change m • finiteExtensionDivisorDegree K L + (finiteExtensionDivisorIndexRepresentative K L) = _ + rw [finiteExtensionDivisorIndexRepresentative_degree] + norm_num [D] + +/-- In an admissible large degree, the effective-divisor coefficient grows +strictly more than the geometric `q^d` multiple when the degree is advanced +by the divisor-degree index `d`. -/ +theorem finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index_of_uniformRiemann + (genus threshold n : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) + (hn : threshold ≤ n) + (hclass : Nonempty + (FiniteExtensionDivisorClassOfDegree K L (n : ℤ))) : + Nat.card K ^ finiteExtensionDivisorDegreeIndex K L * + finiteExtensionEffectiveDivisorCount K L n < + finiteExtensionEffectiveDivisorCount K L + (n + finiteExtensionDivisorDegreeIndex K L) := by + let d := finiteExtensionDivisorDegreeIndex K L + let q := Nat.card K + let h := Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) + let ell := n + 1 - genus + have hd : 0 < d := finiteExtensionDivisorDegreeIndex_pos K L + have hn1 : threshold ≤ n + d := by omega + have hgenus : genus ≤ n := hRiemann.1.trans hn + letI : Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + finiteExtensionDivisorClassOfDegree_finite_of_uniformRiemann + K L genus threshold n hRiemann hn + letI : Nonempty (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + hclass + have hh : 0 < h := by + exact Nat.card_pos + have hsum : 0 < ∑ i ∈ Finset.range d, q ^ i := by + have hle : q ^ 0 ≤ ∑ i ∈ Finset.range d, q ^ i := by + apply Finset.single_le_sum + · intro i _ + exact Nat.zero_le _ + · exact Finset.mem_range.mpr hd + simpa using lt_of_lt_of_le (by simp : 0 < q ^ 0) hle + have hcount0 := + finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_uniformRiemann + K L genus threshold n hconstants hRiemann hn + have hcount1 := + finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_uniformRiemann + K L genus threshold (n + d) hconstants hRiemann hn1 + have hclasses : + Nat.card (FiniteExtensionDivisorClassOfDegree K L ((n + d : ℕ) : ℤ)) = + h := by + rw [← finiteExtensionDivisorClassOfDegree_natCard_add_index K L n] + have hell : n + d + 1 - genus = d + ell := by + dsimp only [ell] + omega + have hformula : + finiteExtensionEffectiveDivisorCount K L (n + d) = + q ^ d * finiteExtensionEffectiveDivisorCount K L n + + h * ∑ i ∈ Finset.range d, q ^ i := by + rw [hcount0, hcount1] + change + Nat.card (FiniteExtensionDivisorClassOfDegree K L + ((n + d : ℕ) : ℤ)) * + (∑ i ∈ Finset.range (n + d + 1 - genus), q ^ i) = + q ^ d * + (h * ∑ i ∈ Finset.range (n + 1 - genus), q ^ i) + + h * ∑ i ∈ Finset.range d, q ^ i + rw [hclasses, hell, geomSum_add' q d ell] + dsimp only [ell] + ring + rw [hformula] + exact Nat.lt_add_of_pos_right (Nat.mul_pos hh hsum) + +/-- There is always a sufficiently large admissible coefficient witnessing +the strict simple-pole growth. -/ +theorem exists_finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index + (genus threshold : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hRiemann : HasFiniteExtensionUniformEventualRiemannFormula + K L genus threshold) : + ∃ n, threshold ≤ n ∧ + Nat.card K ^ finiteExtensionDivisorDegreeIndex K L * + finiteExtensionEffectiveDivisorCount K L n < + finiteExtensionEffectiveDivisorCount K L + (n + finiteExtensionDivisorDegreeIndex K L) := by + let d := finiteExtensionDivisorDegreeIndex K L + let n := threshold * d + have hd : 0 < d := finiteExtensionDivisorDegreeIndex_pos K L + have hn : threshold ≤ n := by + dsimp only [n] + nlinarith + refine ⟨n, hn, ?_⟩ + apply + finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index_of_uniformRiemann + K L genus threshold n hconstants hRiemann hn + dsimp only [n, d] + exact ⟨finiteExtensionDivisorClassOfDegreeIndexMul K L threshold⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean new file mode 100644 index 0000000000..aea9c6f767 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean @@ -0,0 +1,152 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield + +/-! +# Composita of finite fields + +Suppose two finite extensions `S / C` and `K / C` are embedded in a common +finite field `T` and generate `T`. Their degrees determine the compositum: + +`[T : C] = lcm([S : C], [K : C])`. + +The relative form is + +`[T : S] = [K : C] / gcd([S : C], [K : C])`. + +Generation is expressed by surjectivity of the canonical tensor-product map. +This formulation is designed to apply directly to residue fields after a +constant extension. +-/ + +open scoped TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +/-- A finite field generated by two embedded finite subfields has degree the +least common multiple of their degrees over the common finite field. -/ +theorem finiteField_finrank_eq_lcm_of_tensorLift_surjective + (C S K T : Type*) + [Field C] [Field S] [Field K] [Field T] + [Algebra C S] [Algebra C K] [Algebra C T] + [Finite C] [Finite S] [Finite K] [Finite T] + (f : S →ₐ[C] T) (g : K →ₐ[C] T) + (hfg : ∀ s k, Commute (f s) (g k)) + (hsurj : Function.Surjective (Algebra.TensorProduct.lift f g hfg)) : + Module.finrank C T = + Nat.lcm (Module.finrank C S) (Module.finrank C K) := by + letI : Fintype C := Fintype.ofFinite C + letI : Fintype S := Fintype.ofFinite S + letI : Fintype K := Fintype.ofFinite K + letI : Fintype T := Fintype.ofFinite T + let m := Module.finrank C S + let n := Module.finrank C K + let l := Nat.lcm m n + let q := Fintype.card C + have hm : m ∣ Module.finrank C T := + FiniteField.nonempty_algHom_iff_finrank_dvd.mp ⟨f⟩ + have hn : n ∣ Module.finrank C T := + FiniteField.nonempty_algHom_iff_finrank_dvd.mp ⟨g⟩ + have hl_dvd : l ∣ Module.finrank C T := + Nat.lcm_dvd_iff.mpr ⟨hm, hn⟩ + have hm_l : m ∣ l := Nat.dvd_lcm_left m n + have hn_l : n ∣ l := Nat.dvd_lcm_right m n + have hS (s : S) : s ^ (q ^ l) = s := by + obtain ⟨a, ha⟩ := hm_l + rw [ha, pow_mul, ← Module.card_eq_pow_finrank] + exact FiniteField.pow_card_pow a s + have hK (k : K) : k ^ (q ^ l) = k := by + obtain ⟨a, ha⟩ := hn_l + rw [ha, pow_mul, ← Module.card_eq_pow_finrank] + exact FiniteField.pow_card_pow a k + let φ := FiniteField.frobeniusAlgHom C T ^ l + have hφ (x : T) : φ x = x ^ (q ^ l) := by + simp [φ, q, AlgHom.coe_pow, FiniteField.coe_frobeniusAlgHom, + pow_iterate] + have hTensor (y : S ⊗[C] K) : + φ (Algebra.TensorProduct.lift f g hfg y) = + Algebra.TensorProduct.lift f g hfg y := by + induction y using TensorProduct.induction_on with + | zero => simp + | tmul s k => + rw [Algebra.TensorProduct.lift_tmul, map_mul, hφ, hφ] + have hs : (f s) ^ (q ^ l) = f s := by + rw [← map_pow, hS] + have hk : (g k) ^ (q ^ l) = g k := by + rw [← map_pow, hK] + rw [hs, hk] + | add x y hx hy => + rw [map_add, map_add, hx, hy] + have hpow (x : T) : x ^ (q ^ l) = x := by + obtain ⟨y, rfl⟩ := hsurj x + rw [← hφ] + exact hTensor y + have hl0 : l ≠ 0 := + (Nat.lcm_pos Module.finrank_pos Module.finrank_pos).ne' + have hcard : Fintype.card T ≤ q ^ l := by + have hroots := Polynomial.card_le_degree_of_subset_roots + (R := T) (p := Polynomial.X ^ (q ^ l) - Polynomial.X) + (Z := Finset.univ) (fun x _ => by + rw [Polynomial.mem_roots'] + constructor + · exact FiniteField.X_pow_card_pow_sub_X_ne_zero T hl0 + Fintype.one_lt_card + · simp [hpow x]) + rw [FiniteField.X_pow_card_pow_sub_X_natDegree_eq T hl0 + Fintype.one_lt_card] at hroots + exact hroots + have hle : Module.finrank C T ≤ l := by + rw [← Nat.pow_le_pow_iff_right (a := q) Fintype.one_lt_card] + rw [← Module.card_eq_pow_finrank (K := C) (V := T)] + exact hcard + exact Nat.le_antisymm hle (Nat.le_of_dvd + (Module.finrank_pos (R := C) (M := T)) hl_dvd) + +/-- Relative-degree form of the finite-field compositum formula. -/ +theorem finiteField_finrank_over_left_eq_div_gcd_of_tensorLift_surjective + (C S K T : Type*) + [Field C] [Field S] [Field K] [Field T] + [Algebra C S] [Algebra C K] [Algebra C T] + [Finite C] [Finite S] [Finite K] [Finite T] + [Algebra S T] [IsScalarTower C S T] + (g : K →ₐ[C] T) + (hsurj : Function.Surjective (Algebra.TensorProduct.lift + (IsScalarTower.toAlgHom C S T) g + (fun _ _ => Commute.all _ _))) : + Module.finrank S T = + Module.finrank C K / + Nat.gcd (Module.finrank C S) (Module.finrank C K) := by + let m := Module.finrank C S + let n := Module.finrank C K + let d := Nat.gcd m n + let l := Nat.lcm m n + let r := Module.finrank S T + have htotal : Module.finrank C T = l := + finiteField_finrank_eq_lcm_of_tensorLift_surjective + C S K T (IsScalarTower.toAlgHom C S T) g + (fun _ _ => Commute.all _ _) hsurj + have hmr : m * r = l := by + exact (Module.finrank_mul_finrank C S T).trans htotal + have hdr : d * r = n := by + apply Nat.mul_left_cancel + (Module.finrank_pos (R := C) (M := S)) + calc + m * (d * r) = d * (m * r) := by ac_rfl + _ = d * l := by rw [hmr] + _ = m * n := Nat.gcd_mul_lcm m n + have hdpos : 0 < d := Nat.gcd_pos_of_pos_left n + (Module.finrank_pos (R := C) (M := S)) + change r = n / d + symm + apply Nat.div_eq_of_eq_mul_left hdpos + simpa [mul_comm] using hdr.symm + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean new file mode 100644 index 0000000000..b32baf4882 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel + +/-! +# Normalization in a finite constant extension + +Let `N` be a `C[X]`-algebra and let `S / C` be a finite extension of finite +fields. Combining smooth base change for integral closure with explicit +polynomial tensor cancellation gives + +`S ⊗[C] integralClosure C[X] N ≃ integralClosure S[X] (S ⊗[C] N)`. + +The normalization comparison is first kept over `S[X]`, so it transports +contractions of height-one primes to the polynomial base. Its restriction +to `S` is retained for residue-field dimension calculations. The values of +both equivalences on pure tensors are recorded explicitly. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C S N : Type*) [Field C] [Field S] [Algebra C S] + [CommRing N] [Algebra C[X] N] + +local instance normalizationBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap C[X] N).comp (algebraMap C C[X])) + +local instance normalizationBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance normalizationCoefficientPolynomialAlgebra : + Algebra C[X] S[X] := + Polynomial.algebra C S + +/-- The polynomial algebra structure on the constant-extended ambient ring. +It sends `X` to `1 ⊗ algebraMap C[X] N X`. This public name lets downstream +function-field constructions install exactly the same algebra structure. -/ +@[reducible] +noncomputable def constantExtensionTensorPolynomialAlgebra : + Algebra S[X] (S ⊗[C] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + +/-- The matching polynomial algebra structure on the constant tensor of the +original normalization. -/ +@[reducible] +noncomputable def constantExtensionNormalizationTensorPolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S + (integralClosure C[X] N) + +local instance normalizationTargetPolynomialAlgebra : + Algebra S[X] (S ⊗[C] N) := + constantExtensionTensorPolynomialAlgebra C S N + +local instance normalizationSourcePolynomialAlgebra : + Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + constantExtensionNormalizationTensorPolynomialAlgebra C S N + +local instance normalizationTargetConstantAlgebra : Algebra S (S ⊗[C] N) := + Algebra.TensorProduct.leftAlgebra + +local instance normalizationTargetConstantPolynomialTower : + IsScalarTower S S[X] (S ⊗[C] N) := + IsScalarTower.of_algebraMap_eq' (by + apply RingHom.ext + intro s + change s ⊗ₜ[C] (1 : N) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) (Polynomial.C s) + simp) + +local instance normalizationTargetIntegralClosureConstantAlgebra : + Algebra S (integralClosure S[X] (S ⊗[C] N)) := + RingHom.toAlgebra + ((algebraMap S[X] (integralClosure S[X] (S ⊗[C] N))).comp + (algebraMap S S[X])) + +/-- After a finite extension of finite constants, normalization commutes with +constant extension as an equivalence over the polynomial ring `S[X]`. -/ +noncomputable def finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv + [Fintype C] [Finite S] : + S ⊗[C] integralClosure C[X] N ≃ₐ[S[X]] + integralClosure S[X] (S ⊗[C] N) := + (polynomialTensorCancelOverCoefficientPolynomial C S + (integralClosure C[X] N)).symm |>.trans + (finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv C S N) |>.trans + (polynomialTensorCancelOverCoefficientPolynomial C S N).mapIntegralClosure + +/-- The polynomial-algebra normalization equivalence sends a pure tensor to +the corresponding pure tensor in the extended ambient algebra. -/ +@[simp] +theorem finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv_tmul + [Fintype C] [Finite S] + (s : S) (a : integralClosure C[X] N) : + (((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N) + (s ⊗ₜ[C] a) : integralClosure S[X] (S ⊗[C] N)) : + S ⊗[C] N) = + s ⊗ₜ[C] (a : N) := by + simp [finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv, + finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, + TensorProduct.toIntegralClosure] + +/-- After a finite extension of finite constants, the normalization is the +constant tensor extension of the original normalization. -/ +noncomputable def finiteFieldConstantExtensionIntegralClosureAlgEquiv + [Fintype C] [Finite S] : + S ⊗[C] integralClosure C[X] N ≃ₐ[S] + integralClosure S[X] (S ⊗[C] N) := by + letI : Algebra S[X] (S[X] ⊗[C[X]] N) := + Algebra.TensorProduct.leftAlgebra + letI : Algebra S (S[X] ⊗[C[X]] integralClosure C[X] N) := + Algebra.TensorProduct.leftAlgebra + let e : S[X] ⊗[C[X]] integralClosure C[X] N ≃+* + integralClosure S[X] (S ⊗[C] N) := + (finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv C S N).toRingEquiv.trans + (polynomialTensorCancelOverCoefficientPolynomial C S N).mapIntegralClosure.toRingEquiv + exact + { (polynomialTensorCancel C S + (integralClosure C[X] N)).symm.toRingEquiv.trans e with + commutes' := fun s => by + apply Subtype.ext + simp [e, finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, + TensorProduct.toIntegralClosure] + change s ⊗ₜ[C] (1 : N) = + algebraMap S[X] (S ⊗[C] N) (Polynomial.C s) + change s ⊗ₜ[C] (1 : N) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) (Polynomial.C s) + simp } + +/-- The normalization equivalence sends a pure tensor to the corresponding +pure tensor in the extended function algebra. -/ +@[simp] +theorem finiteFieldConstantExtensionIntegralClosureAlgEquiv_tmul + [Fintype C] [Finite S] + (s : S) (a : integralClosure C[X] N) : + (((finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N) + (s ⊗ₜ[C] a) : integralClosure S[X] (S ⊗[C] N)) : + S ⊗[C] N) = + s ⊗ₜ[C] (a : N) := by + simp [finiteFieldConstantExtensionIntegralClosureAlgEquiv, + finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, + TensorProduct.toIntegralClosure] + +/-- The normalization comparison with its constant-algebra structures erased. +This is the stable interface for constructions that only need the underlying +ring map and should not depend on the particular `S`-algebra instances used to +build the comparison. -/ +noncomputable def finiteFieldConstantExtensionIntegralClosureRingEquiv + [Fintype C] [Finite S] : + S ⊗[C] integralClosure C[X] N ≃+* + integralClosure S[X] (S ⊗[C] N) := + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).toRingEquiv + +/-- The instance-free normalization comparison has the expected value on a +pure tensor. -/ +@[simp] +theorem finiteFieldConstantExtensionIntegralClosureRingEquiv_tmul + [Fintype C] [Finite S] + (s : S) (a : integralClosure C[X] N) : + (((finiteFieldConstantExtensionIntegralClosureRingEquiv C S N) + (s ⊗ₜ[C] a) : integralClosure S[X] (S ⊗[C] N)) : + S ⊗[C] N) = + s ⊗ₜ[C] (a : N) := + finiteFieldConstantExtensionIntegralClosureAlgEquiv_tmul C S N s a + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean new file mode 100644 index 0000000000..747e2ce411 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization + +/-! +# Residue degrees after finite constant extension + +This file transports the abstract residue-tensor calculation across the +normalization equivalence. If `q` is a maximal ideal of the normalization +after extending finite constants from `C` to `S`, and `p` is its contraction +to the old normalization, then + +`[κ(q) : C] = lcm([S : C], [κ(p) : C])` + +and hence + +`[κ(q) : S] = [κ(p) : C] / gcd([S : C], [κ(p) : C])`. + +In particular, `q` is rational over `S` whenever the downstairs residue +degree divides `[S : C]`. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C S N : Type*) [Field C] [Field S] [Algebra C S] + [Fintype C] [Finite S] + [CommRing N] [Algebra C[X] N] + +local instance constantExtensionResidueBaseConstantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap C[X] N).comp (algebraMap C C[X])) + +local instance constantExtensionResidueBaseConstantPolynomialTower : + IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance constantExtensionResidueCoefficientPolynomialAlgebra : + Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance constantExtensionResidueOldNormalizationConstantAlgebra : + Algebra C (integralClosure C[X] N) := + RingHom.toAlgebra + ((algebraMap C[X] (integralClosure C[X] N)).comp + (algebraMap C C[X])) + +local instance constantExtensionResidueTargetPolynomialAlgebra : + Algebra S[X] (S ⊗[C] N) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + +local instance constantExtensionResidueTargetConstantAlgebra : + Algebra S (S ⊗[C] N) := + Algebra.TensorProduct.leftAlgebra + +local instance constantExtensionResidueTargetConstantPolynomialTower : + IsScalarTower S S[X] (S ⊗[C] N) := + IsScalarTower.of_algebraMap_eq' (by + apply RingHom.ext + intro s + change s ⊗ₜ[C] (1 : N) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) (Polynomial.C s) + simp) + +local instance constantExtensionResidueTargetNormalizationConstantAlgebra : + Algebra S (integralClosure S[X] (S ⊗[C] N)) := + RingHom.toAlgebra + ((algebraMap S[X] (integralClosure S[X] (S ⊗[C] N))).comp + (algebraMap S S[X])) + +local instance constantExtensionResidueTargetNormalizationBaseAlgebra : + Algebra C (integralClosure S[X] (S ⊗[C] N)) := + RingHom.toAlgebra + ((algebraMap S (integralClosure S[X] (S ⊗[C] N))).comp + (algebraMap C S)) + +local instance constantExtensionResidueTargetNormalizationConstantTower : + IsScalarTower C S (integralClosure S[X] (S ⊗[C] N)) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Pull a maximal ideal of the base-changed normalization back to the tensor +model of that normalization. -/ +def finiteFieldConstantExtensionTensorIdeal + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) : + Ideal (S ⊗[C] integralClosure C[X] N) := + q.comap + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).toRingHom + +/-- The inclusion of the old normalization into the normalization after +constant extension. -/ +def finiteFieldConstantExtensionIntegralClosureAlgHom : + integralClosure C[X] N →ₐ[C] + integralClosure S[X] (S ⊗[C] N) := + ((finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).restrictScalars + C).toAlgHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)) + +/-- Ring-homomorphism form of the old-normalization inclusion. -/ +def finiteFieldConstantExtensionIntegralClosureRingHom : + integralClosure C[X] N →+* + integralClosure S[X] (S ⊗[C] N) := + (finiteFieldConstantExtensionIntegralClosureAlgHom C S N).toRingHom + +/-- Contract an upstairs maximal ideal to the old normalization. -/ +def finiteFieldConstantExtensionDownstairsIdeal + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) : + Ideal (integralClosure C[X] N) := + q.comap (finiteFieldConstantExtensionIntegralClosureRingHom C S N) + +@[simp] +theorem finiteFieldConstantExtensionDownstairsIdeal_eq + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) : + finiteFieldConstantExtensionDownstairsIdeal C S N q = + (finiteFieldConstantExtensionTensorIdeal C S N q).comap + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom := + rfl + +@[simp] +theorem finiteFieldConstantExtensionIntegralClosureRingHom_coe + (a : integralClosure C[X] N) : + (((finiteFieldConstantExtensionIntegralClosureRingHom C S N a : + integralClosure S[X] (S ⊗[C] N)) : S ⊗[C] N)) = + (1 : S) ⊗ₜ[C] (a : N) := by + exact finiteFieldConstantExtensionIntegralClosureAlgEquiv_tmul + C S N 1 a + +local instance finiteFieldConstantExtensionTensorIdeal_isMaximal + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] : + (finiteFieldConstantExtensionTensorIdeal C S N q).IsMaximal := by + unfold finiteFieldConstantExtensionTensorIdeal + exact Ideal.comap_isMaximal_of_surjective + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).toRingHom + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N).surjective + +local instance finiteFieldConstantExtensionDownstairsIdeal_isPrime + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] : + (finiteFieldConstantExtensionDownstairsIdeal C S N q).IsPrime := by + unfold finiteFieldConstantExtensionDownstairsIdeal + exact Ideal.comap_isPrime + (f := finiteFieldConstantExtensionIntegralClosureRingHom C S N) + (K := q) + +/-- The normalization equivalence induces an `S`-algebra equivalence of the +corresponding residue fields. -/ +def finiteFieldConstantExtensionResidueFieldAlgEquiv + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] : + (finiteFieldConstantExtensionTensorIdeal C S N q).ResidueField ≃ₐ[S] + q.ResidueField := + Ideal.residueFieldAlgEquiv + (finiteFieldConstantExtensionTensorIdeal C S N q) q + (finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N) rfl + +local instance finiteFieldConstantExtensionTensorResidueFinite + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] + [Finite q.ResidueField] : + Finite (finiteFieldConstantExtensionTensorIdeal C S N q).ResidueField := + let eS := finiteFieldConstantExtensionResidueFieldAlgEquiv C S N q + Finite.of_injective eS eS.injective + +local instance finiteFieldConstantExtensionDownstairsResidueFinite + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] + [Finite q.ResidueField] : + Finite + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField := by + let q₀ := finiteFieldConstantExtensionTensorIdeal C S N q + let p := finiteFieldConstantExtensionDownstairsIdeal C S N q + let fp : p.ResidueField →ₐ[C] q₀.ResidueField := + Ideal.ResidueField.mapₐ p q₀ + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)) rfl + exact Finite.of_injective fp fp.injective + +/-- The contraction of an upstairs maximal ideal is maximal. The proof uses +the already established embedding of its residue field into the finite +upstairs residue field: the downstairs quotient is therefore a finite domain, +and hence a field. -/ +theorem finiteFieldConstantExtensionDownstairsIdeal_isMaximal + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] + [Finite q.ResidueField] : + (finiteFieldConstantExtensionDownstairsIdeal C S N q).IsMaximal := by + let p := finiteFieldConstantExtensionDownstairsIdeal C S N q + letI : Finite p.ResidueField := by + change Finite + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField + infer_instance + letI : Finite (integralClosure C[X] N ⧸ p) := + Finite.of_injective + (algebraMap (integralClosure C[X] N ⧸ p) p.ResidueField) + p.injective_algebraMap_quotient_residueField + exact (Ideal.Quotient.maximal_ideal_iff_isField_quotient p).mpr + (Finite.isField_of_domain (integralClosure C[X] N ⧸ p)) + +/-- Absolute residue-degree form of the constant-extension compositum +formula. -/ +theorem finiteFieldConstantExtensionResidue_finrank_eq_lcm + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] + [Finite q.ResidueField] : + Module.finrank C q.ResidueField = + Nat.lcm (Module.finrank C S) + (Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField) := by + let q₀ := finiteFieldConstantExtensionTensorIdeal C S N q + letI : q₀.IsMaximal := + finiteFieldConstantExtensionTensorIdeal_isMaximal C S N q + let eS := finiteFieldConstantExtensionResidueFieldAlgEquiv C S N q + let p := q₀.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom + letI : Finite p.ResidueField := by + change Finite + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField + infer_instance + have h := constantTensorResidue_finrank_eq_lcm + C (integralClosure C[X] N) S q₀ + change Module.finrank C q.ResidueField = + Nat.lcm (Module.finrank C S) + (Module.finrank C + (q₀.comap (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom).ResidueField) + calc + Module.finrank C q.ResidueField = Module.finrank C q₀.ResidueField := + (eS.restrictScalars C).toLinearEquiv.finrank_eq.symm + _ = _ := h + +/-- Relative residue-degree form of the constant-extension compositum +formula. -/ +theorem finiteFieldConstantExtensionResidue_finrank_over_constants_eq_div_gcd + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] + [Finite q.ResidueField] : + Module.finrank S q.ResidueField = + Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField / + Nat.gcd (Module.finrank C S) + (Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField) := by + let m := Module.finrank C S + let n := Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField + let d := Nat.gcd m n + let l := Nat.lcm m n + let r := Module.finrank S q.ResidueField + have htotal : Module.finrank C q.ResidueField = l := + finiteFieldConstantExtensionResidue_finrank_eq_lcm C S N q + have hmr : m * r = l := by + exact (Module.finrank_mul_finrank C S q.ResidueField).trans htotal + have hdr : d * r = n := by + apply Nat.mul_left_cancel + (Module.finrank_pos (R := C) (M := S)) + calc + m * (d * r) = d * (m * r) := by ac_rfl + _ = d * l := by rw [hmr] + _ = m * n := Nat.gcd_mul_lcm m n + have hdpos : 0 < d := Nat.gcd_pos_of_pos_left n + (Module.finrank_pos (R := C) (M := S)) + change r = n / d + symm + apply Nat.div_eq_of_eq_mul_left hdpos + simpa [mul_comm] using hdr.symm + +/-- If the downstairs residue degree divides the constant-extension degree, +then the upstairs maximal ideal has residue degree one over the enlarged +constants. -/ +theorem finiteFieldConstantExtensionResidue_finrank_eq_one_of_dvd + (q : Ideal (integralClosure S[X] (S ⊗[C] N))) [q.IsMaximal] + [Finite q.ResidueField] + (hdiv : Module.finrank C + (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField ∣ + Module.finrank C S) : + Module.finrank S q.ResidueField = 1 := by + rw [finiteFieldConstantExtensionResidue_finrank_over_constants_eq_div_gcd + C S N q] + rw [Nat.gcd_eq_right_iff_dvd.mpr hdiv] + exact Nat.div_self + (Module.finrank_pos (R := C) + (M := (finiteFieldConstantExtensionDownstairsIdeal + C S N q).ResidueField)) + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean new file mode 100644 index 0000000000..8ea1b638a8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean @@ -0,0 +1,117 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.Finite.Extension + +/-! +# Nested canonical finite-field extensions + +If `a ∣ b`, finite-field theory supplies an embedding from the chosen +degree-`a` extension into the chosen degree-`b` extension. This file fixes +one such embedding and records the scalar-tower and degree consequences used +by the constant-extension Hasse--Weil argument. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] +variable (p a b : ℕ) [Fact p.Prime] [CharP K p] +variable [NeZero a] [NeZero b] + +/-- A chosen `K`-algebra embedding between canonical finite-field extensions +whose degrees satisfy `a ∣ b`. -/ +noncomputable def finiteFieldExtensionAlgHomOfDvd (h : a ∣ b) : + FiniteField.Extension K p a →ₐ[K] + FiniteField.Extension K p b := + (FiniteField.nonempty_algHom_of_finrank_dvd (F := K) + (K := FiniteField.Extension K p a) + (L := FiniteField.Extension K p b) (by + rw [FiniteField.finrank_extension, FiniteField.finrank_extension] + exact h)).some + +/-- The algebra structure selected by `finiteFieldExtensionAlgHomOfDvd`. -/ +@[reducible] noncomputable def finiteFieldExtensionAlgebraOfDvd + (h : a ∣ b) : + Algebra (FiniteField.Extension K p a) + (FiniteField.Extension K p b) := + (finiteFieldExtensionAlgHomOfDvd K p a b h).toAlgebra + +/-- The selected divisible-degree embedding is compatible with the original +coefficient field. -/ +theorem finiteFieldExtension_isScalarTower_of_dvd (h : a ∣ b) : + letI : Algebra (FiniteField.Extension K p a) + (FiniteField.Extension K p b) := + finiteFieldExtensionAlgebraOfDvd K p a b h + IsScalarTower K (FiniteField.Extension K p a) + (FiniteField.Extension K p b) := by + letI : Algebra (FiniteField.Extension K p a) + (FiniteField.Extension K p b) := + finiteFieldExtensionAlgebraOfDvd K p a b h + apply IsScalarTower.of_algebraMap_eq' + ext c + exact (finiteFieldExtensionAlgHomOfDvd K p a b h).commutes c |>.symm + +/-- The relative degree of the chosen nested extension is the quotient of +the two absolute degrees. -/ +theorem finrank_finiteFieldExtension_of_dvd (h : a ∣ b) : + letI : Algebra (FiniteField.Extension K p a) + (FiniteField.Extension K p b) := + finiteFieldExtensionAlgebraOfDvd K p a b h + Module.finrank (FiniteField.Extension K p a) + (FiniteField.Extension K p b) = b / a := by + let E := FiniteField.Extension K p a + let L := FiniteField.Extension K p b + letI : Algebra E L := finiteFieldExtensionAlgebraOfDvd K p a b h + letI : IsScalarTower K E L := + finiteFieldExtension_isScalarTower_of_dvd K p a b h + letI : Module.Finite E L := Module.Finite.of_finite + have hmul : Module.finrank K E * Module.finrank E L = + Module.finrank K L := Module.finrank_mul_finrank K E L + rw [FiniteField.finrank_extension K p a, + FiniteField.finrank_extension K p b] at hmul + apply (Nat.eq_div_iff_mul_eq_left (NeZero.ne a) h).2 + simpa [Nat.mul_comm] using hmul.symm + +/-- The chosen degree-`2a` extension is quadratic over the chosen degree-`a` +subfield. -/ +theorem finrank_double_finiteFieldExtension : + letI : Algebra (FiniteField.Extension K p a) + (FiniteField.Extension K p (2 * a)) := + finiteFieldExtensionAlgebraOfDvd K p a (2 * a) ⟨2, by omega⟩ + Module.finrank (FiniteField.Extension K p a) + (FiniteField.Extension K p (2 * a)) = 2 := by + rw [finrank_finiteFieldExtension_of_dvd K p a (2 * a) ⟨2, by omega⟩] + simpa [Nat.mul_comm] using Nat.mul_div_cancel_left 2 (NeZero.pos a) + +/-- Cardinality of the degree-`2a` extension is the square of the +degree-`a` extension's cardinality. -/ +theorem natCard_double_finiteFieldExtension_eq_sq : + Nat.card (FiniteField.Extension K p (2 * a)) = + Nat.card (FiniteField.Extension K p a) ^ 2 := by + rw [FiniteField.natCard_extension K p (2 * a), + FiniteField.natCard_extension K p a] + ring + +/-- A positive multiple of the extension degree is already large enough to +dominate that degree. This elementary growth estimate is what makes one +fixed multiple work uniformly in the Stepanov construction. -/ +theorem degree_le_natCard_finiteFieldExtension_mul + (d n : ℕ) [NeZero (d * n)] (hn : 0 < n) : + d ≤ Nat.card (FiniteField.Extension K p (d * n)) := by + rw [FiniteField.natCard_extension K p (d * n)] + have hcard : 1 < Nat.card K := by + simpa only [Nat.card_eq_fintype_card] using + (Fintype.one_lt_card : 1 < Fintype.card K) + have hdPow : d ≤ Nat.card K ^ d := + (Nat.lt_pow_self hcard).le + exact hdPow.trans (Nat.pow_le_pow_right (Nat.card_pos) + (Nat.le_mul_of_pos_right d hn)) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean new file mode 100644 index 0000000000..be252e9f22 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean @@ -0,0 +1,343 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +import Mathlib.Algebra.Polynomial.Eval.Subring +import Mathlib.Algebra.Polynomial.GroupRingAction +import Mathlib.FieldTheory.Galois.Basic + +/-! +# The different of a finite coefficient extension at infinity + +For a finite Galois extension `S / C`, the infinity valuation ring over `S` +is the localization of the reciprocal polynomial ring `S[X]` at the image of +the reciprocal-origin complement from `C[X]`. The key denominator argument +uses the product of all Galois conjugates of a polynomial. + +This localization description transports finiteness and formal +unramifiedness from `C[X] → S[X]`. Consequently the local different of the +coefficient extension at infinity is the unit ideal. +-/ + +open scoped Polynomial TensorProduct nonZeroDivisors + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +variable (C S : Type*) [Field C] [Field S] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] + +local instance finiteFieldInfinityDifferentDecidableEqC : DecidableEq C := + Classical.decEq C +local instance finiteFieldInfinityDifferentDecidableEqS : DecidableEq S := + Classical.decEq S +local instance finiteFieldInfinityDifferentDecidableEqRatFuncC : + DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) +local instance finiteFieldInfinityDifferentDecidableEqRatFuncS : + DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + +local instance finiteFieldInfinityDifferentCoefficientPolynomialAlgebra : + Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance finiteFieldInfinityDifferentReciprocalPolynomialAlgebra : + Algebra S[X] (RatFuncInfinityIntegers S) := + ratFuncInfinityReciprocalPolynomialAlgebra S + +local instance finiteFieldInfinityDifferentCoefficientOriginPrime : + (Ideal.span ({Polynomial.X} : Set C[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +local instance finiteFieldInfinityDifferentExtensionOriginPrime : + (Ideal.span ({Polynomial.X} : Set S[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +omit [FiniteDimensional C S] [IsGalois C S] in +private theorem coefficientPrimeCompl_le_reciprocalPrimeCompl : + Algebra.algebraMapSubmonoid S[X] + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl ≤ + (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl := by + rintro _ ⟨p, hp, rfl⟩ + intro hmap + change p ∉ Ideal.span ({Polynomial.X} : Set C[X]) at hp + apply hp + rw [Ideal.mem_span_singleton, Polynomial.X_dvd_iff] + apply (algebraMap C S).injective + have hzero : + (algebraMap C[X] S[X] p).coeff 0 = 0 := + Polynomial.X_dvd_iff.mp (Ideal.mem_span_singleton.mp hmap) + simpa [Polynomial.algebraMap_def] using hzero + +private theorem exists_coefficient_multiple_of_not_mem_reciprocalOrigin + (p : S[X]) + (hp : p ∉ Ideal.span ({Polynomial.X} : Set S[X])) : + ∃ m : C[X], + m ∉ Ideal.span ({Polynomial.X} : Set C[X]) ∧ + p ∣ algebraMap C[X] S[X] m := by + let G := S ≃ₐ[C] S + let P : S[X] := ∏ g : G, g • p + have hp0 : p.coeff 0 ≠ 0 := by + intro hp0 + apply hp + rw [Ideal.mem_span_singleton, Polynomial.X_dvd_iff] + exact hp0 + have hPfixed (g : G) : g • P = P := by + exact Finset.smul_prod_perm p g + have hcoeffRange (n : ℕ) : + P.coeff n ∈ Set.range (algebraMap C S) := by + rw [IsGalois.mem_range_algebraMap_iff_fixed] + intro g + have hcoeffFixed := + congrArg (fun q : S[X] => q.coeff n) (hPfixed g) + simp only [Polynomial.smul_eq_map, Polynomial.coeff_map] at hcoeffFixed + change g • P.coeff n = P.coeff n at hcoeffFixed + calc + g (P.coeff n) = g • P.coeff n := + (AlgEquiv.smul_def g (P.coeff n)).symm + _ = P.coeff n := hcoeffFixed + have hPrange : + P ∈ (Polynomial.mapRingHom (algebraMap C S)).range := by + rw [Polynomial.mem_map_range] + exact hcoeffRange + obtain ⟨m, hm⟩ := hPrange + have hp_dvd_P : p ∣ P := by + have h := Finset.dvd_prod_of_mem (fun g : G => g • p) + (Finset.mem_univ (1 : G)) + change p ∣ ∏ g : G, g • p + simpa using h + have hP0 : P.coeff 0 ≠ 0 := by + change (∏ g : G, g • p).coeff 0 ≠ 0 + rw [Polynomial.coeff_zero_prod] + exact Finset.prod_ne_zero_iff.mpr fun g _ => by + rw [show (g • p).coeff 0 = g • p.coeff 0 by + simp [Polynomial.smul_eq_map]] + exact (smul_ne_zero_iff_ne g).2 hp0 + have hm0map : algebraMap C S (m.coeff 0) = P.coeff 0 := by + have := congrArg (fun q : S[X] => q.coeff 0) hm + simpa using this + have hm0 : m.coeff 0 ≠ 0 := by + intro hm0 + apply hP0 + rw [← hm0map, hm0, map_zero] + refine ⟨m, ?_, ?_⟩ + · intro hmOrigin + exact hm0 (Polynomial.X_dvd_iff.mp + (Ideal.mem_span_singleton.mp hmOrigin)) + · change p ∣ Polynomial.map (algebraMap C S) m + have hm' : Polynomial.map (algebraMap C S) m = P := hm + rw [hm'] + exact hp_dvd_P + +/-- The infinity valuation ring over `S` is already obtained by localizing +`S[X]` at the image of the reciprocal-origin complement from `C[X]`. -/ +theorem ratFuncInfinityIntegers_isLocalization_coefficientPrimeCompl : + IsLocalization + (Algebra.algebraMapSubmonoid S[X] + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) + (RatFuncInfinityIntegers S) := by + let M := Algebra.algebraMapSubmonoid S[X] + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl + let N := (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl + have hMN : M ≤ N := + coefficientPrimeCompl_le_reciprocalPrimeCompl C S + have hdiv : ∀ p ∈ N, ∃ m ∈ M, p ∣ m := by + intro p hp + obtain ⟨m, hmOrigin, hp_dvd⟩ := + exists_coefficient_multiple_of_not_mem_reciprocalOrigin C S p hp + exact ⟨algebraMap C[X] S[X] m, ⟨m, hmOrigin, rfl⟩, hp_dvd⟩ + exact (IsLocalization.iff_of_le_of_exists_dvd + (M := M) N hMN hdiv).mpr + (ratFuncInfinityIntegers_isLocalization_reciprocal S) + +section Corollaries + +local instance finiteFieldInfinityDifferentBaseReciprocalPolynomialAlgebra : + Algebra C[X] (RatFuncInfinityIntegers C) := + ratFuncInfinityReciprocalPolynomialAlgebra C + +local instance finiteFieldInfinityDifferentCoefficientAlgebra : + Algebra (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := + RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + +local instance (priority := low) + finiteFieldInfinityDifferentBasePolynomialExtensionAlgebra : + Algebra C[X] (RatFuncInfinityIntegers S) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncInfinityIntegers S)).comp + (algebraMap C[X] S[X])) + +local instance finiteFieldInfinityDifferentCoefficientPolynomialTower : + IsScalarTower C[X] S[X] (RatFuncInfinityIntegers S) := + IsScalarTower.of_algebraMap_eq' + (RingHom.algebraMap_toAlgebra _) + +omit [FiniteDimensional C S] [IsGalois C S] in +private theorem ratFuncCoefficientAlgHom_reciprocalPolynomialRingHom + (p : C[X]) : + ratFuncCoefficientAlgHom C S + (((reciprocalPolynomialRingHom C p : + RatFuncInfinityIntegers C) : RatFunc C)) = + ((reciprocalPolynomialRingHom S (algebraMap C[X] S[X] p) : + RatFuncInfinityIntegers S) : RatFunc S) := by + rw [reciprocalPolynomialRingHom_coe, + reciprocalPolynomialRingHom_coe] + change (ratFuncCoefficientAlgHom C S).toRingHom + (Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p) = _ + rw [Polynomial.hom_eval₂] + have hX : ratFuncCoefficientAlgHom C S RatFunc.X = RatFunc.X := by + have h := ratFuncCoefficientAlgHom_algebraMap C S Polynomial.X + simpa using h + have hcoeff : + (ratFuncCoefficientAlgHom C S).toRingHom.comp RatFunc.C = + RatFunc.C.comp (algebraMap C S) := by + ext c + change ratFuncCoefficientAlgHom C S + (algebraMap C (RatFunc C) c) = + algebraMap S (RatFunc S) (algebraMap C S c) + rw [(ratFuncCoefficientAlgHom C S).commutes] + exact IsScalarTower.algebraMap_apply C S (RatFunc S) c + have hrecip : (ratFuncCoefficientAlgHom C S).toRingHom + (1 / RatFunc.X) = 1 / RatFunc.X := by + rw [one_div, map_inv₀] + have hX' : (ratFuncCoefficientAlgHom C S).toRingHom RatFunc.X = + RatFunc.X := hX + simpa [hX'] + rw [hcoeff, hrecip] + change Polynomial.eval₂ (RatFunc.C.comp (algebraMap C S)) + (1 / RatFunc.X) p = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) + (Polynomial.map (algebraMap C S) p) + rw [Polynomial.eval₂_map] + +omit [FiniteDimensional C S] [IsGalois C S] in +private theorem reciprocalPolynomialAlgebraMap_commutes (p : C[X]) : + algebraMap (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) + (algebraMap C[X] (RatFuncInfinityIntegers C) p) = + algebraMap C[X] (RatFuncInfinityIntegers S) p := by + simp only [RingHom.algebraMap_toAlgebra, RingHom.comp_apply] + apply Subtype.ext + exact ratFuncCoefficientAlgHom_reciprocalPolynomialRingHom C S p + +local instance finiteFieldInfinityDifferentBasePolynomialCoefficientTower : + IsScalarTower C[X] (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := + IsScalarTower.of_algebraMap_eq fun p => + (reciprocalPolynomialAlgebraMap_commutes C S p).symm + +local instance finiteFieldInfinityDifferentCoefficientPolynomialModuleFinite : + Module.Finite C[X] S[X] := by + letI : Module.Finite C[X] (C[X] ⊗[C] S) := + Module.Finite.base_change C C[X] S + exact Module.Finite.equiv + (Algebra.IsPushout.equiv C C[X] S S[X]).toLinearEquiv + +/-- The coefficient extension of infinity valuation rings is finite. -/ +theorem ratFuncInfinityIntegers_coefficient_moduleFinite : + Module.Finite (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := by + letI : IsLocalization + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl + (RatFuncInfinityIntegers C) := + ratFuncInfinityIntegers_isLocalization_reciprocal C + letI : IsLocalization + (Algebra.algebraMapSubmonoid S[X] + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) + (RatFuncInfinityIntegers S) := + ratFuncInfinityIntegers_isLocalization_coefficientPrimeCompl C S + exact Module.Finite.of_isLocalization C[X] S[X] + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl + +local instance finiteFieldInfinityDifferentCoefficientModuleFinite : + Module.Finite (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := + ratFuncInfinityIntegers_coefficient_moduleFinite C S + +local instance finiteFieldInfinityDifferentCoefficientIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact ratFuncInfinityIntegersRingHom_injective C S + +/-- The coefficient extension of infinity valuation rings is formally +unramified. -/ +theorem ratFuncInfinityIntegers_coefficient_formallyUnramified : + Algebra.FormallyUnramified (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) := by + letI : IsLocalization + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl + (RatFuncInfinityIntegers C) := + ratFuncInfinityIntegers_isLocalization_reciprocal C + letI : IsLocalization + (Algebra.algebraMapSubmonoid S[X] + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) + (RatFuncInfinityIntegers S) := + ratFuncInfinityIntegers_isLocalization_coefficientPrimeCompl C S + letI : IsLocalization + (Submonoid.map (algebraMap C[X] S[X]) + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) + (RatFuncInfinityIntegers S) := by + simpa only [Algebra.algebraMapSubmonoid] using + ratFuncInfinityIntegers_isLocalization_coefficientPrimeCompl C S + letI : Algebra.FormallyUnramified C[X] S[X] := + coefficientPolynomial_formallyUnramified C S + exact Algebra.FormallyUnramified.localization_map + (R := C[X]) (S := S[X]) + (Rₘ := RatFuncInfinityIntegers C) + (Sₘ := RatFuncInfinityIntegers S) + (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl + +/-- A finite Galois coefficient extension has unit different at the infinity +valuation ring. -/ +theorem ratFuncInfinityIntegers_coefficient_differentIdeal_eq_top : + differentIdeal (RatFuncInfinityIntegers C) + (RatFuncInfinityIntegers S) = ⊤ := by + let A := RatFuncInfinityIntegers C + let B := RatFuncInfinityIntegers S + letI : Algebra.FormallyUnramified A B := + ratFuncInfinityIntegers_coefficient_formallyUnramified C S + letI : IsIntegralClosure B A (FractionRing B) := + IsIntegralClosure.of_isIntegrallyClosed B A (FractionRing B) + letI : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := + isAlgebraic_of_isFractionRing A B .. + letI : IsLocalization + (Algebra.algebraMapSubmonoid B A⁰) (FractionRing B) := + IsIntegralClosure.isLocalization A (FractionRing A) + (FractionRing B) B + letI : FiniteDimensional (FractionRing A) (FractionRing B) := + Module.Finite.of_isLocalization A B A⁰ + letI : Algebra.FormallyUnramified B (FractionRing B) := + Algebra.FormallyUnramified.of_isLocalization B⁰ + letI : Algebra.FormallyUnramified A (FractionRing B) := + Algebra.FormallyUnramified.comp A B (FractionRing B) + letI : Algebra.FormallyUnramified (FractionRing A) (FractionRing B) := + Algebra.FormallyUnramified.localization_base A⁰ + letI : Algebra.IsSeparable (FractionRing A) (FractionRing B) := + Algebra.FormallyUnramified.isSeparable + (FractionRing A) (FractionRing B) + by_contra htop + obtain ⟨P, hPmax, hdiffP⟩ := + Ideal.exists_le_maximal (differentIdeal A B) htop + letI : P.IsPrime := hPmax.isPrime + have hunram : Algebra.IsUnramifiedAt A P := by + exact Algebra.formallyUnramified_iff_forall.mp + (show Algebra.FormallyUnramified A B from inferInstance) + ⟨P, hPmax.isPrime⟩ + exact (not_dvd_differentIdeal_iff.mpr hunram) + (Ideal.dvd_iff_le.mpr hdiffP) + +end Corollaries + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean new file mode 100644 index 0000000000..af60bb460b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean @@ -0,0 +1,136 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.DedekindDomain.Different +import Mathlib.RingTheory.PolynomialAlgebra +import Mathlib.RingTheory.Unramified.Field + +/-! +# The different of a separable coefficient extension + +Let `S / C` be a finite separable extension of fields. For the coefficientwise +algebra structure on `S[X]` over `C[X]`, the different ideal is the unit ideal. + +The proof first identifies `S[X]` with the polynomial base change +`C[X] ⊗[C] S`. Formal unramifiedness therefore follows from separability of +`S / C`. After localizing both polynomial rings, the induced extension of +rational function fields is finite and formally unramified, hence separable. +The local characterization of the Dedekind different then excludes every +maximal ideal from the support of the different. + +The final corollary specializes this to arbitrary extensions of finite fields; +their finiteness and separability are supplied by typeclass inference. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C S : Type*) [Field C] [Field S] + [Algebra C S] [FiniteDimensional C S] [Algebra.IsSeparable C S] + +local instance differentCoefficientPolynomialAlgebra : Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance differentCoefficientPolynomialTower : IsScalarTower C C[X] S[X] := + IsScalarTower.of_algebraMap_eq' (by + ext c + simp) + +local instance differentConstantPolynomialTower : IsScalarTower C S S[X] := + IsScalarTower.of_algebraMap_eq' (by + ext c + simp) + +attribute [local instance] FractionRing.liftAlgebra + +local instance differentCoefficientPolynomialModuleFinite : Module.Finite C[X] S[X] := by + letI : Module.Finite C[X] (C[X] ⊗[C] S) := + Module.Finite.base_change C C[X] S + exact Module.Finite.equiv + (Algebra.IsPushout.equiv C C[X] S S[X]).toLinearEquiv + +local instance differentCoefficientPolynomialFormallyUnramified : + Algebra.FormallyUnramified C[X] S[X] := by + letI : Algebra.FormallyUnramified C S := + Algebra.FormallyUnramified.of_isSeparable C S + letI : Algebra.FormallyUnramified C[X] (C[X] ⊗[C] S) := + Algebra.FormallyUnramified.base_change C[X] + exact Algebra.FormallyUnramified.of_equiv + (Algebra.IsPushout.equiv C C[X] S S[X]) + +local instance differentCoefficientRationalFunctionAlgebraic : + Algebra.IsAlgebraic (FractionRing C[X]) (FractionRing S[X]) := + isAlgebraic_of_isFractionRing C[X] S[X] .. + +local instance differentCoefficientPolynomialIntegralClosure : + IsIntegralClosure S[X] C[X] (FractionRing S[X]) := + IsIntegralClosure.of_isIntegrallyClosed S[X] C[X] (FractionRing S[X]) + +local instance differentCoefficientRationalFunctionLocalization : + IsLocalization + (Algebra.algebraMapSubmonoid S[X] (nonZeroDivisors C[X])) + (FractionRing S[X]) := + IsIntegralClosure.isLocalization C[X] (FractionRing C[X]) + (FractionRing S[X]) S[X] + +local instance differentCoefficientRationalFunctionFiniteDimensional : + FiniteDimensional (FractionRing C[X]) (FractionRing S[X]) := + Module.Finite.of_isLocalization C[X] S[X] (nonZeroDivisors C[X]) + +local instance differentCoefficientRationalFunctionFormallyUnramified : + Algebra.FormallyUnramified + (FractionRing C[X]) (FractionRing S[X]) := by + letI : Algebra.FormallyUnramified C[X] (FractionRing S[X]) := inferInstance + exact Algebra.FormallyUnramified.localization_base (nonZeroDivisors C[X]) + +local instance differentCoefficientRationalFunctionSeparable : + Algebra.IsSeparable (FractionRing C[X]) (FractionRing S[X]) := + Algebra.FormallyUnramified.isSeparable + (FractionRing C[X]) (FractionRing S[X]) + +omit [FiniteDimensional C S] in +/-- A finite separable extension of coefficient fields induces a formally +unramified extension of polynomial rings. -/ +theorem coefficientPolynomial_formallyUnramified : + Algebra.FormallyUnramified C[X] S[X] := + inferInstance + +/-- A finite separable extension of coefficient fields induces a separable +extension of the corresponding rational function fields. -/ +theorem coefficientRationalFunction_isSeparable : + Algebra.IsSeparable (FractionRing C[X]) (FractionRing S[X]) := + inferInstance + +/-- For a finite separable coefficient-field extension, the different of the +coefficientwise polynomial-ring extension is the unit ideal. -/ +theorem coefficientPolynomial_differentIdeal_eq_top : + differentIdeal C[X] S[X] = ⊤ := by + by_contra htop + obtain ⟨P, hPmax, hdiffP⟩ := + Ideal.exists_le_maximal (differentIdeal C[X] S[X]) htop + letI : P.IsPrime := hPmax.isPrime + have hunram : Algebra.IsUnramifiedAt C[X] P := by + exact + Algebra.formallyUnramified_iff_forall.mp + (show Algebra.FormallyUnramified C[X] S[X] from inferInstance) + ⟨P, hPmax.isPrime⟩ + exact + (not_dvd_differentIdeal_iff.mpr hunram) + (Ideal.dvd_iff_le.mpr hdiffP) + +/-- In particular, every extension of finite fields has unit different after +coefficientwise extension of polynomial rings. -/ +theorem finiteFieldPolynomial_differentIdeal_eq_top + (k F : Type*) [Field k] [Fintype k] [Field F] [Finite F] [Algebra k F] : + differentIdeal k[X] F[X] = ⊤ := + coefficientPolynomial_differentIdeal_eq_top k F + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean new file mode 100644 index 0000000000..eac3b8fe61 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.PolynomialAlgebra +import Mathlib.RingTheory.Smooth.Field +import Mathlib.RingTheory.Smooth.IntegralClosure + +/-! +# Normalization after finite constant extension + +Smooth base change commutes with integral closure. Applied to the coefficient +extension `C[X] → S[X]`, this identifies the base change of the normalization +of a `C[X]`-algebra with the normalization of its polynomial base change. + +The first declaration records the general smooth statement. The second +specializes it to finite fields: finiteness makes `S / C` finite type, while +the perfectness of `C` supplies formal smoothness. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C S N : Type*) [Field C] [Field S] [Algebra C S] + [CommRing N] [Algebra C[X] N] + +local instance finiteFieldNormalizationPolynomialCoefficientAlgebra : + Algebra C[X] S[X] := + Polynomial.algebra C S + +/-- Smooth coefficient extension commutes with normalization over the +polynomial base. -/ +noncomputable def polynomialIntegralClosureBaseChangeAlgEquiv + [Algebra.Smooth C S] : + S[X] ⊗[C[X]] integralClosure C[X] N ≃ₐ[S[X]] + integralClosure S[X] (S[X] ⊗[C[X]] N) := by + letI : Algebra.Smooth C[X] (C[X] ⊗[C] S) := inferInstance + letI : Algebra.Smooth C[X] S[X] := + Algebra.Smooth.of_equiv (Algebra.IsPushout.equiv C C[X] S S[X]) + exact AlgEquiv.ofBijective + (TensorProduct.toIntegralClosure C[X] S[X] N) + TensorProduct.toIntegralClosure_bijective_of_smooth + +/-- For an extension of finite fields, coefficient extension commutes with +normalization over the polynomial base. -/ +noncomputable def finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv + [Fintype C] [Finite S] : + S[X] ⊗[C[X]] integralClosure C[X] N ≃ₐ[S[X]] + integralClosure S[X] (S[X] ⊗[C[X]] N) := by + letI : Algebra.Smooth C S := + { formallySmooth := inferInstance + finitePresentation := + Algebra.FinitePresentation.of_finiteType.mp inferInstance } + exact polynomialIntegralClosureBaseChangeAlgEquiv C S N + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean new file mode 100644 index 0000000000..6544960798 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.Finite.GaloisField + +/-! +# Finite subfields in a common overfield + +Finite fields have a unique subfield of each possible degree inside a fixed +finite overfield. The form needed for constant extensions is an inclusion of +the ranges of two specified embeddings: if the degree of `A / C` divides the +degree of `B / C`, then the image of `A` lies in the image of `B`. + +The proof is elementary and keeps the embeddings explicit. The image of `B` +already supplies `#B` roots of `X ^ (#B) - X`; the polynomial has at most +`#B` roots. Divisibility of extension degrees then shows that every element +of the image of `A` is another root of the same polynomial. +-/ + +open Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +/-- In a common finite overfield, the image of a finite field of degree `d` +is contained in the image of one of degree `n` whenever `d ∣ n` over the +same finite base field. -/ +theorem finiteField_fieldRange_le_of_finrank_dvd + {C A B Ω : Type*} + [Field C] [Field A] [Field B] [Field Ω] + [Algebra C A] [Algebra C B] [Algebra C Ω] + [Finite C] [Finite A] [Finite B] [Finite Ω] + (f : A →ₐ[C] Ω) (g : B →ₐ[C] Ω) + (hdiv : Module.finrank C A ∣ Module.finrank C B) : + f.fieldRange ≤ g.fieldRange := by + letI : Fintype C := Fintype.ofFinite C + letI : Fintype A := Fintype.ofFinite A + letI : Fintype B := Fintype.ofFinite B + letI : Fintype Ω := Fintype.ofFinite Ω + classical + let p : Ω[X] := X ^ Fintype.card B - X + have hcardB : 1 < Fintype.card B := Fintype.one_lt_card + have hp0 : p ≠ 0 := FiniteField.X_pow_card_sub_X_ne_zero Ω hcardB + have himageRoots : Finset.univ.image g ⊆ p.roots.toFinset := by + intro y hy + rw [Finset.mem_image] at hy + obtain ⟨x, -, rfl⟩ := hy + rw [Multiset.mem_toFinset, Polynomial.mem_roots hp0, IsRoot.def] + simp only [p, eval_sub, eval_pow, eval_X] + rw [← map_pow, FiniteField.pow_card, sub_self] + have himageCard : (Finset.univ.image g).card = Fintype.card B := by + rw [Finset.card_image_iff.mpr] + · exact Finset.card_univ + · exact g.injective.injOn + have hrootsCard : p.roots.toFinset.card ≤ Fintype.card B := by + calc + p.roots.toFinset.card ≤ p.roots.card := Multiset.toFinset_card_le _ + _ ≤ p.natDegree := Polynomial.card_roots' p + _ = Fintype.card B := + FiniteField.X_pow_card_sub_X_natDegree_eq Ω hcardB + have hrootsEq : p.roots.toFinset = Finset.univ.image g := by + exact (Finset.eq_of_subset_of_card_le himageRoots + (by simpa [himageCard] using hrootsCard)).symm + intro y hy + rw [AlgHom.mem_fieldRange] at hy ⊢ + obtain ⟨x, rfl⟩ := hy + obtain ⟨k, hk⟩ := hdiv + have hroot : f x ∈ p.roots := by + rw [Polynomial.mem_roots hp0, IsRoot.def] + simp only [p, eval_sub, eval_pow, eval_X] + rw [Module.card_eq_pow_finrank (K := C) (V := B), hk, pow_mul, + ← Module.card_eq_pow_finrank (K := C) (V := A)] + rw [← map_pow, FiniteField.pow_card_pow, sub_self] + have hmem : f x ∈ Finset.univ.image g := by + rw [← hrootsEq] + exact Multiset.mem_toFinset.mpr hroot + rw [Finset.mem_image] at hmem + obtain ⟨z, -, hz⟩ := hmem + exact ⟨z, hz⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean new file mode 100644 index 0000000000..2d55750832 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.Dimension.StrongRankCondition +import Mathlib.LinearAlgebra.FreeModule.Finite.Basic + +/-! +# Finite-dimensionality from uniform finite independence bounds + +Čech obstruction spaces are naturally presented as quotients of an +infinite-dimensional function field. It is often easier to bound each +finite linearly independent family than to exhibit one global finite set of +generators. The lemma below packages the standard basis argument converting +that uniform bound into finite-dimensionality and a `finrank` estimate. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +universe u v + +/-- If every finite linearly independent family in a vector space has at +most `g` elements, then the whole space is finite-dimensional of dimension +at most `g`. -/ +theorem moduleFinite_and_finrank_le_of_finite_linearIndependent_card_le + {K : Type u} {V : Type v} + [DivisionRing K] [AddCommGroup V] [Module K V] + (g : ℕ) + (hbound : ∀ (ι : Type v) [Fintype ι] (v : ι → V), + LinearIndependent K v → Fintype.card ι ≤ g) : + Module.Finite K V ∧ Module.finrank K V ≤ g := by + classical + let b := Module.Basis.ofVectorSpace K V + let ι := Module.Basis.ofVectorSpaceIndex K V + have hιFinite : Finite ι := by + rw [← not_infinite_iff_finite] + intro hιInfinite + letI : Infinite ι := hιInfinite + obtain ⟨s, hs⟩ := Infinite.exists_subset_card_eq ι (g + 1) + let v : s → V := fun i ↦ b i.1 + have hv : LinearIndependent K v := + b.linearIndependent.comp _ Subtype.val_injective + have hle := hbound s v hv + have hcard : Fintype.card s = g + 1 := by + simpa only [Fintype.card_coe] using hs + omega + letI : Finite ι := hιFinite + letI : Fintype ι := Fintype.ofFinite ι + let hfinite : Module.Finite K V := Module.Finite.of_basis b + letI : Module.Finite K V := hfinite + refine ⟨hfinite, ?_⟩ + rw [Module.finrank_eq_card_basis b] + exact hbound ι b b.linearIndependent + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean new file mode 100644 index 0000000000..ed5679e7bd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.DedekindDomain.AdicValuation +import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas +import Mathlib.RingTheory.Localization.Integer +import Mathlib.Tactic + +/-! +# Weak approximation at finite places + +This file proves the finite-place weak-approximation theorem needed for +function-field Riemann--Roch constructions. For finitely many distinct +height-one prime ideals, one may prescribe an element of the fraction field +to arbitrary positive order. The resulting global fraction is integral at +every other height-one prime. + +The proof is elementary Dedekind-domain algebra. First clear all prescribed +fractions by one denominator. The numerator is then chosen by the Chinese +remainder theorem. At a selected prime the modulus contains both the desired +precision and the multiplicity of the common denominator. At every other +prime dividing the denominator, a zero residue cancels the complete +denominator multiplicity. + +Mathlib's multiplicative adic valuation is `exp (-order)`. Thus +`v.valuation L (z - x) ≤ exp (-n)` means that `z - x` has additive order at +least `n`, while `v.valuation L z ≤ 1` means that `z` is regular at `v`. +-/ + +namespace BGS.HasseWeil + +open IsDedekindDomain UniqueFactorizationMonoid +open scoped nonZeroDivisors + +noncomputable section + +/-- If the numerator contains every occurrence of a height-one prime in the +denominator, the resulting fraction is integral at that prime. -/ +theorem valuation_div_algebraMap_le_one_of_mem_denominatorPower + {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + (v : HeightOneSpectrum R) (numerator denominator : R) + (hdenominator : denominator ≠ 0) + (hnumerator : numerator ∈ + v.asIdeal ^ + (normalizedFactors (Ideal.span ({denominator} : Set R))).count v.asIdeal) : + v.valuation L + (algebraMap R L numerator / algebraMap R L denominator) ≤ 1 := by + classical + let m : ℕ := + (normalizedFactors (Ideal.span ({denominator} : Set R))).count v.asIdeal + have hspan : Ideal.span ({denominator} : Set R) ≠ (⊥ : Ideal R) := by + exact Ideal.span_singleton_eq_bot.not.mpr hdenominator + have hdenominatorValuation : + v.intValuation denominator = WithZero.exp (-(m : ℤ)) := by + rw [v.intValuation_eq_exp_neg_multiplicity hdenominator, + multiplicity_eq_count_normalizedFactors v.irreducible hspan] + simp [m] + have hnumeratorValuation : + v.intValuation numerator ≤ WithZero.exp (-(m : ℤ)) := by + exact (v.intValuation_le_pow_iff_mem numerator m).mpr hnumerator + calc + v.valuation L + (algebraMap R L numerator / algebraMap R L denominator) = + v.valuation L (algebraMap R L numerator) / + v.valuation L (algebraMap R L denominator) := + (v.valuation L).map_div _ _ + _ = v.intValuation numerator / WithZero.exp (-(m : ℤ)) := by + rw [v.valuation_of_algebraMap, v.valuation_of_algebraMap, + hdenominatorValuation] + _ ≤ 1 := + (div_le_one₀ (show 0 < WithZero.exp (-(m : ℤ)) from + WithZero.exp_pos)).mpr hnumeratorValuation + +/-- A congruence modulo the desired prime power plus the denominator +multiplicity gives the corresponding adic approximation bound after division +by the denominator. -/ +theorem valuation_sub_div_algebraMap_le_of_mem_denominatorPrecisionPower + {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + (v : HeightOneSpectrum R) (numerator target denominator : R) + (precision : ℕ) (hdenominator : denominator ≠ 0) + (hnumerator : numerator - target ∈ + v.asIdeal ^ + (precision + + (normalizedFactors (Ideal.span ({denominator} : Set R))).count v.asIdeal)) : + v.valuation L + (algebraMap R L numerator / algebraMap R L denominator - + algebraMap R L target / algebraMap R L denominator) ≤ + WithZero.exp (-(precision : ℤ)) := by + classical + let m : ℕ := + (normalizedFactors (Ideal.span ({denominator} : Set R))).count v.asIdeal + have hspan : Ideal.span ({denominator} : Set R) ≠ (⊥ : Ideal R) := by + exact Ideal.span_singleton_eq_bot.not.mpr hdenominator + have hdenominatorValuation : + v.intValuation denominator = WithZero.exp (-(m : ℤ)) := by + rw [v.intValuation_eq_exp_neg_multiplicity hdenominator, + multiplicity_eq_count_normalizedFactors v.irreducible hspan] + simp [m] + have hnumeratorValuation : + v.intValuation (numerator - target) ≤ + WithZero.exp (-((precision + m : ℕ) : ℤ)) := by + exact (v.intValuation_le_pow_iff_mem (numerator - target) + (precision + m)).mpr hnumerator + have hfractionIdentity : + algebraMap R L numerator / algebraMap R L denominator - + algebraMap R L target / algebraMap R L denominator = + algebraMap R L (numerator - target) / algebraMap R L denominator := by + rw [map_sub] + ring + rw [hfractionIdentity] + calc + v.valuation L + (algebraMap R L (numerator - target) / + algebraMap R L denominator) = + v.intValuation (numerator - target) / + WithZero.exp (-(m : ℤ)) := by + rw [(v.valuation L).map_div, v.valuation_of_algebraMap, + v.valuation_of_algebraMap, hdenominatorValuation] + _ ≤ WithZero.exp (-((precision + m : ℕ) : ℤ)) / + WithZero.exp (-(m : ℤ)) := + (div_le_div_iff_of_pos_right + (show 0 < WithZero.exp (-(m : ℤ)) from WithZero.exp_pos)).mpr + hnumeratorValuation + _ = WithZero.exp (-(precision : ℤ)) := by + rw [← WithZero.exp_sub] + congr 1 + push_cast + omega + +/-- Chinese-remainder numerator selection with simultaneous denominator +cancellation. At selected primes the congruence precision is increased by +the denominator multiplicity. Every unselected prime factor of the +denominator divides the chosen numerator to its full multiplicity. -/ +theorem exists_numerator_prescribedPrimePower_and_denominatorSupport + {R : Type*} [CommRing R] [IsDedekindDomain R] + (selected : Finset (Ideal R)) (denominatorIdeal : Ideal R) + (hselectedPrime : ∀ P ∈ selected, Prime P) + (target : selected → R) (precision : selected → ℕ) : + ∃ numerator : R, + (∀ P : selected, + numerator - target P ∈ + (P : Ideal R) ^ + (precision P + + (normalizedFactors denominatorIdeal).count (P : Ideal R))) ∧ + (∀ Q ∈ (normalizedFactors denominatorIdeal).toFinset, + Q ∉ selected → + numerator ∈ Q ^ (normalizedFactors denominatorIdeal).count Q) := by + classical + let support : Finset (Ideal R) := + selected ∪ (normalizedFactors denominatorIdeal).toFinset + let exponent : Ideal R → ℕ := fun Q => + if hQ : Q ∈ selected then + precision ⟨Q, hQ⟩ + (normalizedFactors denominatorIdeal).count Q + else + (normalizedFactors denominatorIdeal).count Q + let residue : support → R := fun Q => + if hQ : (Q : Ideal R) ∈ selected then target ⟨Q, hQ⟩ else 0 + have hsupportPrime : ∀ Q ∈ support, Prime Q := by + intro Q hQ + rcases Finset.mem_union.mp hQ with hQselected | hQdenominator + · exact hselectedPrime Q hQselected + · exact prime_of_normalized_factor Q + (Multiset.mem_toFinset.mp hQdenominator) + obtain ⟨numerator, hnumerator⟩ := + IsDedekindDomain.exists_forall_sub_mem_ideal + (s := support) (P := id) exponent hsupportPrime + (by + intro i hi j hj hij + simpa using hij) + residue + refine ⟨numerator, ?_, ?_⟩ + · intro P + have hPsupport : (P : Ideal R) ∈ support := + Finset.mem_union_left _ P.property + have h := hnumerator (P : Ideal R) hPsupport + simpa [residue, exponent, P.property] using h + · intro Q hQdenominator hQselected + have hQsupport : Q ∈ support := + Finset.mem_union_right _ hQdenominator + have h := hnumerator Q hQsupport + simpa [residue, exponent, hQselected] using h + +/-- Finite-place weak approximation in a Dedekind fraction field. + +The selected ideals must be prime. The function `target` prescribes a local +fraction at each selected ideal, and `precision` prescribes its approximation +order. The returned global fraction has that approximation order at every +selected height-one place and is integral at every unselected height-one +place. -/ +theorem exists_fraction_approximating_at_finitePlaces_regular_elsewhere + {R L : Type*} [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra R L] [IsFractionRing R L] + (selected : Finset (Ideal R)) + (hselectedPrime : ∀ P ∈ selected, Prime P) + (target : Ideal R → L) (precision : Ideal R → ℕ) : + ∃ z : L, + (∀ v : HeightOneSpectrum R, v.asIdeal ∈ selected → + v.valuation L (z - target v.asIdeal) ≤ + WithZero.exp (-(precision v.asIdeal : ℤ))) ∧ + (∀ v : HeightOneSpectrum R, v.asIdeal ∉ selected → + v.valuation L z ≤ 1) := by + classical + let denominator : nonZeroDivisors R := + IsLocalization.commonDenom (nonZeroDivisors R) selected target + let localNumerator : selected → R := + IsLocalization.integerMultiple (nonZeroDivisors R) selected target + obtain ⟨numerator, hselected, hdenominatorSupport⟩ := + exists_numerator_prescribedPrimePower_and_denominatorSupport + selected (Ideal.span ({(denominator : R)} : Set R)) + hselectedPrime localNumerator (fun P => precision (P : Ideal R)) + let z : L := + algebraMap R L numerator / algebraMap R L (denominator : R) + refine ⟨z, ?_, ?_⟩ + · intro v hv + let P : selected := ⟨v.asIdeal, hv⟩ + have hlocal := + valuation_sub_div_algebraMap_le_of_mem_denominatorPrecisionPower + (L := L) v numerator (localNumerator P) (denominator : R) + (precision v.asIdeal) + (nonZeroDivisors.ne_zero denominator.property) + (by simpa [P] using hselected P) + have hmap' : + algebraMap R L (localNumerator P) = + algebraMap R L (denominator : R) * target v.asIdeal := by + change algebraMap R L + (IsLocalization.integerMultiple (nonZeroDivisors R) selected target P) = + algebraMap R L + ((IsLocalization.commonDenom + (nonZeroDivisors R) selected target : nonZeroDivisors R) : R) * + target v.asIdeal + rw [IsLocalization.map_integerMultiple] + simp only [Submonoid.smul_def, Algebra.smul_def] + rfl + have hdenominatorMap : algebraMap R L (denominator : R) ≠ 0 := by + intro hzero + apply nonZeroDivisors.ne_zero denominator.property + apply IsFractionRing.injective R L + rw [map_zero] + exact hzero + have htarget : + algebraMap R L (localNumerator P) / + algebraMap R L (denominator : R) = + target v.asIdeal := by + rw [hmap'] + field_simp + change v.valuation L + (algebraMap R L numerator / algebraMap R L (denominator : R) - + target v.asIdeal) ≤ WithZero.exp (-(precision v.asIdeal : ℤ)) + rw [← htarget] + exact hlocal + · intro v hv + have hnumeratorPower : numerator ∈ + v.asIdeal ^ + (normalizedFactors + (Ideal.span ({(denominator : R)} : Set R))).count v.asIdeal := by + by_cases hfactor : v.asIdeal ∈ + (normalizedFactors + (Ideal.span ({(denominator : R)} : Set R))).toFinset + · exact hdenominatorSupport v.asIdeal hfactor hv + · have hcount : + (normalizedFactors + (Ideal.span ({(denominator : R)} : Set R))).count v.asIdeal = 0 := by + exact Multiset.count_eq_zero.mpr (by simpa using hfactor) + simp [hcount] + simpa [z] using + valuation_div_algebraMap_le_one_of_mem_denominatorPower + (L := L) v numerator (denominator : R) + (nonZeroDivisors.ne_zero denominator.property) hnumeratorPower + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean new file mode 100644 index 0000000000..9b1f16480b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower + +/-! +# Local place actions in a Frobenius fiber + +This file supplies the local ideal-theoretic bridge used by the +Frobenius-coset step of the Hasse--Weil argument. + +First, if a maximal ideal has residue degree one over a constant field `S`, +then the kernel of the constant restriction map on its decomposition group is +exactly its inertia group. This is proved directly from the induced action on +the residue field; it assumes no point-count estimate. + +Second, relative Galois conjugation preserves absolute place degree, so it +acts on places of any prescribed degree. On each finite or infinity +restriction fiber, the stabilizer of a point is identified with the existing +decomposition group. +-/ + +open scoped Pointwise Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain + +section ResidueDegreeOne + +variable {C S A G : Type*} + [Field C] [Field S] [CommRing A] + [Algebra C S] [Algebra S A] + [Group G] [MulSemiringAction G A] + +/-- If a maximal ideal has residue degree one over `S`, and the action on the +ambient ring restricts along `π` to the stated action on `S`, then the kernel +of `π` on the decomposition group is exactly the inertia group. -/ +theorem stabilizerRestriction_ker_eq_inertia_of_residue_finrank_one + (q : Ideal A) [q.IsMaximal] + (π : G →* (S ≃ₐ[C] S)) + (hcompat : ∀ (g : G) (s : S), + g • algebraMap S A s = algebraMap S A (π g s)) + (hdegree : Module.finrank S q.ResidueField = 1) : + (π.comp (MulAction.stabilizer G q).subtype).ker = + q.inertia (MulAction.stabilizer G q) := by + ext g + change π g.1 = 1 ↔ ∀ x : A, g.1 • x - x ∈ q + constructor + · intro hg x + have hsurj : Function.Surjective (algebraMap S q.ResidueField) := + (Algebra.finrank_eq_one_iff_bijective_algebraMap.mp hdegree).2 + obtain ⟨s, hs⟩ := hsurj (algebraMap A q.ResidueField x) + have hx : x - algebraMap S A s ∈ q := by + rw [← Ideal.algebraMap_residueField_eq_zero] + rw [map_sub, ← IsScalarTower.algebraMap_apply S A q.ResidueField, hs, + sub_self] + have hgx : g.1 • (x - algebraMap S A s) ∈ q := by + have hmem := Ideal.smul_mem_pointwise_smul g.1 + (x - algebraMap S A s) q hx + rw [g.2] at hmem + exact hmem + have hfixs : g.1 • algebraMap S A s = algebraMap S A s := by + rw [hcompat, hg] + rfl + simpa [smul_sub, hfixs] using q.sub_mem hgx hx + · intro hg + apply AlgEquiv.ext + intro s + have hsMem : algebraMap S A (π g.1 s) - algebraMap S A s ∈ q := by + simpa [hcompat] using hg (algebraMap S A s) + have hAZero : algebraMap A q.ResidueField + (algebraMap S A (π g.1 s - s)) = 0 := + Ideal.algebraMap_residueField_eq_zero.mpr (by + simpa only [map_sub] using hsMem) + have hsZero : algebraMap S q.ResidueField (π g.1 s - s) = 0 := by + calc + algebraMap S q.ResidueField (π g.1 s - s) = + algebraMap A q.ResidueField + (algebraMap S A (π g.1 s - s)) := + IsScalarTower.algebraMap_apply S A q.ResidueField _ + _ = 0 := hAZero + have : π g.1 s - s = 0 := by + apply (algebraMap S q.ResidueField).injective + simpa using hsZero + simpa using sub_eq_zero.mp this + +end ResidueDegreeOne + +section FunctionFieldPlaces + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (M : Type*) [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra M L] [IsScalarTower (RatFunc K) M L] + [IsGalois M L] + +/-- Relative Galois conjugation preserves the absolute degree of a finite +place. -/ +theorem finiteExtensionFinitePlace_degree_finitePlaceGalSmul + (g : Gal(L/M)) (P : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K L + (.inl (finitePlaceGalSmul K M L g P)) = + finiteExtensionPlaceDegree K L (.inl P) := by + rw [finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M L, + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M L] + rw [finitePlaceUnder_finitePlaceGalSmul] + have hlocal := + finitePlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under + K M L (finitePlaceGalSmul K M L g P) P + (finitePlaceUnder_finitePlaceGalSmul K M L g P) + rw [hlocal.2] + +/-- Relative Galois conjugation preserves the absolute degree of a place +above infinity. -/ +theorem finiteExtensionInfinityPlace_degree_infinityPlaceGalSmul + (g : Gal(L/M)) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPlaceDegree K L + (.inr (infinityPlaceGalSmul K M L g P)) = + finiteExtensionPlaceDegree K L (.inr P) := by + rw [finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M L, + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M L] + rw [infinityPlaceUnder_infinityPlaceGalSmul] + have hlocal := + infinityPlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under + K M L (infinityPlaceGalSmul K M L g P) P + (infinityPlaceUnder_infinityPlaceGalSmul K M L g P) + rw [hlocal.2] + +/-- Finite places of a prescribed absolute degree. -/ +abbrev FiniteExtensionFinitePlaceOfDegree (d : ℕ) := + {P : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl P) = d} + +/-- Places above infinity of a prescribed absolute degree. -/ +abbrev FiniteExtensionInfinityPlaceOfDegree (d : ℕ) := + {P : FiniteExtensionInfinityPlace K L // + finiteExtensionPlaceDegree K L (.inr P) = d} + +/-- The relative Galois action on finite places restricts to places of any +prescribed absolute degree. -/ +@[implicit_reducible] +noncomputable def finitePlaceOfDegreeGalAction (d : ℕ) : + MulAction Gal(L/M) (FiniteExtensionFinitePlaceOfDegree K L d) := by + letI := finitePlaceGalAction K M L + exact + { smul := fun g P => ⟨finitePlaceGalSmul K M L g P.1, by + rw [finiteExtensionFinitePlace_degree_finitePlaceGalSmul K M L g P.1, + P.2]⟩ + one_smul := fun P => by + apply Subtype.ext + exact one_smul Gal(L/M) P.1 + mul_smul := fun g h P => by + apply Subtype.ext + exact mul_smul g h P.1 } + +/-- The relative Galois action on places above infinity restricts to places +of any prescribed absolute degree. -/ +@[implicit_reducible] +noncomputable def infinityPlaceOfDegreeGalAction (d : ℕ) : + MulAction Gal(L/M) (FiniteExtensionInfinityPlaceOfDegree K L d) := by + letI := infinityPlaceGalAction K M L + exact + { smul := fun g P => ⟨infinityPlaceGalSmul K M L g P.1, by + rw [finiteExtensionInfinityPlace_degree_infinityPlaceGalSmul + K M L g P.1, P.2]⟩ + one_smul := fun P => by + apply Subtype.ext + exact one_smul Gal(L/M) P.1 + mul_smul := fun g h P => by + apply Subtype.ext + exact mul_smul g h P.1 } + +/-- On a finite-place restriction fiber, the point stabilizer is the usual +decomposition group of the underlying place. -/ +theorem finitePlaceUnderFiber_stabilizer_eq_decompositionGroup + (P : FiniteExtensionFinitePlace K M) + (Q : FinitePlaceUnderFiber K M L P) : + letI := finitePlaceUnderFiberGalAction K M L P + MulAction.stabilizer Gal(L/M) Q = + finitePlaceDecompositionGroup K M L Q.1 := by + letI := finiteIntegralClosureGalAction K M L + letI := finitePlaceUnderFiberGalAction K M L P + ext g + change (g • Q = Q) ↔ g • Q.1.asIdeal = Q.1.asIdeal + constructor + · intro hg + have hplace : finitePlaceGalSmul K M L g Q.1 = Q.1 := + congrArg Subtype.val hg + exact congrArg HeightOneSpectrum.asIdeal hplace + · intro hg + apply Subtype.ext + apply HeightOneSpectrum.ext + exact hg + +/-- On an infinity-place restriction fiber, the point stabilizer is the +usual decomposition group of the underlying place. -/ +theorem infinityPlaceUnderFiber_stabilizer_eq_decompositionGroup + (P : FiniteExtensionInfinityPlace K M) + (Q : InfinityPlaceUnderFiber K M L P) : + letI := infinityPlaceUnderFiberGalAction K M L P + MulAction.stabilizer Gal(L/M) Q = + infinityPlaceDecompositionGroup K M L Q.1 := by + letI := infinityIntegralClosureGalAction K M L + letI := infinityPlaceUnderFiberGalAction K M L P + ext g + change (g • Q = Q) ↔ g • Q.1.1 = Q.1.1 + constructor + · intro hg + have hplace : infinityPlaceGalSmul K M L g Q.1 = Q.1 := + congrArg Subtype.val hg + exact congrArg Subtype.val hplace + · intro hg + apply Subtype.ext + apply Subtype.ext + exact hg + +end FunctionFieldPlaces + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean new file mode 100644 index 0000000000..88019c857e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean @@ -0,0 +1,266 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree + +/-! +# Transporting normalization ideals to finite places + +The project's finite places are height-one prime ideals in +`RatFuncFiniteIntegralClosure S T`. Constant-extension arguments naturally +produce another normalization model together with an equivalence over +`S[X]`. This file transports height-one ideals, residue fields, residue +degrees, and contractions across such an equivalence. + +There is one typeclass subtlety. A canonical embedding `RatFunc S → T` +induces an `S[X]`-algebra structure on `T`, while a geometric construction +may already carry a propositionally equal polynomial algebra structure. +The algebra-map bridge below turns a pointwise compatibility theorem into an +equivalence with `RatFuncFiniteIntegralClosure S T`; it does not assume the +two structures are definitionally equal. +-/ + +open scoped Polynomial + +open IsDedekindDomain + +namespace BGS.HasseWeil + +noncomputable section + +variable {C A B R : Type*} + [CommRing C] [CommRing A] [CommRing B] [CommRing R] + [Algebra C A] [Algebra C B] + +/-- An algebra equivalence transports height-one prime ideals. -/ +def heightOneSpectrumEquivOfAlgEquiv (e : A ≃ₐ[C] B) : + HeightOneSpectrum A ≃ HeightOneSpectrum B := + HeightOneSpectrum.equivOfRingEquiv e.toRingEquiv + +@[simp] +theorem heightOneSpectrumEquivOfAlgEquiv_asIdeal (e : A ≃ₐ[C] B) + (q : HeightOneSpectrum A) : + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal = + q.asIdeal.comap e.symm := + rfl + +/-- Residue fields at corresponding height-one ideals are equivalent over +the common coefficient ring. -/ +def heightOneSpectrumResidueFieldAlgEquiv (e : A ≃ₐ[C] B) + (q : HeightOneSpectrum A) : + q.asIdeal.ResidueField ≃ₐ[C] + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal.ResidueField := + Ideal.residueFieldAlgEquiv q.asIdeal + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal e + (by + change q.asIdeal = (q.asIdeal.comap e.symm).comap e + exact (Ideal.comap_of_equiv e.toRingEquiv).symm) + +/-- Corresponding residue fields have the same degree over the common +coefficient field. -/ +theorem heightOneSpectrum_residueField_finrank_eq + {k A B : Type*} [Field k] [CommRing A] [CommRing B] + [Algebra k A] [Algebra k B] + (e : A ≃ₐ[k] B) (q : HeightOneSpectrum A) : + Module.finrank k q.asIdeal.ResidueField = + Module.finrank k + (heightOneSpectrumEquivOfAlgEquiv e q).asIdeal.ResidueField := + (heightOneSpectrumResidueFieldAlgEquiv e q).toLinearEquiv.finrank_eq + +section Contraction + +variable [IsDedekindDomain R] [IsDomain A] [IsDomain B] + [Algebra R A] [Algebra R B] + [Algebra.IsIntegral R A] [Algebra.IsIntegral R B] + +/-- Transport by an equivalence over the base ring preserves the prime ideal +below a height-one ideal. -/ +@[simp] +theorem heightOneSpectrumEquivOfAlgEquiv_under + (e : A ≃ₐ[R] B) (q : HeightOneSpectrum A) : + HeightOneSpectrum.under R (heightOneSpectrumEquivOfAlgEquiv e q) = + HeightOneSpectrum.under R q := by + apply HeightOneSpectrum.ext + ext x + change e.symm (algebraMap R B x) ∈ q.asIdeal ↔ + algebraMap R A x ∈ q.asIdeal + rw [e.symm.commutes] + +/-- The same contraction result when the equivalence is over a smaller +coefficient ring and compatibility with the base algebra maps is supplied +separately. -/ +@[simp] +theorem heightOneSpectrumEquivOfAlgEquiv_under_of_algebraMap_eq + (e : A ≃ₐ[C] B) + (h : e.toRingHom.comp (algebraMap R A) = algebraMap R B) + (q : HeightOneSpectrum A) : + HeightOneSpectrum.under R (heightOneSpectrumEquivOfAlgEquiv e q) = + HeightOneSpectrum.under R q := by + apply HeightOneSpectrum.ext + ext x + change e.symm (algebraMap R B x) ∈ q.asIdeal ↔ + algebraMap R A x ∈ q.asIdeal + have hx := DFunLike.congr_fun h x + rw [← hx] + change e.symm (e (algebraMap R A x)) ∈ q.asIdeal ↔ + algebraMap R A x ∈ q.asIdeal + rw [e.symm_apply_apply] + +end Contraction + +section PolynomialAlgebraBridge + +open BGS.CorvajaZannier + +variable (S T : Type*) [Field S] [Field T] + [Algebra (RatFunc S) T] + +/-- The polynomial algebra structure on `T` induced by its +`RatFunc S`-algebra structure. -/ +@[reducible] +noncomputable def ratFuncInducedPolynomialAlgebra : Algebra S[X] T := + RingHom.toAlgebra ((algebraMap (RatFunc S) T).comp + (algebraMap S[X] (RatFunc S))) + +/-- Pointwise compatibility of polynomial algebra maps identifies a chosen +`S[X]`-algebra structure with the structure induced from `RatFunc S`. -/ +theorem ratFuncInducedPolynomialAlgebra_eq + (a : Algebra S[X] T) + (h : ∀ p : S[X], + algebraMap (RatFunc S) T (algebraMap S[X] (RatFunc S) p) = + @algebraMap S[X] T _ _ a p) : + ratFuncInducedPolynomialAlgebra S T = a := by + apply Algebra.algebra_ext + intro p + exact h p + +/-- Equality of the ambient polynomial algebra structures identifies their +integral closures, one of which is the project's rational-function model. -/ +noncomputable def integralClosureAlgEquivRatFuncFiniteOfEq + (a : Algebra S[X] T) + (h : ratFuncInducedPolynomialAlgebra S T = a) : + letI := a + integralClosure S[X] T ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T := by + subst a + exact AlgEquiv.refl + +/-- A polynomial restriction formula for `RatFunc S → T` gives the +normalization equivalence needed by the finite-place model. -/ +noncomputable def integralClosureAlgEquivRatFuncFiniteOfAlgebraMap + (a : Algebra S[X] T) + (h : ∀ p : S[X], + algebraMap (RatFunc S) T (algebraMap S[X] (RatFunc S) p) = + @algebraMap S[X] T _ _ a p) : + letI := a + integralClosure S[X] T ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T := + integralClosureAlgEquivRatFuncFiniteOfEq S T a + (ratFuncInducedPolynomialAlgebra_eq S T a h) + +variable (A : Type*) [CommRing A] [Algebra S[X] A] + +/-- Compose a geometric normalization equivalence with the polynomial +algebra bridge, landing in `RatFuncFiniteIntegralClosure S T`. -/ +noncomputable def normalizationAlgEquivRatFuncFiniteOfAlgebraMap + (a : Algebra S[X] T) + (e : letI := a + A ≃ₐ[S[X]] integralClosure S[X] T) + (h : ∀ p : S[X], + algebraMap (RatFunc S) T (algebraMap S[X] (RatFunc S) p) = + @algebraMap S[X] T _ _ a p) : + A ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T := by + letI := a + exact e.trans + (integralClosureAlgEquivRatFuncFiniteOfAlgebraMap S T a h) + +end PolynomialAlgebraBridge + +section FiniteExtensionFinitePlace + +open BGS.CorvajaZannier + +variable (S T A : Type*) [Field S] [Field T] [CommRing A] + [Algebra (RatFunc S) T] + +local instance finitePlacePolynomialTopAlgebra : Algebra S[X] T := + ratFuncInducedPolynomialAlgebra S T + +variable [Algebra S[X] A] + +local instance finitePlaceSourceConstantAlgebra : Algebra S A := + RingHom.toAlgebra ((algebraMap S[X] A).comp (algebraMap S S[X])) + +local instance finitePlaceTargetConstantAlgebra : + Algebra S (RatFuncFiniteIntegralClosure S T) := + RingHom.toAlgebra ((algebraMap S[X] + (RatFuncFiniteIntegralClosure S T)).comp (algebraMap S S[X])) + +local instance finitePlaceSourceConstantTower : IsScalarTower S S[X] A := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finitePlaceTargetConstantTower : + IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S T) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finitePlaceTargetIntegral : + Algebra.IsIntegral S[X] (RatFuncFiniteIntegralClosure S T) := + IsIntegralClosure.isIntegral_algebra S[X] T + +/-- An equivalence of normalization models over `S[X]` transports their +height-one ideals to the project's finite-place type. -/ +def finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv + (e : A ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T) : + HeightOneSpectrum A ≃ FiniteExtensionFinitePlace S T := + heightOneSpectrumEquivOfAlgEquiv (e.restrictScalars S) + +@[simp] +theorem finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv_asIdeal + (e : A ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T) + (q : HeightOneSpectrum A) : + (finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv + S T A e q).asIdeal = q.asIdeal.comap e.symm := + rfl + +/-- A normalization equivalence transports the residue field at each +height-one ideal as an `S`-algebra. -/ +def finiteExtensionFinitePlaceResidueFieldAlgEquivOfNormalization + (e : A ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T) + (q : HeightOneSpectrum A) : + q.asIdeal.ResidueField ≃ₐ[S] + (finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv + S T A e q).asIdeal.ResidueField := + heightOneSpectrumResidueFieldAlgEquiv (e.restrictScalars S) q + +/-- The constant-field residue degree is unchanged when replacing a +normalization by an equivalent model. -/ +theorem finiteExtensionFinitePlace_residueField_finrank_eq_of_normalization + (e : A ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T) + (q : HeightOneSpectrum A) : + Module.finrank S q.asIdeal.ResidueField = + Module.finrank S + (finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv + S T A e q).asIdeal.ResidueField := + (finiteExtensionFinitePlaceResidueFieldAlgEquivOfNormalization + S T A e q).toLinearEquiv.finrank_eq + +variable [IsDomain A] [Algebra.IsIntegral S[X] A] + +/-- The finite place below a transported ideal agrees with the contraction +of the source ideal to `S[X]`. -/ +@[simp] +theorem finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv_under + (e : A ≃ₐ[S[X]] RatFuncFiniteIntegralClosure S T) + (q : HeightOneSpectrum A) : + HeightOneSpectrum.under S[X] + (finiteExtensionFinitePlaceEquivOfNormalizationAlgEquiv S T A e q) = + HeightOneSpectrum.under S[X] q := by + exact heightOneSpectrumEquivOfAlgEquiv_under e q + +end FiniteExtensionFinitePlace + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean new file mode 100644 index 0000000000..2371a2f204 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean @@ -0,0 +1,424 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +import Mathlib.LinearAlgebra.Dimension.Constructions + +/-! +# Finite principal parts + +This file assembles the one-place calculation in `LocalPoleFiltration` over a +finite family of discrete valuation rings. At one place the principal parts +of order at most `n` are the genuine quotient + +`localPoleSpace π n / localPoleSpace π 0`. + +The filtration by pole order proves that its dimension is `n` times the +residue-field degree. Taking a finite product therefore has dimension the +weighted degree of the chosen pole bounds. + +The last section constructs the diagonal principal-parts map on any global +subspace satisfying those pole bounds. Its kernel is exactly the subspace +regular at every chosen place. Thus, once the all-place function-field layer +identifies that regular subspace with the constants, the quotient by constants +embeds in this finite-dimensional principal-parts space. +-/ + +namespace BGS.HasseWeil + +open Submodule +open scoped nonZeroDivisors + +noncomputable section + +section OnePlace + +variable {K R L : Type*} [Field K] [CommRing R] + [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Field L] [Algebra K R] [Algebra R L] [Algebra K L] + [IsScalarTower K R L] [IsFractionRing R L] + +/-- Monotonicity of the local pole filtration for an arbitrary increase in +the allowed pole order. -/ +theorem localPoleSpace_mono_of_le (π : R) {m n : ℕ} (hmn : m ≤ n) : + localPoleSpace (K := K) (L := L) π m ≤ + localPoleSpace (K := K) (L := L) π n := by + induction n, hmn using Nat.le_induction with + | base => exact le_rfl + | succ n _ ih => + exact ih.trans (by simpa [Nat.succ_eq_add_one] using + localPoleSpace_mono (K := K) (L := L) π n) + +/-- Principal parts of order at most `n` at one DVR. -/ +abbrev localPrincipalPartSpace (π : R) (n : ℕ) := + localPoleSpace (K := K) (L := L) π n ⧸ + relativeSubmodule + (localPoleSpace (K := K) (L := L) π 0) + (localPoleSpace (K := K) (L := L) π n) + +/-- The last graded layer in the local pole filtration. -/ +abbrev localPrincipalPartLayer (π : R) (n : ℕ) := + localPoleSpace (K := K) (L := L) π (n + 1) ⧸ + relativeSubmodule + (localPoleSpace (K := K) (L := L) π n) + (localPoleSpace (K := K) (L := L) π (n + 1)) + +/-- Enlarging the pole bound by one gives an inclusion of principal-part +spaces. -/ +def localPrincipalPartInclusion (π : R) (n : ℕ) : + localPrincipalPartSpace (K := K) (L := L) π n →ₗ[K] + localPrincipalPartSpace (K := K) (L := L) π (n + 1) := by + let hnn : localPoleSpace (K := K) (L := L) π n ≤ + localPoleSpace (K := K) (L := L) π (n + 1) := + localPoleSpace_mono (K := K) (L := L) π n + let inclusion : localPoleSpace (K := K) (L := L) π n →ₗ[K] + localPoleSpace (K := K) (L := L) π (n + 1) := + Submodule.inclusion hnn + exact (Submodule.comap + (localPoleSpace (K := K) (L := L) π n).subtype + (localPoleSpace (K := K) (L := L) π 0)).mapQ + (Submodule.comap + (localPoleSpace (K := K) (L := L) π (n + 1)).subtype + (localPoleSpace (K := K) (L := L) π 0)) inclusion (by + intro x hx + change (x : L) ∈ localPoleSpace (K := K) (L := L) π 0 at hx ⊢ + exact hx) + +/-- Forgetting the top pole layer maps principal parts of order `n + 1` onto +the last local quotient. -/ +def localPrincipalPartLayerMap (π : R) (n : ℕ) : + localPrincipalPartSpace (K := K) (L := L) π (n + 1) →ₗ[K] + localPrincipalPartLayer (K := K) (L := L) π n := by + apply Submodule.factor + intro x hx + change (x : L) ∈ localPoleSpace (K := K) (L := L) π 0 at hx + change (x : L) ∈ localPoleSpace (K := K) (L := L) π n + exact localPoleSpace_mono_of_le (K := K) (L := L) π (Nat.zero_le n) hx + +theorem localPrincipalPartInclusion_injective (π : R) (n : ℕ) : + Function.Injective + (localPrincipalPartInclusion (K := K) (L := L) π n) := by + rw [← LinearMap.ker_eq_bot] + ext x + refine Submodule.Quotient.induction_on _ x ?_ + intro x + rw [LinearMap.mem_ker, Submodule.mem_bot] + change (Submodule.Quotient.mk + (Submodule.inclusion + (localPoleSpace_mono (K := K) (L := L) π n) x) = 0) ↔ + Submodule.Quotient.mk x = 0 + rw [Submodule.Quotient.mk_eq_zero, Submodule.Quotient.mk_eq_zero] + rfl + +theorem range_localPrincipalPartInclusion_eq_ker_layerMap + (π : R) (n : ℕ) : + LinearMap.range + (localPrincipalPartInclusion (K := K) (L := L) π n) = + LinearMap.ker + (localPrincipalPartLayerMap (K := K) (L := L) π n) := by + ext x + constructor + · rintro ⟨y, rfl⟩ + apply LinearMap.mem_ker.mpr + refine Submodule.Quotient.induction_on _ y ?_ + intro y + simp [localPrincipalPartInclusion, localPrincipalPartLayerMap] + · intro hx + obtain ⟨x, rfl⟩ := Quotient.exists_rep x + rw [LinearMap.mem_ker] at hx + change Submodule.Quotient.mk x = 0 at hx + rw [Submodule.Quotient.mk_eq_zero] at hx + let y : localPoleSpace (K := K) (L := L) π n := ⟨x.1, hx⟩ + refine ⟨Submodule.Quotient.mk y, ?_⟩ + rfl + +/-- Every local principal-part space is finite-dimensional. -/ +theorem localPrincipalPartSpace_finite + (π : R) (hπ : π ≠ 0) + (hπIdeal : (IsDiscreteValuationRing.maximalIdeal R).asIdeal = + Ideal.span {π}) (n : ℕ) + [Module.Finite K (IsLocalRing.ResidueField R)] : + Module.Finite K (localPrincipalPartSpace (K := K) (L := L) π n) := by + induction n with + | zero => + have htop : Submodule.comap + (localPoleSpace (K := K) (L := L) π 0).subtype + (localPoleSpace (K := K) (L := L) π 0) = ⊤ := by + ext x + simp + change Module.Finite K + (localPoleSpace (K := K) (L := L) π 0 ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π 0).subtype + (localPoleSpace (K := K) (L := L) π 0)) + rw [htop] + infer_instance + | succ n ih => + let f := localPrincipalPartLayerMap (K := K) (L := L) π n + letI : Module.Finite K (localPrincipalPartLayer (K := K) (L := L) π n) := + Module.Finite.equiv + (localPoleQuotientEquivResidueField + (K := K) (L := L) π hπ hπIdeal n).symm + letI : Module.Finite K f.ker := by + rw [show f.ker = LinearMap.range + (localPrincipalPartInclusion (K := K) (L := L) π n) by + exact (range_localPrincipalPartInclusion_eq_ker_layerMap + (K := K) (L := L) π n).symm] + infer_instance + letI : Module.Finite K f.range := inferInstance + letI : Module.Finite K + (localPrincipalPartSpace (K := K) (L := L) π (n + 1) ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + exact Module.Finite.of_submodule_quotient f.ker + +/-- The dimension of the genuine local principal-part quotient is the pole +order times the residue-field degree. -/ +theorem localPrincipalPartSpace_finrank + (π : R) (hπ : π ≠ 0) + (hπIdeal : (IsDiscreteValuationRing.maximalIdeal R).asIdeal = + Ideal.span {π}) (n : ℕ) + [Module.Finite K (IsLocalRing.ResidueField R)] : + Module.finrank K (localPrincipalPartSpace (K := K) (L := L) π n) = + n * Module.finrank K (IsLocalRing.ResidueField R) := by + induction n with + | zero => + have htop : Submodule.comap + (localPoleSpace (K := K) (L := L) π 0).subtype + (localPoleSpace (K := K) (L := L) π 0) = ⊤ := by + ext x + simp + change Module.finrank K + (localPoleSpace (K := K) (L := L) π 0 ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π 0).subtype + (localPoleSpace (K := K) (L := L) π 0)) = + 0 * Module.finrank K (IsLocalRing.ResidueField R) + rw [htop] + simpa using (Module.finrank_zero_of_subsingleton + (R := K) + (M := localPoleSpace (K := K) (L := L) π 0 ⧸ + (⊤ : Submodule K + (localPoleSpace (K := K) (L := L) π 0)))) + | succ n ih => + letI := localPrincipalPartSpace_finite + (K := K) (L := L) π hπ hπIdeal n + letI := localPrincipalPartSpace_finite + (K := K) (L := L) π hπ hπIdeal (n + 1) + let f := localPrincipalPartLayerMap (K := K) (L := L) π n + have hsurj : Function.Surjective f := by + intro x + obtain ⟨x, rfl⟩ := Quotient.exists_rep x + exact ⟨Submodule.Quotient.mk x, rfl⟩ + have hker := range_localPrincipalPartInclusion_eq_ker_layerMap + (K := K) (L := L) π n + have hker' : f.ker = LinearMap.range + (localPrincipalPartInclusion (K := K) (L := L) π n) := by + simpa [f] using hker.symm + calc + Module.finrank K + (localPrincipalPartSpace (K := K) (L := L) π (n + 1)) = + Module.finrank K f.range + Module.finrank K f.ker := + f.finrank_range_add_finrank_ker.symm + _ = Module.finrank K + (localPrincipalPartLayer (K := K) (L := L) π n) + + Module.finrank K + (localPrincipalPartSpace (K := K) (L := L) π n) := by + rw [show f.range = ⊤ from LinearMap.range_eq_top.mpr hsurj, + finrank_top, hker', + LinearMap.finrank_range_of_inj + (localPrincipalPartInclusion_injective + (K := K) (L := L) π n)] + _ = Module.finrank K (IsLocalRing.ResidueField R) + + n * Module.finrank K (IsLocalRing.ResidueField R) := by + rw [localPoleQuotient_finrank + (K := K) (L := L) π hπ hπIdeal n, ih] + _ = (n + 1) * Module.finrank K (IsLocalRing.ResidueField R) := by + simp [Nat.add_mul, Nat.add_comm] + +end OnePlace + +section QuotientByKernel + +variable {K V W : Type*} [Field K] + [AddCommGroup V] [Module K V] [AddCommGroup W] [Module K W] + +/-- A linear map descends injectively after quotienting by a submodule known +to be its kernel. -/ +def quotientLinearMapOfKerEq + (f : V →ₗ[K] W) (P : Submodule K V) (hker : f.ker = P) : + (V ⧸ P) →ₗ[K] W := + P.liftQ f hker.symm.le + +theorem quotientLinearMapOfKerEq_injective + (f : V →ₗ[K] W) (P : Submodule K V) (hker : f.ker = P) : + Function.Injective (quotientLinearMapOfKerEq f P hker) := by + rw [← LinearMap.ker_eq_bot] + exact Submodule.ker_liftQ_eq_bot P f hker.symm.le hker.le + +/-- The quotient by the kernel of a map into a finite-dimensional space has +dimension at most that of the target. -/ +theorem finrank_quotient_le_of_ker_eq + (f : V →ₗ[K] W) (P : Submodule K V) (hker : f.ker = P) + [Module.Finite K W] : + Module.finrank K (V ⧸ P) ≤ Module.finrank K W := by + rw [← hker, f.quotKerEquivRange.finrank_eq] + exact f.range.finrank_le + +end QuotientByKernel + +section FiniteFamily + +variable {K L I : Type*} [Field K] [Field L] [Fintype I] + {R : I → Type*} + [∀ i, CommRing (R i)] [∀ i, IsDedekindDomain (R i)] + [∀ i, IsDiscreteValuationRing (R i)] + [∀ i, Algebra K (R i)] [∀ i, Algebra (R i) L] [Algebra K L] + [∀ i, IsScalarTower K (R i) L] [∀ i, IsFractionRing (R i) L] + +/-- A finite family of local principal-part spaces. -/ +abbrev finitePrincipalPartsSpace (π : ∀ i, R i) (n : I → ℕ) := + ∀ i, localPrincipalPartSpace (K := K) (L := L) (π i) (n i) + +/-- The weighted degree of a finite family of pole bounds. -/ +def finitePrincipalPartsDegree (n : I → ℕ) : ℕ := + ∑ i, n i * Module.finrank K (IsLocalRing.ResidueField (R i)) + +/-- Finite principal parts have dimension equal to the weighted pole degree. -/ +theorem finitePrincipalPartsSpace_finrank + (π : ∀ i, R i) (hπ : ∀ i, π i ≠ 0) + (hπIdeal : ∀ i, + (IsDiscreteValuationRing.maximalIdeal (R i)).asIdeal = + Ideal.span {π i}) (n : I → ℕ) + [∀ i, Module.Finite K (IsLocalRing.ResidueField (R i))] : + Module.finrank K (finitePrincipalPartsSpace (K := K) (L := L) π n) = + finitePrincipalPartsDegree (K := K) (R := R) n := by + letI localPrincipalPartModule (i : I) : Module K + (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := + inferInstance + letI finitePrincipalPartsModule : Module K + (finitePrincipalPartsSpace (K := K) (L := L) π n) := + Pi.module I + (fun i => localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) K + letI (i : I) : Module.Finite K + (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := + localPrincipalPartSpace_finite + (K := K) (L := L) (π i) (hπ i) (hπIdeal i) (n i) + letI (i : I) : Module.Free K + (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := + Module.Free.of_divisionRing K + (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) + rw [Module.finrank_pi_fintype] + apply Finset.sum_congr rfl + intro i _ + exact localPrincipalPartSpace_finrank + (K := K) (L := L) (π i) (hπ i) (hπIdeal i) (n i) + +/-- A global subspace with the prescribed local pole bounds maps diagonally +to its finite family of principal parts. -/ +def finitePrincipalPartsDiagonalMap + (π : ∀ i, R i) (n : I → ℕ) (S : Submodule K L) + (hS : ∀ i, S ≤ localPoleSpace (K := K) (L := L) (π i) (n i)) : + S →ₗ[K] finitePrincipalPartsSpace (K := K) (L := L) π n := + LinearMap.pi fun i => + (Submodule.comap + (localPoleSpace (K := K) (L := L) (π i) (n i)).subtype + (localPoleSpace (K := K) (L := L) (π i) 0)).mkQ.comp + (Submodule.inclusion (hS i)) + +/-- The elements of a global subspace that are regular at every chosen +place. -/ +def regularAtFiniteFamily + (π : ∀ i, R i) (S : Submodule K L) : Submodule K S := + ⨅ i, Submodule.comap S.subtype + (localPoleSpace (K := K) (L := L) (π i) 0) + +omit [Fintype I] [∀ i, IsDedekindDomain (R i)] + [∀ i, IsDiscreteValuationRing (R i)] + [∀ i, IsFractionRing (R i) L] in +/-- The kernel of the diagonal principal-parts map is exactly simultaneous +regularity at the chosen places. -/ +theorem finitePrincipalPartsDiagonalMap_ker + (π : ∀ i, R i) (n : I → ℕ) (S : Submodule K L) + (hS : ∀ i, S ≤ localPoleSpace (K := K) (L := L) (π i) (n i)) : + LinearMap.ker + (finitePrincipalPartsDiagonalMap + (K := K) (L := L) π n S hS) = + regularAtFiniteFamily (K := K) (L := L) π S := by + ext x + rw [LinearMap.mem_ker] + constructor + · intro hx + rw [regularAtFiniteFamily, Submodule.mem_iInf] + intro i + have hi := congrFun hx i + change Submodule.Quotient.mk + (Submodule.inclusion (hS i) x) = 0 at hi + rw [Submodule.Quotient.mk_eq_zero] at hi + exact hi + · intro hx + funext i + rw [regularAtFiniteFamily, Submodule.mem_iInf] at hx + change Submodule.Quotient.mk + (Submodule.inclusion (hS i) x) = 0 + rw [Submodule.Quotient.mk_eq_zero] + exact hx i + +/-- Consequently, the global quotient by simultaneous regularity has +dimension at most the weighted pole degree. -/ +theorem finrank_quotient_regularAtFiniteFamily_le_degree + (π : ∀ i, R i) (hπ : ∀ i, π i ≠ 0) + (hπIdeal : ∀ i, + (IsDiscreteValuationRing.maximalIdeal (R i)).asIdeal = + Ideal.span {π i}) + (n : I → ℕ) (S : Submodule K L) + (hS : ∀ i, S ≤ localPoleSpace (K := K) (L := L) (π i) (n i)) + [∀ i, Module.Finite K (IsLocalRing.ResidueField (R i))] : + Module.finrank K + (S ⧸ regularAtFiniteFamily (K := K) (L := L) π S) ≤ + finitePrincipalPartsDegree (K := K) (R := R) n := by + letI localPrincipalPartModule (i : I) : Module K + (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := + inferInstance + letI finitePrincipalPartsModule : Module K + (finitePrincipalPartsSpace (K := K) (L := L) π n) := + Pi.module I + (fun i => localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) K + letI (i : I) : Module.Finite K + (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := + localPrincipalPartSpace_finite + (K := K) (L := L) (π i) (hπ i) (hπIdeal i) (n i) + letI : Module.Finite K + (finitePrincipalPartsSpace (K := K) (L := L) π n) := inferInstance + let f : S →ₗ[K] finitePrincipalPartsSpace (K := K) (L := L) π n := + finitePrincipalPartsDiagonalMap (K := K) (L := L) π n S hS + have hfker : f.ker = regularAtFiniteFamily (K := K) (L := L) π S := by + simpa [f] using finitePrincipalPartsDiagonalMap_ker + (K := K) (L := L) π n S hS + let q := quotientLinearMapOfKerEq + (K := K) (V := S) + (W := finitePrincipalPartsSpace (K := K) (L := L) π n) f + (regularAtFiniteFamily (K := K) (L := L) π S) hfker + have hq : Function.Injective q := + quotientLinearMapOfKerEq_injective + (K := K) (V := S) + (W := finitePrincipalPartsSpace (K := K) (L := L) π n) f + (regularAtFiniteFamily (K := K) (L := L) π S) hfker + calc + Module.finrank K + (S ⧸ regularAtFiniteFamily (K := K) (L := L) π S) ≤ + Module.finrank K + (finitePrincipalPartsSpace (K := K) (L := L) π n) := + q.finrank_le_finrank_of_injective hq + _ = finitePrincipalPartsDegree (K := K) (R := R) n := + finitePrincipalPartsSpace_finrank + (K := K) (L := L) π hπ hπIdeal n + +end FiniteFamily + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean new file mode 100644 index 0000000000..0fd064c050 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean @@ -0,0 +1,98 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount + +/-! +# Weighted degree cancellation over finite-support fibers + +This file upgrades the unweighted finite-family constant-extension identity to +finitely supported multiplicities. The ambient types need not be finite: a +nonzero downstairs coefficient forces every point in its fiber into the +finite upstairs support, so the relevant fiber can be counted there. +-/ + +namespace Finsupp + +/-- Weighted form of the constant-extension degree cancellation. Suppose +upstairs multiplicities are pulled back from downstairs, upstairs degrees are +obtained by division by `gcd(r, degree)`, and the full fiber has that gcd as +its cardinality. Then the two finitely supported weighted degree sums agree. + +No finiteness assumption is imposed on `Base` or `Up`; only the supports of +the two `Finsupp`s are used as finite indexing sets. -/ +theorem sum_mul_degree_eq_of_div_gcd_fibers + {Base Up : Type*} + (down : Up → Base) + (baseDegree : Base → ℕ) (upDegree : Up → ℕ) + (baseMultiplicity : Base →₀ ℕ) + (upMultiplicity : Up →₀ ℕ) + (extensionDegree : ℕ) + (hmultiplicity : ∀ Q, + upMultiplicity Q = baseMultiplicity (down Q)) + (hdegree : ∀ Q, + upDegree Q = baseDegree (down Q) / + Nat.gcd extensionDegree (baseDegree (down Q))) + (hfiber : ∀ P, + Nat.card {Q : Up // down Q = P} = + Nat.gcd extensionDegree (baseDegree P)) : + upMultiplicity.sum (fun Q m ↦ m * upDegree Q) = + baseMultiplicity.sum (fun P m ↦ m * baseDegree P) := by + classical + rw [Finsupp.sum, Finsupp.sum] + have hmaps : ∀ Q ∈ upMultiplicity.support, + down Q ∈ baseMultiplicity.support := by + intro Q hQ + rw [Finsupp.mem_support_iff] at hQ ⊢ + simpa only [← hmultiplicity Q] using hQ + rw [← Finset.sum_fiberwise_of_maps_to hmaps] + apply Finset.sum_congr rfl + intro P hP + have hfiber_subset : {Q : Up | down Q = P} ⊆ + (upMultiplicity.support : Set Up) := by + intro Q hQP + change Q ∈ upMultiplicity.support + rw [Finsupp.mem_support_iff, hmultiplicity Q, hQP] + exact Finsupp.mem_support_iff.mp hP + letI : Fintype {Q : Up // down Q = P} := + (upMultiplicity.support.finite_toSet.subset hfiber_subset).fintype + let fiberSupport := upMultiplicity.support.filter (fun Q ↦ down Q = P) + let fiberEquiv : {Q : Up // Q ∈ fiberSupport} ≃ + {Q : Up // down Q = P} := + { toFun := fun Q ↦ + ⟨Q.1, (Finset.mem_filter.mp Q.2).2⟩ + invFun := fun Q ↦ + ⟨Q.1, Finset.mem_filter.mpr ⟨hfiber_subset Q.2, Q.2⟩⟩ + left_inv := fun Q ↦ Subtype.ext rfl + right_inv := fun Q ↦ Subtype.ext rfl } + have hcard : fiberSupport.card = + Nat.gcd extensionDegree (baseDegree P) := by + calc + fiberSupport.card = Fintype.card fiberSupport := + (Fintype.card_coe fiberSupport).symm + _ = Fintype.card {Q : Up // down Q = P} := + Fintype.card_congr fiberEquiv + _ = Nat.card {Q : Up // down Q = P} := + Nat.card_eq_fintype_card.symm + _ = Nat.gcd extensionDegree (baseDegree P) := hfiber P + rw [Finset.sum_const_nat] + · rw [hcard] + calc + Nat.gcd extensionDegree (baseDegree P) * + (baseMultiplicity P * + (baseDegree P / Nat.gcd extensionDegree (baseDegree P))) = + baseMultiplicity P * + (Nat.gcd extensionDegree (baseDegree P) * + (baseDegree P / Nat.gcd extensionDegree (baseDegree P))) := by + ac_rfl + _ = baseMultiplicity P * baseDegree P := by + rw [Nat.mul_div_cancel' + (Nat.gcd_dvd_right extensionDegree (baseDegree P))] + · intro Q hQ + simp only [hmultiplicity, hdegree] + rw [(Finset.mem_filter.mp hQ).2] + +end Finsupp diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean new file mode 100644 index 0000000000..3ba091e683 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean @@ -0,0 +1,277 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.GroupTheory.GroupAction.Quotient +import Mathlib.GroupTheory.Index +import Mathlib.SetTheory.Cardinal.Finite + +/-! +# Fixed-point averaging for finite transitive actions + +This file isolates the Burnside-counting identity used in the fixed-field +part of the Hasse--Weil argument. +-/ + +namespace BGS.HasseWeil + +open scoped BigOperators + +/-- For a nonempty finite transitive `G`-set, the sum over group elements of +the number of fixed points is exactly the order of `G`. -/ +theorem sum_card_fixedBy_eq_card_group_of_isPretransitive + (G X : Type*) [Group G] [Fintype G] [MulAction G X] [Fintype X] + [MulAction.IsPretransitive G X] [Nonempty X] : + (∑ g : G, Nat.card (MulAction.fixedBy X g)) = Nat.card G := by + letI (g : G) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ + let Ω := MulAction.orbitRel.Quotient G X + letI : Fintype Ω := Fintype.ofFinite Ω + have hΩ : Fintype.card Ω = 1 := + Fintype.card_eq_one_iff_nonempty_unique.mpr + ((MulAction.pretransitive_iff_unique_quotient_of_nonempty G X).mp inferInstance) + dsimp only [Ω] at hΩ + simp_rw [Nat.card_eq_fintype_card] + rw [MulAction.sum_card_fixedBy_eq_card_orbits_mul_card_group, hΩ, one_mul] + +/-- A finite family of nonempty transitive `G`-sets contributes `|G|` fixed +points per fiber after summing over all group elements. -/ +theorem sum_card_fixedBy_fibers_eq_card_mul_card_group + {ι G : Type*} [Fintype ι] [Group G] [Fintype G] + (X : ι → Type*) [∀ i, MulAction G (X i)] [∀ i, Fintype (X i)] + [∀ i, MulAction.IsPretransitive G (X i)] [∀ i, Nonempty (X i)] : + (∑ g : G, ∑ i : ι, Nat.card (MulAction.fixedBy (X i) g)) = + Nat.card ι * Nat.card G := by + classical + rw [Finset.sum_comm] + calc + (∑ i : ι, ∑ g : G, Nat.card (MulAction.fixedBy (X i) g)) = + ∑ _i : ι, Nat.card G := by + apply Finset.sum_congr rfl + intro i _ + exact sum_card_fixedBy_eq_card_group_of_isPretransitive G (X i) + _ = Nat.card ι * Nat.card G := by simp + +/-- If every point stabilizer maps onto a quotient group, then the kernel of +that quotient map still acts transitively. This is the transitivity input for +the Frobenius-coset form of Burnside averaging. -/ +theorem MonoidHom.ker_isPretransitive_of_stabilizer_surjective + {G C X : Type*} [Group G] [Group C] [MulAction G X] + [MulAction.IsPretransitive G X] + (π : G →* C) + (hstab : ∀ x : X, Function.Surjective + (π.comp (MulAction.stabilizer G x).subtype)) : + MulAction.IsPretransitive π.ker X := by + constructor + intro x y + obtain ⟨g, hg⟩ := MulAction.exists_smul_eq G x y + obtain ⟨h, hh⟩ := hstab x (π g) + change π (h : G) = π g at hh + have hfix : (h : G) • x = x := h.2 + have hinv : ((h : MulAction.stabilizer G x) : G)⁻¹ • x = x := by + exact (congrArg (fun z : X => (h : G)⁻¹ • z) hfix.symm).trans + (inv_smul_smul (h : G) x) + refine ⟨⟨g * (h : G)⁻¹, ?_⟩, ?_⟩ + · change π (g * (h : G)⁻¹) = 1 + rw [map_mul, map_inv, hh] + exact mul_inv_cancel (π g) + · change (g * (h : G)⁻¹) • x = y + simpa only [mul_smul, hinv] using hg + +/-- A homomorphism of finite groups is surjective when the source cardinality +is the product of the kernel and target cardinalities. -/ +theorem MonoidHom.surjective_of_card_eq_card_ker_mul_card + {G C : Type*} [Group G] [Group C] [Finite G] [Finite C] + (π : G →* C) + (hcard : Nat.card G = Nat.card π.ker * Nat.card C) : + Function.Surjective π := by + apply MonoidHom.surjective_of_card_ker_le_div + rw [hcard, Nat.mul_comm (Nat.card π.ker) (Nat.card C), + Nat.mul_div_right _ Nat.card_pos] + +/-- Incidence pairs between elements in one quotient fiber and their fixed +points can be transposed into stabilizer elements in that fiber. -/ +def MonoidHom.sigmaFiberFixedByEquivSigmaStabilizerFiber + {G C X : Type*} [Group G] [Group C] [MulAction G X] + (π : G →* C) (c : C) : + (Σ g : π ⁻¹' ({c} : Set C), MulAction.fixedBy X g.1) ≃ + (Σ x : X, + (π.comp (MulAction.stabilizer G x).subtype) ⁻¹' ({c} : Set C)) where + toFun p := + ⟨p.2.1, ⟨⟨p.1.1, p.2.2⟩, p.1.2⟩⟩ + invFun p := + ⟨⟨p.2.1.1, p.2.2⟩, ⟨p.1, p.2.1.2⟩⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- Stabilizer kernels, summed over points, are the same incidence type as +fixed points of elements in the global kernel. -/ +def MonoidHom.sigmaStabilizerKerEquivSigmaKerFixedBy + {G C X : Type*} [Group G] [Group C] [MulAction G X] + (π : G →* C) : + (Σ x : X, (π.comp (MulAction.stabilizer G x).subtype).ker) ≃ + (Σ g : π.ker, MulAction.fixedBy X g) where + toFun p := + ⟨⟨p.2.1.1, p.2.2⟩, ⟨p.1, p.2.1.2⟩⟩ + invFun p := + ⟨p.2.1, ⟨⟨p.1.1, p.2.2⟩, p.1.2⟩⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- Coset form of Burnside's lemma. For a finite transitive `G`-set, if the +restriction of `π : G → C` to every point stabilizer is surjective, then the +sum of fixed-point counts over any fiber of `π` is exactly `|ker π|`. + +In Stichtenoth's fixed-field argument, `π` is the constant-field Frobenius +quotient and the fiber is a Frobenius coset. -/ +theorem sum_card_fixedBy_quotientFiber_eq_card_ker + {G C X : Type*} [Group G] [Group C] [Fintype G] [Fintype C] + [DecidableEq C] + [MulAction G X] [Fintype X] [MulAction.IsPretransitive G X] + [Nonempty X] + (π : G →* C) + (hstab : ∀ x : X, Function.Surjective + (π.comp (MulAction.stabilizer G x).subtype)) + (c : C) : + letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + (∑ g : π ⁻¹' ({c} : Set C), + Nat.card (MulAction.fixedBy X g.1)) = Nat.card π.ker := by + letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + letI (x : X) : Fintype + ((π.comp (MulAction.stabilizer G x).subtype) ⁻¹' ({c} : Set C)) := + Fintype.ofFinite _ + letI : MulAction.IsPretransitive π.ker X := + MonoidHom.ker_isPretransitive_of_stabilizer_surjective π hstab + letI (g : π ⁻¹' ({c} : Set C)) : + Fintype (MulAction.fixedBy X g.1) := Fintype.ofFinite _ + letI (g : π.ker) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ + let e₁ := + MonoidHom.sigmaFiberFixedByEquivSigmaStabilizerFiber (X := X) π c + let e₂ : + (Σ x : X, + (π.comp (MulAction.stabilizer G x).subtype) ⁻¹' ({c} : Set C)) ≃ + (Σ x : X, (π.comp (MulAction.stabilizer G x).subtype).ker) := + Equiv.sigmaCongrRight fun x : X => + MonoidHom.fiberEquivKerOfSurjective + (f := π.comp (MulAction.stabilizer G x).subtype) (hstab x) c + let e₃ := MonoidHom.sigmaStabilizerKerEquivSigmaKerFixedBy (X := X) π + calc + (∑ g : π ⁻¹' ({c} : Set C), + Nat.card (MulAction.fixedBy X g.1)) = + Fintype.card (Σ g : π ⁻¹' ({c} : Set C), + MulAction.fixedBy X g.1) := by + simp_rw [Nat.card_eq_fintype_card, Fintype.card_sigma] + _ = Fintype.card (Σ g : π.ker, MulAction.fixedBy X g) := by + exact Fintype.card_congr (e₁.trans (e₂.trans e₃)) + _ = ∑ g : π.ker, Nat.card (MulAction.fixedBy X g) := by + simp_rw [Nat.card_eq_fintype_card, Fintype.card_sigma] + _ = Nat.card π.ker := + sum_card_fixedBy_eq_card_group_of_isPretransitive π.ker X + +/-- Finite-family form of Frobenius-coset Burnside averaging. If the +constant-quotient map is surjective on every stabilizer in every transitive +fiber, then summing the fixed-point counts first over the quotient fiber and +then over the family contributes one copy of `|ker π|` per family member. + +For a function-field cover, the family is the finite set of rational base +places and `X i` is the corresponding restriction fiber of top places. -/ +theorem sum_card_fixedBy_quotientFiber_fibers_eq_card_mul_card_ker + {ι G C : Type*} [Fintype ι] [Group G] [Group C] + [Fintype G] [Fintype C] [DecidableEq C] + (X : ι → Type*) [∀ i, MulAction G (X i)] [∀ i, Fintype (X i)] + [∀ i, MulAction.IsPretransitive G (X i)] [∀ i, Nonempty (X i)] + (π : G →* C) + (hstab : ∀ i (x : X i), Function.Surjective + (π.comp (MulAction.stabilizer G x).subtype)) + (c : C) : + letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + (∑ g : π ⁻¹' ({c} : Set C), + ∑ i : ι, Nat.card (MulAction.fixedBy (X i) g.1)) = + Nat.card ι * Nat.card π.ker := by + classical + letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + rw [Finset.sum_comm] + calc + (∑ i : ι, ∑ g : π ⁻¹' ({c} : Set C), + Nat.card (MulAction.fixedBy (X i) g.1)) = + ∑ _i : ι, Nat.card π.ker := by + apply Finset.sum_congr rfl + intro i _ + exact sum_card_fixedBy_quotientFiber_eq_card_ker + π (hstab i) c + _ = Nat.card ι * Nat.card π.ker := by simp + +/-- A group action restricted to a fiber of an invariant map. -/ +@[implicit_reducible] +def invariantFiberMulAction + {G X ι : Type*} [Group G] [MulAction G X] + (base : X → ι) (hbase : ∀ (g : G) (x : X), base (g • x) = base x) + (i : ι) : MulAction G {x : X // base x = i} where + smul g x := ⟨g • x.1, (hbase g x.1).trans x.2⟩ + one_smul x := by + apply Subtype.ext + exact one_smul G x.1 + mul_smul g h x := by + apply Subtype.ext + exact mul_smul g h x.1 + +/-- Fixed points of an invariant global type are the disjoint union of the +fixed points in its fibers. This is the nonduplicating assembly used when a +top place is indexed by its restricted base place. -/ +def fixedByEquivSigmaInvariantFiberFixedBy + {G X ι : Type*} [Group G] [MulAction G X] + (base : X → ι) (hbase : ∀ (g : G) (x : X), base (g • x) = base x) + (g : G) : + MulAction.fixedBy X g ≃ + Σ i : ι, + @MulAction.fixedBy G {x : X // base x = i} + _ (invariantFiberMulAction base hbase i) g where + toFun x := + ⟨base x.1, ⟨⟨x.1, rfl⟩, by + apply Subtype.ext + exact x.2⟩⟩ + invFun x := ⟨x.2.1.1, congrArg Subtype.val x.2.2⟩ + left_inv x := by + apply Subtype.ext + rfl + right_inv x := by + rcases x with ⟨i, ⟨⟨x, hxi⟩, hxg⟩⟩ + subst i + rfl + +/-- Cardinal form of the invariant-fiber fixed-point decomposition. -/ +theorem natCard_fixedBy_eq_sum_natCard_invariantFiberFixedBy + {G X ι : Type*} [Group G] [MulAction G X] + [Fintype X] [Fintype ι] + (base : X → ι) (hbase : ∀ (g : G) (x : X), base (g • x) = base x) + (g : G) : + Nat.card (MulAction.fixedBy X g) = + ∑ i : ι, + Nat.card + (@MulAction.fixedBy G {x : X // base x = i} + _ (invariantFiberMulAction base hbase i) g) := by + rw [Nat.card_congr + (fixedByEquivSigmaInvariantFiberFixedBy base hbase g), Nat.card_sigma] + +/-- Cardinality form of the Frobenius-coset Burnside lemma. It replaces +stabilizer-surjectivity by the exact decomposition-group order identity used +in the function-field argument. -/ +theorem sum_card_fixedBy_quotientFiber_eq_card_ker_of_stabilizer_card + {G C X : Type*} [Group G] [Group C] [Fintype G] [Fintype C] + [DecidableEq C] + [MulAction G X] [Fintype X] [MulAction.IsPretransitive G X] + [Nonempty X] + (π : G →* C) + (hcard : ∀ x : X, + Nat.card (MulAction.stabilizer G x) = + Nat.card (π.comp (MulAction.stabilizer G x).subtype).ker * Nat.card C) + (c : C) : + letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + (∑ g : π ⁻¹' ({c} : Set C), + Nat.card (MulAction.fixedBy X g.1)) = Nat.card π.ker := by + apply sum_card_fixedBy_quotientFiber_eq_card_ker π (fun x => ?_) c + exact MonoidHom.surjective_of_card_eq_card_ker_mul_card + (π.comp (MulAction.stabilizer G x).subtype) (hcard x) + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean new file mode 100644 index 0000000000..7eea0a80c3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness + +/-! +# Formal zeta identity under a constant extension + +Let `N r` be the point count over the degree-`r` extension of the original +constant field. If all nonzero counts occur in degrees divisible by `d`, +and the point counts after the degree-`d` constant extension satisfy + +`N_extended r = N (d * r)`, + +then the exponential point-count zeta series satisfy + +`Z_extended(T^d) = Z(T)^d`. + +The proof does not assume this identity. It reindexes the logarithmic +derivative series and then applies the already proved uniqueness theorem for +normalized formal differential equations. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open scoped PowerSeries + +/-- Reindexing the point-count derivative series under a degree-`d` +constant extension. Only positive indices occur in this series, so the +count and support hypotheses are correspondingly restricted to positive +integers. -/ +theorem subst_pointCountDerivativeSeries_mul_derivative_X_pow + (pointCount extendedPointCount : ℕ → ℕ) (d : ℕ) (hd : 0 < d) + (hcount : ∀ r, 0 < r → + extendedPointCount r = pointCount (d * r)) + (hsupport : ∀ n, 0 < n → ¬ d ∣ n → pointCount n = 0) : + PowerSeries.subst (PowerSeries.X ^ d) + (pointCountDerivativeSeries extendedPointCount) * + PowerSeries.derivative ℂ (PowerSeries.X ^ d) = + pointCountDerivativeSeries (fun n => d * pointCount n) := by + ext n + rw [PowerSeries.derivative_pow] + simp only [PowerSeries.derivative_X, mul_one] + rw [show PowerSeries.subst (PowerSeries.X ^ d) + (pointCountDerivativeSeries extendedPointCount) * + ((d : PowerSeries ℂ) * PowerSeries.X ^ (d - 1)) = + (d : PowerSeries ℂ) * + (PowerSeries.subst (PowerSeries.X ^ d) + (pointCountDerivativeSeries extendedPointCount) * + PowerSeries.X ^ (d - 1)) by ring] + rw [show (d : PowerSeries ℂ) = PowerSeries.C (d : ℂ) by simp] + simp only [PowerSeries.coeff_C_mul, PowerSeries.coeff_mul_X_pow', + pointCountDerivativeSeries, PowerSeries.coeff_mk] + split_ifs with hn + · rw [PowerSeries.coeff_subst_X_pow hd.ne'] + split_ifs with hdiv + · simp only [PowerSeries.coeff_mk, map_natCast] + rw [hcount _ (Nat.succ_pos _)] + have harg : d * ((n - (d - 1)) / d + 1) = n + 1 := by + rw [mul_add, Nat.mul_div_cancel' hdiv] + omega + rw [harg] + norm_cast + · have hnot : ¬ d ∣ n + 1 := by + intro hplus + apply hdiv + have heq : (n + 1) - d = n - (d - 1) := by omega + simpa only [heq] using Nat.dvd_sub hplus (dvd_refl d) + rw [hsupport (n + 1) (by omega) hnot] + simp + · have hnot : ¬ d ∣ n + 1 := by + intro hplus + have hle : d ≤ n + 1 := Nat.le_of_dvd (by omega) hplus + omega + rw [hsupport (n + 1) (by omega) hnot] + simp + +/-- Multiplying every point count by `d` multiplies its derivative series by +the constant series `d`. -/ +theorem pointCountDerivativeSeries_nat_mul + (pointCount : ℕ → ℕ) (d : ℕ) : + pointCountDerivativeSeries (fun n => d * pointCount n) = + (d : PowerSeries ℂ) * pointCountDerivativeSeries pointCount := by + ext n + rw [show (d : PowerSeries ℂ) = PowerSeries.C (d : ℂ) by simp] + rw [PowerSeries.coeff_C_mul] + simp [pointCountDerivativeSeries] + +/-- The exponential point-count zeta series is normalized at `T = 0`. -/ +@[simp] theorem constantCoeff_formalPointCountZeta (pointCount : ℕ → ℕ) : + PowerSeries.constantCoeff (formalPointCountZeta pointCount) = 1 := by + rw [← PowerSeries.coeff_zero_eq_constantCoeff_apply] + rw [formalPointCountZeta, + PowerSeries.coeff_subst' (pointCountLogSeries_hasSubst pointCount)] + rw [finsum_eq_single _ 0] + · simp [pointCountLogSeries] + · intro e he + simp [pointCountLogSeries, zero_pow he] + +/-- The formal constant-extension zeta identity, with hypotheses restricted +to the positive indices that actually occur in the zeta series. -/ +theorem formalPointCountZeta_hasDegreeExtensionIdentity_of_positive + (pointCount extendedPointCount : ℕ → ℕ) (d : ℕ) (hd : 0 < d) + (hcount : ∀ r, 0 < r → + extendedPointCount r = pointCount (d * r)) + (hsupport : ∀ n, 0 < n → ¬ d ∣ n → pointCount n = 0) : + HasFormalDegreeExtensionZetaIdentity + (formalPointCountZeta pointCount) + (formalPointCountZeta extendedPointCount) d := by + rw [HasFormalDegreeExtensionZetaIdentity] + let F : PowerSeries ℂ := PowerSeries.subst + (PowerSeries.X ^ d : PowerSeries ℂ) + (formalPointCountZeta extendedPointCount) + let G := formalPointCountZeta pointCount ^ d + let A := pointCountDerivativeSeries (fun n => d * pointCount n) + let hs : PowerSeries.HasSubst (PowerSeries.X ^ d : PowerSeries ℂ) := + PowerSeries.HasSubst.X_pow hd.ne' + have hconstant : PowerSeries.constantCoeff F = + PowerSeries.constantCoeff G := by + rw [show F = PowerSeries.subst (PowerSeries.X ^ d) + (formalPointCountZeta extendedPointCount) by rfl] + rw [PowerSeries.constantCoeff_subst_X_pow hd.ne'] + simp [G] + have hF : PowerSeries.derivative ℂ F = F * A := by + have htrace := + formalPointCountZeta_hasPointCountDerivative extendedPointCount + rw [HasFormalZetaPointCountDerivative] at htrace + calc + PowerSeries.derivative ℂ F = + PowerSeries.subst (PowerSeries.X ^ d) + (PowerSeries.derivative ℂ + (formalPointCountZeta extendedPointCount)) * + PowerSeries.derivative ℂ (PowerSeries.X ^ d) := by + exact PowerSeries.derivative_subst ℂ hs + _ = PowerSeries.subst (PowerSeries.X ^ d) + (formalPointCountZeta extendedPointCount * + pointCountDerivativeSeries extendedPointCount) * + PowerSeries.derivative ℂ (PowerSeries.X ^ d) := by rw [htrace] + _ = F * (PowerSeries.subst (PowerSeries.X ^ d) + (pointCountDerivativeSeries extendedPointCount) * + PowerSeries.derivative ℂ (PowerSeries.X ^ d)) := by + rw [PowerSeries.subst_mul hs] + simp only [F] + rw [mul_assoc] + _ = F * A := by + rw [subst_pointCountDerivativeSeries_mul_derivative_X_pow + pointCount extendedPointCount d hd hcount hsupport] + have hG : PowerSeries.derivative ℂ G = G * A := by + have htrace := formalPointCountZeta_hasPointCountDerivative pointCount + rw [HasFormalZetaPointCountDerivative] at htrace + have hpred : d - 1 + 1 = d := + Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hd.ne') + have hzpow : formalPointCountZeta pointCount ^ (d - 1) * + formalPointCountZeta pointCount = + formalPointCountZeta pointCount ^ d := by + rw [← pow_succ, hpred] + calc + PowerSeries.derivative ℂ G = + (d : PowerSeries ℂ) * + formalPointCountZeta pointCount ^ (d - 1) * + PowerSeries.derivative ℂ + (formalPointCountZeta pointCount) := by + exact PowerSeries.derivative_pow ℂ + (formalPointCountZeta pointCount) d + _ = (d : PowerSeries ℂ) * + formalPointCountZeta pointCount ^ (d - 1) * + (formalPointCountZeta pointCount * + pointCountDerivativeSeries pointCount) := by rw [htrace] + _ = (formalPointCountZeta pointCount ^ (d - 1) * + formalPointCountZeta pointCount) * + ((d : PowerSeries ℂ) * + pointCountDerivativeSeries pointCount) := by ring + _ = G * A := by + rw [hzpow, ← pointCountDerivativeSeries_nat_mul] + exact powerSeries_eq_of_constantCoeff_eq_of_derivative_eq_mul + F G A hconstant hF hG + +/-- The formal constant-extension zeta identity from all-index count and +degree-support relations. This is the convenient downstream form. -/ +theorem formalPointCountZeta_hasDegreeExtensionIdentity + (pointCount extendedPointCount : ℕ → ℕ) (d : ℕ) (hd : 0 < d) + (hcount : ∀ r, + extendedPointCount r = pointCount (d * r)) + (hsupport : ∀ n, ¬ d ∣ n → pointCount n = 0) : + HasFormalDegreeExtensionZetaIdentity + (formalPointCountZeta pointCount) + (formalPointCountZeta extendedPointCount) d := by + apply formalPointCountZeta_hasDegreeExtensionIdentity_of_positive + pointCount extendedPointCount d hd + · intro r _ + exact hcount r + · intro n _ hn + exact hsupport n hn + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean new file mode 100644 index 0000000000..b265e9f60d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean @@ -0,0 +1,208 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +import Mathlib.RingTheory.PowerSeries.Substitution + +/-! +# An ordinary-extension specialization of the degree-index argument + +Suppose a zeta series has the indexed denominator + +`(1 - T^d) (1 - q^d T^d)`. + +After extending the constants by degree `d`, the formal identity is + +`Z_extended(T^d) = Z(T)^d`. + +If the extended zeta series has the ordinary denominator over the enlarged +constant field, clearing denominators gives + +`P_extended(T^d) D(T)^(d - 1) = P(T)^d`. + +For `d > 1`, evaluation at `T = 1` forces `P(1) = 0`. Thus the single, +explicit noncancellation hypothesis `P(1) ≠ 0` forces `d = 1`. This file +contains only that formal algebra. Its ordinary-rationality premise for the +extended zeta series is deliberately stronger than indexed rationality and is +not used to close the geometric F. K. Schmidt argument. The noncircular +indexed-to-indexed theorem is in `FormalZetaDegreeIndexOneIndexed`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open Polynomial +open scoped PowerSeries + +/-- Polynomial realization of the indexed curve-zeta denominator. -/ +def indexedCurveZetaDenominatorPolynomial (q d : ℕ) : Polynomial ℂ := + (1 - Polynomial.X ^ d) * + (1 - Polynomial.C ((q : ℂ) ^ d) * Polynomial.X ^ d) + +@[simp, norm_cast] theorem coe_indexedCurveZetaDenominatorPolynomial + (q d : ℕ) : + (indexedCurveZetaDenominatorPolynomial q d : PowerSeries ℂ) = + indexedCurveZetaDenominator q d := by + simp only [indexedCurveZetaDenominatorPolynomial, + indexedCurveZetaDenominator, + Polynomial.coe_mul, Polynomial.coe_sub, Polynomial.coe_one, + Polynomial.coe_pow, Polynomial.coe_X, Polynomial.coe_C] + +@[simp] theorem indexedCurveZetaDenominatorPolynomial_eval_one + (q d : ℕ) : + (indexedCurveZetaDenominatorPolynomial q d).eval 1 = 0 := by + simp [indexedCurveZetaDenominatorPolynomial] + +/-- The formal constant-extension identity +`Z_extended(T^d) = Z(T)^d`. + +This is kept as an explicit proposition because proving it for the geometric +closed-place zeta series is a separate part of the constant-extension +argument. -/ +def HasFormalDegreeExtensionZetaIdentity + (Z extendedZeta : PowerSeries ℂ) (d : ℕ) : Prop := + PowerSeries.subst (PowerSeries.X ^ d) extendedZeta = Z ^ d + +/-- Substituting `T^d` into a polynomial power series agrees with polynomial +composition by `T^d`. -/ +theorem subst_coe_eq_coe_comp_X_pow + (Q : Polynomial ℂ) (d : ℕ) (hd : 0 < d) : + PowerSeries.subst (PowerSeries.X ^ d) (Q : PowerSeries ℂ) = + ((Q.comp (Polynomial.X ^ d) : Polynomial ℂ) : PowerSeries ℂ) := by + rw [PowerSeries.subst_coe (PowerSeries.HasSubst.X_pow hd.ne')] + change Polynomial.aeval (PowerSeries.X ^ d) Q = _ + induction Q using Polynomial.induction_on' with + | add p q hp hq => + simp only [map_add, hp, hq, Polynomial.add_comp, Polynomial.coe_add] + | monomial n a => + simp [Polynomial.monomial_comp] + +/-- Substituting `T^d` into the ordinary denominator over the degree-`d` +constant extension produces the indexed denominator over the original +constant field. -/ +theorem subst_curveZetaDenominator_pow + (q d : ℕ) (hd : 0 < d) : + PowerSeries.subst (PowerSeries.X ^ d) + (curveZetaDenominator (q ^ d)) = + indexedCurveZetaDenominator q d := by + let hs : PowerSeries.HasSubst (PowerSeries.X ^ d : PowerSeries ℂ) := + PowerSeries.HasSubst.X_pow hd.ne' + have hsone : PowerSeries.subst (PowerSeries.X ^ d : PowerSeries ℂ) + (1 : PowerSeries ℂ) = (1 : PowerSeries ℂ) := by + rw [← PowerSeries.coe_substAlgHom hs] + exact map_one (PowerSeries.substAlgHom hs) + rw [curveZetaDenominator, PowerSeries.subst_mul hs] + simp only [linearPowerSeriesFactor, + PowerSeries.subst_sub hs, PowerSeries.subst_mul hs, + hsone, PowerSeries.subst_C, PowerSeries.subst_X hs, + indexedCurveZetaDenominator] + norm_num + +/-- Clearing the base and constant-extension denominators leaves exactly +`d - 1` copies of the indexed denominator. + +No noncancellation hypothesis is used here. -/ +theorem clearedNumeratorIdentity_of_indexed_rational_and_degreeExtension + (Z extendedZeta : PowerSeries ℂ) (q d : ℕ) + (P extendedP : Polynomial ℂ) + (hd : 0 < d) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) + (hextended : HasCurveZetaRationalForm extendedZeta (q ^ d) extendedP) + (hextension : HasFormalDegreeExtensionZetaIdentity Z extendedZeta d) : + extendedP.comp (Polynomial.X ^ d) * + indexedCurveZetaDenominatorPolynomial q d ^ (d - 1) = + P ^ d := by + let hs : PowerSeries.HasSubst (PowerSeries.X ^ d : PowerSeries ℂ) := + PowerSeries.HasSubst.X_pow hd.ne' + have hextendedCleared : + Z ^ d * indexedCurveZetaDenominator q d = + ((extendedP.comp (Polynomial.X ^ d) : Polynomial ℂ) : + PowerSeries ℂ) := by + have h := congrArg + (PowerSeries.subst (PowerSeries.X ^ d : PowerSeries ℂ)) hextended + rw [PowerSeries.subst_mul hs, hextension, + subst_curveZetaDenominator_pow q d hd, + subst_coe_eq_coe_comp_X_pow extendedP d hd] at h + exact h + have hindexedPow : + Z ^ d * indexedCurveZetaDenominator q d ^ d = + ((P ^ d : Polynomial ℂ) : PowerSeries ℂ) := by + have h := congrArg (fun F : PowerSeries ℂ => F ^ d) hindexed + simpa only [mul_pow, Polynomial.coe_pow] using h + have hpred : d - 1 + 1 = d := + Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hd.ne') + apply Polynomial.coe_injective ℂ + simp only [Polynomial.coe_mul, Polynomial.coe_pow, + coe_indexedCurveZetaDenominatorPolynomial] + calc + ((extendedP.comp (Polynomial.X ^ d) : Polynomial ℂ) : + PowerSeries ℂ) * indexedCurveZetaDenominator q d ^ (d - 1) = + (Z ^ d * indexedCurveZetaDenominator q d) * + indexedCurveZetaDenominator q d ^ (d - 1) := by + rw [hextendedCleared] + _ = Z ^ d * indexedCurveZetaDenominator q d ^ d := by + rw [mul_assoc, mul_comm (indexedCurveZetaDenominator q d), + ← pow_succ, hpred] + _ = (P : PowerSeries ℂ) ^ d := by + simpa only [Polynomial.coe_pow] using hindexedPow + +/-- If `d > 1`, the cleared identity forces the original indexed numerator +to vanish at `T = 1`. This is the formal pole-order mismatch. -/ +theorem indexedNumerator_eval_one_eq_zero_of_clearedIdentity + (q d : ℕ) (P extendedP : Polynomial ℂ) + (hd : 0 < d) (htwo : 2 ≤ d) + (hcleared : + extendedP.comp (Polynomial.X ^ d) * + indexedCurveZetaDenominatorPolynomial q d ^ (d - 1) = + P ^ d) : + P.eval 1 = 0 := by + have hpredPos : 0 < d - 1 := by omega + have heval := congrArg (Polynomial.eval 1) hcleared + have hzero' : 0 = P.eval 1 ^ d := by + simpa only [Polynomial.eval_mul, Polynomial.eval_pow, + indexedCurveZetaDenominatorPolynomial_eval_one, + zero_pow hpredPos.ne', mul_zero] using heval + exact (pow_eq_zero_iff hd.ne').mp hzero'.symm + +/-- Pure polynomial form of the F. K. Schmidt conclusion: numerator +noncancellation at `T = 1` rules out every positive index greater than one. -/ +theorem degreeIndex_eq_one_of_clearedNumeratorIdentity + (q d : ℕ) (P extendedP : Polynomial ℂ) + (hd : 0 < d) (hPone : P.eval 1 ≠ 0) + (hcleared : + extendedP.comp (Polynomial.X ^ d) * + indexedCurveZetaDenominatorPolynomial q d ^ (d - 1) = + P ^ d) : + d = 1 := by + by_contra hne + have htwo : 2 ≤ d := by omega + exact hPone + (indexedNumerator_eval_one_eq_zero_of_clearedIdentity + q d P extendedP hd htwo hcleared) + +/-- Conditional ordinary-extension specialization of the degree-index theorem. + +This algebraic implication is retained as a convenience lemma. The geometric +development does not use its strong ordinary-rationality premise for the +degree-`d` constant extension; it uses the indexed-to-indexed replacement +instead. -/ +theorem degreeIndex_eq_one_of_indexed_rational_and_degreeExtension + (Z extendedZeta : PowerSeries ℂ) (q d : ℕ) + (P extendedP : Polynomial ℂ) + (hd : 0 < d) + (hPone : P.eval 1 ≠ 0) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) + (hextended : HasCurveZetaRationalForm extendedZeta (q ^ d) extendedP) + (hextension : HasFormalDegreeExtensionZetaIdentity Z extendedZeta d) : + d = 1 := by + apply degreeIndex_eq_one_of_clearedNumeratorIdentity q d P extendedP hd hPone + exact clearedNumeratorIdentity_of_indexed_rational_and_degreeExtension + Z extendedZeta q d P extendedP hd hindexed hextended hextension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean new file mode 100644 index 0000000000..23b94181e9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean @@ -0,0 +1,198 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne + +/-! +# The noncircular indexed F. K. Schmidt argument + +The degree-index argument must not assume that the constant extension already +has divisor-degree index one. This file repairs that dependency: both the +original zeta series and the zeta series after extending constants are allowed +to have indexed denominators. + +After substituting `T ^ d` into the extended indexed denominator, clearing +denominators gives + +`P_extended(T ^ d) D_d(T) ^ d = P(T) ^ d D_(d e)(T)`. + +Here `d` is the original degree index and `e` is the (a priori arbitrary) +degree index after constant extension. If `d > 1`, the derivative at `T = 1` +of the left side vanishes to order at least two. The right side has a simple +zero there when `P(1) ≠ 0`. This contradiction proves `d = 1` without +assuming the conclusion for the constant extension. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open Polynomial +open scoped PowerSeries + +/-- Substituting `T ^ d` into an indexed denominator over the degree-`d` +constant extension multiplies its index by `d`. -/ +theorem subst_indexedCurveZetaDenominator + (q d e : ℕ) (hd : 0 < d) : + PowerSeries.subst (PowerSeries.X ^ d) + (indexedCurveZetaDenominator (q ^ d) e) = + indexedCurveZetaDenominator q (d * e) := by + let hs : PowerSeries.HasSubst (PowerSeries.X ^ d : PowerSeries ℂ) := + PowerSeries.HasSubst.X_pow hd.ne' + have hsone : PowerSeries.subst (PowerSeries.X ^ d : PowerSeries ℂ) + (1 : PowerSeries ℂ) = (1 : PowerSeries ℂ) := by + rw [← PowerSeries.coe_substAlgHom hs] + exact map_one (PowerSeries.substAlgHom hs) + rw [indexedCurveZetaDenominator, PowerSeries.subst_mul hs] + simp only [PowerSeries.subst_sub hs, PowerSeries.subst_mul hs, + PowerSeries.subst_pow hs, hsone, PowerSeries.subst_C, + PowerSeries.subst_X hs, indexedCurveZetaDenominator] + congr 1 + · ring + · simp only [Nat.cast_pow, pow_mul] + rfl + +/-- Clearing two indexed rational forms across a degree-`d` constant +extension. In particular, no ordinary rational form is assumed for the +extended curve. -/ +theorem clearedNumeratorIdentity_of_two_indexed_rationalForms + (Z extendedZeta : PowerSeries ℂ) (q d e : ℕ) + (P extendedP : Polynomial ℂ) + (hd : 0 < d) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) + (hextended : + HasIndexedCurveZetaRationalForm extendedZeta (q ^ d) e extendedP) + (hextension : HasFormalDegreeExtensionZetaIdentity Z extendedZeta d) : + extendedP.comp (Polynomial.X ^ d) * + indexedCurveZetaDenominatorPolynomial q d ^ d = + P ^ d * indexedCurveZetaDenominatorPolynomial q (d * e) := by + let hs : PowerSeries.HasSubst (PowerSeries.X ^ d : PowerSeries ℂ) := + PowerSeries.HasSubst.X_pow hd.ne' + have hextendedCleared : + Z ^ d * indexedCurveZetaDenominator q (d * e) = + ((extendedP.comp (Polynomial.X ^ d) : Polynomial ℂ) : + PowerSeries ℂ) := by + have h := congrArg + (PowerSeries.subst (PowerSeries.X ^ d : PowerSeries ℂ)) hextended + rw [PowerSeries.subst_mul hs, hextension, + subst_indexedCurveZetaDenominator q d e hd, + subst_coe_eq_coe_comp_X_pow extendedP d hd] at h + exact h + have hindexedPow : + Z ^ d * indexedCurveZetaDenominator q d ^ d = + ((P ^ d : Polynomial ℂ) : PowerSeries ℂ) := by + have h := congrArg (fun F : PowerSeries ℂ => F ^ d) hindexed + simpa only [mul_pow, Polynomial.coe_pow] using h + apply Polynomial.coe_injective ℂ + simp only [Polynomial.coe_mul, Polynomial.coe_pow, + coe_indexedCurveZetaDenominatorPolynomial] + calc + ((extendedP.comp (Polynomial.X ^ d) : Polynomial ℂ) : + PowerSeries ℂ) * indexedCurveZetaDenominator q d ^ d = + (Z ^ d * indexedCurveZetaDenominator q (d * e)) * + indexedCurveZetaDenominator q d ^ d := by rw [hextendedCleared] + _ = (Z ^ d * indexedCurveZetaDenominator q d ^ d) * + indexedCurveZetaDenominator q (d * e) := by ring + _ = ((P ^ d : Polynomial ℂ) : PowerSeries ℂ) * + indexedCurveZetaDenominator q (d * e) := by rw [hindexedPow] + _ = (P : PowerSeries ℂ) ^ d * + indexedCurveZetaDenominator q (d * e) := by + simp only [Polynomial.coe_pow] + +/-- The indexed denominator has a simple zero at `T = 1`; this is its exact +derivative there. -/ +theorem indexedCurveZetaDenominatorPolynomial_derivative_eval_one + (q n : ℕ) : + (indexedCurveZetaDenominatorPolynomial q n).derivative.eval 1 = + -(n : ℂ) * (1 - (q : ℂ) ^ n) := by + rw [indexedCurveZetaDenominatorPolynomial, Polynomial.derivative_mul] + simp only [Polynomial.derivative_sub, Polynomial.derivative_one, + Polynomial.derivative_pow, Polynomial.derivative_X, + Polynomial.eval_add, Polynomial.eval_mul, Polynomial.eval_sub, + Polynomial.eval_one, Polynomial.eval_zero, Polynomial.eval_C, + Polynomial.eval_pow, Polynomial.eval_X] + ring + +/-- Over a nontrivial finite field, every positive-index zeta denominator has +a nonzero derivative at `T = 1`. -/ +theorem indexedCurveZetaDenominatorPolynomial_derivative_eval_one_ne_zero + (q n : ℕ) (hq : 1 < q) (hn : 0 < n) : + (indexedCurveZetaDenominatorPolynomial q n).derivative.eval 1 ≠ 0 := by + rw [indexedCurveZetaDenominatorPolynomial_derivative_eval_one] + apply mul_ne_zero + · exact neg_ne_zero.mpr (Nat.cast_ne_zero.mpr hn.ne') + · apply sub_ne_zero.mpr + norm_cast + exact (Nat.one_lt_pow hn.ne' hq).ne + +/-- At `T = 1`, a product containing at least two copies of the indexed +denominator has zero derivative. -/ +theorem derivative_eval_one_mul_indexedDenominator_pow_eq_zero + (Q : Polynomial ℂ) (q d : ℕ) (htwo : 2 ≤ d) : + (Q * indexedCurveZetaDenominatorPolynomial q d ^ d).derivative.eval 1 = 0 := by + rw [Polynomial.derivative_mul] + simp only [Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_pow, indexedCurveZetaDenominatorPolynomial_eval_one, + zero_pow (by omega : d ≠ 0), mul_zero, + Polynomial.derivative_pow, Polynomial.eval_C] + rw [zero_pow (by omega : d - 1 ≠ 0)] + ring + +/-- At `T = 1`, differentiating a numerator times one indexed denominator +leaves the numerator value times the derivative of that denominator. -/ +theorem derivative_eval_one_pow_mul_indexedDenominator + (P : Polynomial ℂ) (q d n : ℕ) : + (P ^ d * indexedCurveZetaDenominatorPolynomial q n).derivative.eval 1 = + P.eval 1 ^ d * + (indexedCurveZetaDenominatorPolynomial q n).derivative.eval 1 := by + rw [Polynomial.derivative_mul] + simp only [Polynomial.eval_add, Polynomial.eval_mul, + Polynomial.eval_pow, indexedCurveZetaDenominatorPolynomial_eval_one, + mul_zero, zero_add] + +/-- Pure polynomial form of the noncircular F. K. Schmidt conclusion. -/ +theorem degreeIndex_eq_one_of_twoIndexed_clearedNumeratorIdentity + (q d e : ℕ) (P extendedP : Polynomial ℂ) + (hq : 1 < q) (hd : 0 < d) (he : 0 < e) + (hPone : P.eval 1 ≠ 0) + (hcleared : + extendedP.comp (Polynomial.X ^ d) * + indexedCurveZetaDenominatorPolynomial q d ^ d = + P ^ d * indexedCurveZetaDenominatorPolynomial q (d * e)) : + d = 1 := by + by_contra hne + have htwo : 2 ≤ d := by omega + have hderiv := + congrArg (fun R : Polynomial ℂ => R.derivative.eval 1) hcleared + rw [derivative_eval_one_mul_indexedDenominator_pow_eq_zero + (extendedP.comp (Polynomial.X ^ d)) q d htwo, + derivative_eval_one_pow_mul_indexedDenominator P q d (d * e)] at hderiv + have hdenom : + (indexedCurveZetaDenominatorPolynomial q (d * e)).derivative.eval 1 ≠ 0 := + indexedCurveZetaDenominatorPolynomial_derivative_eval_one_ne_zero + q (d * e) hq (Nat.mul_pos hd he) + exact (mul_ne_zero (pow_ne_zero d hPone) hdenom) hderiv.symm + +/-- Noncircular formal F. K. Schmidt theorem. The extended zeta series may +have any positive degree index `e`; only indexed rationality is required. -/ +theorem degreeIndex_eq_one_of_two_indexed_rationalForms_and_degreeExtension + (Z extendedZeta : PowerSeries ℂ) (q d e : ℕ) + (P extendedP : Polynomial ℂ) + (hq : 1 < q) (hd : 0 < d) (he : 0 < e) + (hPone : P.eval 1 ≠ 0) + (hindexed : HasIndexedCurveZetaRationalForm Z q d P) + (hextended : + HasIndexedCurveZetaRationalForm extendedZeta (q ^ d) e extendedP) + (hextension : HasFormalDegreeExtensionZetaIdentity Z extendedZeta d) : + d = 1 := by + apply degreeIndex_eq_one_of_twoIndexed_clearedNumeratorIdentity + q d e P extendedP hq hd he hPone + exact clearedNumeratorIdentity_of_two_indexed_rationalForms + Z extendedZeta q d e P extendedP hd hindexed hextended hextension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean new file mode 100644 index 0000000000..544b186f75 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness + +/-! +# Euler recurrences for a formal effective-divisor zeta series + +This file packages the exact formal boundary between the remaining +closed-place combinatorics and zeta rationality. A coefficient sequence `A` +satisfies Euler's recurrence when marking one degree unit in an effective +divisor gives the convolution with extension point counts. That recurrence +is precisely the coefficient form of `Z' = Z * pointCountDerivativeSeries`. + +Together with the proved uniqueness and eventual-recurrence results, this +turns the two explicit coefficient identities into either the indexed or the +standard polynomial zeta numerator. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +/-- The formal power series with effective-divisor counts as coefficients. -/ +def effectiveDivisorCountSeries (A : ℕ → ℕ) : PowerSeries ℂ := + PowerSeries.mk fun n => (A n : ℂ) + +/-- Euler's marked-effective-divisor recurrence. The antidiagonal form is +exactly the multiplication formula for formal power series. -/ +def HasEffectiveDivisorPointCountRecurrence + (A pointCount : ℕ → ℕ) : Prop := + ∀ n : ℕ, + A (n + 1) * (n + 1) = + ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, + A ij.1 * pointCount (ij.2 + 1) + +/-- Euler's recurrence is the formal point-count derivative identity. -/ +theorem effectiveDivisorCountSeries_hasPointCountDerivative + (A pointCount : ℕ → ℕ) + (hrec : HasEffectiveDivisorPointCountRecurrence A pointCount) : + HasFormalZetaPointCountDerivative + (effectiveDivisorCountSeries A) pointCount := by + rw [HasFormalZetaPointCountDerivative] + apply PowerSeries.ext + intro n + rw [PowerSeries.coeff_derivative, PowerSeries.coeff_mul] + simp only [effectiveDivisorCountSeries, PowerSeries.coeff_mk, + pointCountDerivativeSeries] + exact_mod_cast hrec n + +/-- A normalized effective-divisor series satisfying Euler's recurrence is +the canonical exponential point-count zeta series. -/ +theorem effectiveDivisorCountSeries_eq_formalPointCountZeta + (A pointCount : ℕ → ℕ) (hA0 : A 0 = 1) + (hrec : HasEffectiveDivisorPointCountRecurrence A pointCount) : + effectiveDivisorCountSeries A = formalPointCountZeta pointCount := by + apply eq_formalPointCountZeta_of_normalized_pointCountDerivative + · simp [effectiveDivisorCountSeries, hA0] + · exact effectiveDivisorCountSeries_hasPointCountDerivative A pointCount hrec + +/-- Euler's recurrence and an eventual step-one divisor recurrence produce +the normalized standard curve-zeta numerator for the point-count series. -/ +theorem exists_formalPointCountZeta_rational_of_effectiveDivisor_recurrences + (A pointCount : ℕ → ℕ) (q N : ℕ) + (hA0 : A 0 = 1) + (hEuler : HasEffectiveDivisorPointCountRecurrence A pointCount) + (hlinear : ∀ n, N ≤ n → + (A (n + 2) : ℂ) = + ((q : ℂ) + 1) * (A (n + 1) : ℂ) - (q : ℂ) * (A n : ℂ)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + HasCurveZetaRationalForm (formalPointCountZeta pointCount) q P := by + obtain ⟨P, hP0, hP⟩ := + exists_normalized_curveZetaRationalForm_of_eventual_coeff_recurrence + (effectiveDivisorCountSeries A) q N + (by simp [effectiveDivisorCountSeries, hA0]) + (by simpa [effectiveDivisorCountSeries] using hlinear) + refine ⟨P, hP0, ?_⟩ + rw [← effectiveDivisorCountSeries_eq_formalPointCountZeta + A pointCount hA0 hEuler] + exact hP + +/-- The corresponding indexed conclusion before the divisor-degree index is +proved to be one. -/ +theorem exists_formalPointCountZeta_indexed_rational_of_effectiveDivisor_recurrences + (A pointCount : ℕ → ℕ) (q d N : ℕ) (hd : 0 < d) + (hA0 : A 0 = 1) + (hEuler : HasEffectiveDivisorPointCountRecurrence A pointCount) + (hlinear : ∀ n, N ≤ n → + (A (n + 2 * d) : ℂ) = + ((q : ℂ) ^ d + 1) * (A (n + d) : ℂ) - + (q : ℂ) ^ d * (A n : ℂ)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta pointCount) q d P := by + obtain ⟨P, hP0, hP⟩ := + exists_normalized_indexedCurveZetaRationalForm_of_eventual_coeff_recurrence + (effectiveDivisorCountSeries A) q d N hd + (by simp [effectiveDivisorCountSeries, hA0]) + (by simpa [effectiveDivisorCountSeries] using hlinear) + refine ⟨P, hP0, ?_⟩ + rw [← effectiveDivisorCountSeries_eq_formalPointCountZeta + A pointCount hA0 hEuler] + exact hP + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean new file mode 100644 index 0000000000..8ab342d8d6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean @@ -0,0 +1,70 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree + +/-! +# Euler composition with numerator-degree bounds + +This file combines the marked-divisor Euler recurrence with the truncation +degree bounds. It is the degree-aware version of the compositions in +`FormalZetaEuler`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +/-- Euler's recurrence and an eventual step-one divisor recurrence produce +a normalized standard numerator of degree `< N + 2`. -/ +theorem exists_formalPointCountZeta_rational_with_natDegree_lt_of_effectiveDivisor_recurrences + (A pointCount : ℕ → ℕ) (q N : ℕ) + (hA0 : A 0 = 1) + (hEuler : HasEffectiveDivisorPointCountRecurrence A pointCount) + (hlinear : ∀ n, N ≤ n → + (A (n + 2) : ℂ) = + ((q : ℂ) + 1) * (A (n + 1) : ℂ) - (q : ℂ) * (A n : ℂ)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ P.natDegree < N + 2 ∧ + HasCurveZetaRationalForm (formalPointCountZeta pointCount) q P := by + obtain ⟨P, hP0, hPdegree, hP⟩ := + exists_normalized_curveZetaRationalForm_with_natDegree_lt + (effectiveDivisorCountSeries A) q N + (by simp [effectiveDivisorCountSeries, hA0]) + (by simpa [effectiveDivisorCountSeries] using hlinear) + refine ⟨P, hP0, hPdegree, ?_⟩ + rw [← effectiveDivisorCountSeries_eq_formalPointCountZeta + A pointCount hA0 hEuler] + exact hP + +/-- Before proving the divisor index is one, the same composition gives an +indexed numerator of degree `< N + 2d`. -/ +theorem exists_formalPointCountZeta_indexed_rational_with_natDegree_lt_of_effectiveDivisor_recurrences + (A pointCount : ℕ → ℕ) (q d N : ℕ) (hd : 0 < d) + (hA0 : A 0 = 1) + (hEuler : HasEffectiveDivisorPointCountRecurrence A pointCount) + (hlinear : ∀ n, N ≤ n → + (A (n + 2 * d) : ℂ) = + ((q : ℂ) ^ d + 1) * (A (n + d) : ℂ) - + (q : ℂ) ^ d * (A n : ℂ)) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ P.natDegree < N + 2 * d ∧ + HasIndexedCurveZetaRationalForm + (formalPointCountZeta pointCount) q d P := by + obtain ⟨P, hP0, hPdegree, hP⟩ := + exists_normalized_indexedCurveZetaRationalForm_with_natDegree_lt + (effectiveDivisorCountSeries A) q d N hd + (by simp [effectiveDivisorCountSeries, hA0]) + (by simpa [effectiveDivisorCountSeries] using hlinear) + refine ⟨P, hP0, hPdegree, ?_⟩ + rw [← effectiveDivisorCountSeries_eq_formalPointCountZeta + A pointCount hA0 hEuler] + exact hP + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean new file mode 100644 index 0000000000..fa459a508f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean @@ -0,0 +1,75 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace + +/-! +# The Hasse bound from formal zeta rationality + +This module records the final analytic composition in the zeta-function +route. Once the canonical formal point-count zeta series has curve-rational +form with numerator `P`, and the point-count error over the even extensions +has square-root growth, the base-field Hasse bound follows with coefficient +`P.natDegree`. + +The two hypotheses are deliberately explicit. In particular, this theorem +does not construct the zeta numerator or prove the geometric extension-point +estimate. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics + +noncomputable section + +/-- Formal point-count zeta rationality and a two-sided square-root estimate +over the even extensions imply the base-field Hasse bound. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_evenError_isBigO + (q : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) + (hP0 : P.coeff 0 = 1) + (hrational : + HasCurveZetaRationalForm (formalPointCountZeta pointCount) q P) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt q := by + apply abs_pointCount_sub_card_sub_one_le_of_zetaNumerator_and_evenError_isBigO + q pointCount P + · exact + hasZetaNumeratorPointCountFormula_of_formalPointCountZeta_rational + q pointCount P hP0 hrational + · exact herror + +/-- Formal point-count zeta rationality and a two-sided square-root estimate +along any fixed positive divisible-even subsequence imply the base-field +Hasse bound. -/ +theorem + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_divisibleEvenError_isBigO + (q δ : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) + (hq : 0 < q) (hδ : 0 < δ) + (hP0 : P.coeff 0 = 1) + (hrational : + HasCurveZetaRationalForm (formalPointCountZeta pointCount) q P) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * δ * n) : ℂ) - (q : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt q := by + apply + abs_pointCount_sub_card_sub_one_le_of_zetaNumerator_and_divisibleEvenError_isBigO + q δ pointCount P hq hδ + · exact + hasZetaNumeratorPointCountFormula_of_formalPointCountZeta_rational + q pointCount P hP0 hrational + · exact herror + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean new file mode 100644 index 0000000000..57f96cf77b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean @@ -0,0 +1,179 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace +import Mathlib.RingTheory.PowerSeries.Trunc + +/-! +# Formal zeta rationality from an eventual coefficient recurrence + +This file isolates the algebraic last step in the divisor-count proof of +zeta rationality. If the coefficients of a power series eventually satisfy +the recurrence with characteristic polynomial `(1 - T)(1 - qT)`, then +multiplication by that denominator has finite support. Its truncation is +therefore an actual polynomial numerator. + +No geometric or point-count hypothesis is used here. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +/-- Expanded form of the standard curve-zeta denominator. -/ +theorem curveZetaDenominator_eq_quadratic (q : ℕ) : + curveZetaDenominator q = + 1 - PowerSeries.C ((q : ℂ) + 1) * PowerSeries.X + + PowerSeries.C (q : ℂ) * PowerSeries.X ^ 2 := by + simp [curveZetaDenominator, linearPowerSeriesFactor] + ring + +/-- The coefficient of `Z(T)(1-T)(1-qT)` in terms of three consecutive +coefficients of `Z`. -/ +theorem coeff_mul_curveZetaDenominator_succ_succ + (Z : PowerSeries ℂ) (q n : ℕ) : + PowerSeries.coeff (n + 2) (Z * curveZetaDenominator q) = + PowerSeries.coeff (n + 2) Z - + ((q : ℂ) + 1) * PowerSeries.coeff (n + 1) Z + + (q : ℂ) * PowerSeries.coeff n Z := by + rw [curveZetaDenominator_eq_quadratic] + rw [show Z * (1 - PowerSeries.C ((q : ℂ) + 1) * PowerSeries.X + + PowerSeries.C (q : ℂ) * PowerSeries.X ^ 2) = + Z - PowerSeries.C ((q : ℂ) + 1) * (Z * PowerSeries.X) + + PowerSeries.C (q : ℂ) * (Z * PowerSeries.X ^ 2) by ring] + rw [map_add, map_sub] + simp only [PowerSeries.coeff_C_mul, PowerSeries.coeff_mul_X_pow'] + simp + +/-- A power series whose coefficients vanish from `N` onward is exactly its +`N`-term polynomial truncation. -/ +theorem powerSeries_eq_coe_trunc_of_coeff_eq_zero + {R : Type*} [CommSemiring R] (F : PowerSeries R) (N : ℕ) + (hzero : ∀ n, N ≤ n → PowerSeries.coeff n F = 0) : + F = (PowerSeries.trunc N F : PowerSeries R) := by + ext n + rw [Polynomial.coeff_coe, PowerSeries.coeff_trunc] + split_ifs with hn + · rfl + · exact hzero n (Nat.le_of_not_gt hn) + +/-- An eventual recurrence with roots `1` and `q` produces a polynomial +curve-zeta numerator. -/ +theorem exists_curveZetaRationalForm_of_eventual_coeff_recurrence + (Z : PowerSeries ℂ) (q N : ℕ) + (hrec : ∀ n, N ≤ n → + PowerSeries.coeff (n + 2) Z = + ((q : ℂ) + 1) * PowerSeries.coeff (n + 1) Z - + (q : ℂ) * PowerSeries.coeff n Z) : + ∃ P : Polynomial ℂ, HasCurveZetaRationalForm Z q P := by + let F := Z * curveZetaDenominator q + have hzero : ∀ m, N + 2 ≤ m → PowerSeries.coeff m F = 0 := by + intro m hm + obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le hm + have hn : N ≤ N + n := Nat.le_add_right N n + rw [show N + 2 + n = (N + n) + 2 by omega] + rw [coeff_mul_curveZetaDenominator_succ_succ] + rw [hrec (N + n) hn] + ring + refine ⟨PowerSeries.trunc (N + 2) F, ?_⟩ + exact powerSeries_eq_coe_trunc_of_coeff_eq_zero F (N + 2) hzero + +/-- Normalized constant coefficient is preserved by the recurrence +construction. -/ +theorem exists_normalized_curveZetaRationalForm_of_eventual_coeff_recurrence + (Z : PowerSeries ℂ) (q N : ℕ) + (hZ0 : PowerSeries.constantCoeff Z = 1) + (hrec : ∀ n, N ≤ n → + PowerSeries.coeff (n + 2) Z = + ((q : ℂ) + 1) * PowerSeries.coeff (n + 1) Z - + (q : ℂ) * PowerSeries.coeff n Z) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ HasCurveZetaRationalForm Z q P := by + obtain ⟨P, hP⟩ := + exists_curveZetaRationalForm_of_eventual_coeff_recurrence Z q N hrec + refine ⟨P, ?_, hP⟩ + have hconstant := congrArg PowerSeries.constantCoeff hP + simpa [HasCurveZetaRationalForm, hZ0] using hconstant.symm + +/-- The denominator that occurs before proving that the divisor-degree index +is one. An index `d` permits nonzero divisor coefficients only along residue +classes modulo `d`. -/ +def indexedCurveZetaDenominator (q d : ℕ) : PowerSeries ℂ := + (1 - PowerSeries.X ^ d) * + (1 - PowerSeries.C ((q : ℂ) ^ d) * PowerSeries.X ^ d) + +/-- Rationality with a possibly nontrivial divisor-degree index. -/ +def HasIndexedCurveZetaRationalForm + (Z : PowerSeries ℂ) (q d : ℕ) (P : Polynomial ℂ) : Prop := + Z * indexedCurveZetaDenominator q d = (P : PowerSeries ℂ) + +/-- Coefficient expansion for the indexed denominator. -/ +theorem coeff_mul_indexedCurveZetaDenominator + (Z : PowerSeries ℂ) (q d n : ℕ) : + PowerSeries.coeff (n + 2 * d) + (Z * indexedCurveZetaDenominator q d) = + PowerSeries.coeff (n + 2 * d) Z - + ((q : ℂ) ^ d + 1) * PowerSeries.coeff (n + d) Z + + (q : ℂ) ^ d * PowerSeries.coeff n Z := by + rw [indexedCurveZetaDenominator] + rw [show Z * ((1 - PowerSeries.X ^ d) * + (1 - PowerSeries.C ((q : ℂ) ^ d) * PowerSeries.X ^ d)) = + Z - (Z * PowerSeries.X ^ d) - + PowerSeries.C ((q : ℂ) ^ d) * (Z * PowerSeries.X ^ d) + + PowerSeries.C ((q : ℂ) ^ d) * + (Z * PowerSeries.X ^ (2 * d)) by ring] + rw [map_add, map_sub, map_sub] + simp only [PowerSeries.coeff_C_mul, PowerSeries.coeff_mul_X_pow'] + rw [if_pos (by omega : d ≤ n + 2 * d), + if_pos (by omega : 2 * d ≤ n + 2 * d)] + simp only [show n + 2 * d - d = n + d by omega, + show n + 2 * d - 2 * d = n by omega] + ring + +/-- An eventual step-`d` recurrence produces an indexed polynomial zeta +numerator. The case `d = 1` is the standard curve denominator above. -/ +theorem exists_indexedCurveZetaRationalForm_of_eventual_coeff_recurrence + (Z : PowerSeries ℂ) (q d N : ℕ) + (hrec : ∀ n, N ≤ n → + PowerSeries.coeff (n + 2 * d) Z = + ((q : ℂ) ^ d + 1) * PowerSeries.coeff (n + d) Z - + (q : ℂ) ^ d * PowerSeries.coeff n Z) : + ∃ P : Polynomial ℂ, HasIndexedCurveZetaRationalForm Z q d P := by + let F := Z * indexedCurveZetaDenominator q d + have hzero : ∀ m, N + 2 * d ≤ m → PowerSeries.coeff m F = 0 := by + intro m hm + obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le hm + have hn : N ≤ N + n := Nat.le_add_right N n + rw [show N + 2 * d + n = (N + n) + 2 * d by omega] + rw [coeff_mul_indexedCurveZetaDenominator] + rw [hrec (N + n) hn] + ring + refine ⟨PowerSeries.trunc (N + 2 * d) F, ?_⟩ + exact powerSeries_eq_coe_trunc_of_coeff_eq_zero F (N + 2 * d) hzero + +/-- Normalized indexed rationality. -/ +theorem exists_normalized_indexedCurveZetaRationalForm_of_eventual_coeff_recurrence + (Z : PowerSeries ℂ) (q d N : ℕ) + (hd : 0 < d) + (hZ0 : PowerSeries.constantCoeff Z = 1) + (hrec : ∀ n, N ≤ n → + PowerSeries.coeff (n + 2 * d) Z = + ((q : ℂ) ^ d + 1) * PowerSeries.coeff (n + d) Z - + (q : ℂ) ^ d * PowerSeries.coeff n Z) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ HasIndexedCurveZetaRationalForm Z q d P := by + obtain ⟨P, hP⟩ := + exists_indexedCurveZetaRationalForm_of_eventual_coeff_recurrence + Z q d N hrec + refine ⟨P, ?_, hP⟩ + have hconstant := congrArg PowerSeries.constantCoeff hP + simpa [HasIndexedCurveZetaRationalForm, indexedCurveZetaDenominator, hZ0, + Nat.ne_of_gt hd] + using hconstant.symm + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean new file mode 100644 index 0000000000..596e6cc468 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean @@ -0,0 +1,90 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality + +/-! +# Degree bounds in formal zeta rationality + +The recurrence construction in `FormalZetaRationality` chooses its numerator +as a finite truncation. This file exposes the resulting degree bound, which +is needed to turn a Riemann--Roch threshold into a uniform Hasse coefficient. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +/-- A normalized eventual step-one recurrence produces a numerator whose +degree is strictly smaller than the truncation length `N + 2`. -/ +theorem exists_normalized_curveZetaRationalForm_with_natDegree_lt + (Z : PowerSeries ℂ) (q N : ℕ) + (hZ0 : PowerSeries.constantCoeff Z = 1) + (hrec : ∀ n, N ≤ n → + PowerSeries.coeff (n + 2) Z = + ((q : ℂ) + 1) * PowerSeries.coeff (n + 1) Z - + (q : ℂ) * PowerSeries.coeff n Z) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ P.natDegree < N + 2 ∧ + HasCurveZetaRationalForm Z q P := by + let F := Z * curveZetaDenominator q + have hzero : ∀ m, N + 2 ≤ m → PowerSeries.coeff m F = 0 := by + intro m hm + obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le hm + have hn : N ≤ N + n := Nat.le_add_right N n + rw [show N + 2 + n = (N + n) + 2 by omega] + rw [coeff_mul_curveZetaDenominator_succ_succ] + rw [hrec (N + n) hn] + ring + let P := PowerSeries.trunc (N + 2) F + have hform : HasCurveZetaRationalForm Z q P := by + exact powerSeries_eq_coe_trunc_of_coeff_eq_zero F (N + 2) hzero + have hdegree : P.natDegree < N + 2 := by + simpa [P, show N + 2 = (N + 1) + 1 by omega] using + (PowerSeries.natDegree_trunc_lt F (N + 1)) + have hconstant := congrArg PowerSeries.constantCoeff hform + have hP0 : P.coeff 0 = 1 := by + simpa [HasCurveZetaRationalForm, hZ0] using hconstant.symm + exact ⟨P, hP0, hdegree, hform⟩ + +/-- The indexed recurrence likewise exposes the exact truncation-degree +bound `N + 2d`. -/ +theorem exists_normalized_indexedCurveZetaRationalForm_with_natDegree_lt + (Z : PowerSeries ℂ) (q d N : ℕ) (hd : 0 < d) + (hZ0 : PowerSeries.constantCoeff Z = 1) + (hrec : ∀ n, N ≤ n → + PowerSeries.coeff (n + 2 * d) Z = + ((q : ℂ) ^ d + 1) * PowerSeries.coeff (n + d) Z - + (q : ℂ) ^ d * PowerSeries.coeff n Z) : + ∃ P : Polynomial ℂ, + P.coeff 0 = 1 ∧ P.natDegree < N + 2 * d ∧ + HasIndexedCurveZetaRationalForm Z q d P := by + let F := Z * indexedCurveZetaDenominator q d + have hzero : ∀ m, N + 2 * d ≤ m → PowerSeries.coeff m F = 0 := by + intro m hm + obtain ⟨n, rfl⟩ := Nat.exists_eq_add_of_le hm + have hn : N ≤ N + n := Nat.le_add_right N n + rw [show N + 2 * d + n = (N + n) + 2 * d by omega] + rw [coeff_mul_indexedCurveZetaDenominator] + rw [hrec (N + n) hn] + ring + let P := PowerSeries.trunc (N + 2 * d) F + have hform : HasIndexedCurveZetaRationalForm Z q d P := by + exact powerSeries_eq_coe_trunc_of_coeff_eq_zero F (N + 2 * d) hzero + have hlength : 0 < N + 2 * d := by omega + have hdegree : P.natDegree < N + 2 * d := by + have hpred : N + 2 * d - 1 + 1 = N + 2 * d := by omega + simpa [P, hpred] using + (PowerSeries.natDegree_trunc_lt F (N + 2 * d - 1)) + have hconstant := congrArg PowerSeries.constantCoeff hform + have hP0 : P.coeff 0 = 1 := by + simpa [HasIndexedCurveZetaRationalForm, indexedCurveZetaDenominator, + hZ0, Nat.ne_of_gt hd] using hconstant.symm + exact ⟨P, hP0, hdegree, hform⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean new file mode 100644 index 0000000000..97a33645d1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -0,0 +1,283 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral +import Mathlib.RingTheory.PowerSeries.Derivative +import Mathlib.RingTheory.PowerSeries.Exp +import Mathlib.RingTheory.PowerSeries.Inverse +import Mathlib.RingTheory.PowerSeries.Substitution +import Mathlib.RingTheory.PowerSeries.WellKnown + +namespace BGS.HasseWeil + +open Polynomial +open scoped BigOperators PowerSeries + +noncomputable section + +def negativeXLogDerivative (f : PowerSeries ℂ) : PowerSeries ℂ := + -PowerSeries.X * PowerSeries.derivative ℂ f * f⁻¹ + +def linearPowerSeriesFactor (a : ℂ) : PowerSeries ℂ := + 1 - PowerSeries.C a * PowerSeries.X + +@[simp] theorem constantCoeff_linearPowerSeriesFactor (a : ℂ) : + PowerSeries.constantCoeff (linearPowerSeriesFactor a) = 1 := by + simp [linearPowerSeriesFactor] + +theorem linearPowerSeriesFactor_inv (a : ℂ) : + (linearPowerSeriesFactor a)⁻¹ = + PowerSeries.rescale a (PowerSeries.mk 1) := by + apply (PowerSeries.inv_eq_iff_mul_eq_one (by simp)).2 + have h := congrArg (PowerSeries.rescale a) + (PowerSeries.mk_one_mul_one_sub_eq_one ℂ) + simpa [linearPowerSeriesFactor, mul_comm] using h + +theorem derivative_linearPowerSeriesFactor (a : ℂ) : + PowerSeries.derivative ℂ (linearPowerSeriesFactor a) = -PowerSeries.C a := by + change PowerSeries.derivativeFun (linearPowerSeriesFactor a) = -PowerSeries.C a + rw [linearPowerSeriesFactor, sub_eq_add_neg] + rw [show -(PowerSeries.C a * PowerSeries.X) = + (-1 : ℂ) • (PowerSeries.C a * PowerSeries.X) by simp] + rw [PowerSeries.derivativeFun_add, PowerSeries.derivativeFun_one, + PowerSeries.derivativeFun_smul, PowerSeries.derivativeFun_mul] + have hX : PowerSeries.derivativeFun (PowerSeries.X : PowerSeries ℂ) = 1 := + PowerSeries.derivative_X + have hC : PowerSeries.derivativeFun (PowerSeries.C a) = 0 := + PowerSeries.derivative_C a + rw [hX, hC] + simp + +@[simp] theorem coeff_negativeXLogDerivative_linearPowerSeriesFactor + (a : ℂ) (n : ℕ) : + PowerSeries.coeff (n + 1) + (negativeXLogDerivative (linearPowerSeriesFactor a)) = a ^ (n + 1) := by + rw [negativeXLogDerivative, linearPowerSeriesFactor_inv] + rw [derivative_linearPowerSeriesFactor] + simp only [neg_mul_neg] + rw [mul_assoc, PowerSeries.coeff_succ_X_mul, + PowerSeries.coeff_C_mul, PowerSeries.coeff_rescale, PowerSeries.coeff_mk] + simp [pow_succ, mul_comm] + +theorem inverse_mul_of_constantCoeff_ne_zero + (f g : PowerSeries ℂ) + (hf : PowerSeries.constantCoeff f ≠ 0) + (hg : PowerSeries.constantCoeff g ≠ 0) : + (f * g)⁻¹ = f⁻¹ * g⁻¹ := by + apply (PowerSeries.inv_eq_iff_mul_eq_one (by simpa using mul_ne_zero hf hg)).2 + calc + (f⁻¹ * g⁻¹) * (f * g) = (f⁻¹ * f) * (g⁻¹ * g) := by ring + _ = 1 := by rw [PowerSeries.inv_mul_cancel f hf, + PowerSeries.inv_mul_cancel g hg, one_mul] + +theorem negativeXLogDerivative_mul + (f g : PowerSeries ℂ) + (hf : PowerSeries.constantCoeff f ≠ 0) + (hg : PowerSeries.constantCoeff g ≠ 0) : + negativeXLogDerivative (f * g) = + negativeXLogDerivative f + negativeXLogDerivative g := by + unfold negativeXLogDerivative + change -PowerSeries.X * PowerSeries.derivativeFun (f * g) * (f * g)⁻¹ = + -PowerSeries.X * PowerSeries.derivativeFun f * f⁻¹ + + -PowerSeries.X * PowerSeries.derivativeFun g * g⁻¹ + rw [PowerSeries.derivativeFun_mul, + inverse_mul_of_constantCoeff_ne_zero f g hf hg] + simp only [smul_eq_mul] + calc + -PowerSeries.X * (f * PowerSeries.derivativeFun g + + g * PowerSeries.derivativeFun f) * (f⁻¹ * g⁻¹) = + (-PowerSeries.X * PowerSeries.derivativeFun g * g⁻¹) * (f * f⁻¹) + + (-PowerSeries.X * PowerSeries.derivativeFun f * f⁻¹) * (g * g⁻¹) := by ring + _ = -PowerSeries.X * PowerSeries.derivativeFun f * f⁻¹ + + -PowerSeries.X * PowerSeries.derivativeFun g * g⁻¹ := by + rw [PowerSeries.mul_inv_cancel f hf, PowerSeries.mul_inv_cancel g hg] + ring + +theorem negativeXLogDerivative_prod_linearPowerSeriesFactor + {I : Type*} [Fintype I] [DecidableEq I] + (a : I → ℂ) : + negativeXLogDerivative (∏ i, linearPowerSeriesFactor (a i)) = + ∑ i, negativeXLogDerivative (linearPowerSeriesFactor (a i)) := by + classical + refine Finset.induction_on (Finset.univ : Finset I) ?_ ?_ + · simp [negativeXLogDerivative] + · intro i s hi hs + rw [Finset.prod_insert hi, Finset.sum_insert hi, + negativeXLogDerivative_mul] + · rw [hs] + · simp + · simp + +theorem coeff_negativeXLogDerivative_prod_linearPowerSeriesFactor + {I : Type*} [Fintype I] [DecidableEq I] + (a : I → ℂ) (n : ℕ) : + PowerSeries.coeff (n + 1) + (negativeXLogDerivative (∏ i, linearPowerSeriesFactor (a i))) = + ∑ i, a i ^ (n + 1) := by + rw [negativeXLogDerivative_prod_linearPowerSeriesFactor] + simp + +/-- The formal series whose coefficient at `n` is the point count over the +extension of degree `n + 1`. -/ +def pointCountDerivativeSeries (pointCount : ℕ → ℕ) : PowerSeries ℂ := + PowerSeries.mk fun n => (pointCount (n + 1) : ℂ) + +/-- Euler's logarithmic-derivative identity for a point-count zeta series. -/ +def HasFormalZetaPointCountDerivative + (Z : PowerSeries ℂ) (pointCount : ℕ → ℕ) : Prop := + PowerSeries.derivative ℂ Z = Z * pointCountDerivativeSeries pointCount + +/-- The formal logarithm `∑ₙ Nₙ Tⁿ/n` attached to extension point counts. -/ +def pointCountLogSeries (pointCount : ℕ → ℕ) : PowerSeries ℂ := + PowerSeries.mk fun n => + if n = 0 then 0 else (pointCount n : ℂ) / (n : ℂ) + +@[simp] theorem constantCoeff_pointCountLogSeries (pointCount : ℕ → ℕ) : + PowerSeries.constantCoeff (pointCountLogSeries pointCount) = 0 := by + simp [pointCountLogSeries] + +theorem pointCountLogSeries_hasSubst (pointCount : ℕ → ℕ) : + PowerSeries.HasSubst (pointCountLogSeries pointCount) := + PowerSeries.HasSubst.of_constantCoeff_zero + (constantCoeff_pointCountLogSeries pointCount) + +/-- The formal exponential definition +`exp(∑ₙ Nₙ Tⁿ/n)` of the point-count zeta series. -/ +def formalPointCountZeta (pointCount : ℕ → ℕ) : PowerSeries ℂ := + (PowerSeries.exp ℂ).subst (pointCountLogSeries pointCount) + +theorem derivative_pointCountLogSeries (pointCount : ℕ → ℕ) : + PowerSeries.derivative ℂ (pointCountLogSeries pointCount) = + pointCountDerivativeSeries pointCount := by + ext n + rw [PowerSeries.coeff_derivative] + simp [pointCountLogSeries, pointCountDerivativeSeries, + Nat.cast_add, Nat.cast_one] + field_simp + +theorem formalPointCountZeta_hasPointCountDerivative + (pointCount : ℕ → ℕ) : + HasFormalZetaPointCountDerivative + (formalPointCountZeta pointCount) pointCount := by + rw [HasFormalZetaPointCountDerivative, formalPointCountZeta, + PowerSeries.derivative_subst ℂ (pointCountLogSeries_hasSubst pointCount), + PowerSeries.derivative_exp, derivative_pointCountLogSeries] + +/-- The denominator `(1 - T)(1 - qT)` of the zeta function of a curve over +the field with `q` elements. -/ +def curveZetaDenominator (q : ℕ) : PowerSeries ℂ := + linearPowerSeriesFactor 1 * linearPowerSeriesFactor (q : ℂ) + +@[simp] theorem constantCoeff_curveZetaDenominator (q : ℕ) : + PowerSeries.constantCoeff (curveZetaDenominator q) = 1 := by + simp [curveZetaDenominator] + +/-- Rationality in the normalized curve form. -/ +def HasCurveZetaRationalForm + (Z : PowerSeries ℂ) (q : ℕ) (P : Polynomial ℂ) : Prop := + Z * curveZetaDenominator q = (P : PowerSeries ℂ) + +theorem coeff_negativeXLogDerivative_polynomial + (P : Polynomial ℂ) (hP0 : P.coeff 0 = 1) (n : ℕ) : + PowerSeries.coeff (n + 1) + (negativeXLogDerivative (P : PowerSeries ℂ)) = + ∑ i, reciprocalRootParameter P i ^ (n + 1) := by + let a : Fin P.natDegree → ℂ := reciprocalRootParameter P + have hfactor : P = ∏ i, (1 - Polynomial.C (a i) * Polynomial.X) := by + simpa only [a] using polynomial_eq_prod_reciprocalRootParameter P hP0 + have hfactorSeries := + congrArg (Polynomial.coeToPowerSeries.ringHom : + Polynomial ℂ →+* PowerSeries ℂ) hfactor + have hseries : + (P : PowerSeries ℂ) = + ∏ i, linearPowerSeriesFactor (a i) := by + simpa [linearPowerSeriesFactor] using hfactorSeries + rw [hseries] + simpa only [a] using + coeff_negativeXLogDerivative_prod_linearPowerSeriesFactor a n + +theorem coeff_negativeXLogDerivative_curveZetaDenominator + (q n : ℕ) : + PowerSeries.coeff (n + 1) + (negativeXLogDerivative (curveZetaDenominator q)) = + 1 + (q : ℂ) ^ (n + 1) := by + rw [curveZetaDenominator, + negativeXLogDerivative_mul _ _ (by simp) (by simp), map_add] + rw [coeff_negativeXLogDerivative_linearPowerSeriesFactor, + coeff_negativeXLogDerivative_linearPowerSeriesFactor] + simp + +theorem coeff_negativeXLogDerivative_of_pointCountDerivative + (Z : PowerSeries ℂ) (pointCount : ℕ → ℕ) + (hZ0 : PowerSeries.constantCoeff Z = 1) + (htrace : HasFormalZetaPointCountDerivative Z pointCount) + (n : ℕ) : + PowerSeries.coeff (n + 1) (negativeXLogDerivative Z) = + -(pointCount (n + 1) : ℂ) := by + have hZne : PowerSeries.constantCoeff Z ≠ 0 := by simp [hZ0] + have hcancel := PowerSeries.mul_inv_cancel Z hZne + have hseries : + negativeXLogDerivative Z = + -PowerSeries.X * pointCountDerivativeSeries pointCount := by + rw [negativeXLogDerivative, htrace] + calc + -PowerSeries.X * + (Z * pointCountDerivativeSeries pointCount) * Z⁻¹ = + (-PowerSeries.X * pointCountDerivativeSeries pointCount) * (Z * Z⁻¹) := by + ring + _ = -PowerSeries.X * pointCountDerivativeSeries pointCount := by + rw [hcancel, mul_one] + rw [hseries] + simp [pointCountDerivativeSeries] + +/-- A normalized rational zeta series satisfying Euler's derivative identity +produces the reciprocal-root extension point-count formula. -/ +theorem hasZetaNumeratorPointCountFormula_of_formalZeta + (q : ℕ) (pointCount : ℕ → ℕ) + (Z : PowerSeries ℂ) (P : Polynomial ℂ) + (hP0 : P.coeff 0 = 1) + (htrace : HasFormalZetaPointCountDerivative Z pointCount) + (hrational : HasCurveZetaRationalForm Z q P) : + HasZetaNumeratorPointCountFormula q pointCount P := by + have hZ0 : PowerSeries.constantCoeff Z = 1 := by + have h := congrArg PowerSeries.constantCoeff hrational + simpa [HasCurveZetaRationalForm, hP0] using h + have hZne : PowerSeries.constantCoeff Z ≠ 0 := by simp [hZ0] + have hDne : PowerSeries.constantCoeff (curveZetaDenominator q) ≠ 0 := by simp + have hlog : + negativeXLogDerivative Z + + negativeXLogDerivative (curveZetaDenominator q) = + negativeXLogDerivative (P : PowerSeries ℂ) := by + rw [← negativeXLogDerivative_mul Z (curveZetaDenominator q) hZne hDne] + exact congrArg negativeXLogDerivative hrational + refine ⟨hP0, ?_⟩ + intro m hm + obtain ⟨n, rfl⟩ := Nat.exists_eq_succ_of_ne_zero (by omega : m ≠ 0) + have hcoeff := congrArg (PowerSeries.coeff (n + 1)) hlog + rw [map_add, + coeff_negativeXLogDerivative_of_pointCountDerivative Z pointCount hZ0 htrace, + coeff_negativeXLogDerivative_curveZetaDenominator, + coeff_negativeXLogDerivative_polynomial P hP0] at hcoeff + rw [← sum_reciprocalRootParameter_pow] + simp only [pow_succ] at hcoeff ⊢ + linear_combination -hcoeff + +/-- For the canonical exponential point-count zeta series, rationality in +curve form is the only remaining premise needed for the numerator trace +formula. -/ +theorem hasZetaNumeratorPointCountFormula_of_formalPointCountZeta_rational + (q : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) + (hP0 : P.coeff 0 = 1) + (hrational : + HasCurveZetaRationalForm (formalPointCountZeta pointCount) q P) : + HasZetaNumeratorPointCountFormula q pointCount P := + hasZetaNumeratorPointCountFormula_of_formalZeta q pointCount + (formalPointCountZeta pointCount) P hP0 + (formalPointCountZeta_hasPointCountDerivative pointCount) hrational + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean new file mode 100644 index 0000000000..116f1f408f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace + +/-! +# Uniqueness of a normalized formal point-count zeta series + +Over the complex numbers, the differential equation + +`Z' = Z * A` + +together with the constant coefficient of `Z` determines a formal power +series uniquely. This gives the formal bridge needed after proving Euler's +coefficient identity for an effective-divisor zeta series: that series is the +canonical exponential `formalPointCountZeta`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +/-- Two formal power series with the same constant coefficient and the same +logarithmic-derivative equation are equal. -/ +theorem powerSeries_eq_of_constantCoeff_eq_of_derivative_eq_mul + (F G A : PowerSeries ℂ) + (hconstant : PowerSeries.constantCoeff F = PowerSeries.constantCoeff G) + (hF : PowerSeries.derivative ℂ F = F * A) + (hG : PowerSeries.derivative ℂ G = G * A) : + F = G := by + apply PowerSeries.ext + intro n + induction n using Nat.strong_induction_on with + | h n ih => + cases n with + | zero => + simpa only [PowerSeries.coeff_zero_eq_constantCoeff_apply] using hconstant + | succ n => + have hFc := congrArg (PowerSeries.coeff n) hF + have hGc := congrArg (PowerSeries.coeff n) hG + rw [PowerSeries.coeff_derivative] at hFc hGc + have hmul : PowerSeries.coeff n (F * A) = + PowerSeries.coeff n (G * A) := by + rw [PowerSeries.coeff_mul, PowerSeries.coeff_mul] + apply Finset.sum_congr rfl + intro ij hij + have hle : ij.1 ≤ n := + Finset.HasAntidiagonal.antidiagonal.fst_le hij + rw [show PowerSeries.coeff ij.1 F = PowerSeries.coeff ij.1 G by + exact ih ij.1 (Nat.lt_succ_of_le hle)] + have hcast : (n : ℂ) + 1 ≠ 0 := by + exact_mod_cast Nat.succ_ne_zero n + apply mul_right_cancel₀ hcast + calc + PowerSeries.coeff (n + 1) F * ((n : ℂ) + 1) = + PowerSeries.coeff n (F * A) := hFc + _ = PowerSeries.coeff n (G * A) := hmul + _ = PowerSeries.coeff (n + 1) G * ((n : ℂ) + 1) := hGc.symm + +/-- A normalized series satisfying Euler's point-count derivative identity +is the canonical exponential point-count zeta series. -/ +theorem eq_formalPointCountZeta_of_normalized_pointCountDerivative + (Z : PowerSeries ℂ) (pointCount : ℕ → ℕ) + (hZ0 : PowerSeries.constantCoeff Z = 1) + (htrace : HasFormalZetaPointCountDerivative Z pointCount) : + Z = formalPointCountZeta pointCount := by + apply powerSeries_eq_of_constantCoeff_eq_of_derivative_eq_mul + Z (formalPointCountZeta pointCount) (pointCountDerivativeSeries pointCount) + · rw [hZ0, ← PowerSeries.coeff_zero_eq_constantCoeff_apply] + rw [formalPointCountZeta, + PowerSeries.coeff_subst' + (pointCountLogSeries_hasSubst pointCount)] + rw [finsum_eq_single _ 0] + · simp [pointCountLogSeries] + · intro d hd + simp [pointCountLogSeries, zero_pow hd] + · exact htrace + · exact formalPointCountZeta_hasPointCountDerivative pointCount + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean new file mode 100644 index 0000000000..d1d54dc463 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber + +/-! +# Cardinalities of Frobenius place stabilizers + +This file supplies the local cardinality identities required by the +Frobenius-coset form of Burnside averaging. + +Suppose a place of a relative Galois extension has absolute degree `[S : C]` +and lies above a degree-one place. Multiplicativity of place degree then says +that its relative inertia degree is `[S : C]`. The decomposition-group formula +and the finite-field identity + +`|Aut_C(S)| = [S : C]` + +show that its stabilizer has cardinality + +`|restricted quotient kernel| * |Aut_C(S)|`, + +provided the restricted quotient kernel is identified with inertia. Both +finite places and places above infinity are covered, first for the underlying +decomposition groups and then in the restriction-fiber actions used by +`sum_card_fixedBy_quotientFiber_eq_card_ker_of_stabilizer_card`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (C : Type*) [Field C] [Fintype C] + [DecidableEq C] [DecidableEq (RatFunc C)] +variable (M : Type*) [Field M] [Algebra (RatFunc C) M] + [FiniteDimensional (RatFunc C) M] + [Algebra.IsSeparable (RatFunc C) M] +variable (L : Type*) [Field L] [Algebra (RatFunc C) L] + [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] + [Algebra M L] [IsScalarTower (RatFunc C) M L] + [IsGalois M L] +variable (S : Type*) [Field S] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S] + +/-- A finite place of degree `[S : C]` above a degree-one place has the +decomposition-group cardinality required by Frobenius-coset averaging, once +the restricted constant quotient kernel is identified with inertia. -/ +theorem finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut + (π : Gal(L/M) →* (S ≃ₐ[C] S)) + (Q : FiniteExtensionFinitePlace C L) + (hTop : finiteExtensionPlaceDegree C L (.inl Q) = Module.finrank C S) + (hBase : finiteExtensionPlaceDegree C M + (.inl (finitePlaceUnder C M L Q)) = 1) + (hker : + letI := finiteIntegralClosureGalAction C M L + (π.comp (finitePlaceDecompositionGroup C M L Q).subtype).ker = + Q.asIdeal.inertia (finitePlaceDecompositionGroup C M L Q)) : + Nat.card (finitePlaceDecompositionGroup C M L Q) = + Nat.card + (π.comp (finitePlaceDecompositionGroup C M L Q).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + letI := finiteIntegralClosureGalAction C M L + have hrelative : + finitePlaceRelativeInertiaDeg C M L Q = Module.finrank C S := by + have hdegree := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg C M L Q + rw [hTop, hBase, one_mul] at hdegree + exact hdegree.symm + have hkernel : + Nat.card + (π.comp (finitePlaceDecompositionGroup C M L Q).subtype).ker = + finitePlaceRelativeRamificationIdx C M L Q := by + rw [hker] + change Nat.card + ((Q.asIdeal.inertia Gal(L/M)).subgroupOf + (finitePlaceDecompositionGroup C M L Q)) = _ + calc + Nat.card + ((Q.asIdeal.inertia Gal(L/M)).subgroupOf + (finitePlaceDecompositionGroup C M L Q)) = + Nat.card (Q.asIdeal.inertia Gal(L/M)) := + Nat.card_congr + (Subgroup.subgroupOfEquivOfLe + (Ideal.inertia_le_stabilizer (M := Gal(L/M)) Q.asIdeal)).toEquiv + _ = finitePlaceRelativeRamificationIdx C M L Q := + finitePlaceInertiaGroup_card_eq_ramificationIdx C M L Q + rw [finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg, + ← hkernel, hrelative, ← IsGalois.card_aut_eq_finrank C S] + +/-- The corresponding decomposition-group cardinality identity for a place +above infinity. -/ +theorem infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut + (π : Gal(L/M) →* (S ≃ₐ[C] S)) + (Q : FiniteExtensionInfinityPlace C L) + (hTop : finiteExtensionPlaceDegree C L (.inr Q) = Module.finrank C S) + (hBase : finiteExtensionPlaceDegree C M + (.inr (infinityPlaceUnder C M L Q)) = 1) + (hker : + letI := infinityIntegralClosureGalAction C M L + (π.comp (infinityPlaceDecompositionGroup C M L Q).subtype).ker = + Q.1.inertia (infinityPlaceDecompositionGroup C M L Q)) : + Nat.card (infinityPlaceDecompositionGroup C M L Q) = + Nat.card + (π.comp (infinityPlaceDecompositionGroup C M L Q).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + letI := infinityIntegralClosureGalAction C M L + have hrelative : + infinityPlaceRelativeInertiaDeg C M L Q = Module.finrank C S := by + have hdegree := + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg C M L Q + rw [hTop, hBase, one_mul] at hdegree + exact hdegree.symm + have hkernel : + Nat.card + (π.comp (infinityPlaceDecompositionGroup C M L Q).subtype).ker = + infinityPlaceRelativeRamificationIdx C M L Q := by + rw [hker] + change Nat.card + ((Q.1.inertia Gal(L/M)).subgroupOf + (infinityPlaceDecompositionGroup C M L Q)) = _ + calc + Nat.card + ((Q.1.inertia Gal(L/M)).subgroupOf + (infinityPlaceDecompositionGroup C M L Q)) = + Nat.card (Q.1.inertia Gal(L/M)) := + Nat.card_congr + (Subgroup.subgroupOfEquivOfLe + (Ideal.inertia_le_stabilizer (M := Gal(L/M)) Q.1)).toEquiv + _ = infinityPlaceRelativeRamificationIdx C M L Q := + infinityPlaceInertiaGroup_card_eq_ramificationIdx C M L Q + rw [infinityPlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg, + ← hkernel, hrelative, ← IsGalois.card_aut_eq_finrank C S] + +/-- Restriction-fiber form of the finite-place cardinality identity. Its +conclusion is exactly the stabilizer hypothesis consumed by the cardinality +form of Frobenius-coset Burnside averaging. -/ +theorem finitePlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_constantAut + (π : Gal(L/M) →* (S ≃ₐ[C] S)) + (P : FiniteExtensionFinitePlace C M) + (Q : FinitePlaceUnderFiber C M L P) + (hTop : finiteExtensionPlaceDegree C L (.inl Q.1) = Module.finrank C S) + (hBase : finiteExtensionPlaceDegree C M (.inl P) = 1) + (hker : + letI := finiteIntegralClosureGalAction C M L + letI := finitePlaceUnderFiberGalAction C M L P + (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker = + Q.1.asIdeal.inertia (MulAction.stabilizer Gal(L/M) Q)) : + letI := finiteIntegralClosureGalAction C M L + letI := finitePlaceUnderFiberGalAction C M L P + Nat.card (MulAction.stabilizer Gal(L/M) Q) = + Nat.card + (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + letI := finiteIntegralClosureGalAction C M L + letI := finitePlaceUnderFiberGalAction C M L P + have hBase' : finiteExtensionPlaceDegree C M + (.inl (finitePlaceUnder C M L Q.1)) = 1 := by + rw [Q.2] + exact hBase + have hstab := + finitePlaceUnderFiber_stabilizer_eq_decompositionGroup C M L P Q + rw [hstab] at hker ⊢ + exact finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut + C M L S π Q.1 hTop hBase' hker + +/-- Restriction-fiber form of the infinity-place cardinality identity. -/ +theorem infinityPlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_constantAut + (π : Gal(L/M) →* (S ≃ₐ[C] S)) + (P : FiniteExtensionInfinityPlace C M) + (Q : InfinityPlaceUnderFiber C M L P) + (hTop : finiteExtensionPlaceDegree C L (.inr Q.1) = Module.finrank C S) + (hBase : finiteExtensionPlaceDegree C M (.inr P) = 1) + (hker : + letI := infinityIntegralClosureGalAction C M L + letI := infinityPlaceUnderFiberGalAction C M L P + (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker = + Q.1.1.inertia (MulAction.stabilizer Gal(L/M) Q)) : + letI := infinityIntegralClosureGalAction C M L + letI := infinityPlaceUnderFiberGalAction C M L P + Nat.card (MulAction.stabilizer Gal(L/M) Q) = + Nat.card + (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker * + Nat.card (S ≃ₐ[C] S) := by + letI := infinityIntegralClosureGalAction C M L + letI := infinityPlaceUnderFiberGalAction C M L P + have hBase' : finiteExtensionPlaceDegree C M + (.inr (infinityPlaceUnder C M L Q.1)) = 1 := by + rw [Q.2] + exact hBase + have hstab := + infinityPlaceUnderFiber_stabilizer_eq_decompositionGroup C M L P Q + rw [hstab] at hker ⊢ + exact infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut + C M L S π Q.1 hTop hBase' hker + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean new file mode 100644 index 0000000000..f6730516a6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean @@ -0,0 +1,271 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction +import Mathlib.FieldTheory.Finite.Basic +import Mathlib.Tactic + +/-! +# Frobenius restriction over a finite constant field + +Let `K` be a finite field and put `q = #K`. The map +`x ↦ x ^ (q ^ n)` on any commutative `K`-algebra is the `n`-th iterate of +the relative Frobenius. In particular it is a genuine `K`-algebra +endomorphism: no Frobenius-twisted scalar action is needed. + +This file packages that endomorphism as an algebra homomorphism and as a +linear map, specializes the two tensor-restriction orientations, and records +the principal-divisor and pole-budget identities needed by the Stepanov +restriction argument. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped TensorProduct nonZeroDivisors Polynomial + +noncomputable section + +section FiniteFieldAlgebra + +variable (K A : Type*) [Field K] [Fintype K] + [CommRing A] [Algebra K A] + +/-- The `n`-fold relative Frobenius on a commutative algebra over the finite +field `K`. Its underlying function is `x ↦ x ^ ((#K) ^ n)`. -/ +def powCardAlgHom (n : ℕ) : A →ₐ[K] A := + FiniteField.frobeniusAlgHom K A ^ n + +@[simp] +theorem powCardAlgHom_apply (n : ℕ) (x : A) : + powCardAlgHom K A n x = x ^ (Fintype.card K ^ n) := by + simp only [powCardAlgHom, AlgHom.coe_pow, + FiniteField.coe_frobeniusAlgHom, pow_iterate] + +/-- The `K`-linear map underlying the `n`-fold relative Frobenius. -/ +def powCardLinearMap (n : ℕ) : A →ₗ[K] A := + (powCardAlgHom K A n).toLinearMap + +@[simp] +theorem powCardLinearMap_apply (n : ℕ) (x : A) : + powCardLinearMap K A n x = x ^ (Fintype.card K ^ n) := by + simp [powCardLinearMap] + +@[simp] +theorem powCardLinearMap_add (n : ℕ) (x y : A) : + powCardLinearMap K A n (x + y) = + powCardLinearMap K A n x + powCardLinearMap K A n y := by + exact map_add (powCardLinearMap K A n) x y + +@[simp] +theorem powCardLinearMap_smul (n : ℕ) (c : K) (x : A) : + powCardLinearMap K A n (c • x) = c • powCardLinearMap K A n x := by + exact map_smul (powCardLinearMap K A n) c x + +@[simp] +theorem powCardLinearMap_mul (n : ℕ) (x y : A) : + powCardLinearMap K A n (x * y) = + powCardLinearMap K A n x * powCardLinearMap K A n y := by + exact map_mul (powCardAlgHom K A n) x y + +variable {K A : Type*} [Field K] [Fintype K] + [CommRing A] [Algebra K A] +variable {R S T : Submodule K A} + +/-- The tensor restriction induced by `(x, y) ↦ x * y ^ ((#K) ^ n)`. -/ +def powCardTensorRestriction + (n : ℕ) + (hmul : ∀ x : R, ∀ y : S, + (x : A) * (y : A) ^ (Fintype.card K ^ n) ∈ T) : + R ⊗[K] S →ₗ[K] T := + tensorRestriction (powCardAlgHom K A n) (fun x y => by + simpa only [powCardAlgHom_apply] using hmul x y) + +@[simp] +theorem powCardTensorRestriction_tmul + (n : ℕ) + (hmul : ∀ x : R, ∀ y : S, + (x : A) * (y : A) ^ (Fintype.card K ^ n) ∈ T) + (x : R) (y : S) : + powCardTensorRestriction n hmul (x ⊗ₜ[K] y) = + ⟨(x : A) * (y : A) ^ (Fintype.card K ^ n), hmul x y⟩ := by + apply Subtype.ext + simp [powCardTensorRestriction] + +/-- The swapped tensor restriction induced by +`(x, y) ↦ x ^ ((#K) ^ n) * y`. -/ +def powCardSwappedTensorRestriction + (n : ℕ) + (hmul : ∀ x : R, ∀ y : S, + (x : A) ^ (Fintype.card K ^ n) * (y : A) ∈ T) : + R ⊗[K] S →ₗ[K] T := + swappedTensorRestriction (powCardAlgHom K A n) (fun x y => by + simpa only [powCardAlgHom_apply] using hmul x y) + +@[simp] +theorem powCardSwappedTensorRestriction_tmul + (n : ℕ) + (hmul : ∀ x : R, ∀ y : S, + (x : A) ^ (Fintype.card K ^ n) * (y : A) ∈ T) + (x : R) (y : S) : + powCardSwappedTensorRestriction n hmul (x ⊗ₜ[K] y) = + ⟨(x : A) ^ (Fintype.card K ^ n) * (y : A), hmul x y⟩ := by + apply Subtype.ext + simp [powCardSwappedTensorRestriction] + +end FiniteFieldAlgebra + +section FiniteExtension + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance frobeniusRestrictionConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance frobeniusRestrictionConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Raising to `(#K) ^ n` scales every exhaustive place order by that +integer. -/ +theorem finiteExtensionPrincipalDivisor_powCardLinearMap + (x : L) (hx : x ≠ 0) (n : ℕ) : + finiteExtensionPrincipalDivisor K L (powCardLinearMap K L n x) = + (Fintype.card K ^ n) • finiteExtensionPrincipalDivisor K L x := by + rw [powCardLinearMap_apply, + finiteExtensionPrincipalDivisor_pow K L x hx] + +/-- Pointwise form of the Frobenius order-scaling identity. -/ +theorem finiteExtensionPrincipalDivisor_powCardLinearMap_apply + (x : L) (hx : x ≠ 0) (n : ℕ) + (v : FiniteExtensionPlace K L) : + finiteExtensionPrincipalDivisor K L (powCardLinearMap K L n x) v = + ((Fintype.card K ^ n : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L x v := by + rw [finiteExtensionPrincipalDivisor_powCardLinearMap K L x hx n] + simp only [Finsupp.smul_apply, nsmul_eq_mul] + +/-- The pole divisor is scaled by the same power of the constant-field +cardinality under iterated Frobenius. -/ +theorem finiteExtensionPoleDivisor_powCardLinearMap + (x : L) (hx : x ≠ 0) (n : ℕ) : + finiteExtensionPoleDivisor K L (powCardLinearMap K L n x) = + (Fintype.card K ^ n) • finiteExtensionPoleDivisor K L x := by + classical + ext v + rw [finiteExtensionPoleDivisor_apply, + finiteExtensionPrincipalDivisor_powCardLinearMap_apply K L x hx n v] + simp only [Finsupp.smul_apply, nsmul_eq_mul] + rw [finiteExtensionPoleDivisor_apply] + have hs : (0 : ℤ) < (Fintype.card K ^ n : ℕ) := by + exact_mod_cast pow_pos Fintype.card_pos n + by_cases hv : finiteExtensionPrincipalDivisor K L x v < 0 + · have hscaled : + ((Fintype.card K ^ n : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L x v < 0 := + mul_neg_of_pos_of_neg hs hv + rw [if_pos hscaled, if_pos hv] + ring + · have hscaled : ¬ + ((Fintype.card K ^ n : ℕ) : ℤ) * + finiteExtensionPrincipalDivisor K L x v < 0 := + not_lt_of_ge (mul_nonneg hs.le (le_of_not_gt hv)) + rw [if_neg hscaled, if_neg hv, mul_zero] + +/-- Iterated Frobenius sends `L(D)` into `L((#K)^n D)`. -/ +theorem powCardLinearMap_mem_scaledRiemannSpace + {D : FiniteExtensionDivisor K L} {x : L} + (hx : x ∈ finiteExtensionRiemannSpace K L D) (n : ℕ) : + powCardLinearMap K L n x ∈ finiteExtensionRiemannSpace K L + ((Fintype.card K ^ n) • D) := by + simpa only [powCardLinearMap_apply] using + finiteExtensionRiemannSpace_pow_mem K L hx (Fintype.card K ^ n) + +/-- The pole budget for `(x, y) ↦ x * y ^ ((#K)^n)`. -/ +theorem mul_powCardLinearMap_mem_poleDivisor_budget + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (n : ℕ) : + x * powCardLinearMap K L n y ∈ finiteExtensionRiemannSpace K L + (finiteExtensionPoleDivisor K L x + + (Fintype.card K ^ n) • finiteExtensionPoleDivisor K L y) := by + exact finiteExtensionRiemannSpace_mul_mem K L + (mem_finiteExtensionRiemannSpace_poleDivisor K L x hx) + (powCardLinearMap_mem_scaledRiemannSpace K L + (mem_finiteExtensionRiemannSpace_poleDivisor K L y hy) n) + +/-- The pole budget for the swapped product +`(x, y) ↦ x ^ ((#K)^n) * y`. -/ +theorem powCardLinearMap_mul_mem_poleDivisor_budget + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (n : ℕ) : + powCardLinearMap K L n x * y ∈ finiteExtensionRiemannSpace K L + ((Fintype.card K ^ n) • finiteExtensionPoleDivisor K L x + + finiteExtensionPoleDivisor K L y) := by + exact finiteExtensionRiemannSpace_mul_mem K L + (powCardLinearMap_mem_scaledRiemannSpace K L + (mem_finiteExtensionRiemannSpace_poleDivisor K L x hx) n) + (mem_finiteExtensionRiemannSpace_poleDivisor K L y hy) + +/-- Tensor restriction between Riemann spaces in the unswapped orientation. -/ +def powCardRiemannTensorRestriction + (D E : FiniteExtensionDivisor K L) (n : ℕ) : + finiteExtensionRiemannSpace K L D ⊗[K] + finiteExtensionRiemannSpace K L E →ₗ[K] + finiteExtensionRiemannSpace K L + (D + (Fintype.card K ^ n) • E) := + powCardTensorRestriction n (fun x y => + finiteExtensionRiemannSpace_mul_mem K L x.property + (finiteExtensionRiemannSpace_pow_mem K L y.property + (Fintype.card K ^ n))) + +@[simp] +theorem powCardRiemannTensorRestriction_tmul + (D E : FiniteExtensionDivisor K L) (n : ℕ) + (x : finiteExtensionRiemannSpace K L D) + (y : finiteExtensionRiemannSpace K L E) : + powCardRiemannTensorRestriction K L D E n (x ⊗ₜ[K] y) = + ⟨(x : L) * (y : L) ^ (Fintype.card K ^ n), + finiteExtensionRiemannSpace_mul_mem K L x.property + (finiteExtensionRiemannSpace_pow_mem K L y.property + (Fintype.card K ^ n))⟩ := by + apply Subtype.ext + simp [powCardRiemannTensorRestriction] + +/-- Tensor restriction between Riemann spaces in the swapped orientation. -/ +def powCardSwappedRiemannTensorRestriction + (D E : FiniteExtensionDivisor K L) (n : ℕ) : + finiteExtensionRiemannSpace K L D ⊗[K] + finiteExtensionRiemannSpace K L E →ₗ[K] + finiteExtensionRiemannSpace K L + ((Fintype.card K ^ n) • D + E) := + powCardSwappedTensorRestriction n (fun x y => + finiteExtensionRiemannSpace_mul_mem K L + (finiteExtensionRiemannSpace_pow_mem K L x.property + (Fintype.card K ^ n)) y.property) + +@[simp] +theorem powCardSwappedRiemannTensorRestriction_tmul + (D E : FiniteExtensionDivisor K L) (n : ℕ) + (x : finiteExtensionRiemannSpace K L D) + (y : finiteExtensionRiemannSpace K L E) : + powCardSwappedRiemannTensorRestriction K L D E n (x ⊗ₜ[K] y) = + ⟨(x : L) ^ (Fintype.card K ^ n) * (y : L), + finiteExtensionRiemannSpace_mul_mem K L + (finiteExtensionRiemannSpace_pow_mem K L x.property + (Fintype.card K ^ n)) + y.property⟩ := by + apply Subtype.ext + simp [powCardSwappedRiemannTensorRestriction] + +end FiniteExtension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean new file mode 100644 index 0000000000..b006625c31 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.GroupTheory.SpecificGroups.Cyclic + +/-! +# Cyclic subgroups generated by Frobenius twists + +The Galois-theoretic lower-bound argument uses elements `(σ, τ)` in a direct +product. The first component `σ` generates the constant-field Galois group, +while the order of the second finite group divides the order of `σ`. + +This file records the resulting elementary group facts: every twist has the +same order as `σ`, its cyclic subgroup meets the kernel of first projection +trivially, and that cyclic subgroup has the expected cardinality. These are +the group-theoretic inputs for taking fixed fields of Frobenius twists. +-/ + +namespace BGS.HasseWeil + +section + +variable {A B : Type*} [Group A] [Group B] + +/-- If the order of the finite second factor divides the order of `a`, then +the pair `(a,b)` has the same order as `a`. -/ +theorem orderOf_prod_eq_left_of_natCard_dvd + (a : A) (b : B) (hcard : Nat.card B ∣ orderOf a) : + orderOf (a, b) = orderOf a := by + rw [Prod.orderOf, Nat.lcm_eq_left_iff_dvd] + exact (orderOf_dvd_natCard b).trans hcard + +/-- The cyclic subgroup generated by a Frobenius twist meets the kernel of +first projection trivially. -/ +theorem zpowers_prod_inf_fst_ker_eq_bot_of_natCard_dvd + (a : A) (b : B) (hcard : Nat.card B ∣ orderOf a) : + Subgroup.zpowers (a, b) ⊓ (MonoidHom.fst A B).ker = ⊥ := by + apply le_antisymm + · intro x hx + rw [Subgroup.mem_bot] + obtain ⟨k, rfl⟩ := Subgroup.mem_zpowers_iff.mp hx.1 + have ha : a ^ k = 1 := by + have hk := MonoidHom.mem_ker.mp hx.2 + change ((a, b) ^ k).1 = 1 at hk + simpa using hk + have hdiv : (orderOf a : ℤ) ∣ k := + orderOf_dvd_iff_zpow_eq_one.mpr ha + rw [← orderOf_dvd_iff_zpow_eq_one, + orderOf_prod_eq_left_of_natCard_dvd a b hcard] + exact hdiv + · exact bot_le + +/-- The cyclic subgroup generated by a Frobenius twist has cardinality equal +to the order of the constant-field generator. -/ +theorem natCard_zpowers_prod_eq_orderOf_left_of_natCard_dvd + (a : A) (b : B) (hcard : Nat.card B ∣ orderOf a) : + Nat.card (Subgroup.zpowers (a, b)) = orderOf a := by + rw [Nat.card_zpowers, orderOf_prod_eq_left_of_natCard_dvd a b hcard] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean new file mode 100644 index 0000000000..abcec379d1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean @@ -0,0 +1,260 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +import Mathlib.FieldTheory.LinearDisjoint +import Mathlib.RingTheory.Flat.Basic +import Mathlib.RingTheory.Localization.BaseChange +import Mathlib.RingTheory.TensorProduct.MvPolynomial +import Mathlib.RingTheory.TensorProduct.Quotient + +/-! +# Constant extensions of plane-curve function fields + +This file constructs scalar extension at both the affine coordinate-ring and +function-field levels. If `E / K` is algebraic and the base-changed plane +curve stays irreducible, then + +`E ⊗[K] K(C) ≃ₐ[E] E(C_E)`. + +The proof identifies the tensor product of `E` with the fraction field of the +coordinate ring as the fraction field of the tensor-product coordinate ring. +It then transports this fraction field through the explicit base-change +equivalence for the plane-curve coordinate ring. No Galois, Frobenius, place, +or point-counting assertion is made here. +-/ + +open scoped TensorProduct nonZeroDivisors + +namespace BGS.HasseWeil + +noncomputable section + +section TensorFraction + +variable (K E A : Type*) [Field K] [Field E] [CommRing A] + [Algebra K E] [Algebra K A] + +/-- Tensor the fraction field of `A` with an extension field `E / K`. -/ +abbrev TensorFraction := E ⊗[K] FractionRing A + +/-- Tensor `A` itself with an extension field `E / K`. -/ +abbrev TensorBase := E ⊗[K] A + +/-- Localize the tensor-product base ring at the images of the nonzero +elements of `A`. -/ +abbrev TensorBaseLocalization := Localization + (A⁰.map (Algebra.TensorProduct.includeRight (R := K) (A := E) (B := A))) + +noncomputable instance tensorBaseTensorFractionAlgebra : + Algebra (TensorBase K E A) (TensorFraction K E A) := + (Algebra.TensorProduct.map (AlgHom.id K E) + (IsScalarTower.toAlgHom K A (FractionRing A))).toAlgebra + +theorem tensorBaseTensorFraction_algebraMap_tmul (e : E) (a : A) : + algebraMap (TensorBase K E A) (TensorFraction K E A) (e ⊗ₜ[K] a) = + e ⊗ₜ[K] algebraMap A (FractionRing A) a := by + change Algebra.TensorProduct.map (AlgHom.id K E) + (IsScalarTower.toAlgHom K A (FractionRing A)) (e ⊗ₜ[K] a) = _ + rw [Algebra.TensorProduct.map_tmul] + rfl + +instance tensorBaseTensorFractionScalarTower : + IsScalarTower E (TensorBase K E A) (TensorFraction K E A) := + IsScalarTower.of_algebraMap_eq' (by + ext e + change e ⊗ₜ[K] 1 = + algebraMap (TensorBase K E A) (TensorFraction K E A) (e ⊗ₜ[K] 1) + rw [tensorBaseTensorFraction_algebraMap_tmul] + simp) + +variable [IsDomain A] [IsDomain (TensorBase K E A)] + +private theorem tensorBase_nonZero_map : + A⁰.map (Algebra.TensorProduct.includeRight (R := K) (A := E) (B := A)) ≤ + (TensorBase K E A)⁰ := by + intro z hz + rcases hz with ⟨a, ha, rfl⟩ + rw [mem_nonZeroDivisors_iff_ne_zero] + intro hzero + apply nonZeroDivisors.ne_zero ha + apply Algebra.TensorProduct.includeRight_injective + (R := K) (A := E) (B := A) (algebraMap K E).injective + simpa using hzero + +/-- Tensoring the fraction field agrees with localizing the tensor-product +base ring at the nonzero elements coming from `A`. -/ +noncomputable def tensorFractionLocalizationEquiv : + TensorFraction K E A ≃ₐ[E] TensorBaseLocalization K E A := + IsLocalization.tensorProductEquivOfMapIncludeRight K E A⁰ + (FractionRing A) (TensorBaseLocalization K E A) + +omit [IsDomain A] [IsDomain (TensorBase K E A)] in +theorem tensorFractionLocalizationEquiv_algebraMap (z : TensorBase K E A) : + tensorFractionLocalizationEquiv K E A + (algebraMap (TensorBase K E A) (TensorFraction K E A) z) = + algebraMap (TensorBase K E A) (TensorBaseLocalization K E A) z := by + induction z using TensorProduct.induction_on with + | zero => simp + | tmul e a => + exact IsLocalization.tensorProductEquivOfMapIncludeRight_tmul + A A⁰ (FractionRing A) (TensorBaseLocalization K E A) e a + | add x y hx hy => simp only [map_add, hx, hy] + +local instance tensorFractionIsDomain : IsDomain (TensorFraction K E A) := by + letI : IsDomain (TensorBaseLocalization K E A) := + IsLocalization.isDomain_localization (tensorBase_nonZero_map K E A) + exact (tensorFractionLocalizationEquiv K E A).toMulEquiv.isDomain_iff.mpr + inferInstance + +noncomputable local instance tensorFractionField [Algebra.IsAlgebraic K E] : + Field (TensorFraction K E A) := + (Algebra.TensorProduct.isField_of_isAlgebraic K E (FractionRing A) + (.inl inferInstance)).toField + +omit [IsDomain A] [IsDomain (TensorBase K E A)] in +private theorem tensorProduct_map_id_injective + {B : Type*} [CommRing B] [Algebra K B] + (F : A →ₐ[K] B) (hF : Function.Injective F) : + Function.Injective + (Algebra.TensorProduct.map (AlgHom.id E E) F) := by + have heq : + (Algebra.TensorProduct.map (AlgHom.id E E) F).toLinearMap.restrictScalars K = + F.toLinearMap.lTensor E := by + ext e a + simp + rw [← heq] at * + exact Module.Flat.lTensor_preserves_injective_linearMap F.toLinearMap hF + +local instance tensorBaseTensorFractionFaithfulSMul : + FaithfulSMul (TensorBase K E A) (TensorFraction K E A) := + (faithfulSMul_iff_algebraMap_injective _ _).mpr + (tensorProduct_map_id_injective K E A + (IsScalarTower.toAlgHom K A (FractionRing A)) + (IsFractionRing.injective A (FractionRing A))) + +/-- If the scalar-extended base ring is a domain and `E / K` is algebraic, +then tensoring the fraction field produces the fraction field of the +scalar-extended base ring. -/ +theorem tensorFraction_isFractionRing [Algebra.IsAlgebraic K E] : + IsFractionRing (TensorBase K E A) (TensorFraction K E A) := by + apply IsFractionRing.of_field + intro z + let e := tensorFractionLocalizationEquiv K E A + obtain ⟨⟨x, s⟩, hs⟩ := IsLocalization.surj + (A⁰.map (Algebra.TensorProduct.includeRight + (R := K) (A := E) (B := A))) (e z) + refine ⟨x, s, ?_⟩ + have hsT : + z * algebraMap (TensorBase K E A) (TensorFraction K E A) s = + algebraMap (TensorBase K E A) (TensorFraction K E A) x := by + apply e.injective + simpa only [e, map_mul, + tensorFractionLocalizationEquiv_algebraMap] using hs + apply (eq_div_iff ?_).mpr + · exact hsT + · exact map_ne_zero_of_mem_nonZeroDivisors _ + (FaithfulSMul.algebraMap_injective _ _) + (tensorBase_nonZero_map K E A s.property) + +end TensorFraction + +section PlaneCurve + +open BGS.CorvajaZannier + +variable (K E : Type*) [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) + +/-- Scalar extension of a plane-curve coordinate ring, as an equivalence of +algebras over the enlarged constant field. -/ +noncomputable def planeCurveCoordinateRingBaseChangeAlgEquiv : + E ⊗[K] PlaneCurveCoordinateRing f ≃ₐ[E] + PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f) := by + let P := MvPolynomial (Fin 2) K + let PE := MvPolynomial (Fin 2) E + let I : Ideal P := Ideal.span {f} + let eP : E ⊗[K] P ≃ₐ[E] PE := + MvPolynomial.algebraTensorAlgEquiv K E + let IT : Ideal (E ⊗[K] P) := + I.map (Algebra.TensorProduct.includeRight (R := K) (A := E) (B := P)) + let IE : Ideal PE := + Ideal.span {MvPolynomial.map (algebraMap K E) f} + have hideal : IE = IT.map eP.toRingEquiv.toRingHom := by + simp only [IE, IT, I, Ideal.map_span, Set.image_singleton] + congr 2 + symm + change (MvPolynomial.algebraTensorAlgEquiv K E) (1 ⊗ₜ[K] f) = + MvPolynomial.map (algebraMap K E) f + simpa only [one_smul] using + (MvPolynomial.algebraTensorAlgEquiv_tmul + (R := K) (A := E) (a := (1 : E)) f) + exact + (Algebra.TensorProduct.tensorQuotientEquiv + (R := K) E P E I).trans + (Ideal.quotientEquivAlg IT IE eP hideal) + +/-- If the base-changed equation is irreducible, then its tensor-product +coordinate ring is a domain. -/ +theorem planeCurveCoordinateRingBaseChange_isDomain + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) : + IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := by + letI : IsDomain (PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) := + planeCurveCoordinateRing_isDomain hfE + exact (planeCurveCoordinateRingBaseChangeAlgEquiv K E f).toMulEquiv.isDomain_iff.mpr + inferInstance + +variable (hf : Irreducible f) + (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) + [Algebra.IsAlgebraic K E] + +/-- Constant extension commutes with passing from an irreducible plane-curve +coordinate ring to its function field. -/ +noncomputable def planeCurveFunctionFieldBaseChangeAlgEquiv : + E ⊗[K] PlaneCurveFunctionField f ≃ₐ[E] + PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := + planeCurveCoordinateRingBaseChange_isDomain K E f hfE + letI : IsFractionRing + (E ⊗[K] PlaneCurveCoordinateRing f) + (E ⊗[K] PlaneCurveFunctionField f) := + tensorFraction_isFractionRing K E (PlaneCurveCoordinateRing f) + exact IsFractionRing.algEquivOfAlgEquiv + (R := E) + (A := E ⊗[K] PlaneCurveCoordinateRing f) + (B := PlaneCurveCoordinateRing + (MvPolynomial.map (algebraMap K E) f)) + (K := E ⊗[K] PlaneCurveFunctionField f) + (L := PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) + (planeCurveCoordinateRingBaseChangeAlgEquiv K E f) + +theorem planeCurveFunctionFieldBaseChangeAlgEquiv_tmul_one (e : E) : + planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE + (e ⊗ₜ[K] 1) = + algebraMap E + (PlaneCurveFunctionField + (MvPolynomial.map (algebraMap K E) f)) e := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := + planeCurveCoordinateRingBaseChange_isDomain K E f hfE + letI : IsFractionRing + (E ⊗[K] PlaneCurveCoordinateRing f) + (E ⊗[K] PlaneCurveFunctionField f) := + tensorFraction_isFractionRing K E (PlaneCurveCoordinateRing f) + change planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE + (algebraMap E (E ⊗[K] PlaneCurveFunctionField f) e) = _ + exact (planeCurveFunctionFieldBaseChangeAlgEquiv K E f hf hfE).commutes e + +end PlaneCurve + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean new file mode 100644 index 0000000000..0e21d29b2f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import Mathlib.FieldTheory.Finite.GaloisField + +/-! +# The algebraic constant field of a finite function field + +For a finite separable extension `N / K(t)`, define its algebraic constant +field to be the relative algebraic closure of `K` in `N`. When `K` is finite, +this constant field is finite-dimensional over `K`. + +The finiteness proof is place-theoretic. Algebraic constants are integral over +`K[X]`, hence map into the finite integral closure. Reduction modulo any +height-one prime is injective on the constant field, because it is a field. +Choosing a prime above `(X)` embeds the constants into a finite quotient. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain + +attribute [local instance high] Module.Free.of_divisionRing + +variable (K N : Type*) [Field K] [Field N] + [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) N] + [FiniteDimensional (RatFunc K) N] + [Algebra.IsSeparable (RatFunc K) N] + +local instance functionFieldConstantAlgebra : Algebra K N := + RingHom.toAlgebra ((algebraMap (RatFunc K) N).comp + (algebraMap K (RatFunc K))) + +local instance functionFieldConstantRatFuncTower : + IsScalarTower K (RatFunc K) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) functionFieldConstantPolynomialAlgebra : + Algebra K[X] N := + RingHom.toAlgebra ((algebraMap (RatFunc K) N).comp + (algebraMap K[X] (RatFunc K))) + +local instance functionFieldConstantPolynomialRatFuncTower : + IsScalarTower K[X] (RatFunc K) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance functionFieldConstantPolynomialTower : + IsScalarTower K K[X] N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance functionFieldConstantPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] N := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) N + +local instance functionFieldConstantFiniteClosureAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K N) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K N)).comp (algebraMap K K[X])) + +local instance functionFieldConstantFiniteClosureTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K N) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance functionFieldConstantFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K N) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K N) + +local instance functionFieldConstantFiniteClosureIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K N) := + IsIntegralClosure.isIntegral_algebra K[X] N + +local instance functionFieldConstantFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K N) := + IsIntegralClosure.isTorsionFree K[X] N + +local instance functionFieldConstantFiniteClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K N) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) N + (RatFuncFiniteIntegralClosure K N) + +/-- The algebraic constant field of `N / K(t)`. -/ +abbrev FunctionFieldConstantField := algebraicClosure K N + +/-- Algebraic constants are integral over the finite polynomial model. -/ +def functionFieldConstantToFiniteIntegralClosure : + FunctionFieldConstantField K N →ₐ[K] + RatFuncFiniteIntegralClosure K N where + toFun c := ⟨c.1, c.2.tower_top⟩ + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + commutes' _ := rfl + +local instance functionFieldConstantFinitePlaceMaximal + (Q : FiniteExtensionFinitePlace K N) : + Q.asIdeal.IsMaximal := Q.isMaximal + +/-- Reduction modulo a finite place, restricted to the algebraic constant +field. -/ +def functionFieldConstantQuotientAlgHom + (Q : FiniteExtensionFinitePlace K N) : + FunctionFieldConstantField K N →ₐ[K] + (RatFuncFiniteIntegralClosure K N ⧸ Q.asIdeal) := + (Ideal.Quotient.mkₐ K Q.asIdeal).comp + (functionFieldConstantToFiniteIntegralClosure K N) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] + [FiniteDimensional (RatFunc K) N] + [Algebra.IsSeparable (RatFunc K) N] in +/-- Reduction at a finite place is injective on algebraic constants. -/ +theorem functionFieldConstantQuotientAlgHom_injective + (Q : FiniteExtensionFinitePlace K N) : + Function.Injective (functionFieldConstantQuotientAlgHom K N Q) := + (functionFieldConstantQuotientAlgHom K N Q).injective + +omit [DecidableEq (RatFunc K)] in +/-- The residue field of a rational-function finite place is finite over a +finite constant field. -/ +theorem ratFuncFinitePlaceResidueField_finite [Fintype K] + (p : HeightOneSpectrum K[X]) : Finite p.asIdeal.ResidueField := by + let r := finitePlaceNormalizedPrime p + have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero + have hrmonic : (r : K[X]).Monic := + (Polynomial.normalize_eq_self_iff_monic hr0).mp r.property.2 + have hp : p.asIdeal = Ideal.span ({(r : K[X])} : Set K[X]) := by + calc + p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by + rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] + _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl + letI : Module.Finite K (K[X] ⧸ p.asIdeal) := by + rw [hp] + exact hrmonic.finite_quotient + letI : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K + infer_instance + +omit [DecidableEq (RatFunc K)] in +/-- Every finite-place residue field of a finite separable function field is +finite over a finite constant field. -/ +theorem finiteExtensionFinitePlaceResidueField_finite [Fintype K] + (P : FiniteExtensionFinitePlace K N) : Finite P.asIdeal.ResidueField := by + let p := HeightOneSpectrum.under K[X] P + letI : Finite p.asIdeal.ResidueField := + ratFuncFinitePlaceResidueField_finite K p + letI : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal P.asIdeal := ⟨rfl⟩ + letI : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance + letI : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := + inferInstance + exact Module.finite_of_finite p.asIdeal.ResidueField + +/-- Over a finite base field, the algebraic constant field of a finite +separable function field is finite-dimensional. -/ +noncomputable instance functionFieldConstantField_finiteDimensional [Fintype K] : + FiniteDimensional K (FunctionFieldConstantField K N) := by + let p : HeightOneSpectrum K[X] := Polynomial.idealX K + obtain ⟨Q, hQprime, hQcomap⟩ := + Ideal.exists_ideal_over_prime_of_isIntegral_of_isDomain + (S := RatFuncFiniteIntegralClosure K N) p.asIdeal (by + intro x hx + have hxA : algebraMap K[X] (RatFuncFiniteIntegralClosure K N) x = 0 := + (RingHom.mem_ker).mp hx + have hxN : algebraMap K[X] N x = 0 := + congrArg Subtype.val hxA + have hx0 : x = 0 := by + exact FaithfulSMul.algebraMap_injective K[X] N (by simpa using hxN) + subst x + exact p.asIdeal.zero_mem) + let P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K N) := + ⟨Q, hQprime, ⟨hQcomap.symm⟩⟩ + let q : FiniteExtensionFinitePlace K N := primeOverHeightOne p P + letI : Finite q.asIdeal.ResidueField := + finiteExtensionFinitePlaceResidueField_finite K N q + letI : Finite (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) := + Finite.of_injective + (algebraMap (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) + q.asIdeal.ResidueField) + (Ideal.injective_algebraMap_quotient_residueField q.asIdeal) + letI : Module.Finite K + (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) := + Module.Finite.of_finite + exact FiniteDimensional.of_injective + (functionFieldConstantQuotientAlgHom K N q).toLinearMap + (functionFieldConstantQuotientAlgHom_injective K N q) + +/-- The algebraic constant field is a finite type when the original constants +are finite. -/ +noncomputable instance functionFieldConstantField_finite [Fintype K] : + Finite (FunctionFieldConstantField K N) := + Module.finite_of_finite K + +/-- The algebraic constant field is Galois over the finite base field. -/ +noncomputable instance functionFieldConstantField_isGalois [Fintype K] : + IsGalois K (FunctionFieldConstantField K N) := + inferInstance + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean new file mode 100644 index 0000000000..ec8d1aed66 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +import Mathlib.FieldTheory.Galois.GaloisClosure +import Mathlib.FieldTheory.IsSepClosed + +/-! +# A finite Galois closure for a one-variable function field + +For a finite separable extension `L / K(t)`, choose an embedding of `L` into +the absolute separable closure of `K(t)` and take its normal closure there. +The result is a finite Galois extension of `K(t)` containing an embedded copy +of `L`. + +This is the field-theoretic Galois-closure layer required by the twisted +fixed-field argument. It does not identify the algebraic constant field of +the closure or construct any Frobenius complements. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (K L : Type*) [Field K] [Field L] + [Algebra (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- A chosen `K(t)`-embedding of the function field into the absolute +separable closure of `K(t)`. -/ +def functionFieldSeparableClosureEmbedding : + L →ₐ[RatFunc K] SeparableClosure (RatFunc K) := + IsSepClosed.lift + +/-- The normal closure of the chosen embedded copy of `L` inside the absolute +separable closure of `K(t)`. -/ +def FunctionFieldNormalClosure : + IntermediateField (RatFunc K) (SeparableClosure (RatFunc K)) := + IntermediateField.normalClosure (RatFunc K) + (functionFieldSeparableClosureEmbedding K L).fieldRange + (SeparableClosure (RatFunc K)) + +/-- The original function field embeds into its chosen normal closure. -/ +def functionFieldToNormalClosure : + L →ₐ[RatFunc K] FunctionFieldNormalClosure K L := + (functionFieldSeparableClosureEmbedding K L).codRestrict + (FunctionFieldNormalClosure K L).toSubalgebra (fun x => by + exact IntermediateField.le_normalClosure + (functionFieldSeparableClosureEmbedding K L).fieldRange + ⟨x, rfl⟩) + +theorem functionFieldToNormalClosure_injective : + Function.Injective (functionFieldToNormalClosure K L) := + (functionFieldToNormalClosure K L).injective + +variable [FiniteDimensional (RatFunc K) L] + +/-- The chosen normal closure remains finite over `K(t)`. -/ +noncomputable instance functionFieldNormalClosure_finiteDimensional : + FiniteDimensional (RatFunc K) (FunctionFieldNormalClosure K L) := by + letI : FiniteDimensional (RatFunc K) + (functionFieldSeparableClosureEmbedding K L).fieldRange := + (functionFieldSeparableClosureEmbedding K L).toLinearMap.finiteDimensional_range + change FiniteDimensional (RatFunc K) + (IntermediateField.normalClosure (RatFunc K) + (functionFieldSeparableClosureEmbedding K L).fieldRange + (SeparableClosure (RatFunc K))) + infer_instance + +/-- The chosen normal closure is Galois over `K(t)`. -/ +noncomputable instance functionFieldNormalClosure_isGalois : + IsGalois (RatFunc K) (FunctionFieldNormalClosure K L) := + IsGalois.normalClosure (RatFunc K) + (functionFieldSeparableClosureEmbedding K L).fieldRange + (SeparableClosure (RatFunc K)) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean new file mode 100644 index 0000000000..346f2e0290 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient + +/-! +# The constant-base field inside the function-field normal closure + +Let `N / K(t)` be the chosen function-field normal closure and let `C` be its +algebraic constant field. The restriction map + +`Gal(N/K(t)) → Gal(C/K)` + +is already known to be onto. This file defines the fixed field of its kernel. +Every element of `C` lies in that fixed field, so it gives a genuine tower +`C ⊆ L_C ⊆ N`; moreover `N / L_C` is finite Galois. The general exact +constant-extension and Frobenius-quotient theorems can therefore be applied +directly to the normal closure used by the Hasse--Weil proof. +-/ + +namespace BGS.HasseWeil + +noncomputable section + + +variable (K L : Type*) [Field K] [Field L] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The fixed field of the automorphisms of the normal closure that act +trivially on all algebraic constants. -/ +abbrev FunctionFieldNormalClosureConstantBase := + IntermediateField.fixedField + (functionFieldNormalClosureConstantRestriction K L).ker + +/-- Algebraic constants embed into the fixed field of the restriction +kernel. -/ +def functionFieldNormalClosureConstantToBase : + FunctionFieldNormalClosureConstantField K L →ₐ[K] + FunctionFieldNormalClosureConstantBase K L where + toFun c := ⟨c.1, by + apply (IntermediateField.mem_fixedField_iff + (H := (functionFieldNormalClosureConstantRestriction K L).ker) c.1).mpr + intro g hg + exact (mem_functionFieldNormalClosureConstantRestriction_ker_iff + K L g).mp hg c⟩ + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + commutes' _ := rfl + +/-- The induced algebra structure of the kernel fixed field over the full +constant field. -/ +@[reducible] noncomputable instance functionFieldNormalClosureConstantBaseAlgebra : + Algebra (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) := + (functionFieldNormalClosureConstantToBase K L).toAlgebra + +/-- The embeddings of the constants into the fixed field and into the normal +closure form a scalar tower. -/ +noncomputable instance functionFieldNormalClosureConstantBase_isScalarTower : + IsScalarTower (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) := by + apply IsScalarTower.of_algebraMap_eq' + ext c + rfl + +/-- The normal closure is finite over the kernel fixed field. -/ +noncomputable instance + functionFieldNormalClosure_finiteDimensional_over_constantBase : + FiniteDimensional (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) := by + infer_instance + +/-- The normal closure is Galois over the kernel fixed field. -/ +noncomputable instance functionFieldNormalClosure_isGalois_over_constantBase : + IsGalois (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) := by + infer_instance + +section Extension + +variable (S : Type*) [Field S] + [Algebra (FunctionFieldNormalClosureConstantField K L) S] + [FiniteDimensional (FunctionFieldNormalClosureConstantField K L) S] + [IsGalois (FunctionFieldNormalClosureConstantField K L) S] + +/-- The generic exact-constant field structure specializes to the chosen +function-field normal closure. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureExactConstantExtensionField : + Field (ExactConstantExtension + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosure K L) S) := + exactConstantExtensionField + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosure K L) S + (functionFieldNormalClosureConstantField_isExact K L) + +/-- The Galois group of the specialized constant extension is the product of +the new constant Galois group and the kernel-fixed-field Galois group. -/ +noncomputable def functionFieldNormalClosureConstantExtensionAutMulEquiv : + letI := exactConstantExtensionBaseAlgebra + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + (S ≃ₐ[FunctionFieldNormalClosureConstantField K L] S) × + (FunctionFieldNormalClosure K L ≃ₐ[ + FunctionFieldNormalClosureConstantBase K L] + FunctionFieldNormalClosure K L) ≃* + (ExactConstantExtension + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosure K L) S ≃ₐ[ + FunctionFieldNormalClosureConstantBase K L] + ExactConstantExtension + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosure K L) S) := by + letI := exactConstantExtensionBaseAlgebra + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + exact exactConstantExtensionAutMulEquiv + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + (functionFieldNormalClosureConstantField_isExact K L) + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- The specialized constant quotient is onto. -/ +theorem functionFieldNormalClosureConstantExtensionQuotient_surjective : + letI := exactConstantExtensionBaseAlgebra + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + Function.Surjective (exactConstantExtensionConstantQuotient + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + (functionFieldNormalClosureConstantField_isExact K L)) := by + letI := exactConstantExtensionBaseAlgebra + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + exact exactConstantExtensionConstantQuotient_surjective + (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) + (FunctionFieldNormalClosure K L) S + (functionFieldNormalClosureConstantField_isExact K L) + +end Extension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean new file mode 100644 index 0000000000..993752ace4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField + +/-! +# Constants and restriction for the function-field Galois closure + +Equip the chosen normal closure of `L / K(t)` with its induced `K`-algebra +structure, take the algebraic constant field, and restrict every +`K(t)`-automorphism to those constants. Over a finite base field the constant +field is finite Galois and its automorphism group is cyclic, generated by +Frobenius. The restriction map is surjective: a constant fixed by its image +is fixed by the full Galois group over `K(t)`, hence lies in `K(t)`; because it +is algebraic over `K`, the exact constant-field theorem for `K(t)` puts it in +`K`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (K L : Type*) [Field K] [Field L] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +noncomputable instance functionFieldNormalClosureConstantAlgebra : + Algebra K (FunctionFieldNormalClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (FunctionFieldNormalClosure K L)).comp + (algebraMap K (RatFunc K))) + +noncomputable instance functionFieldNormalClosureConstantTower : + IsScalarTower K (RatFunc K) (FunctionFieldNormalClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The algebraic constant field of the chosen Galois closure. -/ +abbrev FunctionFieldNormalClosureConstantField := + FunctionFieldConstantField K (FunctionFieldNormalClosure K L) + +/-- Restriction of a `K(t)`-automorphism of the normal closure to its algebraic +constant field. -/ +def functionFieldNormalClosureConstantRestriction : + Gal((FunctionFieldNormalClosure K L) / (RatFunc K)) →* + Gal((FunctionFieldNormalClosureConstantField K L) / K) where + toFun g := (g.restrictScalars K).algebraicClosure + map_one' := by + ext x + rfl + map_mul' g h := by + ext x + rfl + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [FiniteDimensional (RatFunc K) L] in +theorem functionFieldNormalClosureConstantRestriction_apply + (g : Gal((FunctionFieldNormalClosure K L) / (RatFunc K))) + (c : FunctionFieldNormalClosureConstantField K L) : + functionFieldNormalClosureConstantRestriction K L g c = + ⟨g c.1, by + exact (map_mem_algebraicClosure_iff + (g.restrictScalars K).toAlgHom).mpr c.2⟩ := rfl + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [FiniteDimensional (RatFunc K) L] in +/-- The kernel consists exactly of automorphisms fixing every algebraic +constant. -/ +theorem mem_functionFieldNormalClosureConstantRestriction_ker_iff + (g : Gal((FunctionFieldNormalClosure K L) / (RatFunc K))) : + g ∈ (functionFieldNormalClosureConstantRestriction K L).ker ↔ + ∀ c : FunctionFieldNormalClosureConstantField K L, g c.1 = c.1 := by + rw [MonoidHom.mem_ker] + constructor + · intro hg c + have hc := DFunLike.congr_fun hg c + exact congrArg Subtype.val hc + · intro hg + apply AlgEquiv.ext + intro c + apply Subtype.ext + exact hg c + +omit [DecidableEq (RatFunc K)] in +/-- Every automorphism of the algebraic constant field extends to an +automorphism of the normal closure over `K(t)`. + +The proof uses fixed fields rather than constructing a constant compositum. +If an algebraic constant is fixed by the image of the restriction map, then +it is fixed by every automorphism of the normal closure over `K(t)`, so the +Galois fixed-field theorem puts it in `K(t)`. The rational function field has +no elements algebraic over `K` except `K` itself. Thus the image has trivial +fixed field and is the full constant-field Galois group. -/ +theorem functionFieldNormalClosureConstantRestriction_surjective : + Function.Surjective + (functionFieldNormalClosureConstantRestriction K L) := by + let N := FunctionFieldNormalClosure K L + let C := FunctionFieldNormalClosureConstantField K L + let rho := functionFieldNormalClosureConstantRestriction K L + suffices hfixed : IntermediateField.fixedField rho.range = + (⊥ : IntermediateField K C) from + MonoidHom.range_eq_top.mp <| + IntermediateField.fixingSubgroup_fixedField rho.range ▸ + hfixed ▸ IntermediateField.fixingSubgroup_bot + refine eq_bot_iff.mpr ?_ + intro c hc + have hcFixed : ∀ g : Gal(N / (RatFunc K)), g c.1 = c.1 := by + intro g + have hcg := (IntermediateField.mem_fixedField_iff + (H := rho.range) c).mp hc (rho g) ⟨g, rfl⟩ + exact congrArg Subtype.val hcg + obtain ⟨r, hr⟩ := + (IsGalois.mem_range_algebraMap_iff_fixed c.1).mpr hcFixed + have hrIntegral : IsIntegral K r := by + apply (isIntegral_algHom_iff + (IsScalarTower.toAlgHom K (RatFunc K) N) + (algebraMap (RatFunc K) N).injective).mp + have hcIntegral : IsIntegral K c.1 := + (mem_algebraicClosure_iff.mp c.2).isIntegral + rw [IsScalarTower.toAlgHom_apply, hr] + exact hcIntegral + have hrBot : r ∈ (⊥ : IntermediateField K (RatFunc K)) := by + rw [← ratFunc_algebraicClosure_eq_bot K] + exact hrIntegral + obtain ⟨k, hk⟩ := IntermediateField.mem_bot.mp hrBot + apply IntermediateField.mem_bot.mpr + refine ⟨k, ?_⟩ + apply Subtype.ext + change algebraMap K N k = c.1 + rw [← hr, ← hk] + rfl + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [FiniteDimensional (RatFunc K) L] in +/-- After enlarging the base constants to the algebraic constants of the +normal closure, that field is the exact constant field: no further element of +the normal closure is algebraic over it. -/ +theorem functionFieldNormalClosureConstantField_isExact : + algebraicClosure (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosure K L) = + (⊥ : IntermediateField (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosure K L)) := + algebraicClosure.algebraicClosure_eq_bot K (FunctionFieldNormalClosure K L) + +omit [DecidableEq (RatFunc K)] in +/-- Frobenius on the finite algebraic constant field has order equal to its +degree over `K`. -/ +theorem orderOf_functionFieldNormalClosureConstantFrobenius : + orderOf (FiniteField.frobeniusAlgEquivOfAlgebraic K + (FunctionFieldNormalClosureConstantField K L)) = + Module.finrank K (FunctionFieldNormalClosureConstantField K L) := + FiniteField.orderOf_frobeniusAlgEquivOfAlgebraic K + (FunctionFieldNormalClosureConstantField K L) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean new file mode 100644 index 0000000000..9127fa2f45 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -0,0 +1,446 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +/-! +# The original function field after enlarging the normal-closure constants + +Let `F / K(t)` be finite separable, let `N` be the chosen normal closure, and +let `C` be the full algebraic constant field of `N`. If `K` is already the +exact constant field of `F`, linear disjointness identifies the scalar +extension `C ⊗[K] F` with its multiplication image `CF` inside `N`. + +This file constructs that image as an intermediate field, equips it with the +`C(t)`-structure inherited from the constant base inside `N`, and records the +two structural facts needed downstream: `N / CF` is finite Galois and `C` is +the exact constant field of `CF`. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + + +variable (K F : Type*) [Field K] [Field F] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra K F] + [Algebra (RatFunc K) F] + [IsScalarTower K (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +/-- Multiplication of the two embedded factors `C` and `F` inside the normal +closure. Before exactness is imposed this is merely an algebra homomorphism +from the tensor product; exactness will make its source a field and hence the +map injective. -/ +noncomputable def functionFieldNormalClosureOriginalMultiplication : + ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F) →ₐ[K] + FunctionFieldNormalClosure K F := + Algebra.TensorProduct.lift + (FunctionFieldNormalClosureConstantField K F).val + ((functionFieldToNormalClosure K F).restrictScalars K) + (fun _ _ => Commute.all _ _) + +@[simp] +theorem functionFieldNormalClosureOriginalMultiplication_tmul + (c : FunctionFieldNormalClosureConstantField K F) (x : F) : + functionFieldNormalClosureOriginalMultiplication K F (c ⊗ₜ[K] x) = + c.1 * functionFieldToNormalClosure K F x := by + simp [functionFieldNormalClosureOriginalMultiplication] + +/-- The compositum `CF` inside the chosen normal closure, realized as the +field range of tensor multiplication. -/ +noncomputable def FunctionFieldNormalClosureOriginalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + IntermediateField K (FunctionFieldNormalClosure K F) := by + letI : Field (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + exactConstantExtensionField K F + (FunctionFieldNormalClosureConstantField K F) hExact + exact (functionFieldNormalClosureOriginalMultiplication K F).fieldRange + +/-- Tensor scalar extension is the same field as the compositum `CF` inside +the normal closure. -/ +noncomputable def exactConstantExtensionOriginalCompositumAlgEquiv + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F) ≃ₐ[K] + FunctionFieldNormalClosureOriginalCompositum K F hExact := by + letI : Field (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + exactConstantExtensionField K F + (FunctionFieldNormalClosureConstantField K F) hExact + exact AlgEquiv.ofInjectiveField + (functionFieldNormalClosureOriginalMultiplication K F) + +/-- Every algebraic constant of the normal closure belongs to `CF`. -/ +theorem functionFieldNormalClosureConstant_mem_originalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) + (c : FunctionFieldNormalClosureConstantField K F) : + c.1 ∈ FunctionFieldNormalClosureOriginalCompositum K F hExact := by + letI : Field (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + exactConstantExtensionField K F + (FunctionFieldNormalClosureConstantField K F) hExact + exact ⟨c ⊗ₜ[K] (1 : F), by simp⟩ + +/-- The original rational-function field belongs to `CF`. -/ +theorem functionFieldNormalClosureRatFunc_mem_originalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) + (r : RatFunc K) : + algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) r ∈ + FunctionFieldNormalClosureOriginalCompositum K F hExact := by + letI : Field (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + exactConstantExtensionField K F + (FunctionFieldNormalClosureConstantField K F) hExact + refine ⟨1 ⊗ₜ[K] algebraMap (RatFunc K) F r, ?_⟩ + simp [functionFieldNormalClosureOriginalMultiplication] + +/-- The inclusion of the full constant field into `CF`. -/ +noncomputable def functionFieldNormalClosureConstantToOriginalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + FunctionFieldNormalClosureConstantField K F →ₐ[K] + FunctionFieldNormalClosureOriginalCompositum K F hExact := + (FunctionFieldNormalClosureConstantField K F).val.codRestrict + (FunctionFieldNormalClosureOriginalCompositum K F hExact).toSubalgebra + (functionFieldNormalClosureConstant_mem_originalCompositum K F hExact) + +/-- The compositum is naturally an algebra over the full constant field. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureOriginalCompositumConstantAlgebra + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + Algebra (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + (functionFieldNormalClosureConstantToOriginalCompositum K F hExact).toAlgebra + +/-- The tensor/compositum equivalence respects the enlarged constants. -/ +noncomputable def exactConstantExtensionOriginalCompositumConstantAlgEquiv + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + letI : Field (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + exactConstantExtensionField K F + (FunctionFieldNormalClosureConstantField K F) hExact + letI : Algebra (FunctionFieldNormalClosureConstantField K F) + (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + Algebra.TensorProduct.leftAlgebra + ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F) ≃ₐ[ + FunctionFieldNormalClosureConstantField K F] + FunctionFieldNormalClosureOriginalCompositum K F hExact := by + letI : Field (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + exactConstantExtensionField K F + (FunctionFieldNormalClosureConstantField K F) hExact + letI : Algebra (FunctionFieldNormalClosureConstantField K F) + (ExactConstantExtension K F + (FunctionFieldNormalClosureConstantField K F)) := + Algebra.TensorProduct.leftAlgebra + refine + { exactConstantExtensionOriginalCompositumAlgEquiv K F hExact with + commutes' := ?_ } + intro c + apply Subtype.ext + change functionFieldNormalClosureOriginalMultiplication K F + (c ⊗ₜ[K] (1 : F)) = c.1 + simp + +/-- The constant embedding into `CF` agrees with its embedding into `N`. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositumConstantTower + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + IsScalarTower (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := by + apply IsScalarTower.of_algebraMap_eq' + ext c + rfl + +/-- The inclusion of `K(t)` into `CF`. -/ +noncomputable def functionFieldNormalClosureRatFuncToOriginalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + RatFunc K →ₐ[K] + FunctionFieldNormalClosureOriginalCompositum K F hExact := + (IsScalarTower.toAlgHom K (RatFunc K) + (FunctionFieldNormalClosure K F)).codRestrict + (FunctionFieldNormalClosureOriginalCompositum K F hExact).toSubalgebra + (functionFieldNormalClosureRatFunc_mem_originalCompositum K F hExact) + +/-- The compositum is naturally a `K(t)`-algebra. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureOriginalCompositumRatFuncAlgebra + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + Algebra (RatFunc K) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + (functionFieldNormalClosureRatFuncToOriginalCompositum K F hExact).toAlgebra + +/-- The `K(t)` embedding into `CF` agrees with its embedding into `N`. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositumRatFuncTower + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + IsScalarTower (RatFunc K) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := by + apply IsScalarTower.of_algebraMap_eq' + ext r + rfl + +/-- The constant base `C(t)` inside `N` is contained in the larger compositum +`CF`. -/ +theorem functionFieldNormalClosureConstantBase_le_originalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) + (b : FunctionFieldNormalClosureConstantBase K F) : + b.1 ∈ FunctionFieldNormalClosureOriginalCompositum K F hExact := by + have hb : b.1 ∈ functionFieldNormalClosureConstantCompositum K F := by + rw [← functionFieldNormalClosureConstantBase_eq_compositum K F] + exact b.2 + refine IntermediateField.adjoin_induction (RatFunc K) + (p := fun z _ => + z ∈ FunctionFieldNormalClosureOriginalCompositum K F hExact) + ?_ ?_ ?_ ?_ ?_ hb + · rintro _ ⟨c, rfl⟩ + exact functionFieldNormalClosureConstant_mem_originalCompositum + K F hExact c + · exact functionFieldNormalClosureRatFunc_mem_originalCompositum + K F hExact + · intro x y _ _ hx hy + exact (FunctionFieldNormalClosureOriginalCompositum K F hExact).add_mem hx hy + · intro x _ hx + exact (FunctionFieldNormalClosureOriginalCompositum K F hExact).inv_mem hx + · intro x y _ _ hx hy + exact (FunctionFieldNormalClosureOriginalCompositum K F hExact).mul_mem hx hy + +/-- Inclusion of the constant base `C(t)` into `CF`, linear over `C`. -/ +noncomputable def functionFieldNormalClosureConstantBaseToOriginalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + FunctionFieldNormalClosureConstantBase K F →ₐ[ + FunctionFieldNormalClosureConstantField K F] + FunctionFieldNormalClosureOriginalCompositum K F hExact where + toFun b := ⟨b.1, + functionFieldNormalClosureConstantBase_le_originalCompositum + K F hExact b⟩ + map_one' := rfl + map_mul' _ _ := rfl + map_zero' := rfl + map_add' _ _ := rfl + commutes' _ := rfl + +/-- The standard coefficient algebra structure on `C(t)` used by the +rational-function equivalence. -/ +@[reducible] noncomputable instance (priority := 2000) + functionFieldNormalClosureConstantFieldRatFuncAlgebraForOriginalCompositum : + Algebra (FunctionFieldNormalClosureConstantField K F) + (RatFunc (FunctionFieldNormalClosureConstantField K F)) := + RatFunc.instAlgebraOfPolynomial + (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureConstantField K F) + +/-- The `C(t)`-algebra structure on `CF`, transported through the canonical +equivalence `C(t) ≃ C K(t)` inside the normal closure. -/ +noncomputable def + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgHom + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + RatFunc (FunctionFieldNormalClosureConstantField K F) →ₐ[ + FunctionFieldNormalClosureConstantField K F] + FunctionFieldNormalClosureOriginalCompositum K F hExact := + (functionFieldNormalClosureConstantBaseToOriginalCompositum K F hExact).comp + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F).toAlgHom + +/-- `CF` as an algebra over the enlarged rational-function field `C(t)`. -/ +@[reducible] noncomputable instance + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + Algebra (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + (functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgHom + K F hExact).toAlgebra + +/-- The two embeddings of `K` into `CF`, directly and through `C`, agree. -/ +noncomputable instance + functionFieldNormalClosureOriginalCompositumBaseConstantTower + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + IsScalarTower K (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := by + apply IsScalarTower.of_algebraMap_eq' + ext k + rfl + +/-- The chosen normal closure is finite over the original compositum `CF`. -/ +noncomputable instance + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + FiniteDimensional + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := by + letI : Module.Finite + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := + Module.Finite.of_restrictScalars_finite (RatFunc K) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) + infer_instance + +/-- The chosen normal closure remains Galois after enlarging the base from +`K(t)` to the intermediate field `CF`. -/ +noncomputable instance functionFieldNormalClosure_isGalois_over_originalCompositum + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + IsGalois (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) := by + exact IsGalois.tower_top_of_isGalois (RatFunc K) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) + (FunctionFieldNormalClosure K F) + +/-- Enlarging the original function field to `CF` introduces exactly the +constants `C` and no others. -/ +theorem functionFieldNormalClosureOriginalCompositumConstantField_isExact + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + algebraicClosure (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) = + (⊥ : IntermediateField (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact)) := by + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let N := FunctionFieldNormalClosure K F + let C := FunctionFieldNormalClosureConstantField K F + let i : M →ₐ[C] N := + { toFun := fun x => x.1 + map_one' := rfl + map_mul' := fun _ _ => rfl + map_zero' := rfl + map_add' := fun _ _ => rfl + commutes' := fun _ => rfl } + apply eq_bot_iff.mpr + intro z hz + have hzN : i z ∈ algebraicClosure C N := + (map_mem_algebraicClosure_iff i).mpr hz + rw [functionFieldNormalClosureConstantField_isExact K F] at hzN + obtain ⟨c, hc⟩ := IntermediateField.mem_bot.mp hzN + apply IntermediateField.mem_bot.mpr + refine ⟨c, ?_⟩ + apply Subtype.ext + exact hc + +end + +noncomputable section + +section CanonicalConstantPresentation + + +variable (K F : Type*) [Field K] [Field F] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +/-- The constant algebra on `F` obtained by restricting the given +`K(t)`-algebra. This named definition is useful when applying constructions +whose constant algebra is definitionally this restriction. -/ +@[reducible] noncomputable def functionFieldCanonicalConstantAlgebra : + Algebra K F := + RingHom.toAlgebra + ((algebraMap (RatFunc K) F).comp (algebraMap K (RatFunc K))) + +/-- For the canonical restricted constant algebra, the tensor/compositum +equivalence is linear over `C(t)`, not merely over `K`. -/ +noncomputable def + exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv : + letI : Algebra K F := functionFieldCanonicalConstantAlgebra K F + letI : IsScalarTower K (RatFunc K) F := + IsScalarTower.of_algebraMap_eq' rfl + ∀ (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)), + let C := FunctionFieldNormalClosureConstantField K F + let E := ExactConstantExtension K F C + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Field E := exactConstantExtensionField K F C hExact + letI : Algebra C E := Algebra.TensorProduct.leftAlgebra + letI : Algebra (RatFunc C) E := + ratFuncExactConstantExtensionAlgebra K C F hExact + E ≃ₐ[RatFunc C] M := by + letI : Algebra K F := functionFieldCanonicalConstantAlgebra K F + letI : IsScalarTower K (RatFunc K) F := + IsScalarTower.of_algebraMap_eq' rfl + intro hExact + let C := FunctionFieldNormalClosureConstantField K F + letI : Algebra C (RatFunc C) := RatFunc.instAlgebraOfPolynomial C C + let E := ExactConstantExtension K F C + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + letI : Field E := exactConstantExtensionField K F C hExact + letI : Algebra C E := Algebra.TensorProduct.leftAlgebra + letI : Algebra (RatFunc C) E := + ratFuncExactConstantExtensionAlgebra K C F hExact + letI : Algebra K[X] F := + RingHom.toAlgebra + ((algebraMap (RatFunc K) F).comp + (algebraMap K[X] (RatFunc K))) + let eC : E ≃ₐ[C] M := + exactConstantExtensionOriginalCompositumConstantAlgEquiv K F hExact + let f : RatFunc C →ₐ[C] M := + eC.toAlgHom.comp (ratFuncToExactConstantExtension K C F hExact) + let g : RatFunc C →ₐ[C] M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgHom + K F hExact + have hX : f RatFunc.X = g RatFunc.X := by + have hfX : ((f RatFunc.X : M) : FunctionFieldNormalClosure K F) = + algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) RatFunc.X := by + change functionFieldNormalClosureOriginalMultiplication K F + (ratFuncToExactConstantExtension K C F hExact RatFunc.X) = _ + rw [ratFuncToExactConstantExtension_X] + simp only [polynomialTensorCancelEvaluationPoint, + Algebra.TensorProduct.includeRight_apply] + rw [functionFieldNormalClosureOriginalMultiplication_tmul] + change (1 : FunctionFieldNormalClosure K F) * + functionFieldToNormalClosure K F + (algebraMap K[X] F Polynomial.X) = _ + rw [one_mul] + change functionFieldToNormalClosure K F + (algebraMap (RatFunc K) F + (algebraMap K[X] (RatFunc K) Polynomial.X)) = _ + rw [RatFunc.algebraMap_X] + exact (functionFieldToNormalClosure K F).commutes RatFunc.X + have hgX : ((g RatFunc.X : M) : FunctionFieldNormalClosure K F) = + algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) RatFunc.X := by + change ((functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F + RatFunc.X : FunctionFieldNormalClosureConstantBase K F) : + FunctionFieldNormalClosure K F) = _ + rw [functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X] + rfl + apply Subtype.ext + exact hfX.trans hgX.symm + have hRing : f.toRingHom = g.toRingHom := by + apply IsFractionRing.ringHom_ext (A := C[X]) + intro p + induction p using Polynomial.induction_on' with + | add p q hp hq => + simpa only [map_add] using congrArg₂ (fun x y => x + y) hp hq + | monomial n c => + rw [← Polynomial.C_mul_X_pow_eq_monomial] + simp only [map_mul, map_pow, RatFunc.algebraMap_C, + RatFunc.algebraMap_X] + rw [← RatFunc.algebraMap_eq_C] + have hfc : f.toRingHom (algebraMap C (RatFunc C) c) = + algebraMap C M c := f.commutes c + have hgc : g.toRingHom (algebraMap C (RatFunc C) c) = + algebraMap C M c := g.commutes c + have hX' : f.toRingHom RatFunc.X = g.toRingHom RatFunc.X := hX + rw [hfc, hgc, hX'] + have hfg : f = g := + DFunLike.ext _ _ (fun r => DFunLike.congr_fun hRing r) + refine { eC with commutes' := ?_ } + intro r + exact DFunLike.congr_fun hfg r + +end CanonicalConstantPresentation + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean new file mode 100644 index 0000000000..4daad20b99 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean @@ -0,0 +1,128 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure + +/-! +# The original field inside its chosen normal closure + +The chosen embedding of a finite separable function field into its normal +closure has a field range. This file names that intermediate field, records +the tautological algebra equivalence with the original presentation, and +transports exact constants and rational-place counts across it. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable (K F : Type*) [Field K] [Field F] + [Algebra (RatFunc K) F] + [FiniteDimensional (RatFunc K) F] + [Algebra.IsSeparable (RatFunc K) F] + +/-- The embedded copy of the original function field inside its chosen +normal closure. -/ +abbrev FunctionFieldNormalClosureOriginalField : + IntermediateField (RatFunc K) (FunctionFieldNormalClosure K F) := + (functionFieldToNormalClosure K F).fieldRange + +/-- The original presentation is equivalent, over `K(X)`, to its embedded +copy in the normal closure. -/ +noncomputable def functionFieldNormalClosureOriginalFieldAlgEquiv : + F ≃ₐ[RatFunc K] FunctionFieldNormalClosureOriginalField K F := + (functionFieldToNormalClosure K F).equivFieldRange + +/-- The normal closure is finite over the embedded original field. -/ +noncomputable instance + functionFieldNormalClosure_finiteDimensional_over_originalField : + FiniteDimensional (FunctionFieldNormalClosureOriginalField K F) + (FunctionFieldNormalClosure K F) := by + exact Module.Finite.right (RatFunc K) + (FunctionFieldNormalClosureOriginalField K F) + (FunctionFieldNormalClosure K F) + +/-- The normal closure remains Galois after replacing the rational base by +the embedded original field. -/ +noncomputable instance functionFieldNormalClosure_isGalois_over_originalField : + IsGalois (FunctionFieldNormalClosureOriginalField K F) + (FunctionFieldNormalClosure K F) := + IsGalois.tower_top_of_isGalois (RatFunc K) + (FunctionFieldNormalClosureOriginalField K F) + (FunctionFieldNormalClosure K F) + +section Constants + +variable [Algebra K F] [IsScalarTower K (RatFunc K) F] + +local instance originalFieldImageConstantAlgebra : + Algebra K (FunctionFieldNormalClosureOriginalField K F) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) + (FunctionFieldNormalClosureOriginalField K F)).comp + (algebraMap K (RatFunc K))) + +local instance originalFieldImageConstantTower : + IsScalarTower K (RatFunc K) + (FunctionFieldNormalClosureOriginalField K F) := + IsScalarTower.of_algebraMap_eq' + (R := K) (S := RatFunc K) + (A := FunctionFieldNormalClosureOriginalField K F) rfl + +/-- Exactness of the constant field is unchanged when the original function +field is replaced by its embedded image in the normal closure. -/ +theorem functionFieldNormalClosureOriginalField_algebraicClosure_eq_bot + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + algebraicClosure K (FunctionFieldNormalClosureOriginalField K F) = + (⊥ : IntermediateField K + (FunctionFieldNormalClosureOriginalField K F)) := by + let e : F ≃ₐ[K] FunctionFieldNormalClosureOriginalField K F := + (functionFieldNormalClosureOriginalFieldAlgEquiv K F).restrictScalars K + have hmap := algebraicClosure.map_eq_of_algEquiv e + rw [hExact] at hmap + simpa only [IntermediateField.map_bot] using hmap.symm + +end Constants + +section Places + +variable [DecidableEq K] [DecidableEq (RatFunc K)] + +/-- The original presentation and its embedded normal-closure image have the +same complete rational-place count. -/ +theorem functionFieldNormalClosureOriginalField_rationalPlaceCount_eq : + finiteExtensionRationalPlaceCount K F = + finiteExtensionRationalPlaceCount K + (FunctionFieldNormalClosureOriginalField K F) := + finiteExtensionRationalPlaceCount_eq_of_algEquiv K F + (FunctionFieldNormalClosureOriginalField K F) + (functionFieldNormalClosureOriginalFieldAlgEquiv K F) + +end Places + +section ClosedPlaces + +variable [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + +/-- The entire closed-place extension-count sequence is unchanged when the +original presentation is replaced by its image in the normal closure. -/ +theorem + functionFieldNormalClosureOriginalField_closedPlaceExtensionCount_eq + (r : ℕ) : + finiteExtensionClosedPlaceExtensionCount K F r = + finiteExtensionClosedPlaceExtensionCount K + (FunctionFieldNormalClosureOriginalField K F) r := + finiteExtensionClosedPlaceExtensionCount_eq_of_algEquiv K F + (FunctionFieldNormalClosureOriginalField K F) + (functionFieldNormalClosureOriginalFieldAlgEquiv K F) r + +end ClosedPlaces + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean new file mode 100644 index 0000000000..b2855fe673 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +import Mathlib.FieldTheory.RatFunc.AsPolynomial + +/-! +# The rational-function constant base of the normal closure + +Let `N / K(t)` be the chosen function-field normal closure and let `C` be its +full algebraic constant field. The field generated in `N` by `K(t)` and `C` +is exactly the fixed field of the automorphisms acting trivially on `C`. +This is the Galois-theoretic identification of that fixed field with the +constant extension `C(t)`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + + +variable (K L : Type*) [Field K] [Field L] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The compositum of the original rational function field and the algebraic +constant field, formed inside the chosen normal closure. -/ +def functionFieldNormalClosureConstantCompositum : + IntermediateField (RatFunc K) (FunctionFieldNormalClosure K L) := + IntermediateField.adjoin (RatFunc K) + (Set.range (fun c : FunctionFieldNormalClosureConstantField K L => c.1)) + +/-- The subgroup fixing the constant compositum is precisely the kernel of +restriction to the algebraic constant field. -/ +theorem functionFieldNormalClosureConstantCompositum_fixingSubgroup : + (functionFieldNormalClosureConstantCompositum K L).fixingSubgroup = + (functionFieldNormalClosureConstantRestriction K L).ker := by + apply le_antisymm + · intro g hg + rw [MonoidHom.mem_ker] + apply AlgEquiv.ext + intro c + apply Subtype.ext + exact (IntermediateField.mem_fixingSubgroup_iff + (functionFieldNormalClosureConstantCompositum K L) g).mp hg c.1 + (IntermediateField.subset_adjoin (RatFunc K) _ ⟨c, rfl⟩) + · apply (IntermediateField.le_iff_le + (functionFieldNormalClosureConstantRestriction K L).ker + (functionFieldNormalClosureConstantCompositum K L)).mp + unfold functionFieldNormalClosureConstantCompositum + rw [IntermediateField.adjoin_le_iff] + rintro _ ⟨c, rfl⟩ + exact (functionFieldNormalClosureConstantToBase K L c).property + +/-- The kernel fixed field is the compositum `K(t)C` inside the normal +closure. -/ +theorem functionFieldNormalClosureConstantBase_eq_compositum : + FunctionFieldNormalClosureConstantBase K L = + functionFieldNormalClosureConstantCompositum K L := by + change IntermediateField.fixedField + (functionFieldNormalClosureConstantRestriction K L).ker = _ + rw [show (functionFieldNormalClosureConstantRestriction K L).ker = + (functionFieldNormalClosureConstantCompositum K L).fixingSubgroup by + exact (functionFieldNormalClosureConstantCompositum_fixingSubgroup + K L).symm] + exact IsGalois.fixedField_fixingSubgroup + (functionFieldNormalClosureConstantCompositum K L) + +/-- The original parameter `t` as an element of the kernel fixed field. -/ +def functionFieldNormalClosureConstantBaseX : + FunctionFieldNormalClosureConstantBase K L := + ⟨algebraMap (RatFunc K) (FunctionFieldNormalClosure K L) RatFunc.X, by + apply (IntermediateField.mem_fixedField_iff + (H := (functionFieldNormalClosureConstantRestriction K L).ker) _).mpr + intro g hg + exact g.commutes RatFunc.X⟩ + +/-- The `K`-, `C`-, and kernel-fixed-field algebra structures form a tower. -/ +noncomputable instance functionFieldNormalClosureConstantBase_constantTower : + IsScalarTower K (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) := by + apply IsScalarTower.of_algebraMap_eq' + ext k + rfl + +/-- The original parameter remains transcendental after adjoining all +algebraic constants of the normal closure. -/ +theorem functionFieldNormalClosureConstantBaseX_transcendental : + Transcendental (FunctionFieldNormalClosureConstantField K L) + (functionFieldNormalClosureConstantBaseX K L) := by + intro hx + have hxIntegralK : IsIntegral K + (functionFieldNormalClosureConstantBaseX K L) := + isIntegral_trans _ hx.isIntegral + have hxRatFunc : IsIntegral K (RatFunc.X : RatFunc K) := by + apply (isIntegral_algHom_iff + (IsScalarTower.toAlgHom K (RatFunc K) + (FunctionFieldNormalClosureConstantBase K L)) + (algebraMap (RatFunc K) + (FunctionFieldNormalClosureConstantBase K L)).injective).mp + simpa [functionFieldNormalClosureConstantBaseX] using hxIntegralK + exact RatFunc.transcendental_X hxRatFunc.isAlgebraic + +/-- The kernel fixed field is generated over the full constant field by the +original rational parameter. -/ +theorem functionFieldNormalClosureConstantBase_adjoin_X : + IntermediateField.adjoin + (FunctionFieldNormalClosureConstantField K L) + ({functionFieldNormalClosureConstantBaseX K L} : + Set (FunctionFieldNormalClosureConstantBase K L)) = ⊤ := by + let C := FunctionFieldNormalClosureConstantField K L + let B := FunctionFieldNormalClosureConstantBase K L + let N := FunctionFieldNormalClosure K L + let x : B := functionFieldNormalClosureConstantBaseX K L + let D : IntermediateField C B := IntermediateField.adjoin C ({x} : Set B) + let f : RatFunc K →ₐ[K] B := IsScalarTower.toAlgHom K (RatFunc K) B + have hfX : f RatFunc.X = x := rfl + have hfieldRange : f.fieldRange = + IntermediateField.adjoin K ({x} : Set B) := by + calc + f.fieldRange = IntermediateField.map f + (⊤ : IntermediateField K (RatFunc K)) := + AlgHom.fieldRange_eq_map f + _ = IntermediateField.map f + (IntermediateField.adjoin K ({RatFunc.X} : Set (RatFunc K))) := by + rw [RatFunc.adjoin_X] + _ = IntermediateField.adjoin K (f '' ({RatFunc.X} : Set (RatFunc K))) := + IntermediateField.adjoin_map K _ f + _ = IntermediateField.adjoin K ({x} : Set B) := by + congr 1 + ext y + simp only [Set.mem_image, Set.mem_singleton_iff] + constructor + · rintro ⟨z, rfl, rfl⟩ + exact hfX + · intro hy + refine ⟨RatFunc.X, rfl, ?_⟩ + simpa [hy] using hfX + have hRatFuncRange : f.fieldRange ≤ D.restrictScalars K := by + rw [hfieldRange] + apply IntermediateField.adjoin_simple_le_iff.mpr + rw [IntermediateField.mem_restrictScalars] + exact IntermediateField.subset_adjoin C ({x} : Set B) (Set.mem_singleton x) + have hRatFunc (r : RatFunc K) : + algebraMap (RatFunc K) B r ∈ D := by + rw [← IntermediateField.mem_restrictScalars K] + apply hRatFuncRange + exact ⟨r, rfl⟩ + apply top_unique + intro y hy + change y ∈ D + have hyCompositum : y.1 ∈ functionFieldNormalClosureConstantCompositum K L := by + rw [← functionFieldNormalClosureConstantBase_eq_compositum K L] + exact y.2 + refine IntermediateField.adjoin_induction (RatFunc K) + (p := fun z hz => ∀ hzB : z ∈ FunctionFieldNormalClosureConstantBase K L, + (⟨z, hzB⟩ : B) ∈ D) ?_ ?_ ?_ ?_ ?_ hyCompositum y.2 + · rintro z ⟨c, rfl⟩ hzB + exact D.algebraMap_mem c + · intro r hzB + exact hRatFunc r + · intro z w hz hw hzD hwD hzwB + have hzB : z ∈ FunctionFieldNormalClosureConstantBase K L := by + rw [functionFieldNormalClosureConstantBase_eq_compositum K L] + exact hz + have hwB : w ∈ FunctionFieldNormalClosureConstantBase K L := by + rw [functionFieldNormalClosureConstantBase_eq_compositum K L] + exact hw + exact D.add_mem (hzD hzB) (hwD hwB) + · intro z hz hzD hzInvB + have hzB : z ∈ FunctionFieldNormalClosureConstantBase K L := by + rw [functionFieldNormalClosureConstantBase_eq_compositum K L] + exact hz + exact D.inv_mem (hzD hzB) + · intro z w hz hw hzD hwD hzwB + have hzB : z ∈ FunctionFieldNormalClosureConstantBase K L := by + rw [functionFieldNormalClosureConstantBase_eq_compositum K L] + exact hz + have hwB : w ∈ FunctionFieldNormalClosureConstantBase K L := by + rw [functionFieldNormalClosureConstantBase_eq_compositum K L] + exact hw + exact D.mul_mem (hzD hzB) (hwD hwB) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean new file mode 100644 index 0000000000..8ea194a763 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean @@ -0,0 +1,89 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase + +/-! +# The rational-function equivalence for the normal-closure constant base + +This file packages the generation theorem from +`FunctionFieldNormalClosureRatFuncBase` as an explicit algebra equivalence +between `C(t)` and the kernel fixed field. +-/ + +namespace BGS.HasseWeil + +noncomputable section + + +private noncomputable def ratFuncEquivOfAdjoinEqTop + {C B : Type*} [Field C] [Field B] [Algebra C B] + (x : B) (hx : Transcendental C x) + (hgen : IntermediateField.adjoin C ({x} : Set B) = ⊤) : + RatFunc C ≃ₐ[C] B := + (RatFunc.algEquivOfTranscendental x hx).trans + ((IntermediateField.equivOfEq hgen).trans IntermediateField.topEquiv) + +@[simp] private theorem ratFuncEquivOfAdjoinEqTop_X + {C B : Type*} [Field C] [Field B] [Algebra C B] + (x : B) (hx : Transcendental C x) + (hgen : IntermediateField.adjoin C ({x} : Set B) = ⊤) : + ratFuncEquivOfAdjoinEqTop x hx hgen RatFunc.X = x := by + simp [ratFuncEquivOfAdjoinEqTop] + +@[reducible] private noncomputable def ratFuncSelfAlgebra + (C : Type*) [Field C] : Algebra C (RatFunc C) := + RatFunc.instAlgebraOfPolynomial C C + +variable (K L : Type*) [Field K] [Field L] + [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance functionFieldNormalClosureConstantFieldRatFuncAlgebra : + Algebra (FunctionFieldNormalClosureConstantField K L) + (RatFunc (FunctionFieldNormalClosureConstantField K L)) := + ratFuncSelfAlgebra (FunctionFieldNormalClosureConstantField K L) + +/-- The kernel fixed field is canonically the rational function field over +the exact constant field, with the original parameter corresponding to `X`. +-/ +noncomputable def functionFieldNormalClosureConstantBaseRatFuncAlgEquiv : + RatFunc (FunctionFieldNormalClosureConstantField K L) ≃ₐ[ + FunctionFieldNormalClosureConstantField K L] + FunctionFieldNormalClosureConstantBase K L := + ratFuncEquivOfAdjoinEqTop + (functionFieldNormalClosureConstantBaseX K L) + (functionFieldNormalClosureConstantBaseX_transcendental K L) + (functionFieldNormalClosureConstantBase_adjoin_X K L) + +/-- The rational-function specialization that sends `X` to the original +parameter in the kernel fixed field. -/ +noncomputable def functionFieldNormalClosureConstantBaseRatFuncAlgHom : + RatFunc (FunctionFieldNormalClosureConstantField K L) →ₐ[ + FunctionFieldNormalClosureConstantField K L] + FunctionFieldNormalClosureConstantBase K L := + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K L).toAlgHom + +/-- The rational-function specialization onto the kernel fixed field is +surjective because the parameter generates that field over its constants. -/ +theorem functionFieldNormalClosureConstantBaseRatFuncAlgHom_surjective : + Function.Surjective + (functionFieldNormalClosureConstantBaseRatFuncAlgHom K L) := + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K L).surjective + +@[simp] +theorem functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X : + functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K L RatFunc.X = + functionFieldNormalClosureConstantBaseX K L := by + exact ratFuncEquivOfAdjoinEqTop_X + (C := FunctionFieldNormalClosureConstantField K L) + (B := FunctionFieldNormalClosureConstantBase K L) _ _ _ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean new file mode 100644 index 0000000000..0f41cc86ab --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +import Mathlib + +/-! +# The finite averaging step in the Corvaja--Zannier Hasse--Weil argument + +The Galois-closure argument produces finitely many twisted fixed-point error +terms. Every twist has the same upper bound, while their sum is small. The +elementary lemma below converts those facts into a two-sided bound for each +individual twist. +-/ + +namespace BGS.HasseWeil + +open scoped BigOperators +open Filter Asymptotics + +/-- If every term in a nonempty finite family is at most `B` and the total +sum has absolute value at most `A`, then every term has a two-sided bound. +This is the numerical core of the Galois-twist averaging step. -/ +theorem abs_le_of_uniform_upper_and_abs_sum_le + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : ι → ℝ) (i : ι) (A B : ℝ) + (hB : 0 ≤ B) (hupper : ∀ j, E j ≤ B) + (hsum : |∑ j, E j| ≤ A) : + |E i| ≤ A + (Fintype.card ι - 1 : ℕ) * B := by + have hA : 0 ≤ A := (abs_nonneg _).trans hsum + have hcard : 1 ≤ Fintype.card ι := Fintype.card_pos_iff.mpr ⟨i⟩ + have heraseCard : (Finset.univ.erase i).card = Fintype.card ι - 1 := by + rw [Finset.card_erase_of_mem (Finset.mem_univ i), Finset.card_univ] + have hrest : ∑ j ∈ Finset.univ.erase i, E j ≤ + (Fintype.card ι - 1 : ℕ) * B := by + calc + ∑ j ∈ Finset.univ.erase i, E j ≤ + ∑ _j ∈ Finset.univ.erase i, B := by + exact Finset.sum_le_sum fun j _ => hupper j + _ = (Fintype.card ι - 1 : ℕ) * B := by + simp [heraseCard] + have hsumSplit : ∑ j, E j = E i + ∑ j ∈ Finset.univ.erase i, E j := by + rw [← Finset.sum_erase_add _ _ (Finset.mem_univ i)] + ring + have hlowerSum : -A ≤ ∑ j, E j := (abs_le.mp hsum).1 + have hlower : -(A + (Fintype.card ι - 1 : ℕ) * B) ≤ E i := by + rw [hsumSplit] at hlowerSum + linarith + have hupper' : E i ≤ A + (Fintype.card ι - 1 : ℕ) * B := by + by_cases hsingleton : Fintype.card ι = 1 + · have huniv : (Finset.univ : Finset ι) = {i} := + univ_eq_singleton_of_card_one i hsingleton + have hEi : |E i| ≤ A := by simpa [huniv] using hsum + simpa [hsingleton] using (le_trans (le_abs_self (E i)) hEi) + · have htwo : 2 ≤ Fintype.card ι := by omega + have hcoefficientNat : 1 ≤ Fintype.card ι - 1 := by omega + have hcoefficient : (1 : ℝ) ≤ (Fintype.card ι - 1 : ℕ) := by + exact_mod_cast hcoefficientNat + calc + E i ≤ B := hupper i + _ ≤ (Fintype.card ι - 1 : ℕ) * B := by + exact le_mul_of_one_le_left hB hcoefficient + _ ≤ A + (Fintype.card ι - 1 : ℕ) * B := le_add_of_nonneg_left hA + exact abs_le.mpr ⟨hlower, hupper'⟩ + +/-- Sequence form of Galois averaging. A uniform `B * rho ^ n` upper bound +for all twists, together with a bounded total error, gives the same geometric +growth rate as a two-sided bound for every twist. -/ +theorem abs_twistError_le_geometric_of_uniform_upper_and_abs_sum_le + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : ℕ → ι → ℝ) (i : ι) (A B rho : ℝ) + (hA : 0 ≤ A) (hB : 0 ≤ B) (hrho : 1 ≤ rho) + (hupper : ∀ n j, E n j ≤ B * rho ^ n) + (hsum : ∀ n, |∑ j, E n j| ≤ A) (n : ℕ) : + |E n i| ≤ (A + (Fintype.card ι - 1 : ℕ) * B) * rho ^ n := by + have hrhoPow : 1 ≤ rho ^ n := one_le_pow₀ hrho + have hgeometricNonneg : 0 ≤ B * rho ^ n := by positivity + have hraw := abs_le_of_uniform_upper_and_abs_sum_le + (E n) i A (B * rho ^ n) hgeometricNonneg (hupper n) (hsum n) + calc + |E n i| ≤ A + (Fintype.card ι - 1 : ℕ) * (B * rho ^ n) := hraw + _ ≤ A * rho ^ n + (Fintype.card ι - 1 : ℕ) * (B * rho ^ n) := by + gcongr + simpa using (mul_le_mul_of_nonneg_left hrhoPow hA) + _ = (A + (Fintype.card ι - 1 : ℕ) * B) * rho ^ n := by ring + +/-- The finite averaging estimate gives the geometric `O(rho ^ n)` bound +needed by the zeta-function power-sum argument. -/ +theorem twistError_isBigO_geometric_of_uniform_upper_and_abs_sum_le + {ι : Type*} [Fintype ι] [DecidableEq ι] + (E : ℕ → ι → ℝ) (i : ι) (A B rho : ℝ) + (hA : 0 ≤ A) (hB : 0 ≤ B) (hrho : 1 ≤ rho) + (hupper : ∀ n j, E n j ≤ B * rho ^ n) + (hsum : ∀ n, |∑ j, E n j| ≤ A) : + (fun n : ℕ ↦ E n i) =O[atTop] fun n : ℕ ↦ rho ^ n := by + let C : ℝ := A + ((Fintype.card ι - 1 : ℕ) : ℝ) * B + have hC : 0 ≤ C := by + dsimp [C] + positivity + apply IsBigO.of_bound C + filter_upwards [] with n + rw [Real.norm_eq_abs, Real.norm_eq_abs, + abs_of_nonneg (pow_nonneg (le_trans zero_le_one hrho) n)] + simpa only [C] using + abs_twistError_le_geometric_of_uniform_upper_and_abs_sum_le + E i A B rho hA hB hrho hupper hsum n + +/-- If a nonempty finite family is uniformly close to `center` and its sum +is close to `card · base`, then `base` is close to `center`. The deliberately +division-free bound is convenient for integral point counts and is uniform +when the family cardinality is fixed. -/ +theorem abs_base_sub_center_le_of_average_and_pointwise + {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + (x : ι → ℝ) (base center A B : ℝ) + (hA : 0 ≤ A) (hB : 0 ≤ B) + (haverage : |∑ i, x i - (Fintype.card ι : ℝ) * base| ≤ A) + (hpointwise : ∀ i, |x i - center| ≤ B) : + |base - center| ≤ A + (Fintype.card ι : ℝ) * B := by + have hcardNat : 1 ≤ Fintype.card ι := + Fintype.card_pos_iff.mpr inferInstance + have hcard : (1 : ℝ) ≤ Fintype.card ι := by + exact_mod_cast hcardNat + have hsum : |∑ i, (x i - center)| ≤ + (Fintype.card ι : ℝ) * B := by + calc + |∑ i, (x i - center)| ≤ ∑ i, |x i - center| := + Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ _i : ι, B := Finset.sum_le_sum fun i _ => hpointwise i + _ = (Fintype.card ι : ℝ) * B := by + rw [Finset.sum_const, Finset.card_univ, nsmul_eq_mul] + have hscaled : |(Fintype.card ι : ℝ) * (base - center)| ≤ + A + (Fintype.card ι : ℝ) * B := by + have hid : (Fintype.card ι : ℝ) * (base - center) = + -(∑ i, x i - (Fintype.card ι : ℝ) * base) + + ∑ i, (x i - center) := by + simp only [Finset.sum_sub_distrib, Finset.sum_const, + Finset.card_univ, nsmul_eq_mul] + ring + rw [hid] + calc + |-(∑ i, x i - (Fintype.card ι : ℝ) * base) + + ∑ i, (x i - center)| ≤ + |-(∑ i, x i - (Fintype.card ι : ℝ) * base)| + + |∑ i, (x i - center)| := abs_add_le _ _ + _ ≤ A + (Fintype.card ι : ℝ) * B := by + gcongr + simpa only [abs_neg] using haverage + have hnonneg : 0 ≤ |base - center| := abs_nonneg _ + calc + |base - center| ≤ + (Fintype.card ι : ℝ) * |base - center| := by + nlinarith + _ = |(Fintype.card ι : ℝ) * (base - center)| := by + rw [abs_mul, abs_of_nonneg (by positivity : + (0 : ℝ) ≤ Fintype.card ι)] + _ ≤ A + (Fintype.card ι : ℝ) * B := hscaled + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean new file mode 100644 index 0000000000..cf869a5a11 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.FieldTheory.Galois.Basic + +/-! +# A common factorial degree for Galois groups in a field tower + +For `R ⊆ L ⊆ N`, the order of `Gal(N/L)` is at most `[N:R]`. +Consequently every such intermediate Galois-group order divides the +factorial of the top degree. This supplies one auxiliary constant-extension +degree that works simultaneously for the rational base and the original +compositum in the Frobenius-twist argument. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +/-- The Galois group over the bottom field itself divides the factorial of +the extension degree. -/ +theorem natCard_aut_dvd_finrank_factorial + (R N : Type*) [Field R] [Field N] [Algebra R N] + [FiniteDimensional R N] [IsGalois R N] : + Nat.card (N ≃ₐ[R] N) ∣ (Module.finrank R N).factorial := by + rw [IsGalois.card_aut_eq_finrank] + exact Nat.dvd_factorial Module.finrank_pos le_rfl + +variable (R L N : Type*) [Field R] [Field L] [Field N] + [Algebra R L] [Algebra L N] [Algebra R N] + [IsScalarTower R L N] + [FiniteDimensional R L] [FiniteDimensional L N] + [IsGalois L N] + +/-- The intermediate Galois group order is bounded by the degree over the +bottom field. -/ +theorem natCard_aut_le_finrank_of_tower : + Nat.card (N ≃ₐ[L] N) ≤ Module.finrank R N := by + rw [IsGalois.card_aut_eq_finrank] + calc + Module.finrank L N ≤ + Module.finrank R L * Module.finrank L N := + Nat.le_mul_of_pos_left _ Module.finrank_pos + _ = Module.finrank R N := Module.finrank_mul_finrank R L N + +/-- A single factorial of the top degree is divisible by the order of every +intermediate Galois group in the tower. -/ +theorem natCard_aut_dvd_finrank_factorial_of_tower : + Nat.card (N ≃ₐ[L] N) ∣ (Module.finrank R N).factorial := by + exact Nat.dvd_factorial + (Nat.card_pos : 0 < Nat.card (N ≃ₐ[L] N)) + (natCard_aut_le_finrank_of_tower R L N) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean new file mode 100644 index 0000000000..70bf193c3e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction + +/-! +# The general affine bivariate Hasse--Weil theorem + +The closed Hasse--Weil theorem for finite separable extensions of `K(X)` is +applied to the function field of a separating absolutely irreducible plane +curve. Exact constants and the bidegree genus budget identify its intrinsic +Hasse bound, while the existing normalization-to-affine comparison gives the +coefficient `8`. Frobenius deflation then removes both separating-coordinate +hypotheses without changing the affine point count or increasing the supplied +bidegree bounds. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +/-- The coefficient-`8` affine Hasse--Weil estimate for a separating +absolutely irreducible plane equation. -/ +theorem + abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_separating + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hfirst : 0 < firstDegree) + (hsecond : 0 < secondDegree) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + |((BGS.External.affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + classical + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let inducedAlg : Algebra K L := bridgeBaseConstantAlgebra K L + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg + (planeCurveFunction f 0) hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg (planeCurveFunction f 0) hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + let budget := (firstDegree - 1) * (secondDegree - 1) + have hExactCanonical : + @algebraicClosure K L _ _ canonicalAlg = + (⊥ : @IntermediateField K L _ _ canonicalAlg) := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hExact : algebraicClosure K L = + (⊥ : IntermediateField K L) := by + change @algebraicClosure K L _ _ inducedAlg = + (⊥ : @IntermediateField K L _ _ inducedAlg) + rw [hinducedAlg] + exact hExactCanonical + have hgenusActualCanonical : + @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f := by + simpa only [L] using + planeCurve_genus_le_bidegreeGenusBudget + habsolute hpartialFirst hpartialSecond + have hfirstDegree : MvPolynomial.degreeOf 0 f ≤ firstDegree := + degreeOf_first_le_of_hasBidegreeAtMost hdegree + have hsecondDegree : MvPolynomial.degreeOf 1 f ≤ secondDegree := + degreeOf_second_le_of_hasBidegreeAtMost hdegree + have hbudget : planeCurveBidegreeGenusBudget f ≤ budget := by + dsimp only [planeCurveBidegreeGenusBudget, budget] + exact Nat.mul_le_mul + (Nat.sub_le_sub_right hfirstDegree 1) + (Nat.sub_le_sub_right hsecondDegree 1) + have hgenusCanonical : + @FunctionField.genus K L _ _ canonicalAlg ≤ budget := + hgenusActualCanonical.trans hbudget + have hgenus : FunctionField.genus K L ≤ budget := by + change @FunctionField.genus K L _ _ inducedAlg ≤ budget + rw [hinducedAlg] + exact hgenusCanonical + have hhasse := finiteExtensionClosedPlaceHasseWeil K L hExact + rw [finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount K L] + at hhasse + have hnormalization : + |(separatingPlaneCurveRationalPlaceCount f hf hpartialSecond : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * (budget : ℝ) + 1) * + Real.sqrt (Fintype.card K : ℝ) := by + change + |(@finiteExtensionRationalPlaceCount K _ _ L _ ratAlg + (Classical.decEq (RatFunc K)) : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * (budget : ℝ) + 1) * Real.sqrt (Fintype.card K : ℝ) + have hhasse' : + |(@finiteExtensionRationalPlaceCount K _ _ L _ ratAlg + (Classical.decEq (RatFunc K)) : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * FunctionField.genus K L + 1 : ℝ) * + Real.sqrt (Fintype.card K : ℝ) := by + simpa only [Fintype.card_eq_nat_card] using hhasse + apply hhasse'.trans + apply mul_le_mul_of_nonneg_right _ (Real.sqrt_nonneg _) + exact_mod_cast Nat.add_le_add_right (Nat.mul_le_mul_left 2 hgenus) 1 + rw [affinePlaneCurveZeros_card_eq_affinePlaneCurvePoint_card] + exact + abs_affinePlaneCurvePoint_card_sub_card_le_eight_mul_bidegree_of_rationalPlaceHasse + hdegree hf hpartialFirst hpartialSecond hfirst hsecond + (show 2 * budget + 1 ≤ + 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1 by rfl) + (by simpa using hnormalization) + +/-- The coefficient-`8` affine Hasse--Weil estimate for every absolutely +irreducible bivariate equation of positive supplied bidegree. -/ +theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ) + (hfirst : 0 < firstDegree) + (hsecond : 0 < secondDegree) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) : + |((BGS.External.affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + exact abs_affinePlaneCurveZeros_card_sub_card_le_of_separating_case + K f firstDegree secondDegree hdegree habsolute + (fun g hgdegree hgabsolute hgpartialFirst hgpartialSecond => + abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_separating + hfirst hsecond hgdegree hgabsolute hgpartialFirst hgpartialSecond) + +/-- The in-repository inhabitant of the general affine bivariate +Hasse--Weil interface. -/ +theorem bivariateAffineHasseWeilBound_eight : + BGS.External.BivariateAffineHasseWeilBound 8 := by + intro K _ _ _ f firstDegree secondDegree hfirst hsecond hdegree habsolute + exact abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree + K f firstDegree secondDegree hfirst hsecond hdegree habsolute + +/-- The in-repository inhabitant of the general affine bivariate +Hasse--Weil interface. -/ +theorem generalBivariateAffineHasseWeilTheorem : + BGS.External.GeneralBivariateAffineHasseWeilTheorem := by + exact ⟨8, by norm_num, bivariateAffineHasseWeilBound_eight⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean new file mode 100644 index 0000000000..37fcec3539 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean @@ -0,0 +1,311 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +import Mathlib.FieldTheory.PrimitiveElement +import Mathlib.Tactic + +/-! +# A coarse Riemann inequality for arbitrary function fields + +This file derives the amount of Riemann-space growth needed by the intrinsic +Stepanov argument without appealing to an external Riemann--Roch theorem. + +For a finite separable extension `L / K(X)`, choose a primitive element `y`. +The monomials `X^i y^j` with `j < [L : K(X)]` are linearly independent. Their +pole divisors give a cofinal family of effective divisors supported above +infinity and hence a coarse, but uniform-for-`L`, Riemann inequality. The +finite-place approximation theorem then transfers this inequality to every +one-point divisor at a finite place. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance generalRiemannConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance generalRiemannConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance generalRiemannInfinityModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- A monomial grid with the expected `X`-height gives a Riemann inequality +for every effective divisor supported above infinity. -/ +theorem infinitySupported_riemann_lower_of_monomial + (x y : L) (hx0 : x ≠ 0) (hy0 : y ≠ 0) (b : Nat) + (hLI : ∀ n, LinearIndependent K + (planeMonomialGrid x y (n + 1) b)) + (hxHeight : finiteExtensionHeight K L x = b) + (hxInfinity : ∀ P : FiniteExtensionInfinityPlace K L, + 0 < finiteExtensionPoleDivisor K L x (.inr P)) : + ∀ (E : FiniteExtensionDivisor K L), + (∀ v, 0 ≤ E v) → + (∀ q : FiniteExtensionFinitePlace K L, E (.inl q) = 0) → + (finiteExtensionDivisorDegree K L E).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + + ((b - 1) * finiteExtensionHeight K L y + 1) := by + intro E hE hEfinite + let H := finiteExtensionPoleDivisor K L x + have hH : ∀ v, 0 ≤ H v := + finiteExtensionPoleDivisor_effective K L x + obtain ⟨n, hEH⟩ := + exists_nsmul_ge_of_effective_supportedAtInfinity + K L E H hE hEfinite hH hxInfinity + let D : FiniteExtensionDivisor K L := + planeMonomialPoleBudget K L x y n b + have hD : ∀ v, 0 ≤ D v := by + intro v + dsimp only [D, planeMonomialPoleBudget] + simp only [Finsupp.add_apply, Finsupp.nsmul_apply] + exact add_nonneg + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L x v) n) + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L y v) (b - 1)) + have hED : E ≤ D := by + intro v + have hleft := hEH v + dsimp only [H] at hleft + dsimp only [D, planeMonomialPoleBudget] + exact hleft.trans (le_add_of_nonneg_right + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L y v) (b - 1))) + let A : FiniteExtensionDivisor K L := D - E + have hA : ∀ v, 0 ≤ A v := by + intro v + dsimp only [A] + exact sub_nonneg.mpr (hED v) + have hsplit : E + A = D := by + dsimp only [A] + abel + letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := + finiteExtensionRiemannSpace_effective_moduleFinite K L E hE + have hstrip := + finiteExtensionRiemannSpace_add_effective K L E A hE hA + rw [hsplit] at hstrip + have hmono : (n + 1) * b ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) := by + let hfiniteD : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + exact add_one_mul_le_finrank_poleDivisorBudget + K L x y hx0 hy0 n b (hLI n) hfiniteD + have hDdegree : finiteExtensionDivisorDegree K L D = + (n * b + (b - 1) * finiteExtensionHeight K L y : Nat) := by + dsimp only [D, planeMonomialPoleBudget] + rw [finiteExtensionDivisorDegree_pow_mul_pow_budget, hxHeight] + push_cast + ring + have hDdegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L D := + finiteExtensionDivisorDegree_nonnegative_of_effective K L D hD + have hDdegreeNat : (finiteExtensionDivisorDegree K L D).toNat = + n * b + (b - 1) * finiteExtensionHeight K L y := by + apply Int.ofNat_injective + rw [Int.ofNat_eq_natCast, Int.toNat_of_nonneg hDdegreeNonnegative] + exact hDdegree + have hDriemann : (finiteExtensionDivisorDegree K L D).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + ((b - 1) * finiteExtensionHeight K L y + 1) := by + rw [hDdegreeNat] + have hnb : n * b ≤ (n + 1) * b := + Nat.mul_le_mul_right b (Nat.le_succ n) + omega + have hEdegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L E := + finiteExtensionDivisorDegree_nonnegative_of_effective K L E hE + have hAdegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L A := + finiteExtensionDivisorDegree_nonnegative_of_effective K L A hA + have hdegreeSplit : + (finiteExtensionDivisorDegree K L D).toNat = + (finiteExtensionDivisorDegree K L E).toNat + + (finiteExtensionDivisorDegree K L A).toNat := by + have hdegree : finiteExtensionDivisorDegree K L D = + finiteExtensionDivisorDegree K L E + + finiteExtensionDivisorDegree K L A := by + rw [← hsplit, finiteExtensionDivisorDegree_add] + rw [hdegree, Int.toNat_add hEdegreeNonnegative hAdegreeNonnegative] + have hstripRank : + Module.finrank K (finiteExtensionRiemannSpace K L D) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + + (finiteExtensionDivisorDegree K L A).toNat := hstrip.2 + have hcombined : + (finiteExtensionDivisorDegree K L E).toNat + + (finiteExtensionDivisorDegree K L A).toNat + 1 ≤ + (Module.finrank K (finiteExtensionRiemannSpace K L E) + + (finiteExtensionDivisorDegree K L A).toNat) + + ((b - 1) * finiteExtensionHeight K L y + 1) := by + calc + (finiteExtensionDivisorDegree K L E).toNat + + (finiteExtensionDivisorDegree K L A).toNat + 1 = + (finiteExtensionDivisorDegree K L D).toNat + 1 := by + rw [hdegreeSplit] + _ ≤ Module.finrank K (finiteExtensionRiemannSpace K L D) + + ((b - 1) * finiteExtensionHeight K L y + 1) := hDriemann + _ ≤ (Module.finrank K (finiteExtensionRiemannSpace K L E) + + (finiteExtensionDivisorDegree K L A).toNat) + + ((b - 1) * finiteExtensionHeight K L y + 1) := + Nat.add_le_add_right hstripRank _ + omega + +/-- A nonzero primitive element and the exact pole height of `X` supply the +monomial hypotheses of `infinitySupported_riemann_lower_of_monomial`. -/ +theorem infinitySupported_riemann_lower_of_primitive + (x y : L) (hx0 : x ≠ 0) (hy0 : y ≠ 0) + (hxMap : algebraMap (RatFunc K) L RatFunc.X = x) + (hprimitive : IntermediateField.adjoin (RatFunc K) {y} = ⊤) + (hxHeight : finiteExtensionHeight K L x = + Module.finrank (RatFunc K) L) + (hxInfinity : ∀ P : FiniteExtensionInfinityPlace K L, + 0 < finiteExtensionPoleDivisor K L x (.inr P)) : + ∀ (E : FiniteExtensionDivisor K L), + (∀ v, 0 ≤ E v) → + (∀ q : FiniteExtensionFinitePlace K L, E (.inl q) = 0) → + (finiteExtensionDivisorDegree K L E).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + + ((Module.finrank (RatFunc K) L - 1) * + finiteExtensionHeight K L y + 1) := by + let d := Module.finrank (RatFunc K) L + have hyInt : IsIntegral (RatFunc K) y := IsIntegral.of_finite _ _ + have hdegree : (minpoly (RatFunc K) y).natDegree = d := by + calc + (minpoly (RatFunc K) y).natDegree = + Module.finrank (RatFunc K) + (IntermediateField.adjoin (RatFunc K) {y}) := + (IntermediateField.adjoin.finrank hyInt).symm + _ = Module.finrank (RatFunc K) + (⊤ : IntermediateField (RatFunc K) L) := by + rw [hprimitive] + _ = Module.finrank (RatFunc K) L := by + rw [IntermediateField.finrank_top'] + have hLI : ∀ n, LinearIndependent K + (planeMonomialGrid x y (n + 1) d) := by + intro n + have h := planeMonomialGrid_linearIndependent_of_transcendental_minpoly + (RatFunc.X : RatFunc K) y (n + 1) d RatFunc.transcendental_X + (by rw [hdegree]) + rw [hxMap] at h + exact h + simpa only [d] using + infinitySupported_riemann_lower_of_monomial K L x y hx0 hy0 d hLI + (by simpa only [d] using hxHeight) hxInfinity + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- A finite separable extension has a primitive element which can be chosen +nonzero, including the degree-one case. -/ +theorem exists_nonzero_primitive_element : + ∃ y : L, y ≠ 0 ∧ + IntermediateField.adjoin (RatFunc K) {y} = ⊤ := by + obtain ⟨y, hy⟩ := Field.exists_primitive_element (RatFunc K) L + by_cases hy0 : y = 0 + · subst y + refine ⟨1, one_ne_zero, ?_⟩ + simpa using hy + · exact ⟨y, hy0, hy⟩ + +/-- The coarse primitive-element Riemann inequality at every finite place. -/ +theorem finitePlace_riemann_lower_of_primitive + (x y : L) (hx0 : x ≠ 0) (hy0 : y ≠ 0) + (hxMap : algebraMap (RatFunc K) L RatFunc.X = x) + (hprimitive : IntermediateField.adjoin (RatFunc K) {y} = ⊤) + (hxHeight : finiteExtensionHeight K L x = + Module.finrank (RatFunc K) L) + (hxInfinity : ∀ P : FiniteExtensionInfinityPlace K L, + 0 < finiteExtensionPoleDivisor K L x (.inr P)) : + ∀ (q : FiniteExtensionFinitePlace K L) (N : ℕ), + N * finiteExtensionPlaceDegree K L (.inl q) + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L (.inl q) N) + + ((Module.finrank (RatFunc K) L - 1) * + finiteExtensionHeight K L y + 1) := by + intro q N + let g := (Module.finrank (RatFunc K) L - 1) * + finiteExtensionHeight K L y + 1 + have hinfinity := infinitySupported_riemann_lower_of_primitive + K L x y hx0 hy0 hxMap hprimitive hxHeight hxInfinity + by_cases hN : N = 0 + · subst N + have hzero := hinfinity + (0 : FiniteExtensionDivisor K L) (by simp) (by simp) + have hdegreezero : + finiteExtensionDivisorDegree K L + (0 : FiniteExtensionDivisor K L) = 0 := by + simp [finiteExtensionDivisorDegree] + rw [hdegreezero] at hzero + simp only [Int.toNat_zero, zero_add] at hzero + simp only [zero_mul, zero_add] + change 1 ≤ Module.finrank K + (finiteExtensionRiemannSpace K L (Finsupp.single (.inl q) 0)) + g + rw [Finsupp.single_zero] + simpa only [g] using hzero + · have hNpos : 0 < N := Nat.pos_of_ne_zero hN + obtain ⟨E, hE, hEfinite, hrank⟩ := + exists_infinityDivisor_finitePlacePrincipalParts_rank K L q N hNpos + have hEinfinity : + (finiteExtensionDivisorDegree K L E).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + g := by + simpa only [g] using hinfinity E hE hEfinite + let Dq : FiniteExtensionDivisor K L := + Finsupp.single (.inl q) (N : ℤ) + have hDq : ∀ v, 0 ≤ Dq v := by + intro v + by_cases hv : v = (.inl q : FiniteExtensionPlace K L) + · subst v + simp [Dq] + · simp [Dq, Finsupp.single_eq_of_ne hv] + letI : Module.Finite K (finiteExtensionRiemannSpace K L Dq) := + finiteExtensionRiemannSpace_effective_moduleFinite K L Dq hDq + have hstrip := finiteExtensionRiemannSpace_add_effective + K L Dq E hDq hE + change N * finiteExtensionPlaceDegree K L (.inl q) + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L Dq) + g + have hDqEq : Dq = Finsupp.single (.inl q) (N : ℤ) := rfl + rw [← hDqEq] at hrank + omega + +/-- Every finite separable extension of `K(X)` admits a single natural-number +budget for Riemann's inequality at all of its finite places. The budget is +constructed from a nonzero primitive element; no genus or Riemann--Roch input +is assumed. -/ +theorem exists_finitePlace_riemann_lower_budget : + ∃ g : ℕ, ∀ (q : FiniteExtensionFinitePlace K L) (N : ℕ), + N * finiteExtensionPlaceDegree K L (.inl q) + 1 ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L (.inl q) N) + g := by + let x : L := algebraMap (RatFunc K) L RatFunc.X + obtain ⟨y, hy0, hprimitive⟩ := exists_nonzero_primitive_element K L + let g := (Module.finrank (RatFunc K) L - 1) * + finiteExtensionHeight K L y + 1 + refine ⟨g, ?_⟩ + have hx0 : x ≠ 0 := by + dsimp only [x] + simpa using (algebraMap (RatFunc K) L).injective.ne RatFunc.X_ne_zero + have hxInfinity : ∀ P : FiniteExtensionInfinityPlace K L, + 0 < finiteExtensionPoleDivisor K L x (.inr P) := by + intro P + dsimp only [x] + rw [finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx] + exact_mod_cast P.1.ramificationIdx_pos (RatFuncInfinityIntegers K) + simpa only [g] using + finitePlace_riemann_lower_of_primitive K L x y hx0 hy0 rfl + hprimitive (finiteExtensionHeight_ratFuncX_eq_finrank K L) hxInfinity + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean new file mode 100644 index 0000000000..b23ad08769 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean @@ -0,0 +1,233 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import Mathlib.Tactic + +/-! +# A square-field Stepanov bound for arbitrary function fields + +The one-point Stepanov construction is intrinsic to a finite separable +extension of a rational function field. This file applies it to the complete +type of degree-one places, rather than to the regular affine points of a +chosen plane model. + +Choose one rational place as the pole. Every rational finite place away from +it is a zero-counting place; at most one rational finite place is omitted. +The rational places above infinity contribute at most the degree of the +function-field extension, by the fundamental ramification-inertia equality. +This gives a uniform estimate suitable for the Frobenius fixed-field twists. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +local instance generalSquareFieldConstantAlgebra : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + +local instance generalSquareFieldConstantTower : + IsScalarTower S (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance generalSquareFieldInfinityModuleFinite : + Module.Finite (RatFuncInfinityIntegers S) + (RatFuncInfinityIntegralClosure S L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers S) (RatFunc S) L + (RatFuncInfinityIntegralClosure S L) + +local instance generalSquareFieldInfinityIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers S) + (RatFuncInfinityIntegralClosure S L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers S) L + +local instance generalSquareFieldInfinityTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers S) + (RatFuncInfinityIntegralClosure S L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers S) L + +local instance generalSquareFieldInfinityDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure S L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers S) + (RatFunc S) L (RatFuncInfinityIntegralClosure S L) + +omit [Fintype S] in +/-- The number of rational places above infinity is at most the function-field +degree. -/ +theorem rationalInfinityPlace_card_le_finrank : + Nat.card (FiniteExtensionRationalInfinityPlace S L) ≤ + Module.finrank (RatFunc S) L := by + letI : Fintype (FiniteExtensionInfinityPlace S L) := + Set.Finite.fintype (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace S).asIdeal + (RatFuncInfinityIntegralClosure S L)) + calc + Nat.card (FiniteExtensionRationalInfinityPlace S L) ≤ + Nat.card (FiniteExtensionInfinityPlace S L) := + Nat.card_le_card_of_injective Subtype.val Subtype.val_injective + _ = Fintype.card (FiniteExtensionInfinityPlace S L) := + Nat.card_eq_fintype_card + _ = ∑ P : FiniteExtensionInfinityPlace S L, 1 := by simp + _ ≤ ∑ P : FiniteExtensionInfinityPlace S L, + P.1.ramificationIdx (RatFuncInfinityIntegers S) * + P.1.inertiaDeg (RatFuncInfinityIntegers S) := by + apply Finset.sum_le_sum + intro P _ + exact Right.one_le_mul + (Ideal.ramificationIdx_pos P.1 (RatFuncInfinityIntegers S)) + (Ideal.inertiaDeg_pos P.1 (RatFuncInfinityIntegers S)) + _ = Module.finrank (RatFunc S) L := + finiteExtensionInfinity_sum_ramification_inertia_eq_finrank S L + +/-- The intrinsic one-point square-field Stepanov bound for all degree-one +places of a finite separable function field, using Riemann's inequality only +at rational finite places. + +If a rational finite place exists, it is chosen as the pole in the Stepanov +construction. If none exists, all rational places lie above infinity and the +fundamental ramification--inertia equality gives the required bound directly. +Thus no Riemann inequality at an infinity place is needed. -/ +theorem finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann + (g : Nat) + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hconstants : algebraicClosure S L = ⊥) + (hriemann : ∀ (Q : FiniteExtensionRationalFinitePlace S L) N, + N + 1 ≤ Module.finrank S + (finiteExtensionOnePointRiemannSpace S L (.inl Q.1) N) + g) + (hlarge : (g + 1) * (g + 2) ≤ Fintype.card K) : + finiteExtensionRationalPlaceCount S L ≤ + Fintype.card S + (2 * g + 1) * Fintype.card K + + Module.finrank (RatFunc S) L := by + classical + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM g s + have hs : 0 < s := Fintype.card_pos + have hbudget : ell + s * m + 1 = + Fintype.card S + (2 * g + 1) * s := by + calc + ell + s * m + 1 = (s - 1) + s * (s + 2 * g) + 1 := by + rfl + _ = s + s * (s + 2 * g) := by omega + _ = s ^ 2 + (2 * g + 1) * s := by ring + _ = Fintype.card S + (2 * g + 1) * s := by rw [hcard] + by_cases hnonempty : + Nonempty (FiniteExtensionRationalFinitePlace S L) + · let Q0 : FiniteExtensionRationalFinitePlace S L := + Classical.choice hnonempty + let P : FiniteExtensionPlace S L := .inl Q0.1 + have hdegreeP : finiteExtensionPlaceDegree S L P = 1 := Q0.2 + obtain ⟨u, du, v, dv, c, hu, hv, _hc, hsecond, hfirst⟩ := + exists_squareField_onePointStepanovAuxiliary_of_degree_one + K S L P g hconstants hdegreeP (hriemann Q0) hlarge + let p : FiniteExtensionRationalFinitePlace S L → Prop := fun Q => + (Sum.inl Q.1 : FiniteExtensionPlace S L) = P + let Away := {Q : FiniteExtensionRationalFinitePlace S L // ¬ p Q} + letI : Fintype Away := Fintype.ofFinite _ + let place : Away → FiniteExtensionFinitePlace S L := fun Q => Q.1.1 + have hplaceInjective : Function.Injective place := by + intro Q R hQR + apply Subtype.ext + apply Subtype.ext + exact hQR + have haway : ∀ Q : Away, + (Sum.inl (place Q) : FiniteExtensionPlace S L) ≠ P := by + intro Q + exact Q.2 + have hsquare : ∀ (Q : Away) (z : (place Q).asIdeal.ResidueField), + z ^ (Fintype.card K) ^ 2 = z := by + intro Q + exact finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_one + K S L hcard (place Q) Q.1.2 + have hAway : Nat.card Away ≤ ell + s * m := by + have h := Fintype.card_le_of_squareFieldStepanovAuxiliary + K S L P ell m u du v dv c hu hv hdegreeP place + hplaceInjective haway hsquare hsecond hfirst + simpa only [Nat.card_eq_fintype_card] using h + have hpSubsingleton : Subsingleton + {Q : FiniteExtensionRationalFinitePlace S L // p Q} := by + constructor + intro Q R + apply Subtype.ext + apply Subtype.ext + exact Sum.inl.inj (Q.2.trans R.2.symm) + have hpCard : Nat.card + {Q : FiniteExtensionRationalFinitePlace S L // p Q} ≤ 1 := by + letI := hpSubsingleton + simpa using Nat.card_le_card_of_injective + (fun _ : {Q : FiniteExtensionRationalFinitePlace S L // p Q} => + (Unit.unit : Unit)) + (fun Q R _ => Subsingleton.elim Q R) + have hfinite : Nat.card (FiniteExtensionRationalFinitePlace S L) ≤ + ell + s * m + 1 := by + calc + Nat.card (FiniteExtensionRationalFinitePlace S L) = + Nat.card + ({Q : FiniteExtensionRationalFinitePlace S L // p Q} ⊕ Away) := + Nat.card_congr (Equiv.sumCompl p).symm + _ = Nat.card + {Q : FiniteExtensionRationalFinitePlace S L // p Q} + + Nat.card Away := Nat.card_sum + _ ≤ 1 + (ell + s * m) := Nat.add_le_add hpCard hAway + _ = ell + s * m + 1 := by omega + rw [finiteExtensionRationalPlaceCount, Nat.card_sum] + calc + Nat.card (FiniteExtensionRationalFinitePlace S L) + + Nat.card (FiniteExtensionRationalInfinityPlace S L) ≤ + (ell + s * m + 1) + Module.finrank (RatFunc S) L := + Nat.add_le_add hfinite (rationalInfinityPlace_card_le_finrank S L) + _ = Fintype.card S + (2 * g + 1) * Fintype.card K + + Module.finrank (RatFunc S) L := by rw [hbudget] + · letI : IsEmpty (FiniteExtensionRationalFinitePlace S L) := + ⟨fun Q => hnonempty ⟨Q⟩⟩ + rw [finiteExtensionRationalPlaceCount, Nat.card_sum] + simp only [Nat.card_of_isEmpty, zero_add] + exact (rationalInfinityPlace_card_le_finrank S L).trans + (Nat.le_add_left (Module.finrank (RatFunc S) L) + (Fintype.card S + (2 * g + 1) * Fintype.card K)) + +/-- The intrinsic one-point square-field Stepanov bound for all degree-one +places of a finite separable function field. + +This compatibility wrapper preserves the original API. Its stronger +hypothesis supplies the finite-place Riemann inequalities required by +`finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann`. +-/ +theorem finiteExtensionRationalPlaceCount_le_squareFieldStepanov + (g : Nat) + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hconstants : algebraicClosure S L = ⊥) + (hriemann : ∀ (P : FiniteExtensionPlace S L), + finiteExtensionPlaceDegree S L P = 1 → ∀ N, + N + 1 ≤ Module.finrank S + (finiteExtensionOnePointRiemannSpace S L P N) + g) + (hlarge : (g + 1) * (g + 2) ≤ Fintype.card K) : + finiteExtensionRationalPlaceCount S L ≤ + Fintype.card S + (2 * g + 1) * Fintype.card K + + Module.finrank (RatFunc S) L := by + apply finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann + K S L g hcard hconstants _ hlarge + intro Q N + exact hriemann (.inl Q.1) Q.2 N + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean new file mode 100644 index 0000000000..8dfd935327 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean @@ -0,0 +1,65 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount + +/-! +# Automatic intrinsic Stepanov bounds + +The arbitrary-function-field Stepanov theorem asks only for a finite-place +Riemann budget. The primitive-element construction supplies such a budget +for every finite separable function field. This file composes those results, +leaving only the explicit large-square-field inequality for the constructed +budget. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +local instance automaticSquareFieldConstantAlgebra : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + +local instance automaticSquareFieldConstantTower : + IsScalarTower S (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Every finite separable function field with exact constants has an +intrinsic Stepanov budget. Once the half-sized field is large relative to +that constructed budget, its complete degree-one place count satisfies the +square-field upper bound. -/ +theorem exists_squareFieldStepanov_budget + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hconstants : algebraicClosure S L = ⊥) : + ∃ g : ℕ, + (g + 1) * (g + 2) ≤ Fintype.card K → + finiteExtensionRationalPlaceCount S L ≤ + Fintype.card S + (2 * g + 1) * Fintype.card K + + Module.finrank (RatFunc S) L := by + obtain ⟨g, hriemann⟩ := exists_finitePlace_riemann_lower_budget S L + refine ⟨g, fun hlarge => ?_⟩ + apply + finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann + K S L g hcard hconstants _ hlarge + intro Q N + have h := hriemann Q.1 N + simpa only [Q.2, Nat.mul_one] using h + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean new file mode 100644 index 0000000000..ccfbf52d1a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean @@ -0,0 +1,58 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.RamificationInertia.Ramification + +/-! +# Multiplicity after extending an ideal + +The `emultiplicity` theorem in mathlib is the generic local factorization +statement. This file records the `Nat`-valued wrapper used by the +exact-constant genus transport, first for a specified pair of height-one +places and then with the lower place chosen by `under`. +-/ + +open IsDedekindDomain + +namespace BGS.HasseWeil + +noncomputable section + +variable {R S : Type*} [CommRing R] [CommRing S] + [IsDedekindDomain R] [IsDedekindDomain S] + [Algebra R S] [Module.IsTorsionFree R S] + +/-- Extending a nonzero ideal multiplies its multiplicity at a height-one +prime by the ramification index of that prime. -/ +theorem multiplicity_map_eq_ramificationIdx_mul + (v : HeightOneSpectrum R) (w : HeightOneSpectrum S) + [w.asIdeal.LiesOver v.asIdeal] + (I : Ideal R) (hI : I ≠ ⊥) : + multiplicity w.asIdeal (I.map (algebraMap R S)) = + w.asIdeal.ramificationIdx R * multiplicity v.asIdeal I := by + refine multiplicity_eq_of_emultiplicity_eq_some ?_ + rw [Ideal.IsDedekindDomain.emultiplicity_map_eq_ramificationIdx'_mul + hI v.irreducible w.irreducible w.ne_bot, + Ideal.ramificationIdx'_eq_ramificationIdx v.asIdeal w.asIdeal v.ne_bot, + Nat.cast_mul, + (FiniteMultiplicity.of_prime_left v.prime hI).emultiplicity_eq_multiplicity] + +variable [Algebra.IsIntegral R S] + +/-- The same formula with the lower place chosen canonically by contraction. -/ +theorem multiplicity_map_eq_ramificationIdx_mul_under + (w : HeightOneSpectrum S) (I : Ideal R) (hI : I ≠ ⊥) : + multiplicity w.asIdeal (I.map (algebraMap R S)) = + w.asIdeal.ramificationIdx R * + multiplicity (w.under R).asIdeal I := by + letI : w.asIdeal.LiesOver (w.under R).asIdeal := ⟨rfl⟩ + simpa using + multiplicity_map_eq_ramificationIdx_mul + (R := R) (S := S) (w.under R) w I hI + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean new file mode 100644 index 0000000000..4220d78fb5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.LinearAlgebra.Basis.VectorSpace +import Mathlib.LinearAlgebra.LinearPMap + +/-! +# Gluing and extending linear functionals + +This file isolates the linear-algebra step used by the cotrace construction +of a Weil functional. A functional on a subspace `U` which vanishes on +`U ∩ V` glues with the zero functional on `V`; over a field the glued +functional then extends to the ambient vector space. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable {k E F : Type*} [Field k] + [AddCommGroup E] [Module k E] + [AddCommGroup F] [Module k F] + +/-- A linear map on `U` which vanishes whenever its argument also lies in +`V` extends to the ambient space while vanishing on all of `V`. -/ +theorem exists_linearMap_extending_eq_zero_on + (U V : Submodule k E) (f : U →ₗ[k] F) + (hUV : ∀ x : U, (x : E) ∈ V → f x = 0) : + ∃ g : E →ₗ[k] F, g.comp U.subtype = f ∧ V ≤ LinearMap.ker g := by + let pf : LinearPMap (RingHom.id k) E F := ⟨U, f⟩ + let pzero : LinearPMap (RingHom.id k) E F := ⟨V, 0⟩ + have hagree : ∀ (x : pf.domain) (y : pzero.domain), + (x : E) = y → pf x = pzero y := by + intro x y hxy + change f x = 0 + apply hUV x + exact hxy ▸ y.property + let glued := pf.sup pzero hagree + obtain ⟨g, hg⟩ := LinearMap.exists_extend glued.toFun + refine ⟨g, ?_, ?_⟩ + · apply LinearMap.ext + intro x + let x' : glued.domain := ⟨x, Submodule.mem_sup_left x.property⟩ + have hpf := (pf.left_le_sup pzero hagree).2 + (x := x) (y := x') rfl + have hgx := LinearMap.congr_fun hg x' + exact hgx.trans hpf.symm + · intro x hx + rw [LinearMap.mem_ker] + let x' : glued.domain := ⟨x, Submodule.mem_sup_right hx⟩ + have hpzero := (pf.right_le_sup pzero hagree).2 + (x := ⟨x, hx⟩) (y := x') rfl + have hgx := LinearMap.congr_fun hg x' + exact hgx.trans (hpzero.symm.trans (by rfl)) + +/-- Intersection-subtype form of +`exists_linearMap_extending_eq_zero_on`. -/ +theorem exists_linearMap_extending_eq_zero_on_inf + (U V : Submodule k E) (f : U →ₗ[k] F) + (hUV : ∀ x : ↥(U ⊓ V), f ⟨x, x.property.1⟩ = 0) : + ∃ g : E →ₗ[k] F, g.comp U.subtype = f ∧ V ≤ LinearMap.ker g := by + apply exists_linearMap_extending_eq_zero_on U V f + intro x hx + exact hUV ⟨x, x.property, hx⟩ + +/-- If the original functional is nonzero, the ambient extension can be +chosen nonzero as well. -/ +theorem exists_ne_zero_linearMap_extending_eq_zero_on_inf + (U V : Submodule k E) (f : U →ₗ[k] F) + (hUV : ∀ x : ↥(U ⊓ V), f ⟨x, x.property.1⟩ = 0) + (hf : f ≠ 0) : + ∃ g : E →ₗ[k] F, + g.comp U.subtype = f ∧ V ≤ LinearMap.ker g ∧ g ≠ 0 := by + obtain ⟨g, hgU, hgV⟩ := + exists_linearMap_extending_eq_zero_on_inf U V f hUV + refine ⟨g, hgU, hgV, ?_⟩ + intro hg + apply hf + rw [← hgU, hg] + rfl + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean new file mode 100644 index 0000000000..f6484c7d61 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean @@ -0,0 +1,211 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +import Mathlib.RingTheory.LocalRing.Length +import Mathlib.RingTheory.LocalRing.Quotient + +/-! +# Cumulative local principal parts + +For a DVR uniformizer `π`, the quotient of functions with pole order at most +`n` by the regular functions is the quotient of the DVR by the `n`th power +of its maximal ideal. Over a finite constant field its dimension is +therefore `n` times the residue-field degree. +-/ + +namespace BGS.HasseWeil + +open scoped nonZeroDivisors + +noncomputable section + +variable {K R L : Type*} [Field K] [CommRing R] + [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Field L] [Algebra K R] [Algebra R L] [Algebra K L] + [IsScalarTower K R L] [IsFractionRing R L] + +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] + [IsFractionRing R L] in +private theorem cumulativeLocalPoleSpace_regular (π : R) (n : ℕ) : + ∀ x : localPoleSpace (K := K) (L := L) π n, + ∃ r : R, algebraMap R L (π ^ n) * x.1 = algebraMap R L r := by + intro x + exact x.2 + +/-- The normalized numerator modulo the `n`th power of the maximal ideal. -/ +def localPolePrincipalPartMap (π : R) (n : ℕ) : + localPoleSpace (K := K) (L := L) π n →ₗ[K] + R ⧸ IsLocalRing.maximalIdeal R ^ n := + (Ideal.Quotient.mkₐ K (IsLocalRing.maximalIdeal R ^ n)).toLinearMap.comp + (localNormalizedLiftLinearMap + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n)) + +theorem localPolePrincipalPartMap_surjective + (π : R) (hπ : π ≠ 0) (n : ℕ) : + Function.Surjective + (localPolePrincipalPartMap (K := K) (L := L) π n) := by + intro z + obtain ⟨r, rfl⟩ := Ideal.Quotient.mk_surjective z + have hdenom : algebraMap R L (π ^ n) ≠ 0 := by + rw [map_pow] + exact pow_ne_zero n (by + simpa using (IsFractionRing.injective R L).ne hπ) + let x : L := (algebraMap R L (π ^ n))⁻¹ * algebraMap R L r + have hx : algebraMap R L (π ^ n) * x = algebraMap R L r := by + dsimp only [x] + rw [← mul_assoc, mul_inv_cancel₀ hdenom, one_mul] + let x' : localPoleSpace (K := K) (L := L) π n := ⟨x, r, hx⟩ + refine ⟨x', ?_⟩ + change Ideal.Quotient.mk (IsLocalRing.maximalIdeal R ^ n) + (localNormalizedLift + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x') = + Ideal.Quotient.mk (IsLocalRing.maximalIdeal R ^ n) r + congr 1 + apply IsFractionRing.injective R L + rw [← hx] + exact (localNormalizedLift_spec + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x').symm + +theorem localPolePrincipalPartMap_ker + (π : R) (hπ : π ≠ 0) + (hπIdeal : IsLocalRing.maximalIdeal R = Ideal.span {π}) (n : ℕ) : + (localPolePrincipalPartMap (K := K) (L := L) π n).ker = + Submodule.comap + (localPoleSpace (K := K) (L := L) π n).subtype + (localPoleSpace (K := K) (L := L) π 0) := by + ext x + rw [LinearMap.mem_ker, Submodule.mem_comap] + change Ideal.Quotient.mk (IsLocalRing.maximalIdeal R ^ n) + (localNormalizedLift + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x) = 0 ↔ _ + rw [Ideal.Quotient.eq_zero_iff_mem] + constructor + · intro hr + rw [hπIdeal, Ideal.span_singleton_pow, + Ideal.mem_span_singleton] at hr + obtain ⟨s, hs⟩ := hr + rw [mem_localPoleSpace_iff] + refine ⟨s, ?_⟩ + simp only [pow_zero, map_one, one_mul] + have hlift := localNormalizedLift_spec + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x + rw [hs, map_mul] at hlift + have hdenom : algebraMap R L (π ^ n) ≠ 0 := by + rw [map_pow] + exact pow_ne_zero n (by + simpa using (IsFractionRing.injective R L).ne hπ) + apply mul_left_cancel₀ hdenom + exact hlift + · rintro ⟨s, hs⟩ + have hliftEq : localNormalizedLift + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x = + π ^ n * s := by + apply IsFractionRing.injective R L + rw [map_mul, ← hs] + simp only [pow_zero, map_one, one_mul] + change algebraMap R L + (localNormalizedLift + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x) = + algebraMap R L (π ^ n) * x.1 + exact (localNormalizedLift_spec + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n) x).symm + rw [hliftEq, hπIdeal, Ideal.span_singleton_pow, + Ideal.mem_span_singleton] + exact ⟨s, rfl⟩ + +/-- Cumulative local principal parts are the quotient by the corresponding +power of the maximal ideal. -/ +def localPoleCumulativeQuotientEquiv + (π : R) (hπ : π ≠ 0) + (hπIdeal : IsLocalRing.maximalIdeal R = Ideal.span {π}) (n : ℕ) : + (localPoleSpace (K := K) (L := L) π n ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π n).subtype + (localPoleSpace (K := K) (L := L) π 0)) ≃ₗ[K] + R ⧸ IsLocalRing.maximalIdeal R ^ n := by + let f := localPolePrincipalPartMap (K := K) (L := L) π n + have hsurj : Function.Surjective f := + localPolePrincipalPartMap_surjective (K := K) (L := L) π hπ n + have hker := localPolePrincipalPartMap_ker + (K := K) (L := L) π hπ hπIdeal n + rw [← hker] + exact f.quotKerEquivOfSurjective hsurj + +/-- Over a finite constant field, allowing poles through order `n` creates +exactly `n` copies of the local residue field. -/ +theorem localPoleCumulativeQuotient_finrank + [Fintype K] (π : R) (hπ : π ≠ 0) + (hπIdeal : IsLocalRing.maximalIdeal R = Ideal.span {π}) (n : ℕ) + [Finite (IsLocalRing.ResidueField R)] : + Module.finrank K + (localPoleSpace (K := K) (L := L) π n ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π n).subtype + (localPoleSpace (K := K) (L := L) π 0)) = + n * Module.finrank K (IsLocalRing.ResidueField R) := by + let I := IsLocalRing.maximalIdeal R ^ n + letI : Finite (R ⧸ I) := + IsLocalRing.finite_quotient_iff.mpr ⟨n, le_rfl⟩ + letI : Module.Finite K (R ⧸ I) := Module.Finite.of_finite + letI : Module.Finite K (IsLocalRing.ResidueField R) := + Module.Finite.of_finite + have hlocalLength : Module.length R (R ⧸ I) = n := by + exact IsDiscreteValuationRing.length_quotient_pow_maximalIdeal R n + have hbaseRank : Module.finrank K (IsLocalRing.ResidueField K) = 1 := by + rw [Algebra.finrank_eq_one_iff_bijective_algebraMap] + exact ⟨(algebraMap K (IsLocalRing.ResidueField K)).injective, + Ideal.Quotient.mk_surjective⟩ + have hresidueLength : + Module.length (IsLocalRing.ResidueField K) + (IsLocalRing.ResidueField R) = + Module.finrank K (IsLocalRing.ResidueField R) := by + rw [Module.length_eq_finrank] + have hresidueRank : + Module.finrank (IsLocalRing.ResidueField K) + (IsLocalRing.ResidueField R) = + Module.finrank K (IsLocalRing.ResidueField R) := by + calc + Module.finrank (IsLocalRing.ResidueField K) + (IsLocalRing.ResidueField R) = + 1 * Module.finrank (IsLocalRing.ResidueField K) + (IsLocalRing.ResidueField R) := by simp + _ = Module.finrank K (IsLocalRing.ResidueField K) * + Module.finrank (IsLocalRing.ResidueField K) + (IsLocalRing.ResidueField R) := by rw [hbaseRank] + _ = Module.finrank K (IsLocalRing.ResidueField R) := + Module.finrank_mul_finrank K (IsLocalRing.ResidueField K) + (IsLocalRing.ResidueField R) + exact_mod_cast hresidueRank + rw [(localPoleCumulativeQuotientEquiv + (K := K) (L := L) π hπ hπIdeal n).finrank_eq] + change Module.finrank K (R ⧸ I) = _ + have hlength : Module.length K (R ⧸ I) = + n * Module.finrank K (IsLocalRing.ResidueField R) := by + rw [IsLocalRing.length_restrictScalars K R (R ⧸ I), + hlocalLength, hresidueLength] + rw [Module.length_eq_finrank] at hlength + exact_mod_cast hlength + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean new file mode 100644 index 0000000000..c00ef8227b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean @@ -0,0 +1,222 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +import Mathlib.LinearAlgebra.Isomorphisms + +/-! +# The local pole filtration of a discrete valuation ring + +This file isolates the exact local calculation behind principal parts. If +`R` is a discrete valuation ring in its fraction field `L` and `π` is a +uniformizer, the functions whose pole order is at most `n` form a +`K`-submodule of `L`. Consecutive levels have quotient equal to the residue +field of `R`. + +Unlike the corresponding global Riemann-space increment, this calculation is +an equality: locally every leading residue has a lift. +-/ + +namespace BGS.HasseWeil + +open scoped nonZeroDivisors + +noncomputable section + +variable {K R L : Type*} [Field K] [CommRing R] + [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Field L] [Algebra K R] [Algebra R L] [Algebra K L] + [IsScalarTower K R L] [IsFractionRing R L] + +/-- The local functions whose denominator is bounded by `π ^ n`. -/ +def localPoleSpace (π : R) (n : ℕ) : Submodule K L where + carrier := {x | ∃ r : R, algebraMap R L (π ^ n) * x = algebraMap R L r} + zero_mem' := ⟨0, by simp⟩ + add_mem' := by + rintro x y ⟨rx, hx⟩ ⟨ry, hy⟩ + refine ⟨rx + ry, ?_⟩ + rw [map_add, ← hx, ← hy] + ring + smul_mem' := by + rintro c x ⟨r, hr⟩ + refine ⟨c • r, ?_⟩ + rw [show algebraMap R L (c • r) = c • algebraMap R L r by + exact map_smul (IsScalarTower.toAlgHom K R L) c r] + simp only [Algebra.smul_def] + rw [← hr] + ring + +theorem mem_localPoleSpace_iff (π : R) (n : ℕ) (x : L) : + x ∈ localPoleSpace (K := K) (L := L) π n ↔ + ∃ r : R, algebraMap R L (π ^ n) * x = algebraMap R L r := + Iff.rfl + +/-- Increasing the allowed pole order enlarges the local pole space. -/ +theorem localPoleSpace_mono (π : R) (n : ℕ) : + localPoleSpace (K := K) (L := L) π n ≤ + localPoleSpace (K := K) (L := L) π (n + 1) := by + rintro x ⟨r, hr⟩ + refine ⟨π * r, ?_⟩ + calc + algebraMap R L (π ^ (n + 1)) * x = + algebraMap R L π * (algebraMap R L (π ^ n) * x) := by + rw [pow_succ, map_mul] + ring + _ = algebraMap R L π * algebraMap R L r := congrArg _ hr + _ = algebraMap R L (π * r) := by rw [map_mul] + +private theorem localPoleSpace_regular + (π : R) (n : ℕ) : + ∀ x : localPoleSpace (K := K) (L := L) π n, + ∃ r : R, algebraMap R L (π ^ n) * x.1 = algebraMap R L r := by + intro x + exact x.2 + +/-- The leading-residue map on the `n`th local pole space. -/ +def localPoleLeadingResidueMap (π : R) (n : ℕ) : + localPoleSpace (K := K) (L := L) π n →ₗ[K] + IsLocalRing.ResidueField R := + localLeadingResidueLinearMap + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (localPoleSpace_regular (K := K) (L := L) π n) + +private theorem localPoleNormalizedLift_eq + (π : R) (n : ℕ) + (x : localPoleSpace (K := K) (L := L) π n) (r : R) + (hr : algebraMap R L (π ^ n) * x.1 = algebraMap R L r) : + localNormalizedLift + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (localPoleSpace_regular (K := K) (L := L) π n) x = r := by + apply IsFractionRing.injective R L + rw [← hr] + exact (localNormalizedLift_spec + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (localPoleSpace_regular (K := K) (L := L) π n) x).symm + +/-- Every residue class occurs as a leading coefficient. -/ +theorem localPoleLeadingResidueMap_surjective + (π : R) (hπ : π ≠ 0) (n : ℕ) : + Function.Surjective + (localPoleLeadingResidueMap (K := K) (L := L) π n) := by + intro z + obtain ⟨r, hr⟩ := + (Ideal.Quotient.mk_surjective + (I := IsLocalRing.maximalIdeal R)) z + let πL : L := algebraMap R L π + have hπL : πL ≠ 0 := by + simpa [πL] using (IsFractionRing.injective R L).ne hπ + let x : L := (algebraMap R L (π ^ n))⁻¹ * algebraMap R L r + have hdenom : algebraMap R L (π ^ n) ≠ 0 := by + rw [map_pow] + exact pow_ne_zero n hπL + have hx : algebraMap R L (π ^ n) * x = algebraMap R L r := by + dsimp only [x] + rw [← mul_assoc, mul_inv_cancel₀ hdenom, one_mul] + let x' : localPoleSpace (K := K) (L := L) π n := ⟨x, r, hx⟩ + refine ⟨x', ?_⟩ + change Ideal.Quotient.mk (IsLocalRing.maximalIdeal R) + (localNormalizedLift + (localPoleSpace (K := K) (L := L) π n) + (algebraMap R L (π ^ n)) + (localPoleSpace_regular (K := K) (L := L) π n) x') = z + rw [localPoleNormalizedLift_eq (K := K) (L := L) π n x' r hx] + exact hr + +/-- The kernel of the leading-residue map is the preceding local pole +space. -/ +theorem localPoleLeadingResidueMap_ker + (π : R) (hπ : π ≠ 0) + (hπIdeal : (IsDiscreteValuationRing.maximalIdeal R).asIdeal = + Ideal.span {π}) (n : ℕ) : + (localPoleLeadingResidueMap (K := K) (L := L) π (n + 1)).ker = + Submodule.comap + (localPoleSpace (K := K) (L := L) π (n + 1)).subtype + (localPoleSpace (K := K) (L := L) π n) := by + ext x + rw [LinearMap.mem_ker, Submodule.mem_comap] + rw [localPoleLeadingResidueMap, localLeadingResidueLinearMap_eq_zero_iff] + constructor + · intro hx + change localNormalizedLift + (localPoleSpace (K := K) (L := L) π (n + 1)) + (algebraMap R L (π ^ (n + 1))) + (localPoleSpace_regular (K := K) (L := L) π (n + 1)) x ∈ + (IsDiscreteValuationRing.maximalIdeal R).asIdeal at hx + rw [hπIdeal, Ideal.mem_span_singleton] at hx + obtain ⟨s, hs⟩ := hx + refine ⟨s, ?_⟩ + have hlift := localNormalizedLift_spec + (localPoleSpace (K := K) (L := L) π (n + 1)) + (algebraMap R L (π ^ (n + 1))) + (localPoleSpace_regular (K := K) (L := L) π (n + 1)) x + rw [hs] at hlift + have hπL : algebraMap R L π ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hπ + apply mul_left_cancel₀ hπL + calc + algebraMap R L π * (algebraMap R L (π ^ n) * x.1) = + algebraMap R L (π ^ (n + 1)) * x.1 := by + rw [pow_succ, map_mul] + ring + _ = algebraMap R L (π * s) := hlift + _ = algebraMap R L π * algebraMap R L s := by rw [map_mul] + · rintro ⟨s, hs⟩ + have hliftEq : localNormalizedLift + (localPoleSpace (K := K) (L := L) π (n + 1)) + (algebraMap R L (π ^ (n + 1))) + (localPoleSpace_regular (K := K) (L := L) π (n + 1)) x = π * s := by + apply localPoleNormalizedLift_eq + calc + algebraMap R L (π ^ (n + 1)) * x.1 = + algebraMap R L π * (algebraMap R L (π ^ n) * x.1) := by + rw [pow_succ, map_mul] + ring + _ = algebraMap R L π * algebraMap R L s := congrArg _ hs + _ = algebraMap R L (π * s) := by rw [map_mul] + rw [hliftEq] + change π * s ∈ (IsDiscreteValuationRing.maximalIdeal R).asIdeal + rw [hπIdeal, Ideal.mem_span_singleton] + exact ⟨s, rfl⟩ + +/-- Consecutive local pole spaces have quotient the residue field. -/ +noncomputable def localPoleQuotientEquivResidueField + (π : R) (hπ : π ≠ 0) + (hπIdeal : (IsDiscreteValuationRing.maximalIdeal R).asIdeal = + Ideal.span {π}) (n : ℕ) : + (localPoleSpace (K := K) (L := L) π (n + 1) ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π (n + 1)).subtype + (localPoleSpace (K := K) (L := L) π n)) ≃ₗ[K] + IsLocalRing.ResidueField R := by + let f := localPoleLeadingResidueMap (K := K) (L := L) π (n + 1) + have hsurj : Function.Surjective f := + localPoleLeadingResidueMap_surjective (K := K) (L := L) π hπ (n + 1) + have hker := localPoleLeadingResidueMap_ker + (K := K) (L := L) π hπ hπIdeal n + rw [← hker] + exact f.quotKerEquivOfSurjective hsurj + +/-- The exact dimension of one local principal-part layer. -/ +theorem localPoleQuotient_finrank + (π : R) (hπ : π ≠ 0) + (hπIdeal : (IsDiscreteValuationRing.maximalIdeal R).asIdeal = + Ideal.span {π}) (n : ℕ) + [Module.Finite K (IsLocalRing.ResidueField R)] : + Module.finrank K + (localPoleSpace (K := K) (L := L) π (n + 1) ⧸ + Submodule.comap + (localPoleSpace (K := K) (L := L) π (n + 1)).subtype + (localPoleSpace (K := K) (L := L) π n)) = + Module.finrank K (IsLocalRing.ResidueField R) := + (localPoleQuotientEquivResidueField + (K := K) (L := L) π hπ hπIdeal n).finrank_eq + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean new file mode 100644 index 0000000000..6f0bcb3197 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean @@ -0,0 +1,206 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting + +/-! +# Finiteness of the height-zero one-point Riemann space + +For a finite separable extension `L / K(X)` over a finite field, the functions +regular at every exhaustive place form a finite-dimensional `K`-vector space. + +The proof chooses a branch above infinity and reduces a function modulo that +branch. Every height-zero function has a lift to the corresponding local +ring. If two such functions have the same residue, their difference has +positive order at the chosen branch and nonnegative order everywhere else. +The degree-weighted product formula rules this out unless the difference is +zero. Thus the height-zero space injects into a finite residue field. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance onePointBaseConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance onePointBaseConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance onePointBaseInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance onePointBaseInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance onePointBaseInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance onePointBaseInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance onePointBaseInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance onePointBaseInfinityIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +/-- The height-zero member of the one-point filtration is finite-dimensional +over the finite constant field. -/ +theorem finiteExtensionOnePointRiemannSpace_zero_moduleFinite + (P : FiniteExtensionPlace K L) : + Module.Finite K (finiteExtensionOnePointRiemannSpace K L P 0) := by + let Q : FiniteExtensionInfinityPlace K L := Classical.choice + (inferInstance : Nonempty (FiniteExtensionInfinityPlace K L)) + letI : Algebra (RatFuncInfinityIntegralClosure K L) + (RatFuncInfinityIntegralClosure K L) := + Algebra.id (RatFuncInfinityIntegralClosure K L) + letI : Algebra (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L Q) := + OreLocalization.instAlgebra + let R := FiniteExtensionInfinityPlaceLocalRing K L Q + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) Q + letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) Q + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + (RatFuncInfinityIntegralClosure K L) + (primeOverHeightOne (ratFuncInfinityPlace K) Q).ne_bot R + letI : Finite Q.1.ResidueField := + finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) Q + let V := finiteExtensionOnePointRiemannSpace K L P 0 + have hliftExists : ∀ x : V, ∃ r : R, + (x.1 : L) = finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q r := by + intro x + apply finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) Q x.1 + by_cases hx0 : x.1 = 0 + · simp [finiteExtensionInfinityPlaceLocalOrderTop, hx0] + · rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder Q x.1 hx0] + have hxmem := + (mem_finiteExtensionOnePointRiemannSpace_iff K L P 0 x.1).mp x.2 + rcases hxmem with hxmem | ⟨_, hP, hAway⟩ + · exact (hx0 hxmem).elim + · have hnonneg : + 0 ≤ finiteExtensionPrincipalDivisor K L x.1 (.inr Q) := by + by_cases hQP : (Sum.inr Q : FiniteExtensionPlace K L) = P + · rw [hQP] + simpa using hP + · exact hAway (.inr Q) hQP + exact_mod_cast (by + simpa only [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] + using hnonneg) + let lift : V → R := fun x => Classical.choose (hliftExists x) + have lift_spec (x : V) : + (x.1 : L) = finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q (lift x) := + Classical.choose_spec (hliftExists x) + let residue : V → Q.1.ResidueField := fun x => + IsLocalRing.residue R (lift x) + have hresidueInjective : Function.Injective residue := by + intro x y hxy + apply Subtype.ext + by_contra hne + let r : R := lift x - lift y + have hrResidue : IsLocalRing.residue R r = 0 := by + change IsLocalRing.residue R (lift x) - + IsLocalRing.residue R (lift y) = 0 + exact sub_eq_zero.mpr hxy + have hrMem : r ∈ IsLocalRing.maximalIdeal R := + (IsLocalRing.residue_eq_zero_iff r).mp hrResidue + have hrMap : finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q r = x.1 - y.1 := by + dsimp [r] + calc + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q (lift x - lift y) = + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q (lift x) - + finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q (lift y) := + (finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) Q).map_sub (lift x) (lift y) + _ = x.1 - y.1 := by rw [← lift_spec x, ← lift_spec y] + have hrNe : r ≠ 0 := by + intro hr0 + apply hne + apply sub_eq_zero.mp + rw [← hrMap, hr0, map_zero] + have hrOrder : + (1 : ℤ) ≤ finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L r) := + one_le_finitePlaceOrder_algebraMap_of_mem + (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) r hrMem hrNe + have hQOrder : + 0 < finiteExtensionPrincipalDivisor K L (x.1 - y.1) (.inr Q) := by + rw [finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder, + ← hrMap, ← finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder Q] + change 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) (algebraMap R L r) + omega + have hdNe : x.1 - y.1 ≠ 0 := sub_ne_zero.mpr hne + have hdMem : x.1 - y.1 ∈ V := V.sub_mem x.2 y.2 + have hdOrders : ∀ v : FiniteExtensionPlace K L, + 0 ≤ finiteExtensionPrincipalDivisor K L (x.1 - y.1) v := by + intro v + rcases (mem_finiteExtensionOnePointRiemannSpace_iff + K L P 0 (x.1 - y.1)).mp hdMem with hd0 | ⟨_, hP, hAway⟩ + · exact (hdNe hd0).elim + · by_cases hv : v = P + · rw [hv] + simpa using hP + · exact hAway v hv + have hDegreePos : + 0 < finiteExtensionPrincipalDivisorDegreeSum K L (x.1 - y.1) := by + rw [finiteExtensionPrincipalDivisorDegreeSum] + apply Finsupp.sum_pos' + · intro v _hv + exact mul_nonneg (hdOrders v) (by positivity) + · refine ⟨.inr Q, ?_, ?_⟩ + · exact Finsupp.mem_support_iff.mpr (ne_of_gt hQOrder) + · exact mul_pos hQOrder (by + exact_mod_cast finiteExtensionPlaceDegree_pos K L (.inr Q)) + have hDegreeZero := + finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L (x.1 - y.1) hdNe + omega + letI : Finite V := Finite.of_injective residue hresidueInjective + change Module.Finite K V + infer_instance + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean new file mode 100644 index 0000000000..7bb16b2b41 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +import Mathlib.Tactic + +/-! +# Splitting an effective divisor at one place + +The one-point Stepanov argument starts with a many-pole divisor supplied by +plane monomials, then removes every allowed pole except the distinguished +one. This file records the elementary divisor identities needed for that +comparison. The actual codimension estimate is kept separate. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- Delete the coefficient of `D` at `P`, retaining all other coefficients. -/ +def finiteExtensionDivisorAway + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : + FiniteExtensionDivisor K L := + D - Finsupp.single P (D P) + +@[simp] +theorem finiteExtensionDivisorAway_apply_self + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : + finiteExtensionDivisorAway K L D P P = 0 := by + simp [finiteExtensionDivisorAway] + +@[simp] +theorem finiteExtensionDivisorAway_apply_of_ne + (D : FiniteExtensionDivisor K L) (P v : FiniteExtensionPlace K L) + (hv : v ≠ P) : + finiteExtensionDivisorAway K L D P v = D v := by + simp [finiteExtensionDivisorAway, hv] + +/-- Splitting off the `P` coefficient recovers the original divisor. -/ +theorem single_add_finiteExtensionDivisorAway + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : + Finsupp.single P (D P) + finiteExtensionDivisorAway K L D P = D := by + ext v + by_cases hv : v = P + · subst v + simp + · simp [finiteExtensionDivisorAway, hv] + +/-- Removing one coefficient preserves effectiveness. -/ +theorem finiteExtensionDivisorAway_effective + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) + (hD : ∀ v, 0 ≤ D v) : + ∀ v, 0 ≤ finiteExtensionDivisorAway K L D P v := by + intro v + by_cases hv : v = P + · subst v + simp + · simpa [finiteExtensionDivisorAway, hv] using hD v + +/-- The degree of a divisor supported at one place. -/ +@[simp] +theorem finiteExtensionDivisorDegree_single + (P : FiniteExtensionPlace K L) (z : ℤ) : + finiteExtensionDivisorDegree K L (Finsupp.single P z) = + z * (finiteExtensionPlaceDegree K L P : ℤ) := by + classical + simp [finiteExtensionDivisorDegree] + +/-- Divisor degree changes sign under negation. -/ +theorem finiteExtensionDivisorDegree_neg + (D : FiniteExtensionDivisor K L) : + finiteExtensionDivisorDegree K L (-D) = + -finiteExtensionDivisorDegree K L D := by + have h := finiteExtensionDivisorDegree_add K L D (-D) + rw [add_neg_cancel] at h + have hzero : finiteExtensionDivisorDegree K L (0 : FiniteExtensionDivisor K L) = 0 := by + simp [finiteExtensionDivisorDegree] + rw [hzero] at h + omega + +/-- Divisor degree respects subtraction. -/ +theorem finiteExtensionDivisorDegree_sub + (D E : FiniteExtensionDivisor K L) : + finiteExtensionDivisorDegree K L (D - E) = + finiteExtensionDivisorDegree K L D - + finiteExtensionDivisorDegree K L E := by + rw [sub_eq_add_neg, finiteExtensionDivisorDegree_add, + finiteExtensionDivisorDegree_neg] + rfl + +/-- Degree bookkeeping for the divisor away from the selected place. -/ +theorem finiteExtensionDivisorDegree_away + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : + finiteExtensionDivisorDegree K L (finiteExtensionDivisorAway K L D P) = + finiteExtensionDivisorDegree K L D - + D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + rw [finiteExtensionDivisorAway, finiteExtensionDivisorDegree_sub, + finiteExtensionDivisorDegree_single] + +/-- For an effective divisor, its one-place part is coefficientwise below it. -/ +theorem single_coeff_le_of_effective + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) + (hD : ∀ v, 0 ≤ D v) : + Finsupp.single P (D P) ≤ D := by + intro v + by_cases hv : v = P + · subst v + simp + · simpa [Finsupp.single_eq_of_ne hv] using hD v + +/-- The one-point space using the selected coefficient embeds in the full +Riemann space of an effective divisor. -/ +theorem onePointRiemannSpace_le_of_effective + (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) + (hD : ∀ v, 0 ≤ D v) : + finiteExtensionOnePointRiemannSpace K L P (D P).toNat ≤ + finiteExtensionRiemannSpace K L D := by + have hcoeff : ((D P).toNat : ℤ) = D P := + Int.toNat_of_nonneg (hD P) + change finiteExtensionRiemannSpace K L + (Finsupp.single P ((D P).toNat : ℤ)) ≤ + finiteExtensionRiemannSpace K L D + rw [hcoeff] + exact finiteExtensionRiemannSpace_mono K L + (single_coeff_le_of_effective K L D P hD) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean new file mode 100644 index 0000000000..d3d47bbe85 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean @@ -0,0 +1,121 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting + +/-! +# Heights and zero counts in a one-point Riemann space + +This file supplies the direct bridge from membership in the one-point +Riemann space `L(nP)` to the pole height used by the exhaustive +principal-divisor API. + +For a nonzero `x ∈ L(nP)`, every negative-order place is `P` and its pole +order is at most `n`. Unfolding `finiteExtensionHeight` therefore gives the +bound `height(x) ≤ n * deg(P)`. Combining this with the existing positive-order +place count gives the corresponding Tao-style zero-count estimate. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance onePointHeightConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance onePointHeightConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A nonzero function in `L(nP)` has pole height at most `n * deg(P)`. + +This is proved directly from the exhaustive principal-divisor support and +the definition of `finiteExtensionHeight`; it does not invoke an abstract +divisor-degree estimate. -/ +theorem finiteExtensionHeight_le_of_mem_onePointRiemannSpace + (P : FiniteExtensionPlace K L) (n : ℕ) (x : L) (hx : x ≠ 0) + (hxSpace : x ∈ finiteExtensionOnePointRiemannSpace K L P n) : + finiteExtensionHeight K L x ≤ n * finiteExtensionPlaceDegree K L P := by + classical + have hxDescription := + (mem_finiteExtensionOnePointRiemannSpace_iff K L P n x).mp hxSpace + rcases hxDescription with hxZero | ⟨_hx, hP, hAway⟩ + · exact (hx hxZero).elim + let D := finiteExtensionPrincipalDivisor K L x + let negativeSupport := D.support.filter (fun v ↦ D v < 0) + have hsubset : negativeSupport ⊆ {P} := by + intro v hv + have hvneg : D v < 0 := (Finset.mem_filter.mp hv).2 + apply Finset.mem_singleton.mpr + by_contra hvP + have hvnonneg : 0 ≤ D v := hAway v hvP + omega + have horder : (-D P).toNat ≤ n := by + have hP' : -(n : ℤ) ≤ D P := by simpa [D] using hP + rw [Int.toNat_le] + omega + calc + finiteExtensionHeight K L x = + ∑ v ∈ negativeSupport, (-D v).toNat * finiteExtensionPlaceDegree K L v := rfl + _ ≤ ∑ v ∈ ({P} : Finset (FiniteExtensionPlace K L)), + (-D v).toNat * finiteExtensionPlaceDegree K L v := by + exact Finset.sum_le_sum_of_subset_of_nonneg hsubset (by omega) + _ = (-D P).toNat * finiteExtensionPlaceDegree K L P := by simp + _ ≤ n * finiteExtensionPlaceDegree K L P := + Nat.mul_le_mul_right (finiteExtensionPlaceDegree K L P) horder + +/-- Degree-one specialization of +`finiteExtensionHeight_le_of_mem_onePointRiemannSpace`. -/ +theorem finiteExtensionHeight_le_of_mem_onePointRiemannSpace_degree_one + (P : FiniteExtensionPlace K L) (n : ℕ) (x : L) (hx : x ≠ 0) + (hxSpace : x ∈ finiteExtensionOnePointRiemannSpace K L P n) + (hdegree : finiteExtensionPlaceDegree K L P = 1) : + finiteExtensionHeight K L x ≤ n := by + simpa [hdegree] using + finiteExtensionHeight_le_of_mem_onePointRiemannSpace K L P n x hx hxSpace + +/-- Tao-style zero count: a finite family injecting into positive-order +places of a nonzero `x ∈ L(nP)` has cardinality at most `n * deg(P)`. -/ +theorem Fintype.card_le_mul_placeDegree_of_onePointRiemannSpace + {ι : Type*} [Fintype ι] + (P : FiniteExtensionPlace K L) (n : ℕ) (x : L) (hx : x ≠ 0) + (hxSpace : x ∈ finiteExtensionOnePointRiemannSpace K L P n) + (place : ι → FiniteExtensionPlace K L) + (hinjective : Function.Injective place) + (hpositive : ∀ i, 0 < finiteExtensionPrincipalDivisor K L x (place i)) : + Fintype.card ι ≤ n * finiteExtensionPlaceDegree K L P := by + exact (Fintype.card_le_finiteExtensionHeight_of_injective_orders_positive + K L x hx place hinjective hpositive).trans + (finiteExtensionHeight_le_of_mem_onePointRiemannSpace K L P n x hx hxSpace) + +/-- Degree-one specialization of the one-point zero count. -/ +theorem Fintype.card_le_of_onePointRiemannSpace_degree_one + {ι : Type*} [Fintype ι] + (P : FiniteExtensionPlace K L) (n : ℕ) (x : L) (hx : x ≠ 0) + (hxSpace : x ∈ finiteExtensionOnePointRiemannSpace K L P n) + (hdegree : finiteExtensionPlaceDegree K L P = 1) + (place : ι → FiniteExtensionPlace K L) + (hinjective : Function.Injective place) + (hpositive : ∀ i, 0 < finiteExtensionPrincipalDivisor K L x (place i)) : + Fintype.card ι ≤ n := by + simpa [hdegree] using + Fintype.card_le_mul_placeDegree_of_onePointRiemannSpace + K L P n x hx hxSpace place hinjective hpositive + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean new file mode 100644 index 0000000000..5fb072e776 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement + +/-! +# Successive growth of one-point Riemann spaces + +The local residue argument bounds the jump from `L(nP)` to `L((n+1)P)` by +the degree of `P`. Iterating from `L(0)` also supplies finite-dimensionality +at every level of the one-point filtration. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- One step in the one-point filtration is finite-dimensional and has +dimension jump at most the degree of the distinguished place. -/ +theorem finiteExtensionOnePointRiemannSpace_increment + (P : FiniteExtensionPlace K L) (n : ℕ) + [Module.Finite K (finiteExtensionOnePointRiemannSpace K L P n)] : + Module.Finite K + (finiteExtensionOnePointRiemannSpace K L P (n + 1)) ∧ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (n + 1)) ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) + + finiteExtensionPlaceDegree K L P := by + classical + change Module.Finite K + (finiteExtensionRiemannSpace K L + (Finsupp.single P ((n + 1 : ℕ) : ℤ))) ∧ + Module.finrank K + (finiteExtensionRiemannSpace K L + (Finsupp.single P ((n + 1 : ℕ) : ℤ))) ≤ + Module.finrank K + (finiteExtensionRiemannSpace K L + (Finsupp.single P (n : ℤ))) + + finiteExtensionPlaceDegree K L P + have hD : ∀ v, 0 ≤ (Finsupp.single P (n : ℤ) : + FiniteExtensionDivisor K L) v := by + intro v + by_cases hv : v = P + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + rcases P with q | q + · have hbase : Module.Finite K + (finiteExtensionRiemannSpace K L + (Finsupp.single (.inl q) (n : ℤ))) := by + change Module.Finite K + (finiteExtensionOnePointRiemannSpace K L (.inl q) n) + infer_instance + letI := hbase + have h := finiteExtensionRiemannSpace_finitePlace_increment + K L (Finsupp.single (.inl q) (n : ℤ)) hD q + have hdivisor : + Finsupp.single (.inl q) (n : ℤ) + Finsupp.single (.inl q) 1 = + (Finsupp.single (.inl q) ((n + 1 : ℕ) : ℤ) : + FiniteExtensionDivisor K L) := by + ext v + by_cases hv : v = (.inl q : FiniteExtensionPlace K L) + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + rw [hdivisor] at h + exact h + · have hbase : Module.Finite K + (finiteExtensionRiemannSpace K L + (Finsupp.single (.inr q) (n : ℤ))) := by + change Module.Finite K + (finiteExtensionOnePointRiemannSpace K L (.inr q) n) + infer_instance + letI := hbase + have h := finiteExtensionRiemannSpace_infinityPlace_increment + K L (Finsupp.single (.inr q) (n : ℤ)) hD q + have hdivisor : + Finsupp.single (.inr q) (n : ℤ) + Finsupp.single (.inr q) 1 = + (Finsupp.single (.inr q) ((n + 1 : ℕ) : ℤ) : + FiniteExtensionDivisor K L) := by + ext v + by_cases hv : v = (.inr q : FiniteExtensionPlace K L) + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + rw [hdivisor] at h + exact h + +/-- Every member of a one-point Riemann filtration is finite-dimensional. -/ +theorem finiteExtensionOnePointRiemannSpace_moduleFinite + (P : FiniteExtensionPlace K L) : + ∀ n, Module.Finite K + (finiteExtensionOnePointRiemannSpace K L P n) := by + intro n + induction n with + | zero => + exact finiteExtensionOnePointRiemannSpace_zero_moduleFinite K L P + | succ n ih => + letI : Module.Finite K + (finiteExtensionOnePointRiemannSpace K L P n) := ih + exact (finiteExtensionOnePointRiemannSpace_increment K L P n).1 + +/-- Uniform dimension-jump bound for the one-point filtration. -/ +theorem finiteExtensionOnePointRiemannSpace_finrank_succ_le + (P : FiniteExtensionPlace K L) (n : ℕ) : + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (n + 1)) ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) + + finiteExtensionPlaceDegree K L P := by + letI : Module.Finite K + (finiteExtensionOnePointRiemannSpace K L P n) := + finiteExtensionOnePointRiemannSpace_moduleFinite K L P n + exact (finiteExtensionOnePointRiemannSpace_increment K L P n).2 + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean new file mode 100644 index 0000000000..76c509663c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean @@ -0,0 +1,585 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +import Mathlib.FieldTheory.Finiteness + +namespace BGS.CorvajaZannier + +noncomputable section + +open scoped nonZeroDivisors Polynomial +open IsDedekindDomain + +private noncomputable def residueFieldAlgEquivOfIdealEqOver + {C A : Type*} [CommRing C] [CommRing A] [Algebra C A] + {I J : Ideal A} [I.IsPrime] [J.IsPrime] (h : I = J) : + I.ResidueField ≃ₐ[C] J.ResidueField := by + subst J + exact AlgEquiv.refl + +private theorem constantResidue_surjective_of_ideal_eq + {C A : Type*} [CommRing C] [CommRing A] [Algebra C A] + {I J : Ideal A} [I.IsPrime] [J.IsPrime] (h : I = J) + (hJ : Function.Surjective (algebraMap C J.ResidueField)) : + Function.Surjective (algebraMap C I.ResidueField) := by + let e := residueFieldAlgEquivOfIdealEqOver (C := C) h + intro z + obtain ⟨c, hc⟩ := hJ (e z) + refine ⟨c, e.injective ?_⟩ + simpa [e] using hc + +@[reducible] private noncomputable def canonicalFractionRingAlgebra + (A : Type*) [CommRing A] [IsDomain A] : + Algebra A (FractionRing A) := inferInstance + +section LocalizationResidue + +variable {C R S : Type*} [Field C] [CommRing R] [IsDedekindDomain R] + [Algebra C R] + [CommRing S] [Algebra R S] + [Algebra C S] [IsScalarTower C R S] + +/-- Surjectivity of constants onto a height-one residue field is preserved +when the Dedekind domain is localized at that place. -/ +theorem localizationAtPrime_constantResidue_surjective + (q : HeightOneSpectrum R) [IsLocalization q.asIdeal.primeCompl S] + [IsLocalRing S] + (hresidue : Function.Surjective + (algebraMap C q.asIdeal.ResidueField)) : + Function.Surjective + (algebraMap C + (IsLocalRing.maximalIdeal S).ResidueField) := by + intro z + let m := IsLocalRing.maximalIdeal S + letI : q.asIdeal.IsMaximal := q.isMaximal + letI : m.IsMaximal := by + simpa [m] using (IsLocalRing.maximalIdeal.isMaximal S) + obtain ⟨s, hs⟩ := m.algebraMap_residueField_surjective z + let e := IsLocalization.AtPrime.equivQuotMaximalIdeal q.asIdeal S + let rbar : R ⧸ q.asIdeal := e.symm (Ideal.Quotient.mk m s) + obtain ⟨c, hc⟩ := hresidue + (algebraMap (R ⧸ q.asIdeal) q.asIdeal.ResidueField rbar) + refine ⟨c, ?_⟩ + change algebraMap C m.ResidueField c = z + rw [← hs] + rw [IsScalarTower.algebraMap_apply C S m.ResidueField] + simp only [IsScalarTower.algebraMap_apply S (S ⧸ m) m.ResidueField] + congr 1 + have hq : algebraMap R (R ⧸ q.asIdeal) (algebraMap C R c) = rbar := by + apply q.asIdeal.injective_algebraMap_quotient_residueField + simpa only [IsScalarTower.algebraMap_apply C R + q.asIdeal.ResidueField, + IsScalarTower.algebraMap_apply R (R ⧸ q.asIdeal) + q.asIdeal.ResidueField] using hc + calc + algebraMap S (S ⧸ m) (algebraMap C S c) = + e (algebraMap R (R ⧸ q.asIdeal) (algebraMap C R c)) := by + rw [IsScalarTower.algebraMap_apply C R S] + change Ideal.Quotient.mk m + (algebraMap R S (algebraMap C R c)) = + e (Ideal.Quotient.mk q.asIdeal (algebraMap C R c)) + simpa [e, m] using + (IsLocalization.AtPrime.equivQuotMaximalIdeal_apply_mk + q.asIdeal S (algebraMap C R c)).symm + _ = e rbar := by rw [hq] + _ = algebraMap S (S ⧸ m) s := by simp [rbar, m] + +end LocalizationResidue + +section DegreeOneResidue + +attribute [local instance high] Module.Free.of_divisionRing + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) onePointPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance onePointPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance onePointFiniteConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance onePointFiniteConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance onePointInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance onePointInfinityConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance onePointInfinityClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance onePointInfinityClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +private noncomputable def onePointResidueFieldAlgEquivOfIdealEq + {I J : Ideal K[X]} [I.IsPrime] [J.IsPrime] (h : I = J) : + I.ResidueField ≃ₐ[K] J.ResidueField := by + subst J + exact AlgEquiv.refl + +omit [Fintype K] [DecidableEq (RatFunc K)] in +/-- The degree of a rational-function finite place is the dimension of its +residue field over the constant field. -/ +theorem ratFuncFinitePlaceDegree_eq_finrank_residueField + (p : HeightOneSpectrum K[X]) : + ratFuncFinitePlaceDegree p = + Module.finrank K p.asIdeal.ResidueField := by + let r := finitePlaceNormalizedPrime p + have hp : normalizedPrimeFinitePlace (K := K) r = p := + normalizedPrimeFinitePlace_finitePlaceNormalizedPrime p + have hpIdeal : p.asIdeal = Ideal.span {(r : K[X])} := by + rw [← show (normalizedPrimeFinitePlace (K := K) r).asIdeal = + p.asIdeal by exact congrArg HeightOneSpectrum.asIdeal hp] + rfl + letI : (Ideal.span {(r : K[X])}).IsPrime := + (normalizedPrimeFinitePlace (K := K) r).isPrime + letI : (Ideal.span {(r : K[X])}).IsMaximal := + (inferInstance : (Ideal.span {(r : K[X])}).IsPrime).isMaximal (by + simpa only [ne_eq, Ideal.span_singleton_eq_bot] using + r.property.1.ne_zero) + let ep := onePointResidueFieldAlgEquivOfIdealEq (K := K) hpIdeal + let e : (K[X] ⧸ Ideal.span {(r : K[X])}) ≃ₐ[K] + (Ideal.span {(r : K[X])}).ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K + (K[X] ⧸ Ideal.span {(r : K[X])}) + (Ideal.span {(r : K[X])}).ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField _) + symm + calc + Module.finrank K p.asIdeal.ResidueField = + Module.finrank K (Ideal.span {(r : K[X])}).ResidueField := + ep.toLinearEquiv.finrank_eq + _ = + Module.finrank K (K[X] ⧸ Ideal.span {(r : K[X])}) := + e.toLinearEquiv.finrank_eq.symm + _ = (r : K[X]).natDegree := + (AdjoinRoot.powerBasis r.property.1.ne_zero).finrank + _ = ratFuncFinitePlaceDegree p := by + rw [ratFuncFinitePlaceDegree] + +omit [Fintype K] in +/-- At a finite extension place, the exhaustive place degree is exactly the +constant-field dimension of the residue field. -/ +theorem finiteExtensionFinitePlace_degree_eq_finrank_residueField + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionPlaceDegree K L (.inl q) = + Module.finrank K q.asIdeal.ResidueField := by + let p := HeightOneSpectrum.under K[X] q + letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + letI hLocalAlg := + Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal + letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p.asIdeal q.asIdeal] + rw [ratFuncFinitePlaceDegree_eq_finrank_residueField K p] + rw [mul_comm, Module.finrank_mul_finrank] + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- At an infinity extension place, the exhaustive place degree is exactly +the constant-field dimension of the residue field. -/ +theorem finiteExtensionInfinityPlace_degree_eq_finrank_residueField + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPlaceDegree K L (.inr P) = + Module.finrank K P.1.ResidueField := by + let p := (ratFuncInfinityPlace K).asIdeal + letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + letI : Algebra p.ResidueField P.1.ResidueField := + IsLocalRing.ResidueField.instAlgebra + letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p P.1] + have hbase : Module.finrank K p.ResidueField = 1 := by + simpa [p] using + (ratFuncInfinityPlaceResidueEquiv K).toLinearEquiv.finrank_eq + calc + Module.finrank p.ResidueField P.1.ResidueField = + 1 * Module.finrank p.ResidueField P.1.ResidueField := by simp + _ = Module.finrank K p.ResidueField * + Module.finrank p.ResidueField P.1.ResidueField := by rw [hbase] + _ = Module.finrank K P.1.ResidueField := + Module.finrank_mul_finrank K p.ResidueField P.1.ResidueField + +omit [Fintype K] in +/-- Degree one forces constants to fill the residue field at a finite +extension place. -/ +theorem finiteExtensionFinitePlace_constantResidue_surjective_of_degree_one + (q : FiniteExtensionFinitePlace K L) + (hq : finiteExtensionPlaceDegree K L (.inl q) = 1) : + Function.Surjective (algebraMap K q.asIdeal.ResidueField) := by + have hfinrank : Module.finrank K q.asIdeal.ResidueField = 1 := by + rw [← finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q] + exact hq + exact (Algebra.finrank_eq_one_iff_bijective_algebraMap.mp hfinrank).2 + +omit [Fintype K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +/-- Degree one forces constants to fill the residue field at an infinity +extension place. -/ +theorem finiteExtensionInfinityPlace_constantResidue_surjective_of_degree_one + (P : FiniteExtensionInfinityPlace K L) + (hP : finiteExtensionPlaceDegree K L (.inr P) = 1) : + Function.Surjective (algebraMap K P.1.ResidueField) := by + have hfinrank : Module.finrank K P.1.ResidueField = 1 := by + rw [← finiteExtensionInfinityPlace_degree_eq_finrank_residueField K L P] + exact hP + exact (Algebra.finrank_eq_one_iff_bijective_algebraMap.mp hfinrank).2 + +end DegreeOneResidue + +section GlobalDedekindCancellation + +variable {C R L : Type*} [Field C] [CommRing R] [IsDedekindDomain R] + [Field L] [Algebra C R] [Algebra R L] [Algebra C L] + [IsScalarTower C R L] [IsFractionRing R L] + +/-- Global height-one cancellation obtained by applying the DVR theorem after +localizing at the chosen Dedekind place. -/ +theorem exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt_of_residue + (q : HeightOneSpectrum R) + (hresidue : Function.Surjective + (algebraMap C q.asIdeal.ResidueField)) + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) + (horder : finitePlaceOrder q x = finitePlaceOrder q y) : + ∃ c : C, + x - algebraMap C L c * y = 0 ∨ + finitePlaceOrder q x < + finitePlaceOrder q (x - algebraMap C L c * y) := by + let S := Localization.AtPrime q.asIdeal + letI : Algebra C S := + Algebra.ofModule smul_mul_assoc mul_smul_comm + letI : IsScalarTower C R S := inferInstance + let toField : S →+* L := + IsLocalization.lift + (S := S) (M := q.asIdeal.primeCompl) + (g := algebraMap R L) fun d => + IsLocalization.map_units L + ⟨d.1, q.asIdeal.primeCompl_le_nonZeroDivisors d.2⟩ + letI : Algebra S L := toField.toAlgebra + letI : IsScalarTower R S L := by + apply IsScalarTower.of_algebraMap_eq' + exact (IsLocalization.lift_comp _).symm + letI : IsFractionRing S L := + IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + q.asIdeal.primeCompl S L + letI : IsDiscreteValuationRing S := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + R q.ne_bot S + letI : IsScalarTower C S L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + simp only [RingHom.comp_apply, + IsScalarTower.algebraMap_apply C R L, + IsScalarTower.algebraMap_apply C R S, + IsScalarTower.algebraMap_apply R S L] + let v := IsDiscreteValuationRing.maximalIdeal S + have hlocalResidue : Function.Surjective + (algebraMap C v.asIdeal.ResidueField) := by + have hvIdeal : v.asIdeal = IsLocalRing.maximalIdeal S := + IsLocalRing.eq_maximalIdeal v.isMaximal + apply constantResidue_surjective_of_ideal_eq hvIdeal + exact localizationAtPrime_constantResidue_surjective + (C := C) (R := R) (S := S) q hresidue + have hlocalOrder : finitePlaceOrder v x = finitePlaceOrder v y := by + simpa [v, S, localizationAtPrime_finitePlaceOrder_eq q] using horder + obtain ⟨c, hc⟩ := + exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt + v hlocalResidue x y hx hy hlocalOrder + refine ⟨c, hc.elim Or.inl (fun hlt => Or.inr ?_)⟩ + simpa [v, S, localizationAtPrime_finitePlaceOrder_eq q] using hlt + +end GlobalDedekindCancellation + +section FiniteExtensionCancellation + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance onePointCancellationConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance onePointCancellationConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) onePointCancellationPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance onePointCancellationPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance onePointCancellationFiniteConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance onePointCancellationInfinityBaseConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance onePointCancellationInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance onePointCancellationFiniteIsDedekindDomain : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + integralClosure.isDedekindDomain K[X] (RatFunc K) L + +local instance onePointCancellationFiniteIsFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) L + +local instance onePointCancellationInfinityIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance onePointCancellationInfinityIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) L + +local instance onePointCancellationInfinityCanonicalFractionAlgebra : + Algebra (RatFuncInfinityIntegralClosure K L) + (FractionRing (RatFuncInfinityIntegralClosure K L)) := + canonicalFractionRingAlgebra (RatFuncInfinityIntegralClosure K L) + +local instance onePointCancellationInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance onePointCancellationInfinityIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance onePointCancellationFiniteConstantTowerToField : + IsScalarTower K (RatFuncFiniteIntegralClosure K L) L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + simp only [RingHom.comp_apply] + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + +local instance onePointCancellationInfinityConstantTowerToField : + IsScalarTower K (RatFuncInfinityIntegralClosure K L) L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + simp only [RingHom.comp_apply] + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + +omit [Fintype K] in +private theorem finiteExtensionPrincipalDivisor_inr_eq_finitePlaceOrder + (x : L) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L x (.inr P) = + finitePlaceOrder + (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by + rw [finiteExtensionPrincipalDivisor_inr] + symm + simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using + fractionRingAlgEquiv_finitePlaceOrder_eq + (R := RatFuncInfinityIntegralClosure K L) (L := L) + (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + +omit [Fintype K] in +/-- At a degree-one exhaustive place, equal-order nonzero functions admit a +strict constant leading-term cancellation. -/ +theorem exists_constant_finiteExtensionPlaceOrder_sub_mul_eq_zero_or_lt + (P : FiniteExtensionPlace K L) + (hP : finiteExtensionPlaceDegree K L P = 1) + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) + (horder : finiteExtensionPrincipalDivisor K L x P = + finiteExtensionPrincipalDivisor K L y P) : + ∃ c : K, + x - algebraMap K L c * y = 0 ∨ + finiteExtensionPrincipalDivisor K L x P < + finiteExtensionPrincipalDivisor K L + (x - algebraMap K L c * y) P := by + cases P with + | inl q => + have hresidue := + finiteExtensionFinitePlace_constantResidue_surjective_of_degree_one + K L q hP + have horder' : finitePlaceOrder q x = finitePlaceOrder q y := by + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + using horder + obtain ⟨c, hc⟩ := + exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt_of_residue + (C := K) (R := RatFuncFiniteIntegralClosure K L) (L := L) + q hresidue x y hx hy horder' + refine ⟨c, hc.imp id ?_⟩ + intro hlt + simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + using hlt + | inr P => + let q := primeOverHeightOne + (R := RatFuncInfinityIntegers K) + (S := RatFuncInfinityIntegralClosure K L) + (ratFuncInfinityPlace K) P + have hresidue : Function.Surjective + (algebraMap K q.asIdeal.ResidueField) := by + change Function.Surjective (algebraMap K P.1.ResidueField) + exact + finiteExtensionInfinityPlace_constantResidue_surjective_of_degree_one + K L P hP + have horder' : finitePlaceOrder q x = finitePlaceOrder q y := by + simpa only [q, + finiteExtensionPrincipalDivisor_inr_eq_finitePlaceOrder] + using horder + obtain ⟨c, hc⟩ := + exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt_of_residue + (C := K) (R := RatFuncInfinityIntegralClosure K L) (L := L) + q hresidue x y hx hy horder' + refine ⟨c, hc.imp id ?_⟩ + intro hlt + simpa only [q, + finiteExtensionPrincipalDivisor_inr_eq_finitePlaceOrder] + using hlt + +/-- At a degree-one place, cancelling the common leading coefficient of two +nonzero sections with exact pole order `n` either gives zero or lowers the +allowed pole order by one. -/ +theorem exists_constant_sub_mul_mem_onePointRiemannSpace_pred + (P : FiniteExtensionPlace K L) + (hP : finiteExtensionPlaceDegree K L P = 1) + {n : ℕ} (hn : 0 < n) {x y : L} + (hx : x ∈ finiteExtensionOnePointRiemannSpace K L P n) + (hy : y ∈ finiteExtensionOnePointRiemannSpace K L P n) + (hx0 : x ≠ 0) (hy0 : y ≠ 0) + (hxOrder : finiteExtensionPrincipalDivisor K L x P = -(n : ℤ)) + (hyOrder : finiteExtensionPrincipalDivisor K L y P = -(n : ℤ)) : + ∃ c : K, + x - algebraMap K L c * y = 0 ∨ + x - algebraMap K L c * y ∈ + finiteExtensionOnePointRiemannSpace K L P (n - 1) := by + have hxyOrder : finiteExtensionPrincipalDivisor K L x P = + finiteExtensionPrincipalDivisor K L y P := + hxOrder.trans hyOrder.symm + obtain ⟨c, hc⟩ := + exists_constant_finiteExtensionPlaceOrder_sub_mul_eq_zero_or_lt + K L P hP x y hx0 hy0 hxyOrder + refine ⟨c, hc.elim Or.inl (fun hlt => ?_)⟩ + let z := x - algebraMap K L c * y + by_cases hz0 : z = 0 + · exact Or.inl (by simpa [z] using hz0) + · refine Or.inr ?_ + rw [mem_finiteExtensionOnePointRiemannSpace_iff] + refine Or.inr ⟨hz0, ?_, ?_⟩ + · change -((n - 1 : ℕ) : ℤ) ≤ + finiteExtensionPrincipalDivisor K L z P + have hzOrder : -(n : ℤ) < + finiteExtensionPrincipalDivisor K L z P := by + simpa [z, hxOrder] using hlt + omega + · have hcy : algebraMap K L c * y ∈ + finiteExtensionOnePointRiemannSpace K L P n := by + have hsmul := + (finiteExtensionOnePointRiemannSpace K L P n).smul_mem c hy + simpa only [Algebra.smul_def] using hsmul + have hzMem : z ∈ finiteExtensionOnePointRiemannSpace K L P n := by + exact (finiteExtensionOnePointRiemannSpace K L P n).sub_mem hx hcy + rcases + (mem_finiteExtensionOnePointRiemannSpace_iff K L P n z).mp hzMem with + hz | ⟨_, _, hAway⟩ + · exact (hz0 hz).elim + · exact hAway + +/-- If the degree-one one-point filtration grows at level `n + 1`, one new +section is a pivot for the whole quotient. Its pole order is exactly +`-(n + 1)`, and every section of the larger space becomes a scalar multiple +of it modulo the preceding space. -/ +theorem exists_onePointRiemannSpace_pivot_of_lt + (P : FiniteExtensionPlace K L) + (hP : finiteExtensionPlaceDegree K L P = 1) (n : ℕ) + (hstrict : finiteExtensionOnePointRiemannSpace K L P n < + finiteExtensionOnePointRiemannSpace K L P (n + 1)) : + ∃ y : L, + y ∈ finiteExtensionOnePointRiemannSpace K L P (n + 1) ∧ + finiteExtensionPrincipalDivisor K L y P = -((n + 1 : ℕ) : ℤ) ∧ + ∀ x : L, + x ∈ finiteExtensionOnePointRiemannSpace K L P (n + 1) → + ∃ c : K, + x - c • y ∈ finiteExtensionOnePointRiemannSpace K L P n := by + have hnotle : ¬ finiteExtensionOnePointRiemannSpace K L P (n + 1) ≤ + finiteExtensionOnePointRiemannSpace K L P n := + not_le_of_gt hstrict + have hexists : ∃ y : L, + y ∈ finiteExtensionOnePointRiemannSpace K L P (n + 1) ∧ + y ∉ finiteExtensionOnePointRiemannSpace K L P n := by + by_contra h + apply hnotle + intro y hy + by_contra hyNot + exact h ⟨y, hy, hyNot⟩ + obtain ⟨y, hySucc, hyNot⟩ := hexists + obtain ⟨hy0, hyOrder⟩ := + BGS.HasseWeil.onePointRiemannSpace_order_eq_neg_succ_of_mem_not_mem + K L P n hySucc hyNot + refine ⟨y, hySucc, hyOrder, ?_⟩ + intro x hxSucc + by_cases hxMem : x ∈ finiteExtensionOnePointRiemannSpace K L P n + · refine ⟨0, ?_⟩ + simpa using hxMem + · obtain ⟨hx0, hxOrder⟩ := + BGS.HasseWeil.onePointRiemannSpace_order_eq_neg_succ_of_mem_not_mem + K L P n hxSucc hxMem + obtain ⟨c, hc⟩ := + exists_constant_sub_mul_mem_onePointRiemannSpace_pred + K L P hP (Nat.zero_lt_succ n) hxSucc hySucc hx0 hy0 hxOrder hyOrder + refine ⟨c, ?_⟩ + rcases hc with hzero | hmem + · have hzero' : x - c • y = 0 := by + simpa only [Algebra.smul_def] using hzero + rw [hzero'] + exact Submodule.zero_mem _ + · simpa only [Algebra.smul_def, Nat.succ_sub_one] using hmem + +end FiniteExtensionCancellation + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean new file mode 100644 index 0000000000..a9142fab9c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean @@ -0,0 +1,292 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +import Mathlib.Tactic + +/-! +# One-point pole-order semigroups +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + +/-- The elements at most `n` missing from an additive submonoid of `ℕ`. -/ +noncomputable def addSubmonoidGapsBelowOrAt + (H : AddSubmonoid ℕ) (n : ℕ) : Finset ℕ := by + classical + exact (Finset.range (n + 1)).filter (fun i => i ∉ H) + +private noncomputable def addSubmonoidMembersBelowOrAt + (H : AddSubmonoid ℕ) (n : ℕ) : Finset ℕ := by + classical + exact (Finset.range (n + 1)).filter (fun i => i ∈ H) + +private noncomputable def addSubmonoidPositiveMembersBelow + (H : AddSubmonoid ℕ) (n : ℕ) : Finset ℕ := by + classical + exact (Finset.range n).filter (fun i => i + 1 ∈ H) + +/-- Reflection through `i ↦ n - i` proves the elementary conductor bound: +if at most `g` elements up to `n` are gaps and `n ≥ 2g`, then `n` belongs to +the additive submonoid. -/ +theorem addSubmonoid_mem_of_card_gaps_le + (H : AddSubmonoid ℕ) (n g : ℕ) + (hgaps : (addSubmonoidGapsBelowOrAt H n).card ≤ g) + (hlarge : 2 * g ≤ n) : + n ∈ H := by + classical + by_contra hn + let members := addSubmonoidMembersBelowOrAt H n + let gaps := addSubmonoidGapsBelowOrAt H n + have hreflect : members.card ≤ gaps.card := by + apply Finset.card_le_card_of_injOn (fun i => n - i) + · intro i hi + have hi' : i < n + 1 ∧ i ∈ H := by + have hiFin : i ∈ addSubmonoidMembersBelowOrAt H n := hi + simpa only [addSubmonoidMembersBelowOrAt, Finset.mem_filter, + Finset.mem_range] using hiFin + have hreflected : n - i ∉ H := by + intro hreflected + have hsum : n - i + i = n := + Nat.sub_add_cancel (Nat.le_of_lt_succ hi'.1) + apply hn + rw [← hsum] + exact H.add_mem hreflected hi'.2 + have hreflectedRange : n - i < n + 1 := Nat.sub_lt_succ n i + have hreflectedFin : n - i ∈ addSubmonoidGapsBelowOrAt H n := by + rw [addSubmonoidGapsBelowOrAt, Finset.mem_filter, Finset.mem_range] + exact ⟨hreflectedRange, hreflected⟩ + exact hreflectedFin + · intro i hi j hj heq + have hi' : i < n + 1 ∧ i ∈ H := by + have hiFin : i ∈ addSubmonoidMembersBelowOrAt H n := hi + simpa only [addSubmonoidMembersBelowOrAt, Finset.mem_filter, + Finset.mem_range] using hiFin + have hj' : j < n + 1 ∧ j ∈ H := by + have hjFin : j ∈ addSubmonoidMembersBelowOrAt H n := hj + simpa only [addSubmonoidMembersBelowOrAt, Finset.mem_filter, + Finset.mem_range] using hjFin + have hiSum : n - i + i = n := + Nat.sub_add_cancel (Nat.le_of_lt_succ hi'.1) + have hjSum : n - j + j = n := + Nat.sub_add_cancel (Nat.le_of_lt_succ hj'.1) + change n - i = n - j at heq + apply Nat.add_left_cancel (n := n - j) + calc + (n - j) + i = (n - i) + i := by rw [heq] + _ = n := hiSum + _ = (n - j) + j := hjSum.symm + have hpartition : members.card + gaps.card = n + 1 := by + simpa only [members, gaps, addSubmonoidMembersBelowOrAt, + addSubmonoidGapsBelowOrAt, Finset.card_range] using + (Finset.card_filter_add_card_filter_not + (s := Finset.range (n + 1)) (p := fun i => i ∈ H)) + have hgap : gaps.card ≤ g := by + simpa only [gaps] using hgaps + omega + +private theorem one_add_card_positive_members_eq_card_members + (H : AddSubmonoid ℕ) : ∀ n : ℕ, + 1 + (addSubmonoidPositiveMembersBelow H n).card = + (addSubmonoidMembersBelowOrAt H n).card := by + classical + intro n + induction n with + | zero => + change 1 = ((Finset.range 1).filter (fun i => i ∈ H)).card + simp only [Finset.range_one, Finset.filter_singleton] + rw [if_pos H.zero_mem] + simp + | succ n ih => + by_cases hn : n + 1 ∈ H + · have hpositive : + (addSubmonoidPositiveMembersBelow H (n + 1)).card = + (addSubmonoidPositiveMembersBelow H n).card + 1 := by + rw [addSubmonoidPositiveMembersBelow, Finset.range_add_one, + Finset.filter_insert, if_pos hn, Finset.card_insert_of_notMem] + · rfl + · simp + have hmembers : + (addSubmonoidMembersBelowOrAt H (n + 1)).card = + (addSubmonoidMembersBelowOrAt H n).card + 1 := by + rw [addSubmonoidMembersBelowOrAt] + rw [show n + 1 + 1 = (n + 1) + 1 by omega, + Finset.range_add_one, Finset.filter_insert, if_pos hn, + Finset.card_insert_of_notMem] + · rfl + · simp + rw [hpositive, hmembers] + omega + · have hpositive : + (addSubmonoidPositiveMembersBelow H (n + 1)).card = + (addSubmonoidPositiveMembersBelow H n).card := by + rw [addSubmonoidPositiveMembersBelow, Finset.range_add_one, + Finset.filter_insert, if_neg hn, + addSubmonoidPositiveMembersBelow] + have hmembers : + (addSubmonoidMembersBelowOrAt H (n + 1)).card = + (addSubmonoidMembersBelowOrAt H n).card := by + rw [addSubmonoidMembersBelowOrAt] + rw [show n + 1 + 1 = (n + 1) + 1 by omega, + Finset.range_add_one, Finset.filter_insert, if_neg hn, + addSubmonoidMembersBelowOrAt] + rw [hpositive, hmembers] + exact ih + +private theorem card_gaps_le_of_card_positive_members_ge + (H : AddSubmonoid ℕ) (n g : ℕ) + (hmembers : n - g ≤ + (addSubmonoidPositiveMembersBelow H n).card) + (hgn : g ≤ n) : + (addSubmonoidGapsBelowOrAt H n).card ≤ g := by + classical + let members := addSubmonoidMembersBelowOrAt H n + let gaps := addSubmonoidGapsBelowOrAt H n + have hmemberCard : 1 + + (addSubmonoidPositiveMembersBelow H n).card = members.card := by + simpa only [members] using one_add_card_positive_members_eq_card_members H n + have hpartition : members.card + gaps.card = n + 1 := by + simpa only [members, gaps, addSubmonoidMembersBelowOrAt, + addSubmonoidGapsBelowOrAt, Finset.card_range] using + (Finset.card_filter_add_card_filter_not + (s := Finset.range (n + 1)) (p := fun i => i ∈ H)) + change gaps.card ≤ g + omega + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance onePointPoleSemigroupConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance onePointPoleSemigroupConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Exact pole orders at `P` of nonzero functions regular away from `P`. -/ +def onePointPoleOrderSemigroup + (P : FiniteExtensionPlace K L) : AddSubmonoid ℕ where + carrier := {n | ∃ x : L, x ≠ 0 ∧ + finiteExtensionPrincipalDivisor K L x P = -(n : ℤ) ∧ + ∀ v, v ≠ P → 0 ≤ finiteExtensionPrincipalDivisor K L x v} + zero_mem' := by + refine ⟨1, one_ne_zero, ?_, ?_⟩ + · rw [finiteExtensionPrincipalDivisor_one K L] + simp + · intro v hv + rw [finiteExtensionPrincipalDivisor_one K L] + simp + add_mem' := by + rintro m n ⟨x, hx0, hxP, hxAway⟩ ⟨y, hy0, hyP, hyAway⟩ + refine ⟨x * y, mul_ne_zero hx0 hy0, ?_, ?_⟩ + · rw [finiteExtensionPrincipalDivisor_mul K L x y hx0 hy0, + Finsupp.add_apply, hxP, hyP] + push_cast + ring + · intro v hv + rw [finiteExtensionPrincipalDivisor_mul K L x y hx0 hy0, + Finsupp.add_apply] + exact add_nonneg (hxAway v hv) (hyAway v hv) + +omit [Fintype K] in +@[simp] +theorem mem_onePointPoleOrderSemigroup_iff + (P : FiniteExtensionPlace K L) (n : ℕ) : + n ∈ onePointPoleOrderSemigroup K L P ↔ + ∃ x : L, x ≠ 0 ∧ + finiteExtensionPrincipalDivisor K L x P = -(n : ℤ) ∧ + ∀ v, v ≠ P → 0 ≤ finiteExtensionPrincipalDivisor K L x v := + Iff.rfl + +/-- A positive exact pole order is equivalent to strict growth at that level. -/ +theorem succ_mem_onePointPoleOrderSemigroup_iff_lt + (P : FiniteExtensionPlace K L) (n : ℕ) : + n + 1 ∈ onePointPoleOrderSemigroup K L P ↔ + finiteExtensionOnePointRiemannSpace K L P n < + finiteExtensionOnePointRiemannSpace K L P (n + 1) := by + constructor + · rintro ⟨x, hx0, hxP, hxAway⟩ + have hxSucc : x ∈ finiteExtensionOnePointRiemannSpace K L P (n + 1) := by + rw [mem_finiteExtensionOnePointRiemannSpace_iff] + exact Or.inr ⟨hx0, by rw [hxP], hxAway⟩ + have hxNot : x ∉ finiteExtensionOnePointRiemannSpace K L P n := by + intro hx + rcases (mem_finiteExtensionOnePointRiemannSpace_iff K L P n x).mp hx with + rfl | ⟨_, hxLower, _⟩ + · exact hx0 rfl + · rw [hxP] at hxLower + omega + apply lt_of_le_of_ne (finiteExtensionOnePointRiemannSpace_mono K L P (by omega)) + intro heq + apply hxNot + rw [heq] + exact hxSucc + · intro hstrict + obtain ⟨x, hxSucc, hxNot⟩ := SetLike.exists_of_lt hstrict + obtain ⟨hx0, hxP⟩ := + onePointRiemannSpace_order_eq_neg_succ_of_mem_not_mem K L P n hxSucc hxNot + rcases (mem_finiteExtensionOnePointRiemannSpace_iff K L P (n + 1) x).mp + hxSucc with rfl | ⟨_, _, hxAway⟩ + · exact (hx0 rfl).elim + · exact ⟨x, hx0, hxP, hxAway⟩ + +/-- A degree-one place whose one-point spaces satisfy the coarse Riemann lower +bound has every pole order at least twice the genus budget. -/ +theorem mem_onePointPoleOrderSemigroup_of_two_mul_le + (P : FiniteExtensionPlace K L) + (hdegree : finiteExtensionPlaceDegree K L P = 1) + (hconstants : algebraicClosure K L = ⊥) + (g n : ℕ) + (hlower : ∀ m : ℕ, + m + 1 ≤ Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P m) + g) + (hlarge : 2 * g ≤ n) : + n ∈ onePointPoleOrderSemigroup K L P := by + have hgn : g ≤ n := by omega + have hlower' : 1 + finiteExtensionPlaceDegree K L P * (n - g) ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P n) := by + have h := hlower n + rw [hdegree] + simp only [one_mul] + omega + have hstrict : n - g ≤ + (strictFiltrationLevels + (fun m => finiteExtensionOnePointRiemannSpace K L P m) n).card := + le_card_onePointStrictLevels_of_finrank_lower K L P n (n - g) + hconstants hlower' + have hstrictEq : + strictFiltrationLevels + (fun m => finiteExtensionOnePointRiemannSpace K L P m) n = + addSubmonoidPositiveMembersBelow + (onePointPoleOrderSemigroup K L P) n := by + classical + ext i + simp only [strictFiltrationLevels, addSubmonoidPositiveMembersBelow, + Finset.mem_filter, Finset.mem_range] + rw [succ_mem_onePointPoleOrderSemigroup_iff_lt K L P i] + have hpositive : n - g ≤ + (addSubmonoidPositiveMembersBelow + (onePointPoleOrderSemigroup K L P) n).card := by + rw [← hstrictEq] + exact hstrict + apply addSubmonoid_mem_of_card_gaps_le + (onePointPoleOrderSemigroup K L P) n g + · exact card_gaps_le_of_card_positive_members_ge + (onePointPoleOrderSemigroup K L P) n g hpositive hgn + · exact hlarge + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean new file mode 100644 index 0000000000..a55d725b0a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +import Mathlib.Data.Fintype.EquivFin + +/-! +# Selecting one-point sections with distinct pole orders + +The local jump bound converts a Riemann-space dimension lower bound into +many strict levels of the pole filtration. Choosing one section at each +strict level, and adjoining the constant section, produces a linearly +independent family with distinct pole-order digits in a prescribed range. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance sectionSelectionConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance sectionSelectionConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- With exact constants, the initial one-point Riemann space has dimension +one. -/ +theorem finiteExtensionOnePointRiemannSpace_zero_finrank + (P : FiniteExtensionPlace K L) + (hconstants : algebraicClosure K L = ⊥) : + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P 0) = 1 := by + classical + change Module.finrank K + (finiteExtensionRiemannSpace K L (Finsupp.single P (0 : ℤ))) = 1 + have hzero : Finsupp.single P (0 : ℤ) = + (0 : FiniteExtensionDivisor K L) := by + ext v + by_cases hv : v = P <;> simp [hv] + rw [hzero] + exact finiteExtensionRiemannSpace_zero_finrank K L hconstants + +/-- A final dimension lower bound forces the stated number of strict levels +in the one-point filtration. -/ +theorem le_card_onePointStrictLevels_of_finrank_lower + (P : FiniteExtensionPlace K L) (N m : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hlower : + 1 + finiteExtensionPlaceDegree K L P * m ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P N)) : + m ≤ (strictFiltrationLevels + (fun n => finiteExtensionOnePointRiemannSpace K L P n) N).card := by + apply le_card_strictFiltrationLevels_of_initial_add_mul_le_finrank + (R := fun n => finiteExtensionOnePointRiemannSpace K L P n) + (d := finiteExtensionPlaceDegree K L P) + · exact finiteExtensionPlaceDegree_pos K L P + · intro n + exact finiteExtensionOnePointRiemannSpace_mono K L P (by omega) + · intro n + exact finiteExtensionOnePointRiemannSpace_finrank_succ_le K L P n + · rw [finiteExtensionOnePointRiemannSpace_zero_finrank K L P hconstants] + exact hlower + +/-- Select a prescribed number of positive-pole sections from the strict +levels below `N`. -/ +theorem exists_onePointSections_of_le_card_strictLevels + (P : FiniteExtensionPlace K L) (N m : ℕ) + (hm : m ≤ (strictFiltrationLevels + (fun n => finiteExtensionOnePointRiemannSpace K L P n) N).card) : + ∃ (f : Fin m → L) (d : Fin m → ℕ), + (∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P N) ∧ + (∀ i, f i ≠ 0) ∧ + (∀ i, finiteExtensionPrincipalDivisor K L (f i) P = -(d i : ℤ)) ∧ + Function.Injective d ∧ + (∀ i, 0 < d i ∧ d i ≤ N) ∧ + LinearIndependent K f := by + classical + let I := {n // n ∈ strictFiltrationLevels + (fun r => finiteExtensionOnePointRiemannSpace K L P r) N} + obtain ⟨F, hF, hFinjective⟩ := + exists_onePointRiemannSpace_sections_indexed_by_strictLevels K L P N + have hcard : Fintype.card (Fin m) ≤ Fintype.card I := by + rw [Fintype.card_fin] + simpa only [I, Fintype.card_coe] using hm + let e : Fin m ↪ I := + Classical.choice (Function.Embedding.nonempty_of_card_le hcard) + let f : Fin m → L := fun i => F (e i) + let d : Fin m → ℕ := fun i => (e i).1 + 1 + have hdPositive (i : Fin m) : 0 < d i := by + simp [d] + have hdLe (i : Fin m) : d i ≤ N := by + have hiRange : (e i).1 ∈ Finset.range N := + (Finset.mem_filter.mp (e i).2).1 + have hiLt : (e i).1 < N := Finset.mem_range.mp hiRange + simp only [d] + omega + have hfMem (i : Fin m) : + f i ∈ finiteExtensionOnePointRiemannSpace K L P N := by + apply finiteExtensionOnePointRiemannSpace_mono K L P (hdLe i) + exact (hF (e i)).1 + have hfNotMem (i : Fin m) : + f i ∉ finiteExtensionOnePointRiemannSpace K L P (e i).1 := + (hF (e i)).2.1 + have hfNe (i : Fin m) : f i ≠ 0 := by + intro hzero + apply hfNotMem i + rw [hzero] + exact Submodule.zero_mem _ + have hfOrder (i : Fin m) : + finiteExtensionPrincipalDivisor K L (f i) P = -(d i : ℤ) := by + simpa only [f, d] using (hF (e i)).2.2 + have hdInjective : Function.Injective d := by + intro i j hij + apply e.injective + apply Subtype.ext + simp only [d] at hij + omega + have horderInjective : Function.Injective + (fun i => finiteExtensionPrincipalDivisor K L (f i) P) := by + intro i j hij + apply hdInjective + have hcast : -(d i : ℤ) = -(d j : ℤ) := by + rw [← hfOrder i, ← hfOrder j] + exact hij + exact_mod_cast (neg_inj.mp hcast) + refine ⟨f, d, hfMem, hfNe, hfOrder, hdInjective, + fun i => ⟨hdPositive i, hdLe i⟩, ?_⟩ + exact linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order + K L P f hfNe horderInjective + +/-- Adjoin the constant section to a selected positive-pole family. The +resulting pole digits start at zero and remain pairwise distinct. -/ +theorem exists_onePointSectionsWithConstant_of_le_card_strictLevels + (P : FiniteExtensionPlace K L) (N m : ℕ) + (hm : m ≤ (strictFiltrationLevels + (fun n => finiteExtensionOnePointRiemannSpace K L P n) N).card) : + ∃ (f : Option (Fin m) → L) (d : Option (Fin m) → ℕ), + (∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P N) ∧ + (∀ i, f i ≠ 0) ∧ + (∀ i, finiteExtensionPrincipalDivisor K L (f i) P = -(d i : ℤ)) ∧ + Function.Injective d ∧ + (∀ i, d i ≤ N) ∧ + LinearIndependent K f := by + classical + obtain ⟨f₀, d₀, hf₀Mem, hf₀Ne, hf₀Order, hd₀Injective, + hd₀Range, hf₀LI⟩ := + exists_onePointSections_of_le_card_strictLevels K L P N m hm + let f : Option (Fin m) → L + | none => 1 + | some i => f₀ i + let d : Option (Fin m) → ℕ + | none => 0 + | some i => d₀ i + have hfMem : ∀ i, f i ∈ + finiteExtensionOnePointRiemannSpace K L P N := by + intro i + cases i with + | none => + simpa [f] using + algebraMap_mem_finiteExtensionOnePointRiemannSpace K L P N (1 : K) + | some i => simpa [f] using hf₀Mem i + have hfNe : ∀ i, f i ≠ 0 := by + intro i + cases i with + | none => simp [f] + | some i => simpa [f] using hf₀Ne i + have hfOrder : ∀ i, + finiteExtensionPrincipalDivisor K L (f i) P = -(d i : ℤ) := by + intro i + cases i with + | none => + simp [f, d, finiteExtensionPrincipalDivisor_one] + | some i => simpa [f, d] using hf₀Order i + have hdInjective : Function.Injective d := by + intro i j hij + cases i with + | none => + cases j with + | none => rfl + | some j => + exfalso + have hj := (hd₀Range j).1 + simp [d] at hij + omega + | some i => + cases j with + | none => + exfalso + have hi := (hd₀Range i).1 + simp [d] at hij + omega + | some j => + congr 1 + exact hd₀Injective (by simpa [d] using hij) + have horderInjective : Function.Injective + (fun i => finiteExtensionPrincipalDivisor K L (f i) P) := by + intro i j hij + apply hdInjective + have hcast : -(d i : ℤ) = -(d j : ℤ) := by + rw [← hfOrder i, ← hfOrder j] + exact hij + exact_mod_cast (neg_inj.mp hcast) + refine ⟨f, d, hfMem, hfNe, hfOrder, hdInjective, ?_, ?_⟩ + · intro i + cases i with + | none => simp [d] + | some i => simpa [d] using (hd₀Range i).2 + · exact linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order + K L P f hfNe horderInjective + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean new file mode 100644 index 0000000000..27df79589c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean @@ -0,0 +1,175 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +import Mathlib.Tactic + +/-! +# One-point Stepanov grids from a full Riemann-space basis + +The usual mixed-order grid chooses both tensor factors at distinct strict +levels. For a place of degree greater than one, that discards most of the +second Riemann space. This file proves that the second family may instead +be any linearly independent family. + +Group a relation by the first index. Frobenius linearity turns each row +into `u i * Frobenius (row i)`. Every nonzero such term has order + +`-d i + (#K) * order (row i)`. + +The digits `d i < #K` are distinct, so these orders remain distinct modulo +`#K`, independently of the orders of the rows. A unique least-order term +then rules out a nontrivial relation. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial BigOperators + +noncomputable section + +section FrobeniusInjectivity + +variable (K A : Type*) [Field K] [Fintype K] + [Field A] [Algebra K A] + +/-- Frobenius iteration is injective on a field. -/ +theorem powCardLinearMap_injective (n : ℕ) : + Function.Injective (powCardLinearMap K A n) := by + exact (powCardAlgHom K A n).injective + +end FrobeniusInjectivity + +private theorem digit_eq_of_neg_add_mul_eq + {s d e : ℕ} (hd : d < s) (he : e < s) + {a b : ℤ} + (h : -(d : ℤ) + (s : ℤ) * a = -(e : ℤ) + (s : ℤ) * b) : + d = e := by + have hdiv : (s : ℤ) ∣ (d : ℤ) - (e : ℤ) := by + refine ⟨a - b, ?_⟩ + linarith + have habs : |(d : ℤ) - (e : ℤ)| < (s : ℤ) := by + rw [abs_lt] + constructor <;> omega + have hzero := Int.eq_zero_of_abs_lt_dvd hdiv habs + exact_mod_cast (sub_eq_zero.mp hzero) + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance basisGridConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance basisGridConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A bounded distinct first pole-order digit and an arbitrary linearly +independent second family produce a linearly independent Frobenius product +grid. -/ +theorem onePointStepanovBasisGrid_linearIndependent + {α β : Type*} [Fintype α] [Fintype β] + (P : FiniteExtensionPlace K L) + (u : α → L) (d : α → ℕ) (v : β → L) + (hu : ∀ i, u i ≠ 0) + (huOrder : ∀ i, + finiteExtensionPrincipalDivisor K L (u i) P = -(d i : ℤ)) + (hdInjective : Function.Injective d) + (hdigit : ∀ i, d i < Fintype.card K) + (hvLI : LinearIndependent K v) : + LinearIndependent K + (fun ij : α × β => u ij.1 * (v ij.2) ^ Fintype.card K) := by + classical + rw [Fintype.linearIndependent_iff] + intro c hrelation ij + by_contra hcZero + let row : α → L := fun i => ∑ j, c (i, j) • v j + have hrowNe : row ij.1 ≠ 0 := by + intro hzero + have hcoeff := (Fintype.linearIndependent_iff.mp hvLI) + (fun j => c (ij.1, j)) hzero ij.2 + exact hcZero hcoeff + let S : Finset α := Finset.univ.filter (fun i => row i ≠ 0) + have hijS : ij.1 ∈ S := by simp [S, hrowNe] + have hSnonempty : S.Nonempty := ⟨ij.1, hijS⟩ + let term : α → L := fun i => + u i * powCardLinearMap K L 1 (row i) + have htermNe : ∀ i ∈ S, term i ≠ 0 := by + intro i hi + have hpowNe : powCardLinearMap K L 1 (row i) ≠ 0 := by + intro hzero + apply (Finset.mem_filter.mp hi).2 + apply powCardLinearMap_injective K L 1 + simpa using hzero + exact mul_ne_zero (hu i) hpowNe + have htermOrder (i : α) (hi : i ∈ S) : + finiteExtensionPrincipalDivisor K L (term i) P = + -(d i : ℤ) + (Fintype.card K : ℤ) * + finiteExtensionPrincipalDivisor K L (row i) P := by + change finiteExtensionPrincipalDivisor K L + (u i * powCardLinearMap K L 1 (row i)) P = _ + have hpowNe : powCardLinearMap K L 1 (row i) ≠ 0 := by + intro hzero + apply (Finset.mem_filter.mp hi).2 + apply powCardLinearMap_injective K L 1 + simpa using hzero + rw [finiteExtensionPrincipalDivisor_mul K L _ _ (hu i) hpowNe] + simp only [Finsupp.add_apply] + rw [finiteExtensionPrincipalDivisor_powCardLinearMap_apply K L + (row i) ((Finset.mem_filter.mp hi).2) 1 P, + huOrder i] + simp + have htermOrderInjective : ∀ i ∈ S, ∀ j ∈ S, + finiteExtensionPrincipalDivisor K L (term i) P = + finiteExtensionPrincipalDivisor K L (term j) P → i = j := by + intro i hi j hj hij + apply hdInjective + apply digit_eq_of_neg_add_mul_eq (hdigit i) (hdigit j) + rw [← htermOrder i hi, ← htermOrder j hj] + exact hij + have hsumRelation : ∑ i ∈ S, term i = 0 := by + calc + ∑ i ∈ S, term i = ∑ i, term i := by + apply Finset.sum_subset (Finset.subset_univ S) + intro i _ hi + have hrowZero : row i = 0 := by + simpa only [S, Finset.mem_filter, Finset.mem_univ, true_and, + not_ne_iff] using hi + simp [term, hrowZero] + _ = ∑ i, ∑ j, c (i, j) • + (u i * (v j) ^ Fintype.card K) := by + apply Finset.sum_congr rfl + intro i _ + simp only [term, row, map_sum, map_smul, + powCardLinearMap_apply, pow_one, Finset.mul_sum] + apply Finset.sum_congr rfl + intro j _ + simp only [Algebra.smul_def] + ring + _ = ∑ p : α × β, c p • + (u p.1 * (v p.2) ^ Fintype.card K) := by + rw [Fintype.sum_prod_type] + _ = 0 := hrelation + obtain ⟨i, hiS, hileast⟩ := S.exists_min_image + (fun j => finiteExtensionPrincipalDivisor K L (term j) P) hSnonempty + have htermMin : ∀ j ∈ S, j ≠ i → + finiteExtensionPrincipalDivisor K L (term i) P < + finiteExtensionPrincipalDivisor K L (term j) P := by + intro j hj hji + exact lt_of_le_of_ne (hileast j hj) + (fun heq => hji (htermOrderInjective j hj i hiS heq.symm)) + exact False.elim ((finiteExtensionPrincipalDivisor_sum_eq_of_unique_min + K L P S term i hiS htermNe htermMin).1 hsumRelation) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean new file mode 100644 index 0000000000..09e9c025d4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean @@ -0,0 +1,241 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +import Mathlib.Tactic + +/-! +# Stepanov auxiliaries at places of degree at most two + +At a degree-two place the strict-level filtration can jump by two. Choosing +one section per strict level for both tensor factors therefore loses the +factor of two needed by the Stepanov dimension count. The first factor still +uses bounded distinct pole-order digits, while the second factor is now a +full basis of its one-point Riemann space. The basis-grid theorem proves +that the first restriction remains injective. + +With `ell = #K - 1` and `m = #K + 2g`, the same large-field hypothesis as in +the degree-one construction makes the coefficient dimension exceed the +second restriction target for every place degree `r ≤ 2`. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance degreeTwoAuxiliaryConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance degreeTwoAuxiliaryConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The one-point Riemann space at level `N` has dimension at most +`N * degree(P) + 1` when the constants are exactly `K`. -/ +theorem finiteExtensionOnePointRiemannSpace_finrank_upper + (P : FiniteExtensionPlace K L) + (hconstants : algebraicClosure K L = ⊥) : + ∀ N, Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P N) ≤ + N * finiteExtensionPlaceDegree K L P + 1 := by + intro N + induction N with + | zero => + simpa using + (finiteExtensionOnePointRiemannSpace_zero_finrank K L P hconstants).le + | succ N ih => + have hstep := finiteExtensionOnePointRiemannSpace_finrank_succ_le + K L P N + calc + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (N + 1)) ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P N) + + finiteExtensionPlaceDegree K L P := hstep + _ ≤ (N * finiteExtensionPlaceDegree K L P + 1) + + finiteExtensionPlaceDegree K L P := + Nat.add_le_add_right ih _ + _ = (N + 1) * finiteExtensionPlaceDegree K L P + 1 := by + rw [Nat.add_mul] + omega + +/-- The full-basis Stepanov coefficient space beats the target dimension at +every positive place degree at most two. -/ +theorem stepanov_dimension_inequality_degree_le_two + {g s r : ℕ} (hlarge : (g + 1) * (g + 2) ≤ s) + (hrpos : 0 < r) (hrle : r ≤ 2) : + r * (s * stepanovEll s + stepanovM g s) + 1 < + (stepanovEll s + 1 - g) * + (r * stepanovM g s + 1 - g) := by + have hr : r = 1 ∨ r = 2 := by omega + rcases hr with rfl | rfl + · simpa only [one_mul, Nat.mul_comm s (stepanovEll s)] using + (stepanov_dimension_inequality hlarge) + · have hs : 0 < s := by nlinarith + have hgs : g ≤ s := by nlinarith + have hell : stepanovEll s + 1 - g = s - g := by + simp only [stepanovEll] + omega + have hm : 2 * stepanovM g s + 1 - g = 2 * s + 3 * g + 1 := by + simp only [stepanovM] + omega + have hleft : 2 * (s * stepanovEll s + stepanovM g s) + 1 = + 2 * s ^ 2 + 4 * g + 1 := by + simp only [stepanovEll, stepanovM] + nlinarith [Nat.sub_add_cancel (show 1 ≤ s by omega)] + rw [hell, hm, hleft] + have hlargeZ : (((g + 1) * (g + 2) : ℕ) : ℤ) ≤ (s : ℤ) := by + exact_mod_cast hlarge + have hgoalZ : + ((2 * s ^ 2 + 4 * g + 1 : ℕ) : ℤ) < + (((s - g) * (2 * s + 3 * g + 1) : ℕ) : ℤ) := by + rw [Nat.cast_mul, Nat.cast_sub hgs] + push_cast at hlargeZ ⊢ + nlinarith [sq_nonneg (g : ℤ), + mul_nonneg (by positivity : (0 : ℤ) ≤ g) (sq_nonneg (g : ℤ))] + exact_mod_cast hgoalZ + +/-- A Riemann lower bound at a place of degree at most two produces a +nonzero Stepanov coefficient grid. The first family has bounded distinct +pole orders; the second family is a full basis of `L(mP)`. + +The returned second restriction equality is in the ambient function field, +so it can be consumed directly by the local square-Frobenius vanishing +argument. -/ +theorem exists_onePointStepanovBasisAuxiliary_of_degree_le_two + (P : FiniteExtensionPlace K L) (g : ℕ) + (hconstants : algebraicClosure K L = ⊥) + (hdegreeLe : finiteExtensionPlaceDegree K L P ≤ 2) + (hriemann : ∀ N, + N * finiteExtensionPlaceDegree K L P + 1 ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P N) + g) + (hlarge : (g + 1) * (g + 2) ≤ Fintype.card K) : + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM g s + let V := finiteExtensionOnePointRiemannSpace K L P m + ∃ (u : Option (Fin (ell - g)) → L) + (du : Option (Fin (ell - g)) → ℕ) + (v : Fin (Module.finrank K V) → L) + (c : (Option (Fin (ell - g)) × + Fin (Module.finrank K V)) →₀ K), + (∀ i, u i ∈ finiteExtensionOnePointRiemannSpace K L P ell) ∧ + (∀ i, u i ≠ 0) ∧ + (∀ i, finiteExtensionPrincipalDivisor K L (u i) P = -(du i : ℤ)) ∧ + Function.Injective du ∧ + (∀ i, du i ≤ ell) ∧ + LinearIndependent K u ∧ + (∀ j, v j ∈ V) ∧ + LinearIndependent K v ∧ + c ≠ 0 ∧ + onePointStepanovSecondRestrictionMap K L u v s c = 0 ∧ + onePointStepanovFirstRestrictionMap K L u v s c ≠ 0 := by + let r := finiteExtensionPlaceDegree K L P + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM g s + let V := finiteExtensionOnePointRiemannSpace K L P m + have hrpos : 0 < r := finiteExtensionPlaceDegree_pos K L P + have hrle : r ≤ 2 := hdegreeLe + have hlarge' : (g + 1) * (g + 2) ≤ s := hlarge + have hgltS : g < s := by nlinarith + have hgell : g ≤ ell := by + simp only [ell, stepanovEll] + omega + have helllt : ell < s := stepanovEll_lt hlarge' + have hellDecomp : ell = (ell - g) + g := by omega + have hstrictLower : + 1 + r * (ell - g) ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P ell) := by + have hcoarse := hriemann ell + change ell * r + 1 ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P ell) + g at hcoarse + have hellMul : ell * r = (ell - g) * r + g * r := by + calc + ell * r = ((ell - g) + g) * r := by rw [← hellDecomp] + _ = (ell - g) * r + g * r := Nat.add_mul _ _ _ + rw [hellMul] at hcoarse + have hgr : g ≤ g * r := Nat.le_mul_of_pos_right g hrpos + have htarget : 1 + (ell - g) * r ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P ell) := by + omega + simpa only [Nat.mul_comm r (ell - g)] using htarget + have hstrict : ell - g ≤ + (strictFiltrationLevels + (fun n => finiteExtensionOnePointRiemannSpace K L P n) ell).card := + le_card_onePointStrictLevels_of_finrank_lower + K L P ell (ell - g) hconstants hstrictLower + obtain ⟨u, du, huMem, huNe, huOrder, hduInjective, hduLe, huLI⟩ := + exists_onePointSectionsWithConstant_of_le_card_strictLevels + K L P ell (ell - g) hstrict + letI : Module.Finite K V := + finiteExtensionOnePointRiemannSpace_moduleFinite K L P m + let b := Module.finBasis K V + let v : Fin (Module.finrank K V) → L := fun j => (b j : V) + have hvMem : ∀ j, v j ∈ V := fun j => (b j).property + have hvLI : LinearIndependent K v := by + rw [Fintype.linearIndependent_iff] + intro c hc j + apply (Fintype.linearIndependent_iff.mp b.linearIndependent c) _ j + apply V.subtype_injective + simpa only [map_sum, map_smul, map_zero, Submodule.subtype_apply, v] + using hc + have hgridLI : LinearIndependent K + (fun ij : Option (Fin (ell - g)) × Fin (Module.finrank K V) => + u ij.1 * (v ij.2) ^ s) := by + exact onePointStepanovBasisGrid_linearIndependent K L P u du v + huNe huOrder hduInjective (fun i => (hduLe i).trans_lt helllt) hvLI + have hupper : Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (s * ell + m)) ≤ + r * (s * ell + m) + 1 := by + have h := finiteExtensionOnePointRiemannSpace_finrank_upper + K L P hconstants (s * ell + m) + simpa only [r, Nat.mul_comm] using h + have hVlower : r * m + 1 - g ≤ Module.finrank K V := by + have h := hriemann m + simpa only [r, V, Nat.mul_comm] using (Nat.sub_le_iff_le_add.mpr h) + have hfirstCard : ell - g + 1 = ell + 1 - g := by omega + have hnumericBase := stepanov_dimension_inequality_degree_le_two + hlarge' hrpos hrle + have hnumeric : r * (s * ell + m) + 1 < + Fintype.card (Option (Fin (ell - g))) * + Fintype.card (Fin (Module.finrank K V)) := by + simp only [Fintype.card_option, Fintype.card_fin, hfirstCard] + exact hnumericBase.trans_le + (Nat.mul_le_mul_left (ell + 1 - g) hVlower) + obtain ⟨c, hcNe, hsecond, hfirst⟩ := + exists_onePointStepanovAuxiliary_of_target_finrank_upper + K L P u v ell m s (r * (s * ell + m) + 1) + huMem hvMem hgridLI hupper hnumeric + have hsecondRaw : + onePointStepanovSecondRestrictionMap K L u v s c = 0 := by + have h := congrArg Subtype.val hsecond + simpa only [onePointStepanovSecondCodRestrictionMap_coe, + Submodule.coe_zero] using h + exact ⟨u, du, v, c, huMem, huNe, huOrder, hduInjective, hduLe, + huLI, hvMem, hvLI, hcNe, hsecondRaw, hfirst⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean new file mode 100644 index 0000000000..9691e06925 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean @@ -0,0 +1,292 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +import Mathlib.Tactic + +/-! +# One-point Stepanov grids + +At an arbitrary exhaustive place, a finite family of nonzero functions with +pairwise distinct principal-divisor orders is linearly independent over the +constant field. Applying this to products whose pole orders use a +mixed-radix encoding gives the one-point Stepanov grid. + +The distinguished place is not assumed to have degree one. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance onePointStepanovGridConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance onePointStepanovGridConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Multiplication by a nonzero constant does not change the order at an +exhaustive place. -/ +theorem finiteExtensionPrincipalDivisor_smul_apply + (P : FiniteExtensionPlace K L) (c : K) (x : L) + (hc : c ≠ 0) (hx : x ≠ 0) : + finiteExtensionPrincipalDivisor K L (c • x) P = + finiteExtensionPrincipalDivisor K L x P := by + have hcL : algebraMap K L c ≠ 0 := + by simpa only [map_zero] using (algebraMap K L).injective.ne hc + rw [Algebra.smul_def, + finiteExtensionPrincipalDivisor_mul K L _ _ hcL hx, + finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc] + simp + +/-- If one summand has strictly smaller order than the other, then the sum is +nonzero and has the smaller order. -/ +theorem finiteExtensionPrincipalDivisor_add_eq_left_of_lt + (P : FiniteExtensionPlace K L) (x y : L) + (hx : x ≠ 0) (hy : y ≠ 0) + (hxyOrder : finiteExtensionPrincipalDivisor K L x P < + finiteExtensionPrincipalDivisor K L y P) : + x + y ≠ 0 ∧ + finiteExtensionPrincipalDivisor K L (x + y) P = + finiteExtensionPrincipalDivisor K L x P := by + have hxy : x + y ≠ 0 := by + intro hzero + have hyx : y = -x := + eq_neg_of_add_eq_zero_left (by simpa only [add_comm] using hzero) + have hneg := finiteExtensionPrincipalDivisor_neg_apply K L x hx P + rw [hyx, hneg] at hxyOrder + exact (lt_irrefl _ hxyOrder) + have hlower := finiteExtensionPrincipalDivisor_add_ge_min + K L x y hx hy hxy P + rw [min_eq_left (le_of_lt hxyOrder)] at hlower + have hreverse := finiteExtensionPrincipalDivisor_add_ge_min + K L (x + y) (-y) hxy (neg_ne_zero.mpr hy) + (by simpa only [add_neg_cancel_right] using hx) P + rw [show (x + y) + (-y) = x by ring, + finiteExtensionPrincipalDivisor_neg_apply K L y hy P] at hreverse + have hsumLeY : + finiteExtensionPrincipalDivisor K L (x + y) P ≤ + finiteExtensionPrincipalDivisor K L y P := by + by_contra hnot + have hyLeSum : finiteExtensionPrincipalDivisor K L y P ≤ + finiteExtensionPrincipalDivisor K L (x + y) P := le_of_not_ge hnot + rw [min_eq_right hyLeSum] at hreverse + omega + rw [min_eq_left hsumLeY] at hreverse + exact ⟨hxy, le_antisymm hreverse hlower⟩ + +/-- If every summand has order strictly above `a`, then their finite sum is +either zero or also has order strictly above `a`. -/ +theorem finiteExtensionPrincipalDivisor_sum_eq_zero_or_gt + {ι : Type*} (P : FiniteExtensionPlace K L) + (S : Finset ι) (f : ι → L) (a : ℤ) + (hf : ∀ i ∈ S, f i ≠ 0) + (horder : ∀ i ∈ S, a < finiteExtensionPrincipalDivisor K L (f i) P) : + (∑ i ∈ S, f i) = 0 ∨ + ((∑ i ∈ S, f i) ≠ 0 ∧ + a < finiteExtensionPrincipalDivisor K L (∑ i ∈ S, f i) P) := by + classical + induction S using Finset.induction_on with + | empty => simp + | @insert i S hi ih => + rw [Finset.sum_insert hi] + have hi0 : f i ≠ 0 := hf i (Finset.mem_insert_self i S) + have hiOrder : a < finiteExtensionPrincipalDivisor K L (f i) P := + horder i (Finset.mem_insert_self i S) + have hrest := ih + (fun j hj => hf j (Finset.mem_insert_of_mem hj)) + (fun j hj => horder j (Finset.mem_insert_of_mem hj)) + rcases hrest with hrestZero | ⟨hrest0, hrestOrder⟩ + · rw [hrestZero, add_zero] + exact Or.inr ⟨hi0, hiOrder⟩ + · by_cases hsum : f i + ∑ j ∈ S, f j = 0 + · exact Or.inl hsum + · refine Or.inr ⟨hsum, ?_⟩ + have hlower := finiteExtensionPrincipalDivisor_add_ge_min + K L (f i) (∑ j ∈ S, f j) hi0 hrest0 hsum P + exact (lt_min hiOrder hrestOrder).trans_le hlower + +/-- A unique least-order term controls a finite sum. -/ +theorem finiteExtensionPrincipalDivisor_sum_eq_of_unique_min + {ι : Type*} (P : FiniteExtensionPlace K L) + (S : Finset ι) (f : ι → L) (i : ι) (hi : i ∈ S) + (hf : ∀ j ∈ S, f j ≠ 0) + (hmin : ∀ j ∈ S, j ≠ i → + finiteExtensionPrincipalDivisor K L (f i) P < + finiteExtensionPrincipalDivisor K L (f j) P) : + (∑ j ∈ S, f j) ≠ 0 ∧ + finiteExtensionPrincipalDivisor K L (∑ j ∈ S, f j) P = + finiteExtensionPrincipalDivisor K L (f i) P := by + classical + let T := S.erase i + let r : L := ∑ j ∈ T, f j + have hrest := finiteExtensionPrincipalDivisor_sum_eq_zero_or_gt + K L P T f (finiteExtensionPrincipalDivisor K L (f i) P) + (fun j hj => hf j (Finset.mem_of_mem_erase hj)) + (fun j hj => hmin j (Finset.mem_of_mem_erase hj) + (Finset.ne_of_mem_erase hj)) + have hsum : (∑ j ∈ S, f j) = f i + r := by + rw [← Finset.sum_erase_add S f hi] + simp only [T, r] + ac_rfl + rcases hrest with hrestZero | ⟨hrest0, hrestOrder⟩ + · change r = 0 at hrestZero + rw [hsum, hrestZero, add_zero] + exact ⟨hf i hi, rfl⟩ + · change r ≠ 0 at hrest0 + change finiteExtensionPrincipalDivisor K L (f i) P < + finiteExtensionPrincipalDivisor K L r P at hrestOrder + rw [hsum] + exact finiteExtensionPrincipalDivisor_add_eq_left_of_lt + K L P (f i) r (hf i hi) hrest0 hrestOrder + +/-- A finite family of nonzero functions with pairwise distinct orders at one +exhaustive place is linearly independent over the constant field. -/ +theorem linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order + {ι : Type*} [Fintype ι] + (P : FiniteExtensionPlace K L) (f : ι → L) + (hf : ∀ i, f i ≠ 0) + (horder : Function.Injective + (fun i => finiteExtensionPrincipalDivisor K L (f i) P)) : + LinearIndependent K f := by + classical + rw [Fintype.linearIndependent_iff] + intro c hrelation + by_contra hnotZero + push Not at hnotZero + obtain ⟨i0, hi0⟩ := hnotZero + let S : Finset ι := Finset.univ.filter (fun i => c i ≠ 0) + have hSnonempty : S.Nonempty := by + exact ⟨i0, by simp [S, hi0]⟩ + obtain ⟨i, hiS, hileast⟩ := S.exists_min_image + (fun j => finiteExtensionPrincipalDivisor K L (f j) P) hSnonempty + let term : ι → L := fun j => c j • f j + have hterm0 : ∀ j ∈ S, term j ≠ 0 := by + intro j hj + have hcj : c j ≠ 0 := (Finset.mem_filter.mp hj).2 + change c j • f j ≠ 0 + rw [Algebra.smul_def] + exact mul_ne_zero + (by simpa only [map_zero] using (algebraMap K L).injective.ne hcj) + (hf j) + have htermOrder (j : ι) (hj : j ∈ S) : + finiteExtensionPrincipalDivisor K L (term j) P = + finiteExtensionPrincipalDivisor K L (f j) P := by + exact finiteExtensionPrincipalDivisor_smul_apply + K L P (c j) (f j) (Finset.mem_filter.mp hj).2 (hf j) + have htermMin : ∀ j ∈ S, j ≠ i → + finiteExtensionPrincipalDivisor K L (term i) P < + finiteExtensionPrincipalDivisor K L (term j) P := by + intro j hj hji + rw [htermOrder i hiS, htermOrder j hj] + exact lt_of_le_of_ne (hileast j hj) + (fun heq => hji (horder heq).symm) + have hsumNonzero := + (finiteExtensionPrincipalDivisor_sum_eq_of_unique_min + K L P S term i hiS hterm0 htermMin).1 + apply hsumNonzero + calc + (∑ j ∈ S, term j) = ∑ j, term j := by + apply Finset.sum_subset (Finset.subset_univ S) + intro j _hjUniv hjNotS + have hcj : c j = 0 := by + simp only [S, Finset.mem_filter, Finset.mem_univ, true_and, + not_ne_iff] at hjNotS + exact hjNotS + simp [term, hcj] + _ = 0 := by simpa only [term] using hrelation + +/-- Mixed-radix encoding of two pole-order digits. -/ +def onePointStepanovMixedOrder + {ι κ : Type*} (d : ι → ℕ) (e : κ → ℕ) (s : ℕ) + (ij : ι × κ) : ℕ := + d ij.1 + s * e ij.2 + +/-- If the first digit is strictly below the radix, the mixed pole-order +encoding is injective. -/ +theorem onePointStepanovMixedOrder_injective + {ι κ : Type*} (d : ι → ℕ) (e : κ → ℕ) (s : ℕ) + (hd : Function.Injective d) (he : Function.Injective e) + (hdigit : ∀ i, d i < s) : + Function.Injective (onePointStepanovMixedOrder d e s) := by + rintro ⟨i, j⟩ ⟨i', j'⟩ h + have hs : 0 < s := lt_of_le_of_lt (Nat.zero_le (d i)) (hdigit i) + have hdEq : d i = d i' := by + have hmod := congrArg (fun n : ℕ => n % s) h + simpa only [onePointStepanovMixedOrder, Nat.add_mul_mod_self_left, + Nat.mod_eq_of_lt (hdigit i), Nat.mod_eq_of_lt (hdigit i')] using hmod + have hi : i = i' := hd hdEq + subst i' + have heEq : e j = e j' := by + have hmul : s * e j = s * e j' := Nat.add_left_cancel h + exact Nat.eq_of_mul_eq_mul_left hs hmul + exact Prod.ext rfl (he heEq) + +/-- Exact order of a product in the one-point Stepanov grid. -/ +theorem onePointStepanovGrid_order + {ι κ : Type*} (P : FiniteExtensionPlace K L) + (f : ι → L) (g : κ → L) (d : ι → ℕ) (e : κ → ℕ) (s : ℕ) + (hf : ∀ i, f i ≠ 0) (hg : ∀ j, g j ≠ 0) + (hfOrder : ∀ i, finiteExtensionPrincipalDivisor K L (f i) P = + -(d i : ℤ)) + (hgOrder : ∀ j, finiteExtensionPrincipalDivisor K L (g j) P = + -(e j : ℤ)) + (ij : ι × κ) : + finiteExtensionPrincipalDivisor K L + (f ij.1 * (g ij.2) ^ s) P = + -(onePointStepanovMixedOrder d e s ij : ℤ) := by + rw [finiteExtensionPrincipalDivisor_mul K L _ _ + (hf ij.1) (pow_ne_zero s (hg ij.2)), + finiteExtensionPrincipalDivisor_pow K L _ (hg ij.2) s] + simp only [Finsupp.add_apply, Finsupp.smul_apply, nsmul_eq_mul, + hfOrder, hgOrder, onePointStepanovMixedOrder] + push_cast + ring + +/-- Two strict-level families whose first pole-order digit is below `s` +produce a linearly independent Stepanov product grid. -/ +theorem onePointStepanovGrid_linearIndependent + {ι κ : Type*} [Fintype ι] [Fintype κ] + (P : FiniteExtensionPlace K L) + (f : ι → L) (g : κ → L) (d : ι → ℕ) (e : κ → ℕ) (s : ℕ) + (hf : ∀ i, f i ≠ 0) (hg : ∀ j, g j ≠ 0) + (hfOrder : ∀ i, finiteExtensionPrincipalDivisor K L (f i) P = + -(d i : ℤ)) + (hgOrder : ∀ j, finiteExtensionPrincipalDivisor K L (g j) P = + -(e j : ℤ)) + (hd : Function.Injective d) (he : Function.Injective e) + (hdigit : ∀ i, d i < s) : + LinearIndependent K (fun ij : ι × κ => f ij.1 * (g ij.2) ^ s) := by + apply linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order + K L P + · intro ij + exact mul_ne_zero (hf ij.1) (pow_ne_zero s (hg ij.2)) + · intro ij ij' horderEq + apply onePointStepanovMixedOrder_injective d e s hd he hdigit + have hcast : + -(onePointStepanovMixedOrder d e s ij : ℤ) = + -(onePointStepanovMixedOrder d e s ij' : ℤ) := by + rw [← onePointStepanovGrid_order K L P f g d e s + hf hg hfOrder hgOrder ij, + ← onePointStepanovGrid_order K L P f g d e s + hf hg hfOrder hgOrder ij'] + exact horderEq + exact_mod_cast (neg_inj.mp hcast) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean new file mode 100644 index 0000000000..6f412a16c4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean @@ -0,0 +1,231 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace + +/-! +# Strict levels in one-point filtrations + +This file separates the filtration-counting argument from any degree-one +leading-coefficient cancellation. For a nested filtration whose successive +finrank jumps are bounded by `d`, it bounds the final finrank by `d` times the +number of strict levels. A matching lower bound therefore forces many strict +levels. + +For the one-point Riemann filtration, a section that first appears at level +`n + 1` automatically has exact pole order `-(n + 1)`. Choosing one section +at every strict level gives a pairwise-distinct family of exact pole orders, +with no hypothesis on the degree of the distinguished place. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +variable {K L : Type*} [Field K] [AddCommGroup L] [Module K L] + +/-- Levels below `N` at which a nested filtration grows strictly. -/ +noncomputable def strictFiltrationLevels + (R : ℕ → Submodule K L) (N : ℕ) : Finset ℕ := by + classical + exact (Finset.range N).filter (fun n => R n < R (n + 1)) + +@[simp] +theorem strictFiltrationLevels_zero (R : ℕ → Submodule K L) : + strictFiltrationLevels R 0 = ∅ := by + simp [strictFiltrationLevels] + +theorem strictFiltrationLevels_succ_card_of_lt + (R : ℕ → Submodule K L) (n : ℕ) (h : R n < R (n + 1)) : + (strictFiltrationLevels R (n + 1)).card = + (strictFiltrationLevels R n).card + 1 := by + classical + simp only [strictFiltrationLevels, Finset.range_add_one, Finset.filter_insert] + rw [if_pos h, Finset.card_insert_of_notMem] + simp + +theorem strictFiltrationLevels_succ_card_of_not_lt + (R : ℕ → Submodule K L) (n : ℕ) (h : ¬ R n < R (n + 1)) : + (strictFiltrationLevels R (n + 1)).card = + (strictFiltrationLevels R n).card := by + classical + simp only [strictFiltrationLevels, Finset.range_add_one, Finset.filter_insert] + rw [if_neg h] + +/-- If every nontrivial step of a nested filtration has dimension increase at +most `d`, then the total dimension is bounded by `d` times the number of +strict steps, plus the initial dimension. -/ +theorem finrank_le_initial_add_mul_card_strictFiltrationLevels + (R : ℕ → Submodule K L) (d : ℕ) + (hnested : ∀ n, R n ≤ R (n + 1)) + (hjump : ∀ n, Module.finrank K (R (n + 1)) ≤ + Module.finrank K (R n) + d) : + ∀ N, Module.finrank K (R N) ≤ Module.finrank K (R 0) + + d * (strictFiltrationLevels R N).card := by + intro N + induction N with + | zero => simp + | succ n ih => + by_cases hstrict : R n < R (n + 1) + · calc + Module.finrank K (R (n + 1)) ≤ + Module.finrank K (R n) + d := hjump n + _ ≤ (Module.finrank K (R 0) + + d * (strictFiltrationLevels R n).card) + d := + Nat.add_le_add_right ih d + _ = Module.finrank K (R 0) + + d * (strictFiltrationLevels R (n + 1)).card := by + rw [strictFiltrationLevels_succ_card_of_lt R n hstrict] + simp [Nat.mul_add, Nat.add_assoc] + · have heq : R n = R (n + 1) := + eq_of_le_of_not_lt (hnested n) hstrict + calc + Module.finrank K (R (n + 1)) = Module.finrank K (R n) := by rw [← heq] + _ ≤ Module.finrank K (R 0) + + d * (strictFiltrationLevels R n).card := ih + _ = Module.finrank K (R 0) + + d * (strictFiltrationLevels R (n + 1)).card := by + rw [strictFiltrationLevels_succ_card_of_not_lt R n hstrict] + +/-- A lower dimension bound forces many strict filtration levels. -/ +theorem le_card_strictFiltrationLevels_of_initial_add_mul_le_finrank + (R : ℕ → Submodule K L) {d m N : ℕ} (hd : 0 < d) + (hnested : ∀ n, R n ≤ R (n + 1)) + (hjump : ∀ n, Module.finrank K (R (n + 1)) ≤ + Module.finrank K (R n) + d) + (hlower : Module.finrank K (R 0) + d * m ≤ + Module.finrank K (R N)) : + m ≤ (strictFiltrationLevels R N).card := by + have hupper := + finrank_le_initial_add_mul_card_strictFiltrationLevels + R d hnested hjump N + have hmul : d * m ≤ d * (strictFiltrationLevels R N).card := + Nat.le_of_add_le_add_left (hlower.trans hupper) + exact Nat.le_of_mul_le_mul_left hmul hd + +end + +end BGS.HasseWeil + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance strictLevelsConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance strictLevelsConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +private theorem exists_mem_not_mem_of_submodule_lt + {S T : Submodule K L} (h : S < T) : + ∃ x : L, x ∈ T ∧ x ∉ S := by + have hnotle : ¬ T ≤ S := not_le_of_gt h + by_contra hexists + apply hnotle + intro x hx + by_contra hxNot + exact hexists ⟨x, hx, hxNot⟩ + +/-- A section appearing for the first time at level `n + 1` has exact pole +order `-(n + 1)` at the distinguished place. No residue-degree hypothesis +is needed. -/ +theorem onePointRiemannSpace_order_eq_neg_succ_of_mem_not_mem + (P : FiniteExtensionPlace K L) (n : ℕ) {x : L} + (hxSucc : x ∈ finiteExtensionOnePointRiemannSpace K L P (n + 1)) + (hxNot : x ∉ finiteExtensionOnePointRiemannSpace K L P n) : + x ≠ 0 ∧ + finiteExtensionPrincipalDivisor K L x P = -((n + 1 : ℕ) : ℤ) := by + have hx0 : x ≠ 0 := by + intro hx + subst x + exact hxNot (Submodule.zero_mem _) + rcases + (mem_finiteExtensionOnePointRiemannSpace_iff K L P (n + 1) x).mp + hxSucc with + hx | ⟨_, hxLower, hxAway⟩ + · exact (hx0 hx).elim + · refine ⟨hx0, ?_⟩ + have hxNotLower : ¬ -(n : ℤ) ≤ + finiteExtensionPrincipalDivisor K L x P := by + intro hxLowerN + apply hxNot + rw [mem_finiteExtensionOnePointRiemannSpace_iff] + exact Or.inr ⟨hx0, hxLowerN, hxAway⟩ + have hxUpper : finiteExtensionPrincipalDivisor K L x P < -(n : ℤ) := + lt_of_not_ge hxNotLower + omega + +/-- Choose one section for every strict level below `N`. The chosen sections +have pairwise distinct exact pole orders, hence are themselves pairwise +distinct. -/ +theorem exists_onePointRiemannSpace_sections_indexed_by_strictLevels + (P : FiniteExtensionPlace K L) (N : ℕ) : + ∃ f : {n // n ∈ strictFiltrationLevels + (K := K) (L := L) + (fun m => finiteExtensionOnePointRiemannSpace K L P m) N} → L, + (∀ i, + f i ∈ finiteExtensionOnePointRiemannSpace K L P (i.1 + 1) ∧ + f i ∉ finiteExtensionOnePointRiemannSpace K L P i.1 ∧ + finiteExtensionPrincipalDivisor K L (f i) P = + -((i.1 + 1 : ℕ) : ℤ)) ∧ + Function.Injective f := by + classical + let I := {n // n ∈ strictFiltrationLevels + (K := K) (L := L) + (fun m => finiteExtensionOnePointRiemannSpace K L P m) N} + have hexists (i : I) : ∃ x : L, + x ∈ finiteExtensionOnePointRiemannSpace K L P (i.1 + 1) ∧ + x ∉ finiteExtensionOnePointRiemannSpace K L P i.1 ∧ + finiteExtensionPrincipalDivisor K L x P = + -((i.1 + 1 : ℕ) : ℤ) := by + have hiStrict : finiteExtensionOnePointRiemannSpace K L P i.1 < + finiteExtensionOnePointRiemannSpace K L P (i.1 + 1) := + (Finset.mem_filter.mp i.2).2 + obtain ⟨x, hxSucc, hxNot⟩ := + exists_mem_not_mem_of_submodule_lt K L hiStrict + obtain ⟨_, hxOrder⟩ := + onePointRiemannSpace_order_eq_neg_succ_of_mem_not_mem + K L P i.1 hxSucc hxNot + exact ⟨x, hxSucc, hxNot, hxOrder⟩ + let f : I → L := fun i => Classical.choose (hexists i) + have hf (i : I) : + f i ∈ finiteExtensionOnePointRiemannSpace K L P (i.1 + 1) ∧ + f i ∉ finiteExtensionOnePointRiemannSpace K L P i.1 ∧ + finiteExtensionPrincipalDivisor K L (f i) P = + -((i.1 + 1 : ℕ) : ℤ) := + Classical.choose_spec (hexists i) + refine ⟨f, hf, ?_⟩ + intro i j hij + apply Subtype.ext + have horders : -((i.1 + 1 : ℕ) : ℤ) = -((j.1 + 1 : ℕ) : ℤ) := by + calc + -((i.1 + 1 : ℕ) : ℤ) = + finiteExtensionPrincipalDivisor K L (f i) P := (hf i).2.2.symm + _ = finiteExtensionPrincipalDivisor K L (f j) P := by rw [hij] + _ = -((j.1 + 1 : ℕ) : ℤ) := (hf j).2.2 + omega + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean new file mode 100644 index 0000000000..3792885add --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib + +/-! +# Numerical transfer from normalization counts to affine counts + +The geometric comparison between an affine plane curve and its normalization +is naturally expressed by two inequalities between natural-number +cardinalities. This file isolates the real absolute-value bookkeeping needed +to combine those inequalities with the closed Hasse--Weil bound. +-/ + +namespace BGS.HasseWeil + +/-- If the affine and normalization counts differ by at most `error` in both +directions, then a Hasse--Weil bound for the normalization transfers to the +affine count, with the affine/projective constant `1` and `error` added. -/ +theorem abs_affine_sub_card_le_of_two_sided_count_comparison + (affine normalization fieldCard error : ℕ) + (upper : affine ≤ normalization + error) + (lower : normalization ≤ affine + error) + (bound : ℝ) + (hnormalization : + |(normalization : ℝ) - (fieldCard : ℝ) - 1| ≤ bound) : + |(affine : ℝ) - (fieldCard : ℝ)| ≤ bound + error + 1 := by + have hupperReal : + (affine : ℝ) - normalization ≤ error := by + have h : (affine : ℝ) ≤ normalization + error := by + exact_mod_cast upper + linarith + have hlowerReal : + -(error : ℝ) ≤ (affine : ℝ) - normalization := by + have h : (normalization : ℝ) ≤ affine + error := by + exact_mod_cast lower + linarith + have hcomparison : + |(affine : ℝ) - normalization| ≤ error := + abs_le.mpr ⟨hlowerReal, hupperReal⟩ + calc + |(affine : ℝ) - fieldCard| = + |((affine : ℝ) - normalization) + + ((normalization : ℝ) - fieldCard - 1) + 1| := by ring_nf + _ ≤ |(affine : ℝ) - normalization| + + |(normalization : ℝ) - fieldCard - 1| + |(1 : ℝ)| := + calc + |((affine : ℝ) - normalization) + + ((normalization : ℝ) - fieldCard - 1) + 1| ≤ + |((affine : ℝ) - normalization) + + ((normalization : ℝ) - fieldCard - 1)| + |(1 : ℝ)| := + abs_add_le _ _ + _ ≤ (|(affine : ℝ) - normalization| + + |(normalization : ℝ) - fieldCard - 1|) + |(1 : ℝ)| := + add_le_add (abs_add_le _ _) le_rfl + _ ≤ (error : ℝ) + bound + 1 := by + exact add_le_add (add_le_add hcomparison hnormalization) (by norm_num) + _ = bound + error + 1 := by ring + +/-- Large-degree branch of the affine estimate. A trivial fiber bound by +`fieldCard * smallDegree` already has Hasse--Weil scale whenever the other +coordinate degree is at least `sqrt fieldCard`. -/ +theorem abs_pointCount_sub_card_le_two_mul_sqrt_of_fiber_bound + (pointCount fieldCard smallDegree largeDegree : ℕ) + (hsmall : 0 < smallDegree) + (hcount : pointCount ≤ fieldCard * smallDegree) + (hlarge : Real.sqrt (fieldCard : ℝ) ≤ largeDegree) : + |(pointCount : ℝ) - fieldCard| ≤ + 2 * Real.sqrt (fieldCard : ℝ) * smallDegree * largeDegree := by + have hcountReal : (pointCount : ℝ) ≤ fieldCard * smallDegree := by + exact_mod_cast hcount + have hsmallReal : (1 : ℝ) ≤ smallDegree := by + exact_mod_cast hsmall + have hfieldNonneg : (0 : ℝ) ≤ fieldCard := by positivity + have hsqrtNonneg : 0 ≤ Real.sqrt (fieldCard : ℝ) := Real.sqrt_nonneg _ + have hsqrtSquare : + Real.sqrt (fieldCard : ℝ) * Real.sqrt (fieldCard : ℝ) = fieldCard := + Real.mul_self_sqrt hfieldNonneg + calc + |(pointCount : ℝ) - fieldCard| ≤ + |(pointCount : ℝ)| + |(fieldCard : ℝ)| := abs_sub _ _ + _ = (pointCount : ℝ) + fieldCard := by + rw [abs_of_nonneg (by positivity), abs_of_nonneg hfieldNonneg] + _ ≤ (fieldCard : ℝ) * smallDegree + fieldCard := by gcongr + _ ≤ 2 * (fieldCard : ℝ) * smallDegree := by nlinarith + _ = 2 * (Real.sqrt (fieldCard : ℝ) * + Real.sqrt (fieldCard : ℝ)) * smallDegree := by rw [hsqrtSquare] + _ = (2 * Real.sqrt (fieldCard : ℝ) * smallDegree) * + Real.sqrt (fieldCard : ℝ) := by ring + _ ≤ (2 * Real.sqrt (fieldCard : ℝ) * smallDegree) * largeDegree := + mul_le_mul_of_nonneg_left hlarge (by positivity) + _ = 2 * Real.sqrt (fieldCard : ℝ) * smallDegree * largeDegree := by ring + +/-- In the small-degree branch, the explicit resultant bound for the +second-coordinate critical locus is already of Hasse--Weil scale. -/ +theorem criticalCount_le_two_mul_sqrt + (criticalCount fieldCard firstDegree secondDegree : ℕ) + (hcritical : criticalCount ≤ + ((2 * secondDegree - 1) * firstDegree) * secondDegree) + (hsecond : (secondDegree : ℝ) ≤ Real.sqrt (fieldCard : ℝ)) : + (criticalCount : ℝ) ≤ + 2 * Real.sqrt (fieldCard : ℝ) * firstDegree * secondDegree := by + have hcoarseNat : criticalCount ≤ + (2 * secondDegree * firstDegree) * secondDegree := by + calc + criticalCount ≤ ((2 * secondDegree - 1) * firstDegree) * secondDegree := + hcritical + _ ≤ (2 * secondDegree * firstDegree) * secondDegree := + Nat.mul_le_mul_right secondDegree + (Nat.mul_le_mul_right firstDegree (Nat.sub_le _ _)) + have hcoarse : (criticalCount : ℝ) ≤ + (2 * secondDegree * firstDegree) * secondDegree := by + exact_mod_cast hcoarseNat + calc + (criticalCount : ℝ) ≤ + (2 * secondDegree * firstDegree) * secondDegree := hcoarse + _ = (2 * firstDegree * secondDegree) * secondDegree := by ring + _ ≤ (2 * firstDegree * secondDegree) * + Real.sqrt (fieldCard : ℝ) := + mul_le_mul_of_nonneg_left hsecond (by positivity) + _ = 2 * Real.sqrt (fieldCard : ℝ) * firstDegree * secondDegree := by ring + +/-- The coarse zeta numerator degree budget is bounded by three times the +bidegree product, which is sufficient for a universal affine coefficient. -/ +theorem zetaDegree_mul_sqrt_le_three_mul_bidegree + (zetaDegree fieldCard firstDegree secondDegree : ℕ) + (hfirst : 0 < firstDegree) (hsecond : 0 < secondDegree) + (hdegree : zetaDegree ≤ + 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1) : + (zetaDegree : ℝ) * Real.sqrt (fieldCard : ℝ) ≤ + 3 * Real.sqrt (fieldCard : ℝ) * firstDegree * secondDegree := by + have hbudget : (firstDegree - 1) * (secondDegree - 1) ≤ + firstDegree * secondDegree := + Nat.mul_le_mul (Nat.sub_le _ _) (Nat.sub_le _ _) + have hone : 1 ≤ firstDegree * secondDegree := Nat.mul_pos hfirst hsecond + have hdegreeCoarse : zetaDegree ≤ 3 * (firstDegree * secondDegree) := by + calc + zetaDegree ≤ 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1 := hdegree + _ ≤ 2 * (firstDegree * secondDegree) + 1 := by omega + _ ≤ 3 * (firstDegree * secondDegree) := by omega + have hdegreeReal : (zetaDegree : ℝ) ≤ + 3 * (firstDegree * secondDegree : ℕ) := by exact_mod_cast hdegreeCoarse + have hsqrtNonneg : 0 ≤ Real.sqrt (fieldCard : ℝ) := Real.sqrt_nonneg _ + calc + (zetaDegree : ℝ) * Real.sqrt (fieldCard : ℝ) ≤ + (3 * (firstDegree * secondDegree : ℕ) : ℝ) * + Real.sqrt (fieldCard : ℝ) := + mul_le_mul_of_nonneg_right hdegreeReal hsqrtNonneg + _ = 3 * Real.sqrt (fieldCard : ℝ) * firstDegree * secondDegree := by + push_cast + ring + +/-- The constant affine/projective correction `1` is absorbed by the +square-root bidegree scale over every nontrivial finite field. -/ +theorem one_le_sqrt_mul_bidegree + (fieldCard firstDegree secondDegree : ℕ) + (hfield : 1 ≤ fieldCard) + (hfirst : 0 < firstDegree) (hsecond : 0 < secondDegree) : + (1 : ℝ) ≤ Real.sqrt (fieldCard : ℝ) * firstDegree * secondDegree := by + have hsqrt : (1 : ℝ) ≤ Real.sqrt (fieldCard : ℝ) := by + exact Real.one_le_sqrt.mpr (by exact_mod_cast hfield) + have hfirstReal : (1 : ℝ) ≤ firstDegree := by exact_mod_cast hfirst + have hsecondReal : (1 : ℝ) ≤ secondDegree := by exact_mod_cast hsecond + exact one_le_mul_of_one_le_of_one_le + (one_le_mul_of_one_le_of_one_le hsqrt hfirstReal) hsecondReal + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean new file mode 100644 index 0000000000..14c9c2cfbf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization + +/-! +# Elementary affine plane-curve fiber bounds + +For an irreducible plane curve with positive degree in one coordinate, every +fiber in that direction is cut out by a nonzero univariate polynomial. This +gives the two elementary bounds + +`#C(K) ≤ #K * degree_y(f)` and `#C(K) ≤ #K * degree_x(f)`. + +These estimates handle the large-bidegree branch of the final affine +Hasse--Weil theorem, where a trivial fiber count is stronger than carrying +normalization error terms. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + +/-- Affine points are the sigma type of their first coordinate and the roots +of the corresponding second-coordinate specialization. -/ +def affinePlaneCurvePointEquivSecondCoordinateRoots + (f : MvPolynomial (Fin 2) K) : + AffinePlaneCurvePoint f ≃ + Σ x : K, {y : K // (secondCoordinateSpecialization f x).eval y = 0} where + toFun z := ⟨z.1.1, ⟨z.1.2, by + rw [secondCoordinateSpecialization_eval] + exact z.2⟩⟩ + invFun z := ⟨(z.1, z.2.1), by + rw [← secondCoordinateSpecialization_eval] + exact z.2.2⟩ + left_inv z := by + apply Subtype.ext + rfl + right_inv z := by + cases z + rfl + +/-- Counting the roots in every first-coordinate fiber bounds all affine +points by the field cardinality times a second-coordinate degree bound. -/ +theorem affinePlaneCurvePoint_card_le_card_mul_of_degreeOf_second_le + {f : MvPolynomial (Fin 2) K} {secondDegree : ℕ} + (hf : Irreducible f) + (hsecond : 0 < MvPolynomial.degreeOf 1 f) + (hdegreeSecond : MvPolynomial.degreeOf 1 f ≤ secondDegree) : + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card K * secondDegree := by + let roots := fun x : K => + {y : K // (secondCoordinateSpecialization f x).eval y = 0} + have hFiber (x : K) : Fintype.card (roots x) ≤ secondDegree := + (polynomialEvalZeroSubtype_card_le_natDegree + (secondCoordinateSpecialization f x) + (secondCoordinateSpecialization_ne_zero_of_irreducible hf hsecond x)).trans + ((secondCoordinateSpecialization_natDegree_le_degreeOf_second f x).trans + hdegreeSecond) + calc + Fintype.card (AffinePlaneCurvePoint f) = + Fintype.card (Σ x : K, roots x) := + Fintype.card_congr (affinePlaneCurvePointEquivSecondCoordinateRoots f) + _ = ∑ x : K, Fintype.card (roots x) := Fintype.card_sigma + _ ≤ ∑ _x : K, secondDegree := + Finset.sum_le_sum fun x _ => hFiber x + _ = Fintype.card K * secondDegree := by simp + +/-- Public bidegree form of the second-coordinate fiber bound. -/ +theorem affinePlaneCurvePoint_card_le_card_mul_secondDegree + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card K * secondDegree := by + exact affinePlaneCurvePoint_card_le_card_mul_of_degreeOf_second_le + hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + (degreeOf_second_le_of_hasBidegreeAtMost hdegree) + +/-- Swapping the two affine coordinates identifies the point sets of `f` and +the coordinate-swapped polynomial. -/ +def affinePlaneCurvePointEquivSwap (f : MvPolynomial (Fin 2) K) : + AffinePlaneCurvePoint f ≃ + AffinePlaneCurvePoint (swapPlaneCurveCoordinates f) where + toFun z := ⟨(z.1.2, z.1.1), by + rw [eval_swapPlaneCurveCoordinates] + exact z.2⟩ + invFun z := ⟨(z.1.2, z.1.1), by + have hz := z.2 + rw [eval_swapPlaneCurveCoordinates] at hz + exact hz⟩ + left_inv z := by + apply Subtype.ext + rfl + right_inv z := by + apply Subtype.ext + rfl + +/-- Coordinate swapping preserves irreducibility. -/ +theorem irreducible_swapPlaneCurveCoordinates + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : + Irreducible (swapPlaneCurveCoordinates f) := by + change Irreducible + (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1) f) + exact hf.map (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1)) + +/-- After swapping, the second-coordinate degree is the original +first-coordinate degree. -/ +theorem degreeOf_second_swapPlaneCurveCoordinates + (f : MvPolynomial (Fin 2) K) : + MvPolynomial.degreeOf 1 (swapPlaneCurveCoordinates f) = + MvPolynomial.degreeOf 0 f := by + change MvPolynomial.degreeOf 1 + (MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f) = _ + simpa using + (MvPolynomial.degreeOf_rename_of_injective + (p := f) (Equiv.swap (0 : Fin 2) 1).injective (0 : Fin 2)) + +/-- Public bidegree form of the symmetric first-coordinate fiber bound. -/ +theorem affinePlaneCurvePoint_card_le_card_mul_firstDegree + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) : + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card K * firstDegree := by + rw [Fintype.card_congr (affinePlaneCurvePointEquivSwap f)] + apply affinePlaneCurvePoint_card_le_card_mul_of_degreeOf_second_le + (irreducible_swapPlaneCurveCoordinates hf) + · rw [degreeOf_second_swapPlaneCurveCoordinates] + exact degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst + · rw [degreeOf_second_swapPlaneCurveCoordinates] + exact degreeOf_first_le_of_hasBidegreeAtMost hdegree + +/-- The external finite-set presentation has the same cardinality as the +affine-point subtype used by the normalization development. -/ +def affinePlaneCurveZerosEquivAffinePlaneCurvePoint + (f : MvPolynomial (Fin 2) K) : + ↑(BGS.External.affinePlaneCurveZeros K f) ≃ AffinePlaneCurvePoint f := + Equiv.subtypeEquivRight fun _ => BGS.External.mem_affinePlaneCurveZeros_iff + +theorem affinePlaneCurveZeros_card_eq_affinePlaneCurvePoint_card + (f : MvPolynomial (Fin 2) K) : + (BGS.External.affinePlaneCurveZeros K f).card = + Fintype.card (AffinePlaneCurvePoint f) := by + rw [← Fintype.card_coe] + exact Fintype.card_congr (affinePlaneCurveZerosEquivAffinePlaneCurvePoint f) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean new file mode 100644 index 0000000000..b9847d6dfa --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean @@ -0,0 +1,299 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic + +/-! +# Affine plane Hasse bounds from the even-extension error + +For a separating absolutely irreducible plane curve, exact constants and the +bidegree genus bound are already formalized. This file composes those facts +with the automatic zeta package and the two-sided affine/normalization +comparison. The sole remaining premise is therefore the even constant-field +extension error used by the spectral argument. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics +open BGS.CorvajaZannier + +noncomputable section + +/-- For a separating absolutely irreducible plane curve, the even-extension +error estimate implies the affine Hasse--Weil bound with coefficient `8`. + +The exact constant-field theorem, divisor index one, standard zeta +rationality, trace formula, numerator-degree budget, and intrinsic genus bound +are all discharged in the proof. -/ +theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_evenError + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hfirst : 0 < firstDegree) + (hsecond : 0 < secondDegree) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ((fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount K L (2 * n) : ℂ) - + (Nat.card K : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (Nat.card K : ℝ) ^ n) → + |((BGS.External.affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + classical + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let inducedAlg : Algebra K L := bridgeBaseConstantAlgebra K L + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg + (planeCurveFunction f 0) hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg (planeCurveFunction f 0) hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + dsimp only + intro herror + let budget := (firstDegree - 1) * (secondDegree - 1) + have hExactCanonical : + @algebraicClosure K L _ _ canonicalAlg = + (⊥ : @IntermediateField K L _ _ canonicalAlg) := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hExact : algebraicClosure K L = + (⊥ : IntermediateField K L) := by + change @algebraicClosure K L _ _ inducedAlg = + (⊥ : @IntermediateField K L _ _ inducedAlg) + rw [hinducedAlg] + exact hExactCanonical + have hgenusActualCanonical : + @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f := by + simpa only [L] using + planeCurve_genus_le_bidegreeGenusBudget + habsolute hpartialFirst hpartialSecond + have hfirstDegree : MvPolynomial.degreeOf 0 f ≤ firstDegree := + degreeOf_first_le_of_hasBidegreeAtMost hdegree + have hsecondDegree : MvPolynomial.degreeOf 1 f ≤ secondDegree := + degreeOf_second_le_of_hasBidegreeAtMost hdegree + have hbudget : planeCurveBidegreeGenusBudget f ≤ budget := by + dsimp only [planeCurveBidegreeGenusBudget, budget] + exact Nat.mul_le_mul + (Nat.sub_le_sub_right hfirstDegree 1) + (Nat.sub_le_sub_right hsecondDegree 1) + have hgenusCanonical : + @FunctionField.genus K L _ _ canonicalAlg ≤ budget := + hgenusActualCanonical.trans hbudget + have hgenus : FunctionField.genus K L ≤ budget := by + change @FunctionField.genus K L _ _ inducedAlg ≤ budget + rw [hinducedAlg] + exact hgenusCanonical + have hhasse := + finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_evenError + K L budget hExact hgenus herror + rw [finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount K L] + at hhasse + have hnormalization : + |(separatingPlaneCurveRationalPlaceCount f hf hpartialSecond : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * (budget : ℝ) + 1) * Real.sqrt (Fintype.card K : ℝ) := by + change + |(@finiteExtensionRationalPlaceCount K _ _ L _ ratAlg + (Classical.decEq (RatFunc K)) : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * (budget : ℝ) + 1) * Real.sqrt (Fintype.card K : ℝ) + simpa only [Fintype.card_eq_nat_card] using hhasse + rw [affinePlaneCurveZeros_card_eq_affinePlaneCurvePoint_card] + exact + abs_affinePlaneCurvePoint_card_sub_card_le_eight_mul_bidegree_of_rationalPlaceHasse + hdegree hf hpartialFirst hpartialSecond hfirst hsecond + (show 2 * budget + 1 ≤ + 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1 by rfl) + (by simpa using hnormalization) + +/-- For a separating absolutely irreducible plane curve, a two-sided +constant-extension estimate along one fixed positive divisible-even +subsequence implies the affine Hasse--Weil bound with coefficient `8`. + +This is the plane-curve endpoint used by the selected Lorenzini route. No +estimate at extension degrees outside the subsequence `2 * δ * n` is needed. -/ +theorem + abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_divisibleEvenError + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree δ : ℕ} + (hfirst : 0 < firstDegree) + (hsecond : 0 < secondDegree) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hδ : 0 < δ) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ((fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount K L (2 * δ * n) : ℂ) - + (Nat.card K : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((Nat.card K : ℝ) ^ δ) ^ n) → + |((BGS.External.affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + classical + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let inducedAlg : Algebra K L := bridgeBaseConstantAlgebra K L + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg + (planeCurveFunction f 0) hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg (planeCurveFunction f 0) hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + dsimp only + intro herror + let budget := (firstDegree - 1) * (secondDegree - 1) + have hExactCanonical : + @algebraicClosure K L _ _ canonicalAlg = + (⊥ : @IntermediateField K L _ _ canonicalAlg) := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hExact : algebraicClosure K L = + (⊥ : IntermediateField K L) := by + change @algebraicClosure K L _ _ inducedAlg = + (⊥ : @IntermediateField K L _ _ inducedAlg) + rw [hinducedAlg] + exact hExactCanonical + have hgenusActualCanonical : + @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f := by + simpa only [L] using + planeCurve_genus_le_bidegreeGenusBudget + habsolute hpartialFirst hpartialSecond + have hfirstDegree : MvPolynomial.degreeOf 0 f ≤ firstDegree := + degreeOf_first_le_of_hasBidegreeAtMost hdegree + have hsecondDegree : MvPolynomial.degreeOf 1 f ≤ secondDegree := + degreeOf_second_le_of_hasBidegreeAtMost hdegree + have hbudget : planeCurveBidegreeGenusBudget f ≤ budget := by + dsimp only [planeCurveBidegreeGenusBudget, budget] + exact Nat.mul_le_mul + (Nat.sub_le_sub_right hfirstDegree 1) + (Nat.sub_le_sub_right hsecondDegree 1) + have hgenusCanonical : + @FunctionField.genus K L _ _ canonicalAlg ≤ budget := + hgenusActualCanonical.trans hbudget + have hgenus : FunctionField.genus K L ≤ budget := by + change @FunctionField.genus K L _ _ inducedAlg ≤ budget + rw [hinducedAlg] + exact hgenusCanonical + have hhasse := + finiteExtensionClosedPlaceHasseBound_of_exactConstants_and_divisibleEvenError + K L budget δ hExact hgenus hδ herror + rw [finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount K L] + at hhasse + have hnormalization : + |(separatingPlaneCurveRationalPlaceCount f hf hpartialSecond : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * (budget : ℝ) + 1) * Real.sqrt (Fintype.card K : ℝ) := by + change + |(@finiteExtensionRationalPlaceCount K _ _ L _ ratAlg + (Classical.decEq (RatFunc K)) : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (2 * (budget : ℝ) + 1) * Real.sqrt (Fintype.card K : ℝ) + simpa only [Fintype.card_eq_nat_card] using hhasse + rw [affinePlaneCurveZeros_card_eq_affinePlaneCurvePoint_card] + exact + abs_affinePlaneCurvePoint_card_sub_card_le_eight_mul_bidegree_of_rationalPlaceHasse + hdegree hf hpartialFirst hpartialSecond hfirst hsecond + (show 2 * budget + 1 ≤ + 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1 by rfl) + (by simpa using hnormalization) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean new file mode 100644 index 0000000000..c63cae273d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean @@ -0,0 +1,398 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +import Mathlib.Tactic + +/-! +# Affine plane Hasse bounds from the standard zeta package + +This module composes the two-sided affine/normalization comparison with the +formal zeta Hasse bound. In the separating-coordinate case it gives the +external affine-plane estimate with the explicit universal coefficient `8`. + +The final theorem retains only the standard zeta numerator package and its +even-extension square-root estimate. Constructing those data, and removing +the separating-coordinate restriction without losing the original bidegree +scale, remain separate upstream tasks. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open Filter Asymptotics + + +section ClosedPlaceLevelOne + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- At extension level one, the closed-place point count is exactly the +number of degree-one places. -/ +theorem finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount : + finiteExtensionClosedPlaceExtensionCount K L 1 = + finiteExtensionRationalPlaceCount K L := by + classical + letI := finiteExtensionPlaceDegreeLEFintype K L 1 + rw [finiteExtensionClosedPlaceExtensionCount] + have hdegree : ∀ P : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ 1}, + finiteExtensionPlaceDegree K L P.1 = 1 := by + intro P + have hpos := finiteExtensionPlaceDegree_pos K L P.1 + omega + simp_rw [hdegree] + simp only [dvd_refl, ↓reduceIte, Finset.sum_const, Finset.card_univ, + nsmul_eq_mul, mul_one] + rw [finiteExtensionRationalPlaceCount_eq_natCard_subtype] + let e : {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ 1} ≃ + {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P = 1} := + { toFun := fun P => ⟨P.1, hdegree P⟩ + invFun := fun P => ⟨P.1, P.2.le⟩ + left_inv := by intro P; cases P; rfl + right_inv := by intro P; cases P; rfl } + calc + ↑(Fintype.card {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ 1}) = + Nat.card {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P ≤ 1} := by + rw [Nat.card_eq_fintype_card] + _ = Nat.card {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P = 1} := Nat.card_congr e + +end ClosedPlaceLevelOne + +section FunctionFieldZeta + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance affineHasseZetaConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance affineHasseZetaConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Exact constants, divisor index one, a genus budget, and the even-extension +square-root estimate give the corresponding rational-place Hasse bound. -/ +theorem abs_finiteExtensionRationalPlaceCount_sub_card_sub_one_le_of_index_one_and_evenError_isBigO + (budget : ℕ) + (hconstants : algebraicClosure K L = + (⊥ : IntermediateField K L)) + (hindex : finiteExtensionDivisorDegreeIndex K L = 1) + (hgenus : FunctionField.genus K L ≤ budget) + (herror : + (fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount K L (2 * n) : ℂ) - + (Fintype.card K : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (Fintype.card K : ℝ) ^ n) : + |(finiteExtensionRationalPlaceCount K L : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + ((2 * budget + 1 : ℕ) : ℝ) * + Real.sqrt (Fintype.card K : ℝ) := by + obtain ⟨P, hPzero, _hPone, hPdegree, hPform, _hPtrace⟩ := + exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget + K L budget hconstants hindex hgenus + have herror' : + (fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount K L (2 * n) : ℂ) - + (Nat.card K : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (Nat.card K : ℝ) ^ n := by + simpa only [Fintype.card_eq_nat_card] using herror + have hhasse := + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_evenError_isBigO + (Nat.card K) (finiteExtensionClosedPlaceExtensionCount K L) + P hPzero hPform herror' + rw [finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount K L] + at hhasse + simpa only [Fintype.card_eq_nat_card] using hhasse.trans (by + have hdegreeReal : (P.natDegree : ℝ) ≤ (2 * budget + 1 : ℕ) := by + exact_mod_cast hPdegree + exact mul_le_mul_of_nonneg_right hdegreeReal (Real.sqrt_nonneg _)) + +end FunctionFieldZeta + +/-- The rational-place count of a separating plane model, with all +projection-dependent instances packaged into a stable natural number. -/ +def separatingPlaneCurveRationalPlaceCount + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : ℕ := + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) + +section AffineTransfer + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + +/-- A rational-place Hasse estimate with the standard bidegree numerator +budget transfers to the affine plane count with universal coefficient `8`. + +The large-`secondDegree` branch uses the elementary first-coordinate fiber +bound. In the small branch the new reverse comparison and the existing +forward critical-locus comparison give a common error bounded by four +square-root bidegree units; the zeta term costs three and the affine/projective +constant costs one. -/ +theorem abs_affinePlaneCurvePoint_card_sub_card_le_eight_mul_bidegree_of_rationalPlaceHasse + {f : MvPolynomial (Fin 2) K} + {firstDegree secondDegree zetaDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hfirst : 0 < firstDegree) + (hsecond : 0 < secondDegree) + (hzetaDegree : zetaDegree ≤ + 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1) + (hnormalization : + |(separatingPlaneCurveRationalPlaceCount + f hf hpartialSecond : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (zetaDegree : ℝ) * Real.sqrt (Fintype.card K : ℝ)) : + |(Fintype.card (AffinePlaneCurvePoint f) : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + classical + by_cases hlarge : Real.sqrt (Fintype.card K : ℝ) ≤ secondDegree + · have hcount := affinePlaneCurvePoint_card_le_card_mul_firstDegree + hdegree hf hpartialFirst + exact (abs_pointCount_sub_card_le_two_mul_sqrt_of_fiber_bound + (Fintype.card (AffinePlaneCurvePoint f)) (Fintype.card K) + firstDegree secondDegree hfirst hcount hlarge).trans (by + have hscale : 0 ≤ Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by positivity + nlinarith) + · have hsecondSmall : (secondDegree : ℝ) ≤ + Real.sqrt (Fintype.card K : ℝ) := (lt_of_not_ge hlarge).le + let error := + (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree + secondDegree + have hcritical := affineSecondCoordinateCriticalPoints_card_le + hdegree hf hpartialSecond + have hupperRaw : Fintype.card (AffinePlaneCurvePoint f) ≤ + separatingPlaneCurveRationalPlaceCount f hf hpartialSecond + + (affineSecondCoordinateCriticalPoints K f).card := by + simpa only [separatingPlaneCurveRationalPlaceCount] using + affinePlaneCurvePoint_card_le_rationalPlaceCount_add_critical + hf hpartialFirst hpartialSecond + have hupper : Fintype.card (AffinePlaneCurvePoint f) ≤ + separatingPlaneCurveRationalPlaceCount f hf hpartialSecond + + error := by + apply hupperRaw.trans + apply Nat.add_le_add_left + dsimp only [error] + calc + (affineSecondCoordinateCriticalPoints K f).card ≤ + ((2 * secondDegree - 1) * firstDegree) * secondDegree := hcritical + _ ≤ (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree := Nat.mul_le_mul_right secondDegree + (Nat.le_add_left _ _) + _ ≤ (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree + secondDegree := Nat.le_add_right _ _ + have hlower : + separatingPlaneCurveRationalPlaceCount f hf hpartialSecond ≤ + Fintype.card (AffinePlaneCurvePoint f) + error := by + simpa only [separatingPlaneCurveRationalPlaceCount, error, + Nat.add_assoc] using + finiteExtensionRationalPlaceCount_le_affine_add_exceptional + hdegree hf hpartialSecond + have htransfer := abs_affine_sub_card_le_of_two_sided_count_comparison + (Fintype.card (AffinePlaneCurvePoint f)) + (separatingPlaneCurveRationalPlaceCount f hf hpartialSecond) + (Fintype.card K) error hupper hlower + ((zetaDegree : ℝ) * Real.sqrt (Fintype.card K : ℝ)) hnormalization + apply htransfer.trans + have hzeta := zetaDegree_mul_sqrt_le_three_mul_bidegree + zetaDegree (Fintype.card K) firstDegree secondDegree + hfirst hsecond hzetaDegree + have hfield : 1 ≤ Fintype.card K := + (Fintype.one_lt_card : 1 < Fintype.card K).le + have hone := one_le_sqrt_mul_bidegree + (Fintype.card K) firstDegree secondDegree hfield hfirst hsecond + have herror : (error : ℝ) ≤ + 4 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + dsimp only [error] + push_cast + have hfirstReal : (1 : ℝ) ≤ firstDegree := by exact_mod_cast hfirst + have hsecondReal : (1 : ℝ) ≤ secondDegree := by exact_mod_cast hsecond + have hsqrt : (1 : ℝ) ≤ Real.sqrt (Fintype.card K : ℝ) := + Real.one_le_sqrt.mpr (by exact_mod_cast hfield) + have hsub : ((2 * secondDegree - 1 : ℕ) : ℝ) ≤ + 2 * (secondDegree : ℝ) := by + exact_mod_cast Nat.sub_le (2 * secondDegree) 1 + have hterm1 : (firstDegree : ℝ) * secondDegree ≤ + Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree := by + have hxle : (firstDegree : ℝ) ≤ + Real.sqrt (Fintype.card K : ℝ) * firstDegree := by + simpa only [one_mul] using + mul_le_mul_of_nonneg_right hsqrt + (by positivity : (0 : ℝ) ≤ firstDegree) + exact mul_le_mul_of_nonneg_right hxle (by positivity) + have hterm2 : 2 * (firstDegree : ℝ) * secondDegree * secondDegree ≤ + 2 * Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree := by + have hmul := mul_le_mul_of_nonneg_left hsecondSmall + (show (0 : ℝ) ≤ 2 * firstDegree * secondDegree by positivity) + nlinarith + have hterm3 : (secondDegree : ℝ) ≤ + Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree := by + have honeProduct : (1 : ℝ) ≤ + Real.sqrt (Fintype.card K : ℝ) * firstDegree := + one_le_mul_of_one_le_of_one_le hsqrt hfirstReal + simpa only [one_mul] using + mul_le_mul_of_nonneg_right honeProduct + (show (0 : ℝ) ≤ secondDegree by positivity) + calc + ((firstDegree : ℝ) + ↑(2 * secondDegree - 1) * firstDegree) * + secondDegree + secondDegree ≤ + (firstDegree + 2 * secondDegree * firstDegree) * + secondDegree + secondDegree := by gcongr + _ = (firstDegree : ℝ) * secondDegree + + 2 * firstDegree * secondDegree * secondDegree + secondDegree := by + ring + _ ≤ Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree + + 2 * Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree + + Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree := by + exact add_le_add (add_le_add hterm1 hterm2) hterm3 + _ = 4 * Real.sqrt (Fintype.card K : ℝ) * firstDegree * secondDegree := by + ring + nlinarith + +end AffineTransfer + +section PlaneZetaComposition + +/-- Standard zeta rationality and the even-extension square-root estimate +imply the exact affine-plane shape required by +`GeneralBivariateAffineHasseWeilTheorem`, with coefficient `8`, whenever both +coordinate projections are separating. + +The conclusion is stated using the external finite-set presentation. Thus +the remaining gap to the unrestricted external proposition is explicit: the +two partial-derivative hypotheses and the upstream zeta package. -/ +theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_standardZeta + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hfirst : 0 < firstDegree) + (hsecond : 0 < secondDegree) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (P : Polynomial ℂ) + (hPzero : P.coeff 0 = 1) + (hPdegree : P.natDegree ≤ + 2 * ((firstDegree - 1) * (secondDegree - 1)) + 1) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + HasCurveZetaRationalForm + (formalPointCountZeta + (finiteExtensionClosedPlaceExtensionCount K L)) + (Nat.card K) P → + ((fun n : ℕ ↦ + (finiteExtensionClosedPlaceExtensionCount K L (2 * n) : ℂ) - + (Nat.card K : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (Nat.card K : ℝ) ^ n) → + |((BGS.External.affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + classical + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + intro hPform herror + have hhasse := + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_evenError_isBigO + (Nat.card K) (finiteExtensionClosedPlaceExtensionCount K L) + P hPzero hPform herror + rw [finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount K L] + at hhasse + have hnormalization : + |(separatingPlaneCurveRationalPlaceCount f hf hpartialSecond : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt (Fintype.card K : ℝ) := by + change + |(@finiteExtensionRationalPlaceCount K _ _ L _ ratAlg + (Classical.decEq (RatFunc K)) : ℝ) - + (Fintype.card K : ℝ) - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt (Fintype.card K : ℝ) + simpa only [Fintype.card_eq_nat_card] using hhasse + rw [affinePlaneCurveZeros_card_eq_affinePlaneCurvePoint_card] + exact + abs_affinePlaneCurvePoint_card_sub_card_le_eight_mul_bidegree_of_rationalPlaceHasse + hdegree hf hpartialFirst hpartialSecond hfirst hsecond hPdegree + hnormalization + +end PlaneZetaComposition + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean new file mode 100644 index 0000000000..7c86fcb92a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean @@ -0,0 +1,297 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +import Mathlib.Tactic + +/-! +# Affine plane points and rational normalization places + +For an irreducible plane curve with both coordinates separating, every affine +point that is regular in the second-coordinate direction determines a +degree-one finite place of the function field. Distinct regular affine points +give distinct places. Consequently the regular affine locus injects into the +rational finite places, and adding the explicit critical locus compares all +affine rational points with the full rational-place count. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] +variable {f : MvPolynomial (Fin 2) K} + +/-- Send a second-coordinate regular affine point to its selected degree-one +finite normalization place. -/ +def affineSecondCoordinateRegularPointToRationalFinitePlace + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffineSecondCoordinateRegularPoint f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + FiniteExtensionRationalFinitePlace K (PlaneCurveFunctionField f) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + exact ⟨affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z.1, + affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY + K hf hpartialFirst hpartialSecond z.1 z.2⟩ + +/-- Distinct second-coordinate regular affine points determine distinct +degree-one finite normalization places. -/ +theorem affineSecondCoordinateRegularPointToRationalFinitePlace_injective + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Function.Injective + (affineSecondCoordinateRegularPointToRationalFinitePlace + hf hpartialFirst hpartialSecond) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + intro z w hzw + apply Subtype.ext + apply affinePointExhaustiveFinitePlace_injective + hf hpartialFirst hpartialSecond + exact congrArg Subtype.val hzw + +/-- The regular affine locus has cardinality at most the number of degree-one +finite places. -/ +theorem affineSecondCoordinateRegularPoint_card_le_rationalFinitePlace + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Fintype.card (AffineSecondCoordinateRegularPoint f) ≤ + Nat.card (FiniteExtensionRationalFinitePlace K + (PlaneCurveFunctionField f)) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + let toPlace := affineSecondCoordinateRegularPointToRationalFinitePlace + hf hpartialFirst hpartialSecond + have hcard := Nat.card_le_card_of_injective toPlace + (affineSecondCoordinateRegularPointToRationalFinitePlace_injective + hf hpartialFirst hpartialSecond) + simpa only [Nat.card_eq_fintype_card] using hcard + +/-- The regular affine locus has cardinality at most the total rational-place +count, which also includes places above infinity. -/ +theorem affineSecondCoordinateRegularPoint_card_le_rationalPlaceCount + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Fintype.card (AffineSecondCoordinateRegularPoint f) ≤ + finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + calc + Fintype.card (AffineSecondCoordinateRegularPoint f) ≤ + Nat.card (FiniteExtensionRationalFinitePlace K + (PlaneCurveFunctionField f)) := + affineSecondCoordinateRegularPoint_card_le_rationalFinitePlace + hf hpartialFirst hpartialSecond + _ ≤ Nat.card (FiniteExtensionRationalPlace K + (PlaneCurveFunctionField f)) := + Nat.card_le_card_of_injective + (fun Q : FiniteExtensionRationalFinitePlace K + (PlaneCurveFunctionField f) => + (Sum.inl Q : FiniteExtensionRationalPlace K + (PlaneCurveFunctionField f))) + Sum.inl_injective + _ = finiteExtensionRationalPlaceCount K + (PlaneCurveFunctionField f) := rfl + +/-- The first affine-normalization comparison: all affine rational points are +bounded by the rational places of the normalization plus the explicit +second-coordinate critical locus. -/ +theorem affinePlaneCurvePoint_card_le_rationalPlaceCount_add_critical + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Fintype.card (AffinePlaneCurvePoint f) ≤ + finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) + + (affineSecondCoordinateCriticalPoints K f).card := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + rw [affinePlaneCurvePoint_card_eq_regular_add_critical f] + exact Nat.add_le_add_right + (affineSecondCoordinateRegularPoint_card_le_rationalPlaceCount + hf hpartialFirst hpartialSecond) + (affineSecondCoordinateCriticalPoints K f).card + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean new file mode 100644 index 0000000000..fb3449726d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean @@ -0,0 +1,371 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +import Mathlib.FieldTheory.RatFunc.Luroth + +/-! +# Constants in an absolutely irreducible plane-curve function field + +This file develops the constant-field step needed by the function-field +Bombieri--Stepanov proof of Hasse--Weil. The key algebraic point is that, +after enlarging the constants inside the original function field, the +base-changed plane equation is still the primitive cleared minimal relation +of the second coordinate over the first-coordinate rational subfield. + +No geometric Hasse--Weil statement is assumed here. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open Polynomial + +noncomputable section + +/-- The iterated-polynomial presentation evaluates at the same ordered pair +as the original bivariate polynomial. -/ +theorem evalBivariate_planeCurveToBivariate + {K L : Type*} [Field K] [Field L] [Algebra K L] + (f : MvPolynomial (Fin 2) K) (x y : L) : + evalBivariate y x (planeCurveToBivariate K f) = + MvPolynomial.eval₂ (algebraMap K L) ![x, y] f := by + let lhs : MvPolynomial (Fin 2) K →+* L := + (Polynomial.eval₂RingHom + (Polynomial.eval₂RingHom (algebraMap K L) y) x).comp + (planeCurveToBivariate K).toRingEquiv.toRingHom + let rhs : MvPolynomial (Fin 2) K →+* L := + MvPolynomial.eval₂Hom (algebraMap K L) ![x, y] + have hhom : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro c + simp [lhs, rhs] + · intro i + fin_cases i <;> simp [lhs, rhs] + change lhs f = rhs f + rw [hhom] + +/-- Swap the iterated presentation so that the second affine coordinate is +the outer polynomial variable. -/ +def planeCurveSecondOuterRelation + (K : Type*) [Field K] (f : MvPolynomial (Fin 2) K) : + Polynomial (Polynomial K) := + transposeBivariate (planeCurveToBivariate K f) + +theorem evalBivariate_planeCurveSecondOuterRelation + {K L : Type*} [Field K] [Field L] [Algebra K L] + (f : MvPolynomial (Fin 2) K) (x y : L) : + evalBivariate x y (planeCurveSecondOuterRelation K f) = + MvPolynomial.eval₂ (algebraMap K L) ![x, y] f := by + rw [planeCurveSecondOuterRelation, evalBivariate_transposeBivariate] + exact evalBivariate_planeCurveToBivariate f x y + +/-- Irreducibility is preserved by the two variable-presentation +equivalences. -/ +theorem planeCurveSecondOuterRelation_irreducible + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) : + Irreducible (planeCurveSecondOuterRelation K f) := by + have hfirst : Irreducible (planeCurveToBivariate K f) := + hf.map (planeCurveToBivariate K).toMulEquiv + rw [planeCurveSecondOuterRelation, transposeBivariate_eq_bivariateSwap] + exact hfirst.map (Polynomial.Bivariate.swap (R := K)).toMulEquiv + +/-- The outer degree in the swapped presentation is exactly the degree in +the second affine coordinate. -/ +theorem planeCurveSecondOuterRelation_natDegree + (K : Type*) [Field K] (f : MvPolynomial (Fin 2) K) : + (planeCurveSecondOuterRelation K f).natDegree = + MvPolynomial.degreeOf 1 f := by + rw [planeCurveSecondOuterRelation, + transposeBivariate_planeCurveToBivariate, + bivariateEquiv_symm_natDegree_eq_degreeOf_one] + +/-- Over any enlarged constant field inside the ambient function field, an +irreducible plane equation is associated to the primitive cleared minimal +relation of the second coordinate. -/ +theorem primitiveClearedMinpolyRelation_associated_planeRelation + {K L : Type*} [Field K] [Field L] [Algebra K L] + (f : MvPolynomial (Fin 2) K) (hf : Irreducible f) + (x y : L) (hx : Transcendental K x) + (hy : IsIntegral (IntermediateField.adjoin K {x}) y) + (hzero : MvPolynomial.eval₂ (algebraMap K L) ![x, y] f = 0) : + Associated (primitiveClearedMinpolyRelation x hx y) + (planeCurveSecondOuterRelation K f) := by + have hdvd : primitiveClearedMinpolyRelation x hx y ∣ + planeCurveSecondOuterRelation K f := by + apply primitiveClearedMinpolyRelation_dvd_of_evalBivariate_eq_zero + x hx y hy + simpa [evalBivariate_planeCurveSecondOuterRelation] using hzero + exact (primitiveClearedMinpolyRelation_irreducible x hx y hy).associated_of_dvd + (planeCurveSecondOuterRelation_irreducible hf) hdvd + +/-- Consequently the minimal-polynomial degree over `K(x)` is the second +coordinate degree of the irreducible plane relation. -/ +theorem minpoly_natDegree_eq_planeRelation_secondDegree + {K L : Type*} [Field K] [Field L] [Algebra K L] + (f : MvPolynomial (Fin 2) K) (hf : Irreducible f) + (x y : L) (hx : Transcendental K x) + (hy : IsIntegral (IntermediateField.adjoin K {x}) y) + (hzero : MvPolynomial.eval₂ (algebraMap K L) ![x, y] f = 0) : + (minpoly (IntermediateField.adjoin K {x}) y).natDegree = + MvPolynomial.degreeOf 1 f := by + have hassociated := + primitiveClearedMinpolyRelation_associated_planeRelation + f hf x y hx hy hzero + calc + (minpoly (IntermediateField.adjoin K {x}) y).natDegree = + (primitiveClearedMinpolyRelation x hx y).natDegree := + (primitiveClearedMinpolyRelation_natDegree x hx y hy).symm + _ = (planeCurveSecondOuterRelation K f).natDegree := by + apply Nat.le_antisymm + · exact Polynomial.natDegree_le_of_dvd hassociated.dvd + (planeCurveSecondOuterRelation_irreducible hf).ne_zero + · exact Polynomial.natDegree_le_of_dvd hassociated.symm.dvd + (primitiveClearedMinpolyRelation_ne_zero x hx y) + _ = MvPolynomial.degreeOf 1 f := + planeCurveSecondOuterRelation_natDegree K f + +/-- A rational function field has no constants algebraic over its coefficient +field beyond the coefficient field itself. Lüroth's theorem makes this a +short argument: any nontrivial intermediate field has a transcendental +generator, whereas every element of the relative algebraic closure is +algebraic. -/ +theorem ratFunc_algebraicClosure_eq_bot (K : Type*) [Field K] : + algebraicClosure K (RatFunc K) = ⊥ := by + by_contra hne + let E : IntermediateField K (RatFunc K) := + algebraicClosure K (RatFunc K) + have hmem : RatFunc.Luroth.generator E ∈ E := + RatFunc.Luroth.generator_mem + have halgebraic : IsAlgebraic K (RatFunc.Luroth.generator E) := + mem_algebraicClosure_iff.mp hmem + exact (RatFunc.Luroth.transcendental_generator hne) halgebraic + +/-- The field generated by one transcendental element has the same exact +constant field as a rational function field. -/ +theorem adjoin_transcendental_algebraicClosure_eq_bot + {K L : Type*} [Field K] [Field L] [Algebra K L] + (x : L) (hx : Transcendental K x) : + algebraicClosure K (IntermediateField.adjoin K {x}) = ⊥ := by + let e : RatFunc K ≃ₐ[K] IntermediateField.adjoin K {x} := + RatFunc.algEquivOfTranscendental x hx + have hmap := algebraicClosure.map_eq_of_algEquiv e + rw [ratFunc_algebraicClosure_eq_bot] at hmap + simpa only [IntermediateField.map_bot] using hmap.symm + +/-- **Exact constant field of an absolutely irreducible plane curve.** + +If the defining equation remains irreducible over an algebraic closure and +the second coordinate is separating, then the only elements of its function +field algebraic over `K` are the elements of `K` itself. + +The proof compares the degree over `K(x)` with the degree after adjoining the +relative algebraic closure `E` to the constants. Absolute irreducibility and +the cleared-minimal-polynomial relation show that both degrees are exactly +`degreeOf 1 f`. The tower formula therefore forces `E(x) = K(x)`. Finally, +the rational-function constant-field theorem above forces every element of +`E` back into `K`. -/ +theorem planeCurveFunctionField_algebraicClosure_eq_bot + {K : Type*} [Field K] + (f : MvPolynomial (Fin 2) K) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + algebraicClosure K (PlaneCurveFunctionField f) = ⊥ := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let L := PlaneCurveFunctionField f + let E : IntermediateField K L := algebraicClosure K L + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + let F : IntermediateField K L := IntermediateField.adjoin K {x} + let A : IntermediateField E L := IntermediateField.adjoin E {x} + have hdegree : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + have hxK : Transcendental K x := + firstCoordinate_transcendental hf hdegree + have hxE : Transcendental E x := hxK.algebraicClosure + let fE : MvPolynomial (Fin 2) E := + MvPolynomial.map (algebraMap K E) f + have hfE : Irreducible fE := + irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K E) f habsolute + have hdegreeE : MvPolynomial.degreeOf 1 fE = + MvPolynomial.degreeOf 1 f := + degreeOf_map_eq_of_injective (algebraMap K E) + (algebraMap K E).injective 1 f + have hzeroE : + MvPolynomial.eval₂ (algebraMap E L) ![x, y] fE = 0 := by + simp only [fE, MvPolynomial.eval₂_map] + change MvPolynomial.eval₂ + ((algebraMap E L).comp (algebraMap K E)) ![x, y] f = 0 + have hcomp : (algebraMap E L).comp (algebraMap K E) = + algebraMap K L := by + ext c + exact IsScalarTower.algebraMap_apply K E L c + rw [hcomp] + have hcoordinates : ![x, y] = planeCurveFunction f := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f + have hFA : F ≤ A.restrictScalars K := by + apply IntermediateField.adjoin_le_iff.mpr + intro z hz + rw [Set.mem_singleton_iff] at hz + subst z + exact IntermediateField.subset_adjoin E {x} (Set.mem_singleton x) + letI : Algebra F A := (IntermediateField.inclusion hFA).toAlgebra + letI : IsScalarTower F A L := + IsScalarTower.of_algebraMap_eq' (R := F) (S := A) (A := L) rfl + have hpoly : polynomialOverFirstCoordinate f ≠ 0 := + polynomialOverFirstCoordinate_ne_zero_of_irreducible hf hdegree + have hyF : IsAlgebraic F y := by + exact secondCoordinate_isAlgebraic_over_first f hpoly + have hyAalg : IsAlgebraic A y := + hyF.extendScalars (algebraMap F A).injective + have hyA : IsIntegral A y := isAlgebraic_iff_isIntegral.mp hyAalg + have hminA : (minpoly A y).natDegree = MvPolynomial.degreeOf 1 f := by + calc + (minpoly A y).natDegree = MvPolynomial.degreeOf 1 fE := + minpoly_natDegree_eq_planeRelation_secondDegree + fE hfE x y hxE hyA hzeroE + _ = MvPolynomial.degreeOf 1 f := hdegreeE + have hpairK : IntermediateField.adjoin K {x, y} = ⊤ := by + rw [← range_planeCurveFunction f] + exact adjoin_planeCurveFunctions_eq_top + have hpairE : IntermediateField.adjoin E {x, y} = ⊤ := by + apply top_unique + intro z _hz + have hzK : z ∈ IntermediateField.adjoin K {x, y} := by + rw [hpairK] + trivial + have hle : IntermediateField.adjoin K {x, y} ≤ + (IntermediateField.adjoin E {x, y}).restrictScalars K := by + apply IntermediateField.adjoin_le_iff.mpr + intro u hu + exact IntermediateField.subset_adjoin E {x, y} hu + exact hle hzK + have htopA : IntermediateField.adjoin A {y} = ⊤ := by + apply IntermediateField.restrictScalars_injective E + rw [IntermediateField.restrictScalars_top] + change (IntermediateField.adjoin + (IntermediateField.adjoin E {x}) {y}).restrictScalars E = ⊤ + rw [IntermediateField.adjoin_adjoin_left] + simpa only [Set.singleton_union] using hpairE + letI : FiniteDimensional A (IntermediateField.adjoin A {y}) := + IntermediateField.adjoin.finiteDimensional hyA + letI : FiniteDimensional A (⊤ : IntermediateField A L) := by + rw [← htopA] + infer_instance + letI : FiniteDimensional A L := + IntermediateField.topEquiv.toLinearEquiv.finiteDimensional + have hfinA : Module.finrank A L = MvPolynomial.degreeOf 1 f := by + calc + Module.finrank A L = Module.finrank A + (⊤ : IntermediateField A L) := by + rw [IntermediateField.finrank_top'] + _ = Module.finrank A (IntermediateField.adjoin A {y}) := by + rw [htopA] + _ = (minpoly A y).natDegree := + IntermediateField.adjoin.finrank hyA + _ = MvPolynomial.degreeOf 1 f := hminA + letI : FiniteDimensional F L := + (finiteSeparable_over_firstCoordinate_of_irreducible + hf hpartialSecond).1 + have hfinF : Module.finrank F L = MvPolynomial.degreeOf 1 f := + finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible + hf hpartialSecond + letI : FiniteDimensional F A := + FiniteDimensional.of_injective + (IsScalarTower.toAlgHom F A L).toLinearMap + (RingHom.injective _) + have hmul : Module.finrank F A * Module.finrank A L = + Module.finrank F L := Module.finrank_mul_finrank F A L + have hfinFA : Module.finrank F A = 1 := by + rw [hfinA, hfinF] at hmul + nlinarith + have hsurj : Function.Surjective (algebraMap F A) := + (Algebra.finrank_eq_one_iff_bijective_algebraMap.mp hfinFA).2 + have hArestrict : A.restrictScalars K = F := by + apply le_antisymm + · intro z hz + let zA : A := ⟨z, hz⟩ + obtain ⟨w, hw⟩ := hsurj zA + have hcoe : (w : L) = z := by + exact congrArg (fun a : A ↦ (a : L)) hw + change z ∈ F + rw [← hcoe] + exact w.property + · exact hFA + apply le_antisymm + · intro z hz + have hzA : z ∈ A := by + exact A.algebraMap_mem ⟨z, hz⟩ + have hzF : z ∈ F := by + have : z ∈ A.restrictScalars K := hzA + rwa [hArestrict] at this + let zF : F := ⟨z, hzF⟩ + have hzAlgL : IsAlgebraic K z := + mem_algebraicClosure_iff.mp hz + have hzAlgF : IsAlgebraic K zF := by + apply (isAlgebraic_algHom_iff + (IsScalarTower.toAlgHom K F L) (RingHom.injective _)).mp + change IsAlgebraic K (zF : L) + simpa [L] using hzAlgL + have hzClosure : zF ∈ algebraicClosure K F := + mem_algebraicClosure_iff.mpr hzAlgF + have hclosure : algebraicClosure K F = ⊥ := + adjoin_transcendental_algebraicClosure_eq_bot x hxK + rw [hclosure, IntermediateField.mem_bot] at hzClosure + rw [IntermediateField.mem_bot] + obtain ⟨c, hc⟩ := hzClosure + refine ⟨c, ?_⟩ + exact congrArg Subtype.val hc + · exact bot_le + +/-- Exact constants persist after an arbitrary extension of the coefficient +field. Absolute irreducibility over `K` supplies absolute irreducibility over +`E`, and injectivity of the coefficient embedding preserves the separating +second partial derivative. -/ +theorem planeCurveBaseChangeFunctionField_algebraicClosure_eq_bot + {K E : Type*} [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let fE := MvPolynomial.map (algebraMap K E) f + let hfE := irreducible_map_of_irreducible_map_algebraicClosure + (algebraMap K E) f habsolute + letI := planeCurveCoordinateRing_isDomain hfE + algebraicClosure E (PlaneCurveFunctionField fE) = ⊥ := by + let fE := MvPolynomial.map (algebraMap K E) f + have habsoluteE : Irreducible + (MvPolynomial.map (algebraMap E (AlgebraicClosure E)) fE) := by + have h := irreducible_map_of_irreducible_map_algebraicClosure + ((algebraMap E (AlgebraicClosure E)).comp (algebraMap K E)) + f habsolute + simpa only [fE, MvPolynomial.map_map] using h + have hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by + rw [MvPolynomial.pderiv_map] + intro hz + apply hpartialSecond + apply MvPolynomial.map_injective (algebraMap K E) + (algebraMap K E).injective + simpa using hz + exact planeCurveFunctionField_algebraicClosure_eq_bot + fE habsoluteE hpartialSecondE + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean new file mode 100644 index 0000000000..6c796af190 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +import Mathlib.Tactic + +/-! +# A controlled pole place for the first plane coordinate + +In the first-coordinate rational-function model of an irreducible plane +curve, the pole divisor of the first coordinate has degree exactly the degree +of the defining polynomial in the second variable. Consequently that pole +divisor has nonempty support, and one can choose a pole place whose (possibly +nontrivial) place degree is bounded by that second-variable degree. + +No rationality assertion is made about the selected place. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- In the first-coordinate `RatFunc` model, the pole height of the first +coordinate is the degree of the plane equation in the second variable. -/ +theorem finiteExtensionHeight_planeCurveFirstCoordinate + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionHeight K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) = + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hx0 : x ≠ 0 := by + change planeCurveFunction f 0 ≠ 0 + intro hzero + apply hx + rw [hzero] + exact isAlgebraic_zero + calc + finiteExtensionHeight K L x = + finiteExtensionPositiveDegree K L x := + (finiteExtensionPositiveDegree_eq_height K L x hx0).symm + _ = MvPolynomial.degreeOf 1 f := by + have hpositive := + finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow + hf hpartialSecond 1 (by omega) + simpa only [x, pow_one, one_mul] using hpositive + +/-- Equivalently, the effective pole divisor of the first coordinate has +degree equal to the degree of the plane equation in the second variable. -/ +theorem finiteExtensionDivisorDegree_planeCurveFirstCoordinate_poleDivisor + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0)) = + (MvPolynomial.degreeOf 1 f : ℤ) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change finiteExtensionDivisorDegree K L + (finiteExtensionPoleDivisor K L x) = + (MvPolynomial.degreeOf 1 f : ℤ) + rw [finiteExtensionDivisorDegree_poleDivisor, + finiteExtensionHeight_planeCurveFirstCoordinate hf hpartialSecond] + +/-- A positive coefficient of an effective divisor contributes at least the +degree of its place to the total divisor degree. -/ +theorem finiteExtensionPlaceDegree_le_divisorDegree_of_effective_of_pos + (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) {P : FiniteExtensionPlace K L} + (hP : 0 < D P) : + (finiteExtensionPlaceDegree K L P : ℤ) ≤ + finiteExtensionDivisorDegree K L D := by + classical + rw [finiteExtensionDivisorDegree, Finsupp.sum] + have hPmem : P ∈ D.support := + Finsupp.mem_support_iff.mpr hP.ne' + calc + (finiteExtensionPlaceDegree K L P : ℤ) ≤ + D P * (finiteExtensionPlaceDegree K L P : ℤ) := by + have hcoefficient : (1 : ℤ) ≤ D P := by omega + simpa only [one_mul] using + mul_le_mul_of_nonneg_right hcoefficient + (show 0 ≤ (finiteExtensionPlaceDegree K L P : ℤ) by positivity) + _ ≤ ∑ v ∈ D.support, + D v * (finiteExtensionPlaceDegree K L v : ℤ) := by + exact Finset.single_le_sum + (fun v _hv => mul_nonneg (hD v) (by positivity)) hPmem + +/-- The first-coordinate pole divisor has nonempty support. -/ +theorem planeCurveFirstCoordinate_poleDivisor_support_nonempty + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0)).support.Nonempty := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change (finiteExtensionPoleDivisor K L x).support.Nonempty + apply Finsupp.support_nonempty_iff.mpr + intro hzero + have hdegree := + finiteExtensionDivisorDegree_planeCurveFirstCoordinate_poleDivisor + hf hpartialSecond + change finiteExtensionDivisorDegree K L + (finiteExtensionPoleDivisor K L x) = + (MvPolynomial.degreeOf 1 f : ℤ) at hdegree + rw [hzero] at hdegree + simp only [finiteExtensionDivisorDegree, Finsupp.sum_zero_index] at hdegree + have hpositive : 0 < MvPolynomial.degreeOf 1 f := + degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + omega + +/-- There is a pole place for the first coordinate. Its coefficient in the +pole divisor is positive, and its (not necessarily one) place degree lies +between one and the degree of the plane equation in the second variable. -/ +theorem exists_planeCurveFirstCoordinate_polePlace + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∃ P : FiniteExtensionPlace K (PlaneCurveFunctionField f), + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) P ∧ + 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) P ∧ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) P ≤ + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + obtain ⟨P, hPsupport⟩ := + planeCurveFirstCoordinate_poleDivisor_support_nonempty + hf hpartialSecond + have hPcoefficient : + 0 < finiteExtensionPoleDivisor K L x P := by + exact lt_of_le_of_ne + (finiteExtensionPoleDivisor_effective K L x P) + (Finsupp.mem_support_iff.mp hPsupport).symm + have hPdegreePositive : 0 < finiteExtensionPlaceDegree K L P := + finiteExtensionPlaceDegree_pos K L P + have hPdegreeCast : + (finiteExtensionPlaceDegree K L P : ℤ) ≤ + (MvPolynomial.degreeOf 1 f : ℤ) := by + rw [← finiteExtensionDivisorDegree_planeCurveFirstCoordinate_poleDivisor + hf hpartialSecond] + exact finiteExtensionPlaceDegree_le_divisorDegree_of_effective_of_pos + (K := K) L (finiteExtensionPoleDivisor K L x) + (finiteExtensionPoleDivisor_effective K L x) hPcoefficient + refine ⟨P, hPcoefficient, hPdegreePositive, ?_⟩ + exact_mod_cast hPdegreeCast + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean new file mode 100644 index 0000000000..5c2f302cdc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean @@ -0,0 +1,342 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole + +/-! +# The first plane coordinate only has poles above infinity + +The first-coordinate rational-function model sends `RatFunc.X` to the first +plane coordinate. At a finite place, `Polynomial.X` lies in the finite +integral closure, so its order is nonnegative. Thus the effective pole +divisor of the first coordinate vanishes at every finite place. + +Combining this support statement with the previously constructed controlled +pole place shows that the selected pole may be taken above the rational- +function place at infinity, without changing its place-degree bound. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) coordinatePolePolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance coordinatePolePolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance coordinatePoleFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance coordinatePoleFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance coordinatePolePolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance coordinatePoleFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance coordinatePoleInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance coordinatePoleInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance coordinatePoleInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance coordinatePoleInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance coordinatePoleInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance coordinatePoleInfinityIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +omit [Fintype K] in +private theorem principalDivisor_algebraMap_X_inl_nonnegative + (q : FiniteExtensionFinitePlace K L) : + 0 ≤ finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) (.inl q) := by + let S := RatFuncFiniteIntegralClosure K L + let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L + let s : S := algebraMap K[X] S Polynomial.X + have hs : s ≠ 0 := by + have hinj : Function.Injective (algebraMap K[X] S) := + FunctionField.ringOfIntegers.algebraMap_injective K L + dsimp only [s] + exact (map_ne_zero_iff (algebraMap K[X] S) hinj).2 Polynomial.X_ne_zero + have hrepr : + e.symm (algebraMap (RatFunc K) L RatFunc.X) = + algebraMap S (FractionRing S) s := by + apply e.injective + rw [e.apply_symm_apply, e.commutes] + rfl + rw [finiteExtensionPrincipalDivisor_inl, hrepr] + exact finitePlaceOrder_algebraMap_nonnegative q s hs + +omit [Fintype K] in +/-- At every place above the rational-function place at infinity, the image +of `RatFunc.X` has strictly negative order. This is stronger than merely +knowing that some infinity place is a pole: it makes the pole divisor of the +first coordinate cofinal among divisors supported at infinity. -/ +theorem finiteExtensionPrincipalDivisor_algebraMap_X_inr_negative + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) (.inr P) < 0 := by + let q := primeOverHeightOne (ratFuncInfinityPlace K) P + let pi := ratFuncInfinityUniformizer K + have hpiBase : pi ∈ (ratFuncInfinityPlace K).asIdeal := by + rw [ratFuncInfinityPlace_span_uniformizer] + exact Ideal.mem_span_singleton_self pi + have hpiP : algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi ∈ P.1 := by + have hover : (ratFuncInfinityPlace K).asIdeal = Ideal.comap + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)) P.1 := by + exact Ideal.over_def P.1 (ratFuncInfinityPlace K).asIdeal + exact Ideal.mem_comap.mp (hover ▸ hpiBase) + have hpiLt : q.valuation L + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi) < 1 := + (q.valuation_lt_one_iff_mem + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi)).mpr hpiP + have hpiImage : algebraMap + (RatFuncInfinityIntegralClosure K L) L + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi) = + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ := by + change algebraMap (RatFunc K) L (1 / RatFunc.X) = + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ + simp + have hxinverse : q.valuation L + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ < 1 := by + rw [← hpiImage] + exact hpiLt + have hX0 : algebraMap (RatFunc K) L RatFunc.X ≠ 0 := by + simpa using (algebraMap (RatFunc K) L).injective.ne RatFunc.X_ne_zero + have hXgt : 1 < q.valuation L + (algebraMap (RatFunc K) L RatFunc.X) := + ((q.valuation L).one_lt_val_iff hX0).mpr hxinverse + have horder := valuation_eq_exp_neg_finitePlaceOrder q + (algebraMap (RatFunc K) L RatFunc.X) hX0 + rw [horder, ← WithZero.exp_zero, WithZero.exp_lt_exp] at hXgt + have hnegative : finitePlaceOrder q + (algebraMap (RatFunc K) L RatFunc.X) < 0 := by + omega + have hord := fractionRingAlgEquiv_finitePlaceOrder_eq + (L := L) q + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm + (algebraMap (RatFunc K) L RatFunc.X)) + have hord' : finitePlaceOrder q + (algebraMap (RatFunc K) L RatFunc.X) = + finitePlaceOrder q + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm + (algebraMap (RatFunc K) L RatFunc.X)) := by + simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using hord + rw [finiteExtensionPrincipalDivisor_inr, ← hord'] + exact hnegative + +variable {K} + +omit [Fintype K] in +/-- The first plane coordinate has nonnegative principal-divisor order at +every finite place in its rational-function model. -/ +theorem finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegative + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∀ q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f), + 0 ≤ finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (.inl q) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change ∀ q : FiniteExtensionFinitePlace K L, + 0 ≤ finiteExtensionPrincipalDivisor K L x (.inl q) + intro q + dsimp only [x] + rw [← planeCurveFirstCoordinateRatFuncAlgebra_X f hx] + exact principalDivisor_algebraMap_X_inl_nonnegative K L q + +/-- Consequently, the pole divisor of the first plane coordinate vanishes at +every finite place. -/ +theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∀ q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f), + finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (.inl q) = 0 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change ∀ q : FiniteExtensionFinitePlace K L, + finiteExtensionPoleDivisor K L x (.inl q) = 0 + intro q + rw [finiteExtensionPoleDivisor_apply] + rw [if_neg (not_lt_of_ge + (finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegative + hf hpartialSecond q))] + +/-- Every place above infinity occurs with positive coefficient in the pole +divisor of the first plane coordinate. -/ +theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∀ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (.inr P) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change ∀ P : FiniteExtensionInfinityPlace K L, + 0 < finiteExtensionPoleDivisor K L x (.inr P) + intro P + have hnegative : finiteExtensionPrincipalDivisor K L x (.inr P) < 0 := by + have hmapX : algebraMap (RatFunc K) L RatFunc.X = x := by + dsimp only [x] + exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx + rw [← hmapX] + exact finiteExtensionPrincipalDivisor_algebraMap_X_inr_negative K L P + rw [finiteExtensionPoleDivisor_apply, if_pos hnegative] + omega + +/-- The controlled pole place for the first plane coordinate lies above the +rational-function place at infinity. Its positive pole coefficient and +place-degree bound are the same as in `exists_planeCurveFirstCoordinate_polePlace`. -/ +theorem exists_planeCurveFirstCoordinate_infinityPolePlace + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∃ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (.inr P) ∧ + 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inr P) ∧ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inr P) ≤ + MvPolynomial.degreeOf 1 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change ∃ P : FiniteExtensionInfinityPlace K L, + 0 < finiteExtensionPoleDivisor K L x (.inr P) ∧ + 0 < finiteExtensionPlaceDegree K L (.inr P) ∧ + finiteExtensionPlaceDegree K L (.inr P) ≤ MvPolynomial.degreeOf 1 f + obtain ⟨P, hPpole, hPdegreePositive, hPdegreeBound⟩ := + exists_planeCurveFirstCoordinate_polePlace hf hpartialSecond + cases P with + | inl q => + have hzero := + finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero + hf hpartialSecond q + rw [hzero] at hPpole + omega + | inr P => + exact ⟨P, hPpole, hPdegreePositive, hPdegreeBound⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean new file mode 100644 index 0000000000..1ffbcb8c88 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean @@ -0,0 +1,479 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import Mathlib.Algebra.MvPolynomial.Monad +import Mathlib.Algebra.MvPolynomial.PDeriv +import Mathlib.RingTheory.MvPolynomial.Expand + +/-! +# A separating coordinate shear for affine plane curves + +This file formalizes the invertible linear change of variables +`(x, y) ↦ (x, x + y)`. If the first partial derivative of `f` vanishes but +the second does not, the transformed equation has both partial derivatives +nonzero. The shear preserves affine point counts and geometric +irreducibility, including after extension to an algebraic closure. + +The case in which both partial derivatives vanish is deliberately not hidden +here: over a finite field it requires the separate characteristic-`p` +argument that an absolutely irreducible nonconstant polynomial cannot be a +polynomial in `x^p` and `y^p`. +-/ + +namespace BGS.HasseWeil + +open MvPolynomial + +noncomputable section + +section VanishingPartials + +variable {R σ : Type*} [Field R] + +/-- Divide every exponent of a multivariate monomial by `p`. On the +support of a polynomial whose partial derivatives vanish in characteristic +`p`, this is an exact inverse to multiplication of exponents by `p`. -/ +def divideExponents (p : ℕ) (m : σ →₀ ℕ) : σ →₀ ℕ := + m.mapRange (fun n => n / p) (Nat.zero_div p) + +variable (p : ℕ) [CharP R p] + +/-- In characteristic `p`, every exponent occurring in a variable with +vanishing partial derivative is divisible by `p`. -/ +theorem dvd_exponent_of_pderiv_eq_zero + {f : MvPolynomial σ R} {i : σ} + (hderiv : pderiv i f = 0) {m : σ →₀ ℕ} (hm : m ∈ f.support) : + p ∣ m i := by + by_contra hnot + have hi : m i ≠ 0 := by + intro hi + apply hnot + simp [hi] + let n : σ →₀ ℕ := m - Finsupp.single i 1 + have hn : n + Finsupp.single i 1 = m := by + exact Finsupp.sub_add_single_one_cancel hi + have hni : n i + 1 = m i := by + simpa [n] using congrArg (fun v : σ →₀ ℕ => v i) hn + have hcoeff : coeff m f ≠ 0 := by + simpa [mem_support_iff] using hm + have hcast : (m i : R) ≠ 0 := by + exact (CharP.cast_eq_zero_iff R p (m i)).not.mpr hnot + have hz := congrArg (coeff n) hderiv + rw [coeff_pderiv] at hz + simp only [coeff_zero] at hz + rw [hn] at hz + have hfactor : ((n i : R) + 1) = (m i : R) := by + simpa only [Nat.cast_add, Nat.cast_one] using + congrArg (fun a : ℕ => (a : R)) hni + rw [hfactor] at hz + exact (mul_ne_zero hcoeff hcast) hz + +theorem smul_divideExponents_eq + {f : MvPolynomial σ R} + (hderiv : ∀ i, pderiv i f = 0) + {m : σ →₀ ℕ} (hm : m ∈ f.support) : + p • divideExponents p m = m := by + ext i + simp only [Finsupp.smul_apply, nsmul_eq_mul, divideExponents, + Finsupp.mapRange_apply] + exact Nat.mul_div_cancel' (dvd_exponent_of_pderiv_eq_zero p (hderiv i) hm) + +variable [Fact p.Prime] [PerfectRing R p] + +/-- Over a perfect field of positive characteristic, a multivariate +polynomial with every partial derivative zero is a `p`-th power. -/ +theorem exists_pow_eq_of_forall_pderiv_eq_zero + (f : MvPolynomial σ R) (hderiv : ∀ i, pderiv i f = 0) : + ∃ g : MvPolynomial σ R, g ^ p = f := by + let g : MvPolynomial σ R := + ∑ m ∈ f.support, + monomial (divideExponents p m) + ((frobeniusEquiv R p).symm (coeff m f)) + refine ⟨g, ?_⟩ + rw [← map_frobenius_expand p] + calc + map (frobenius R p) (expand p g) = + ∑ m ∈ f.support, monomial m (coeff m f) := by + simp only [g, map_sum, map_monomial, expand_monomial] + apply Finset.sum_congr rfl + intro m hm + rw [smul_divideExponents_eq p hderiv hm] + simp + _ = f := f.as_sum.symm + +/-- Hence a polynomial with every partial derivative zero cannot be +irreducible over a perfect field of characteristic `p`. -/ +theorem not_irreducible_of_forall_pderiv_eq_zero + (p : ℕ) [Fact p.Prime] [CharP R p] [PerfectRing R p] + (f : MvPolynomial σ R) (hderiv : ∀ i, pderiv i f = 0) : + ¬ Irreducible f := by + obtain ⟨g, rfl⟩ := exists_pow_eq_of_forall_pderiv_eq_zero p f hderiv + exact not_irreducible_pow (Fact.out : p.Prime).ne_one + +end VanishingPartials + +variable (R : Type*) [CommRing R] + +/-- The substitution `(x, y) ↦ (x, x + y)`. -/ +def planeYShearSubstitution : Fin 2 → MvPolynomial (Fin 2) R := + ![X 0, X 0 + X 1] + +/-- The inverse substitution `(x, y) ↦ (x, y - x)`. -/ +def planeYUnShearSubstitution : Fin 2 → MvPolynomial (Fin 2) R := + ![X 0, X 1 - X 0] + +@[simp] theorem planeYShearSubstitution_zero : + planeYShearSubstitution R 0 = X 0 := rfl + +@[simp] theorem planeYShearSubstitution_one : + planeYShearSubstitution R 1 = X 0 + X 1 := rfl + +def planeYShearHom : MvPolynomial (Fin 2) R →ₐ[R] MvPolynomial (Fin 2) R := + bind₁ (planeYShearSubstitution R) + +def planeYUnShearHom : MvPolynomial (Fin 2) R →ₐ[R] MvPolynomial (Fin 2) R := + bind₁ (planeYUnShearSubstitution R) + +theorem planeYShearHom_comp_planeYUnShearHom : + (planeYShearHom R).comp (planeYUnShearHom R) = AlgHom.id R _ := by + ext i + fin_cases i <;> simp [planeYShearHom, planeYUnShearHom, + planeYShearSubstitution, planeYUnShearSubstitution] + +theorem planeYUnShearHom_comp_planeYShearHom : + (planeYUnShearHom R).comp (planeYShearHom R) = AlgHom.id R _ := by + ext i + fin_cases i <;> simp [planeYShearHom, planeYUnShearHom, + planeYShearSubstitution, planeYUnShearSubstitution] + +/-- The polynomial automorphism induced by `(x, y) ↦ (x, x + y)`. -/ +def planeYShearAlgEquiv : + MvPolynomial (Fin 2) R ≃ₐ[R] MvPolynomial (Fin 2) R := + AlgEquiv.ofAlgHom (planeYShearHom R) (planeYUnShearHom R) + (planeYShearHom_comp_planeYUnShearHom R) + (planeYUnShearHom_comp_planeYShearHom R) + +@[simp] theorem planeYShearAlgEquiv_apply (f : MvPolynomial (Fin 2) R) : + planeYShearAlgEquiv R f = bind₁ (planeYShearSubstitution R) f := rfl + +/-- The corresponding bijection of affine points. -/ +def planeYShearPointEquiv : R × R ≃ R × R where + toFun z := (z.1, z.1 + z.2) + invFun z := (z.1, z.2 - z.1) + left_inv := by rintro ⟨x, y⟩; simp + right_inv := by rintro ⟨x, y⟩; simp + +@[simp] theorem eval_planeYShearAlgEquiv + (f : MvPolynomial (Fin 2) R) (z : R × R) : + eval ![z.1, z.2] (planeYShearAlgEquiv R f) = + eval ![(planeYShearPointEquiv R z).1, (planeYShearPointEquiv R z).2] f := by + change aeval ![z.1, z.2] (bind₁ (planeYShearSubstitution R) f) = + aeval ![z.1, z.1 + z.2] f + rw [aeval_bind₁] + congr 1 + ext i + fin_cases i <;> simp [planeYShearSubstitution] + +theorem planeYShearAlgEquiv_irreducible_iff + (f : MvPolynomial (Fin 2) R) : + Irreducible (planeYShearAlgEquiv R f) ↔ Irreducible f := by + constructor + · intro h + have h' : Irreducible + ((planeYShearAlgEquiv R).symm (planeYShearAlgEquiv R f)) := + h.map (planeYShearAlgEquiv R).symm.toMulEquiv + simpa only [AlgEquiv.symm_apply_apply] using h' + · intro h + exact h.map (planeYShearAlgEquiv R).toMulEquiv + +/-- Chain rule in the first coordinate for the shear. -/ +theorem pderiv_zero_planeYShearAlgEquiv (f : MvPolynomial (Fin 2) R) : + pderiv 0 (planeYShearAlgEquiv R f) = + planeYShearAlgEquiv R (pderiv 0 f + pderiv 1 f) := by + change pderiv 0 (bind₁ (planeYShearSubstitution R) f) = + bind₁ (planeYShearSubstitution R) (pderiv 0 f + pderiv 1 f) + induction f using MvPolynomial.induction_on with + | C a => simp + | add f g hf hg => simp [hf, hg, map_add]; abel + | mul_X f i hf => + fin_cases i <;> + simp [hf] <;> + ring + +/-- Chain rule in the second coordinate for the shear. -/ +theorem pderiv_one_planeYShearAlgEquiv (f : MvPolynomial (Fin 2) R) : + pderiv 1 (planeYShearAlgEquiv R f) = + planeYShearAlgEquiv R (pderiv 1 f) := by + change pderiv 1 (bind₁ (planeYShearSubstitution R) f) = + bind₁ (planeYShearSubstitution R) (pderiv 1 f) + induction f using MvPolynomial.induction_on with + | C a => simp + | add f g hf hg => simp [hf, hg, map_add] + | mul_X f i hf => + fin_cases i <;> + simp [hf] + +/-- If only the second coordinate is separating, the shear makes both +coordinates separating. -/ +theorem planeYShearAlgEquiv_pderivs_ne_zero_of_zero_ne + (f : MvPolynomial (Fin 2) R) + (hzero : pderiv 0 f = 0) (hne : pderiv 1 f ≠ 0) : + pderiv 0 (planeYShearAlgEquiv R f) ≠ 0 ∧ + pderiv 1 (planeYShearAlgEquiv R f) ≠ 0 := by + have hs : planeYShearAlgEquiv R (pderiv 1 f) ≠ 0 := by + intro hs + apply hne + apply (planeYShearAlgEquiv R).injective + simpa using hs + rw [pderiv_zero_planeYShearAlgEquiv, + pderiv_one_planeYShearAlgEquiv, hzero, zero_add] + exact ⟨hs, hs⟩ + +/-- The shear commutes with extension of coefficients. -/ +theorem map_planeYShearAlgEquiv {S : Type*} [CommRing S] + (φ : R →+* S) (f : MvPolynomial (Fin 2) R) : + map φ (planeYShearAlgEquiv R f) = planeYShearAlgEquiv S (map φ f) := by + rw [planeYShearAlgEquiv_apply, planeYShearAlgEquiv_apply, map_bind₁] + congr 1 + ext i + fin_cases i <;> simp [planeYShearSubstitution] + +/-- The symmetric substitution `(x, y) ↦ (x + y, y)`. -/ +def planeXShearSubstitution : Fin 2 → MvPolynomial (Fin 2) R := + ![X 0 + X 1, X 1] + +/-- The inverse symmetric substitution `(x, y) ↦ (x - y, y)`. -/ +def planeXUnShearSubstitution : Fin 2 → MvPolynomial (Fin 2) R := + ![X 0 - X 1, X 1] + +@[simp] theorem planeXShearSubstitution_zero : + planeXShearSubstitution R 0 = X 0 + X 1 := rfl + +@[simp] theorem planeXShearSubstitution_one : + planeXShearSubstitution R 1 = X 1 := rfl + +def planeXShearHom : MvPolynomial (Fin 2) R →ₐ[R] MvPolynomial (Fin 2) R := + bind₁ (planeXShearSubstitution R) + +def planeXUnShearHom : MvPolynomial (Fin 2) R →ₐ[R] MvPolynomial (Fin 2) R := + bind₁ (planeXUnShearSubstitution R) + +theorem planeXShearHom_comp_planeXUnShearHom : + (planeXShearHom R).comp (planeXUnShearHom R) = AlgHom.id R _ := by + ext i + fin_cases i <;> simp [planeXShearHom, planeXUnShearHom, + planeXShearSubstitution, planeXUnShearSubstitution] + +theorem planeXUnShearHom_comp_planeXShearHom : + (planeXUnShearHom R).comp (planeXShearHom R) = AlgHom.id R _ := by + ext i + fin_cases i <;> simp [planeXShearHom, planeXUnShearHom, + planeXShearSubstitution, planeXUnShearSubstitution] + +/-- The polynomial automorphism induced by `(x, y) ↦ (x + y, y)`. -/ +def planeXShearAlgEquiv : + MvPolynomial (Fin 2) R ≃ₐ[R] MvPolynomial (Fin 2) R := + AlgEquiv.ofAlgHom (planeXShearHom R) (planeXUnShearHom R) + (planeXShearHom_comp_planeXUnShearHom R) + (planeXUnShearHom_comp_planeXShearHom R) + +@[simp] theorem planeXShearAlgEquiv_apply (f : MvPolynomial (Fin 2) R) : + planeXShearAlgEquiv R f = bind₁ (planeXShearSubstitution R) f := rfl + +/-- The symmetric shear on affine points. -/ +def planeXShearPointEquiv : R × R ≃ R × R where + toFun z := (z.1 + z.2, z.2) + invFun z := (z.1 - z.2, z.2) + left_inv := by rintro ⟨x, y⟩; simp + right_inv := by rintro ⟨x, y⟩; simp + +@[simp] theorem eval_planeXShearAlgEquiv + (f : MvPolynomial (Fin 2) R) (z : R × R) : + eval ![z.1, z.2] (planeXShearAlgEquiv R f) = + eval ![(planeXShearPointEquiv R z).1, (planeXShearPointEquiv R z).2] f := by + change aeval ![z.1, z.2] (bind₁ (planeXShearSubstitution R) f) = + aeval ![z.1 + z.2, z.2] f + rw [aeval_bind₁] + congr 1 + ext i + fin_cases i <;> simp [planeXShearSubstitution] + +theorem planeXShearAlgEquiv_irreducible_iff + (f : MvPolynomial (Fin 2) R) : + Irreducible (planeXShearAlgEquiv R f) ↔ Irreducible f := by + constructor + · intro h + have h' : Irreducible + ((planeXShearAlgEquiv R).symm (planeXShearAlgEquiv R f)) := + h.map (planeXShearAlgEquiv R).symm.toMulEquiv + simpa only [AlgEquiv.symm_apply_apply] using h' + · intro h + exact h.map (planeXShearAlgEquiv R).toMulEquiv + +/-- Chain rule in the first coordinate for the symmetric shear. -/ +theorem pderiv_zero_planeXShearAlgEquiv (f : MvPolynomial (Fin 2) R) : + pderiv 0 (planeXShearAlgEquiv R f) = + planeXShearAlgEquiv R (pderiv 0 f) := by + change pderiv 0 (bind₁ (planeXShearSubstitution R) f) = + bind₁ (planeXShearSubstitution R) (pderiv 0 f) + induction f using MvPolynomial.induction_on with + | C a => simp + | add f g hf hg => simp [hf, hg, map_add] + | mul_X f i hf => + fin_cases i <;> simp [hf] + +/-- Chain rule in the second coordinate for the symmetric shear. -/ +theorem pderiv_one_planeXShearAlgEquiv (f : MvPolynomial (Fin 2) R) : + pderiv 1 (planeXShearAlgEquiv R f) = + planeXShearAlgEquiv R (pderiv 0 f + pderiv 1 f) := by + change pderiv 1 (bind₁ (planeXShearSubstitution R) f) = + bind₁ (planeXShearSubstitution R) (pderiv 0 f + pderiv 1 f) + induction f using MvPolynomial.induction_on with + | C a => simp + | add f g hf hg => simp [hf, hg, map_add]; abel + | mul_X f i hf => + fin_cases i <;> simp [hf] <;> ring + +/-- If only the first coordinate is separating, the symmetric shear makes +both coordinates separating. -/ +theorem planeXShearAlgEquiv_pderivs_ne_zero_of_ne_zero + (f : MvPolynomial (Fin 2) R) + (hne : pderiv 0 f ≠ 0) (hzero : pderiv 1 f = 0) : + pderiv 0 (planeXShearAlgEquiv R f) ≠ 0 ∧ + pderiv 1 (planeXShearAlgEquiv R f) ≠ 0 := by + have hs : planeXShearAlgEquiv R (pderiv 0 f) ≠ 0 := by + intro hs + apply hne + apply (planeXShearAlgEquiv R).injective + simpa using hs + rw [pderiv_zero_planeXShearAlgEquiv, + pderiv_one_planeXShearAlgEquiv, hzero, add_zero] + exact ⟨hs, hs⟩ + +/-- The symmetric shear commutes with extension of coefficients. -/ +theorem map_planeXShearAlgEquiv {S : Type*} [CommRing S] + (φ : R →+* S) (f : MvPolynomial (Fin 2) R) : + map φ (planeXShearAlgEquiv R f) = planeXShearAlgEquiv S (map φ f) := by + rw [planeXShearAlgEquiv_apply, planeXShearAlgEquiv_apply, map_bind₁] + congr 1 + ext i + fin_cases i <;> simp [planeXShearSubstitution] + +end + +section AbsoluteIrreducibility + +variable (K : Type*) [Field K] + +/-- Absolute irreducibility is invariant under the coordinate shear. -/ +theorem planeYShearAlgEquiv_absolutelyIrreducible_iff + (f : MvPolynomial (Fin 2) K) : + Irreducible + (map (algebraMap K (AlgebraicClosure K)) (planeYShearAlgEquiv K f)) ↔ + Irreducible (map (algebraMap K (AlgebraicClosure K)) f) := by + rw [map_planeYShearAlgEquiv] + exact planeYShearAlgEquiv_irreducible_iff _ _ + +/-- Absolute irreducibility is invariant under the symmetric shear. -/ +theorem planeXShearAlgEquiv_absolutelyIrreducible_iff + (f : MvPolynomial (Fin 2) K) : + Irreducible + (map (algebraMap K (AlgebraicClosure K)) (planeXShearAlgEquiv K f)) ↔ + Irreducible (map (algebraMap K (AlgebraicClosure K)) f) := by + rw [map_planeXShearAlgEquiv] + exact planeXShearAlgEquiv_irreducible_iff _ _ + +/-- An absolutely irreducible bivariate polynomial over a field of positive +characteristic cannot have both partial derivatives zero. The proof passes +to the algebraic closure, where perfectness turns simultaneous vanishing +into a `p`-th power. -/ +theorem pderiv_zero_ne_zero_or_pderiv_one_ne_zero_of_absolutelyIrreducible + [Finite K] + (f : MvPolynomial (Fin 2) K) + (hirr : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) : + pderiv 0 f ≠ 0 ∨ pderiv 1 f ≠ 0 := by + let p := ringChar K + letI : Fact p.Prime := ⟨CharP.char_is_prime K p⟩ + by_contra h + rw [not_or] at h + have hzero : pderiv 0 f = 0 := not_ne_iff.mp h.1 + have hone : pderiv 1 f = 0 := not_ne_iff.mp h.2 + have hderivMapped : ∀ i, + pderiv i (map (algebraMap K (AlgebraicClosure K)) f) = 0 := by + intro i + fin_cases i + · rw [pderiv_map] + simpa using congrArg (map (algebraMap K (AlgebraicClosure K))) hzero + · rw [pderiv_map] + simpa using congrArg (map (algebraMap K (AlgebraicClosure K))) hone + exact (not_irreducible_of_forall_pderiv_eq_zero p + (map (algebraMap K (AlgebraicClosure K)) f) hderivMapped) hirr + +/-- For an absolutely irreducible plane polynomial over a finite field, +either both coordinates already separate or one of the two elementary +shears makes both partial derivatives nonzero. -/ +theorem pderivs_ne_zero_or_planeYShear_or_planeXShear_of_absolutelyIrreducible + [Finite K] + (f : MvPolynomial (Fin 2) K) + (hirr : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) : + (pderiv 0 f ≠ 0 ∧ pderiv 1 f ≠ 0) ∨ + (pderiv 0 (planeYShearAlgEquiv K f) ≠ 0 ∧ + pderiv 1 (planeYShearAlgEquiv K f) ≠ 0) ∨ + (pderiv 0 (planeXShearAlgEquiv K f) ≠ 0 ∧ + pderiv 1 (planeXShearAlgEquiv K f) ≠ 0) := by + rcases pderiv_zero_ne_zero_or_pderiv_one_ne_zero_of_absolutelyIrreducible + K f hirr with hzero | hone + · by_cases hone' : pderiv 1 f = 0 + · exact Or.inr (Or.inr + (planeXShearAlgEquiv_pderivs_ne_zero_of_ne_zero K f hzero hone')) + · exact Or.inl ⟨hzero, hone'⟩ + · by_cases hzero' : pderiv 0 f = 0 + · exact Or.inr (Or.inl + (planeYShearAlgEquiv_pderivs_ne_zero_of_zero_ne K f hzero' hone)) + · exact Or.inl ⟨hzero', hone⟩ + +end AbsoluteIrreducibility + +section FiniteField + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + +/-- The shear bijects the affine zero sets before and after substitution. -/ +def planeYShearAffineZeroEquiv (f : MvPolynomial (Fin 2) K) : + ↥(BGS.External.affinePlaneCurveZeros K (planeYShearAlgEquiv K f)) ≃ + ↥(BGS.External.affinePlaneCurveZeros K f) := + (planeYShearPointEquiv K).subtypeEquiv fun z => by + simp only [BGS.External.mem_affinePlaneCurveZeros_iff] + exact (eval_planeYShearAlgEquiv K f z).congr_left + +theorem card_affinePlaneCurveZeros_planeYShearAlgEquiv + (f : MvPolynomial (Fin 2) K) : + (BGS.External.affinePlaneCurveZeros K (planeYShearAlgEquiv K f)).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + rw [← Fintype.card_coe, ← Fintype.card_coe] + exact Fintype.card_congr (planeYShearAffineZeroEquiv K f) + +/-- The symmetric shear bijects the affine zero sets. -/ +def planeXShearAffineZeroEquiv (f : MvPolynomial (Fin 2) K) : + ↥(BGS.External.affinePlaneCurveZeros K (planeXShearAlgEquiv K f)) ≃ + ↥(BGS.External.affinePlaneCurveZeros K f) := + (planeXShearPointEquiv K).subtypeEquiv fun z => by + simp only [BGS.External.mem_affinePlaneCurveZeros_iff] + exact (eval_planeXShearAlgEquiv K f z).congr_left + +theorem card_affinePlaneCurveZeros_planeXShearAlgEquiv + (f : MvPolynomial (Fin 2) K) : + (BGS.External.affinePlaneCurveZeros K (planeXShearAlgEquiv K f)).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + rw [← Fintype.card_coe, ← Fintype.card_coe] + exact Fintype.card_congr (planeXShearAffineZeroEquiv K f) + +end FiniteField + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean new file mode 100644 index 0000000000..3c466bcbc1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean @@ -0,0 +1,176 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower + +/-! +# Automatic bidegree genus bound for plane curves + +For an absolutely irreducible plane curve with both coordinate projections +separating, the intrinsic genus of its function field is bounded by the bidegree +monomial budget. The proof combines three already formalized ingredients: + +* exactness of the constant field; +* Riemann--Roch for the exhaustive finite-extension divisor model; +* the finite-place bidegree form of Riemann's inequality. + +The finite place needed by the one-point comparison is constructed above the +prime `(X)` of `K[X]`, so it is not an additional hypothesis. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped Polynomial + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) automaticGenusPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance automaticGenusPolynomialTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance automaticGenusFiniteClosureIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance automaticGenusPolynomialTorsionFree : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- A finite separable extension of `K(X)` has an exhaustive finite place. +We select a prime of the finite integral closure lying above `(X)`. -/ +theorem finiteExtensionFinitePlace_nonempty : + Nonempty (FiniteExtensionFinitePlace K L) := by + let p : HeightOneSpectrum K[X] := Polynomial.idealX K + obtain ⟨Q, hQprime, hQcomap⟩ := + Ideal.exists_ideal_over_prime_of_isIntegral_of_isDomain + (S := RatFuncFiniteIntegralClosure K L) p.asIdeal (by + intro x hx + have hxA : algebraMap K[X] (RatFuncFiniteIntegralClosure K L) x = 0 := + (RingHom.mem_ker).mp hx + have hxL : algebraMap K[X] L x = 0 := congrArg Subtype.val hxA + have hx0 : x = 0 := by + exact FaithfulSMul.algebraMap_injective K[X] L (by simpa using hxL) + subst x + exact p.asIdeal.zero_mem) + let P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := + ⟨Q, hQprime, ⟨hQcomap.symm⟩⟩ + exact ⟨primeOverHeightOne p P⟩ + +variable {K} + +/-- The function-field genus of an absolutely irreducible plane curve is at +most its bidegree monomial budget + +`(degreeOf 0 f - 1) * (degreeOf 1 f - 1)`. + +This theorem has no Riemann--Roch, constant-field, or place hypothesis: all +three are discharged by the existing formalized theory. -/ +theorem planeCurve_genus_le_bidegreeGenusBudget + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + FunctionField.genus K (PlaneCurveFunctionField f) ≤ + planeCurveBidegreeGenusBudget f := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + letI : Algebra K L := canonicalAlg + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let inducedAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg + (planeCurveFunction f 0) hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg (planeCurveFunction f 0) hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + letI : SMul K L := inducedAlg.toSMul + letI : Module K L := inducedAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + have hconstantsCanonical : + @algebraicClosure K L _ _ canonicalAlg = ⊥ := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hconstants : algebraicClosure K L = ⊥ := by + change @algebraicClosure K L _ _ inducedAlg = ⊥ + rw [hinducedAlg] + exact hconstantsCanonical + letI : FunctionField.IsFullConstantField K L := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 + hconstants + let q : FiniteExtensionFinitePlace K L := + Classical.choice (finiteExtensionFinitePlace_nonempty K L) + have hchart : FunctionField.Chart.genus K L ≤ + planeCurveBidegreeGenusBudget f := by + apply genus_le_budget_of_uniformRiemann_onePoint K L + (FunctionField.Chart.genus K L) + (2 * FunctionField.Chart.genus K L) + (planeCurveBidegreeGenusBudget f) (.inl q) + (hasFiniteExtensionUniformEventualRiemannFormula_of_fullConstantField K L) + intro N + simpa only [L] using + planeCurve_finitePlace_riemann_lower + hf hpartialFirst hpartialSecond q N + have hintrinsic : FunctionField.genus K L ≤ + planeCurveBidegreeGenusBudget f := by + rw [FunctionField.genus_eq_genusChart K L] + exact hchart + change @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f + change @FunctionField.genus K L _ _ inducedAlg ≤ + planeCurveBidegreeGenusBudget f at hintrinsic + rw [hinducedAlg] at hintrinsic + exact hintrinsic + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean new file mode 100644 index 0000000000..d709e2f1f9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField + +/-! +# Plane-curve genus bound from direct cotrace canonicality + +For an absolutely irreducible plane curve whose second coordinate is +separating, the local cotrace maximality theorem identifies the explicit +different divisor as canonical. The established bidegree estimate for that +divisor therefore gives the intrinsic genus bound without a separately +assumed Riemann--Hurwitz degree identity. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- The one-separating-coordinate plane-curve genus bound obtained directly +from cotrace canonicality and the explicit different-degree estimate. -/ +theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Nat.card K) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + let polynomialAlg : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + letI : Algebra K[X] L := polynomialAlg + letI : SMul K[X] L := polynomialAlg.toSMul + letI : Module K[X] L := polynomialAlg.toModule + letI : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + let inducedAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := inducedAlg + letI : SMul K L := inducedAlg.toSMul + letI : Module K L := inducedAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + let polynomialAlg : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + letI : Algebra K[X] L := polynomialAlg + letI : SMul K[X] L := polynomialAlg.toSMul + letI : Module K[X] L := polynomialAlg.toModule + letI : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let inducedAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg + (planeCurveFunction f 0) hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg (planeCurveFunction f 0) hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + letI : SMul K L := inducedAlg.toSMul + letI : Module K L := inducedAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + have hconstantsCanonical : + @algebraicClosure K L _ _ canonicalAlg = ⊥ := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hconstants : algebraicClosure K L = ⊥ := by + change @algebraicClosure K L _ _ inducedAlg = ⊥ + rw [hinducedAlg] + exact hconstantsCanonical + letI : FunctionField.IsFullConstantField K L := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 + hconstants + have hcardK' : MvPolynomial.degreeOf 1 f < Fintype.card K := by + simpa only [Nat.card_eq_fintype_card] using hcardK + have hdegreeLe : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + 2 * (planeCurveBidegreeGenusBudget f : ℤ) - 2 := by + simpa only [L] using + planeCurve_canonicalDifferentDivisor_degree_le_two_genusBudget_sub_two + hf hpartialSecond hcardK' + have hgenus : FunctionField.genus K L ≤ + planeCurveBidegreeGenusBudget f := + finiteExtension_genus_le_budget_of_cotrace + K L (planeCurveBidegreeGenusBudget f) hdegreeLe + change @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f + change @FunctionField.genus K L _ _ inducedAlg ≤ + planeCurveBidegreeGenusBudget f at hgenus + rw [hinducedAlg] at hgenus + exact hgenus + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean new file mode 100644 index 0000000000..bb2483a3ad --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField + +/-! +# Plane-curve genus bound from the cotrace divisor + +For an absolutely irreducible plane curve with the second coordinate +separating, the cotrace construction and the explicit bidegree estimate reduce +the intrinsic genus bound to the Riemann--Hurwitz degree identity for the +canonical-different divisor. The identity remains a visible premise here. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open scoped Polynomial + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +/-- The one-separating-coordinate plane-curve genus bound, conditional only +on the displayed Riemann--Hurwitz degree identity for the cotrace divisor. + +Absolute irreducibility supplies the exact constant field, while +`planeCurve_canonicalDifferentDivisor_degree_le_two_genusBudget_sub_two` +supplies the required degree upper bound. -/ +theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace_degree_eq + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + let polynomialAlg : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + letI : Algebra K[X] L := polynomialAlg + letI : SMul K[X] L := polynomialAlg.toSMul + letI : Module K[X] L := polynomialAlg.toModule + letI : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + let inducedAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := inducedAlg + letI : SMul K L := inducedAlg.toSMul + letI : Module K L := inducedAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.genus K L : ℤ) - 2 → + @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let canonicalAlg : Algebra K L := inferInstance + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + let polynomialAlg : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + letI : Algebra K[X] L := polynomialAlg + letI : SMul K[X] L := polynomialAlg.toSMul + letI : Module K[X] L := polynomialAlg.toModule + letI : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let inducedAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg + (planeCurveFunction f 0) hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg (planeCurveFunction f 0) hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + letI : SMul K L := inducedAlg.toSMul + letI : Module K L := inducedAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K K[X] L := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro hdegreeEq + have hconstantsCanonical : + @algebraicClosure K L _ _ canonicalAlg = ⊥ := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hconstants : algebraicClosure K L = ⊥ := by + change @algebraicClosure K L _ _ inducedAlg = ⊥ + rw [hinducedAlg] + exact hconstantsCanonical + letI : FunctionField.IsFullConstantField K L := + (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 + hconstants + have hdegreeEqChart : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) = + 2 * (FunctionField.Chart.genus K L : ℤ) - 2 := by + rw [← FunctionField.genus_eq_genusChart K L] + exact hdegreeEq + have hdegreeLe : + finiteExtensionDivisorDegree K L + (finiteExtensionCanonicalDifferentDivisor K L + (finiteExtensionFiniteDifferentIdeal_ne_bot K L)) ≤ + 2 * (planeCurveBidegreeGenusBudget f : ℤ) - 2 := by + simpa only [L] using + planeCurve_canonicalDifferentDivisor_degree_le_two_genusBudget_sub_two + hf hpartialSecond hcardK + have hgenus : FunctionField.genus K L ≤ + planeCurveBidegreeGenusBudget f := + finiteExtension_genus_le_budget_of_cotrace_and_degree_eq + K L (planeCurveBidegreeGenusBudget f) hdegreeEqChart hdegreeLe + change @FunctionField.genus K L _ _ canonicalAlg ≤ + planeCurveBidegreeGenusBudget f + change @FunctionField.genus K L _ _ inducedAlg ≤ + planeCurveBidegreeGenusBudget f at hgenus + rw [hinducedAlg] at hgenus + exact hgenus + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean new file mode 100644 index 0000000000..41265347c3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean @@ -0,0 +1,454 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts +import Mathlib.Tactic + +/-! +# Riemann's inequality at finite plane-curve places + +Weak approximation lifts a basis of the principal parts at one finite place +to global functions regular at every other finite place. A common effective +divisor above infinity absorbs the remaining poles. The resulting +principal-part map is surjective, so rank-nullity contributes exactly +`N * degree(q)` new dimensions over the infinity-supported Riemann space. + +The infinity-supported bidegree Riemann inequality and the effective-divisor +increment upper bound then cancel the auxiliary infinity divisor. This gives +Riemann's inequality for `L(N q)` at every finite exhaustive place. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance finiteRiemannConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance finiteRiemannConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) finiteRiemannPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance finiteRiemannPolynomialTower : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance finiteRiemannClosureIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance finiteRiemannClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance finiteRiemannPolynomialTorsionFree : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance finiteRiemannClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance finiteRiemannClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance finiteRiemannClosureFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) + +theorem mem_finiteExtensionLocalPoleSpace_zero_of_valuation_le_one + (q : FiniteExtensionFinitePlace K L) (x : L) + (hx : q.valuation L x ≤ 1) : + x ∈ finiteExtensionLocalPoleSpace K L (.inl q) 0 := by + rw [mem_finiteExtensionLocalPoleSpace_iff] + by_cases hx0 : x = 0 + · exact Or.inl hx0 + · refine Or.inr ⟨hx0, ?_⟩ + rw [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] + rw [valuation_eq_exp_neg_finitePlaceOrder q x hx0, ← WithZero.exp_zero, + WithZero.exp_le_exp] at hx + omega + +theorem exists_global_finitePrincipalPart_representative + (q : FiniteExtensionFinitePlace K L) (N : ℕ) + (p : finiteExtensionLocalPoleSpace K L (.inl q) N ⧸ + relativeSubmodule + (finiteExtensionLocalPoleSpace K L (.inl q) 0) + (finiteExtensionLocalPoleSpace K L (.inl q) N)) : + ∃ z : finiteExtensionLocalPoleSpace K L (.inl q) N, + Submodule.Quotient.mk z = p ∧ + ∀ q' : FiniteExtensionFinitePlace K L, q' ≠ q → + (z : L) ∈ finiteExtensionLocalPoleSpace K L (.inl q') 0 := by + classical + obtain ⟨x, hxmk⟩ := + (Submodule.Quotient.mk_surjective + (relativeSubmodule + (finiteExtensionLocalPoleSpace K L (.inl q) 0) + (finiteExtensionLocalPoleSpace K L (.inl q) N))) p + let selected : Finset (Ideal (RatFuncFiniteIntegralClosure K L)) := + {q.asIdeal} + let target : Ideal (RatFuncFiniteIntegralClosure K L) → L := fun Q => + if Q = q.asIdeal then (x : L) else 0 + obtain ⟨z, happrox, hregular⟩ := + exists_fraction_approximating_at_finitePlaces_regular_elsewhere + selected (by + intro P hP + simp only [selected, Finset.mem_singleton] at hP + subst P + exact (Ideal.prime_iff_isPrime q.ne_bot).mpr q.isPrime) target + (fun _ => 0) + have hzsub : z - (x : L) ∈ + finiteExtensionLocalPoleSpace K L (.inl q) 0 := by + apply mem_finiteExtensionLocalPoleSpace_zero_of_valuation_le_one K L + have h := happrox q (by simp [selected]) + simpa only [target, if_pos rfl, CharP.cast_eq_zero, neg_zero, + WithZero.exp_zero] using h + have hzMem : z ∈ finiteExtensionLocalPoleSpace K L (.inl q) N := by + have hxMem : (x : L) ∈ finiteExtensionLocalPoleSpace K L (.inl q) N := x.2 + have hzeroLe := finiteExtensionLocalPoleSpace_mono K L (.inl q) + (Nat.zero_le N) + have hsubMem := hzeroLe hzsub + have hadd := (finiteExtensionLocalPoleSpace K L (.inl q) N).add_mem + hxMem hsubMem + rw [show (x : L) + (z - (x : L)) = z by abel] at hadd + exact hadd + refine ⟨⟨z, hzMem⟩, ?_, ?_⟩ + · rw [← hxmk] + rw [Submodule.Quotient.eq] + change z - (x : L) ∈ + finiteExtensionLocalPoleSpace K L (.inl q) 0 + exact hzsub + · intro q' hq' + apply mem_finiteExtensionLocalPoleSpace_zero_of_valuation_le_one K L + apply hregular q' + simp only [selected, Finset.mem_singleton] + intro hideal + apply hq' + exact HeightOneSpectrum.ext hideal + +/-- The part of an exhaustive divisor supported at infinity. -/ +def finiteExtensionDivisorInfinityPart + (D : FiniteExtensionDivisor K L) : FiniteExtensionDivisor K L := by + classical + exact Finsupp.filter (fun v => match v with + | .inl _ => False + | .inr _ => True) D + +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +@[simp] +theorem finiteExtensionDivisorInfinityPart_inl + (D : FiniteExtensionDivisor K L) + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionDivisorInfinityPart K L D (.inl q) = 0 := by + simp [finiteExtensionDivisorInfinityPart] + +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in +@[simp] +theorem finiteExtensionDivisorInfinityPart_inr + (D : FiniteExtensionDivisor K L) + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionDivisorInfinityPart K L D (.inr P) = D (.inr P) := by + simp [finiteExtensionDivisorInfinityPart] + +theorem exists_infinityDivisor_finitePlacePrincipalParts_rank + (q : FiniteExtensionFinitePlace K L) (N : ℕ) (hN : 0 < N) : + ∃ E : FiniteExtensionDivisor K L, + (∀ v, 0 ≤ E v) ∧ + (∀ q' : FiniteExtensionFinitePlace K L, E (.inl q') = 0) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L E) + + N * finiteExtensionPlaceDegree K L (.inl q) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single (.inl q) (N : ℤ) + E)) := by + classical + let A := finiteExtensionLocalPoleSpace K L (.inl q) N + let A0 := finiteExtensionLocalPoleSpace K L (.inl q) 0 + let PP := A ⧸ relativeSubmodule A0 A + have hPPfinrank : Module.finrank K PP = + N * finiteExtensionPlaceDegree K L (.inl q) := by + simpa only [A, A0, PP] using + finiteExtensionLocalPoleSpace_inl_cumulative_finrank K L q N + letI : Module.Finite K PP := by + apply Module.finite_of_finrank_pos + rw [hPPfinrank] + exact Nat.mul_pos hN (finiteExtensionPlaceDegree_pos K L (.inl q)) + let b := Module.finBasis K PP + have hzExists (i : Fin (Module.finrank K PP)) := + exists_global_finitePrincipalPart_representative K L q N (b i) + let z : Fin (Module.finrank K PP) → A := fun i => + Classical.choose (hzExists i) + have hzmk (i : Fin (Module.finrank K PP)) : + Submodule.Quotient.mk (z i) = b i := + (Classical.choose_spec (hzExists i)).1 + have hzregular (i : Fin (Module.finrank K PP)) + (q' : FiniteExtensionFinitePlace K L) (hq' : q' ≠ q) : + (z i : L) ∈ finiteExtensionLocalPoleSpace K L (.inl q') 0 := + (Classical.choose_spec (hzExists i)).2 q' hq' + have hzNe (i : Fin (Module.finrank K PP)) : (z i : L) ≠ 0 := by + intro hzero + have hzSubtype : z i = 0 := Subtype.ext hzero + have hmk := hzmk i + rw [hzSubtype] at hmk + exact b.linearIndependent.ne_zero i (by simpa using hmk.symm) + let H : FiniteExtensionDivisor K L := + ∑ i, finiteExtensionPoleDivisor K L (z i : L) + have hH : (0 : FiniteExtensionDivisor K L) ≤ H := by + dsimp only [H] + apply Finset.sum_nonneg + intro i _ v + exact finiteExtensionPoleDivisor_effective K L (z i : L) v + have hPoleLeH (i : Fin (Module.finrank K PP)) : + finiteExtensionPoleDivisor K L (z i : L) ≤ H := by + dsimp only [H] + calc + finiteExtensionPoleDivisor K L (z i : L) ≤ + finiteExtensionPoleDivisor K L (z i : L) + + ∑ j ∈ Finset.univ.erase i, + finiteExtensionPoleDivisor K L (z j : L) := + le_add_of_nonneg_right (Finset.sum_nonneg fun j _ v => + finiteExtensionPoleDivisor_effective K L (z j : L) v) + _ = ∑ j, finiteExtensionPoleDivisor K L (z j : L) := by + rw [add_comm, Finset.sum_erase_add _ _ (Finset.mem_univ i)] + let E : FiniteExtensionDivisor K L := + finiteExtensionDivisorInfinityPart K L H + have hE : ∀ v, 0 ≤ E v := by + intro v + rcases v with q' | P + · simp [E] + · simp only [E, finiteExtensionDivisorInfinityPart_inr, H] + exact hH (.inr P) + have hEfinite : ∀ q' : FiniteExtensionFinitePlace K L, + E (.inl q') = 0 := by + intro q' + simp [E] + let D : FiniteExtensionDivisor K L := + Finsupp.single (.inl q) (N : ℤ) + E + have hD : ∀ v, 0 ≤ D v := by + intro v + exact add_nonneg (by + by_cases hv : v = (.inl q : FiniteExtensionPlace K L) + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv]) (hE v) + have hzPoleLe (i : Fin (Module.finrank K PP)) : + finiteExtensionPoleDivisor K L (z i : L) ≤ D := by + intro v + rcases v with q' | P + · by_cases hq' : q' = q + · subst q' + have hzOrder : -(N : ℤ) ≤ + finiteExtensionPrincipalDivisor K L (z i : L) (.inl q) := by + have hzmem := (z i).2 + rw [mem_finiteExtensionLocalPoleSpace_iff] at hzmem + rcases hzmem with hzero | ⟨_, horder⟩ + · exact (hzNe i hzero).elim + · exact horder + rw [finiteExtensionPoleDivisor_apply] + by_cases hneg : + finiteExtensionPrincipalDivisor K L (z i : L) (.inl q) < 0 + · rw [if_pos hneg] + simp only [D, Finsupp.add_apply, Finsupp.single_eq_same, + hEfinite q, add_zero] + omega + · rw [if_neg hneg] + exact hD (.inl q) + · have hzreg := hzregular i q' hq' + rw [mem_finiteExtensionLocalPoleSpace_iff] at hzreg + have hzOrder : 0 ≤ + finiteExtensionPrincipalDivisor K L (z i : L) (.inl q') := by + rcases hzreg with hzero | ⟨_, horder⟩ + · exact (hzNe i hzero).elim + · simpa using horder + rw [finiteExtensionPoleDivisor_apply, if_neg (not_lt_of_ge hzOrder)] + exact hD (.inl q') + · simp only [D, Finsupp.add_apply, + Finsupp.single_eq_of_ne (by simp : + (Sum.inr P : FiniteExtensionPlace K L) ≠ Sum.inl q), + zero_add, E, finiteExtensionDivisorInfinityPart_inr, H] + exact hPoleLeH i (.inr P) + have hzD (i : Fin (Module.finrank K PP)) : + (z i : L) ∈ finiteExtensionRiemannSpace K L D := by + apply finiteExtensionRiemannSpace_mono K L (hzPoleLe i) + exact mem_finiteExtensionRiemannSpace_poleDivisor K L + (z i : L) (hzNe i) + have hDq : D (.inl q) = N := by + simp [D, hEfinite] + have hlocal (x : finiteExtensionRiemannSpace K L D) : + (x : L) ∈ A := by + have hx := finiteExtensionRiemannSpace_le_localPoleSpace K L D hD + (.inl q) x.2 + simpa only [A, hDq, Int.toNat_natCast] using hx + let toLocal : finiteExtensionRiemannSpace K L D →ₗ[K] A := + LinearMap.codRestrict A + (finiteExtensionRiemannSpace K L D).subtype hlocal + let φ : finiteExtensionRiemannSpace K L D →ₗ[K] PP := + (relativeSubmodule A0 A).mkQ.comp toLocal + have hφz (i : Fin (Module.finrank K PP)) : + φ ⟨(z i : L), hzD i⟩ = b i := by + change Submodule.Quotient.mk (z i) = b i + exact hzmk i + have hφsurj : Function.Surjective φ := by + intro p + let w : finiteExtensionRiemannSpace K L D := + ∑ i, (b.repr p) i • ⟨(z i : L), hzD i⟩ + refine ⟨w, ?_⟩ + simp only [w, map_sum, map_smul, hφz] + exact b.sum_repr p + have hED : E ≤ D := by + intro v + exact le_add_of_nonneg_left (by + by_cases hv : v = (.inl q : FiniteExtensionPlace K L) + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv]) + let incl : finiteExtensionRiemannSpace K L E →ₗ[K] + finiteExtensionRiemannSpace K L D := + Submodule.inclusion (finiteExtensionRiemannSpace_mono K L hED) + have hinclKer (x : finiteExtensionRiemannSpace K L E) : incl x ∈ φ.ker := by + rw [LinearMap.mem_ker] + change Submodule.Quotient.mk (toLocal (incl x)) = 0 + rw [Submodule.Quotient.mk_eq_zero] + change (x : L) ∈ A0 + have hx := finiteExtensionRiemannSpace_le_localPoleSpace K L E hE + (.inl q) x.2 + simpa only [A0, hEfinite q, Int.toNat_zero] using hx + let inclKer : finiteExtensionRiemannSpace K L E →ₗ[K] φ.ker := + LinearMap.codRestrict φ.ker incl hinclKer + have hinclKerInjective : Function.Injective inclKer := by + intro x y hxy + apply Subtype.ext + exact congrArg (fun w : φ.ker => ((w : finiteExtensionRiemannSpace K L D) : L)) hxy + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + have hkerLower : Module.finrank K (finiteExtensionRiemannSpace K L E) ≤ + Module.finrank K φ.ker := + inclKer.finrank_le_finrank_of_injective hinclKerInjective + have hrank := φ.finrank_range_add_finrank_ker + have hrange : Module.finrank K φ.range = Module.finrank K PP := by + rw [LinearMap.range_eq_top.mpr hφsurj] + simp + refine ⟨E, hE, hEfinite, ?_⟩ + change Module.finrank K (finiteExtensionRiemannSpace K L E) + + N * finiteExtensionPlaceDegree K L (.inl q) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + rw [← hPPfinrank, ← hrange] + omega + +end + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +variable {K} + +/-- Bidegree Riemann inequality at an arbitrary finite exhaustive place of +an irreducible plane curve. -/ +theorem planeCurve_finitePlace_riemann_lower + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∀ (q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f)) (N : ℕ), + N * finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inl q) + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K + (PlaneCurveFunctionField f) (.inl q) N) + + planeCurveBidegreeGenusBudget f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let g := planeCurveBidegreeGenusBudget f + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := constantAlg + letI : SMul K L := constantAlg.toSMul + letI : Module K L := constantAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro q N + by_cases hN : N = 0 + · subst N + have hzero := planeCurve_infinitySupported_riemann_lower + hf hpartialFirst hpartialSecond + (0 : FiniteExtensionDivisor K L) (by simp) (by simp) + have hdegreezero : + finiteExtensionDivisorDegree K L (0 : FiniteExtensionDivisor K L) = 0 := by + simp [finiteExtensionDivisorDegree] + rw [hdegreezero] at hzero + simp only [Int.toNat_zero, zero_add] at hzero + simp only [zero_mul, zero_add] + change 1 ≤ Module.finrank K + (finiteExtensionRiemannSpace K L (Finsupp.single (.inl q) 0)) + g + rw [Finsupp.single_zero] + simpa only [L, g] using hzero + · have hNpos : 0 < N := Nat.pos_of_ne_zero hN + obtain ⟨E, hE, hEfinite, hrank⟩ := + exists_infinityDivisor_finitePlacePrincipalParts_rank K L q N hNpos + have hinfinity : + (finiteExtensionDivisorDegree K L E).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + g := by + simpa only [L, g] using + (planeCurve_infinitySupported_riemann_lower + hf hpartialFirst hpartialSecond E hE hEfinite) + let Dq : FiniteExtensionDivisor K L := + Finsupp.single (.inl q) (N : ℤ) + have hDq : ∀ v, 0 ≤ Dq v := by + intro v + by_cases hv : v = (.inl q : FiniteExtensionPlace K L) + · subst v + simp [Dq] + · simp [Dq, Finsupp.single_eq_of_ne hv] + letI : Module.Finite K (finiteExtensionRiemannSpace K L Dq) := + finiteExtensionRiemannSpace_effective_moduleFinite K L Dq hDq + have hstrip := finiteExtensionRiemannSpace_add_effective + K L Dq E hDq hE + change N * finiteExtensionPlaceDegree K L (.inl q) + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L Dq) + g + have hDqEq : Dq = Finsupp.single (.inl q) (N : ℤ) := rfl + rw [← hDqEq] at hrank + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean new file mode 100644 index 0000000000..dcd68adb2c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean @@ -0,0 +1,416 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +import Mathlib.Algebra.MvPolynomial.Equiv +import Mathlib.Algebra.Polynomial.Expand +import Mathlib.Tactic + +/-! +# Frobenius deflation for affine plane curves + +If the first partial derivative vanishes in characteristic `p`, every first +coordinate exponent is divisible by `p`. This module contracts those +exponents, proves that substitution `X₀ ↦ X₀^p` reconstructs the original +polynomial, and records the exact invariants needed by the affine +Hasse--Weil reduction: absolute irreducibility, the other partial derivative, +the supplied bidegree bound, and the finite-field affine point count. + +Unlike a coordinate shear, this operation does not enlarge the other +coordinate degree, and it strictly lowers the actual first coordinate degree +whenever that degree is positive. +-/ + +namespace BGS.HasseWeil + +open MvPolynomial + +noncomputable section + +variable (R : Type*) [CommRing R] + +/-- Substitute `X₀^p` for `X₀`, leaving `X₁` unchanged. -/ +def planeFirstInflateSubstitution (p : ℕ) : + Fin 2 → MvPolynomial (Fin 2) R := + ![X 0 ^ p, X 1] + +/-- The one-coordinate Frobenius expansion homomorphism. -/ +def planeFirstInflateHom (p : ℕ) : + MvPolynomial (Fin 2) R →ₐ[R] MvPolynomial (Fin 2) R := + bind₁ (planeFirstInflateSubstitution R p) + +@[simp] theorem planeFirstInflateHom_C (p : ℕ) (r : R) : + planeFirstInflateHom R p (C r) = C r := by + simp [planeFirstInflateHom] + +@[simp] theorem planeFirstInflateHom_X_zero (p : ℕ) : + planeFirstInflateHom R p (X 0) = X 0 ^ p := by + simp [planeFirstInflateHom, planeFirstInflateSubstitution] + +@[simp] theorem planeFirstInflateHom_X_one (p : ℕ) : + planeFirstInflateHom R p (X 1) = X 1 := by + simp [planeFirstInflateHom, planeFirstInflateSubstitution] + +theorem finSuccEquiv_planeFirstInflateHom (p : ℕ) + (f : MvPolynomial (Fin 2) R) : + MvPolynomial.finSuccEquiv R 1 (planeFirstInflateHom R p f) = + Polynomial.expand (MvPolynomial (Fin 1) R) p + (MvPolynomial.finSuccEquiv R 1 f) := by + let lhs : MvPolynomial (Fin 2) R →ₐ[R] + Polynomial (MvPolynomial (Fin 1) R) := + (MvPolynomial.finSuccEquiv R 1).toAlgHom.comp + (planeFirstInflateHom R p) + let rhs : MvPolynomial (Fin 2) R →ₐ[R] + Polynomial (MvPolynomial (Fin 1) R) := + ((Polynomial.expand (MvPolynomial (Fin 1) R) p).restrictScalars R).comp + (MvPolynomial.finSuccEquiv R 1).toAlgHom + change lhs f = rhs f + apply DFunLike.congr_fun + apply MvPolynomial.algHom_ext + exact Fin.forall_fin_two.2 ⟨ + by simp [lhs, rhs, planeFirstInflateHom, + planeFirstInflateSubstitution, MvPolynomial.finSuccEquiv_apply], + by + have hcases : + Fin.cases + (Polynomial.X : Polynomial (MvPolynomial (Fin 1) R)) + (fun k : Fin 1 => Polynomial.C + (X k : MvPolynomial (Fin 1) R)) + (1 : Fin 2) = + Polynomial.C (X (0 : Fin 1) : MvPolynomial (Fin 1) R) := by + exact @Fin.cases_succ 1 + (fun _ => Polynomial (MvPolynomial (Fin 1) R)) + Polynomial.X + (fun k : Fin 1 => Polynomial.C + (X k : MvPolynomial (Fin 1) R)) 0 + simp [lhs, rhs, planeFirstInflateHom, + planeFirstInflateSubstitution, MvPolynomial.finSuccEquiv_apply, + hcases]⟩ + +/-- Divide the exponents of `X₀` by `p`, discarding coefficients whose +exponents are not divisible by `p`. -/ +def planeFirstDeflate (p : ℕ) (f : MvPolynomial (Fin 2) R) : + MvPolynomial (Fin 2) R := + (MvPolynomial.finSuccEquiv R 1).symm + (Polynomial.contract p (MvPolynomial.finSuccEquiv R 1 f)) + +theorem derivative_finSuccEquiv_eq_finSuccEquiv_pderiv_zero + (f : MvPolynomial (Fin 2) R) : + Polynomial.derivative (MvPolynomial.finSuccEquiv R 1 f) = + MvPolynomial.finSuccEquiv R 1 (pderiv 0 f) := by + ext n m + rw [Polynomial.coeff_derivative, mul_comm] + rw [← Nat.cast_succ, ← nsmul_eq_mul, coeff_smul, + MvPolynomial.finSuccEquiv_coeff_coeff, + MvPolynomial.finSuccEquiv_coeff_coeff, + coeff_pderiv, nsmul_eq_mul, mul_comm] + congr 1 + · apply congrArg (coeff · f) + apply Finsupp.ext + intro i + refine Fin.cases ?_ (fun j => ?_) i <;> simp + · simp + +variable {R} + +theorem planeFirstInflateHom_planeFirstDeflate + [IsDomain R] (p : ℕ) [CharP R p] (hp : p ≠ 0) + (f : MvPolynomial (Fin 2) R) (hderiv : pderiv 0 f = 0) : + planeFirstInflateHom R p (planeFirstDeflate R p f) = f := by + apply (MvPolynomial.finSuccEquiv R 1).injective + rw [finSuccEquiv_planeFirstInflateHom, planeFirstDeflate, + AlgEquiv.apply_symm_apply] + apply Polynomial.expand_contract p + · rw [derivative_finSuccEquiv_eq_finSuccEquiv_pderiv_zero, hderiv, map_zero] + · exact hp + +theorem planeFirstInflateHom_injective (p : ℕ) (hp : 0 < p) : + Function.Injective (planeFirstInflateHom R p) := by + intro f g hfg + apply (MvPolynomial.finSuccEquiv R 1).injective + have hfg' := congrArg (MvPolynomial.finSuccEquiv R 1) hfg + rw [finSuccEquiv_planeFirstInflateHom, + finSuccEquiv_planeFirstInflateHom] at hfg' + exact Polynomial.expand_injective hp hfg' + +theorem irreducible_of_planeFirstInflateHom_irreducible + [IsDomain R] (p : ℕ) (hp : p ≠ 0) {f : MvPolynomial (Fin 2) R} + (hf : Irreducible (planeFirstInflateHom R p f)) : + Irreducible f := by + have hpoly : Irreducible + (Polynomial.expand (MvPolynomial (Fin 1) R) p + (MvPolynomial.finSuccEquiv R 1 f)) := by + rw [← finSuccEquiv_planeFirstInflateHom] + exact hf.map (MvPolynomial.finSuccEquiv R 1).toMulEquiv + have hbase : Irreducible (MvPolynomial.finSuccEquiv R 1 f) := + Polynomial.of_irreducible_expand hp hpoly + simpa using hbase.map (MvPolynomial.finSuccEquiv R 1).symm.toMulEquiv + +theorem eval_planeFirstInflateHom + (p : ℕ) (f : MvPolynomial (Fin 2) R) (x y : R) : + eval ![x, y] (planeFirstInflateHom R p f) = + eval ![x ^ p, y] f := by + change aeval ![x, y] (bind₁ (planeFirstInflateSubstitution R p) f) = _ + rw [aeval_bind₁] + apply congrArg (fun z : Fin 2 → R => aeval z f) + funext i + fin_cases i <;> simp [planeFirstInflateSubstitution] + +theorem pderiv_one_planeFirstInflateHom + (p : ℕ) (f : MvPolynomial (Fin 2) R) : + pderiv 1 (planeFirstInflateHom R p f) = + planeFirstInflateHom R p (pderiv 1 f) := by + induction f using MvPolynomial.induction_on with + | C r => simp + | add f g hf hg => simp [map_add, hf, hg] + | mul_X f i hf => + fin_cases i <;> simp [map_mul, hf] + +theorem map_planeFirstInflateHom + {S : Type*} [CommRing S] (p : ℕ) (φ : R →+* S) + (f : MvPolynomial (Fin 2) R) : + map φ (planeFirstInflateHom R p f) = + planeFirstInflateHom S p (map φ f) := by + change map φ (bind₁ (planeFirstInflateSubstitution R p) f) = _ + rw [map_bind₁] + congr 1 + ext i + fin_cases i <;> simp [planeFirstInflateSubstitution] + +/-- Multiply only the first exponent of a plane monomial by `p`. -/ +def scaleFirstExponent (p : ℕ) (m : Fin 2 →₀ ℕ) : Fin 2 →₀ ℕ := + m.tail.cons (m 0 * p) + +@[simp] theorem scaleFirstExponent_zero (p : ℕ) (m : Fin 2 →₀ ℕ) : + scaleFirstExponent p m 0 = m 0 * p := by + simp [scaleFirstExponent] + +@[simp] theorem scaleFirstExponent_one (p : ℕ) (m : Fin 2 →₀ ℕ) : + scaleFirstExponent p m 1 = m 1 := by + change m.tail 0 = m 1 + rw [Finsupp.tail_apply] + rfl + +theorem scaleFirstExponent_mem_support_planeFirstInflateHom + (p : ℕ) (hp : 0 < p) {f : MvPolynomial (Fin 2) R} + {m : Fin 2 →₀ ℕ} (hm : m ∈ f.support) : + scaleFirstExponent p m ∈ (planeFirstInflateHom R p f).support := by + change m.tail.cons (m 0 * p) ∈ (planeFirstInflateHom R p f).support + rw [← MvPolynomial.mem_support_coeff_finSuccEquiv, + finSuccEquiv_planeFirstInflateHom, + Polynomial.coeff_expand_mul hp, + MvPolynomial.mem_support_coeff_finSuccEquiv] + simpa using hm + +/-- A bidegree bound for a one-coordinate inflation descends to the +unexpanded polynomial without loss. -/ +theorem hasBidegreeAtMost_of_planeFirstInflateHom + (p : ℕ) (hp : 0 < p) {f : MvPolynomial (Fin 2) R} + {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost + (planeFirstInflateHom R p f) firstDegree secondDegree) : + BGS.External.HasBidegreeAtMost f firstDegree secondDegree := by + intro m hm + have hs := hdegree (scaleFirstExponent p m) + (scaleFirstExponent_mem_support_planeFirstInflateHom p hp hm) + exact ⟨(Nat.le_mul_of_pos_right (m 0) hp).trans (by simpa using hs.1), + by simpa using hs.2⟩ + +theorem degreeOf_zero_planeFirstInflateHom + (p : ℕ) (f : MvPolynomial (Fin 2) R) : + degreeOf 0 (planeFirstInflateHom R p f) = degreeOf 0 f * p := by + rw [← MvPolynomial.natDegree_finSuccEquiv, + finSuccEquiv_planeFirstInflateHom, + Polynomial.natDegree_expand, + MvPolynomial.natDegree_finSuccEquiv] + +theorem absolutelyIrreducible_of_planeFirstInflateHom_eq + {K : Type*} [Field K] (p : ℕ) (hp : p ≠ 0) + {f g : MvPolynomial (Fin 2) K} + (hfg : planeFirstInflateHom K p g = f) + (hf : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) : + Irreducible (map (algebraMap K (AlgebraicClosure K)) g) := by + apply irreducible_of_planeFirstInflateHom_irreducible p hp + rw [← map_planeFirstInflateHom, hfg] + exact hf + +theorem pderiv_one_ne_zero_of_planeFirstInflateHom_eq + {K : Type*} [Field K] (p : ℕ) + {f g : MvPolynomial (Fin 2) K} + (hfg : planeFirstInflateHom K p g = f) + (hf : pderiv 1 f ≠ 0) : + pderiv 1 g ≠ 0 := by + intro hg + apply hf + rw [← hfg, pderiv_one_planeFirstInflateHom, hg, map_zero] + +theorem degreeOf_zero_lt_of_planeFirstInflateHom_eq + {K : Type*} [Field K] (p : ℕ) (hp : 1 < p) + {f g : MvPolynomial (Fin 2) K} + (hfg : planeFirstInflateHom K p g = f) + (hfpos : 0 < degreeOf 0 f) : + degreeOf 0 g < degreeOf 0 f := by + have hdegree := degreeOf_zero_planeFirstInflateHom p g + rw [hfg] at hdegree + have hgpos : 0 < degreeOf 0 g := by + by_contra hg + rw [Nat.not_lt, Nat.le_zero] at hg + rw [hg, zero_mul] at hdegree + omega + calc + degreeOf 0 g < degreeOf 0 g * p := + (Nat.lt_mul_iff_one_lt_right hgpos).2 hp + _ = degreeOf 0 f := hdegree.symm + +section FiniteField + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] +variable (p : ℕ) [Fact p.Prime] [CharP K p] + +/-- Frobenius in the first coordinate, identity in the second. -/ +def planeFirstFrobeniusPointEquiv : K × K ≃ K × K := + (frobeniusEquiv K p).toEquiv.prodCongr (Equiv.refl K) + +@[simp] theorem planeFirstFrobeniusPointEquiv_apply (z : K × K) : + planeFirstFrobeniusPointEquiv K p z = (z.1 ^ p, z.2) := by + rcases z with ⟨x, y⟩ + rfl + +/-- Frobenius bijects the affine zero set of an inflation with the affine +zero set of the unexpanded polynomial. -/ +def planeFirstInflateAffineZeroEquiv (f : MvPolynomial (Fin 2) K) : + {z // z ∈ BGS.External.affinePlaneCurveZeros K + (planeFirstInflateHom K p f)} ≃ + {z // z ∈ BGS.External.affinePlaneCurveZeros K f} := + (planeFirstFrobeniusPointEquiv K p).subtypeEquiv fun z => by + simp only [BGS.External.mem_affinePlaneCurveZeros_iff, + planeFirstFrobeniusPointEquiv_apply] + exact (eval_planeFirstInflateHom p f z.1 z.2).congr_left + +theorem card_affinePlaneCurveZeros_planeFirstInflateHom + (f : MvPolynomial (Fin 2) K) : + (BGS.External.affinePlaneCurveZeros K + (planeFirstInflateHom K p f)).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + rw [← Fintype.card_coe, ← Fintype.card_coe] + exact Fintype.card_congr (planeFirstInflateAffineZeroEquiv K p f) + +theorem card_affinePlaneCurveZeros_eq_of_planeFirstInflateHom_eq + {f g : MvPolynomial (Fin 2) K} + (hfg : planeFirstInflateHom K p g = f) : + (BGS.External.affinePlaneCurveZeros K g).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + rw [← hfg, card_affinePlaneCurveZeros_planeFirstInflateHom] + +end FiniteField + +/-- One strict Frobenius-deflation step in the first coordinate. The +second partial derivative is retained, absolute irreducibility and the +affine point count descend, and no supplied bidegree bound is enlarged. -/ +theorem exists_planeFirstFrobeniusDeflationStep + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : pderiv 0 f = 0) + (hpartialSecond : pderiv 1 f ≠ 0) + (hfirstDegree : 0 < degreeOf 0 f) : + ∃ g : MvPolynomial (Fin 2) K, + planeFirstInflateHom K (ringChar K) g = f ∧ + BGS.External.HasBidegreeAtMost g firstDegree secondDegree ∧ + Irreducible (map (algebraMap K (AlgebraicClosure K)) g) ∧ + pderiv 1 g ≠ 0 ∧ + degreeOf 0 g < degreeOf 0 f ∧ + (BGS.External.affinePlaneCurveZeros K g).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + let p := ringChar K + letI : Fact p.Prime := ⟨CharP.char_is_prime K p⟩ + let g := planeFirstDeflate K p f + have hfg : planeFirstInflateHom K p g = f := + planeFirstInflateHom_planeFirstDeflate p + ((Fact.out : p.Prime).ne_zero) f hpartialFirst + refine ⟨g, hfg, ?_, ?_, ?_, ?_, ?_⟩ + · apply hasBidegreeAtMost_of_planeFirstInflateHom p + (Fact.out : p.Prime).pos + simpa [hfg] using hdegree + · exact absolutelyIrreducible_of_planeFirstInflateHom_eq + p (Fact.out : p.Prime).ne_zero hfg habsolute + · exact pderiv_one_ne_zero_of_planeFirstInflateHom_eq + p hfg hpartialSecond + · exact degreeOf_zero_lt_of_planeFirstInflateHom_eq + p (Fact.out : p.Prime).one_lt hfg hfirstDegree + · exact card_affinePlaneCurveZeros_eq_of_planeFirstInflateHom_eq + K p hfg + +/-- Iterating the strict first-coordinate step terminates. Unless the +original polynomial has actual first degree zero, it produces a polynomial +with both coordinate partials nonzero, without increasing the supplied +bidegree bounds or changing the affine point count. -/ +theorem exists_planeFirstSeparatingDeflation_or_degreeOf_zero + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialSecond : pderiv 1 f ≠ 0) : + degreeOf 0 f = 0 ∨ + ∃ g : MvPolynomial (Fin 2) K, + BGS.External.HasBidegreeAtMost g firstDegree secondDegree ∧ + Irreducible (map (algebraMap K (AlgebraicClosure K)) g) ∧ + pderiv 0 g ≠ 0 ∧ + pderiv 1 g ≠ 0 ∧ + (BGS.External.affinePlaneCurveZeros K g).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + let P : ℕ → Prop := fun n => + ∀ f : MvPolynomial (Fin 2) K, + degreeOf 0 f = n → + BGS.External.HasBidegreeAtMost f firstDegree secondDegree → + Irreducible (map (algebraMap K (AlgebraicClosure K)) f) → + pderiv 1 f ≠ 0 → + degreeOf 0 f = 0 ∨ + ∃ g : MvPolynomial (Fin 2) K, + BGS.External.HasBidegreeAtMost g firstDegree secondDegree ∧ + Irreducible (map (algebraMap K (AlgebraicClosure K)) g) ∧ + pderiv 0 g ≠ 0 ∧ + pderiv 1 g ≠ 0 ∧ + (BGS.External.affinePlaneCurveZeros K g).card = + (BGS.External.affinePlaneCurveZeros K f).card + have hP : ∀ n, P n := by + intro n + induction n using Nat.strong_induction_on with + | h n ih => + intro f hfn hdegree habsolute hpartialSecond + by_cases hdegreeZero : degreeOf 0 f = 0 + · exact Or.inl hdegreeZero + by_cases hpartialFirst : pderiv 0 f = 0 + · obtain ⟨g, hfg, hgdegree, hgabsolute, hgpartialSecond, + hglt, hgcard⟩ := + exists_planeFirstFrobeniusDeflationStep K f + firstDegree secondDegree hdegree habsolute hpartialFirst + hpartialSecond (Nat.pos_of_ne_zero hdegreeZero) + have hgn : degreeOf 0 g < n := by + simpa [← hfn] using hglt + have hgout := ih (degreeOf 0 g) hgn g rfl hgdegree + hgabsolute hgpartialSecond + rcases hgout with hgzero | ⟨u, hudegree, huabsolute, + hupartialFirst, hupartialSecond, hucard⟩ + · have hdegInflate := + degreeOf_zero_planeFirstInflateHom (ringChar K) g + rw [hfg, hgzero, zero_mul] at hdegInflate + exact (hdegreeZero hdegInflate).elim + · exact Or.inr ⟨u, hudegree, huabsolute, hupartialFirst, + hupartialSecond, hucard.trans hgcard⟩ + · exact Or.inr ⟨f, hdegree, habsolute, hpartialFirst, + hpartialSecond, rfl⟩ + exact hP (degreeOf 0 f) f rfl hdegree habsolute hpartialSecond + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean new file mode 100644 index 0000000000..e959e5a109 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean @@ -0,0 +1,219 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation + +/-! +# The zero-coordinate-degree case of Frobenius reduction + +An absolutely irreducible plane polynomial with zero degree in one +coordinate is a univariate polynomial in the other coordinate. After +extension to an algebraic closure, irreducibility forces that univariate +polynomial to have degree one. Consequently it has one rational root over +the original field and its affine plane zero set has exactly one point above +each value of the absent coordinate. +-/ + +namespace BGS.HasseWeil + +open MvPolynomial + +noncomputable section + +variable {R : Type*} [CommRing R] + +theorem natDegree_uniqueAlgEquiv_fin_one + (q : MvPolynomial (Fin 1) R) : + (MvPolynomial.uniqueAlgEquiv R (Fin 1) q).natDegree = + degreeOf 0 q := by + apply le_antisymm + · rw [Polynomial.natDegree_le_iff_coeff_eq_zero] + intro n hn + rw [MvPolynomial.coeff_uniqueAlgEquiv] + by_contra hcoeff + have hm : Finsupp.single (0 : Fin 1) n ∈ q.support := + MvPolynomial.mem_support_iff.mpr hcoeff + have hle := monomial_le_degreeOf (0 : Fin 1) hm + have : n < n := by simpa using hle.trans_lt hn + exact this.false + · rw [MvPolynomial.degreeOf_le_iff] + intro m hm + apply Polynomial.le_natDegree_of_ne_zero + rw [MvPolynomial.coeff_uniqueAlgEquiv] + change coeff (Finsupp.single (0 : Fin 1) (m 0)) q ≠ 0 + have hmEq : Finsupp.single (0 : Fin 1) (m 0) = m := by + simpa using (Finsupp.unique_single m).symm + rw [hmEq] + exact MvPolynomial.mem_support_iff.mp hm + +def secondPolynomialOfFirstDegreeZero + (f : MvPolynomial (Fin 2) R) : Polynomial R := + MvPolynomial.uniqueAlgEquiv R (Fin 1) + ((MvPolynomial.finSuccEquiv R 1 f).coeff 0) + +theorem finSuccEquiv_eq_C_coeff_zero_of_degreeOf_zero + {f : MvPolynomial (Fin 2) R} (hdegree : degreeOf 0 f = 0) : + MvPolynomial.finSuccEquiv R 1 f = + Polynomial.C ((MvPolynomial.finSuccEquiv R 1 f).coeff 0) := by + apply Polynomial.eq_C_of_natDegree_eq_zero + simpa [MvPolynomial.natDegree_finSuccEquiv] using hdegree + +theorem degreeOf_one_eq_natDegree_secondPolynomialOfFirstDegreeZero + {f : MvPolynomial (Fin 2) R} (hdegree : degreeOf 0 f = 0) : + degreeOf 1 f = (secondPolynomialOfFirstDegreeZero f).natDegree := by + let q := (MvPolynomial.finSuccEquiv R 1 f).coeff 0 + have hC := finSuccEquiv_eq_C_coeff_zero_of_degreeOf_zero hdegree + have hqle : degreeOf 0 q ≤ degreeOf 1 f := by + exact MvPolynomial.degreeOf_coeff_finSuccEquiv f 0 0 + have hfle : degreeOf 1 f ≤ degreeOf 0 q := by + rw [MvPolynomial.degreeOf_le_iff] + intro m hm + have htail : m.tail ∈ + ((MvPolynomial.finSuccEquiv R 1 f).coeff (m 0)).support := by + rw [MvPolynomial.mem_support_coeff_finSuccEquiv] + simpa using hm + have hmzero : m 0 = 0 := by + by_contra hmzero + have hz : (MvPolynomial.finSuccEquiv R 1 f).coeff (m 0) = 0 := by + rw [hC] + rw [Polynomial.coeff_C, if_neg hmzero] + rw [hz] at htail + simpa using htail + have htailq : m.tail ∈ q.support := by + rw [hmzero] at htail + exact htail + have hle := monomial_le_degreeOf (0 : Fin 1) htailq + change m 1 ≤ degreeOf 0 q + simpa [Finsupp.tail_apply] using hle + rw [secondPolynomialOfFirstDegreeZero, + natDegree_uniqueAlgEquiv_fin_one] + exact le_antisymm hfle hqle + +theorem degreeOf_map_eq_of_injective_local + {S : Type*} [CommRing S] (φ : R →+* S) + (hφ : Function.Injective φ) (i : Fin 2) + (f : MvPolynomial (Fin 2) R) : + degreeOf i (map φ f) = degreeOf i f := by + rw [MvPolynomial.degreeOf_eq_sup, MvPolynomial.degreeOf_eq_sup, + MvPolynomial.support_map_of_injective f hφ] + +theorem degreeOf_one_eq_one_of_absolutelyIrreducible_degreeOf_zero + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) + (hdegree : degreeOf 0 f = 0) : + degreeOf 1 f = 1 := by + let F := AlgebraicClosure K + let φ : K →+* F := algebraMap K F + let fF : MvPolynomial (Fin 2) F := map φ f + have hdegreeMap (i : Fin 2) : degreeOf i fF = degreeOf i f := + degreeOf_map_eq_of_injective_local φ (RingHom.injective φ) i f + have hdegreeZeroF : degreeOf 0 fF = 0 := by + rw [hdegreeMap] + exact hdegree + let qF : MvPolynomial (Fin 1) F := + (MvPolynomial.finSuccEquiv F 1 fF).coeff 0 + have hC : MvPolynomial.finSuccEquiv F 1 fF = Polynomial.C qF := by + simpa [qF] using + (finSuccEquiv_eq_C_coeff_zero_of_degreeOf_zero hdegreeZeroF) + have hfinIrr : Irreducible (MvPolynomial.finSuccEquiv F 1 fF) := + habsolute.map (MvPolynomial.finSuccEquiv F 1).toMulEquiv + have hCIrr : Irreducible (Polynomial.C qF) := by + rw [← hC] + exact hfinIrr + letI : IsLocalHom + (Polynomial.C : MvPolynomial (Fin 1) F →+* + Polynomial (MvPolynomial (Fin 1) F)) := + ⟨fun _ hunit => Polynomial.isUnit_C.mp hunit⟩ + have hqIrr : Irreducible qF := hCIrr.of_map + have hpolyIrr : Irreducible + (MvPolynomial.uniqueAlgEquiv F (Fin 1) qF) := + hqIrr.map (MvPolynomial.uniqueAlgEquiv F (Fin 1)).toMulEquiv + have hpolyDegree : + (MvPolynomial.uniqueAlgEquiv F (Fin 1) qF).natDegree = 1 := + Polynomial.natDegree_eq_of_degree_eq_some + (IsAlgClosed.degree_eq_one_of_irreducible F hpolyIrr) + have hdegreeOneF : degreeOf 1 fF = 1 := by + rw [degreeOf_one_eq_natDegree_secondPolynomialOfFirstDegreeZero + hdegreeZeroF] + simpa [secondPolynomialOfFirstDegreeZero, qF] using hpolyDegree + rw [hdegreeMap] at hdegreeOneF + exact hdegreeOneF + +theorem eval_eq_secondPolynomialOfFirstDegreeZero + {f : MvPolynomial (Fin 2) R} (hdegree : degreeOf 0 f = 0) + (x y : R) : + eval ![x, y] f = (secondPolynomialOfFirstDegreeZero f).eval y := by + let q := (MvPolynomial.finSuccEquiv R 1 f).coeff 0 + have hC := finSuccEquiv_eq_C_coeff_zero_of_degreeOf_zero hdegree + calc + eval ![x, y] f = + Polynomial.eval x + (Polynomial.map (eval ![y]) + (MvPolynomial.finSuccEquiv R 1 f)) := by + simpa using + (MvPolynomial.eval_eq_eval_mv_eval' (R := R) ![y] x f) + _ = eval ![y] q := by + rw [hC] + simp [q] + _ = (secondPolynomialOfFirstDegreeZero f).eval y := by + symm + simpa [secondPolynomialOfFirstDegreeZero, q] using + (MvPolynomial.eval₂_uniqueAlgEquiv + (R := R) (σ := Fin 1) + (f := q) (φ := RingHom.id R) (a := ![y])) + +theorem card_affinePlaneCurveZeros_eq_card_of_degreeOf_zero + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) + (hdegree : degreeOf 0 f = 0) : + (BGS.External.affinePlaneCurveZeros K f).card = Fintype.card K := by + let q := secondPolynomialOfFirstDegreeZero f + have hdegreeOne := + degreeOf_one_eq_one_of_absolutelyIrreducible_degreeOf_zero + habsolute hdegree + have hqnat : q.natDegree = 1 := by + rw [← degreeOf_one_eq_natDegree_secondPolynomialOfFirstDegreeZero + hdegree] + exact hdegreeOne + have hqdegree : q.degree = 1 := + (Polynomial.degree_eq_iff_natDegree_eq_of_pos Nat.zero_lt_one).2 hqnat + let r : K := -((q.coeff 1)⁻¹ * q.coeff 0) + have hqne : q ≠ 0 := by + intro hq + rw [hq, Polynomial.degree_zero] at hqdegree + exact WithBot.bot_ne_coe hqdegree + have hzero (y : K) : q.eval y = 0 ↔ y = r := by + change q.IsRoot y ↔ y = r + rw [← Polynomial.mem_roots hqne, + Polynomial.roots_degree_eq_one hqdegree] + simp [r] + let e : {z // z ∈ BGS.External.affinePlaneCurveZeros K f} ≃ K := + { toFun := fun z => z.1.1 + invFun := fun x => ⟨(x, r), by + rw [BGS.External.mem_affinePlaneCurveZeros_iff, + eval_eq_secondPolynomialOfFirstDegreeZero hdegree] + exact (hzero r).2 rfl⟩ + left_inv := by + intro z + apply Subtype.ext + apply Prod.ext + · rfl + · have hz := BGS.External.mem_affinePlaneCurveZeros_iff.mp z.2 + rw [eval_eq_secondPolynomialOfFirstDegreeZero hdegree] at hz + exact ((hzero z.1.2).1 hz).symm + right_inv := by intro x; rfl } + calc + (BGS.External.affinePlaneCurveZeros K f).card = + Fintype.card {z // z ∈ BGS.External.affinePlaneCurveZeros K f} := + (Fintype.card_coe _).symm + _ = Fintype.card K := Fintype.card_congr e + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean new file mode 100644 index 0000000000..5a27bcc02e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean @@ -0,0 +1,234 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate + +/-! +# Closed Frobenius reduction for affine plane curves + +This module conjugates first-coordinate deflation by the coordinate swap and +thereby handles either inseparable coordinate. An absolutely irreducible +plane equation over a finite field either has an absent coordinate, in which +case its affine point count is exactly the field cardinality, or it admits a +same-count equation with both coordinate partial derivatives nonzero and no +larger supplied bidegree bounds. +-/ + +namespace BGS.HasseWeil + +open MvPolynomial + +noncomputable section + +variable (R : Type*) [CommRing R] + +/-- Swap the two variables of a plane polynomial. -/ +def planeSwapAlgEquiv : + MvPolynomial (Fin 2) R ≃ₐ[R] MvPolynomial (Fin 2) R := + MvPolynomial.renameEquiv R (Equiv.swap (0 : Fin 2) 1) + +@[simp] theorem planeSwapAlgEquiv_apply (f : MvPolynomial (Fin 2) R) : + planeSwapAlgEquiv R f = + MvPolynomial.rename (Equiv.swap (0 : Fin 2) 1) f := rfl + +theorem pderiv_zero_planeSwapAlgEquiv + (f : MvPolynomial (Fin 2) R) : + pderiv 0 (planeSwapAlgEquiv R f) = + planeSwapAlgEquiv R (pderiv 1 f) := by + simpa [planeSwapAlgEquiv] using + (MvPolynomial.pderiv_rename + (Equiv.swap (0 : Fin 2) 1).injective (1 : Fin 2) f) + +theorem pderiv_one_planeSwapAlgEquiv + (f : MvPolynomial (Fin 2) R) : + pderiv 1 (planeSwapAlgEquiv R f) = + planeSwapAlgEquiv R (pderiv 0 f) := by + simpa [planeSwapAlgEquiv] using + (MvPolynomial.pderiv_rename + (Equiv.swap (0 : Fin 2) 1).injective (0 : Fin 2) f) + +theorem pderiv_zero_planeSwapAlgEquiv_ne_zero + {f : MvPolynomial (Fin 2) R} (hf : pderiv 1 f ≠ 0) : + pderiv 0 (planeSwapAlgEquiv R f) ≠ 0 := by + rw [pderiv_zero_planeSwapAlgEquiv] + exact (planeSwapAlgEquiv R).injective.ne hf + +theorem pderiv_one_planeSwapAlgEquiv_ne_zero + {f : MvPolynomial (Fin 2) R} (hf : pderiv 0 f ≠ 0) : + pderiv 1 (planeSwapAlgEquiv R f) ≠ 0 := by + rw [pderiv_one_planeSwapAlgEquiv] + exact (planeSwapAlgEquiv R).injective.ne hf + +theorem degreeOf_zero_planeSwapAlgEquiv + (f : MvPolynomial (Fin 2) R) : + degreeOf 0 (planeSwapAlgEquiv R f) = degreeOf 1 f := by + simpa [planeSwapAlgEquiv] using + (MvPolynomial.degreeOf_rename_of_injective + (Equiv.swap (0 : Fin 2) 1).injective (1 : Fin 2) (p := f)) + +theorem hasBidegreeAtMost_planeSwapAlgEquiv + {f : MvPolynomial (Fin 2) R} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) : + BGS.External.HasBidegreeAtMost + (planeSwapAlgEquiv R f) secondDegree firstDegree := by + classical + intro m hm + rw [planeSwapAlgEquiv_apply, + MvPolynomial.support_rename_of_injective + (Equiv.swap (0 : Fin 2) 1).injective] at hm + obtain ⟨n, hn, rfl⟩ := Finset.mem_image.mp hm + have hd := hdegree n hn + have hzero : + Finsupp.mapDomain (Equiv.swap (0 : Fin 2) 1) n 0 = n 1 := by + simpa using Finsupp.mapDomain_apply + (Equiv.swap (0 : Fin 2) 1).injective n (1 : Fin 2) + have hone : + Finsupp.mapDomain (Equiv.swap (0 : Fin 2) 1) n 1 = n 0 := by + simpa using Finsupp.mapDomain_apply + (Equiv.swap (0 : Fin 2) 1).injective n (0 : Fin 2) + simpa [hzero, hone] using And.intro hd.2 hd.1 + +theorem map_planeSwapAlgEquiv + {S : Type*} [CommRing S] (φ : R →+* S) + (f : MvPolynomial (Fin 2) R) : + map φ (planeSwapAlgEquiv R f) = + planeSwapAlgEquiv S (map φ f) := by + simp [planeSwapAlgEquiv, MvPolynomial.map_rename] + +theorem absolutelyIrreducible_planeSwapAlgEquiv + {K : Type*} [Field K] {f : MvPolynomial (Fin 2) K} + (hf : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) : + Irreducible + (map (algebraMap K (AlgebraicClosure K)) + (planeSwapAlgEquiv K f)) := by + rw [map_planeSwapAlgEquiv] + exact hf.map (planeSwapAlgEquiv (AlgebraicClosure K)).toMulEquiv + +theorem eval_planeSwapAlgEquiv + (f : MvPolynomial (Fin 2) R) (x y : R) : + eval ![y, x] (planeSwapAlgEquiv R f) = eval ![x, y] f := by + simp [planeSwapAlgEquiv, MvPolynomial.eval_rename] + +section FiniteField + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + +def planeSwapAffineZeroEquiv (f : MvPolynomial (Fin 2) K) : + {z // z ∈ BGS.External.affinePlaneCurveZeros K + (planeSwapAlgEquiv K f)} ≃ + {z // z ∈ BGS.External.affinePlaneCurveZeros K f} := + (Equiv.prodComm K K).subtypeEquiv fun z => by + simp only [BGS.External.mem_affinePlaneCurveZeros_iff] + exact (eval_planeSwapAlgEquiv K f z.2 z.1).congr_left + +theorem card_affinePlaneCurveZeros_planeSwapAlgEquiv + (f : MvPolynomial (Fin 2) K) : + (BGS.External.affinePlaneCurveZeros K + (planeSwapAlgEquiv K f)).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + rw [← Fintype.card_coe, ← Fintype.card_coe] + exact Fintype.card_congr (planeSwapAffineZeroEquiv K f) + +end FiniteField + +/-- Frobenius deflation in whichever coordinate is inseparable. The only +alternative to a same-count separating equation is the exact univariate +point count. -/ +theorem separatingFrobeniusDeflation_or_exactPointCount + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) : + (BGS.External.affinePlaneCurveZeros K f).card = Fintype.card K ∨ + ∃ g : MvPolynomial (Fin 2) K, + BGS.External.HasBidegreeAtMost g firstDegree secondDegree ∧ + Irreducible (map (algebraMap K (AlgebraicClosure K)) g) ∧ + pderiv 0 g ≠ 0 ∧ pderiv 1 g ≠ 0 ∧ + (BGS.External.affinePlaneCurveZeros K g).card = + (BGS.External.affinePlaneCurveZeros K f).card := by + by_cases hpartialSecond : pderiv 1 f ≠ 0 + · rcases exists_planeFirstSeparatingDeflation_or_degreeOf_zero + K f firstDegree secondDegree hdegree habsolute hpartialSecond with + hdegreeZero | ⟨g, hgdegree, hgabsolute, hgpartialFirst, + hgpartialSecond, hgcard⟩ + · exact Or.inl + (card_affinePlaneCurveZeros_eq_card_of_degreeOf_zero + K habsolute hdegreeZero) + · exact Or.inr ⟨g, hgdegree, hgabsolute, hgpartialFirst, + hgpartialSecond, hgcard⟩ + · have hpartialFirst : pderiv 0 f ≠ 0 := by + rcases + pderiv_zero_ne_zero_or_pderiv_one_ne_zero_of_absolutelyIrreducible + K f habsolute with h | h + · exact h + · exact (hpartialSecond h).elim + let fSwap := planeSwapAlgEquiv K f + have hdegreeSwap : BGS.External.HasBidegreeAtMost + fSwap secondDegree firstDegree := + hasBidegreeAtMost_planeSwapAlgEquiv K hdegree + have habsoluteSwap : Irreducible + (map (algebraMap K (AlgebraicClosure K)) fSwap) := + absolutelyIrreducible_planeSwapAlgEquiv habsolute + have hpartialSecondSwap : pderiv 1 fSwap ≠ 0 := + pderiv_one_planeSwapAlgEquiv_ne_zero K hpartialFirst + rcases exists_planeFirstSeparatingDeflation_or_degreeOf_zero + K fSwap secondDegree firstDegree hdegreeSwap habsoluteSwap + hpartialSecondSwap with hdegreeZero | ⟨g, hgdegree, + hgabsolute, hgpartialFirst, hgpartialSecond, hgcard⟩ + · left + rw [← card_affinePlaneCurveZeros_planeSwapAlgEquiv K f] + exact card_affinePlaneCurveZeros_eq_card_of_degreeOf_zero + K habsoluteSwap hdegreeZero + · right + refine ⟨planeSwapAlgEquiv K g, + hasBidegreeAtMost_planeSwapAlgEquiv K hgdegree, + absolutelyIrreducible_planeSwapAlgEquiv hgabsolute, + pderiv_zero_planeSwapAlgEquiv_ne_zero K hgpartialSecond, + pderiv_one_planeSwapAlgEquiv_ne_zero K hgpartialFirst, ?_⟩ + rw [card_affinePlaneCurveZeros_planeSwapAlgEquiv, hgcard, + card_affinePlaneCurveZeros_planeSwapAlgEquiv] + +/-- Any coefficient-`8` affine Hasse bound proved for separating equations +extends to every absolutely irreducible plane equation. This theorem is the +composition boundary between Frobenius reduction and the zeta/spectral +argument. -/ +theorem abs_affinePlaneCurveZeros_card_sub_card_le_of_separating_case + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) (firstDegree secondDegree : ℕ) + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (habsolute : Irreducible + (map (algebraMap K (AlgebraicClosure K)) f)) + (hseparating : + ∀ g : MvPolynomial (Fin 2) K, + BGS.External.HasBidegreeAtMost g firstDegree secondDegree → + Irreducible (map (algebraMap K (AlgebraicClosure K)) g) → + pderiv 0 g ≠ 0 → pderiv 1 g ≠ 0 → + |((BGS.External.affinePlaneCurveZeros K g).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ)) : + |((BGS.External.affinePlaneCurveZeros K f).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 8 * Real.sqrt (Fintype.card K : ℝ) * + (firstDegree : ℝ) * (secondDegree : ℝ) := by + rcases separatingFrobeniusDeflation_or_exactPointCount + K f firstDegree secondDegree hdegree habsolute with + hcard | ⟨g, hgdegree, hgabsolute, hgpartialFirst, + hgpartialSecond, hgcard⟩ + · rw [hcard] + simp only [sub_self, abs_zero] + positivity + · rw [← hgcard] + exact hseparating g hgdegree hgabsolute hgpartialFirst hgpartialSecond + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean new file mode 100644 index 0000000000..e8b3fa1d2b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean @@ -0,0 +1,226 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +import Mathlib.Tactic + +/-! +# Riemann's inequality for divisors supported above infinity + +The first coordinate of a plane curve has a pole at every branch above the +rational-function place at infinity. Its pole divisor is therefore cofinal +among effective divisors supported on those branches. A sufficiently large +rectangular monomial pole budget dominates any such divisor. + +The monomial budget already satisfies the bidegree form of Riemann's +inequality. Removing the effective difference costs at most its divisor +degree, so the same inequality descends to the original infinity-supported +divisor. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- An effective divisor supported above infinity is dominated by a natural +multiple of any effective divisor that is positive at every infinity +place. -/ +theorem exists_nsmul_ge_of_effective_supportedAtInfinity + (E H : FiniteExtensionDivisor K L) + (hE : ∀ v, 0 ≤ E v) + (hEfinite : ∀ q : FiniteExtensionFinitePlace K L, E (.inl q) = 0) + (hH : ∀ v, 0 ≤ H v) + (hHinfinity : ∀ P : FiniteExtensionInfinityPlace K L, 0 < H (.inr P)) : + ∃ n : ℕ, E ≤ n • H := by + classical + let n : ℕ := ∑ v ∈ E.support, (E v).toNat + refine ⟨n, ?_⟩ + intro v + rcases v with q | P + · rw [hEfinite q] + exact nsmul_nonneg (hH (.inl q)) n + · have hEPnonneg : 0 ≤ E (.inr P) := hE (.inr P) + by_cases hEPzero : E (.inr P) = 0 + · rw [hEPzero] + exact nsmul_nonneg (hH (.inr P)) n + · have hmem : (.inr P : FiniteExtensionPlace K L) ∈ E.support := + Finsupp.mem_support_iff.mpr hEPzero + have htermNonneg : ∀ v ∈ E.support, 0 ≤ (E v).toNat := by + intro v hv + positivity + have hcoeff : (E (.inr P)).toNat ≤ n := by + dsimp only [n] + exact Finset.single_le_sum htermNonneg hmem + have hcoeffInt : E (.inr P) ≤ (n : ℤ) := by + rw [← Int.toNat_of_nonneg hEPnonneg] + exact_mod_cast hcoeff + have hHone : (1 : ℤ) ≤ H (.inr P) := by + exact hHinfinity P + simp only [Finsupp.nsmul_apply, nsmul_eq_mul] + nlinarith + +variable {K} + +/-- Bidegree Riemann inequality for every effective divisor supported on the +infinity branches of an absolutely irreducible plane curve. -/ +theorem planeCurve_infinitySupported_riemann_lower + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∀ (E : FiniteExtensionDivisor K (PlaneCurveFunctionField f)), + (∀ v, 0 ≤ E v) → + (∀ q : FiniteExtensionFinitePlace K + (PlaneCurveFunctionField f), E (.inl q) = 0) → + (finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) E).toNat + 1 ≤ + Module.finrank K + (finiteExtensionRiemannSpace K (PlaneCurveFunctionField f) E) + + planeCurveBidegreeGenusBudget f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + let a := MvPolynomial.degreeOf 0 f + let b := MvPolynomial.degreeOf 1 f + let g := planeCurveBidegreeGenusBudget f + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := constantAlg + letI : SMul K L := constantAlg.toSMul + letI : Module K L := constantAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro E hE hEfinite + let H := finiteExtensionPoleDivisor K L x + have hH : ∀ v, 0 ≤ H v := + finiteExtensionPoleDivisor_effective K L x + have hHinfinity : ∀ P : FiniteExtensionInfinityPlace K L, + 0 < H (.inr P) := by + simpa only [H, L, x] using + finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive + hf hpartialSecond + obtain ⟨n, hEH⟩ := + exists_nsmul_ge_of_effective_supportedAtInfinity + K L E H hE hEfinite hH hHinfinity + let D : FiniteExtensionDivisor K L := + planeMonomialPoleBudget K L x y n b + have hD : ∀ v, 0 ≤ D v := by + intro v + dsimp only [D, planeMonomialPoleBudget] + simp only [Finsupp.add_apply, Finsupp.nsmul_apply] + exact add_nonneg + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L x v) n) + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L y v) (b - 1)) + have hED : E ≤ D := by + intro v + have hleft := hEH v + dsimp only [H] at hleft + dsimp only [D, planeMonomialPoleBudget] + exact hleft.trans (le_add_of_nonneg_right + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L y v) (b - 1))) + let A : FiniteExtensionDivisor K L := D - E + have hA : ∀ v, 0 ≤ A v := by + intro v + dsimp only [A] + exact sub_nonneg.mpr (hED v) + have hsplit : E + A = D := by + dsimp only [A] + abel + letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := + finiteExtensionRiemannSpace_effective_moduleFinite K L E hE + have hstrip := + finiteExtensionRiemannSpace_add_effective K L E A hE hA + rw [hsplit] at hstrip + have hmono : (n + 1) * b ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) := by + simpa only [D, L, x, y, b] using + planeCurveMonomialPoleBudget_finrank_lower + hf hpartialFirst hpartialSecond n + have hxHeight : finiteExtensionHeight K L x = b := by + simpa only [L, x, b] using + finiteExtensionHeight_planeCurveFirstCoordinate hf hpartialSecond + have hyHeight : finiteExtensionHeight K L y ≤ a := by + simpa only [L, y, a] using + planeCurveSecondCoordinate_height_le_degreeOf_first + hf hpartialFirst hpartialSecond + have hDdegree : finiteExtensionDivisorDegree K L D ≤ + (n * b + (b - 1) * a : ℕ) := by + dsimp only [D, planeMonomialPoleBudget] + rw [finiteExtensionDivisorDegree_pow_mul_pow_budget, hxHeight] + have hyCast : (finiteExtensionHeight K L y : ℤ) ≤ (a : ℤ) := by + exact_mod_cast hyHeight + calc + (n : ℤ) * (b : ℤ) + ((b - 1 : ℕ) : ℤ) * + (finiteExtensionHeight K L y : ℤ) ≤ + (n : ℤ) * (b : ℤ) + ((b - 1 : ℕ) : ℤ) * (a : ℤ) := by + gcongr + _ = (n * b + (b - 1) * a : ℕ) := by + push_cast + ring + have hDdegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L D := + finiteExtensionDivisorDegree_nonnegative_of_effective K L D hD + have hDdegreeNat : (finiteExtensionDivisorDegree K L D).toNat ≤ + n * b + (b - 1) * a := by + have hcast : (((finiteExtensionDivisorDegree K L D).toNat : ℕ) : ℤ) = + finiteExtensionDivisorDegree K L D := + Int.toNat_of_nonneg hDdegreeNonnegative + exact_mod_cast (hcast ▸ hDdegree) + have haPos : 0 < a := degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst + have hbPos : 0 < b := degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + have hgenusIdentity : + n * b + (b - 1) * a + 1 = (n + 1) * b + g := by + dsimp only [g, planeCurveBidegreeGenusBudget, a, b] + nlinarith [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr haPos.ne'), + Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hbPos.ne')] + have hDriemann : (finiteExtensionDivisorDegree K L D).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + g := by + omega + have hEdegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L E := + finiteExtensionDivisorDegree_nonnegative_of_effective K L E hE + have hAdegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L A := + finiteExtensionDivisorDegree_nonnegative_of_effective K L A hA + have hdegreeSplit : + (finiteExtensionDivisorDegree K L D).toNat = + (finiteExtensionDivisorDegree K L E).toNat + + (finiteExtensionDivisorDegree K L A).toNat := by + have hdegree : finiteExtensionDivisorDegree K L D = + finiteExtensionDivisorDegree K L E + + finiteExtensionDivisorDegree K L A := by + rw [← hsplit, finiteExtensionDivisorDegree_add] + rw [hdegree, Int.toNat_add hEdegreeNonnegative hAdegreeNonnegative] + change (finiteExtensionDivisorDegree K L E).toNat + 1 ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + g + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean new file mode 100644 index 0000000000..2a7264de41 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean @@ -0,0 +1,496 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +import Mathlib.Algebra.Polynomial.Basis +import Mathlib.LinearAlgebra.Dimension.Constructions +import Mathlib.RingTheory.AlgebraTower +import Mathlib.RingTheory.Finiteness.Basic + +/-! +# Plane monomial spaces for the Stepanov construction + +This file packages the finite rectangular spaces spanned by the monomials +`x ^ i * y ^ j`. It proves their dimension from linear independence, gives +a plane-curve independence criterion from the degree in one coordinate, and +records the mixed-radix exponent map occurring when an ordinary grid is +multiplied by a grid in the powered coordinates. + +The final tower lemma is the algebraic form needed by Stepanov: if the +ordinary (digit) grid is independent over a subfield containing `x ^ s` and +`y ^ s`, and the powered grid is independent over the constant field, then +the twisted products + +`x ^ (i + s * i') * y ^ (j + s * j')` + +are independent over the constant field. No Frobenius endomorphism is +introduced or assumed. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +/-- The rectangular family of plane monomials with `i < a` and `j < b`. -/ +def planeMonomialGrid + {L : Type*} [Monoid L] + (x y : L) (a b : ℕ) : Fin a × Fin b → L := + fun ij ↦ x ^ (ij.1 : ℕ) * y ^ (ij.2 : ℕ) + +/-- The finite `K`-subspace spanned by a rectangular plane-monomial grid. -/ +def planeMonomialSpace + (K : Type*) {L : Type*} [Field K] [CommRing L] [Algebra K L] + (x y : L) (a b : ℕ) : Submodule K L := + Submodule.span K (Set.range (planeMonomialGrid x y a b)) + +theorem planeMonomialGrid_mem_space + {K L : Type*} [Field K] [CommRing L] [Algebra K L] + (x y : L) (a b : ℕ) (ij : Fin a × Fin b) : + planeMonomialGrid x y a b ij ∈ planeMonomialSpace K x y a b := + Submodule.subset_span (Set.mem_range_self ij) + +/-- A rectangular monomial space is finite, independently of any +linear-independence hypothesis. -/ +theorem moduleFinite_planeMonomialSpace + (K : Type*) {L : Type*} [Field K] [CommRing L] [Algebra K L] + (x y : L) (a b : ℕ) : + Module.Finite K (planeMonomialSpace K x y a b) := by + exact Module.Finite.span_of_finite K + (Set.finite_range (planeMonomialGrid x y a b)) + +/-- Linear independence identifies the finrank of a rectangular monomial +space with the number of grid points. -/ +theorem finrank_planeMonomialSpace_eq_mul + {K L : Type*} [Field K] [CommRing L] [Algebra K L] + (x y : L) (a b : ℕ) + (hLI : LinearIndependent K (planeMonomialGrid x y a b)) : + Module.finrank K (planeMonomialSpace K x y a b) = a * b := by + change Module.finrank K + (Submodule.span K (Set.range (planeMonomialGrid x y a b))) = a * b + rw [finrank_span_eq_card hLI, Fintype.card_prod, + Fintype.card_fin, Fintype.card_fin] + +/-- Finite initial segments of the powers of a transcendental element are +linearly independent. -/ +theorem linearIndependent_fin_powers_of_transcendental + {K A : Type*} [Field K] [CommRing A] [Algebra K A] + (z : A) (hz : Transcendental K z) (n : ℕ) : + LinearIndependent K (fun i : Fin n ↦ z ^ (i : ℕ)) := by + have hpolynomial : LinearIndependent K + (fun i : Fin n ↦ (Polynomial.X : Polynomial K) ^ (i : ℕ)) := by + simpa only [Polynomial.coe_basisMonomials, + Polynomial.monomial_one_right_eq_X_pow, Function.comp_def] using + (Polynomial.basisMonomials K).linearIndependent.comp + (fun i : Fin n ↦ (i : ℕ)) Fin.val_injective + have heval : LinearMap.ker (Polynomial.aeval z).toLinearMap = ⊥ := + LinearMap.ker_eq_bot_of_injective + ((transcendental_iff_injective.mp hz)) + have hmapped := + hpolynomial.map' (Polynomial.aeval z).toLinearMap heval + change LinearIndependent K + (fun i : Fin n ↦ (Polynomial.aeval z) + ((Polynomial.X : Polynomial K) ^ (i : ℕ))) at hmapped + simpa only [Polynomial.aeval_X_pow] using hmapped + +/-- A tower criterion for a rectangular monomial grid. Powers of the +transcendental lower coordinate supply one independent family, and powers of +the upper element below its minimal-polynomial degree supply the other. -/ +theorem planeMonomialGrid_linearIndependent_of_transcendental_minpoly + {K F L : Type*} [Field K] [Field F] [Field L] + [Algebra K F] [Algebra F L] [Algebra K L] [IsScalarTower K F L] + (x : F) (y : L) (a b : ℕ) + (hx : Transcendental K x) + (hb : b ≤ (minpoly F y).natDegree) : + LinearIndependent K + (planeMonomialGrid (algebraMap F L x) y a b) := by + have hxPowers : LinearIndependent K (fun i : Fin a ↦ x ^ (i : ℕ)) := + linearIndependent_fin_powers_of_transcendental x hx a + have hyPowers : LinearIndependent F (fun j : Fin b ↦ y ^ (j : ℕ)) := by + simpa only [Function.comp_def, Fin.val_castLE] using + (linearIndependent_pow y).comp (Fin.castLE hb) + (Fin.castLE_injective hb) + change LinearIndependent K + (fun ij : Fin a × Fin b ↦ + (algebraMap F L x) ^ (ij.1 : ℕ) * y ^ (ij.2 : ℕ)) + simpa only [Algebra.smul_def, map_pow] using + (linearIndependent_smul hxPowers hyPowers) + +/-- The grid part of the Corvaja--Zannier auxiliary family is a linearly +independent rectangular monomial family. -/ +theorem planeMonomialGrid_linearIndependent_of_auxiliaryFamily + {C L : Type*} [Field C] [Field L] [Algebra C L] + (u v : L) (h k : ℕ) + (haux : LinearIndependent C (auxiliaryFamily u v h k)) : + LinearIndependent C (planeMonomialGrid u v (k + 1) h) := by + change LinearIndependent C + (fun rs : Fin (k + 1) × Fin h ↦ + u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ)) + simpa only [Function.comp_def, auxiliaryFamily] using + haux.comp (fun rs : Fin (k + 1) × Fin h ↦ Sum.inr rs) + Sum.inr_injective + +/-- On an irreducible plane curve, monomials with arbitrary first exponent +and second exponent below the second-coordinate degree are independent. -/ +theorem planeCurve_monomialGrid_linearIndependent + {K : Type*} [Field K] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (a b : ℕ) (hb : b ≤ MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + LinearIndependent K + (planeMonomialGrid (planeCurveFunction f 0) + (planeCurveFunction f 1) a b) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let xF : FirstCoordinateSubfield f := firstCoordinateInSubfield f + have hxL : Transcendental K (planeCurveFunction f 0) := + firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + have hxF : Transcendental K xF := by + apply (transcendental_algebraMap_iff + (algebraMap (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f)).injective).mp + change Transcendental K + (algebraMap (FirstCoordinateSubfield f) + (PlaneCurveFunctionField f) xF) + simpa only [xF, firstCoordinateInSubfield, + IntermediateField.algebraMap_apply] using hxL + have hminpoly : + (minpoly (FirstCoordinateSubfield f) + (planeCurveFunction f 1)).natDegree = + MvPolynomial.degreeOf 1 f := + natDegree_minpoly_secondCoordinate_eq_degreeOf_second + hf hpartialSecond + have hb' : b ≤ (minpoly (FirstCoordinateSubfield f) + (planeCurveFunction f 1)).natDegree := by + rw [hminpoly] + exact hb + simpa only [xF, firstCoordinateInSubfield, + IntermediateField.algebraMap_apply] using + planeMonomialGrid_linearIndependent_of_transcendental_minpoly + xF (planeCurveFunction f 1) a b hxF hb' + +/-- The bidegree criterion gives the exact dimension of the corresponding +plane-curve monomial space. -/ +theorem finrank_planeCurve_monomialSpace_eq_mul + {K : Type*} [Field K] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (a b : ℕ) (hb : b ≤ MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank K + (planeMonomialSpace K (planeCurveFunction f 0) + (planeCurveFunction f 1) a b) = a * b := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact finrank_planeMonomialSpace_eq_mul + (planeCurveFunction f 0) (planeCurveFunction f 1) a b + (planeCurve_monomialGrid_linearIndependent + hf hpartialSecond a b hb) + +/-- The mixed-radix exponent attached to a low digit and a high digit. -/ +def digitExponent {a a' : ℕ} (s : ℕ) (ii' : Fin a × Fin a') : ℕ := + (ii'.1 : ℕ) + s * (ii'.2 : ℕ) + +/-- Low digits bounded by the radix make the mixed-radix exponent map +injective. -/ +theorem digitExponent_injective + {s a a' : ℕ} (ha : a ≤ s) : + Function.Injective (digitExponent (a := a) (a' := a') s) := by + rintro ⟨i, i'⟩ ⟨k, k'⟩ heq + have hi : (i : ℕ) < s := i.isLt.trans_le ha + have hk : (k : ℕ) < s := k.isLt.trans_le ha + have hs : 0 < s := by omega + have hlow : (i : ℕ) = (k : ℕ) := by + have hmod := congrArg (fun n : ℕ ↦ n % s) heq + change ((i : ℕ) + s * (i' : ℕ)) % s = + ((k : ℕ) + s * (k' : ℕ)) % s at hmod + rw [Nat.add_mul_mod_self_left, Nat.add_mul_mod_self_left, + Nat.mod_eq_of_lt hi, Nat.mod_eq_of_lt hk] at hmod + exact hmod + have hhigh : (i' : ℕ) = (k' : ℕ) := by + have hmul : s * (i' : ℕ) = s * (k' : ℕ) := by + apply Nat.add_left_cancel (n := (i : ℕ)) + simpa only [digitExponent, hlow] using heq + exact Nat.mul_left_cancel hs hmul + exact Prod.ext (Fin.ext hlow) (Fin.ext hhigh) + +/-- The pair of mixed-radix exponents used by the twisted monomial grid. -/ +def twistedExponentGrid + (s a b a' b' : ℕ) : + (Fin a × Fin b) × (Fin a' × Fin b') → ℕ × ℕ := + fun z ↦ + ((z.1.1 : ℕ) + s * (z.2.1 : ℕ), + (z.1.2 : ℕ) + s * (z.2.2 : ℕ)) + +/-- Digit bounds in both coordinates make the exponent-pair map injective. -/ +theorem twistedExponentGrid_injective + {s a b a' b' : ℕ} (ha : a ≤ s) (hb : b ≤ s) : + Function.Injective (twistedExponentGrid s a b a' b') := by + rintro ⟨⟨i, j⟩, ⟨i', j'⟩⟩ ⟨⟨k, l⟩, ⟨k', l'⟩⟩ heq + have hfirst : (i, i') = (k, k') := + digitExponent_injective ha (congrArg Prod.fst heq) + have hsecond : (j, j') = (l, l') := + digitExponent_injective hb (congrArg Prod.snd heq) + cases hfirst + cases hsecond + rfl + +/-- The products of an ordinary monomial grid and its `s`-powered copy. -/ +def twistedPlaneMonomialGrid + {L : Type*} [Monoid L] + (x y : L) (s a b a' b' : ℕ) : + (Fin a × Fin b) × (Fin a' × Fin b') → L := + fun z ↦ + x ^ ((z.1.1 : ℕ) + s * (z.2.1 : ℕ)) * + y ^ ((z.1.2 : ℕ) + s * (z.2.2 : ℕ)) + +/-- Send a pair of low and high digits to the encompassing rectangular +grid. -/ +def twistedGridToGrid + (s a b a' b' : ℕ) : + (Fin a × Fin b) × (Fin a' × Fin b') → + Fin (a + s * a') × Fin (b + s * b') := + fun z ↦ + (⟨(z.1.1 : ℕ) + s * (z.2.1 : ℕ), + Nat.add_lt_add_of_lt_of_le z.1.1.isLt + (Nat.mul_le_mul_left s z.2.1.isLt.le)⟩, + ⟨(z.1.2 : ℕ) + s * (z.2.2 : ℕ), + Nat.add_lt_add_of_lt_of_le z.1.2.isLt + (Nat.mul_le_mul_left s z.2.2.isLt.le)⟩) + +theorem twistedGridToGrid_injective + {s a b a' b' : ℕ} (ha : a ≤ s) (hb : b ≤ s) : + Function.Injective (twistedGridToGrid s a b a' b') := by + intro z w hzw + apply twistedExponentGrid_injective ha hb + exact congrArg (fun q ↦ ((q.1 : ℕ), (q.2 : ℕ))) hzw + +/-- Direct bidegree criterion for the twisted family. The digit bounds make +the exponent encoding injective, while the final second-exponent range stays +below the curve's second-coordinate degree. -/ +theorem planeCurve_twistedMonomialGrid_linearIndependent + {K : Type*} [Field K] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (s a b a' b' : ℕ) + (ha : a ≤ s) (hb : b ≤ s) + (hdegree : b + s * b' ≤ MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + LinearIndependent K + (twistedPlaneMonomialGrid (planeCurveFunction f 0) + (planeCurveFunction f 1) s a b a' b') := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have hgrid := planeCurve_monomialGrid_linearIndependent + hf hpartialSecond (a + s * a') (b + s * b') hdegree + have hsubfamily := hgrid.comp (twistedGridToGrid s a b a' b') + (twistedGridToGrid_injective ha hb) + change LinearIndependent K + (fun z : (Fin a × Fin b) × (Fin a' × Fin b') ↦ + (planeCurveFunction f 0) ^ + ((z.1.1 : ℕ) + s * (z.2.1 : ℕ)) * + (planeCurveFunction f 1) ^ + ((z.1.2 : ℕ) + s * (z.2.2 : ℕ))) + simpa only [Function.comp_def, planeMonomialGrid, + twistedGridToGrid] using hsubfamily + +/-- In particular, under the direct bidegree criterion the twisted grid is +an injective family of functions. -/ +theorem planeCurve_twistedMonomialGrid_injective + {K : Type*} [Field K] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (s a b a' b' : ℕ) + (ha : a ≤ s) (hb : b ≤ s) + (hdegree : b + s * b' ≤ MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + Function.Injective + (twistedPlaneMonomialGrid (planeCurveFunction f 0) + (planeCurveFunction f 1) s a b a' b') := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + exact (planeCurve_twistedMonomialGrid_linearIndependent + hf hpartialSecond s a b a' b' ha hb hdegree).injective + +/-- Tower composition for Stepanov's twisted grid. The ordinary grid is +independent over `F`; the powered grid, regarded inside `F`, is independent +over `K`. Multiplication combines the two independent families. -/ +theorem twistedPlaneMonomialGrid_linearIndependent_of_subfield + {K L : Type*} [Field K] [Field L] [Algebra K L] + (F : Subfield L) [Algebra K F] [IsScalarTower K F L] + (x y : L) (s a b a' b' : ℕ) + (hxs : x ^ s ∈ F) (hys : y ^ s ∈ F) + (hdigit : LinearIndependent F (planeMonomialGrid x y a b)) + (hpowered : LinearIndependent K + (planeMonomialGrid (⟨x ^ s, hxs⟩ : F) + (⟨y ^ s, hys⟩ : F) a' b')) : + LinearIndependent K + (twistedPlaneMonomialGrid x y s a b a' b') := by + have hproduct := linearIndependent_smul hpowered hdigit + have hreindexed := hproduct.comp + (fun z : (Fin a × Fin b) × (Fin a' × Fin b') ↦ (z.2, z.1)) + (Equiv.prodComm (Fin a × Fin b) (Fin a' × Fin b')).injective + have hcoeX : F.subtype (⟨x ^ s, hxs⟩ : F) = x ^ s := rfl + have hcoeY : F.subtype (⟨y ^ s, hys⟩ : F) = y ^ s := rfl + change LinearIndependent K + (fun z : (Fin a × Fin b) × (Fin a' × Fin b') ↦ + x ^ ((z.1.1 : ℕ) + s * (z.2.1 : ℕ)) * + y ^ ((z.1.2 : ℕ) + s * (z.2.2 : ℕ))) + simpa only [Function.comp_def, planeMonomialGrid, + Algebra.smul_def, map_mul, map_pow, + Subfield.algebraMap_ofSubfield, RingHom.coe_coe, + hcoeX, hcoeY, Subtype.coe_mk, pow_mul, pow_add, + mul_assoc, mul_left_comm, mul_comm] using hreindexed + +/-- The powered-image relation supplies the bidegree needed for a monomial +grid in the powered coordinates. -/ +theorem planeCurve_poweredMonomialGrid_linearIndependent + {K : Type*} [Field K] + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : ℕ) (hm : 0 < m) (n a b : ℕ) + (hb : b ≤ + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree) : + letI := planeCurveCoordinateRing_isDomain hf + LinearIndependent K + (planeMonomialGrid ((planeCurveFunction f 0) ^ m) + ((planeCurveFunction f 1) ^ n) a b) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let xm : FirstPoweredCoordinateSubfield f m := + ⟨(planeCurveFunction f 0) ^ m, + IntermediateField.mem_adjoin_simple_self K + ((planeCurveFunction f 0) ^ m)⟩ + letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) := + finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have hxmL : Transcendental K ((planeCurveFunction f 0) ^ m) := + firstPoweredCoordinate_transcendental hf hpartialSecond m hm + have hxm : Transcendental K xm := by + apply (transcendental_algebraMap_iff + (algebraMap (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f)).injective).mp + change Transcendental K + (algebraMap (FirstPoweredCoordinateSubfield f m) + (PlaneCurveFunctionField f) xm) + simpa only [xm, IntermediateField.algebraMap_apply] using hxmL + have hynIntegral : IsIntegral (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n) := + IsIntegral.of_finite (FirstPoweredCoordinateSubfield f m) _ + have hminpoly : + (minpoly (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n)).natDegree = + (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := by + calc + (minpoly (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n)).natDegree = + Module.finrank (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) := + (IntermediateField.adjoin.finrank hynIntegral).symm + _ = (poweredCoordinateImageRelation + hf hpartialSecond m hm n).natDegree := + (poweredCoordinateImageRelation_natDegree_eq_finrank + hf hpartialSecond m hm n).symm + have hb' : b ≤ (minpoly (FirstPoweredCoordinateSubfield f m) + ((planeCurveFunction f 1) ^ n)).natDegree := by + rw [hminpoly] + exact hb + simpa only [xm, IntermediateField.algebraMap_apply] using + planeMonomialGrid_linearIndependent_of_transcendental_minpoly + xm ((planeCurveFunction f 1) ^ n) a b hxm hb' + +section PoleBudget + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance planeMonomialSpaceConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance planeMonomialSpaceConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Every monomial with `x`-exponent at most `n` and `y`-exponent below `b` +lies in the Riemann space with pole budget +`n · pole(x) + (b - 1) · pole(y)`. -/ +theorem planeMonomialSpace_le_poleDivisorBudget + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (n b : ℕ) : + planeMonomialSpace K x y (n + 1) b ≤ + finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y) := by + apply Submodule.span_le.mpr + rintro z ⟨ij, rfl⟩ + apply finiteExtensionRiemannSpace_mono K L + (D := (ij.1 : ℕ) • finiteExtensionPoleDivisor K L x + + (ij.2 : ℕ) • finiteExtensionPoleDivisor K L y) + · exact add_le_add + (nsmul_le_nsmul_left + (finiteExtensionPoleDivisor_effective K L x) + (by omega)) + (nsmul_le_nsmul_left + (finiteExtensionPoleDivisor_effective K L y) + (by omega)) + · exact pow_mul_pow_mem_poleDivisor_budget + K L x y hx hy (ij.1 : ℕ) (ij.2 : ℕ) + +/-- Pole-budget containment is already useful before finite-dimensionality of +the ambient Riemann space has been established: it gives monotonicity of the +corresponding module ranks. -/ +theorem rank_planeMonomialSpace_le_rank_poleDivisorBudget + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (n b : ℕ) : + Module.rank K (planeMonomialSpace K x y (n + 1) b) ≤ + Module.rank K + (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y)) := + Submodule.rank_mono + (planeMonomialSpace_le_poleDivisorBudget K L x y hx hy n b) + +/-- Once finite-dimensionality of the ambient Riemann space is available, +the same containment yields the numerical lower bound `(n + 1) * b`. -/ +theorem add_one_mul_le_finrank_poleDivisorBudget + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (n b : ℕ) + (hLI : LinearIndependent K (planeMonomialGrid x y (n + 1) b)) + (hfinite : Module.Finite K + (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y))) : + (n + 1) * b ≤ Module.finrank K + (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y)) := by + letI : Module.Finite K + (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y)) := hfinite + calc + (n + 1) * b = Module.finrank K + (planeMonomialSpace K x y (n + 1) b) := + (finrank_planeMonomialSpace_eq_mul x y (n + 1) b hLI).symm + _ ≤ Module.finrank K + (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y)) := + Submodule.finrank_mono + (planeMonomialSpace_le_poleDivisorBudget + K L x y hx hy n b) + +end PoleBudget + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean new file mode 100644 index 0000000000..558e477914 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean @@ -0,0 +1,671 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels + +/-! +# One-point Riemann-space lower bounds for plane curves + +For an absolutely irreducible affine plane equation `f`, choose an infinity +place `P` where the first coordinate has a pole. The rectangular monomial +grid + +`{x^i y^j | 0 ≤ i ≤ n, 0 ≤ j < degreeOf 1 f}` + +lies in the Riemann space of a controlled effective pole divisor. Removing +all components away from `P` and comparing divisor degrees gives the coarse +one-point estimate + +`m * degree(P) + 1 ≤ finrank L(m P) + + (degreeOf 0 f - 1) * (degreeOf 1 f - 1)` + +along an explicit arithmetic progression of pole levels `m`. The final +theorem combines this estimate with the one-place increment bound and the +exact constant field to force at least `m - g` strict levels in the one-point +Riemann filtration, where `g` is the displayed bidegree budget. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The effective pole divisor containing the rectangular monomial grid +`x^i y^j` with `i ≤ n` and `j < b`. -/ +def planeMonomialPoleBudget (x y : L) (n b : ℕ) : + FiniteExtensionDivisor K L := + n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y + +/-- The coefficient of the monomial pole budget at a selected place. -/ +def planeMonomialPoleLevel (x y : L) (n b : ℕ) + (P : FiniteExtensionPlace K L) : ℕ := + (planeMonomialPoleBudget K L x y n b P).toNat + +/-- The selected pole level is an explicit arithmetic progression in `n`. -/ +theorem planeMonomialPoleLevel_eq (x y : L) (n b : ℕ) + (P : FiniteExtensionPlace K L) : + planeMonomialPoleLevel K L x y n b P = + n * (finiteExtensionPoleDivisor K L x P).toNat + + (b - 1) * (finiteExtensionPoleDivisor K L y P).toNat := by + have hx := finiteExtensionPoleDivisor_effective K L x P + have hy := finiteExtensionPoleDivisor_effective K L y P + simp only [planeMonomialPoleLevel, planeMonomialPoleBudget, + Finsupp.add_apply, Finsupp.nsmul_apply, nsmul_eq_mul] + rw [Int.toNat_add + (mul_nonneg (Int.natCast_nonneg n) hx) + (mul_nonneg (Int.natCast_nonneg (b - 1)) hy), + Int.toNat_mul (Int.natCast_nonneg n) hx, + Int.toNat_mul (Int.natCast_nonneg (b - 1)) hy] + simp + +/-- The coarse bidegree genus budget used by the monomial argument. It is an +upper-bound budget and does not assert that the affine plane model is smooth. -/ +def planeCurveBidegreeGenusBudget + {K : Type*} [CommSemiring K] (f : MvPolynomial (Fin 2) K) : ℕ := + (MvPolynomial.degreeOf 0 f - 1) * (MvPolynomial.degreeOf 1 f - 1) + +variable {K} + +theorem planeCurveSecondCoordinate_height_le_degreeOf_first + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + finiteExtensionHeight K (PlaneCurveFunctionField f) + (planeCurveFunction f 1) ≤ MvPolynomial.degreeOf 0 f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let y : L := planeCurveFunction f 1 + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro hy + apply hyTrans + rw [hy] + exact isAlgebraic_zero + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change finiteExtensionHeight K L y ≤ MvPolynomial.degreeOf 0 f + rw [← finiteExtensionPositiveDegree_eq_height K L y hy0] + exact finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_first + hf hpartialFirst hpartialSecond + +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +private theorem planeCurve_monomialGrid_linearIndependent_firstRatFunc + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (a b : ℕ) (hb : b ≤ MvPolynomial.degreeOf 1 f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap K (RatFunc K))) + letI : Algebra K (PlaneCurveFunctionField f) := constantAlg + letI : SMul K (PlaneCurveFunctionField f) := constantAlg.toSMul + letI : Module K (PlaneCurveFunctionField f) := constantAlg.toModule + LinearIndependent K + (planeMonomialGrid (planeCurveFunction f 0) + (planeCurveFunction f 1) a b) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let y : L := planeCurveFunction f 1 + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := constantAlg + letI : SMul K L := constantAlg.toSMul + letI : Module K L := constantAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + let F : Polynomial (RatFunc K) := + (planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K)) + have hFirreducible : Irreducible F := + planeCurvePolynomialInSecondCoordinate_ratFunc_irreducible + hf hpartialSecond + have hFroot : Polynomial.aeval y F = 0 := by + simpa only [L, y] using + aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + hf hpartialSecond + have heq := minpoly.eq_of_irreducible hFirreducible hFroot + have hminDegree : (minpoly (RatFunc K) y).natDegree = + MvPolynomial.degreeOf 1 f := by + calc + (minpoly (RatFunc K) y).natDegree = + (F * Polynomial.C F.leadingCoeff⁻¹).natDegree := by rw [heq] + _ = F.natDegree := Polynomial.natDegree_mul_C + (inv_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr + hFirreducible.ne_zero)) + _ = MvPolynomial.degreeOf 1 f := by + change ((planeCurvePolynomialInSecondCoordinate f).map + (algebraMap (Polynomial K) (RatFunc K))).natDegree = _ + rw [Polynomial.natDegree_map_eq_of_injective + (IsFractionRing.injective (Polynomial K) (RatFunc K)), + planeCurvePolynomialInSecondCoordinate_natDegree] + have hb' : b ≤ (minpoly (RatFunc K) y).natDegree := by + rw [hminDegree] + exact hb + have hLI := + planeMonomialGrid_linearIndependent_of_transcendental_minpoly + (RatFunc.X : RatFunc K) y a b RatFunc.transcendental_X hb' + rw [planeCurveFirstCoordinateRatFuncAlgebra_X f hx] at hLI + simpa only [L, y] using hLI + +theorem planeCurveMonomialPoleBudget_finrank_lower + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (n : ℕ) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + (n + 1) * MvPolynomial.degreeOf 1 f ≤ + Module.finrank K (finiteExtensionRiemannSpace K + (PlaneCurveFunctionField f) + (planeMonomialPoleBudget K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (planeCurveFunction f 1) n + (MvPolynomial.degreeOf 1 f))) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + let b := MvPolynomial.degreeOf 1 f + have hx0 : x ≠ 0 := by + intro h + apply hx + change IsAlgebraic K x + rw [h] + exact isAlgebraic_zero + have hyTrans : Transcendental K y := + secondCoordinate_transcendental hf + (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) + have hy0 : y ≠ 0 := by + intro h + apply hyTrans + rw [h] + exact isAlgebraic_zero + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := constantAlg + letI : SMul K L := constantAlg.toSMul + letI : Module K L := constantAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + have hD : ∀ v, 0 ≤ + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y) v := by + intro v + simp only [Finsupp.add_apply, Finsupp.nsmul_apply] + exact add_nonneg + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L x v) n) + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L y v) (b - 1)) + have hfinite : Module.Finite K (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y)) := + finiteExtensionRiemannSpace_effective_moduleFinite K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y) hD + change (n + 1) * b ≤ Module.finrank K + (finiteExtensionRiemannSpace K L + (n • finiteExtensionPoleDivisor K L x + + (b - 1) • finiteExtensionPoleDivisor K L y)) + apply add_one_mul_le_finrank_poleDivisorBudget + K L x y hx0 hy0 n b + · simpa only [L, x, y, b] using + planeCurve_monomialGrid_linearIndependent_firstRatFunc + hf hpartialSecond (n + 1) b le_rfl + · exact hfinite + +private theorem exists_planeCurve_onePointRiemannSpace_progression_lower_bound_irreducible + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∃ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), + let Q : FiniteExtensionPlace K (PlaneCurveFunctionField f) := .inr P + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) Q ∧ + 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q ∧ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q ≤ + MvPolynomial.degreeOf 1 f ∧ + ∀ n : ℕ, + let m := planeMonomialPoleLevel K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (planeCurveFunction f 1) n + (MvPolynomial.degreeOf 1 f) Q + m = n * (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) Q).toNat + + (MvPolynomial.degreeOf 1 f - 1) * + (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 1) Q).toNat ∧ + Module.Finite K (finiteExtensionOnePointRiemannSpace K + (PlaneCurveFunctionField f) Q m) ∧ + m * finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K + (PlaneCurveFunctionField f) Q m) + + planeCurveBidegreeGenusBudget f := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + let a := MvPolynomial.degreeOf 0 f + let b := MvPolynomial.degreeOf 1 f + let g := planeCurveBidegreeGenusBudget f + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : Algebra K L := constantAlg + letI : SMul K L := constantAlg.toSMul + letI : Module K L := constantAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + obtain ⟨P, hPpole, hPdegreePositive, hPdegreeBound⟩ := + exists_planeCurveFirstCoordinate_infinityPolePlace hf hpartialSecond + let Q : FiniteExtensionPlace K L := .inr P + refine ⟨P, hPpole, hPdegreePositive, hPdegreeBound, ?_⟩ + intro n + let D : FiniteExtensionDivisor K L := + planeMonomialPoleBudget K L x y n b + let m := (D Q).toNat + have hD : ∀ v, 0 ≤ D v := by + intro v + dsimp only [D] + simp only [planeMonomialPoleBudget, Finsupp.add_apply, + Finsupp.nsmul_apply] + exact add_nonneg + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L x v) n) + (nsmul_nonneg (finiteExtensionPoleDivisor_effective K L y v) (b - 1)) + have hm : m = n * (finiteExtensionPoleDivisor K L x Q).toNat + + (b - 1) * (finiteExtensionPoleDivisor K L y Q).toNat := by + simpa only [m, D, planeMonomialPoleLevel] using + planeMonomialPoleLevel_eq K L x y n b Q + have hmCast : (m : ℤ) = D Q := by + exact Int.toNat_of_nonneg (hD Q) + have hfiniteOne : Module.Finite K + (finiteExtensionOnePointRiemannSpace K L Q m) := by + change Module.Finite K (finiteExtensionRiemannSpace K L + (Finsupp.single Q (m : ℤ))) + apply finiteExtensionRiemannSpace_effective_moduleFinite K L + intro v + by_cases hv : v = Q + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + letI : Module.Finite K + (finiteExtensionOnePointRiemannSpace K L Q m) := hfiniteOne + have hfullLower : (n + 1) * b ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) := by + simpa only [D, L, x, y, b] using + planeCurveMonomialPoleBudget_finrank_lower + hf hpartialFirst hpartialSecond n + have hsplit : Module.finrank K (finiteExtensionRiemannSpace K L D) ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q m) + + (finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D Q)).toNat := by + exact finiteExtensionRiemannSpace_finrank_le_onePoint_add_degreeAway + K L D hD Q + have hxHeight : finiteExtensionHeight K L x = b := by + simpa only [L, x, b] using + finiteExtensionHeight_planeCurveFirstCoordinate hf hpartialSecond + have hyHeight : finiteExtensionHeight K L y ≤ a := by + simpa only [L, y, a] using + planeCurveSecondCoordinate_height_le_degreeOf_first + hf hpartialFirst hpartialSecond + have hDdegree : finiteExtensionDivisorDegree K L D ≤ + (n * b + (b - 1) * a : ℕ) := by + dsimp only [D, planeMonomialPoleBudget] + rw [finiteExtensionDivisorDegree_pow_mul_pow_budget, hxHeight] + have hyCast : (finiteExtensionHeight K L y : ℤ) ≤ (a : ℤ) := by + exact_mod_cast hyHeight + calc + (n : ℤ) * (b : ℤ) + ((b - 1 : ℕ) : ℤ) * + (finiteExtensionHeight K L y : ℤ) ≤ + (n : ℤ) * (b : ℤ) + ((b - 1 : ℕ) : ℤ) * (a : ℤ) := by + gcongr + _ = (n * b + (b - 1) * a : ℕ) := by push_cast; ring + have hAwayEffective : ∀ v, 0 ≤ finiteExtensionDivisorAway K L D Q v := + finiteExtensionDivisorAway_effective K L D Q hD + have hAwayDegreeNonnegative : 0 ≤ finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D Q) := + finiteExtensionDivisorDegree_nonnegative_of_effective K L + (finiteExtensionDivisorAway K L D Q) hAwayEffective + have hAwayPlusSelected : + (finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D Q)).toNat + + m * finiteExtensionPlaceDegree K L Q ≤ + n * b + (b - 1) * a := by + have hcast : + (((finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D Q)).toNat + + m * finiteExtensionPlaceDegree K L Q : ℕ) : ℤ) ≤ + ((n * b + (b - 1) * a : ℕ) : ℤ) := by + push_cast + rw [Int.toNat_of_nonneg hAwayDegreeNonnegative, hmCast] + calc + finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D Q) + + D Q * (finiteExtensionPlaceDegree K L Q : ℤ) = + finiteExtensionDivisorDegree K L D := by + rw [finiteExtensionDivisorDegree_away] + ring + _ ≤ ((n * b + (b - 1) * a : ℕ) : ℤ) := hDdegree + exact_mod_cast hcast + have haPos : 0 < a := degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst + have hbPos : 0 < b := degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + have hgenusIdentity : + n * b + (b - 1) * a + 1 = (n + 1) * b + g := by + dsimp only [g, planeCurveBidegreeGenusBudget, a, b] + have haEq : MvPolynomial.degreeOf 0 f - 1 + 1 = + MvPolynomial.degreeOf 0 f := by omega + have hbEq : MvPolynomial.degreeOf 1 f - 1 + 1 = + MvPolynomial.degreeOf 1 f := by omega + nlinarith + refine ⟨hm, hfiniteOne, ?_⟩ + change m * finiteExtensionPlaceDegree K L Q + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q m) + g + have hdim := hfullLower.trans hsplit + omega + +/-- An absolutely irreducible plane curve admits a controlled infinity place +and an explicit arithmetic progression of one-point pole levels satisfying +the coarse Riemann lower bound + +`m * degree(P) + 1 ≤ finrank L(m P) + g`, + +where `g = (degreeOf 0 f - 1) * (degreeOf 1 f - 1)`. The first-partial +hypothesis supplies the second-coordinate height bound used by the monomial +budget; the second-partial hypothesis makes the first coordinate separating. -/ +theorem exists_planeCurve_onePointRiemannSpace_progression_lower_bound + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + ∃ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), + let Q : FiniteExtensionPlace K (PlaneCurveFunctionField f) := .inr P + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) Q ∧ + 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q ∧ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q ≤ + MvPolynomial.degreeOf 1 f ∧ + ∀ n : ℕ, + let m := planeMonomialPoleLevel K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (planeCurveFunction f 1) n + (MvPolynomial.degreeOf 1 f) Q + m = n * (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) Q).toNat + + (MvPolynomial.degreeOf 1 f - 1) * + (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 1) Q).toNat ∧ + Module.Finite K (finiteExtensionOnePointRiemannSpace K + (PlaneCurveFunctionField f) Q m) ∧ + m * finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K + (PlaneCurveFunctionField f) Q m) + + planeCurveBidegreeGenusBudget f := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + exact exists_planeCurve_onePointRiemannSpace_progression_lower_bound_irreducible + hf hpartialFirst hpartialSecond + +/-- Along the progression from +`exists_planeCurve_onePointRiemannSpace_progression_lower_bound`, every level +`m ≥ g` contains at least `m - g` strict inclusions in the one-point Riemann +filtration. Exact constants give the initial dimension one, while adding the +selected place raises dimension by at most its residue degree. -/ +theorem exists_planeCurve_onePointRiemannSpace_progression_strictLevels_lower_bound + {f : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) f)) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra K (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap K (RatFunc K))) + letI : Algebra K (PlaneCurveFunctionField f) := constantAlg + letI : SMul K (PlaneCurveFunctionField f) := constantAlg.toSMul + letI : Module K (PlaneCurveFunctionField f) := constantAlg.toModule + ∃ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), + let Q : FiniteExtensionPlace K (PlaneCurveFunctionField f) := .inr P + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) Q ∧ + 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q ∧ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) Q ≤ + MvPolynomial.degreeOf 1 f ∧ + ∀ n : ℕ, + let m := planeMonomialPoleLevel K (PlaneCurveFunctionField f) + (planeCurveFunction f 0) (planeCurveFunction f 1) n + (MvPolynomial.degreeOf 1 f) Q + planeCurveBidegreeGenusBudget f ≤ m → + m - planeCurveBidegreeGenusBudget f ≤ + (strictFiltrationLevels + (fun k => finiteExtensionOnePointRiemannSpace K + (PlaneCurveFunctionField f) Q k) m).card := by + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField f + let x : L := planeCurveFunction f 0 + let y : L := planeCurveFunction f 1 + let b := MvPolynomial.degreeOf 1 f + let g := planeCurveBidegreeGenusBudget f + letI : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let canonicalAlg : Algebra K L := inferInstance + let constantAlg : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + have hconstantAlg : constantAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg x hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg x hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := constantAlg + letI : SMul K L := constantAlg.toSMul + letI : Module K L := constantAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + obtain ⟨P, hPpole, hPdegreePositive, hPdegreeBound, hprogress⟩ := + exists_planeCurve_onePointRiemannSpace_progression_lower_bound + habsolute hpartialFirst hpartialSecond + let Q : FiniteExtensionPlace K L := .inr P + refine ⟨P, hPpole, hPdegreePositive, hPdegreeBound, ?_⟩ + have hconstantsCanonical : + @algebraicClosure K L _ _ canonicalAlg = ⊥ := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + f habsolute hpartialSecond + have hconstants : + @algebraicClosure K L _ _ constantAlg = ⊥ := by + rw [hconstantAlg] + exact hconstantsCanonical + have hzeroFinrank : Module.finrank K + (finiteExtensionOnePointRiemannSpace K L Q 0) = 1 := by + change Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single Q (0 : ℤ))) = 1 + have hzeroDivisor : Finsupp.single Q (0 : ℤ) = + (0 : FiniteExtensionDivisor K L) := by + ext v + by_cases hv : v = Q <;> simp [hv] + rw [hzeroDivisor] + exact finiteExtensionRiemannSpace_zero_finrank K L hconstants + have hnested : ∀ k, + finiteExtensionOnePointRiemannSpace K L Q k ≤ + finiteExtensionOnePointRiemannSpace K L Q (k + 1) := by + intro k + exact finiteExtensionOnePointRiemannSpace_mono K L Q (by omega) + have hjump : ∀ k, Module.finrank K + (finiteExtensionOnePointRiemannSpace K L Q (k + 1)) ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q k) + + finiteExtensionPlaceDegree K L Q := by + intro k + let Dk : FiniteExtensionDivisor K L := Finsupp.single Q (k : ℤ) + have hDk : ∀ v, 0 ≤ Dk v := by + intro v + by_cases hv : v = Q + · subst v + simp [Dk] + · simp [Dk, Finsupp.single_eq_of_ne hv] + have hfiniteK : Module.Finite K + (finiteExtensionRiemannSpace K L Dk) := + finiteExtensionRiemannSpace_effective_moduleFinite K L Dk hDk + letI : Module.Finite K + (finiteExtensionRiemannSpace K L Dk) := hfiniteK + have hstep := finiteExtensionRiemannSpace_place_increment K L Dk hDk Q + have hdivisor : Dk + Finsupp.single Q 1 = + Finsupp.single Q ((k + 1 : ℕ) : ℤ) := by + ext v + by_cases hv : v = Q + · subst v + simp only [Dk, Finsupp.add_apply, Finsupp.single_eq_same] + push_cast + ring + · simp [Dk, Finsupp.single_eq_of_ne hv] + change Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single Q ((k + 1 : ℕ) : ℤ))) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single Q (k : ℤ))) + finiteExtensionPlaceDegree K L Q + rw [← hdivisor] + exact hstep.2 + intro n + let m := planeMonomialPoleLevel K L x y n b Q + change g ≤ m → m - g ≤ + (strictFiltrationLevels + (fun k => finiteExtensionOnePointRiemannSpace K L Q k) m).card + intro hgm + obtain ⟨_hm, _hfinite, hlowerRaw⟩ := hprogress n + have hlower : m * finiteExtensionPlaceDegree K L Q + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q m) + g := by + simpa only [m, L, x, y, b, Q, g] using hlowerRaw + have hdegreeGenus : g ≤ finiteExtensionPlaceDegree K L Q * g := + Nat.le_mul_of_pos_left g hPdegreePositive + have hscaled : 1 + finiteExtensionPlaceDegree K L Q * (m - g) ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q m) := by + have hmDecomp : m = (m - g) + g := + (Nat.sub_add_cancel hgm).symm + have hmulDecomp : finiteExtensionPlaceDegree K L Q * m = + finiteExtensionPlaceDegree K L Q * (m - g) + + finiteExtensionPlaceDegree K L Q * g := by + calc + finiteExtensionPlaceDegree K L Q * m = + finiteExtensionPlaceDegree K L Q * ((m - g) + g) := + congrArg (fun t => finiteExtensionPlaceDegree K L Q * t) hmDecomp + _ = finiteExtensionPlaceDegree K L Q * (m - g) + + finiteExtensionPlaceDegree K L Q * g := by + rw [Nat.mul_add] + rw [Nat.mul_comm m (finiteExtensionPlaceDegree K L Q)] at hlower + omega + apply le_card_strictFiltrationLevels_of_initial_add_mul_le_finrank + (fun k => finiteExtensionOnePointRiemannSpace K L Q k) + hPdegreePositive hnested hjump + rw [hzeroFinrank] + exact hscaled + +end + + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean new file mode 100644 index 0000000000..e35cb0947d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean @@ -0,0 +1,1661 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +import Mathlib.Algebra.Polynomial.RingDivision +import Mathlib.NumberTheory.RamificationInertia.Basic + +/-! +# Rational normalization places and affine exceptional fibers + +This file begins the reverse comparison from degree-one normalization places +to affine rational points. It supplies the two finite-place counting APIs +needed independently of the remaining local-center argument: + +* degree-one finite places of `K(X)` are canonically equivalent to `K`; +* rational finite places whose base coordinate is a zero of a polynomial `R` + are bounded by `#Z(R)` times the function-field degree. + +For a plane equation, the exceptional base polynomial is the product of the +second-coordinate leading coefficient and the derivative resultant. The +leading-coefficient factor is necessary: the derivative resultant alone need +not detect degree drop after specialization, especially in positive +characteristic. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier Polynomial + +variable (K : Type*) [Field K] [DecidableEq K] + +private def linearNormalizedPrime (a : K) : NormalizedPrimePolynomial K := + ⟨Polynomial.X - Polynomial.C a, Polynomial.prime_X_sub_C a, + (Polynomial.monic_X_sub_C a).normalize_eq_self⟩ + +/-- Degree-one finite places of `K(X)` are exactly the linear primes +`X - a`, hence are canonically parametrized by `a : K`. -/ +def ratFuncRationalFinitePlaceEquiv : RatFuncRationalFinitePlace K ≃ K where + toFun P := -((finitePlaceNormalizedPrime P.1 : K[X]).coeff 0) + invFun a := ⟨normalizedPrimeFinitePlace (K := K) (linearNormalizedPrime K a), by + simp [ratFuncFinitePlaceDegree, linearNormalizedPrime]⟩ + left_inv P := by + apply Subtype.ext + let r := finitePlaceNormalizedPrime P.1 + have hrNatDegree : (r : K[X]).natDegree = 1 := by + simpa [r, ratFuncFinitePlaceDegree] using P.2 + have hrDegree : (r : K[X]).degree = 1 := by + simpa [hrNatDegree] using + (Polynomial.degree_eq_natDegree r.property.1.ne_zero) + have hrMonic : (r : K[X]).Monic := by + rw [← r.property.2] + exact Polynomial.monic_normalize r.property.1.ne_zero + have hr : (r : K[X]) = + Polynomial.X - Polynomial.C (-((r : K[X]).coeff 0)) := by + simpa [hrMonic.leadingCoeff] using + (Polynomial.eq_X_add_C_of_degree_eq_one hrDegree) + symm + calc + P.1 = normalizedPrimeFinitePlace (K := K) r := + (normalizedPrimeFinitePlace_finitePlaceNormalizedPrime P.1).symm + _ = normalizedPrimeFinitePlace (K := K) + (linearNormalizedPrime K (-((r : K[X]).coeff 0))) := by + congr 1 + exact Subtype.ext hr + right_inv a := by + simp [linearNormalizedPrime] + +end + + +noncomputable section + +open BGS.CorvajaZannier Polynomial + +variable {K : Type*} [Field K] + +/-- The base polynomial containing both the critical fibers and the fibers +where the second-coordinate degree drops. -/ +noncomputable def secondCoordinateAffineExceptionalPolynomial + (f : MvPolynomial (Fin 2) K) : Polynomial K := + (planeCurvePolynomialInSecondCoordinate f).leadingCoeff * + secondCoordinateCriticalResultant f + +theorem secondCoordinateAffineExceptionalPolynomial_ne_zero + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + secondCoordinateAffineExceptionalPolynomial f ≠ 0 := by + have hF0 : planeCurvePolynomialInSecondCoordinate f ≠ 0 := by + intro hzero + have hdegree : (planeCurvePolynomialInSecondCoordinate f).natDegree = 0 := by + rw [hzero, Polynomial.natDegree_zero] + have hpos : 0 < (planeCurvePolynomialInSecondCoordinate f).natDegree := by + simpa using degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + omega + exact mul_ne_zero (Polynomial.leadingCoeff_ne_zero.mpr hF0) + (secondCoordinateCriticalResultant_ne_zero hf hpartialSecond) + +theorem secondCoordinateAffineExceptionalPolynomial_natDegree_le + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + (secondCoordinateAffineExceptionalPolynomial f).natDegree ≤ + firstDegree + (2 * secondDegree - 1) * firstDegree := by + calc + (secondCoordinateAffineExceptionalPolynomial f).natDegree ≤ + (planeCurvePolynomialInSecondCoordinate f).leadingCoeff.natDegree + + (secondCoordinateCriticalResultant f).natDegree := + Polynomial.natDegree_mul_le + _ ≤ firstDegree + (2 * secondDegree - 1) * firstDegree := by + exact Nat.add_le_add + (planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le hdegree _) + (secondCoordinateCriticalResultant_natDegree_le hdegree) + +theorem secondCoordinateAffineExceptionalBase_card_le + [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + Fintype.card {a : K // + (secondCoordinateAffineExceptionalPolynomial f).eval a = 0} ≤ + firstDegree + (2 * secondDegree - 1) * firstDegree := by + exact (polynomialEvalZeroSubtype_card_le_natDegree + (secondCoordinateAffineExceptionalPolynomial f) + (secondCoordinateAffineExceptionalPolynomial_ne_zero hf hpartialSecond)).trans + (secondCoordinateAffineExceptionalPolynomial_natDegree_le hdegree) + +end + + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain + +variable (K : Type*) [Field K] [DecidableEq K] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [DecidableEq (RatFunc K)] + +local instance rationalComparisonConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance rationalComparisonConstantScalarTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) rationalComparisonPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance rationalComparisonPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance rationalComparisonFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance rationalComparisonPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance rationalComparisonFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance rationalComparisonFiniteClosureNoZeroSMulDivisors : + NoZeroSMulDivisors K[X] (RatFuncFiniteIntegralClosure K L) where + eq_zero_or_eq_zero_of_smul_eq_zero h := smul_eq_zero.mp h + +local instance rationalComparisonFiniteClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance rationalComparisonFiniteClosureFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance rationalComparisonFiniteClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance rationalComparisonFiniteClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance rationalComparisonFiniteClosureConstantTowerToField : + IsScalarTower K (RatFuncFiniteIntegralClosure K L) L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + +/-- At a rational finite place, a nonconstant regular function has a unique +constant residue representative, expressed by positive order of the +difference. -/ +theorem exists_constant_sub_finitePlaceOrder_pos_of_nonnegative + (q : FiniteExtensionRationalFinitePlace K L) (z : L) + (hz : z ≠ 0) + (hnotConstant : ∀ c : K, z ≠ algebraMap K L c) + (hregular : 0 ≤ finitePlaceOrder q.1 z) : + ∃ c : K, 0 < finitePlaceOrder q.1 (z - algebraMap K L c) := by + by_cases hpos : 0 < finitePlaceOrder q.1 z + · exact ⟨0, by simpa using hpos⟩ + have hzero : finitePlaceOrder q.1 z = 0 := + le_antisymm (not_lt.mp hpos) hregular + have horders : + finiteExtensionPrincipalDivisor K L z (.inl q.1) = + finiteExtensionPrincipalDivisor K L 1 (.inl q.1) := by + rw [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder, hzero, + finiteExtensionPrincipalDivisor_one] + rfl + obtain ⟨c, hc⟩ := + exists_constant_finiteExtensionPlaceOrder_sub_mul_eq_zero_or_lt + K L (.inl q.1) q.2 z 1 hz one_ne_zero horders + refine ⟨c, ?_⟩ + rcases hc with hconstant | hstrict + · exact (hnotConstant c (by simpa using sub_eq_zero.mp hconstant)).elim + · rw [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder, hzero] at hstrict + simpa only [mul_one, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hstrict + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +/-- Nonnegative finite-place order is equivalent to regularity in the +canonical valuation subring; this direction is the one needed below. -/ +theorem mem_valuationSubringAtPrime_of_finitePlaceOrder_nonnegative + (q : HeightOneSpectrum (RatFuncFiniteIntegralClosure K L)) + (z : L) (hz : z ≠ 0) (hregular : 0 ≤ finitePlaceOrder q z) : + z ∈ IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L q := by + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + change q.valuation L z ≤ 1 + rw [valuation_eq_exp_neg_finitePlaceOrder q z hz, ← WithZero.exp_zero] + exact WithZero.exp_le_exp.mpr (by omega) + +omit [DecidableEq (RatFunc K)] in +/-- The full lying-over fiber above a rational finite base place has at most +the extension degree many primes. -/ +theorem rationalBasePlace_primesOver_card_le_finrank + (P : RatFuncRationalFinitePlace K) : + Fintype.card + (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) ≤ + Module.finrank (RatFunc K) L := by + letI : Fintype + (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := + Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.asIdeal + (RatFuncFiniteIntegralClosure K L)) + let e : P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) ≃ + ↥(IsDedekindDomain.primesOverFinset P.1.asIdeal + (RatFuncFiniteIntegralClosure K L)) := + Equiv.setCongr + (IsDedekindDomain.coe_primesOverFinset P.1.ne_bot + (RatFuncFiniteIntegralClosure K L)).symm + calc + Fintype.card + (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) = + Fintype.card ↥(IsDedekindDomain.primesOverFinset P.1.asIdeal + (RatFuncFiniteIntegralClosure K L)) := Fintype.card_congr e + _ = (IsDedekindDomain.primesOverFinset P.1.asIdeal + (RatFuncFiniteIntegralClosure K L)).card := Fintype.card_coe _ + _ ≤ Module.finrank (RatFunc K) L := + Ideal.card_primesOverFinset_le_finrank + (RatFuncFiniteIntegralClosure K L) (RatFunc K) L P.1.ne_bot + +/-- The first-coordinate value of the rational base place below a rational +finite extension place. -/ +def rationalFinitePlaceBaseCoordinate + (Q : FiniteExtensionRationalFinitePlace K L) : K := + ratFuncRationalFinitePlaceEquiv K + (rationalFinitePlaceToBaseFiber K L Q).1 + +/-- Rational finite places whose base coordinate is a zero of `R`. -/ +abbrev RationalFinitePlaceOverPolynomialZeros (R : Polynomial K) := + {Q : FiniteExtensionRationalFinitePlace K L // + R.eval (rationalFinitePlaceBaseCoordinate K L Q) = 0} + +/-- A base polynomial with `r` rational roots accounts for at most +`r * [L : K(X)]` rational finite places. -/ +theorem rationalFinitePlaceOverPolynomialZeros_card_le + [Fintype K] (R : Polynomial K) : + Nat.card (RationalFinitePlaceOverPolynomialZeros K L R) ≤ + Fintype.card {a : K // R.eval a = 0} * + Module.finrank (RatFunc K) L := by + let baseZero := {P : RatFuncRationalFinitePlace K // + R.eval (ratFuncRationalFinitePlaceEquiv K P) = 0} + letI : Fintype (RationalFinitePlaceOverPolynomialZeros K L R) := + Fintype.ofFinite _ + letI : Fintype baseZero := Fintype.ofFinite baseZero + letI (P : baseZero) : + Fintype (P.1.1.asIdeal.primesOver + (RatFuncFiniteIntegralClosure K L)) := + Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.1.asIdeal + (RatFuncFiniteIntegralClosure K L)) + let embedding : RationalFinitePlaceOverPolynomialZeros K L R → + Sigma (fun P : baseZero => P.1.1.asIdeal.primesOver + (RatFuncFiniteIntegralClosure K L)) := fun Q => + ⟨⟨(rationalFinitePlaceToBaseFiber K L Q.1).1, Q.2⟩, + (rationalFinitePlaceToBaseFiber K L Q.1).2⟩ + have embedding_injective : Function.Injective embedding := by + intro Q S hQS + apply Subtype.ext + apply Subtype.ext + apply HeightOneSpectrum.ext + have hIdeals := congrArg + (fun z : Sigma (fun P : baseZero => P.1.1.asIdeal.primesOver + (RatFuncFiniteIntegralClosure K L)) => z.2.1) hQS + simpa [embedding, rationalFinitePlaceToBaseFiber] using hIdeals + let baseEquiv : baseZero ≃ {a : K // R.eval a = 0} := + Equiv.subtypeEquiv (ratFuncRationalFinitePlaceEquiv K) (by + intro P + rfl) + calc + Nat.card (RationalFinitePlaceOverPolynomialZeros K L R) = + Fintype.card (RationalFinitePlaceOverPolynomialZeros K L R) := + Nat.card_eq_fintype_card + _ ≤ Fintype.card (Sigma (fun P : baseZero => + P.1.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L))) := + Fintype.card_le_of_injective embedding embedding_injective + _ = ∑ P : baseZero, Fintype.card + (P.1.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := + Fintype.card_sigma + _ ≤ ∑ _P : baseZero, Module.finrank (RatFunc K) L := by + exact Finset.sum_le_sum fun P _ => + rationalBasePlace_primesOver_card_le_finrank K L P.1 + _ = Fintype.card baseZero * Module.finrank (RatFunc K) L := by + simp + _ = Fintype.card {a : K // R.eval a = 0} * + Module.finrank (RatFunc K) L := by + rw [Fintype.card_congr baseEquiv] + +/-- Rational finite places whose base coordinate avoids the zero locus of +`R`. -/ +abbrev RationalFinitePlaceAwayFromPolynomialZeros (R : Polynomial K) := + {Q : FiniteExtensionRationalFinitePlace K L // + R.eval (rationalFinitePlaceBaseCoordinate K L Q) ≠ 0} + +/-- Rational finite places split as the places away from `R = 0` and the +places over `R = 0`. -/ +theorem rationalFinitePlace_card_eq_away_add_overPolynomialZeros + [Finite K] (R : Polynomial K) : + Nat.card (FiniteExtensionRationalFinitePlace K L) = + Nat.card (RationalFinitePlaceAwayFromPolynomialZeros K L R) + + Nat.card (RationalFinitePlaceOverPolynomialZeros K L R) := by + classical + calc + Nat.card (FiniteExtensionRationalFinitePlace K L) = + Nat.card + (RationalFinitePlaceOverPolynomialZeros K L R ⊕ + RationalFinitePlaceAwayFromPolynomialZeros K L R) := + Nat.card_congr + (Equiv.sumCompl (fun Q : FiniteExtensionRationalFinitePlace K L => + R.eval (rationalFinitePlaceBaseCoordinate K L Q) = 0)).symm + _ = Nat.card (RationalFinitePlaceOverPolynomialZeros K L R) + + Nat.card (RationalFinitePlaceAwayFromPolynomialZeros K L R) := + Nat.card_sum + _ = Nat.card (RationalFinitePlaceAwayFromPolynomialZeros K L R) + + Nat.card (RationalFinitePlaceOverPolynomialZeros K L R) := + Nat.add_comm _ _ + +/-- Abstract reverse counting principle. An injective center map from the +rational finite places away from `R = 0` into a finite type `A`, together with +the bad-fiber and infinity estimates, bounds every rational place. -/ +theorem finiteExtensionRationalPlaceCount_le_natCard_add_polynomialZeros_of_away_injective + [Fintype K] (R : Polynomial K) (A : Type*) [Finite A] + (center : RationalFinitePlaceAwayFromPolynomialZeros K L R → A) + (hcenter : Function.Injective center) : + finiteExtensionRationalPlaceCount K L ≤ + Nat.card A + + Fintype.card {a : K // R.eval a = 0} * + Module.finrank (RatFunc K) L + + Module.finrank (RatFunc K) L := by + classical + have hgood : + Nat.card (RationalFinitePlaceAwayFromPolynomialZeros K L R) ≤ + Nat.card A := + Nat.card_le_card_of_injective center hcenter + have hbad := rationalFinitePlaceOverPolynomialZeros_card_le K L R + have hinfinity := rationalInfinityPlace_card_le_finrank K L + rw [finiteExtensionRationalPlaceCount, Nat.card_sum, + rationalFinitePlace_card_eq_away_add_overPolynomialZeros + (K := K) (L := L) R] + omega + +/-- A base polynomial that does not vanish at the rational base coordinate +of a rational finite extension place becomes a unit in that place's +valuation subring. -/ +theorem rationalFinitePlacePolynomial_isUnit_of_eval_baseCoordinate_ne_zero + (Q : FiniteExtensionRationalFinitePlace K L) (R : Polynomial K) + (hR : R.eval (rationalFinitePlaceBaseCoordinate K L Q) ≠ 0) : + let V := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L Q.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap (RatFuncFiniteIntegralClosure K L) V).comp + (algebraMap K[X] (RatFuncFiniteIntegralClosure K L))) + IsUnit (algebraMap K[X] V R) := by + let B := RatFuncFiniteIntegralClosure K L + let V := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L Q.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap (RatFuncFiniteIntegralClosure K L) V).comp + (algebraMap K[X] (RatFuncFiniteIntegralClosure K L))) + dsimp only + by_contra hunit + have hmax : algebraMap K[X] V R ∈ IsLocalRing.maximalIdeal V := by + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact hunit + have hqB : algebraMap K[X] B R ∈ Q.1.asIdeal := by + rw [← IsLocalization.AtPrime.under_maximalIdeal V Q.1.asIdeal] + exact hmax + have hbase : R ∈ + (IsDedekindDomain.HeightOneSpectrum.under K[X] Q.1).asIdeal := hqB + let P : RatFuncRationalFinitePlace K := + (rationalFinitePlaceToBaseFiber K L Q).1 + let a : K := ratFuncRationalFinitePlaceEquiv K P + have hP : P = (ratFuncRationalFinitePlaceEquiv K).symm a := by + exact (Equiv.symm_apply_apply (ratFuncRationalFinitePlaceEquiv K) P).symm + have hspan : R ∈ Ideal.span {Polynomial.X - Polynomial.C a} := by + change R ∈ P.1.asIdeal at hbase + rw [hP] at hbase + exact hbase + have heval : R.eval a = 0 := by + have hker : R ∈ RingHom.ker (Polynomial.evalRingHom a) := by + rw [Polynomial.ker_evalRingHom] + exact hspan + simpa [RingHom.mem_ker] using hker + exact hR heval + +/-- The residue of the rational-function parameter at a rational finite +extension place is its recorded base coordinate. -/ +theorem rationalFinitePlaceBaseCoordinate_residue + (Q : FiniteExtensionRationalFinitePlace K L) : + let B := RatFuncFiniteIntegralClosure K L + let V := HeightOneSpectrum.valuationSubringAtPrime L Q.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : Algebra K V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K B)) + letI : IsScalarTower K K[X] V := IsScalarTower.of_algebraMap_eq' rfl + let m := IsLocalRing.maximalIdeal V + algebraMap K m.ResidueField (rationalFinitePlaceBaseCoordinate K L Q) = + algebraMap V m.ResidueField (algebraMap K[X] V Polynomial.X) := by + let B := RatFuncFiniteIntegralClosure K L + let V := HeightOneSpectrum.valuationSubringAtPrime L Q.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : Algebra K V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K B)) + letI : IsScalarTower K K[X] V := IsScalarTower.of_algebraMap_eq' rfl + let m := IsLocalRing.maximalIdeal V + dsimp only + let P : RatFuncRationalFinitePlace K := + (rationalFinitePlaceToBaseFiber K L Q).1 + let a : K := ratFuncRationalFinitePlaceEquiv K P + have hP : P = (ratFuncRationalFinitePlaceEquiv K).symm a := by + exact (Equiv.symm_apply_apply (ratFuncRationalFinitePlaceEquiv K) P).symm + have hlinear : Polynomial.X - Polynomial.C a ∈ + (HeightOneSpectrum.under K[X] Q.1).asIdeal := by + change Polynomial.X - Polynomial.C a ∈ P.1.asIdeal + rw [hP] + exact Ideal.mem_span_singleton_self (Polynomial.X - Polynomial.C a) + have hB : algebraMap K[X] B (Polynomial.X - Polynomial.C a) ∈ + Q.1.asIdeal := hlinear + have hV : algebraMap B V + (algebraMap K[X] B (Polynomial.X - Polynomial.C a)) ∈ m := by + rw [← IsLocalization.AtPrime.under_maximalIdeal V Q.1.asIdeal] at hB + exact hB + have hzero : algebraMap V m.ResidueField + (algebraMap K[X] V (Polynomial.X - Polynomial.C a)) = 0 := by + apply Ideal.algebraMap_residueField_eq_zero.mpr + change algebraMap B V + (algebraMap K[X] B (Polynomial.X - Polynomial.C a)) ∈ m + exact hV + have ha : a = rationalFinitePlaceBaseCoordinate K L Q := rfl + rw [← ha] + have htower : ∀ c : K, algebraMap K V c = + algebraMap K[X] V (Polynomial.C c) := by + intro c + exact (IsScalarTower.algebraMap_apply K K[X] V c).symm + simp only [map_sub] at hzero + rw [← htower a, + ← IsScalarTower.algebraMap_apply K V m.ResidueField a] at hzero + exact (sub_eq_zero.mp hzero).symm + +end + + +noncomputable section + +open BGS.CorvajaZannier IsDedekindDomain Polynomial + + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] +variable {f : MvPolynomial (Fin 2) K} + +omit [Fintype K] in +/-- Away from the leading-coefficient zero locus, the second plane +coordinate is regular in the valuation subring of a rational finite place. +The proof makes the specialized leading coefficient a unit, obtains a monic +equation over the valuation ring, and uses its integral closedness. -/ +theorem planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : FiniteExtensionRationalFinitePlace K (PlaneCurveFunctionField f), + (secondCoordinateAffineExceptionalPolynomial f).eval + (rationalFinitePlaceBaseCoordinate K (PlaneCurveFunctionField f) Q) ≠ 0 → + planeCurveFunction f 1 ∈ + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) Q.1 := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra K[X] E := + RingHom.toAlgebra + ((algebraMap (RatFunc K) E).comp + (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let B := RatFuncFiniteIntegralClosure K E + letI : Module.Finite K[X] B := + Module.IsNoetherian.finite K[X] B + letI : Module.IsTorsionFree K[X] E := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E + letI : Module.IsTorsionFree K[X] B := + IsIntegralClosure.isTorsionFree K[X] E + letI : NoZeroSMulDivisors K[X] B := + { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B + letI : IsFractionRing B E := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] + (RatFunc K) E B + dsimp only + intro Q hgood + let V := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E Q.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : IsScalarTower K[X] V E := + IsScalarTower.of_algebraMap_eq' rfl + let F : K[X][X] := planeCurvePolynomialInSecondCoordinate f + let G : V[X] := F.map (algebraMap K[X] V) + have hlcEval : F.leadingCoeff.eval + (rationalFinitePlaceBaseCoordinate K E Q) ≠ 0 := by + change ((planeCurvePolynomialInSecondCoordinate f).leadingCoeff * + secondCoordinateCriticalResultant f).eval + (rationalFinitePlaceBaseCoordinate K E Q) ≠ 0 at hgood + rw [Polynomial.eval_mul] at hgood + exact (mul_ne_zero_iff.mp hgood).1 + have hlcUnit : IsUnit (algebraMap K[X] V F.leadingCoeff) := + rationalFinitePlacePolynomial_isUnit_of_eval_baseCoordinate_ne_zero + K E Q F.leadingCoeff hlcEval + have hGLeading : G.leadingCoeff = algebraMap K[X] V F.leadingCoeff := by + have hinjective : Function.Injective (algebraMap K[X] V) := by + intro p q hpq + apply FaithfulSMul.algebraMap_injective K[X] E + have hmap := congrArg (algebraMap V E) hpq + simpa only [IsScalarTower.algebraMap_apply K[X] V E] using hmap + exact Polynomial.leadingCoeff_map_of_injective hinjective F + have hGUnit : IsUnit G.leadingCoeff := by + rw [hGLeading] + exact hlcUnit + have hroot : Polynomial.aeval (planeCurveFunction f 1) G = 0 := by + have hroot0 := + aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero + hf hpartialSecond + dsimp only at hroot0 + rw [Polynomial.aeval_def] + change Polynomial.eval₂ (algebraMap V E) (planeCurveFunction f 1) + (F.map (algebraMap K[X] V)) = 0 + rw [Polynomial.eval₂_map, + ← IsScalarTower.algebraMap_eq K[X] V E] + rw [Polynomial.aeval_def, Polynomial.eval₂_map, + ← IsScalarTower.algebraMap_eq K[X] (RatFunc K) E] at hroot0 + exact hroot0 + let H : V[X] := hGUnit.unit⁻¹ • G + have hHMonic : H.Monic := + Polynomial.monic_of_isUnit_leadingCoeff_inv_smul hGUnit + have hHRoot : Polynomial.aeval (planeCurveFunction f 1) H = 0 := by + change Polynomial.aeval (planeCurveFunction f 1) + (hGUnit.unit⁻¹ • G) = 0 + rw [Units.smul_def, map_smul, hroot, smul_zero] + have hintegral : IsIntegral V (planeCurveFunction f 1) := + ⟨H, hHMonic, hHRoot⟩ + obtain ⟨y, hy⟩ := IsIntegrallyClosed.isIntegral_iff.mp hintegral + exact hy ▸ y.2 + +/-- The affine residue center of a rational finite normalization place away +from the leading-coefficient/discriminant locus. Both plane coordinates are +regular there, and the degree-one residue field identifies their residue +classes with unique constants in `K`. -/ +noncomputable def planeCurveGoodRationalFinitePlaceCenter + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f) → + AffinePlaneCurvePoint f := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra K[X] E := + RingHom.toAlgebra + ((algebraMap (RatFunc K) E).comp + (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let B := RatFuncFiniteIntegralClosure K E + letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + letI : Module.IsTorsionFree K[X] E := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E + letI : Module.IsTorsionFree K[X] B := + IsIntegralClosure.isTorsionFree K[X] E + letI : NoZeroSMulDivisors K[X] B := + { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B + letI : IsFractionRing B E := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] + (RatFunc K) E B + letI : Algebra K B := RingHom.toAlgebra + ((algebraMap K[X] B).comp (algebraMap K K[X])) + letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + have h := congrArg + (fun g : Polynomial K →+* E => g (Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) + letI : IsScalarTower K K[X] E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K K[X] (RatFunc K)] + rfl) + letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K K[X] E] + rfl) + dsimp only + intro Q + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K B)) + letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K B E] + rfl) + let m := IsLocalRing.maximalIdeal V + have hglobalResidue : Function.Surjective + (algebraMap K Q.1.1.asIdeal.ResidueField) := + finiteExtensionFinitePlace_constantResidue_surjective_of_degree_one + K E Q.1.1 Q.1.2 + have hresidue : Function.Surjective + (algebraMap K m.ResidueField) := + localizationAtPrime_constantResidue_surjective + (C := K) (R := B) (S := V) Q.1.1 hglobalResidue + let xv : V := algebraMap K[X] V Polynomial.X + have hxv : (xv : E) = planeCurveFunction f 0 := by + rw [show (xv : E) = algebraMap K[X] E Polynomial.X by + exact IsScalarTower.algebraMap_apply K[X] V E Polynomial.X] + have h := congrArg + (fun g : Polynomial K →+* E => g Polynomial.X) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + change ratFuncSpecialization (planeCurveFunction f 0) hx + (algebraMap K[X] (RatFunc K) Polynomial.X) = planeCurveFunction f 0 + simpa using h + have hymem : planeCurveFunction f 1 ∈ V := + planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero + hf hpartialSecond Q.1 Q.2 + let yv : V := ⟨planeCurveFunction f 1, hymem⟩ + let a : K := rationalFinitePlaceBaseCoordinate K E Q.1 + have ha : algebraMap K m.ResidueField a = + algebraMap V m.ResidueField xv := by + exact rationalFinitePlaceBaseCoordinate_residue K E Q.1 + let b : K := Classical.choose + (hresidue (algebraMap V m.ResidueField yv)) + have hb : algebraMap K m.ResidueField b = + algebraMap V m.ResidueField yv := Classical.choose_spec + (hresidue (algebraMap V m.ResidueField yv)) + let evalV : MvPolynomial (Fin 2) K →+* V := + MvPolynomial.eval₂Hom (algebraMap K V) ![xv, yv] + have hfV : evalV f = 0 := by + apply Subtype.ext + simp only [evalV, MvPolynomial.coe_eval₂Hom] + change algebraMap V E + (MvPolynomial.eval₂ (algebraMap K V) ![xv, yv] f) = 0 + rw [MvPolynomial.eval₂_comp_left, + ← IsScalarTower.algebraMap_eq K V E] + have hcoordinatesE : (algebraMap V E) ∘ ![xv, yv] = + ![(xv : E), (yv : E)] := by + funext i + fin_cases i <;> rfl + rw [hcoordinatesE, hxv] + change MvPolynomial.eval₂ (algebraMap K E) + ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [← hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f + let evalK : MvPolynomial (Fin 2) K →+* K := + MvPolynomial.eval₂Hom (RingHom.id K) ![a, b] + have hcomp : (algebraMap K m.ResidueField).comp evalK = + (algebraMap V m.ResidueField).comp evalV := by + apply MvPolynomial.ringHom_ext + · intro c + simp only [RingHom.comp_apply, evalK, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C] + exact (IsScalarTower.algebraMap_apply K V m.ResidueField c).symm + · intro i + fin_cases i + · simpa [evalK, evalV] using ha + · simpa [evalK, evalV] using hb + refine ⟨(a, b), ?_⟩ + change evalK f = 0 + apply (algebraMap K m.ResidueField).injective + rw [map_zero] + calc + algebraMap K m.ResidueField (evalK f) = + ((algebraMap K m.ResidueField).comp evalK) f := rfl + _ = ((algebraMap V m.ResidueField).comp evalV) f := by rw [hcomp] + _ = algebraMap V m.ResidueField (evalV f) := rfl + _ = 0 := by rw [hfV, map_zero] + +omit [Fintype K] in +/-- The first coordinate of the affine residue center is the base coordinate +of the rational finite place. -/ +theorem planeCurveGoodRationalFinitePlaceCenter_firstCoordinate + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f), + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q).1.1 = + rationalFinitePlaceBaseCoordinate K (PlaneCurveFunctionField f) Q.1 := by + classical + dsimp only + intro Q + rfl + +omit [Fintype K] in +/-- The second coordinate of the affine center represents the residue class +of the second plane coordinate in the local residue field. -/ +theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f), + let E := PlaneCurveFunctionField f + let B := RatFuncFiniteIntegralClosure K E + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : Algebra K B := RingHom.toAlgebra + ((algebraMap K[X] B).comp (algebraMap K K[X])) + letI : Algebra K V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K B)) + let m := IsLocalRing.maximalIdeal V + algebraMap K m.ResidueField + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q).1.2 = + algebraMap V m.ResidueField + (⟨planeCurveFunction f 1, + planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero + hf hpartialSecond Q.1 Q.2⟩ : V) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra K[X] E := RingHom.toAlgebra + ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let B := RatFuncFiniteIntegralClosure K E + letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + letI : Module.IsTorsionFree K[X] E := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E + letI : Module.IsTorsionFree K[X] B := + IsIntegralClosure.isTorsionFree K[X] E + letI : NoZeroSMulDivisors K[X] B := + { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B + letI : IsFractionRing B E := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B + letI : Algebra K B := RingHom.toAlgebra + ((algebraMap K[X] B).comp (algebraMap K K[X])) + letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + have h := congrArg + (fun g : Polynomial K →+* E => g (Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) + letI : IsScalarTower K K[X] E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K K[X] (RatFunc K)] + rfl) + letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K K[X] E] + rfl) + dsimp only + intro Q + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K B)) + letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K B E] + rfl) + let m := IsLocalRing.maximalIdeal V + have hglobalResidue : Function.Surjective + (algebraMap K Q.1.1.asIdeal.ResidueField) := + finiteExtensionFinitePlace_constantResidue_surjective_of_degree_one + K E Q.1.1 Q.1.2 + have hresidue : Function.Surjective (algebraMap K m.ResidueField) := + localizationAtPrime_constantResidue_surjective + (C := K) (R := B) (S := V) Q.1.1 hglobalResidue + let yv : V := ⟨planeCurveFunction f 1, + planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero + hf hpartialSecond Q.1 Q.2⟩ + change algebraMap K m.ResidueField + (Classical.choose (hresidue (algebraMap V m.ResidueField yv))) = + algebraMap V m.ResidueField yv + exact Classical.choose_spec + (hresidue (algebraMap V m.ResidueField yv)) + +omit [Fintype K] in +/-- A good rational finite place admits a coordinate-ring map into its +valuation ring. The map is the canonical inclusion in the function field, +and the inverse image of the local maximal ideal is exactly the maximal ideal +of its affine residue center. -/ +theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f), + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + ∃ φ : A →+* V, + (∀ r : A, ((φ r : V) : E) = algebraMap A E r) ∧ + Ideal.comap φ (IsLocalRing.maximalIdeal V) = + (affinePlaneCurvePointMaximalIdeal f + (planeCurveGoodRationalFinitePlaceCenter + hf hpartialSecond Q)).asIdeal := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra K[X] E := RingHom.toAlgebra + ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let B := RatFuncFiniteIntegralClosure K E + letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + letI : Module.IsTorsionFree K[X] E := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E + letI : Module.IsTorsionFree K[X] B := + IsIntegralClosure.isTorsionFree K[X] E + letI : NoZeroSMulDivisors K[X] B := + { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B + letI : IsFractionRing B E := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B + letI : Algebra K B := RingHom.toAlgebra + ((algebraMap K[X] B).comp (algebraMap K K[X])) + letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + have h := congrArg + (fun g : Polynomial K →+* E => g (Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) + letI : IsScalarTower K K[X] E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K K[X] (RatFunc K)] + rfl) + letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K K[X] E] + rfl) + dsimp only + intro Q + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra K[X] V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K[X] B)) + letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K V := RingHom.toAlgebra + ((algebraMap B V).comp (algebraMap K B)) + letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K B E] + rfl) + let m := IsLocalRing.maximalIdeal V + let xv : V := algebraMap K[X] V Polynomial.X + have hxv : (xv : E) = planeCurveFunction f 0 := by + rw [show (xv : E) = algebraMap K[X] E Polynomial.X by + exact IsScalarTower.algebraMap_apply K[X] V E Polynomial.X] + have h := congrArg + (fun g : Polynomial K →+* E => g Polynomial.X) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + change ratFuncSpecialization (planeCurveFunction f 0) hx + (algebraMap K[X] (RatFunc K) Polynomial.X) = planeCurveFunction f 0 + simpa using h + have hymem : planeCurveFunction f 1 ∈ V := + planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero + hf hpartialSecond Q.1 Q.2 + let yv : V := ⟨planeCurveFunction f 1, hymem⟩ + let evalV : MvPolynomial (Fin 2) K →+* V := + MvPolynomial.eval₂Hom (algebraMap K V) ![xv, yv] + have hfV : evalV f = 0 := by + apply Subtype.ext + simp only [evalV, MvPolynomial.coe_eval₂Hom] + change algebraMap V E + (MvPolynomial.eval₂ (algebraMap K V) ![xv, yv] f) = 0 + rw [MvPolynomial.eval₂_comp_left, + ← IsScalarTower.algebraMap_eq K V E] + have hcoordinatesE : (algebraMap V E) ∘ ![xv, yv] = + ![(xv : E), (yv : E)] := by + funext i + fin_cases i <;> rfl + rw [hcoordinatesE, hxv] + change MvPolynomial.eval₂ (algebraMap K E) + ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [← hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f + let φ : A →+* V := Ideal.Quotient.lift (Ideal.span {f}) evalV (by + intro g hg + obtain ⟨c, rfl⟩ := Ideal.mem_span_singleton.mp hg + rw [map_mul, hfV, zero_mul]) + have hφE : ∀ r : A, ((φ r : V) : E) = algebraMap A E r := by + intro r + suffices (algebraMap V E).comp φ = algebraMap A E by + exact DFunLike.congr_fun this r + apply Ideal.Quotient.ringHom_ext + apply MvPolynomial.ringHom_ext + · intro c + simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C] + change algebraMap V E (algebraMap K V c) = algebraMap K E c + exact (IsScalarTower.algebraMap_apply K V E c).symm + · intro i + simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_X] + fin_cases i + · change (xv : E) = planeCurveFunction f 0 + exact hxv + · change (yv : E) = planeCurveFunction f 1 + rfl + let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q + have hfirst : algebraMap K m.ResidueField z.1.1 = + algebraMap V m.ResidueField xv := by + rw [planeCurveGoodRationalFinitePlaceCenter_firstCoordinate + hf hpartialSecond Q] + exact rationalFinitePlaceBaseCoordinate_residue K E Q.1 + have hsecond : algebraMap K m.ResidueField z.1.2 = + algebraMap V m.ResidueField yv := by + exact planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue + hf hpartialSecond Q + have hrescomp : (algebraMap V m.ResidueField).comp φ = + (algebraMap K m.ResidueField).comp (planeCurvePointEval f z) := by + apply Ideal.Quotient.ringHom_ext + apply MvPolynomial.ringHom_ext + · intro c + simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C, + planeCurvePointEval, Ideal.Quotient.lift_mk] + exact (IsScalarTower.algebraMap_apply K V m.ResidueField c).symm + · intro i + fin_cases i + · simpa [φ, evalV, planeCurvePointEval, z] using hfirst.symm + · simpa [φ, evalV, planeCurvePointEval, z] using hsecond.symm + refine ⟨φ, hφE, ?_⟩ + apply Ideal.ext + intro r + change φ r ∈ m ↔ planeCurvePointEval f z r = 0 + rw [← Ideal.algebraMap_residueField_eq_zero] + have hr := DFunLike.congr_fun hrescomp r + simp only [RingHom.comp_apply] at hr + rw [hr] + constructor + · intro h + apply (algebraMap K m.ResidueField).injective + simpa using h + · intro h + simp [h] + + +omit [Fintype K] in +/-- Avoiding the derivative resultant forces the affine residue center to lie +in the partial-`Y` smooth locus. -/ +theorem planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f), + MvPolynomial.eval + ![(planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q).1.1, + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q).1.2] + (MvPolynomial.pderiv 1 f) ≠ 0 := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + intro Q hzero + let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q + have hresultant : (secondCoordinateCriticalResultant f).eval z.1.1 = 0 := + secondCoordinateCriticalResultant_eval_eq_zero_of_common_zero + hpartialSecond z.1.1 z.1.2 z.2 (by simpa [z] using hzero) + have hgood := Q.2 + change ((planeCurvePolynomialInSecondCoordinate f).leadingCoeff * + secondCoordinateCriticalResultant f).eval + (rationalFinitePlaceBaseCoordinate K (PlaneCurveFunctionField f) Q.1) ≠ 0 + at hgood + rw [Polynomial.eval_mul] at hgood + have hresultantBase : (secondCoordinateCriticalResultant f).eval + (rationalFinitePlaceBaseCoordinate K (PlaneCurveFunctionField f) Q.1) ≠ 0 := + (mul_ne_zero_iff.mp hgood).2 + apply hresultantBase + rw [← planeCurveGoodRationalFinitePlaceCenter_firstCoordinate + hf hpartialSecond Q] + exact hresultant + +/-- At a good rational finite place, the normalization valuation ring is +the unique valuation ring dominating its smooth affine residue center. -/ +theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f), + HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) Q.1.1 = + dominatingValuationSubring + (affinePlaneCurvePointMaximalIdeal f + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q)) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra K[X] E := RingHom.toAlgebra + ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let B := RatFuncFiniteIntegralClosure K E + letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + letI : Module.IsTorsionFree K[X] E := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E + letI : Module.IsTorsionFree K[X] B := + IsIntegralClosure.isTorsionFree K[X] E + letI : NoZeroSMulDivisors K[X] B := + { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B + letI : IsFractionRing B E := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B + dsimp only + intro Q + let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q + let m := affinePlaneCurvePointMaximalIdeal f z + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + let D := dominatingValuationSubring (A := A) (L := E) m + obtain ⟨φ, hφE, hcenter⟩ := + exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom + hf hpartialSecond Q + let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z + letI : Finite m.asIdeal.ResidueField := + Finite.of_injective eCenter eCenter.injective + let r0 : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 + have hr0mem : r0 ∈ m.asIdeal := + firstCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal z + have hr0mapEq : algebraMap A E r0 = + planeCurveFunction f 0 - algebraMap K E z.1.1 := by + simp only [r0, map_sub] + rfl + have hr0map : algebraMap A E r0 ≠ 0 := by + rw [hr0mapEq] + exact firstCoordinate_sub_affinePoint_ne_zero hf hpartialSecond z + have hr0 : r0 ≠ 0 := by + intro hzero + apply hr0map + rw [hzero, map_zero] + have hm0 : m.asIdeal ≠ ⊥ := by + intro hm + apply hr0 + simpa [hm] using hr0mem + have hsmooth : planeCurvePartialY f ∉ m.asIdeal := by + change planeCurvePointEval f z (planeCurvePartialY f) ≠ 0 + change MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.pderiv 1 f) ≠ 0 + exact planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero + hf hpartialSecond Q + letI : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := + planeCurveClosedPoint_localization_isDiscreteValuationRing + K hf m hm0 hsmooth + let Wsub : Subalgebra A E := + Localization.subalgebra.ofField E m.asIdeal.primeCompl + m.asIdeal.primeCompl_le_nonZeroDivisors + letI : IsDiscreteValuationRing Wsub := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing + (IsLocalization.algEquiv m.asIdeal.primeCompl + (Localization.AtPrime m.asIdeal) Wsub).toRingEquiv + let W : ValuationSubring E := + ValuationSubring.ofSubring Wsub.toSubring fun x => by + simpa [IsLocalization.IsInteger] using + ValuationRing.isInteger_or_isInteger Wsub x + letI : Algebra A W := Wsub.algebra' + letI : IsLocalization m.asIdeal.primeCompl W := + Localization.subalgebra.isLocalization_ofField E + m.asIdeal.primeCompl m.asIdeal.primeCompl_le_nonZeroDivisors + let eW : Wsub ≃+* W := + { toFun := fun x => ⟨x.1, x.2⟩ + invFun := fun x => ⟨x.1, x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + letI : IsDiscreteValuationRing W := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW + have hWV : W ≤ V := by + intro x hx + change x ∈ Wsub at hx + rcases hx with ⟨a, s, hs, rfl⟩ + have haV : algebraMap A E a ∈ V := by + rw [← hφE a] + exact (φ a).property + have hsV : algebraMap A E s ∈ V := by + rw [← hφE s] + exact (φ s).property + let sv : V := φ s + have hsvNot : sv ∉ IsLocalRing.maximalIdeal V := by + intro hsv + apply hs + rw [← hcenter] + exact hsv + have hsvUnit : IsUnit sv := by + by_contra hunit + apply hsvNot + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact hunit + have hinvV : (algebraMap A E s)⁻¹ ∈ V := by + have h := Submonoid.inv_mem_of_isUnit (S := V) hsvUnit + rwa [hφE s] at h + exact V.toSubring.mul_mem haV hinvV + have hV : V ≠ ⊤ := by + change HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 ≠ ⊤ + rw [HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + simp only [ne_eq, Valuation.valuationSubring_eq_top_iff, not_not] + infer_instance + have hWVeq : W = V := + ValuationSubring.eq_of_le_of_ne_top W hWV hV + have hWD : W ≤ D := by + intro x hx + change x ∈ Wsub at hx + rcases hx with ⟨a, s, hs, rfl⟩ + have haD : algebraMap A E a ∈ D := + range_le_dominatingValuationSubring m ⟨a, rfl⟩ + have hsD : algebraMap A E s ∈ D := + range_le_dominatingValuationSubring m ⟨s, rfl⟩ + let sd : D := ⟨algebraMap A E s, hsD⟩ + have hsdNot : sd ∉ IsLocalRing.maximalIdeal D := by + intro hsd + apply hs + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := E)] + exact hsd + have hsdUnit : IsUnit sd := by + by_contra hunit + apply hsdNot + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact hunit + have hinvD : (algebraMap A E s)⁻¹ ∈ D := + Submonoid.inv_mem_of_isUnit (S := D) hsdUnit + exact D.toSubring.mul_mem haD hinvD + have hrNonunits : algebraMap A E r0 ∈ D.nonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := E) m r0 hr0mem + have hD : D ≠ ⊤ := by + intro htop + have hnontrivial : D.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one D.valuation).2 + ⟨algebraMap A E r0, hr0map, hrNonunits⟩ + exact ((ValuationSubring.eq_top_iff D).mp htop) hnontrivial + have hWDeq : W = D := + ValuationSubring.eq_of_le_of_ne_top W hWD hD + exact hWVeq.symm.trans hWDeq + +/-- The residue-center map is injective on the good rational finite +places: smoothness makes the local DVR, hence the dominating valuation ring, +unique. -/ +theorem planeCurveGoodRationalFinitePlaceCenter_injective + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Function.Injective + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond) := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc K) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra K[X] E := RingHom.toAlgebra + ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + intro Q R hcenter + apply Subtype.ext + apply Subtype.ext + apply HeightOneSpectrum.eq_of_valuation_isEquiv_valuation (K := E) + rw [Valuation.isEquiv_iff_valuationSubring, + ← HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + ← HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + calc + HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 = + dominatingValuationSubring + (affinePlaneCurvePointMaximalIdeal f + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q)) := + planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating + hf hpartialSecond Q + _ = dominatingValuationSubring + (affinePlaneCurvePointMaximalIdeal f + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond R)) := by + rw [hcenter] + _ = HeightOneSpectrum.valuationSubringAtPrime E R.1.1 := + (planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating + hf hpartialSecond R).symm + +/-- Plane-curve specialization of the bad-fiber estimate. Rational finite +places over a base fiber where either the second-coordinate leading +coefficient vanishes or the second-coordinate derivative has a common root +are controlled only by the bidegree. -/ +theorem planeCurveExceptionalRationalFinitePlace_card_le + {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Nat.card (RationalFinitePlaceOverPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f)) ≤ + (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + calc + Nat.card (RationalFinitePlaceOverPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f)) ≤ + Fintype.card {a : K // + (secondCoordinateAffineExceptionalPolynomial f).eval a = 0} * + Module.finrank (RatFunc K) (PlaneCurveFunctionField f) := + rationalFinitePlaceOverPolynomialZeros_card_le K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f) + _ ≤ (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree := by + apply Nat.mul_le_mul + · exact secondCoordinateAffineExceptionalBase_card_le + hdegree hf hpartialSecond + · rw [finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond] + exact degreeOf_second_le_of_hasBidegreeAtMost hdegree + +/-- Conditional reverse affine-normalization comparison. Once the geometric +center construction is supplied as an injection from rational finite places +away from the leading-coefficient/discriminant locus, the total rational +place count is bounded by affine points, the exceptional finite fibers, and +the places at infinity. -/ +theorem finiteExtensionRationalPlaceCount_le_affine_add_exceptional_of_away_injective + {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ (center : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f) → + AffinePlaneCurvePoint f), + Function.Injective center → + finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) ≤ + Fintype.card (AffinePlaneCurvePoint f) + + (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree + secondDegree := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + intro center hcenter + have hgeneric := + finiteExtensionRationalPlaceCount_le_natCard_add_polynomialZeros_of_away_injective + (K := K) (L := PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f) + (AffinePlaneCurvePoint f) center hcenter + have hroots := secondCoordinateAffineExceptionalBase_card_le + hdegree hf hpartialSecond + have hrank : Module.finrank (RatFunc K) (PlaneCurveFunctionField f) ≤ + secondDegree := by + rw [finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second + hf hpartialSecond] + exact degreeOf_second_le_of_hasBidegreeAtMost hdegree + rw [Nat.card_eq_fintype_card] at hgeneric + nlinarith + +/-- Unconditional reverse affine-normalization comparison. Good rational +finite places inject into affine rational points, exceptional finite fibers +are controlled by the leading-coefficient/resultant polynomial, and infinity +contributes at most the second-coordinate degree. -/ +theorem finiteExtensionRationalPlaceCount_le_affine_add_exceptional + {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) ≤ + Fintype.card (AffinePlaneCurvePoint f) + + (firstDegree + (2 * secondDegree - 1) * firstDegree) * + secondDegree + secondDegree := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + dsimp only + exact finiteExtensionRationalPlaceCount_le_affine_add_exceptional_of_away_injective + hdegree hf hpartialSecond + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond) + (planeCurveGoodRationalFinitePlaceCenter_injective hf hpartialSecond) + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean new file mode 100644 index 0000000000..4bdafd794a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +import Mathlib.Tactic + +/-! +# Regular affine points in the second-coordinate direction + +The Stepanov argument is applied only at affine points where the second +partial derivative is nonzero. At those points the affine local ring agrees +with the normalization local ring, so the selected normalization place has +residue degree one. The complementary critical points are kept explicit and +are bounded by `affineSecondCoordinateCriticalPoints_card_le`. + +This file contains only the finite-set bookkeeping. The local normalization +statement and the Stepanov zero count are proved in separate modules. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] + +/-- Affine points where differentiation in the second coordinate is regular. -/ +abbrev AffineSecondCoordinateRegularPoint + (f : MvPolynomial (Fin 2) K) := + {z : AffinePlaneCurvePoint f // + MvPolynomial.eval ![z.1.1, z.1.2] (MvPolynomial.pderiv 1 f) ≠ 0} + +/-- The complement of the regular-point subtype is the finite critical locus. -/ +def affineSecondCoordinateNonregularEquivCritical + (f : MvPolynomial (Fin 2) K) : + {z : AffinePlaneCurvePoint f // + ¬ MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.pderiv 1 f) ≠ 0} ≃ + {z : K × K // z ∈ affineSecondCoordinateCriticalPoints K f} where + toFun z := ⟨z.1.1, by + rw [mem_affineSecondCoordinateCriticalPoints_iff] + exact ⟨z.1.2, not_ne_iff.mp z.2⟩⟩ + invFun z := ⟨⟨z.1, (mem_affineSecondCoordinateCriticalPoints_iff.mp z.2).1⟩, + not_ne_iff.mpr + (mem_affineSecondCoordinateCriticalPoints_iff.mp z.2).2⟩ + left_inv z := by + apply Subtype.ext + apply Subtype.ext + rfl + right_inv z := by + apply Subtype.ext + rfl + +/-- Every affine point is either regular in the second-coordinate direction +or belongs to the explicitly defined critical locus. -/ +theorem affinePlaneCurvePoint_card_eq_regular_add_critical + (f : MvPolynomial (Fin 2) K) : + Fintype.card (AffinePlaneCurvePoint f) = + Fintype.card (AffineSecondCoordinateRegularPoint f) + + (affineSecondCoordinateCriticalPoints K f).card := by + classical + let regular : AffinePlaneCurvePoint f → Prop := fun z => + MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.pderiv 1 f) ≠ 0 + have hcompl : + Fintype.card {z : AffinePlaneCurvePoint f // ¬ regular z} = + (affineSecondCoordinateCriticalPoints K f).card := by + calc + Fintype.card {z : AffinePlaneCurvePoint f // ¬ regular z} = + Fintype.card + {z : K × K // z ∈ affineSecondCoordinateCriticalPoints K f} := + Fintype.card_congr + (affineSecondCoordinateNonregularEquivCritical f) + _ = (affineSecondCoordinateCriticalPoints K f).card := by + exact Fintype.card_coe _ + have hregularLe : + Fintype.card {z : AffinePlaneCurvePoint f // regular z} ≤ + Fintype.card (AffinePlaneCurvePoint f) := + Fintype.card_subtype_le regular + have hpartition := Fintype.card_subtype_compl regular + change Fintype.card (AffinePlaneCurvePoint f) = + Fintype.card {z : AffinePlaneCurvePoint f // regular z} + + (affineSecondCoordinateCriticalPoints K f).card + rw [← hcompl, hpartition] + omega + +/-- Removing one chosen regular point lowers the regular-point cardinality by +exactly one. This is the form needed when that point supplies the unique +allowed pole of the Stepanov auxiliary. -/ +theorem regularPoint_card_eq_punctured_add_one + {f : MvPolynomial (Fin 2) K} + (z₀ : AffineSecondCoordinateRegularPoint f) : + Fintype.card (AffineSecondCoordinateRegularPoint f) = + Fintype.card {z : AffineSecondCoordinateRegularPoint f // z ≠ z₀} + 1 := by + classical + have h := Fintype.card_subtype_compl + (fun z : AffineSecondCoordinateRegularPoint f => z = z₀) + have hpositive : 0 < Fintype.card (AffineSecondCoordinateRegularPoint f) := + Fintype.card_pos_iff.mpr ⟨z₀⟩ + have hpunctured : + Fintype.card {z : AffineSecondCoordinateRegularPoint f // z ≠ z₀} = + Fintype.card (AffineSecondCoordinateRegularPoint f) - 1 := by + simpa only [Fintype.card_subtype_eq] using h + rw [hpunctured] + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean new file mode 100644 index 0000000000..8fe71a1a34 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean @@ -0,0 +1,323 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +import Mathlib.Tactic + +/-! +# A coarse affine singular-point bound for plane curves + +For a bivariate polynomial `f`, write it as a polynomial `F` in the second +coordinate with coefficients in the first-coordinate polynomial ring. We +eliminate the second coordinate from `F` and `F.derivative` by their ordinary +resultant, with the two degree parameters fixed before specialization. + +Fixing those parameters is essential: specializing the first coordinate can +lower the degree, so neither a default resultant whose parameters are chosen +after specialization nor a specialized discriminant is the correct object. +The fixed resultant nevertheless vanishes at the first coordinate of every +common zero of `f` and its second partial derivative. Irreducibility and a +nonzero second partial derivative make the resultant nonzero, and elementary +root and fiber counts then bound all affine singular points by +`((2 * secondDegree - 1) * firstDegree) * secondDegree`. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open Polynomial + +variable {K : Type*} [Field K] + +theorem planeCurvePolynomialInSecondCoordinate_derivative + (f : MvPolynomial (Fin 2) K) : + (BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate f).derivative = + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate + (MvPolynomial.pderiv 1 f) := by + rw [BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate_eq_bivariateEquiv, + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate_eq_bivariateEquiv] + apply (Polynomial.Bivariate.equivMvPolynomial K).injective + simpa using + (Polynomial.Bivariate.pderiv_one_equivMvPolynomial + ((Polynomial.Bivariate.equivMvPolynomial K).symm f)).symm + +/-- The first-coordinate eliminant of the equation and its derivative in the +second coordinate. -/ +noncomputable def secondCoordinateCriticalResultant + (f : MvPolynomial (Fin 2) K) : Polynomial K := + let F := BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate f + Polynomial.resultant F F.derivative F.natDegree F.derivative.natDegree + +theorem secondCoordinateCriticalResultant_natDegree_le + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) : + (secondCoordinateCriticalResultant f).natDegree ≤ + (2 * secondDegree - 1) * firstDegree := by + let F : Polynomial (Polynomial K) := + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate f + have hFDegree : F.natDegree ≤ secondDegree := by + simpa [F] using + (BGS.CorvajaZannier.degreeOf_second_le_of_hasBidegreeAtMost hdegree) + have hderivDegree : F.derivative.natDegree ≤ secondDegree - 1 := + (Polynomial.natDegree_derivative_le F).trans + (Nat.sub_le_sub_right hFDegree 1) + have hFcoeff : ∀ i, (F.coeff i).natDegree ≤ firstDegree := by + intro i + simpa [F] using + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate_coeff_natDegree_le + hdegree i + have hderivCoeff : ∀ i, (F.derivative.coeff i).natDegree ≤ firstDegree := by + intro i + rw [Polynomial.coeff_derivative] + calc + (F.coeff (i + 1) * (i + 1)).natDegree ≤ + (F.coeff (i + 1)).natDegree + + ((i + 1 : Polynomial K)).natDegree := + Polynomial.natDegree_mul_le + _ ≤ firstDegree + 0 := + Nat.add_le_add (hFcoeff (i + 1)) (by + simpa using + (Polynomial.natDegree_natCast (R := K) (i + 1)).le) + _ = firstDegree := Nat.add_zero _ + have hresultant := + BGS.CorvajaZannier.natDegree_resultant_le_of_degree_le + F F.derivative secondDegree (secondDegree - 1) + firstDegree firstDegree hFDegree hderivDegree hFcoeff hderivCoeff + change (Polynomial.resultant F F.derivative).natDegree ≤ _ + calc + (Polynomial.resultant F F.derivative).natDegree ≤ + secondDegree * firstDegree + + (secondDegree - 1) * firstDegree := hresultant + _ = (2 * secondDegree - 1) * firstDegree := by + rw [← Nat.add_mul] + congr 1 + omega + +theorem secondCoordinateCriticalResultant_eval_eq_zero_of_common_zero + {f : MvPolynomial (Fin 2) K} + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (x y : K) + (hfxy : MvPolynomial.eval ![x, y] f = 0) + (hderivxy : MvPolynomial.eval ![x, y] + (MvPolynomial.pderiv 1 f) = 0) : + (secondCoordinateCriticalResultant f).eval x = 0 := by + let F : Polynomial (Polynomial K) := + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate f + let ev : Polynomial K →+* K := Polynomial.evalRingHom x + have hFxy : (F.map ev).eval y = 0 := by + change (BGS.CorvajaZannier.secondCoordinateSpecialization f x).eval y = 0 + simpa using hfxy + have hderivFxy : (F.derivative.map ev).eval y = 0 := by + rw [show F.derivative = + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate + (MvPolynomial.pderiv 1 f) by + simpa [F] using planeCurvePolynomialInSecondCoordinate_derivative f] + change (BGS.CorvajaZannier.secondCoordinateSpecialization + (MvPolynomial.pderiv 1 f) x).eval y = 0 + simpa using hderivxy + have hFdegree : 0 < F.natDegree := by + simpa [F] using + BGS.CorvajaZannier.degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + have hspecialized : + Polynomial.resultant (F.map ev) (F.derivative.map ev) + F.natDegree F.derivative.natDegree = 0 := by + exact BGS.CorvajaZannier.resultant_eq_zero_of_common_root + (F.map ev) (F.derivative.map ev) F.natDegree F.derivative.natDegree + Polynomial.natDegree_map_le Polynomial.natDegree_map_le + (Or.inl hFdegree.ne') y hFxy hderivFxy + rw [Polynomial.resultant_map_map] at hspecialized + simpa [secondCoordinateCriticalResultant, F, ev] using hspecialized + +theorem secondCoordinateCriticalResultant_ne_zero + {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + secondCoordinateCriticalResultant f ≠ 0 := by + let F : Polynomial (Polynomial K) := + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate f + let ι : Polynomial K →+* RatFunc K := algebraMap (Polynomial K) (RatFunc K) + have hFderivative : F.derivative ≠ 0 := by + rw [show F.derivative = + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate + (MvPolynomial.pderiv 1 f) by + simpa [F] using planeCurvePolynomialInSecondCoordinate_derivative f] + intro hzero + apply hpartialSecond + apply BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate.injective + simpa using hzero + have hFmapIrreducible : Irreducible (F.map ι) := by + simpa [F, ι] using + BGS.CorvajaZannier.planeCurvePolynomialInSecondCoordinate_ratFunc_irreducible + hf hpartialSecond + have hFmapDerivative : (F.map ι).derivative ≠ 0 := by + simpa only [Polynomial.derivative_map] using + (by simpa only [Polynomial.map_zero] using + (Polynomial.map_injective ι + (IsFractionRing.injective (Polynomial K) (RatFunc K))).ne hFderivative) + have hseparable : (F.map ι).Separable := + (Polynomial.separable_iff_derivative_ne_zero hFmapIrreducible).2 + hFmapDerivative + have hmapResultantDefault : + Polynomial.resultant (F.map ι) (F.derivative.map ι) ≠ 0 := by + change IsCoprime (F.map ι) (F.map ι).derivative at hseparable + exact Polynomial.resultant_ne_zero _ _ (by + simpa only [Polynomial.derivative_map] using hseparable) + have hmapFdegree : (F.map ι).natDegree = F.natDegree := + by simpa [ι] using + (Polynomial.natDegree_map_eq_of_injective + (IsFractionRing.injective (Polynomial K) (RatFunc K)) F) + have hmapDdegree : (F.derivative.map ι).natDegree = F.derivative.natDegree := + by simpa [ι] using + (Polynomial.natDegree_map_eq_of_injective + (IsFractionRing.injective (Polynomial K) (RatFunc K)) F.derivative) + have hmapResultant : + Polynomial.resultant (F.map ι) (F.derivative.map ι) + F.natDegree F.derivative.natDegree ≠ 0 := by + simpa only [hmapFdegree, hmapDdegree] using hmapResultantDefault + intro hzero + apply hmapResultant + rw [Polynomial.resultant_map_map] + simpa [secondCoordinateCriticalResultant, F, ι] using congrArg ι hzero + +/-- Affine points where the curve equation and its second-coordinate +derivative vanish. This set contains every affine singular point. -/ +noncomputable def affineSecondCoordinateCriticalPoints + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) : Finset (K × K) := by + classical + exact Finset.univ.filter fun z => + MvPolynomial.eval ![z.1, z.2] f = 0 ∧ + MvPolynomial.eval ![z.1, z.2] (MvPolynomial.pderiv 1 f) = 0 + +@[simp] +theorem mem_affineSecondCoordinateCriticalPoints_iff + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {z : K × K} : + z ∈ affineSecondCoordinateCriticalPoints K f ↔ + MvPolynomial.eval ![z.1, z.2] f = 0 ∧ + MvPolynomial.eval ![z.1, z.2] (MvPolynomial.pderiv 1 f) = 0 := by + classical + simp [affineSecondCoordinateCriticalPoints] + +/-- Affine singular points: the equation and both coordinate partial +derivatives vanish. -/ +noncomputable def affinePlaneCurveSingularPoints + (K : Type*) [Field K] [Fintype K] [DecidableEq K] + (f : MvPolynomial (Fin 2) K) : Finset (K × K) := by + classical + exact Finset.univ.filter fun z => + MvPolynomial.eval ![z.1, z.2] f = 0 ∧ + MvPolynomial.eval ![z.1, z.2] (MvPolynomial.pderiv 0 f) = 0 ∧ + MvPolynomial.eval ![z.1, z.2] (MvPolynomial.pderiv 1 f) = 0 + +@[simp] +theorem mem_affinePlaneCurveSingularPoints_iff + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {z : K × K} : + z ∈ affinePlaneCurveSingularPoints K f ↔ + MvPolynomial.eval ![z.1, z.2] f = 0 ∧ + MvPolynomial.eval ![z.1, z.2] (MvPolynomial.pderiv 0 f) = 0 ∧ + MvPolynomial.eval ![z.1, z.2] (MvPolynomial.pderiv 1 f) = 0 := by + classical + simp [affinePlaneCurveSingularPoints] + +theorem polynomialEvalZeroSubtype_card_le_natDegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (P : Polynomial K) (hP : P ≠ 0) : + Fintype.card {x : K // P.eval x = 0} ≤ P.natDegree := by + classical + let rootEmbedding : {x : K // P.eval x = 0} ↪ P.roots.toFinset := + { toFun := fun x => ⟨x, by + rw [Multiset.mem_toFinset, Polynomial.mem_roots hP] + exact x.2⟩ + inj' := by + intro x y hxy + apply Subtype.ext + exact congrArg (fun z : P.roots.toFinset => (z : K)) hxy } + calc + Fintype.card {x : K // P.eval x = 0} ≤ P.roots.toFinset.card := by + simpa only [Fintype.card_coe] using + Fintype.card_le_of_injective rootEmbedding rootEmbedding.injective + _ ≤ P.roots.card := Multiset.toFinset_card_le _ + _ ≤ P.natDegree := Polynomial.card_roots' P + +theorem affineSecondCoordinateCriticalPoints_card_le + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + (affineSecondCoordinateCriticalPoints K f).card ≤ + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by + classical + let S := affineSecondCoordinateCriticalPoints K f + let R := secondCoordinateCriticalResultant f + let X := {x : K // R.eval x = 0} + let Y := fun x : X => + {y : K // + (BGS.CorvajaZannier.secondCoordinateSpecialization f x.1).eval y = 0} + let embedding : {z // z ∈ S} ↪ Sigma Y := + { toFun := fun z => + ⟨⟨z.1.1, by + have hz := mem_affineSecondCoordinateCriticalPoints_iff.mp z.2 + exact secondCoordinateCriticalResultant_eval_eq_zero_of_common_zero + hpartialSecond z.1.1 z.1.2 hz.1 hz.2⟩, + ⟨z.1.2, by + rw [BGS.CorvajaZannier.secondCoordinateSpecialization_eval] + exact (mem_affineSecondCoordinateCriticalPoints_iff.mp z.2).1⟩⟩ + inj' := by + intro z w hzw + apply Subtype.ext + apply Prod.ext + · exact congrArg (fun q : Sigma Y => (q.1 : K)) hzw + · exact congrArg (fun q : Sigma Y => (q.2.1 : K)) hzw } + have hsecond : 0 < MvPolynomial.degreeOf 1 f := + BGS.CorvajaZannier.degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond + have hFiber (x : X) : Fintype.card (Y x) ≤ secondDegree := by + exact (polynomialEvalZeroSubtype_card_le_natDegree + (BGS.CorvajaZannier.secondCoordinateSpecialization f x.1) + (BGS.CorvajaZannier.secondCoordinateSpecialization_ne_zero_of_irreducible + hf hsecond x.1)).trans + (BGS.CorvajaZannier.secondCoordinateSpecialization_natDegree_le + hdegree x.1) + have hRne : R ≠ 0 := by + simpa [R] using secondCoordinateCriticalResultant_ne_zero hf hpartialSecond + have hBase : Fintype.card X ≤ R.natDegree := by + exact polynomialEvalZeroSubtype_card_le_natDegree R hRne + have hRdegree : R.natDegree ≤ (2 * secondDegree - 1) * firstDegree := by + simpa [R] using secondCoordinateCriticalResultant_natDegree_le hdegree + calc + S.card = Fintype.card {z // z ∈ S} := by simp + _ ≤ Fintype.card (Sigma Y) := + Fintype.card_le_of_injective embedding embedding.injective + _ = ∑ x, Fintype.card (Y x) := Fintype.card_sigma + _ ≤ ∑ _x : X, secondDegree := by + exact Finset.sum_le_sum fun x _ => hFiber x + _ = Fintype.card X * secondDegree := by simp + _ ≤ R.natDegree * secondDegree := Nat.mul_le_mul_right _ hBase + _ ≤ ((2 * secondDegree - 1) * firstDegree) * secondDegree := + Nat.mul_le_mul_right _ hRdegree + +/-- A coarse bidegree bound for the number of affine singular points of an +irreducible separating plane curve. -/ +theorem affinePlaneCurveSingularPoints_card_le + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {f : MvPolynomial (Fin 2) K} {firstDegree secondDegree : ℕ} + (hdegree : BGS.External.HasBidegreeAtMost f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + (affinePlaneCurveSingularPoints K f).card ≤ + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by + apply (Finset.card_le_card ?_).trans + (affineSecondCoordinateCriticalPoints_card_le hdegree hf hpartialSecond) + intro z hz + rw [mem_affineSecondCoordinateCriticalPoints_iff] + have hz' := mem_affinePlaneCurveSingularPoints_iff.mp hz + exact ⟨hz'.1, hz'.2.2⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean new file mode 100644 index 0000000000..0c985e47c1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean @@ -0,0 +1,1125 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import Mathlib.RingTheory.DiscreteValuationRing.TFAE +import Mathlib.RingTheory.Smooth.StandardSmoothCotangent +import Mathlib.RingTheory.Localization.LocalizationLocalization +import Mathlib.LinearAlgebra.TensorProduct.Basis +import Mathlib.RingTheory.Etale.Field +import Mathlib.Tactic + +/-! +# Smooth affine centres and normalization residue fields + +For a closed affine centre coming from the quadratic constant-field +extension, its residue field embeds into that quadratic extension. Hence +every residue satisfies the square-Frobenius identity required by the +Stepanov vanishing argument. + +At a smooth centre, the local Jacobian criterion identifies the affine local +ring as a discrete valuation ring. Its valuation subring inside the function +field is therefore the selected dominating normalization valuation. Thus the +affine centre and its selected normalization prime have canonically equivalent +residue fields; in particular, the selected place has degree at most two and +satisfies square Frobenius. + +The file also records that nonvanishing of the second partial derivative at +a quadratic-extension point is exactly non-membership of that derivative in +the corresponding affine maximal ideal. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open Module +open scoped Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-! ## The smooth partial-`Y` chart -/ + +/-- The singleton relation family presenting the affine plane curve. -/ +def planeCurveRelationFamily (f : MvPolynomial (Fin 2) K) (_ : Unit) := f + +/-- The singleton-relation presentation is the usual plane-curve coordinate +ring. -/ +def planeCurvePresentationEquiv (f : MvPolynomial (Fin 2) K) : + (MvPolynomial (Fin 2) K ⧸ + Ideal.span (Set.range (planeCurveRelationFamily f))) ≃ₐ[K] + PlaneCurveCoordinateRing f := + Ideal.quotientEquivAlgOfEq K (by + congr 1 + ext g + simp [planeCurveRelationFamily, eq_comm]) + +/-- The plane curve as a one-equation pre-submersive presentation, with the +second coordinate chosen as the Jacobian direction. -/ +def planeCurveYPreSubmersivePresentation (f : MvPolynomial (Fin 2) K) : + Algebra.PreSubmersivePresentation K (PlaneCurveCoordinateRing f) (Fin 2) Unit := + (Algebra.PreSubmersivePresentation.naive + (v := planeCurveRelationFamily f) + (fun _ => 1) (fun _ _ _ => Subsingleton.elim _ _)).ofAlgEquiv + (planeCurvePresentationEquiv f) + +noncomputable instance planeCurveFinitePresentation (f : MvPolynomial (Fin 2) K) : + Algebra.FinitePresentation K (PlaneCurveCoordinateRing f) := + Algebra.Presentation.finitePresentation_of_isFinite + (planeCurveYPreSubmersivePresentation f).toPresentation + +/-- The class of the second partial derivative in the plane-curve coordinate +ring. -/ +def planeCurvePartialY (f : MvPolynomial (Fin 2) K) : + PlaneCurveCoordinateRing f := + planeCurveQuotientMap f (MvPolynomial.pderiv 1 f) + +/-- The Jacobian of the chosen one-equation presentation is the second +partial derivative. -/ +theorem planeCurveYPreSubmersivePresentation_jacobian + (f : MvPolynomial (Fin 2) K) : + (planeCurveYPreSubmersivePresentation f).jacobian = planeCurvePartialY f := by + let P := Algebra.PreSubmersivePresentation.naive + (v := planeCurveRelationFamily f) + (fun _ => 1) (fun _ _ _ => Subsingleton.elim _ _) + let E := planeCurvePresentationEquiv f + change (P.ofAlgEquiv E).jacobian = planeCurvePartialY f + rw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, + Algebra.PreSubmersivePresentation.jacobian_eq_jacobiMatrix_det, + Matrix.det_unique, Algebra.PreSubmersivePresentation.jacobiMatrix_naive] + change E (Ideal.Quotient.mk _ (MvPolynomial.pderiv 1 f)) = + Ideal.Quotient.mk _ (MvPolynomial.pderiv 1 f) + exact Ideal.quotientEquivAlgOfEq_mk K _ _ + +/-- The principal smooth chart on which the second partial derivative is +inverted. -/ +abbrev PlaneCurvePartialYLocalization (f : MvPolynomial (Fin 2) K) := + Localization.Away (planeCurvePartialY f) + +def planeCurvePartialYLocalizationPreSubmersivePresentation + (f : MvPolynomial (Fin 2) K) : + Algebra.PreSubmersivePresentation + (PlaneCurveCoordinateRing f) (PlaneCurvePartialYLocalization f) Unit Unit := + Algebra.PreSubmersivePresentation.localizationAway + (PlaneCurvePartialYLocalization f) (planeCurvePartialY f) + +def planeCurvePartialYCompositePresentation (f : MvPolynomial (Fin 2) K) : + Algebra.PreSubmersivePresentation K (PlaneCurvePartialYLocalization f) + (Unit ⊕ Fin 2) (Unit ⊕ Unit) := + (planeCurvePartialYLocalizationPreSubmersivePresentation f).comp + (planeCurveYPreSubmersivePresentation f) + +theorem planeCurvePartialYCompositePresentation_jacobian_isUnit + (f : MvPolynomial (Fin 2) K) : + IsUnit (planeCurvePartialYCompositePresentation f).jacobian := by + let A := PlaneCurveCoordinateRing f + let Ad := PlaneCurvePartialYLocalization f + let P₀ := planeCurveYPreSubmersivePresentation f + let Q := planeCurvePartialYLocalizationPreSubmersivePresentation f + have hP₀ : IsUnit (algebraMap A Ad P₀.jacobian) := by + rw [show P₀.jacobian = planeCurvePartialY f by + exact planeCurveYPreSubmersivePresentation_jacobian f] + exact IsLocalization.Away.algebraMap_isUnit + (S := Ad) (planeCurvePartialY f) + have hQ : IsUnit Q.jacobian := by + rw [show Q.jacobian = algebraMap A Ad (planeCurvePartialY f) by + exact Algebra.PreSubmersivePresentation.localizationAway_jacobian _] + exact IsLocalization.Away.algebraMap_isUnit + (S := Ad) (planeCurvePartialY f) + change IsUnit (Q.comp P₀).jacobian + rw [Algebra.PreSubmersivePresentation.comp_jacobian_eq_jacobian_smul_jacobian, + Algebra.smul_def] + exact hP₀.mul hQ + +/-- A submersive presentation of the partial-`Y` smooth chart. -/ +def planeCurvePartialYSubmersivePresentation (f : MvPolynomial (Fin 2) K) : + Algebra.SubmersivePresentation K (PlaneCurvePartialYLocalization f) + (Unit ⊕ Fin 2) (Unit ⊕ Unit) where + toPreSubmersivePresentation := planeCurvePartialYCompositePresentation f + jacobian_isUnit := planeCurvePartialYCompositePresentation_jacobian_isUnit f + +theorem planeCurvePartialYLocalization_isStandardSmooth + (f : MvPolynomial (Fin 2) K) : + Algebra.IsStandardSmooth K (PlaneCurvePartialYLocalization f) := + (planeCurvePartialYSubmersivePresentation f).isStandardSmooth + +theorem planeCurvePartialYSubmersivePresentation_dimension + (f : MvPolynomial (Fin 2) K) : + (planeCurvePartialYSubmersivePresentation f).dimension = 1 := by + simp [Algebra.Presentation.dimension] + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] +variable (p : ℕ) [Fact p.Prime] [CharP K p] + +omit [DecidableEq K] in +/-- The residue field of every closed affine centre obtained from the +quadratic constant-field extension satisfies square Frobenius. -/ +theorem squareExtensionClosedPoint_residue_squareFrobenius + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) : + ∀ z : m.1.asIdeal.ResidueField, + z ^ (Fintype.card K) ^ 2 = z := by + obtain ⟨w, hw⟩ := m.2 + let wf : SquareExtensionClosedPointFiber K p f m := + ⟨w, Subtype.ext hw⟩ + let ι := squareExtensionFiberResidueAlgHom K p f m wf + letI : Fintype (SquareExtension K p) := Fintype.ofFinite _ + have hcard : Fintype.card (SquareExtension K p) = + (Fintype.card K) ^ 2 := by + rw [Fintype.card_eq_nat_card, FiniteField.natCard_extension K p 2, + Nat.card_eq_fintype_card] + intro z + apply ι.injective + rw [map_pow, ← hcard, FiniteField.pow_card] + +omit [DecidableEq K] in +/-- The second partial derivative is nonzero at a quadratic-extension point +exactly in the direction needed for the local Jacobian criterion: its class +does not belong to the point's affine maximal ideal. -/ +theorem squareExtensionPoint_pderiv_not_mem_maximalIdeal + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) + (hregular : MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.map (algebraMap K (SquareExtension K p)) + (MvPolynomial.pderiv 1 f)) ≠ 0) : + planeCurveQuotientMap f (MvPolynomial.pderiv 1 f) ∉ + (squareExtensionPointMaximalIdeal K p f z).asIdeal := by + rw [squareExtensionPointMaximalIdeal_asIdeal, RingHom.mem_ker] + change MvPolynomial.eval₂ (algebraMap K (SquareExtension K p)) + ![z.1.1, z.1.2] (MvPolynomial.pderiv 1 f) ≠ 0 + rw [MvPolynomial.eval₂_eq_eval_map] + exact hregular + +/-! ## Smooth closed points are discrete valuation rings -/ + +omit [DecidableEq K] in +/-- A closed point on the partial-`Y` smooth locus is not the generic point. -/ +theorem squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (m : SquareExtensionClosedPoint K p f) + (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : + letI := planeCurveCoordinateRing_isDomain hf + m.1.asIdeal ≠ ⊥ := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let A := PlaneCurveCoordinateRing f + obtain ⟨z, hz⟩ := m.2 + let r : A := planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - + planeCurveCoordinate f 0 + have hr : r ∈ m.1.asIdeal := by + rw [← hz] + change planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - + planeCurveCoordinate f 0 ∈ + (squareExtensionPointMaximalIdeal K p f z).asIdeal + exact squareExtensionFrobeniusElement_mem_pointMaximalIdeal K p f z + intro hm + have hrzero : r = 0 := by simpa [hm] using hr + have hpartial : MvPolynomial.pderiv 1 f ≠ 0 := by + intro hzero + apply hsmooth + simp [planeCurvePartialY, hzero] + have hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartial) + let g : Polynomial K := + Polynomial.X ^ (Nat.card K) ^ 2 - Polynomial.X + have hg0 : g ≠ 0 := by + exact FiniteField.X_pow_card_pow_sub_X_ne_zero K (by omega) + Finite.one_lt_card + apply hg0 + apply (transcendental_iff.mp hx) g + simpa [g, r, planeCurveFunction] using congrArg + (algebraMap A (PlaneCurveFunctionField f)) hrzero + +omit [DecidableEq K] in +/-- A finite-residue closed point on the partial-`Y` smooth locus has a +discrete valuation local ring. -/ +theorem planeCurveClosedPoint_localization_isDiscreteValuationRing + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (m : MaximalSpectrum (PlaneCurveCoordinateRing f)) + [Finite m.asIdeal.ResidueField] + (hm0 : m.asIdeal ≠ ⊥) + (hsmooth : planeCurvePartialY f ∉ m.asIdeal) : + letI := planeCurveCoordinateRing_isDomain hf + IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let A := PlaneCurveCoordinateRing f + let d : A := planeCurvePartialY f + let Ad := PlaneCurvePartialYLocalization f + have hd0 : d ≠ 0 := by + intro hd + apply hsmooth + change d ∈ m.asIdeal + rw [hd] + exact m.asIdeal.zero_mem + letI : IsDomain Ad := IsLocalization.Away.isDomain Ad hd0 + have hdisj : Disjoint ((Submonoid.powers d : Submonoid A) : Set A) + (m.asIdeal : Set A) := by + rw [Ideal.disjoint_powers_iff_notMem_of_isPrime] + exact hsmooth + let q : Ideal Ad := Ideal.map (algebraMap A Ad) m.asIdeal + letI hqPrime : q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint + (Submonoid.powers d) Ad m.asIdeal m.isMaximal.isPrime hdisj + have hunder : q.comap (algebraMap A Ad) = m.asIdeal := by + exact IsLocalization.under_map_of_isPrime_disjoint + (Submonoid.powers d) Ad m.isMaximal.isPrime hdisj + letI hunderMax : (q.comap (algebraMap A Ad)).IsMaximal := by + rw [hunder] + exact m.isMaximal + letI hqMax : q.IsMaximal := by + exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) + let S := Localization.AtPrime q + letI : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q + letI : IsDomain S := IsLocalization.isDomain_of_atPrime S q + letI : Algebra A S := inferInstance + letI : IsScalarTower A Ad S := inferInstance + letI hSatPrime : IsLocalization.AtPrime S m.asIdeal := by + have hlocal : IsLocalization.AtPrime S + (q.comap (algebraMap A Ad)) := + IsLocalization.isLocalization_isLocalization_atPrime_isLocalization + (Submonoid.powers d) S q + refine ⟨?_⟩ + simpa only [hunder] using hlocal.toIsLocalizationMap + letI : Algebra K S := inferInstance + letI : IsScalarTower K A S := inferInstance + letI : IsScalarTower K Ad S := inferInstance + letI : Algebra.IsStandardSmooth K Ad := + planeCurvePartialYLocalization_isStandardSmooth f + letI : Algebra.FormallySmooth K Ad := inferInstance + letI : Algebra.FormallySmooth Ad S := + Algebra.FormallySmooth.of_isLocalization q.primeCompl + letI : Algebra.FormallySmooth K S := + Algebra.FormallySmooth.comp K Ad S + + let P := planeCurvePartialYSubmersivePresentation f + let I := ((Set.range P.map)ᶜ : Set (Unit ⊕ Fin 2)) + let bAd : Basis I Ad Ω[Ad⁄K] := P.basisKaehler + let bS : Basis I S Ω[S⁄K] := + bAd.ofIsLocalizedModule S q.primeCompl + (KaehlerDifferential.map K K Ad S) + let k := IsLocalRing.ResidueField S + let bk : Basis I k (TensorProduct S k (KaehlerDifferential K S)) := + bS.baseChange k + have hcardI : Fintype.card I = P.dimension := by + simp only [I, Fintype.card_compl_set, Algebra.Presentation.dimension, + Nat.card_eq_fintype_card, Set.card_range_of_injective P.map_inj] + have htarget : Module.finrank k + (TensorProduct S k (KaehlerDifferential K S)) = 1 := by + rw [Module.finrank_eq_card_basis bk, hcardI] + exact planeCurvePartialYSubmersivePresentation_dimension f + + let eResidue := atPrimeResidueAlgEquiv K A S m.asIdeal + letI : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective + letI : Algebra.IsSeparable K k := inferInstance + letI : Algebra.FormallyEtale K k := + Algebra.FormallyEtale.of_isSeparable K k + have hraw : Function.Injective + (KaehlerDifferential.kerCotangentToTensor K S k) := by + exact (Algebra.FormallySmooth.kerCotangentToTensor_injective_iff + (R := K) (P := S) (A := k) IsLocalRing.residue_surjective).2 inferInstance + have hker : RingHom.ker (algebraMap S k) = + IsLocalRing.maximalIdeal S := by + simpa [k, IsLocalRing.ResidueField.algebraMap_eq] using + (IsLocalRing.ker_residue (R := S)) + let cotangentEquiv : IsLocalRing.CotangentSpace S ≃ₗ[S] + (RingHom.ker (algebraMap S k)).Cotangent := + Ideal.Cotangent.equivOfEq _ _ hker.symm + let cotangentMapS : IsLocalRing.CotangentSpace S →ₗ[S] + (TensorProduct S k (KaehlerDifferential K S)) := + (KaehlerDifferential.kerCotangentToTensor K S k).comp + cotangentEquiv.toLinearMap + let cotangentMap : IsLocalRing.CotangentSpace S →ₗ[k] + (TensorProduct S k (KaehlerDifferential K S)) := + cotangentMapS.extendScalarsOfSurjective IsLocalRing.residue_surjective + have hcotangentMap : Function.Injective cotangentMap := by + intro x y hxy + apply cotangentEquiv.injective + apply hraw + exact hxy + have hcotangent : Module.finrank k (IsLocalRing.CotangentSpace S) ≤ 1 := by + rw [← htarget] + exact cotangentMap.finrank_le_finrank_of_injective hcotangentMap + + have hnotField : ¬ IsField S := + IsLocalization.AtPrime.not_isField A hm0 S + have hprincipal : (IsLocalRing.maximalIdeal S).IsPrincipal := + IsLocalRing.finrank_cotangentSpace_le_one_iff.mp hcotangent + have hSDvr : IsDiscreteValuationRing S := + ((IsDiscreteValuationRing.TFAE S hnotField).out 4 0).mp hprincipal + letI : IsDiscreteValuationRing S := hSDvr + exact IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing + (IsLocalization.algEquiv m.asIdeal.primeCompl S + (Localization.AtPrime m.asIdeal)).toRingEquiv + +omit [DecidableEq K] in +/-- The local ring at a closed point where the second partial derivative does +not vanish is a discrete valuation ring. This is the local Jacobian boundary +needed to compare the affine curve with its normalization. -/ +theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (m : SquareExtensionClosedPoint K p f) + (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : + letI := planeCurveCoordinateRing_isDomain hf + IsDiscreteValuationRing (Localization.AtPrime m.1.asIdeal) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let A := PlaneCurveCoordinateRing f + let d : A := planeCurvePartialY f + let Ad := PlaneCurvePartialYLocalization f + have hd0 : d ≠ 0 := by + intro hd + apply hsmooth + change d ∈ m.1.asIdeal + rw [hd] + exact m.1.asIdeal.zero_mem + letI : IsDomain Ad := IsLocalization.Away.isDomain Ad hd0 + have hdisj : Disjoint ((Submonoid.powers d : Submonoid A) : Set A) + (m.1.asIdeal : Set A) := by + rw [Ideal.disjoint_powers_iff_notMem_of_isPrime] + exact hsmooth + let q : Ideal Ad := Ideal.map (algebraMap A Ad) m.1.asIdeal + letI hqPrime : q.IsPrime := + IsLocalization.isPrime_of_isPrime_disjoint + (Submonoid.powers d) Ad m.1.asIdeal m.1.isMaximal.isPrime hdisj + have hunder : q.comap (algebraMap A Ad) = m.1.asIdeal := by + exact IsLocalization.under_map_of_isPrime_disjoint + (Submonoid.powers d) Ad m.1.isMaximal.isPrime hdisj + letI hunderMax : (q.comap (algebraMap A Ad)).IsMaximal := by + rw [hunder] + exact m.1.isMaximal + letI hqMax : q.IsMaximal := by + exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) + let S := Localization.AtPrime q + letI : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q + letI : IsDomain S := IsLocalization.isDomain_of_atPrime S q + letI : Algebra A S := inferInstance + letI : IsScalarTower A Ad S := inferInstance + letI hSatPrime : IsLocalization.AtPrime S m.1.asIdeal := by + have hlocal : IsLocalization.AtPrime S + (q.comap (algebraMap A Ad)) := + IsLocalization.isLocalization_isLocalization_atPrime_isLocalization + (Submonoid.powers d) S q + refine ⟨?_⟩ + simpa only [hunder] using hlocal.toIsLocalizationMap + letI : Algebra K S := inferInstance + letI : IsScalarTower K A S := inferInstance + letI : IsScalarTower K Ad S := inferInstance + letI : Algebra.IsStandardSmooth K Ad := + planeCurvePartialYLocalization_isStandardSmooth f + letI : Algebra.FormallySmooth K Ad := inferInstance + letI : Algebra.FormallySmooth Ad S := + Algebra.FormallySmooth.of_isLocalization q.primeCompl + letI : Algebra.FormallySmooth K S := + Algebra.FormallySmooth.comp K Ad S + + let P := planeCurvePartialYSubmersivePresentation f + let I := ((Set.range P.map)ᶜ : Set (Unit ⊕ Fin 2)) + let bAd : Basis I Ad Ω[Ad⁄K] := P.basisKaehler + let bS : Basis I S Ω[S⁄K] := + bAd.ofIsLocalizedModule S q.primeCompl + (KaehlerDifferential.map K K Ad S) + let k := IsLocalRing.ResidueField S + let bk : Basis I k (TensorProduct S k (KaehlerDifferential K S)) := + bS.baseChange k + have hcardI : Fintype.card I = P.dimension := by + simp only [I, Fintype.card_compl_set, Algebra.Presentation.dimension, + Nat.card_eq_fintype_card, Set.card_range_of_injective P.map_inj] + have htarget : Module.finrank k + (TensorProduct S k (KaehlerDifferential K S)) = 1 := by + rw [Module.finrank_eq_card_basis bk, hcardI] + exact planeCurvePartialYSubmersivePresentation_dimension f + + obtain ⟨z, hz⟩ := m.2 + let zf : SquareExtensionClosedPointFiber K p f m := + ⟨z, Subtype.ext hz⟩ + let ι := squareExtensionFiberResidueAlgHom K p f m zf + letI : Finite m.1.asIdeal.ResidueField := Finite.of_injective ι ι.injective + let eResidue := atPrimeResidueAlgEquiv K A S m.1.asIdeal + letI : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective + letI : Algebra.IsSeparable K k := inferInstance + letI : Algebra.FormallyEtale K k := + Algebra.FormallyEtale.of_isSeparable K k + have hraw : Function.Injective + (KaehlerDifferential.kerCotangentToTensor K S k) := by + exact (Algebra.FormallySmooth.kerCotangentToTensor_injective_iff + (R := K) (P := S) (A := k) IsLocalRing.residue_surjective).2 inferInstance + have hker : RingHom.ker (algebraMap S k) = + IsLocalRing.maximalIdeal S := by + simpa [k, IsLocalRing.ResidueField.algebraMap_eq] using + (IsLocalRing.ker_residue (R := S)) + let cotangentEquiv : IsLocalRing.CotangentSpace S ≃ₗ[S] + (RingHom.ker (algebraMap S k)).Cotangent := + Ideal.Cotangent.equivOfEq _ _ hker.symm + let cotangentMapS : IsLocalRing.CotangentSpace S →ₗ[S] + (TensorProduct S k (KaehlerDifferential K S)) := + (KaehlerDifferential.kerCotangentToTensor K S k).comp + cotangentEquiv.toLinearMap + let cotangentMap : IsLocalRing.CotangentSpace S →ₗ[k] + (TensorProduct S k (KaehlerDifferential K S)) := + cotangentMapS.extendScalarsOfSurjective IsLocalRing.residue_surjective + have hcotangentMap : Function.Injective cotangentMap := by + intro x y hxy + apply cotangentEquiv.injective + apply hraw + exact hxy + have hcotangent : Module.finrank k (IsLocalRing.CotangentSpace S) ≤ 1 := by + rw [← htarget] + exact cotangentMap.finrank_le_finrank_of_injective hcotangentMap + + have hm0 : m.1.asIdeal ≠ ⊥ := + squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY + K p hf m hsmooth + have hnotField : ¬ IsField S := + IsLocalization.AtPrime.not_isField A hm0 S + have hprincipal : (IsLocalRing.maximalIdeal S).IsPrincipal := + IsLocalRing.finrank_cotangentSpace_le_one_iff.mp hcotangent + have hSDvr : IsDiscreteValuationRing S := + ((IsDiscreteValuationRing.TFAE S hnotField).out 4 0).mp hprincipal + letI : IsDiscreteValuationRing S := hSDvr + exact IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing + (IsLocalization.algEquiv m.1.asIdeal.primeCompl S + (Localization.AtPrime m.1.asIdeal)).toRingEquiv + +section CommonLocalization + +variable {C A B R : Type*} + [Field C] [CommRing A] [CommRing B] [CommRing R] + [Algebra C A] [Algebra C B] [Algebra A R] [Algebra B R] [Algebra C R] + [IsScalarTower C A R] [IsScalarTower C B R] [IsLocalRing R] + (m : Ideal A) [m.IsMaximal] (q : Ideal B) [q.IsMaximal] + [IsLocalization.AtPrime R m] [IsLocalization.AtPrime R q] + +/-- If two maximal ideals have the same local ring, their residue fields are +canonically equivalent over the common coefficient field. -/ +noncomputable def atPrimeResidueAlgEquivOfCommonLocalization : + m.ResidueField ≃ₐ[C] q.ResidueField := + (atPrimeResidueAlgEquiv C A R m).trans + (atPrimeResidueAlgEquiv C B R q).symm + +include R in +/-- Residue-field degree is preserved across a common localization. -/ +theorem finrank_residueField_eq_of_commonLocalization : + Module.finrank C m.ResidueField = Module.finrank C q.ResidueField := + (atPrimeResidueAlgEquivOfCommonLocalization + (C := C) (A := A) (B := B) (R := R) m q).toLinearEquiv.finrank_eq + +end CommonLocalization + +section SquareExtensionCommonLocalization + +variable {f : MvPolynomial (Fin 2) K} +variable {B R : Type*} [CommRing B] [CommRing R] + [Algebra K B] + [Algebra (PlaneCurveCoordinateRing f) R] [Algebra B R] [Algebra K R] + [IsScalarTower K (PlaneCurveCoordinateRing f) R] + [IsScalarTower K B R] [IsLocalRing R] + (m : SquareExtensionClosedPoint K p f) + (q : Ideal B) [q.IsMaximal] + [IsLocalization.AtPrime R m.1.asIdeal] + [IsLocalization.AtPrime R q] + +omit [DecidableEq K] in +include f R m in +/-- A normalization prime sharing its local ring with a +quadratic-extension affine centre has residue degree at most two. -/ +theorem squareExtensionClosedPoint_commonLocalization_residue_finrank_le_two : + Module.finrank K q.ResidueField ≤ 2 := by + rw [← finrank_residueField_eq_of_commonLocalization + (C := K) (A := PlaneCurveCoordinateRing f) (B := B) (R := R) + m.1.asIdeal q] + exact squareExtensionClosedPoint_residueDegree_le_two K p f m + +omit [DecidableEq K] in +include f R m in +/-- A normalization local ring that is also the affine local ring at a +quadratic-extension centre has the square-Frobenius residue identity needed +by Stepanov's method. -/ +theorem squareExtensionClosedPoint_commonLocalization_residue_squareFrobenius : + ∀ z : q.ResidueField, z ^ (Fintype.card K) ^ 2 = z := by + let e := atPrimeResidueAlgEquivOfCommonLocalization + (C := K) (A := PlaneCurveCoordinateRing f) (B := B) (R := R) + m.1.asIdeal q + intro z + apply e.symm.injective + simpa using + (squareExtensionClosedPoint_residue_squareFrobenius K p f m (e.symm z)) + +end SquareExtensionCommonLocalization + +/-! ## The selected normalization place at a smooth centre -/ + +/-- At a partial-`Y` smooth centre, normalization preserves the residue field: +the degree of the selected normalization place is exactly the residue degree +of its affine centre. -/ +theorem squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_eq_residueDegree_of_partialY + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) + (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) + (.inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m)) = + Module.finrank K m.1.asIdeal.ResidueField := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + let q : FiniteExtensionFinitePlace K E := + squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m + let B := RatFuncFiniteIntegralClosure K E + letI : Algebra K B := + RingHom.toAlgebra + ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) + letI : IsScalarTower K (Polynomial K) B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + have h := congrArg + (fun g : Polynomial K →+* E => g (Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) + letI : IsScalarTower K (Polynomial K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] + rfl) + letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] + rfl) + let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q + letI : Algebra K R := + RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) + letI : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl + + let Wsub : Subalgebra A E := + Localization.subalgebra.ofField E m.1.asIdeal.primeCompl + m.1.asIdeal.primeCompl_le_nonZeroDivisors + letI : IsDiscreteValuationRing (Localization.AtPrime m.1.asIdeal) := + squareExtensionClosedPoint_localization_isDiscreteValuationRing + K p hf m hsmooth + letI : IsDiscreteValuationRing Wsub := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing + (IsLocalization.algEquiv m.1.asIdeal.primeCompl + (Localization.AtPrime m.1.asIdeal) Wsub).toRingEquiv + let W : ValuationSubring E := + ValuationSubring.ofSubring Wsub.toSubring fun x => by + simpa [IsLocalization.IsInteger] using + ValuationRing.isInteger_or_isInteger Wsub x + letI : Algebra A W := Wsub.algebra' + letI : IsLocalization m.1.asIdeal.primeCompl W := + Localization.subalgebra.isLocalization_ofField E + m.1.asIdeal.primeCompl m.1.asIdeal.primeCompl_le_nonZeroDivisors + let eW : Wsub ≃+* W := + { toFun := fun x => ⟨x.1, x.2⟩ + invFun := fun x => ⟨x.1, x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + letI : IsDiscreteValuationRing W := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW + let V := dominatingValuationSubring (A := A) (L := E) m.1 + have hWV : W ≤ V := by + intro x hx + change x ∈ Wsub at hx + rcases hx with ⟨a, s, hs, rfl⟩ + have haV : algebraMap A E a ∈ V := + range_le_dominatingValuationSubring m.1 ⟨a, rfl⟩ + have hsV : algebraMap A E s ∈ V := + range_le_dominatingValuationSubring m.1 ⟨s, rfl⟩ + let sv : V := ⟨algebraMap A E s, hsV⟩ + have hsvNot : sv ∉ IsLocalRing.maximalIdeal V := by + intro hsv + apply hs + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := E)] + exact hsv + have hsvUnit : IsUnit sv := by + by_contra hunit + apply hsvNot + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact hunit + have hinvV : (algebraMap A E s)⁻¹ ∈ V := + Submonoid.inv_mem_of_isUnit (S := V) hsvUnit + exact V.toSubring.mul_mem haV hinvV + have hm0 : m.1.asIdeal ≠ ⊥ := + squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY + K p hf m hsmooth + rw [Submodule.ne_bot_iff] at hm0 + obtain ⟨r, hr, hr0⟩ := hm0 + have hrMap0 : algebraMap A E r ≠ 0 := by + intro hzero + apply hr0 + apply IsFractionRing.injective A E + simpa using hzero + have hrNonunits : algebraMap A E r ∈ V.nonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := E) m.1 r hr + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨algebraMap A E r, hrMap0, hrNonunits⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hWVeq : W = V := + ValuationSubring.eq_of_le_of_ne_top W hWV hV + have hspec : R = V := + squareExtensionClosedPointExhaustiveFinitePlace_spec + K p hf hpartialSecond m + have hWR : W = R := hWVeq.trans hspec.symm + let eWR : W ≃+* R := + { toFun := fun x => ⟨x.1, by rw [← hWR]; exact x.2⟩ + invFun := fun x => ⟨x.1, by rw [hWR]; exact x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + letI : Algebra A R := + RingHom.toAlgebra (eWR.toRingHom.comp (algebraMap A W)) + let eWRAlg : W ≃ₐ[A] R := + { eWR with commutes' := fun _ => rfl } + letI : IsLocalization m.1.asIdeal.primeCompl R := + IsLocalization.isLocalization_of_algEquiv + m.1.asIdeal.primeCompl eWRAlg + letI : IsScalarTower K A R := + IsScalarTower.of_algebraMap_eq (R := K) (S := A) (A := R) (fun c => by + apply Subtype.ext + change algebraMap B E (algebraMap K B c) = + algebraMap A E (algebraMap K A c) + rw [← IsScalarTower.algebraMap_apply K B E, + ← IsScalarTower.algebraMap_apply K A E]) + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q] + exact (finrank_residueField_eq_of_commonLocalization + (C := K) (A := A) (B := B) (R := R) m.1.asIdeal q.asIdeal).symm + +section FinitePlaceDegree + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] +variable [DecidableEq (RatFunc K)] + +local instance (priority := 10) planeSmoothPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance planeSmoothPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance planeSmoothFiniteConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra ((algebraMap K[X] + (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) + +local instance planeSmoothFiniteConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Any finite function-field place of constant-field degree at most two has +the square-Frobenius residue identity consumed by the Stepanov restriction +map. -/ +theorem finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_le_two + (q : FiniteExtensionFinitePlace K L) + (hdegree : finiteExtensionPlaceDegree K L (.inl q) ≤ 2) : + ∀ z : q.asIdeal.ResidueField, + z ^ (Fintype.card K) ^ 2 = z := by + have hdegree' : Module.finrank K q.asIdeal.ResidueField ≤ 2 := by + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q] at hdegree + exact hdegree + letI : Finite q.asIdeal.ResidueField := + finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q + letI : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ + letI : Module.Finite K q.asIdeal.ResidueField := by + rw [Module.finite_def] + exact ⟨Finset.univ, by simp⟩ + have hpositive : 0 < Module.finrank K q.asIdeal.ResidueField := Module.finrank_pos + have hcard : Fintype.card q.asIdeal.ResidueField = + (Fintype.card K) ^ Module.finrank K q.asIdeal.ResidueField := by + exact Module.card_eq_pow_finrank + intro z + have hdegreeCases : Module.finrank K q.asIdeal.ResidueField = 1 ∨ + Module.finrank K q.asIdeal.ResidueField = 2 := by omega + rcases hdegreeCases with hdegreeOne | hdegreeTwo + · have hz := FiniteField.pow_card_pow 2 z + simpa [hcard, hdegreeOne] using hz + · simpa [hcard, hdegreeTwo] using FiniteField.pow_card z + +end FinitePlaceDegree + +/-- A selected normalization place above a partial-`Y` smooth quadratic +closed point has constant-field degree at most two. -/ +theorem squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_le_two_of_partialY + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) + (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) + (.inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m)) ≤ 2 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + rw [squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_eq_residueDegree_of_partialY + K p hf hpartialSecond m hsmooth] + exact squareExtensionClosedPoint_residueDegree_le_two K p f m + +/-- The residue field of the selected normalization place above a +partial-`Y` smooth quadratic closed point satisfies square Frobenius. -/ +theorem squareExtensionClosedPointExhaustiveFinitePlace_residue_squareFrobenius_of_partialY + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) + (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ z : (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m).asIdeal.ResidueField, + z ^ (Fintype.card K) ^ 2 = z := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let q := squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m + apply finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_le_two + K (PlaneCurveFunctionField f) q + exact squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_le_two_of_partialY + K p hf hpartialSecond m hsmooth + +/-- Evaluation identifies the residue field at a rational affine point with +the ground field. -/ +noncomputable def affinePlaneCurvePoint_residueAlgEquiv + {f : MvPolynomial (Fin 2) K} (z : AffinePlaneCurvePoint f) : + (affinePlaneCurvePointMaximalIdeal f z).asIdeal.ResidueField ≃ₐ[K] K := by + let A := PlaneCurveCoordinateRing f + let m := affinePlaneCurvePointMaximalIdeal f z + let ev : A →ₐ[K] K := + { planeCurvePointEval f z with + commutes' := planeCurvePointEval_algebraMap f z } + let eQuot : (A ⧸ m.asIdeal) ≃ₐ[K] K := by + change (A ⧸ RingHom.ker ev.toRingHom) ≃ₐ[K] K + exact Ideal.quotientKerAlgEquivOfSurjective + (planeCurvePointEval_surjective f z) + let eResidue : (A ⧸ m.asIdeal) ≃ₐ[K] m.asIdeal.ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K (A ⧸ m.asIdeal) m.asIdeal.ResidueField) + m.asIdeal.bijective_algebraMap_quotient_residueField + exact eResidue.symm.trans eQuot + +/-- The normalization place selected above a rational affine point that is +regular in the second-coordinate direction has degree one over the full +constant field. -/ +theorem affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (z : AffinePlaneCurvePoint f) + (hregular : MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.pderiv 1 f) ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) + (.inl (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z)) = 1 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + let m := affinePlaneCurvePointMaximalIdeal f z + let q : FiniteExtensionFinitePlace K E := + affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond z + let B := RatFuncFiniteIntegralClosure K E + letI : Algebra K B := + RingHom.toAlgebra + ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) + letI : IsScalarTower K (Polynomial K) B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + have h := congrArg + (fun g : Polynomial K →+* E => g (Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) + letI : IsScalarTower K (Polynomial K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] + rfl) + letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] + rfl) + let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q + letI : Algebra K R := + RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) + letI : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl + + let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z + letI : Finite m.asIdeal.ResidueField := + Finite.of_injective eCenter eCenter.injective + let r0 : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 + have hr0mem : r0 ∈ m.asIdeal := + firstCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal z + have hr0mapEq : algebraMap A E r0 = + planeCurveFunction f 0 - algebraMap K E z.1.1 := by + simp only [r0, map_sub] + rfl + have hr0map : algebraMap A E r0 ≠ 0 := by + rw [hr0mapEq] + exact firstCoordinate_sub_affinePoint_ne_zero hf hpartialSecond z + have hr0 : r0 ≠ 0 := by + intro hzero + apply hr0map + rw [hzero, map_zero] + have hm0 : m.asIdeal ≠ ⊥ := by + intro hm + apply hr0 + simpa [hm] using hr0mem + have hsmooth : planeCurvePartialY f ∉ m.asIdeal := by + change planeCurvePointEval f z (planeCurvePartialY f) ≠ 0 + change MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.pderiv 1 f) ≠ 0 + exact hregular + letI : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := + planeCurveClosedPoint_localization_isDiscreteValuationRing + K hf m hm0 hsmooth + + let Wsub : Subalgebra A E := + Localization.subalgebra.ofField E m.asIdeal.primeCompl + m.asIdeal.primeCompl_le_nonZeroDivisors + letI : IsDiscreteValuationRing Wsub := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing + (IsLocalization.algEquiv m.asIdeal.primeCompl + (Localization.AtPrime m.asIdeal) Wsub).toRingEquiv + let W : ValuationSubring E := + ValuationSubring.ofSubring Wsub.toSubring fun x => by + simpa [IsLocalization.IsInteger] using + ValuationRing.isInteger_or_isInteger Wsub x + letI : Algebra A W := Wsub.algebra' + letI : IsLocalization m.asIdeal.primeCompl W := + Localization.subalgebra.isLocalization_ofField E + m.asIdeal.primeCompl m.asIdeal.primeCompl_le_nonZeroDivisors + let eW : Wsub ≃+* W := + { toFun := fun x => ⟨x.1, x.2⟩ + invFun := fun x => ⟨x.1, x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + letI : IsDiscreteValuationRing W := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW + let V := dominatingValuationSubring (A := A) (L := E) m + have hWV : W ≤ V := by + intro x hx + change x ∈ Wsub at hx + rcases hx with ⟨a, s, hs, rfl⟩ + have haV : algebraMap A E a ∈ V := + range_le_dominatingValuationSubring m ⟨a, rfl⟩ + have hsV : algebraMap A E s ∈ V := + range_le_dominatingValuationSubring m ⟨s, rfl⟩ + let sv : V := ⟨algebraMap A E s, hsV⟩ + have hsvNot : sv ∉ IsLocalRing.maximalIdeal V := by + intro hsv + apply hs + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := E)] + exact hsv + have hsvUnit : IsUnit sv := by + by_contra hunit + apply hsvNot + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact hunit + have hinvV : (algebraMap A E s)⁻¹ ∈ V := + Submonoid.inv_mem_of_isUnit (S := V) hsvUnit + exact V.toSubring.mul_mem haV hinvV + have hrNonunits : algebraMap A E r0 ∈ V.nonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := E) m r0 hr0mem + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨algebraMap A E r0, hr0map, hrNonunits⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hWVeq : W = V := + ValuationSubring.eq_of_le_of_ne_top W hWV hV + have hspec : R = V := + (affinePointExhaustiveFinitePlace_spec + hf hpartialFirst hpartialSecond z).1 + have hWR : W = R := hWVeq.trans hspec.symm + let eWR : W ≃+* R := + { toFun := fun x => ⟨x.1, by rw [← hWR]; exact x.2⟩ + invFun := fun x => ⟨x.1, by rw [hWR]; exact x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + letI : Algebra A R := + RingHom.toAlgebra (eWR.toRingHom.comp (algebraMap A W)) + let eWRAlg : W ≃ₐ[A] R := + { eWR with commutes' := fun _ => rfl } + letI : IsLocalization m.asIdeal.primeCompl R := + IsLocalization.isLocalization_of_algEquiv + m.asIdeal.primeCompl eWRAlg + letI : IsScalarTower K A R := + IsScalarTower.of_algebraMap_eq (R := K) (S := A) (A := R) (fun c => by + apply Subtype.ext + change algebraMap B E (algebraMap K B c) = + algebraMap A E (algebraMap K A c) + rw [← IsScalarTower.algebraMap_apply K B E, + ← IsScalarTower.algebraMap_apply K A E]) + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q] + calc + Module.finrank K q.asIdeal.ResidueField = + Module.finrank K m.asIdeal.ResidueField := + (finrank_residueField_eq_of_commonLocalization + (C := K) (A := A) (B := B) (R := R) m.asIdeal q.asIdeal).symm + _ = 1 := by + simpa using eCenter.toLinearEquiv.finrank_eq + +end +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean new file mode 100644 index 0000000000..37be95a9f8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean @@ -0,0 +1,274 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +import Mathlib.Tactic + +/-! +# A conditional square-field Stepanov bound for plane curves + +Let `S` be the full finite constant field and let `K` supply a half-Frobenius +scale, with `#S = (#K)^2`. For an irreducible plane curve with both +coordinate partials nonzero, exact constants and the standard large-field +condition produce a one-point Stepanov auxiliary at any degree-one selected +place. + +We choose the pole place above one affine point that is regular in the second +coordinate direction. Every other such point gives a distinct finite place +away from the pole. Assuming these selected regular-point places have degree +one, their residue fields satisfy the quadratic half-Frobenius identity, so +the generic square-field zero count applies. Adding back the pole point and +the explicit second-coordinate critical locus gives the affine point bound. + +The degree-one hypothesis is deliberately explicit. It is precisely the +normalization input that must later be discharged by the local smooth-point +theorem; no degree-one assertion is made for arbitrary singular points. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] + +/-- Conditional affine plane-curve upper bound from the square-field +Stepanov construction. + +The final summand is the actual finite critical locus, rather than its +bidegree upper bound. This keeps the geometric loss visible at the theorem +boundary. -/ +theorem planeCurve_affinePoint_card_le_of_regularPlace_degree_one + {f : MvPolynomial (Fin 2) S} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hlarge : + (planeCurveBidegreeGenusBudget f + 1) * + (planeCurveBidegreeGenusBudget f + 2) ≤ Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc S) (PlaneCurveFunctionField f)).comp + (algebraMap S (RatFunc S))) + letI : Algebra S (PlaneCurveFunctionField f) := constantAlg + letI : SMul S (PlaneCurveFunctionField f) := constantAlg.toSMul + letI : Module S (PlaneCurveFunctionField f) := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + algebraicClosure S (PlaneCurveFunctionField f) = ⊥ → + (∀ z : AffineSecondCoordinateRegularPoint f, + finiteExtensionPlaceDegree S (PlaneCurveFunctionField f) + (.inl (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z.1)) = 1) → + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card S + + (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + + (affineSecondCoordinateCriticalPoints S f).card := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc S) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc S) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + letI : Algebra S E := constantAlg + letI : SMul S E := constantAlg.toSMul + letI : Module S E := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro hconstants hregularDegree + let g := planeCurveBidegreeGenusBudget f + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM g s + have hs : 0 < s := Fintype.card_pos + have hbudget : ell + s * m + 1 = + Fintype.card S + (2 * g + 1) * s := by + calc + ell + s * m + 1 = (s - 1) + s * (s + 2 * g) + 1 := by + rfl + _ = s + s * (s + 2 * g) := by omega + _ = s ^ 2 + (2 * g + 1) * s := by ring + _ = Fintype.card S + (2 * g + 1) * s := by rw [hcard] + by_cases hregularCard : + Fintype.card (AffineSecondCoordinateRegularPoint f) = 0 + · rw [affinePlaneCurvePoint_card_eq_regular_add_critical f, + hregularCard] + omega + · have hregularNonempty : + Nonempty (AffineSecondCoordinateRegularPoint f) := + Fintype.card_pos_iff.mp (Nat.pos_of_ne_zero hregularCard) + let z0 : AffineSecondCoordinateRegularPoint f := + Classical.choice hregularNonempty + let q0 : FiniteExtensionFinitePlace S E := + affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z0.1 + let P : FiniteExtensionPlace S E := .inl q0 + have hdegreeP : finiteExtensionPlaceDegree S E P = 1 := by + simpa only [P, q0, E] using hregularDegree z0 + have hriemann : ∀ N, + N + 1 ≤ Module.finrank S + (finiteExtensionOnePointRiemannSpace S E P N) + g := by + intro N + have h := planeCurve_finitePlace_riemann_lower + (K := S) hf hpartialFirst hpartialSecond q0 N + simpa only [E, P, g, hdegreeP, Nat.mul_one] using h + obtain ⟨u, du, v, dv, c, hu, hv, _hc, hsecond, hfirst⟩ := + exists_squareField_onePointStepanovAuxiliary_of_degree_one + K S E P g hconstants hdegreeP hriemann hlarge + let point : + {z : AffineSecondCoordinateRegularPoint f // z ≠ z0} → + AffinePlaneCurvePoint f := fun z => z.1.1 + let place : + {z : AffineSecondCoordinateRegularPoint f // z ≠ z0} → + FiniteExtensionFinitePlace S E := fun z => + affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond (point z) + have hpointInjective : Function.Injective point := by + intro z w hzw + apply Subtype.ext + apply Subtype.ext + exact hzw + have hplaceInjective : Function.Injective place := by + exact (affinePointExhaustiveFinitePlace_injective + hf hpartialFirst hpartialSecond).comp hpointInjective + have haway : ∀ z, + (Sum.inl (place z) : FiniteExtensionPlace S E) ≠ P := by + intro z heq + apply z.2 + apply Subtype.ext + apply affinePointExhaustiveFinitePlace_injective + hf hpartialFirst hpartialSecond + exact Sum.inl.inj heq + have hplaceDegree : ∀ z, + finiteExtensionPlaceDegree S E (.inl (place z)) = 1 := by + intro z + simpa only [place, point, E] using hregularDegree z.1 + have hsquare : ∀ (z : + {z : AffineSecondCoordinateRegularPoint f // z ≠ z0}) + (a : (place z).asIdeal.ResidueField), + a ^ (Fintype.card K) ^ 2 = a := by + intro z + exact finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_one + K S E hcard (place z) (hplaceDegree z) + have hpunctured : + Fintype.card + {z : AffineSecondCoordinateRegularPoint f // z ≠ z0} ≤ + ell + s * m := by + exact Fintype.card_le_of_squareFieldStepanovAuxiliary + K S E P ell m u du v dv c hu hv hdegreeP place + hplaceInjective haway hsquare hsecond hfirst + have hregular := regularPoint_card_eq_punctured_add_one z0 + rw [affinePlaneCurvePoint_card_eq_regular_add_critical f, + hregular] + calc + Fintype.card + {z : AffineSecondCoordinateRegularPoint f // z ≠ z0} + + 1 + (affineSecondCoordinateCriticalPoints S f).card ≤ + (ell + s * m) + 1 + + (affineSecondCoordinateCriticalPoints S f).card := by omega + _ = Fintype.card S + (2 * g + 1) * s + + (affineSecondCoordinateCriticalPoints S f).card := by + rw [hbudget] + +/-- Bidegree specialization of +`planeCurve_affinePoint_card_le_of_regularPlace_degree_one`. + +Only the critical-locus summand is replaced by its explicit resultant bound; +the Stepanov error remains `(2 * genusBudget + 1) * #K`. -/ +theorem planeCurve_affinePoint_card_le_bidegree_of_regularPlace_degree_one + {f : MvPolynomial (Fin 2) S} {firstDegree secondDegree : Nat} + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hlarge : + (planeCurveBidegreeGenusBudget f + 1) * + (planeCurveBidegreeGenusBudget f + 2) ≤ Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc S) (PlaneCurveFunctionField f)).comp + (algebraMap S (RatFunc S))) + letI : Algebra S (PlaneCurveFunctionField f) := constantAlg + letI : SMul S (PlaneCurveFunctionField f) := constantAlg.toSMul + letI : Module S (PlaneCurveFunctionField f) := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + algebraicClosure S (PlaneCurveFunctionField f) = ⊥ → + (∀ z : AffineSecondCoordinateRegularPoint f, + finiteExtensionPlaceDegree S (PlaneCurveFunctionField f) + (.inl (affinePointExhaustiveFinitePlace + hf hpartialFirst hpartialSecond z.1)) = 1) → + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card S + + (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc S) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc S) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + letI : Algebra S E := constantAlg + letI : SMul S E := constantAlg.toSMul + letI : Module S E := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro hconstants hregularDegree + have hcount := planeCurve_affinePoint_card_le_of_regularPlace_degree_one + K S hf hpartialFirst hpartialSecond hcard hlarge + hconstants hregularDegree + have hcritical := affineSecondCoordinateCriticalPoints_card_le + hdegree hf hpartialSecond + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean new file mode 100644 index 0000000000..849d435236 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount +import Mathlib.Tactic + +/-! +# The square-field Stepanov bound on the smooth affine chart + +The smooth-point normalization theorem proves that the selected finite place +above every affine point where the second partial is nonzero has degree one. +This module uses that fact to discharge the sole normalization hypothesis of +the conditional plane square-field Stepanov count. + +Exact constants and the large-field inequality remain explicit mathematical +hypotheses. The resulting error term is honestly `(2 * genusBudget + 1) * +#K`, together with the second-coordinate critical locus; no sharp Hasse--Weil +constant is claimed here. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] + +/-- Square-field Stepanov bound with the regular-point degree-one condition +discharged by smooth normalization. -/ +theorem planeCurve_affinePoint_card_le_squareField + {f : MvPolynomial (Fin 2) S} (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hlarge : + (planeCurveBidegreeGenusBudget f + 1) * + (planeCurveBidegreeGenusBudget f + 2) ≤ Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc S) (PlaneCurveFunctionField f)).comp + (algebraMap S (RatFunc S))) + letI : Algebra S (PlaneCurveFunctionField f) := constantAlg + letI : SMul S (PlaneCurveFunctionField f) := constantAlg.toSMul + letI : Module S (PlaneCurveFunctionField f) := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + algebraicClosure S (PlaneCurveFunctionField f) = ⊥ → + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card S + + (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + + (affineSecondCoordinateCriticalPoints S f).card := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc S) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc S) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + letI : Algebra S E := constantAlg + letI : SMul S E := constantAlg.toSMul + letI : Module S E := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro hconstants + apply planeCurve_affinePoint_card_le_of_regularPlace_degree_one + K S hf hpartialFirst hpartialSecond hcard hlarge hconstants + intro z + exact affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY + (K := S) hf hpartialFirst hpartialSecond z.1 z.2 + +/-- Explicit bidegree version of `planeCurve_affinePoint_card_le_squareField`. +The resultant estimate replaces the critical-locus cardinal by +`((2 * secondDegree - 1) * firstDegree) * secondDegree`. -/ +theorem planeCurve_affinePoint_card_le_squareField_bidegree + {f : MvPolynomial (Fin 2) S} {firstDegree secondDegree : Nat} + (hdegree : BGS.External.HasBidegreeAtMost + f firstDegree secondDegree) + (hf : Irreducible f) + (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (hlarge : + (planeCurveBidegreeGenusBudget f + 1) * + (planeCurveBidegreeGenusBudget f + 2) ≤ Fintype.card K) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc S) (PlaneCurveFunctionField f)).comp + (algebraMap S (RatFunc S))) + letI : Algebra S (PlaneCurveFunctionField f) := constantAlg + letI : SMul S (PlaneCurveFunctionField f) := constantAlg.toSMul + letI : Module S (PlaneCurveFunctionField f) := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + algebraicClosure S (PlaneCurveFunctionField f) = ⊥ → + Fintype.card (AffinePlaneCurvePoint f) ≤ + Fintype.card S + + (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by + classical + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let E := PlaneCurveFunctionField f + letI : Algebra (RatFunc S) E := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc S) E := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc S) E := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let constantAlg : Algebra S E := + RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp + (algebraMap S (RatFunc S))) + letI : Algebra S E := constantAlg + letI : SMul S E := constantAlg.toSMul + letI : Module S E := constantAlg.toModule + letI : IsScalarTower S (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' rfl + dsimp only + intro hconstants + apply planeCurve_affinePoint_card_le_bidegree_of_regularPlace_degree_one + K S hdegree hf hpartialFirst hpartialSecond hcard hlarge hconstants + intro z + exact affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY + (K := S) hf hpartialFirst hpartialSecond z.1 z.2 + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean new file mode 100644 index 0000000000..449b4b7b4e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters + +/-! +# The degree-one plane Stepanov auxiliary + +This file assembles the one-point ingredients of the Bombieri--Stepanov +construction for an absolutely irreducible bivariate plane curve. + +The plane monomial theorem initially gives the coarse Riemann lower bound +only along an explicit arithmetic progression of pole levels. Since the +progression has positive step, every level lies below a later progression +level. The one-place increment estimate therefore transports the lower +bound back to every level. Exact constants then force enough strict levels +to select the two section families prescribed by `stepanovEll` and +`stepanovM`. + +At a degree-one selected place, the target Riemann space has dimension at +most its pole budget plus one. The existing numerical parameter inequality +then gives a nonzero coefficient grid killed by the second Frobenius +restriction and detected by the first. + +The degree-one hypothesis is deliberately an implication in the final +theorem. This module does **not** assert that the controlled infinity place +has degree one, and it does not count square-extension points. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance planeStepanovConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance planeStepanovConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The data furnished by strict-level section selection at pole budget +`N`: nonzero sections with distinct exact pole orders, bounded digits, and +linear independence. -/ +def onePointSectionFamilySpec + {α : Type*} (P : FiniteExtensionPlace K L) (N : ℕ) + (f : α → L) (d : α → ℕ) : Prop := + (∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P N) ∧ + (∀ i, f i ≠ 0) ∧ + (∀ i, finiteExtensionPrincipalDivisor K L (f i) P = -(d i : ℤ)) ∧ + Function.Injective d ∧ + (∀ i, d i ≤ N) ∧ + LinearIndependent K f + +/-- A coefficient grid is a Stepanov auxiliary when it is nonzero, is killed +by the swapped restriction, and gives a nonzero function under the first +restriction. -/ +def onePointStepanovAuxiliarySpec + {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) + (c : α × β →₀ K) : Prop := + c ≠ 0 ∧ + onePointStepanovSecondRestrictionMap K L f g s c = 0 ∧ + onePointStepanovFirstRestrictionMap K L f g s c ≠ 0 + +private theorem finiteExtensionOnePointRiemannSpace_finrank_le_add_gap + (P : FiniteExtensionPlace K L) {N M : ℕ} (hNM : N ≤ M) : + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P M) ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P N) + + (M - N) * finiteExtensionPlaceDegree K L P := by + let D : FiniteExtensionDivisor K L := Finsupp.single P (N : ℤ) + have hD : ∀ v, 0 ≤ D v := by + intro v + by_cases hv : v = P + · subst v + simp [D] + · simp [D, Finsupp.single_eq_of_ne hv] + letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + finiteExtensionRiemannSpace_effective_moduleFinite K L D hD + have hinc := finiteExtensionRiemannSpace_natPlace_increment + K L D hD P (M - N) + have hdivisor : D + Finsupp.single P ((M - N : ℕ) : ℤ) = + Finsupp.single P (M : ℤ) := by + ext v + by_cases hv : v = P + · subst v + simp only [D, Finsupp.add_apply, Finsupp.single_eq_same] + omega + · simp [D, Finsupp.single_eq_of_ne hv] + rw [hdivisor] at hinc + exact hinc.2 + +private theorem finiteExtensionOnePointRiemannSpace_finrank_upper_degree_one + (P : FiniteExtensionPlace K L) + (hconstants : algebraicClosure K L = ⊥) + (hdegree : finiteExtensionPlaceDegree K L P = 1) : + ∀ N, Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P N) ≤ N + 1 := by + intro N + induction N with + | zero => + simpa using + (finiteExtensionOnePointRiemannSpace_zero_finrank K L P hconstants).le + | succ N ih => + have hstep := finiteExtensionOnePointRiemannSpace_finrank_succ_le + K L P N + rw [hdegree] at hstep + omega + +/-- **Conditional degree-one Stepanov auxiliary for a plane curve.** + +For an absolutely irreducible bivariate plane equation with both coordinate +partials nonzero, this theorem chooses the controlled infinity place from +the plane monomial argument and retains its positive pole coefficient and +degree bound. If that selected place has degree one, then for + +`g = (degreeOf 0 F - 1) * (degreeOf 1 F - 1)`, +`s = #K`, `ell = s - 1`, and `m = s + 2g`, + +it produces two strict-level section families and a nonzero coefficient grid +whose second Stepanov restriction vanishes while its first restriction is a +nonzero function. + +The implication on the degree-one equality is essential: no existence of a +degree-one place is claimed here. -/ +theorem exists_planeCurve_onePointStepanovAuxiliary_of_degree_one + {F : MvPolynomial (Fin 2) K} + (habsolute : Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) F)) + (hpartialFirst : MvPolynomial.pderiv 0 F ≠ 0) + (hpartialSecond : MvPolynomial.pderiv 1 F ≠ 0) + (hlarge : + let genusBudget := planeCurveBidegreeGenusBudget F + (genusBudget + 1) * (genusBudget + 2) ≤ Fintype.card K) : + let hF : Irreducible F := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI := planeCurveCoordinateRing_isDomain hF + let hx := firstCoordinate_transcendental hF + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra F hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hF hpartialSecond + letI := separable_planeCurveFunctionField_over_ratFunc hF hpartialSecond + ∃ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField F), + let Q : FiniteExtensionPlace K (PlaneCurveFunctionField F) := .inr P + let genusBudget := planeCurveBidegreeGenusBudget F + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM genusBudget s + 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField F) + (planeCurveFunction F 0) Q ∧ + 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField F) Q ∧ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField F) Q ≤ + MvPolynomial.degreeOf 1 F ∧ + (finiteExtensionPlaceDegree K (PlaneCurveFunctionField F) Q = 1 → + ∃ (u : Option (Fin (ell - genusBudget)) → + PlaneCurveFunctionField F) + (du : Option (Fin (ell - genusBudget)) → ℕ) + (v : Option (Fin (m - genusBudget)) → + PlaneCurveFunctionField F) + (dv : Option (Fin (m - genusBudget)) → ℕ) + (c : (Option (Fin (ell - genusBudget)) × + Option (Fin (m - genusBudget))) →₀ K), + onePointSectionFamilySpec K (PlaneCurveFunctionField F) + Q ell u du ∧ + onePointSectionFamilySpec K (PlaneCurveFunctionField F) + Q m v dv ∧ + onePointStepanovAuxiliarySpec K (PlaneCurveFunctionField F) + u v s c) := by + let hF : Irreducible F := + irreducible_of_irreducible_map_algebraicClosure habsolute + letI : IsDomain (PlaneCurveCoordinateRing F) := + planeCurveCoordinateRing_isDomain hF + let hx := firstCoordinate_transcendental hF + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let L := PlaneCurveFunctionField F + let x : L := planeCurveFunction F 0 + let y : L := planeCurveFunction F 1 + let b := MvPolynomial.degreeOf 1 F + let genusBudget := planeCurveBidegreeGenusBudget F + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM genusBudget s + let canonicalAlg : Algebra K L := inferInstance + letI : Algebra K L := canonicalAlg + let ratAlg : Algebra (RatFunc K) L := + planeCurveFirstCoordinateRatFuncAlgebra F hx + letI : Algebra (RatFunc K) L := ratAlg + letI : SMul (RatFunc K) L := ratAlg.toSMul + letI : Module (RatFunc K) L := ratAlg.toModule + letI : FiniteDimensional (RatFunc K) L := + finiteDimensional_planeCurveFunctionField_over_ratFunc hF hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) L := + separable_planeCurveFunctionField_over_ratFunc hF hpartialSecond + let inducedAlg : Algebra K L := planeStepanovConstantAlgebra K L + have hinducedAlg : inducedAlg = canonicalAlg := by + apply Algebra.algebra_ext + intro c + change (@ratFuncSpecialization K L _ _ canonicalAlg x hx) (RatFunc.C c) = + @algebraMap K L _ _ canonicalAlg c + have h := DFunLike.congr_fun + (@ratFuncSpecialization_comp_polynomial_algebraMap + K L _ _ canonicalAlg x hx) + (Polynomial.C c) + simpa using h + letI : Algebra K L := inducedAlg + letI : SMul K L := inducedAlg.toSMul + letI : Module K L := inducedAlg.toModule + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + have hconstantsCanonical : + @algebraicClosure K L _ _ canonicalAlg = ⊥ := by + simpa only [L] using + planeCurveFunctionField_algebraicClosure_eq_bot + F habsolute hpartialSecond + have hconstants : algebraicClosure K L = ⊥ := by + change @algebraicClosure K L _ _ inducedAlg = ⊥ + rw [hinducedAlg] + exact hconstantsCanonical + obtain ⟨P, hPpole, hPdegreePositive, hPdegreeBound, hprogress⟩ := + exists_planeCurve_onePointRiemannSpace_progression_lower_bound + habsolute hpartialFirst hpartialSecond + let Q : FiniteExtensionPlace K L := .inr P + refine ⟨P, hPpole, hPdegreePositive, hPdegreeBound, ?_⟩ + intro hPdegree + have hcoarse : ∀ N, + N * finiteExtensionPlaceDegree K L Q + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q N) + + genusBudget := by + intro N + let M := planeMonomialPoleLevel K L x y N b Q + obtain ⟨hMformula, _hMfinite, hMlowerRaw⟩ := hprogress N + have hMformula' : M = + N * (finiteExtensionPoleDivisor K L x Q).toNat + + (b - 1) * (finiteExtensionPoleDivisor K L y Q).toNat := by + simpa only [M, L, x, y, b, Q] using hMformula + have hPoleNat : 0 < (finiteExtensionPoleDivisor K L x Q).toNat := by + have hPole : 0 < finiteExtensionPoleDivisor K L x Q := by + simpa only [L, x, Q] using hPpole + have hcast : (0 : ℤ) < + (((finiteExtensionPoleDivisor K L x Q).toNat : ℕ) : ℤ) := by + rw [Int.toNat_of_nonneg hPole.le] + exact hPole + exact_mod_cast hcast + have hNM : N ≤ M := by + rw [hMformula'] + have hbase : N ≤ + N * (finiteExtensionPoleDivisor K L x Q).toNat := + Nat.le_mul_of_pos_right N hPoleNat + omega + have hgap := finiteExtensionOnePointRiemannSpace_finrank_le_add_gap + K L Q hNM + have hMlower : M * finiteExtensionPlaceDegree K L Q + 1 ≤ + Module.finrank K (finiteExtensionOnePointRiemannSpace K L Q M) + + genusBudget := by + simpa only [M, L, x, y, b, Q, genusBudget] using hMlowerRaw + have hMdecomp : M = N + (M - N) := by omega + have hmul : M * finiteExtensionPlaceDegree K L Q = + N * finiteExtensionPlaceDegree K L Q + + (M - N) * finiteExtensionPlaceDegree K L Q := by + calc + M * finiteExtensionPlaceDegree K L Q = + (N + (M - N)) * finiteExtensionPlaceDegree K L Q := by + rw [← hMdecomp] + _ = N * finiteExtensionPlaceDegree K L Q + + (M - N) * finiteExtensionPlaceDegree K L Q := by + rw [Nat.add_mul] + omega + have hstrict : ∀ N, genusBudget ≤ N → + N - genusBudget ≤ + (strictFiltrationLevels + (fun r => finiteExtensionOnePointRiemannSpace K L Q r) N).card := by + intro N hgenusN + apply le_card_onePointStrictLevels_of_finrank_lower + K L Q N (N - genusBudget) hconstants + have hN := hcoarse N + rw [hPdegree] at hN ⊢ + omega + have hlarge' : (genusBudget + 1) * (genusBudget + 2) ≤ s := by + simpa only [genusBudget, s] using hlarge + have hsPositive : 0 < s := Fintype.card_pos + have hgenusLtS : genusBudget < s := by + nlinarith + have hgenusEll : genusBudget ≤ ell := by + simp only [ell, stepanovEll] + omega + have hgenusM : genusBudget ≤ m := by + simp only [m, stepanovM] + omega + have hellLt : ell < s := stepanovEll_lt hlarge' + have hellStrict := hstrict ell hgenusEll + have hmStrict := hstrict m hgenusM + obtain ⟨u, du, huMem, huNe, huOrder, hduInjective, + hduLe, huLI⟩ := + exists_onePointSectionsWithConstant_of_le_card_strictLevels + K L Q ell (ell - genusBudget) hellStrict + obtain ⟨v, dv, hvMem, hvNe, hvOrder, hdvInjective, + hdvLe, hvLI⟩ := + exists_onePointSectionsWithConstant_of_le_card_strictLevels + K L Q m (m - genusBudget) hmStrict + have hgridLI : LinearIndependent K + (fun ij : Option (Fin (ell - genusBudget)) × + Option (Fin (m - genusBudget)) => u ij.1 * (v ij.2) ^ s) := by + exact onePointStepanovGrid_linearIndependent K L Q u v du dv s + huNe hvNe huOrder hvOrder hduInjective hdvInjective + (fun i => (hduLe i).trans_lt hellLt) + have hupper : Module.finrank K + (finiteExtensionOnePointRiemannSpace K L Q (s * ell + m)) ≤ + s * ell + m + 1 := + finiteExtensionOnePointRiemannSpace_finrank_upper_degree_one + K L Q hconstants hPdegree (s * ell + m) + have hellCard : ell - genusBudget + 1 = ell + 1 - genusBudget := by + omega + have hmCard : m - genusBudget + 1 = m + 1 - genusBudget := by + omega + have hnumeric : s * ell + m + 1 < + Fintype.card (Option (Fin (ell - genusBudget))) * + Fintype.card (Option (Fin (m - genusBudget))) := by + have hdim := stepanov_dimension_inequality hlarge' + simpa only [Fintype.card_option, Fintype.card_fin, hellCard, hmCard, + Nat.mul_comm s ell] using hdim + obtain ⟨c, hcNe, hsecond, hfirst⟩ := + exists_onePointStepanovAuxiliary_of_target_finrank_upper + K L Q u v ell m s (s * ell + m + 1) + huMem hvMem hgridLI hupper hnumeric + have hsecondRaw : + onePointStepanovSecondRestrictionMap K L u v s c = 0 := by + have h := congrArg Subtype.val hsecond + simpa only [onePointStepanovSecondCodRestrictionMap_coe, + Submodule.coe_zero] using h + refine ⟨u, du, v, dv, c, ?_, ?_, ?_⟩ + · exact ⟨huMem, huNe, huOrder, hduInjective, hduLe, huLI⟩ + · exact ⟨hvMem, hvNe, hvOrder, hdvInjective, hdvLe, hvLI⟩ + · exact ⟨hcNe, hsecondRaw, hfirst⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean new file mode 100644 index 0000000000..463e8bbb46 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace + +/-! +# Pole divisors in the exhaustive finite-extension place model + +The existing Corvaja--Zannier infrastructure records principal divisors and +their total pole height. The Stepanov argument also needs the actual +effective pole divisor. This file defines it by retaining the negative +coefficients of the principal divisor and changing their signs, proves that +it makes the original function a section, and identifies its divisor degree +with the existing height. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance poleDivisorConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance poleDivisorConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The effective negative part of the principal divisor of `x`. -/ +def finiteExtensionPoleDivisor (x : L) : FiniteExtensionDivisor K L := + by + classical + let D := finiteExtensionPrincipalDivisor K L x + exact -(D.filter (fun v => D v < 0)) + +@[simp] +theorem finiteExtensionPoleDivisor_apply (x : L) + (v : FiniteExtensionPlace K L) : + finiteExtensionPoleDivisor K L x v = + if finiteExtensionPrincipalDivisor K L x v < 0 then + -finiteExtensionPrincipalDivisor K L x v else 0 := by + simp only [finiteExtensionPoleDivisor, Finsupp.neg_apply, + Finsupp.filter_apply] + split <;> simp_all + +/-- A pole divisor is effective. -/ +theorem finiteExtensionPoleDivisor_effective (x : L) : + ∀ v, 0 ≤ finiteExtensionPoleDivisor K L x v := by + intro v + rw [finiteExtensionPoleDivisor_apply] + split <;> omega + +/-- Adding the pole divisor to the principal divisor is effective. -/ +theorem finiteExtensionPrincipal_add_poleDivisor_effective (x : L) : + ∀ v, 0 ≤ finiteExtensionPrincipalDivisor K L x v + + finiteExtensionPoleDivisor K L x v := by + intro v + rw [finiteExtensionPoleDivisor_apply] + split <;> omega + +/-- Every nonzero function is a section of its pole divisor. -/ +theorem mem_finiteExtensionRiemannSpace_poleDivisor + (x : L) (hx : x ≠ 0) : + x ∈ finiteExtensionRiemannSpace K L + (finiteExtensionPoleDivisor K L x) := by + rw [mem_finiteExtensionRiemannSpace] + exact Or.inr ⟨hx, + finiteExtensionPrincipal_add_poleDivisor_effective K L x⟩ + +/-- The degree of the pole divisor is the previously defined pole height. -/ +theorem finiteExtensionDivisorDegree_poleDivisor + (x : L) : + finiteExtensionDivisorDegree K L + (finiteExtensionPoleDivisor K L x) = + (finiteExtensionHeight K L x : ℤ) := by + classical + let D := finiteExtensionPrincipalDivisor K L x + have hnegative := finiteExtensionHeight_negativeSum K L x + change -((finiteExtensionHeight K L x : ℕ) : ℤ) = + ∑ v ∈ D.support.filter (fun v => D v < 0), + D v * (finiteExtensionPlaceDegree K L v : ℤ) at hnegative + rw [finiteExtensionDivisorDegree, Finsupp.sum, + finiteExtensionPoleDivisor] + simp only [Finsupp.support_neg, Finsupp.support_filter, + Finsupp.neg_apply, Finsupp.filter_apply] + calc + ∑ a ∈ D.support.filter (fun v => D v < 0), + -(if D a < 0 then D a else 0) * + (finiteExtensionPlaceDegree K L a : ℤ) = + -∑ a ∈ D.support.filter (fun v => D v < 0), + D a * (finiteExtensionPlaceDegree K L a : ℤ) := by + rw [← Finset.sum_neg_distrib] + apply Finset.sum_congr rfl + intro a ha + rw [if_pos (Finset.mem_filter.mp ha).2] + ring + _ = (finiteExtensionHeight K L x : ℤ) := by omega + +/-- Divisor degree commutes with natural scaling. -/ +theorem finiteExtensionDivisorDegree_nsmul + (n : ℕ) (D : FiniteExtensionDivisor K L) : + finiteExtensionDivisorDegree K L (n • D) = + (n : ℤ) * finiteExtensionDivisorDegree K L D := by + induction n with + | zero => simp [finiteExtensionDivisorDegree] + | succ n ih => + rw [succ_nsmul, finiteExtensionDivisorDegree_add, ih] + push_cast + ring + +/-- A coordinate monomial is a section of the sum of the correspondingly +scaled pole divisors. -/ +theorem pow_mul_pow_mem_poleDivisor_budget + (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) (i j : ℕ) : + x ^ i * y ^ j ∈ finiteExtensionRiemannSpace K L + (i • finiteExtensionPoleDivisor K L x + + j • finiteExtensionPoleDivisor K L y) := by + exact finiteExtensionRiemannSpace_mul_mem K L + (finiteExtensionRiemannSpace_pow_mem K L + (mem_finiteExtensionRiemannSpace_poleDivisor K L x hx) i) + (finiteExtensionRiemannSpace_pow_mem K L + (mem_finiteExtensionRiemannSpace_poleDivisor K L y hy) j) + +/-- The degree of the monomial pole budget is the corresponding linear +combination of the two coordinate heights. -/ +theorem finiteExtensionDivisorDegree_pow_mul_pow_budget + (x y : L) (i j : ℕ) : + finiteExtensionDivisorDegree K L + (i • finiteExtensionPoleDivisor K L x + + j • finiteExtensionPoleDivisor K L y) = + (i : ℤ) * finiteExtensionHeight K L x + + (j : ℤ) * finiteExtensionHeight K L y := by + rw [finiteExtensionDivisorDegree_add, + finiteExtensionDivisorDegree_nsmul, + finiteExtensionDivisorDegree_nsmul, + finiteExtensionDivisorDegree_poleDivisor, + finiteExtensionDivisorDegree_poleDivisor] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean new file mode 100644 index 0000000000..f24bd3259b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean @@ -0,0 +1,164 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace +import Mathlib.FieldTheory.IsAlgClosed.Basic + +/-! +# Spectral parameters from a zeta numerator + +This file records the elementary factorization needed after rationality of a +curve zeta function has produced a numerator polynomial. A complex +polynomial whose constant coefficient is one is uniquely the product of the +factors `1 - alpha * X`, where the parameters `alpha` are the inverses of its +roots, counted with multiplicity. + +The substantive arithmetic input remains the construction of the zeta +numerator and its logarithmic-derivative point-count identity. No spectral +norm estimate is used here. +-/ + +namespace BGS.HasseWeil + +open Polynomial +open scoped BigOperators Polynomial + +noncomputable section + +/-- The reciprocal root parameter attached to the `i`-th root of `P`, with +roots enumerated by the canonical sorted list underlying their multiset. -/ +def reciprocalRootParameter (P : Polynomial ℂ) (i : Fin P.natDegree) : ℂ := + ((P.roots.toList.get + (Fin.cast (by simp [IsAlgClosed.card_roots_eq_natDegree]) i))⁻¹) + +/-- Summing powers of the indexed reciprocal-root family agrees with the +multiset power sum, including root multiplicities. -/ +theorem sum_reciprocalRootParameter_pow + (P : Polynomial ℂ) (m : ℕ) : + ∑ i, reciprocalRootParameter P i ^ m = + (P.roots.map fun r => r⁻¹ ^ m).sum := by + unfold reciprocalRootParameter + have hlen : P.natDegree = P.roots.toList.length := + ((Multiset.length_toList P.roots).trans + IsAlgClosed.card_roots_eq_natDegree).symm + let e : Fin P.natDegree ≃ Fin P.roots.toList.length := + Fin.castOrderIso hlen + calc + ∑ i, (P.roots.toList.get (Fin.cast hlen i))⁻¹ ^ m = + ∑ j : Fin P.roots.toList.length, + (P.roots.toList.get j)⁻¹ ^ m := by + apply Fintype.sum_equiv e + intro i + rfl + _ = (P.roots.map fun r => r⁻¹ ^ m).sum := by + simpa [Multiset.sum_coe] using + (Fin.sum_univ_fun_getElem P.roots.toList (fun r => r⁻¹ ^ m)) + +/-- A complex polynomial normalized by `P(0) = 1` factors into reciprocal +linear factors, with one factor for every root counted with multiplicity. -/ +theorem polynomial_eq_prod_one_sub_C_mul_X_of_coeff_zero_eq_one + (P : Polynomial ℂ) (hP0 : P.coeff 0 = 1) : + P = (P.roots.map fun r => 1 - C r⁻¹ * X).prod := by + have hP : P ≠ 0 := by + intro h + rw [h, coeff_zero] at hP0 + norm_num at hP0 + have hsplits : P.Splits := IsAlgClosed.splits P + have hroot0 (r : ℂ) (hr : r ∈ P.roots) : r ≠ 0 := by + intro hr0 + subst r + have hEval : P.eval 0 = 0 := (mem_roots hP).mp hr + rw [← coeff_zero_eq_eval_zero, hP0] at hEval + norm_num at hEval + let R : Polynomial ℂ := (P.roots.map fun r => X - C r).prod + let c : ℂ := (P.roots.map fun r => -r⁻¹).prod + have hfactor (r : ℂ) (hr : r ∈ P.roots) : + 1 - C r⁻¹ * X = C (-r⁻¹) * (X - C r) := by + rw [mul_sub, ← C_mul] + simp [hroot0 r hr] + ring + have hQ : (P.roots.map fun r => 1 - C r⁻¹ * X).prod = C c * R := by + dsimp [R, c] + have hmap : + P.roots.map (fun r => 1 - C r⁻¹ * X) = + P.roots.map (fun r => C (-r⁻¹) * (X - C r)) := by + apply Multiset.map_congr rfl + intro r hr + exact hfactor r hr + rw [hmap, Multiset.prod_map_mul] + have hCprod : + (P.roots.map fun r => C (-r⁻¹)).prod = + C (P.roots.map fun r => -r⁻¹).prod := by + simpa only [Multiset.map_map, Function.comp_apply] using + (map_multiset_prod C (P.roots.map fun r => -r⁻¹)).symm + rw [hCprod] + have hPprod : P = C P.leadingCoeff * R := by + simpa only [R] using hsplits.eq_prod_roots + have hR0eq : R.coeff 0 = (P.roots.map fun r => -r).prod := by + dsimp [R] + simp [coeff_zero_eq_eval_zero, eval_multiset_prod] + have hR0 : R.coeff 0 ≠ 0 := by + rw [hR0eq] + apply Multiset.prod_ne_zero + intro hzero + obtain ⟨z, hz, hneg⟩ := Multiset.mem_map.mp hzero + exact hroot0 z hz (neg_eq_zero.mp hneg) + have hc : c * R.coeff 0 = 1 := by + rw [hR0eq] + dsimp [c] + rw [← Multiset.prod_map_mul] + apply Multiset.prod_eq_one + intro z hz + obtain ⟨r, hr, rfl⟩ := Multiset.mem_map.mp hz + simp [hroot0 r hr] + have hlc : P.leadingCoeff * R.coeff 0 = 1 := by + have hcoeff := congrArg (fun Q : Polynomial ℂ => Q.coeff 0) hPprod + simpa [hP0] using hcoeff.symm + have hscalar : P.leadingCoeff = c := by + apply mul_right_cancel₀ hR0 + rw [hlc, hc] + calc + P = C P.leadingCoeff * R := hPprod + _ = C c * R := by rw [hscalar] + _ = (P.roots.map fun r => 1 - C r⁻¹ * X).prod := hQ.symm + +/-- The reciprocal-root factorization with the parameters indexed by +`Fin P.natDegree`, ready for the finite power sums used in the spectral +point-count formula. -/ +theorem polynomial_eq_prod_reciprocalRootParameter + (P : Polynomial ℂ) (hP0 : P.coeff 0 = 1) : + P = ∏ i, (1 - C (reciprocalRootParameter P i) * X) := by + have hlen : P.natDegree = P.roots.toList.length := + ((Multiset.length_toList P.roots).trans + IsAlgClosed.card_roots_eq_natDegree).symm + let e : Fin P.natDegree ≃ Fin P.roots.toList.length := + Fin.castOrderIso hlen + calc + P = (P.roots.map fun r => 1 - C r⁻¹ * X).prod := + polynomial_eq_prod_one_sub_C_mul_X_of_coeff_zero_eq_one P hP0 + _ = + (P.roots.toList.map fun r => 1 - C r⁻¹ * X).prod := by + let f : ℂ → Polynomial ℂ := fun r => 1 - C r⁻¹ * X + have hs := congrArg (fun s : Multiset ℂ => (s.map f).prod) + (Multiset.coe_toList P.roots) + simpa only [f, Multiset.map_coe, Multiset.prod_coe] using hs.symm + _ = ∏ j : Fin P.roots.toList.length, + (1 - C (P.roots.toList.get j)⁻¹ * X) := by + simpa using + (Fin.prod_univ_fun_getElem P.roots.toList + (fun r => 1 - C r⁻¹ * X)).symm + _ = ∏ i : Fin P.natDegree, + (1 - C (P.roots.toList.get (Fin.cast hlen i))⁻¹ * X) := by + symm + apply Fintype.prod_equiv e + intro i + rfl + _ = ∏ i, (1 - C (reciprocalRootParameter P i) * X) := by + rfl + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean new file mode 100644 index 0000000000..34e0c7c339 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean @@ -0,0 +1,382 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Algebra.Polynomial.AlgebraMap +import Mathlib.RingTheory.PolynomialAlgebra +import Mathlib.RingTheory.TensorProduct.Maps + +/-! +# Cancelling a polynomial ring in a tensor product + +If the `C[X]`-algebra structure on `A` extends its `C`-algebra structure, then +base change from `C[X]` to `S[X]` is canonically the same as base change from +`C` to `S`. This file constructs the resulting explicit `S`-algebra +equivalence + +`S[X] ⊗[C[X]] A ≃ₐ[S] S ⊗[C] A` + +and records its values on pure tensors in both directions. +-/ + +open scoped Polynomial TensorProduct + +namespace BGS.HasseWeil + +noncomputable section + +variable (C S A : Type*) + [CommRing C] [CommRing S] [CommRing A] + [Algebra C S] [Algebra C A] [Algebra C[X] A] + [IsScalarTower C C[X] A] + +private noncomputable def coefficientPolynomialAlgHom : + C[X] →ₐ[C] S[X] := + Polynomial.mapAlgHom (Algebra.ofId C S) + +local instance coefficientPolynomialAlgebra : Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance coefficientPolynomialTower : IsScalarTower C C[X] S[X] := + IsScalarTower.of_algebraMap_eq' (by + apply RingHom.ext + intro c + simp [Polynomial.algebraMap_def]) + +private abbrev PolynomialTensor := TensorProduct C[X] S[X] A +private abbrev ConstantTensor := TensorProduct C S A + +/-- The image of the polynomial variable in the constant tensor product. -/ +noncomputable def polynomialTensorCancelEvaluationPoint : + TensorProduct C S A := + Algebra.TensorProduct.includeRight (algebraMap C[X] A Polynomial.X) + +private noncomputable def constantTensorPolynomialAlgHom : + C[X] →ₐ[C] ConstantTensor C S A := + Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S A) + +/-- The `C[X]`-algebra structure on `S ⊗[C] A` obtained by evaluating `X` +at `1 ⊗ algebraMap C[X] A X`. -/ +@[reducible] +noncomputable def polynomialTensorCancelTargetPolynomialAlgebra : + Algebra C[X] (TensorProduct C S A) := + (constantTensorPolynomialAlgHom C S A).toAlgebra + +local instance constantTensorPolynomialAlgebra : + Algebra C[X] (ConstantTensor C S A) := + polynomialTensorCancelTargetPolynomialAlgebra C S A + +/-- The `S[X]`-algebra structure on `S ⊗[C] A` obtained by evaluating `X` +at `1 ⊗ algebraMap C[X] A X`. -/ +@[reducible] +noncomputable def polynomialTensorCancelTargetPolynomialExtensionAlgebra : + Algebra S[X] (TensorProduct C S A) := + (Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S A)).toAlgebra + +local instance constantTensorPolynomialExtensionAlgebra : + Algebra S[X] (ConstantTensor C S A) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S A + +local instance constantTensorPolynomialTower : + IsScalarTower C C[X] (ConstantTensor C S A) := + IsScalarTower.of_algebraMap_eq' (by + apply RingHom.ext + intro c + change (algebraMap C S c ⊗ₜ[C] (1 : A)) = + constantTensorPolynomialAlgHom C S A (Polynomial.C c) + simp [constantTensorPolynomialAlgHom]) + +private theorem includeRight_algebraMap_polynomial (p : C[X]) : + (Algebra.TensorProduct.includeRight : + A →ₐ[C] ConstantTensor C S A) (algebraMap C[X] A p) = + constantTensorPolynomialAlgHom C S A p := by + have h : + (Algebra.TensorProduct.includeRight : + A →ₐ[C] ConstantTensor C S A).comp + (IsScalarTower.toAlgHom C C[X] A) = + constantTensorPolynomialAlgHom C S A := by + ext + simp [constantTensorPolynomialAlgHom, + polynomialTensorCancelEvaluationPoint] + simpa [Polynomial.algebraMap_def, coefficientPolynomialAlgHom] using + DFunLike.congr_fun h p + +private noncomputable def rightFactorToConstantTensor : + A →ₐ[C[X]] ConstantTensor C S A where + __ := (Algebra.TensorProduct.includeRight : + A →ₐ[C] ConstantTensor C S A).toRingHom + commutes' := includeRight_algebraMap_polynomial C S A + +private noncomputable def leftFactorToConstantTensorOverS : + S[X] →ₐ[S] ConstantTensor C S A := + Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S A) + +omit [IsScalarTower C C[X] A] in +private theorem leftFactorToConstantTensor_compatible (p : C[X]) : + leftFactorToConstantTensorOverS C S A (algebraMap C[X] S[X] p) = + constantTensorPolynomialAlgHom C S A p := by + have h : + ((leftFactorToConstantTensorOverS C S A).restrictScalars C).comp + (coefficientPolynomialAlgHom C S) = + constantTensorPolynomialAlgHom C S A := by + ext + simp [leftFactorToConstantTensorOverS, + constantTensorPolynomialAlgHom, + polynomialTensorCancelEvaluationPoint, coefficientPolynomialAlgHom] + exact DFunLike.congr_fun h p + +private noncomputable def leftFactorToConstantTensor : + S[X] →ₐ[C[X]] ConstantTensor C S A where + __ := (leftFactorToConstantTensorOverS C S A).toRingHom + commutes' := leftFactorToConstantTensor_compatible C S A + +private noncomputable def polynomialTensorToConstantTensorOverPolynomial : + PolynomialTensor C S A →ₐ[C[X]] ConstantTensor C S A := + Algebra.TensorProduct.lift + (leftFactorToConstantTensor C S A) + (rightFactorToConstantTensor C S A) + (fun _ _ ↦ Commute.all _ _) + +private noncomputable def polynomialTensorToConstantTensor : + PolynomialTensor C S A →ₐ[S] ConstantTensor C S A where + __ := (polynomialTensorToConstantTensorOverPolynomial C S A).toRingHom + commutes' s := by + change polynomialTensorToConstantTensorOverPolynomial C S A + ((Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S] PolynomialTensor C S A) (Polynomial.C s)) = + algebraMap S (ConstantTensor C S A) s + simp [polynomialTensorToConstantTensorOverPolynomial, + leftFactorToConstantTensor, leftFactorToConstantTensorOverS] + +private noncomputable def constantsToPolynomialTensor : + S →ₐ[S] PolynomialTensor C S A := + (Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S] PolynomialTensor C S A).comp Polynomial.CAlgHom + +private noncomputable def rightFactorToPolynomialTensor : + A →ₐ[C] PolynomialTensor C S A := + (Algebra.TensorProduct.includeRight : + A →ₐ[C[X]] PolynomialTensor C S A).restrictScalars C + +private noncomputable def constantTensorToPolynomialTensor : + ConstantTensor C S A →ₐ[S] PolynomialTensor C S A := + Algebra.TensorProduct.lift + (constantsToPolynomialTensor C S A) + (rightFactorToPolynomialTensor C S A) + (fun _ _ ↦ Commute.all _ _) + +private theorem constantTensorToPolynomialTensor_comp_leftFactor : + (constantTensorToPolynomialTensor C S A).comp + (leftFactorToConstantTensorOverS C S A) = + (Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S] PolynomialTensor C S A) := by + ext + simp [constantTensorToPolynomialTensor, + leftFactorToConstantTensorOverS, + polynomialTensorCancelEvaluationPoint, rightFactorToPolynomialTensor] + +private theorem constantTensorToPolynomialTensor_commutes_polynomial + (p : C[X]) : + constantTensorToPolynomialTensor C S A + (algebraMap C[X] (ConstantTensor C S A) p) = + algebraMap C[X] (PolynomialTensor C S A) p := by + rw [show algebraMap C[X] (ConstantTensor C S A) p = + leftFactorToConstantTensorOverS C S A + (algebraMap C[X] S[X] p) by + exact (leftFactorToConstantTensor_compatible C S A p).symm] + have hp := AlgHom.congr_fun + (constantTensorToPolynomialTensor_comp_leftFactor C S A) + (algebraMap C[X] S[X] p) + change constantTensorToPolynomialTensor C S A + (leftFactorToConstantTensorOverS C S A + (algebraMap C[X] S[X] p)) = + Algebra.TensorProduct.includeLeft (algebraMap C[X] S[X] p) at hp + rw [hp] + rfl + +private noncomputable def constantTensorToPolynomialTensorOverPolynomial : + ConstantTensor C S A →ₐ[C[X]] PolynomialTensor C S A where + __ := (constantTensorToPolynomialTensor C S A).toRingHom + commutes' := constantTensorToPolynomialTensor_commutes_polynomial C S A + +private noncomputable def polynomialTensorToConstantTensorOverCoefficientPolynomial : + PolynomialTensor C S A →ₐ[S[X]] ConstantTensor C S A where + __ := (polynomialTensorToConstantTensor C S A).toRingHom + commutes' p := by + change polynomialTensorToConstantTensor C S A + ((Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S[X]] PolynomialTensor C S A) p) = + leftFactorToConstantTensorOverS C S A p + simp [polynomialTensorToConstantTensor, + polynomialTensorToConstantTensorOverPolynomial, + leftFactorToConstantTensor] + +private noncomputable def constantTensorToPolynomialTensorOverCoefficientPolynomial : + ConstantTensor C S A →ₐ[S[X]] PolynomialTensor C S A where + __ := (constantTensorToPolynomialTensor C S A).toRingHom + commutes' p := by + have hp := AlgHom.congr_fun + (constantTensorToPolynomialTensor_comp_leftFactor C S A) p + change constantTensorToPolynomialTensor C S A + (leftFactorToConstantTensorOverS C S A p) = + (Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S[X]] PolynomialTensor C S A) p + exact hp + +private theorem constantTensorToPolynomialTensor_leftInverse : + (constantTensorToPolynomialTensor C S A).comp + (polynomialTensorToConstantTensor C S A) = + AlgHom.id S (PolynomialTensor C S A) := by + apply AlgHom.ext + intro z + induction z using TensorProduct.induction_on with + | zero => simp + | add x y hx hy => simp only [map_add, hx, hy] + | tmul p a => + change constantTensorToPolynomialTensor C S A + (leftFactorToConstantTensorOverS C S A p * + rightFactorToConstantTensor C S A a) = + p ⊗ₜ[C[X]] a + rw [map_mul] + have hp := AlgHom.congr_fun + (constantTensorToPolynomialTensor_comp_leftFactor C S A) p + change constantTensorToPolynomialTensor C S A + (leftFactorToConstantTensorOverS C S A p) = + Algebra.TensorProduct.includeLeft p at hp + rw [hp] + simp [constantTensorToPolynomialTensor, + rightFactorToConstantTensor, rightFactorToPolynomialTensor] + +private theorem constantTensorToPolynomialTensor_rightInverse : + (polynomialTensorToConstantTensor C S A).comp + (constantTensorToPolynomialTensor C S A) = + AlgHom.id S (ConstantTensor C S A) := by + apply Algebra.TensorProduct.ext + · apply AlgHom.ext + intro s + simpa [constantTensorToPolynomialTensor, constantsToPolynomialTensor] using + (polynomialTensorToConstantTensor C S A).commutes s + · apply AlgHom.ext + intro a + simp [constantTensorToPolynomialTensor, + polynomialTensorToConstantTensor, + polynomialTensorToConstantTensorOverPolynomial, + rightFactorToConstantTensor, rightFactorToPolynomialTensor] + +private theorem constantTensorToPolynomialTensorOverPolynomial_leftInverse : + (constantTensorToPolynomialTensorOverPolynomial C S A).comp + (polynomialTensorToConstantTensorOverPolynomial C S A) = + AlgHom.id C[X] (PolynomialTensor C S A) := by + apply AlgHom.ext + intro z + exact DFunLike.congr_fun + (constantTensorToPolynomialTensor_leftInverse C S A) z + +private theorem constantTensorToPolynomialTensorOverPolynomial_rightInverse : + (polynomialTensorToConstantTensorOverPolynomial C S A).comp + (constantTensorToPolynomialTensorOverPolynomial C S A) = + AlgHom.id C[X] (ConstantTensor C S A) := by + apply AlgHom.ext + intro z + exact DFunLike.congr_fun + (constantTensorToPolynomialTensor_rightInverse C S A) z + +private theorem + constantTensorToPolynomialTensorOverCoefficientPolynomial_leftInverse : + (constantTensorToPolynomialTensorOverCoefficientPolynomial C S A).comp + (polynomialTensorToConstantTensorOverCoefficientPolynomial C S A) = + AlgHom.id S[X] (PolynomialTensor C S A) := by + apply AlgHom.ext + intro z + exact DFunLike.congr_fun + (constantTensorToPolynomialTensor_leftInverse C S A) z + +private theorem + constantTensorToPolynomialTensorOverCoefficientPolynomial_rightInverse : + (polynomialTensorToConstantTensorOverCoefficientPolynomial C S A).comp + (constantTensorToPolynomialTensorOverCoefficientPolynomial C S A) = + AlgHom.id S[X] (ConstantTensor C S A) := by + apply AlgHom.ext + intro z + exact DFunLike.congr_fun + (constantTensorToPolynomialTensor_rightInverse C S A) z + +/-- Polynomial tensor cancellation as a `C[X]`-algebra equivalence, where the +target uses `polynomialTensorCancelTargetPolynomialAlgebra`. -/ +noncomputable def polynomialTensorCancelOverPolynomial : + TensorProduct C[X] S[X] A ≃ₐ[C[X]] TensorProduct C S A := + AlgEquiv.ofAlgHom + (polynomialTensorToConstantTensorOverPolynomial C S A) + (constantTensorToPolynomialTensorOverPolynomial C S A) + (constantTensorToPolynomialTensorOverPolynomial_rightInverse C S A) + (constantTensorToPolynomialTensorOverPolynomial_leftInverse C S A) + +/-- Polynomial tensor cancellation as an `S[X]`-algebra equivalence, where +the target uses `polynomialTensorCancelTargetPolynomialExtensionAlgebra`. -/ +noncomputable def polynomialTensorCancelOverCoefficientPolynomial : + TensorProduct C[X] S[X] A ≃ₐ[S[X]] TensorProduct C S A := + AlgEquiv.ofAlgHom + (polynomialTensorToConstantTensorOverCoefficientPolynomial C S A) + (constantTensorToPolynomialTensorOverCoefficientPolynomial C S A) + (constantTensorToPolynomialTensorOverCoefficientPolynomial_rightInverse + C S A) + (constantTensorToPolynomialTensorOverCoefficientPolynomial_leftInverse + C S A) + +/-- Cancelling the polynomial base change in a tensor product. -/ +noncomputable def polynomialTensorCancel : + TensorProduct C[X] S[X] A ≃ₐ[S] TensorProduct C S A := + AlgEquiv.ofAlgHom + (polynomialTensorToConstantTensor C S A) + (constantTensorToPolynomialTensor C S A) + (constantTensorToPolynomialTensor_rightInverse C S A) + (constantTensorToPolynomialTensor_leftInverse C S A) + +@[simp] +theorem polynomialTensorCancelOverPolynomial_apply + (z : TensorProduct C[X] S[X] A) : + polynomialTensorCancelOverPolynomial C S A z = + polynomialTensorCancel C S A z := by + rfl + +@[simp] +theorem polynomialTensorCancelOverPolynomial_symm_apply + (z : TensorProduct C S A) : + (polynomialTensorCancelOverPolynomial C S A).symm z = + (polynomialTensorCancel C S A).symm z := by + rfl + +@[simp] +theorem polynomialTensorCancelOverCoefficientPolynomial_apply + (z : TensorProduct C[X] S[X] A) : + polynomialTensorCancelOverCoefficientPolynomial C S A z = + polynomialTensorCancel C S A z := by + rfl + +@[simp] +theorem polynomialTensorCancelOverCoefficientPolynomial_symm_apply + (z : TensorProduct C S A) : + (polynomialTensorCancelOverCoefficientPolynomial C S A).symm z = + (polynomialTensorCancel C S A).symm z := by + rfl + +@[simp] +theorem polynomialTensorCancel_tmul (p : S[X]) (a : A) : + polynomialTensorCancel C S A (p ⊗ₜ[C[X]] a) = + Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S A) p * + (1 ⊗ₜ[C] a) := by + rfl + +@[simp] +theorem polynomialTensorCancel_symm_tmul (s : S) (a : A) : + (polynomialTensorCancel C S A).symm (s ⊗ₜ[C] a) = + Polynomial.C s ⊗ₜ[C[X]] a := by + simp [polynomialTensorCancel, constantTensorToPolynomialTensor, + constantsToPolynomialTensor, rightFactorToPolynomialTensor] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean new file mode 100644 index 0000000000..1f0ee69aa3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean @@ -0,0 +1,158 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib + +/-! +# Growth of finite weighted power sums + +This file formalizes the elementary power-sum lemma used in the +Corvaja--Zannier passage from even-extension point-count estimates to bounds +on Frobenius parameters. + +For a finite set `s` of distinct complex numbers and nonzero weights, an +`O(ρ ^ n)` bound on the weighted power sum forces every member of `s` to +have norm at most `ρ`. The proof uses an isolation polynomial: applying a +polynomial that vanishes at all the other members of `s` expresses the chosen +geometric progression as a fixed linear combination of shifted power sums. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics +open scoped BigOperators + +noncomputable section + +/-- The finite power sum with base set `s` and coefficient function `weight`. -/ +def weightedPowerSum (s : Finset ℂ) (weight : ℂ → ℂ) (n : ℕ) : ℂ := + ∑ z ∈ s, weight z * z ^ n + +/-- The polynomial that vanishes at every member of `s` other than `z`. -/ +private def isolatePolynomial (s : Finset ℂ) (z : ℂ) : Polynomial ℂ := + ∏ w ∈ s.erase z, (Polynomial.X - Polynomial.C w) + +private lemma isolatePolynomial_eval_self_ne_zero {s : Finset ℂ} {z : ℂ} : + (isolatePolynomial s z).eval z ≠ 0 := by + classical + rw [isolatePolynomial, Polynomial.eval_prod] + simp only [Polynomial.eval_sub, Polynomial.eval_X, Polynomial.eval_C] + exact Finset.prod_ne_zero_iff.mpr fun w hw ↦ + sub_ne_zero.mpr (Ne.symm (Finset.ne_of_mem_erase hw)) + +private lemma isolatePolynomial_eval_eq_zero_of_mem_of_ne + {s : Finset ℂ} {z w : ℂ} (hw : w ∈ s) (hwz : w ≠ z) : + (isolatePolynomial s z).eval w = 0 := by + classical + rw [isolatePolynomial, Polynomial.eval_prod] + exact Finset.prod_eq_zero (Finset.mem_erase.mpr ⟨hwz, hw⟩) (by simp) + +private lemma isolatePolynomial_sum_weightedPowerSum + {s : Finset ℂ} {weight : ℂ → ℂ} {z : ℂ} (hz : z ∈ s) (n : ℕ) : + (isolatePolynomial s z).sum + (fun k a ↦ a * weightedPowerSum s weight (n + k)) = + weight z * z ^ n * (isolatePolynomial s z).eval z := by + classical + rw [Polynomial.sum_def] + simp_rw [weightedPowerSum, Finset.mul_sum] + rw [Finset.sum_comm] + calc + _ = ∑ x ∈ s, weight x * x ^ n * + ∑ k ∈ (isolatePolynomial s z).support, + (isolatePolynomial s z).coeff k * x ^ k := by + apply Finset.sum_congr rfl + intro x hx + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro k hk + rw [pow_add] + ring + _ = ∑ x ∈ s, weight x * x ^ n * (isolatePolynomial s z).eval x := by + apply Finset.sum_congr rfl + intro x hx + rw [Polynomial.eval_eq_sum, Polynomial.sum_def] + _ = weight z * z ^ n * (isolatePolynomial s z).eval z := by + rw [Finset.sum_eq_single z] + · intro x hx hne + rw [isolatePolynomial_eval_eq_zero_of_mem_of_ne hx hne, mul_zero] + · exact fun hnot ↦ (hnot hz).elim + +/-- A single complex geometric progression can be `O(ρ ^ n)` only when its +base has norm at most the nonnegative real number `ρ`. -/ +theorem norm_le_of_pow_isBigO {z : ℂ} {ρ : ℝ} (hρ : 0 ≤ ρ) + (h : (fun n : ℕ ↦ z ^ n) =O[atTop] fun n : ℕ ↦ ρ ^ n) : + ‖z‖ ≤ ρ := by + by_contra hz + have hlt : ρ < ‖z‖ := lt_of_not_ge hz + have hsmall : (fun n : ℕ ↦ ρ ^ n) =o[atTop] fun n : ℕ ↦ ‖z‖ ^ n := + isLittleO_pow_pow_of_lt_left hρ hlt + have hself : (fun n : ℕ ↦ z ^ n) =o[atTop] fun n : ℕ ↦ ‖z‖ ^ n := + h.trans_isLittleO hsmall + have hhalf := hself.def' (by norm_num : (0 : ℝ) < 1 / 2) + rcases hhalf.bound.exists with ⟨n, hn⟩ + have hzpos : 0 < ‖z‖ := by linarith + have hpos : 0 < ‖z‖ ^ n := pow_pos hzpos n + have hle : ‖z‖ ^ n ≤ (1 / 2 : ℝ) * ‖z‖ ^ n := by + simpa [norm_pow, Real.norm_eq_abs, + abs_of_nonneg (pow_nonneg (norm_nonneg z) n)] using hn + nlinarith + +/-- If a finite weighted power sum is `O(ρ ^ n)` and every coefficient is +nonzero, then each base occurring in the sum has norm at most `ρ`. + +Distinctness is encoded by `s` being a `Finset`. No nonzero assumption on the +bases is needed: zero bases satisfy the conclusion automatically. -/ +theorem norm_le_of_mem_of_weightedPowerSum_isBigO + {s : Finset ℂ} {weight : ℂ → ℂ} {ρ : ℝ} + (hρ : 0 ≤ ρ) + (hweight : ∀ z ∈ s, weight z ≠ 0) + (hO : weightedPowerSum s weight =O[atTop] fun n : ℕ ↦ ρ ^ n) + {z : ℂ} (hz : z ∈ s) : + ‖z‖ ≤ ρ := by + classical + have hshift (k : ℕ) : + (fun n : ℕ ↦ weightedPowerSum s weight (n + k)) =O[atTop] + fun n : ℕ ↦ ρ ^ n := by + have hcomp := hO.comp_tendsto (tendsto_add_atTop_nat k) + change (fun n : ℕ ↦ weightedPowerSum s weight (n + k)) =O[atTop] + (fun n : ℕ ↦ ρ ^ (n + k)) at hcomp + refine hcomp.trans ?_ + simpa only [pow_add, mul_comm] using + (isBigO_refl (fun n : ℕ ↦ ρ ^ n) atTop).const_mul_left (ρ ^ k) + have hfiltered : + (fun n : ℕ ↦ (isolatePolynomial s z).sum + (fun k a ↦ a * weightedPowerSum s weight (n + k))) =O[atTop] + fun n : ℕ ↦ ρ ^ n := by + simpa only [Polynomial.sum_def] using + (IsBigO.sum fun k hk ↦ + (hshift k).const_mul_left ((isolatePolynomial s z).coeff k) : + (fun n : ℕ ↦ ∑ k ∈ (isolatePolynomial s z).support, + (isolatePolynomial s z).coeff k * + weightedPowerSum s weight (n + k)) =O[atTop] + fun n : ℕ ↦ ρ ^ n) + have hisolated : + (fun n : ℕ ↦ weight z * z ^ n * (isolatePolynomial s z).eval z) =O[atTop] + fun n : ℕ ↦ ρ ^ n := by + simpa only [isolatePolynomial_sum_weightedPowerSum hz] using hfiltered + have hcoefficient : weight z * (isolatePolynomial s z).eval z ≠ 0 := + mul_ne_zero (hweight z hz) isolatePolynomial_eval_self_ne_zero + have hpower : (fun n : ℕ ↦ z ^ n) =O[atTop] fun n : ℕ ↦ ρ ^ n := by + apply (isBigO_const_mul_left_iff hcoefficient).mp + exact hisolated.congr_left fun n ↦ by ring + exact norm_le_of_pow_isBigO hρ hpower + +/-- Simultaneous form of `norm_le_of_mem_of_weightedPowerSum_isBigO`. -/ +theorem weightedPowerSum_base_norm_le + {s : Finset ℂ} {weight : ℂ → ℂ} {ρ : ℝ} + (hρ : 0 ≤ ρ) + (hweight : ∀ z ∈ s, weight z ≠ 0) + (hO : weightedPowerSum s weight =O[atTop] fun n : ℕ ↦ ρ ^ n) : + ∀ z ∈ s, ‖z‖ ≤ ρ := + fun _z hz ↦ norm_le_of_mem_of_weightedPowerSum_isBigO hρ hweight hO hz + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean new file mode 100644 index 0000000000..a0eb5940f7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch + +/-! +# The canonical divisor `-2∞` on the rational function field + +This module constructs an actual infinity place of the identity extension +`K(X) / K(X)`, proves that its residue degree is one, and identifies the +divisor supported there with coefficient `-2` as canonical. The proof uses +the in-repository Riemann--Roch theorem and the proved genus-zero theorem for +`RatFunc K`; it does not assume a base canonical divisor. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] + +local instance ratFuncIdentityInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K (RatFunc K)) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) + (RatFunc K) (RatFuncInfinityIntegralClosure K (RatFunc K)) + +local instance ratFuncIdentityInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K (RatFunc K)) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) (RatFunc K) + +local instance ratFuncIdentityInfinityClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K (RatFunc K)) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) (RatFunc K) + +local instance ratFuncIdentityInfinityClosureNoZeroSMulDivisors : + NoZeroSMulDivisors (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K (RatFunc K)) where + eq_zero_or_eq_zero_of_smul_eq_zero h := smul_eq_zero.mp h + +local instance ratFuncIdentityInfinityClosureIsDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K (RatFunc K)) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) (RatFunc K) + (RatFuncInfinityIntegralClosure K (RatFunc K)) + +local instance ratFuncIdentityInfinityClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K (RatFunc K)) (RatFunc K) := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) (RatFunc K) + (RatFuncInfinityIntegralClosure K (RatFunc K)) + +/-- A place above infinity in the identity extension `K(X) / K(X)`. -/ +noncomputable def ratFuncIdentityInfinityPlace : + FiniteExtensionInfinityPlace K (RatFunc K) := + Classical.choice inferInstance + +omit [Fintype K] in +/-- The chosen identity-extension infinity place has residue degree one. -/ +theorem ratFuncIdentityInfinityPlace_degree_eq_one : + finiteExtensionPlaceDegree K (RatFunc K) + (.inr (ratFuncIdentityInfinityPlace K)) = 1 := by + let P := ratFuncIdentityInfinityPlace K + change P.1.inertiaDeg (RatFuncInfinityIntegers K) = 1 + have hpos : 0 < P.1.inertiaDeg (RatFuncInfinityIntegers K) := + Ideal.inertiaDeg_pos P.1 (RatFuncInfinityIntegers K) + letI : P.1.IsPrime := P.2.1 + letI : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 + letI : (ratFuncInfinityPlace K).asIdeal.IsMaximal := + (ratFuncInfinityPlace K).isPrime.isMaximal (ratFuncInfinityPlace K).ne_bot + have hle : (ratFuncInfinityPlace K).asIdeal.inertiaDeg' P.1 ≤ + Module.finrank (RatFunc K) (RatFunc K) := by + exact Ideal.inertiaDeg_le_finrank + (RatFuncInfinityIntegralClosure K (RatFunc K)) + (RatFunc K) (RatFunc K) P.1 (ratFuncInfinityPlace K).ne_bot + rw [Ideal.inertiaDeg'_eq_inertiaDeg, Module.finrank_self] at hle + omega + +/-- The chosen infinity place in the Riemann--Roch two-chart place model. -/ +noncomputable def ratFuncInfinityChartPlace : + FunctionField.Chart.PlaceA K (RatFunc K) := + finiteExtensionPlaceEquivChart K (RatFunc K) + (.inr (ratFuncIdentityInfinityPlace K)) + +/-- The explicit divisor `-2∞` on `K(X)`. -/ +noncomputable def ratFuncCanonicalInfinityDivisor : + FunctionField.Chart.DivisorA K (RatFunc K) := + Finsupp.single (ratFuncInfinityChartPlace K) (-2) + +/-- The explicit divisor `-2∞` has degree `-2`. -/ +theorem ratFuncCanonicalInfinityDivisor_degree : + FunctionField.Chart.deg K (RatFunc K) + (ratFuncCanonicalInfinityDivisor K) = -2 := by + rw [ratFuncCanonicalInfinityDivisor, FunctionField.Chart.deg_single] + have hdegree := finiteExtensionPlaceDegree_eq_chart K (RatFunc K) + (.inr (ratFuncIdentityInfinityPlace K)) + rw [ratFuncIdentityInfinityPlace_degree_eq_one K] at hdegree + change (1 : ℕ) = FunctionField.Chart.placeDegree K (RatFunc K) + (ratFuncInfinityChartPlace K) at hdegree + rw [← hdegree] + norm_num + +/-- The explicit divisor `-2∞` is canonical on `K(X)`. -/ +theorem ratFuncCanonicalInfinityDivisor_isCanonical : + FunctionField.Chart.IsCanonical K (RatFunc K) + (ratFuncCanonicalInfinityDivisor K) := by + rw [FunctionField.chart_isCanonical_iff_degree_ell] + constructor + · rw [ratFuncCanonicalInfinityDivisor_degree, + FunctionField.Chart.genus_ratFunc] + norm_num + · have hnegative : FunctionField.Chart.deg K (RatFunc K) + (ratFuncCanonicalInfinityDivisor K) < 0 := by + rw [ratFuncCanonicalInfinityDivisor_degree] + norm_num + rw [FunctionField.Chart.RRspace_neg_deg_ell K (RatFunc K) hnegative, + FunctionField.Chart.genus_ratFunc] + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean new file mode 100644 index 0000000000..35e72c752d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean @@ -0,0 +1,305 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Algebra.Polynomial.Module.TensorProduct +import Mathlib.FieldTheory.RatFunc.Basic +import Mathlib.LinearAlgebra.Dimension.Localization +import Mathlib.LinearAlgebra.FiniteDimensional.Basic +import Mathlib.RingTheory.DedekindDomain.Instances +import Mathlib.RingTheory.Localization.LocalizationLocalization +import Mathlib.RingTheory.TensorProduct.Finite + +/-! +# Constant extensions of rational function fields + +For a finite field extension `S / K`, this file constructs the coefficient +embedding `K(X) → S(X)` and proves that `S(X)` is a finite-dimensional +`K(X)`-vector space of dimension `[S : K]`. + +The construction is explicit. We first localize `S[X]` at the images of the +nonzero polynomials in `K[X]`, prove that this localization is a field, and +identify it with `S(X)`. This is the rational-function-field base-change +input needed for the later constant extension of a general function field. +-/ + +open scoped Polynomial nonZeroDivisors + +namespace BGS.HasseWeil + +noncomputable section + +variable (K S : Type*) [Field K] [Field S] [Algebra K S] + +local instance polynomialCoefficientAlgebra : Algebra K[X] S[X] := + (Polynomial.mapRingHom (algebraMap K S)).toAlgebra + +local instance polynomialCoefficientFaithfulSMul : FaithfulSMul K[X] S[X] where + eq_of_smul_eq_smul h := by + have hinj : Function.Injective (algebraMap K[X] S[X]) := by + change Function.Injective (Polynomial.map (algebraMap K S)) + exact Polynomial.map_injective (algebraMap K S) (algebraMap K S).injective + exact hinj (by simpa only [Algebra.smul_def, mul_one] using h 1) + +/-- The coefficient extension on polynomial rings. -/ +noncomputable def ratFuncCoefficientPolynomialAlgHom : K[X] →ₐ[K] S[X] := + Polynomial.mapAlgHom (Algebra.ofId K S) + +theorem ratFuncCoefficientPolynomialAlgHom_injective : + Function.Injective (ratFuncCoefficientPolynomialAlgHom K S) := by + change Function.Injective (Polynomial.map (algebraMap K S)) + exact Polynomial.map_injective (algebraMap K S) (algebraMap K S).injective + +private theorem ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors : + K[X]⁰ ≤ S[X]⁰.comap (ratFuncCoefficientPolynomialAlgHom K S) := + nonZeroDivisors_le_comap_nonZeroDivisors_of_injective _ + (ratFuncCoefficientPolynomialAlgHom_injective K S) + +/-- The canonical coefficient extension `K(X) → S(X)`. -/ +noncomputable def ratFuncCoefficientAlgHom : RatFunc K →ₐ[K] RatFunc S := + RatFunc.mapAlgHom (ratFuncCoefficientPolynomialAlgHom K S) + (ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) + +theorem ratFuncCoefficientAlgHom_injective : + Function.Injective (ratFuncCoefficientAlgHom K S) := + RatFunc.map_injective (ratFuncCoefficientPolynomialAlgHom K S) + (ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) + (ratFuncCoefficientPolynomialAlgHom_injective K S) + +theorem ratFuncCoefficientAlgHom_algebraMap (p : K[X]) : + ratFuncCoefficientAlgHom K S (algebraMap K[X] (RatFunc K) p) = + algebraMap S[X] (RatFunc S) (algebraMap K[X] S[X] p) := by + change RatFunc.map (ratFuncCoefficientPolynomialAlgHom K S) + (ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) + (algebraMap K[X] (RatFunc K) p) = _ + rw [show algebraMap K[X] (RatFunc K) p = + algebraMap K[X] (RatFunc K) p / algebraMap K[X] (RatFunc K) 1 by simp] + rw [RatFunc.map_apply_div] + simp only [map_one, div_one] + congr 1 + +/-- The algebra structure on `S(X)` induced by coefficient extension. -/ +@[reducible] noncomputable def ratFuncCoefficientAlgebra : + Algebra (RatFunc K) (RatFunc S) := + (ratFuncCoefficientAlgHom K S).toAlgebra + +local instance ratFuncCoefficientAlgebraInstance : + Algebra (RatFunc K) (RatFunc S) := + ratFuncCoefficientAlgebra K S + +/-- Localize `S[X]` by the images of all nonzero polynomials in `K[X]`. -/ +abbrev RatFuncConstantLocalization := + Localization (Submonoid.map (algebraMap K[X] S[X]) K[X]⁰) + +local instance ratFuncConstantLocalizationIsDomain : + IsDomain (RatFuncConstantLocalization K S) := + IsLocalization.isDomain_localization + (by + simpa only [Algebra.algebraMapSubmonoid] using + algebraMapSubmonoid_le_nonZeroDivisors_of_faithfulSMul S[X] le_rfl) + +noncomputable local instance ratFuncConstantLocalizationAlgebra : + Algebra (RatFunc K) (RatFuncConstantLocalization K S) := + (IsLocalization.map (RatFuncConstantLocalization K S) + (algebraMap K[X] S[X]) (Submonoid.le_comap_map K[X]⁰)).toAlgebra + +local instance ratFuncConstantLocalizationScalarTower : + IsScalarTower K[X] (RatFunc K) (RatFuncConstantLocalization K S) := + let hmap : K[X]⁰ ≤ Submonoid.comap (algebraMap K[X] S[X]) + (Submonoid.map (algebraMap K[X] S[X]) K[X]⁰) := + Submonoid.le_comap_map K[X]⁰ + IsScalarTower.of_algebraMap_eq' (by + rw [IsScalarTower.algebraMap_eq K[X] S[X] + (RatFuncConstantLocalization K S)] + exact (IsLocalization.map_comp hmap).symm) + +private noncomputable def polynomialModuleEquivPolynomial : + PolynomialModule K S ≃ₗ[K[X]] S[X] where + toEquiv := (PolynomialModule.equivPolynomial (R := K)).toEquiv + map_add' := (PolynomialModule.equivPolynomial (R := K)).map_add + map_smul' p x := by + ext n + change (p • x).coeff n = + ((algebraMap K[X] S[X] p) * + (PolynomialModule.equivPolynomial (R := K) x)).coeff n + rw [PolynomialModule.smul_apply, Polynomial.coeff_mul] + apply Finset.sum_congr rfl + intro ij hij + simp [Algebra.smul_def, PolynomialModule.equivPolynomial] + +local instance polynomialCoefficientModuleFinite [FiniteDimensional K S] : + Module.Finite K[X] S[X] := by + letI : Module.Finite K[X] (TensorProduct K K[X] S) := + Module.Finite.base_change K K[X] S + exact Module.Finite.equiv + ((PolynomialModule.polynomialTensorProductLEquivPolynomialModule K S).trans + (polynomialModuleEquivPolynomial K S)) + +local instance ratFuncConstantLocalizationIsLocalization : + IsLocalization (Algebra.algebraMapSubmonoid S[X] K[X]⁰) + (RatFuncConstantLocalization K S) := by + change IsLocalization (Submonoid.map (algebraMap K[X] S[X]) K[X]⁰) + (RatFuncConstantLocalization K S) + infer_instance + +local instance ratFuncConstantLocalizationFinite [FiniteDimensional K S] : + Module.Finite (RatFunc K) (RatFuncConstantLocalization K S) := + Module.Finite.of_isLocalization K[X] S[X] K[X]⁰ + +noncomputable local instance ratFuncConstantLocalizationField + [FiniteDimensional K S] : Field (RatFuncConstantLocalization K S) := + (IsField.of_isDomain_of_finite (RatFunc K) + (RatFuncConstantLocalization K S)).toField + +private theorem ratFuncConstantLocalizationSubmonoid_le : + Submonoid.map (algebraMap K[X] S[X]) K[X]⁰ ≤ S[X]⁰ := by + simpa only [Algebra.algebraMapSubmonoid] using + algebraMapSubmonoid_le_nonZeroDivisors_of_faithfulSMul S[X] le_rfl + +private noncomputable def ratFuncConstantLocalizationToRatFunc + [FiniteDimensional K S] : + RatFuncConstantLocalization K S →+* RatFunc S := + IsLocalization.map + (M := Submonoid.map (algebraMap K[X] S[X]) K[X]⁰) + (T := S[X]⁰) (RatFunc S) (RingHom.id S[X]) (by + change Submonoid.map (algebraMap K[X] S[X]) K[X]⁰ ≤ S[X]⁰ + exact ratFuncConstantLocalizationSubmonoid_le K S) + +private theorem ratFuncConstantLocalizationToRatFunc_algebraMap + [FiniteDimensional K S] (p : S[X]) : + ratFuncConstantLocalizationToRatFunc K S + (algebraMap S[X] (RatFuncConstantLocalization K S) p) = + algebraMap S[X] (RatFunc S) p := by + let hM : Submonoid.map (algebraMap K[X] S[X]) K[X]⁰ ≤ + S[X]⁰.comap (RingHom.id S[X]) := by + change Submonoid.map (algebraMap K[X] S[X]) K[X]⁰ ≤ S[X]⁰ + exact ratFuncConstantLocalizationSubmonoid_le K S + have h := congrArg (fun f : S[X] →+* RatFunc S => f p) + (IsLocalization.map_comp + (Q := RatFunc S) + (S := RatFuncConstantLocalization K S) hM) + change (IsLocalization.map (RatFunc S) (RingHom.id S[X]) hM) + (algebraMap S[X] (RatFuncConstantLocalization K S) p) = + algebraMap S[X] (RatFunc S) p + simpa only [RingHom.comp_apply, RingHom.id_apply] using h + +private noncomputable def ratFuncToConstantLocalization + [FiniteDimensional K S] : + RatFunc S →+* RatFuncConstantLocalization K S := + IsFractionRing.lift (IsLocalization.injective + (RatFuncConstantLocalization K S) + (ratFuncConstantLocalizationSubmonoid_le K S)) + +private theorem ratFuncToConstantLocalization_algebraMap + [FiniteDimensional K S] (p : S[X]) : + ratFuncToConstantLocalization K S (algebraMap S[X] (RatFunc S) p) = + algebraMap S[X] (RatFuncConstantLocalization K S) p := by + exact IsFractionRing.lift_algebraMap _ p + +/-- The localization of `S[X]` at nonzero `K[X]` is the full rational +function field `S(X)` when `S / K` is finite. -/ +noncomputable def ratFuncConstantLocalizationRingEquiv + [FiniteDimensional K S] : + RatFuncConstantLocalization K S ≃+* RatFunc S where + toFun := ratFuncConstantLocalizationToRatFunc K S + invFun := ratFuncToConstantLocalization K S + map_add' := map_add _ + map_mul' := map_mul _ + left_inv x := by + have hcomp : + (ratFuncToConstantLocalization K S).comp + (ratFuncConstantLocalizationToRatFunc K S) = + RingHom.id (RatFuncConstantLocalization K S) := by + apply IsLocalization.ringHom_ext + (Submonoid.map (algebraMap K[X] S[X]) K[X]⁰) + apply RingHom.ext + intro p + simp only [RingHom.comp_apply, + ratFuncConstantLocalizationToRatFunc_algebraMap, + ratFuncToConstantLocalization_algebraMap, RingHom.id_apply] + exact congrArg + (fun f : RatFuncConstantLocalization K S →+* + RatFuncConstantLocalization K S => f x) hcomp + right_inv x := by + have hcomp : + (ratFuncConstantLocalizationToRatFunc K S).comp + (ratFuncToConstantLocalization K S) = + RingHom.id (RatFunc S) := by + apply IsFractionRing.ringHom_ext (A := S[X]) + intro p + simp only [RingHom.comp_apply, + ratFuncConstantLocalizationToRatFunc_algebraMap, + ratFuncToConstantLocalization_algebraMap, RingHom.id_apply] + exact congrArg (fun f : RatFunc S →+* RatFunc S => f x) hcomp + +theorem ratFuncConstantLocalizationRingEquiv_algebraMap + [FiniteDimensional K S] (r : RatFunc K) : + ratFuncConstantLocalizationRingEquiv K S + (algebraMap (RatFunc K) (RatFuncConstantLocalization K S) r) = + algebraMap (RatFunc K) (RatFunc S) r := by + have hcomp : + (ratFuncConstantLocalizationRingEquiv K S).toRingHom.comp + (algebraMap (RatFunc K) (RatFuncConstantLocalization K S)) = + algebraMap (RatFunc K) (RatFunc S) := by + apply IsFractionRing.ringHom_ext (A := K[X]) + intro p + simp only [RingHom.comp_apply] + rw [← IsScalarTower.algebraMap_apply K[X] (RatFunc K) + (RatFuncConstantLocalization K S)] + rw [IsScalarTower.algebraMap_apply K[X] S[X] + (RatFuncConstantLocalization K S)] + change ratFuncConstantLocalizationToRatFunc K S + (algebraMap S[X] (RatFuncConstantLocalization K S) + (algebraMap K[X] S[X] p)) = + ratFuncCoefficientAlgHom K S (algebraMap K[X] (RatFunc K) p) + rw [ratFuncConstantLocalizationToRatFunc_algebraMap] + exact (ratFuncCoefficientAlgHom_algebraMap K S p).symm + exact congrArg (fun f : RatFunc K →+* RatFunc S => f r) hcomp + +/-- The localization equivalence, now linear over the canonical coefficient +embedding `K(X) → S(X)`. -/ +noncomputable def ratFuncConstantLocalizationLinearEquiv + [FiniteDimensional K S] : + RatFuncConstantLocalization K S ≃ₗ[RatFunc K] RatFunc S where + toEquiv := (ratFuncConstantLocalizationRingEquiv K S).toEquiv + map_add' := map_add (ratFuncConstantLocalizationRingEquiv K S) + map_smul' r x := by + change ratFuncConstantLocalizationRingEquiv K S + (algebraMap (RatFunc K) (RatFuncConstantLocalization K S) r * x) = + algebraMap (RatFunc K) (RatFunc S) r * + ratFuncConstantLocalizationRingEquiv K S x + rw [map_mul, ratFuncConstantLocalizationRingEquiv_algebraMap] + +/-- A finite coefficient extension induces a finite extension of rational +function fields. -/ +theorem ratFuncCoefficient_moduleFinite [FiniteDimensional K S] : + Module.Finite (RatFunc K) (RatFunc S) := + Module.Finite.equiv (ratFuncConstantLocalizationLinearEquiv K S) + +/-- Constant extension preserves the extension degree of rational function +fields: `[S(X) : K(X)] = [S : K]`. -/ +theorem ratFuncCoefficient_finrank [FiniteDimensional K S] : + Module.finrank (RatFunc K) (RatFunc S) = Module.finrank K S := by + let ePoly := + (PolynomialModule.polynomialTensorProductLEquivPolynomialModule K S).trans + (polynomialModuleEquivPolynomial K S) + calc + Module.finrank (RatFunc K) (RatFunc S) = + Module.finrank (RatFunc K) (RatFuncConstantLocalization K S) := + (ratFuncConstantLocalizationLinearEquiv K S).finrank_eq.symm + _ = Module.finrank K[X] (RatFuncConstantLocalization K S) := by + simpa only [Module.finrank] using congrArg Cardinal.toNat + (IsLocalization.rank_eq + (N := RatFuncConstantLocalization K S) (RatFunc K) K[X]⁰ le_rfl) + _ = Module.finrank K[X] S[X] := by + exact IsLocalizedModule.finrank_eq K[X]⁰ + (IsScalarTower.toAlgHom K[X] S[X] + (RatFuncConstantLocalization K S)).toLinearMap le_rfl + _ = Module.finrank K[X] (TensorProduct K K[X] S) := ePoly.finrank_eq.symm + _ = Module.finrank K S := Module.finrank_baseChange + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean new file mode 100644 index 0000000000..703c24a4f9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean @@ -0,0 +1,472 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +import Mathlib.FieldTheory.RatFunc.AsPolynomial +import Mathlib.RingTheory.Flat.Stability + +/-! +# The rational-function field in an exact constant extension + +Let `C` be the exact constant field of a function field `N / C(X)`, and let +`S / C` be a finite Galois extension. The tensor product `S ⊗[C] N` is then +a field. This file constructs its canonical `S(X)`-algebra structure and +proves that it is compatible with both copies of `C(X)`. + +For finite Galois `N / C(X)`, the tensor product is finite and separable over +`S(X)`. The final equivalence identifies the polynomial normalization after +constant extension with the normalization used by the project's finite-place +model. +-/ + +open scoped Polynomial TensorProduct nonZeroDivisors + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier + +noncomputable section + + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Algebra (RatFunc C) N] [Algebra C S] + [FiniteDimensional C S] [IsGalois C S] + +local instance constantAlgebra : Algebra C N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C (RatFunc C))) + +-- Save these instances before installing the competing `C[X]`-algebra on `N`. +@[reducible] private noncomputable def canonicalRatFuncPolynomialAlgebra : + Algebra C[X] (RatFunc C) := inferInstance + +private theorem canonicalRatFuncFractionRing : + letI := canonicalRatFuncPolynomialAlgebra C + IsFractionRing C[X] (RatFunc C) := by + letI := canonicalRatFuncPolynomialAlgebra C + infer_instance + +local instance polynomialAlgebra : Algebra C[X] N := + RingHom.toAlgebra ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + +local instance ratFuncCoefficientPolynomialAlgebra : Algebra C[X] S[X] := + Polynomial.algebra C S + +local instance coefficientPolynomialModule : Module C[X] S[X] := + Algebra.toModule + +local instance coefficientPolynomialFlat : Module.Flat C[X] S[X] := by + letI : Module.Flat C[X] (TensorProduct C C[X] S) := inferInstance + exact Module.Flat.of_linearEquiv + (Algebra.IsPushout.equiv C C[X] S S[X]).symm.toLinearEquiv + +local instance constantPolynomialTower : IsScalarTower C C[X] N := + IsScalarTower.of_algebraMap_eq' (by + ext c + change algebraMap (RatFunc C) N (algebraMap C (RatFunc C) c) = + algebraMap (RatFunc C) N + (algebraMap C[X] (RatFunc C) (Polynomial.C c)) + congr 1) + +private theorem polynomialAlgebraMap_injective : + Function.Injective (algebraMap C[X] N) := by + change Function.Injective + ((algebraMap (RatFunc C) N).comp (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) N).injective.comp + (RatFunc.algebraMap_injective C) + +local instance targetPolynomialAlgebra : + Algebra S[X] (ExactConstantExtension C N S) := + polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N + +omit [FiniteDimensional C S] in +private theorem targetPolynomialAlgebraMap_injective : + Function.Injective + (algebraMap S[X] (ExactConstantExtension C N S)) := by + intro p q hpq + let e := polynomialTensorCancelOverCoefficientPolynomial C S N + have hleft : + (Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S[X]] TensorProduct C[X] S[X] N) p = + (Algebra.TensorProduct.includeLeft : + S[X] →ₐ[S[X]] TensorProduct C[X] S[X] N) q := by + apply e.injective + calc + e (Algebra.TensorProduct.includeLeft p) = + algebraMap S[X] (ExactConstantExtension C N S) p := e.commutes p + _ = algebraMap S[X] (ExactConstantExtension C N S) q := hpq + _ = e (Algebra.TensorProduct.includeLeft q) := (e.commutes q).symm + exact Algebra.TensorProduct.includeLeft_injective + (polynomialAlgebraMap_injective C N) hleft + +omit [FiniteDimensional C S] [IsGalois C S] in +private theorem targetEvaluation_coefficientPolynomial (p : C[X]) : + Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S N) + (algebraMap C[X] S[X] p) = + (1 : S) ⊗ₜ[C] (algebraMap C[X] N p) := by + let e := polynomialTensorCancelOverCoefficientPolynomial C S N + have hsource : + (algebraMap C[X] S[X] p) ⊗ₜ[C[X]] (1 : N) = + (1 : S[X]) ⊗ₜ[C[X]] (algebraMap C[X] N p) := by + exact Algebra.TensorProduct.tmul_one_eq_one_tmul p + calc + Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S N) + (algebraMap C[X] S[X] p) = + e ((algebraMap C[X] S[X] p) ⊗ₜ[C[X]] (1 : N)) := by + exact (e.commutes (algebraMap C[X] S[X] p)).symm + _ = e ((1 : S[X]) ⊗ₜ[C[X]] (algebraMap C[X] N p)) := + congrArg e hsource + _ = (1 : S) ⊗ₜ[C] (algebraMap C[X] N p) := by + rw [polynomialTensorCancelOverCoefficientPolynomial_apply, + polynomialTensorCancel_tmul] + simp + +section Exact + +variable (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + +/-- The canonical copy of `S(X)` inside the exact constant extension, +obtained by extending the evaluated `S[X]`-algebra map. -/ +noncomputable def ratFuncToExactConstantExtension : + RatFunc S →ₐ[S] ExactConstantExtension C N S := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + let hpoly := targetPolynomialAlgebraMap_injective C S N + exact RatFunc.liftAlgHom + (Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N)) + (nonZeroDivisors_le_comap_nonZeroDivisors_of_injective _ hpoly) + +theorem ratFuncToExactConstantExtension_injective : + Function.Injective + (ratFuncToExactConstantExtension C S N hExact) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + let hpoly := targetPolynomialAlgebraMap_injective C S N + exact RatFunc.liftAlgHom_injective + (Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N)) hpoly + +theorem ratFuncToExactConstantExtension_algebraMap (p : S[X]) : + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) = + Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) p := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + change RatFunc.liftAlgHom _ _ (algebraMap S[X] (RatFunc S) p) = _ + exact RatFunc.liftRingHom_algebraMap _ _ p + +theorem ratFuncToExactConstantExtension_X : + ratFuncToExactConstantExtension C S N hExact RatFunc.X = + polynomialTensorCancelEvaluationPoint C S N := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + calc + ratFuncToExactConstantExtension C S N hExact RatFunc.X = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) Polynomial.X) := by + apply congrArg (ratFuncToExactConstantExtension C S N hExact) + exact (RatFunc.algebraMap_X (K := S)).symm + _ = Polynomial.aeval + (polynomialTensorCancelEvaluationPoint C S N) Polynomial.X := + ratFuncToExactConstantExtension_algebraMap C S N hExact Polynomial.X + _ = polynomialTensorCancelEvaluationPoint C S N := by + exact Polynomial.aeval_X _ + +/-- The algebra structure induced by the canonical copy of `S(X)`. -/ +@[reducible] noncomputable def ratFuncExactConstantExtensionAlgebra : + Algebra (RatFunc S) (ExactConstantExtension C N S) := + (ratFuncToExactConstantExtension C S N hExact).toAlgebra + +/-- The copy of `C(X)` obtained through coefficient extension to `S(X)` +agrees with the copy coming from the right tensor factor `N`. -/ +theorem rationalBase_algebraMap_eq : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + algebraMap (RatFunc C) (ExactConstantExtension C N S) = + (algebraMap (RatFunc S) (ExactConstantExtension C N S)).comp + (algebraMap (RatFunc C) (RatFunc S)) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra C[X] (RatFunc C) := canonicalRatFuncPolynomialAlgebra C + letI : IsFractionRing C[X] (RatFunc C) := canonicalRatFuncFractionRing C + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + apply IsFractionRing.ringHom_ext (A := C[X]) + intro p + change + (1 : S) ⊗ₜ[C] + algebraMap (RatFunc C) N (algebraMap C[X] (RatFunc C) p) = + ratFuncToExactConstantExtension C S N hExact + (ratFuncCoefficientAlgHom C S + (algebraMap C[X] (RatFunc C) p)) + rw [ratFuncCoefficientAlgHom_algebraMap] + change + (1 : S) ⊗ₜ[C] + algebraMap (RatFunc C) N (algebraMap C[X] (RatFunc C) p) = + ratFuncToExactConstantExtension C S N hExact + (RatFunc.mk (algebraMap C[X] S[X] p) 1) + rw [RatFunc.mk_eq_localization_mk _ one_ne_zero] + change _ = RatFunc.liftAlgHom _ _ + (RatFunc.ofFractionRing + (Localization.mk (algebraMap C[X] S[X] p) (1 : S[X]⁰))) + rw [RatFunc.liftAlgHom_apply_ofFractionRing_mk] + have hone : + Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S N) + ((1 : S[X]⁰) : S[X]) = 1 := by + exact map_one _ + rw [hone, div_one] + change (1 : S) ⊗ₜ[C] (algebraMap C[X] N p) = _ + exact (targetEvaluation_coefficientPolynomial C S N p).symm + +/-- The rational-function coefficient extension and the exact constant +extension form a scalar tower. -/ +theorem rationalBase_scalarTower : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + IsScalarTower (RatFunc C) (RatFunc S) + (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + exact IsScalarTower.of_algebraMap_eq' + (rationalBase_algebraMap_eq C S N hExact) + +section FiniteTop + +variable [FiniteDimensional (RatFunc C) N] + +/-- If `N / C(X)` is finite, then the exact constant extension is finite over +the enlarged rational function field `S(X)`. -/ +theorem finiteDimensional_over_extendedRatFunc : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Module (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toModule + letI : IsScalarTower (RatFunc C) (RatFunc S) + (ExactConstantExtension C N S) := + rationalBase_scalarTower C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + let e := exactConstantExtensionLinearEquiv C N S + letI : Module.Finite N (N ⊗[C] S) := + Module.Finite.base_change C N S + letI : Module.Finite N (ExactConstantExtension C N S) := + Module.Finite.equiv e + letI : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := + Module.Finite.trans N (ExactConstantExtension C N S) + exact Module.Finite.of_restrictScalars_finite + (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) + +section SeparableTop + +variable [Algebra.IsSeparable (RatFunc C) N] + +include hExact + +/-- For a finite separable `N / C(X)`, the exact constant extension remains +separable over the original rational function field `C(X)`. -/ +theorem isSeparable_exactConstantExtension_over_baseRatFunc : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toSMul + letI : Module (RatFunc C) (ExactConstantExtension C N S) := + Algebra.toModule + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + exact Algebra.IsSeparable.trans + (RatFunc C) N (ExactConstantExtension C N S) + +/-- For a finite separable `N / C(X)`, the exact constant extension is separable +over the enlarged rational function field `S(X)`. -/ +theorem isSeparable_over_extendedRatFunc : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : IsScalarTower C (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra (RatFunc C) (RatFunc S) := + ratFuncCoefficientAlgebra C S + letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + letI : IsScalarTower (RatFunc C) (RatFunc S) + (ExactConstantExtension C N S) := + rationalBase_scalarTower C S N hExact + letI : Algebra N (ExactConstantExtension C N S) := + exactConstantExtensionAlgebra C N S + letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + letI : Module N (ExactConstantExtension C N S) := Algebra.toModule + letI : IsScalarTower (RatFunc C) N + (ExactConstantExtension C N S) := + exactConstantExtensionBaseTower C (RatFunc C) N S + letI : IsGalois N (ExactConstantExtension C N S) := + exactConstantExtension_isGalois C N N S hExact + letI : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + exact Algebra.isSeparable_tower_top_of_isSeparable + (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) + +end SeparableTop + +end FiniteTop + +/-- The constant field, its rational function field, and the exact constant +extension form a scalar tower. -/ +theorem scalarTower_constant_ratFunc_exactConstantExtension : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + IsScalarTower S (RatFunc S) (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + Algebra.toSMul + apply IsScalarTower.of_algebraMap_eq' + ext s + exact (ratFuncToExactConstantExtension C S N hExact).commutes s |>.symm + +section Normalization + +variable [Fintype C] [Finite S] + +/-- The polynomial normalization obtained after extending the constants is +the normalization used by the rational-function finite-place model. -/ +noncomputable def exactConstantExtensionNormalizationAlgEquiv : + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + constantExtensionNormalizationTensorPolynomialAlgebra C S N + S ⊗[C] integralClosure C[X] N ≃ₐ[S[X]] + RatFuncFiniteIntegralClosure S (ExactConstantExtension C N S) := by + letI : Field (ExactConstantExtension C N S) := + exactConstantExtensionField C N S hExact + letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + ratFuncExactConstantExtensionAlgebra C S N hExact + letI : Algebra S[X] (S ⊗[C] integralClosure C[X] N) := + constantExtensionNormalizationTensorPolynomialAlgebra C S N + exact normalizationAlgEquivRatFuncFiniteOfAlgebraMap + S (ExactConstantExtension C N S) + (S ⊗[C] integralClosure C[X] N) + (constantExtensionTensorPolynomialAlgebra C S N) + (finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N) + (ratFuncToExactConstantExtension_algebraMap C S N hExact) + +end Normalization + +end Exact + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean new file mode 100644 index 0000000000..648834718c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean @@ -0,0 +1,455 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +import Mathlib.Algebra.Polynomial.Reverse +import Mathlib.RingTheory.Localization.AtPrime.Basic +import Mathlib.RingTheory.Localization.Integral + +/-! +# The infinity valuation ring as a reciprocal localization + +Writing `Y = X⁻¹`, a rational function is regular at infinity exactly when +it belongs to the local ring `K[Y]_(Y)`. This file proves that statement for +the repository's valuation-ring model `RatFuncInfinityIntegers K`. + +The proof is explicit: a function of nonpositive integer degree is written +using the reversed numerator and denominator. This localization model is +the bridge needed to transport polynomial normalization under finite constant +extension to places above infinity. +-/ + +open scoped Polynomial nonZeroDivisors + +open IsDedekindDomain Multiplicative WithZero + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + +local instance : Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +/-- Evaluate a polynomial in the reciprocal coordinate `X⁻¹`. -/ +noncomputable def reciprocalPolynomialRingHom : + K[X] →+* RatFuncInfinityIntegers K := + Polynomial.eval₂RingHom (ratFuncInfinityConstantRingHom K) + (ratFuncInfinityUniformizer K) + +/-- The polynomial algebra structure on the infinity valuation ring in the +reciprocal coordinate. Its variable is the uniformizer `X⁻¹`. -/ +@[reducible] +noncomputable def ratFuncInfinityReciprocalPolynomialAlgebra : + Algebra K[X] (RatFuncInfinityIntegers K) := + (reciprocalPolynomialRingHom K).toAlgebra + +local instance reciprocalPolynomialAlgebra : + Algebra K[X] (RatFuncInfinityIntegers K) := + ratFuncInfinityReciprocalPolynomialAlgebra K + +local instance reciprocalSpanXPrime : + (Ideal.span ({Polynomial.X} : Set K[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +@[simp] theorem reciprocalPolynomialRingHom_X : + reciprocalPolynomialRingHom K Polynomial.X = + ratFuncInfinityUniformizer K := by + simp [reciprocalPolynomialRingHom] + +@[simp] theorem reciprocalPolynomialRingHom_C (c : K) : + reciprocalPolynomialRingHom K (Polynomial.C c) = + algebraMap K (RatFuncInfinityIntegers K) c := by + unfold reciprocalPolynomialRingHom + change Polynomial.eval₂ (ratFuncInfinityConstantRingHom K) + (ratFuncInfinityUniformizer K) (Polynomial.C c) = _ + rw [Polynomial.eval₂_C] + rfl + +@[simp] theorem reciprocalPolynomialAlgebraMap_eq (p : K[X]) : + algebraMap K[X] (RatFuncInfinityIntegers K) p = + reciprocalPolynomialRingHom K p := rfl + +@[simp] theorem reciprocalPolynomialRingHom_coe (p : K[X]) : + ((reciprocalPolynomialRingHom K p : + RatFuncInfinityIntegers K) : RatFunc K) = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p := by + induction p using Polynomial.induction_on' with + | add p q hp hq => + rw [map_add, Polynomial.eval₂_add] + change ((reciprocalPolynomialRingHom K p : + RatFuncInfinityIntegers K) : RatFunc K) + + ((reciprocalPolynomialRingHom K q : + RatFuncInfinityIntegers K) : RatFunc K) = _ + rw [hp, hq] + | monomial n c => + simp [reciprocalPolynomialRingHom, ratFuncInfinityUniformizer, + ratFuncInfinityConstantRingHom] + +theorem reciprocalPolynomialRingHom_isUnit_of_coeff_zero_ne_zero + (p : K[X]) (hp : p.coeff 0 ≠ 0) : + IsUnit (reciprocalPolynomialRingHom K p) := by + by_contra hunit + have hmap : reciprocalPolynomialRingHom K p ∈ + (ratFuncInfinityPlace K).asIdeal := by + change reciprocalPolynomialRingHom K p ∈ + IsLocalRing.maximalIdeal (RatFuncInfinityIntegers K) + rw [IsLocalRing.mem_maximalIdeal] + exact hunit + obtain ⟨r, hr⟩ := (Polynomial.X_dvd_sub_C (p := p)) + have hdiff : reciprocalPolynomialRingHom K + (p - Polynomial.C (p.coeff 0)) ∈ + (ratFuncInfinityPlace K).asIdeal := by + rw [hr, map_mul, reciprocalPolynomialRingHom_X] + rw [ratFuncInfinityPlace_span_uniformizer] + rw [mul_comm] + exact Ideal.mul_mem_left _ _ (Ideal.mem_span_singleton_self _) + have hconst : reciprocalPolynomialRingHom K + (Polynomial.C (p.coeff 0)) ∈ (ratFuncInfinityPlace K).asIdeal := by + have := (ratFuncInfinityPlace K).asIdeal.sub_mem hmap hdiff + simpa only [map_sub, sub_sub_cancel] using this + have hunit : IsUnit (reciprocalPolynomialRingHom K + (Polynomial.C (p.coeff 0))) := by + rw [reciprocalPolynomialRingHom_C] + exact (isUnit_iff_ne_zero.mpr hp).map + (algebraMap K (RatFuncInfinityIntegers K)) + change reciprocalPolynomialRingHom K (Polynomial.C (p.coeff 0)) ∈ + IsLocalRing.maximalIdeal (RatFuncInfinityIntegers K) at hconst + rw [IsLocalRing.mem_maximalIdeal] at hconst + exact hconst hunit + +theorem reciprocalPolynomialRingHom_injective : + Function.Injective (reciprocalPolynomialRingHom K) := by + intro p q hpq + apply sub_eq_zero.mp + have heval : Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) (p - q) = 0 := by + have hzero : reciprocalPolynomialRingHom K (p - q) = 0 := by + rw [map_sub, hpq, sub_self] + have hzeroVal : + ((reciprocalPolynomialRingHom K (p - q) : + RatFuncInfinityIntegers K) : RatFunc K) = 0 := by + simpa using congrArg Subtype.val hzero + rw [reciprocalPolynomialRingHom_coe] at hzeroVal + exact hzeroVal + have htrans : Transcendental K ((RatFunc.X : RatFunc K)⁻¹) := by + rw [Transcendental, IsAlgebraic.inv_iff] + exact RatFunc.transcendental_X + rw [one_div] at heval + exact (transcendental_iff.mp htrans (p - q)) (by + simpa [Polynomial.aeval_def] using heval) + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +@[simp] theorem polynomialEvalRatFuncX_eq_algebraMap (p : K[X]) : + Polynomial.eval₂ RatFunc.C RatFunc.X p = + algebraMap K[X] (RatFunc K) p := by + induction p using Polynomial.induction_on' with + | add p q hp hq => simp [hp, hq] + | monomial n c => simp + +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem eval_reciprocal_reverse_mul_X_pow (p : K[X]) : + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p.reverse * + RatFunc.X ^ p.natDegree = + algebraMap K[X] (RatFunc K) p := by + letI : Invertible (RatFunc.X : RatFunc K) := + invertibleOfNonzero RatFunc.X_ne_zero + simpa [invOf_eq_inv, one_div] using + (Polynomial.eval₂_reverse_mul_pow RatFunc.C + (RatFunc.X : RatFunc K) p) + +theorem reciprocalPolynomialRingHom_surj + (z : RatFuncInfinityIntegers K) : + ∃ x : K[X] × (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl, + z * algebraMap K[X] (RatFuncInfinityIntegers K) x.2 = + algebraMap K[X] (RatFuncInfinityIntegers K) x.1 := by + let f : RatFunc K := z + by_cases hf : f = 0 + · refine ⟨⟨0, ⟨1, ?_⟩⟩, ?_⟩ + · simp + · apply Subtype.ext + change f * _ = _ + simp [hf] + have hdegree : f.intDegree ≤ 0 := by + have hz := z.property + change RatFunc.inftyValuation K f ≤ 1 at hz + rw [RatFunc.inftyValuation_apply, + RatFunc.inftyValuation_of_nonzero K hf, + ← WithZero.exp_zero, WithZero.exp_le_exp] at hz + exact hz + have hnd : f.num.natDegree ≤ f.denom.natDegree := by + rw [RatFunc.intDegree] at hdegree + omega + let a : K[X] := f.num.reverse * + Polynomial.X ^ (f.denom.natDegree - f.num.natDegree) + let b : K[X] := f.denom.reverse + have hbcoeff : b.coeff 0 ≠ 0 := by + change f.denom.reverse.coeff 0 ≠ 0 + rw [Polynomial.coeff_zero_reverse] + exact Polynomial.leadingCoeff_ne_zero.mpr f.denom_ne_zero + have hb : b ∈ (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl := by + change b ∉ Ideal.span ({Polynomial.X} : Set K[X]) + intro hspan + rw [Ideal.mem_span_singleton, Polynomial.X_dvd_iff] at hspan + exact hbcoeff hspan + refine ⟨⟨a, ⟨b, hb⟩⟩, ?_⟩ + apply Subtype.ext + change f * + ((algebraMap K[X] (RatFuncInfinityIntegers K) b : + RatFuncInfinityIntegers K) : RatFunc K) = + ((algebraMap K[X] (RatFuncInfinityIntegers K) a : + RatFuncInfinityIntegers K) : RatFunc K) + rw [reciprocalPolynomialAlgebraMap_eq, + reciprocalPolynomialAlgebraMap_eq, + reciprocalPolynomialRingHom_coe, + reciprocalPolynomialRingHom_coe] + apply (mul_right_cancel₀ (pow_ne_zero f.denom.natDegree + RatFunc.X_ne_zero)) + rw [mul_assoc] + have hden := eval_reciprocal_reverse_mul_X_pow K f.denom + have hnum := eval_reciprocal_reverse_mul_X_pow K f.num + change f * (Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) b * + RatFunc.X ^ f.denom.natDegree) = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) a * + RatFunc.X ^ f.denom.natDegree + rw [show Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) b * + RatFunc.X ^ f.denom.natDegree = + algebraMap K[X] (RatFunc K) f.denom by exact hden] + have hleft : f * algebraMap K[X] (RatFunc K) f.denom = + algebraMap K[X] (RatFunc K) f.num := by + calc + f * algebraMap K[X] (RatFunc K) f.denom = + (algebraMap K[X] (RatFunc K) f.num / + algebraMap K[X] (RatFunc K) f.denom) * + algebraMap K[X] (RatFunc K) f.denom := by + congr 1 + exact (RatFunc.num_div_denom f).symm + _ = algebraMap K[X] (RatFunc K) f.num := + div_mul_cancel₀ _ + (RatFunc.algebraMap_ne_zero f.denom_ne_zero) + rw [hleft, ← hnum] + change Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) f.num.reverse * + RatFunc.X ^ f.num.natDegree = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) a * + RatFunc.X ^ f.denom.natDegree + rw [show Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) a = + Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) f.num.reverse * + (1 / RatFunc.X) ^ + (f.denom.natDegree - f.num.natDegree) by + simp [a]] + rw [mul_assoc] + congr 1 + rw [one_div, inv_pow] + rw [show RatFunc.X ^ f.denom.natDegree = + RatFunc.X ^ (f.denom.natDegree - f.num.natDegree) * + RatFunc.X ^ f.num.natDegree by + exact (pow_sub_mul_pow RatFunc.X hnd).symm] + rw [← mul_assoc, inv_mul_cancel₀] + · simp + · exact pow_ne_zero _ RatFunc.X_ne_zero + +/-- The infinity valuation ring is the localization of the reciprocal +polynomial coordinate ring at the origin. -/ +theorem ratFuncInfinityIntegers_isLocalization_reciprocal : + IsLocalization + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl + (RatFuncInfinityIntegers K) := by + rw [isLocalization_iff] + constructor + · intro y + apply reciprocalPolynomialRingHom_isUnit_of_coeff_zero_ne_zero K + intro hy0 + apply y.2 + change (y : K[X]) ∈ Ideal.span ({Polynomial.X} : Set K[X]) + rw [Ideal.mem_span_singleton, Polynomial.X_dvd_iff] + exact hy0 + constructor + · exact reciprocalPolynomialRingHom_surj K + · intro x y hxy + refine ⟨1, ?_⟩ + simp only [Submonoid.coe_one, one_mul] + exact reciprocalPolynomialRingHom_injective K hxy + +local instance ratFuncInfinityIntegersReciprocalLocalization : + IsLocalization + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl + (RatFuncInfinityIntegers K) := + ratFuncInfinityIntegers_isLocalization_reciprocal K + +/-- Canonical localization model for the infinity valuation ring, with the +polynomial variable corresponding to `X⁻¹`. -/ +noncomputable def reciprocalPolynomialAtOriginAlgEquivInfinityIntegers : + Localization.AtPrime (Ideal.span ({Polynomial.X} : Set K[X])) ≃ₐ[K[X]] + RatFuncInfinityIntegers K := + IsLocalization.algEquiv + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl + (Localization.AtPrime (Ideal.span ({Polynomial.X} : Set K[X]))) + (RatFuncInfinityIntegers K) + +section Extension + +variable (N : Type*) [Field N] [Algebra (RatFunc K) N] + +local instance infinityLocalizationConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance infinityLocalizationReciprocalPolynomialAlgebra : + Algebra K[X] (RatFuncInfinityIntegers K) := + ratFuncInfinityReciprocalPolynomialAlgebra K + +local instance infinityLocalizationSpanXPrime : + (Ideal.span ({Polynomial.X} : Set K[X])).IsPrime := + (Ideal.span_singleton_prime Polynomial.X_ne_zero).mpr Polynomial.prime_X + +/-- Reciprocal polynomial structure on an extension of `K(X)`. The variable +acts as the image of `X⁻¹`. -/ +@[reducible] +noncomputable def ratFuncExtensionReciprocalPolynomialAlgebra : + Algebra K[X] N := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) N).comp + (reciprocalPolynomialRingHom K)) + +local instance infinityLocalizationExtensionPolynomialAlgebra : + Algebra K[X] N := + ratFuncExtensionReciprocalPolynomialAlgebra K N + +local instance infinityLocalizationPolynomialTower : + IsScalarTower K[X] (RatFuncInfinityIntegers K) N := + IsScalarTower.of_algebraMap_eq' rfl + +local instance infinityLocalizationBase : + IsLocalization + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl + (RatFuncInfinityIntegers K) := + ratFuncInfinityIntegers_isLocalization_reciprocal K + +private theorem extensionReciprocalPolynomialAlgMap_injective : + Function.Injective (algebraMap K[X] N) := by + intro p q hpq + apply reciprocalPolynomialRingHom_injective K + apply Subtype.ext + apply (algebraMap (RatFunc K) N).injective + exact hpq + +local instance infinityLocalizationExtensionPolynomialFaithful : + FaithfulSMul K[X] N := by + rw [faithfulSMul_iff_algebraMap_injective] + exact extensionReciprocalPolynomialAlgMap_injective K N + +private theorem extensionReciprocalPrimeCompl_maps_nonzero : + (0 : N) ∉ Algebra.algebraMapSubmonoid N + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl := by + intro h0 + have hle := algebraMapSubmonoid_le_nonZeroDivisors_of_faithfulSMul + N (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl_le_nonZeroDivisors + exact (nonZeroDivisors.ne_zero (hle h0)) rfl + +private theorem fieldSelf_isLocalization (M : Submonoid N) + (hM : (0 : N) ∉ M) : IsLocalization M N := by + rw [isLocalization_iff] + constructor + · intro y + exact isUnit_iff_ne_zero.mpr (fun hy ↦ hM (hy ▸ y.2)) + constructor + · intro z + exact ⟨⟨z, 1⟩, by simp⟩ + · intro x y hxy + exact ⟨1, by simpa using hxy⟩ + +local instance infinityLocalizationExtensionSelf : + IsLocalization + (Algebra.algebraMapSubmonoid N + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl) N := + fieldSelf_isLocalization N _ + (extensionReciprocalPrimeCompl_maps_nonzero K N) + +local instance reciprocalPolynomialInfinityIntegralClosureAlgebra : + Algebra K[X] (RatFuncInfinityIntegralClosure K N) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K N)).comp + (algebraMap K[X] (RatFuncInfinityIntegers K))) + +local instance reciprocalPolynomialInfinityIntegralClosureTower : + IsScalarTower K[X] (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K N) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Inclusion of the reciprocal affine normalization into its localization +at infinity. -/ +noncomputable def reciprocalIntegralClosureToInfinityAlgHom : + integralClosure K[X] N →ₐ[K[X]] RatFuncInfinityIntegralClosure K N := + { toFun := fun x ↦ ⟨x.1, x.2.tower_top⟩ + map_one' := rfl + map_mul' := fun _ _ ↦ rfl + map_zero' := rfl + map_add' := fun _ _ ↦ rfl + commutes' := fun _ ↦ rfl } + +/-- Algebra structure on the infinity normalization induced by localizing the +reciprocal affine normalization. -/ +@[reducible] +noncomputable def ratFuncInfinityReciprocalIntegralClosureAlgebra : + Algebra (integralClosure K[X] N) + (RatFuncInfinityIntegralClosure K N) := + (reciprocalIntegralClosureToInfinityAlgHom K N).toAlgebra + +local instance reciprocalIntegralClosureInfinityAlgebra : + Algebra (integralClosure K[X] N) + (RatFuncInfinityIntegralClosure K N) := + ratFuncInfinityReciprocalIntegralClosureAlgebra K N + +local instance reciprocalIntegralClosureInfinityAmbientTower : + IsScalarTower (integralClosure K[X] N) + (RatFuncInfinityIntegralClosure K N) N := + ⟨fun r s x ↦ by + simp only [Algebra.smul_def, map_mul] + change (r : N) * (s : N) * x = (r : N) * ((s : N) * x) + ring⟩ + +local instance reciprocalPolynomialIntegralClosuresTower : + IsScalarTower K[X] (integralClosure K[X] N) + (RatFuncInfinityIntegralClosure K N) := + IsScalarTower.of_algebraMap_eq fun p ↦ by + apply Subtype.ext + change algebraMap K[X] N p = algebraMap K[X] N p + rfl + +/-- The infinity integral closure is the localization of the reciprocal +affine normalization away from the origin. -/ +theorem ratFuncInfinityIntegralClosure_isLocalization_reciprocal : + IsLocalization + (Algebra.algebraMapSubmonoid (integralClosure K[X] N) + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl) + (RatFuncInfinityIntegralClosure K N) := by + letI : IsScalarTower K[X] (integralClosure K[X] N) + (RatFuncInfinityIntegralClosure K N) := + reciprocalPolynomialIntegralClosuresTower K N + exact @IsLocalization.integralClosure + K[X] _ N _ (ratFuncExtensionReciprocalPolynomialAlgebra K N) + (RatFuncInfinityIntegers K) N _ _ + (ratFuncInfinityReciprocalPolynomialAlgebra K) + (inferInstance : Algebra N N) + (inferInstance : Algebra (RatFuncInfinityIntegers K) N) + (ratFuncExtensionReciprocalPolynomialAlgebra K N) + (inferInstance : IsScalarTower K[X] N N) + (infinityLocalizationPolynomialTower K N) + (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl + (infinityLocalizationBase K) + (infinityLocalizationExtensionSelf K N) + (ratFuncInfinityReciprocalIntegralClosureAlgebra K N) + (reciprocalIntegralClosureInfinityAmbientTower K N) + (reciprocalPolynomialIntegralClosuresTower K N) + +end Extension + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean new file mode 100644 index 0000000000..ea247a6f23 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean @@ -0,0 +1,297 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +import Mathlib.Tactic + +/-! +# The rational parameter's pole divisor in a finite extension + +For a finite separable extension `L / K(X)`, the image of `RatFunc.X` is +integral at every finite place. At a place `P` above infinity its order is +exactly `-e(P)`, because `X⁻¹` is the uniformizer of the base infinity place. +Consequently its complete pole divisor is supported exactly above infinity, +with coefficient `e(P)`, and its height is `[L : K(X)]` by the +ramification--inertia degree formula. + +These statements do not require the constant field `K` to be finite. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped nonZeroDivisors Polynomial BigOperators + +noncomputable section + +attribute [local instance] FractionRing.liftAlgebra + FractionRing.isScalarTower_liftAlgebra + +variable (K : Type*) [Field K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance (priority := 10) ratFuncParameterPolynomialAlgebra : + Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance ratFuncParameterPolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance ratFuncParameterFiniteIntegralClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance ratFuncParameterFiniteIntegralClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance ratFuncParameterPolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance ratFuncParameterFiniteIntegralClosureIsTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance ratFuncParameterInfinityIntegralClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance ratFuncParameterInfinityIntegralClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance ratFuncParameterInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance ratFuncParameterInfinityIntegralClosureIsTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance ratFuncParameterInfinityIntegralClosureIsDedekindDomain : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance ratFuncParameterInfinityIntegralClosureIsFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance ratFuncParameterInfinityPlaceFintype : + Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype + (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + +/-- The rational parameter `X` is integral at every finite place. -/ +theorem finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative + (q : FiniteExtensionFinitePlace K L) : + 0 ≤ finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) (.inl q) := by + let S := RatFuncFiniteIntegralClosure K L + let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L + let s : S := algebraMap K[X] S Polynomial.X + have hs : s ≠ 0 := by + have hinj : Function.Injective (algebraMap K[X] S) := + FunctionField.ringOfIntegers.algebraMap_injective K L + dsimp only [s] + exact (map_ne_zero_iff (algebraMap K[X] S) hinj).2 Polynomial.X_ne_zero + have hrepr : + e.symm (algebraMap (RatFunc K) L RatFunc.X) = + algebraMap S (FractionRing S) s := by + apply e.injective + rw [e.apply_symm_apply, e.commutes] + rfl + rw [finiteExtensionPrincipalDivisor_inl, hrepr] + exact finitePlaceOrder_algebraMap_nonnegative q s hs + +private theorem finiteExtensionPrincipalDivisor_inr_eq_order + (x : L) (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L x (.inr P) = + finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by + rw [finiteExtensionPrincipalDivisor_inr] + symm + simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using + fractionRingAlgEquiv_finitePlaceOrder_eq + (R := RatFuncInfinityIntegralClosure K L) (L := L) + (primeOverHeightOne (ratFuncInfinityPlace K) P) + ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) + +/-- At a place `P` above infinity, the rational parameter has order exactly +the negative ramification index. -/ +theorem finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) (.inr P) = + -(P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + let q := primeOverHeightOne (ratFuncInfinityPlace K) P + let pi := ratFuncInfinityUniformizer K + letI : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by + simpa [q] using + (Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P) + have hpi0 : pi ≠ 0 := by + dsimp only [pi] + intro hzero + exact (ratFuncInfinityUniformizer_isUniformizer K).ne_zero + (congrArg Subtype.val hzero) + have hpiOrder : finitePlaceOrder q + (algebraMap (RatFuncInfinityIntegralClosure K L) L + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi)) = + (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + exact finitePlaceOrder_algebraMap_uniformizer_eq_ramificationIdx + (ratFuncInfinityPlace K) q pi hpi0 + (ratFuncInfinityPlace_span_uniformizer K) + have hpiImage : algebraMap + (RatFuncInfinityIntegralClosure K L) L + (algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) pi) = + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ := by + change algebraMap (RatFunc K) L (1 / RatFunc.X) = + (algebraMap (RatFunc K) L RatFunc.X)⁻¹ + simp + have hX0 : algebraMap (RatFunc K) L RatFunc.X ≠ 0 := by + simpa using (algebraMap (RatFunc K) L).injective.ne RatFunc.X_ne_zero + have hinv := finitePlaceOrder_inv_eq_neg' q + (algebraMap (RatFunc K) L RatFunc.X) hX0 + rw [← hpiImage, hpiOrder] at hinv + rw [finiteExtensionPrincipalDivisor_inr_eq_order K L] + change finitePlaceOrder q (algebraMap (RatFunc K) L RatFunc.X) = _ + omega + +/-- The pole divisor of the rational parameter vanishes at finite places. -/ +theorem finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero + (q : FiniteExtensionFinitePlace K L) : + finiteExtensionPoleDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) (.inl q) = 0 := by + simp only [finiteExtensionPoleDivisor, Finsupp.neg_apply, + Finsupp.filter_apply] + rw [if_neg (not_lt_of_ge + (finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative K L q))] + simp + +/-- Above infinity, the pole coefficient of the rational parameter is exactly +the ramification index. -/ +theorem finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx + (P : FiniteExtensionInfinityPlace K L) : + finiteExtensionPoleDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) (.inr P) = + (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + have he : 0 < P.1.ramificationIdx (RatFuncInfinityIntegers K) := + P.1.ramificationIdx_pos (RatFuncInfinityIntegers K) + simp only [finiteExtensionPoleDivisor, Finsupp.neg_apply, + Finsupp.filter_apply, + finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx, + neg_lt_zero] + rw [if_pos (by exact_mod_cast he)] + simp + +/-- Pointwise description of the complete pole divisor of the rational +parameter: it is zero at finite places and has coefficient `e(P)` at every +place above infinity. -/ +theorem finiteExtensionPoleDivisor_ratFuncX_apply + (v : FiniteExtensionPlace K L) : + finiteExtensionPoleDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) v = + match v with + | .inl _ => 0 + | .inr P => (P.1.ramificationIdx + (RatFuncInfinityIntegers K) : ℤ) := by + cases v with + | inl q => exact finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero K L q + | inr P => + exact finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx K L P + +/-- The support of the pole divisor of the rational parameter consists +exactly of the places above infinity. -/ +theorem finiteExtensionPoleDivisor_ratFuncX_support : + (finiteExtensionPoleDivisor K L + (algebraMap (RatFunc K) L RatFunc.X)).support = + Finset.univ.map + (Function.Embedding.inr : + FiniteExtensionInfinityPlace K L ↪ FiniteExtensionPlace K L) := by + classical + ext v + cases v with + | inl q => simp [finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero] + | inr P => + have he : 0 < P.1.ramificationIdx (RatFuncInfinityIntegers K) := + P.1.ramificationIdx_pos (RatFuncInfinityIntegers K) + simp [finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx, + Nat.ne_of_gt he] + +/-- The negative support of the principal divisor of the rational parameter +consists exactly of the places above infinity. -/ +theorem finiteExtensionPrincipalDivisor_ratFuncX_negativeSupport : + (finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L RatFunc.X)).support.filter + (fun v => finiteExtensionPrincipalDivisor K L + (algebraMap (RatFunc K) L RatFunc.X) v < 0) = + Finset.univ.map + (Function.Embedding.inr : + FiniteExtensionInfinityPlace K L ↪ FiniteExtensionPlace K L) := by + classical + ext v + cases v with + | inl q => + constructor + · intro hv + have hneg := (Finset.mem_filter.mp hv).2 + exact (not_lt_of_ge + (finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative K L q) + hneg).elim + · intro hv + simp at hv + | inr P => + have he : 0 < P.1.ramificationIdx (RatFuncInfinityIntegers K) := + P.1.ramificationIdx_pos (RatFuncInfinityIntegers K) + constructor + · intro _ + simp + · intro _ + apply Finset.mem_filter.mpr + constructor + · apply Finsupp.mem_support_iff.mpr + rw [finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx] + exact neg_ne_zero.mpr (Int.natCast_ne_zero.mpr (Nat.ne_of_gt he)) + · rw [finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx] + exact neg_lt_zero.mpr (Int.natCast_pos.mpr he) + +/-- The height of the rational parameter in a finite separable extension is +the extension degree. -/ +theorem finiteExtensionHeight_ratFuncX_eq_finrank : + finiteExtensionHeight K L (algebraMap (RatFunc K) L RatFunc.X) = + Module.finrank (RatFunc K) L := by + rw [finiteExtensionHeight, + finiteExtensionPrincipalDivisor_ratFuncX_negativeSupport K L] + rw [Finset.sum_map] + simp only [Function.Embedding.inr_apply, + finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx, + neg_neg, Int.toNat_natCast, finiteExtensionPlaceDegree] + simpa only using + finiteExtensionInfinity_sum_ramification_inertia_eq_finrank K L + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean new file mode 100644 index 0000000000..e4267a3ceb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean @@ -0,0 +1,223 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +import Mathlib.RingTheory.Polynomial.DegreeLT + +/-! +# Degree-one places of a finite function field + +This file defines the actual degree-one place type used by the fixed-field +argument and proves that it is finite over a finite constant field. The proof +does not assume a point-count bound: finite degree-one places inject into the +finite family of linear base primes together with their finite lying-over +fibers, while the places above infinity already form a finite lying-over +fiber. +-/ + +open scoped Polynomial + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier +open IsDedekindDomain + +variable (K : Type*) [Field K] [DecidableEq K] + +/-- Degree-one finite places of the rational function field `K(t)`. -/ +abbrev RatFuncRationalFinitePlace := + {P : HeightOneSpectrum K[X] // ratFuncFinitePlaceDegree P = 1} + +/-- Embed a degree-one rational-function-field place into the finite +coefficient space of polynomials of degree less than two. -/ +def ratFuncRationalFinitePlaceToDegreeLT : + RatFuncRationalFinitePlace K → Polynomial.degreeLT K 2 := fun P => by + let r := finitePlaceNormalizedPrime P.1 + refine ⟨(r : K[X]), Polynomial.mem_degreeLT.mpr ?_⟩ + have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero + have hrDegree : (r : K[X]).natDegree = 1 := by + simpa only [ratFuncFinitePlaceDegree] using P.2 + rw [Polynomial.degree_eq_natDegree hr0, hrDegree] + exact WithBot.coe_lt_coe.mpr (by omega) + +theorem ratFuncRationalFinitePlaceToDegreeLT_injective : + Function.Injective (ratFuncRationalFinitePlaceToDegreeLT K) := by + intro P Q hPQ + apply Subtype.ext + have hr : finitePlaceNormalizedPrime P.1 = finitePlaceNormalizedPrime Q.1 := by + apply Subtype.ext + exact congrArg + (fun r : Polynomial.degreeLT K 2 => (r.1 : K[X])) hPQ + simpa only [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] using + congrArg (normalizedPrimeFinitePlace (K := K)) hr + +/-- There are finitely many degree-one finite places of `K(t)` when `K` is +finite. -/ +noncomputable instance ratFuncRationalFinitePlace_finite [Finite K] : + Finite (RatFuncRationalFinitePlace K) := by + letI : Finite (Fin 2 → K) := Pi.finite + letI : Finite (Polynomial.degreeLT K 2) := + Finite.of_equiv (Fin 2 → K) (Polynomial.degreeLTEquiv K 2).toEquiv.symm + exact Finite.of_injective (ratFuncRationalFinitePlaceToDegreeLT K) + (ratFuncRationalFinitePlaceToDegreeLT_injective K) + +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [DecidableEq (RatFunc K)] + +local instance (priority := 10) rationalPlacePolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance rationalPlacePolynomialScalarTower : + IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance rationalPlaceFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance rationalPlaceFiniteClosureIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance rationalPlacePolynomialTorsionFreeTop : + Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance rationalPlaceFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance rationalPlaceFiniteClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance rationalPlaceInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance rationalPlaceInfinityClosureIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance rationalPlaceInfinityClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance rationalPlaceInfinityClosureDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) + (RatFunc K) L (RatFuncInfinityIntegralClosure K L) + +/-- Degree-one finite places of a finite extension of `K(t)`. -/ +abbrev FiniteExtensionRationalFinitePlace := + {Q : FiniteExtensionFinitePlace K L // + finiteExtensionPlaceDegree K L (.inl Q) = 1} + +/-- Degree-one places above infinity of a finite extension of `K(t)`. -/ +abbrev FiniteExtensionRationalInfinityPlace := + {Q : FiniteExtensionInfinityPlace K L // + finiteExtensionPlaceDegree K L (.inr Q) = 1} + +/-- The exhaustive type of degree-one places of a finite extension of +`K(t)`, split into the finite and above-infinity parts. -/ +abbrev FiniteExtensionRationalPlace := + FiniteExtensionRationalFinitePlace K L ⊕ + FiniteExtensionRationalInfinityPlace K L + +/-- The split rational-place type is exactly the subtype of exhaustive places +whose place degree is one. -/ +def finiteExtensionRationalPlaceEquivSubtype : + FiniteExtensionRationalPlace K L ≃ + {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P = 1} where + toFun + | .inl P => ⟨.inl P.1, P.2⟩ + | .inr P => ⟨.inr P.1, P.2⟩ + invFun + | ⟨.inl Q, hQ⟩ => .inl ⟨Q, hQ⟩ + | ⟨.inr Q, hQ⟩ => .inr ⟨Q, hQ⟩ + left_inv P := by cases P <;> rfl + right_inv P := by rcases P with ⟨P, hP⟩; cases P <;> rfl + +/-- The number of degree-one places of the finite function field. -/ +def finiteExtensionRationalPlaceCount : ℕ := + Nat.card (FiniteExtensionRationalPlace K L) + +theorem finiteExtensionRationalPlaceCount_eq_natCard_subtype : + finiteExtensionRationalPlaceCount K L = + Nat.card {P : FiniteExtensionPlace K L // + finiteExtensionPlaceDegree K L P = 1} := + Nat.card_congr (finiteExtensionRationalPlaceEquivSubtype K L) + +private theorem rationalFinitePlace_baseDegree_eq_one + (Q : FiniteExtensionRationalFinitePlace K L) : + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] Q.1) = 1 := by + have hprod : + Q.1.asIdeal.inertiaDeg K[X] * + ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] Q.1) = 1 := by + simpa only [finiteExtensionPlaceDegree] using Q.2 + exact Nat.eq_one_of_dvd_one ⟨Q.1.asIdeal.inertiaDeg K[X], by + simpa only [Nat.mul_comm] using hprod.symm⟩ + +/-- A rational finite place determines a rational base place together with a +prime in its finite lying-over fiber. -/ +def rationalFinitePlaceToBaseFiber + (Q : FiniteExtensionRationalFinitePlace K L) : + Σ P : RatFuncRationalFinitePlace K, + P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := + ⟨⟨HeightOneSpectrum.under K[X] Q.1, + rationalFinitePlace_baseDegree_eq_one K L Q⟩, + ⟨Q.1.asIdeal, Q.1.isPrime, ⟨rfl⟩⟩⟩ + +theorem rationalFinitePlaceToBaseFiber_injective : + Function.Injective (rationalFinitePlaceToBaseFiber K L) := by + intro Q R hQR + apply Subtype.ext + apply HeightOneSpectrum.ext + have hIdeals := congrArg + (fun z : Σ P : RatFuncRationalFinitePlace K, + P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) => z.2.1) hQR + simpa only [rationalFinitePlaceToBaseFiber] using hIdeals + +/-- The degree-one finite places of a finite function field are finite over a +finite constant field. -/ +noncomputable instance finiteExtensionRationalFinitePlace_finite [Finite K] : + Finite (FiniteExtensionRationalFinitePlace K L) := by + letI : Fintype (RatFuncRationalFinitePlace K) := Fintype.ofFinite _ + letI (P : RatFuncRationalFinitePlace K) : + Fintype (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := + Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.asIdeal + (RatFuncFiniteIntegralClosure K L)) + exact Finite.of_injective (rationalFinitePlaceToBaseFiber K L) + (rationalFinitePlaceToBaseFiber_injective K L) + +/-- The degree-one places above infinity are finite. -/ +noncomputable instance finiteExtensionRationalInfinityPlace_finite : + Finite (FiniteExtensionRationalInfinityPlace K L) := by + letI : Fintype (FiniteExtensionInfinityPlace K L) := + Set.Finite.fintype (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal + (RatFuncInfinityIntegralClosure K L)) + infer_instance + +/-- The exhaustive degree-one place type is finite over a finite constant +field. -/ +noncomputable instance finiteExtensionRationalPlace_finite [Finite K] : + Finite (FiniteExtensionRationalPlace K L) := inferInstance + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean new file mode 100644 index 0000000000..9ac95987cd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace + +/-! +# Restriction of rational places in a function-field tower + +Place degree is multiplicative in a tower. Consequently a degree-one place +of the top field restricts to a degree-one place of every intermediate field, +and its relative residue degree is one. This file packages that consequence +for the repository's exhaustive finite/infinity place type. +-/ + +namespace BGS.HasseWeil + +noncomputable section + +open BGS.CorvajaZannier + +variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (M : Type*) [Field M] [Algebra (RatFunc K) M] + [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + [Algebra M L] [IsScalarTower (RatFunc K) M L] + +/-- A degree-one finite place of the top field restricts to a degree-one +finite place of the intermediate field. -/ +def rationalFinitePlaceUnder + (Q : FiniteExtensionRationalFinitePlace K L) : + FiniteExtensionRationalFinitePlace K M := by + refine ⟨finitePlaceUnder K M L Q.1, ?_⟩ + have hmul := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M L Q.1 + rw [Q.2] at hmul + exact Nat.eq_one_of_dvd_one + ⟨finitePlaceRelativeInertiaDeg K M L Q.1, hmul⟩ + +/-- A degree-one place above infinity restricts to a degree-one place above +infinity in the intermediate field. -/ +def rationalInfinityPlaceUnder + (Q : FiniteExtensionRationalInfinityPlace K L) : + FiniteExtensionRationalInfinityPlace K M := by + refine ⟨infinityPlaceUnder K M L Q.1, ?_⟩ + have hmul := + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M L Q.1 + rw [Q.2] at hmul + exact Nat.eq_one_of_dvd_one + ⟨infinityPlaceRelativeInertiaDeg K M L Q.1, hmul⟩ + +/-- Restriction of an exhaustive degree-one place through an intermediate +function field. -/ +def rationalPlaceUnder : + FiniteExtensionRationalPlace K L → + FiniteExtensionRationalPlace K M + | .inl Q => .inl (rationalFinitePlaceUnder K M L Q) + | .inr Q => .inr (rationalInfinityPlaceUnder K M L Q) + +/-- The relative residue degree of a rational finite place is one. -/ +theorem rationalFinitePlace_relativeInertiaDeg_eq_one + (Q : FiniteExtensionRationalFinitePlace K L) : + finitePlaceRelativeInertiaDeg K M L Q.1 = 1 := by + have hmul := + finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg K M L Q.1 + rw [Q.2] at hmul + exact Nat.eq_one_of_dvd_one + ⟨finiteExtensionPlaceDegree K M + (.inl (finitePlaceUnder K M L Q.1)), by + simpa only [Nat.mul_comm] using hmul⟩ + +/-- The relative residue degree of a rational place above infinity is one. -/ +theorem rationalInfinityPlace_relativeInertiaDeg_eq_one + (Q : FiniteExtensionRationalInfinityPlace K L) : + infinityPlaceRelativeInertiaDeg K M L Q.1 = 1 := by + have hmul := + finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg K M L Q.1 + rw [Q.2] at hmul + exact Nat.eq_one_of_dvd_one + ⟨finiteExtensionPlaceDegree K M + (.inr (infinityPlaceUnder K M L Q.1)), by + simpa only [Nat.mul_comm] using hmul⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean new file mode 100644 index 0000000000..f13e67416c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +import Mathlib.FieldTheory.AlgebraicClosure + +/-! +# The zero-divisor Riemann space and the exact constant field + +The functions regular at every exhaustive place form a finite-dimensional +subalgebra of the function field. Consequently every such function is +algebraic over the constant field. When the relative algebraic closure of +the constants is trivial, this identifies `L(0)` with the image of the +constant field and gives its finrank exactly equal to one. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance regularConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance regularConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The subalgebra of functions regular at every exhaustive place. -/ +def finiteExtensionRegularSubalgebra : Subalgebra K L where + carrier := finiteExtensionRiemannSpace K L 0 + add_mem' := (finiteExtensionRiemannSpace K L 0).add_mem + zero_mem' := (finiteExtensionRiemannSpace K L 0).zero_mem + mul_mem' := by + intro x y hx hy + simpa using finiteExtensionRiemannSpace_mul_mem K L hx hy + one_mem' := by + simpa using algebraMap_mem_finiteExtensionRiemannSpace_of_effective + K L (D := 0) (by simp) (1 : K) + algebraMap_mem' := by + intro c + exact algebraMap_mem_finiteExtensionRiemannSpace_of_effective + K L (D := 0) (by simp) c + +@[simp] +theorem mem_finiteExtensionRegularSubalgebra {x : L} : + x ∈ finiteExtensionRegularSubalgebra K L ↔ + x ∈ finiteExtensionRiemannSpace K L 0 := Iff.rfl + +/-- The regular subalgebra and the zero-divisor Riemann space have the same +underlying vector space. -/ +def finiteExtensionRegularSubalgebraEquiv : + finiteExtensionRegularSubalgebra K L ≃ₗ[K] + finiteExtensionRiemannSpace K L 0 where + toFun x := ⟨x.1, x.2⟩ + invFun x := ⟨x.1, x.2⟩ + left_inv _ := rfl + right_inv _ := rfl + map_add' _ _ := rfl + map_smul' _ _ := rfl + +/-- The all-place zero-divisor Riemann space is finite-dimensional. -/ +theorem finiteExtensionRiemannSpace_zero_moduleFinite : + Module.Finite K (finiteExtensionRiemannSpace K L 0) := by + let Q : FiniteExtensionInfinityPlace K L := Classical.choice inferInstance + let P : FiniteExtensionPlace K L := .inr Q + have h := finiteExtensionOnePointRiemannSpace_zero_moduleFinite K L P + change Module.Finite K + (finiteExtensionRiemannSpace K L (Finsupp.single P (0 : ℤ))) at h + have hzero : Finsupp.single P (0 : ℤ) = + (0 : FiniteExtensionDivisor K L) := by + ext v + by_cases hv : v = P <;> simp [hv] + rw [hzero] at h + exact h + +/-- The everywhere-regular subalgebra is finite-dimensional. -/ +theorem finiteExtensionRegularSubalgebra_moduleFinite : + Module.Finite K (finiteExtensionRegularSubalgebra K L) := by + letI : Module.Finite K (finiteExtensionRiemannSpace K L 0) := + finiteExtensionRiemannSpace_zero_moduleFinite K L + exact Module.Finite.equiv (finiteExtensionRegularSubalgebraEquiv K L).symm + +/-- With exact constants, every everywhere-regular function is a constant. -/ +theorem finiteExtensionRiemannSpace_zero_eq_range + (hconstants : algebraicClosure K L = ⊥) : + finiteExtensionRiemannSpace K L 0 = + LinearMap.range (Algebra.linearMap K L) := by + apply le_antisymm + · intro x hx + letI : Module.Finite K (finiteExtensionRegularSubalgebra K L) := + finiteExtensionRegularSubalgebra_moduleFinite K L + let x' : finiteExtensionRegularSubalgebra K L := ⟨x, hx⟩ + have hxAlg' : IsAlgebraic K x' := IsAlgebraic.of_finite K x' + have hxAlg : IsAlgebraic K x := + hxAlg'.algHom (Subalgebra.val (finiteExtensionRegularSubalgebra K L)) + have hxClosure : x ∈ algebraicClosure K L := + mem_algebraicClosure_iff.mpr hxAlg + rw [hconstants] at hxClosure + obtain ⟨c, rfl⟩ := IntermediateField.mem_bot.mp hxClosure + exact ⟨c, rfl⟩ + · rintro x ⟨c, rfl⟩ + exact algebraMap_mem_finiteExtensionRiemannSpace_of_effective + K L (D := 0) (by simp) c + +/-- With exact constants, `L(0)` has dimension one. -/ +theorem finiteExtensionRiemannSpace_zero_finrank + (hconstants : algebraicClosure K L = ⊥) : + Module.finrank K (finiteExtensionRiemannSpace K L 0) = 1 := by + rw [finiteExtensionRiemannSpace_zero_eq_range K L hconstants] + have hinjective : Function.Injective (Algebra.linearMap K L) := + (algebraMap K L).injective + let e : K ≃ₗ[K] LinearMap.range (Algebra.linearMap K L) := + LinearEquiv.ofInjective (Algebra.linearMap K L) hinjective + calc + Module.finrank K (LinearMap.range (Algebra.linearMap K L)) = + Module.finrank K K := e.finrank_eq.symm + _ = 1 := Module.finrank_self K + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean new file mode 100644 index 0000000000..9961172a80 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean @@ -0,0 +1,275 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +import Mathlib.Tactic + +/-! +# Effective increments of exhaustive Riemann spaces + +The local finite- and infinity-place residue maps give the same one-place +dimension bound. This file first packages those two cases as a bound for an +arbitrary exhaustive place, then iterates over the coefficients and support +of an effective divisor. + +The final statements split an effective divisor at one selected place. They +are the linear-algebraic codimension estimates needed to pass from a +many-pole auxiliary space to a one-point Riemann space. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- The finite- and infinity-place increment lemmas together cover every +place in the exhaustive place type. -/ +theorem finiteExtensionRiemannSpace_place_increment + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) + [Module.Finite K (finiteExtensionRiemannSpace K L D)] : + Module.Finite K (finiteExtensionRiemannSpace K L + (D + Finsupp.single P 1)) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L + (D + Finsupp.single P 1)) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + finiteExtensionPlaceDegree K L P := by + rcases P with q | P + · simpa using + (finiteExtensionRiemannSpace_finitePlace_increment K L D hD q) + · simpa using + (finiteExtensionRiemannSpace_infinityPlace_increment K L D hD P) + +/-- Adding `n` copies of one place raises dimension by at most `n` times the +degree of that place. -/ +theorem finiteExtensionRiemannSpace_natPlace_increment + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) + (n : ℕ) + [Module.Finite K (finiteExtensionRiemannSpace K L D)] : + Module.Finite K (finiteExtensionRiemannSpace K L + (D + Finsupp.single P (n : ℤ))) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L + (D + Finsupp.single P (n : ℤ))) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + n * finiteExtensionPlaceDegree K L P := by + induction n with + | zero => + have hdivisor : + D + Finsupp.single P (((0 : ℕ) : ℤ)) = D := by + ext v + simp + rw [hdivisor] + simp only [zero_mul, add_zero] + constructor + · exact inferInstance + · exact le_rfl + | succ n ih => + let E : FiniteExtensionDivisor K L := + D + Finsupp.single P (n : ℤ) + have hE : ∀ v, 0 ≤ E v := by + intro v + by_cases hv : v = P + · subst v + dsimp only [E] + simp only [Finsupp.add_apply, Finsupp.single_eq_same] + exact add_nonneg (hD P) (by positivity) + · simpa [E, Finsupp.single_eq_of_ne hv] using hD v + letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := ih.1 + have hstep := finiteExtensionRiemannSpace_place_increment K L E hE P + have hdivisor : + D + Finsupp.single P ((n + 1 : ℕ) : ℤ) = + E + Finsupp.single P 1 := by + ext v + by_cases hv : v = P + · subst v + simp only [E, Finsupp.add_apply, Finsupp.single_eq_same] + push_cast + ring + · simp only [E, Finsupp.add_apply, + Finsupp.single_eq_of_ne hv] + ring + constructor + · rw [hdivisor] + exact hstep.1 + · rw [hdivisor] + calc + Module.finrank K (finiteExtensionRiemannSpace K L + (E + Finsupp.single P 1)) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L E) + + finiteExtensionPlaceDegree K L P := hstep.2 + _ ≤ (Module.finrank K (finiteExtensionRiemannSpace K L D) + + n * finiteExtensionPlaceDegree K L P) + + finiteExtensionPlaceDegree K L P := + Nat.add_le_add_right ih.2 _ + _ = Module.finrank K (finiteExtensionRiemannSpace K L D) + + (n + 1) * finiteExtensionPlaceDegree K L P := by + simp only [Nat.add_mul, one_mul] + omega + +/-- Adding an effective divisor to an effective starting divisor preserves +finite-dimensionality, and its total dimension cost is at most its degree. -/ +theorem finiteExtensionRiemannSpace_add_effective + (D E : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (hE : ∀ v, 0 ≤ E v) + [Module.Finite K (finiteExtensionRiemannSpace K L D)] : + Module.Finite K (finiteExtensionRiemannSpace K L (D + E)) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L (D + E)) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + (finiteExtensionDivisorDegree K L E).toNat := by + let motive := fun E : FiniteExtensionDivisor K L => + (∀ v, 0 ≤ E v) → + Module.Finite K (finiteExtensionRiemannSpace K L (D + E)) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L (D + E)) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + (finiteExtensionDivisorDegree K L E).toNat + apply Finsupp.induction E (motive := motive) + · intro _ + rw [add_zero] + constructor + · exact inferInstance + · exact le_rfl + · intro P b E hP hb ih hsingleAdd + have hEP : E P = 0 := Finsupp.notMem_support_iff.mp hP + have hbNonneg : 0 ≤ b := by + have h := hsingleAdd P + simpa [hEP] using h + have hEeffective : ∀ v, 0 ≤ E v := by + intro v + by_cases hv : v = P + · subst v + simp [hEP] + · have h := hsingleAdd v + simpa [Finsupp.single_eq_of_ne hv] using h + have hih := ih hEeffective + letI : Module.Finite K + (finiteExtensionRiemannSpace K L (D + E)) := hih.1 + have hDEeffective : ∀ v, 0 ≤ (D + E) v := by + intro v + exact add_nonneg (hD v) (hEeffective v) + have hmultiple := finiteExtensionRiemannSpace_natPlace_increment + K L (D + E) hDEeffective P b.toNat + have hdivisor : + D + (Finsupp.single P b + E) = + (D + E) + Finsupp.single P (b.toNat : ℤ) := by + rw [Int.toNat_of_nonneg hbNonneg] + abel + have hdegreeE : 0 ≤ finiteExtensionDivisorDegree K L E := + finiteExtensionDivisorDegree_nonnegative_of_effective K L E hEeffective + have hdegreeSingle : + 0 ≤ b * (finiteExtensionPlaceDegree K L P : ℤ) := + mul_nonneg hbNonneg (by positivity) + have hdegree : + (finiteExtensionDivisorDegree K L + (Finsupp.single P b + E)).toNat = + b.toNat * finiteExtensionPlaceDegree K L P + + (finiteExtensionDivisorDegree K L E).toNat := by + rw [finiteExtensionDivisorDegree_add, + finiteExtensionDivisorDegree_single, + Int.toNat_add hdegreeSingle hdegreeE, + Int.toNat_mul hbNonneg (by positivity)] + simp + constructor + · rw [hdivisor] + exact hmultiple.1 + · rw [hdivisor] + calc + Module.finrank K (finiteExtensionRiemannSpace K L + ((D + E) + Finsupp.single P (b.toNat : ℤ))) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L (D + E)) + + b.toNat * finiteExtensionPlaceDegree K L P := hmultiple.2 + _ ≤ (Module.finrank K (finiteExtensionRiemannSpace K L D) + + (finiteExtensionDivisorDegree K L E).toNat) + + b.toNat * finiteExtensionPlaceDegree K L P := + Nat.add_le_add_right hih.2 _ + _ = Module.finrank K (finiteExtensionRiemannSpace K L D) + + (finiteExtensionDivisorDegree K L + (Finsupp.single P b + E)).toNat := by omega + exact hE + +/-- Every effective exhaustive divisor has a finite-dimensional Riemann +space. -/ +theorem finiteExtensionRiemannSpace_effective_moduleFinite + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) : + Module.Finite K (finiteExtensionRiemannSpace K L D) := by + letI : Module.Finite K + (finiteExtensionRiemannSpace K L (0 : FiniteExtensionDivisor K L)) := + finiteExtensionRiemannSpace_zero_moduleFinite K L + have h := finiteExtensionRiemannSpace_add_effective K L + (0 : FiniteExtensionDivisor K L) D (by simp) hD + rw [zero_add] at h + exact h.1 + +/-- Splitting an effective divisor at `P`, the discarded poles cost at most +the degree of the away part. -/ +theorem finiteExtensionRiemannSpace_finrank_le_onePoint_add_degreeAway + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) : + Module.finrank K (finiteExtensionRiemannSpace K L D) ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (D P).toNat) + + (finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D P)).toNat := by + let A : FiniteExtensionDivisor K L := Finsupp.single P (D P) + let B : FiniteExtensionDivisor K L := finiteExtensionDivisorAway K L D P + have hA : ∀ v, 0 ≤ A v := by + intro v + by_cases hv : v = P + · subst v + simpa [A] using hD P + · simp [A, Finsupp.single_eq_of_ne hv] + have hB : ∀ v, 0 ≤ B v := by + exact finiteExtensionDivisorAway_effective K L D P hD + letI : Module.Finite K (finiteExtensionRiemannSpace K L A) := + finiteExtensionRiemannSpace_effective_moduleFinite K L A hA + have hbound := finiteExtensionRiemannSpace_add_effective K L A B hA hB + have hsplit : A + B = D := by + exact single_add_finiteExtensionDivisorAway K L D P + have hcoeff : ((D P).toNat : ℤ) = D P := + Int.toNat_of_nonneg (hD P) + rw [hsplit] at hbound + change Module.finrank K (finiteExtensionRiemannSpace K L D) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L + (Finsupp.single P ((D P).toNat : ℤ))) + + (finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D P)).toNat + rw [hcoeff] + simpa only [A, B] using hbound.2 + +/-- Rearranged form of the away-degree estimate: the selected one-point +space retains at least the full dimension minus the away degree. -/ +theorem finiteExtensionOnePointRiemannSpace_finrank_lowerBound + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionPlace K L) : + Module.finrank K (finiteExtensionRiemannSpace K L D) - + (finiteExtensionDivisorDegree K L + (finiteExtensionDivisorAway K L D P)).toNat ≤ + Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (D P).toNat) := by + have h := finiteExtensionRiemannSpace_finrank_le_onePoint_add_degreeAway + K L D hD P + omega + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean new file mode 100644 index 0000000000..a2e570d95d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean @@ -0,0 +1,406 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +import Mathlib.RingTheory.Finiteness.Finsupp +import Mathlib.Tactic + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +noncomputable section + + +section LocalLift + +variable {K R L : Type*} [Field K] [CommRing R] + [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Field L] [Algebra K R] [Algebra R L] [Algebra K L] + [IsScalarTower K R L] [IsFractionRing R L] + +variable (T : Submodule K L) (a : L) +variable (hregular : ∀ x : T, ∃ r : R, a * x.1 = algebraMap R L r) + +noncomputable def localNormalizedLift (x : T) : R := + Classical.choose (hregular x) + +theorem localNormalizedLift_spec (x : T) : + a * x.1 = algebraMap R L (localNormalizedLift T a hregular x) := + Classical.choose_spec (hregular x) + +theorem localNormalizedLift_add (x y : T) : + localNormalizedLift T a hregular (x + y) = + localNormalizedLift T a hregular x + localNormalizedLift T a hregular y := by + apply IsFractionRing.injective R L + rw [map_add] + rw [← localNormalizedLift_spec T a hregular] + rw [← localNormalizedLift_spec T a hregular] + rw [← localNormalizedLift_spec T a hregular] + simp only [Submodule.coe_add] + ring + +theorem localNormalizedLift_smul (c : K) (x : T) : + localNormalizedLift T a hregular (c • x) = + c • localNormalizedLift T a hregular x := by + apply IsFractionRing.injective R L + rw [show algebraMap R L (c • localNormalizedLift T a hregular x) = + c • algebraMap R L (localNormalizedLift T a hregular x) by + exact map_smul (IsScalarTower.toAlgHom K R L) c _] + rw [← localNormalizedLift_spec T a hregular] + rw [← localNormalizedLift_spec T a hregular] + simp only [Submodule.coe_smul] + rw [Algebra.smul_def, Algebra.smul_def] + ring + +noncomputable def localNormalizedLiftLinearMap : T →ₗ[K] R where + toFun := localNormalizedLift T a hregular + map_add' := localNormalizedLift_add T a hregular + map_smul' := localNormalizedLift_smul T a hregular + +noncomputable def localLeadingResidueLinearMap : + T →ₗ[K] IsLocalRing.ResidueField R := + (Ideal.Quotient.mkₐ K (IsLocalRing.maximalIdeal R)).toLinearMap.comp + (localNormalizedLiftLinearMap T a hregular) + +theorem localLeadingResidueLinearMap_eq_zero_iff (x : T) : + localLeadingResidueLinearMap T a hregular x = 0 ↔ + localNormalizedLift T a hregular x ∈ IsLocalRing.maximalIdeal R := by + exact IsLocalRing.residue_eq_zero_iff _ + +theorem mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap + (v : HeightOneSpectrum R) (r : R) + (horder : (1 : ℤ) ≤ finitePlaceOrder v (algebraMap R L r)) : + r ∈ v.asIdeal := by + by_cases hr : r = 0 + · simpa [hr] + · have hrMap : algebraMap R L r ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hr + have hvaluation := + valuation_eq_exp_neg_finitePlaceOrder v (algebraMap R L r) hrMap + rw [HeightOneSpectrum.valuation_of_algebraMap] at hvaluation + rw [← v.intValuation_lt_one_iff_mem] + rw [hvaluation, ← WithZero.exp_zero, WithZero.exp_lt_exp] + omega + +end LocalLift + +section PlaceDegree + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance upperConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance upperConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance (priority := 10) upperPolynomialAlgebra : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + +local instance upperPolynomialTower : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance upperFiniteClosureConstantAlgebra : + Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp + (algebraMap K K[X])) + +local instance upperFiniteClosureConstantTower : + IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance upperFiniteClosureIsIntegral : + Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + +local instance upperFiniteClosureModuleFinite : + Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + +local instance upperPolynomialTorsionFreeTop : Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + +local instance upperFiniteClosureTorsionFree : + Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + +local instance upperFiniteClosureDedekind : + IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + +local instance upperFiniteClosureFractionRing : + IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) + +/-- Adding one finite place to an effective divisor preserves finite +dimensionality. The dimension jump is at most the degree of that place. -/ +theorem finiteExtensionRiemannSpace_finitePlace_increment + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (q : FiniteExtensionFinitePlace K L) + [Module.Finite K (finiteExtensionRiemannSpace K L D)] : + Module.Finite K (finiteExtensionRiemannSpace K L + (D + Finsupp.single (.inl q) 1)) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L + (D + Finsupp.single (.inl q) 1)) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + finiteExtensionPlaceDegree K L (.inl q) := by + let A := RatFuncFiniteIntegralClosure K L + let R := FiniteExtensionFinitePlaceLocalRing K L q + let Q : FiniteExtensionPlace K L := .inl q + let S := finiteExtensionRiemannSpace K L D + let T := finiteExtensionRiemannSpace K L (D + Finsupp.single Q 1) + letI : Algebra (RatFuncFiniteIntegralClosure K L) + (RatFuncFiniteIntegralClosure K L) := + Algebra.id (RatFuncFiniteIntegralClosure K L) + let upperFiniteClosureLocalAlgebra : + Algebra (RatFuncFiniteIntegralClosure K L) + (FiniteExtensionFinitePlaceLocalRing K L q) := + OreLocalization.instAlgebra + letI := upperFiniteClosureLocalAlgebra + letI : SMul (RatFuncFiniteIntegralClosure K L) + (FiniteExtensionFinitePlaceLocalRing K L q) := + upperFiniteClosureLocalAlgebra.toSMul + letI : Algebra K (FiniteExtensionFinitePlaceLocalRing K L q) := + OreLocalization.instAlgebra + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + symm + change finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap K R c) = algebraMap K L c + rw [show algebraMap K R c = + algebraMap A R (algebraMap K A c) by rfl] + rw [show finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap A R (algebraMap K A c)) = + algebraMap A L (algebraMap K A c) by + exact DFunLike.congr_fun + (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q) (algebraMap K A c)] + rfl + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A q.ne_bot R + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : + (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + let πL : L := algebraMap R L π + have hπLNe : πL ≠ 0 := by + dsimp [πL] + simpa using (IsFractionRing.injective R L).ne hπ.ne_zero + have hπOrder : + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q πL = + (1 : WithTop ℤ) := by + change finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) πL = (1 : WithTop ℤ) + simpa [πL] using finitePlaceOrderTop_uniformizer_zpow + (L := L) (IsDiscreteValuationRing.maximalIdeal R) + π hπ hπIdeal (1 : ℤ) + let m : ℕ := (D Q).toNat + have hm : (m : ℤ) = D Q := by + exact Int.toNat_of_nonneg (hD Q) + let a : L := πL ^ (m + 1) + have hregular : ∀ x : T, ∃ r : R, + a * x.1 = algebraMap R L r := by + intro x + apply finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) q (a * x.1) + by_cases hx0 : x.1 = 0 + · simp [a, hx0, finiteExtensionFinitePlaceLocalOrderTop] + · have hxmem := (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp x.2 + rcases hxmem with hxmem | ⟨_, hxorders⟩ + · exact (hx0 hxmem).elim + · have hxQ := hxorders Q + simp only [Finsupp.add_apply, Finsupp.single_eq_same] at hxQ + rw [finiteExtensionFinitePlaceLocalOrderTop_mul, + show a = πL ^ (m + 1) by rfl, + finiteExtensionFinitePlaceLocalOrderTop_pow, + hπOrder, + finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + K L q x.1 hx0] + change (0 : WithTop ℤ) ≤ + (m + 1) • (1 : WithTop ℤ) + + (finiteExtensionFinitePrincipalDivisor K L x.1 q : WithTop ℤ) + rw [show (m + 1) • (1 : WithTop ℤ) = + ((m + 1 : ℕ) : WithTop ℤ) by simp] + exact_mod_cast (show 0 ≤ (m : ℤ) + 1 + + finiteExtensionFinitePrincipalDivisor K L x.1 q by + change 0 ≤ (m : ℤ) + 1 + + finiteExtensionPrincipalDivisor K L x.1 Q + rw [hm] + omega) + have hResidueRank : Module.finrank K (IsLocalRing.ResidueField R) = + finiteExtensionPlaceDegree K L (.inl q) := by + simpa [R] using + (finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q).symm + let f := localLeadingResidueLinearMap (K := K) (R := R) (L := L) + T a hregular + have hST : S ≤ T := by + apply finiteExtensionRiemannSpace_mono + intro v + classical + by_cases hv : v = Q <;> simp [hv] + have hkerPoint (x : T) : f x = 0 ↔ x.1 ∈ S := by + rw [localLeadingResidueLinearMap_eq_zero_iff + (K := K) (R := R) (L := L) T a hregular] + constructor + · intro hrMem + by_cases hx0 : x.1 = 0 + · simpa [hx0] using S.zero_mem + · have hrNe : localNormalizedLift (R := R) T a hregular x ≠ 0 := by + intro hr0 + have hax0 : a * x.1 = 0 := by + rw [localNormalizedLift_spec (R := R) T a hregular x, + hr0, map_zero] + exact hx0 ((mul_eq_zero.mp hax0).resolve_left (pow_ne_zero _ hπLNe)) + have hrOrder : + (1 : ℤ) ≤ finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) := + one_le_finitePlaceOrder_algebraMap_of_mem + (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) + (localNormalizedLift (R := R) T a hregular x) hrMem hrNe + have hrMapNe : + algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hrNe + have haxOrder : + (1 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop + (K := K) (L := L) q (a * x.1) := by + rw [localNormalizedLift_spec (R := R) T a hregular x] + change (1 : WithTop ℤ) ≤ finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) + rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] + exact_mod_cast hrOrder + have hxQ : + 0 ≤ finiteExtensionPrincipalDivisor K L x.1 Q + D Q := by + rw [finiteExtensionFinitePlaceLocalOrderTop_mul, + show a = πL ^ (m + 1) by rfl, + finiteExtensionFinitePlaceLocalOrderTop_pow, + hπOrder, + finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + K L q x.1 hx0] at haxOrder + rw [show (m + 1) • (1 : WithTop ℤ) = + ((m + 1 : ℕ) : WithTop ℤ) by simp] at haxOrder + have haxOrderInt : 1 ≤ (m : ℤ) + 1 + + finiteExtensionPrincipalDivisor K L x.1 Q := by + exact_mod_cast haxOrder + rw [← hm] + omega + rw [mem_finiteExtensionRiemannSpace] + refine Or.inr ⟨hx0, ?_⟩ + intro v + by_cases hv : v = Q + · simpa [hv] using hxQ + · have hxmem := + (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp x.2 + rcases hxmem with hxmem | ⟨_, hxorders⟩ + · exact (hx0 hxmem).elim + · have hxv := hxorders v + simp only [Finsupp.add_apply, + Finsupp.single_eq_of_ne hv] at hxv + simpa using hxv + · intro hxS + by_cases hx0 : x.1 = 0 + · have hlift0 : localNormalizedLift (R := R) T a hregular x = 0 := by + apply IsFractionRing.injective R L + rw [map_zero, + ← localNormalizedLift_spec (R := R) T a hregular x] + simp [hx0] + simpa [hlift0] + · have hxmem := + (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp hxS + rcases hxmem with hxmem | ⟨_, hxorders⟩ + · exact (hx0 hxmem).elim + · have hxQ := hxorders Q + have haxOrder : + (1 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop + (K := K) (L := L) q (a * x.1) := by + rw [finiteExtensionFinitePlaceLocalOrderTop_mul, + show a = πL ^ (m + 1) by rfl, + finiteExtensionFinitePlaceLocalOrderTop_pow, + hπOrder, + finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + K L q x.1 hx0] + rw [show (m + 1) • (1 : WithTop ℤ) = + ((m + 1 : ℕ) : WithTop ℤ) by simp] + exact_mod_cast (show 1 ≤ (m : ℤ) + 1 + + finiteExtensionPrincipalDivisor K L x.1 Q by + rw [hm] + omega) + rw [localNormalizedLift_spec (R := R) T a hregular x] at haxOrder + by_cases hr0 : localNormalizedLift (R := R) T a hregular x = 0 + · simpa [hr0] + · apply mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap + (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) + (localNormalizedLift (R := R) T a hregular x) + have hrMapNe : + algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hr0 + change (1 : WithTop ℤ) ≤ finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) at haxOrder + rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] at haxOrder + exact_mod_cast haxOrder + have hker : f.ker = Submodule.comap T.subtype S := by + ext x + rw [LinearMap.mem_ker, Submodule.mem_comap] + exact hkerPoint x + letI : Finite (IsLocalRing.ResidueField R) := by + simpa [R] using + finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q + letI : Module.Finite K (IsLocalRing.ResidueField R) := + Module.Finite.of_finite + letI : Module.Finite K f.range := inferInstance + letI : Module.Finite K f.ker := by + rw [hker] + exact Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hST).symm + letI : Module.Finite K (T ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + letI hTFinite : Module.Finite K T := + Module.Finite.of_submodule_quotient f.ker + have hkerRank : Module.finrank K f.ker = Module.finrank K S := by + rw [hker] + exact (Submodule.comapSubtypeEquivOfLe hST).finrank_eq + constructor + · exact hTFinite + · calc + Module.finrank K T = + Module.finrank K f.range + Module.finrank K f.ker := + f.finrank_range_add_finrank_ker.symm + _ ≤ Module.finrank K (IsLocalRing.ResidueField R) + + Module.finrank K S := + Nat.add_le_add f.range.finrank_le (le_of_eq hkerRank) + _ = Module.finrank K S + + finiteExtensionPlaceDegree K L (.inl q) := by + rw [hResidueRank, Nat.add_comm] + +end PlaceDegree + +end +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean new file mode 100644 index 0000000000..55a4cda57c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean @@ -0,0 +1,369 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial BigOperators +open IsDedekindDomain + +noncomputable section + + +section InfinityPlace + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance infinityIncrementConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance infinityIncrementConstantTower : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance upperInfinityConstantAlgebra : + Algebra K (RatFuncInfinityIntegers K) := + (ratFuncInfinityConstantRingHom K).toAlgebra + +local instance upperInfinityClosureConstantAlgebra : + Algebra K (RatFuncInfinityIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L)).comp + (algebraMap K (RatFuncInfinityIntegers K))) + +local instance upperInfinityClosureConstantTower : + IsScalarTower K (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + +local instance upperInfinityClosureModuleFinite : + Module.Finite (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance upperInfinityClosureIsIntegral : + Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + +local instance upperInfinityBaseTorsionFreeTop : + Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + +local instance upperInfinityClosureTorsionFree : + Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + +local instance upperInfinityClosureDedekind : + IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance upperInfinityClosureFractionRing : + IsFractionRing (RatFuncInfinityIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + (RatFuncInfinityIntegers K) (RatFunc K) L + (RatFuncInfinityIntegralClosure K L) + +local instance upperInfinityClosureConstantTowerToField : + IsScalarTower K (RatFuncInfinityIntegralClosure K L) L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + simp only [RingHom.comp_apply] + rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] + rfl + +private noncomputable def infinityIncrementResidueFieldAlgEquivOfIdealEq + {I J : Ideal (RatFuncInfinityIntegralClosure K L)} + [I.IsPrime] [J.IsPrime] (h : I = J) : + I.ResidueField ≃ₐ[K] J.ResidueField := by + subst J + exact AlgEquiv.refl + +private noncomputable def infinityIncrementResidueFieldAlgEquiv + (P : FiniteExtensionInfinityPlace K L) : + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField + ≃ₐ[K] P.1.ResidueField := + infinityIncrementResidueFieldAlgEquivOfIdealEq K L + (primeOverHeightOne_asIdeal (ratFuncInfinityPlace K) P) + +/-- Adding one infinity place to an effective divisor preserves finite +dimensionality. The dimension jump is at most the degree of that place. -/ +theorem finiteExtensionRiemannSpace_infinityPlace_increment + (D : FiniteExtensionDivisor K L) + (hD : ∀ v, 0 ≤ D v) + (P : FiniteExtensionInfinityPlace K L) + [Module.Finite K (finiteExtensionRiemannSpace K L D)] : + Module.Finite K (finiteExtensionRiemannSpace K L + (D + Finsupp.single (.inr P) 1)) ∧ + Module.finrank K (finiteExtensionRiemannSpace K L + (D + Finsupp.single (.inr P) 1)) ≤ + Module.finrank K (finiteExtensionRiemannSpace K L D) + + finiteExtensionPlaceDegree K L (.inr P) := by + let A := RatFuncInfinityIntegralClosure K L + let R := FiniteExtensionInfinityPlaceLocalRing K L P + let Q : FiniteExtensionPlace K L := .inr P + let S := finiteExtensionRiemannSpace K L D + let T := finiteExtensionRiemannSpace K L (D + Finsupp.single Q 1) + letI : Algebra (RatFuncInfinityIntegralClosure K L) + (RatFuncInfinityIntegralClosure K L) := + Algebra.id (RatFuncInfinityIntegralClosure K L) + let upperInfinityClosureLocalAlgebra : + Algebra (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) := + OreLocalization.instAlgebra + letI := upperInfinityClosureLocalAlgebra + letI : SMul (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) := + upperInfinityClosureLocalAlgebra.toSMul + letI : Algebra K (FiniteExtensionInfinityPlaceLocalRing K L P) := + OreLocalization.instAlgebra + letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext c + symm + change finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P (algebraMap K R c) = algebraMap K L c + rw [show algebraMap K R c = + algebraMap A R (algebraMap K A c) by rfl] + rw [show finiteExtensionInfinityPlaceLocalizationToField + (K := K) (L := L) P (algebraMap A R (algebraMap K A c)) = + algebraMap A L (algebraMap K A c) by + exact DFunLike.congr_fun + (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) P) (algebraMap K A c)] + exact (IsScalarTower.algebraMap_apply K A L c).symm + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot R + obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R + have hπIdeal : + (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := + (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ + let πL : L := algebraMap R L π + have hπLNe : πL ≠ 0 := by + dsimp [πL] + simpa using (IsFractionRing.injective R L).ne hπ.ne_zero + have hπOrder : + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P πL = + (1 : WithTop ℤ) := by + change finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) πL = (1 : WithTop ℤ) + simpa [πL] using finitePlaceOrderTop_uniformizer_zpow + (L := L) (IsDiscreteValuationRing.maximalIdeal R) + π hπ hπIdeal (1 : ℤ) + let m : ℕ := (D Q).toNat + have hm : (m : ℤ) = D Q := by + exact Int.toNat_of_nonneg (hD Q) + let a : L := πL ^ (m + 1) + have hregular : ∀ x : T, ∃ r : R, + a * x.1 = algebraMap R L r := by + intro x + apply finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) P (a * x.1) + by_cases hx0 : x.1 = 0 + · simp [a, hx0, finiteExtensionInfinityPlaceLocalOrderTop] + · have hxmem := (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp x.2 + rcases hxmem with hxmem | ⟨_, hxorders⟩ + · exact (hx0 hxmem).elim + · have hxQ := hxorders Q + simp only [Finsupp.add_apply, Finsupp.single_eq_same] at hxQ + rw [finiteExtensionInfinityPlaceLocalOrderTop_mul, + show a = πL ^ (m + 1) by rfl, + finiteExtensionInfinityPlaceLocalOrderTop_pow, + hπOrder, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P x.1 hx0, + ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder + (K := K) (L := L) x.1 P] + rw [show (m + 1) • (1 : WithTop ℤ) = + ((m + 1 : ℕ) : WithTop ℤ) by simp] + exact_mod_cast (show 0 ≤ (m : ℤ) + 1 + + finiteExtensionPrincipalDivisor K L x.1 Q by + rw [hm] + omega) + have hResidueRank : Module.finrank K (IsLocalRing.ResidueField R) = + finiteExtensionPlaceDegree K L (.inr P) := by + change Module.finrank K + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField = _ + calc + Module.finrank K + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField = + Module.finrank K P.1.ResidueField := + (infinityIncrementResidueFieldAlgEquiv K L P).toLinearEquiv.finrank_eq + _ = finiteExtensionPlaceDegree K L (.inr P) := + (finiteExtensionInfinityPlace_degree_eq_finrank_residueField K L P).symm + let f := localLeadingResidueLinearMap (K := K) (R := R) (L := L) + T a hregular + have hST : S ≤ T := by + apply finiteExtensionRiemannSpace_mono + intro v + classical + by_cases hv : v = Q <;> simp [hv] + have hkerPoint (x : T) : f x = 0 ↔ x.1 ∈ S := by + rw [localLeadingResidueLinearMap_eq_zero_iff + (K := K) (R := R) (L := L) T a hregular] + constructor + · intro hrMem + by_cases hx0 : x.1 = 0 + · simpa [hx0] using S.zero_mem + · have hrNe : localNormalizedLift (R := R) T a hregular x ≠ 0 := by + intro hr0 + have hax0 : a * x.1 = 0 := by + rw [localNormalizedLift_spec (R := R) T a hregular x, + hr0, map_zero] + exact hx0 ((mul_eq_zero.mp hax0).resolve_left (pow_ne_zero _ hπLNe)) + have hrOrder : + (1 : ℤ) ≤ finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) := + one_le_finitePlaceOrder_algebraMap_of_mem + (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) + (localNormalizedLift (R := R) T a hregular x) hrMem hrNe + have hrMapNe : + algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hrNe + have haxOrder : + (1 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop + (K := K) (L := L) P (a * x.1) := by + rw [localNormalizedLift_spec (R := R) T a hregular x] + change (1 : WithTop ℤ) ≤ finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) + rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] + exact_mod_cast hrOrder + have hxQ : + 0 ≤ finiteExtensionPrincipalDivisor K L x.1 Q + D Q := by + rw [finiteExtensionInfinityPlaceLocalOrderTop_mul, + show a = πL ^ (m + 1) by rfl, + finiteExtensionInfinityPlaceLocalOrderTop_pow, + hπOrder, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P x.1 hx0, + ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder + (K := K) (L := L) x.1 P] at haxOrder + rw [show (m + 1) • (1 : WithTop ℤ) = + ((m + 1 : ℕ) : WithTop ℤ) by simp] at haxOrder + have haxOrderInt : 1 ≤ (m : ℤ) + 1 + + finiteExtensionPrincipalDivisor K L x.1 Q := by + exact_mod_cast haxOrder + rw [← hm] + omega + rw [mem_finiteExtensionRiemannSpace] + refine Or.inr ⟨hx0, ?_⟩ + intro v + by_cases hv : v = Q + · simpa [hv] using hxQ + · have hxmem := + (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp x.2 + rcases hxmem with hxmem | ⟨_, hxorders⟩ + · exact (hx0 hxmem).elim + · have hxv := hxorders v + simp only [Finsupp.add_apply, + Finsupp.single_eq_of_ne hv] at hxv + simpa using hxv + · intro hxS + by_cases hx0 : x.1 = 0 + · have hlift0 : localNormalizedLift (R := R) T a hregular x = 0 := by + apply IsFractionRing.injective R L + rw [map_zero, + ← localNormalizedLift_spec (R := R) T a hregular x] + simp [hx0] + rw [hlift0] + exact (IsLocalRing.maximalIdeal R).zero_mem + · have hxmem := + (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp hxS + rcases hxmem with hxmem | ⟨_, hxorders⟩ + · exact (hx0 hxmem).elim + · have hxQ := hxorders Q + have haxOrder : + (1 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop + (K := K) (L := L) P (a * x.1) := by + rw [finiteExtensionInfinityPlaceLocalOrderTop_mul, + show a = πL ^ (m + 1) by rfl, + finiteExtensionInfinityPlaceLocalOrderTop_pow, + hπOrder, + finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder P x.1 hx0, + ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder + (K := K) (L := L) x.1 P] + rw [show (m + 1) • (1 : WithTop ℤ) = + ((m + 1 : ℕ) : WithTop ℤ) by simp] + exact_mod_cast (show 1 ≤ (m : ℤ) + 1 + + finiteExtensionPrincipalDivisor K L x.1 Q by + rw [hm] + omega) + rw [localNormalizedLift_spec (R := R) T a hregular x] at haxOrder + by_cases hr0 : localNormalizedLift (R := R) T a hregular x = 0 + · rw [hr0] + exact (IsLocalRing.maximalIdeal R).zero_mem + · apply mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap + (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) + (localNormalizedLift (R := R) T a hregular x) + have hrMapNe : + algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hr0 + change (1 : WithTop ℤ) ≤ finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) at haxOrder + rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] at haxOrder + exact_mod_cast haxOrder + have hker : f.ker = Submodule.comap T.subtype S := by + ext x + rw [LinearMap.mem_ker, Submodule.mem_comap] + exact hkerPoint x + letI : Finite (IsLocalRing.ResidueField R) := by + letI : Finite P.1.ResidueField := + finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P + change Finite + (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField + exact Finite.of_injective + (infinityIncrementResidueFieldAlgEquiv K L P) + (infinityIncrementResidueFieldAlgEquiv K L P).injective + letI : Module.Finite K (IsLocalRing.ResidueField R) := + Module.Finite.of_finite + letI : Module.Finite K f.range := inferInstance + letI : Module.Finite K f.ker := by + rw [hker] + exact Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hST).symm + letI : Module.Finite K (T ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + letI hTFinite : Module.Finite K T := + Module.Finite.of_submodule_quotient f.ker + have hkerRank : Module.finrank K f.ker = Module.finrank K S := by + rw [hker] + exact (Submodule.comapSubtypeEquivOfLe hST).finrank_eq + constructor + · exact hTFinite + · calc + Module.finrank K T = + Module.finrank K f.range + Module.finrank K f.ker := + f.finrank_range_add_finrank_ker.symm + _ ≤ Module.finrank K (IsLocalRing.ResidueField R) + + Module.finrank K S := + Nat.add_le_add f.range.finrank_le (le_of_eq hkerRank) + _ = Module.finrank K S + + finiteExtensionPlaceDegree K L (.inr P) := by + rw [hResidueRank, Nat.add_comm] + +end InfinityPlace + +end +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean new file mode 100644 index 0000000000..8068bd5688 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean @@ -0,0 +1,178 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum +import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace + +/-! +# Spectral bounds from even power-sum asymptotics + +This file formalizes the elementary Corvaja--Zannier/Tao step that turns an +even-extension point-count asymptotic into the Riemann-hypothesis bound for +each Frobenius parameter. + +Repeated squared parameters must first be grouped. Their coefficients are +the positive cardinalities of their fibers, so the weighted power-sum lemma +from `BGS.HasseWeil.PowerSum` applies without an injectivity assumption on the +original family of parameters. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics +open scoped BigOperators + +noncomputable section + +/-- The finite set of distinct squared values occurring in `alpha`. -/ +def squaredBaseSet {N : ℕ} (alpha : Fin N → ℂ) : Finset ℂ := + Finset.univ.image fun i ↦ alpha i ^ 2 + +/-- The complex-valued multiplicity of a squared value occurring in `alpha`. -/ +def squaredBaseMultiplicity {N : ℕ} (alpha : Fin N → ℂ) (z : ℂ) : ℂ := + ((Finset.univ.filter fun i ↦ alpha i ^ 2 = z).card : ℂ) + +/-- Every squared value in `squaredBaseSet alpha` has positive, hence nonzero, +multiplicity. -/ +lemma squaredBaseMultiplicity_ne_zero_of_mem + {N : ℕ} {alpha : Fin N → ℂ} {z : ℂ} (hz : z ∈ squaredBaseSet alpha) : + squaredBaseMultiplicity alpha z ≠ 0 := by + classical + rw [squaredBaseSet, Finset.mem_image] at hz + rcases hz with ⟨i, hi, rfl⟩ + rw [squaredBaseMultiplicity] + have hmem : i ∈ Finset.univ.filter (fun j : Fin N ↦ alpha j ^ 2 = alpha i ^ 2) := by + exact Finset.mem_filter.mpr ⟨Finset.mem_univ i, rfl⟩ + have hcard : + (Finset.univ.filter (fun j : Fin N ↦ alpha j ^ 2 = alpha i ^ 2)).card ≠ 0 := + Finset.card_ne_zero.mpr ⟨i, hmem⟩ + exact_mod_cast hcard + +/-- Grouping repeated squared values with their multiplicities recovers the +original even power sum. -/ +lemma weightedPowerSum_squaredBaseMultiplicity + {N : ℕ} (alpha : Fin N → ℂ) (n : ℕ) : + weightedPowerSum (squaredBaseSet alpha) (squaredBaseMultiplicity alpha) n = + ∑ i, alpha i ^ (2 * n) := by + classical + rw [weightedPowerSum, squaredBaseSet] + calc + ∑ z ∈ Finset.univ.image (fun i ↦ alpha i ^ 2), + squaredBaseMultiplicity alpha z * z ^ n = + ∑ z ∈ Finset.univ.image (fun i ↦ alpha i ^ 2), + ∑ i ∈ Finset.univ with alpha i ^ 2 = z, (alpha i ^ 2) ^ n := by + apply Finset.sum_congr rfl + intro z hz + rw [squaredBaseMultiplicity] + calc + ((Finset.univ.filter fun i ↦ alpha i ^ 2 = z).card : ℂ) * z ^ n = + ∑ _i ∈ Finset.univ.filter (fun i ↦ alpha i ^ 2 = z), z ^ n := by simp + _ = ∑ i ∈ Finset.univ with alpha i ^ 2 = z, (alpha i ^ 2) ^ n := by + apply Finset.sum_congr rfl + intro i hi + rw [(Finset.mem_filter.mp hi).2] + _ = ∑ i, (alpha i ^ 2) ^ n := + Finset.sum_fiberwise_of_maps_to + (fun i hi ↦ Finset.mem_image.mpr ⟨i, hi, rfl⟩) (fun i ↦ (alpha i ^ 2) ^ n) + _ = ∑ i, alpha i ^ (2 * n) := by + apply Finset.sum_congr rfl + intro i hi + rw [pow_mul] + +/-- An `O(q ^ n)` bound for all even power sums forces every spectral +parameter to have norm at most `sqrt q`. + +The `IsBigO` hypothesis already allows an arbitrary fixed multiplicative +constant. -/ +theorem spectral_norm_le_sqrt_of_evenPowerSum_isBigO + {N : ℕ} {q : ℝ} (alpha : Fin N → ℂ) + (hq : 0 ≤ q) + (hO : (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * n)) =O[atTop] + fun n : ℕ ↦ q ^ n) : + ∀ i, ‖alpha i‖ ≤ Real.sqrt q := by + classical + have hgrouped : + weightedPowerSum (squaredBaseSet alpha) (squaredBaseMultiplicity alpha) =O[atTop] + fun n : ℕ ↦ q ^ n := + hO.congr_left fun n ↦ (weightedPowerSum_squaredBaseMultiplicity alpha n).symm + have hall := weightedPowerSum_base_norm_le hq + (fun z hz ↦ squaredBaseMultiplicity_ne_zero_of_mem hz) hgrouped + intro i + have hmem : alpha i ^ 2 ∈ squaredBaseSet alpha := by + rw [squaredBaseSet] + exact Finset.mem_image.mpr ⟨i, Finset.mem_univ i, rfl⟩ + have hsquare : ‖alpha i ^ 2‖ ≤ q := hall (alpha i ^ 2) hmem + have hnormSquare : ‖alpha i‖ ^ 2 ≤ q := by + simpa only [norm_pow] using hsquare + exact (Real.le_sqrt (norm_nonneg _) hq).2 hnormSquare + +/-- It is enough to control the even power sums along any fixed positive +divisible subsequence. -/ +theorem spectral_norm_le_sqrt_of_divisibleEvenPowerSum_isBigO + {N δ : ℕ} {q : ℝ} (alpha : Fin N → ℂ) + (hq : 0 < q) (hδ : 0 < δ) + (hO : (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * δ * n)) =O[atTop] + fun n : ℕ ↦ (q ^ δ) ^ n) : + ∀ i, ‖alpha i‖ ≤ Real.sqrt q := by + classical + have hO' : + (fun n : ℕ ↦ ∑ i, (alpha i ^ δ) ^ (2 * n)) =O[atTop] + fun n : ℕ ↦ (q ^ δ) ^ n := + hO.congr_left fun n ↦ by + apply Finset.sum_congr rfl + intro i hi + calc + alpha i ^ (2 * δ * n) = alpha i ^ (δ * (2 * n)) := by + congr 1 + ac_rfl + _ = (alpha i ^ δ) ^ (2 * n) := by rw [pow_mul] + have hpowered := spectral_norm_le_sqrt_of_evenPowerSum_isBigO + (fun i ↦ alpha i ^ δ) (pow_nonneg hq.le δ) hO' + intro i + have hsquared : + ‖alpha i ^ δ‖ ^ 2 ≤ (Real.sqrt (q ^ δ)) ^ 2 := + pow_le_pow_left₀ (norm_nonneg _) (hpowered i) 2 + have hpow : (‖alpha i‖ ^ 2) ^ δ ≤ q ^ δ := by + calc + (‖alpha i‖ ^ 2) ^ δ = ‖alpha i‖ ^ (2 * δ) := by rw [pow_mul] + _ = ‖alpha i‖ ^ (δ * 2) := by + congr 1 + ac_rfl + _ = (‖alpha i‖ ^ δ) ^ 2 := by rw [pow_mul] + _ = ‖alpha i ^ δ‖ ^ 2 := by rw [norm_pow] + _ ≤ (Real.sqrt (q ^ δ)) ^ 2 := hsquared + _ = q ^ δ := Real.sq_sqrt (pow_nonneg hq.le δ) + have hnormSquare : ‖alpha i‖ ^ 2 ≤ q := + le_of_pow_le_pow_left₀ hδ.ne' hq.le hpow + exact (Real.le_sqrt (norm_nonneg _) hq.le).2 hnormSquare + +/-- The Hasse point-count inequality obtained from a spectral point-count +formula and the even-power-sum asymptotic. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_evenPowerSum_isBigO + (q g pointCount : ℕ) (alpha : Fin (2 * g) → ℂ) + (hformula : HasPointCountSpectralFormula q g pointCount alpha) + (hO : (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * n)) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + |(pointCount : ℝ) - q - 1| ≤ (2 * g : ℝ) * Real.sqrt q := by + apply abs_pointCount_sub_card_sub_one_le_of_spectralFormula q g pointCount alpha hformula + exact spectral_norm_le_sqrt_of_evenPowerSum_isBigO alpha (by positivity) hO + +/-- The degree-one Hasse bound follows from a power-sum estimate on any fixed +positive divisible-even subsequence. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_divisibleEvenPowerSum_isBigO + (q g pointCount δ : ℕ) (alpha : Fin (2 * g) → ℂ) + (hq : 0 < q) (hδ : 0 < δ) + (hformula : HasPointCountSpectralFormula q g pointCount alpha) + (hO : (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * δ * n)) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n) : + |(pointCount : ℝ) - q - 1| ≤ (2 * g : ℝ) * Real.sqrt q := by + apply abs_pointCount_sub_card_sub_one_le_of_spectralFormula q g pointCount alpha hformula + exact spectral_norm_le_sqrt_of_divisibleEvenPowerSum_isBigO alpha + (by exact_mod_cast hq) hδ hO + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean new file mode 100644 index 0000000000..c7e650d237 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean @@ -0,0 +1,872 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import Mathlib.FieldTheory.Finite.GaloisField +import Mathlib.Tactic + +/-! +# Quadratic-extension affine points and base-field places + +An affine point over the quadratic constant-field extension does not in +general determine a distinct place of the base function field: its Frobenius +conjugate has the same affine centre. This file therefore passes through the +maximal ideal of the base coordinate ring and keeps the residue-degree +weight. Fibres over a closed affine centre have cardinality at most the +degree of its residue field (and hence at most two). + +The selected normalization place above each closed centre may have larger +residue field at a singular point. This only strengthens the weighted +count. The final estimate bounds all quadratic-extension affine points by +the positive divisor degree, and by the height for a nonzero function. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped BigOperators nonZeroDivisors Polynomial + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] +variable (p : ℕ) [Fact p.Prime] [CharP K p] + +/-- Mathlib's chosen quadratic extension of the finite field `K`. -/ +abbrev SquareExtension := FiniteField.Extension K p 2 + +/-- Affine zeros of the base-changed plane equation over the quadratic +extension. -/ +abbrev SquareExtensionAffinePoint (f : MvPolynomial (Fin 2) K) := + AffineBivariatePoint (extensionPlaneCurvePolynomial K p 2 f) + +/-- Evaluation of the base coordinate ring at a quadratic-extension affine +point. -/ +def squareExtensionPointEval + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) : + PlaneCurveCoordinateRing f →ₐ[K] SquareExtension K p where + toRingHom := Ideal.Quotient.lift (Ideal.span {f}) + (MvPolynomial.eval₂Hom + (algebraMap K (SquareExtension K p)) ![z.1.1, z.1.2]) (by + intro g hg + obtain ⟨a, rfl⟩ := Ideal.mem_span_singleton.mp hg + rw [map_mul] + have hfzero : MvPolynomial.eval₂ + (algebraMap K (SquareExtension K p)) ![z.1.1, z.1.2] f = 0 := by + rw [MvPolynomial.eval₂_eq_eval_map] + exact z.2 + change MvPolynomial.eval₂ + (algebraMap K (SquareExtension K p)) ![z.1.1, z.1.2] f * + MvPolynomial.eval₂ + (algebraMap K (SquareExtension K p)) ![z.1.1, z.1.2] a = 0 + rw [hfzero, zero_mul]) + commutes' c := by + change MvPolynomial.eval₂ + (algebraMap K (SquareExtension K p)) ![z.1.1, z.1.2] + (MvPolynomial.C c) = algebraMap K (SquareExtension K p) c + simp + +omit [DecidableEq K] in +@[simp] +theorem squareExtensionPointEval_coordinate + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) (i : Fin 2) : + squareExtensionPointEval K p f z (planeCurveCoordinate f i) = + ![z.1.1, z.1.2] i := by + simp [squareExtensionPointEval, planeCurveCoordinate, + planeCurveQuotientMap] + +/-- The base closed affine centre of a quadratic-extension point. The +kernel is maximal because the finite image of the evaluation homomorphism is +a field. -/ +def squareExtensionPointMaximalIdeal + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) : + MaximalSpectrum (PlaneCurveCoordinateRing f) := by + let φ := squareExtensionPointEval K p f z + let R := φ.range + letI : Finite R := inferInstance + letI : IsDomain R := inferInstance + letI : Field R := IsField.toField (Finite.isField_of_domain R) + refine ⟨RingHom.ker φ, ?_⟩ + rw [← AlgHom.ker_rangeRestrict φ] + exact RingHom.ker_isMaximal_of_surjective φ.rangeRestrict.toRingHom + φ.rangeRestrict_surjective + +omit [DecidableEq K] in +@[simp] +theorem squareExtensionPointMaximalIdeal_asIdeal + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) : + (squareExtensionPointMaximalIdeal K p f z).asIdeal = + RingHom.ker (squareExtensionPointEval K p f z) := by + simp [squareExtensionPointMaximalIdeal] + +/-- Closed affine centres arising from quadratic-extension points. -/ +abbrev SquareExtensionClosedPoint (f : MvPolynomial (Fin 2) K) := + Set.range (squareExtensionPointMaximalIdeal K p f) + +noncomputable instance squareExtensionAffinePointFintype + (f : MvPolynomial (Fin 2) K) : + Fintype (SquareExtensionAffinePoint K p f) := + Fintype.ofFinite _ + +/-- Send a quadratic-extension point to its base closed affine centre. -/ +def squareExtensionClosedPointMap + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) : + SquareExtensionClosedPoint K p f := + ⟨squareExtensionPointMaximalIdeal K p f z, ⟨z, rfl⟩⟩ + +omit [DecidableEq K] in +theorem squareExtensionClosedPointMap_surjective + (f : MvPolynomial (Fin 2) K) : + Function.Surjective (squareExtensionClosedPointMap K p f) := by + rintro ⟨m, z, rfl⟩ + exact ⟨z, rfl⟩ + +noncomputable instance squareExtensionClosedPointFintype + (f : MvPolynomial (Fin 2) K) : + Fintype (SquareExtensionClosedPoint K p f) := by + exact Fintype.ofFinite _ + +/-- The fibre of quadratic-extension points above one base closed affine +centre. -/ +abbrev SquareExtensionClosedPointFiber + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) := + {z : SquareExtensionAffinePoint K p f // + squareExtensionClosedPointMap K p f z = m} + +noncomputable instance squareExtensionClosedPointFiberFintype + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) : + Fintype (SquareExtensionClosedPointFiber K p f m) := + Fintype.ofFinite _ + +/-- A point in a fixed closed-centre fibre gives a `K`-embedding of that +centre's residue field into the quadratic extension. -/ +def squareExtensionFiberResidueAlgHom + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) + (z : SquareExtensionClosedPointFiber K p f m) : + m.1.asIdeal.ResidueField →ₐ[K] SquareExtension K p := by + let φ := squareExtensionPointEval K p f z.1 + have hm : squareExtensionPointMaximalIdeal K p f z.1 = m.1 := + congrArg Subtype.val z.2 + have hker : m.1.asIdeal = RingHom.ker φ := by + rw [← hm] + exact squareExtensionPointMaximalIdeal_asIdeal K p f z.1 + apply Ideal.ResidueField.liftₐ m.1.asIdeal φ hker.le + intro a ha + change IsUnit (φ a) + rw [isUnit_iff_ne_zero] + intro hzero + apply ha + rw [hker] + exact hzero + +omit [DecidableEq K] in +theorem squareExtensionFiberResidueAlgHom_injective + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) : + Function.Injective + (squareExtensionFiberResidueAlgHom K p f m) := by + intro z w hzw + apply Subtype.ext + apply Subtype.ext + apply Prod.ext + · have h := DFunLike.congr_fun hzw + (algebraMap (PlaneCurveCoordinateRing f) m.1.asIdeal.ResidueField + (planeCurveCoordinate f 0)) + simpa [squareExtensionFiberResidueAlgHom] using h + · have h := DFunLike.congr_fun hzw + (algebraMap (PlaneCurveCoordinateRing f) m.1.asIdeal.ResidueField + (planeCurveCoordinate f 1)) + simpa [squareExtensionFiberResidueAlgHom] using h + +omit [DecidableEq K] in +/-- A closed-centre fibre has cardinality at most the degree of its residue +field over `K`. -/ +theorem squareExtensionClosedPointFiber_card_le_residueDegree + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) : + Fintype.card (SquareExtensionClosedPointFiber K p f m) ≤ + Module.finrank K m.1.asIdeal.ResidueField := by + obtain ⟨z, hz⟩ := m.2 + let zf : SquareExtensionClosedPointFiber K p f m := + ⟨z, Subtype.ext hz⟩ + let ι := squareExtensionFiberResidueAlgHom K p f m zf + letI : Finite m.1.asIdeal.ResidueField := + Finite.of_injective ι ι.injective + letI : Fintype m.1.asIdeal.ResidueField := Fintype.ofFinite _ + letI : Module.Finite K m.1.asIdeal.ResidueField := + Module.Finite.of_fg_top (by + rw [Submodule.fg_def] + exact ⟨Set.univ, Set.finite_univ, by simp⟩) + let Φ := squareExtensionFiberResidueAlgHom K p f m + calc + Fintype.card (SquareExtensionClosedPointFiber K p f m) = + Nat.card (SquareExtensionClosedPointFiber K p f m) := + Fintype.card_eq_nat_card + _ ≤ Nat.card + (m.1.asIdeal.ResidueField →ₐ[K] SquareExtension K p) := + Nat.card_le_card_of_injective Φ + (squareExtensionFiberResidueAlgHom_injective K p f m) + _ ≤ Module.finrank K m.1.asIdeal.ResidueField := + card_algHom_le_finrank K m.1.asIdeal.ResidueField + (SquareExtension K p) + +omit [DecidableEq K] in +/-- Every such closed affine centre has degree one or two. -/ +theorem squareExtensionClosedPoint_residueDegree_le_two + (f : MvPolynomial (Fin 2) K) + (m : SquareExtensionClosedPoint K p f) : + Module.finrank K m.1.asIdeal.ResidueField ≤ 2 := by + obtain ⟨z, hz⟩ := m.2 + let zf : SquareExtensionClosedPointFiber K p f m := + ⟨z, Subtype.ext hz⟩ + let ι := squareExtensionFiberResidueAlgHom K p f m zf + have hdvd : Module.finrank K m.1.asIdeal.ResidueField ∣ + Module.finrank K (SquareExtension K p) := + FiniteField.nonempty_algHom_iff_finrank_dvd.mp ⟨ι⟩ + rw [FiniteField.finrank_extension K p 2] at hdvd + exact Nat.le_of_dvd (by omega) hdvd + +/-- The residue field of a maximal ideal is canonically the residue field of +its localization at that ideal, as an algebra over any compatible base +field. -/ +def atPrimeResidueAlgEquiv + (B R : Type*) [CommRing B] [Algebra K B] + [CommRing R] [Algebra B R] [Algebra K R] [IsScalarTower K B R] + [IsLocalRing R] (q : Ideal B) [q.IsMaximal] + [IsLocalization.AtPrime R q] : + q.ResidueField ≃ₐ[K] IsLocalRing.ResidueField R := by + let e₁ : (B ⧸ q) ≃ₐ[K] q.ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom K (B ⧸ q) q.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField q) + let e : (B ⧸ q) ≃+* IsLocalRing.ResidueField R := + IsLocalization.AtPrime.equivQuotMaximalIdeal q R + let e₂ : (B ⧸ q) ≃ₐ[K] IsLocalRing.ResidueField R := + { e with + commutes' := by + intro c + change (IsLocalization.AtPrime.equivQuotMaximalIdeal q R) + (Ideal.Quotient.mk q (algebraMap K B c)) = + IsLocalRing.residue R (algebraMap K R c) + rw [IsLocalization.AtPrime.equivQuotMaximalIdeal_apply_mk, + IsScalarTower.algebraMap_apply K B R] + rfl } + exact e₁.symm.trans e₂ + +/-! ## A selected normalization place above each closed affine centre -/ + +omit [DecidableEq K] in +/-- The first coordinate satisfies the quadratic-extension Frobenius +polynomial at every quadratic-extension point. -/ +theorem squareExtensionFrobeniusElement_mem_pointMaximalIdeal + (f : MvPolynomial (Fin 2) K) + (z : SquareExtensionAffinePoint K p f) : + planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - + planeCurveCoordinate f 0 ∈ + (squareExtensionPointMaximalIdeal K p f z).asIdeal := by + letI : Fintype (SquareExtension K p) := Fintype.ofFinite _ + rw [squareExtensionPointMaximalIdeal_asIdeal] + change squareExtensionPointEval K p f z + (planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - + planeCurveCoordinate f 0) = 0 + rw [map_sub, map_pow, squareExtensionPointEval_coordinate] + have hcard : Fintype.card (SquareExtension K p) = (Nat.card K) ^ 2 := by + rw [Fintype.card_eq_nat_card] + exact FiniteField.natCard_extension K p 2 + rw [← hcard, FiniteField.pow_card, sub_self] + +omit [DecidableEq K] in +/-- Every base closed affine centre arising from a quadratic-extension point +has an exhaustive finite place above it. -/ +theorem exists_squareExtensionClosedPoint_exhaustiveFinitePlace + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsDedekindDomain + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) + letI : IsFractionRing + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) + (PlaneCurveFunctionField f) := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) + (PlaneCurveFunctionField f) + ∃ q : HeightOneSpectrum + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)), + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) q = + dominatingValuationSubring m.1 := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : IsDedekindDomain + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := + integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) + letI : IsFractionRing + (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) + (PlaneCurveFunctionField f) := + integralClosure.isFractionRing_of_finite_extension (RatFunc K) + (PlaneCurveFunctionField f) + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + let B := integralClosure (Polynomial K) E + let hbase : ∀ P : Polynomial K, + algebraMap (Polynomial K) E P ∈ (algebraMap A E).range := + polynomial_algebraMap_mem_planeCurveCoordinateRing_range hf hpartialSecond + let V := dominatingValuationSubring (A := A) (L := E) m.1 + let r : A := planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - + planeCurveCoordinate f 0 + let P : Polynomial K := Polynomial.X ^ (Nat.card K) ^ 2 - Polynomial.X + let b : B := algebraMap (Polynomial K) B P + obtain ⟨z, hz⟩ := m.2 + have hm : squareExtensionPointMaximalIdeal K p f z = m.1 := hz + have hr : r ∈ m.1.asIdeal := by + rw [← hm] + exact squareExtensionFrobeniusElement_mem_pointMaximalIdeal K p f z + have hP0 : P ≠ 0 := by + exact FiniteField.X_pow_card_pow_sub_X_ne_zero K (by omega) + Finite.one_lt_card + have hPMap : algebraMap (Polynomial K) E P = + planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - + planeCurveFunction f 0 := by + change ratFuncSpecialization (planeCurveFunction f 0) hx + (algebraMap (Polynomial K) (RatFunc K) P) = _ + have hcomp := congrArg + (fun h : Polynomial K →+* E => h P) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [P] using hcomp + have hfun0 : planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - + planeCurveFunction f 0 ≠ 0 := by + intro hzero + apply hP0 + apply (transcendental_iff.mp hx) P + simpa [P] using hzero + have hrMap : algebraMap A E r = + planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - + planeCurveFunction f 0 := by + simp only [r, map_sub, map_pow] + rfl + have hbMap : algebraMap B E b = + planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - + planeCurveFunction f 0 := by + rw [show algebraMap B E b = algebraMap (Polynomial K) E P by + exact IsScalarTower.algebraMap_apply (Polynomial K) B E P] + exact hPMap + have hb0 : b ≠ 0 := by + intro hb + apply hfun0 + rw [← hbMap, hb, map_zero] + have hnonunits : + planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - + planeCurveFunction f 0 ∈ V.nonunits := by + rw [← hrMap] + exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) m.1 r hr + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - + planeCurveFunction f 0, hfun0, hnonunits⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hbMem : b ∈ dominatingIntegralClosurePrime m.1 hbase := by + change integralClosureToDominatingValuationSubring m.1 hbase b ∈ + IsLocalRing.maximalIdeal V + apply ValuationSubring.coe_mem_nonunits_iff.mp + have hcoe : + ((integralClosureToDominatingValuationSubring + m.1 hbase b : V) : E) = algebraMap B E b := by + rfl + rw [hcoe, hbMap] + exact hnonunits + have hqne : dominatingIntegralClosurePrime m.1 hbase ≠ ⊥ := by + intro hbot + have : b = 0 := by simpa [hbot] using hbMem + exact hb0 this + exact ⟨dominatingIntegralClosurePlace m.1 hbase hqne, + valuationSubringAt_dominatingIntegralClosurePlace_eq + m.1 hbase hqne hV⟩ + +/-- The selected exhaustive finite place above a quadratic-extension closed +affine centre. -/ +def squareExtensionClosedPointExhaustiveFinitePlace + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + FiniteExtensionFinitePlace K (PlaneCurveFunctionField f) := by + exact Classical.choose + (exists_squareExtensionClosedPoint_exhaustiveFinitePlace + K p hf hpartialSecond m) + +omit [DecidableEq K] in +/-- The selected place has the prescribed dominating valuation subring. -/ +theorem squareExtensionClosedPointExhaustiveFinitePlace_spec + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m) = + dominatingValuationSubring m.1 := by + exact Classical.choose_spec + (exists_squareExtensionClosedPoint_exhaustiveFinitePlace + K p hf hpartialSecond m) + +omit [DecidableEq K] in +/-- Distinct closed affine centres have distinct selected finite places. -/ +theorem squareExtensionClosedPointExhaustiveFinitePlace_injective + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + Function.Injective + (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + change Function.Injective + (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond) + intro m n hmn + apply Subtype.ext + apply MaximalSpectrum.ext + apply pointIdeal_eq_of_dominatingValuationSubring_eq + (A := PlaneCurveCoordinateRing f) + (L := PlaneCurveFunctionField f) + calc + dominatingValuationSubring m.1 = + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m) := + (squareExtensionClosedPointExhaustiveFinitePlace_spec + K p hf hpartialSecond m).symm + _ = IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) + (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond n) := by rw [hmn] + _ = dominatingValuationSubring n.1 := + squareExtensionClosedPointExhaustiveFinitePlace_spec + K p hf hpartialSecond n + +/-- The residue degree of a closed affine centre is at most the degree of its +selected normalization place. The inequality can be strict at a singular +centre. -/ +theorem squareExtensionClosedPoint_residueDegree_le_placeDegree + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (m : SquareExtensionClosedPoint K p f) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Module.finrank K m.1.asIdeal.ResidueField ≤ + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) + (.inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let E := PlaneCurveFunctionField f + let q : FiniteExtensionFinitePlace K E := + squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m + let B := RatFuncFiniteIntegralClosure K E + letI : Algebra K B := + RingHom.toAlgebra + ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) + letI : IsScalarTower K (Polynomial K) B := + IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower K (RatFunc K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + have h := congrArg + (fun g : Polynomial K →+* E => g (Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap + (planeCurveFunction f 0) hx) + simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) + letI : IsScalarTower K (Polynomial K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] + rfl) + letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] + rfl) + let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q + letI : Algebra K R := + RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) + letI : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl + let V := dominatingValuationSubring + (A := PlaneCurveCoordinateRing f) (L := E) m.1 + have hspec : R = V := + squareExtensionClosedPointExhaustiveFinitePlace_spec + K p hf hpartialSecond m + let eVR : V ≃+* R := + { toFun := fun x => ⟨x.1, by rw [hspec]; exact x.2⟩ + invFun := fun x => ⟨x.1, by rw [← hspec]; exact x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + let A := PlaneCurveCoordinateRing f + let ψ : A →+* R := + eVR.toRingHom.comp + (coordinateRingToDominatingValuationSubring + (A := A) (L := E) m.1) + have hcenter : m.1.asIdeal = + Ideal.comap ψ (IsLocalRing.maximalIdeal R) := by + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := E)] + ext a + change coordinateRingToDominatingValuationSubring m.1 a ∈ + IsLocalRing.maximalIdeal V ↔ + eVR (coordinateRingToDominatingValuationSubring m.1 a) ∈ + IsLocalRing.maximalIdeal R + simp only [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact (not_congr (MulEquiv.isUnit_map (f := eVR.toMulEquiv))).symm + have hψcoe (a : A) : ((ψ a : R) : E) = algebraMap A E a := by + rfl + let θ : A →ₐ[K] IsLocalRing.ResidueField R := + { toRingHom := (IsLocalRing.residue R).comp ψ + commutes' := by + intro c + rw [IsScalarTower.algebraMap_apply K R + (IsLocalRing.ResidueField R)] + apply congrArg (IsLocalRing.residue R) + apply Subtype.ext + rw [hψcoe] + change algebraMap A E (algebraMap K A c) = + algebraMap B E (algebraMap K B c) + rw [← IsScalarTower.algebraMap_apply K A E, + ← IsScalarTower.algebraMap_apply K B E] } + have hker : m.1.asIdeal = RingHom.ker θ := by + ext a + rw [RingHom.mem_ker] + change a ∈ m.1.asIdeal ↔ IsLocalRing.residue R (ψ a) = 0 + rw [IsLocalRing.residue_eq_zero_iff, hcenter] + rfl + let ι : m.1.asIdeal.ResidueField →ₐ[K] + IsLocalRing.ResidueField R := by + apply Ideal.ResidueField.liftₐ m.1.asIdeal θ hker.le + intro a ha + change IsUnit (θ a) + rw [isUnit_iff_ne_zero] + intro hzero + apply ha + rw [hker] + exact hzero + let e := atPrimeResidueAlgEquiv K B R q.asIdeal + letI : DecidableEq (RatFunc K) := Classical.decEq _ + have hplace : finiteExtensionPlaceDegree K E (.inl q) = + Module.finrank K q.asIdeal.ResidueField := + finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q + letI : Module.Finite K q.asIdeal.ResidueField := + Module.finite_of_finrank_pos (by + rw [← hplace] + exact finiteExtensionPlaceDegree_pos K E (.inl q)) + letI : Module.Finite K (IsLocalRing.ResidueField R) := + Module.Finite.equiv e.toLinearEquiv + have hle : Module.finrank K m.1.asIdeal.ResidueField ≤ + Module.finrank K (IsLocalRing.ResidueField R) := + LinearMap.finrank_le_finrank_of_injective + (f := ι.toLinearMap) ι.injective + have heq : Module.finrank K (IsLocalRing.ResidueField R) = + Module.finrank K q.asIdeal.ResidueField := + e.symm.toLinearEquiv.finrank_eq + rw [hplace, ← heq] + exact hle + +/-- Quadratic-extension affine points are bounded by the sum of the degrees +of one selected normalization place above each closed affine centre. The +residue degree is the weight that accounts for Frobenius-conjugate points. -/ +theorem squareExtensionAffinePoint_card_le_selectedPlaceDegreeSum + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + Fintype.card (SquareExtensionAffinePoint K p f) ≤ + ∑ m : SquareExtensionClosedPoint K p f, + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) + (.inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m)) := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + have hcard : + Fintype.card (SquareExtensionAffinePoint K p f) = + ∑ m : SquareExtensionClosedPoint K p f, + Fintype.card (SquareExtensionClosedPointFiber K p f m) := by + rw [← Fintype.card_sigma] + exact Fintype.card_congr + (Equiv.sigmaFiberEquiv (squareExtensionClosedPointMap K p f)).symm + rw [hcard] + apply Finset.sum_le_sum + intro m _hm + exact (squareExtensionClosedPointFiber_card_le_residueDegree K p f m).trans + (squareExtensionClosedPoint_residueDegree_le_placeDegree + K p hf hpartialSecond m) + +/-- If a nonzero function has positive order at one selected normalization +place above every closed affine centre arising over the quadratic extension, +then every such affine point is counted by the function's pole height. -/ +theorem squareExtensionAffinePoint_card_le_finiteExtensionHeight_of_selectedPlace_orders_positive + {f : MvPolynomial (Fin 2) K} + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) + (u : PlaneCurveFunctionField f) (hu : u ≠ 0) : + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + (∀ m : SquareExtensionClosedPoint K p f, + 0 < finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) u + (.inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m))) → + Fintype.card (SquareExtensionAffinePoint K p f) ≤ + finiteExtensionHeight K (PlaneCurveFunctionField f) u := by + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + letI : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := + IsScalarTower.of_algebraMap_eq' rfl + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (RatFunc K) := Classical.decEq _ + change + (∀ m : SquareExtensionClosedPoint K p f, + 0 < finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) u + (.inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m))) → + Fintype.card (SquareExtensionAffinePoint K p f) ≤ + finiteExtensionHeight K (PlaneCurveFunctionField f) u + intro hpositive + classical + let place : SquareExtensionClosedPoint K p f → + FiniteExtensionPlace K (PlaneCurveFunctionField f) := fun m => + .inl (squareExtensionClosedPointExhaustiveFinitePlace + K p hf hpartialSecond m) + have hplaceInjective : Function.Injective place := by + intro m n hmn + apply squareExtensionClosedPointExhaustiveFinitePlace_injective + K p hf hpartialSecond + exact Sum.inl_injective hmn + let S : Finset (FiniteExtensionPlace K (PlaneCurveFunctionField f)) := + Finset.univ.image place + have hsum : + (∑ m : SquareExtensionClosedPoint K p f, + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (place m)) = + ∑ v ∈ S, + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) v := by + symm + exact Finset.sum_image hplaceInjective.injOn + have hSpositive : + ∀ v ∈ S, + 0 < finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) u v := by + intro v hv + rcases Finset.mem_image.mp hv with ⟨m, _hm, rfl⟩ + exact hpositive m + calc + Fintype.card (SquareExtensionAffinePoint K p f) ≤ + ∑ m : SquareExtensionClosedPoint K p f, + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (place m) := by + exact squareExtensionAffinePoint_card_le_selectedPlaceDegreeSum + K p hf hpartialSecond + _ = ∑ v ∈ S, + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) v := hsum + _ ≤ finiteExtensionHeight K (PlaneCurveFunctionField f) u := + sum_placeDegree_le_finiteExtensionHeight_of_orders_positive + K (PlaneCurveFunctionField f) u hu S hSpositive + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean new file mode 100644 index 0000000000..1e9148c527 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean @@ -0,0 +1,81 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +import Mathlib.Tactic + +/-! +# Degree-one residues over a square constant field + +For a function field over a finite field `S`, a finite place of constant-field +degree one has residue field of cardinality `#S`. If `#S = (#K)^2`, every +residue therefore satisfies the half-Frobenius square identity used by the +semilinear Stepanov restriction. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +local instance (priority := 10) squareFieldResiduePolynomialAlgebra : + Algebra S[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S[X] (RatFunc S))) + +local instance squareFieldResiduePolynomialScalarTower : + IsScalarTower S[X] (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + +local instance squareFieldResidueFiniteConstantAlgebra : + Algebra S (RatFuncFiniteIntegralClosure S L) := + RingHom.toAlgebra ((algebraMap S[X] + (RatFuncFiniteIntegralClosure S L)).comp (algebraMap S S[X])) + +local instance squareFieldResidueFiniteConstantTower : + IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S L) := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A degree-one finite place over a square constant field has the quadratic +half-Frobenius identity in its residue field. -/ +theorem finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_one + (hcard : Fintype.card S = (Fintype.card K) ^ 2) + (q : FiniteExtensionFinitePlace S L) + (hdegree : finiteExtensionPlaceDegree S L (.inl q) = 1) : + ∀ z : q.asIdeal.ResidueField, + z ^ (Fintype.card K) ^ 2 = z := by + letI : Finite q.asIdeal.ResidueField := + finiteExtensionFinitePlace_residueField_finite (K := S) (L := L) q + letI : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ + letI : Module.Finite S q.asIdeal.ResidueField := by + rw [Module.finite_def] + exact ⟨Finset.univ, by simp⟩ + have hfinrank : Module.finrank S q.asIdeal.ResidueField = 1 := by + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField S L q] at hdegree + exact hdegree + have hresidueCard : + Fintype.card q.asIdeal.ResidueField = (Fintype.card K) ^ 2 := by + calc + Fintype.card q.asIdeal.ResidueField = + (Fintype.card S) ^ Module.finrank S q.asIdeal.ResidueField := + Module.card_eq_pow_finrank + _ = (Fintype.card K) ^ 2 := by rw [hfinrank, pow_one, hcard] + intro z + simpa [hresidueCard] using FiniteField.pow_card z + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean new file mode 100644 index 0000000000..71a403704f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean @@ -0,0 +1,131 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction +import Mathlib.Tactic + +/-! +# A sharp one-point Stepanov auxiliary over a square constant field + +The function field is defined over the full square field `S`, so an +`S`-rational normalization point is a place of degree one. The integer +`s = #K`, for a quadratic subfield `K`, is used only as the half-Frobenius +scale. This keeps both the Riemann-space dimension count and the final pole +height sharp. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +local instance squareFieldAuxiliaryConstantAlgebra : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + +local instance squareFieldAuxiliaryConstantTower : + IsScalarTower S (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Riemann's inequality at a degree-one place, together with the standard +large-square-field condition, produces the semilinear Stepanov auxiliary. +-/ +theorem exists_squareField_onePointStepanovAuxiliary_of_degree_one + (P : FiniteExtensionPlace S L) (g : ℕ) + (hconstants : algebraicClosure S L = ⊥) + (hdegree : finiteExtensionPlaceDegree S L P = 1) + (hriemann : ∀ N, + N + 1 ≤ Module.finrank S + (finiteExtensionOnePointRiemannSpace S L P N) + g) + (hlarge : (g + 1) * (g + 2) ≤ Fintype.card K) : + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM g s + ∃ (u : Option (Fin (ell - g)) → L) + (du : Option (Fin (ell - g)) → ℕ) + (v : Option (Fin (m - g)) → L) + (dv : Option (Fin (m - g)) → ℕ) + (c : (Option (Fin (ell - g)) × Option (Fin (m - g))) →₀ S), + onePointSectionFamilySpec S L P ell u du ∧ + onePointSectionFamilySpec S L P m v dv ∧ + c ≠ 0 ∧ + onePointStepanovSecondRestrictionMap S L u v s c = 0 ∧ + squareFieldStepanovFirstRestriction K S L u v c ≠ 0 := by + let s := Fintype.card K + let ell := stepanovEll s + let m := stepanovM g s + have hlarge' : (g + 1) * (g + 2) ≤ s := hlarge + have hs : 0 < s := Fintype.card_pos + have hglt : g < s := by nlinarith + have hgell : g ≤ ell := by + simp only [ell, stepanovEll] + omega + have hgm : g ≤ m := by + simp only [m, stepanovM] + omega + have helllt : ell < s := stepanovEll_lt hlarge' + have hstrict : ∀ N, g ≤ N → + N - g ≤ + (strictFiltrationLevels + (fun r => finiteExtensionOnePointRiemannSpace S L P r) N).card := by + intro N hgN + apply le_card_onePointStrictLevels_of_finrank_lower + S L P N (N - g) hconstants + have hN := hriemann N + rw [hdegree] + omega + obtain ⟨u, du, huMem, huNe, huOrder, hduInjective, + hduLe, huLI⟩ := + exists_onePointSectionsWithConstant_of_le_card_strictLevels + S L P ell (ell - g) (hstrict ell hgell) + obtain ⟨v, dv, hvMem, hvNe, hvOrder, hdvInjective, + hdvLe, hvLI⟩ := + exists_onePointSectionsWithConstant_of_le_card_strictLevels + S L P m (m - g) (hstrict m hgm) + have hgridLI : LinearIndependent S + (fun ij : Option (Fin (ell - g)) × Option (Fin (m - g)) => + u ij.1 * (v ij.2) ^ s) := by + exact onePointStepanovGrid_linearIndependent S L P u v du dv s + huNe hvNe huOrder hvOrder hduInjective hdvInjective + (fun i => (hduLe i).trans_lt helllt) + have hupper : Module.finrank S + (finiteExtensionOnePointRiemannSpace S L P (s * ell + m)) ≤ + s * ell + m + 1 := by + have h := finiteExtensionOnePointRiemannSpace_finrank_upper + S L P hconstants (s * ell + m) + rw [hdegree] at h + simpa using h + have hellCard : ell - g + 1 = ell + 1 - g := by omega + have hmCard : m - g + 1 = m + 1 - g := by omega + have hnumeric : s * ell + m + 1 < + Fintype.card (Option (Fin (ell - g))) * + Fintype.card (Option (Fin (m - g))) := by + have hdim := stepanov_dimension_inequality hlarge' + simpa only [Fintype.card_option, Fintype.card_fin, hellCard, hmCard, + Nat.mul_comm s ell] using hdim + obtain ⟨c, hc, hsecond, hfirst⟩ := + exists_squareFieldStepanovAuxiliary_of_target_finrank_upper + K S L P u v ell m (s * ell + m + 1) + huMem hvMem hgridLI hupper hnumeric + refine ⟨u, du, v, dv, c, ?_, ?_, hc, hsecond, hfirst⟩ + · exact ⟨huMem, huNe, huOrder, hduInjective, hduLe, huLI⟩ + · exact ⟨hvMem, hvNe, hvOrder, hdvInjective, hdvLe, hvLI⟩ + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean new file mode 100644 index 0000000000..ccb8f52421 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean @@ -0,0 +1,475 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing +import Mathlib.Tactic + +/-! +# Stepanov restrictions over a square constant field + +Let `S/K` be a quadratic extension of finite fields and put `s = #K`. +The square-field Stepanov argument is linear over the full constant field +`S`, but its two restrictions are related by the `s`-power automorphism. +Consequently the coefficients of the first restriction must be transformed +by that automorphism. This is the semilinear point which is lost if an +`S`-rational point is treated merely as a degree-two place over `K`. + +This file packages the coefficient transform and proves the local residue +identity. It makes no point-count or smoothness assertion. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped Polynomial BigOperators + +noncomputable section + + +section Coefficients + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Algebra K S] + +/-- Apply the `#K`-power automorphism coefficientwise to a finite grid over +the square constant field. -/ +def squareRootFrobeniusCoefficients {ι : Type*} (c : ι →₀ S) : ι →₀ S := + Finsupp.mapRange (powCardAlgHom K S 1) (map_zero (powCardAlgHom K S 1)) c + +@[simp] +theorem squareRootFrobeniusCoefficients_apply + {ι : Type*} (c : ι →₀ S) (i : ι) : + squareRootFrobeniusCoefficients K S c i = + (c i) ^ Fintype.card K := by + simp [squareRootFrobeniusCoefficients, powCardAlgHom_apply] + +theorem squareRootFrobeniusCoefficients_ne_zero + {ι : Type*} {c : ι →₀ S} (hc : c ≠ 0) : + squareRootFrobeniusCoefficients K S c ≠ 0 := by + intro hzero + apply hc + apply Finsupp.mapRange_injective _ _ (powCardAlgHom K S 1).injective + change squareRootFrobeniusCoefficients K S c = + squareRootFrobeniusCoefficients K S 0 + rw [hzero] + ext i + simp [squareRootFrobeniusCoefficients] + +end Coefficients + +section Restriction + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +local instance squareFieldRestrictionConstantAlgebra : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + +local instance squareFieldRestrictionConstantTower : + IsScalarTower S (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The first square-field restriction. The function grid is +`f_i g_j^s`, while the coefficients are transformed by `c ↦ c^s`. -/ +def squareFieldStepanovFirstRestriction + {α β : Type*} (f : α → L) (g : β → L) (c : α × β →₀ S) : L := + onePointStepanovFirstRestrictionMap S L f g (Fintype.card K) + (squareRootFrobeniusCoefficients K S c) + +/-- The transformed first restriction has the same one-point pole budget as +the ordinary first restriction. -/ +theorem squareFieldStepanovFirstRestriction_mem + {α β : Type*} (P : FiniteExtensionPlace S L) + (f : α → L) (g : β → L) (ell m : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace S L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace S L P m) + (c : α × β →₀ S) : + squareFieldStepanovFirstRestriction K S L f g c ∈ + finiteExtensionOnePointRiemannSpace S L P + (ell + Fintype.card K * m) := by + exact onePointStepanovFirstRestrictionMap_mem S L P f g ell m + (Fintype.card K) hf hg (squareRootFrobeniusCoefficients K S c) + +/-- Rank-nullity over the full square constant field produces a coefficient +grid killed by the second restriction. Frobenius injectivity and linear +independence of the first grid make the transformed first restriction +nonzero. -/ +theorem exists_squareFieldStepanovAuxiliary_of_target_finrank_upper + {α β : Type*} [Fintype α] [Fintype β] + (P : FiniteExtensionPlace S L) + (f : α → L) (g : β → L) (ell m targetBound : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace S L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace S L P m) + (hLI : LinearIndependent S + (fun ij : α × β => f ij.1 * (g ij.2) ^ Fintype.card K)) + (hupper : Module.finrank S + (finiteExtensionOnePointRiemannSpace S L P + (Fintype.card K * ell + m)) ≤ targetBound) + (hnumeric : targetBound < Fintype.card α * Fintype.card β) : + ∃ c : α × β →₀ S, + c ≠ 0 ∧ + onePointStepanovSecondRestrictionMap S L f g + (Fintype.card K) c = 0 ∧ + squareFieldStepanovFirstRestriction K S L f g c ≠ 0 := by + obtain ⟨c, hc, hsecond, _hfirst⟩ := + exists_onePointStepanovAuxiliary_of_target_finrank_upper + S L P f g ell m (Fintype.card K) targetBound + hf hg hLI hupper hnumeric + have hcFrob : squareRootFrobeniusCoefficients K S c ≠ 0 := + squareRootFrobeniusCoefficients_ne_zero K S hc + have hinjective : Function.Injective + (onePointStepanovFirstRestrictionMap S L f g (Fintype.card K)) := + onePointStepanovFirstRestrictionMap_injective_of_linearIndependent + S L f g (Fintype.card K) hLI + refine ⟨c, hc, ?_, ?_⟩ + · have h := congrArg Subtype.val hsecond + simpa only [onePointStepanovSecondCodRestrictionMap_coe, + Submodule.coe_zero] using h + · intro hzero + apply hcFrob + apply hinjective + rw [map_zero] + simpa only [squareFieldStepanovFirstRestriction] using hzero + +end Restriction + +section LocalResidue + +variable (K S R : Type*) [Field K] [Fintype K] + [Field S] [Algebra K S] + [CommRing R] [IsLocalRing R] [Algebra S R] + [Algebra K R] + +/-- With Frobenius-transformed coefficients, the residue of the first +restriction is the `#K`-power of the residue of the second restriction. -/ +theorem squareFieldStepanovLocalResidue_first_eq_frobenius_second + {α β : Type*} (F : α → R) (G : β → R) (c : α × β →₀ S) + (hsquare : ∀ z : IsLocalRing.ResidueField R, + z ^ (Fintype.card K) ^ 2 = z) : + stepanovLocalResidueAlgHom S R + (Finsupp.linearCombination S + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) + (squareRootFrobeniusCoefficients K S c)) = + powCardAlgHom K (IsLocalRing.ResidueField R) 1 + (stepanovLocalResidueAlgHom S R + (Finsupp.linearCombination S + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c)) := by + classical + let ρ := stepanovLocalResidueAlgHom S R + let φ := powCardAlgHom K (IsLocalRing.ResidueField R) 1 + rw [Finsupp.linearCombination_apply, Finsupp.linearCombination_apply] + simp only [squareRootFrobeniusCoefficients] + have hmap : + (Finsupp.mapRange (powCardAlgHom K S 1) + (map_zero (powCardAlgHom K S 1)) c).sum + (fun ij a => a • (F ij.1 * G ij.2 ^ Fintype.card K)) = + c.sum fun ij a => + (powCardAlgHom K S 1 a) • + (F ij.1 * G ij.2 ^ Fintype.card K) := by + exact Finsupp.sum_mapRange_index (fun ij => + zero_smul S (F ij.1 * G ij.2 ^ Fintype.card K)) + rw [hmap] + change ρ (c.sum fun ij a => + (powCardAlgHom K S 1 a) • + (F ij.1 * G ij.2 ^ Fintype.card K)) = + φ (ρ (c.sum fun ij a => + a • (F ij.1 ^ Fintype.card K * G ij.2))) + simp only [map_finsuppSum, map_smul, map_mul, map_pow] + apply Finsupp.sum_congr + intro ij hij + dsimp only [φ] + simp only [Algebra.smul_def, map_mul, map_pow, + powCardAlgHom_apply, Nat.pow_one] + rw [← pow_mul] + rw [show (ρ (F ij.1)) ^ (Fintype.card K * Fintype.card K) = + ρ (F ij.1) by + simpa only [pow_two] using hsquare (ρ (F ij.1))] + +end LocalResidue + +section LocalOrder + +variable (K S R L : Type*) [Field K] [Fintype K] + [Field S] [Algebra K S] + [CommRing R] [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Algebra S R] [Algebra K R] + [Field L] [Algebra R L] [IsFractionRing R L] + +/-- Local DVR form of the semilinear square-field vanishing step. -/ +theorem squareFieldStepanovLocal_first_eq_zero_or_order_pos + {α β : Type*} (F : α → R) (G : β → R) (c : α × β →₀ S) + (hsquare : ∀ z : IsLocalRing.ResidueField R, + z ^ (Fintype.card K) ^ 2 = z) + (hsecond : + Finsupp.linearCombination S + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c = 0) : + algebraMap R L + (Finsupp.linearCombination S + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) + (squareRootFrobeniusCoefficients K S c)) = 0 ∨ + 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L + (Finsupp.linearCombination S + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) + (squareRootFrobeniusCoefficients K S c))) := by + let a : R := Finsupp.linearCombination S + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) + (squareRootFrobeniusCoefficients K S c) + have hresidue : stepanovLocalResidueAlgHom S R a = 0 := by + have h := squareFieldStepanovLocalResidue_first_eq_frobenius_second + K S R F G c hsquare + change stepanovLocalResidueAlgHom S R a = _ at h + rw [hsecond, map_zero, map_zero] at h + exact h + have haMem : a ∈ IsLocalRing.maximalIdeal R := by + apply (IsLocalRing.residue_eq_zero_iff a).mp + exact hresidue + by_cases haMap : algebraMap R L a = 0 + · exact Or.inl haMap + · refine Or.inr ?_ + have ha : a ≠ 0 := by + intro ha0 + apply haMap + rw [ha0, map_zero] + have horder := one_le_finitePlaceOrder_algebraMap_of_mem + (L := L) (IsDiscreteValuationRing.maximalIdeal R) a haMem ha + change 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) (algebraMap R L a) + omega + +end LocalOrder + +section FiniteExtensionPlace + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +/-- Finite-place form of semilinear square-field vanishing. The function +field and its places are over the full constant field `S`; `K` supplies the +half-Frobenius exponent. -/ +theorem squareFieldStepanovFirstRestriction_eq_zero_or_principalDivisor_pos_at_finitePlace + {α β : Type*} + (q : FiniteExtensionFinitePlace S L) + (f : α → L) (g : β → L) (c : α × β →₀ S) + (hfRegular : ∀ i, + 0 ≤ finiteExtensionPrincipalDivisor S L (f i) (.inl q)) + (hgRegular : ∀ j, + 0 ≤ finiteExtensionPrincipalDivisor S L (g j) (.inl q)) + (hsquare : ∀ z : q.asIdeal.ResidueField, + z ^ (Fintype.card K) ^ 2 = z) + (hsecond : onePointStepanovSecondRestrictionMap S L f g + (Fintype.card K) c = 0) : + squareFieldStepanovFirstRestriction K S L f g c = 0 ∨ + 0 < finiteExtensionPrincipalDivisor S L + (squareFieldStepanovFirstRestriction K S L f g c) (.inl q) := by + let A := RatFuncFiniteIntegralClosure S L + let R := FiniteExtensionFinitePlaceLocalRing S L q + letI : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + letI : IsScalarTower S (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S[X] (RatFunc S))) + letI : IsScalarTower S[X] (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra S (RatFuncFiniteIntegralClosure S L) := + RingHom.toAlgebra + ((algebraMap S[X] (RatFuncFiniteIntegralClosure S L)).comp + (algebraMap S S[X])) + letI : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S L) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra.IsIntegral S[X] (RatFuncFiniteIntegralClosure S L) := + IsIntegralClosure.isIntegral_algebra S[X] L + letI : Module.Finite S[X] (RatFuncFiniteIntegralClosure S L) := + Module.IsNoetherian.finite S[X] (RatFuncFiniteIntegralClosure S L) + letI : Module.IsTorsionFree S[X] L := + Module.IsTorsionFree.trans_faithfulSMul S[X] (RatFunc S) L + letI : Module.IsTorsionFree S[X] + (RatFuncFiniteIntegralClosure S L) := + IsIntegralClosure.isTorsionFree S[X] L + letI : IsDedekindDomain (RatFuncFiniteIntegralClosure S L) := + IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) L + (RatFuncFiniteIntegralClosure S L) + letI : IsFractionRing (RatFuncFiniteIntegralClosure S L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + S[X] (RatFunc S) L (RatFuncFiniteIntegralClosure S L) + letI : Algebra (RatFuncFiniteIntegralClosure S L) + (RatFuncFiniteIntegralClosure S L) := + Algebra.id (RatFuncFiniteIntegralClosure S L) + let localAlgebra : Algebra (RatFuncFiniteIntegralClosure S L) + (FiniteExtensionFinitePlaceLocalRing S L q) := + OreLocalization.instAlgebra + letI := localAlgebra + letI : SMul (RatFuncFiniteIntegralClosure S L) + (FiniteExtensionFinitePlaceLocalRing S L q) := + localAlgebra.toSMul + letI : Algebra S (FiniteExtensionFinitePlaceLocalRing S L q) := + OreLocalization.instAlgebra + letI := finiteExtensionFinitePlaceLocalAlgebra (K := S) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := S) (L := L) q + letI : IsScalarTower S R L := by + apply IsScalarTower.of_algebraMap_eq' + ext x + symm + change finiteExtensionFinitePlaceLocalizationToField + (K := S) (L := L) q (algebraMap S R x) = algebraMap S L x + rw [show algebraMap S R x = + algebraMap A R (algebraMap S A x) by rfl] + rw [show finiteExtensionFinitePlaceLocalizationToField + (K := S) (L := L) q (algebraMap A R (algebraMap S A x)) = + algebraMap A L (algebraMap S A x) by + exact DFunLike.congr_fun + (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := S) (L := L) q) (algebraMap S A x)] + rfl + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A q.ne_bot R + letI : Algebra K R := RingHom.toAlgebra + ((algebraMap S R).comp (algebraMap K S)) + let eResidue : + (RatFuncFiniteIntegralClosure S L ⧸ q.asIdeal) ≃+* + IsLocalRing.ResidueField R := + IsLocalization.AtPrime.equivQuotMaximalIdeal q.asIdeal R + let eQuotientResidue : + (RatFuncFiniteIntegralClosure S L ⧸ q.asIdeal) ≃+* + q.asIdeal.ResidueField := + RingEquiv.ofBijective + (algebraMap + (RatFuncFiniteIntegralClosure S L ⧸ q.asIdeal) + q.asIdeal.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField q.asIdeal) + have hsquareQuotient : + ∀ z : RatFuncFiniteIntegralClosure S L ⧸ q.asIdeal, + z ^ (Fintype.card K) ^ 2 = z := by + intro z + apply eQuotientResidue.injective + simpa only [map_pow] using hsquare (eQuotientResidue z) + have hsquareLocal : ∀ z : IsLocalRing.ResidueField R, + z ^ (Fintype.card K) ^ 2 = z := by + intro z + have h := congrArg eResidue (hsquareQuotient (eResidue.symm z)) + simpa only [map_pow, RingEquiv.apply_symm_apply] using h + have hfTop (i : α) : + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := S) (L := L) q (f i) := by + by_cases hfi : f i = 0 + · simp [hfi, finiteExtensionFinitePlaceLocalOrderTop] + · rw [finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + S L q (f i) hfi] + exact_mod_cast hfRegular i + have hgTop (j : β) : + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := S) (L := L) q (g j) := by + by_cases hgj : g j = 0 + · simp [hgj, finiteExtensionFinitePlaceLocalOrderTop] + · rw [finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + S L q (g j) hgj] + exact_mod_cast hgRegular j + let F : α → R := fun i => Classical.choose + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := S) (L := L) q (f i) (hfTop i)) + let G : β → R := fun j => Classical.choose + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := S) (L := L) q (g j) (hgTop j)) + have hF (i : α) : f i = algebraMap R L (F i) := by + exact Classical.choose_spec + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := S) (L := L) q (f i) (hfTop i)) + have hG (j : β) : g j = algebraMap R L (G j) := by + exact Classical.choose_spec + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := S) (L := L) q (g j) (hgTop j)) + let firstLocal : R := Finsupp.linearCombination S + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) + (squareRootFrobeniusCoefficients K S c) + let secondLocal : R := Finsupp.linearCombination S + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c + let ι : R →ₗ[S] L := (IsScalarTower.toAlgHom S R L).toLinearMap + have hfirstMap : + squareFieldStepanovFirstRestriction K S L f g c = + algebraMap R L firstLocal := by + symm + calc + algebraMap R L firstLocal = ι firstLocal := rfl + _ = Finsupp.linearCombination S + (fun ij : α × β => + ι (F ij.1 * (G ij.2) ^ Fintype.card K)) + (squareRootFrobeniusCoefficients K S c) := by + exact Finsupp.apply_linearCombination S ι _ _ + _ = Finsupp.linearCombination S + (fun ij : α × β => + f ij.1 * (g ij.2) ^ Fintype.card K) + (squareRootFrobeniusCoefficients K S c) := by + apply congrArg (fun v => Finsupp.linearCombination S v + (squareRootFrobeniusCoefficients K S c)) + funext ij + change algebraMap R L + (F ij.1 * (G ij.2) ^ Fintype.card K) = _ + rw [map_mul, map_pow, ← hF ij.1, ← hG ij.2] + _ = squareFieldStepanovFirstRestriction K S L f g c := rfl + have hsecondMap : + onePointStepanovSecondRestrictionMap S L f g + (Fintype.card K) c = algebraMap R L secondLocal := by + symm + calc + algebraMap R L secondLocal = ι secondLocal := rfl + _ = Finsupp.linearCombination S + (fun ij : α × β => + ι ((F ij.1) ^ Fintype.card K * G ij.2)) c := by + exact Finsupp.apply_linearCombination S ι _ c + _ = Finsupp.linearCombination S + (fun ij : α × β => + (f ij.1) ^ Fintype.card K * g ij.2) c := by + apply congrArg (fun v => Finsupp.linearCombination S v c) + funext ij + change algebraMap R L + ((F ij.1) ^ Fintype.card K * G ij.2) = _ + rw [map_mul, map_pow, ← hF ij.1, ← hG ij.2] + _ = onePointStepanovSecondRestrictionMap S L f g + (Fintype.card K) c := rfl + have hsecondLocal : secondLocal = 0 := by + apply IsFractionRing.injective R L + rw [map_zero, ← hsecondMap] + exact hsecond + have hlocal := squareFieldStepanovLocal_first_eq_zero_or_order_pos + K S R L F G c hsquareLocal hsecondLocal + rcases hlocal with hzero | hpositive + · exact Or.inl (by rw [hfirstMap]; exact hzero) + · refine Or.inr ?_ + rw [hfirstMap, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder, + ← finiteExtensionFinitePlaceLocalOrder_eq_globalOrder q] + change 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) (algebraMap R L firstLocal) + exact hpositive + +end FiniteExtensionPlace + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean new file mode 100644 index 0000000000..0cf5b9bf90 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean @@ -0,0 +1,113 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +import Mathlib.Tactic + +/-! +# The square-field Stepanov zero count + +This module turns a semilinear square-field Stepanov auxiliary into the +sharp zero-count estimate. The selected points are represented by an +injective finite family of finite exhaustive places, all away from a +degree-one pole place `P`. + +Membership of the two section families in their one-point Riemann spaces +makes every section regular at each selected place. The square-field local +vanishing theorem then gives positive order of the nonzero first restriction +at every selected place. Its pole budget is `ell + (#K) * m`, so the +degree-one one-point height bound controls the cardinality of the family by +that same number. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial + +noncomputable section + +variable (K S : Type*) [Field K] [Fintype K] + [Field S] [Fintype S] [DecidableEq S] [Algebra K S] + [DecidableEq (RatFunc S)] +variable (L : Type*) [Field L] [Algebra (RatFunc S) L] + [FiniteDimensional (RatFunc S) L] + [Algebra.IsSeparable (RatFunc S) L] + +local instance squareFieldZeroCountConstantAlgebra : Algebra S L := + RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp + (algebraMap S (RatFunc S))) + +local instance squareFieldZeroCountConstantTower : + IsScalarTower S (RatFunc S) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- A square-field Stepanov auxiliary bounds any injective finite family of +finite places away from its degree-one pole place. + +The quadratic Frobenius identity is required only in the residue field of +each selected place. Thus the theorem records exactly the local geometric +input used by the semilinear vanishing step, without imposing a global +residue-degree assertion. -/ +theorem Fintype.card_le_of_squareFieldStepanovAuxiliary + {alpha beta iota : Type*} [Fintype iota] + (P : FiniteExtensionPlace S L) (ell m : Nat) + (f : alpha → L) (df : alpha → Nat) + (g : beta → L) (dg : beta → Nat) + (c : alpha × beta →₀ S) + (hf : onePointSectionFamilySpec S L P ell f df) + (hg : onePointSectionFamilySpec S L P m g dg) + (hdegree : finiteExtensionPlaceDegree S L P = 1) + (place : iota → FiniteExtensionFinitePlace S L) + (hinjective : Function.Injective place) + (haway : ∀ i, + (Sum.inl (place i) : FiniteExtensionPlace S L) ≠ P) + (hsquare : ∀ (i : iota) (z : (place i).asIdeal.ResidueField), + z ^ (Fintype.card K) ^ 2 = z) + (hsecond : onePointStepanovSecondRestrictionMap S L f g + (Fintype.card K) c = 0) + (hfirst : squareFieldStepanovFirstRestriction K S L f g c ≠ 0) : + Fintype.card iota ≤ ell + Fintype.card K * m := by + have hfRegular (i : iota) (a : alpha) : + 0 ≤ finiteExtensionPrincipalDivisor S L (f a) (.inl (place i)) := by + rcases (mem_finiteExtensionOnePointRiemannSpace_iff + S L P ell (f a)).mp (hf.1 a) with hzero | hdescription + · exact (hf.2.1 a hzero).elim + · exact hdescription.2.2 (.inl (place i)) (haway i) + have hgRegular (i : iota) (b : beta) : + 0 ≤ finiteExtensionPrincipalDivisor S L (g b) (.inl (place i)) := by + rcases (mem_finiteExtensionOnePointRiemannSpace_iff + S L P m (g b)).mp (hg.1 b) with hzero | hdescription + · exact (hg.2.1 b hzero).elim + · exact hdescription.2.2 (.inl (place i)) (haway i) + have hpositive (i : iota) : + 0 < finiteExtensionPrincipalDivisor S L + (squareFieldStepanovFirstRestriction K S L f g c) + (.inl (place i)) := by + exact (squareFieldStepanovFirstRestriction_eq_zero_or_principalDivisor_pos_at_finitePlace + K S L (place i) f g c (hfRegular i) (hgRegular i) + (hsquare i) hsecond).resolve_left hfirst + have hplaceInjective : Function.Injective + (fun i => (Sum.inl (place i) : FiniteExtensionPlace S L)) := by + intro i j hij + apply hinjective + exact Sum.inl.inj hij + have hspace : squareFieldStepanovFirstRestriction K S L f g c ∈ + finiteExtensionOnePointRiemannSpace S L P + (ell + Fintype.card K * m) := + squareFieldStepanovFirstRestriction_mem K S L P f g ell m + hf.1 hg.1 c + exact Fintype.card_le_of_onePointRiemannSpace_degree_one + S L P (ell + Fintype.card K * m) + (squareFieldStepanovFirstRestriction K S L f g c) + hfirst hspace hdegree + (fun i => (Sum.inl (place i) : FiniteExtensionPlace S L)) + hplaceInjective hpositive + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean new file mode 100644 index 0000000000..4aa05e0a3d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +import Mathlib.LinearAlgebra.Dimension.Finite +import Mathlib.LinearAlgebra.Dimension.Constructions + +/-! +# Linear-algebra core of the Bombieri--Stepanov argument + +This file isolates the rank-nullity step from the geometry. A finite +controlled-degree space `V` has two restriction maps. If the second map has +target dimension smaller than `V`, while the first map is injective, there is +an auxiliary vector which vanishes under the second restriction but remains +nonzero under the first. Once the first restriction is known to lie in a +one-point Riemann space and to vanish at every rational intersection point, +the exhaustive divisor zero count bounds the number of those points. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped nonZeroDivisors Polynomial TensorProduct + +noncomputable section + +variable {k V W₁ W₂ : Type*} [Field k] + [AddCommGroup V] [Module k V] + [AddCommGroup W₁] [Module k W₁] + [AddCommGroup W₂] [Module k W₂] + +/-- Rank-nullity produces an auxiliary vector killed by `second` but not by +the injective map `first`. -/ +theorem exists_auxiliary_of_finrank_lt + [FiniteDimensional k V] [FiniteDimensional k W₂] + (first : V →ₗ[k] W₁) (second : V →ₗ[k] W₂) + (hfirst : Function.Injective first) + (hdim : Module.finrank k W₂ < Module.finrank k V) : + ∃ v : V, v ≠ 0 ∧ second v = 0 ∧ first v ≠ 0 := by + have hnotInjective : ¬ Function.Injective second := by + intro hinjective + have := LinearMap.finrank_le_finrank_of_injective hinjective + omega + rw [Function.not_injective_iff] at hnotInjective + obtain ⟨x, y, heq, hxy⟩ := hnotInjective + refine ⟨x - y, sub_ne_zero.mpr hxy, ?_, ?_⟩ + · simpa using sub_eq_zero.mpr heq + · exact (map_ne_zero_iff first hfirst).mpr (sub_ne_zero.mpr hxy) + +/-- Riemann-space lower bounds and a target upper bound imply the strict +dimension inequality needed by rank-nullity on a tensor product. -/ +theorem tensor_finrank_gt_of_bounds + {A B W : Type*} + [AddCommGroup A] [Module k A] [FiniteDimensional k A] + [AddCommGroup B] [Module k B] [FiniteDimensional k B] + [AddCommGroup W] [Module k W] [FiniteDimensional k W] + {a b targetBound : ℕ} + (hA : a ≤ Module.finrank k A) + (hB : b ≤ Module.finrank k B) + (hW : Module.finrank k W ≤ targetBound) + (hnumeric : targetBound < a * b) : + Module.finrank k W < Module.finrank k (A ⊗[k] B) := by + rw [Module.finrank_tensorProduct] + exact hW.trans_lt (hnumeric.trans_le (Nat.mul_le_mul hA hB)) + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance stepanovLinearAlgebraConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance stepanovLinearAlgebraConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- Abstract Stepanov zero-count theorem. + +The hypotheses after rank-nullity are exactly the geometric obligations left +to an application: the first restriction has controlled poles, the selected +places are distinct, and vanishing of the second restriction forces positive +order of the first restriction at each selected place. -/ +theorem card_le_mul_placeDegree_of_stepanov_restrictions + {V W : Type*} [AddCommGroup V] [Module K V] + [AddCommGroup W] [Module K W] + [FiniteDimensional K V] [FiniteDimensional K W] + {ι : Type*} [Fintype ι] + (P : FiniteExtensionPlace K L) (n : ℕ) + (first : V →ₗ[K] L) (second : V →ₗ[K] W) + (hfirst : Function.Injective first) + (hdim : Module.finrank K W < Module.finrank K V) + (hspace : ∀ v, first v ∈ + finiteExtensionOnePointRiemannSpace K L P n) + (place : ι → FiniteExtensionPlace K L) + (hplace : Function.Injective place) + (hvanish : ∀ v, v ≠ 0 → second v = 0 → ∀ i, + 0 < finiteExtensionPrincipalDivisor K L (first v) (place i)) : + Fintype.card ι ≤ n * finiteExtensionPlaceDegree K L P := by + obtain ⟨v, hv, hsecond, hfirstv⟩ := + exists_auxiliary_of_finrank_lt first second hfirst hdim + exact Fintype.card_le_mul_placeDegree_of_onePointRiemannSpace + K L P n (first v) hfirstv (hspace v) place hplace + (hvanish v hv hsecond) + +/-- Degree-one version of the abstract Stepanov zero-count theorem. -/ +theorem card_le_of_stepanov_restrictions_degree_one + {V W : Type*} [AddCommGroup V] [Module K V] + [AddCommGroup W] [Module K W] + [FiniteDimensional K V] [FiniteDimensional K W] + {ι : Type*} [Fintype ι] + (P : FiniteExtensionPlace K L) (n : ℕ) + (first : V →ₗ[K] L) (second : V →ₗ[K] W) + (hfirst : Function.Injective first) + (hdim : Module.finrank K W < Module.finrank K V) + (hspace : ∀ v, first v ∈ + finiteExtensionOnePointRiemannSpace K L P n) + (hdegree : finiteExtensionPlaceDegree K L P = 1) + (place : ι → FiniteExtensionPlace K L) + (hplace : Function.Injective place) + (hvanish : ∀ v, v ≠ 0 → second v = 0 → ∀ i, + 0 < finiteExtensionPrincipalDivisor K L (first v) (place i)) : + Fintype.card ι ≤ n := by + simpa [hdegree] using + card_le_mul_placeDegree_of_stepanov_restrictions + K L P n first second hfirst hdim hspace place hplace hvanish + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean new file mode 100644 index 0000000000..8a9cb9ad33 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib + +/-! +# Numerical parameters for the Bombieri--Stepanov argument + +The sharp parameter choice in Tao's exposition uses a floor. The BGS +application only needs a universal bidegree multiple of the square-root +error, so it is cleaner to use + +`ell = s - 1`, `m = s + 2 * g` + +when the square-root field size `s` is at least `(g + 1) * (g + 2)`. +These parameters satisfy the three inequalities needed by the one-point +Riemann-space argument, and give the same `O(g * s)` error term. +-/ + +namespace BGS.HasseWeil + +/-- The slightly non-sharp parameters used in the formal Stepanov argument. -/ +def stepanovEll (s : ℕ) : ℕ := s - 1 + +/-- The second tensor-factor parameter used in the formal Stepanov argument. -/ +def stepanovM (g s : ℕ) : ℕ := s + 2 * g + +/-- The first parameter is strictly smaller than the Frobenius scale. -/ +theorem stepanovEll_lt + {g s : ℕ} (hlarge : (g + 1) * (g + 2) ≤ s) : + stepanovEll s < s := by + have hs : 0 < s := by nlinarith + simp only [stepanovEll] + omega + +/-- Both tensor factors are large enough for Riemann's inequality. -/ +theorem stepanov_genus_le_parameters + {g s : ℕ} (hlarge : (g + 1) * (g + 2) ≤ s) : + g ≤ stepanovEll s + 1 ∧ g ≤ stepanovM g s + 1 := by + have hgs : g ≤ s := by nlinarith + constructor + · simp only [stepanovEll] + omega + · simp only [stepanovM] + omega + +/-- The tensor-product dimension lower bound is strictly larger than the +dimension upper bound for the second Frobenius restriction map. -/ +theorem stepanov_dimension_inequality + {g s : ℕ} (hlarge : (g + 1) * (g + 2) ≤ s) : + (stepanovEll s + 1 - g) * (stepanovM g s + 1 - g) > + stepanovEll s * s + stepanovM g s + 1 := by + have hs : 0 < s := by nlinarith + have hgs : g ≤ s := by nlinarith + have hfirst : stepanovEll s + 1 - g = s - g := by + simp only [stepanovEll] + omega + have hsecond : stepanovM g s + 1 - g = s + g + 1 := by + simp only [stepanovM] + omega + rw [hfirst, hsecond] + simp only [stepanovEll, stepanovM] + have hsOne : 1 ≤ s := by omega + have hlargeZ : + (((g + 1) * (g + 2) : ℕ) : ℤ) ≤ (s : ℤ) := by + exact_mod_cast hlarge + have hgoalZ : + (((s - g : ℕ) : ℤ) * ((s + g + 1 : ℕ) : ℤ)) > + (((s - 1 : ℕ) : ℤ) * (s : ℤ) + ((s + 2 * g : ℕ) : ℤ) + 1) := by + rw [Nat.cast_sub hgs, Nat.cast_sub hsOne] + push_cast at hlargeZ ⊢ + nlinarith + exact_mod_cast hgoalZ + +/-- The resulting zero-count bound is at most +`s^2 + (2g+1)s`; this is the weak Hasse--Weil upper bound needed later. -/ +theorem stepanov_zero_bound + {g s : ℕ} (hs : 0 < s) : + stepanovEll s + stepanovM g s * s ≤ + s ^ 2 + (2 * g + 1) * s := by + simp only [stepanovEll, stepanovM] + nlinarith [Nat.sub_add_cancel (Nat.one_le_iff_ne_zero.mpr hs.ne')] + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean new file mode 100644 index 0000000000..222e11abef --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean @@ -0,0 +1,316 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra +import Mathlib.LinearAlgebra.Dimension.Constructions +import Mathlib.Tactic + +/-! +# Stepanov restriction maps on a finite coefficient grid + +For finite families `f : α → L` and `g : β → L`, the coefficient space is +the free `K`-module `(α × β →₀ K)`. Its two restriction maps evaluate the +same coefficient grid against + +* `f i * (g j) ^ s`, and +* `(f i) ^ s * g j`. + +The maps are defined with `Finsupp.linearCombination`. One-point pole bounds +give codomain restrictions with budgets `ell + s * m` and `s * ell + m`. +The final results expose exactly the injectivity and finrank interfaces used +by `exists_auxiliary_of_finrank_lt`. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open scoped Polynomial BigOperators + +noncomputable section + + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +local instance stepanovRestrictionConstantAlgebra : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + +local instance stepanovRestrictionConstantTower : + IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + +/-- The first Stepanov restriction: evaluate the coefficient grid against +`f i * (g j) ^ s`. -/ +def onePointStepanovFirstRestrictionMap + {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) : + (α × β →₀ K) →ₗ[K] L := + Finsupp.linearCombination K + (fun ij : α × β => f ij.1 * (g ij.2) ^ s) + +/-- The second Stepanov restriction: evaluate the coefficient grid against +`(f i) ^ s * g j`. -/ +def onePointStepanovSecondRestrictionMap + {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) : + (α × β →₀ K) →ₗ[K] L := + Finsupp.linearCombination K + (fun ij : α × β => (f ij.1) ^ s * g ij.2) + +@[simp] +theorem onePointStepanovFirstRestrictionMap_single + {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) + (ij : α × β) (c : K) : + onePointStepanovFirstRestrictionMap K L f g s + (Finsupp.single ij c) = + c • (f ij.1 * (g ij.2) ^ s) := by + simp [onePointStepanovFirstRestrictionMap] + +@[simp] +theorem onePointStepanovSecondRestrictionMap_single + {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) + (ij : α × β) (c : K) : + onePointStepanovSecondRestrictionMap K L f g s + (Finsupp.single ij c) = + c • ((f ij.1) ^ s * g ij.2) := by + simp [onePointStepanovSecondRestrictionMap] + +/-- Powers multiply a one-point pole budget. -/ +theorem finiteExtensionOnePointRiemannSpace_pow_mem + (P : FiniteExtensionPlace K L) {m : ℕ} {x : L} + (hx : x ∈ finiteExtensionOnePointRiemannSpace K L P m) + (s : ℕ) : + x ^ s ∈ finiteExtensionOnePointRiemannSpace K L P (s * m) := by + classical + change x ^ s ∈ finiteExtensionRiemannSpace K L + (Finsupp.single P ((s * m : ℕ) : ℤ)) + have hpow := finiteExtensionRiemannSpace_pow_mem K L hx s + have hdivisor : + s • Finsupp.single P (m : ℤ) = + Finsupp.single P ((s * m : ℕ) : ℤ) := by + ext v + by_cases hv : v = P + · subst v + simp + · simp [Finsupp.single_eq_of_ne hv] + rw [← hdivisor] + exact hpow + +/-- Every basis value of the first restriction has pole budget +`ell + s * m`. -/ +theorem onePointStepanovFirstGrid_mem + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (ij : α × β) : + f ij.1 * (g ij.2) ^ s ∈ + finiteExtensionOnePointRiemannSpace K L P (ell + s * m) := by + exact finiteExtensionOnePointRiemannSpace_mul_mem K L P + (hf ij.1) + (finiteExtensionOnePointRiemannSpace_pow_mem K L P (hg ij.2) s) + +/-- Every basis value of the second restriction has pole budget +`s * ell + m`. -/ +theorem onePointStepanovSecondGrid_mem + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (ij : α × β) : + (f ij.1) ^ s * g ij.2 ∈ + finiteExtensionOnePointRiemannSpace K L P (s * ell + m) := by + exact finiteExtensionOnePointRiemannSpace_mul_mem K L P + (finiteExtensionOnePointRiemannSpace_pow_mem K L P (hf ij.1) s) + (hg ij.2) + +/-- The whole first linear combination has pole budget `ell + s * m`. -/ +theorem onePointStepanovFirstRestrictionMap_mem + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (c : α × β →₀ K) : + onePointStepanovFirstRestrictionMap K L f g s c ∈ + finiteExtensionOnePointRiemannSpace K L P (ell + s * m) := by + rw [onePointStepanovFirstRestrictionMap, + Finsupp.linearCombination_apply, Finsupp.sum] + apply Submodule.sum_mem + intro ij hij + exact (finiteExtensionOnePointRiemannSpace K L P (ell + s * m)).smul_mem + (c ij) (onePointStepanovFirstGrid_mem K L P f g ell m s hf hg ij) + +/-- The whole second linear combination has pole budget `s * ell + m`. -/ +theorem onePointStepanovSecondRestrictionMap_mem + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (c : α × β →₀ K) : + onePointStepanovSecondRestrictionMap K L f g s c ∈ + finiteExtensionOnePointRiemannSpace K L P (s * ell + m) := by + rw [onePointStepanovSecondRestrictionMap, + Finsupp.linearCombination_apply, Finsupp.sum] + apply Submodule.sum_mem + intro ij hij + exact (finiteExtensionOnePointRiemannSpace K L P (s * ell + m)).smul_mem + (c ij) (onePointStepanovSecondGrid_mem K L P f g ell m s hf hg ij) + +/-- The first restriction with its one-point codomain made explicit. -/ +def onePointStepanovFirstCodRestrictionMap + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) : + (α × β →₀ K) →ₗ[K] + finiteExtensionOnePointRiemannSpace K L P (ell + s * m) := + LinearMap.codRestrict _ + (onePointStepanovFirstRestrictionMap K L f g s) + (onePointStepanovFirstRestrictionMap_mem K L P f g ell m s hf hg) + +/-- The second restriction with its one-point codomain made explicit. -/ +def onePointStepanovSecondCodRestrictionMap + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) : + (α × β →₀ K) →ₗ[K] + finiteExtensionOnePointRiemannSpace K L P (s * ell + m) := + LinearMap.codRestrict _ + (onePointStepanovSecondRestrictionMap K L f g s) + (onePointStepanovSecondRestrictionMap_mem K L P f g ell m s hf hg) + +@[simp] +theorem onePointStepanovFirstCodRestrictionMap_coe + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (c : α × β →₀ K) : + ((onePointStepanovFirstCodRestrictionMap K L P f g ell m s hf hg c : + finiteExtensionOnePointRiemannSpace K L P (ell + s * m)) : L) = + onePointStepanovFirstRestrictionMap K L f g s c := by + rfl + +@[simp] +theorem onePointStepanovSecondCodRestrictionMap_coe + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (c : α × β →₀ K) : + ((onePointStepanovSecondCodRestrictionMap K L P f g ell m s hf hg c : + finiteExtensionOnePointRiemannSpace K L P (s * ell + m)) : L) = + onePointStepanovSecondRestrictionMap K L f g s c := by + rfl + +/-- Linear independence of the first product grid is exactly injectivity of +the first restriction map. -/ +theorem onePointStepanovFirstRestrictionMap_injective_of_linearIndependent + {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) + (hLI : LinearIndependent K + (fun ij : α × β => f ij.1 * (g ij.2) ^ s)) : + Function.Injective (onePointStepanovFirstRestrictionMap K L f g s) := by + intro c d hcd + apply sub_eq_zero.mp + apply (linearIndependent_iff.mp hLI) + change onePointStepanovFirstRestrictionMap K L f g s (c - d) = 0 + rw [map_sub, hcd, sub_self] + +/-- The mixed-order Stepanov-grid criterion proves injectivity of the first +restriction. -/ +theorem onePointStepanovFirstRestrictionMap_injective_of_grid + {α β : Type*} [Fintype α] [Fintype β] + (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (d : α → ℕ) (e : β → ℕ) (s : ℕ) + (hf : ∀ i, f i ≠ 0) (hg : ∀ j, g j ≠ 0) + (hfOrder : ∀ i, finiteExtensionPrincipalDivisor K L (f i) P = + -(d i : ℤ)) + (hgOrder : ∀ j, finiteExtensionPrincipalDivisor K L (g j) P = + -(e j : ℤ)) + (hd : Function.Injective d) (he : Function.Injective e) + (hdigit : ∀ i, d i < s) : + Function.Injective (onePointStepanovFirstRestrictionMap K L f g s) := by + apply onePointStepanovFirstRestrictionMap_injective_of_linearIndependent + exact onePointStepanovGrid_linearIndependent K L P f g d e s + hf hg hfOrder hgOrder hd he hdigit + +/-- The first codomain restriction remains injective. -/ +theorem onePointStepanovFirstCodRestrictionMap_injective_of_linearIndependent + {α β : Type*} (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (hLI : LinearIndependent K + (fun ij : α × β => f ij.1 * (g ij.2) ^ s)) : + Function.Injective + (onePointStepanovFirstCodRestrictionMap K L P f g ell m s hf hg) := by + intro c d hcd + apply onePointStepanovFirstRestrictionMap_injective_of_linearIndependent + K L f g s hLI + exact congrArg Subtype.val hcd + +/-- The coefficient space has dimension equal to the cardinality of its +finite product index. -/ +@[simp] +theorem onePointStepanovCoefficientSpace_finrank + {α β : Type*} [Fintype α] [Fintype β] : + Module.finrank K (α × β →₀ K) = + Fintype.card α * Fintype.card β := by + rw [Module.finrank_finsupp_self, Fintype.card_prod] + +/-- A target finrank upper bound and a numerical strict inequality give the +dimension inequality required by rank-nullity. -/ +theorem onePointStepanovTarget_finrank_lt_coefficientSpace + {α β : Type*} [Fintype α] [Fintype β] + (P : FiniteExtensionPlace K L) (n targetBound : ℕ) + (hupper : Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P n) ≤ targetBound) + (hnumeric : targetBound < Fintype.card α * Fintype.card β) : + Module.finrank K (finiteExtensionOnePointRiemannSpace K L P n) < + Module.finrank K (α × β →₀ K) := by + rw [onePointStepanovCoefficientSpace_finrank K] + exact hupper.trans_lt hnumeric + +/-- Concrete rank-nullity interface for the two Stepanov restrictions. + +An upper bound for the second one-point target, strictly below the product +index cardinality, produces a nonzero coefficient grid killed by the second +restriction and detected by the first. -/ +theorem exists_onePointStepanovAuxiliary_of_target_finrank_upper + {α β : Type*} [Fintype α] [Fintype β] + (P : FiniteExtensionPlace K L) + (f : α → L) (g : β → L) (ell m s targetBound : ℕ) + (hf : ∀ i, f i ∈ finiteExtensionOnePointRiemannSpace K L P ell) + (hg : ∀ j, g j ∈ finiteExtensionOnePointRiemannSpace K L P m) + (hLI : LinearIndependent K + (fun ij : α × β => f ij.1 * (g ij.2) ^ s)) + (hupper : Module.finrank K + (finiteExtensionOnePointRiemannSpace K L P (s * ell + m)) ≤ + targetBound) + (hnumeric : targetBound < Fintype.card α * Fintype.card β) : + ∃ c : α × β →₀ K, + c ≠ 0 ∧ + onePointStepanovSecondCodRestrictionMap K L P f g ell m s hf hg c = 0 ∧ + onePointStepanovFirstRestrictionMap K L f g s c ≠ 0 := by + letI : Module.Finite K + (finiteExtensionOnePointRiemannSpace K L P (s * ell + m)) := + finiteExtensionOnePointRiemannSpace_moduleFinite K L P _ + apply exists_auxiliary_of_finrank_lt + (onePointStepanovFirstRestrictionMap K L f g s) + (onePointStepanovSecondCodRestrictionMap K L P f g ell m s hf hg) + · exact onePointStepanovFirstRestrictionMap_injective_of_linearIndependent + K L f g s hLI + · exact onePointStepanovTarget_finrank_lt_coefficientSpace + K L P (s * ell + m) targetBound hupper hnumeric + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean new file mode 100644 index 0000000000..4d42cf4635 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean @@ -0,0 +1,383 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +import Mathlib.Tactic + +/-! +# The quadratic Frobenius vanishing step + +Let `q = #K`. The two Stepanov restrictions use the grids + +* `f i * (g j) ^ q`, and +* `(f i) ^ q * g j`. + +At a place whose residue field satisfies `z ^ (q ^ 2) = z`, the residue of +the first grid is the `q`-Frobenius of the residue of the second grid. +Consequently, if the second restriction vanishes and all grid entries are +regular at the place, the first restriction either vanishes or has positive +order there. + +The square-Frobenius identity is an explicit hypothesis. In particular, +this file does not assert that every normalization place above a quadratic +extension point has residue degree at most two. +-/ + +namespace BGS.HasseWeil + +open BGS.CorvajaZannier +open IsDedekindDomain +open scoped Polynomial nonZeroDivisors + +noncomputable section + + +section LocalResidue + +variable (K R : Type*) [Field K] [Fintype K] + [CommRing R] [IsLocalRing R] [Algebra K R] + +/-- The residue map of a local `K`-algebra, bundled as a `K`-algebra map. -/ +def stepanovLocalResidueAlgHom : + R →ₐ[K] IsLocalRing.ResidueField R := + Ideal.Quotient.mkₐ K (IsLocalRing.maximalIdeal R) + +omit [Fintype K] in +@[simp] +theorem stepanovLocalResidueAlgHom_apply (r : R) : + stepanovLocalResidueAlgHom K R r = + algebraMap R (IsLocalRing.ResidueField R) r := by + rfl + +/-- The first Stepanov residue is the `q`-Frobenius of the second residue +when every residue satisfies the quadratic Frobenius identity. -/ +theorem stepanovLocalResidue_first_eq_frobenius_second + {α β : Type*} (F : α → R) (G : β → R) (c : α × β →₀ K) + (hsquare : ∀ z : IsLocalRing.ResidueField R, + z ^ (Fintype.card K) ^ 2 = z) : + stepanovLocalResidueAlgHom K R + (Finsupp.linearCombination K + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) c) = + powCardAlgHom K (IsLocalRing.ResidueField R) 1 + (stepanovLocalResidueAlgHom K R + (Finsupp.linearCombination K + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c)) := by + let ρ := stepanovLocalResidueAlgHom K R + let φ := powCardAlgHom K (IsLocalRing.ResidueField R) 1 + have hbasis (ij : α × β) : + ρ (F ij.1 * (G ij.2) ^ Fintype.card K) = + φ (ρ ((F ij.1) ^ Fintype.card K * G ij.2)) := by + dsimp only [ρ, φ] + simp only [map_mul, map_pow, powCardAlgHom_apply, Nat.pow_one] + rw [← pow_mul] + rw [show (stepanovLocalResidueAlgHom K R (F ij.1)) ^ + (Fintype.card K * Fintype.card K) = + stepanovLocalResidueAlgHom K R (F ij.1) by + simpa only [pow_two] using + hsquare (stepanovLocalResidueAlgHom K R (F ij.1))] + calc + ρ (Finsupp.linearCombination K + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) c) = + Finsupp.linearCombination K + (fun ij : α × β => + ρ (F ij.1 * (G ij.2) ^ Fintype.card K)) c := by + exact Finsupp.apply_linearCombination K ρ.toLinearMap _ c + _ = Finsupp.linearCombination K + (fun ij : α × β => + φ (ρ ((F ij.1) ^ Fintype.card K * G ij.2))) c := by + apply congrArg (fun v => Finsupp.linearCombination K v c) + funext ij + exact hbasis ij + _ = φ (Finsupp.linearCombination K + (fun ij : α × β => + ρ ((F ij.1) ^ Fintype.card K * G ij.2)) c) := by + exact (Finsupp.apply_linearCombination K φ.toLinearMap _ c).symm + _ = φ (ρ (Finsupp.linearCombination K + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c)) := by + apply congrArg φ + exact (Finsupp.apply_linearCombination K ρ.toLinearMap _ c).symm + +end LocalResidue + +section LocalOrder + +variable (K R L : Type*) [Field K] [Fintype K] + [CommRing R] [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Algebra K R] + [Field L] [Algebra R L] [IsFractionRing R L] + +/-- Local DVR form of square-Frobenius vanishing. If the second local +linear combination is zero, the first is either zero in the fraction field +or has positive order at the maximal ideal. -/ +theorem stepanovLocal_first_eq_zero_or_order_pos + {α β : Type*} (F : α → R) (G : β → R) (c : α × β →₀ K) + (hsquare : ∀ z : IsLocalRing.ResidueField R, + z ^ (Fintype.card K) ^ 2 = z) + (hsecond : + Finsupp.linearCombination K + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c = 0) : + algebraMap R L + (Finsupp.linearCombination K + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) c) = 0 ∨ + 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) + (algebraMap R L + (Finsupp.linearCombination K + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) c)) := by + let a : R := Finsupp.linearCombination K + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) c + have hresidue : stepanovLocalResidueAlgHom K R a = 0 := by + have h := stepanovLocalResidue_first_eq_frobenius_second + K R F G c hsquare + change stepanovLocalResidueAlgHom K R a = _ at h + rw [hsecond, map_zero, map_zero] at h + exact h + have haMem : a ∈ IsLocalRing.maximalIdeal R := by + apply (IsLocalRing.residue_eq_zero_iff a).mp + exact hresidue + by_cases haMap : algebraMap R L a = 0 + · exact Or.inl haMap + · refine Or.inr ?_ + have ha : a ≠ 0 := by + intro ha0 + apply haMap + rw [ha0, map_zero] + have horder := one_le_finitePlaceOrder_algebraMap_of_mem + (L := L) (IsDiscreteValuationRing.maximalIdeal R) a haMem ha + change 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) (algebraMap R L a) + omega + +end LocalOrder + +section FiniteExtensionPlace + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + [DecidableEq (RatFunc K)] +variable (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] + +/-- Finite-place form used after the two Stepanov restriction maps. + +The families are assumed regular at `q`. The residue hypothesis is stated +on the canonical residue field `q.asIdeal.ResidueField`; it is transported +internally to the residue field of the localized DVR. -/ +theorem onePointStepanovFirstRestrictionMap_eq_zero_or_principalDivisor_pos_at_finitePlace + {α β : Type*} + (q : FiniteExtensionFinitePlace K L) + (f : α → L) (g : β → L) (c : α × β →₀ K) + (hfRegular : ∀ i, + 0 ≤ finiteExtensionPrincipalDivisor K L (f i) (.inl q)) + (hgRegular : ∀ j, + 0 ≤ finiteExtensionPrincipalDivisor K L (g j) (.inl q)) + (hsquare : ∀ z : q.asIdeal.ResidueField, + z ^ (Fintype.card K) ^ 2 = z) + (hsecond : onePointStepanovSecondRestrictionMap K L f g + (Fintype.card K) c = 0) : + onePointStepanovFirstRestrictionMap K L f g + (Fintype.card K) c = 0 ∨ + 0 < finiteExtensionPrincipalDivisor K L + (onePointStepanovFirstRestrictionMap K L f g + (Fintype.card K) c) (.inl q) := by + let A := RatFuncFiniteIntegralClosure K L + let R := FiniteExtensionFinitePlaceLocalRing K L q + letI : Algebra K L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K (RatFunc K))) + letI : IsScalarTower K (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K[X] L := + RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp + (algebraMap K[X] (RatFunc K))) + letI : IsScalarTower K[X] (RatFunc K) L := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra K (RatFuncFiniteIntegralClosure K L) := + RingHom.toAlgebra + ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp + (algebraMap K K[X])) + letI : IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra K[X] L + letI : Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) + letI : Module.IsTorsionFree K[X] L := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L + letI : Module.IsTorsionFree K[X] + (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isTorsionFree K[X] L + letI : IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L + (RatFuncFiniteIntegralClosure K L) + letI : IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + IsIntegralClosure.isFractionRing_of_finite_extension + K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) + letI : Algebra (RatFuncFiniteIntegralClosure K L) + (RatFuncFiniteIntegralClosure K L) := + Algebra.id (RatFuncFiniteIntegralClosure K L) + let localAlgebra : Algebra (RatFuncFiniteIntegralClosure K L) + (FiniteExtensionFinitePlaceLocalRing K L q) := + OreLocalization.instAlgebra + letI := localAlgebra + letI : SMul (RatFuncFiniteIntegralClosure K L) + (FiniteExtensionFinitePlaceLocalRing K L q) := + localAlgebra.toSMul + letI : Algebra K (FiniteExtensionFinitePlaceLocalRing K L q) := + OreLocalization.instAlgebra + letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + letI : IsScalarTower K R L := by + apply IsScalarTower.of_algebraMap_eq' + ext x + symm + change finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap K R x) = algebraMap K L x + rw [show algebraMap K R x = + algebraMap A R (algebraMap K A x) by rfl] + rw [show finiteExtensionFinitePlaceLocalizationToField + (K := K) (L := L) q (algebraMap A R (algebraMap K A x)) = + algebraMap A L (algebraMap K A x) by + exact DFunLike.congr_fun + (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap + (K := K) (L := L) q) (algebraMap K A x)] + rfl + letI : IsDiscreteValuationRing R := + IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain + A q.ne_bot R + let eResidue : + (RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal) ≃+* + IsLocalRing.ResidueField R := + IsLocalization.AtPrime.equivQuotMaximalIdeal q.asIdeal R + let eQuotientResidue : + (RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal) ≃+* + q.asIdeal.ResidueField := + RingEquiv.ofBijective + (algebraMap + (RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal) + q.asIdeal.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField q.asIdeal) + have hsquareQuotient : + ∀ z : RatFuncFiniteIntegralClosure K L ⧸ q.asIdeal, + z ^ (Fintype.card K) ^ 2 = z := by + intro z + apply eQuotientResidue.injective + simpa only [map_pow] using hsquare (eQuotientResidue z) + have hsquareLocal : ∀ z : IsLocalRing.ResidueField R, + z ^ (Fintype.card K) ^ 2 = z := by + intro z + have h := congrArg eResidue (hsquareQuotient (eResidue.symm z)) + simpa only [map_pow, RingEquiv.apply_symm_apply] using h + have hfTop (i : α) : + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (f i) := by + by_cases hfi : f i = 0 + · simp [hfi, finiteExtensionFinitePlaceLocalOrderTop] + · rw [finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + K L q (f i) hfi] + exact_mod_cast hfRegular i + have hgTop (j : β) : + (0 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (g j) := by + by_cases hgj : g j = 0 + · simp [hgj, finiteExtensionFinitePlaceLocalOrderTop] + · rw [finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor + K L q (g j) hgj] + exact_mod_cast hgRegular j + let F : α → R := fun i => Classical.choose + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) q (f i) (hfTop i)) + let G : β → R := fun j => Classical.choose + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) q (g j) (hgTop j)) + have hF (i : α) : f i = algebraMap R L (F i) := by + exact Classical.choose_spec + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) q (f i) (hfTop i)) + have hG (j : β) : g j = algebraMap R L (G j) := by + exact Classical.choose_spec + (finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative + (K := K) (L := L) q (g j) (hgTop j)) + let firstLocal : R := Finsupp.linearCombination K + (fun ij : α × β => + F ij.1 * (G ij.2) ^ Fintype.card K) c + let secondLocal : R := Finsupp.linearCombination K + (fun ij : α × β => + (F ij.1) ^ Fintype.card K * G ij.2) c + let ι : R →ₗ[K] L := (IsScalarTower.toAlgHom K R L).toLinearMap + have hfirstMap : + onePointStepanovFirstRestrictionMap K L f g (Fintype.card K) c = + algebraMap R L firstLocal := by + symm + calc + algebraMap R L firstLocal = ι firstLocal := rfl + _ = Finsupp.linearCombination K + (fun ij : α × β => + ι (F ij.1 * (G ij.2) ^ Fintype.card K)) c := by + exact Finsupp.apply_linearCombination K ι _ c + _ = Finsupp.linearCombination K + (fun ij : α × β => + f ij.1 * (g ij.2) ^ Fintype.card K) c := by + apply congrArg (fun v => Finsupp.linearCombination K v c) + funext ij + change algebraMap R L + (F ij.1 * (G ij.2) ^ Fintype.card K) = _ + rw [map_mul, map_pow, ← hF ij.1, ← hG ij.2] + _ = onePointStepanovFirstRestrictionMap K L f g + (Fintype.card K) c := rfl + have hsecondMap : + onePointStepanovSecondRestrictionMap K L f g (Fintype.card K) c = + algebraMap R L secondLocal := by + symm + calc + algebraMap R L secondLocal = ι secondLocal := rfl + _ = Finsupp.linearCombination K + (fun ij : α × β => + ι ((F ij.1) ^ Fintype.card K * G ij.2)) c := by + exact Finsupp.apply_linearCombination K ι _ c + _ = Finsupp.linearCombination K + (fun ij : α × β => + (f ij.1) ^ Fintype.card K * g ij.2) c := by + apply congrArg (fun v => Finsupp.linearCombination K v c) + funext ij + change algebraMap R L + ((F ij.1) ^ Fintype.card K * G ij.2) = _ + rw [map_mul, map_pow, ← hF ij.1, ← hG ij.2] + _ = onePointStepanovSecondRestrictionMap K L f g + (Fintype.card K) c := rfl + have hsecondLocal : secondLocal = 0 := by + apply IsFractionRing.injective R L + rw [map_zero, ← hsecondMap] + exact hsecond + have hlocal := stepanovLocal_first_eq_zero_or_order_pos + K R L F G c hsquareLocal hsecondLocal + rcases hlocal with hzero | hpositive + · exact Or.inl (by rw [hfirstMap]; exact hzero) + · refine Or.inr ?_ + rw [hfirstMap, + finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder, + ← finiteExtensionFinitePlaceLocalOrder_eq_globalOrder q] + change 0 < finitePlaceOrder + (IsDiscreteValuationRing.maximalIdeal R) (algebraMap R L firstLocal) + exact hpositive + +end FiniteExtensionPlace + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean new file mode 100644 index 0000000000..334fffbc45 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean @@ -0,0 +1,173 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.LinearAlgebra.Dimension.Constructions +import Mathlib.LinearAlgebra.Dimension.Finite +import Mathlib.LinearAlgebra.FiniteDimensional.Defs +import Mathlib.LinearAlgebra.TensorProduct.Submodule +import Mathlib.RingTheory.TensorProduct.Finite + +/-! +# Tensor restriction maps + +This file packages the bilinear maps used in the Stepanov restriction step. +For submodules `R`, `S`, and `T` of a commutative `K`-algebra `L`, an algebra +endomorphism `φ` gives the two twisted products +`x * φ y` and `φ x * y`. An explicit containment hypothesis promotes either +product to a linear map from `R ⊗[K] S` into `T`. + +The final lemmas record the finite-generation and finrank consequences that +are needed when such a tensor restriction map is used as a target map in a +rank-nullity argument. +-/ + +namespace BGS.HasseWeil + +open scoped TensorProduct + +variable {K L : Type*} [Field K] [CommRing L] [Algebra K L] +variable {R S T : Submodule K L} + +/-- The tensor restriction map induced by the twisted product +`(x, y) ↦ x * φ y`, with codomain restricted by `hmul`. -/ +def tensorRestriction + (φ : L →ₐ[K] L) + (hmul : ∀ x : R, ∀ y : S, (x : L) * φ (y : L) ∈ T) : + R ⊗[K] S →ₗ[K] T := + TensorProduct.lift <| + LinearMap.mk₂ K + (fun x y ↦ ⟨(x : L) * φ (y : L), hmul x y⟩) + (fun x₁ x₂ y ↦ by + apply Subtype.ext + change ((x₁ : L) + (x₂ : L)) * φ (y : L) = + (x₁ : L) * φ (y : L) + (x₂ : L) * φ (y : L) + rw [add_mul]) + (fun c x y ↦ by + apply Subtype.ext + change (c • (x : L)) * φ (y : L) = + c • ((x : L) * φ (y : L)) + rw [smul_mul_assoc]) + (fun x y₁ y₂ ↦ by + apply Subtype.ext + change (x : L) * φ ((y₁ : L) + (y₂ : L)) = + (x : L) * φ (y₁ : L) + (x : L) * φ (y₂ : L) + rw [map_add, mul_add]) + (fun c x y ↦ by + apply Subtype.ext + change (x : L) * φ (c • (y : L)) = + c • ((x : L) * φ (y : L)) + rw [map_smul, mul_smul_comm]) + +@[simp] +theorem tensorRestriction_tmul + (φ : L →ₐ[K] L) + (hmul : ∀ x : R, ∀ y : S, (x : L) * φ (y : L) ∈ T) + (x : R) (y : S) : + tensorRestriction φ hmul (x ⊗ₜ[K] y) = + ⟨(x : L) * φ (y : L), hmul x y⟩ := + rfl + +/-- The swapped tensor restriction map induced by the twisted product +`(x, y) ↦ φ x * y`, with codomain restricted by `hmul`. -/ +def swappedTensorRestriction + (φ : L →ₐ[K] L) + (hmul : ∀ x : R, ∀ y : S, φ (x : L) * (y : L) ∈ T) : + R ⊗[K] S →ₗ[K] T := + TensorProduct.lift <| + LinearMap.mk₂ K + (fun x y ↦ ⟨φ (x : L) * (y : L), hmul x y⟩) + (fun x₁ x₂ y ↦ by + apply Subtype.ext + change φ ((x₁ : L) + (x₂ : L)) * (y : L) = + φ (x₁ : L) * (y : L) + φ (x₂ : L) * (y : L) + rw [map_add, add_mul]) + (fun c x y ↦ by + apply Subtype.ext + change φ (c • (x : L)) * (y : L) = + c • (φ (x : L) * (y : L)) + rw [map_smul, smul_mul_assoc]) + (fun x y₁ y₂ ↦ by + apply Subtype.ext + change φ (x : L) * ((y₁ : L) + (y₂ : L)) = + φ (x : L) * (y₁ : L) + φ (x : L) * (y₂ : L) + rw [mul_add]) + (fun c x y ↦ by + apply Subtype.ext + change φ (x : L) * (c • (y : L)) = + c • (φ (x : L) * (y : L)) + rw [mul_smul_comm]) + +@[simp] +theorem swappedTensorRestriction_tmul + (φ : L →ₐ[K] L) + (hmul : ∀ x : R, ∀ y : S, φ (x : L) * (y : L) ∈ T) + (x : R) (y : S) : + swappedTensorRestriction φ hmul (x ⊗ₜ[K] y) = + ⟨φ (x : L) * (y : L), hmul x y⟩ := + rfl + +/-- A tensor product of finite modules is finite. This named bridge keeps +downstream restriction arguments independent of the tensor-product instance +search details. -/ +theorem moduleFinite_tensorProduct + [Module.Finite K R] [Module.Finite K S] : + Module.Finite K (R ⊗[K] S) := + Module.Finite.tensorProduct K R S + +/-- The range of a linear map out of a tensor product of finite modules is +finite. -/ +theorem moduleFinite_range_tensorProductMap + {U : Type*} [AddCommGroup U] [Module K U] + [Module.Finite K R] [Module.Finite K S] + (f : R ⊗[K] S →ₗ[K] U) : + Module.Finite K (LinearMap.range f) := by + letI : Module.Finite K (R ⊗[K] S) := + moduleFinite_tensorProduct + exact Module.Finite.range f + +/-- The range of a linear map out of `R ⊗ S` has finrank at most the product +of the two input finranks. -/ +theorem finrank_range_tensorProductMap_le + {U : Type*} [AddCommGroup U] [Module K U] + [Module.Finite K R] [Module.Finite K S] + (f : R ⊗[K] S →ₗ[K] U) : + Module.finrank K (LinearMap.range f) ≤ + Module.finrank K R * Module.finrank K S := by + letI : Module.Finite K (R ⊗[K] S) := + moduleFinite_tensorProduct + calc + Module.finrank K (LinearMap.range f) ≤ + Module.finrank K (R ⊗[K] S) := + LinearMap.finrank_range_le f + _ = Module.finrank K R * Module.finrank K S := + Module.finrank_tensorProduct + +/-- A surjective linear map out of `R ⊗ S` makes its target finite. -/ +theorem moduleFinite_of_surjective_tensorProductMap + {U : Type*} [AddCommGroup U] [Module K U] + [Module.Finite K R] [Module.Finite K S] + (f : R ⊗[K] S →ₗ[K] U) (hf : Function.Surjective f) : + Module.Finite K U := by + letI : Module.Finite K (R ⊗[K] S) := + moduleFinite_tensorProduct + exact Module.Finite.of_surjective f hf + +/-- A surjective linear map out of `R ⊗ S` bounds the target finrank by the +product of the two input finranks. -/ +theorem finrank_le_mul_of_surjective_tensorProductMap + {U : Type*} [AddCommGroup U] [Module K U] + [Module.Finite K R] [Module.Finite K S] + (f : R ⊗[K] S →ₗ[K] U) (hf : Function.Surjective f) : + Module.finrank K U ≤ Module.finrank K R * Module.finrank K S := by + letI : Module.Finite K (R ⊗[K] S) := + moduleFinite_tensorProduct + calc + Module.finrank K U ≤ Module.finrank K (R ⊗[K] S) := + LinearMap.finrank_le_finrank_of_surjective hf + _ = Module.finrank K R * Module.finrank K S := + Module.finrank_tensorProduct + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean new file mode 100644 index 0000000000..c727f03ef7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean @@ -0,0 +1,76 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic + +/-! +# Extension point counts and the zeta spectral formula + +This file packages the elementary interface between rationality of a curve's +zeta function and the even-extension estimate produced by the +Bombieri--Stepanov/Galois-averaging argument. The geometric construction of +the zeta function remains a separate preceding stage. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics +open scoped BigOperators + +noncomputable section + +/-- A compatible spectral formula for every positive extension degree. -/ +def HasExtensionPointCountSpectralFormula + (q g : ℕ) (pointCount : ℕ → ℕ) (alpha : Fin (2 * g) → ℂ) : Prop := + ∀ m, 0 < m → + (pointCount m : ℂ) = (q : ℂ) ^ m + 1 - ∑ i, alpha i ^ m + +/-- The extension formula at degree one is the single spectral formula used +in the final Hasse inequality. -/ +theorem HasExtensionPointCountSpectralFormula.at_one + {q g : ℕ} {pointCount : ℕ → ℕ} {alpha : Fin (2 * g) → ℂ} + (h : HasExtensionPointCountSpectralFormula q g pointCount alpha) : + HasPointCountSpectralFormula q g (pointCount 1) alpha := by + simpa [HasPointCountSpectralFormula] using h 1 (by omega) + +/-- An even-extension point-count error of order `q ^ n` is exactly the +power-sum estimate needed to bound the Frobenius parameters. -/ +theorem evenPowerSum_isBigO_of_extensionPointCountError_isBigO + {q g : ℕ} {pointCount : ℕ → ℕ} {alpha : Fin (2 * g) → ℂ} + (hformula : HasExtensionPointCountSpectralFormula q g pointCount alpha) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * n)) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n := by + apply herror.neg_left.congr' + · filter_upwards [eventually_ge_atTop 1] with n hn + have hpositive : 0 < 2 * n := by omega + have h := hformula (2 * n) hpositive + change -((pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) = + ∑ i, alpha i ^ (2 * n) + rw [h] + ring + · exact Filter.EventuallyEq.rfl + +/-- The complete analytic last step: a zeta spectral formula together with +the two-sided even-extension asymptotic gives Hasse--Weil at the base field. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_extensionFormula_and_evenError_isBigO + (q g : ℕ) (pointCount : ℕ → ℕ) (alpha : Fin (2 * g) → ℂ) + (hformula : HasExtensionPointCountSpectralFormula q g pointCount alpha) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ (2 * g : ℝ) * Real.sqrt q := by + apply abs_pointCount_sub_card_sub_one_le_of_evenPowerSum_isBigO + q g (pointCount 1) alpha hformula.at_one + exact evenPowerSum_isBigO_of_extensionPointCountError_isBigO hformula herror + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean new file mode 100644 index 0000000000..da97e231cc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean @@ -0,0 +1,207 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral + +/-! +# From a zeta numerator to a rank-bounded spectral formula + +The zeta numerator of a curve need not be presented with an even degree in +the coarse plane-curve estimates used by this project. This file therefore +states the spectral argument for an arbitrary finite rank. Its final bound +is `rank * sqrt q`. + +`HasZetaNumeratorPointCountFormula` is a transparent property of a concrete +polynomial: its reciprocal-root power sums are the extension point-count +errors. The zeta-function construction must prove that property; it is not +an assumed theorem or a replacement for Hasse--Weil. +-/ + +namespace BGS.HasseWeil + +open Filter Asymptotics +open scoped BigOperators + +noncomputable section + +/-- A compatible spectral formula with an arbitrary finite number of +parameters. -/ +def HasExtensionPointCountSpectralFormulaOfRank + (q rank : ℕ) (pointCount : ℕ → ℕ) (alpha : Fin rank → ℂ) : Prop := + ∀ m, 0 < m → + (pointCount m : ℂ) = (q : ℂ) ^ m + 1 - ∑ i, alpha i ^ m + +/-- The logarithmic-derivative point-count identity for a normalized zeta +numerator, written directly as reciprocal-root power sums. -/ +def HasZetaNumeratorPointCountFormula + (q : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) : Prop := + P.coeff 0 = 1 ∧ + ∀ m, 0 < m → + (pointCount m : ℂ) = (q : ℂ) ^ m + 1 - + (P.roots.map fun r => r⁻¹ ^ m).sum + +/-- A zeta-numerator point-count identity gives a spectral formula indexed by +the numerator degree. -/ +theorem hasExtensionPointCountSpectralFormulaOfRank_of_zetaNumerator + {q : ℕ} {pointCount : ℕ → ℕ} {P : Polynomial ℂ} + (h : HasZetaNumeratorPointCountFormula q pointCount P) : + HasExtensionPointCountSpectralFormulaOfRank q P.natDegree pointCount + (reciprocalRootParameter P) := by + intro m hm + rw [sum_reciprocalRootParameter_pow] + exact h.2 m hm + +/-- Extension-count error of order `q^n` gives the corresponding even +power-sum estimate, for arbitrary spectral rank. -/ +theorem evenPowerSum_isBigO_of_extensionPointCountError_isBigO_of_rank + {q rank : ℕ} {pointCount : ℕ → ℕ} {alpha : Fin rank → ℂ} + (hformula : + HasExtensionPointCountSpectralFormulaOfRank q rank pointCount alpha) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * n)) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n := by + apply herror.neg_left.congr' + · filter_upwards [eventually_ge_atTop 1] with n hn + have hpositive : 0 < 2 * n := by omega + have h := hformula (2 * n) hpositive + change -((pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) = + ∑ i, alpha i ^ (2 * n) + rw [h] + ring + · exact Filter.EventuallyEq.rfl + +/-- An extension-count error estimate along any fixed positive +`2 * δ`-divisible subsequence gives the corresponding power-sum estimate, +for arbitrary spectral rank. -/ +theorem divisibleEvenPowerSum_isBigO_of_extensionPointCountError_isBigO_of_rank + {q rank δ : ℕ} {pointCount : ℕ → ℕ} {alpha : Fin rank → ℂ} + (hδ : 0 < δ) + (hformula : + HasExtensionPointCountSpectralFormulaOfRank q rank pointCount alpha) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * δ * n) : ℂ) - (q : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n) : + (fun n : ℕ ↦ ∑ i, alpha i ^ (2 * δ * n)) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n := by + apply herror.neg_left.congr' + · filter_upwards [eventually_ge_atTop 1] with n hn + have hpositive : 0 < 2 * δ * n := + Nat.mul_pos (Nat.mul_pos (by omega) hδ) hn + have h := hformula (2 * δ * n) hpositive + change -((pointCount (2 * δ * n) : ℂ) - + (q : ℂ) ^ (2 * δ * n) - 1) = + ∑ i, alpha i ^ (2 * δ * n) + rw [h] + ring + · exact Filter.EventuallyEq.rfl + +/-- The arbitrary-rank analytic Hasse step. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_rank_extensionFormula_and_evenError_isBigO + (q rank : ℕ) (pointCount : ℕ → ℕ) (alpha : Fin rank → ℂ) + (hformula : + HasExtensionPointCountSpectralFormulaOfRank q rank pointCount alpha) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ (rank : ℝ) * Real.sqrt q := by + have hnorm : ∀ i, ‖alpha i‖ ≤ Real.sqrt q := + spectral_norm_le_sqrt_of_evenPowerSum_isBigO alpha (by positivity) + (evenPowerSum_isBigO_of_extensionPointCountError_isBigO_of_rank + hformula herror) + have hone := hformula 1 (by omega) + have herrorOne : + (((pointCount 1 : ℝ) - q - 1 : ℝ) : ℂ) = -(∑ i, alpha i) := by + push_cast + rw [hone] + simp + ring + calc + |(pointCount 1 : ℝ) - q - 1| = + ‖(((pointCount 1 : ℝ) - q - 1 : ℝ) : ℂ)‖ := by + rw [Complex.norm_real, Real.norm_eq_abs] + _ = ‖∑ i, alpha i‖ := by rw [herrorOne, norm_neg] + _ ≤ ∑ i, ‖alpha i‖ := norm_sum_le _ _ + _ ≤ ∑ _i : Fin rank, Real.sqrt q := by + exact Finset.sum_le_sum fun i _ => hnorm i + _ = (rank : ℝ) * Real.sqrt q := by simp + +/-- The arbitrary-rank analytic Hasse step from an estimate available only +along a fixed positive divisible-even subsequence. -/ +theorem + abs_pointCount_sub_card_sub_one_le_of_rank_extensionFormula_and_divisibleEvenError_isBigO + (q rank δ : ℕ) (pointCount : ℕ → ℕ) (alpha : Fin rank → ℂ) + (hq : 0 < q) (hδ : 0 < δ) + (hformula : + HasExtensionPointCountSpectralFormulaOfRank q rank pointCount alpha) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * δ * n) : ℂ) - (q : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ (rank : ℝ) * Real.sqrt q := by + have hnorm : ∀ i, ‖alpha i‖ ≤ Real.sqrt q := + spectral_norm_le_sqrt_of_divisibleEvenPowerSum_isBigO alpha + (by exact_mod_cast hq) hδ + (divisibleEvenPowerSum_isBigO_of_extensionPointCountError_isBigO_of_rank + hδ hformula herror) + have hone := hformula 1 (by omega) + have herrorOne : + (((pointCount 1 : ℝ) - q - 1 : ℝ) : ℂ) = -(∑ i, alpha i) := by + push_cast + rw [hone] + simp + ring + calc + |(pointCount 1 : ℝ) - q - 1| = + ‖(((pointCount 1 : ℝ) - q - 1 : ℝ) : ℂ)‖ := by + rw [Complex.norm_real, Real.norm_eq_abs] + _ = ‖∑ i, alpha i‖ := by rw [herrorOne, norm_neg] + _ ≤ ∑ i, ‖alpha i‖ := norm_sum_le _ _ + _ ≤ ∑ _i : Fin rank, Real.sqrt q := by + exact Finset.sum_le_sum fun i _ => hnorm i + _ = (rank : ℝ) * Real.sqrt q := by simp + +/-- A normalized zeta numerator and the even extension estimate imply the +base-field Hasse bound with coefficient equal to the numerator degree. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_zetaNumerator_and_evenError_isBigO + (q : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) + (hformula : HasZetaNumeratorPointCountFormula q pointCount P) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * n) : ℂ) - (q : ℂ) ^ (2 * n) - 1) =O[atTop] + fun n : ℕ ↦ (q : ℝ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt q := by + exact abs_pointCount_sub_card_sub_one_le_of_rank_extensionFormula_and_evenError_isBigO + q P.natDegree pointCount (reciprocalRootParameter P) + (hasExtensionPointCountSpectralFormulaOfRank_of_zetaNumerator hformula) herror + +/-- A normalized zeta numerator and a square-root error estimate along a +fixed positive divisible-even subsequence imply the base-field Hasse bound, +with coefficient equal to the numerator degree. -/ +theorem + abs_pointCount_sub_card_sub_one_le_of_zetaNumerator_and_divisibleEvenError_isBigO + (q δ : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) + (hq : 0 < q) (hδ : 0 < δ) + (hformula : HasZetaNumeratorPointCountFormula q pointCount P) + (herror : + (fun n : ℕ ↦ + (pointCount (2 * δ * n) : ℂ) - (q : ℂ) ^ (2 * δ * n) - 1) =O[atTop] + fun n : ℕ ↦ ((q : ℝ) ^ δ) ^ n) : + |(pointCount 1 : ℝ) - q - 1| ≤ + (P.natDegree : ℝ) * Real.sqrt q := by + exact + abs_pointCount_sub_card_sub_one_le_of_rank_extensionFormula_and_divisibleEvenError_isBigO + q P.natDegree δ pointCount (reciprocalRootParameter P) hq hδ + (hasExtensionPointCountSpectralFormulaOfRank_of_zetaNumerator hformula) herror + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean new file mode 100644 index 0000000000..530912e896 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib + +/-! +# From zeta-function spectral data to the Hasse--Weil estimate + +This file isolates the final, elementary inequality in the Hasse--Weil +argument. Once the point-count formula writes the error as a sum of `2g` +Frobenius parameters of norm at most `sqrt q`, the projective point-count +bound follows from the triangle inequality. + +The zeta-function construction and the proof of the spectral bound are kept +separate: they are the substantive preceding stages of the +Corvaja--Zannier/Bombieri argument. +-/ + +namespace BGS.HasseWeil + +open scoped BigOperators + +noncomputable section + +/-- A single point-count formula with `2g` Frobenius parameters. -/ +def HasPointCountSpectralFormula + (q g N : ℕ) (alpha : Fin (2 * g) → ℂ) : Prop := + (N : ℂ) = (q : ℂ) + 1 - ∑ i, alpha i + +/-- The Hasse--Weil inequality is the triangle inequality once every +Frobenius parameter has norm at most `sqrt q`. -/ +theorem abs_pointCount_sub_card_sub_one_le_of_spectralFormula + (q g N : ℕ) (alpha : Fin (2 * g) → ℂ) + (hformula : HasPointCountSpectralFormula q g N alpha) + (hspectral : ∀ i, ‖alpha i‖ ≤ Real.sqrt q) : + |(N : ℝ) - q - 1| ≤ (2 * g : ℝ) * Real.sqrt q := by + have hformula' : + (N : ℂ) = (q : ℂ) + 1 - ∑ i, alpha i := hformula + have herror : + (((N : ℝ) - q - 1 : ℝ) : ℂ) = -(∑ i, alpha i) := by + push_cast + linear_combination hformula' + calc + |(N : ℝ) - q - 1| = ‖(((N : ℝ) - q - 1 : ℝ) : ℂ)‖ := by + rw [Complex.norm_real, Real.norm_eq_abs] + _ = ‖∑ i, alpha i‖ := by rw [herror, norm_neg] + _ ≤ ∑ i, ‖alpha i‖ := norm_sum_le _ _ + _ ≤ ∑ _i : Fin (2 * g), Real.sqrt q := by + exact Finset.sum_le_sum fun i _ => hspectral i + _ = (2 * g : ℝ) * Real.sqrt q := by simp + +end + +end BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean new file mode 100644 index 0000000000..76fa48127b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean new file mode 100644 index 0000000000..8fc8366854 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean @@ -0,0 +1,85 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount + +/-! +# The elementary asymptotic in the giant-orbit assembly + +The concrete small-order count is `2 * (2 + 2 * B^2)^2`. This file proves that choosing +`B ≤ p^(ε/5)` makes that count at most `p^ε` for all sufficiently large `p`. No dynamical +claim about the cage complement is used here. +-/ + +namespace BGS.Markoff + +open Filter +open scoped Topology + +/-- Once `p^(ε/5)` absorbs the fixed constant, the explicit polynomial bound is at most +`p^ε`. -/ +theorem smallOrderPointBound_le_rpow + {p bound : ℕ} {ε : ℝ} + (hThirtyTwo : (32 : ℝ) ≤ (p : ℝ) ^ (ε / 5)) + (hbound : (bound : ℝ) ≤ (p : ℝ) ^ (ε / 5)) : + ((2 * (2 + 2 * bound ^ 2) ^ 2 : ℕ) : ℝ) ≤ (p : ℝ) ^ ε := by + let x : ℝ := (p : ℝ) ^ (ε / 5) + have hxNonneg : 0 ≤ x := Real.rpow_nonneg (Nat.cast_nonneg p) _ + have hxOne : 1 ≤ x := by + dsimp [x] + linarith [hThirtyTwo] + have hboundNonneg : 0 ≤ (bound : ℝ) := Nat.cast_nonneg bound + have hboundSq : (bound : ℝ) ^ 2 ≤ x ^ 2 := by + exact pow_le_pow_left₀ hboundNonneg hbound 2 + have hxSqOne : 1 ≤ x ^ 2 := by nlinarith + have hInside : 1 + (bound : ℝ) ^ 2 ≤ 2 * x ^ 2 := by linarith + have hPolynomial : + ((2 * (2 + 2 * bound ^ 2) ^ 2 : ℕ) : ℝ) ≤ 32 * x ^ 4 := by + norm_num only [Nat.cast_mul, Nat.cast_add, Nat.cast_ofNat, Nat.cast_pow] + calc + 2 * (2 + 2 * (bound : ℝ) ^ 2) ^ 2 = 8 * (1 + (bound : ℝ) ^ 2) ^ 2 := by ring + _ ≤ 8 * (2 * x ^ 2) ^ 2 := by gcongr + _ = 32 * x ^ 4 := by ring + have hAbsorbConstant : 32 * x ^ 4 ≤ x ^ 5 := by + nlinarith [sq_nonneg (x ^ 2), mul_nonneg hxNonneg (sq_nonneg x)] + calc + ((2 * (2 + 2 * bound ^ 2) ^ 2 : ℕ) : ℝ) ≤ 32 * x ^ 4 := hPolynomial + _ ≤ x ^ 5 := hAbsorbConstant + _ = (p : ℝ) ^ ε := by + dsimp [x] + rw [← Real.rpow_mul_natCast (Nat.cast_nonneg p) (ε / 5) 5] + congr 1 + ring + +/-- The explicit polynomial small-order bound is eventually absorbed by the target real power. -/ +theorem eventually_smallOrderPointBound_le_rpow {ε : ℝ} (hε : 0 < ε) : + ∀ᶠ p : ℕ in atTop, ∀ bound : ℕ, + (bound : ℝ) ≤ (p : ℝ) ^ (ε / 5) → + ((2 * (2 + 2 * bound ^ 2) ^ 2 : ℕ) : ℝ) ≤ (p : ℝ) ^ ε := by + have hExponent : 0 < ε / 5 := div_pos hε (by norm_num) + have hEventuallyThirtyTwo : + ∀ᶠ p : ℕ in atTop, (32 : ℝ) ≤ (p : ℝ) ^ (ε / 5) := + ((tendsto_rpow_atTop hExponent).comp tendsto_natCast_atTop_atTop).eventually + (eventually_ge_atTop 32) + filter_upwards [hEventuallyThirtyTwo] with p hp + exact fun bound hbound ↦ smallOrderPointBound_le_rpow hp hbound + +/-- The counted punctured small-order set satisfies the target bound as soon as its order cutoff +is at most `p^(ε/5)` and the harmless constant has been absorbed. -/ +theorem puncturedSmallOrderSet_card_le_rpow_of_bound + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) {ε : ℝ} (bound : ℕ) + (hThirtyTwo : (32 : ℝ) ≤ (p : ℝ) ^ (ε / 5)) + (hbound : (bound : ℝ) ≤ (p : ℝ) ^ (ε / 5)) : + ((puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card : ℝ) ≤ + (p : ℝ) ^ ε := by + calc + ((puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card : ℝ) ≤ + (2 * (2 + 2 * bound ^ 2) ^ 2 : ℕ) := by + exact_mod_cast puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le hpTwo bound + _ ≤ (p : ℝ) ^ ε := smallOrderPointBound_le_rpow hThirtyTwo hbound + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean new file mode 100644 index 0000000000..d23e6b18f2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail + +/-! +# Endgame and cage wrappers at the unified coarse support cutoff + +The geometric endgame is unchanged. This module feeds it the simultaneous +tenth-moment estimates proved in `CoarseSupportTail`, so every non-cubic +support condition follows from the single hypothesis `2^756 < p`. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Above the unified support cutoff, a large first-coordinate rotation +reaches a maximal split rotation. -/ +theorem exists_coarse_sameComponent_maximalRotation_of_large_firstCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : 2 ^ 756 < p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ rotationOrder y.1.u2 = p - 1 := by + let xf : ↑(normalizedFiber1 x.1.u1) := ⟨x.1, x.property, rfl⟩ + obtain ⟨n, hrotation⟩ := + exists_iterate_point_with_maximal_secondRotation_of_explicitInequalities + p ((by norm_num : 5 ≤ 7).trans (seven_le_of_twoPow756_lt hp)) + x.1.u1 xf + (fun orbitExponent orbitOrder hmul horder ↦ + coarse_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + hp hmul horder (by norm_num)) + (fun orbitExponent orbitOrder hmul horder ↦ + coarse_endgamePrimitiveTrace_explicitInequality_of_card_add_one + hp hmul horder (by norm_num)) + (coarse_four_lt_rpow_five_div_six hp) hlarge + let y := (normalizedRotate1Surface^[n]) x + refine ⟨y, sameNormalizedComponent_iterate_normalizedRotate1Surface x n, ?_⟩ + rw [show y.1 = (normalizedRotate1^[n]) x.1 by + exact coe_iterate_normalizedRotate1Surface x n] + exact hrotation + +/-- First-coordinate form of the coarse large-order-to-cage endgame. -/ +theorem exists_coarse_sameComponent_splitCage_of_large_firstCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : 2 ^ 756 < p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + obtain ⟨y, hxy, hyOrder⟩ := + exists_coarse_sameComponent_maximalRotation_of_large_firstCoordinate + hp x hlarge + exact ⟨y, hxy, .second, hyOrder⟩ + +/-- If one coordinate rotation is large, the point reaches the split cage. -/ +theorem exists_coarse_sameComponent_splitCage_of_some_largeCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : 2 ^ 756 < p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u3) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + rcases hlarge with hfirst | hsecond | hthird + · exact + exists_coarse_sameComponent_splitCage_of_large_firstCoordinate + hp x hfirst + · let x' := normalizedSwap12Surface x + have hx' : SameNormalizedComponent x x' := + sameNormalizedComponent_swap12Surface x + have hlarge' : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, coe_normalizedSwap12Surface] using hsecond + obtain ⟨y, hy, hyOrder⟩ := + exists_coarse_sameComponent_maximalRotation_of_large_firstCoordinate + hp x' hlarge' + exact ⟨y, sameNormalizedComponent_trans hx' hy, .second, hyOrder⟩ + · let x' := normalizedSwap12Surface (normalizedSwap23Surface x) + have hx23 : SameNormalizedComponent x (normalizedSwap23Surface x) := + sameNormalizedComponent_swap23Surface x + have hx12 : SameNormalizedComponent (normalizedSwap23Surface x) x' := + sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x) + have hlarge' : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, normalizedSwap23, + coe_normalizedSwap12Surface, coe_normalizedSwap23Surface] using hthird + obtain ⟨y, hy, hyOrder⟩ := + exists_coarse_sameComponent_maximalRotation_of_large_firstCoordinate + hp x' hlarge' + exact ⟨y, sameNormalizedComponent_trans + (sameNormalizedComponent_trans hx23 hx12) hy, .second, hyOrder⟩ + +/-- The selected split cage is connected above the unified support cutoff. -/ +theorem coarse_splitCage_connected + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : 2 ^ 756 < p) + (x y : NormalizedMarkoffSurface (ZMod p)) + (hx : IsInSplitCage p x) (hy : IsInSplitCage p y) : + SameNormalizedComponent x y := by + exact splitCage_connected_of_explicitInequality p + (seven_le_of_twoPow756_lt hp) + (coarse_cageWitness_explicitInequality hp (by norm_num)) + x y hx hy + +/-- A large-order point lies in the component of any chosen cage base point. -/ +theorem coarse_sameNormalizedComponent_of_largeOrder_to_splitCage + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : 2 ^ 756 < p) + (base x : NormalizedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p base) + (hlarge : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u3) : + SameNormalizedComponent base x := by + obtain ⟨y, hxy, hy⟩ := + exists_coarse_sameComponent_splitCage_of_some_largeCoordinate + hp x hlarge + exact sameNormalizedComponent_trans + (coarse_splitCage_connected hp base y hbase hy) + (sameNormalizedComponent_symm hxy) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean new file mode 100644 index 0000000000..1d605cb8e5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics + +/-! +# Coarse automatic linear tail + +The simultaneous tenth-moment bound makes the linear middle-game condition +automatic at a cutoff far below the paper scale. No divisor-table tuning is +used here. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- A tenth-moment estimate and the clean coefficient threshold +`24^15 * 2^687 < p` imply `24*T < p^(1/6)`. + +The exponent choice is exact: +`(24^15 * 2^687)^4 = 24^60 * (2^458)^6`. -/ +theorem twentyFour_mul_lt_rpow_one_div_six_of_tenthMoment + {p T : ℕ} + (hp : 24 ^ 15 * 2 ^ 687 < p) + (hmoment : T ^ 10 ≤ 2 ^ 458 * p) : + ((24 * T : ℕ) : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) := by + let Q : ℕ := 24 ^ 15 * 2 ^ 687 + have hQ : Q < p := by + simpa [Q] using hp + have hpPos : 0 < p := by + have hQPos : 0 < Q := by positivity + exact hQPos.trans hQ + have h24 : (24 ^ 15) ^ 4 = 24 ^ 60 := by + rw [← pow_mul] + have hTwoLeft : (2 ^ 458) ^ 6 = 2 ^ 2748 := by + rw [← pow_mul] + have hTwoRight : (2 ^ 687) ^ 4 = 2 ^ 2748 := by + rw [← pow_mul] + have hpowNat : (24 * T) ^ 60 < p ^ 10 := by + calc + (24 * T) ^ 60 = 24 ^ 60 * (T ^ 10) ^ 6 := by ring + _ ≤ 24 ^ 60 * (2 ^ 458 * p) ^ 6 := by gcongr + _ = (24 ^ 60 * (2 ^ 458) ^ 6) * p ^ 6 := by + rw [mul_pow] + ring + _ = ((24 ^ 15) ^ 4 * (2 ^ 687) ^ 4) * p ^ 6 := by + rw [h24, hTwoLeft, hTwoRight] + _ = Q ^ 4 * p ^ 6 := by + simp only [Q, mul_pow] + _ < p ^ 4 * p ^ 6 := + Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hQ (Nat.zero_le Q) (by norm_num)) + (pow_pos hpPos 6) + _ = p ^ 10 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((24 * T : ℕ) : ℝ) ^ 60 < (p : ℝ) ^ 10 := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 60 = (p : ℝ) ^ 10 := by + calc + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 60 = + (p : ℝ) ^ ((1 / 6 : ℝ) * 60) := + (Real.rpow_mul_natCast hpNonnegative (1 / 6 : ℝ) 60).symm + _ = (p : ℝ) ^ 10 := by norm_num + apply lt_of_pow_lt_pow_left₀ 60 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- Apply the generic tail estimate to the simultaneous divisor count +`T = τ(p-1) + τ(p+1)`. -/ +theorem preliminary_twentyFour_mul_divisorSum_lt_rpow_one_div_six_of_coarseBound + {p : ℕ} + (hp : 24 ^ 15 * 2 ^ 687 < p) : + ((24 * ((p - 1).divisors.card + (p + 1).divisors.card) : ℕ) : ℝ) < + (p : ℝ) ^ (1 / 6 : ℝ) := by + apply twentyFour_mul_lt_rpow_one_div_six_of_tenthMoment hp + have hpTwo : 2 ≤ p := by + have hcoefficientPos : 0 < 24 ^ 15 * 2 ^ 687 := by positivity + omega + calc + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 10 ≤ + 2 ^ 457 * p := by + simpa [preliminaryDivisorMomentConstant] using + preliminary_divisor_sum_pow_ten_le hpTwo + _ ≤ 2 ^ 458 * p := by + apply Nat.mul_le_mul_right + calc + 2 ^ 457 = 2 ^ 457 * 1 := by simp + _ ≤ 2 ^ 457 * 2 := Nat.mul_le_mul_left _ (by norm_num) + _ = 2 ^ (457 + 1) := (pow_succ 2 457).symm + _ = 2 ^ 458 := by norm_num + +/-- Once `24*T < p^(1/6)`, every `M ≤ T` and every +`d < p^(5/6)` satisfy the linear middle-game inequality. -/ +theorem twentyFour_mul_mul_lt_of_le_of_lt_fiveSixths + {p T M d : ℕ} + (hpPos : 0 < p) + (hT : ((24 * T : ℕ) : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ)) + (hM : M ≤ T) + (hd : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ)) : + 24 * M * d < p := by + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast hpPos + have hLinearPower : + (p : ℝ) ^ (1 / 6 : ℝ) * (p : ℝ) ^ (5 / 6 : ℝ) = + (p : ℝ) := by + rw [← Real.rpow_add hpRealPos] + norm_num + have hMT : 24 * M ≤ 24 * T := + Nat.mul_le_mul_left 24 hM + have hLinearReal : ((24 * M * d : ℕ) : ℝ) < p := by + calc + ((24 * M * d : ℕ) : ℝ) = + ((24 * M : ℕ) : ℝ) * (d : ℝ) := by norm_num + _ ≤ ((24 * T : ℕ) : ℝ) * (d : ℝ) := by + apply mul_le_mul_of_nonneg_right + · exact_mod_cast hMT + · exact Nat.cast_nonneg d + _ ≤ (p : ℝ) ^ (1 / 6 : ℝ) * (d : ℝ) := + mul_le_mul_of_nonneg_right hT.le (Nat.cast_nonneg d) + _ < (p : ℝ) ^ (1 / 6 : ℝ) * (p : ℝ) ^ (5 / 6 : ℝ) := + mul_lt_mul_of_pos_left hd (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) := hLinearPower + exact_mod_cast hLinearReal + +/-- Coarse all-divisor specialization: the linear branch is automatic for +any `M` bounded by the simultaneous divisor count. -/ +theorem preliminary_twentyFour_mul_mul_lt_of_coarseBound + {p M d : ℕ} + (hp : 24 ^ 15 * 2 ^ 687 < p) + (hM : + M ≤ (p - 1).divisors.card + (p + 1).divisors.card) + (hd : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ)) : + 24 * M * d < p := by + have hpPos : 0 < p := by + have hcoefficientPos : 0 < 24 ^ 15 * 2 ^ 687 := by positivity + omega + exact + twentyFour_mul_mul_lt_of_le_of_lt_fiveSixths hpPos + (preliminary_twentyFour_mul_divisorSum_lt_rpow_one_div_six_of_coarseBound hp) + hM hd + +/-- In particular, the maximal-divisor coefficient in the Euler-seven +frontier satisfies the linear branch automatically above the coarse tail. -/ +theorem maximalDivisorCountSum_linear_lt_of_coarseBound + {p d : ℕ} + (hp : 24 ^ 15 * 2 ^ 687 < p) + (hd : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ)) : + 24 * maximalDivisorCountSum p (d + 1) * d < p := by + apply preliminary_twentyFour_mul_mul_lt_of_coarseBound hp + · unfold maximalDivisorCountSum + exact Nat.add_le_add + (maximalDivisorsBelow_card_le_card_divisors (p - 1) (d + 1)) + (maximalDivisorsBelow_card_le_card_divisors (p + 1) (d + 1)) + · exact hd + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean new file mode 100644 index 0000000000..9ec0fd1cbf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics +import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound + +/-! +# Certificate-free coarse-support surjectivity + +The Euler-seven complement argument reduces the last global obstruction to +`35721 * S^4 < 8 * p`. Taking `S` to be the square of the simultaneous +divisor count and combining this obstruction with the elementary tenth moment +gives an unconditional cutoff without a divisor table. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- The exact open cutoff supplied by the Euler-seven obstruction and the +joint tenth moment for the two neighboring divisor counts. -/ +def coarseSupportStrongApproximationOpenCutoff : ℕ := + 35721 ^ 5 * 2 ^ 1701 * 262145 ^ 4 + +/-- Closed version of `coarseSupportStrongApproximationOpenCutoff`. -/ +def coarseSupportStrongApproximationCutoff : ℕ := + coarseSupportStrongApproximationOpenCutoff + 1 + +private theorem twoPow756_lt_coarseSupportStrongApproximationOpenCutoff : + 2 ^ 756 < coarseSupportStrongApproximationOpenCutoff := by + calc + 2 ^ 756 < 2 ^ 1701 := + Nat.pow_lt_pow_right (by norm_num) (by norm_num) + _ = 1 * 2 ^ 1701 * 1 := by ring + _ ≤ 35721 ^ 5 * 2 ^ 1701 * 262145 ^ 4 := by + gcongr <;> norm_num + +/-- The joint tenth moment rules out the final Euler-seven obstruction above +the exact coarse-support cutoff. -/ +theorem preliminary_35721_mul_divisorSum_pow_eight_lt + {p : ℕ} (hpOdd : Odd p) + (hp : coarseSupportStrongApproximationOpenCutoff < p) : + 35721 * ((p - 1).divisors.card + (p + 1).divisors.card) ^ 8 < 8 * p := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let D := neighboringDivisorSumMomentConstant + have hpPos : 0 < p := (Nat.zero_le _).trans_lt hp + have hpSupport : 2 ^ 756 < p := + twoPow756_lt_coarseSupportStrongApproximationOpenCutoff.trans hp + have hpLarge : 794039 ≤ p := by + have hsmall : 794039 < 2 ^ 20 := by norm_num + have hpowers : 2 ^ 20 ≤ 2 ^ 756 := + Nat.pow_le_pow_right (by norm_num) (by norm_num) + omega + have hmoment : T ^ 10 ≤ D * p := by + simpa [T, D] using + card_divisors_pred_add_card_divisors_succ_pow_ten_le hpOdd hpLarge + by_contra hnot + have hbad : 8 * p ≤ 35721 * T ^ 8 := by + exact Nat.le_of_not_gt (by simpa [T] using hnot) + have hbadPow : (8 * p) ^ 5 ≤ (35721 * T ^ 8) ^ 5 := + Nat.pow_le_pow_left hbad 5 + have hmomentPow : (T ^ 10) ^ 4 ≤ (D * p) ^ 4 := + Nat.pow_le_pow_left hmoment 4 + have hcombined : + 2 ^ 15 * p ^ 5 ≤ 35721 ^ 5 * D ^ 4 * p ^ 4 := by + calc + 2 ^ 15 * p ^ 5 = (8 * p) ^ 5 := by ring + _ ≤ (35721 * T ^ 8) ^ 5 := hbadPow + _ = 35721 ^ 5 * (T ^ 10) ^ 4 := by ring + _ ≤ 35721 ^ 5 * (D * p) ^ 4 := + Nat.mul_le_mul_left _ hmomentPow + _ = 35721 ^ 5 * D ^ 4 * p ^ 4 := by ring + have hcombined' : + (2 ^ 15 * p) * p ^ 4 ≤ + (35721 ^ 5 * D ^ 4) * p ^ 4 := by + simpa only [show p ^ 5 = p * p ^ 4 by ring, Nat.mul_assoc] using hcombined + have hcancel : 2 ^ 15 * p ≤ 35721 ^ 5 * D ^ 4 := + Nat.le_of_mul_le_mul_right hcombined' (pow_pos hpPos 4) + have hfactor : + 35721 ^ 5 * D ^ 4 = + 2 ^ 15 * coarseSupportStrongApproximationOpenCutoff := by + have hD : D = 2 ^ 429 * 262145 := by + exact neighboringDivisorSumMomentConstant_eq + rw [hD] + rw [mul_pow] + rw [show (2 ^ 429) ^ 4 = 2 ^ 1716 by + rw [show (1716 : ℕ) = 429 * 4 by norm_num, pow_mul]] + rw [show (1716 : ℕ) = 15 + 1701 by norm_num, pow_add] + unfold coarseSupportStrongApproximationOpenCutoff + ring + have hcutoffUpper : p ≤ coarseSupportStrongApproximationOpenCutoff := by + rw [hfactor] at hcancel + have hcancel' : + p * 2 ^ 15 ≤ coarseSupportStrongApproximationOpenCutoff * 2 ^ 15 := by + simpa only [Nat.mul_comm] using hcancel + exact Nat.le_of_mul_le_mul_right hcancel' (pow_pos (by norm_num) 15) + exact (Nat.not_le_of_lt hp) hcutoffUpper + +/-- Every joint maximal-divisor square count is bounded by the square of the +simultaneous all-divisor count. -/ +theorem maximalDivisorCountSum_sq_le_divisorSum_sq + (p d : ℕ) : + maximalDivisorCountSum p (d + 1) ^ 2 ≤ + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 2 := by + apply Nat.pow_le_pow_left + unfold maximalDivisorCountSum + exact Nat.add_le_add + (maximalDivisorsBelow_card_le_card_divisors (p - 1) (d + 1)) + (maximalDivisorsBelow_card_le_card_divisors (p + 1) (d + 1)) + +/-- The exact cutoff dominates the support-only threshold required by the +coarse endgame and cage arguments. -/ +theorem twoPow756_lt_of_coarseSupportOpenCutoff_lt + {p : ℕ} (hp : coarseSupportStrongApproximationOpenCutoff < p) : + 2 ^ 756 < p := by + exact twoPow756_lt_coarseSupportStrongApproximationOpenCutoff.trans hp + +/-- Natural Markoff reduction is surjective above the exact certificate-free +coarse-support cutoff. -/ +theorem markoffReduction_surjective_of_coarseSupportOpenCutoff + (p : ℕ) (hpPrime : p.Prime) + (hp : coarseSupportStrongApproximationOpenCutoff < p) : + Function.Surjective (markoffReduction p) := by + letI : Fact p.Prime := ⟨hpPrime⟩ + have hpThree : 3 < p := by + have hsupport := twoPow756_lt_of_coarseSupportOpenCutoff_lt hp + omega + have hpOdd : Odd p := + hpPrime.odd_of_ne_two (by omega) + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero + (natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hpThree) + let T := (p - 1).divisors.card + (p + 1).divisors.card + apply markoffReduction_surjective_of_eulerSevenSquareEnvelope_coarseSupport + p (twoPow756_lt_of_coarseSupportOpenCutoff_lt hp) (fun _ ↦ T ^ 2) + · intro d + simpa [T] using maximalDivisorCountSum_sq_le_divisorSum_sq p d + · intro d + calc + 35721 * (T ^ 2) ^ 4 = 35721 * T ^ 8 := by ring + _ < 8 * p := by + simpa [T] using + preliminary_35721_mul_divisorSum_pow_eight_lt hpOdd hp + +/-- Closed-cutoff form used by the public Comparator theorem. -/ +theorem markoffReduction_surjective_of_coarseSupportBound + (p : ℕ) (hpPrime : p.Prime) + (hp : coarseSupportStrongApproximationCutoff ≤ p) : + Function.Surjective (markoffReduction p) := by + apply markoffReduction_surjective_of_coarseSupportOpenCutoff p hpPrime + simpa [coarseSupportStrongApproximationCutoff] using hp + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean new file mode 100644 index 0000000000..551b5fa03c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean @@ -0,0 +1,415 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame + +/-! +# Coarse support tails below the paper scale + +The single clean threshold `2^756 < p`, together with the simultaneous +tenth-moment divisor estimate, discharges the non-cubic middle-game, +primitive-endgame, cage, and split-sign support inequalities. +-/ + + +namespace BGS.Markoff + +open BGS.NumberTheory + +theorem twentyFour_support_margin : + 24 ^ 15 * 2 ^ 687 < 2 ^ 756 := by + have hbase : 24 ^ 5 < 2 ^ 23 := by norm_num + calc + 24 ^ 15 * 2 ^ 687 = (24 ^ 5) ^ 3 * 2 ^ 687 := by ring + _ < (2 ^ 23) ^ 3 * 2 ^ 687 := + Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) + (pow_pos (by norm_num) 687) + _ = 2 ^ 756 := by + rw [← pow_mul, ← pow_add] + +theorem sixtyEight_support_margin : + 68 ^ 15 * 2 ^ 1374 < 2 ^ 1512 := by + have hbase : 68 < 2 ^ 7 := by norm_num + calc + 68 ^ 15 * 2 ^ 1374 < (2 ^ 7) ^ 15 * 2 ^ 1374 := + Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) + (pow_pos (by norm_num) 1374) + _ = 2 ^ 1479 := by + rw [← pow_mul, ← pow_add] + _ = 2 ^ 1479 * 1 := by simp + _ < 2 ^ 1479 * 2 ^ 33 := + Nat.mul_lt_mul_of_pos_left (by norm_num) (pow_pos (by norm_num) 1479) + _ = 2 ^ 1512 := by rw [← pow_add] + +theorem cageCoefficient_support_margin : + 100522 ^ 10 * 2 ^ 916 < 2 ^ 2268 := by + have hbase : 100522 < 2 ^ 17 := by norm_num + calc + 100522 ^ 10 * 2 ^ 916 < (2 ^ 17) ^ 10 * 2 ^ 916 := + Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) + (pow_pos (by norm_num) 916) + _ = 2 ^ 1086 := by + rw [← pow_mul, ← pow_add] + _ = 2 ^ 1086 * 1 := by simp + _ < 2 ^ 1086 * 2 ^ 1182 := + Nat.mul_lt_mul_of_pos_left (by norm_num) (pow_pos (by norm_num) 1086) + _ = 2 ^ 2268 := by rw [← pow_add] + +theorem seven_le_of_twoPow756_lt + {p : ℕ} (hp : 2 ^ 756 < p) : + 7 ≤ p := by + have hseven : 7 < 2 ^ 756 := by + calc + 7 < 2 ^ 3 := by norm_num + _ ≤ 2 ^ 756 := + Nat.pow_le_pow_right (by norm_num) (by norm_num) + omega + +/-- The linear-tail theorem at the unified clean support cutoff. -/ +theorem twentyFour_mul_lt_rpow_one_div_six_of_twoPow756 + {p T : ℕ} + (hp : 2 ^ 756 < p) + (hmoment : T ^ 10 ≤ 2 ^ 458 * p) : + ((24 * T : ℕ) : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) := + twentyFour_mul_lt_rpow_one_div_six_of_tenthMoment + (twentyFour_support_margin.trans hp) hmoment + +/-- The weighted primitive-endgame divisor term is below `p^(1/3)`. -/ +theorem sixtyEight_mul_square_lt_rpow_one_div_three_of_tenthMoment + {p T : ℕ} + (hpCoefficient : 68 ^ 15 * 2 ^ 1374 < p ^ 2) + (hmoment : T ^ 10 ≤ 2 ^ 458 * p) : + ((68 * T ^ 2 : ℕ) : ℝ) < (p : ℝ) ^ (1 / 3 : ℝ) := by + let Q : ℕ := 68 ^ 15 * 2 ^ 1374 + have hQ : Q < p ^ 2 := by + simpa [Q] using hpCoefficient + have hpPos : 0 < p := by + by_contra hpNot + have hpZero : p = 0 := Nat.eq_zero_of_not_pos hpNot + subst p + simp [Q] at hQ + have h68 : (68 ^ 15) ^ 2 = 68 ^ 30 := by + rw [← pow_mul] + have hTwoLeft : (2 ^ 458) ^ 6 = 2 ^ 2748 := by + rw [← pow_mul] + have hTwoRight : (2 ^ 1374) ^ 2 = 2 ^ 2748 := by + rw [← pow_mul] + have hpowNat : (68 * T ^ 2) ^ 30 < p ^ 10 := by + calc + (68 * T ^ 2) ^ 30 = 68 ^ 30 * (T ^ 10) ^ 6 := by ring + _ ≤ 68 ^ 30 * (2 ^ 458 * p) ^ 6 := by gcongr + _ = (68 ^ 30 * (2 ^ 458) ^ 6) * p ^ 6 := by + rw [mul_pow] + ring + _ = ((68 ^ 15) ^ 2 * (2 ^ 1374) ^ 2) * p ^ 6 := by + rw [h68, hTwoLeft, hTwoRight] + _ = Q ^ 2 * p ^ 6 := by + simp only [Q, mul_pow] + _ < (p ^ 2) ^ 2 * p ^ 6 := + Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hQ (Nat.zero_le Q) (by norm_num)) + (pow_pos hpPos 6) + _ = p ^ 10 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((68 * T ^ 2 : ℕ) : ℝ) ^ 30 < + (p : ℝ) ^ 10 := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 3 : ℝ)) ^ 30 = (p : ℝ) ^ 10 := by + calc + ((p : ℝ) ^ (1 / 3 : ℝ)) ^ 30 = + (p : ℝ) ^ ((1 / 3 : ℝ) * 30) := + (Real.rpow_mul_natCast hpNonnegative (1 / 3 : ℝ) 30).symm + _ = (p : ℝ) ^ 10 := by norm_num + apply lt_of_pow_lt_pow_left₀ 30 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +theorem preliminary_sixtyEight_mul_divisorSum_sq_lt_rpow_one_div_three_of_twoPow756 + {p : ℕ} (hp : 2 ^ 756 < p) : + ((68 * ((p - 1).divisors.card + (p + 1).divisors.card) ^ 2 : ℕ) : ℝ) < + (p : ℝ) ^ (1 / 3 : ℝ) := by + apply sixtyEight_mul_square_lt_rpow_one_div_three_of_tenthMoment + · calc + 68 ^ 15 * 2 ^ 1374 < 2 ^ 1512 := + sixtyEight_support_margin + _ = (2 ^ 756) ^ 2 := by rw [← pow_mul] + _ < p ^ 2 := + pow_lt_pow_left₀ hp (Nat.zero_le _) (by norm_num) + · have hpTwo : 2 ≤ p := by + have := seven_le_of_twoPow756_lt hp + omega + calc + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 10 ≤ + 2 ^ 457 * p := by + simpa [preliminaryDivisorMomentConstant] using + preliminary_divisor_sum_pow_ten_le hpTwo + _ ≤ 2 ^ 458 * p := by + apply Nat.mul_le_mul_right + calc + 2 ^ 457 = 2 ^ 457 * 1 := by simp + _ ≤ 2 ^ 457 * 2 := Nat.mul_le_mul_left _ (by norm_num) + _ = 2 ^ (457 + 1) := (pow_succ 2 457).symm + _ = 2 ^ 458 := by norm_num + +/-- The cage coefficient times the squared divisor sum is below `sqrt p`. -/ +theorem cageCoefficient_mul_square_lt_sqrt_of_tenthMoment + {p T : ℕ} + (hpCoefficient : 100522 ^ 10 * 2 ^ 916 < p ^ 3) + (hmoment : T ^ 10 ≤ 2 ^ 458 * p) : + ((100522 * T ^ 2 : ℕ) : ℝ) < Real.sqrt (p : ℝ) := by + let Q : ℕ := 100522 ^ 10 * 2 ^ 916 + have hQ : Q < p ^ 3 := by + simpa [Q] using hpCoefficient + have hpPos : 0 < p := by + by_contra hpNot + have hpZero : p = 0 := Nat.eq_zero_of_not_pos hpNot + subst p + simp [Q] at hQ + have hTwo : (2 ^ 458) ^ 2 = 2 ^ 916 := by + rw [← pow_mul] + have hpowNat : (100522 * T ^ 2) ^ 10 < p ^ 5 := by + calc + (100522 * T ^ 2) ^ 10 = + 100522 ^ 10 * (T ^ 10) ^ 2 := by ring + _ ≤ 100522 ^ 10 * (2 ^ 458 * p) ^ 2 := by gcongr + _ = (100522 ^ 10 * (2 ^ 458) ^ 2) * p ^ 2 := by + rw [mul_pow] + ring + _ = Q * p ^ 2 := by rw [hTwo] + _ < p ^ 3 * p ^ 2 := + Nat.mul_lt_mul_of_pos_right hQ (pow_pos hpPos 2) + _ = p ^ 5 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((100522 * T ^ 2 : ℕ) : ℝ) ^ 10 < + (p : ℝ) ^ 5 := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 2 : ℝ)) ^ 10 = (p : ℝ) ^ 5 := by + calc + ((p : ℝ) ^ (1 / 2 : ℝ)) ^ 10 = + (p : ℝ) ^ ((1 / 2 : ℝ) * 10) := + (Real.rpow_mul_natCast hpNonnegative (1 / 2 : ℝ) 10).symm + _ = (p : ℝ) ^ 5 := by norm_num + rw [Real.sqrt_eq_rpow] + apply lt_of_pow_lt_pow_left₀ 10 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +theorem preliminary_cageCoefficient_mul_divisorSum_sq_lt_sqrt_of_twoPow756 + {p : ℕ} (hp : 2 ^ 756 < p) : + ((100522 * + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 2 : ℕ) : ℝ) < + Real.sqrt (p : ℝ) := by + apply cageCoefficient_mul_square_lt_sqrt_of_tenthMoment + · calc + 100522 ^ 10 * 2 ^ 916 < 2 ^ 2268 := + cageCoefficient_support_margin + _ = (2 ^ 756) ^ 3 := by rw [← pow_mul] + _ < p ^ 3 := + pow_lt_pow_left₀ hp (Nat.zero_le _) (by norm_num) + · have hpTwo : 2 ≤ p := by + have := seven_le_of_twoPow756_lt hp + omega + calc + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 10 ≤ + 2 ^ 457 * p := by + simpa [preliminaryDivisorMomentConstant] using + preliminary_divisor_sum_pow_ten_le hpTwo + _ ≤ 2 ^ 458 * p := by + apply Nat.mul_le_mul_right + calc + 2 ^ 457 = 2 ^ 457 * 1 := by simp + _ ≤ 2 ^ 457 * 2 := Nat.mul_le_mul_left _ (by norm_num) + _ = 2 ^ (457 + 1) := (pow_succ 2 457).symm + _ = 2 ^ 458 := by norm_num + +/-- Primitive trace inclusion--exclusion above the unified support cutoff. -/ +theorem coarse_endgamePrimitiveTrace_explicitInequality + {p orbitExponent coefficient : ℕ} + (hp : 2 ^ 756 < p) + (horbit : (orbitExponent : ℝ) ≤ + 2 * (p : ℝ) ^ (1 / 6 : ℝ)) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpRealPos : (0 : ℝ) < p := by + exact_mod_cast (Nat.zero_lt_of_lt hp) + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ (T : ℝ) := by + exact_mod_cast (show (p - 1).divisors.card ≤ T by + dsimp [T] + omega) + have hweighted : (68 : ℝ) * (T : ℝ) ^ 2 < + (p : ℝ) ^ (1 / 3 : ℝ) := by + simpa [T] using + preliminary_sixtyEight_mul_divisorSum_sq_lt_rpow_one_div_three_of_twoPow756 hp + calc + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + (2 * (p : ℝ) ^ (1 / 6 : ℝ)) * (T : ℝ) ^ 2 * + (34 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = (68 * (T : ℝ) ^ 2) * + ((p : ℝ) ^ (1 / 6 : ℝ) * Real.sqrt (p : ℝ)) := by ring + _ < (p : ℝ) ^ (1 / 3 : ℝ) * + ((p : ℝ) ^ (1 / 6 : ℝ) * Real.sqrt (p : ℝ)) := by + exact mul_lt_mul_of_pos_right hweighted <| + mul_pos (Real.rpow_pos_of_pos hpRealPos _) (Real.sqrt_pos.2 hpRealPos) + _ = (p : ℝ) := by + rw [Real.sqrt_eq_rpow, ← Real.rpow_add hpRealPos, + ← Real.rpow_add hpRealPos] + norm_num + +theorem coarse_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : 2 ^ 756 < p) + (hmul : orbitExponent * orbitOrder = p - 1) + (horder : (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply coarse_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := Nat.zero_lt_of_lt hp + have horbit := orbitExponent_le_rpow_of_mul_order_eq_card_sub_one + p orbitExponent orbitOrder (δ := (1 / 3 : ℝ)) hpNat hmul (by + convert horder using 1 <;> norm_num) + calc + (orbitExponent : ℝ) ≤ (p : ℝ) ^ (1 / 6 : ℝ) := by + convert horbit using 1 <;> norm_num + _ ≤ 2 * (p : ℝ) ^ (1 / 6 : ℝ) := by + nlinarith [Real.rpow_nonneg (Nat.cast_nonneg p) (1 / 6 : ℝ)] + +theorem coarse_endgamePrimitiveTrace_explicitInequality_of_card_add_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : 2 ^ 756 < p) + (hmul : orbitExponent * orbitOrder = p + 1) + (horder : (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply coarse_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := Nat.zero_lt_of_lt hp + have horbit := orbitExponent_le_two_mul_rpow_of_mul_order_eq_card_add_one + p orbitExponent orbitOrder (δ := (1 / 3 : ℝ)) hpNat hmul (by + convert horder using 1 <;> norm_num) + convert horbit using 1 <;> norm_num + +theorem coarse_four_lt_rpow_five_div_six + {p : ℕ} (hp : 2 ^ 756 < p) : + (4 : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + have hpPos : 0 < p := Nat.zero_lt_of_lt hp + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast hpPos + have hpSeven : 7 ≤ p := seven_le_of_twoPow756_lt hp + have hpOneNat : 1 < p := by omega + have hpOne : (1 : ℝ) < p := by exact_mod_cast hpOneNat + have hpowNat : 4 ^ 6 < p := by + calc + 4 ^ 6 < 2 ^ 756 := by + calc + 4 ^ 6 = 2 ^ 12 := by norm_num + _ < 2 ^ 756 := + Nat.pow_lt_pow_right (by norm_num) (by norm_num) + _ < p := hp + have hpowReal : (4 : ℝ) ^ 6 < (p : ℝ) := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 6 = (p : ℝ) := by + calc + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 6 = + (p : ℝ) ^ ((1 / 6 : ℝ) * 6) := + (Real.rpow_mul_natCast hpRealPos.le (1 / 6 : ℝ) 6).symm + _ = (p : ℝ) := by norm_num + have hfour : (4 : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) := by + apply lt_of_pow_lt_pow_left₀ 6 (Real.rpow_nonneg hpRealPos.le _) + rw [hrootPow] + exact hpowReal + exact hfour.trans + (Real.rpow_lt_rpow_of_exponent_lt hpOne (by norm_num)) + +/-- Cage connectivity inequality above the unified support cutoff. -/ +theorem coarse_cageWitness_explicitInequality + {p coefficient : ℕ} (hp : 2 ^ 756 < p) + (hcoefficient : coefficient ≤ 100522) : + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpRealPos : (0 : ℝ) < p := by + exact_mod_cast (Nat.zero_lt_of_lt hp) + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ (T : ℝ) := by + exact_mod_cast (show (p - 1).divisors.card ≤ T by + dsimp [T] + omega) + have hcage : (100522 : ℝ) * (T : ℝ) ^ 2 < + Real.sqrt (p : ℝ) := by + simpa [T] using + preliminary_cageCoefficient_mul_divisorSum_sq_lt_sqrt_of_twoPow756 hp + calc + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + (T : ℝ) ^ 2 * (100522 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = (100522 * (T : ℝ) ^ 2) * Real.sqrt (p : ℝ) := by ring + _ < Real.sqrt (p : ℝ) * Real.sqrt (p : ℝ) := + mul_lt_mul_of_pos_right hcage (Real.sqrt_pos.2 hpRealPos) + _ = (p : ℝ) := Real.mul_self_sqrt hpRealPos.le + +/-- The half-order sign threshold is automatic above `2^756`. -/ +theorem coarse_halfOrderThreshold + {p : ℕ} (hp : 2 ^ 756 < p) : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ) := by + have hpPos : 0 < p := Nat.zero_lt_of_lt hp + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast hpPos + have hthreePowNat : 3 ^ 6 < p := by + calc + 3 ^ 6 < 2 ^ 756 := by + calc + 3 ^ 6 < 2 ^ 12 := by norm_num + _ < 2 ^ 756 := + Nat.pow_lt_pow_right (by norm_num) (by norm_num) + _ < p := hp + have hthreePowReal : (3 : ℝ) ^ 6 < (p : ℝ) := by + exact_mod_cast hthreePowNat + have hrootPow : + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 6 = (p : ℝ) := by + calc + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 6 = + (p : ℝ) ^ ((1 / 6 : ℝ) * 6) := + (Real.rpow_mul_natCast hpRealPos.le (1 / 6 : ℝ) 6).symm + _ = (p : ℝ) := by norm_num + have hthree : (3 : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) := by + apply lt_of_pow_lt_pow_left₀ 6 (Real.rpow_nonneg hpRealPos.le _) + rw [hrootPow] + exact hthreePowReal + have hproduct : + 3 * (p : ℝ) ^ (5 / 6 : ℝ) < p := by + calc + 3 * (p : ℝ) ^ (5 / 6 : ℝ) < + (p : ℝ) ^ (1 / 6 : ℝ) * (p : ℝ) ^ (5 / 6 : ℝ) := + mul_lt_mul_of_pos_right hthree + (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) := by + rw [← Real.rpow_add hpRealPos] + norm_num + have hthird : + (p : ℝ) ^ (5 / 6 : ℝ) < (p : ℝ) / 3 := by + linarith + have hpSeven : 7 ≤ p := seven_le_of_twoPow756_lt hp + have hNat : p ≤ 3 * ((p - 1) / 2) := by omega + have hthirdLe : + (p : ℝ) / 3 ≤ (((p - 1) / 2 : ℕ) : ℝ) := by + have hcast : (p : ℝ) ≤ 3 * (((p - 1) / 2 : ℕ) : ℝ) := by + exact_mod_cast hNat + linarith + exact hthird.le.trans hthirdLe + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean new file mode 100644 index 0000000000..4827dfc987 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility + +/-! +# From a giant divisible orbit to transitivity + +The published version observes that a giant orbit with complement smaller than `p` is the whole +punctured Markoff surface if every orbit cardinality is divisible by `p`. This module proves that +finite-orbit argument and combines it with Chen's component-divisibility theorem, using Martin's +later elementary proof. +-/ + +namespace BGS.Markoff + +/-- If one orbit has complement smaller than `p` and every orbit cardinality is divisible by `p`, +then the action is transitive. -/ +theorem puncturedMarkoffTransitiveAt_of_small_orbitComplement_and_orbitCard_dvd + (p : ℕ) [Fact p.Prime] + (x : PuncturedMarkoffSurface (ZMod p)) + (hsmall : orbitComplementCard x < p) + (hdiv : ∀ y : PuncturedMarkoffSurface (ZMod p), + p ∣ (puncturedGammaOrbit y).ncard) : + PuncturedMarkoffTransitiveAt p Fact.out := by + intro a b + have hxAll : ∀ y : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent x y := by + intro y + by_contra hy + have horbitSubset : puncturedGammaOrbit y ⊆ Set.univ \ puncturedGammaOrbit x := by + intro z hz + refine ⟨Set.mem_univ z, ?_⟩ + intro hzx + apply hy + exact samePuncturedComponent_trans hzx (samePuncturedComponent_symm hz) + have horbitPos : 0 < (puncturedGammaOrbit y).ncard := + (Set.ncard_pos (Set.toFinite _)).2 ⟨y, samePuncturedComponent_refl y⟩ + have hpLeOrbit : p ≤ (puncturedGammaOrbit y).ncard := + Nat.le_of_dvd horbitPos (hdiv y) + have horbitLeComplement : + (puncturedGammaOrbit y).ncard ≤ orbitComplementCard x := by + rw [orbitComplementCard] + exact Set.ncard_le_ncard horbitSubset + omega + obtain ⟨ga, hga⟩ := (samePuncturedComponent_iff_exists x a).1 (hxAll a) + obtain ⟨gb, hgb⟩ := (samePuncturedComponent_iff_exists x b).1 (hxAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • x := by rw [← hga]; simp + _ = b := hgb + +/-- A `p^epsilon` giant-orbit bound with `epsilon < 1` has complement strictly smaller than `p`. -/ +theorem exists_orbitComplementCard_lt_prime_of_hasGiantOrbitAt + (p : ℕ) (hp : p.Prime) (epsilon : ℝ) (hepsilon : epsilon < 1) + (hgiant : HasGiantOrbitAt p hp epsilon) : + letI : Fact p.Prime := ⟨hp⟩ + ∃ x : PuncturedMarkoffSurface (ZMod p), orbitComplementCard x < p := by + letI : Fact p.Prime := ⟨hp⟩ + obtain ⟨x, hx⟩ := hgiant + refine ⟨x, ?_⟩ + have hpReal : (1 : ℝ) < (p : ℝ) := by exact_mod_cast hp.one_lt + have hrpow : (p : ℝ) ^ epsilon < (p : ℝ) := by + simpa only [Real.rpow_one] using + Real.rpow_lt_rpow_of_exponent_lt hpReal hepsilon + have hreal : (orbitComplementCard x : ℝ) < (p : ℝ) := hx.trans_lt hrpow + exact_mod_cast hreal + +/-- The published short route from a giant orbit and orbit-cardinality divisibility to +punctured finite-field transitivity at the given prime. -/ +theorem puncturedMarkoffTransitiveAt_of_hasGiantOrbitAt_and_orbitCard_dvd + (p : ℕ) (hp : p.Prime) (epsilon : ℝ) (hepsilon : epsilon < 1) + (hgiant : HasGiantOrbitAt p hp epsilon) + (hdiv : letI : Fact p.Prime := ⟨hp⟩ + ∀ y : PuncturedMarkoffSurface (ZMod p), + p ∣ (puncturedGammaOrbit y).ncard) : + PuncturedMarkoffTransitiveAt p hp := by + letI : Fact p.Prime := ⟨hp⟩ + obtain ⟨x, hx⟩ := + exists_orbitComplementCard_lt_prime_of_hasGiantOrbitAt + p hp epsilon hepsilon hgiant + exact puncturedMarkoffTransitiveAt_of_small_orbitComplement_and_orbitCard_dvd p x hx hdiv + +/-- Eventual giant-orbit control with any fixed exponent below one, combined with orbit +divisibility for primes larger than three, gives eventual punctured finite-field transitivity. -/ +theorem eventually_puncturedMarkoffTransitiveAt_of_giantOrbit_and_orbitCard_dvd + (epsilon : ℝ) (hepsilon : epsilon < 1) + (hgiant : ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → + HasGiantOrbitAt p hp epsilon) + (hdiv : ∀ (p : ℕ) (hp : p.Prime), 3 < p → + letI : Fact p.Prime := ⟨hp⟩ + ∀ y : PuncturedMarkoffSurface (ZMod p), + p ∣ (puncturedGammaOrbit y).ncard) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → + PuncturedMarkoffTransitiveAt p hp := by + obtain ⟨p0, hp0⟩ := hgiant + refine ⟨max p0 4, fun p hp hple => ?_⟩ + have hp0le : p0 ≤ p := (Nat.le_max_left p0 4).trans hple + have hpThree : 3 < p := by omega + exact puncturedMarkoffTransitiveAt_of_hasGiantOrbitAt_and_orbitCard_dvd + p hp epsilon hepsilon (hp0 p hp hp0le) (hdiv p hp hpThree) + +/-- Chen's component-divisibility theorem, through Martin's elementary proof, turns any eventual +giant-orbit estimate with exponent below one into eventual punctured finite-field transitivity. -/ +theorem eventually_puncturedMarkoffTransitiveAt_of_giantOrbit + (epsilon : ℝ) (hepsilon : epsilon < 1) + (hgiant : ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → + HasGiantOrbitAt p hp epsilon) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → + PuncturedMarkoffTransitiveAt p hp := by + apply eventually_puncturedMarkoffTransitiveAt_of_giantOrbit_and_orbitCard_dvd + epsilon hepsilon hgiant + intro p hp hpThree + letI : Fact p.Prime := ⟨hp⟩ + intro y + exact prime_dvd_puncturedGammaOrbit_ncard p hpThree y + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean new file mode 100644 index 0000000000..0dcb7a080d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean @@ -0,0 +1,365 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +import Mathlib.GroupTheory.SpecificGroups.Cyclic + +/-! +# Elementary counts for the giant-orbit assembly + +This file isolates the two elementary finite counts omitted from the paper's final assembly: + +* fixing the first two coordinates of a Markoff point leaves at most two choices for the third; +* traces coming from elements of bounded order in a finite cyclic group have a deliberately crude + quadratic cardinality bound. + +The cyclicity hypothesis in the second count is essential: the analogous statement for arbitrary +finite groups is false (an elementary abelian `2`-group can have more than two elements of order +two). The split and norm-one tori to which this count will eventually be applied are cyclic. +-/ + +namespace BGS.Markoff + +open Polynomial + +section ThirdCoordinateFiber + +variable {F : Type*} [Field F] + +/-- The monic quadratic obtained from the Markoff equation after fixing its first two +coordinates. -/ +noncomputable def thirdCoordinatePolynomial (a b : F) : F[X] := + X ^ 2 - C (3 * a * b) * X + C (a ^ 2 + b ^ 2) + +@[simp] +theorem thirdCoordinatePolynomial_eval (a b c : F) : + (thirdCoordinatePolynomial a b).eval c = markoffPolynomial ⟨a, b, c⟩ := by + simp [thirdCoordinatePolynomial, markoffPolynomial] + ring + +theorem thirdCoordinatePolynomial_monic (a b : F) : + (thirdCoordinatePolynomial a b).Monic := by + exact (isMonicOfDegree_sub_add_two (3 * a * b) (a ^ 2 + b ^ 2)).monic + +@[simp] +theorem thirdCoordinatePolynomial_natDegree (a b : F) : + (thirdCoordinatePolynomial a b).natDegree = 2 := by + exact (isMonicOfDegree_sub_add_two (3 * a * b) (a ^ 2 + b ^ 2)).natDegree_eq + +variable [Fintype F] + +/-- The possible third coordinates of Markoff points whose first two coordinates are `a,b`. -/ +noncomputable def thirdCoordinatesOnMarkoffSurface (a b : F) : Finset F := by + classical + exact Finset.univ.filter fun c => IsMarkoff ⟨a, b, c⟩ + +theorem thirdCoordinatesOnMarkoffSurface_card_le_two (a b : F) : + (thirdCoordinatesOnMarkoffSurface a b).card ≤ 2 := by + classical + let f := thirdCoordinatePolynomial a b + have hf : f ≠ 0 := (thirdCoordinatePolynomial_monic a b).ne_zero + have hsubset : thirdCoordinatesOnMarkoffSurface a b ⊆ f.roots.toFinset := by + intro c hc + rw [thirdCoordinatesOnMarkoffSurface, Finset.mem_filter] at hc + rw [Multiset.mem_toFinset, Polynomial.mem_roots hf] + simpa [f, IsMarkoff] using hc.2 + calc + (thirdCoordinatesOnMarkoffSurface a b).card ≤ f.roots.toFinset.card := + Finset.card_mono hsubset + _ ≤ f.roots.card := Multiset.toFinset_card_le _ + _ ≤ f.natDegree := Polynomial.card_roots' f + _ = 2 := thirdCoordinatePolynomial_natDegree a b + +/-- Markoff-surface points, represented in the project's ambient `Point` type, with prescribed +first and second coordinates. -/ +noncomputable def markoffPointsWithFirstTwoCoordinates (a b : F) : Finset (Point F) := by + classical + exact (thirdCoordinatesOnMarkoffSurface a b).image fun c => ⟨a, b, c⟩ + +theorem mem_markoffPointsWithFirstTwoCoordinates_iff {a b : F} {x : Point F} : + x ∈ markoffPointsWithFirstTwoCoordinates a b ↔ + IsMarkoff x ∧ x.x1 = a ∧ x.x2 = b := by + classical + constructor + · intro hx + obtain ⟨c, hc, rfl⟩ := Finset.mem_image.mp hx + rw [thirdCoordinatesOnMarkoffSurface, Finset.mem_filter] at hc + exact ⟨hc.2, rfl, rfl⟩ + · rintro ⟨hmarkoff, hx1, hx2⟩ + have hpoint : (⟨a, b, x.x3⟩ : Point F) = x := by + ext <;> simp [hx1, hx2] + apply Finset.mem_image.mpr + refine ⟨x.x3, ?_, hpoint⟩ + · rw [thirdCoordinatesOnMarkoffSurface, Finset.mem_filter] + refine ⟨Finset.mem_univ _, ?_⟩ + rw [hpoint] + exact hmarkoff + +theorem markoffPointsWithFirstTwoCoordinates_card_le_two (a b : F) : + (markoffPointsWithFirstTwoCoordinates a b).card ≤ 2 := by + classical + exact Finset.card_image_le.trans (thirdCoordinatesOnMarkoffSurface_card_le_two a b) + +end ThirdCoordinateFiber + +section LowOrderTrace + +variable {G T : Type*} [Group G] [Fintype G] [DecidableEq T] + +/-- Elements of a finite group whose multiplicative order is strictly below `bound`. -/ +noncomputable def elementsOfOrderLessThan + (G : Type*) [Group G] [Fintype G] (bound : ℕ) : Finset G := + Finset.univ.filter fun g => orderOf g < bound + +/-- Values of a trace-like map on group elements whose multiplicative order is below `bound`. -/ +noncomputable def boundedOrderTraceSet (trace : G → T) (bound : ℕ) : Finset T := + (elementsOfOrderLessThan G bound).image trace + +theorem elementsOfOrderLessThan_card_le_sum_range [IsCyclic G] (bound : ℕ) : + (elementsOfOrderLessThan G bound).card ≤ ∑ d ∈ Finset.range bound, d := by + classical + rw [elementsOfOrderLessThan] + rw [Finset.card_eq_sum_card_fiberwise + (t := Finset.range bound) (f := orderOf) (by + intro g hg + exact Finset.mem_range.mpr (Finset.mem_filter.mp hg).2)] + apply Finset.sum_le_sum + intro d hd + rw [Finset.mem_range] at hd + have hfiber : + (Finset.univ.filter fun g : G => orderOf g < bound).filter (fun g => orderOf g = d) = + Finset.univ.filter (fun g : G => orderOf g = d) := by + ext g + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · exact fun h => h.2 + · intro h + exact ⟨h ▸ hd, h⟩ + rw [hfiber] + by_cases hdvd : d ∣ Fintype.card G + · rw [IsCyclic.card_orderOf_eq_totient hdvd] + exact Nat.totient_le d + · have hempty : Finset.univ.filter (fun g : G => orderOf g = d) = ∅ := by + ext g + simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.notMem_empty, + iff_false] + intro horder + apply hdvd + rw [← horder] + exact orderOf_dvd_card + simp [hempty] + +/-- A divisor-sensitive version of the bounded-order count. Only orders dividing the group +cardinality can occur, and each such order contributes fewer than `bound` elements. -/ +theorem elementsOfOrderLessThan_card_le_pred_mul_card_divisors [IsCyclic G] (bound : ℕ) : + (elementsOfOrderLessThan G bound).card ≤ + (bound - 1) * (Fintype.card G).divisors.card := by + classical + have hcard : Fintype.card G ≠ 0 := Fintype.card_ne_zero + rw [elementsOfOrderLessThan] + rw [Finset.card_eq_sum_card_fiberwise + (t := Finset.range bound) (f := orderOf) (by + intro g hg + exact Finset.mem_range.mpr (Finset.mem_filter.mp hg).2)] + calc + (∑ d ∈ Finset.range bound, + ((Finset.univ.filter fun g : G => orderOf g < bound).filter + fun g => orderOf g = d).card) ≤ + ∑ d ∈ Finset.range bound, + if d ∣ Fintype.card G then bound - 1 else 0 := by + apply Finset.sum_le_sum + intro d hd + by_cases hdvd : d ∣ Fintype.card G + · rw [if_pos hdvd] + have hfiber : + (Finset.univ.filter fun g : G => orderOf g < bound).filter + (fun g => orderOf g = d) = + Finset.univ.filter (fun g : G => orderOf g = d) := by + ext g + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · exact fun h => h.2 + · intro h + exact ⟨h ▸ Finset.mem_range.mp hd, h⟩ + rw [hfiber, IsCyclic.card_orderOf_eq_totient hdvd] + exact (Nat.totient_le d).trans (Nat.le_sub_one_of_lt (Finset.mem_range.mp hd)) + · rw [if_neg hdvd] + have hempty : Finset.univ.filter (fun g : G => orderOf g = d) = ∅ := by + ext g + simp only [Finset.mem_filter, Finset.mem_univ, true_and, + Finset.notMem_empty, iff_false] + intro horder + apply hdvd + rw [← horder] + exact orderOf_dvd_card + have hfiber : + (Finset.univ.filter fun g : G => orderOf g < bound).filter + (fun g => orderOf g = d) = ∅ := by + apply Finset.eq_empty_iff_forall_notMem.mpr + intro g hg + have hgOrder := (Finset.mem_filter.mp hg).2 + have : g ∈ Finset.univ.filter (fun g : G => orderOf g = d) := by + simp [hgOrder] + rw [hempty] at this + exact (Finset.notMem_empty g) this + simp [hfiber] + _ = (bound - 1) * ((Finset.range bound).filter + fun d => d ∣ Fintype.card G).card := by + rw [← Finset.sum_filter] + simp [mul_comm] + _ ≤ (bound - 1) * (Fintype.card G).divisors.card := by + gcongr + intro d hd + rw [Finset.mem_filter] at hd + exact Nat.mem_divisors.mpr ⟨hd.2, hcard⟩ + +theorem elementsOfOrderLessThan_card_le_bound_mul_card_divisors [IsCyclic G] (bound : ℕ) : + (elementsOfOrderLessThan G bound).card ≤ + bound * (Fintype.card G).divisors.card := by + exact (elementsOfOrderLessThan_card_le_pred_mul_card_divisors bound).trans <| by + gcongr + omega + +theorem boundedOrderTraceSet_card_le_sum_range [IsCyclic G] + (trace : G → T) (bound : ℕ) : + (boundedOrderTraceSet trace bound).card ≤ ∑ d ∈ Finset.range bound, d := by + exact Finset.card_image_le.trans (elementsOfOrderLessThan_card_le_sum_range bound) + +theorem boundedOrderTraceSet_card_le_bound_mul_card_divisors [IsCyclic G] + (trace : G → T) (bound : ℕ) : + (boundedOrderTraceSet trace bound).card ≤ + bound * (Fintype.card G).divisors.card := by + exact Finset.card_image_le.trans + (elementsOfOrderLessThan_card_le_bound_mul_card_divisors bound) + +theorem boundedOrderTraceSet_card_le_pred_mul_card_divisors [IsCyclic G] + (trace : G → T) (bound : ℕ) : + (boundedOrderTraceSet trace bound).card ≤ + (bound - 1) * (Fintype.card G).divisors.card := by + exact Finset.card_image_le.trans + (elementsOfOrderLessThan_card_le_pred_mul_card_divisors bound) + +theorem sum_orders_below_bound_le_bound_sq (bound : ℕ) : + (∑ d ∈ Finset.range bound, d) ≤ bound ^ 2 := by + calc + (∑ d ∈ Finset.range bound, d) ≤ + ∑ _d ∈ Finset.range bound, bound := by + gcongr with d hd + exact Nat.le_of_lt (Finset.mem_range.mp hd) + _ = bound * bound := by simp + _ = bound ^ 2 := by ring + +theorem boundedOrderTraceSet_card_le_bound_sq [IsCyclic G] + (trace : G → T) (bound : ℕ) : + (boundedOrderTraceSet trace bound).card ≤ bound ^ 2 := + (boundedOrderTraceSet_card_le_sum_range trace bound).trans + (sum_orders_below_bound_le_bound_sq bound) + +/-- The union of bounded-order trace values from the split and norm-one tori, together with a +finite set of exceptional (parabolic) trace values. -/ +noncomputable def lowOrderTraceSet + {Gsplit Gnonsplit T : Type*} + [Group Gsplit] [Fintype Gsplit] [Group Gnonsplit] [Fintype Gnonsplit] [DecidableEq T] + (parabolic : Finset T) (splitTrace : Gsplit → T) (nonsplitTrace : Gnonsplit → T) + (bound : ℕ) : Finset T := + parabolic ∪ boundedOrderTraceSet splitTrace bound ∪ boundedOrderTraceSet nonsplitTrace bound + +theorem lowOrderTraceSet_card_le + {Gsplit Gnonsplit T : Type*} + [Group Gsplit] [Fintype Gsplit] [IsCyclic Gsplit] + [Group Gnonsplit] [Fintype Gnonsplit] [IsCyclic Gnonsplit] + [DecidableEq T] + (parabolic : Finset T) (splitTrace : Gsplit → T) (nonsplitTrace : Gnonsplit → T) + (bound : ℕ) : + (lowOrderTraceSet parabolic splitTrace nonsplitTrace bound).card ≤ + parabolic.card + 2 * ∑ d ∈ Finset.range bound, d := by + unfold lowOrderTraceSet + calc + (parabolic ∪ boundedOrderTraceSet splitTrace bound ∪ + boundedOrderTraceSet nonsplitTrace bound).card ≤ + (parabolic ∪ boundedOrderTraceSet splitTrace bound).card + + (boundedOrderTraceSet nonsplitTrace bound).card := + Finset.card_union_le + (parabolic ∪ boundedOrderTraceSet splitTrace bound) + (boundedOrderTraceSet nonsplitTrace bound) + _ ≤ (parabolic.card + (boundedOrderTraceSet splitTrace bound).card) + + (boundedOrderTraceSet nonsplitTrace bound).card := by + gcongr + exact Finset.card_union_le parabolic (boundedOrderTraceSet splitTrace bound) + _ ≤ (parabolic.card + (∑ d ∈ Finset.range bound, d)) + + (∑ d ∈ Finset.range bound, d) := by + gcongr + · exact boundedOrderTraceSet_card_le_sum_range splitTrace bound + · exact boundedOrderTraceSet_card_le_sum_range nonsplitTrace bound + _ = parabolic.card + 2 * ∑ d ∈ Finset.range bound, d := by omega + +theorem lowOrderTraceSet_card_le_parabolic_add_two_mul_bound_sq + {Gsplit Gnonsplit T : Type*} + [Group Gsplit] [Fintype Gsplit] [IsCyclic Gsplit] + [Group Gnonsplit] [Fintype Gnonsplit] [IsCyclic Gnonsplit] + [DecidableEq T] + (parabolic : Finset T) (splitTrace : Gsplit → T) (nonsplitTrace : Gnonsplit → T) + (bound : ℕ) : + (lowOrderTraceSet parabolic splitTrace nonsplitTrace bound).card ≤ + parabolic.card + 2 * bound ^ 2 := by + exact (lowOrderTraceSet_card_le parabolic splitTrace nonsplitTrace bound).trans <| by + gcongr + exact sum_orders_below_bound_le_bound_sq bound + +/-- A divisor-sensitive count for the union of the two bounded-order trace sets. -/ +theorem lowOrderTraceSet_card_le_parabolic_add_pred_mul_divisor_cards + {Gsplit Gnonsplit T : Type*} + [Group Gsplit] [Fintype Gsplit] [IsCyclic Gsplit] + [Group Gnonsplit] [Fintype Gnonsplit] [IsCyclic Gnonsplit] + [DecidableEq T] + (parabolic : Finset T) (splitTrace : Gsplit → T) (nonsplitTrace : Gnonsplit → T) + (bound : ℕ) : + (lowOrderTraceSet parabolic splitTrace nonsplitTrace bound).card ≤ + parabolic.card + (bound - 1) * + ((Fintype.card Gsplit).divisors.card + (Fintype.card Gnonsplit).divisors.card) := by + unfold lowOrderTraceSet + calc + (parabolic ∪ boundedOrderTraceSet splitTrace bound ∪ + boundedOrderTraceSet nonsplitTrace bound).card ≤ + (parabolic ∪ boundedOrderTraceSet splitTrace bound).card + + (boundedOrderTraceSet nonsplitTrace bound).card := + Finset.card_union_le + (parabolic ∪ boundedOrderTraceSet splitTrace bound) + (boundedOrderTraceSet nonsplitTrace bound) + _ ≤ (parabolic.card + (boundedOrderTraceSet splitTrace bound).card) + + (boundedOrderTraceSet nonsplitTrace bound).card := by + gcongr + exact Finset.card_union_le parabolic (boundedOrderTraceSet splitTrace bound) + _ ≤ (parabolic.card + + (bound - 1) * (Fintype.card Gsplit).divisors.card) + + (bound - 1) * (Fintype.card Gnonsplit).divisors.card := by + gcongr + · exact boundedOrderTraceSet_card_le_pred_mul_card_divisors splitTrace bound + · exact boundedOrderTraceSet_card_le_pred_mul_card_divisors nonsplitTrace bound + _ = parabolic.card + (bound - 1) * + ((Fintype.card Gsplit).divisors.card + + (Fintype.card Gnonsplit).divisors.card) := by + rw [Nat.mul_add] + omega + +theorem lowOrderTraceSet_card_le_parabolic_add_bound_mul_divisor_cards + {Gsplit Gnonsplit T : Type*} + [Group Gsplit] [Fintype Gsplit] [IsCyclic Gsplit] + [Group Gnonsplit] [Fintype Gnonsplit] [IsCyclic Gnonsplit] + [DecidableEq T] + (parabolic : Finset T) (splitTrace : Gsplit → T) (nonsplitTrace : Gnonsplit → T) + (bound : ℕ) : + (lowOrderTraceSet parabolic splitTrace nonsplitTrace bound).card ≤ + parabolic.card + bound * + ((Fintype.card Gsplit).divisors.card + (Fintype.card Gnonsplit).divisors.card) := by + exact (lowOrderTraceSet_card_le_parabolic_add_pred_mul_divisor_cards + parabolic splitTrace nonsplitTrace bound).trans <| by + gcongr + omega + +end LowOrderTrace + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean new file mode 100644 index 0000000000..5c4421a359 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail + +/-! +# Euler-seven frontier with all support tails discharged + +At `2^756 < p`, the simultaneous tenth-moment estimate now supplies the +linear middle game, primitive endgame, cage connectivity, split-cage base, +and half-order comparison. The only remaining arithmetic certificate is a +square envelope for the joint maximal-divisor count together with its exact +Euler-seven cubic inequality. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- Punctured transitivity above the unified support cutoff. All non-cubic +arithmetic and all endgame/cage hypotheses have been discharged. -/ +theorem + puncturedMarkoffTransitiveAt_of_eulerSevenSquareEnvelope_coarseSupport + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSupport : 2 ^ 756 < p) + (squareEnvelope : ℕ → ℕ) + (hcount : ∀ d : ℕ, + maximalDivisorCountSum p (d + 1) ^ 2 ≤ squareEnvelope d) + (hcubic : ∀ d : ℕ, + 35721 * squareEnvelope d ^ 4 < 8 * p) : + PuncturedMarkoffTransitiveAt p Fact.out := by + have hpSeven : 7 ≤ p := seven_le_of_twoPow756_lt hpSupport + obtain ⟨baseNormalized, hbaseCage⟩ := + exists_normalizedPunctured_splitCagePoint p hpSeven + let base : PuncturedMarkoffSurface (ZMod p) := + (puncturedNormalizationEquiv (ZMod p)).symm baseNormalized + apply + puncturedMarkoffTransitiveAt_of_splitCage_eulerSevenSquareEnvelope_coarseLinearTail + p hpSeven (twentyFour_support_margin.trans hpSupport) + base ?_ (coarse_halfOrderThreshold hpSupport) + squareEnvelope hcount hcubic + · intro z hzLarge + have hcoordinate : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u3 := by + by_contra hsmall + push Not at hsmall + have hmaxSmall : (maximalCoordinateRotationOrder z.1 : ℝ) < + (p : ℝ) ^ (5 / 6 : ℝ) := by + rw [maximalCoordinateRotationOrder, Nat.cast_max, Nat.cast_max] + exact max_lt hsmall.1 (max_lt hsmall.2.1 hsmall.2.2) + exact (not_lt_of_ge hzLarge) hmaxSmall + have hcomponent := + coarse_sameNormalizedComponent_of_largeOrder_to_splitCage + hpSupport (normalizedSurfaceOfPunctured baseNormalized) + z hbaseCage hcoordinate + simpa [base] using hcomponent + · simpa [base] using hbaseCage + +/-- Natural Markoff reduction is surjective under the same support-closed +Euler-seven square-envelope certificate. -/ +theorem + markoffReduction_surjective_of_eulerSevenSquareEnvelope_coarseSupport + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSupport : 2 ^ 756 < p) + (squareEnvelope : ℕ → ℕ) + (hcount : ∀ d : ℕ, + maximalDivisorCountSum p (d + 1) ^ 2 ≤ squareEnvelope d) + (hcubic : ∀ d : ℕ, + 35721 * squareEnvelope d ^ 4 < 8 * p) : + Function.Surjective (markoffReduction p) := + (puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective + p Fact.out).mp + (puncturedMarkoffTransitiveAt_of_eulerSevenSquareEnvelope_coarseSupport + p hpSupport squareEnvelope hcount hcubic) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean new file mode 100644 index 0000000000..862cabac40 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean @@ -0,0 +1,252 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame + +/-! +# Euler-seven nonparabolic complement frontier + +This is the complement-maximal argument with the exact paired +Euler-characteristic middle-game condition `189 * M^3 < d`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +private def normalizedPuncturedPointEulerSevenComplement + {R : Type*} [Field R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : NormalizedMarkoffSurface R := + normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x) + +private theorem normalizedPuncturedPointEulerSevenComplement_smul + {R : Type*} [Field R] [Invertible (3 : R)] + (g : Gamma R) (z : PuncturedMarkoffSurface R) : + normalizedPuncturedPointEulerSevenComplement (g • z) = + normalizedGammaPerm R g + (normalizedPuncturedPointEulerSevenComplement z) := by + have hzinv : + (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R z)) = z.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply z.1.1 + unfold normalizedPuncturedPointEulerSevenComplement + rw [normalizedGammaPerm_apply, hzinv] + apply Subtype.ext + rfl + +/-- Complement-maximal frontier with the exact Euler-seven paired +Corvaja--Zannier coefficient. The sign-invariance and factor-four inputs +remain explicit. -/ +theorem + puncturedMarkoffTransitiveAt_of_nonparabolicComplement_eulerSevenPairedMaximalDivisor_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hcube : ∀ d : ℕ, 0 < d → + 8 * p ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 → + 189 * maximalDivisorCountSum p (d + 1) ^ 3 < d) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 * maximalDivisorCountSum p (d + 1) * d < p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedPuncturedPointEulerSevenComplement c) z) + (hsign : ∀ (s : EvenSign) + (x : PuncturedMarkoffSurface (ZMod p)), + s • x ∈ puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c) + (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) : + PuncturedMarkoffTransitiveAt p Fact.out := by + classical + have hpTwo : p ≠ 2 := by omega + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent c x := by + intro x + by_contra hcx + let bad := puncturedComponentComplementFinset p c + have hxBad : x ∈ bad := by + simpa [bad] using hcx + have hbadNonempty : bad.Nonempty := by + refine ⟨(1 : EvenSign) • x, ?_⟩ + exact (by simpa [bad] using (hsign (1 : EvenSign) x).2 hxBad) + let orderMeasure : PuncturedMarkoffSurface (ZMod p) → ℕ := fun w => + maximalCoordinateRotationOrder + (normalizedPuncturedPointEulerSevenComplement w).1 + obtain ⟨z, hzBad, hzMax⟩ := + Finset.exists_max_image bad orderMeasure hbadNonempty + let d := orderMeasure z + have hmax : ∀ w : PuncturedMarkoffSurface (ZMod p), + w ∈ bad → orderMeasure w ≤ d := by + intro w hw + exact hzMax w hw + have hzNotComponent : ¬ SamePuncturedComponent c z := by + simpa [bad] using hzBad + have hdPos : 0 < d := by + have hfirstPos : 0 < + rotationOrder + (normalizedPuncturedPointEulerSevenComplement z).1.u1 := + rotationOrder_pos _ + exact hfirstPos.trans_le <| by + simpa [d, orderMeasure] using + rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointEulerSevenComplement z).1 + have hnotBaseZ : ¬ SameNormalizedComponent + (normalizedPuncturedPointEulerSevenComplement c) + (normalizedPuncturedPointEulerSevenComplement z) := by + intro hcz + apply hzNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c z).2 hcz + have hdUpper : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + by_contra hd + apply hnotBaseZ + apply hlarge (normalizedPuncturedPointEulerSevenComplement z) + simpa [d, orderMeasure] using le_of_not_gt hd + have hbadSmall : + bad.card ≤ + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := by + apply Finset.card_le_card + intro w hwBad + have hwNotComponent : ¬ SamePuncturedComponent c w := by + simpa [bad] using hwBad + have hwNotBase : ¬ SameNormalizedComponent + (normalizedPuncturedPointEulerSevenComplement c) + (normalizedPuncturedPointEulerSevenComplement w) := by + intro hcw + apply hwNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c w).2 hcw + have hnonparabolic := + first_two_nonparabolic_of_not_sameComponent_of_endgame_large_connected + hpTwo + (normalizedPuncturedPointEulerSevenComplement c) + (normalizedPuncturedPointEulerSevenComplement w) + hlarge hwNotBase + have hwMax := hmax w hwBad + have hfirst : + rotationOrder + (normalizedPuncturedPointEulerSevenComplement w).1.u1 ≤ d := + (rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointEulerSevenComplement w).1).trans hwMax + have hsecond : + rotationOrder + (normalizedPuncturedPointEulerSevenComplement w).1.u2 ≤ d := + (rotationOrder_second_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointEulerSevenComplement w).1).trans hwMax + change w ∈ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1) + rw [ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_iff + ] + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa only [normalizedPuncturedPointEulerSevenComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hfirst + · simpa only [normalizedPuncturedPointEulerSevenComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hsecond + · simpa only [normalizedPuncturedPointEulerSevenComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.1 + · simpa only [normalizedPuncturedPointEulerSevenComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.2 + have hfourPLeBad : 4 * p ≤ bad.card := by + apply four_mul_prime_le_puncturedComponentComplementFinset_card + p hpThree c + · simpa [bad] using hbadNonempty + · exact hfour + have heightPLeSmallOrderSquare : + 8 * p ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 := by + calc + 8 * p = 2 * (4 * p) := by ring + _ ≤ 2 * bad.card := Nat.mul_le_mul_left 2 hfourPLeBad + _ ≤ 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := + Nat.mul_le_mul_left 2 hbadSmall + _ ≤ (d * maximalDivisorCountSum p (d + 1)) ^ 2 := + two_mul_puncturedSmallNonparabolicOrder_succ_card_le_maximalDivisors + hpTwo d + have hcubeCount := hcube d hdPos heightPLeSmallOrderSquare + have hlinearCount := hlinear d hdUpper + have hmaximalCard : + (middleGameMaximalOrders p d).card ≤ + maximalDivisorCountSum p (d + 1) := by + simpa [maximalDivisorCountSum] using + middleGameMaximalOrders_card_le p d + have hcube' : + 189 * (middleGameMaximalOrders p d).card ^ 3 < d := by + apply lt_of_le_of_lt _ hcubeCount + gcongr + have hlinearCoefficient : + 24 * (middleGameMaximalOrders p d).card ≤ + 24 * maximalDivisorCountSum p (d + 1) := + Nat.mul_le_mul_left 24 hmaximalCard + have hlinear' : + 24 * (middleGameMaximalOrders p d).card * d < p := + (Nat.mul_le_mul_right d hlinearCoefficient).trans_lt hlinearCount + obtain ⟨y, hzy, hincrease⟩ := + exists_sameNormalizedComponent_maximalOrder_increase_of_eulerSevenPairedMaximalDivisorBounds + p hpTwo (delta := (1 / 3 : ℝ)) (by norm_num) + (normalizedPuncturedPointEulerSevenComplement z) + (by simpa only [show (1 / 2 + 1 / 3 : ℝ) = 5 / 6 by norm_num, + d, orderMeasure] using hdUpper) + (by simpa [d, orderMeasure] using hcube') + (by simpa [d, orderMeasure] using hlinear') + obtain ⟨g, hg⟩ := + (sameNormalizedComponent_iff_exists_gamma + (normalizedPuncturedPointEulerSevenComplement z) y).1 hzy + let w : PuncturedMarkoffSurface (ZMod p) := g • z + have hzw : SamePuncturedComponent z w := + (samePuncturedComponent_iff_exists z w).2 ⟨g, rfl⟩ + have hwBad : w ∈ bad := by + rw [show bad = puncturedComponentComplementFinset p c by rfl, + mem_puncturedComponentComplementFinset_iff] + intro hcw + apply hzNotComponent + exact samePuncturedComponent_trans hcw + (samePuncturedComponent_symm hzw) + have hwNormalized : + normalizedPuncturedPointEulerSevenComplement w = y := by + change normalizedPuncturedPointEulerSevenComplement (g • z) = y + rw [normalizedPuncturedPointEulerSevenComplement_smul] + exact hg + have hwMax := hmax w hwBad + change maximalCoordinateRotationOrder + (normalizedPuncturedPointEulerSevenComplement w).1 ≤ d at hwMax + rw [hwNormalized] at hwMax + have hincrease' : d < maximalCoordinateRotationOrder y.1 := by + simpa [d, orderMeasure] using hincrease + exact (not_lt_of_ge hwMax) hincrease' + intro a b + obtain ⟨ga, hga⟩ := + (samePuncturedComponent_iff_exists c a).1 (hAll a) + obtain ⟨gb, hgb⟩ := + (samePuncturedComponent_iff_exists c b).1 (hAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • c := by rw [← hga]; simp + _ = b := hgb + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean new file mode 100644 index 0000000000..92717357ff --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean @@ -0,0 +1,137 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape + +/-! +# Euler-seven paired maximal-divisor middle-game assembly + +This lifts the exact `189 * K^3 < d` paired escape from a chosen coordinate +to the maximum of the three coordinate rotation orders. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- One exact Euler-seven paired middle-game step strictly increases the +maximum coordinate order. -/ +theorem + exists_sameNormalizedComponent_maximalOrder_increase_of_eulerSevenPairedMaximalDivisorBounds + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + {delta : ℝ} (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedMarkoffSurface (ZMod p)) + (hbelow : (maximalCoordinateRotationOrder x.1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + 189 * + (middleGameMaximalOrders p + (maximalCoordinateRotationOrder x.1)).card ^ 3 < + maximalCoordinateRotationOrder x.1) + (hlinear : + 24 * + (middleGameMaximalOrders p + (maximalCoordinateRotationOrder x.1)).card * + maximalCoordinateRotationOrder x.1 < p) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ + maximalCoordinateRotationOrder x.1 < + maximalCoordinateRotationOrder y.1 := by + obtain ⟨x', hxx', hx'Order⟩ := + exists_sameNormalizedComponent_firstRotation_eq_maximal x + have hx'Cube : + 189 * + (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card ^ 3 < + rotationOrder x'.1.u1 := by + simpa [hx'Order] using hcube + have hx'Linear : + 24 * (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card * + rotationOrder x'.1.u1 < p := by + simpa [hx'Order] using hlinear + have hordersPos : + 0 < (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card := by + apply Finset.card_pos.mpr + have hpPlus : p + 1 ≠ 0 := by omega + have honeBound : 1 < rotationOrder x'.1.u1 + 1 := by + exact Nat.lt_succ_of_le (rotationOrder_pos x'.1.u1) + obtain ⟨m, hm, _hmultiple⟩ := + exists_dvd_maximalDivisorBelow hpPlus (one_dvd (p + 1)) honeBound + refine ⟨m, ?_⟩ + rw [middleGameMaximalOrders, Finset.mem_union] + exact Or.inr hm + have hbase : + 4 < + 189 * + (middleGameMaximalOrders p + (rotationOrder x'.1.u1)).card ^ 3 := by + have hcubePos : + 0 < + (middleGameMaximalOrders p + (rotationOrder x'.1.u1)).card ^ 3 := + pow_pos hordersPos 3 + nlinarith + have hx'AboveFour : 4 < rotationOrder x'.1.u1 := + hbase.trans hx'Cube + have hx'Below : (rotationOrder x'.1.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) := by + simpa [hx'Order] using hbelow + have hx'0 : x'.1.u1 ≠ 0 := by + intro hzero + have hle := rotationOrder_zero_le_four p + rw [hzero] at hx'AboveFour + omega + have hx'Nonparabolic : x'.1.u1 ^ 2 ≠ 4 := by + intro hparabolic + have hcases : x'.1.u1 = 2 ∨ x'.1.u1 = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + x'.1.u1 ^ 2 = 4 := hparabolic + _ = (2 : ZMod p) ^ 2 := by norm_num + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast + (show 1 ≤ p by exact (Fact.out : p.Prime).one_le) + have hexponentLe : (1 : ℝ) / 2 + delta ≤ 1 := by + linarith + have hrpowLe : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ (p : ℝ) := by + simpa using Real.rpow_le_rpow_of_exponent_le hpOne hexponentLe + rcases hcases with htwo | hnegTwo + · rw [htwo, rotationOrder_two] at hx'Below + linarith + · rw [hnegTwo, rotationOrder_neg_two p hpTwo] at hx'Below + have htwoP : ((2 * p : ℕ) : ℝ) = 2 * (p : ℝ) := by norm_num + rw [htwoP] at hx'Below + have hpPos : (0 : ℝ) < p := by positivity + linarith + obtain ⟨n, hnIncrease⟩ := + exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic_eulerSevenPairedMaximalOrders + p hpTwo delta hdelta x'.1 x'.property hx'0 hx'Nonparabolic + hx'Below hx'Cube hx'Linear + let y := (normalizedRotate1Surface^[n]) x' + have hcoe : y.1 = (normalizedRotate1^[n]) x'.1 := + coe_iterate_normalizedRotate1Surface x' n + refine ⟨y, sameNormalizedComponent_trans hxx' + (sameNormalizedComponent_iterate_normalizedRotate1Surface x' n), ?_⟩ + rw [← hx'Order] + exact hnIncrease.trans_le <| by + have hmeasureEq : maximalCoordinateRotationOrder y.1 = + maximalCoordinateRotationOrder + ((normalizedRotate1^[n]) x'.1) := + congrArg maximalCoordinateRotationOrder hcoe + calc + rotationOrder ((normalizedRotate1^[n]) x'.1).u2 ≤ + maximalCoordinateRotationOrder + ((normalizedRotate1^[n]) x'.1) := + rotationOrder_second_le_maximalCoordinateRotationOrder _ + _ = maximalCoordinateRotationOrder y.1 := hmeasureEq.symm + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean new file mode 100644 index 0000000000..bdf82d0179 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity + +/-! +# Euler-seven split-cage frontier with automatic linear tail + +Above `24^15 * 2^687`, the tenth-moment estimate discharges the full linear +middle-game family. Only the square-envelope cube obstruction remains. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- Split-cage transitivity with no separate linear-table hypothesis. -/ +theorem + puncturedMarkoffTransitiveAt_of_splitCage_eulerSevenSquareEnvelope_coarseLinearTail + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (hpLinearTail : 24 ^ 15 * 2 ^ 687 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (squareEnvelope : ℕ → ℕ) + (hsquare : ∀ d : ℕ, + maximalDivisorCountSum p (d + 1) ^ 2 ≤ squareEnvelope d) + (hglobal : ∀ d : ℕ, + 35721 * squareEnvelope d ^ 4 < 8 * p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + apply + puncturedMarkoffTransitiveAt_of_splitCage_nonparabolicComplement_eulerSevenPairedMaximalDivisor_frontier + p hpSeven c hbase hhalfThreshold + · intro d _hd hcount + by_contra hnot + have hdegree : + d ≤ 189 * maximalDivisorCountSum p (d + 1) ^ 3 := + Nat.le_of_not_gt hnot + have hbad : + 8 * p ≤ 35721 * squareEnvelope d ^ 4 := + eight_mul_le_35721_mul_fourth_of_count_degree_squareEnvelope + hcount hdegree (hsquare d) + exact (Nat.not_le_of_lt (hglobal d)) hbad + · intro d hd + exact maximalDivisorCountSum_linear_lt_of_coarseBound hpLinearTail hd + · exact hlarge + +/-- Natural Markoff reduction surjectivity with the same automatic linear +tail and no separate linear-table hypothesis. -/ +theorem + markoffReduction_surjective_of_splitCage_eulerSevenSquareEnvelope_coarseLinearTail + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (hpLinearTail : 24 ^ 15 * 2 ^ 687 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (squareEnvelope : ℕ → ℕ) + (hsquare : ∀ d : ℕ, + maximalDivisorCountSum p (d + 1) ^ 2 ≤ squareEnvelope d) + (hglobal : ∀ d : ℕ, + 35721 * squareEnvelope d ^ 4 < 8 * p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + Function.Surjective (markoffReduction p) := + (puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective + p Fact.out).mp + (puncturedMarkoffTransitiveAt_of_splitCage_eulerSevenSquareEnvelope_coarseLinearTail + p hpSeven hpLinearTail c hbase hhalfThreshold + squareEnvelope hsquare hglobal hlarge) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean new file mode 100644 index 0000000000..84f8850800 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier + +/-! +# Split-cage Euler-seven nonparabolic complement frontier + +The split-cage base discharges the even-sign inputs, while the middle game +uses the exact paired coefficient `189`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- Exact Euler-seven nonparabolic complement frontier with the even-sign +invariance and factor-four hypotheses discharged by a split-cage base. -/ +theorem + puncturedMarkoffTransitiveAt_of_splitCage_nonparabolicComplement_eulerSevenPairedMaximalDivisor_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (hcube : ∀ d : ℕ, 0 < d → + 8 * p ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 → + 189 * maximalDivisorCountSum p (d + 1) ^ 3 < d) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 * maximalDivisorCountSum p (d + 1) * d < p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + have hbaseSign : + ∀ s : EvenSign, SamePuncturedComponent c (s • c) := + samePuncturedComponent_evenSign_smul_of_splitCageBase + p hpSeven c hbase hhalfThreshold hlarge + have hsign : + ∀ (s : EvenSign) (x : PuncturedMarkoffSurface (ZMod p)), + s • x ∈ puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c := + fun s x => + puncturedComponentComplementFinset_evenSign_mem_iff_of_base_stable + p c x hbaseSign s + have hfour : + 4 ∣ (puncturedComponentComplementFinset p c).card := + four_dvd_puncturedComponentComplementFinset_card_of_base_sign_stable + p (by omega) c hbaseSign + exact + puncturedMarkoffTransitiveAt_of_nonparabolicComplement_eulerSevenPairedMaximalDivisor_frontier + p (by omega) c hcube hlinear hlarge hsign hfour + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean new file mode 100644 index 0000000000..ea2efce200 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier +import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion + +/-! +# Root-free Euler-seven split-cage square-envelope frontier + +For `M = maximalDivisorCountSum p (d + 1)`, a certificate `M^2 ≤ S` +reduces the exact Euler-seven cube branch to + +`35721 * S^4 < 8 * p`, + +because `35721 = 189^2`. The linear branch is independently reduced to + +`24^2 * S * d^2 < p^2`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- The exact Euler-seven split-cage endpoint in root-free square-envelope +form. The split-cage base, half-threshold comparison, and large-order orbit +bridge remain explicit inputs. -/ +theorem + puncturedMarkoffTransitiveAt_of_splitCage_eulerSevenSquareEnvelope_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (squareEnvelope : ℕ → ℕ) + (hsquare : ∀ d : ℕ, + maximalDivisorCountSum p (d + 1) ^ 2 ≤ squareEnvelope d) + (hglobal : ∀ d : ℕ, + 35721 * squareEnvelope d ^ 4 < 8 * p) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 ^ 2 * squareEnvelope d * d ^ 2 < p ^ 2) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + apply + puncturedMarkoffTransitiveAt_of_splitCage_nonparabolicComplement_eulerSevenPairedMaximalDivisor_frontier + p hpSeven c hbase hhalfThreshold + · intro d _hd hcount + by_contra hnot + have hdegree : + d ≤ 189 * maximalDivisorCountSum p (d + 1) ^ 3 := + Nat.le_of_not_gt hnot + have hbad : + 8 * p ≤ 35721 * squareEnvelope d ^ 4 := + eight_mul_le_35721_mul_fourth_of_count_degree_squareEnvelope + hcount hdegree (hsquare d) + exact (Nat.not_le_of_lt (hglobal d)) hbad + · intro d hd + exact + coefficient_mul_count_mul_order_lt_of_squareEnvelope + (coefficient := 24) + (count := maximalDivisorCountSum p (d + 1)) + (envelope := squareEnvelope d) + (order := d) (p := p) + (hsquare d) (hlinear d hd) + · exact hlarge + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean new file mode 100644 index 0000000000..13720a0700 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity + +/-! +# Euler-seven square-envelope reduction surjectivity + +This separate façade converts the exact split-cage transitivity endpoint to +surjectivity of natural Markoff reduction using the canonical equivalence. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- Natural Markoff reduction is surjective under the exact Euler-seven +split-cage square-envelope hypotheses. -/ +theorem + markoffReduction_surjective_of_splitCage_eulerSevenSquareEnvelope_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (squareEnvelope : ℕ → ℕ) + (hsquare : ∀ d : ℕ, + maximalDivisorCountSum p (d + 1) ^ 2 ≤ squareEnvelope d) + (hglobal : ∀ d : ℕ, + 35721 * squareEnvelope d ^ 4 < 8 * p) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 ^ 2 * squareEnvelope d * d ^ 2 < p ^ 2) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + Function.Surjective (markoffReduction p) := + (puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective + p Fact.out).mp + (puncturedMarkoffTransitiveAt_of_splitCage_eulerSevenSquareEnvelope_frontier + p hpSeven c hbase hhalfThreshold squareEnvelope + hsquare hglobal hlinear hlarge) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean new file mode 100644 index 0000000000..89c5056178 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility + +/-! +# From base sign-stability to complement divisibility + +Because `Gamma` normalizes the even-sign subgroup, it is enough to connect the +four sign changes of one base point back to that base component. Every even +sign change then preserves the whole component and its finite complement. +-/ + +namespace BGS.Markoff + +/-- If all even-sign changes of the base point lie in its `Gamma` component, +then every even sign preserves membership in that component. -/ +theorem samePuncturedComponent_evenSign_smul_iff_of_base_stable + {R : Type*} [CommRing R] + (c x : PuncturedMarkoffSurface R) + (hbase : ∀ s : EvenSign, SamePuncturedComponent c (s • c)) + (s : EvenSign) : + SamePuncturedComponent c (s • x) ↔ + SamePuncturedComponent c x := by + have hforward : + ∀ (t : EvenSign) (y : PuncturedMarkoffSurface R), + SamePuncturedComponent c y → + SamePuncturedComponent c (t • y) := by + intro t y hy + obtain ⟨g, hgy⟩ := (samePuncturedComponent_iff_exists c y).1 hy + obtain ⟨u, hcommute⟩ := exists_evenSign_smul_Gamma_smul t g + have hbaseU := hbase u + have hmove : + SamePuncturedComponent (u • c) (g • (u • c)) := + (samePuncturedComponent_iff_exists (u • c) (g • (u • c))).2 + ⟨g, rfl⟩ + have htarget : + SamePuncturedComponent c (g • (u • c)) := + samePuncturedComponent_trans hbaseU hmove + have heq : t • y = g • (u • c) := by + calc + t • y = t • (g • c) := congrArg (t • ·) hgy.symm + _ = g • (u • c) := hcommute c + rw [heq] + exact htarget + constructor + · intro hsx + have hback := hforward s⁻¹ (s • x) hsx + rw [inv_smul_smul] at hback + exact hback + · exact hforward s x + +/-- Base sign-stability makes the finite component complement invariant under +every even sign. -/ +theorem puncturedComponentComplementFinset_evenSign_mem_iff_of_base_stable + (p : ℕ) [Fact p.Prime] + (c x : PuncturedMarkoffSurface (ZMod p)) + (hbase : ∀ s : EvenSign, SamePuncturedComponent c (s • c)) + (s : EvenSign) : + s • x ∈ puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c := by + rw [mem_puncturedComponentComplementFinset_iff, + mem_puncturedComponentComplementFinset_iff] + exact not_congr + (samePuncturedComponent_evenSign_smul_iff_of_base_stable c x hbase s) + +/-- The expected factor four in the complement size follows from the sole +geometric input that the four sign changes of the base point return to its +`Gamma` component. -/ +theorem four_dvd_puncturedComponentComplementFinset_card_of_base_sign_stable + (p : ℕ) [Fact p.Prime] (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : ∀ s : EvenSign, SamePuncturedComponent c (s • c)) : + 4 ∣ (puncturedComponentComplementFinset p c).card := by + apply + four_dvd_puncturedComponentComplementFinset_card_of_evenSign_invariant + p hpThree c + intro s x + exact + puncturedComponentComplementFinset_evenSign_mem_iff_of_base_stable + p c x hbase s + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean new file mode 100644 index 0000000000..6d41da8a82 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier + +/-! +# Even-sign divisibility for component complements + +This file specializes the free even-sign action to the finite complement used +by the nonparabolic complement frontier. +-/ + +namespace BGS.Markoff + +/-- An even-sign-invariant component complement has cardinality divisible by +four. The hypothesis is stated in the same form as the complement frontier's +`hsign` input. -/ +theorem four_dvd_puncturedComponentComplementFinset_card_of_evenSign_invariant + (p : ℕ) [Fact p.Prime] (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hsign : ∀ (s : EvenSign) + (x : PuncturedMarkoffSurface (ZMod p)), + s • x ∈ puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c) : + 4 ∣ (puncturedComponentComplementFinset p c).card := by + have htwo : (2 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) (by omega)) hpDvd + exact four_dvd_finset_card_of_evenSign_invariant htwo + (puncturedComponentComplementFinset p c) + (fun s x hx => (hsign s x).2 hx) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean new file mode 100644 index 0000000000..5e89e0d0d0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction + +/-! +# Divisibility from the free even-sign action + +For odd characteristic, the Klein four-group of even sign changes acts freely +on the punctured Markoff surface. Consequently every finite sign-invariant set +is a disjoint union of four-element sign orbits. +-/ + +namespace BGS.Markoff + +noncomputable section + +private theorem eq_zero_of_neg_eq + {F : Type*} [Field F] (htwo : (2 : F) ≠ 0) + {a : F} (ha : -a = a) : + a = 0 := by + have hmul : (2 : F) * a = 0 := by + rw [two_mul] + calc + a + a = -a + a := congrArg (fun z => z + a) ha.symm + _ = 0 := neg_add_cancel a + exact (mul_eq_zero.mp hmul).resolve_left htwo + +/-- In characteristic different from two, no nontrivial even sign change +fixes a punctured Markoff point. -/ +theorem evenSign_eq_one_of_smul_eq + {F : Type*} [Field F] (htwo : (2 : F) ≠ 0) + (s : EvenSign) (x : PuncturedMarkoffSurface F) + (hfixed : s • x = x) : + s = 1 := by + have fixedPoint : + evenSignPoint s x.1.1 = x.1.1 := by + exact congrArg (fun y : PuncturedMarkoffSurface F => y.1.1) hfixed + cases s with + | id => + rfl + | neg12 => + have hfirst : x.1.1.x1 = 0 := + eq_zero_of_neg_eq htwo (congrArg Point.x1 fixedPoint) + have hsecond : x.1.1.x2 = 0 := + eq_zero_of_neg_eq htwo (congrArg Point.x2 fixedPoint) + have hthird : x.1.1.x3 = 0 := by + have hmarkoff := x.1.2 + simp [IsMarkoff, markoffPolynomial, hfirst, hsecond] at hmarkoff + exact hmarkoff + exfalso + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hfirst, hsecond, hthird] + | neg13 => + have hfirst : x.1.1.x1 = 0 := + eq_zero_of_neg_eq htwo (congrArg Point.x1 fixedPoint) + have hthird : x.1.1.x3 = 0 := + eq_zero_of_neg_eq htwo (congrArg Point.x3 fixedPoint) + have hsecond : x.1.1.x2 = 0 := by + have hmarkoff := x.1.2 + simp [IsMarkoff, markoffPolynomial, hfirst, hthird] at hmarkoff + exact hmarkoff + exfalso + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hfirst, hsecond, hthird] + | neg23 => + have hsecond : x.1.1.x2 = 0 := + eq_zero_of_neg_eq htwo (congrArg Point.x2 fixedPoint) + have hthird : x.1.1.x3 = 0 := + eq_zero_of_neg_eq htwo (congrArg Point.x3 fixedPoint) + have hfirst : x.1.1.x1 = 0 := by + have hmarkoff := x.1.2 + simp [IsMarkoff, markoffPolynomial, hsecond, hthird] at hmarkoff + exact hmarkoff + exfalso + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hfirst, hsecond, hthird] + +/-- The even-sign action on the punctured Markoff surface is free in +characteristic different from two. -/ +theorem evenSign_isCancelSMul_punctured + {F : Type*} [Field F] (htwo : (2 : F) ≠ 0) : + IsCancelSMul EvenSign (PuncturedMarkoffSurface F) := by + rw [isCancelSMul_iff_eq_one_of_smul_eq] + exact fun s x hfixed => evenSign_eq_one_of_smul_eq htwo s x hfixed + +/-- The four-point orbit of a punctured point under even sign changes. -/ +def evenSignOrbitFinset + {R : Type*} [CommRing R] (x : PuncturedMarkoffSurface R) : + Finset (PuncturedMarkoffSurface R) := by + classical + exact Finset.univ.image fun s : EvenSign => s • x + +@[simp] +theorem mem_evenSignOrbitFinset_iff + {R : Type*} [CommRing R] {x y : PuncturedMarkoffSurface R} : + y ∈ evenSignOrbitFinset x ↔ ∃ s : EvenSign, s • x = y := by + classical + simp [evenSignOrbitFinset] + +theorem evenSignOrbitFinset_eq_of_mem + {R : Type*} [CommRing R] {x y : PuncturedMarkoffSurface R} + (hy : y ∈ evenSignOrbitFinset x) : + evenSignOrbitFinset y = evenSignOrbitFinset x := by + classical + obtain ⟨s, hs⟩ := mem_evenSignOrbitFinset_iff.mp hy + ext z + constructor + · intro hz + obtain ⟨t, ht⟩ := mem_evenSignOrbitFinset_iff.mp hz + apply mem_evenSignOrbitFinset_iff.mpr + refine ⟨t * s, ?_⟩ + calc + (t * s) • x = t • (s • x) := mul_smul t s x + _ = t • y := congrArg (t • ·) hs + _ = z := ht + · intro hz + obtain ⟨u, hu⟩ := mem_evenSignOrbitFinset_iff.mp hz + apply mem_evenSignOrbitFinset_iff.mpr + refine ⟨u * s⁻¹, ?_⟩ + calc + (u * s⁻¹) • y = (u * s⁻¹) • (s • x) := + congrArg ((u * s⁻¹) • ·) hs.symm + _ = u • (s⁻¹ • (s • x)) := mul_smul u s⁻¹ (s • x) + _ = u • x := congrArg (u • ·) (inv_smul_smul s x) + _ = z := hu + +theorem evenSignOrbitFinset_card_eq_four + {F : Type*} [Field F] (htwo : (2 : F) ≠ 0) + (x : PuncturedMarkoffSurface F) : + (evenSignOrbitFinset x).card = 4 := by + classical + letI : IsCancelSMul EvenSign (PuncturedMarkoffSurface F) := + evenSign_isCancelSMul_punctured htwo + have hinjective : + Function.Injective (fun s : EvenSign => s • x) := by + intro s t hst + exact IsCancelSMul.right_cancel s t x hst + calc + (evenSignOrbitFinset x).card = + (Finset.univ : Finset EvenSign).card := by + exact Finset.card_image_of_injective Finset.univ hinjective + _ = 4 := EvenSign.card_eq_four + +/-- The finite family of distinct even-sign orbits meeting `C`. -/ +def evenSignOrbitPartition + {R : Type*} [CommRing R] + (C : Finset (PuncturedMarkoffSurface R)) : + Finset (Finset (PuncturedMarkoffSurface R)) := by + classical + exact C.image evenSignOrbitFinset + +/-- The union of all even-sign orbits meeting `C`. This wrapper fixes one +classical equality-decider for the nested finite union. -/ +def evenSignOrbitPartitionUnion + {R : Type*} [CommRing R] + (C : Finset (PuncturedMarkoffSurface R)) : + Finset (PuncturedMarkoffSurface R) := by + classical + exact (evenSignOrbitPartition C).biUnion id + +theorem evenSignOrbitPartition_pairwiseDisjoint + {R : Type*} [CommRing R] + (C : Finset (PuncturedMarkoffSurface R)) : + ((evenSignOrbitPartition C : Finset + (Finset (PuncturedMarkoffSurface R))) : Set + (Finset (PuncturedMarkoffSurface R))).PairwiseDisjoint id := by + classical + intro A hA B hB hne + change A ∈ evenSignOrbitPartition C at hA + change B ∈ evenSignOrbitPartition C at hB + rw [evenSignOrbitPartition] at hA hB + obtain ⟨x, _hx, rfl⟩ := Finset.mem_image.mp hA + obtain ⟨y, _hy, rfl⟩ := Finset.mem_image.mp hB + change Disjoint (evenSignOrbitFinset x) (evenSignOrbitFinset y) + rw [Finset.disjoint_left] + intro z hzx hzy + apply hne + calc + evenSignOrbitFinset x = evenSignOrbitFinset z := + (evenSignOrbitFinset_eq_of_mem hzx).symm + _ = evenSignOrbitFinset y := + evenSignOrbitFinset_eq_of_mem hzy + +theorem evenSignOrbitPartitionUnion_eq + {R : Type*} [CommRing R] + (C : Finset (PuncturedMarkoffSurface R)) + (hC : ∀ (s : EvenSign) (x : PuncturedMarkoffSurface R), + x ∈ C → s • x ∈ C) : + evenSignOrbitPartitionUnion C = C := by + classical + rw [evenSignOrbitPartitionUnion] + ext z + constructor + · intro hz + obtain ⟨A, hA, hzA⟩ := Finset.mem_biUnion.mp hz + rw [evenSignOrbitPartition] at hA + obtain ⟨x, hx, rfl⟩ := Finset.mem_image.mp hA + obtain ⟨s, rfl⟩ := mem_evenSignOrbitFinset_iff.mp hzA + exact hC s x hx + · intro hz + apply Finset.mem_biUnion.mpr + refine ⟨evenSignOrbitFinset z, ?_, ?_⟩ + · rw [evenSignOrbitPartition] + exact Finset.mem_image.mpr ⟨z, hz, rfl⟩ + · exact mem_evenSignOrbitFinset_iff.mpr ⟨1, one_smul EvenSign z⟩ + +/-- Any finite set of punctured Markoff points preserved by all even sign +changes has cardinality divisible by four. -/ +theorem four_dvd_finset_card_of_evenSign_invariant + {F : Type*} [Field F] (htwo : (2 : F) ≠ 0) + (C : Finset (PuncturedMarkoffSurface F)) + (hC : ∀ (s : EvenSign) (x : PuncturedMarkoffSurface F), + x ∈ C → s • x ∈ C) : + 4 ∣ C.card := by + classical + let P := evenSignOrbitPartition C + have hpartition : evenSignOrbitPartitionUnion C = C := + evenSignOrbitPartitionUnion_eq C hC + have hdisjoint : + ((P : Finset (Finset (PuncturedMarkoffSurface F))) : Set + (Finset (PuncturedMarkoffSurface F))).PairwiseDisjoint id := + evenSignOrbitPartition_pairwiseDisjoint C + have hunionCard : + (evenSignOrbitPartitionUnion C).card = + ∑ A ∈ P, A.card := by + rw [evenSignOrbitPartitionUnion] + simpa using Finset.card_biUnion hdisjoint + have hcard : + C.card = ∑ A ∈ P, A.card := by + calc + C.card = (evenSignOrbitPartitionUnion C).card := + congrArg Finset.card hpartition.symm + _ = ∑ A ∈ P, A.card := hunionCard + refine ⟨P.card, ?_⟩ + rw [hcard] + calc + ∑ A ∈ P, A.card = ∑ _A ∈ P, 4 := by + apply Finset.sum_congr rfl + intro A hA + change A ∈ evenSignOrbitPartition C at hA + rw [evenSignOrbitPartition] at hA + obtain ⟨x, _hx, rfl⟩ := Finset.mem_image.mp hA + exact evenSignOrbitFinset_card_eq_four htwo x + _ = 4 * P.card := by simp [Nat.mul_comm] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean new file mode 100644 index 0000000000..b61df1380e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier + +/-! +# Exact-order root obstruction from a nontransitive complement + +With the root-sum convention + +`R = Σ_{e ∣ p-1, 2 + maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderComplement w).1 + obtain ⟨z, hzBad, hzMax⟩ := + Finset.exists_max_image bad orderMeasure hbadNonempty + let d := orderMeasure z + have hmax : ∀ w : PuncturedMarkoffSurface (ZMod p), + w ∈ bad → orderMeasure w ≤ d := by + intro w hw + exact hzMax w hw + have hzNotComponent : ¬ SamePuncturedComponent c z := by + simpa [bad] using hzBad + have hdPos : 0 < d := by + have hfirstPos : 0 < + rotationOrder + (normalizedPuncturedPointExactOrderComplement z).1.u1 := + rotationOrder_pos _ + exact hfirstPos.trans_le <| by + simpa [d, orderMeasure] using + rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderComplement z).1 + have hnotBaseZ : ¬ SameNormalizedComponent + (normalizedPuncturedPointExactOrderComplement c) + (normalizedPuncturedPointExactOrderComplement z) := by + intro hcz + apply hzNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c z).2 hcz + have hdUpper : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + by_contra hd + apply hnotBaseZ + apply hlarge (normalizedPuncturedPointExactOrderComplement z) + simpa [d, orderMeasure] using le_of_not_gt hd + have hbadSmall : + bad.card ≤ + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := by + apply Finset.card_le_card + intro w hwBad + have hwNotComponent : ¬ SamePuncturedComponent c w := by + simpa [bad] using hwBad + have hwNotBase : ¬ SameNormalizedComponent + (normalizedPuncturedPointExactOrderComplement c) + (normalizedPuncturedPointExactOrderComplement w) := by + intro hcw + apply hwNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c w).2 hcw + have hnonparabolic := + first_two_nonparabolic_of_not_sameComponent_of_endgame_large_connected + hpTwo + (normalizedPuncturedPointExactOrderComplement c) + (normalizedPuncturedPointExactOrderComplement w) + hlarge hwNotBase + have hwMax := hmax w hwBad + have hfirst : + rotationOrder + (normalizedPuncturedPointExactOrderComplement w).1.u1 ≤ d := + (rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderComplement w).1).trans hwMax + have hsecond : + rotationOrder + (normalizedPuncturedPointExactOrderComplement w).1.u2 ≤ d := + (rotationOrder_second_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderComplement w).1).trans hwMax + change w ∈ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1) + rw [ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_iff + ] + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa only [normalizedPuncturedPointExactOrderComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hfirst + · simpa only [normalizedPuncturedPointExactOrderComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hsecond + · simpa only [normalizedPuncturedPointExactOrderComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.1 + · simpa only [normalizedPuncturedPointExactOrderComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.2 + have hfourPLeBad : 4 * p ≤ bad.card := by + apply four_mul_prime_le_puncturedComponentComplementFinset_card + p hpThree c + · simpa [bad] using hbadNonempty + · exact hfour + have hrootObstruction : + 8 * p ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 := by + calc + 8 * p = 2 * (4 * p) := by ring + _ ≤ 2 * bad.card := Nat.mul_le_mul_left 2 hfourPLeBad + _ ≤ 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := + Nat.mul_le_mul_left 2 hbadSmall + _ ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 := + two_mul_puncturedSmallNonparabolicOrder_succ_card_le_rootSumSq + hpTwo d + exact ⟨d, hdPos, hdUpper, hrootObstruction⟩ + +/-- Global nontransitivity forces an exact root-sum obstruction below the +large-order endgame threshold. -/ +theorem exists_exactOrderRootSum_obstruction_of_not_puncturedTransitive + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedPuncturedPointExactOrderComplement c) z) + (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) + (hnotTransitive : ¬ PuncturedMarkoffTransitiveAt p Fact.out) : + ∃ d : ℕ, + 0 < d ∧ + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) ∧ + 8 * p ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 := by + have hexists : + ∃ x : PuncturedMarkoffSurface (ZMod p), + ¬ SamePuncturedComponent c x := by + by_contra hnone + have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent c x := by + intro x + by_contra hx + exact hnone ⟨x, hx⟩ + apply hnotTransitive + intro a b + obtain ⟨ga, hga⟩ := + (samePuncturedComponent_iff_exists c a).1 (hAll a) + obtain ⟨gb, hgb⟩ := + (samePuncturedComponent_iff_exists c b).1 (hAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • c := by rw [← hga]; simp + _ = b := hgb + obtain ⟨x, hx⟩ := hexists + exact + exists_exactOrderRootSum_obstruction_of_not_samePuncturedComponent + p hpThree c x hlarge hfour hx + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean new file mode 100644 index 0000000000..1f2d9302c8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean @@ -0,0 +1,272 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame + +/-! +# Exact-order obstruction with the Euler-seven cap + +The exact-order root budget and the Euler-seven middle-game cap must concern +the same maximal bad rotation order. This file keeps that common witness +visible instead of composing two unrelated existential statements. +-/ + +namespace BGS.Markoff + +noncomputable section + +private def normalizedPuncturedPointExactOrderEulerSeven + {R : Type*} [Field R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : NormalizedMarkoffSurface R := + normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x) + +private theorem normalizedPuncturedPointExactOrderEulerSeven_smul + {R : Type*} [Field R] [Invertible (3 : R)] + (g : Gamma R) (z : PuncturedMarkoffSurface R) : + normalizedPuncturedPointExactOrderEulerSeven (g • z) = + normalizedGammaPerm R g + (normalizedPuncturedPointExactOrderEulerSeven z) := by + have hzinv : + (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R z)) = z.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply z.1.1 + unfold normalizedPuncturedPointExactOrderEulerSeven + rw [normalizedGammaPerm_apply, hzinv] + apply Subtype.ext + rfl + +/-- A point outside the base component gives one order `d` which +simultaneously satisfies the exact root-sum obstruction and the negation of +the strict Euler-seven escape condition. -/ +theorem + exists_exactOrderRootSum_eulerSevenCap_of_not_samePuncturedComponent + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c x : PuncturedMarkoffSurface (ZMod p)) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedPuncturedPointExactOrderEulerSeven c) z) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 * (middleGameMaximalOrders p d).card * d < p) + (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) + (hcx : ¬ SamePuncturedComponent c x) : + ∃ d : ℕ, + 0 < d ∧ + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) ∧ + 8 * p ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 ∧ + d ≤ 189 * (middleGameMaximalOrders p d).card ^ 3 := by + classical + have hpTwo : p ≠ 2 := by omega + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let bad := puncturedComponentComplementFinset p c + have hxBad : x ∈ bad := by + simpa [bad] using hcx + have hbadNonempty : bad.Nonempty := ⟨x, hxBad⟩ + let orderMeasure : PuncturedMarkoffSurface (ZMod p) → ℕ := fun w => + maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderEulerSeven w).1 + obtain ⟨z, hzBad, hzMax⟩ := + Finset.exists_max_image bad orderMeasure hbadNonempty + let d := orderMeasure z + have hmax : ∀ w : PuncturedMarkoffSurface (ZMod p), + w ∈ bad → orderMeasure w ≤ d := by + intro w hw + exact hzMax w hw + have hzNotComponent : ¬ SamePuncturedComponent c z := by + simpa [bad] using hzBad + have hdPos : 0 < d := by + have hfirstPos : 0 < + rotationOrder + (normalizedPuncturedPointExactOrderEulerSeven z).1.u1 := + rotationOrder_pos _ + exact hfirstPos.trans_le <| by + simpa [d, orderMeasure] using + rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderEulerSeven z).1 + have hnotBaseZ : ¬ SameNormalizedComponent + (normalizedPuncturedPointExactOrderEulerSeven c) + (normalizedPuncturedPointExactOrderEulerSeven z) := by + intro hcz + apply hzNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c z).2 hcz + have hdUpper : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + by_contra hd + apply hnotBaseZ + apply hlarge (normalizedPuncturedPointExactOrderEulerSeven z) + simpa [d, orderMeasure] using le_of_not_gt hd + have hcap : + d ≤ 189 * (middleGameMaximalOrders p d).card ^ 3 := by + by_contra hnotCap + have hcube : + 189 * (middleGameMaximalOrders p d).card ^ 3 < d := + Nat.lt_of_not_ge hnotCap + have hlinearD : + 24 * (middleGameMaximalOrders p d).card * d < p := + hlinear d hdUpper + obtain ⟨y, hzy, hincrease⟩ := + exists_sameNormalizedComponent_maximalOrder_increase_of_eulerSevenPairedMaximalDivisorBounds + p hpTwo (delta := (1 / 3 : ℝ)) (by norm_num) + (normalizedPuncturedPointExactOrderEulerSeven z) + (by + simpa only [ + show (1 / 2 + 1 / 3 : ℝ) = 5 / 6 by norm_num, + d, orderMeasure] using hdUpper) + (by simpa [d, orderMeasure] using hcube) + (by simpa [d, orderMeasure] using hlinearD) + obtain ⟨g, hg⟩ := + (sameNormalizedComponent_iff_exists_gamma + (normalizedPuncturedPointExactOrderEulerSeven z) y).1 hzy + let w : PuncturedMarkoffSurface (ZMod p) := g • z + have hzw : SamePuncturedComponent z w := + (samePuncturedComponent_iff_exists z w).2 ⟨g, rfl⟩ + have hwBad : w ∈ bad := by + rw [show bad = puncturedComponentComplementFinset p c by rfl, + mem_puncturedComponentComplementFinset_iff] + intro hcw + apply hzNotComponent + exact samePuncturedComponent_trans hcw + (samePuncturedComponent_symm hzw) + have hwNormalized : + normalizedPuncturedPointExactOrderEulerSeven w = y := by + change normalizedPuncturedPointExactOrderEulerSeven (g • z) = y + rw [normalizedPuncturedPointExactOrderEulerSeven_smul] + exact hg + have hwMax := hmax w hwBad + change maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderEulerSeven w).1 ≤ d at hwMax + rw [hwNormalized] at hwMax + have hincrease' : d < maximalCoordinateRotationOrder y.1 := by + simpa [d, orderMeasure] using hincrease + exact (not_lt_of_ge hwMax) hincrease' + have hbadSmall : + bad.card ≤ + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := by + apply Finset.card_le_card + intro w hwBad + have hwNotComponent : ¬ SamePuncturedComponent c w := by + simpa [bad] using hwBad + have hwNotBase : ¬ SameNormalizedComponent + (normalizedPuncturedPointExactOrderEulerSeven c) + (normalizedPuncturedPointExactOrderEulerSeven w) := by + intro hcw + apply hwNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c w).2 hcw + have hnonparabolic := + first_two_nonparabolic_of_not_sameComponent_of_endgame_large_connected + hpTwo + (normalizedPuncturedPointExactOrderEulerSeven c) + (normalizedPuncturedPointExactOrderEulerSeven w) + hlarge hwNotBase + have hwMax := hmax w hwBad + have hfirst : + rotationOrder + (normalizedPuncturedPointExactOrderEulerSeven w).1.u1 ≤ d := + (rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderEulerSeven w).1).trans hwMax + have hsecond : + rotationOrder + (normalizedPuncturedPointExactOrderEulerSeven w).1.u2 ≤ d := + (rotationOrder_second_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointExactOrderEulerSeven w).1).trans hwMax + change w ∈ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1) + rw [ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_iff + ] + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa only [normalizedPuncturedPointExactOrderEulerSeven, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hfirst + · simpa only [normalizedPuncturedPointExactOrderEulerSeven, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hsecond + · simpa only [normalizedPuncturedPointExactOrderEulerSeven, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.1 + · simpa only [normalizedPuncturedPointExactOrderEulerSeven, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.2 + have hfourPLeBad : 4 * p ≤ bad.card := by + apply four_mul_prime_le_puncturedComponentComplementFinset_card + p hpThree c + · simpa [bad] using hbadNonempty + · exact hfour + have hrootObstruction : + 8 * p ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 := by + calc + 8 * p = 2 * (4 * p) := by ring + _ ≤ 2 * bad.card := Nat.mul_le_mul_left 2 hfourPLeBad + _ ≤ 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := + Nat.mul_le_mul_left 2 hbadSmall + _ ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 := + two_mul_puncturedSmallNonparabolicOrder_succ_card_le_rootSumSq + hpTwo d + exact ⟨d, hdPos, hdUpper, hrootObstruction, hcap⟩ + +/-- Global nontransitivity forces one common exact-order/Euler-seven witness, +not two independently chosen orders. -/ +theorem + exists_exactOrderRootSum_eulerSevenCap_of_not_puncturedTransitive + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedPuncturedPointExactOrderEulerSeven c) z) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 * (middleGameMaximalOrders p d).card * d < p) + (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) + (hnotTransitive : ¬ PuncturedMarkoffTransitiveAt p Fact.out) : + ∃ d : ℕ, + 0 < d ∧ + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) ∧ + 8 * p ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 ∧ + d ≤ 189 * (middleGameMaximalOrders p d).card ^ 3 := by + have hexists : + ∃ x : PuncturedMarkoffSurface (ZMod p), + ¬ SamePuncturedComponent c x := by + by_contra hnone + have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent c x := by + intro x + by_contra hx + exact hnone ⟨x, hx⟩ + apply hnotTransitive + intro a b + obtain ⟨ga, hga⟩ := + (samePuncturedComponent_iff_exists c a).1 (hAll a) + obtain ⟨gb, hgb⟩ := + (samePuncturedComponent_iff_exists c b).1 (hAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • c := by rw [← hga]; simp + _ = b := hgb + obtain ⟨x, hx⟩ := hexists + exact + exists_exactOrderRootSum_eulerSevenCap_of_not_samePuncturedComponent + p hpThree c x hlarge hlinear hfour hx + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean new file mode 100644 index 0000000000..500840645b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount + +/-! +# Exact-order square bound for punctured small-order points + +The root-sum convention is retained: `combinedTruncatedOrderTotientSum` counts +eigenvalue roots, not traces. Inversion pairing supplies the factor two +before the two-coordinate Markoff fiber estimate is squared. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The punctured two-coordinate low-order set is bounded by the square of +the exact combined split/nonsplit root budget. -/ +theorem two_mul_puncturedSmallNonparabolicOrder_succ_card_le_rootSumSq + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (bound : ℕ) : + 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (bound + 1)).card ≤ + (combinedTruncatedOrderTotientSum p bound) ^ 2 := by + classical + rw [ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_card_eq_normalized + ] + let smallSet := + normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (bound + 1) + let traceSet := + nonparabolicConcreteLowOrderTraceSet p (bound + 1) + have hpoints : smallSet.card ≤ 2 * traceSet.card ^ 2 := by + rw [← Finset.card_map + (f := ⟨Subtype.val, Subtype.val_injective⟩)] + exact + (Finset.card_mono + (normalizedPuncturedSmallNonparabolicOrderValues_subset_traceSet + hpTwo (bound + 1))).trans + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn_card_le traceSet) + have htraces : + 2 * traceSet.card ≤ + combinedTruncatedOrderTotientSum p bound := by + exact + two_mul_nonparabolicConcreteLowOrderTraceSet_succ_card_le_totient + bound + change + 2 * smallSet.card ≤ + (combinedTruncatedOrderTotientSum p bound) ^ 2 + calc + 2 * smallSet.card ≤ 2 * (2 * traceSet.card ^ 2) := + Nat.mul_le_mul_left 2 hpoints + _ = (2 * traceSet.card) ^ 2 := by ring + _ ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2 := by + gcongr + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean new file mode 100644 index 0000000000..93abb23b99 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean @@ -0,0 +1,481 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization + +/-! +# Exact-order Rankin envelope for the Markoff obstruction + +This file combines the new exact-order obstruction with the rational Rankin +Euler product. The deliberately coarse first endpoint uses the total numbers +of divisors of `p - 1` and `p + 1`; the already formalized Sperner width can +replace this envelope later without changing the Rankin layer. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- Coarse joint envelope for the two sets of maximal candidate orders. -/ +def jointDivisorCount (p : ℕ) : ℕ := + (p - 1).divisors.card + (p + 1).divisors.card + +/-- Exact rational Euler-product envelope for the two neighboring torus +orders. -/ +def jointRankinEulerProduct + (p : ℕ) (primeWeight : ℕ → ℚ) : ℚ := + ((p - 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime)) + + ((p + 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime)) + +theorem middleGameMaximalOrders_card_le_jointDivisorCount + (p bound : ℕ) : + (middleGameMaximalOrders p bound).card ≤ jointDivisorCount p := by + calc + (middleGameMaximalOrders p bound).card ≤ + (maximalDivisorsBelow (p - 1) (bound + 1)).card + + (maximalDivisorsBelow (p + 1) (bound + 1)).card := + middleGameMaximalOrders_card_le p bound + _ ≤ (p - 1).divisors.card + (p + 1).divisors.card := + Nat.add_le_add + (maximalDivisorsBelow_card_le_card_divisors _ _) + (maximalDivisorsBelow_card_le_card_divisors _ _) + _ = jointDivisorCount p := rfl + +/-- The Euler-seven common witness is bounded using only the two complete +divisor counts. -/ +theorem bound_le_jointDivisorCube + {p bound : ℕ} + (hbound : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) : + bound ≤ 189 * (jointDivisorCount p) ^ 3 := by + exact hbound.trans (by + gcongr + exact middleGameMaximalOrders_card_le_jointDivisorCount p bound) + +theorem combinedTruncatedOrderTotientSum_cast_le_jointFactorizationRankin + (p bound : ℕ) (hp : 1 < p) + (primeWeight : ℕ → ℚ) (cap : ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) + (hprimeWeightPower : + ∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * (primeWeight prime) ^ 12) + (hcapNonneg : 0 ≤ cap) + (hboundCap : (bound : ℚ) ≤ cap ^ 12) : + (combinedTruncatedOrderTotientSum p bound : ℚ) ≤ + (bound : ℚ) * cap * jointRankinEulerProduct p primeWeight := by + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + rw [combinedTruncatedOrderTotientSum, Nat.cast_add] + calc + (truncatedOrderTotientSum (p - 1) bound : ℚ) + + (truncatedOrderTotientSum (p + 1) bound : ℚ) ≤ + ((bound : ℚ) * cap * + ((p - 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime))) + + ((bound : ℚ) * cap * + ((p + 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime))) := + add_le_add + (truncatedOrderTotientSum_cast_le_factorizationRankin + (p - 1) bound primeWeight cap hprimeWeightNonneg + hprimeWeightPower hcapNonneg hboundCap hminusNe) + (truncatedOrderTotientSum_cast_le_factorizationRankin + (p + 1) bound primeWeight cap hprimeWeightNonneg + hprimeWeightPower hcapNonneg hboundCap hplusNe) + _ = (bound : ℚ) * cap * + jointRankinEulerProduct p primeWeight := by + simp only [jointRankinEulerProduct] + ring + +theorem jointRankinEulerProduct_nonneg + (p : ℕ) (hp : 1 < p) + (primeWeight : ℕ → ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) : + 0 ≤ jointRankinEulerProduct p primeWeight := by + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + exact add_nonneg + (factorizationEulerProduct_nonneg + (p - 1) hminusNe primeWeight hprimeWeightNonneg) + (factorizationEulerProduct_nonneg + (p + 1) hplusNe primeWeight hprimeWeightNonneg) + +/-- The exact-order obstruction, a natural cap `D` for its witness, and a +rational twelfth-root cap force one closed rational square inequality. -/ +theorem eight_mul_prime_cast_le_jointRankinSquare + {p bound D : ℕ} + (hp : 1 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hbound : bound ≤ D) + (primeWeight : ℕ → ℚ) (cap : ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) + (hprimeWeightPower : + ∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * (primeWeight prime) ^ 12) + (hcapNonneg : 0 ≤ cap) + (hDCap : (D : ℚ) ≤ cap ^ 12) : + (8 * p : ℚ) ≤ + ((D : ℚ) * cap * jointRankinEulerProduct p primeWeight) ^ 2 := by + have hboundCast : (bound : ℚ) ≤ D := by + exact_mod_cast hbound + have hboundCap : (bound : ℚ) ≤ cap ^ 12 := by + exact hboundCast.trans hDCap + have hRankin := + combinedTruncatedOrderTotientSum_cast_le_jointFactorizationRankin + p bound hp primeWeight cap hprimeWeightNonneg + hprimeWeightPower hcapNonneg hboundCap + have hEulerNonneg := + jointRankinEulerProduct_nonneg p hp primeWeight + hprimeWeightNonneg + have hUpper : + (combinedTruncatedOrderTotientSum p bound : ℚ) ≤ + (D : ℚ) * cap * jointRankinEulerProduct p primeWeight := by + calc + (combinedTruncatedOrderTotientSum p bound : ℚ) ≤ + (bound : ℚ) * cap * + jointRankinEulerProduct p primeWeight := hRankin + _ ≤ (D : ℚ) * cap * + jointRankinEulerProduct p primeWeight := by + exact mul_le_mul_of_nonneg_right + (mul_le_mul_of_nonneg_right hboundCast hcapNonneg) + hEulerNonneg + have hrootCast : + (8 * p : ℚ) ≤ + (combinedTruncatedOrderTotientSum p bound : ℚ) ^ 2 := by + exact_mod_cast hroot + have hcombinedNonneg : + (0 : ℚ) ≤ combinedTruncatedOrderTotientSum p bound := by + positivity + have hrightNonneg : + (0 : ℚ) ≤ + (D : ℚ) * cap * jointRankinEulerProduct p primeWeight := by + positivity + exact hrootCast.trans + ((sq_le_sq₀ hcombinedNonneg hrightNonneg).2 hUpper) + +/-- Soundness boundary for one complete factorization profile. Coverage is +kept separate: this theorem only assumes the two semantic majorizations that +a later canonical-profile theorem must provide. -/ +theorem prime_le_of_rankinNeighborProfile_closes + {p bound cutoff : ℕ} + (hp : 1 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hcloses : profile.ClosesCutoff cutoff) + (primeWeight : ℕ → ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) + (hprimeWeightPower : + ∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * (primeWeight prime) ^ 12) + (hdivisorCount : + jointDivisorCount p ≤ profile.jointDivisorCount) + (hEuler : + jointRankinEulerProduct p primeWeight ≤ + profile.jointCoarseEulerProduct) : + p ≤ cutoff := by + rcases hprofile with + ⟨htwo, htwoWeight, htwoFloor, hodd, + hfloors, hrootCapPos, hwitnessCap⟩ + have hboundJoint := + bound_le_jointDivisorCube hboundWitness + have hboundProfile : bound ≤ profile.witnessCap := by + exact hboundJoint.trans (by + simp only [RankinNeighborProfile.witnessCap] + gcongr) + have hrootCapNonneg : (0 : ℚ) ≤ profile.rootCap := by + positivity + have hwitnessCapCast : + (profile.witnessCap : ℚ) ≤ (profile.rootCap : ℚ) ^ 12 := by + exact_mod_cast hwitnessCap + have hfailure := + eight_mul_prime_cast_le_jointRankinSquare + hp hroot hboundProfile primeWeight profile.rootCap + hprimeWeightNonneg hprimeWeightPower hrootCapNonneg + hwitnessCapCast + have hEulerActualNonneg := + jointRankinEulerProduct_nonneg p hp primeWeight + hprimeWeightNonneg + have hEulerProfileNonneg : + (0 : ℚ) ≤ profile.jointCoarseEulerProduct := + hEulerActualNonneg.trans hEuler + have hscaleNonneg : + (0 : ℚ) ≤ (profile.witnessCap : ℚ) * profile.rootCap := by + positivity + have hupper : + (profile.witnessCap : ℚ) * profile.rootCap * + jointRankinEulerProduct p primeWeight ≤ + (profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct := + mul_le_mul_of_nonneg_left hEuler hscaleNonneg + have hleftNonneg : + (0 : ℚ) ≤ + (profile.witnessCap : ℚ) * profile.rootCap * + jointRankinEulerProduct p primeWeight := by + positivity + have hrightNonneg : + (0 : ℚ) ≤ + (profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct := by + positivity + have hprofileSquare : + (8 * p : ℚ) ≤ + ((profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct) ^ 2 := + hfailure.trans ((sq_le_sq₀ hleftNonneg hrightNonneg).2 hupper) + by_contra hnot + have hcutoffSucc : cutoff + 1 ≤ p := by omega + have hcutoffCast : + (8 * (cutoff + 1) : ℚ) ≤ (8 * p : ℚ) := by + exact_mod_cast Nat.mul_le_mul_left 8 hcutoffSucc + have hclosesCast : + ((profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct) ^ 2 < + (8 * (cutoff + 1) : ℚ) := by + simpa only [RankinNeighborProfile.ClosesCutoff, + RankinNeighborProfile.failureSquare, + Nat.cast_mul, Nat.cast_add, Nat.cast_ofNat, + Nat.cast_one] using hcloses + exact (not_lt_of_ge (hcutoffCast.trans hprofileSquare)) hclosesCast + +/-- The semantic matching theorem discharges both majorization hypotheses of +`prime_le_of_rankinNeighborProfile_closes`. A valid, closing profile that +matches the actual factorizations of `p - 1` and `p + 1` therefore bounds the +prime directly. -/ +theorem prime_le_of_matching_rankinNeighborProfile_closes + {p bound cutoff : ℕ} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hcloses : profile.ClosesCutoff cutoff) + (hmatch : profile.Matches p) : + p ≤ cutoff := by + have hp : 1 < p := by omega + obtain ⟨assignment, hweightNonneg, hweightPower, + hminusEuler, hplusEuler⟩ := + profile.exists_assignedPrimeWeight_bounds + hpPrime hpTwo hprofile hmatch + have hdivisorEq := + profile.jointDivisorCount_eq_neighborCards + hpPrime hpTwo hmatch + apply prime_le_of_rankinNeighborProfile_closes + hp hroot hboundWitness profile hprofile hcloses + (assignedPrimeWeight p profile assignment) + hweightNonneg hweightPower + · change + (p - 1).divisors.card + (p + 1).divisors.card ≤ + profile.jointDivisorCount + exact le_of_eq hdivisorEq.symm + · change + ((p - 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent + (assignedPrimeWeight p profile assignment prime)) + + ((p + 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent + (assignedPrimeWeight p profile assignment prime)) ≤ + profile.coarseEulerProduct .minus + + profile.coarseEulerProduct .plus + exact add_le_add hminusEuler hplusEuler + +/-- The exact-order obstruction forces the profile failure square itself, +after both semantic bounds have been discharged by matching. -/ +theorem eight_mul_prime_cast_le_matching_profile_failureSquare + {p bound : ℕ} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) : + (8 * p : ℚ) ≤ profile.failureSquare := by + have hp : 1 < p := by omega + obtain ⟨assignment, hweightNonneg, hweightPower, + hminusEuler, hplusEuler⟩ := + profile.exists_assignedPrimeWeight_bounds + hpPrime hpTwo hprofile hmatch + have hdivisorEq := + profile.jointDivisorCount_eq_neighborCards + hpPrime hpTwo hmatch + have hboundJoint := bound_le_jointDivisorCube hboundWitness + have hboundProfile : bound ≤ profile.witnessCap := by + apply hboundJoint.trans + simp only [RankinNeighborProfile.witnessCap] + gcongr + change + (p - 1).divisors.card + (p + 1).divisors.card ≤ + profile.jointDivisorCount + exact le_of_eq hdivisorEq.symm + have hrootCapNonneg : (0 : ℚ) ≤ profile.rootCap := by positivity + have hwitnessCapCast : + (profile.witnessCap : ℚ) ≤ (profile.rootCap : ℚ) ^ 12 := by + exact_mod_cast hprofile.2.2.2.2.2.2 + have hfailure := + eight_mul_prime_cast_le_jointRankinSquare + hp hroot hboundProfile + (assignedPrimeWeight p profile assignment) profile.rootCap + hweightNonneg hweightPower hrootCapNonneg hwitnessCapCast + have hEuler : + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) ≤ + profile.jointCoarseEulerProduct := by + exact add_le_add hminusEuler hplusEuler + have hEulerActualNonneg := + jointRankinEulerProduct_nonneg p hp + (assignedPrimeWeight p profile assignment) hweightNonneg + have hEulerProfileNonneg : + (0 : ℚ) ≤ profile.jointCoarseEulerProduct := + hEulerActualNonneg.trans hEuler + have hscaleNonneg : + (0 : ℚ) ≤ (profile.witnessCap : ℚ) * profile.rootCap := by + positivity + have hupper : + (profile.witnessCap : ℚ) * profile.rootCap * + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) ≤ + (profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct := + mul_le_mul_of_nonneg_left hEuler hscaleNonneg + have hleftNonneg : + (0 : ℚ) ≤ + (profile.witnessCap : ℚ) * profile.rootCap * + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) := by + positivity + have hrightNonneg : + (0 : ℚ) ≤ + (profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct := by + positivity + simpa only [RankinNeighborProfile.failureSquare] using + hfailure.trans ((sq_le_sq₀ hleftNonneg hrightNonneg).2 hupper) + +/-- A checked lower-product exclusion cannot coexist with the exact-order +failure obstruction. -/ +theorem false_of_matching_rankinNeighborProfile_excludes + {p bound : ℕ} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) + (hexcludes : profile.ExcludesFailure) : False := by + have hfailure := + eight_mul_prime_cast_le_matching_profile_failureSquare + hpPrime hpTwo hroot hboundWitness profile hprofile hmatch + have hlower := + profile.lowerNeighborProducts_le hpPrime hpTwo hmatch + rcases hexcludes with hminus | hplus | hjoint + · have hlowerPrime : + profile.lowerNeighborProduct .minus + 1 ≤ p := by omega + have hlowerCast : + (((8 * (profile.lowerNeighborProduct .minus + 1) : ℕ) : ℚ)) ≤ + (8 * p : ℚ) := by + exact_mod_cast Nat.mul_le_mul_left 8 hlowerPrime + exact (not_lt_of_ge (hlowerCast.trans hfailure)) hminus + · have hlowerPrime : + profile.lowerNeighborProduct .plus - 1 ≤ p := by omega + have hlowerCast : + (((8 * (profile.lowerNeighborProduct .plus - 1) : ℕ) : ℚ)) ≤ + (8 * p : ℚ) := by + have hnat := Nat.mul_le_mul_left 8 hlowerPrime + exact_mod_cast hnat + exact (not_lt_of_ge (hlowerCast.trans hfailure)) hplus + · have hneighborProduct : + profile.lowerNeighborProduct .minus * + profile.lowerNeighborProduct .plus ≤ + (p - 1) * (p + 1) := + Nat.mul_le_mul hlower.1 hlower.2 + have hneighborLt : (p - 1) * (p + 1) < p ^ 2 := by + have hsub : p - 1 + 1 = p := by omega + nlinarith + have hlowerJointCast : + (((64 * (profile.lowerNeighborProduct .minus * + profile.lowerNeighborProduct .plus) : ℕ) : ℚ)) < + (64 * p ^ 2 : ℚ) := by + have hnat := (Nat.mul_lt_mul_left (by omega : 0 < 64)).2 + (hneighborProduct.trans_lt hneighborLt) + exact_mod_cast hnat + have hfailureNonneg : (0 : ℚ) ≤ profile.failureSquare := by + rw [RankinNeighborProfile.failureSquare] + exact sq_nonneg _ + have heighthPrimeNonneg : (0 : ℚ) ≤ (8 * p : ℚ) := by positivity + have hfailureSquared : + (64 * p ^ 2 : ℚ) ≤ profile.failureSquare ^ 2 := by + have hsquare := + (sq_le_sq₀ heighthPrimeNonneg hfailureNonneg).2 hfailure + norm_num [mul_pow] at hsquare ⊢ + exact hsquare + exact (not_lt_of_ge + (hlowerJointCast.le.trans hfailureSquared)) hjoint + +/-- Every fully matched profile can be certified by either a direct cutoff +closure or a lower-product exclusion. This disjunction is the leaf predicate +for the forthcoming exhaustive profile tree. -/ +theorem prime_le_of_matching_rankinNeighborProfile_closes_or_excludes + {p bound cutoff : ℕ} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) + (hleaf : profile.ClosesCutoff cutoff ∨ profile.ExcludesFailure) : + p ≤ cutoff := by + rcases hleaf with hcloses | hexcludes + · exact prime_le_of_matching_rankinNeighborProfile_closes + hpPrime hpTwo hroot hboundWitness profile hprofile hcloses hmatch + · exact False.elim + (false_of_matching_rankinNeighborProfile_excludes + hpPrime hpTwo hroot hboundWitness profile hprofile hmatch hexcludes) + +/-- Side-erased profiles eliminate the exponential assignment word from the +future exhaustive search: it is enough to check the product envelope leaf. -/ +theorem prime_le_of_matching_rankinNeighborProfile_jointEnvelope_leaf + {p bound cutoff : ℕ} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) + (hleaf : + profile.JointEnvelopeClosesCutoff cutoff ∨ + profile.JointEnvelopeExcludesFailure) : + p ≤ cutoff := by + apply prime_le_of_matching_rankinNeighborProfile_closes_or_excludes + hpPrime hpTwo hroot hboundWitness profile hprofile hmatch + rcases hleaf with hcloses | hexcludes + · exact Or.inl + (profile.jointEnvelopeClosesCutoff_implies_closesCutoff + hprofile hcloses) + · exact Or.inr + (profile.jointEnvelopeExcludesFailure_implies_excludesFailure + hprofile hexcludes) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean new file mode 100644 index 0000000000..078ebe1e48 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient + +/-! +# Exact-order root budgets for nonparabolic traces + +The old maximal-divisor estimate replaces each exact-order fiber by a common +worst-case size. Here the cyclic fibers remain disjoint and contribute their +exact root counts `φ(e)`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +theorem pow_two_ne_one_iff_two_lt_orderOf + {G : Type*} [Group G] [Finite G] (x : G) : + x ^ 2 ≠ 1 ↔ 2 < orderOf x := by + constructor + · intro hpow + have hpos : 0 < orderOf x := + (isOfFinOrder_of_finite x).orderOf_pos + by_contra hnot + have hle : orderOf x ≤ 2 := Nat.le_of_not_gt hnot + have hcases : orderOf x = 1 ∨ orderOf x = 2 := by + omega + have hdvd : orderOf x ∣ 2 := by + rcases hcases with horder | horder <;> simp [horder] + exact hpow (orderOf_dvd_iff_pow_eq_one.mp hdvd) + · intro horder hpow + have hdvd : orderOf x ∣ 2 := + orderOf_dvd_of_pow_eq_one hpow + have hle : orderOf x ≤ 2 := + Nat.le_of_dvd (by norm_num) hdvd + omega + +section CyclicTrace + +variable {G T : Type*} [Group G] [Fintype G] [DecidableEq G] + [DecidableEq T] [IsCyclic G] + +theorem nonTwoTorsionBoundedOrderTraceSet_succ_eq_exactOrderImage + (trace : G → T) (bound : ℕ) : + nonTwoTorsionBoundedOrderTraceSet trace (bound + 1) = + (elementsOfOrderBetweenThreeAnd G bound).image trace := by + unfold nonTwoTorsionBoundedOrderTraceSet + congr 1 + ext x + simp only [Finset.mem_filter, Finset.mem_univ, true_and, + mem_elementsOfOrderBetweenThreeAnd_iff, + pow_two_ne_one_iff_two_lt_orderOf] + omega + +/-- An inversion-invariant trace map has at most half the exact cyclic root +budget in the non-two-torsion truncated range. -/ +theorem two_mul_nonTwoTorsionBoundedOrderTraceSet_succ_card_le_totient + (trace : G → T) (bound : ℕ) + (htraceInv : ∀ x, trace x⁻¹ = trace x) : + 2 * (nonTwoTorsionBoundedOrderTraceSet + trace (bound + 1)).card ≤ + truncatedOrderTotientSum (Fintype.card G) bound := by + let roots := elementsOfOrderBetweenThreeAnd G bound + have hsinv : ∀ x ∈ roots, x⁻¹ ∈ roots := by + intro x hx + rw [show roots = elementsOfOrderBetweenThreeAnd G bound by rfl, + mem_elementsOfOrderBetweenThreeAnd_iff] + have hxData := + mem_elementsOfOrderBetweenThreeAnd_iff.mp + (by simpa [roots] using hx) + simpa using hxData + have hnofixed : ∀ x ∈ roots, x⁻¹ ≠ x := by + intro x hx hinv + have hxOrder : + 2 < orderOf x := + (mem_elementsOfOrderBetweenThreeAnd_iff.mp + (by simpa [roots] using hx)).1 + have hxPow : x ^ 2 ≠ 1 := + (pow_two_ne_one_iff_two_lt_orderOf x).mpr hxOrder + apply hxPow + calc + x ^ 2 = x * x := pow_two x + _ = x * x⁻¹ := congrArg (fun z ↦ x * z) hinv.symm + _ = 1 := mul_inv_cancel x + rw [nonTwoTorsionBoundedOrderTraceSet_succ_eq_exactOrderImage] + calc + 2 * (roots.image trace).card ≤ roots.card := + two_mul_card_image_le_card_of_inv_invariant_of_no_fixed + roots trace hsinv htraceInv hnofixed + _ = truncatedOrderTotientSum (Fintype.card G) bound := + elementsOfOrderBetweenThreeAnd_card_eq_truncatedOrderTotientSum + G bound + +end CyclicTrace + +/-- Exact combined root budget for the split and nonsplit rotation tori. -/ +def combinedTruncatedOrderTotientSum (p bound : ℕ) : ℕ := + truncatedOrderTotientSum (p - 1) bound + + truncatedOrderTotientSum (p + 1) bound + +/-- The concrete nonparabolic trace set is bounded by the exact combined +root-order budget. -/ +theorem two_mul_nonparabolicConcreteLowOrderTraceSet_succ_card_le_totient + {p : ℕ} [Fact p.Prime] (bound : ℕ) : + 2 * (nonparabolicConcreteLowOrderTraceSet + p (bound + 1)).card ≤ + combinedTruncatedOrderTotientSum p bound := by + classical + let splitSet := + nonTwoTorsionBoundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) (bound + 1) + let nonsplitSet := + nonTwoTorsionBoundedOrderTraceSet + (quadraticNormOneTrace p) (bound + 1) + have hsplit : + 2 * splitSet.card ≤ + truncatedOrderTotientSum + (Fintype.card (ZMod p)ˣ) bound := by + exact + two_mul_nonTwoTorsionBoundedOrderTraceSet_succ_card_le_totient + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound + (splitTorusTrace_inv (ZMod p)) + have hnonsplit : + 2 * nonsplitSet.card ≤ + truncatedOrderTotientSum + (Fintype.card (quadraticNormOneTorus p)) bound := by + exact + two_mul_nonTwoTorsionBoundedOrderTraceSet_succ_card_le_totient + (quadraticNormOneTrace p) bound + (quadraticNormOneTrace_inv p) + have hsplitCard : Fintype.card (ZMod p)ˣ = p - 1 := by + rw [← Nat.card_eq_fintype_card, Nat.card_units, Nat.card_zmod] + have hnonsplitCard : + Fintype.card (quadraticNormOneTorus p) = p + 1 := by + rw [← Nat.card_eq_fintype_card, quadraticNormOneTorus_natCard] + calc + 2 * (nonparabolicConcreteLowOrderTraceSet + p (bound + 1)).card ≤ + 2 * (splitSet.card + nonsplitSet.card) := by + apply Nat.mul_le_mul_left + simpa [nonparabolicConcreteLowOrderTraceSet, splitSet, nonsplitSet] using + (Finset.card_union_le splitSet nonsplitSet) + _ = 2 * splitSet.card + 2 * nonsplitSet.card := by ring + _ ≤ truncatedOrderTotientSum + (Fintype.card (ZMod p)ˣ) bound + + truncatedOrderTotientSum + (Fintype.card (quadraticNormOneTorus p)) bound := by + omega + _ = combinedTruncatedOrderTotientSum p bound := by + rw [hsplitCard, hnonsplitCard] + rfl + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean new file mode 100644 index 0000000000..ac098b3454 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean @@ -0,0 +1,114 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity + +/-! +# Exceptional-prime consequences of Chen orbit divisibility + +Chen's component-divisibility theorem, formalized here through Martin's later elementary proof, +upgrades the giant-orbit half of Theorem 1 to strong approximation at every sufficiently large +prime. This file records the resulting finite exceptional-prime set and derives the subpower +exceptional-prime bound of Theorem 2. +-/ + +namespace BGS.Markoff + +open Filter +open scoped Topology + +/-- If strong approximation holds at every prime beyond `p0`, then at most `p0` primes are +exceptional below any cutoff. -/ +theorem exceptionalPrimeCount_le_of_eventually_strongApproximationAt + (p0 : ℕ) + (hstrong : ∀ (p : ℕ), p.Prime → p0 ≤ p → StrongApproximationAt p) + (T : ℕ) : + exceptionalPrimeCount T ≤ p0 := by + rw [exceptionalPrimeCount] + calc + {p : ℕ | p ≤ T ∧ IsExceptionalPrime p}.ncard ≤ (Set.Iio p0).ncard := by + refine Set.ncard_le_ncard ?_ (Set.toFinite (Set.Iio p0)) + intro p hp + change p ≤ T ∧ IsExceptionalPrime p at hp + rcases hp.2 with ⟨hpPrime, hpFailure⟩ + change p < p0 + by_contra hpNotLt + exact hpFailure (hstrong p hpPrime (Nat.le_of_not_gt hpNotLt)) + _ = p0 := Set.ncard_Iio_nat p0 + +/-- Eventual strong approximation implies the subpower exceptional-prime estimate of +`TheoremTwoStatement`. -/ +theorem theoremTwoStatement_of_eventually_strongApproximationAt + (hstrong : ∃ p0 : ℕ, ∀ (p : ℕ), p.Prime → p0 ≤ p → StrongApproximationAt p) : + TheoremTwoStatement := by + obtain ⟨p0, hp0⟩ := hstrong + intro epsilon hepsilon + have hEventually : + ∀ᶠ T : ℕ in atTop, (p0 : ℝ) ≤ (T : ℝ) ^ epsilon := + ((tendsto_rpow_atTop hepsilon).comp tendsto_natCast_atTop_atTop).eventually + (eventually_ge_atTop (p0 : ℝ)) + rw [eventually_atTop] at hEventually + obtain ⟨T0, hT0⟩ := hEventually + refine ⟨T0, fun T hT => ?_⟩ + have hcount : exceptionalPrimeCount T ≤ p0 := + exceptionalPrimeCount_le_of_eventually_strongApproximationAt p0 hp0 T + have hcountReal : (exceptionalPrimeCount T : ℝ) ≤ p0 := by + exact_mod_cast hcount + exact hcountReal.trans (hT0 T hT) + +/-- The giant-orbit half of Theorem 1 and Chen orbit divisibility, via Martin's proof, imply +eventual punctured finite-field transitivity. -/ +theorem eventually_puncturedMarkoffTransitiveAt_of_theoremOneStatement + (hOne : TheoremOneStatement) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → + PuncturedMarkoffTransitiveAt p hp := by + exact eventually_puncturedMarkoffTransitiveAt_of_giantOrbit + (1 / 2 : ℝ) (by norm_num) (hOne.1 (1 / 2 : ℝ) (by norm_num)) + +/-- Theorem 1 and Chen orbit divisibility, through Martin's proof, imply eventual strong +approximation after applying natural Markoff connectivity. -/ +theorem eventually_strongApproximationAt_of_theoremOneStatement + (hOne : TheoremOneStatement) : + ∃ p0 : ℕ, ∀ (p : ℕ), p.Prime → p0 ≤ p → StrongApproximationAt p := by + obtain ⟨p0, hp0⟩ := + eventually_puncturedMarkoffTransitiveAt_of_theoremOneStatement hOne + refine ⟨p0, fun p hp hple => ?_⟩ + exact (puncturedMarkoffTransitiveAt_iff_strongApproximationAt p hp).mp + (hp0 p hp hple) + +/-- The general-interface form of eventual BGS Conjecture 1. + +Theorem 1 and Chen's orbit-divisibility theorem, via Martin's proof, imply +strong approximation at every sufficiently large prime. The parameter-free endpoint is +`BGS.Markoff.eventually_strongApproximationAt`. -/ +theorem eventually_strongApproximationAt_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + ∃ p0 : ℕ, ∀ (p : ℕ), p.Prime → p0 ≤ p → StrongApproximationAt p := + eventually_strongApproximationAt_of_theoremOneStatement + (theoremOneStatement_of_generalHasseWeil hHasse) + +/-- Theorem 1 together with Chen's orbit-divisibility theorem, via Martin's elementary proof, +implies Theorem 2. -/ +theorem theoremTwoStatement_of_theoremOneStatement + (hOne : TheoremOneStatement) : + TheoremTwoStatement := + theoremTwoStatement_of_eventually_strongApproximationAt + (eventually_strongApproximationAt_of_theoremOneStatement hOne) + +/-- The general-interface form of BGS Theorem 2. + +The completed Theorem 1 assembly supplies the in-repository Corvaja--Zannier +estimate. The parameter-free endpoint is +`BGS.Markoff.theoremTwoStatement`. -/ +theorem theoremTwoStatement_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + TheoremTwoStatement := + theoremTwoStatement_of_theoremOneStatement + (theoremOneStatement_of_generalHasseWeil hHasse) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean new file mode 100644 index 0000000000..867c06c1ec --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean @@ -0,0 +1,328 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame + +/-! +# Explicit punctured transitivity + +This file isolates the finite maximal-orbit argument used by the explicit +punctured-transitivity proof. The only geometric input is a stated +large-order-to-base-component hypothesis; the middle-game step is the proved +Corvaja--Zannier escape theorem. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The normalized surface point underlying an original punctured point. -/ +private def normalizedPuncturedPoint + {R : Type*} [Field R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : NormalizedMarkoffSurface R := + normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x) + +/-- Normalizing an original punctured point intertwines the two `Gamma` +actions. -/ +private theorem normalizedPuncturedPoint_smul + {R : Type*} [Field R] [Invertible (3 : R)] + (g : Gamma R) (z : PuncturedMarkoffSurface R) : + normalizedPuncturedPoint (g • z) = + normalizedGammaPerm R g (normalizedPuncturedPoint z) := by + have hzinv : + (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R z)) = z.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply z.1.1 + unfold normalizedPuncturedPoint + rw [normalizedGammaPerm_apply, hzinv] + apply Subtype.ext + rfl + +/-- The finite maximal-orbit argument at a fixed prime. The hypotheses expose +exactly the three frontiers consumed by the argument: the divisor-sensitive +count forces the cubic middle-game bound, the upper range supplies the linear +bound, and large order connects to one base component. -/ +theorem puncturedMarkoffTransitiveAt_of_maximalOrbit_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hcube : ∀ d : ℕ, 0 < d → + p ≤ 2 * (2 + d * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 → + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < d) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * d < p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent (normalizedPuncturedPoint c) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + classical + have hpTwo : p ≠ 2 := by omega + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent c x := by + intro x + by_contra hcx + let orderMeasure : PuncturedMarkoffSurface (ZMod p) → ℕ := fun w => + maximalCoordinateRotationOrder (normalizedPuncturedPoint w).1 + let orbitFinset := (puncturedGammaOrbit x).toFinite.toFinset + have hxMem : x ∈ orbitFinset := by + have hxOrbit : x ∈ puncturedGammaOrbit x := samePuncturedComponent_refl x + simpa [orbitFinset] using hxOrbit + obtain ⟨z, hzMem, hzMax⟩ := + Finset.exists_max_image orbitFinset orderMeasure ⟨x, hxMem⟩ + let d := orderMeasure z + have hzComponent : SamePuncturedComponent x z := by + change z ∈ puncturedGammaOrbit x + simpa [orbitFinset] using hzMem + have hmax : ∀ w : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent x w → orderMeasure w ≤ d := by + intro w hw + apply hzMax w + change w ∈ puncturedGammaOrbit x at hw + simpa [orbitFinset] using hw + have hdPos : 0 < d := by + have hfirstPos : 0 < rotationOrder (normalizedPuncturedPoint z).1.u1 := + rotationOrder_pos _ + exact hfirstPos.trans_le <| by + simpa [d, orderMeasure] using + rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPoint z).1 + have hnotBaseZ : ¬ SameNormalizedComponent + (normalizedPuncturedPoint c) (normalizedPuncturedPoint z) := by + intro hcz + apply hcx + have hczPunctured : SamePuncturedComponent c z := + (samePuncturedComponent_iff_sameNormalizedComponent c z).2 hcz + exact samePuncturedComponent_trans hczPunctured + (samePuncturedComponent_symm hzComponent) + have hdUpper : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + by_contra hd + apply hnotBaseZ + apply hlarge (normalizedPuncturedPoint z) + simpa [d, orderMeasure] using le_of_not_gt hd + have hpLeOrbit : p ≤ (puncturedGammaOrbit x).ncard := by + have horbitPos : 0 < (puncturedGammaOrbit x).ncard := + (Set.ncard_pos (Set.toFinite _)).2 ⟨x, samePuncturedComponent_refl x⟩ + exact Nat.le_of_dvd horbitPos + (prime_dvd_puncturedGammaOrbit_ncard p hpThree x) + have horbitSmall : (puncturedGammaOrbit x).ncard ≤ + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1)).card := by + rw [Set.ncard_eq_toFinset_card (puncturedGammaOrbit x) (Set.toFinite _)] + apply Finset.card_le_card + intro w hwFinset + have hw : SamePuncturedComponent x w := by + change w ∈ puncturedGammaOrbit x + simpa [orbitFinset] using hwFinset + have hwMax := hmax w hw + have hfirst : rotationOrder (normalizedPuncturedPoint w).1.u1 ≤ d := + (rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPoint w).1).trans hwMax + have hsecond : rotationOrder (normalizedPuncturedPoint w).1.u2 ≤ d := + (rotationOrder_second_le_maximalCoordinateRotationOrder + (normalizedPuncturedPoint w).1).trans hwMax + change w ∈ puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1) + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] + constructor + · simpa only [normalizedPuncturedPoint, normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hfirst + · simpa only [normalizedPuncturedPoint, normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hsecond + have hpLeSmallOrderSet : p ≤ 2 * (2 + d * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := by + calc + p ≤ (puncturedGammaOrbit x).ncard := hpLeOrbit + _ ≤ (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1)).card := + horbitSmall + _ ≤ 2 * (2 + d * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := + puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_succ_card_le_divisor_sensitive + hpTwo d + have hcube' := hcube d hdPos hpLeSmallOrderSet + have hlinear' := hlinear d hdUpper + obtain ⟨y, hzy, hincrease⟩ := + exists_sameNormalizedComponent_maximalOrder_increase_of_directBounds + p hpTwo (δ := (1 / 3 : ℝ)) (by norm_num) + (corvajaZannierWeightedTraceBound p (quadraticFiniteField p)) + (normalizedPuncturedPoint z) + (by simpa only [show (1 / 2 + 1 / 3 : ℝ) = 5 / 6 by norm_num, + d, orderMeasure] using hdUpper) + (by simpa [d, orderMeasure] using hcube') + (by simpa [d, orderMeasure] using hlinear') + obtain ⟨g, hg⟩ := + (sameNormalizedComponent_iff_exists_gamma (normalizedPuncturedPoint z) y).1 hzy + let w : PuncturedMarkoffSurface (ZMod p) := g • z + have hwComponent : SamePuncturedComponent x w := + samePuncturedComponent_trans hzComponent + ((samePuncturedComponent_iff_exists z w).2 ⟨g, rfl⟩) + have hwNormalized : normalizedPuncturedPoint w = y := by + change normalizedPuncturedPoint (g • z) = y + rw [normalizedPuncturedPoint_smul] + exact hg + have hwMax := hmax w hwComponent + change maximalCoordinateRotationOrder (normalizedPuncturedPoint w).1 ≤ d at hwMax + rw [hwNormalized] at hwMax + have hincrease' : d < maximalCoordinateRotationOrder y.1 := by + simpa [d, orderMeasure] using hincrease + exact (not_lt_of_ge hwMax) hincrease' + intro a b + obtain ⟨ga, hga⟩ := (samePuncturedComponent_iff_exists c a).1 (hAll a) + obtain ⟨gb, hgb⟩ := (samePuncturedComponent_iff_exists c b).1 (hAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • c := by rw [← hga]; simp + _ = b := hgb + +private theorem explicitCutoff_seven_le_for_assembly + {p : ℕ} [Fact p.Prime] + (hp : explicitStrongApproximationCutoff ≤ p) : 7 ≤ p := by + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (explicitCutoff_gt_one.trans_le hp).le + have hrootLe : (p : ℝ) ^ (1 / 8 : ℝ) ≤ p := by + simpa using Real.rpow_le_self_of_one_le hpOne (by norm_num : (1 / 8 : ℝ) ≤ 1) + have hfiveRoot : (5 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + small_fixed_lt_rpow_one_div_eight_of_explicitCutoff hp (by norm_num) + have hfive : 5 < p := by + exact_mod_cast hfiveRoot.trans_le hrootLe + have hpSix : p ≠ 6 := by + intro hpEq + subst p + have hprime : Nat.Prime 6 := Fact.out + norm_num at hprime + omega + +/-- **Explicit punctured transitivity.** The closed cutoff supplies +all numerical estimates; the large-order route and cage connectivity are the +pointwise explicit endgame theorems. -/ +theorem puncturedMarkoffTransitiveAt_of_explicitCutoff + (p : ℕ) (hpPrime : p.Prime) + (hp : explicitStrongApproximationCutoff ≤ p) : + PuncturedMarkoffTransitiveAt p hpPrime := by + letI : Fact p.Prime := ⟨hpPrime⟩ + have hpSeven : 7 ≤ p := explicitCutoff_seven_le_for_assembly hp + have hpThree : 3 < p := by omega + have hthree : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) hpThree) hpDvd + letI : Invertible (3 : ZMod p) := invertibleOfNonzero hthree + obtain ⟨baseNormalized, hbaseCage⟩ := + exists_normalizedPunctured_splitCagePoint p hpSeven + let base : PuncturedMarkoffSurface (ZMod p) := + (puncturedNormalizationEquiv (ZMod p)).symm baseNormalized + apply puncturedMarkoffTransitiveAt_of_maximalOrbit_frontier p hpThree base + · intro d hdPos hpLe + exact explicit_lowOrder_divisorSensitive_cube hp hdPos hpLe + · intro d hUpper + exact explicit_middleGame_corvajaZannier_linearBound hp hUpper + · intro z hzLarge + have hcoordinate : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u3 := by + by_contra hsmall + push_neg at hsmall + have hmaxSmall : (maximalCoordinateRotationOrder z.1 : ℝ) < + (p : ℝ) ^ (5 / 6 : ℝ) := by + rw [maximalCoordinateRotationOrder, Nat.cast_max, Nat.cast_max] + exact max_lt hsmall.1 (max_lt hsmall.2.1 hsmall.2.2) + exact (not_lt_of_ge hzLarge) hmaxSmall + have hcomponent := + explicit_sameNormalizedComponent_of_largeOrder_to_splitCage + hp (normalizedSurfaceOfPunctured baseNormalized) z hbaseCage hcoordinate + simpa [base, normalizedPuncturedPoint] using hcomponent + +/-- Raw-expression form of the explicit endpoint. This displays the actual +closed natural-number bound without requiring clients to unfold either sealed +constant. -/ +theorem puncturedMarkoffTransitiveAt_of_concreteExplicitBound + (p : ℕ) (hpPrime : p.Prime) + (hp : (2 ^ 9 * (48 ^ 3 + 1) ^ 18 * + (2 ^ 9 * (9 ^ 9) ^ (2 ^ 9)) ^ 8 + 1) ≤ p) : + PuncturedMarkoffTransitiveAt p hpPrime := by + apply puncturedMarkoffTransitiveAt_of_explicitCutoff p hpPrime + simpa only [explicitStrongApproximationCutoff_eq, + explicitDivisorMomentConstant_eq] using hp + +private theorem preliminaryCutoff_seven_le_for_assembly + {p : ℕ} [Fact p.Prime] + (hp : preliminaryStrongApproximationCutoff ≤ p) : 7 ≤ p := by + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (preliminaryCutoff_gt_one.trans_le hp).le + have hrootLe : (p : ℝ) ^ (1 / 8 : ℝ) ≤ p := by + simpa using + Real.rpow_le_self_of_one_le hpOne (by norm_num : (1 / 8 : ℝ) ≤ 1) + have hfiveRoot : (5 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + preliminary_small_fixed_lt_rpow_one_div_eight hp (by norm_num) + have hfive : 5 < p := by + exact_mod_cast hfiveRoot.trans_le hrootLe + have hpSix : p ≠ 6 := by + intro hpEq + subst p + have hprime : Nat.Prime 6 := Fact.out + norm_num at hprime + omega +/-- **Elementary preliminary-route punctured transitivity.** This is the +paper's all-divisors Corvaja--Zannier route with the analytic Nicolas estimate +replaced by the fully formalized elementary tenth-moment divisor bound. -/ +theorem puncturedMarkoffTransitiveAt_of_preliminaryCutoff + (p : ℕ) (hpPrime : p.Prime) + (hp : preliminaryStrongApproximationCutoff ≤ p) : + PuncturedMarkoffTransitiveAt p hpPrime := by + letI : Fact p.Prime := ⟨hpPrime⟩ + have hpSeven : 7 ≤ p := preliminaryCutoff_seven_le_for_assembly hp + have hpThree : 3 < p := by omega + have hthree : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) hpThree) hpDvd + letI : Invertible (3 : ZMod p) := invertibleOfNonzero hthree + obtain ⟨baseNormalized, hbaseCage⟩ := + exists_normalizedPunctured_splitCagePoint p hpSeven + let base : PuncturedMarkoffSurface (ZMod p) := + (puncturedNormalizationEquiv (ZMod p)).symm baseNormalized + apply puncturedMarkoffTransitiveAt_of_maximalOrbit_frontier p hpThree base + · intro d hdPos hpLe + exact preliminary_lowOrder_divisorSensitive_cube hp hdPos hpLe + · intro d hUpper + exact preliminary_middleGame_corvajaZannier_linearBound hp hUpper + · intro z hzLarge + have hcoordinate : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder z.1.u3 := by + by_contra hsmall + push_neg at hsmall + have hmaxSmall : (maximalCoordinateRotationOrder z.1 : ℝ) < + (p : ℝ) ^ (5 / 6 : ℝ) := by + rw [maximalCoordinateRotationOrder, Nat.cast_max, Nat.cast_max] + exact max_lt hsmall.1 (max_lt hsmall.2.1 hsmall.2.2) + exact (not_lt_of_ge hzLarge) hmaxSmall + have hcomponent := + preliminary_sameNormalizedComponent_of_largeOrder_to_splitCage + hp (normalizedSurfaceOfPunctured baseNormalized) z hbaseCage hcoordinate + simpa [base, normalizedPuncturedPoint] using hcomponent + +/-- Raw-expression form of the elementary preliminary-route endpoint. -/ +theorem puncturedMarkoffTransitiveAt_of_concretePreliminaryBound + (p : ℕ) (hpPrime : p.Prime) + (hp : (2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1) ≤ p) : + PuncturedMarkoffTransitiveAt p hpPrime := by + apply puncturedMarkoffTransitiveAt_of_preliminaryCutoff p hpPrime + simpa only [preliminaryStrongApproximationCutoff_eq] using hp +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean new file mode 100644 index 0000000000..45754785bb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount + +/-! +# Fixed-point-free maximal-divisor trace pairing + +After restricting to eigenvalues with `x^2 ≠ 1`, inversion has no fixed +points. Every trace fiber therefore contains a genuine inverse pair, with no +additive exceptional term. Applying this on each maximal-divisor piece gives + +`2 * |non-two-torsion bounded traces| ≤ (bound - 1) * M`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +section FixedPointFreeInvolutionImage + +variable {G T : Type*} [Group G] [Fintype G] [DecidableEq G] + [DecidableEq T] [IsCyclic G] + +/-- An inversion-invariant map has at most half as many values as inputs when +inversion has no fixed point on the source. -/ +theorem two_mul_card_image_le_card_of_inv_invariant_of_no_fixed + (s : Finset G) (f : G → T) + (hsinv : ∀ x ∈ s, x⁻¹ ∈ s) + (hfinv : ∀ x, f x⁻¹ = f x) + (hnofixed : ∀ x ∈ s, x⁻¹ ≠ x) : + 2 * (s.image f).card ≤ s.card := by + classical + have hcardFibers : + s.card = + ∑ y ∈ s.image f, (s.filter fun x => f x = y).card := + Finset.card_eq_sum_card_fiberwise + (s := s) (t := s.image f) (f := f) (by + intro x hx + exact Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hfiber : + ∀ y ∈ s.image f, + 2 ≤ (s.filter fun x => f x = y).card := by + intro y hy + obtain ⟨x, hx, hxy⟩ := Finset.mem_image.mp hy + have hxFiber : x ∈ s.filter fun z => f z = y := + Finset.mem_filter.mpr ⟨hx, hxy⟩ + have hxInvFiber : x⁻¹ ∈ s.filter fun z => f z = y := by + refine Finset.mem_filter.mpr ⟨hsinv x hx, ?_⟩ + rw [hfinv, hxy] + have hpair : + ({x, x⁻¹} : Finset G) ⊆ s.filter fun z => f z = y := by + intro z hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · exact hxFiber + · exact hxInvFiber + have hne : x ≠ x⁻¹ := Ne.symm (hnofixed x hx) + simpa [hne] using Finset.card_le_card hpair + calc + 2 * (s.image f).card = + ∑ _y ∈ s.image f, 2 := by simp [Nat.mul_comm] + _ ≤ ∑ y ∈ s.image f, + (s.filter fun x => f x = y).card := by + gcongr with y hy + exact hfiber y hy + _ = s.card := hcardFibers.symm + +/-- Elements of a roots-of-unity piece that are not fixed by inversion. -/ +def nonTwoTorsionElementsWithPowOne (m : ℕ) : Finset G := + (elementsWithPowOne G m).filter fun x => x ^ 2 ≠ 1 + +@[simp] +theorem mem_nonTwoTorsionElementsWithPowOne_iff + {m : ℕ} {x : G} : + x ∈ nonTwoTorsionElementsWithPowOne (G := G) m ↔ + x ^ m = 1 ∧ x ^ 2 ≠ 1 := by + simp [nonTwoTorsionElementsWithPowOne] + +/-- Bounded-order trace values represented by non-two-torsion eigenvalues. -/ +def nonTwoTorsionBoundedOrderTraceSet + (trace : G → T) (bound : ℕ) : Finset T := + (Finset.univ.filter fun x : G => + orderOf x < bound ∧ x ^ 2 ≠ 1).image trace + +/-- The maximal-divisor cover built only from non-two-torsion roots. -/ +def nonTwoTorsionMaximalDivisorTraceCover + (trace : G → T) (bound : ℕ) : Finset T := + (maximalDivisorsBelow (Fintype.card G) bound).biUnion fun m => + (nonTwoTorsionElementsWithPowOne (G := G) m).image trace + +/-- Every bounded-order non-two-torsion trace lies in the fixed-point-free +maximal-divisor cover. -/ +theorem nonTwoTorsionBoundedOrderTraceSet_subset_maximalDivisorTraceCover + (trace : G → T) (bound : ℕ) : + nonTwoTorsionBoundedOrderTraceSet trace bound ⊆ + nonTwoTorsionMaximalDivisorTraceCover trace bound := by + intro y hy + rw [nonTwoTorsionBoundedOrderTraceSet, Finset.mem_image] at hy + obtain ⟨x, hx, rfl⟩ := hy + have hxData := Finset.mem_filter.mp hx + obtain ⟨m, hm, horderDvd⟩ := + exists_dvd_maximalDivisorBelow Fintype.card_ne_zero + orderOf_dvd_card hxData.2.1 + rw [nonTwoTorsionMaximalDivisorTraceCover, Finset.mem_biUnion] + refine ⟨m, hm, Finset.mem_image.mpr ⟨x, ?_, rfl⟩⟩ + rw [mem_nonTwoTorsionElementsWithPowOne_iff] + exact ⟨orderOf_dvd_iff_pow_eq_one.mp horderDvd, hxData.2.2⟩ + +/-- Each maximal-divisor piece is paired without fixed points, so summing the +pieces introduces no additive constant. -/ +theorem two_mul_nonTwoTorsionMaximalDivisorTraceCover_card_le + (trace : G → T) (bound : ℕ) + (htraceInv : ∀ x, trace x⁻¹ = trace x) : + 2 * (nonTwoTorsionMaximalDivisorTraceCover trace bound).card ≤ + (bound - 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + classical + have hpiece : + ∀ m ∈ maximalDivisorsBelow (Fintype.card G) bound, + 2 * ((nonTwoTorsionElementsWithPowOne + (G := G) m).image trace).card ≤ bound - 1 := by + intro m hm + have hmData := mem_maximalDivisorsBelow_iff.mp hm + have hmPos : 0 < m := by + have hmDvd : m ∣ Fintype.card G := + (Nat.mem_divisors.mp hmData.1).1 + exact Nat.pos_of_dvd_of_pos hmDvd Fintype.card_pos + let s := nonTwoTorsionElementsWithPowOne (G := G) m + have hsinv : ∀ x ∈ s, x⁻¹ ∈ s := by + intro x hx + have hxData : + x ^ m = 1 ∧ x ^ 2 ≠ 1 := by + simpa [s] using + (mem_nonTwoTorsionElementsWithPowOne_iff.mp hx) + rw [show s = nonTwoTorsionElementsWithPowOne (G := G) m by rfl, + mem_nonTwoTorsionElementsWithPowOne_iff] + constructor + · simpa using congrArg Inv.inv hxData.1 + · intro hinvSq + apply hxData.2 + have h := congrArg Inv.inv hinvSq + simpa using h + have hnofixed : ∀ x ∈ s, x⁻¹ ≠ x := by + intro x hx hinv + have hxSq : x ^ 2 ≠ 1 := + (mem_nonTwoTorsionElementsWithPowOne_iff.mp + (by simpa [s] using hx)).2 + apply hxSq + calc + x ^ 2 = x * x := pow_two x + _ = x * x⁻¹ := by rw [hinv] + _ = 1 := mul_inv_cancel x + have hpaired : + 2 * (s.image trace).card ≤ s.card := + two_mul_card_image_le_card_of_inv_invariant_of_no_fixed + s trace hsinv htraceInv hnofixed + calc + 2 * ((nonTwoTorsionElementsWithPowOne + (G := G) m).image trace).card = + 2 * (s.image trace).card := by rfl + _ ≤ s.card := hpaired + _ ≤ (elementsWithPowOne G m).card := + Finset.card_le_card (Finset.filter_subset _ _) + _ ≤ m := IsCyclic.card_pow_eq_one_le hmPos + _ ≤ bound - 1 := Nat.le_sub_one_of_lt hmData.2.1 + calc + 2 * (nonTwoTorsionMaximalDivisorTraceCover trace bound).card ≤ + 2 * ∑ m ∈ maximalDivisorsBelow (Fintype.card G) bound, + ((nonTwoTorsionElementsWithPowOne + (G := G) m).image trace).card := by + apply Nat.mul_le_mul_left + exact Finset.card_biUnion_le + _ = ∑ m ∈ maximalDivisorsBelow (Fintype.card G) bound, + 2 * ((nonTwoTorsionElementsWithPowOne + (G := G) m).image trace).card := by + simp [Finset.mul_sum] + _ ≤ ∑ _m ∈ maximalDivisorsBelow (Fintype.card G) bound, + (bound - 1) := by + gcongr with m hm + exact hpiece m hm + _ = (bound - 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + simp [Nat.mul_comm] + +/-- Fixed-point-free inversion pairing for the bounded-order trace set. -/ +theorem two_mul_nonTwoTorsionBoundedOrderTraceSet_card_le_maximalDivisors + (trace : G → T) (bound : ℕ) + (htraceInv : ∀ x, trace x⁻¹ = trace x) : + 2 * (nonTwoTorsionBoundedOrderTraceSet trace bound).card ≤ + (bound - 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + exact + (Nat.mul_le_mul_left 2 + (Finset.card_le_card + (nonTwoTorsionBoundedOrderTraceSet_subset_maximalDivisorTraceCover + trace bound))).trans + (two_mul_nonTwoTorsionMaximalDivisorTraceCover_card_le + trace bound htraceInv) + +end FixedPointFreeInvolutionImage + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean new file mode 100644 index 0000000000..0af8b339e7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean @@ -0,0 +1,323 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane + +/-! +# Assembly of the giant orbit + +This file connects the selected split cage component to the original punctured +Markoff action, bounds the complement by the already-counted small-order set, +and assembles Theorem 1 first from explicit specialized estimates and then from +the reusable general Hasse--Weil interface. The interface is inhabited in +`BGS.HasseWeil.GeneralBivariateAffineHasseWeil`; the parameter-free endpoint is +exported by `BGS.Markoff.Assembly.Unconditional`. +-/ + +namespace BGS.Markoff + +open Filter + +noncomputable section + +/-- Regard a normalized punctured point as a point of the normalized surface. -/ +def normalizedSurfaceOfPunctured + {R : Type*} [CommRing R] (x : ↥(normalizedPuncturedSurface R)) : + NormalizedMarkoffSurface R := + ⟨x.1, x.2.1⟩ + +/-- Normalization identifies the punctured component relation with the transported +component relation on normalized surface points. -/ +theorem samePuncturedComponent_iff_sameNormalizedComponent + {R : Type*} [Field R] [Invertible (3 : R)] + (x y : PuncturedMarkoffSurface R) : + SamePuncturedComponent x y ↔ + SameNormalizedComponent + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x)) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R y)) := by + have hx : (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x)) = x.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply x.1.1 + have hy : (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R y)) = y.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply y.1.1 + rw [SameNormalizedComponent, hx, hy] + constructor + · rintro ⟨g, hg⟩ + refine ⟨g, ?_⟩ + exact congrArg Subtype.val hg + · rintro ⟨g, hg⟩ + refine ⟨g, Subtype.ext hg⟩ + +private theorem exists_fullOrderBaseUnit (p : ℕ) [Fact p.Prime] : + ∃ u : (ZMod p)ˣ, orderOf u = Nat.card (ZMod p)ˣ := by + obtain ⟨u, hu⟩ := IsCyclic.exists_generator (α := (ZMod p)ˣ) + exact ⟨u, orderOf_eq_card_of_forall_mem_zpowers hu⟩ + +/-- For every sufficiently large prime, an explicit split conic point supplies a +punctured base point in the selected cage. -/ +theorem exists_normalizedPunctured_splitCagePoint + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpSeven : 7 ≤ p) : + ∃ x : ↥(normalizedPuncturedSurface (ZMod p)), + IsInSplitCage p (normalizedSurfaceOfPunctured x) := by + obtain ⟨u, huOrder⟩ := exists_fullOrderBaseUnit p + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huSq + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huSq + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + omega + let point : NormalizedPoint (ZMod p) := splitFiberPoint u 1 + have hpointFiber : point ∈ normalizedFiber1 (splitTorusTrace u) := + splitFiberPoint_mem u 1 huSq + have hrotation : rotationOrder (splitTorusTrace u) = p - 1 := by + rw [rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + have hpointNe : point ≠ normalizedOrigin := by + intro hzero + have htraceZero : splitTorusTrace u = 0 := by + have hfirst := congrArg NormalizedPoint.u1 hzero + change splitTorusTrace u = (0 : ZMod p) at hfirst + exact hfirst + have hzeroOrder := rotationOrder_zero_le_four p + rw [← htraceZero, hrotation] at hzeroOrder + omega + let x : ↥(normalizedPuncturedSurface (ZMod p)) := + ⟨point, hpointFiber.1, by simpa using hpointNe⟩ + refine ⟨x, .first, ?_⟩ + exact hrotation + +/-- A ceiling buffer over a smaller real power is eventually bounded by any +strictly larger real power. -/ +theorem eventually_natCeil_rpow_add_one_le_rpow + {δ η : ℝ} (hδ : 0 < δ) (hδη : δ < η) : + ∀ᶠ p : ℕ in atTop, + ((Nat.ceil ((p : ℝ) ^ δ) + 1 : ℕ) : ℝ) ≤ (p : ℝ) ^ η := by + have htwoEventually : + ∀ᶠ p : ℕ in atTop, (2 : ℝ) * (p : ℝ) ^ (0 : ℝ) < (p : ℝ) ^ δ := + eventually_const_mul_rpow_lt_rpow (C := (2 : ℝ)) (a := (0 : ℝ)) + (b := δ) hδ + have hdoubleEventually : + ∀ᶠ p : ℕ in atTop, (2 : ℝ) * (p : ℝ) ^ δ < (p : ℝ) ^ η := + eventually_const_mul_rpow_lt_rpow (C := (2 : ℝ)) (a := δ) + (b := η) hδη + filter_upwards [htwoEventually, hdoubleEventually] with p htwo hdouble + have hpPowTwo : (2 : ℝ) < (p : ℝ) ^ δ := by + simpa using htwo + have hceil : ((Nat.ceil ((p : ℝ) ^ δ) + 1 : ℕ) : ℝ) < + (p : ℝ) ^ δ + 2 := by + norm_num only [Nat.cast_add, Nat.cast_one] + have hceilBase := Nat.ceil_lt_add_one + (Real.rpow_nonneg (Nat.cast_nonneg p) δ) + linarith + have haddDouble : (p : ℝ) ^ δ + 2 < 2 * (p : ℝ) ^ δ := by + calc + (p : ℝ) ^ δ + 2 < (p : ℝ) ^ δ + (p : ℝ) ^ δ := + by simpa [add_comm] using add_lt_add_left hpPowTwo ((p : ℝ) ^ δ) + _ = 2 * (p : ℝ) ^ δ := by ring + exact le_of_lt (hceil.trans (haddDouble.trans hdouble)) + +/-- If every point above the middle-game cutoff reaches a connected split cage, +then every point outside the chosen cage component has small maximal order. -/ +theorem maximalCoordinateRotationOrder_le_rpow_of_not_same_splitCageComponent + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] {δ : ℝ} + (c x : NormalizedMarkoffSurface (ZMod p)) + (hescape : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ δ < maximalCoordinateRotationOrder z.1 → + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent z y ∧ IsInSplitCage p y) + (hconnected : ∀ y : NormalizedMarkoffSurface (ZMod p), + IsInSplitCage p y → SameNormalizedComponent c y) + (hnot : ¬ SameNormalizedComponent c x) : + (maximalCoordinateRotationOrder x.1 : ℝ) ≤ (p : ℝ) ^ δ := by + by_contra hlarge + obtain ⟨y, hxy, hyCage⟩ := hescape x (lt_of_not_ge hlarge) + exact hnot (sameNormalizedComponent_trans (hconnected y hyCage) + (sameNormalizedComponent_symm hxy)) + +private theorem three_ne_zero_zmod_of_prime_ne_three + (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq + · exact (Fact.out : p.Prime).ne_one hpOne + · exact hpThree hpEq + +/-- Intermediate assembly relative to a neutral weighted-trace +torsion-intersection bound and three specialized point-count estimates. + +The public endpoint supplies the weighted-trace bound from the completed +Corvaja--Zannier theorem and derives the three point-count specializations from +the general affine Hasse--Weil theorem. -/ +theorem eventually_hasGiantOrbit_of_specializedEstimates + (hBound : ∀ (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)], + WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + (cageCoefficient : ℕ) (hCageEstimate : CageWitnessPointEstimate cageCoefficient) : + ∀ epsilon : ℝ, 0 < epsilon → + ∃ p0 : ℕ, ∀ (p : ℕ) (hpPrime : p.Prime), p0 ≤ p → + HasGiantOrbitAt p hpPrime epsilon := by + intro epsilon hEpsilon + let δ : ℝ := min (epsilon / 10) (1 / 4) + have hδ : 0 < δ := by + dsimp [δ] + exact lt_min (div_pos hEpsilon (by norm_num)) (by norm_num) + have hδQuarter : δ ≤ (1 : ℝ) / 4 := min_le_right _ _ + have hδEpsilon : δ < epsilon / 5 := by + have hδTen : δ ≤ epsilon / 10 := min_le_left _ _ + linarith + obtain ⟨middleThreshold, hmiddle⟩ := + exists_threshold_middleGame_to_splitCage hBound splitCoefficient hSplitWeil + nonsplitCoefficient hNonsplitWeil hδ hδQuarter + obtain ⟨cageThreshold, hcage⟩ := + exists_threshold_splitCage_connected cageCoefficient hCageEstimate + obtain ⟨boundThreshold, hboundThreshold⟩ := + eventually_atTop.mp + (eventually_natCeil_rpow_add_one_le_rpow hδ hδEpsilon) + obtain ⟨countThreshold, hcountThreshold⟩ := + eventually_atTop.mp (eventually_smallOrderPointBound_le_rpow hEpsilon) + refine ⟨max (max (max middleThreshold cageThreshold) boundThreshold) + (max countThreshold 7), ?_⟩ + intro p hpPrime hp + letI : Fact p.Prime := ⟨hpPrime⟩ + have hpMiddle : middleThreshold ≤ p := by omega + have hpCage : cageThreshold ≤ p := by omega + have hpBound : boundThreshold ≤ p := by omega + have hpCount : countThreshold ≤ p := by omega + have hpSeven : 7 ≤ p := by omega + have hpTwo : p ≠ 2 := by omega + have hpThree : p ≠ 3 := by omega + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + obtain ⟨cNormalized, hcNormalizedCage⟩ := + exists_normalizedPunctured_splitCagePoint p hpSeven + let c : PuncturedMarkoffSurface (ZMod p) := + (puncturedNormalizationEquiv (ZMod p)).symm cNormalized + let bound : ℕ := Nat.ceil ((p : ℝ) ^ δ) + 1 + let bad := puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound + apply hasGiantOrbitAt_of_complement_subset_finset p hpPrime epsilon c bad + · intro x hxOutside + have hxNotComponent : ¬ SamePuncturedComponent c x := hxOutside.2 + let xNormalized := puncturedNormalizationEquiv (ZMod p) x + let xSurface := normalizedSurfaceOfPunctured xNormalized + have hxNotNormalized : ¬ SameNormalizedComponent + (normalizedSurfaceOfPunctured cNormalized) xSurface := by + intro hcx + apply hxNotComponent + apply (samePuncturedComponent_iff_sameNormalizedComponent c x).2 + simpa [c, xSurface, xNormalized] using hcx + have hxMaxSmall : (maximalCoordinateRotationOrder xSurface.1 : ℝ) ≤ + (p : ℝ) ^ δ := + maximalCoordinateRotationOrder_le_rpow_of_not_same_splitCageComponent + p (normalizedSurfaceOfPunctured cNormalized) xSurface + (hmiddle p hpMiddle hpThree) + (fun y hy => hcage p hpCage hpThree _ y hcNormalizedCage hy) + hxNotNormalized + have hfirstReal : (rotationOrder xSurface.1.u1 : ℝ) ≤ (p : ℝ) ^ δ := by + have hfirstMax : (rotationOrder xSurface.1.u1 : ℝ) ≤ + maximalCoordinateRotationOrder xSurface.1 := by + exact_mod_cast rotationOrder_first_le_maximalCoordinateRotationOrder xSurface.1 + exact hfirstMax.trans hxMaxSmall + have hsecondReal : (rotationOrder xSurface.1.u2 : ℝ) ≤ (p : ℝ) ^ δ := by + have hsecondMax : (rotationOrder xSurface.1.u2 : ℝ) ≤ + maximalCoordinateRotationOrder xSurface.1 := by + exact_mod_cast rotationOrder_second_le_maximalCoordinateRotationOrder xSurface.1 + exact hsecondMax.trans hxMaxSmall + have hfirstCeil : rotationOrder xSurface.1.u1 ≤ Nat.ceil ((p : ℝ) ^ δ) := by + exact_mod_cast hfirstReal.trans (Nat.le_ceil ((p : ℝ) ^ δ)) + have hsecondCeil : rotationOrder xSurface.1.u2 ≤ Nat.ceil ((p : ℝ) ^ δ) := by + exact_mod_cast hsecondReal.trans (Nat.le_ceil ((p : ℝ) ^ δ)) + have hfirstCeil' : rotationOrder (toNormalized x.1.1).u1 ≤ + Nat.ceil ((p : ℝ) ^ δ) := by + simpa only [xSurface, xNormalized, normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hfirstCeil + have hsecondCeil' : rotationOrder (toNormalized x.1.1).u2 ≤ + Nat.ceil ((p : ℝ) ^ δ) := by + simpa only [xSurface, xNormalized, normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hsecondCeil + change x ∈ puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] + exact ⟨by simpa [bound] using hfirstCeil', + by simpa [bound] using hsecondCeil'⟩ + · have hbound : (bound : ℝ) ≤ (p : ℝ) ^ (epsilon / 5) := by + exact hboundThreshold p hpBound + calc + (bad.card : ℝ) ≤ (2 * (2 + 2 * bound ^ 2) ^ 2 : ℕ) := by + exact_mod_cast + puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le hpTwo bound + _ ≤ (p : ℝ) ^ epsilon := hcountThreshold p hpCount bound hbound + +/-- Modular bound-injection form of Theorem 1. + +It exposes the neutral weighted-trace torsion-intersection contract together +with the split, nonsplit, and cage point-count specializations. The public +endpoint below supplies these inputs from the completed Corvaja--Zannier +theorem and the remaining general affine Hasse--Weil input. -/ +theorem theoremOneStatement_of_specializedEstimates + (hBound : ∀ (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)], + WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + (cageCoefficient : ℕ) (hCageEstimate : CageWitnessPointEstimate cageCoefficient) : + TheoremOneStatement := by + apply theoremOneStatement_of_eventually_hasGiantOrbit + exact eventually_hasGiantOrbit_of_specializedEstimates hBound splitCoefficient hSplitWeil + nonsplitCoefficient hNonsplitWeil cageCoefficient hCageEstimate + +/-- The near-final Theorem 1 assembly with Corvaja--Zannier discharged by the +in-repository theorem. This intermediate adapter keeps the general affine +Hasse--Weil input explicit, together with its descended nonsplit adapter. -/ +theorem theoremOneStatement_of_generalHasseWeil_and_nonsplitHasseAdapter + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) : + TheoremOneStatement := by + classical + obtain ⟨splitCoefficient, hSplitWeil⟩ := + exists_weightedSplitTraceWeilBoundAssumption_of_generalHasseWeil hHasse + obtain ⟨cageCoefficient, _hcagePositive, hCageEstimate⟩ := + exists_cageWitnessPointEstimate_of_generalHasseWeil hHasse + apply theoremOneStatement_of_specializedEstimates + (fun p _ _ => + corvajaZannierWeightedTraceBound p (quadraticFiniteField p)) + splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil + cageCoefficient hCageEstimate + +/-- **BGS Theorem 1 with Corvaja--Zannier fully discharged.** + +The in-repository Corvaja--Zannier theorem supplies the middle-game estimate. +This theorem is the general-interface assembly step; the parameter-free public +endpoint is `BGS.Markoff.theoremOneStatement`. -/ +theorem theoremOneStatement_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + TheoremOneStatement := by + obtain ⟨nonsplitCoefficient, hNonsplitWeil⟩ := + exists_seededNonsplitTraceWeilBoundAssumption_of_generalHasseWeil hHasse + exact theoremOneStatement_of_generalHasseWeil_and_nonsplitHasseAdapter + hHasse nonsplitCoefficient hNonsplitWeil + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean new file mode 100644 index 0000000000..bb05ec7b1c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion + +/-! +# Root-free joint maximal-divisor frontier + +The improved arithmetic naturally controls the square of the sum of the two +maximal-divisor counts. This module keeps that square envelope intact instead +of taking an integer square root and losing information. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +private def jointNormalizedPuncturedPoint + {R : Type*} [Field R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : NormalizedMarkoffSurface R := + normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x) + +/-- A square envelope converts a root-free sixth-power comparison into the +cube inequality required by the middle game. -/ +theorem coefficient_mul_count_cube_lt_of_squareEnvelope + {coefficient count envelope order : ℕ} + (hsquare : count ^ 2 ≤ envelope) + (hstrict : coefficient ^ 6 * envelope ^ 3 < order ^ 2) : + (coefficient * count) ^ 3 < order := by + have hpower : + ((coefficient * count) ^ 3) ^ 2 ≤ + coefficient ^ 6 * envelope ^ 3 := by + calc + ((coefficient * count) ^ 3) ^ 2 = + coefficient ^ 6 * (count ^ 2) ^ 3 := by ring + _ ≤ coefficient ^ 6 * envelope ^ 3 := by gcongr + by_contra hnot + have hreverse : order ≤ (coefficient * count) ^ 3 := + Nat.le_of_not_gt hnot + have hreverseSq : + order ^ 2 ≤ ((coefficient * count) ^ 3) ^ 2 := + Nat.pow_le_pow_left hreverse 2 + exact (Nat.not_le_of_lt (hpower.trans_lt hstrict)) hreverseSq + +/-- A square envelope also converts the linear middle-game comparison into a +root-free quadratic comparison. -/ +theorem coefficient_mul_count_mul_order_lt_of_squareEnvelope + {coefficient count envelope order p : ℕ} + (hsquare : count ^ 2 ≤ envelope) + (hstrict : + coefficient ^ 2 * envelope * order ^ 2 < p ^ 2) : + coefficient * count * order < p := by + have hpower : + (coefficient * count * order) ^ 2 ≤ + coefficient ^ 2 * envelope * order ^ 2 := by + calc + (coefficient * count * order) ^ 2 = + coefficient ^ 2 * count ^ 2 * order ^ 2 := by ring + _ ≤ coefficient ^ 2 * envelope * order ^ 2 := by gcongr + by_contra hnot + have hreverse : p ≤ coefficient * count * order := + Nat.le_of_not_gt hnot + have hreverseSq : + p ^ 2 ≤ (coefficient * count * order) ^ 2 := + Nat.pow_le_pow_left hreverse 2 + exact (Nat.not_le_of_lt (hpower.trans_lt hstrict)) hreverseSq + +/-- Punctured transitivity from a square envelope for the two neighboring +maximal-divisor counts. Both numerical hypotheses are polynomial +inequalities over natural numbers. -/ +theorem puncturedMarkoffTransitiveAt_of_jointSquareEnvelope_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (squareEnvelope : ℕ → ℕ) + (hsquare : ∀ d : ℕ, + (maximalDivisorCountSum p (d + 1)) ^ 2 ≤ squareEnvelope d) + (hcube : ∀ d : ℕ, 0 < d → + p ≤ 2 * (2 + d * maximalDivisorCountSum p (d + 1)) ^ 2 → + corvajaZannierCorollaryTwoSafeCoefficient ^ 6 * + (squareEnvelope d) ^ 3 < d ^ 2) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + corvajaZannierCorollaryTwoSafeCoefficient ^ 2 * + squareEnvelope d * d ^ 2 < p ^ 2) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (jointNormalizedPuncturedPoint c) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + apply puncturedMarkoffTransitiveAt_of_maximalDivisor_frontier + p hpThree c + · intro d hd hpLow + exact coefficient_mul_count_cube_lt_of_squareEnvelope + (hsquare d) (hcube d hd hpLow) + · intro d hd + exact coefficient_mul_count_mul_order_lt_of_squareEnvelope + (hsquare d) (hlinear d hd) + · intro z hz + exact hlarge z hz + +/-- Specialization of the square-envelope frontier to the new +`C^2 + 3J` bound. -/ +theorem puncturedMarkoffTransitiveAt_of_jointMaximalDivisorBounds + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (central productEnvelope : ℕ → ℕ) + (hminus : ∀ d : ℕ, + (maximalDivisorsBelow (p - 1) (d + 1)).card ≤ central d) + (hplus : ∀ d : ℕ, + (maximalDivisorsBelow (p + 1) (d + 1)).card ≤ central d) + (hproduct : ∀ d : ℕ, + (maximalDivisorsBelow (p - 1) (d + 1)).card * + (maximalDivisorsBelow (p + 1) (d + 1)).card ≤ + productEnvelope d) + (hcube : ∀ d : ℕ, 0 < d → + p ≤ 2 * (2 + d * maximalDivisorCountSum p (d + 1)) ^ 2 → + corvajaZannierCorollaryTwoSafeCoefficient ^ 6 * + (central d ^ 2 + 3 * productEnvelope d) ^ 3 < d ^ 2) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + corvajaZannierCorollaryTwoSafeCoefficient ^ 2 * + (central d ^ 2 + 3 * productEnvelope d) * d ^ 2 < p ^ 2) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (jointNormalizedPuncturedPoint c) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + apply puncturedMarkoffTransitiveAt_of_jointSquareEnvelope_frontier + p hpThree c (fun d ↦ central d ^ 2 + 3 * productEnvelope d) + · intro d + simpa [maximalDivisorCountSum] using + maximalDivisorCounts_add_sq_le + (hminus d) (hplus d) (hproduct d) + · exact hcube + · exact hlinear + · exact hlarge + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean new file mode 100644 index 0000000000..57161b29d7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds + +/-! +# Small-order Markoff counts using maximal divisors + +This is the counting half of the paper's maximal-divisor improvement, +formalized at the finite-set boundary used by the maximal-orbit argument. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +def maximalDivisorCountSum (p bound : ℕ) : ℕ := + (maximalDivisorsBelow (p - 1) bound).card + + (maximalDivisorsBelow (p + 1) bound).card + +theorem concreteLowOrderTraceSet_card_le_maximalDivisors + {p : ℕ} [Fact p.Prime] (bound : ℕ) : + (concreteLowOrderTraceSet p bound).card ≤ + 2 + (bound - 1) * maximalDivisorCountSum p bound := by + classical + have hsplitCard : Fintype.card (ZMod p)ˣ = p - 1 := by + rw [← Nat.card_eq_fintype_card, Nat.card_units, Nat.card_zmod] + have hnonsplitCard : Fintype.card (quadraticNormOneTorus p) = p + 1 := by + rw [← Nat.card_eq_fintype_card, quadraticNormOneTorus_natCard] + have hsplit : + (boundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound).card ≤ + (bound - 1) * + (maximalDivisorsBelow (Fintype.card (ZMod p)ˣ) bound).card := by + calc + (boundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound).card ≤ + (elementsOfOrderLessThan (ZMod p)ˣ bound).card := + Finset.card_image_le + _ ≤ (bound - 1) * + (maximalDivisorsBelow (Fintype.card (ZMod p)ˣ) bound).card := by + simpa [elementsOfOrderLessThan] using + (BGS.NumberTheory.elementsOfOrderLessThan_card_le_maximalDivisors + ((ZMod p)ˣ) bound) + have hnonsplit : + (boundedOrderTraceSet (quadraticNormOneTrace p) bound).card ≤ + (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (quadraticNormOneTorus p)) bound).card := by + calc + (boundedOrderTraceSet (quadraticNormOneTrace p) bound).card ≤ + (elementsOfOrderLessThan (quadraticNormOneTorus p) bound).card := + Finset.card_image_le + _ ≤ (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (quadraticNormOneTorus p)) bound).card := by + simpa [elementsOfOrderLessThan] using + (BGS.NumberTheory.elementsOfOrderLessThan_card_le_maximalDivisors + (quadraticNormOneTorus p) bound) + unfold concreteLowOrderTraceSet lowOrderTraceSet + calc + (normalizedParabolicTraceSet p ∪ + boundedOrderTraceSet (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound ∪ + boundedOrderTraceSet (quadraticNormOneTrace p) bound).card ≤ + (normalizedParabolicTraceSet p ∪ + boundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound).card + + (boundedOrderTraceSet (quadraticNormOneTrace p) bound).card := + Finset.card_union_le _ _ + _ ≤ ((normalizedParabolicTraceSet p).card + + (boundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound).card) + + (boundedOrderTraceSet (quadraticNormOneTrace p) bound).card := by + gcongr + exact Finset.card_union_le _ _ + _ ≤ 2 + + (bound - 1) * + (maximalDivisorsBelow (Fintype.card (ZMod p)ˣ) bound).card + + (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (quadraticNormOneTorus p)) bound).card := by + gcongr + exact Finset.card_le_two + _ = 2 + (bound - 1) * maximalDivisorCountSum p bound := by + rw [hsplitCard, hnonsplitCard] + simp only [maximalDivisorCountSum, Nat.mul_add] + omega + +theorem concreteLowOrderTraceSet_succ_card_le_maximalDivisors + {p : ℕ} [Fact p.Prime] (d : ℕ) : + (concreteLowOrderTraceSet p (d + 1)).card ≤ + 2 + d * maximalDivisorCountSum p (d + 1) := by + simpa using + (concreteLowOrderTraceSet_card_le_maximalDivisors (p := p) (d + 1)) + +theorem normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_maximalDivisors + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (bound : ℕ) : + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + 2 * (2 + (bound - 1) * maximalDivisorCountSum p bound) ^ 2 := by + calc + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn + (concreteLowOrderTraceSet p bound)).card := + Finset.card_mono + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_subset_traceSet + hpTwo bound) + _ ≤ 2 * (concreteLowOrderTraceSet p bound).card ^ 2 := + normalizedMarkoffPointsWithFirstTwoCoordinatesIn_card_le _ + _ ≤ 2 * (2 + (bound - 1) * + maximalDivisorCountSum p bound) ^ 2 := by + gcongr + exact concreteLowOrderTraceSet_card_le_maximalDivisors bound + +theorem puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_succ_card_le_maximalDivisors + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (d : ℕ) : + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1)).card ≤ + 2 * (2 + d * maximalDivisorCountSum p (d + 1)) ^ 2 := by + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_eq_normalized] + exact + (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_ambient + (d + 1)).trans + (by + simpa using + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_maximalDivisors + (p := p) hpTwo (d + 1))) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean new file mode 100644 index 0000000000..821768bcf3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean @@ -0,0 +1,142 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape + +/-! +# Maximal-divisor middle-game assembly + +This module lifts the maximal-order Corvaja--Zannier escape from a chosen +coordinate to the maximum of the three coordinate rotation orders. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- One middle-game step strictly increases the maximum coordinate order when +the two size inequalities use only divisibility-maximal candidate orders. -/ +theorem exists_sameNormalizedComponent_maximalOrder_increase_of_maximalDivisorBounds + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + {delta : ℝ} (hdelta : delta ≤ (1 : ℝ) / 2) + (hBound : + WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + (x : NormalizedMarkoffSurface (ZMod p)) + (hbelow : (maximalCoordinateRotationOrder x.1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p + (maximalCoordinateRotationOrder x.1)).card) ^ 3 < + maximalCoordinateRotationOrder x.1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p + (maximalCoordinateRotationOrder x.1)).card * + maximalCoordinateRotationOrder x.1 < p) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ + maximalCoordinateRotationOrder x.1 < + maximalCoordinateRotationOrder y.1 := by + obtain ⟨x', hxx', hx'Order⟩ := + exists_sameNormalizedComponent_firstRotation_eq_maximal x + have hx'Cube : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card) ^ 3 < + rotationOrder x'.1.u1 := by + simpa [hx'Order] using hcube + have hx'Linear : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card * + rotationOrder x'.1.u1 < p := by + simpa [hx'Order] using hlinear + have hordersPos : + 0 < (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card := by + apply Finset.card_pos.mpr + have hpPlus : p + 1 ≠ 0 := by omega + have honeBound : 1 < rotationOrder x'.1.u1 + 1 := by + exact Nat.lt_succ_of_le (rotationOrder_pos x'.1.u1) + obtain ⟨m, hm, _hmultiple⟩ := + exists_dvd_maximalDivisorBelow hpPlus (one_dvd (p + 1)) honeBound + refine ⟨m, ?_⟩ + rw [middleGameMaximalOrders, Finset.mem_union] + exact Or.inr hm + have hbase : + 4 < (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card) ^ 3 := by + have hcoeff : corvajaZannierCorollaryTwoSafeCoefficient ≤ + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card := by + simp only [corvajaZannierCorollaryTwoSafeCoefficient] + nlinarith + calc + 4 < corvajaZannierCorollaryTwoSafeCoefficient ^ 3 := by + norm_num [corvajaZannierCorollaryTwoSafeCoefficient] + _ ≤ (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p + (rotationOrder x'.1.u1)).card) ^ 3 := + Nat.pow_le_pow_left hcoeff 3 + have hx'AboveFour : 4 < rotationOrder x'.1.u1 := + hbase.trans hx'Cube + have hx'Below : (rotationOrder x'.1.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) := by + simpa [hx'Order] using hbelow + have hx'0 : x'.1.u1 ≠ 0 := by + intro hzero + have hle := rotationOrder_zero_le_four p + rw [hzero] at hx'AboveFour + omega + have hx'Nonparabolic : x'.1.u1 ^ 2 ≠ 4 := by + intro hparabolic + have hcases : x'.1.u1 = 2 ∨ x'.1.u1 = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + x'.1.u1 ^ 2 = 4 := hparabolic + _ = (2 : ZMod p) ^ 2 := by norm_num + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (show 1 ≤ p by exact (Fact.out : p.Prime).one_le) + have hexponentLe : (1 : ℝ) / 2 + delta ≤ 1 := by + linarith + have hrpowLe : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ (p : ℝ) := by + simpa using Real.rpow_le_rpow_of_exponent_le hpOne hexponentLe + rcases hcases with htwo | hnegTwo + · rw [htwo, rotationOrder_two] at hx'Below + linarith + · rw [hnegTwo, rotationOrder_neg_two p hpTwo] at hx'Below + have htwoP : ((2 * p : ℕ) : ℝ) = 2 * (p : ℝ) := by norm_num + rw [htwoP] at hx'Below + have hpPos : (0 : ℝ) < p := by positivity + linarith + obtain ⟨n, hnIncrease⟩ := + exists_iterate_with_larger_secondRotationOrder_of_weightedTraceBound_maximalOrders + p hpTwo delta hdelta x'.1 x'.property hx'0 hx'Nonparabolic hx'Below + hx'Cube hx'Linear hBound + let y := (normalizedRotate1Surface^[n]) x' + have hcoe : y.1 = (normalizedRotate1^[n]) x'.1 := + coe_iterate_normalizedRotate1Surface x' n + refine ⟨y, sameNormalizedComponent_trans hxx' + (sameNormalizedComponent_iterate_normalizedRotate1Surface x' n), ?_⟩ + rw [← hx'Order] + exact hnIncrease.trans_le <| by + have hmeasureEq : maximalCoordinateRotationOrder y.1 = + maximalCoordinateRotationOrder + ((normalizedRotate1^[n]) x'.1) := + congrArg maximalCoordinateRotationOrder hcoe + calc + rotationOrder ((normalizedRotate1^[n]) x'.1).u2 ≤ + maximalCoordinateRotationOrder + ((normalizedRotate1^[n]) x'.1) := + rotationOrder_second_le_maximalCoordinateRotationOrder _ + _ = maximalCoordinateRotationOrder y.1 := hmeasureEq.symm + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean new file mode 100644 index 0000000000..ddde85e4b4 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame + +/-! +# Punctured transitivity from the maximal-divisor frontier + +The maximal-orbit argument now uses the same maximal-divisor count in both +places where the published proof used all divisors: + +* counting points whose first two rotation orders are small; +* the Corvaja--Zannier union that forces an order increase. + +This is the idea-level endpoint. A separate arithmetic certificate can +discharge its two explicit inequalities using the joint `p - 1`, `p + 1` +square envelope. +-/ + +namespace BGS.Markoff + +noncomputable section + +private def normalizedPuncturedPointMaximalDivisors + {R : Type*} [Field R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : NormalizedMarkoffSurface R := + normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x) + +private theorem normalizedPuncturedPointMaximalDivisors_smul + {R : Type*} [Field R] [Invertible (3 : R)] + (g : Gamma R) (z : PuncturedMarkoffSurface R) : + normalizedPuncturedPointMaximalDivisors (g • z) = + normalizedGammaPerm R g + (normalizedPuncturedPointMaximalDivisors z) := by + have hzinv : + (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R z)) = z.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply z.1.1 + unfold normalizedPuncturedPointMaximalDivisors + rw [normalizedGammaPerm_apply, hzinv] + apply Subtype.ext + rfl + +/-- The finite maximal-orbit argument with maximal-divisor counts at both +small-order and middle-game boundaries. -/ +theorem puncturedMarkoffTransitiveAt_of_maximalDivisor_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hcube : ∀ d : ℕ, 0 < d → + p ≤ 2 * (2 + d * maximalDivisorCountSum p (d + 1)) ^ 2 → + (corvajaZannierCorollaryTwoSafeCoefficient * + maximalDivisorCountSum p (d + 1)) ^ 3 < d) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + corvajaZannierCorollaryTwoSafeCoefficient * + maximalDivisorCountSum p (d + 1) * d < p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedPuncturedPointMaximalDivisors c) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + classical + have hpTwo : p ≠ 2 := by omega + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent c x := by + intro x + by_contra hcx + let orderMeasure : PuncturedMarkoffSurface (ZMod p) → ℕ := fun w => + maximalCoordinateRotationOrder + (normalizedPuncturedPointMaximalDivisors w).1 + let orbitFinset := (puncturedGammaOrbit x).toFinite.toFinset + have hxMem : x ∈ orbitFinset := by + have hxOrbit : x ∈ puncturedGammaOrbit x := + samePuncturedComponent_refl x + simpa [orbitFinset] using hxOrbit + obtain ⟨z, hzMem, hzMax⟩ := + Finset.exists_max_image orbitFinset orderMeasure ⟨x, hxMem⟩ + let d := orderMeasure z + have hzComponent : SamePuncturedComponent x z := by + change z ∈ puncturedGammaOrbit x + simpa [orbitFinset] using hzMem + have hmax : ∀ w : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent x w → orderMeasure w ≤ d := by + intro w hw + apply hzMax w + change w ∈ puncturedGammaOrbit x at hw + simpa [orbitFinset] using hw + have hdPos : 0 < d := by + have hfirstPos : 0 < + rotationOrder + (normalizedPuncturedPointMaximalDivisors z).1.u1 := + rotationOrder_pos _ + exact hfirstPos.trans_le <| by + simpa [d, orderMeasure] using + rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointMaximalDivisors z).1 + have hnotBaseZ : ¬ SameNormalizedComponent + (normalizedPuncturedPointMaximalDivisors c) + (normalizedPuncturedPointMaximalDivisors z) := by + intro hcz + apply hcx + have hczPunctured : SamePuncturedComponent c z := + (samePuncturedComponent_iff_sameNormalizedComponent c z).2 hcz + exact samePuncturedComponent_trans hczPunctured + (samePuncturedComponent_symm hzComponent) + have hdUpper : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + by_contra hd + apply hnotBaseZ + apply hlarge (normalizedPuncturedPointMaximalDivisors z) + simpa [d, orderMeasure] using le_of_not_gt hd + have hpLeOrbit : p ≤ (puncturedGammaOrbit x).ncard := by + have horbitPos : 0 < (puncturedGammaOrbit x).ncard := + (Set.ncard_pos (Set.toFinite _)).2 + ⟨x, samePuncturedComponent_refl x⟩ + exact Nat.le_of_dvd horbitPos + (prime_dvd_puncturedGammaOrbit_ncard p hpThree x) + have horbitSmall : (puncturedGammaOrbit x).ncard ≤ + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders + p (d + 1)).card := by + rw [Set.ncard_eq_toFinset_card + (puncturedGammaOrbit x) (Set.toFinite _)] + apply Finset.card_le_card + intro w hwFinset + have hw : SamePuncturedComponent x w := by + change w ∈ puncturedGammaOrbit x + simpa [orbitFinset] using hwFinset + have hwMax := hmax w hw + have hfirst : + rotationOrder + (normalizedPuncturedPointMaximalDivisors w).1.u1 ≤ d := + (rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointMaximalDivisors w).1).trans hwMax + have hsecond : + rotationOrder + (normalizedPuncturedPointMaximalDivisors w).1.u2 ≤ d := + (rotationOrder_second_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointMaximalDivisors w).1).trans hwMax + change w ∈ + puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1) + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] + constructor + · simpa only [normalizedPuncturedPointMaximalDivisors, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using + Nat.lt_succ_of_le hfirst + · simpa only [normalizedPuncturedPointMaximalDivisors, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using + Nat.lt_succ_of_le hsecond + have hpLeSmallOrderSet : p ≤ + 2 * (2 + d * maximalDivisorCountSum p (d + 1)) ^ 2 := by + calc + p ≤ (puncturedGammaOrbit x).ncard := hpLeOrbit + _ ≤ (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders + p (d + 1)).card := horbitSmall + _ ≤ 2 * (2 + d * + maximalDivisorCountSum p (d + 1)) ^ 2 := + puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_succ_card_le_maximalDivisors + hpTwo d + have hcubeCount := + hcube d hdPos hpLeSmallOrderSet + have hlinearCount := hlinear d hdUpper + have hmaximalCard : + (middleGameMaximalOrders p d).card ≤ + maximalDivisorCountSum p (d + 1) := by + simpa [maximalDivisorCountSum] using + middleGameMaximalOrders_card_le p d + have hcoefficient : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p d).card ≤ + corvajaZannierCorollaryTwoSafeCoefficient * + maximalDivisorCountSum p (d + 1) := + Nat.mul_le_mul_left + corvajaZannierCorollaryTwoSafeCoefficient hmaximalCard + have hcube' : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p d).card) ^ 3 < d := + (Nat.pow_le_pow_left hcoefficient 3).trans_lt hcubeCount + have hlinear' : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p d).card * d < p := + (Nat.mul_le_mul_right d hcoefficient).trans_lt hlinearCount + obtain ⟨y, hzy, hincrease⟩ := + exists_sameNormalizedComponent_maximalOrder_increase_of_maximalDivisorBounds + p hpTwo (delta := (1 / 3 : ℝ)) (by norm_num) + (corvajaZannierWeightedTraceBound p (quadraticFiniteField p)) + (normalizedPuncturedPointMaximalDivisors z) + (by simpa only [show (1 / 2 + 1 / 3 : ℝ) = 5 / 6 by norm_num, + d, orderMeasure] using hdUpper) + (by simpa [d, orderMeasure] using hcube') + (by simpa [d, orderMeasure] using hlinear') + obtain ⟨g, hg⟩ := + (sameNormalizedComponent_iff_exists_gamma + (normalizedPuncturedPointMaximalDivisors z) y).1 hzy + let w : PuncturedMarkoffSurface (ZMod p) := g • z + have hwComponent : SamePuncturedComponent x w := + samePuncturedComponent_trans hzComponent + ((samePuncturedComponent_iff_exists z w).2 ⟨g, rfl⟩) + have hwNormalized : + normalizedPuncturedPointMaximalDivisors w = y := by + change normalizedPuncturedPointMaximalDivisors (g • z) = y + rw [normalizedPuncturedPointMaximalDivisors_smul] + exact hg + have hwMax := hmax w hwComponent + change maximalCoordinateRotationOrder + (normalizedPuncturedPointMaximalDivisors w).1 ≤ d at hwMax + rw [hwNormalized] at hwMax + have hincrease' : d < maximalCoordinateRotationOrder y.1 := by + simpa [d, orderMeasure] using hincrease + exact (not_lt_of_ge hwMax) hincrease' + intro a b + obtain ⟨ga, hga⟩ := + (samePuncturedComponent_iff_exists c a).1 (hAll a) + obtain ⟨gb, hgb⟩ := + (samePuncturedComponent_iff_exists c b).1 (hAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • c := by rw [← hga]; simp + _ = b := hgb + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean new file mode 100644 index 0000000000..6d66c4d2ec --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean @@ -0,0 +1,369 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape + +/-! +# Iterating the middle-game escape to the cage +-/ + +namespace BGS.Markoff + +open Filter + +noncomputable section + +private theorem three_ne_zero_zmod_of_prime_ne_three + (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq + · exact (Fact.out : p.Prime).ne_one hpOne + · exact hpThree hpEq + +/-- Maximum of the three coordinate rotation orders. -/ +def maximalCoordinateRotationOrder {R : Type*} [CommRing R] + (x : NormalizedPoint R) : ℕ := + max (rotationOrder x.u1) (max (rotationOrder x.u2) (rotationOrder x.u3)) + +theorem rotationOrder_first_le_maximalCoordinateRotationOrder + {R : Type*} [CommRing R] (x : NormalizedPoint R) : + rotationOrder x.u1 ≤ maximalCoordinateRotationOrder x := by + simp [maximalCoordinateRotationOrder] + +theorem rotationOrder_second_le_maximalCoordinateRotationOrder + {R : Type*} [CommRing R] (x : NormalizedPoint R) : + rotationOrder x.u2 ≤ maximalCoordinateRotationOrder x := by + simp [maximalCoordinateRotationOrder] + +theorem rotationOrder_third_le_maximalCoordinateRotationOrder + {R : Type*} [CommRing R] (x : NormalizedPoint R) : + rotationOrder x.u3 ≤ maximalCoordinateRotationOrder x := by + simp [maximalCoordinateRotationOrder] + +/-- A coordinate permutation puts a coordinate of maximum rotation order first. -/ +theorem exists_sameNormalizedComponent_firstRotation_eq_maximal + {R : Type*} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + ∃ y : NormalizedMarkoffSurface R, + SameNormalizedComponent x y ∧ + rotationOrder y.1.u1 = maximalCoordinateRotationOrder x.1 := by + by_cases hfirst : rotationOrder x.1.u2 ≤ rotationOrder x.1.u1 ∧ + rotationOrder x.1.u3 ≤ rotationOrder x.1.u1 + · refine ⟨x, sameNormalizedComponent_refl x, ?_⟩ + simp [maximalCoordinateRotationOrder, hfirst.1, hfirst.2] + · by_cases hsecond : rotationOrder x.1.u1 ≤ rotationOrder x.1.u2 ∧ + rotationOrder x.1.u3 ≤ rotationOrder x.1.u2 + · let y := normalizedSwap12Surface x + refine ⟨y, sameNormalizedComponent_swap12Surface x, ?_⟩ + simp [y, normalizedSwap12, maximalCoordinateRotationOrder, + hsecond.1, hsecond.2] + · have hthirdFirst : rotationOrder x.1.u1 ≤ rotationOrder x.1.u3 := by omega + have hthirdSecond : rotationOrder x.1.u2 ≤ rotationOrder x.1.u3 := by omega + let y := normalizedSwap12Surface (normalizedSwap23Surface x) + have hcomp := sameNormalizedComponent_trans + (sameNormalizedComponent_swap23Surface x) + (sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x)) + refine ⟨y, hcomp, ?_⟩ + simp [y, normalizedSwap12, normalizedSwap23, maximalCoordinateRotationOrder, + hthirdFirst, hthirdSecond] + +/-- One genuine middle-game step strictly increases the maximum coordinate order. -/ +theorem exists_sameNormalizedComponent_maximalOrder_increase_of_middleRange + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + {δ : ℝ} (hδ : 0 < δ) (hδQuarter : δ ≤ (1 : ℝ) / 4) + (hfour : (4 : ℝ) < (p : ℝ) ^ δ) + (hsize : ∀ currentOrder : ℕ, + (p : ℝ) ^ δ < currentOrder → + (currentOrder : ℝ) < (p : ℝ) ^ (1 - δ) → + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < currentOrder ∧ + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p) + (hBound : WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlower : (p : ℝ) ^ δ < maximalCoordinateRotationOrder x.1) + (hbelow : (maximalCoordinateRotationOrder x.1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + δ)) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ + maximalCoordinateRotationOrder x.1 < maximalCoordinateRotationOrder y.1 := by + obtain ⟨x', hxx', hx'Order⟩ := + exists_sameNormalizedComponent_firstRotation_eq_maximal x + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (show 1 ≤ p by exact (Fact.out : p.Prime).one_le) + have hx'Lower : (p : ℝ) ^ δ < rotationOrder x'.1.u1 := by + simpa [hx'Order] using hlower + have hx'Below : (rotationOrder x'.1.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) := by + simpa [hx'Order] using hbelow + have hx'0 : x'.1.u1 ≠ 0 := by + intro hzero + have hle := rotationOrder_zero_le_four p + rw [hzero] at hx'Lower + have : (rotationOrder (0 : ZMod p) : ℝ) ≤ 4 := by exact_mod_cast hle + linarith + have hx'Nonparabolic : x'.1.u1 ^ 2 ≠ 4 := by + intro hparabolic + have hcases : x'.1.u1 = 2 ∨ x'.1.u1 = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + x'.1.u1 ^ 2 = 4 := hparabolic + _ = (2 : ZMod p) ^ 2 := by norm_num + have hexponentLe : (1 : ℝ) / 2 + δ ≤ 1 := by linarith + have hrpowLe : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ (p : ℝ) := by + simpa using Real.rpow_le_rpow_of_exponent_le hpOne hexponentLe + rcases hcases with htwo | hnegTwo + · rw [htwo, rotationOrder_two] at hx'Below + linarith + · rw [hnegTwo, rotationOrder_neg_two p hpTwo] at hx'Below + have htwoP : (((2 * p : ℕ) : ℝ)) = 2 * (p : ℝ) := by norm_num + rw [htwoP] at hx'Below + have hpPos : (0 : ℝ) < p := by positivity + linarith + have hupperExponent : (1 : ℝ) / 2 + δ ≤ 1 - δ := by linarith + have hupperPower : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ (p : ℝ) ^ (1 - δ) := + Real.rpow_le_rpow_of_exponent_le hpOne hupperExponent + have hx'Upper : (rotationOrder x'.1.u1 : ℝ) < (p : ℝ) ^ (1 - δ) := + hx'Below.trans_le hupperPower + obtain ⟨hcube, hlinear⟩ := hsize (rotationOrder x'.1.u1) hx'Lower hx'Upper + obtain ⟨n, hnIncrease⟩ := + exists_iterate_with_larger_secondRotationOrder_of_weightedTraceBound + p hpTwo δ (by linarith) x'.1 x'.property + hx'0 hx'Nonparabolic hx'Below hcube hlinear hBound + let y := (normalizedRotate1Surface^[n]) x' + have hcoe : y.1 = (normalizedRotate1^[n]) x'.1 := + coe_iterate_normalizedRotate1Surface x' n + refine ⟨y, sameNormalizedComponent_trans hxx' + (sameNormalizedComponent_iterate_normalizedRotate1Surface x' n), ?_⟩ + rw [← hx'Order] + exact hnIncrease.trans_le <| by + have hmeasureEq : maximalCoordinateRotationOrder y.1 = + maximalCoordinateRotationOrder ((normalizedRotate1^[n]) x'.1) := + congrArg maximalCoordinateRotationOrder hcoe + calc + rotationOrder ((normalizedRotate1^[n]) x'.1).u2 ≤ + maximalCoordinateRotationOrder ((normalizedRotate1^[n]) x'.1) := + rotationOrder_second_le_maximalCoordinateRotationOrder _ + _ = maximalCoordinateRotationOrder y.1 := hmeasureEq.symm + +/-- One middle-game step strictly increases the maximum coordinate order when the two +Corvaja--Zannier size inequalities are supplied directly. Unlike +`exists_sameNormalizedComponent_maximalOrder_increase_of_middleRange`, this interface does not +require a fixed lower power threshold for the current order. -/ +theorem exists_sameNormalizedComponent_maximalOrder_increase_of_directBounds + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + {δ : ℝ} (hδ : δ ≤ (1 : ℝ) / 2) + (hBound : WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + (x : NormalizedMarkoffSurface (ZMod p)) + (hbelow : (maximalCoordinateRotationOrder x.1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + δ)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < + maximalCoordinateRotationOrder x.1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * + maximalCoordinateRotationOrder x.1 < p) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ + maximalCoordinateRotationOrder x.1 < maximalCoordinateRotationOrder y.1 := by + obtain ⟨x', hxx', hx'Order⟩ := + exists_sameNormalizedComponent_firstRotation_eq_maximal x + have hx'Cube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < + rotationOrder x'.1.u1 := by + simpa [hx'Order] using hcube + have hx'Linear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * + rotationOrder x'.1.u1 < p := by + simpa [hx'Order] using hlinear + have hsumPos : + 0 < (p - 1).divisors.card + (p + 1).divisors.card := by + have hpPlus : p + 1 ≠ 0 := by omega + have hone : 1 ∈ (p + 1).divisors := Nat.one_mem_divisors.mpr hpPlus + have hcard : 0 < (p + 1).divisors.card := Finset.card_pos.mpr ⟨1, hone⟩ + omega + have hbase : + 4 < (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 := by + have hcoeff : corvajaZannierCorollaryTwoSafeCoefficient ≤ + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) := by + simp only [corvajaZannierCorollaryTwoSafeCoefficient] + nlinarith + calc + 4 < corvajaZannierCorollaryTwoSafeCoefficient ^ 3 := by + norm_num [corvajaZannierCorollaryTwoSafeCoefficient] + _ ≤ (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 := + Nat.pow_le_pow_left hcoeff 3 + have hx'AboveFour : 4 < rotationOrder x'.1.u1 := hbase.trans hx'Cube + have hx'Below : (rotationOrder x'.1.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) := by + simpa [hx'Order] using hbelow + have hx'0 : x'.1.u1 ≠ 0 := by + intro hzero + have hle := rotationOrder_zero_le_four p + rw [hzero] at hx'AboveFour + omega + have hx'Nonparabolic : x'.1.u1 ^ 2 ≠ 4 := by + intro hparabolic + have hcases : x'.1.u1 = 2 ∨ x'.1.u1 = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + x'.1.u1 ^ 2 = 4 := hparabolic + _ = (2 : ZMod p) ^ 2 := by norm_num + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (show 1 ≤ p by exact (Fact.out : p.Prime).one_le) + have hexponentLe : (1 : ℝ) / 2 + δ ≤ 1 := by linarith + have hrpowLe : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ (p : ℝ) := by + simpa using Real.rpow_le_rpow_of_exponent_le hpOne hexponentLe + rcases hcases with htwo | hnegTwo + · rw [htwo, rotationOrder_two] at hx'Below + linarith + · rw [hnegTwo, rotationOrder_neg_two p hpTwo] at hx'Below + have htwoP : (((2 * p : ℕ) : ℝ)) = 2 * (p : ℝ) := by norm_num + rw [htwoP] at hx'Below + have hpPos : (0 : ℝ) < p := by positivity + linarith + obtain ⟨n, hnIncrease⟩ := + exists_iterate_with_larger_secondRotationOrder_of_weightedTraceBound + p hpTwo δ hδ x'.1 x'.property hx'0 hx'Nonparabolic hx'Below + hx'Cube hx'Linear hBound + let y := (normalizedRotate1Surface^[n]) x' + have hcoe : y.1 = (normalizedRotate1^[n]) x'.1 := + coe_iterate_normalizedRotate1Surface x' n + refine ⟨y, sameNormalizedComponent_trans hxx' + (sameNormalizedComponent_iterate_normalizedRotate1Surface x' n), ?_⟩ + rw [← hx'Order] + exact hnIncrease.trans_le <| by + have hmeasureEq : maximalCoordinateRotationOrder y.1 = + maximalCoordinateRotationOrder ((normalizedRotate1^[n]) x'.1) := + congrArg maximalCoordinateRotationOrder hcoe + calc + rotationOrder ((normalizedRotate1^[n]) x'.1).u2 ≤ + maximalCoordinateRotationOrder ((normalizedRotate1^[n]) x'.1) := + rotationOrder_second_le_maximalCoordinateRotationOrder _ + _ = maximalCoordinateRotationOrder y.1 := hmeasureEq.symm + +/-- Repeated weighted-trace escape steps reach the real endgame threshold. -/ +theorem exists_threshold_middleGame_reaches_endgame + (hBound : ∀ (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)], + WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + {δ : ℝ} (hδ : 0 < δ) (hδQuarter : δ ≤ (1 : ℝ) / 4) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + ∀ x : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ δ < maximalCoordinateRotationOrder x.1 → + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ + maximalCoordinateRotationOrder y.1 := by + obtain ⟨sizeThreshold, hsizeThreshold⟩ := + eventually_atTop.mp (eventually_middleGame_corvajaZannier_sizeBounds hδ) + have hfourEventually : + ∀ᶠ p : ℕ in atTop, (4 : ℝ) < (p : ℝ) ^ δ := by + simpa using + (eventually_const_mul_rpow_lt_rpow + (C := (4 : ℝ)) (a := (0 : ℝ)) (b := δ) hδ) + obtain ⟨fourThreshold, hfourThreshold⟩ := eventually_atTop.mp hfourEventually + refine ⟨max (max sizeThreshold fourThreshold) 7, ?_⟩ + intro p hp _ hpThree + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero + (three_ne_zero_zmod_of_prime_ne_three p hpThree) + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + intro x hxLower + have hpSize : sizeThreshold ≤ p := + (le_max_left sizeThreshold fourThreshold).trans + ((le_max_left (max sizeThreshold fourThreshold) 7).trans hp) + have hpFour : fourThreshold ≤ p := + (le_max_right sizeThreshold fourThreshold).trans + ((le_max_left (max sizeThreshold fourThreshold) 7).trans hp) + have hsize := hsizeThreshold p hpSize + have hfour := hfourThreshold p hpFour + let endgameReal : ℝ := (p : ℝ) ^ ((1 : ℝ) / 2 + δ) + let target : ℕ := Nat.ceil endgameReal + let MiddleState := {q : NormalizedMarkoffSurface (ZMod p) // + (p : ℝ) ^ δ < maximalCoordinateRotationOrder q.1} + let start : MiddleState := ⟨x, hxLower⟩ + let r : MiddleState → MiddleState → Prop := fun q z => + SameNormalizedComponent q.1 z.1 + let measure : MiddleState → ℕ := fun q => maximalCoordinateRotationOrder q.1.1 + have hstep : ∀ q : MiddleState, measure q < target → + ∃ z : MiddleState, r q z ∧ measure q < measure z := by + intro q hqTarget + have hqBelow : (maximalCoordinateRotationOrder q.1.1 : ℝ) < endgameReal := by + exact (Nat.lt_ceil.mp hqTarget) + obtain ⟨z, hqz, hincrease⟩ := + exists_sameNormalizedComponent_maximalOrder_increase_of_middleRange + p (by omega) hδ hδQuarter hfour hsize (hBound p) q.1 q.2 hqBelow + exact ⟨⟨z, q.2.trans_le (by exact_mod_cast hincrease.le)⟩, hqz, hincrease⟩ + obtain ⟨finish, hchain, htarget⟩ := + BGS.exists_reflTransGen_measure_ge r measure target hstep start + have hcomponent : SameNormalizedComponent x finish.1 := by + have hchainComponent : ∀ {q z : MiddleState}, Relation.ReflTransGen r q z → + SameNormalizedComponent q.1 z.1 := by + intro q z hqz + induction hqz with + | refl => exact sameNormalizedComponent_refl q.1 + | tail hqa hab ih => + exact sameNormalizedComponent_trans ih hab + exact hchainComponent hchain + have hendgame : endgameReal ≤ (maximalCoordinateRotationOrder finish.1.1 : ℝ) := by + exact (Nat.ceil_le.mp htarget) + exact ⟨finish.1, hcomponent, hendgame⟩ + +/-- The weighted-trace middle-game bound, followed by the completed endgame, +lands every point above the opening threshold in the selected split cage. -/ +theorem exists_threshold_middleGame_to_splitCage + (hBound : ∀ (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)], + WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) (hδQuarter : δ ≤ (1 : ℝ) / 4) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + ∀ x : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ δ < maximalCoordinateRotationOrder x.1 → + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + obtain ⟨middleThreshold, hmiddle⟩ := + exists_threshold_middleGame_reaches_endgame hBound hδ hδQuarter + obtain ⟨endgameThreshold, hendgame⟩ := + exists_threshold_largeOrder_to_splitCage splitCoefficient hSplitWeil + nonsplitCoefficient hNonsplitWeil hδ + refine ⟨max middleThreshold endgameThreshold, ?_⟩ + intro p hp _ hpThree + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + intro x hxLarge + have hpMiddle : middleThreshold ≤ p := (le_max_left _ _).trans hp + have hpEndgame : endgameThreshold ≤ p := (le_max_right _ _).trans hp + obtain ⟨z, hxz, hzLarge⟩ := hmiddle p hpMiddle hpThree x hxLarge + obtain ⟨z', hzz', hz'First⟩ := + exists_sameNormalizedComponent_firstRotation_eq_maximal z + have hz'Large : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder z'.1.u1 := by + simpa [hz'First] using hzLarge + obtain ⟨y, hz'y, hyCage⟩ := hendgame p hpEndgame hpThree z' (Or.inl hz'Large) + exact ⟨y, sameNormalizedComponent_trans hxz + (sameNormalizedComponent_trans hzz' hz'y), hyCage⟩ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean new file mode 100644 index 0000000000..31844f15ae --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean @@ -0,0 +1,64 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape + +/-! +# Nonparabolic coordinates outside the endgame component + +At the exponent used by the explicit route, a normalized parabolic trace has +rotation order at least `p ^ (5 / 6)`. Consequently, once every point at that +threshold is connected to a fixed base point, every point outside the base +component has nonparabolic coordinates. +-/ + +namespace BGS.Markoff + +/-- A point outside a component containing every endgame-large point has +nonparabolic first and second coordinates. -/ +theorem first_two_nonparabolic_of_not_sameComponent_of_endgame_large_connected + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) + (base z : NormalizedMarkoffSurface (ZMod p)) + (hlarge : ∀ y : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder y.1 → + SameNormalizedComponent base y) + (hnot : ¬ SameNormalizedComponent base z) : + z.1.u1 ^ 2 ≠ 4 ∧ z.1.u2 ^ 2 ≠ 4 := by + constructor + · intro hparabolic + apply hnot + apply hlarge z + have hcases := + (normalizedTrace_sq_eq_four_iff_parabolic p z.1.u1).mp hparabolic + have hthreshold := + endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + p hpTwo (1 / 3 : ℝ) (by norm_num) z.1.u1 hcases + calc + (p : ℝ) ^ (5 / 6 : ℝ) = + (p : ℝ) ^ ((1 : ℝ) / 2 + 1 / 3) := by norm_num + _ ≤ (rotationOrder z.1.u1 : ℝ) := hthreshold + _ ≤ maximalCoordinateRotationOrder z.1 := by + exact_mod_cast + rotationOrder_first_le_maximalCoordinateRotationOrder z.1 + · intro hparabolic + apply hnot + apply hlarge z + have hcases := + (normalizedTrace_sq_eq_four_iff_parabolic p z.1.u2).mp hparabolic + have hthreshold := + endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + p hpTwo (1 / 3 : ℝ) (by norm_num) z.1.u2 hcases + calc + (p : ℝ) ^ (5 / 6 : ℝ) = + (p : ℝ) ^ ((1 : ℝ) / 2 + 1 / 3) := by norm_num + _ ≤ (rotationOrder z.1.u2 : ℝ) := hthreshold + _ ≤ maximalCoordinateRotationOrder z.1 := by + exact_mod_cast + rotationOrder_second_le_maximalCoordinateRotationOrder z.1 + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean new file mode 100644 index 0000000000..de750a7af8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean @@ -0,0 +1,381 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame +import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction + +/-! +# Nonparabolic complement frontier + +Instead of maximizing the rotation order on one bad orbit, this route +maximizes it on the entire complement of a fixed punctured component. That +complement is Vieta-invariant, so its cardinality is divisible by `p`. +Assuming the expected even-sign divisibility by four, every nonempty +complement therefore has at least `4 * p` points. + +The parabolic endgame bridge puts the whole complement in the +fixed-point-free small-order set. Consequently its maximal order `d` forces + +`8 * p ≤ (d * M) ^ 2`, + +with no additive parabolic correction. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- The finite complement of the punctured component of `c`. -/ +def puncturedComponentComplementFinset + (p : ℕ) [Fact p.Prime] + (c : PuncturedMarkoffSurface (ZMod p)) : + Finset (PuncturedMarkoffSurface (ZMod p)) := by + classical + exact Finset.univ.filter fun x => ¬ SamePuncturedComponent c x + +@[simp] +theorem mem_puncturedComponentComplementFinset_iff + {p : ℕ} [Fact p.Prime] + {c x : PuncturedMarkoffSurface (ZMod p)} : + x ∈ puncturedComponentComplementFinset p c ↔ + ¬ SamePuncturedComponent c x := by + classical + simp [puncturedComponentComplementFinset] + +theorem puncturedComponentComplementFinset_vieta1_mem_iff + {p : ℕ} [Fact p.Prime] + (c x : PuncturedMarkoffSurface (ZMod p)) : + vieta1PuncturedPerm (ZMod p) x ∈ + puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c := by + rw [mem_puncturedComponentComplementFinset_iff, + mem_puncturedComponentComplementFinset_iff] + constructor + · intro hnot hcx + apply hnot + exact samePuncturedComponent_trans hcx + (samePuncturedComponent_vieta1 x) + · intro hnot hcv + apply hnot + exact samePuncturedComponent_trans hcv + (samePuncturedComponent_symm (samePuncturedComponent_vieta1 x)) + +theorem puncturedComponentComplementFinset_vieta2_mem_iff + {p : ℕ} [Fact p.Prime] + (c x : PuncturedMarkoffSurface (ZMod p)) : + vieta2PuncturedPerm (ZMod p) x ∈ + puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c := by + rw [mem_puncturedComponentComplementFinset_iff, + mem_puncturedComponentComplementFinset_iff] + constructor + · intro hnot hcx + apply hnot + exact samePuncturedComponent_trans hcx + (samePuncturedComponent_vieta2 x) + · intro hnot hcv + apply hnot + exact samePuncturedComponent_trans hcv + (samePuncturedComponent_symm (samePuncturedComponent_vieta2 x)) + +theorem puncturedComponentComplementFinset_vieta3_mem_iff + {p : ℕ} [Fact p.Prime] + (c x : PuncturedMarkoffSurface (ZMod p)) : + vieta3PuncturedPerm (ZMod p) x ∈ + puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c := by + rw [mem_puncturedComponentComplementFinset_iff, + mem_puncturedComponentComplementFinset_iff] + constructor + · intro hnot hcx + apply hnot + exact samePuncturedComponent_trans hcx + (samePuncturedComponent_vieta3 x) + · intro hnot hcv + apply hnot + exact samePuncturedComponent_trans hcv + (samePuncturedComponent_symm (samePuncturedComponent_vieta3 x)) + +/-- The complement of one component is itself Vieta-invariant, hence its +cardinality is divisible by the characteristic prime. -/ +theorem prime_dvd_puncturedComponentComplementFinset_card + (p : ℕ) [Fact p.Prime] (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) : + p ∣ (puncturedComponentComplementFinset p c).card := by + have htwo : (2 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) (by omega)) hpDvd + have hthree : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) hpThree) hpDvd + apply (ZMod.natCast_eq_zero_iff _ _).mp + exact card_cast_eq_zero_of_vieta_invariant htwo hthree + (puncturedComponentComplementFinset p c) + (puncturedComponentComplementFinset_vieta1_mem_iff c) + (puncturedComponentComplementFinset_vieta2_mem_iff c) + (puncturedComponentComplementFinset_vieta3_mem_iff c) + +/-- Combining Vieta `p`-divisibility with a supplied even-sign +four-divisibility gives the exact `4 * p` lower bound for a nonempty +component complement. -/ +theorem four_mul_prime_le_puncturedComponentComplementFinset_card + (p : ℕ) [Fact p.Prime] (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hnonempty : (puncturedComponentComplementFinset p c).Nonempty) + (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) : + 4 * p ≤ (puncturedComponentComplementFinset p c).card := by + have hpOdd : Odd p := + (Fact.out : p.Prime).odd_of_ne_two (by omega) + have hcoprime : Nat.Coprime 4 p := by + simpa using + hpOdd.coprime_two_left.mul_left hpOdd.coprime_two_left + have hdiv : + 4 * p ∣ (puncturedComponentComplementFinset p c).card := + hcoprime.mul_dvd_of_dvd_of_dvd hfour + (prime_dvd_puncturedComponentComplementFinset_card p hpThree c) + exact Nat.le_of_dvd (Finset.card_pos.mpr hnonempty) hdiv + +private def normalizedPuncturedPointNonparabolicComplement + {R : Type*} [Field R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : NormalizedMarkoffSurface R := + normalizedSurfaceOfPunctured (puncturedNormalizationEquiv R x) + +private theorem normalizedPuncturedPointNonparabolicComplement_smul + {R : Type*} [Field R] [Invertible (3 : R)] + (g : Gamma R) (z : PuncturedMarkoffSurface R) : + normalizedPuncturedPointNonparabolicComplement (g • z) = + normalizedGammaPerm R g + (normalizedPuncturedPointNonparabolicComplement z) := by + have hzinv : + (normalizationSurfaceEquiv R).symm + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R z)) = z.1 := by + apply Subtype.ext + exact (normalizationEquiv R).symm_apply_apply z.1.1 + unfold normalizedPuncturedPointNonparabolicComplement + rw [normalizedGammaPerm_apply, hzinv] + apply Subtype.ext + rfl + +/-- Complement-maximal paired frontier with the fixed-point-free low-order +count. The even-sign action is kept explicit: `hsign` records invariance of +the component complement, while `hfour` supplies the remaining free-action +cardinality consequence. -/ +theorem + puncturedMarkoffTransitiveAt_of_nonparabolicComplement_pairedMaximalDivisor_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpThree : 3 < p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hcube : ∀ d : ℕ, 0 < d → + 8 * p ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 → + (6 * maximalDivisorCountSum p (d + 1)) ^ 3 < d) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 * maximalDivisorCountSum p (d + 1) * d < p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedPuncturedPointNonparabolicComplement c) z) + (hsign : ∀ (s : EvenSign) + (x : PuncturedMarkoffSurface (ZMod p)), + s • x ∈ puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c) + (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) : + PuncturedMarkoffTransitiveAt p Fact.out := by + classical + have hpTwo : p ≠ 2 := by omega + letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), + SamePuncturedComponent c x := by + intro x + by_contra hcx + let bad := puncturedComponentComplementFinset p c + have hxBad : x ∈ bad := by + simpa [bad] using hcx + have hbadNonempty : bad.Nonempty := by + refine ⟨(1 : EvenSign) • x, ?_⟩ + exact (by simpa [bad] using (hsign (1 : EvenSign) x).2 hxBad) + let orderMeasure : PuncturedMarkoffSurface (ZMod p) → ℕ := fun w => + maximalCoordinateRotationOrder + (normalizedPuncturedPointNonparabolicComplement w).1 + obtain ⟨z, hzBad, hzMax⟩ := + Finset.exists_max_image bad orderMeasure hbadNonempty + let d := orderMeasure z + have hmax : ∀ w : PuncturedMarkoffSurface (ZMod p), + w ∈ bad → orderMeasure w ≤ d := by + intro w hw + exact hzMax w hw + have hzNotComponent : ¬ SamePuncturedComponent c z := by + simpa [bad] using hzBad + have hdPos : 0 < d := by + have hfirstPos : 0 < + rotationOrder + (normalizedPuncturedPointNonparabolicComplement z).1.u1 := + rotationOrder_pos _ + exact hfirstPos.trans_le <| by + simpa [d, orderMeasure] using + rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointNonparabolicComplement z).1 + have hnotBaseZ : ¬ SameNormalizedComponent + (normalizedPuncturedPointNonparabolicComplement c) + (normalizedPuncturedPointNonparabolicComplement z) := by + intro hcz + apply hzNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c z).2 hcz + have hdUpper : (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + by_contra hd + apply hnotBaseZ + apply hlarge (normalizedPuncturedPointNonparabolicComplement z) + simpa [d, orderMeasure] using le_of_not_gt hd + have hbadSmall : + bad.card ≤ + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := by + apply Finset.card_le_card + intro w hwBad + have hwNotComponent : ¬ SamePuncturedComponent c w := by + simpa [bad] using hwBad + have hwNotBase : ¬ SameNormalizedComponent + (normalizedPuncturedPointNonparabolicComplement c) + (normalizedPuncturedPointNonparabolicComplement w) := by + intro hcw + apply hwNotComponent + exact + (samePuncturedComponent_iff_sameNormalizedComponent c w).2 hcw + have hnonparabolic := + first_two_nonparabolic_of_not_sameComponent_of_endgame_large_connected + hpTwo + (normalizedPuncturedPointNonparabolicComplement c) + (normalizedPuncturedPointNonparabolicComplement w) + hlarge hwNotBase + have hwMax := hmax w hwBad + have hfirst : + rotationOrder + (normalizedPuncturedPointNonparabolicComplement w).1.u1 ≤ d := + (rotationOrder_first_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointNonparabolicComplement w).1).trans hwMax + have hsecond : + rotationOrder + (normalizedPuncturedPointNonparabolicComplement w).1.u2 ≤ d := + (rotationOrder_second_le_maximalCoordinateRotationOrder + (normalizedPuncturedPointNonparabolicComplement w).1).trans hwMax + change w ∈ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1) + rw [ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders, + mem_originalPuncturedFinsetOfNormalized_iff, + mem_normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_iff + ] + refine ⟨?_, ?_, ?_, ?_⟩ + · simpa only [normalizedPuncturedPointNonparabolicComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hfirst + · simpa only [normalizedPuncturedPointNonparabolicComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using Nat.lt_succ_of_le hsecond + · simpa only [normalizedPuncturedPointNonparabolicComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.1 + · simpa only [normalizedPuncturedPointNonparabolicComplement, + normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe] using hnonparabolic.2 + have hfourPLeBad : 4 * p ≤ bad.card := by + apply four_mul_prime_le_puncturedComponentComplementFinset_card + p hpThree c + · simpa [bad] using hbadNonempty + · exact hfour + have heightPLeSmallOrderSquare : + 8 * p ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 := by + calc + 8 * p = 2 * (4 * p) := by ring + _ ≤ 2 * bad.card := Nat.mul_le_mul_left 2 hfourPLeBad + _ ≤ 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card := + Nat.mul_le_mul_left 2 hbadSmall + _ ≤ (d * maximalDivisorCountSum p (d + 1)) ^ 2 := + two_mul_puncturedSmallNonparabolicOrder_succ_card_le_maximalDivisors + hpTwo d + have hcubeCount := hcube d hdPos heightPLeSmallOrderSquare + have hlinearCount := hlinear d hdUpper + have hmaximalCard : + (middleGameMaximalOrders p d).card ≤ + maximalDivisorCountSum p (d + 1) := by + simpa [maximalDivisorCountSum] using + middleGameMaximalOrders_card_le p d + have hrootCoefficient : + 6 * (middleGameMaximalOrders p d).card ≤ + 6 * maximalDivisorCountSum p (d + 1) := + Nat.mul_le_mul_left 6 hmaximalCard + have hlinearCoefficient : + 24 * (middleGameMaximalOrders p d).card ≤ + 24 * maximalDivisorCountSum p (d + 1) := + Nat.mul_le_mul_left 24 hmaximalCard + have hcube' : + (6 * (middleGameMaximalOrders p d).card) ^ 3 < d := + (Nat.pow_le_pow_left hrootCoefficient 3).trans_lt hcubeCount + have hlinear' : + 24 * (middleGameMaximalOrders p d).card * d < p := + (Nat.mul_le_mul_right d hlinearCoefficient).trans_lt hlinearCount + obtain ⟨y, hzy, hincrease⟩ := + exists_sameNormalizedComponent_maximalOrder_increase_of_pairedMaximalDivisorBounds + p hpTwo (delta := (1 / 3 : ℝ)) (by norm_num) + (normalizedPuncturedPointNonparabolicComplement z) + (by simpa only [show (1 / 2 + 1 / 3 : ℝ) = 5 / 6 by norm_num, + d, orderMeasure] using hdUpper) + (by simpa [d, orderMeasure] using hcube') + (by simpa [d, orderMeasure] using hlinear') + obtain ⟨g, hg⟩ := + (sameNormalizedComponent_iff_exists_gamma + (normalizedPuncturedPointNonparabolicComplement z) y).1 hzy + let w : PuncturedMarkoffSurface (ZMod p) := g • z + have hzw : SamePuncturedComponent z w := + (samePuncturedComponent_iff_exists z w).2 ⟨g, rfl⟩ + have hwBad : w ∈ bad := by + rw [show bad = puncturedComponentComplementFinset p c by rfl, + mem_puncturedComponentComplementFinset_iff] + intro hcw + apply hzNotComponent + exact samePuncturedComponent_trans hcw + (samePuncturedComponent_symm hzw) + have hwNormalized : + normalizedPuncturedPointNonparabolicComplement w = y := by + change normalizedPuncturedPointNonparabolicComplement (g • z) = y + rw [normalizedPuncturedPointNonparabolicComplement_smul] + exact hg + have hwMax := hmax w hwBad + change maximalCoordinateRotationOrder + (normalizedPuncturedPointNonparabolicComplement w).1 ≤ d at hwMax + rw [hwNormalized] at hwMax + have hincrease' : d < maximalCoordinateRotationOrder y.1 := by + simpa [d, orderMeasure] using hincrease + exact (not_lt_of_ge hwMax) hincrease' + intro a b + obtain ⟨ga, hga⟩ := + (samePuncturedComponent_iff_exists c a).1 (hAll a) + obtain ⟨gb, hgb⟩ := + (samePuncturedComponent_iff_exists c b).1 (hAll b) + refine ⟨gb * ga⁻¹, ?_⟩ + calc + (gb * ga⁻¹) • a = gb • (ga⁻¹ • a) := mul_smul _ _ _ + _ = gb • c := by rw [← hga]; simp + _ = b := hgb + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean new file mode 100644 index 0000000000..8ae8007f09 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean @@ -0,0 +1,138 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount + +/-! +# Fixed-point-free low-order traces on the two rotation tori + +The nonparabolic low-order trace set omits the global parabolic set and uses +only eigenvalues whose square is not one. Inversion is therefore +fixed-point-free on both the split and norm-one sources, giving + +`2 * |nonparabolic low traces| ≤ (bound - 1) * M`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- Nonparabolic bounded-order traces represented in either the split torus +or the quadratic norm-one torus. -/ +def nonparabolicConcreteLowOrderTraceSet + (p : ℕ) [Fact p.Prime] (bound : ℕ) : Finset (ZMod p) := by + classical + exact + nonTwoTorsionBoundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound ∪ + nonTwoTorsionBoundedOrderTraceSet + (quadraticNormOneTrace p) bound + +/-- Every nonparabolic trace of small rotation order lies in the +fixed-point-free concrete trace set. -/ +theorem mem_nonparabolicConcreteLowOrderTraceSet_of_rotationOrder_lt + {p : ℕ} [Fact p.Prime] + (hpTwo : p ≠ 2) (t : ZMod p) (bound : ℕ) + (hnonparabolic : t ^ 2 ≠ 4) + (hsmall : rotationOrder t < bound) : + t ∈ nonparabolicConcreteLowOrderTraceSet p bound := by + classical + rcases exists_split_or_quadraticNormOneTrace + p hpTwo t hnonparabolic with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · rw [nonparabolicConcreteLowOrderTraceSet, Finset.mem_union] + apply Or.inl + rw [nonTwoTorsionBoundedOrderTraceSet, Finset.mem_image] + refine ⟨w, Finset.mem_filter.mpr ⟨Finset.mem_univ _, ?_, ?_⟩, + htrace⟩ + · rw [← rotationOrder_splitTorusTrace w hw, htrace] + exact hsmall + · intro hsq + apply hw + simpa using congrArg (fun u : (ZMod p)ˣ ↦ (u : ZMod p)) hsq + · rw [nonparabolicConcreteLowOrderTraceSet, Finset.mem_union] + apply Or.inr + rw [nonTwoTorsionBoundedOrderTraceSet, Finset.mem_image] + refine ⟨w, Finset.mem_filter.mpr ⟨Finset.mem_univ _, ?_, ?_⟩, + htrace⟩ + · rw [← rotationOrder_quadraticNormOneTrace p w hw, htrace] + exact hsmall + · intro hsq + apply hw + simpa using congrArg + (fun u : quadraticNormOneTorus p ↦ + (((u : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p))) hsq + +/-- The exact fixed-point-free maximal-divisor trace count. -/ +theorem two_mul_nonparabolicConcreteLowOrderTraceSet_card_le + {p : ℕ} [Fact p.Prime] (bound : ℕ) : + 2 * (nonparabolicConcreteLowOrderTraceSet p bound).card ≤ + (bound - 1) * maximalDivisorCountSum p bound := by + classical + let splitSet := + nonTwoTorsionBoundedOrderTraceSet + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound + let nonsplitSet := + nonTwoTorsionBoundedOrderTraceSet + (quadraticNormOneTrace p) bound + have hsplit : + 2 * splitSet.card ≤ + (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (ZMod p)ˣ) bound).card := by + exact + two_mul_nonTwoTorsionBoundedOrderTraceSet_card_le_maximalDivisors + (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound + (splitTorusTrace_inv (ZMod p)) + have hnonsplit : + 2 * nonsplitSet.card ≤ + (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (quadraticNormOneTorus p)) bound).card := by + exact + two_mul_nonTwoTorsionBoundedOrderTraceSet_card_le_maximalDivisors + (quadraticNormOneTrace p) bound + (quadraticNormOneTrace_inv p) + have hsplitCard : Fintype.card (ZMod p)ˣ = p - 1 := by + rw [← Nat.card_eq_fintype_card, Nat.card_units, Nat.card_zmod] + have hnonsplitCard : + Fintype.card (quadraticNormOneTorus p) = p + 1 := by + rw [← Nat.card_eq_fintype_card, quadraticNormOneTorus_natCard] + calc + 2 * (nonparabolicConcreteLowOrderTraceSet p bound).card ≤ + 2 * (splitSet.card + nonsplitSet.card) := by + apply Nat.mul_le_mul_left + simpa [nonparabolicConcreteLowOrderTraceSet, splitSet, nonsplitSet] using + (Finset.card_union_le splitSet nonsplitSet) + _ = 2 * splitSet.card + 2 * nonsplitSet.card := by ring + _ ≤ (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (ZMod p)ˣ) bound).card + + (bound - 1) * + (maximalDivisorsBelow + (Fintype.card (quadraticNormOneTorus p)) bound).card := by + omega + _ = (bound - 1) * maximalDivisorCountSum p bound := by + rw [hsplitCard, hnonsplitCard] + simp only [maximalDivisorCountSum, Nat.mul_add] + +/-- At `bound = d + 1`, the fixed-point-free trace estimate has the exact +coefficient `d`. -/ +theorem two_mul_nonparabolicConcreteLowOrderTraceSet_succ_card_le + {p : ℕ} [Fact p.Prime] (d : ℕ) : + 2 * + (nonparabolicConcreteLowOrderTraceSet p (d + 1)).card ≤ + d * maximalDivisorCountSum p (d + 1) := by + simpa using + (two_mul_nonparabolicConcreteLowOrderTraceSet_card_le + (p := p) (d + 1)) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean new file mode 100644 index 0000000000..ba727ce18a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization + +/-! +# Fixed-point-free small-order counts on the punctured surface + +Restricting both counted coordinates to nonparabolic traces removes the +two-torsion correction from the torus trace count. The resulting transported +punctured set satisfies + +`2 * |small nonparabolic points| ≤ ((bound - 1) * M) ^ 2`. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Normalized punctured points whose first two coordinates are both +nonparabolic and have rotation order below `bound`. -/ +def normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + Finset ↥(normalizedPuncturedSurface (ZMod p)) := by + classical + exact Finset.univ.filter fun x => + rotationOrder x.1.u1 < bound ∧ + rotationOrder x.1.u2 < bound ∧ + x.1.u1 ^ 2 ≠ 4 ∧ x.1.u2 ^ 2 ≠ 4 + +@[simp] +theorem mem_normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_iff + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] {bound : ℕ} + {x : ↥(normalizedPuncturedSurface (ZMod p))} : + x ∈ + normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound ↔ + rotationOrder x.1.u1 < bound ∧ + rotationOrder x.1.u2 < bound ∧ + x.1.u1 ^ 2 ≠ 4 ∧ x.1.u2 ^ 2 ≠ 4 := by + classical + simp + [normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders] + +/-- Forgetting the puncture embeds the nonparabolic small-order set into the +ambient set cut out by the fixed-point-free trace set. -/ +theorem normalizedPuncturedSmallNonparabolicOrderValues_subset_traceSet + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (bound : ℕ) : + (normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound).map ⟨Subtype.val, Subtype.val_injective⟩ ⊆ + normalizedMarkoffPointsWithFirstTwoCoordinatesIn + (nonparabolicConcreteLowOrderTraceSet p bound) := by + intro x hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_map.mp hx + rw [ + mem_normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_iff + ] at hy + exact mem_normalizedMarkoffPointsWithFirstTwoCoordinatesIn_iff.mpr + ⟨y.2.1, + mem_nonparabolicConcreteLowOrderTraceSet_of_rotationOrder_lt + hpTwo y.1.u1 bound hy.2.2.1 hy.1, + mem_nonparabolicConcreteLowOrderTraceSet_of_rotationOrder_lt + hpTwo y.1.u2 bound hy.2.2.2 hy.2.1⟩ + +/-- Original punctured points transported from the normalized nonparabolic +small-order set. -/ +def puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + Finset (PuncturedMarkoffSurface (ZMod p)) := + originalPuncturedFinsetOfNormalized + (normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound) + +theorem puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_card_eq_normalized + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound).card = + (normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound).card := by + exact originalPuncturedFinsetOfNormalized_card _ + +/-- The fixed-point-free trace pairing on both coordinates gives a square +bound with no additive parabolic correction. -/ +theorem two_mul_puncturedSmallNonparabolicOrder_card_le_maximalDivisors + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (bound : ℕ) : + 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound).card ≤ + ((bound - 1) * maximalDivisorCountSum p bound) ^ 2 := by + classical + rw [ + puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders_card_eq_normalized + ] + let smallSet := + normalizedPuncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p bound + let traceSet := nonparabolicConcreteLowOrderTraceSet p bound + have hpoints : smallSet.card ≤ 2 * traceSet.card ^ 2 := by + rw [← Finset.card_map + (f := ⟨Subtype.val, Subtype.val_injective⟩)] + exact + (Finset.card_mono + (normalizedPuncturedSmallNonparabolicOrderValues_subset_traceSet + hpTwo bound)).trans + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn_card_le traceSet) + have htraces : + 2 * traceSet.card ≤ + (bound - 1) * maximalDivisorCountSum p bound := by + exact two_mul_nonparabolicConcreteLowOrderTraceSet_card_le bound + change 2 * smallSet.card ≤ + ((bound - 1) * maximalDivisorCountSum p bound) ^ 2 + calc + 2 * smallSet.card ≤ 2 * (2 * traceSet.card ^ 2) := + Nat.mul_le_mul_left 2 hpoints + _ = (2 * traceSet.card) ^ 2 := by ring + _ ≤ ((bound - 1) * maximalDivisorCountSum p bound) ^ 2 := by + gcongr + +/-- At `bound = d + 1`, the low-order square has coefficient exactly `d`. -/ +theorem two_mul_puncturedSmallNonparabolicOrder_succ_card_le_maximalDivisors + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (d : ℕ) : + 2 * + (puncturedMarkoffPointsWithSmallNonparabolicFirstTwoRotationOrders + p (d + 1)).card ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 := by + simpa using + (two_mul_puncturedSmallNonparabolicOrder_card_le_maximalDivisors + hpTwo (d + 1)) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean new file mode 100644 index 0000000000..8ed7c6176a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +/-! +# Finite counts in normalized Markoff coordinates + +This module transports the canonical two-point bound for a fixed pair of original Markoff +coordinates across `normalizationEquiv`. It then sums that bound over a finite set of possible +first and second normalized coordinates. +-/ + +namespace BGS.Markoff + +universe u + +section NormalizedThirdCoordinateFiber + +variable {F : Type u} [Field F] [Fintype F] [Invertible (3 : F)] + +/-- The original coordinate whose normalized value is `a`. -/ +def originalCoordinateOfNormalized (a : F) : F := + (⅟ (3 : F)) * a + +/-- Normalized Markoff points with prescribed first and second coordinates, obtained by mapping +the canonical original-coordinate fiber through the normalization equivalence. -/ +noncomputable def normalizedMarkoffPointsWithFirstTwoCoordinates (a b : F) : + Finset (NormalizedPoint F) := + (markoffPointsWithFirstTwoCoordinates + (originalCoordinateOfNormalized a) (originalCoordinateOfNormalized b)).map + (normalizationEquiv F).toEmbedding + +@[simp] +theorem mem_normalizedMarkoffPointsWithFirstTwoCoordinates_iff + {a b : F} {x : NormalizedPoint F} : + x ∈ normalizedMarkoffPointsWithFirstTwoCoordinates a b ↔ + IsNormalizedMarkoff x ∧ x.u1 = a ∧ x.u2 = b := by + classical + constructor + · intro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_map.mp hx + obtain ⟨hyMarkoff, hy1, hy2⟩ := + mem_markoffPointsWithFirstTwoCoordinates_iff.mp hy + refine ⟨(isNormalizedMarkoff_toNormalized_iff y).2 hyMarkoff, ?_, ?_⟩ + · simp [normalizationEquiv, toNormalized, originalCoordinateOfNormalized, hy1, + ← mul_assoc] + · simp [normalizationEquiv, toNormalized, originalCoordinateOfNormalized, hy2, + ← mul_assoc] + · rintro ⟨hxMarkoff, hx1, hx2⟩ + let y : Point F := fromNormalized x + have hnormalize : toNormalized y = x := by + change (normalizationEquiv F) ((normalizationEquiv F).symm x) = x + exact (normalizationEquiv F).apply_symm_apply x + have hyMarkoff : IsMarkoff y := by + apply (isNormalizedMarkoff_toNormalized_iff y).mp + rw [hnormalize] + exact hxMarkoff + have hy1 : y.x1 = originalCoordinateOfNormalized a := by + simp [y, fromNormalized, originalCoordinateOfNormalized, hx1] + have hy2 : y.x2 = originalCoordinateOfNormalized b := by + simp [y, fromNormalized, originalCoordinateOfNormalized, hx2] + apply Finset.mem_map.mpr + refine ⟨y, mem_markoffPointsWithFirstTwoCoordinates_iff.mpr ⟨hyMarkoff, hy1, hy2⟩, ?_⟩ + exact hnormalize + +/-- Mapping through normalization preserves the exact cardinality of a fixed-coordinate fiber. -/ +theorem normalizedMarkoffPointsWithFirstTwoCoordinates_card_eq_original (a b : F) : + (normalizedMarkoffPointsWithFirstTwoCoordinates a b).card = + (markoffPointsWithFirstTwoCoordinates + (originalCoordinateOfNormalized a) (originalCoordinateOfNormalized b)).card := by + classical + simp [normalizedMarkoffPointsWithFirstTwoCoordinates] + +/-- Fixing the first two normalized coordinates leaves at most two normalized Markoff points. -/ +theorem normalizedMarkoffPointsWithFirstTwoCoordinates_card_le_two (a b : F) : + (normalizedMarkoffPointsWithFirstTwoCoordinates a b).card ≤ 2 := by + rw [normalizedMarkoffPointsWithFirstTwoCoordinates_card_eq_original] + exact markoffPointsWithFirstTwoCoordinates_card_le_two _ _ + +/-- Normalized Markoff points whose first two coordinates both lie in `S`. -/ +noncomputable def normalizedMarkoffPointsWithFirstTwoCoordinatesIn (S : Finset F) : + Finset (NormalizedPoint F) := by + classical + exact (S.product S).biUnion fun ab => + normalizedMarkoffPointsWithFirstTwoCoordinates ab.1 ab.2 + +@[simp] +theorem mem_normalizedMarkoffPointsWithFirstTwoCoordinatesIn_iff + {S : Finset F} {x : NormalizedPoint F} : + x ∈ normalizedMarkoffPointsWithFirstTwoCoordinatesIn S ↔ + IsNormalizedMarkoff x ∧ x.u1 ∈ S ∧ x.u2 ∈ S := by + classical + rw [normalizedMarkoffPointsWithFirstTwoCoordinatesIn, Finset.mem_biUnion] + constructor + · rintro ⟨ab, hab, hx⟩ + have hab' : ab.1 ∈ S ∧ ab.2 ∈ S := Finset.mem_product.mp hab + rw [mem_normalizedMarkoffPointsWithFirstTwoCoordinates_iff] at hx + exact ⟨hx.1, hx.2.1 ▸ hab'.1, hx.2.2 ▸ hab'.2⟩ + · rintro ⟨hxMarkoff, hx1, hx2⟩ + refine ⟨(x.u1, x.u2), Finset.mem_product.mpr ⟨hx1, hx2⟩, ?_⟩ + exact mem_normalizedMarkoffPointsWithFirstTwoCoordinates_iff.mpr + ⟨hxMarkoff, rfl, rfl⟩ + +/-- If both of the first two normalized coordinates lie in a finite set `S`, there are at most +`2 * |S|^2` normalized Markoff points. -/ +theorem normalizedMarkoffPointsWithFirstTwoCoordinatesIn_card_le + (S : Finset F) : + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn S).card ≤ 2 * S.card ^ 2 := by + classical + calc + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn S).card ≤ + (S.product S).card * 2 := by + apply Finset.card_biUnion_le_card_mul + intro ab hab + exact normalizedMarkoffPointsWithFirstTwoCoordinates_card_le_two ab.1 ab.2 + _ = 2 * S.card ^ 2 := by + simp [Finset.card_product, pow_two, Nat.mul_comm] + +end NormalizedThirdCoordinateFiber + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean new file mode 100644 index 0000000000..90a5426e70 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization + +/-! +# The elementary small-order point count + +This module connects matrix rotation order to the concrete split/nonsplit trace set and then to +the normalized fixed-fiber bound. It is the counting step omitted from the paper's final +assembly; no dynamical assertion about escaping to the cage is assumed here. +-/ + +namespace BGS.Markoff + +/-- Normalized Markoff points whose first two matrix rotation orders are below `bound`. -/ +noncomputable def normalizedMarkoffPointsWithSmallFirstTwoRotationOrders + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + Finset (NormalizedPoint (ZMod p)) := by + classical + exact Finset.univ.filter fun x => + IsNormalizedMarkoff x ∧ rotationOrder x.u1 < bound ∧ rotationOrder x.u2 < bound + +@[simp] +theorem mem_normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_iff + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] {bound : ℕ} + {x : NormalizedPoint (ZMod p)} : + x ∈ normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound ↔ + IsNormalizedMarkoff x ∧ rotationOrder x.u1 < bound ∧ rotationOrder x.u2 < bound := by + classical + simp [normalizedMarkoffPointsWithSmallFirstTwoRotationOrders] + +theorem normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_subset_traceSet + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) (bound : ℕ) : + normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound ⊆ + normalizedMarkoffPointsWithFirstTwoCoordinatesIn (concreteLowOrderTraceSet p bound) := by + intro x hx + rw [mem_normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] at hx + exact mem_normalizedMarkoffPointsWithFirstTwoCoordinatesIn_iff.mpr + ⟨hx.1, + mem_concreteLowOrderTraceSet_of_rotationOrder_lt p hpTwo x.u1 bound hx.2.1, + mem_concreteLowOrderTraceSet_of_rotationOrder_lt p hpTwo x.u2 bound hx.2.2⟩ + +/-- The concrete low-order trace set, counted using the divisors of the two torus orders. -/ +theorem concreteLowOrderTraceSet_card_le_divisor_sensitive + {p : ℕ} [Fact p.Prime] (bound : ℕ) : + (concreteLowOrderTraceSet p bound).card ≤ + 2 + (bound - 1) * ((p - 1).divisors.card + (p + 1).divisors.card) := by + have hsplit : Fintype.card (ZMod p)ˣ = p - 1 := by + rw [← Nat.card_eq_fintype_card, Nat.card_units, Nat.card_zmod] + have hnonsplit : Fintype.card (quadraticNormOneTorus p) = p + 1 := by + rw [← Nat.card_eq_fintype_card, quadraticNormOneTorus_natCard] + calc + (concreteLowOrderTraceSet p bound).card ≤ + (normalizedParabolicTraceSet p).card + (bound - 1) * + ((Fintype.card (ZMod p)ˣ).divisors.card + + (Fintype.card (quadraticNormOneTorus p)).divisors.card) := by + exact lowOrderTraceSet_card_le_parabolic_add_pred_mul_divisor_cards + (normalizedParabolicTraceSet p) (splitTorusTrace : (ZMod p)ˣ → ZMod p) + (quadraticNormOneTrace p) bound + _ ≤ 2 + (bound - 1) * ((p - 1).divisors.card + (p + 1).divisors.card) := by + rw [hsplit, hnonsplit] + gcongr + exact Finset.card_le_two + +theorem concreteLowOrderTraceSet_succ_card_le_divisor_sensitive + {p : ℕ} [Fact p.Prime] (d : ℕ) : + (concreteLowOrderTraceSet p (d + 1)).card ≤ + 2 + d * ((p - 1).divisors.card + (p + 1).divisors.card) := by + simpa using (concreteLowOrderTraceSet_card_le_divisor_sensitive (p := p) (d + 1)) + +/-- The fully connected crude count used in the giant-orbit assembly. -/ +theorem normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) (bound : ℕ) : + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + 2 * (2 + 2 * bound ^ 2) ^ 2 := by + calc + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn + (concreteLowOrderTraceSet p bound)).card := + Finset.card_mono + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_subset_traceSet + hpTwo bound) + _ ≤ 2 * (concreteLowOrderTraceSet p bound).card ^ 2 := + normalizedMarkoffPointsWithFirstTwoCoordinatesIn_card_le _ + _ ≤ 2 * (2 + 2 * bound ^ 2) ^ 2 := by + gcongr + exact concreteLowOrderTraceSet_card_le p bound + +/-- The normalized small-order point count obtained from the divisor-sensitive trace count. -/ +theorem normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_divisor_sensitive + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) (bound : ℕ) : + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + 2 * (2 + (bound - 1) * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := by + calc + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + (normalizedMarkoffPointsWithFirstTwoCoordinatesIn + (concreteLowOrderTraceSet p bound)).card := + Finset.card_mono + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_subset_traceSet + hpTwo bound) + _ ≤ 2 * (concreteLowOrderTraceSet p bound).card ^ 2 := + normalizedMarkoffPointsWithFirstTwoCoordinatesIn_card_le _ + _ ≤ 2 * + (2 + (bound - 1) * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := by + gcongr + exact concreteLowOrderTraceSet_card_le_divisor_sensitive bound + +theorem normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_succ_card_le_divisor_sensitive + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) (d : ℕ) : + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1)).card ≤ + 2 * (2 + d * ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := by + simpa using + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_divisor_sensitive + hpTwo (d + 1)) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean new file mode 100644 index 0000000000..5a242692f6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean @@ -0,0 +1,379 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action + +/-! +# Divisibility of Markoff orbit cardinalities + +This file formalizes Daniel E. Martin's elementary proof of the Markoff-graph corollary of +Chen's theorem. Piecewise Penner weights sum to one at every punctured Markoff point, while the +weight in coordinate `i` pairs to one across the `i`-th Vieta involution. Reindexing a finite +Vieta-invariant set by those involutions then forces its cardinality to vanish in the ground +field. Over `ZMod p`, this says that `p` divides the cardinality. + +The result is stated only for `3 < p`. This is the range used in Martin's proof and is necessary: +at `p = 3` the eight points with all coordinates in `{1, -1}` form one Vieta component. +-/ + +namespace BGS.Markoff + +universe u + +/-- Martin's piecewise Penner weights in the original Markoff coordinates. -/ +noncomputable def pennerWeights {F : Type u} [Field F] (x : Point F) : Point F := by + classical + exact if hx1 : x.x1 = 0 then + ⟨0, 1 / 2, 1 / 2⟩ + else if hx2 : x.x2 = 0 then + ⟨1 / 2, 0, 1 / 2⟩ + else if hx3 : x.x3 = 0 then + ⟨1 / 2, 1 / 2, 0⟩ + else + ⟨x.x1 / (3 * x.x2 * x.x3), + x.x2 / (3 * x.x1 * x.x3), + x.x3 / (3 * x.x1 * x.x2)⟩ + +/-- Penner weights restricted to the punctured Markoff surface. -/ +noncomputable def puncturedPennerWeights {F : Type u} [Field F] + (x : PuncturedMarkoffSurface F) : Point F := + pennerWeights x.1.1 + +private theorem half_add_half_eq_one {F : Type u} [Field F] (htwo : (2 : F) ≠ 0) : + (1 / 2 : F) + 1 / 2 = 1 := by + field_simp + ring + +private theorem first_ne_zero_of_second_eq_zero + {F : Type u} [Field F] (x : PuncturedMarkoffSurface F) + (hx2 : x.1.1.x2 = 0) : x.1.1.x1 ≠ 0 := by + intro hx1 + have hx3 : x.1.1.x3 = 0 := by + have hmark := x.1.2 + simp [IsMarkoff, markoffPolynomial, hx1, hx2] at hmark + exact hmark + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hx1, hx2, hx3] + +private theorem first_ne_zero_of_third_eq_zero + {F : Type u} [Field F] (x : PuncturedMarkoffSurface F) + (hx3 : x.1.1.x3 = 0) : x.1.1.x1 ≠ 0 := by + intro hx1 + have hx2 : x.1.1.x2 = 0 := by + have hmark := x.1.2 + simp [IsMarkoff, markoffPolynomial, hx1, hx3] at hmark + exact hmark + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hx1, hx2, hx3] + +private theorem second_ne_zero_of_first_eq_zero + {F : Type u} [Field F] (x : PuncturedMarkoffSurface F) + (hx1 : x.1.1.x1 = 0) : x.1.1.x2 ≠ 0 := by + intro hx2 + have hx3 : x.1.1.x3 = 0 := by + have hmark := x.1.2 + simp [IsMarkoff, markoffPolynomial, hx1, hx2] at hmark + exact hmark + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hx1, hx2, hx3] + +private theorem second_ne_zero_of_third_eq_zero + {F : Type u} [Field F] (x : PuncturedMarkoffSurface F) + (hx3 : x.1.1.x3 = 0) : x.1.1.x2 ≠ 0 := by + intro hx2 + have hx1 : x.1.1.x1 = 0 := by + have hmark := x.1.2 + simp [IsMarkoff, markoffPolynomial, hx2, hx3] at hmark + exact hmark + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hx1, hx2, hx3] + +private theorem third_ne_zero_of_first_eq_zero + {F : Type u} [Field F] (x : PuncturedMarkoffSurface F) + (hx1 : x.1.1.x1 = 0) : x.1.1.x3 ≠ 0 := by + intro hx3 + have hx2 : x.1.1.x2 = 0 := by + have hmark := x.1.2 + simp [IsMarkoff, markoffPolynomial, hx1, hx3] at hmark + exact hmark + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hx1, hx2, hx3] + +private theorem third_ne_zero_of_second_eq_zero + {F : Type u} [Field F] (x : PuncturedMarkoffSurface F) + (hx2 : x.1.1.x2 = 0) : x.1.1.x3 ≠ 0 := by + intro hx3 + have hx1 : x.1.1.x1 = 0 := by + have hmark := x.1.2 + simp [IsMarkoff, markoffPolynomial, hx2, hx3] at hmark + exact hmark + apply x.2 + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin, hx1, hx2, hx3] + +private theorem pennerWeights_first_of_second_third_ne_zero + {F : Type u} [Field F] (x : Point F) (hx2 : x.x2 ≠ 0) (hx3 : x.x3 ≠ 0) : + (pennerWeights x).x1 = x.x1 / (3 * x.x2 * x.x3) := by + by_cases hx1 : x.x1 = 0 + · simp [pennerWeights, hx1] + · simp [pennerWeights, hx1, hx2, hx3] + +private theorem pennerWeights_second_of_first_third_ne_zero + {F : Type u} [Field F] (x : Point F) (hx1 : x.x1 ≠ 0) (hx3 : x.x3 ≠ 0) : + (pennerWeights x).x2 = x.x2 / (3 * x.x1 * x.x3) := by + by_cases hx2 : x.x2 = 0 + · simp [pennerWeights, hx1, hx2] + · simp [pennerWeights, hx1, hx2, hx3] + +private theorem pennerWeights_third_of_first_second_ne_zero + {F : Type u} [Field F] (x : Point F) (hx1 : x.x1 ≠ 0) (hx2 : x.x2 ≠ 0) : + (pennerWeights x).x3 = x.x3 / (3 * x.x1 * x.x2) := by + by_cases hx3 : x.x3 = 0 + · simp [pennerWeights, hx1, hx2, hx3] + · simp [pennerWeights, hx1, hx2, hx3] + +/-- The three Penner weights at a punctured Markoff point sum to one. -/ +theorem puncturedPennerWeights_sum_eq_one + {F : Type u} [Field F] (htwo : (2 : F) ≠ 0) (hthree : (3 : F) ≠ 0) + (x : PuncturedMarkoffSurface F) : + (puncturedPennerWeights x).x1 + (puncturedPennerWeights x).x2 + + (puncturedPennerWeights x).x3 = 1 := by + by_cases hx1 : x.1.1.x1 = 0 + · simpa [puncturedPennerWeights, pennerWeights, hx1] using half_add_half_eq_one htwo + by_cases hx2 : x.1.1.x2 = 0 + · simpa [puncturedPennerWeights, pennerWeights, hx1, hx2] using half_add_half_eq_one htwo + by_cases hx3 : x.1.1.x3 = 0 + · simpa [puncturedPennerWeights, pennerWeights, hx1, hx2, hx3] using + half_add_half_eq_one htwo + have hmark := x.1.2 + change x.1.1.x1 ^ 2 + x.1.1.x2 ^ 2 + x.1.1.x3 ^ 2 - + 3 * x.1.1.x1 * x.1.1.x2 * x.1.1.x3 = 0 at hmark + rw [sub_eq_zero] at hmark + simp only [puncturedPennerWeights, pennerWeights, hx1, hx2, hx3, ↓reduceDIte] + calc + x.1.1.x1 / (3 * x.1.1.x2 * x.1.1.x3) + + x.1.1.x2 / (3 * x.1.1.x1 * x.1.1.x3) + + x.1.1.x3 / (3 * x.1.1.x1 * x.1.1.x2) = + (x.1.1.x1 ^ 2 + x.1.1.x2 ^ 2 + x.1.1.x3 ^ 2) / + (3 * x.1.1.x1 * x.1.1.x2 * x.1.1.x3) := by + field_simp [hx1, hx2, hx3, hthree] + _ = 1 := by rw [hmark]; field_simp [hx1, hx2, hx3, hthree] + +/-- The first Penner weight pairs to one across the first Vieta involution. -/ +theorem puncturedPennerWeight_first_add_vieta1_eq_one + {F : Type u} [Field F] (htwo : (2 : F) ≠ 0) (hthree : (3 : F) ≠ 0) + (x : PuncturedMarkoffSurface F) : + (puncturedPennerWeights x).x1 + + (puncturedPennerWeights (vieta1PuncturedPerm F x)).x1 = 1 := by + change (pennerWeights x.1.1).x1 + (pennerWeights (vieta1 x.1.1)).x1 = 1 + by_cases hx2 : x.1.1.x2 = 0 + · have hx1 := first_ne_zero_of_second_eq_zero x hx2 + simpa [pennerWeights, vieta1, hx1, hx2] using half_add_half_eq_one htwo + by_cases hx3 : x.1.1.x3 = 0 + · have hx1 := first_ne_zero_of_third_eq_zero x hx3 + simpa [pennerWeights, vieta1, hx1, hx2, hx3] using half_add_half_eq_one htwo + rw [pennerWeights_first_of_second_third_ne_zero x.1.1 hx2 hx3] + rw [pennerWeights_first_of_second_third_ne_zero (vieta1 x.1.1) (by simpa [vieta1]) + (by simpa [vieta1])] + simp only [vieta1] + field_simp [hx2, hx3, hthree] + ring + +/-- The second Penner weight pairs to one across the second Vieta involution. -/ +theorem puncturedPennerWeight_second_add_vieta2_eq_one + {F : Type u} [Field F] (htwo : (2 : F) ≠ 0) (hthree : (3 : F) ≠ 0) + (x : PuncturedMarkoffSurface F) : + (puncturedPennerWeights x).x2 + + (puncturedPennerWeights (vieta2PuncturedPerm F x)).x2 = 1 := by + change (pennerWeights x.1.1).x2 + (pennerWeights (vieta2 x.1.1)).x2 = 1 + by_cases hx1 : x.1.1.x1 = 0 + · have hx2 := second_ne_zero_of_first_eq_zero x hx1 + simpa [pennerWeights, vieta2, hx1, hx2] using half_add_half_eq_one htwo + by_cases hx3 : x.1.1.x3 = 0 + · have hx2 := second_ne_zero_of_third_eq_zero x hx3 + simpa [pennerWeights, vieta2, hx1, hx2, hx3] using half_add_half_eq_one htwo + rw [pennerWeights_second_of_first_third_ne_zero x.1.1 hx1 hx3] + rw [pennerWeights_second_of_first_third_ne_zero (vieta2 x.1.1) (by simpa [vieta2]) + (by simpa [vieta2])] + simp only [vieta2] + field_simp [hx1, hx3, hthree] + ring + +/-- The third Penner weight pairs to one across the third Vieta involution. -/ +theorem puncturedPennerWeight_third_add_vieta3_eq_one + {F : Type u} [Field F] (htwo : (2 : F) ≠ 0) (hthree : (3 : F) ≠ 0) + (x : PuncturedMarkoffSurface F) : + (puncturedPennerWeights x).x3 + + (puncturedPennerWeights (vieta3PuncturedPerm F x)).x3 = 1 := by + change (pennerWeights x.1.1).x3 + (pennerWeights (vieta3 x.1.1)).x3 = 1 + by_cases hx1 : x.1.1.x1 = 0 + · have hx3 := third_ne_zero_of_first_eq_zero x hx1 + simpa [pennerWeights, vieta3, hx1, hx3] using half_add_half_eq_one htwo + by_cases hx2 : x.1.1.x2 = 0 + · have hx3 := third_ne_zero_of_second_eq_zero x hx2 + simpa [pennerWeights, vieta3, hx1, hx2, hx3] using half_add_half_eq_one htwo + rw [pennerWeights_third_of_first_second_ne_zero x.1.1 hx1 hx2] + rw [pennerWeights_third_of_first_second_ne_zero (vieta3 x.1.1) (by simpa [vieta3]) + (by simpa [vieta3])] + simp only [vieta3] + field_simp [hx1, hx2, hthree] + ring + +/-- A finite punctured Markoff set invariant under all three Vieta involutions has cardinality +zero in the ground field. -/ +theorem card_cast_eq_zero_of_vieta_invariant + {F : Type u} [Field F] (htwo : (2 : F) ≠ 0) (hthree : (3 : F) ≠ 0) + (C : Finset (PuncturedMarkoffSurface F)) + (hC1 : ∀ x, vieta1PuncturedPerm F x ∈ C ↔ x ∈ C) + (hC2 : ∀ x, vieta2PuncturedPerm F x ∈ C ↔ x ∈ C) + (hC3 : ∀ x, vieta3PuncturedPerm F x ∈ C ↔ x ∈ C) : + (C.card : F) = 0 := by + classical + have hreindex1 : + (∑ x : C, (puncturedPennerWeights (vieta1PuncturedPerm F x.1)).x1) = + ∑ x : C, (puncturedPennerWeights x.1).x1 := by + simpa [Equiv.Perm.subtypePerm_apply] using + (Equiv.sum_comp ((vieta1PuncturedPerm F).subtypePerm hC1) + (fun x : C ↦ (puncturedPennerWeights x.1).x1)) + have hreindex2 : + (∑ x : C, (puncturedPennerWeights (vieta2PuncturedPerm F x.1)).x2) = + ∑ x : C, (puncturedPennerWeights x.1).x2 := by + simpa [Equiv.Perm.subtypePerm_apply] using + (Equiv.sum_comp ((vieta2PuncturedPerm F).subtypePerm hC2) + (fun x : C ↦ (puncturedPennerWeights x.1).x2)) + have hreindex3 : + (∑ x : C, (puncturedPennerWeights (vieta3PuncturedPerm F x.1)).x3) = + ∑ x : C, (puncturedPennerWeights x.1).x3 := by + simpa [Equiv.Perm.subtypePerm_apply] using + (Equiv.sum_comp ((vieta3PuncturedPerm F).subtypePerm hC3) + (fun x : C ↦ (puncturedPennerWeights x.1).x3)) + have hsum1 : + (2 : F) * (∑ x : C, (puncturedPennerWeights x.1).x1) = C.card := by + calc + (2 : F) * (∑ x : C, (puncturedPennerWeights x.1).x1) = + (∑ x : C, (puncturedPennerWeights x.1).x1) + + ∑ x : C, (puncturedPennerWeights x.1).x1 := by ring + _ = (∑ x : C, (puncturedPennerWeights x.1).x1) + + ∑ x : C, (puncturedPennerWeights (vieta1PuncturedPerm F x.1)).x1 := by + rw [hreindex1] + _ = ∑ x : C, ((puncturedPennerWeights x.1).x1 + + (puncturedPennerWeights (vieta1PuncturedPerm F x.1)).x1) := by + rw [Finset.sum_add_distrib] + _ = ∑ _x : C, (1 : F) := by + apply Finset.sum_congr rfl + intro x _hx + exact puncturedPennerWeight_first_add_vieta1_eq_one htwo hthree x.1 + _ = C.card := by simp + have hsum2 : + (2 : F) * (∑ x : C, (puncturedPennerWeights x.1).x2) = C.card := by + calc + (2 : F) * (∑ x : C, (puncturedPennerWeights x.1).x2) = + (∑ x : C, (puncturedPennerWeights x.1).x2) + + ∑ x : C, (puncturedPennerWeights x.1).x2 := by ring + _ = (∑ x : C, (puncturedPennerWeights x.1).x2) + + ∑ x : C, (puncturedPennerWeights (vieta2PuncturedPerm F x.1)).x2 := by + rw [hreindex2] + _ = ∑ x : C, ((puncturedPennerWeights x.1).x2 + + (puncturedPennerWeights (vieta2PuncturedPerm F x.1)).x2) := by + rw [Finset.sum_add_distrib] + _ = ∑ _x : C, (1 : F) := by + apply Finset.sum_congr rfl + intro x _hx + exact puncturedPennerWeight_second_add_vieta2_eq_one htwo hthree x.1 + _ = C.card := by simp + have hsum3 : + (2 : F) * (∑ x : C, (puncturedPennerWeights x.1).x3) = C.card := by + calc + (2 : F) * (∑ x : C, (puncturedPennerWeights x.1).x3) = + (∑ x : C, (puncturedPennerWeights x.1).x3) + + ∑ x : C, (puncturedPennerWeights x.1).x3 := by ring + _ = (∑ x : C, (puncturedPennerWeights x.1).x3) + + ∑ x : C, (puncturedPennerWeights (vieta3PuncturedPerm F x.1)).x3 := by + rw [hreindex3] + _ = ∑ x : C, ((puncturedPennerWeights x.1).x3 + + (puncturedPennerWeights (vieta3PuncturedPerm F x.1)).x3) := by + rw [Finset.sum_add_distrib] + _ = ∑ _x : C, (1 : F) := by + apply Finset.sum_congr rfl + intro x _hx + exact puncturedPennerWeight_third_add_vieta3_eq_one htwo hthree x.1 + _ = C.card := by simp + have htotal : + (∑ x : C, (puncturedPennerWeights x.1).x1) + + (∑ x : C, (puncturedPennerWeights x.1).x2) + + (∑ x : C, (puncturedPennerWeights x.1).x3) = C.card := by + calc + (∑ x : C, (puncturedPennerWeights x.1).x1) + + (∑ x : C, (puncturedPennerWeights x.1).x2) + + (∑ x : C, (puncturedPennerWeights x.1).x3) = + ∑ x : C, ((puncturedPennerWeights x.1).x1 + + (puncturedPennerWeights x.1).x2 + (puncturedPennerWeights x.1).x3) := by + rw [Finset.sum_add_distrib, Finset.sum_add_distrib] + _ = ∑ _x : C, (1 : F) := by + apply Finset.sum_congr rfl + intro x _hx + exact puncturedPennerWeights_sum_eq_one htwo hthree x.1 + _ = C.card := by simp + linear_combination 2 * htotal - hsum1 - hsum2 - hsum3 + +/-- Every `Gamma` orbit on the punctured Markoff surface over `ZMod p` has cardinality divisible +by `p` once `3 < p`. -/ +theorem prime_dvd_puncturedGammaOrbit_ncard + (p : ℕ) [Fact p.Prime] (hpThree : 3 < p) + (x : PuncturedMarkoffSurface (ZMod p)) : + p ∣ (puncturedGammaOrbit x).ncard := by + classical + have htwo : (2 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) (by omega)) hpDvd + have hthree : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + exact (Nat.not_dvd_of_pos_of_lt (by omega) hpThree) hpDvd + let S := puncturedGammaOrbit x + have hS : S.Finite := Set.toFinite S + let C : Finset (PuncturedMarkoffSurface (ZMod p)) := hS.toFinset + have hC1 : ∀ y, vieta1PuncturedPerm (ZMod p) y ∈ C ↔ y ∈ C := by + intro y + simp only [C, Set.Finite.mem_toFinset] + constructor + · intro hy + exact samePuncturedComponent_trans hy + (samePuncturedComponent_symm (samePuncturedComponent_vieta1 y)) + · intro hy + exact samePuncturedComponent_trans hy (samePuncturedComponent_vieta1 y) + have hC2 : ∀ y, vieta2PuncturedPerm (ZMod p) y ∈ C ↔ y ∈ C := by + intro y + simp only [C, Set.Finite.mem_toFinset] + constructor + · intro hy + exact samePuncturedComponent_trans hy + (samePuncturedComponent_symm (samePuncturedComponent_vieta2 y)) + · intro hy + exact samePuncturedComponent_trans hy (samePuncturedComponent_vieta2 y) + have hC3 : ∀ y, vieta3PuncturedPerm (ZMod p) y ∈ C ↔ y ∈ C := by + intro y + simp only [C, Set.Finite.mem_toFinset] + constructor + · intro hy + exact samePuncturedComponent_trans hy + (samePuncturedComponent_symm (samePuncturedComponent_vieta3 y)) + · intro hy + exact samePuncturedComponent_trans hy (samePuncturedComponent_vieta3 y) + have hzero : (C.card : ZMod p) = 0 := + card_cast_eq_zero_of_vieta_invariant htwo hthree C hC1 hC2 hC3 + change p ∣ S.ncard + apply (ZMod.natCast_eq_zero_iff _ _).mp + rw [Set.ncard_eq_toFinset_card S hS] + simpa [C] using hzero + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean new file mode 100644 index 0000000000..fdb08019b2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount + +/-! +# Small-order trace counts after inversion pairing + +The trace maps on both rotation tori identify an eigenvalue with its +inverse. Applying this before the maximal-divisor union removes the factor +two that is lost by counting eigenvalues instead of traces. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +section InvolutionImage + +variable {G T : Type*} [Group G] [Fintype G] [DecidableEq G] + [DecidableEq T] [IsCyclic G] + +/-- An inversion-invariant map has at most half as many values as inputs, +apart from the at most two elements satisfying `x² = 1`. -/ +theorem two_mul_card_image_le_card_add_two_of_inv_invariant + (s : Finset G) (f : G → T) + (hsinv : ∀ x ∈ s, x⁻¹ ∈ s) + (hfinv : ∀ x, f x⁻¹ = f x) : + 2 * (s.image f).card ≤ s.card + 2 := by + classical + let fixed : Finset G := s.filter fun x => x⁻¹ = x + have hfixedSubset : + fixed ⊆ BGS.NumberTheory.elementsWithPowOne G 2 := by + intro x hx + rw [Finset.mem_filter] at hx + rw [BGS.NumberTheory.mem_elementsWithPowOne_iff] + have hmul := congrArg (fun y : G => y * x) hx.2 + simpa [pow_two] using hmul.symm + have hfixedCard : fixed.card ≤ 2 := + (Finset.card_le_card hfixedSubset).trans + (IsCyclic.card_pow_eq_one_le (α := G) (n := 2) (by norm_num)) + have hcardFibers : + s.card = + ∑ y ∈ s.image f, (s.filter fun x => f x = y).card := + Finset.card_eq_sum_card_fiberwise + (s := s) (t := s.image f) (f := f) (by + intro x hx + exact Finset.mem_image.mpr ⟨x, hx, rfl⟩) + have hfiber : + ∀ y ∈ s.image f, + 2 ≤ (s.filter fun x => f x = y).card + + if y ∈ fixed.image f then 1 else 0 := by + intro y hy + obtain ⟨x, hx, hxy⟩ := Finset.mem_image.mp hy + by_cases hyfixed : y ∈ fixed.image f + · rw [if_pos hyfixed] + have hxFiber : x ∈ s.filter fun z => f z = y := + Finset.mem_filter.mpr ⟨hx, hxy⟩ + have hpositive : 1 ≤ (s.filter fun z => f z = y).card := + Finset.one_le_card.mpr ⟨x, hxFiber⟩ + omega + · rw [if_neg hyfixed] + have hfix : x⁻¹ ≠ x := by + intro h + apply hyfixed + exact Finset.mem_image.mpr + ⟨x, Finset.mem_filter.mpr ⟨hx, h⟩, hxy⟩ + have hxFiber : x ∈ s.filter fun z => f z = y := + Finset.mem_filter.mpr ⟨hx, hxy⟩ + have hxInvFiber : x⁻¹ ∈ s.filter fun z => f z = y := by + refine Finset.mem_filter.mpr ⟨hsinv x hx, ?_⟩ + rw [hfinv, hxy] + have hpair : + ({x, x⁻¹} : Finset G) ⊆ s.filter fun z => f z = y := by + intro z hz + simp only [Finset.mem_insert, Finset.mem_singleton] at hz + rcases hz with rfl | rfl + · exact hxFiber + · exact hxInvFiber + have hne : x ≠ x⁻¹ := Ne.symm hfix + have htwo : 2 ≤ (s.filter fun z => f z = y).card := by + simpa [hne] using Finset.card_le_card hpair + simpa using htwo + have hfixedImageSubset : fixed.image f ⊆ s.image f := by + apply Finset.image_subset_iff.mpr + intro x hx + exact Finset.mem_image.mpr + ⟨x, (Finset.mem_filter.mp hx).1, rfl⟩ + have hconditional : + (∑ y ∈ s.image f, if y ∈ fixed.image f then 1 else 0) = + (fixed.image f).card := by + calc + (∑ y ∈ s.image f, if y ∈ fixed.image f then 1 else 0) = + ((s.image f).filter fun y => y ∈ fixed.image f).card := by + simp + _ = (fixed.image f).card := by + congr 1 + ext y + simp only [Finset.mem_filter] + constructor + · exact fun h => h.2 + · intro h + exact ⟨hfixedImageSubset h, h⟩ + calc + 2 * (s.image f).card = + ∑ _y ∈ s.image f, 2 := by simp [Nat.mul_comm] + _ ≤ ∑ y ∈ s.image f, + ((s.filter fun x => f x = y).card + + if y ∈ fixed.image f then 1 else 0) := by + gcongr with y hy + exact hfiber y hy + _ = s.card + (fixed.image f).card := by + rw [Finset.sum_add_distrib, ← hcardFibers, hconditional] + _ ≤ s.card + 2 := Nat.add_le_add_left + (Finset.card_image_le.trans hfixedCard) _ + +end InvolutionImage + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean new file mode 100644 index 0000000000..cf4d7c0b9d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape + +/-! +# Paired maximal-divisor middle-game assembly + +This module lifts the paired maximal-order escape from a chosen coordinate to +the maximum of the three coordinate rotation orders. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +/-- One paired middle-game step strictly increases the maximum coordinate +order under the coefficient-sensitive maximal-divisor inequalities. -/ +theorem + exists_sameNormalizedComponent_maximalOrder_increase_of_pairedMaximalDivisorBounds + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + {delta : ℝ} (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedMarkoffSurface (ZMod p)) + (hbelow : (maximalCoordinateRotationOrder x.1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (6 * + (middleGameMaximalOrders p + (maximalCoordinateRotationOrder x.1)).card) ^ 3 < + maximalCoordinateRotationOrder x.1) + (hlinear : + 24 * + (middleGameMaximalOrders p + (maximalCoordinateRotationOrder x.1)).card * + maximalCoordinateRotationOrder x.1 < p) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ + maximalCoordinateRotationOrder x.1 < + maximalCoordinateRotationOrder y.1 := by + obtain ⟨x', hxx', hx'Order⟩ := + exists_sameNormalizedComponent_firstRotation_eq_maximal x + have hx'Cube : + (6 * + (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card) ^ 3 < + rotationOrder x'.1.u1 := by + simpa [hx'Order] using hcube + have hx'Linear : + 24 * (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card * + rotationOrder x'.1.u1 < p := by + simpa [hx'Order] using hlinear + have hordersPos : + 0 < (middleGameMaximalOrders p (rotationOrder x'.1.u1)).card := by + apply Finset.card_pos.mpr + have hpPlus : p + 1 ≠ 0 := by omega + have honeBound : 1 < rotationOrder x'.1.u1 + 1 := by + exact Nat.lt_succ_of_le (rotationOrder_pos x'.1.u1) + obtain ⟨m, hm, _hmultiple⟩ := + exists_dvd_maximalDivisorBelow hpPlus (one_dvd (p + 1)) honeBound + refine ⟨m, ?_⟩ + rw [middleGameMaximalOrders, Finset.mem_union] + exact Or.inr hm + have hbase : + 4 < + (6 * + (middleGameMaximalOrders p + (rotationOrder x'.1.u1)).card) ^ 3 := by + have hcoeff : + 6 ≤ + 6 * + (middleGameMaximalOrders p + (rotationOrder x'.1.u1)).card := by + nlinarith + calc + 4 < 6 ^ 3 := by norm_num + _ ≤ (6 * + (middleGameMaximalOrders p + (rotationOrder x'.1.u1)).card) ^ 3 := + Nat.pow_le_pow_left hcoeff 3 + have hx'AboveFour : 4 < rotationOrder x'.1.u1 := + hbase.trans hx'Cube + have hx'Below : (rotationOrder x'.1.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) := by + simpa [hx'Order] using hbelow + have hx'0 : x'.1.u1 ≠ 0 := by + intro hzero + have hle := rotationOrder_zero_le_four p + rw [hzero] at hx'AboveFour + omega + have hx'Nonparabolic : x'.1.u1 ^ 2 ≠ 4 := by + intro hparabolic + have hcases : x'.1.u1 = 2 ∨ x'.1.u1 = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + x'.1.u1 ^ 2 = 4 := hparabolic + _ = (2 : ZMod p) ^ 2 := by norm_num + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast + (show 1 ≤ p by exact (Fact.out : p.Prime).one_le) + have hexponentLe : (1 : ℝ) / 2 + delta ≤ 1 := by + linarith + have hrpowLe : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ (p : ℝ) := by + simpa using Real.rpow_le_rpow_of_exponent_le hpOne hexponentLe + rcases hcases with htwo | hnegTwo + · rw [htwo, rotationOrder_two] at hx'Below + linarith + · rw [hnegTwo, rotationOrder_neg_two p hpTwo] at hx'Below + have htwoP : ((2 * p : ℕ) : ℝ) = 2 * (p : ℝ) := by norm_num + rw [htwoP] at hx'Below + have hpPos : (0 : ℝ) < p := by positivity + linarith + obtain ⟨n, hnIncrease⟩ := + exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic_pairedMaximalOrders + p hpTwo delta hdelta x'.1 x'.property hx'0 hx'Nonparabolic + hx'Below hx'Cube hx'Linear + let y := (normalizedRotate1Surface^[n]) x' + have hcoe : y.1 = (normalizedRotate1^[n]) x'.1 := + coe_iterate_normalizedRotate1Surface x' n + refine ⟨y, sameNormalizedComponent_trans hxx' + (sameNormalizedComponent_iterate_normalizedRotate1Surface x' n), ?_⟩ + rw [← hx'Order] + exact hnIncrease.trans_le <| by + have hmeasureEq : maximalCoordinateRotationOrder y.1 = + maximalCoordinateRotationOrder + ((normalizedRotate1^[n]) x'.1) := + congrArg maximalCoordinateRotationOrder hcoe + calc + rotationOrder ((normalizedRotate1^[n]) x'.1).u2 ≤ + maximalCoordinateRotationOrder + ((normalizedRotate1^[n]) x'.1) := + rotationOrder_second_le_maximalCoordinateRotationOrder _ + _ = maximalCoordinateRotationOrder y.1 := hmeasureEq.symm + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean new file mode 100644 index 0000000000..a8d0e90fc1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount + +/-! +# Maximal-divisor trace covers after inversion pairing + +This module applies the abstract involution estimate to every maximal cyclic +subgroup in the low-order cover. The resulting inequality is kept +division-free: + +`2 * |trace values| ≤ (bound + 1) * |maximal divisors|`. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +noncomputable section + +section CyclicTraceCover + +variable {G T : Type*} [Group G] [Fintype G] [DecidableEq G] + [DecidableEq T] [IsCyclic G] + +def maximalDivisorTraceCover (trace : G → T) (bound : ℕ) : Finset T := + (maximalDivisorsBelow (Fintype.card G) bound).biUnion fun m => + (elementsWithPowOne G m).image trace + +theorem boundedOrderTraceSet_subset_maximalDivisorTraceCover + (trace : G → T) (bound : ℕ) : + boundedOrderTraceSet trace bound ⊆ + maximalDivisorTraceCover trace bound := by + intro y hy + rw [boundedOrderTraceSet, Finset.mem_image] at hy + obtain ⟨x, hx, rfl⟩ := hy + have hxCover := + elementsOfOrderLessThan_subset_maximalDivisorCover G bound hx + rw [Finset.mem_biUnion] at hxCover + obtain ⟨m, hm, hxm⟩ := hxCover + rw [maximalDivisorTraceCover, Finset.mem_biUnion] + exact ⟨m, hm, Finset.mem_image.mpr ⟨x, hxm, rfl⟩⟩ + +theorem two_mul_maximalDivisorTraceCover_card_le + (trace : G → T) (bound : ℕ) + (htraceInv : ∀ x, trace x⁻¹ = trace x) : + 2 * (maximalDivisorTraceCover trace bound).card ≤ + (bound + 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + classical + have hpiece : + ∀ m ∈ maximalDivisorsBelow (Fintype.card G) bound, + 2 * ((elementsWithPowOne G m).image trace).card ≤ bound + 1 := by + intro m hm + have hmData := mem_maximalDivisorsBelow_iff.mp hm + have hmPos : 0 < m := by + have hmDvd : m ∣ Fintype.card G := + (Nat.mem_divisors.mp hmData.1).1 + exact Nat.pos_of_dvd_of_pos hmDvd Fintype.card_pos + have hpair := + two_mul_card_image_le_card_add_two_of_inv_invariant + (elementsWithPowOne G m) trace + (by + intro x hx + rw [mem_elementsWithPowOne_iff] at hx ⊢ + simpa using congrArg Inv.inv hx) + htraceInv + calc + 2 * ((elementsWithPowOne G m).image trace).card ≤ + (elementsWithPowOne G m).card + 2 := hpair + _ ≤ m + 2 := Nat.add_le_add_right + (IsCyclic.card_pow_eq_one_le hmPos) 2 + _ ≤ bound + 1 := by omega + calc + 2 * (maximalDivisorTraceCover trace bound).card ≤ + 2 * ∑ m ∈ maximalDivisorsBelow (Fintype.card G) bound, + ((elementsWithPowOne G m).image trace).card := by + apply Nat.mul_le_mul_left + exact Finset.card_biUnion_le + _ = ∑ m ∈ maximalDivisorsBelow (Fintype.card G) bound, + 2 * ((elementsWithPowOne G m).image trace).card := by + simp [Finset.mul_sum] + _ ≤ ∑ _m ∈ maximalDivisorsBelow (Fintype.card G) bound, + (bound + 1) := by + gcongr with m hm + exact hpiece m hm + _ = (bound + 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + simp [Nat.mul_comm] + +theorem two_mul_boundedOrderTraceSet_card_le_maximalDivisors + (trace : G → T) (bound : ℕ) + (htraceInv : ∀ x, trace x⁻¹ = trace x) : + 2 * (boundedOrderTraceSet trace bound).card ≤ + (bound + 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + exact + (Nat.mul_le_mul_left 2 + (Finset.card_le_card + (boundedOrderTraceSet_subset_maximalDivisorTraceCover + trace bound))).trans + (two_mul_maximalDivisorTraceCover_card_le trace bound htraceInv) + +end CyclicTraceCover + +theorem splitTorusTrace_inv (F : Type*) [Field F] (x : Fˣ) : + splitTorusTrace x⁻¹ = splitTorusTrace x := by + simp [splitTorusTrace, add_comm] + +theorem quadraticNormOneTrace_inv + (p : ℕ) [Fact p.Prime] (x : quadraticNormOneTorus p) : + quadraticNormOneTrace p x⁻¹ = quadraticNormOneTrace p x := by + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + rw [algebraMap_quadraticNormOneTrace, + algebraMap_quadraticNormOneTrace] + simp [splitTorusTrace, add_comm] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean new file mode 100644 index 0000000000..9002a7d61c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount + +/-! +# Small-order counts on the punctured Markoff surface + +This module transports the normalized small-order set through the core punctured-normalization +equivalence. Keeping these finite-set estimates here prevents the core equivalence module from +depending on the giant-orbit counting layer. +-/ + +namespace BGS.Markoff + +/-- The canonical small-order set, restricted to the normalized punctured surface. -/ +noncomputable def normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + Finset ↑(normalizedPuncturedSurface (ZMod p)) := by + classical + exact Finset.univ.filter fun x => + rotationOrder x.1.u1 < bound ∧ rotationOrder x.1.u2 < bound + +@[simp] +theorem mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] {bound : ℕ} + {x : ↑(normalizedPuncturedSurface (ZMod p))} : + x ∈ normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound ↔ + rotationOrder x.1.u1 < bound ∧ rotationOrder x.1.u2 < bound := by + classical + simp [normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders] + +/-- Forgetting the puncture proof embeds the normalized punctured small-order set in the +canonical normalized small-order set. -/ +theorem normalizedPuncturedSmallOrderValues_subset + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).map + ⟨Subtype.val, Subtype.val_injective⟩ ⊆ + normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound := by + intro x hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_map.mp hx + rw [mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] at hy + exact mem_normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_iff.mpr + ⟨y.2.1, hy.1, hy.2⟩ + +/-- After forgetting the puncture proof, the punctured small-order set is exactly the canonical +ambient small-order set with the normalized origin erased. Thus the puncture is exposed rather +than silently discarded during transport. -/ +theorem normalizedPuncturedSmallOrderValues_eq_erase_origin + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).map + ⟨Subtype.val, Subtype.val_injective⟩ = + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).erase normalizedOrigin := by + classical + ext x + constructor + · intro hx + obtain ⟨y, hy, rfl⟩ := Finset.mem_map.mp hx + rw [mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] at hy + apply Finset.mem_erase.mpr + refine ⟨?_, mem_normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_iff.mpr + ⟨y.2.1, hy.1, hy.2⟩⟩ + simpa using y.2.2 + · intro hx + obtain ⟨hxOrigin, hxSmall⟩ := Finset.mem_erase.mp hx + rw [mem_normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_iff] at hxSmall + let y : ↑(normalizedPuncturedSurface (ZMod p)) := + ⟨x, by + change IsNormalizedMarkoff x ∧ x ∉ ({normalizedOrigin} : Set (NormalizedPoint (ZMod p))) + exact ⟨hxSmall.1, by simpa using hxOrigin⟩⟩ + apply Finset.mem_map.mpr + refine ⟨y, ?_, rfl⟩ + exact mem_normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_iff.mpr + ⟨hxSmall.2.1, hxSmall.2.2⟩ + +/-- Removing the normalized origin cannot enlarge the canonical small-order set. -/ +theorem normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_ambient + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card := by + classical + rw [← Finset.card_map (f := ⟨Subtype.val, Subtype.val_injective⟩)] + exact Finset.card_mono (normalizedPuncturedSmallOrderValues_subset bound) + +/-- Original punctured Markoff points obtained by transporting the canonical normalized +punctured small-order set. -/ +noncomputable def puncturedMarkoffPointsWithSmallFirstTwoRotationOrders + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + Finset (PuncturedMarkoffSurface (ZMod p)) := + originalPuncturedFinsetOfNormalized + (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound) + +/-- The transported original punctured set has exactly the cardinality of its normalized +source. -/ +theorem puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_eq_normalized + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card = + (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card := by + exact originalPuncturedFinsetOfNormalized_card _ + +/-- Equivalently, the transported original set has exactly the cardinality of the ambient +canonical normalized small-order set after its origin is removed. -/ +theorem puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_eq_normalized_erase_origin + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (bound : ℕ) : + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card = + ((normalizedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).erase + normalizedOrigin).card := by + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_eq_normalized] + rw [← normalizedPuncturedSmallOrderValues_eq_erase_origin] + simp + +/-- The elementary normalized small-order count therefore bounds the transported finite set on +the original punctured surface. -/ +theorem puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (bound : ℕ) : + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + 2 * (2 + 2 * bound ^ 2) ^ 2 := by + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_eq_normalized] + exact (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_ambient bound).trans + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le hpTwo bound) + +/-- The divisor-sensitive normalized count also bounds the transported punctured set. -/ +theorem puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_divisor_sensitive + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (bound : ℕ) : + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p bound).card ≤ + 2 * (2 + (bound - 1) * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := by + rw [puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_eq_normalized] + exact (normalizedPuncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_ambient bound).trans + (normalizedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_divisor_sensitive hpTwo bound) + +theorem puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_succ_card_le_divisor_sensitive + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpTwo : p ≠ 2) (d : ℕ) : + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders p (d + 1)).card ≤ + 2 * (2 + d * ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2 := by + simpa using + (puncturedMarkoffPointsWithSmallFirstTwoRotationOrders_card_le_divisor_sensitive + hpTwo (d + 1)) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean new file mode 100644 index 0000000000..0311deff59 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean @@ -0,0 +1,94 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic + +/-! +# Sperner handoff for the joint maximal-order antichain + +This file isolates the final semantic obligation for a central-coefficient +width bound. It is enough to encode the nontrivial maximal orders injectively +into any finite ranked poset with a symmetric-chain decomposition, in such a +way that comparison of encoded points implies divisibility of the original +orders. The joint antichain then has cardinality at most the central rank. +-/ + +namespace BGS.Markoff + +open BGS.Combinatorics + +/-- A comparison-reflecting factorization encoding transports the joint +divisor antichain into any explicitly symmetric-chain-decomposed poset. -/ +theorem nontrivialMiddleGameMaximalOrders_card_le_centralRank_of_encoding + {P : Type*} [PartialOrder P] [Fintype P] [DecidableEq P] + {rank : P -> Nat} {total p bound : Nat} + (hp : 1 < p) + (decomposition : SymmetricChainDecomposition P rank total) + (encode : Nat -> P) + (hinjective : Function.Injective encode) + (hcomparison : + ∀ {a b : Nat}, + a ∈ nontrivialMiddleGameMaximalOrders p bound -> + b ∈ nontrivialMiddleGameMaximalOrders p bound -> + encode a <= encode b -> a ∣ b) : + (nontrivialMiddleGameMaximalOrders p bound).card <= + Fintype.card {point : P // rank point = total / 2} := by + let embedding : Nat ↪ P := ⟨encode, hinjective⟩ + let encoded : Finset P := + (nontrivialMiddleGameMaximalOrders p bound).map embedding + have hencodedAntichain : + IsAntichain (· <= ·) (encoded : Set P) := by + intro x hx y hy hxy hle + have hx' : x ∈ encoded := by simpa using hx + have hy' : y ∈ encoded := by simpa using hy + change x ∈ + (nontrivialMiddleGameMaximalOrders p bound).map embedding at hx' + change y ∈ + (nontrivialMiddleGameMaximalOrders p bound).map embedding at hy' + rcases Finset.mem_map.mp hx' with ⟨a, ha, hax⟩ + rcases Finset.mem_map.mp hy' with ⟨b, hb, hby⟩ + have hdiv : a ∣ b := by + apply hcomparison ha hb + change embedding a <= embedding b + rw [hax, hby] + exact hle + have hab : a = b := + nontrivialMiddleGameMaximalOrders_eq_of_dvd hp ha hb hdiv + apply hxy + calc + x = embedding a := hax.symm + _ = embedding b := congrArg embedding hab + _ = y := hby + have hcentral := + decomposition.antichain_card_le_central_rank + encoded hencodedAntichain + simpa [encoded] using hcentral + +/-- The central rank supplied by a factorization encoding can be inserted +directly into the Corvaja--Zannier witness cap, with the two exceptional +divisors restored. -/ +theorem bound_le_rankinCentralRankWitnessCap_of_encoding + {P : Type*} [PartialOrder P] [Fintype P] [DecidableEq P] + {rank : P -> Nat} {total p bound : Nat} + (hp : 1 < p) + (hbound : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (decomposition : SymmetricChainDecomposition P rank total) + (encode : Nat -> P) + (hinjective : Function.Injective encode) + (hcomparison : + ∀ {a b : Nat}, + a ∈ nontrivialMiddleGameMaximalOrders p bound -> + b ∈ nontrivialMiddleGameMaximalOrders p bound -> + encode a <= encode b -> a ∣ b) : + bound <= rankinWidthWitnessCap + (Fintype.card {point : P // rank point = total / 2} + 2) := by + apply bound_le_rankinJointAntichainWitnessCap hbound + exact nontrivialMiddleGameMaximalOrders_card_le_centralRank_of_encoding + hp decomposition encode hinjective hcomparison + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean new file mode 100644 index 0000000000..d5d7803e57 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean @@ -0,0 +1,212 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +import Mathlib.Order.Antichain + +/-! +# One joint antichain for the two neighboring tori + +The maximal candidate orders dividing `p - 1` and `p + 1` are not two +independent divisor families. After removing the possible divisors `1` and +`2`, their union is a single antichain: a cross-side divisibility relation +would force its smaller term to divide the difference `2`. + +This is the arithmetic input that makes the width-sensitive Rankin endpoint +strictly sharper than summing two complete divisor counts. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- The actual middle-game maximal orders after removing the only divisors of +the neighbor difference `2`. -/ +def nontrivialMiddleGameMaximalOrders (p bound : Nat) : Finset Nat := + (middleGameMaximalOrders p bound).filter fun d => ¬ d ∣ 2 + +@[simp] theorem mem_nontrivialMiddleGameMaximalOrders_iff + {p bound d : Nat} : + d ∈ nontrivialMiddleGameMaximalOrders p bound <-> + (d ∈ maximalDivisorsBelow (p - 1) (bound + 1) \/ + d ∈ maximalDivisorsBelow (p + 1) (bound + 1)) /\ + ¬ d ∣ 2 := by + simp [nontrivialMiddleGameMaximalOrders, middleGameMaximalOrders] + +/-- Every nontrivial maximal order divides the common product `p^2 - 1`. -/ +theorem nontrivialMiddleGameMaximalOrders_subset_divisors_sq_sub_one + {p bound : Nat} (hp : 1 < p) : + nontrivialMiddleGameMaximalOrders p bound ⊆ + (p ^ 2 - 1).divisors := by + intro d hd + have hfactor : p ^ 2 - 1 = (p + 1) * (p - 1) := by + simpa using (sq_tsub_sq p 1) + have hsq : 1 < p ^ 2 := by nlinarith + have hcommonNe : p ^ 2 - 1 ≠ 0 := + (Nat.sub_pos_of_lt hsq).ne' + have hdData := mem_nontrivialMiddleGameMaximalOrders_iff.mp hd + apply Nat.mem_divisors.mpr + refine ⟨?_, hcommonNe⟩ + rcases hdData.1 with hdMinus | hdPlus + · have hdDvd : d ∣ p - 1 := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp hdMinus).1).1 + obtain ⟨k, hk⟩ := hdDvd + refine ⟨(p + 1) * k, ?_⟩ + calc + p ^ 2 - 1 = (p + 1) * (p - 1) := hfactor + _ = (p + 1) * (d * k) := by rw [hk] + _ = d * ((p + 1) * k) := by ring + · have hdDvd : d ∣ p + 1 := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp hdPlus).1).1 + obtain ⟨k, hk⟩ := hdDvd + refine ⟨k * (p - 1), ?_⟩ + calc + p ^ 2 - 1 = (p + 1) * (p - 1) := hfactor + _ = (d * k) * (p - 1) := by rw [hk] + _ = d * (k * (p - 1)) := by ring + +/-- Divisibility between two nontrivial joint maximal orders forces equality. +The same-side cases use maximality; the cross-side cases use the difference +of the two neighboring torus orders. -/ +theorem nontrivialMiddleGameMaximalOrders_eq_of_dvd + {p bound a b : Nat} (hp : 1 < p) + (ha : a ∈ nontrivialMiddleGameMaximalOrders p bound) + (hb : b ∈ nontrivialMiddleGameMaximalOrders p bound) + (hab : a ∣ b) : + a = b := by + have haData := mem_nontrivialMiddleGameMaximalOrders_iff.mp ha + have hbData := mem_nontrivialMiddleGameMaximalOrders_iff.mp hb + rcases haData.1 with haMinus | haPlus + · rcases hbData.1 with hbMinus | hbPlus + · exact + ((mem_maximalDivisorsBelow_iff.mp haMinus).2.2 b + (mem_maximalDivisorsBelow_iff.mp hbMinus).1 + (mem_maximalDivisorsBelow_iff.mp hbMinus).2.1 + hab).symm + · exfalso + apply haData.2 + have haDvdMinus : a ∣ p - 1 := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp haMinus).1).1 + have hbDvdPlus : b ∣ p + 1 := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp hbPlus).1).1 + have haDvdPlus : a ∣ p + 1 := hab.trans hbDvdPlus + have hsub := Nat.dvd_sub haDvdPlus haDvdMinus + have hdifference : (p + 1) - (p - 1) = 2 := by omega + rw [hdifference] at hsub + exact hsub + · rcases hbData.1 with hbMinus | hbPlus + · exfalso + apply haData.2 + have haDvdPlus : a ∣ p + 1 := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp haPlus).1).1 + have hbDvdMinus : b ∣ p - 1 := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp hbMinus).1).1 + have haDvdMinus : a ∣ p - 1 := hab.trans hbDvdMinus + have hsub := Nat.dvd_sub haDvdPlus haDvdMinus + have hdifference : (p + 1) - (p - 1) = 2 := by omega + rw [hdifference] at hsub + exact hsub + · exact + ((mem_maximalDivisorsBelow_iff.mp haPlus).2.2 b + (mem_maximalDivisorsBelow_iff.mp hbPlus).1 + (mem_maximalDivisorsBelow_iff.mp hbPlus).2.1 + hab).symm + +/-- The nontrivial maximal candidate orders from both neighboring tori form +one canonical antichain under divisibility. -/ +theorem nontrivialMiddleGameMaximalOrders_isAntichain + {p bound : Nat} (hp : 1 < p) : + IsAntichain (· ∣ ·) + (nontrivialMiddleGameMaximalOrders p bound : Set Nat) := by + intro a ha b hb hab hdiv + apply hab + exact nontrivialMiddleGameMaximalOrders_eq_of_dvd hp + (by simpa using ha) (by simpa using hb) hdiv + +/-- Restoring the discarded part costs at most the two exceptional divisors +`1` and `2`. -/ +theorem middleGameMaximalOrders_card_le_nontrivial_add_two + (p bound : Nat) : + (middleGameMaximalOrders p bound).card <= + (nontrivialMiddleGameMaximalOrders p bound).card + 2 := by + classical + let orders := middleGameMaximalOrders p bound + let exceptional := orders.filter fun d => d ∣ 2 + have hexceptionalSubset : exceptional ⊆ ({1, 2} : Finset Nat) := by + intro d hd + have hdTwo : d ∣ 2 := (Finset.mem_filter.mp hd).2 + rcases Nat.prime_two.eq_one_or_self_of_dvd d hdTwo with rfl | rfl + · simp + · simp + have hexceptionalCard : exceptional.card <= 2 := by + calc + exceptional.card <= ({1, 2} : Finset Nat).card := + Finset.card_le_card hexceptionalSubset + _ = 2 := by decide + have hsplit := + Finset.card_filter_add_card_filter_not + (s := orders) (fun d => ¬ d ∣ 2) + have hsplit' : + (nontrivialMiddleGameMaximalOrders p bound).card + + exceptional.card = + (middleGameMaximalOrders p bound).card := by + simpa [orders, exceptional, nontrivialMiddleGameMaximalOrders] using + hsplit + omega + +/-- Any bound on the one nontrivial antichain gives a bound on all maximal +orders with an additive cost of only two. -/ +theorem middleGameMaximalOrders_card_le_of_nontrivialWidth + {p bound width : Nat} + (hwidth : + (nontrivialMiddleGameMaximalOrders p bound).card <= width) : + (middleGameMaximalOrders p bound).card <= width + 2 := by + exact (middleGameMaximalOrders_card_le_nontrivial_add_two p bound).trans + (Nat.add_le_add_right hwidth 2) + +/-- The exact-order witness cap can therefore use the width of the single +joint antichain, plus the two exceptional divisors. -/ +theorem bound_le_rankinJointAntichainWitnessCap + {p bound width : Nat} + (hbound : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (hwidth : + (nontrivialMiddleGameMaximalOrders p bound).card <= width) : + bound <= rankinWidthWitnessCap (width + 2) := by + exact bound_le_rankinWidthWitnessCap hbound + (middleGameMaximalOrders_card_le_of_nontrivialWidth hwidth) + +/-- Width-sensitive Rankin closure fed directly by the single joint +antichain. -/ +theorem prime_le_of_matching_rankinNeighborProfile_jointAntichainWidth_leaf + {p bound width rootCap cutoff : Nat} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p <= (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (hwidth : + (nontrivialMiddleGameMaximalOrders p bound).card <= width) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) + (hrootValid : RankinWidthRootValid (width + 2) rootCap) + (hleaf : + RankinWidthClosesCutoff (width + 2) rootCap profile cutoff \/ + RankinWidthExcludesFailure (width + 2) rootCap profile) : + p <= cutoff := by + exact prime_le_of_matching_rankinNeighborProfile_rankinWidth_leaf + hpPrime hpTwo hroot hboundWitness + (middleGameMaximalOrders_card_le_of_nontrivialWidth hwidth) + profile hprofile hmatch hrootValid hleaf + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean new file mode 100644 index 0000000000..73e8e98793 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope + +/-! +# A width-sensitive exact-order Rankin envelope + +The first exact-order Rankin endpoint bounded the middle-game maximal orders +by all divisors of `p - 1` and `p + 1`. This file separates that coarse +choice from the analytic argument. Any certified upper bound for the actual +maximal-order set can now be cubed directly, while the Euler product remains +the same side-erased Rankin product. + +This is the interface needed for a joint-antichain or symmetric-chain width +certificate. It does not assume such a certificate. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- The Corvaja--Zannier witness cap obtained from an arbitrary certified +upper bound for the number of maximal candidate orders. -/ +def rankinWidthWitnessCap (width : Nat) : Nat := + 189 * width ^ 3 + +/-- The side-erased Rankin failure square using a maximal-order width rather +than the total number of neighboring divisors. -/ +def rankinWidthJointFailureSquare + (width rootCap : Nat) (profile : RankinNeighborProfile) : Rat := + ((rankinWidthWitnessCap width : Rat) * rootCap * + (2 * profile.jointCoarseEulerProductProduct)) ^ 2 + +/-- The chosen integral root cap is sufficient for the width witness. -/ +def RankinWidthRootValid (width rootCap : Nat) : Prop := + rankinWidthWitnessCap width <= rootCap ^ 12 + +/-- A direct cutoff leaf for the width-sensitive envelope. -/ +def RankinWidthClosesCutoff + (width rootCap : Nat) (profile : RankinNeighborProfile) + (cutoff : Nat) : Prop := + rankinWidthJointFailureSquare width rootCap profile < + (8 * (cutoff + 1) : Nat) + +/-- A side-erased lower-product contradiction for the width-sensitive +envelope. -/ +def RankinWidthExcludesFailure + (width rootCap : Nat) (profile : RankinNeighborProfile) : Prop := + rankinWidthJointFailureSquare width rootCap profile ^ 2 < + (64 * profile.jointLowerNeighborProduct : Nat) + +def rankinWidthLeafCheck + (width rootCap cutoff : Nat) (profile : RankinNeighborProfile) : Bool := + decide + (rankinWidthWitnessCap width <= rootCap ^ 12 /\ + (rankinWidthJointFailureSquare width rootCap profile < + ((8 * (cutoff + 1) : Nat) : Rat) \/ + rankinWidthJointFailureSquare width rootCap profile ^ 2 < + ((64 * profile.jointLowerNeighborProduct : Nat) : Rat))) + +@[simp] theorem rankinWidthLeafCheck_eq_true_iff + (width rootCap cutoff : Nat) (profile : RankinNeighborProfile) : + rankinWidthLeafCheck width rootCap cutoff profile = true <-> + RankinWidthRootValid width rootCap /\ + (RankinWidthClosesCutoff width rootCap profile cutoff \/ + RankinWidthExcludesFailure width rootCap profile) := by + simp [rankinWidthLeafCheck, RankinWidthRootValid, + RankinWidthClosesCutoff, RankinWidthExcludesFailure] + +theorem bound_le_rankinWidthWitnessCap + {p bound width : Nat} + (hbound : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (hwidth : (middleGameMaximalOrders p bound).card <= width) : + bound <= rankinWidthWitnessCap width := by + exact hbound.trans (by + simp only [rankinWidthWitnessCap] + gcongr) + +/-- A matched profile and any certified maximal-order width force the new +side-erased failure square. No divisor-count upper bound occurs here. -/ +theorem eight_mul_prime_cast_le_matching_profile_rankinWidthFailureSquare + {p bound width rootCap : Nat} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p <= (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (hwidth : (middleGameMaximalOrders p bound).card <= width) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) + (hrootValid : RankinWidthRootValid width rootCap) : + (8 * p : Rat) <= + rankinWidthJointFailureSquare width rootCap profile := by + have hp : 1 < p := by omega + obtain ⟨assignment, hweightNonneg, hweightPower, + hminusEuler, hplusEuler⟩ := + profile.exists_assignedPrimeWeight_bounds + hpPrime hpTwo hprofile hmatch + have hboundWidth : bound <= rankinWidthWitnessCap width := + bound_le_rankinWidthWitnessCap hboundWitness hwidth + have hrootCapNonneg : (0 : Rat) <= rootCap := by positivity + have hrootValidCast : + (rankinWidthWitnessCap width : Rat) <= (rootCap : Rat) ^ 12 := by + exact_mod_cast hrootValid + have hfailure := + eight_mul_prime_cast_le_jointRankinSquare + hp hroot hboundWidth + (assignedPrimeWeight p profile assignment) rootCap + hweightNonneg hweightPower hrootCapNonneg hrootValidCast + have hEuler : + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) <= + profile.jointCoarseEulerProduct := by + change + ((p - 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent + (assignedPrimeWeight p profile assignment prime)) + + ((p + 1).factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent + (assignedPrimeWeight p profile assignment prime)) <= + profile.coarseEulerProduct .minus + + profile.coarseEulerProduct .plus + exact add_le_add hminusEuler hplusEuler + have hEulerErased : + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) <= + 2 * profile.jointCoarseEulerProductProduct := + hEuler.trans profile.jointCoarseEulerProduct_le_two_mul_product + have hEulerActualNonneg := + jointRankinEulerProduct_nonneg p hp + (assignedPrimeWeight p profile assignment) hweightNonneg + have hEulerErasedNonneg : + (0 : Rat) <= 2 * profile.jointCoarseEulerProductProduct := + hEulerActualNonneg.trans hEulerErased + have hscaleNonneg : + (0 : Rat) <= + (rankinWidthWitnessCap width : Rat) * rootCap := by + positivity + have hupper : + (rankinWidthWitnessCap width : Rat) * rootCap * + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) <= + (rankinWidthWitnessCap width : Rat) * rootCap * + (2 * profile.jointCoarseEulerProductProduct) := + mul_le_mul_of_nonneg_left hEulerErased hscaleNonneg + have hleftNonneg : + (0 : Rat) <= + (rankinWidthWitnessCap width : Rat) * rootCap * + jointRankinEulerProduct p + (assignedPrimeWeight p profile assignment) := by + positivity + have hrightNonneg : + (0 : Rat) <= + (rankinWidthWitnessCap width : Rat) * rootCap * + (2 * profile.jointCoarseEulerProductProduct) := by + exact mul_nonneg hscaleNonneg hEulerErasedNonneg + simpa only [rankinWidthJointFailureSquare] using + hfailure.trans ((sq_le_sq₀ hleftNonneg hrightNonneg).2 hupper) + +/-- A valid checked width leaf bounds the prime. This is the replacement +endpoint to be fed by the forthcoming joint-antichain width certificate. -/ +theorem prime_le_of_matching_rankinNeighborProfile_rankinWidth_leaf + {p bound width rootCap cutoff : Nat} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p <= (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (hwidth : (middleGameMaximalOrders p bound).card <= width) + (profile : RankinNeighborProfile) + (hprofile : profile.Valid) + (hmatch : profile.Matches p) + (hrootValid : RankinWidthRootValid width rootCap) + (hleaf : + RankinWidthClosesCutoff width rootCap profile cutoff \/ + RankinWidthExcludesFailure width rootCap profile) : + p <= cutoff := by + have hfailure := + eight_mul_prime_cast_le_matching_profile_rankinWidthFailureSquare + hpPrime hpTwo hroot hboundWitness hwidth profile hprofile hmatch + hrootValid + rcases hleaf with hcloses | hexcludes + · by_contra hnot + have hcutoffSucc : cutoff + 1 <= p := by omega + have hcutoffCast : + (8 * (cutoff + 1) : Rat) <= (8 * p : Rat) := by + exact_mod_cast Nat.mul_le_mul_left 8 hcutoffSucc + exact (not_lt_of_ge (hcutoffCast.trans hfailure)) (by + simpa [RankinWidthClosesCutoff, Nat.cast_mul, Nat.cast_add, + Nat.cast_ofNat, Nat.cast_one] using hcloses) + · have hlower := profile.lowerNeighborProducts_le hpPrime hpTwo hmatch + have hneighborProduct : + profile.jointLowerNeighborProduct <= (p - 1) * (p + 1) := by + rw [profile.jointLowerNeighborProduct_eq_mul] + exact Nat.mul_le_mul hlower.1 hlower.2 + have hneighborLt : (p - 1) * (p + 1) < p ^ 2 := by + have hsub : p - 1 + 1 = p := by omega + nlinarith + have hlowerJointCast : + ((64 * profile.jointLowerNeighborProduct : Nat) : Rat) < + (64 * p ^ 2 : Rat) := by + have hnat := (Nat.mul_lt_mul_left (by omega : 0 < 64)).2 + (hneighborProduct.trans_lt hneighborLt) + exact_mod_cast hnat + have hfailureNonneg : + (0 : Rat) <= rankinWidthJointFailureSquare width rootCap profile := by + rw [rankinWidthJointFailureSquare] + exact sq_nonneg _ + have heighthPrimeNonneg : (0 : Rat) <= (8 * p : Rat) := by + positivity + have hfailureSquared : + (64 * p ^ 2 : Rat) <= + rankinWidthJointFailureSquare width rootCap profile ^ 2 := by + have hsquare := + (sq_le_sq₀ heighthPrimeNonneg hfailureNonneg).2 hfailure + norm_num [mul_pow] at hsquare ⊢ + exact hsquare + exact False.elim + ((not_lt_of_ge (hlowerJointCast.le.trans hfailureSquared)) hexcludes) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean new file mode 100644 index 0000000000..240b419976 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean @@ -0,0 +1,54 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity + +/-! +# Explicit strong approximation + +The explicit punctured-transitivity theorem, together with natural Markoff connectivity, +gives surjectivity of reduction from natural-number Markoff solutions. +-/ + +namespace BGS.Markoff + +/-- **Explicit strong approximation in its source-faithful form.** For every prime above the +closed cutoff, every Markoff solution modulo `p` is the reduction of a natural-number solution. -/ +theorem markoffReduction_surjective_of_concreteExplicitBound + (p : ℕ) (hpPrime : p.Prime) + (hp : (2 ^ 9 * (48 ^ 3 + 1) ^ 18 * + (2 ^ 9 * (9 ^ 9) ^ (2 ^ 9)) ^ 8 + 1) ≤ p) : + Function.Surjective (markoffReduction p) := + (puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective p hpPrime).mp + (puncturedMarkoffTransitiveAt_of_concreteExplicitBound p hpPrime hp) + +/-- Strong approximation obtained from the elementary preliminary route. -/ +theorem markoffReduction_surjective_of_concretePreliminaryBound + (p : ℕ) (hpPrime : p.Prime) + (hp : (2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1) ≤ p) : + Function.Surjective (markoffReduction p) := + (puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective p hpPrime).mp + (puncturedMarkoffTransitiveAt_of_concretePreliminaryBound p hpPrime hp) + +/-- The weighted certificate-free Euler-seven coarse-support theorem in the +functor presentation used by the Comparator challenge. -/ +theorem reduction_surjective_of_explicitBound : + let p₀ := 35721 ^ 5 * 2 ^ 1547 * 32769 ^ 2 + 1 + ∀ (p : ℕ), p.Prime → p₀ ≤ p → + Function.Surjective + (BGS.Markoff.map (CommSemiRingCat.ofHom (Nat.castRingHom (ZMod p)))) := by + dsimp only + intro p hpPrime hp y + obtain ⟨x, hx⟩ := + markoffReduction_surjective_of_weightedCoarseSupportBound p hpPrime hp + (markoffEquivSemiringMarkoffSurface (ZMod p) y) + refine ⟨(markoffEquivSemiringMarkoffSurface ℕ).symm x, ?_⟩ + apply (markoffEquivSemiringMarkoffSurface (ZMod p)).injective + simpa [markoffReduction] using hx + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean new file mode 100644 index 0000000000..4fdceda950 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean @@ -0,0 +1,195 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction + +/-! +# Even-sign stability of a split-cage base component + +If `u` has full split-torus order `p - 1`, then `-u` has order at least +`(p - 1) / 2`. Thus negating a split-maximal trace still produces a +coordinate above the endgame threshold whenever + +`p ^ (5 / 6) ≤ (p - 1) / 2`. + +Every even sign change preserves or negates each normalized coordinate. +Consequently, under the usual large-order-to-base hypothesis, all four even +sign images of a split-cage base lie in its Gamma orbit. +-/ + +namespace BGS.Markoff + +noncomputable section + +@[simp] +theorem splitTorusTrace_neg + {F : Type*} [Field F] (u : Fˣ) : + splitTorusTrace (-u) = -splitTorusTrace u := by + simp [splitTorusTrace] + ring + +/-- A split-maximal trace is represented by a full-order split-torus unit. -/ +theorem exists_fullOrder_splitUnit_of_isSplitMaximalTrace + (p : ℕ) [Fact p.Prime] (hpSeven : 7 ≤ p) + (t : ZMod p) (hmax : IsSplitMaximalTrace p t) : + ∃ u : (ZMod p)ˣ, + splitTorusTrace u = t ∧ + orderOf u = p - 1 ∧ + (u : ZMod p) ^ 2 ≠ 1 := by + have hpTwo : p ≠ 2 := by omega + have htNonparabolic := + splitMaximalTrace_sq_ne_four p hpSeven t hmax + rcases exists_split_or_quadraticNormOneTrace + p hpTwo t htNonparabolic with + ⟨u, htrace, huSq⟩ | ⟨u, htrace, huSq⟩ + · refine ⟨u, htrace, ?_, huSq⟩ + calc + orderOf u = rotationOrder t := by + rw [← htrace, rotationOrder_splitTorusTrace u huSq] + _ = p - 1 := hmax + · exfalso + have hrotation : rotationOrder t = orderOf u := by + rw [← htrace, rotationOrder_quadraticNormOneTrace p u huSq] + have horder : orderOf u = p - 1 := by + rw [← hmax] + exact hrotation.symm + have hdvd := orderOf_dvd_natCard u + rw [quadraticNormOneTorus_natCard, horder] at hdvd + have hdvdTwo : p - 1 ∣ 2 := by + have hsub := Nat.dvd_sub hdvd (dvd_refl (p - 1)) + have heq : (p + 1) - (p - 1) = 2 := by omega + rw [heq] at hsub + exact hsub + have hle : p - 1 ≤ 2 := Nat.le_of_dvd (by norm_num) hdvdTwo + omega + +/-- Negating a full-order unit loses at most a factor of two in its order. -/ +theorem half_card_sub_one_le_orderOf_neg_of_fullOrder + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (u : (ZMod p)ˣ) (huOrder : orderOf u = p - 1) : + (p - 1) / 2 ≤ orderOf (-u) := by + have hnegOneOrder : orderOf (-1 : (ZMod p)ˣ) = 2 := by + rw [← orderOf_units, Units.coe_neg_one, orderOf_neg_one, + ringChar.eq (ZMod p) p, if_neg hpTwo] + have huEq : u = (-1 : (ZMod p)ˣ) * (-u) := by simp + have hdvd : + p - 1 ∣ 2 * orderOf (-u) := by + have hproduct := + (Commute.all (-1 : (ZMod p)ˣ) (-u)).orderOf_mul_dvd_mul_orderOf + rw [← huEq, huOrder, hnegOneOrder] at hproduct + exact hproduct + have hle : p - 1 ≤ 2 * orderOf (-u) := + Nat.le_of_dvd + (Nat.mul_pos (by norm_num) (orderOf_pos (-u))) hdvd + omega + +/-- The negated trace of a full-order split unit has rotation order at least +half the split-torus cardinality. -/ +theorem half_card_sub_one_le_rotationOrder_neg_splitTorusTrace + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (u : (ZMod p)ˣ) + (huOrder : orderOf u = p - 1) + (huSq : (u : ZMod p) ^ 2 ≠ 1) : + (p - 1) / 2 ≤ rotationOrder (-splitTorusTrace u) := by + have hnegSq : ((-u : (ZMod p)ˣ) : ZMod p) ^ 2 ≠ 1 := by + intro hsq + apply huSq + simpa using hsq + rw [← splitTorusTrace_neg, + rotationOrder_splitTorusTrace (-u) hnegSq] + exact half_card_sub_one_le_orderOf_neg_of_fullOrder + p hpTwo u huOrder + +/-- Normalization sends a signed point's selected coordinate either to the +original normalized coordinate or to its negative. -/ +theorem normalizedCoordinateAt_evenSign_smul_eq_or_eq_neg + {R : Type*} [CommRing R] [Invertible (3 : R)] + (axis : NormalizedCoordinateAxis) (s : EvenSign) + (x : PuncturedMarkoffSurface R) : + normalizedCoordinateAt axis + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R (s • x))).1 = + normalizedCoordinateAt axis + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R x)).1 ∨ + normalizedCoordinateAt axis + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R (s • x))).1 = + -normalizedCoordinateAt axis + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv R x)).1 := by + cases axis <;> cases s <;> + simp [normalizedCoordinateAt, normalizedSurfaceOfPunctured, + puncturedNormalizationEquiv_coe, toNormalized, + evenSign_smul_punctured_coe, evenSign_smul_surface_coe, + evenSignPoint] + +/-- Under the explicit half-order threshold, every even sign image of a +split-cage base lies in the base Gamma component. -/ +theorem samePuncturedComponent_evenSign_smul_of_splitCageBase + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + ∀ s : EvenSign, SamePuncturedComponent c (s • c) := by + intro s + apply (samePuncturedComponent_iff_sameNormalizedComponent c (s • c)).2 + let base := + normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c) + let signed := + normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) (s • c)) + obtain ⟨axis, hmax⟩ := hbase + let t := normalizedCoordinateAt axis base.1 + have hmaxT : IsSplitMaximalTrace p t := by + simpa [t, base] using hmax + obtain ⟨u, htrace, huOrder, huSq⟩ := + exists_fullOrder_splitUnit_of_isSplitMaximalTrace + p hpSeven t hmaxT + have hnegOrder : + (p - 1) / 2 ≤ rotationOrder (-t) := by + rw [← htrace] + exact half_card_sub_one_le_rotationOrder_neg_splitTorusTrace + p (by omega) u huOrder huSq + have hcoordinate := + normalizedCoordinateAt_evenSign_smul_eq_or_eq_neg axis s c + have hcoordinateOrder : + (p - 1) / 2 ≤ + rotationOrder (normalizedCoordinateAt axis signed.1) := by + rcases hcoordinate with hpositive | hnegative + · rw [show normalizedCoordinateAt axis signed.1 = t by + simpa [signed, base, t] using hpositive, + hmaxT] + exact Nat.div_le_self _ _ + · rw [show normalizedCoordinateAt axis signed.1 = -t by + simpa [signed, base, t] using hnegative] + exact hnegOrder + have hcoordinateLe : + rotationOrder (normalizedCoordinateAt axis signed.1) ≤ + maximalCoordinateRotationOrder signed.1 := by + cases axis + · exact rotationOrder_first_le_maximalCoordinateRotationOrder signed.1 + · exact rotationOrder_second_le_maximalCoordinateRotationOrder signed.1 + · exact rotationOrder_third_le_maximalCoordinateRotationOrder signed.1 + apply hlarge signed + exact hhalfThreshold.trans (by + exact_mod_cast hcoordinateOrder.trans hcoordinateLe) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean new file mode 100644 index 0000000000..0bfa507a6b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean @@ -0,0 +1,93 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier + +/-! +# Split-cage nonparabolic complement frontier + +The split-cage base supplies the only geometric input needed for the +even-sign factor four: every signed image of the base point returns to its +Gamma component. This module discharges both sign-invariance hypotheses of +the nonparabolic complement frontier automatically. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- A split-cage base above the half-order threshold has a component +complement whose cardinality is divisible by four. -/ +theorem four_dvd_puncturedComponentComplementFinset_card_of_splitCageBase + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + 4 ∣ (puncturedComponentComplementFinset p c).card := by + apply + four_dvd_puncturedComponentComplementFinset_card_of_base_sign_stable + p (by omega) c + exact samePuncturedComponent_evenSign_smul_of_splitCageBase + p hpSeven c hbase hhalfThreshold hlarge + +/-- Nonparabolic paired-maximal-divisor frontier with the even-sign +invariance and factor-four hypotheses discharged by a split-cage base. -/ +theorem + puncturedMarkoffTransitiveAt_of_splitCage_nonparabolicComplement_pairedMaximalDivisor_frontier + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] + (hpSeven : 7 ≤ p) + (c : PuncturedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c))) + (hhalfThreshold : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ (((p - 1) / 2 : ℕ) : ℝ)) + (hcube : ∀ d : ℕ, 0 < d → + 8 * p ≤ + (d * maximalDivisorCountSum p (d + 1)) ^ 2 → + (6 * maximalDivisorCountSum p (d + 1)) ^ 3 < d) + (hlinear : ∀ d : ℕ, + (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → + 24 * maximalDivisorCountSum p (d + 1) * d < p) + (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ (5 / 6 : ℝ) ≤ + maximalCoordinateRotationOrder z.1 → + SameNormalizedComponent + (normalizedSurfaceOfPunctured + (puncturedNormalizationEquiv (ZMod p) c)) z) : + PuncturedMarkoffTransitiveAt p Fact.out := by + have hbaseSign : + ∀ s : EvenSign, SamePuncturedComponent c (s • c) := + samePuncturedComponent_evenSign_smul_of_splitCageBase + p hpSeven c hbase hhalfThreshold hlarge + have hsign : + ∀ (s : EvenSign) (x : PuncturedMarkoffSurface (ZMod p)), + s • x ∈ puncturedComponentComplementFinset p c ↔ + x ∈ puncturedComponentComplementFinset p c := + fun s x => + puncturedComponentComplementFinset_evenSign_mem_iff_of_base_stable + p c x hbaseSign s + have hfour : + 4 ∣ (puncturedComponentComplementFinset p c).card := + four_dvd_puncturedComponentComplementFinset_card_of_base_sign_stable + p (by omega) c hbaseSign + exact + puncturedMarkoffTransitiveAt_of_nonparabolicComplement_pairedMaximalDivisor_frontier + p (by omega) c hcube hlinear hlarge hsign hfour + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean new file mode 100644 index 0000000000..79238d2663 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean @@ -0,0 +1,322 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements + +/-! +# Punctured finite-field transitivity and reduction surjectivity + +The Markoff equation defines a functor on commutative semirings. This file identifies the +finite-field transitivity statement used by the dynamical proof with the source-faithful +arithmetic statement that reduction from natural-number Markoff solutions is surjective. +-/ + +namespace BGS.Markoff + +/-- Reduction from natural-number solutions, viewed in the existing ring-level surface. -/ +def markoffReductionSurface (p : ℕ) : + SemiringMarkoffSurface ℕ → MarkoffSurface (ZMod p) := + semiringMarkoffSurfaceEquiv (ZMod p) ∘ markoffReduction p + +@[simp] +theorem markoffReductionSurface_origin (p : ℕ) : + markoffReductionSurface p (semiringSurfaceOrigin ℕ) = surfaceOrigin (ZMod p) := by + change semiringMarkoffSurfaceEquiv (ZMod p) + (markoffReduction p (semiringSurfaceOrigin ℕ)) = surfaceOrigin (ZMod p) + rw [markoffReduction_origin, semiringMarkoffSurfaceEquiv_origin] + +@[simp] +theorem markoffReductionSurface_root (p : ℕ) : + markoffReductionSurface p (semiringSurfaceRoot ℕ) = surfaceRoot (ZMod p) := by + change semiringMarkoffSurfaceEquiv (ZMod p) + (markoffReduction p (semiringSurfaceRoot ℕ)) = surfaceRoot (ZMod p) + rw [markoffReduction_root, semiringMarkoffSurfaceEquiv_root] + +private theorem natCoordinate_le_vietaProduct {a b c : ℕ} + (h : a ^ 2 + b ^ 2 + c ^ 2 = 3 * a * b * c) : + a ≤ 3 * b * c := by + by_cases ha : a = 0 + · simp [ha] + · have haPos : 0 < a := Nat.pos_of_ne_zero ha + apply Nat.le_of_mul_le_mul_left _ haPos + calc + a * a ≤ a ^ 2 + b ^ 2 + c ^ 2 := by nlinarith + _ = 3 * a * b * c := h + _ = a * (3 * b * c) := by ring + +@[simp] +theorem markoffReductionSurface_natVieta1 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + markoffReductionSurface p (natVieta1Surface x) = + vieta1SurfacePerm (ZMod p) (markoffReductionSurface p x) := by + have hle : x.1.x1 ≤ 3 * x.1.x2 * x.1.x3 := + natCoordinate_le_vietaProduct x.2 + apply Subtype.ext + ext + · change ((3 * x.1.x2 * x.1.x3 - x.1.x1 : ℕ) : ZMod p) = + 3 * (x.1.x2 : ZMod p) * (x.1.x3 : ZMod p) - (x.1.x1 : ZMod p) + rw [Nat.cast_sub hle] + push_cast + rfl + · rfl + · rfl + +@[simp] +theorem markoffReductionSurface_natVieta2 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + markoffReductionSurface p (natVieta2Surface x) = + vieta2SurfacePerm (ZMod p) (markoffReductionSurface p x) := by + have hreorder : x.1.x2 ^ 2 + x.1.x1 ^ 2 + x.1.x3 ^ 2 = + 3 * x.1.x2 * x.1.x1 * x.1.x3 := by + simpa [IsSemiringMarkoff, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using x.2 + have hle : x.1.x2 ≤ 3 * x.1.x1 * x.1.x3 := + natCoordinate_le_vietaProduct hreorder + apply Subtype.ext + ext + · rfl + · change ((3 * x.1.x1 * x.1.x3 - x.1.x2 : ℕ) : ZMod p) = + 3 * (x.1.x1 : ZMod p) * (x.1.x3 : ZMod p) - (x.1.x2 : ZMod p) + rw [Nat.cast_sub hle] + push_cast + rfl + · rfl + +@[simp] +theorem markoffReductionSurface_natVieta3 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + markoffReductionSurface p (natVieta3Surface x) = + vieta3SurfacePerm (ZMod p) (markoffReductionSurface p x) := by + have hreorder : x.1.x3 ^ 2 + x.1.x1 ^ 2 + x.1.x2 ^ 2 = + 3 * x.1.x3 * x.1.x1 * x.1.x2 := by + simpa [IsSemiringMarkoff, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using x.2 + have hle : x.1.x3 ≤ 3 * x.1.x1 * x.1.x2 := + natCoordinate_le_vietaProduct hreorder + apply Subtype.ext + ext + · rfl + · rfl + · change ((3 * x.1.x1 * x.1.x2 - x.1.x3 : ℕ) : ZMod p) = + 3 * (x.1.x1 : ZMod p) * (x.1.x2 : ZMod p) - (x.1.x3 : ZMod p) + rw [Nat.cast_sub hle] + push_cast + rfl + +@[simp] +theorem markoffReductionSurface_natSwap12 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + markoffReductionSurface p (natSwap12Surface x) = + swap12SurfacePerm (ZMod p) (markoffReductionSurface p x) := by + apply Subtype.ext + ext <;> rfl + +@[simp] +theorem markoffReductionSurface_natSwap23 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + markoffReductionSurface p (natSwap23Surface x) = + swap23SurfacePerm (ZMod p) (markoffReductionSurface p x) := by + apply Subtype.ext + ext <;> rfl + +/-- Every word in the finite-field Markoff group has a word in the natural Markoff group whose +action commutes with reduction. -/ +theorem exists_naturalGamma_lift (p : ℕ) (g : Gamma (ZMod p)) : + ∃ h : NaturalGamma, ∀ x : SemiringMarkoffSurface ℕ, + markoffReductionSurface p (h • x) = g • markoffReductionSurface p x := by + let motive : ∀ q : Equiv.Perm (MarkoffSurface (ZMod p)), + q ∈ Subgroup.closure (gammaGenerators (ZMod p)) → Prop := + fun q hq ↦ ∃ h : NaturalGamma, ∀ x : SemiringMarkoffSurface ℕ, + markoffReductionSurface p (h • x) = + (⟨q, hq⟩ : Gamma (ZMod p)) • markoffReductionSurface p x + apply Subgroup.closure_induction (p := motive) + · intro q hq + simp only [gammaGenerators, Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl | rfl | rfl | rfl + · refine ⟨⟨natVieta1SurfaceEquiv, natVieta1SurfaceEquiv_mem_NaturalGamma⟩, fun x ↦ ?_⟩ + exact markoffReductionSurface_natVieta1 p x + · refine ⟨⟨natVieta2SurfaceEquiv, natVieta2SurfaceEquiv_mem_NaturalGamma⟩, fun x ↦ ?_⟩ + exact markoffReductionSurface_natVieta2 p x + · refine ⟨⟨natVieta3SurfaceEquiv, natVieta3SurfaceEquiv_mem_NaturalGamma⟩, fun x ↦ ?_⟩ + exact markoffReductionSurface_natVieta3 p x + · refine ⟨⟨natSwap12SurfaceEquiv, natSwap12SurfaceEquiv_mem_NaturalGamma⟩, fun x ↦ ?_⟩ + exact markoffReductionSurface_natSwap12 p x + · refine ⟨⟨natSwap23SurfaceEquiv, natSwap23SurfaceEquiv_mem_NaturalGamma⟩, fun x ↦ ?_⟩ + exact markoffReductionSurface_natSwap23 p x + · refine ⟨1, fun x ↦ ?_⟩ + change markoffReductionSurface p ((1 : NaturalGamma) • x) = + (1 : Gamma (ZMod p)) • markoffReductionSurface p x + simp + · intro q r hq hr hqLift hrLift + obtain ⟨qNat, hqNat⟩ := hqLift + obtain ⟨rNat, hrNat⟩ := hrLift + refine ⟨qNat * rNat, fun x ↦ ?_⟩ + change markoffReductionSurface p ((qNat * rNat) • x) = + ((⟨q, hq⟩ : Gamma (ZMod p)) * (⟨r, hr⟩ : Gamma (ZMod p))) • + markoffReductionSurface p x + rw [mul_smul, mul_smul, hqNat, hrNat] + · intro q hq hqLift + obtain ⟨qNat, hqNat⟩ := hqLift + refine ⟨qNat⁻¹, fun x ↦ ?_⟩ + change markoffReductionSurface p (qNat⁻¹ • x) = + (⟨q, hq⟩ : Gamma (ZMod p))⁻¹ • markoffReductionSurface p x + have h := congrArg (fun y ↦ (⟨q, hq⟩ : Gamma (ZMod p))⁻¹ • y) + (hqNat (qNat⁻¹ • x)) + simpa [mul_smul] using h.symm + +/-- Every word in the natural Markoff group reduces to a word in the finite-field Markoff group. -/ +theorem exists_gamma_reduction_of_naturalGamma (p : ℕ) (h : NaturalGamma) : + ∃ g : Gamma (ZMod p), ∀ x : SemiringMarkoffSurface ℕ, + markoffReductionSurface p (h • x) = g • markoffReductionSurface p x := by + let motive : ∀ q : Equiv.Perm (SemiringMarkoffSurface ℕ), + q ∈ Subgroup.closure naturalGammaGenerators → Prop := + fun q hq ↦ ∃ g : Gamma (ZMod p), ∀ x : SemiringMarkoffSurface ℕ, + markoffReductionSurface p ((⟨q, hq⟩ : NaturalGamma) • x) = + g • markoffReductionSurface p x + apply Subgroup.closure_induction (p := motive) + · intro q hq + simp only [naturalGammaGenerators, Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl | rfl | rfl | rfl + · refine ⟨gammaVieta1 (ZMod p), fun x ↦ ?_⟩ + exact markoffReductionSurface_natVieta1 p x + · refine ⟨gammaVieta2 (ZMod p), fun x ↦ ?_⟩ + exact markoffReductionSurface_natVieta2 p x + · refine ⟨gammaVieta3 (ZMod p), fun x ↦ ?_⟩ + exact markoffReductionSurface_natVieta3 p x + · refine ⟨gammaSwap12 (ZMod p), fun x ↦ ?_⟩ + exact markoffReductionSurface_natSwap12 p x + · refine ⟨gammaSwap23 (ZMod p), fun x ↦ ?_⟩ + exact markoffReductionSurface_natSwap23 p x + · refine ⟨1, fun x ↦ ?_⟩ + change markoffReductionSurface p ((1 : NaturalGamma) • x) = + (1 : Gamma (ZMod p)) • markoffReductionSurface p x + simp + · intro q r hq hr hqLift hrLift + obtain ⟨qMod, hqMod⟩ := hqLift + obtain ⟨rMod, hrMod⟩ := hrLift + refine ⟨qMod * rMod, fun x ↦ ?_⟩ + change markoffReductionSurface p + (((⟨q, hq⟩ : NaturalGamma) * (⟨r, hr⟩ : NaturalGamma)) • x) = + (qMod * rMod) • markoffReductionSurface p x + rw [mul_smul, mul_smul, hqMod, hrMod] + · intro q hq hqLift + obtain ⟨qMod, hqMod⟩ := hqLift + refine ⟨qMod⁻¹, fun x ↦ ?_⟩ + change markoffReductionSurface p ((⟨q, hq⟩ : NaturalGamma)⁻¹ • x) = + qMod⁻¹ • markoffReductionSurface p x + have hred := congrArg (fun y ↦ qMod⁻¹ • y) + (hqMod ((⟨q, hq⟩ : NaturalGamma)⁻¹ • x)) + simpa [mul_smul] using hred.symm + +/-- Natural Markoff connectivity descends to finite-field Markoff connectivity. -/ +theorem sameComponent_markoffReductionSurface_of_sameNatMarkoffComponent + (p : ℕ) {x y : SemiringMarkoffSurface ℕ} + (hxy : SameNatMarkoffComponent x y) : + SameComponent (markoffReductionSurface p x) (markoffReductionSurface p y) := by + unfold SameNatMarkoffComponent at hxy + rw [MulAction.mem_orbit_iff] at hxy + obtain ⟨h, rfl⟩ := hxy + obtain ⟨g, hg⟩ := exists_gamma_reduction_of_naturalGamma p h + exact (sameComponent_iff_exists _ _).2 ⟨g, (hg x).symm⟩ + +@[simp] +theorem surfaceRoot_ne_surfaceOrigin (R : Type*) [CommRing R] [Nontrivial R] : + surfaceRoot R ≠ surfaceOrigin R := by + intro h + have hfirst := congrArg (fun x : MarkoffSurface R ↦ x.1.x1) h + change (1 : R) = 0 at hfirst + exact one_ne_zero hfirst + +/-- Finite-field transitivity implies surjectivity of reduction from natural-number solutions. -/ +theorem markoffReduction_surjective_of_puncturedMarkoffTransitiveAt + (p : ℕ) (hp : p.Prime) (htransitive : PuncturedMarkoffTransitiveAt p hp) : + Function.Surjective (markoffReduction p) := by + letI : Fact p.Prime := ⟨hp⟩ + change ∀ x y : PuncturedMarkoffSurface (ZMod p), + ∃ g : Gamma (ZMod p), g • x = y at htransitive + intro y + let ySurface : MarkoffSurface (ZMod p) := semiringMarkoffSurfaceEquiv (ZMod p) y + by_cases hy : ySurface = surfaceOrigin (ZMod p) + · refine ⟨semiringSurfaceOrigin ℕ, ?_⟩ + apply (semiringMarkoffSurfaceEquiv (ZMod p)).injective + change markoffReductionSurface p (semiringSurfaceOrigin ℕ) = ySurface + rw [markoffReductionSurface_origin, hy] + · let root : PuncturedMarkoffSurface (ZMod p) := + ⟨surfaceRoot (ZMod p), surfaceRoot_ne_surfaceOrigin (ZMod p)⟩ + let target : PuncturedMarkoffSurface (ZMod p) := ⟨ySurface, hy⟩ + obtain ⟨g, hg⟩ := htransitive root target + obtain ⟨h, hh⟩ := exists_naturalGamma_lift p g + refine ⟨h • semiringSurfaceRoot ℕ, ?_⟩ + apply (semiringMarkoffSurfaceEquiv (ZMod p)).injective + change markoffReductionSurface p (h • semiringSurfaceRoot ℕ) = ySurface + calc + markoffReductionSurface p (h • semiringSurfaceRoot ℕ) = + g • markoffReductionSurface p (semiringSurfaceRoot ℕ) := + hh (semiringSurfaceRoot ℕ) + _ = g • surfaceRoot (ZMod p) := by rw [markoffReductionSurface_root] + _ = ySurface := congrArg Subtype.val hg + +/-- Surjectivity of natural-number reduction implies finite-field transitivity. The classical +connectivity of nonzero natural Markoff solutions is the essential input in this direction. -/ +theorem puncturedMarkoffTransitiveAt_of_markoffReduction_surjective + (p : ℕ) (hp : p.Prime) (hsurjective : Function.Surjective (markoffReduction p)) : + PuncturedMarkoffTransitiveAt p hp := by + letI : Fact p.Prime := ⟨hp⟩ + change ∀ x y : PuncturedMarkoffSurface (ZMod p), + ∃ g : Gamma (ZMod p), g • x = y + intro x y + let xSemiring : SemiringMarkoffSurface (ZMod p) := + (semiringMarkoffSurfaceEquiv (ZMod p)).symm x.1 + let ySemiring : SemiringMarkoffSurface (ZMod p) := + (semiringMarkoffSurfaceEquiv (ZMod p)).symm y.1 + obtain ⟨xNat, hxNat⟩ := hsurjective xSemiring + obtain ⟨yNat, hyNat⟩ := hsurjective ySemiring + have hxSurface : markoffReductionSurface p xNat = x.1 := by + change semiringMarkoffSurfaceEquiv (ZMod p) (markoffReduction p xNat) = x.1 + rw [hxNat, Equiv.apply_symm_apply] + have hySurface : markoffReductionSurface p yNat = y.1 := by + change semiringMarkoffSurfaceEquiv (ZMod p) (markoffReduction p yNat) = y.1 + rw [hyNat, Equiv.apply_symm_apply] + have hxNatNe : xNat ≠ semiringSurfaceOrigin ℕ := by + intro hxOrigin + subst xNat + rw [markoffReductionSurface_origin] at hxSurface + exact x.2 hxSurface.symm + have hyNatNe : yNat ≠ semiringSurfaceOrigin ℕ := by + intro hyOrigin + subst yNat + rw [markoffReductionSurface_origin] at hySurface + exact y.2 hySurface.symm + have hxNatural : SameNatMarkoffComponent (semiringSurfaceRoot ℕ) xNat := + (natMarkoff_eq_origin_or_sameComponent_root xNat).resolve_left hxNatNe + have hyNatural : SameNatMarkoffComponent (semiringSurfaceRoot ℕ) yNat := + (natMarkoff_eq_origin_or_sameComponent_root yNat).resolve_left hyNatNe + have hxComponent : SameComponent (surfaceRoot (ZMod p)) x.1 := by + simpa only [markoffReductionSurface_root, hxSurface] using + sameComponent_markoffReductionSurface_of_sameNatMarkoffComponent p hxNatural + have hyComponent : SameComponent (surfaceRoot (ZMod p)) y.1 := by + simpa only [markoffReductionSurface_root, hySurface] using + sameComponent_markoffReductionSurface_of_sameNatMarkoffComponent p hyNatural + have hxy : SameComponent x.1 y.1 := + sameComponent_trans (sameComponent_symm hxComponent) hyComponent + obtain ⟨g, hg⟩ := (sameComponent_iff_exists x.1 y.1).1 hxy + refine ⟨g, ?_⟩ + apply Subtype.ext + exact hg + +/-- The source-faithful reduction statement is equivalent to the finite-field transitivity +statement used by the BGS dynamical proof. -/ +theorem puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective + (p : ℕ) (hp : p.Prime) : + PuncturedMarkoffTransitiveAt p hp ↔ Function.Surjective (markoffReduction p) := + ⟨markoffReduction_surjective_of_puncturedMarkoffTransitiveAt p hp, + puncturedMarkoffTransitiveAt_of_markoffReduction_surjective p hp⟩ + +/-- For prime moduli, punctured finite-field transitivity is equivalent to strong +approximation. Natural Markoff connectivity is the essential input from right to left. -/ +theorem puncturedMarkoffTransitiveAt_iff_strongApproximationAt + (p : ℕ) (hp : p.Prime) : + PuncturedMarkoffTransitiveAt p hp ↔ StrongApproximationAt p := + (puncturedMarkoffTransitiveAt_iff_markoffReduction_surjective p hp).trans + (strongApproximationAt_iff_markoffReduction_surjective p).symm + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean new file mode 100644 index 0000000000..5dba097067 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount + +/-! +# Unconditional BGS assembly + +The closed function-field Hasse--Weil theorem now supplies the general affine +plane-curve estimate used by the split, nonsplit, and cage arguments. These +short wrappers close the final parameter of the existing BGS assembly. +-/ + +namespace BGS.Markoff + +/-- **BGS Theorem 1**, with both Corvaja--Zannier and affine Hasse--Weil +discharged in the repository. -/ +theorem theoremOneStatement : TheoremOneStatement := + theoremOneStatement_of_generalHasseWeil + BGS.HasseWeil.generalBivariateAffineHasseWeilTheorem + +/-- The eventual form of BGS Conjecture 1: strong approximation holds at +every sufficiently large prime. -/ +theorem eventually_strongApproximationAt : + ∃ p0 : ℕ, ∀ (p : ℕ), p.Prime → p0 ≤ p → StrongApproximationAt p := + eventually_strongApproximationAt_of_generalHasseWeil + BGS.HasseWeil.generalBivariateAffineHasseWeilTheorem + +/-- **BGS Theorem 2**, obtained from the unconditional Theorem 1 and Chen's +orbit-divisibility theorem, using Martin's later elementary proof. -/ +theorem theoremTwoStatement : TheoremTwoStatement := + theoremTwoStatement_of_generalHasseWeil + BGS.HasseWeil.generalBivariateAffineHasseWeilTheorem + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean new file mode 100644 index 0000000000..e7ee41762c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity +import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound + +/-! +# Weighted certificate-free coarse-support surjectivity + +This module feeds the weighted twentieth moment for the neighboring divisor +counts into the Euler-seven coarse-support obstruction. It improves the +tenth-moment checkpoint without changing the geometric frontier and without +introducing a divisor table or a finite maximal-divisor certificate. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- Open cutoff supplied by the weighted twentieth moment and the Euler-seven +obstruction. -/ +def weightedCoarseSupportStrongApproximationOpenCutoff : ℕ := + 35721 ^ 5 * 2 ^ 1547 * 32769 ^ 2 + +/-- Closed version of `weightedCoarseSupportStrongApproximationOpenCutoff`. -/ +def weightedCoarseSupportStrongApproximationCutoff : ℕ := + weightedCoarseSupportStrongApproximationOpenCutoff + 1 + +private theorem twoPow756_lt_weightedCoarseSupportStrongApproximationOpenCutoff : + 2 ^ 756 < weightedCoarseSupportStrongApproximationOpenCutoff := by + calc + 2 ^ 756 < 2 ^ 1547 := + Nat.pow_lt_pow_right (by norm_num) (by norm_num) + _ = 1 * 2 ^ 1547 * 1 := by ring + _ ≤ 35721 ^ 5 * 2 ^ 1547 * 32769 ^ 2 := by + gcongr <;> norm_num + +/-- The weighted joint twentieth moment rules out the final Euler-seven +obstruction above the exact weighted cutoff. -/ +theorem weighted_35721_mul_divisorSum_pow_eight_lt + {p : ℕ} (hpOdd : Odd p) + (hp : weightedCoarseSupportStrongApproximationOpenCutoff < p) : + 35721 * ((p - 1).divisors.card + (p + 1).divisors.card) ^ 8 < 8 * p := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let D := neighboringDivisorSumWeightedMomentConstant + have hpPos : 0 < p := (Nat.zero_le _).trans_lt hp + have hpSupport : 2 ^ 756 < p := + twoPow756_lt_weightedCoarseSupportStrongApproximationOpenCutoff.trans hp + have hpLarge : 794039 ≤ p := by + have hsmall : 794039 < 2 ^ 20 := by norm_num + have hpowers : 2 ^ 20 ≤ 2 ^ 756 := + Nat.pow_le_pow_right (by norm_num) (by norm_num) + omega + have hmoment : T ^ 20 ≤ D * p ^ 2 := by + simpa [T, D] using + card_divisors_pred_add_card_divisors_succ_pow_twenty_le hpOdd hpLarge + by_contra hnot + have hbad : 8 * p ≤ 35721 * T ^ 8 := by + exact Nat.le_of_not_gt (by simpa [T] using hnot) + have hbadPow : (8 * p) ^ 5 ≤ (35721 * T ^ 8) ^ 5 := + Nat.pow_le_pow_left hbad 5 + have hmomentPow : (T ^ 20) ^ 2 ≤ (D * p ^ 2) ^ 2 := + Nat.pow_le_pow_left hmoment 2 + have hcombined : + 2 ^ 15 * p ^ 5 ≤ 35721 ^ 5 * D ^ 2 * p ^ 4 := by + calc + 2 ^ 15 * p ^ 5 = (8 * p) ^ 5 := by ring + _ ≤ (35721 * T ^ 8) ^ 5 := hbadPow + _ = 35721 ^ 5 * (T ^ 20) ^ 2 := by ring + _ ≤ 35721 ^ 5 * (D * p ^ 2) ^ 2 := + Nat.mul_le_mul_left _ hmomentPow + _ = 35721 ^ 5 * D ^ 2 * p ^ 4 := by ring + have hcombined' : + (2 ^ 15 * p) * p ^ 4 ≤ + (35721 ^ 5 * D ^ 2) * p ^ 4 := by + simpa only [show p ^ 5 = p * p ^ 4 by ring, Nat.mul_assoc] using hcombined + have hcancel : 2 ^ 15 * p ≤ 35721 ^ 5 * D ^ 2 := + Nat.le_of_mul_le_mul_right hcombined' (pow_pos hpPos 4) + have hfactor : + 35721 ^ 5 * D ^ 2 = + 2 ^ 15 * weightedCoarseSupportStrongApproximationOpenCutoff := by + have hD : D = 2 ^ 781 * 32769 := + neighboringDivisorSumWeightedMomentConstant_eq + rw [hD, mul_pow] + rw [show (2 ^ 781) ^ 2 = 2 ^ 1562 by + rw [show (1562 : ℕ) = 781 * 2 by norm_num, pow_mul]] + rw [show (1562 : ℕ) = 15 + 1547 by norm_num, pow_add] + unfold weightedCoarseSupportStrongApproximationOpenCutoff + ring + have hcutoffUpper : + p ≤ weightedCoarseSupportStrongApproximationOpenCutoff := by + rw [hfactor] at hcancel + have hcancel' : + p * 2 ^ 15 ≤ + weightedCoarseSupportStrongApproximationOpenCutoff * 2 ^ 15 := by + simpa only [Nat.mul_comm] using hcancel + exact Nat.le_of_mul_le_mul_right hcancel' (pow_pos (by norm_num) 15) + exact (Nat.not_le_of_lt hp) hcutoffUpper + +/-- The weighted cutoff dominates the support-only threshold used by the +coarse endgame and cage arguments. -/ +theorem twoPow756_lt_of_weightedCoarseSupportOpenCutoff_lt + {p : ℕ} + (hp : weightedCoarseSupportStrongApproximationOpenCutoff < p) : + 2 ^ 756 < p := + twoPow756_lt_weightedCoarseSupportStrongApproximationOpenCutoff.trans hp + +/-- Natural Markoff reduction is surjective above the weighted +certificate-free cutoff. -/ +theorem markoffReduction_surjective_of_weightedCoarseSupportOpenCutoff + (p : ℕ) (hpPrime : p.Prime) + (hp : weightedCoarseSupportStrongApproximationOpenCutoff < p) : + Function.Surjective (markoffReduction p) := by + letI : Fact p.Prime := ⟨hpPrime⟩ + have hpThree : 3 < p := by + have hsupport := twoPow756_lt_of_weightedCoarseSupportOpenCutoff_lt hp + omega + have hpOdd : Odd p := + hpPrime.odd_of_ne_two (by omega) + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero + (natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hpThree) + let T := (p - 1).divisors.card + (p + 1).divisors.card + apply markoffReduction_surjective_of_eulerSevenSquareEnvelope_coarseSupport + p (twoPow756_lt_of_weightedCoarseSupportOpenCutoff_lt hp) (fun _ ↦ T ^ 2) + · intro d + simpa [T] using maximalDivisorCountSum_sq_le_divisorSum_sq p d + · intro d + calc + 35721 * (T ^ 2) ^ 4 = 35721 * T ^ 8 := by ring + _ < 8 * p := by + simpa [T] using + weighted_35721_mul_divisorSum_pow_eight_lt hpOdd hp + +/-- Closed-cutoff form used by the public Comparator theorem. -/ +theorem markoffReduction_surjective_of_weightedCoarseSupportBound + (p : ℕ) (hpPrime : p.Prime) + (hp : weightedCoarseSupportStrongApproximationCutoff ≤ p) : + Function.Surjective (markoffReduction p) := by + apply markoffReduction_surjective_of_weightedCoarseSupportOpenCutoff p hpPrime + simpa [weightedCoarseSupportStrongApproximationCutoff] using hp + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean new file mode 100644 index 0000000000..1e6d5ceea9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime +import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean new file mode 100644 index 0000000000..1abf31b11e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean @@ -0,0 +1,292 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption + +/-! +# Coordinate-axis invariance of cage witnesses + +The cage geometry is symmetric in the three normalized coordinates, but its +point-count argument is written for the canonical ordered pair of outer axes +`(.first, .second)`. The two incidence witnesses are independent points, so +they may be permuted independently while their common bridge coordinate is +sent to the third coordinate. This file records that symmetry as an actual +equivalence, retaining the common trace exactly. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Swapping the first two normalized coordinates as an equivalence. -/ +private def normalizedSwap12Equiv (R : Type*) : + NormalizedPoint R ≃ NormalizedPoint R where + toFun := normalizedSwap12 + invFun := normalizedSwap12 + left_inv x := by ext <;> rfl + right_inv x := by ext <;> rfl + +/-- Swapping the last two normalized coordinates as an equivalence. -/ +private def normalizedSwap23Equiv (R : Type*) : + NormalizedPoint R ≃ NormalizedPoint R where + toFun := normalizedSwap23 + invFun := normalizedSwap23 + left_inv x := by ext <;> rfl + right_inv x := by ext <;> rfl + +/-- Permute the first incidence point so that its outer coordinate is first +and its bridge coordinate is third. -/ +private def cageFirstPointCanonicalEquiv (R : Type*) + (axis other : NormalizedCoordinateAxis) : + NormalizedPoint R ≃ NormalizedPoint R := + match axis, other with + | .first, .first => normalizedSwap23Equiv R + | .first, .second => Equiv.refl _ + | .first, .third => normalizedSwap23Equiv R + | .second, .first => normalizedSwap12Equiv R + | .second, .second => + (normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R) + | .second, .third => + (normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R) + | .third, .first => + (normalizedSwap23Equiv R).trans (normalizedSwap12Equiv R) + | .third, .second => + ((normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R)).trans + (normalizedSwap12Equiv R) + | .third, .third => + ((normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R)).trans + (normalizedSwap12Equiv R) + +/-- Permute the second incidence point so that its outer coordinate is second +and its bridge coordinate is third. -/ +private def cageSecondPointCanonicalEquiv (R : Type*) + (axis other : NormalizedCoordinateAxis) : + NormalizedPoint R ≃ NormalizedPoint R := + match axis, other with + | .first, .first => + (normalizedSwap23Equiv R).trans (normalizedSwap12Equiv R) + | .first, .second => Equiv.refl _ + | .first, .third => normalizedSwap23Equiv R + | .second, .first => normalizedSwap12Equiv R + | .second, .second => + ((normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R)).trans + (normalizedSwap12Equiv R) + | .second, .third => + (normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R) + | .third, .first => + (normalizedSwap23Equiv R).trans (normalizedSwap12Equiv R) + | .third, .second => + ((normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R)).trans + (normalizedSwap12Equiv R) + | .third, .third => + (normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R) + +private theorem cageFirstPointCanonical_mem + {R : Type*} [CommRing R] + (axis other : NormalizedCoordinateAxis) (xi middle : R) + {x : NormalizedPoint R} + (hOuter : x ∈ normalizedFiberAt axis xi) + (hMiddle : normalizedCoordinateAt (cageBridgeAxis axis other) x = middle) : + (cageFirstPointCanonicalEquiv R axis other) x ∈ + normalizedFiberAt .first xi ∧ + normalizedCoordinateAt .third + ((cageFirstPointCanonicalEquiv R axis other) x) = middle := by + cases axis <;> cases other <;> + simp only [cageFirstPointCanonicalEquiv, normalizedSwap12Equiv, + normalizedSwap23Equiv, Equiv.trans_apply, Equiv.refl_apply, + normalizedFiberAt, normalizedCoordinateAt, cageBridgeAxis] + at hOuter hMiddle ⊢ + all_goals + refine ⟨⟨?_, hOuter.2⟩, ?_⟩ + · have hSurface := hOuter.1 + dsimp [IsNormalizedMarkoff, normalizedPolynomial] at hSurface + dsimp [IsNormalizedMarkoff, normalizedPolynomial, + normalizedSwap12, normalizedSwap23] + ring_nf at hSurface ⊢ + exact hSurface + · exact hMiddle + +private theorem cageSecondPointCanonical_mem + {R : Type*} [CommRing R] + (axis other : NormalizedCoordinateAxis) (eta middle : R) + {x : NormalizedPoint R} + (hOuter : x ∈ normalizedFiberAt other eta) + (hMiddle : normalizedCoordinateAt (cageBridgeAxis axis other) x = middle) : + (cageSecondPointCanonicalEquiv R axis other) x ∈ + normalizedFiberAt .second eta ∧ + normalizedCoordinateAt .third + ((cageSecondPointCanonicalEquiv R axis other) x) = middle := by + cases axis <;> cases other <;> + simp only [cageSecondPointCanonicalEquiv, normalizedSwap12Equiv, + normalizedSwap23Equiv, Equiv.trans_apply, Equiv.refl_apply, + normalizedFiberAt, normalizedCoordinateAt, cageBridgeAxis] + at hOuter hMiddle ⊢ + all_goals + refine ⟨⟨?_, hOuter.2⟩, ?_⟩ + · have hSurface := hOuter.1 + dsimp [IsNormalizedMarkoff, normalizedPolynomial] at hSurface + dsimp [IsNormalizedMarkoff, normalizedPolynomial, + normalizedSwap12, normalizedSwap23] + ring_nf at hSurface ⊢ + exact hSurface + · exact hMiddle + +/-- Send an arbitrary ordered pair of cage axes to the canonical ordered pair. +The two points are permuted independently and their common bridge coordinate +becomes the common third coordinate. -/ +def cageMiddleWitnessToCanonical + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) : + CageMiddleWitnessPair p axis other xi eta → + CageMiddleWitnessPair p .first .second xi eta := fun z => by + let firstPoint := + (cageFirstPointCanonicalEquiv (ZMod p) axis other) z.1.1 + let secondPoint := + (cageSecondPointCanonicalEquiv (ZMod p) axis other) z.1.2 + have hFirst := cageFirstPointCanonical_mem axis other xi + (normalizedCoordinateAt (cageBridgeAxis axis other) z.1.1) + z.2.1 rfl + have hSecondMiddle : + normalizedCoordinateAt (cageBridgeAxis axis other) z.1.2 = + normalizedCoordinateAt (cageBridgeAxis axis other) z.1.1 := + z.2.2.2.symm + have hSecond := cageSecondPointCanonical_mem axis other eta + (normalizedCoordinateAt (cageBridgeAxis axis other) z.1.1) + z.2.2.1 hSecondMiddle + exact ⟨(firstPoint, secondPoint), hFirst.1, hSecond.1, + hFirst.2.trans hSecond.2.symm⟩ + +private theorem cageFirstPointCanonicalEquiv_preserves_surface + {R : Type*} [CommRing R] + (axis other : NormalizedCoordinateAxis) (x : NormalizedPoint R) : + IsNormalizedMarkoff ((cageFirstPointCanonicalEquiv R axis other) x) ↔ + IsNormalizedMarkoff x := by + cases axis <;> cases other <;> + simp [cageFirstPointCanonicalEquiv, normalizedSwap12Equiv, + normalizedSwap23Equiv, IsNormalizedMarkoff, + normalizedPolynomial_swap12, normalizedPolynomial_swap23] + +private theorem cageSecondPointCanonicalEquiv_preserves_surface + {R : Type*} [CommRing R] + (axis other : NormalizedCoordinateAxis) (x : NormalizedPoint R) : + IsNormalizedMarkoff ((cageSecondPointCanonicalEquiv R axis other) x) ↔ + IsNormalizedMarkoff x := by + cases axis <;> cases other <;> + simp [cageSecondPointCanonicalEquiv, normalizedSwap12Equiv, + normalizedSwap23Equiv, IsNormalizedMarkoff, + normalizedPolynomial_swap12, normalizedPolynomial_swap23] + +/-- The inverse coordinate permutations reconstruct a witness on the original +ordered pair of axes. -/ +def canonicalCageMiddleWitnessToAxes + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) : + CageMiddleWitnessPair p .first .second xi eta → + CageMiddleWitnessPair p axis other xi eta := fun z => by + let firstPoint := + (cageFirstPointCanonicalEquiv (ZMod p) axis other).symm z.1.1 + let secondPoint := + (cageSecondPointCanonicalEquiv (ZMod p) axis other).symm z.1.2 + refine ⟨(firstPoint, secondPoint), ?_⟩ + cases axis <;> cases other <;> + simp [firstPoint, secondPoint, cageFirstPointCanonicalEquiv, + cageSecondPointCanonicalEquiv, normalizedSwap12Equiv, + normalizedSwap23Equiv, + normalizedSwap12, normalizedSwap23, normalizedFiberAt, + normalizedCoordinateAt, cageBridgeAxis] at z ⊢ + all_goals + rcases z.2 with ⟨⟨hFirstSurface, hxi⟩, + ⟨⟨hSecondSurface, heta⟩, hmiddle⟩⟩ + exact ⟨⟨by + dsimp [IsNormalizedMarkoff, normalizedPolynomial, + normalizedSwap12, normalizedSwap23] at hFirstSurface ⊢ + ring_nf at hFirstSurface ⊢ + exact hFirstSurface, hxi⟩, + ⟨⟨by + dsimp [IsNormalizedMarkoff, normalizedPolynomial, + normalizedSwap12, normalizedSwap23] at hSecondSurface ⊢ + ring_nf at hSecondSurface ⊢ + exact hSecondSurface, heta⟩, + hmiddle⟩⟩ + +/-- Cage witness pairs for arbitrary axes are canonically equivalent to the +first--second model used by the plane equations. -/ +def cageMiddleWitnessEquivCanonical + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) : + CageMiddleWitnessPair p axis other xi eta ≃ + CageMiddleWitnessPair p .first .second xi eta where + toFun := cageMiddleWitnessToCanonical p axis other xi eta + invFun := canonicalCageMiddleWitnessToAxes p axis other xi eta + left_inv z := by + apply Subtype.ext + apply Prod.ext <;> apply NormalizedPoint.ext <;> + cases axis <;> cases other <;> rfl + right_inv z := by + apply Subtype.ext + apply Prod.ext <;> apply NormalizedPoint.ext <;> + cases axis <;> cases other <;> rfl + +/-- Canonicalizing the axes preserves the common middle trace exactly. -/ +@[simp] +theorem cageMiddleWitnessEquivCanonical_trace + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) + (z : CageMiddleWitnessPair p axis other xi eta) : + cageMiddleWitnessTrace + (cageMiddleWitnessEquivCanonical p axis other xi eta z) = + cageMiddleWitnessTrace z := by + cases axis <;> cases other <;> rfl + +/-- Axis canonicalization extends to the one-sided power-range solutions used +by the cage point count. -/ +def cageMiddleWitnessPowerRangeEquivCanonical + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) (d : ℕ) : + cageMiddleWitnessPowerRangeSolutions p axis other xi eta d ≃ + cageMiddleWitnessPowerRangeSolutions p .first .second xi eta d where + toFun z := ⟨(cageMiddleWitnessEquivCanonical p axis other xi eta z.1.1, z.1.2), by + simpa using z.2⟩ + invFun z := ⟨((cageMiddleWitnessEquivCanonical p axis other xi eta).symm z.1.1, + z.1.2), by + have htrace := cageMiddleWitnessEquivCanonical_trace + p axis other xi eta + ((cageMiddleWitnessEquivCanonical p axis other xi eta).symm z.1.1) + calc + cageMiddleWitnessTrace + ((cageMiddleWitnessEquivCanonical p axis other xi eta).symm z.1.1) = + cageMiddleWitnessTrace + (cageMiddleWitnessEquivCanonical p axis other xi eta + ((cageMiddleWitnessEquivCanonical p axis other xi eta).symm z.1.1)) := + htrace.symm + _ = cageMiddleWitnessTrace z.1.1 := by + rw [(cageMiddleWitnessEquivCanonical p axis other xi eta).apply_symm_apply] + _ = splitTorusTrace z.1.2 := z.2⟩ + left_inv z := by + apply Subtype.ext + apply Prod.ext + · exact (cageMiddleWitnessEquivCanonical p axis other xi eta).left_inv z.1.1 + · rfl + right_inv z := by + apply Subtype.ext + apply Prod.ext + · exact (cageMiddleWitnessEquivCanonical p axis other xi eta).right_inv z.1.1 + · rfl + +/-- The witness-bearing cage count is independent of the chosen ordered pair +of outer coordinate axes. -/ +theorem natCard_cageMiddleWitnessPowerRangeSolutions_eq_canonical + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) (d : ℕ) : + Nat.card (cageMiddleWitnessPowerRangeSolutions p axis other xi eta d) = + Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) := + Nat.card_congr + (cageMiddleWitnessPowerRangeEquivCanonical p axis other xi eta d) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean new file mode 100644 index 0000000000..5937bc8ad9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean @@ -0,0 +1,269 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing + +/-! +# A primitive quartic for a biquadratic extension + +If `f`, `g`, and `f * g` are nonsquares in a field of characteristic different +from two, then `sqrt f + sqrt g` generates the corresponding biquadratic +extension. Its minimal polynomial is + +`(X^2 - (f + g))^2 - 4 * f * g`. + +This file packages that calculation as a reusable irreducibility theorem. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {F : Type*} [Field F] + +private lemma sum_of_square_roots_power_sum + {R : Type*} [CommRing R] (a b f g c0 c1 c2 c3 : R) + (ha : a ^ 2 = f) (hb : b ^ 2 = g) : + (c0 + c2 * (f + g)) + + (c1 + c3 * (f + 3 * g)) * a + + (c1 + c3 * (3 * f + g)) * b + + (2 * c2) * a * b = + c0 * 1 + c1 * (a + b) + c2 * (a + b) ^ 2 + c3 * (a + b) ^ 3 := by + rw [← ha, ← hb] + ring + +private lemma sum_of_square_roots_quartic_relation + {R : Type*} [CommRing R] (a b f g : R) + (ha : a ^ 2 = f) (hb : b ^ 2 = g) : + ((a + b) ^ 2 - (f + g)) ^ 2 - 4 * f * g = 0 := by + rw [← ha, ← hb] + ring + +private lemma finFour_power_relation + {R S : Type*} [CommRing R] [CommRing S] [Algebra R S] + (c : Fin 4 → R) (z : S) + (h : ∑ i : Fin 4, c i • z ^ (i : ℕ) = 0) : + algebraMap R S (c 0) * 1 + algebraMap R S (c 1) * z + + algebraMap R S (c 2) * z ^ 2 + algebraMap R S (c 3) * z ^ 3 = 0 := by + simpa [Fin.sum_univ_four, Algebra.smul_def] using h + +private lemma regroup_quadratic_tower_coefficients + {R S T : Type*} [CommRing R] [CommRing S] [CommRing T] + [Algebra R S] [Algebra S T] [Algebra R T] [IsScalarTower R S T] + (r : S) (s : T) (A0 A1 B0 B1 : R) : + algebraMap R T A0 + algebraMap R T A1 * algebraMap S T r + + algebraMap R T B0 * s + algebraMap R T B1 * algebraMap S T r * s = + algebraMap S T (algebraMap R S A0 + algebraMap R S A1 * r) + + algebraMap S T (algebraMap R S B0 + algebraMap R S B1 * r) * s := by + simp only [map_add, map_mul, IsScalarTower.algebraMap_apply R S T] + ring + +/-- The minimal-polynomial candidate for `sqrt f + sqrt g`. -/ +def biquadraticPrimitiveQuartic (f g : F) : F[X] := + (X ^ 2 - C (f + g)) ^ 2 - C (4 * f * g) + +lemma biquadraticPrimitiveQuartic_monic (f g : F) : + (biquadraticPrimitiveQuartic f g).Monic := by + have hquadratic : IsMonicOfDegree (X ^ 2 - C (f + g) : F[X]) 2 := + (isMonicOfDegree_X_pow F 2).sub (by simp) + exact ((hquadratic.pow 2).sub (by + have hpos : 0 < 2 * 2 := by norm_num + simpa only [← C_mul, natDegree_C] using hpos)).monic + +lemma biquadraticPrimitiveQuartic_degree (f g : F) : + (biquadraticPrimitiveQuartic f g).degree = 4 := by + have hquadratic : IsMonicOfDegree (X ^ 2 - C (f + g) : F[X]) 2 := + (isMonicOfDegree_X_pow F 2).sub (by simp) + have hquartic : IsMonicOfDegree (biquadraticPrimitiveQuartic f g) 4 := by + simpa [biquadraticPrimitiveQuartic] using + (hquadratic.pow 2).sub (by + have hpos : 0 < 2 * 2 := by norm_num + simpa only [← C_mul, natDegree_C] using hpos) + rw [degree_eq_natDegree hquartic.ne_zero, hquartic.natDegree_eq] + norm_num + +/-- Three independent square classes give the irreducible primitive quartic +of the associated biquadratic extension. -/ +theorem biquadraticPrimitiveQuartic_irreducible + (h2 : (2 : F) ≠ 0) {f g : F} + (hf : ¬ IsSquare f) (hg : ¬ IsSquare g) + (hfg : ¬ IsSquare (f * g)) : + Irreducible (biquadraticPrimitiveQuartic f g) := by + let qf : F[X] := adjoinSquarePolynomial f + have hqfIrreducible : Irreducible qf := by + simpa [qf] using adjoinSquarePolynomial_irreducible_of_not_isSquare hf + letI : Fact (Irreducible qf) := ⟨hqfIrreducible⟩ + let E := AdjoinRoot qf + let gE : E := algebraMap F E g + have hgE : ¬ IsSquare gE := by + exact not_isSquare_algebraMap_adjoinSquare_of_independent h2 hf hg hfg + let qg : E[X] := adjoinSquarePolynomial gE + have hqgIrreducible : Irreducible qg := by + simpa [qg] using adjoinSquarePolynomial_irreducible_of_not_isSquare hgE + letI : Fact (Irreducible qg) := ⟨hqgIrreducible⟩ + let L := AdjoinRoot qg + let a : L := algebraMap E L (AdjoinRoot.root qf) + let b : L := AdjoinRoot.root qg + let z : L := a + b + have hqfMonic : qf.Monic := by + simpa [qf] using adjoinSquarePolynomial_monic f + have hqgMonic : qg.Monic := by + simpa [qg] using adjoinSquarePolynomial_monic gE + have hqfDegree : qf.natDegree = 2 := by + simpa [qf] using adjoinSquarePolynomial_natDegree f + have hqgDegree : qg.natDegree = 2 := by + simpa [qg] using adjoinSquarePolynomial_natDegree gE + have ha_sq : a ^ 2 = algebraMap F L f := by + change (algebraMap E L (AdjoinRoot.root qf)) ^ 2 = algebraMap F L f + rw [← map_pow, show (AdjoinRoot.root qf) ^ 2 = algebraMap F E f by + simpa only [E, qf, AdjoinRoot.algebraMap_eq] using adjoinSquareRoot_sq f] + exact IsScalarTower.algebraMap_apply F E L f + have hb_sq : b ^ 2 = algebraMap F L g := by + change (AdjoinRoot.root qg) ^ 2 = algebraMap F L g + rw [show (AdjoinRoot.root qg) ^ 2 = algebraMap E L gE by + simpa only [L, qg, AdjoinRoot.algebraMap_eq] using adjoinSquareRoot_sq gE] + exact IsScalarTower.algebraMap_apply F E L g + have hfg_ne : f ≠ g := by + intro heq + apply hfg + refine ⟨f, ?_⟩ + rw [heq] + let firstBasis : Module.Basis (Fin qf.natDegree) F E := + (AdjoinRoot.powerBasis' hqfMonic).basis + let secondBasis : Module.Basis (Fin qg.natDegree) E L := + (AdjoinRoot.powerBasis' hqgMonic).basis + let firstZero : Fin qf.natDegree := ⟨0, by rw [hqfDegree]; norm_num⟩ + let firstOne : Fin qf.natDegree := ⟨1, by rw [hqfDegree]; norm_num⟩ + let secondZero : Fin qg.natDegree := ⟨0, by rw [hqgDegree]; norm_num⟩ + let secondOne : Fin qg.natDegree := ⟨1, by rw [hqgDegree]; norm_num⟩ + have hfirst_ne : firstZero ≠ firstOne := by + intro h + have := congrArg Fin.val h + norm_num [firstZero, firstOne] at this + have hsecond_ne : secondZero ≠ secondOne := by + intro h + have := congrArg Fin.val h + norm_num [secondZero, secondOne] at this + have hfirst0 : firstBasis firstZero = 1 := by + change (AdjoinRoot.powerBasis' hqfMonic).basis firstZero = 1 + rw [(AdjoinRoot.powerBasis' hqfMonic).basis_eq_pow] + simp [firstZero] + have hfirst1 : firstBasis firstOne = AdjoinRoot.root qf := by + change (AdjoinRoot.powerBasis' hqfMonic).basis firstOne = AdjoinRoot.root qf + rw [(AdjoinRoot.powerBasis' hqfMonic).basis_eq_pow] + simp [firstOne] + have hsecond0 : secondBasis secondZero = 1 := by + change (AdjoinRoot.powerBasis' hqgMonic).basis secondZero = 1 + rw [(AdjoinRoot.powerBasis' hqgMonic).basis_eq_pow] + simp [secondZero] + have hsecond1 : secondBasis secondOne = AdjoinRoot.root qg := by + change (AdjoinRoot.powerBasis' hqgMonic).basis secondOne = AdjoinRoot.root qg + rw [(AdjoinRoot.powerBasis' hqgMonic).basis_eq_pow] + simp [secondOne] + have hpowers : LinearIndependent F (fun i : Fin 4 ↦ z ^ (i : ℕ)) := by + refine Fintype.linearIndependent_iff.mpr ?_ + intro c hc i + have hcExpanded := finFour_power_relation c z hc + have hrelation : + algebraMap F L (c 0 + c 2 * (f + g)) + + algebraMap F L (c 1 + c 3 * (f + 3 * g)) * a + + algebraMap F L (c 1 + c 3 * (3 * f + g)) * b + + algebraMap F L (2 * c 2) * a * b = 0 := by + calc + algebraMap F L (c 0 + c 2 * (f + g)) + + algebraMap F L (c 1 + c 3 * (f + 3 * g)) * a + + algebraMap F L (c 1 + c 3 * (3 * f + g)) * b + + algebraMap F L (2 * c 2) * a * b = + algebraMap F L (c 0) * 1 + + algebraMap F L (c 1) * z + + algebraMap F L (c 2) * z ^ 2 + + algebraMap F L (c 3) * z ^ 3 := by + simpa only [z, map_add, map_mul, map_ofNat] using + sum_of_square_roots_power_sum a b + (algebraMap F L f) (algebraMap F L g) + (algebraMap F L (c 0)) (algebraMap F L (c 1)) + (algebraMap F L (c 2)) (algebraMap F L (c 3)) ha_sq hb_sq + _ = 0 := hcExpanded + let constantCoefficient : E := + algebraMap F E (c 0 + c 2 * (f + g)) + + algebraMap F E (c 1 + c 3 * (f + 3 * g)) * AdjoinRoot.root qf + let rootCoefficient : E := + algebraMap F E (c 1 + c 3 * (3 * f + g)) + + algebraMap F E (2 * c 2) * AdjoinRoot.root qf + have hregroup : + algebraMap E L constantCoefficient + + algebraMap E L rootCoefficient * b = 0 := by + rw [← hrelation] + simpa only [constantCoefficient, rootCoefficient, a] using + (regroup_quadratic_tower_coefficients + (R := F) (S := E) (T := L) (AdjoinRoot.root qf) b + (c 0 + c 2 * (f + g)) + (c 1 + c 3 * (f + 3 * g)) + (c 1 + c 3 * (3 * f + g)) (2 * c 2)).symm + have hsecondRelation : + constantCoefficient • secondBasis secondZero + + rootCoefficient • secondBasis secondOne = 0 := by + simpa only [hsecond0, hsecond1, Algebra.smul_def, b, mul_one] using hregroup + have hconstant := congrArg (secondBasis.coord secondZero) hsecondRelation + have hroot := congrArg (secondBasis.coord secondOne) hsecondRelation + have hconstant_zero : constantCoefficient = 0 := by + simpa [hsecond_ne] using hconstant + have hroot_zero : rootCoefficient = 0 := by + simpa [hsecond_ne] using hroot + have hconstantFirstRelation : + (c 0 + c 2 * (f + g)) • firstBasis firstZero + + (c 1 + c 3 * (f + 3 * g)) • firstBasis firstOne = 0 := by + simpa [constantCoefficient, hfirst0, hfirst1, Algebra.smul_def] using + hconstant_zero + have hrootFirstRelation : + (c 1 + c 3 * (3 * f + g)) • firstBasis firstZero + + (2 * c 2) • firstBasis firstOne = 0 := by + simpa [rootCoefficient, hfirst0, hfirst1, Algebra.smul_def] using hroot_zero + have hc0c2 := congrArg (firstBasis.coord firstZero) hconstantFirstRelation + have hc1c3Left := congrArg (firstBasis.coord firstOne) hconstantFirstRelation + have hc1c3Right := congrArg (firstBasis.coord firstZero) hrootFirstRelation + have hc2two := congrArg (firstBasis.coord firstOne) hrootFirstRelation + have hc2 : c 2 = 0 := by + have : (2 : F) * c 2 = 0 := by simpa [hfirst_ne] using hc2two + exact (mul_eq_zero.mp this).resolve_left h2 + have hc0 : c 0 = 0 := by + simpa [hfirst_ne, hc2] using hc0c2 + have hc3 : c 3 = 0 := by + have hsub : c 3 * (2 * (g - f)) = 0 := by + have hleft : c 1 + c 3 * (f + 3 * g) = 0 := by + simpa [hfirst_ne] using hc1c3Left + have hright : c 1 + c 3 * (3 * f + g) = 0 := by + simpa [hfirst_ne] using hc1c3Right + calc + c 3 * (2 * (g - f)) = + (c 1 + c 3 * (f + 3 * g)) - + (c 1 + c 3 * (3 * f + g)) := by ring + _ = 0 := by rw [hleft, hright]; ring + apply (mul_eq_zero.mp hsub).resolve_right + exact mul_ne_zero h2 (sub_ne_zero.mpr hfg_ne.symm) + have hc1 : c 1 = 0 := by + simpa [hfirst_ne, hc3] using hc1c3Left + fin_cases i <;> assumption + have hzRoot : (biquadraticPrimitiveQuartic f g).aeval z = 0 := by + simp only [biquadraticPrimitiveQuartic, map_sub, map_pow, aeval_X, aeval_C] + simpa only [z, map_add, map_mul, map_ofNat] using + sum_of_square_roots_quartic_relation a b + (algebraMap F L f) (algebraMap F L g) ha_sq hb_sq + have hminpoly : minpoly F z = biquadraticPrimitiveQuartic f g := + minpoly.eq_of_linearIndependent + F z (biquadraticPrimitiveQuartic_monic f g) hzRoot 4 + (biquadraticPrimitiveQuartic_degree f g) hpowers + have hzIntegral : IsIntegral F z := + ⟨biquadraticPrimitiveQuartic f g, + biquadraticPrimitiveQuartic_monic f g, hzRoot⟩ + rw [← hminpoly] + exact minpoly.irreducible hzIntegral + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean new file mode 100644 index 0000000000..11f942ffb2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean @@ -0,0 +1,257 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal + +/-! +# Connectivity of the selected split cage +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Membership in the selected split cage core. -/ +def IsInSplitCage (p : ℕ) [Fact p.Prime] + (x : NormalizedMarkoffSurface (ZMod p)) : Prop := + ∃ axis : NormalizedCoordinateAxis, + IsSplitMaximalTrace p (normalizedCoordinateAt axis x.1) + +theorem mem_normalizedFiberAt_coordinate + {R : Type*} [CommRing R] (axis : NormalizedCoordinateAxis) + (x : NormalizedMarkoffSurface R) : + x.1 ∈ normalizedFiberAt axis (normalizedCoordinateAt axis x.1) := by + cases axis <;> exact ⟨x.property, rfl⟩ + +theorem isNormalizedMarkoff_of_mem_normalizedFiberAt + {R : Type*} [CommRing R] {axis : NormalizedCoordinateAxis} {t : R} + {x : NormalizedPoint R} (hx : x ∈ normalizedFiberAt axis t) : + IsNormalizedMarkoff x := by + cases axis <;> exact hx.1 + +/-- On a split-maximal first-coordinate fiber, the normalized rotation is transitive. -/ +theorem sameNormalizedComponent_of_mem_splitMaximal_firstFiber + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpSeven : 7 ≤ p) + (t : ZMod p) (hmax : IsSplitMaximalTrace p t) + (x y : ↥(normalizedFiber1 t)) : + SameNormalizedComponent + (⟨x.1, x.property.1⟩ : NormalizedMarkoffSurface (ZMod p)) + (⟨y.1, y.property.1⟩ : NormalizedMarkoffSurface (ZMod p)) := by + have ht0 : t ≠ 0 := by + intro htZero + subst t + have hle := rotationOrder_zero_le_four p + rw [IsSplitMaximalTrace] at hmax + rw [hmax] at hle + omega + have ht : t ^ 2 ≠ 4 := by + intro htParabolic + have htCases : t = 2 ∨ t = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + t ^ 2 = 4 := htParabolic + _ = (2 : ZMod p) ^ 2 := by norm_num + rw [IsSplitMaximalTrace] at hmax + rcases htCases with rfl | rfl + · rw [rotationOrder_two] at hmax + omega + · rw [rotationOrder_neg_two p (by omega)] at hmax + omega + rcases exists_split_or_quadraticNormOneTrace p (by omega) t ht with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · have htrace0 : splitTorusTrace w ≠ 0 := by simpa [htrace] using ht0 + let xw : ↥(normalizedFiber1 (splitTorusTrace w)) := + ⟨x.1, x.property.1, by simpa [htrace] using x.property.2⟩ + let yw : ↥(normalizedFiber1 (splitTorusTrace w)) := + ⟨y.1, y.property.1, by simpa [htrace] using y.property.2⟩ + let sx := (splitFiberEquiv w hw htrace0).symm xw + let sy := (splitFiberEquiv w hw htrace0).symm yw + have hx : splitFiberPoint w sx = (x : NormalizedPoint (ZMod p)) := + congrArg Subtype.val ((splitFiberEquiv w hw htrace0).apply_symm_apply xw) + have hy : splitFiberPoint w sy = (y : NormalizedPoint (ZMod p)) := + congrArg Subtype.val ((splitFiberEquiv w hw htrace0).apply_symm_apply yw) + have horder : orderOf w = Nat.card (ZMod p)ˣ := by + have hrotation : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_splitTorusTrace w hw] + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + calc + orderOf w = rotationOrder t := hrotation.symm + _ = p - 1 := hmax + _ = Nat.card (ZMod p)ˣ := hcard.symm + have htop : Subgroup.zpowers w = ⊤ := by + apply (Subgroup.card_eq_iff_eq_top (H := Subgroup.zpowers w)).mp + rw [Nat.card_zpowers, horder] + have hmem : sx⁻¹ * sy ∈ Submonoid.powers w := by + apply mem_powers_iff_mem_zpowers.mpr + rw [htop] + exact Subgroup.mem_top _ + obtain ⟨n, hn⟩ := (Submonoid.mem_powers_iff (sx⁻¹ * sy) w).mp hmem + have hiterate : (normalizedRotate1^[n]) (x : NormalizedPoint (ZMod p)) = y := by + rw [← hx, iterate_normalizedRotate1_splitFiberPoint, hn] + simpa [mul_assoc] using hy + let xs : NormalizedMarkoffSurface (ZMod p) := ⟨x.1, x.property.1⟩ + let ys : NormalizedMarkoffSurface (ZMod p) := ⟨y.1, y.property.1⟩ + have hsurface : (normalizedRotate1Surface^[n]) xs = ys := by + apply Subtype.ext + rw [coe_iterate_normalizedRotate1Surface] + exact hiterate + change SameNormalizedComponent xs ys + rw [← hsurface] + exact sameNormalizedComponent_iterate_normalizedRotate1Surface xs n + · have hrotation : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_quadraticNormOneTrace p w hw] + have horder : orderOf w = p - 1 := by + rw [← hmax] + exact hrotation.symm + have hdvd := orderOf_dvd_natCard w + rw [quadraticNormOneTorus_natCard, horder] at hdvd + have hdvdTwo : p - 1 ∣ 2 := by + have hsub := Nat.dvd_sub hdvd (dvd_refl (p - 1)) + have heq : (p + 1) - (p - 1) = 2 := by omega + rw [heq] at hsub + exact hsub + have hle : p - 1 ≤ 2 := Nat.le_of_dvd (by norm_num) hdvdTwo + omega + +/-- Any two normalized surface points in the same split-maximal fiber, on any coordinate axis, +lie in the same Markoff component. -/ +theorem sameNormalizedComponent_of_mem_same_splitMaximalFiber + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpSeven : 7 ≤ p) + (axis : NormalizedCoordinateAxis) (t : ZMod p) (hmax : IsSplitMaximalTrace p t) + (x y : NormalizedMarkoffSurface (ZMod p)) + (hx : x.1 ∈ normalizedFiberAt axis t) + (hy : y.1 ∈ normalizedFiberAt axis t) : + SameNormalizedComponent x y := by + rcases axis with _ | _ | _ + · let xf : ↥(normalizedFiber1 t) := ⟨x.1, hx⟩ + let yf : ↥(normalizedFiber1 t) := ⟨y.1, hy⟩ + exact sameNormalizedComponent_of_mem_splitMaximal_firstFiber + p hpSeven t hmax xf yf + · let x' := normalizedSwap12Surface x + let y' := normalizedSwap12Surface y + have hxComp : SameNormalizedComponent x x' := sameNormalizedComponent_swap12Surface x + have hyComp : SameNormalizedComponent y y' := sameNormalizedComponent_swap12Surface y + let xf : ↥(normalizedFiber1 t) := ⟨x'.1, x'.property, by + simpa [x', normalizedSwap12, coe_normalizedSwap12Surface] using hx.2⟩ + let yf : ↥(normalizedFiber1 t) := ⟨y'.1, y'.property, by + simpa [y', normalizedSwap12, coe_normalizedSwap12Surface] using hy.2⟩ + have hmiddle : SameNormalizedComponent x' y' := + sameNormalizedComponent_of_mem_splitMaximal_firstFiber + p hpSeven t hmax xf yf + exact sameNormalizedComponent_trans hxComp + (sameNormalizedComponent_trans hmiddle (sameNormalizedComponent_symm hyComp)) + · let x23 := normalizedSwap23Surface x + let y23 := normalizedSwap23Surface y + let x' := normalizedSwap12Surface x23 + let y' := normalizedSwap12Surface y23 + have hx23 : SameNormalizedComponent x x23 := sameNormalizedComponent_swap23Surface x + have hy23 : SameNormalizedComponent y y23 := sameNormalizedComponent_swap23Surface y + have hx12 : SameNormalizedComponent x23 x' := sameNormalizedComponent_swap12Surface x23 + have hy12 : SameNormalizedComponent y23 y' := sameNormalizedComponent_swap12Surface y23 + let xf : ↥(normalizedFiber1 t) := ⟨x'.1, x'.property, by + simpa [x', x23, normalizedSwap12, normalizedSwap23, + coe_normalizedSwap12Surface, coe_normalizedSwap23Surface] using hx.2⟩ + let yf : ↥(normalizedFiber1 t) := ⟨y'.1, y'.property, by + simpa [y', y23, normalizedSwap12, normalizedSwap23, + coe_normalizedSwap12Surface, coe_normalizedSwap23Surface] using hy.2⟩ + have hmiddle : SameNormalizedComponent x' y' := + sameNormalizedComponent_of_mem_splitMaximal_firstFiber + p hpSeven t hmax xf yf + exact sameNormalizedComponent_trans + (sameNormalizedComponent_trans hx23 hx12) + (sameNormalizedComponent_trans hmiddle + (sameNormalizedComponent_trans + (sameNormalizedComponent_symm hy12) (sameNormalizedComponent_symm hy23))) + +private theorem three_ne_zero_zmod_of_prime_ne_three + (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq + · exact (Fact.out : p.Prime).ne_one hpOne + · exact hpThree hpEq + +/-- The selected split cage is connected for all sufficiently large primes, relative only to +the explicit cage Hasse--Weil count assumption. -/ +theorem exists_threshold_splitCage_connected + (coefficient : ℕ) (hHasse : CageWitnessPointEstimate coefficient) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + ∀ x y : NormalizedMarkoffSurface (ZMod p), + IsInSplitCage p x → IsInSplitCage p y → SameNormalizedComponent x y := by + obtain ⟨bridgeThreshold, hbridge⟩ := + exists_threshold_splitMaximalFiberBridge coefficient hHasse + refine ⟨max bridgeThreshold 7, ?_⟩ + intro p hp _ hpThree + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + intro x y hxCage hyCage + rcases hxCage with ⟨axis, hxi⟩ + rcases hyCage with ⟨other, heta⟩ + let xi := normalizedCoordinateAt axis x.1 + let eta := normalizedCoordinateAt other y.1 + obtain ⟨middle, z, hmiddleAxis, hmiddleOther, hzMax, hxMeet, hyMeet⟩ := + hbridge p ((le_max_left bridgeThreshold 7).trans hp) + axis other xi eta hxi heta + rcases hxMeet with ⟨px, hpxAxis, hpxMiddle⟩ + rcases hyMeet with ⟨py, hpyOther, hpyMiddle⟩ + let pxs : NormalizedMarkoffSurface (ZMod p) := + ⟨px, isNormalizedMarkoff_of_mem_normalizedFiberAt hpxAxis⟩ + let pys : NormalizedMarkoffSurface (ZMod p) := + ⟨py, isNormalizedMarkoff_of_mem_normalizedFiberAt hpyOther⟩ + have hxFiber : x.1 ∈ normalizedFiberAt axis xi := by + exact mem_normalizedFiberAt_coordinate axis x + have hyFiber : y.1 ∈ normalizedFiberAt other eta := by + exact mem_normalizedFiberAt_coordinate other y + have hxpx : SameNormalizedComponent x pxs := + sameNormalizedComponent_of_mem_same_splitMaximalFiber + p ((le_max_right bridgeThreshold 7).trans hp) axis xi hxi x pxs + hxFiber hpxAxis + have hpxpy : SameNormalizedComponent pxs pys := + sameNormalizedComponent_of_mem_same_splitMaximalFiber + p ((le_max_right bridgeThreshold 7).trans hp) middle z hzMax pxs pys + hpxMiddle hpyMiddle + have hypy : SameNormalizedComponent y pys := + sameNormalizedComponent_of_mem_same_splitMaximalFiber + p ((le_max_right bridgeThreshold 7).trans hp) other eta heta y pys + hyFiber hpyOther + exact sameNormalizedComponent_trans hxpx + (sameNormalizedComponent_trans hpxpy (sameNormalizedComponent_symm hypy)) + +/-- The completed endgame lands in the selected split cage core. -/ +theorem exists_threshold_largeOrder_to_splitCage + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + ∀ x : NormalizedMarkoffSurface (ZMod p), + ((p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u3) → + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + obtain ⟨threshold, hendgame⟩ := + exists_threshold_sameComponent_maximalRotation_of_some_largeCoordinate + splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ + refine ⟨threshold, ?_⟩ + intro p hp _ hpThree + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + intro x hlarge + obtain ⟨y, hxy, hyOrder⟩ := hendgame p hp hpThree x hlarge + refine ⟨y, hxy, .second, ?_⟩ + exact hyOrder + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean new file mode 100644 index 0000000000..51a7068e63 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean @@ -0,0 +1,328 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime + +/-! +# Transferring plane estimates to the cage witness count + +This file combines the geometric Hasse--Weil estimates, the explicit plane +comparison, the exact `d`-fold power-cover multiplicity, and the all-axis +equivalence. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The pulled cage radicand depends on a trace only through its square. -/ +lemma cagePulledRadicand_eq_of_sq_eq + {K : Type*} [Field K] {xi eta : K} (d : ℕ) + (h : xi ^ 2 = eta ^ 2) : + cagePulledRadicand xi d = cagePulledRadicand eta d := by + simp only [cagePulledRadicand, h] + +/-- Replacing either cage trace by another trace with the same square does +not change the pulled root-pair cover. -/ +def cagePulledRootPairEquivOfSqEq + (p : ℕ) [Fact p.Prime] (xi eta eta' : ZMod p) (d : ℕ) + (h : eta ^ 2 = eta' ^ 2) : + CagePulledRootPair p xi eta d ≃ CagePulledRootPair p xi eta' d where + toFun z := + { parameter := z.parameter + firstRoot := z.firstRoot + secondRoot := z.secondRoot + firstEquation := z.firstEquation + secondEquation := by + rw [← cagePulledRadicand_eq_of_sq_eq d h] + exact z.secondEquation } + invFun z := + { parameter := z.parameter + firstRoot := z.firstRoot + secondRoot := z.secondRoot + firstEquation := z.firstEquation + secondEquation := by + rw [cagePulledRadicand_eq_of_sq_eq d h] + exact z.secondEquation } + left_inv z := by + apply CagePulledRootPair.ext <;> rfl + right_inv z := by + apply CagePulledRootPair.ext <;> rfl + +lemma natCard_cagePulledRootPair_eq_of_sq_eq + (p : ℕ) [Fact p.Prime] (xi eta eta' : ZMod p) (d : ℕ) + (h : eta ^ 2 = eta' ^ 2) : + Nat.card (CagePulledRootPair p xi eta d) = + Nat.card (CagePulledRootPair p xi eta' d) := by + exact Nat.card_congr (cagePulledRootPairEquivOfSqEq p xi eta eta' d h) + +/-- The diagonal plane estimate gives the canonical cage range estimate with +the correct geometric multiplicity two. -/ +lemma canonicalDiagonalCageRangeEstimate + (planeCoefficient : ℕ) (hPlane : CagePlanePointEstimate planeCoefficient) + (p : ℕ) [Fact p.Prime] (hpSeven : 7 ≤ p) + (xi : ZMod p) (hxi : IsSplitMaximalTrace p xi) + (d : ℕ) (hd : d ∣ Nat.card (ZMod p)ˣ) (hdPositive : 0 < d) : + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi xi d) : ℝ) - + (2 : ℝ) * p / d| ≤ + ((2 * planeCoefficient + 8 : ℕ) : ℝ) * Real.sqrt p := by + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hdPred : d ∣ p - 1 := by + rw [← hcard] + exact hd + have hpTwo : p ≠ 2 := by omega + have hXi := sub_ne_zero.mpr (splitMaximalTrace_sq_ne_four p hpSeven xi hxi) + have hcomparisonInt := cagePulledRootPair_diagonal_card_comparison + p hpTwo xi hdPositive hXi + have hcomparison : + |(Nat.card (CagePulledRootPair p xi xi d) : ℝ) - + 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card| ≤ + (4 * d + 4 : ℕ) := by + exact_mod_cast hcomparisonInt + have hHasse := (hPlane p hpSeven xi xi hxi hxi d hdPred hdPositive).1 + have hsqrt : (1 : ℝ) ≤ Real.sqrt p := by + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hsquare := Real.sq_sqrt hpNonnegative + have hsqrtNonnegative := Real.sqrt_nonneg (p : ℝ) + have hpSevenReal : (7 : ℝ) ≤ p := by exact_mod_cast hpSeven + nlinarith + have hdOne : (1 : ℝ) ≤ d := by exact_mod_cast hdPositive + have hexception : ((4 * d + 4 : ℕ) : ℝ) ≤ + 8 * Real.sqrt p * d := by + push_cast + nlinarith + have hcoverError : + |(Nat.card (CagePulledRootPair p xi xi d) : ℝ) - (2 : ℝ) * p| ≤ + (((2 * planeCoefficient + 8 : ℕ) : ℝ) * Real.sqrt p) * d := by + let planeCard := (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card + calc + |(Nat.card (CagePulledRootPair p xi xi d) : ℝ) - (2 : ℝ) * p| = + |((Nat.card (CagePulledRootPair p xi xi d) : ℝ) - + 2 * planeCard) + 2 * ((planeCard : ℝ) - p)| := by + congr 1 + ring + _ ≤ |(Nat.card (CagePulledRootPair p xi xi d) : ℝ) - + 2 * planeCard| + |2 * ((planeCard : ℝ) - p)| := abs_add_le _ _ + _ = |(Nat.card (CagePulledRootPair p xi xi d) : ℝ) - + 2 * planeCard| + 2 * |(planeCard : ℝ) - p| := by + rw [abs_mul] + norm_num + _ ≤ ((4 * d + 4 : ℕ) : ℝ) + + 2 * ((planeCoefficient : ℝ) * Real.sqrt p * d) := by + gcongr + _ ≤ 8 * Real.sqrt p * d + + 2 * ((planeCoefficient : ℝ) * Real.sqrt p * d) := by + gcongr + _ = (((2 * planeCoefficient + 8 : ℕ) : ℝ) * Real.sqrt p) * d := by + push_cast + ring + apply range_count_error_of_exact_cover hdPositive + (natCard_cagePulledRootPair_eq_mul_canonicalPowerRange + p hpTwo xi xi d hdPred) + simpa only [Nat.cast_ofNat] using hcoverError + +/-- When the two cage traces have the same square, their pulled radicands +coincide and the diagonal multiplicity-two estimate applies unchanged. -/ +lemma canonicalEqualSquareCageRangeEstimate + (planeCoefficient : ℕ) (hPlane : CagePlanePointEstimate planeCoefficient) + (p : ℕ) [Fact p.Prime] (hpSeven : 7 ≤ p) + (xi eta : ZMod p) + (hxi : IsSplitMaximalTrace p xi) + (hsquare : xi ^ 2 = eta ^ 2) + (d : ℕ) (hd : d ∣ Nat.card (ZMod p)ˣ) (hdPositive : 0 < d) : + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) : ℝ) - + (2 : ℝ) * p / d| ≤ + ((2 * planeCoefficient + 8 : ℕ) : ℝ) * Real.sqrt p := by + have hpTwo : p ≠ 2 := by omega + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hdPred : d ∣ p - 1 := by + rw [← hcard] + exact hd + have hpulled : + Nat.card (CagePulledRootPair p xi eta d) = + Nat.card (CagePulledRootPair p xi xi d) := + natCard_cagePulledRootPair_eq_of_sq_eq p xi eta xi d hsquare.symm + have hcoverEta := natCard_cagePulledRootPair_eq_mul_canonicalPowerRange + p hpTwo xi eta d hdPred + have hcoverXi := natCard_cagePulledRootPair_eq_mul_canonicalPowerRange + p hpTwo xi xi d hdPred + have hrange : + Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) = + Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi xi d) := by + rw [hpulled] at hcoverEta + rw [hcoverXi] at hcoverEta + exact Nat.eq_of_mul_eq_mul_left hdPositive hcoverEta.symm + rw [hrange] + exact canonicalDiagonalCageRangeEstimate planeCoefficient hPlane p hpSeven + xi hxi d hd hdPositive + +/-- Away from the equal-square diagonal, the primitive quartic plane model +has the same main term as the pulled root-pair cover, up to its explicitly +bounded exceptional fibers. -/ +lemma canonicalOffDiagonalCageRangeEstimate + (planeCoefficient : ℕ) (hPlane : CagePlanePointEstimate planeCoefficient) + (p : ℕ) [Fact p.Prime] (hpSeven : 7 ≤ p) + (xi eta : ZMod p) + (hxi : IsSplitMaximalTrace p xi) + (heta : IsSplitMaximalTrace p eta) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) + (d : ℕ) (hd : d ∣ Nat.card (ZMod p)ˣ) (hdPositive : 0 < d) : + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) : ℝ) - + (p : ℝ) / d| ≤ + ((planeCoefficient + 10 : ℕ) : ℝ) * Real.sqrt p := by + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hdPred : d ∣ p - 1 := by + rw [← hcard] + exact hd + have hpTwo : p ≠ 2 := by omega + have hcomparisonInt := cagePulledRootPair_offDiagonal_card_comparison + p hpTwo xi eta hdPositive hoffDiagonal + have hcomparison : + |(Nat.card (CagePulledRootPair p xi eta d) : ℝ) - + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card| ≤ + (6 * d + 4 : ℕ) := by + exact_mod_cast hcomparisonInt + have hHasse := + (hPlane p hpSeven xi eta hxi heta d hdPred hdPositive).2 hoffDiagonal + have hsqrt : (1 : ℝ) ≤ Real.sqrt p := by + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hsquare := Real.sq_sqrt hpNonnegative + have hsqrtNonnegative := Real.sqrt_nonneg (p : ℝ) + have hpSevenReal : (7 : ℝ) ≤ p := by exact_mod_cast hpSeven + nlinarith + have hdOne : (1 : ℝ) ≤ d := by exact_mod_cast hdPositive + have hexception : ((6 * d + 4 : ℕ) : ℝ) ≤ + 10 * Real.sqrt p * d := by + push_cast + nlinarith + have hcoverError : + |(Nat.card (CagePulledRootPair p xi eta d) : ℝ) - (p : ℝ)| ≤ + (((planeCoefficient + 10 : ℕ) : ℝ) * Real.sqrt p) * d := by + let planeCard := (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card + calc + |(Nat.card (CagePulledRootPair p xi eta d) : ℝ) - (p : ℝ)| = + |((Nat.card (CagePulledRootPair p xi eta d) : ℝ) - planeCard) + + ((planeCard : ℝ) - p)| := by + congr 1 + ring + _ ≤ |(Nat.card (CagePulledRootPair p xi eta d) : ℝ) - planeCard| + + |((planeCard : ℝ) - p)| := abs_add_le _ _ + _ ≤ ((6 * d + 4 : ℕ) : ℝ) + + ((planeCoefficient : ℝ) * Real.sqrt p * d) := by + gcongr + _ ≤ 10 * Real.sqrt p * d + + ((planeCoefficient : ℝ) * Real.sqrt p * d) := by + gcongr + _ = (((planeCoefficient + 10 : ℕ) : ℝ) * Real.sqrt p) * d := by + push_cast + ring + have hrange := range_count_error_of_exact_cover + (coverCard := Nat.card (CagePulledRootPair p xi eta d)) + (rangeCard := Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d)) + (p := p) (d := d) (multiplicity := 1) + (error := ((planeCoefficient + 10 : ℕ) : ℝ) * Real.sqrt p) + hdPositive + (natCard_cagePulledRootPair_eq_mul_canonicalPowerRange + p hpTwo xi eta d hdPred) + (by simpa only [Nat.cast_one, one_mul] using hcoverError) + simpa only [Nat.cast_one, one_mul] using hrange + +/-- A fixed cage-plane estimate supplies the corresponding fixed witness +estimate. The proof chooses the geometric multiplicity only after splitting +the genuine equal-square and off-diagonal cases. -/ +theorem cageWitnessPointEstimate_of_cagePlanePointEstimate + (planeCoefficient : ℕ) (hPlane : CagePlanePointEstimate planeCoefficient) : + CageWitnessPointEstimate (100000 + 2 * planeCoefficient + 10) := by + let coefficient := 100000 + 2 * planeCoefficient + 10 + change CageWitnessPointEstimate coefficient + intro p _ hpFive axis other xi eta hxi heta + by_cases hpIsFive : p = 5 + · subst p + obtain ⟨multiplicity, hmultiplicity, hestimate⟩ := + cageWitnessPointEstimate_five axis other xi eta hxi heta + refine ⟨multiplicity, hmultiplicity, ?_⟩ + intro d hd hdPositive + calc + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + 5 axis other xi eta d) : ℝ) - + (multiplicity : ℝ) * (5 : ℝ) / d| ≤ + (100000 : ℝ) * Real.sqrt 5 := hestimate d hd hdPositive + _ ≤ (coefficient : ℝ) * Real.sqrt 5 := by + have hsqrtNonnegative : (0 : ℝ) ≤ Real.sqrt 5 := Real.sqrt_nonneg 5 + dsimp [coefficient] + push_cast + nlinarith + · have hpNotSix : p ≠ 6 := by + intro hpSix + subst p + have hprime : Nat.Prime 6 := Fact.out + norm_num at hprime + have hpSeven : 7 ≤ p := by omega + by_cases hsquare : xi ^ 2 = eta ^ 2 + · refine ⟨2, by norm_num, ?_⟩ + intro d hd hdPositive + rw [natCard_cageMiddleWitnessPowerRangeSolutions_eq_canonical + p axis other xi eta d] + calc + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) : ℝ) - + (2 : ℝ) * p / d| ≤ + ((2 * planeCoefficient + 8 : ℕ) : ℝ) * Real.sqrt p := + canonicalEqualSquareCageRangeEstimate planeCoefficient hPlane + p hpSeven xi eta hxi hsquare d hd hdPositive + _ ≤ (coefficient : ℝ) * Real.sqrt p := by + have hsqrtNonnegative : (0 : ℝ) ≤ Real.sqrt p := Real.sqrt_nonneg p + dsimp [coefficient] + push_cast + nlinarith + + · refine ⟨1, by norm_num, ?_⟩ + intro d hd hdPositive + rw [natCard_cageMiddleWitnessPowerRangeSolutions_eq_canonical + p axis other xi eta d] + norm_num only [Nat.cast_one, one_mul] + calc + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) : ℝ) - + (p : ℝ) / d| ≤ + ((planeCoefficient + 10 : ℕ) : ℝ) * Real.sqrt p := + canonicalOffDiagonalCageRangeEstimate planeCoefficient hPlane + p hpSeven xi eta hxi heta hsquare d hd hdPositive + _ ≤ (coefficient : ℝ) * Real.sqrt p := by + have hsqrtNonnegative : (0 : ℝ) ≤ Real.sqrt p := Real.sqrt_nonneg p + have hplaneNonnegative : (0 : ℝ) ≤ planeCoefficient := by positivity + dsimp [coefficient] + push_cast + nlinarith + +/-- The single allowed general affine Hasse--Weil theorem supplies the full +cage witness estimate. -/ +theorem exists_cageWitnessPointEstimate_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + ∃ coefficient : ℕ, 0 < coefficient ∧ CageWitnessPointEstimate coefficient := by + obtain ⟨planeCoefficient, _hplanePositive, hPlane⟩ := + exists_cagePlanePointEstimate_of_generalHasseWeil hHasse + exact ⟨100000 + 2 * planeCoefficient + 10, by omega, + cageWitnessPointEstimate_of_cagePlanePointEstimate planeCoefficient hPlane⟩ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean new file mode 100644 index 0000000000..e489aa764b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean @@ -0,0 +1,271 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph + +/-! +# Explicit Hasse--Weil interface for the cage + +The external input is a point-count estimate on the actual finite set used by the cage +inclusion--exclusion. Connectivity and primitive extraction are not assumed here. +-/ + +namespace BGS.Markoff + +open Filter +open scoped ArithmeticFunction.Moebius BigOperators + +noncomputable section + +/-- The selected cage core consists of split-maximal normalized traces. This is sufficient for +Theorem 1 because the endgame constructed in this repository always reaches order `p - 1`. -/ +def IsSplitMaximalTrace (p : ℕ) [Fact p.Prime] (t : ZMod p) : Prop := + rotationOrder t = p - 1 + +/-- Choose an axis different from both prescribed axes. -/ +def cageBridgeAxis : NormalizedCoordinateAxis → NormalizedCoordinateAxis → + NormalizedCoordinateAxis + | .first, .first => .second + | .first, .second => .third + | .first, .third => .second + | .second, .first => .third + | .second, .second => .first + | .second, .third => .first + | .third, .first => .second + | .third, .second => .first + | .third, .third => .first + +theorem cageBridgeAxis_ne_left (axis other : NormalizedCoordinateAxis) : + cageBridgeAxis axis other ≠ axis := by + cases axis <;> cases other <;> decide + +theorem cageBridgeAxis_ne_right (axis other : NormalizedCoordinateAxis) : + cageBridgeAxis axis other ≠ other := by + cases axis <;> cases other <;> decide + +/-- Coordinate selected by an axis label. -/ +def normalizedCoordinateAt (axis : NormalizedCoordinateAxis) {R : Type*} + (x : NormalizedPoint R) : R := + match axis with + | .first => x.u1 + | .second => x.u2 + | .third => x.u3 + +theorem mem_normalizedFiberAt_iff + {R : Type*} [CommRing R] {axis : NormalizedCoordinateAxis} + {t : R} {x : NormalizedPoint R} : + x ∈ normalizedFiberAt axis t ↔ + IsNormalizedMarkoff x ∧ normalizedCoordinateAt axis x = t := by + cases axis <;> rfl + +/-- The concrete incidence condition counted by the cage fiber-product curve. -/ +def CageMiddleTraceRelation + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) + (u : (ZMod p)ˣ) : Prop := + NormalizedFibersMeet + (normalizedFiberAt axis xi) + (normalizedFiberAt (cageBridgeAxis axis other) (splitTorusTrace u)) ∧ + NormalizedFibersMeet + (normalizedFiberAt other eta) + (normalizedFiberAt (cageBridgeAxis axis other) (splitTorusTrace u)) + +/-- A pair of actual intersection witnesses over a common middle trace. -/ +def CageMiddleWitnessPair + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) := + {z : NormalizedPoint (ZMod p) × NormalizedPoint (ZMod p) // + z.1 ∈ normalizedFiberAt axis xi ∧ + z.2 ∈ normalizedFiberAt other eta ∧ + normalizedCoordinateAt (cageBridgeAxis axis other) z.1 = + normalizedCoordinateAt (cageBridgeAxis axis other) z.2} + +/-- The common middle coordinate of a witness pair. -/ +def cageMiddleWitnessTrace + {p : ℕ} [Fact p.Prime] + {axis other : NormalizedCoordinateAxis} {xi eta : ZMod p} + (z : CageMiddleWitnessPair p axis other xi eta) : ZMod p := + normalizedCoordinateAt (cageBridgeAxis axis other) z.1.1 + +/-- Witness-bearing solutions with the middle unit restricted to a power-map image. -/ +abbrev cageMiddleWitnessPowerRangeSolutions + (p : ℕ) [Fact p.Prime] + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) (d : ℕ) := + BGS.rightPowerTraceRangeSolutions + (cageMiddleWitnessTrace (p := p) (axis := axis) (other := other) + (xi := xi) (eta := eta)) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d + +/-- Witness-bearing cage point-count target with the geometric component +multiplicity exposed. The generic fiber product has multiplicity one, while +the diagonal degeneration can have a larger main term. Requiring a single +positive multiplicity for all divisor ranges is exactly what Möbius inversion +needs; fixing it silently to one would make this statement false. + +This is not an allowed external assumption: it must ultimately be derived +from the one general Hasse--Weil theorem. -/ +def CageWitnessPointEstimate (coefficient : ℕ) : Prop := + ∀ (p : ℕ) [Fact p.Prime], 5 ≤ p → + ∀ (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p), + IsSplitMaximalTrace p xi → IsSplitMaximalTrace p eta → + ∃ multiplicity : ℕ, 0 < multiplicity ∧ + ∀ d : ℕ, d ∣ Nat.card (ZMod p)ˣ → 0 < d → + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + p axis other xi eta d) : ℝ) - + (multiplicity : ℝ) * (p : ℝ) / d| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) + +/-- The Hasse--Weil range estimates imply a primitive middle unit once the explicit divisor +error is smaller than the Möbius main term. -/ +theorem exists_primitive_cageMiddleUnit_of_explicitInequality + (coefficient : ℕ) (hHasse : CageWitnessPointEstimate coefficient) + (p : ℕ) [Fact p.Prime] (hpFive : 5 ≤ p) + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) + (hxi : IsSplitMaximalTrace p xi) (heta : IsSplitMaximalTrace p eta) + (hexplicit : + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p) : + ∃ u : (ZMod p)ˣ, + CageMiddleTraceRelation p axis other xi eta u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + let leftTrace : CageMiddleWitnessPair p axis other xi eta → ZMod p := + cageMiddleWitnessTrace + let rightTrace : (ZMod p)ˣ → ZMod p := splitTorusTrace + obtain ⟨multiplicity, hmultiplicity, hEstimate⟩ := + hHasse p hpFive axis other xi eta hxi heta + have hRange : ∀ d : ℕ, d ∣ Nat.card (ZMod p)ˣ → 0 < d → + |(Nat.card (BGS.rightPowerTraceRangeSolutions + leftTrace rightTrace d) : ℝ) - + (multiplicity : ℝ) * (p : ℝ) / d| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) := by + intro d hdvd hd + simpa [leftTrace, rightTrace, cageMiddleWitnessPowerRangeSolutions] using + hEstimate d hdvd hd + have hpositive := + divisorsError_lt_primitiveTraceMoebiusMainTerm_of_explicitInequality + (Nat.card (ZMod p)ˣ) p 1 coefficient Nat.card_pos (by norm_num) (by + simpa using hexplicit) + letI : Finite (CageMiddleWitnessPair p axis other xi eta) := + Finite.of_injective Subtype.val Subtype.val_injective + obtain ⟨z, hz⟩ := + BGS.rightTraceExactOrderSolutions_nonempty_of_divisorsError_lt_moebiusMain + leftTrace rightTrace (fun d => (multiplicity : ℝ) * (p : ℝ) / d) + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) hRange (by + have hmainPositive : + 0 < primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p 1 := + lt_of_le_of_lt (by positivity) hpositive + have hmultiplicityReal : (1 : ℝ) ≤ multiplicity := by + exact_mod_cast hmultiplicity + have hscale : + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p 1 ≤ + (multiplicity : ℝ) * + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p 1 := by + nlinarith + calc + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p 1 := hpositive + _ ≤ (multiplicity : ℝ) * + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p 1 := hscale + _ = ∑ x ∈ (Nat.card (ZMod p)ˣ).divisorsAntidiagonal, + (μ x.fst : ℝ) * + ((multiplicity : ℝ) * (p : ℝ) / x.fst) := by + simp only [primitiveTraceMoebiusMainTerm] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro x hx + ring) + rcases z with ⟨w, u⟩ + have hz' := (BGS.mem_rightTraceExactOrderSolutions_iff + leftTrace rightTrace (Nat.card (ZMod p)ˣ) (w, u)).mp hz + refine ⟨u, ?_, hz'.2⟩ + rcases w with ⟨⟨firstPoint, secondPoint⟩, hfirst, hsecond, hcommon⟩ + let middle := cageBridgeAxis axis other + have htrace : normalizedCoordinateAt middle firstPoint = splitTorusTrace u := by + simpa [leftTrace, rightTrace, cageMiddleWitnessTrace, middle] using hz'.1 + have hfirstSurface : IsNormalizedMarkoff firstPoint := by + cases axis <;> exact hfirst.1 + have hsecondSurface : IsNormalizedMarkoff secondPoint := by + cases other <;> exact hsecond.1 + have hfirstMiddle : firstPoint ∈ normalizedFiberAt middle (splitTorusTrace u) := by + exact mem_normalizedFiberAt_iff.mpr ⟨hfirstSurface, htrace⟩ + have hsecondTrace : normalizedCoordinateAt middle secondPoint = splitTorusTrace u := + hcommon.symm.trans htrace + have hsecondMiddle : secondPoint ∈ normalizedFiberAt middle (splitTorusTrace u) := by + exact mem_normalizedFiberAt_iff.mpr ⟨hsecondSurface, hsecondTrace⟩ + exact ⟨⟨firstPoint, hfirst, hfirstMiddle⟩, + ⟨secondPoint, hsecond, hsecondMiddle⟩⟩ + +/-- Uniform large-prime form of the primitive cage bridge. -/ +theorem exists_threshold_primitive_cageMiddleUnit + (coefficient : ℕ) (hHasse : CageWitnessPointEstimate coefficient) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p), + IsSplitMaximalTrace p xi → IsSplitMaximalTrace p eta → + ∃ u : (ZMod p)ˣ, + CageMiddleTraceRelation p axis other xi eta u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_endgamePrimitiveTrace_explicitInequality coefficient + (show (0 : ℝ) < 1 / 4 by norm_num) + refine ⟨max threshold 5, ?_⟩ + intro p hp _ axis other xi eta hxi heta + have hpThreshold : threshold ≤ p := (le_max_left threshold 5).trans hp + have hpOne : 1 ≤ p := by omega + have hpOneReal : (1 : ℝ) ≤ (p : ℝ) := by exact_mod_cast hpOne + have honeLe : ((1 : ℕ) : ℝ) ≤ (p : ℝ) ^ ((1 : ℝ) / 2 - 1 / 4) := by + simpa using (Real.one_le_rpow hpOneReal (show (0 : ℝ) ≤ 1 / 2 - 1 / 4 by norm_num)) + have hexplicit := hthreshold p hpThreshold 1 honeLe + apply exists_primitive_cageMiddleUnit_of_explicitInequality + coefficient hHasse p (by omega) axis other xi eta hxi heta + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + rw [hcard] + simpa only [Nat.cast_one, one_mul] using hexplicit + +/-- The primitive-incidence bridge derived from the Hasse--Weil count and Möbius inversion. -/ +theorem exists_threshold_splitMaximalFiberBridge + (coefficient : ℕ) (hHasse : CageWitnessPointEstimate coefficient) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p), + IsSplitMaximalTrace p xi → IsSplitMaximalTrace p eta → + ∃ middle : NormalizedCoordinateAxis, ∃ y : ZMod p, + middle ≠ axis ∧ middle ≠ other ∧ IsSplitMaximalTrace p y ∧ + NormalizedFibersMeet + (normalizedFiberAt axis xi) (normalizedFiberAt middle y) ∧ + NormalizedFibersMeet + (normalizedFiberAt other eta) (normalizedFiberAt middle y) := by + obtain ⟨threshold, hprimitive⟩ := + exists_threshold_primitive_cageMiddleUnit coefficient hHasse + refine ⟨max threshold 5, ?_⟩ + intro p hp _ axis other xi eta hxi heta + obtain ⟨u, huRelation, huOrder⟩ := + hprimitive p ((le_max_left threshold 5).trans hp) axis other xi eta hxi heta + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huPower + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huPower + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + have hpFive : 5 ≤ p := (le_max_right threshold 5).trans hp + omega + refine ⟨cageBridgeAxis axis other, splitTorusTrace u, + cageBridgeAxis_ne_left axis other, cageBridgeAxis_ne_right axis other, ?_, + huRelation.1, huRelation.2⟩ + rw [IsSplitMaximalTrace, rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean new file mode 100644 index 0000000000..2345bf135e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization + +/-! +# Geometry of the normalized cage incidence curve + +The cage uses normalized trace coordinates, whereas the incidence geometry +already proved in `IncidenceCoordinateRing` uses the paper's original Markoff +coordinates. This file supplies the missing exact scaling bridge. Dividing +the trace, common coordinate, and both retained roots by three identifies the +two pairs of quadratic equations. + +The off-diagonal geometric-integrality theorem below therefore reuses the +existing biquadratic coordinate-ring proof. It does not assert geometric +integrality of the subsequent power-trace pullback; that is the next Kummer +obligation in the cage Hasse--Weil argument. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The two retained incidence equations in normalized trace coordinates. -/ +def NormalizedIncidenceAux (xi eta middle firstRoot secondRoot : K) : Prop := + (xi ^ 2 - 4) * middle ^ 2 - firstRoot ^ 2 = 4 * xi ^ 2 ∧ + (eta ^ 2 - 4) * middle ^ 2 - secondRoot ^ 2 = 4 * eta ^ 2 + +/-- A witness-bearing point of the original-coordinate incidence auxiliary curve. -/ +structure IncidenceAuxEquationWitness (K : Type*) [Field K] (a b : K) where + /-- The common original-coordinate incidence parameter. -/ + middle : K + /-- The retained root for the first quadratic equation. -/ + firstRoot : K + /-- The retained root for the second quadratic equation. -/ + secondRoot : K + /-- Both original-coordinate incidence equations. -/ + equations : IncidenceAux a b middle firstRoot secondRoot + +@[ext] +theorem IncidenceAuxEquationWitness.ext + {a b : K} {x y : IncidenceAuxEquationWitness K a b} + (hmiddle : x.middle = y.middle) + (hfirst : x.firstRoot = y.firstRoot) + (hsecond : x.secondRoot = y.secondRoot) : x = y := by + cases x + cases y + simp_all + +/-- Dividing all five normalized coordinates by three gives exactly the +original-coordinate incidence equations. -/ +theorem normalizedIncidenceAux_iff_incidenceAux_div_three + (h3 : (3 : K) ≠ 0) (xi eta middle firstRoot secondRoot : K) : + NormalizedIncidenceAux xi eta middle firstRoot secondRoot ↔ + IncidenceAux (xi / 3) (eta / 3) (middle / 3) + (firstRoot / 3) (secondRoot / 3) := by + have scaledEquation (trace root : K) : + (trace ^ 2 - 4) * middle ^ 2 - root ^ 2 = 4 * trace ^ 2 ↔ + (9 * (trace / 3) ^ 2 - 4) * (middle / 3) ^ 2 - (root / 3) ^ 2 = + 4 * (trace / 3) ^ 2 := by + let originalResidual := + (trace ^ 2 - 4) * middle ^ 2 - root ^ 2 - 4 * trace ^ 2 + let scaledResidual := + (9 * (trace / 3) ^ 2 - 4) * (middle / 3) ^ 2 - (root / 3) ^ 2 - + 4 * (trace / 3) ^ 2 + have hscale : (9 : K) * scaledResidual = originalResidual := by + dsimp [scaledResidual, originalResidual] + field_simp [h3] + ring + have h9 : (9 : K) ≠ 0 := by + convert mul_ne_zero h3 h3 using 1 + norm_num + constructor + · intro h + have hOriginal : originalResidual = 0 := by + dsimp [originalResidual] + exact sub_eq_zero.mpr h + have hScaled : scaledResidual = 0 := by + apply (mul_eq_zero.mp (hscale.trans hOriginal)).resolve_left h9 + dsimp [scaledResidual] at hScaled + exact sub_eq_zero.mp hScaled + · intro h + have hScaled : scaledResidual = 0 := by + dsimp [scaledResidual] + exact sub_eq_zero.mpr h + have hOriginal : originalResidual = 0 := by + rw [← hscale, hScaled, mul_zero] + dsimp [originalResidual] at hOriginal + exact sub_eq_zero.mp hOriginal + constructor + · rintro ⟨hfirst, hsecond⟩ + exact ⟨(scaledEquation xi firstRoot).mp hfirst, + (scaledEquation eta secondRoot).mp hsecond⟩ + · rintro ⟨hfirst, hsecond⟩ + exact ⟨(scaledEquation xi firstRoot).mpr hfirst, + (scaledEquation eta secondRoot).mpr hsecond⟩ + +/-- The normalized nondegeneracy conditions imply geometric integrality of +the proved original-coordinate model. -/ +theorem normalizedIncidenceAuxGeometricallyIntegral_of_nondegenerate + (h2 : (2 : K) ≠ 0) (h3 : (3 : K) ≠ 0) {xi eta : K} + (hxi : xi ≠ 0) (heta : eta ≠ 0) + (hXi : xi ^ 2 - 4 ≠ 0) (hEta : eta ^ 2 - 4 ≠ 0) + (hneq : xi ^ 2 ≠ eta ^ 2) : + IncidenceAuxGeometricallyIntegral (xi / 3) (eta / 3) := by + apply incidenceAuxGeometricallyIntegral_of_nondegenerate h2 + · exact div_ne_zero hxi h3 + · exact div_ne_zero heta h3 + · have heq : 9 * (xi / 3) ^ 2 - 4 = xi ^ 2 - 4 := by + field_simp [h3] + ring + rw [heq] + exact hXi + · have heq : 9 * (eta / 3) ^ 2 - 4 = eta ^ 2 - 4 := by + field_simp [h3] + ring + rw [heq] + exact hEta + · intro h + apply hneq + calc + xi ^ 2 = 9 * (xi / 3) ^ 2 := by field_simp [h3]; ring + _ = 9 * (eta / 3) ^ 2 := by rw [h] + _ = eta ^ 2 := by field_simp [h3]; ring + +/-- The original-coordinate coordinate-ring model of the normalized cage +incidence curve. The accompanying point equivalence below records the +coordinate scaling, rather than identifying the two coordinate systems. -/ +abbrev NormalizedCageIncidenceCoordinateRing + (K : Type*) [Field K] (xi eta : K) := + IncidenceAuxCoordinateRing K (xi / 3) (eta / 3) + +/-- Geometric integrality of the normalized incidence curve through its +explicit original-coordinate model. -/ +def NormalizedCageIncidenceGeometricallyIntegral + {K : Type*} [Field K] (xi eta : K) : Prop := + IncidenceAuxGeometricallyIntegral (xi / 3) (eta / 3) + +/-- A split-maximal cage trace is nonzero for the primes used by the cage. -/ +theorem splitMaximalTrace_ne_zero + (p : Nat) [Fact p.Prime] (hpSeven : 7 ≤ p) (t : ZMod p) + (hmax : IsSplitMaximalTrace p t) : t ≠ 0 := by + intro ht + subst t + have hle := rotationOrder_zero_le_four p + rw [IsSplitMaximalTrace] at hmax + rw [hmax] at hle + omega + +/-- A split-maximal cage trace is not parabolic. -/ +theorem splitMaximalTrace_sq_ne_four + (p : Nat) [Fact p.Prime] (hpSeven : 7 ≤ p) (t : ZMod p) + (hmax : IsSplitMaximalTrace p t) : t ^ 2 ≠ 4 := by + intro ht + have htCases : t = 2 ∨ t = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + t ^ 2 = 4 := ht + _ = (2 : ZMod p) ^ 2 := by norm_num + rw [IsSplitMaximalTrace] at hmax + rcases htCases with rfl | rfl + · rw [rotationOrder_two] at hmax + omega + · rw [rotationOrder_neg_two p (by omega)] at hmax + omega + +/-- The off-diagonal base incidence curve occurring in the cage is +geometrically integral under the cage's actual split-maximal hypotheses. -/ +theorem normalizedCageIncidence_offDiagonal_geometricallyIntegral + (p : Nat) [Fact p.Prime] (hpSeven : 7 ≤ p) (xi eta : ZMod p) + (hxi : IsSplitMaximalTrace p xi) (heta : IsSplitMaximalTrace p eta) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) : + NormalizedCageIncidenceGeometricallyIntegral xi eta := by + apply normalizedIncidenceAuxGeometricallyIntegral_of_nondegenerate + · exact natCast_ne_zero_zmod_of_pos_of_lt (n := 2) (p := p) (by norm_num) (by omega) + · exact natCast_ne_zero_zmod_of_pos_of_lt (n := 3) (p := p) (by norm_num) (by omega) + · exact splitMaximalTrace_ne_zero p hpSeven xi hxi + · exact splitMaximalTrace_ne_zero p hpSeven eta heta + · exact sub_ne_zero.mpr (splitMaximalTrace_sq_ne_four p hpSeven xi hxi) + · exact sub_ne_zero.mpr (splitMaximalTrace_sq_ne_four p hpSeven eta heta) + · exact hoffDiagonal + +/-- Witness-preserving equivalence between the normalized cage equations and +the original-coordinate incidence equations. -/ +def cageIncidenceEquationWitnessScaleEquiv + {p : Nat} [Fact p.Prime] (h3 : (3 : ZMod p) ≠ 0) (xi eta : ZMod p) : + CageIncidenceEquationWitness p xi eta ≃ + IncidenceAuxEquationWitness (ZMod p) (xi / 3) (eta / 3) where + toFun z := + { middle := z.middle / 3 + firstRoot := z.firstRoot / 3 + secondRoot := z.secondRoot / 3 + equations := + (normalizedIncidenceAux_iff_incidenceAux_div_three h3 xi eta + z.middle z.firstRoot z.secondRoot).mp ⟨z.firstEquation, z.secondEquation⟩ } + invFun z := + { middle := 3 * z.middle + firstRoot := 3 * z.firstRoot + secondRoot := 3 * z.secondRoot + firstEquation := by + have hscaled : + IncidenceAux (xi / 3) (eta / 3) ((3 * z.middle) / 3) + ((3 * z.firstRoot) / 3) ((3 * z.secondRoot) / 3) := by + simpa [h3] using z.equations + exact ((normalizedIncidenceAux_iff_incidenceAux_div_three h3 xi eta + (3 * z.middle) (3 * z.firstRoot) (3 * z.secondRoot)).mpr hscaled).1 + secondEquation := by + have hscaled : + IncidenceAux (xi / 3) (eta / 3) ((3 * z.middle) / 3) + ((3 * z.firstRoot) / 3) ((3 * z.secondRoot) / 3) := by + simpa [h3] using z.equations + exact ((normalizedIncidenceAux_iff_incidenceAux_div_three h3 xi eta + (3 * z.middle) (3 * z.firstRoot) (3 * z.secondRoot)).mpr hscaled).2 } + left_inv z := by + apply CageIncidenceEquationWitness.ext <;> field_simp [h3] + right_inv z := by + apply IncidenceAuxEquationWitness.ext <;> simp [h3] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean new file mode 100644 index 0000000000..91606352db --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean @@ -0,0 +1,763 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover + +/-! +# Comparing the pulled cage cover with its affine plane models + +The plane models retain the power parameter `t`, whereas the pulled cover +requires `t ≠ 0`. On the diagonal the plane model also forgets the choice +between the two equal radicand roots. This file isolates those two losses +and bounds them by the roots of explicit univariate polynomials. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +/-- A finite-field polynomial has at most its degree many distinct roots. -/ +private lemma natCard_eval_eq_zero_le_natDegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : K[X]) (hf : f ≠ 0) : + Nat.card {x : K // f.eval x = 0} <= f.natDegree := by + classical + let rootEmbedding : {x : K // f.eval x = 0} ↪ f.roots.toFinset := + { toFun := fun x => ⟨x, by + rw [Multiset.mem_toFinset, Polynomial.mem_roots hf] + exact x.2⟩ + inj' := by + intro x y h + apply Subtype.ext + exact congrArg (fun z : f.roots.toFinset => (z : K)) h } + letI : Fintype {x : K // f.eval x = 0} := Fintype.ofFinite _ + calc + Nat.card {x : K // f.eval x = 0} <= f.roots.toFinset.card := by + simpa only [Nat.card_eq_fintype_card, Fintype.card_coe] using + Fintype.card_le_of_injective rootEmbedding rootEmbedding.injective + _ <= f.roots.card := Multiset.toFinset_card_le _ + _ <= f.natDegree := Polynomial.card_roots' f + +/-- The pulled radicand has degree at most `4d`. -/ +lemma cagePulledRadicand_natDegree_le (K : Type*) [Field K] + (xi : K) (d : Nat) : + (cagePulledRadicand xi d).natDegree <= 4 * d := by + rw [cagePulledRadicand_expanded] + refine (natDegree_add_le _ _).trans (max_le ?_ ?_) + · refine (natDegree_sub_le _ _).trans (max_le ?_ ?_) + · exact natDegree_C_mul_X_pow_le _ _ + · exact (natDegree_C_mul_X_pow_le _ _).trans (by omega) + · exact (natDegree_C _).le.trans (Nat.zero_le _) + +/-- Rational points of the diagonal plane model. -/ +abbrev CageDiagonalPlanePoint (p : Nat) [Fact p.Prime] + (xi : ZMod p) (d : Nat) := + ↥(BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)) + +/-- A plane point together with the sign used to recover the second root. -/ +abbrev CageDiagonalTaggedPlanePoint (p : Nat) [Fact p.Prime] + (xi : ZMod p) (d : Nat) := CageDiagonalPlanePoint p xi d × Bool + +/-- The tagged points which recover a unique pulled pair. At a zero root, +the two signs coincide, so only `false` is retained. -/ +def IsGoodDiagonalTaggedPoint {p : Nat} [Fact p.Prime] + {xi : ZMod p} {d : Nat} + (z : CageDiagonalTaggedPlanePoint p xi d) : Prop := + z.1.1.2 ≠ 0 ∧ (z.1.1.1 ≠ 0 ∨ z.2 = false) + +/-- Away from the explicit exceptional set, a signed diagonal plane point +is exactly a pulled pair of roots. -/ +def goodDiagonalTaggedPointEquivPulled + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi : ZMod p) (d : Nat) : + {z : CageDiagonalTaggedPlanePoint p xi d // + IsGoodDiagonalTaggedPoint z} ≃ CagePulledRootPair p xi xi d where + toFun z := by + let parameter : (ZMod p)ˣ := Units.mk0 z.1.1.1.2 z.2.1 + let root := z.1.1.1.1 + refine + { parameter := parameter + firstRoot := root + secondRoot := if z.1.2 then -root else root + firstEquation := ?_ + secondEquation := ?_ } + · exact (eval_cageDiagonalPlanePolynomial_eq_zero_iff xi d root + z.1.1.1.2).mp + (BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.1.2) + · have hfirst : root ^ 2 = + (cagePulledRadicand xi d).eval z.1.1.1.2 := + (eval_cageDiagonalPlanePolynomial_eq_zero_iff xi d root + z.1.1.1.2).mp + (BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.1.2) + split <;> simpa [parameter, root] using hfirst + invFun z := by + have hsquares : z.secondRoot = z.firstRoot ∨ + z.secondRoot = -z.firstRoot := by + rw [← sq_eq_sq_iff_eq_or_eq_neg] + exact z.secondEquation.trans z.firstEquation.symm + let tag : Bool := if z.secondRoot = z.firstRoot then false else true + have htag : z.secondRoot = if tag then -z.firstRoot else z.firstRoot := by + dsimp [tag] + split + · simp_all + · simp_all + refine ⟨(⟨(z.firstRoot, (z.parameter : ZMod p)), ?_⟩, tag), ?_⟩ + · apply BGS.External.mem_affinePlaneCurveZeros_iff.mpr + exact (eval_cageDiagonalPlanePolynomial_eq_zero_iff xi d + z.firstRoot (z.parameter : ZMod p)).mpr z.firstEquation + · refine ⟨z.parameter.ne_zero, ?_⟩ + by_cases hroot : z.firstRoot = 0 + · right + have hsecond : z.secondRoot = 0 := by + rcases hsquares with h | h <;> simp_all + simp [tag, hroot, hsecond] + · exact Or.inl hroot + left_inv z := by + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext + apply Prod.ext <;> rfl + · cases htag : z.1.2 + · simp [htag] + · have hroot : z.1.1.1.1 ≠ 0 := by + rcases z.2.2 with hroot | hfalse + · exact hroot + · simp [htag] at hfalse + have hneg : -z.1.1.1.1 ≠ z.1.1.1.1 := by + intro h + have htwo : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod + (lt_of_le_of_ne (Fact.out : p.Prime).two_le (Ne.symm hpTwo)) + have hzero : z.1.1.1.1 + z.1.1.1.1 = 0 := + neg_eq_iff_add_eq_zero.mp h + have hzero' : (2 : ZMod p) * z.1.1.1.1 = 0 := by + simpa [two_mul] using hzero + exact hroot ((mul_eq_zero.mp hzero').resolve_left htwo) + simp [htag, hneg] + right_inv z := by + apply CagePulledRootPair.ext + · apply Units.ext + rfl + · rfl + · dsimp + split + · symm + assumption + · rename_i hne + rcases (sq_eq_sq_iff_eq_or_eq_neg.mp + (z.secondEquation.trans z.firstEquation.symm)) with h | h + · exact (hne h).elim + · exact h.symm + +/-- The bad signed diagonal points inject into either the two signs above +`t = 0`, or a root of the pulled radicand with the duplicated sign. -/ +def badDiagonalTaggedPointEmbedding + (p : Nat) [Fact p.Prime] (xi : ZMod p) {d : Nat} (hd : 0 < d) : + {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z} ↪ + ({root : ZMod p // root ^ 2 = xi ^ 2 - 4} × Bool) ⊕ + {parameter : ZMod p // (cagePulledRadicand xi d).eval parameter = 0} := + { toFun := fun z => by + by_cases hparameter : z.1.1.1.2 = 0 + · exact Sum.inl ⟨⟨z.1.1.1.1, by + have heq := (eval_cageDiagonalPlanePolynomial_eq_zero_iff xi d + z.1.1.1.1 z.1.1.1.2).mp + (BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.1.2) + simpa [hparameter, cagePulledRadicand_eval_zero xi hd] using heq⟩, + z.1.2⟩ + · exact Sum.inr ⟨z.1.1.1.2, by + have hbad := z.2 + have hroot : z.1.1.1.1 = 0 := by + by_contra hroot + exact hbad ⟨hparameter, Or.inl hroot⟩ + have heq := (eval_cageDiagonalPlanePolynomial_eq_zero_iff xi d + z.1.1.1.1 z.1.1.1.2).mp + (BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.1.2) + simpa [hroot] using heq.symm⟩ + inj' := by + intro x y hxy + by_cases hx : x.1.1.1.2 = 0 + · by_cases hy : y.1.1.1.2 = 0 + · simp only [hx, hy, if_pos] at hxy + have hpayload := Sum.inl.inj hxy + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext + apply Prod.ext + · exact congrArg (fun q => q.1.1) hpayload + · exact hx.trans hy.symm + · exact congrArg + (fun q : ({root : ZMod p // root ^ 2 = xi ^ 2 - 4} × Bool) => q.2) + hpayload + · simp [hx, hy] at hxy + · by_cases hy : y.1.1.1.2 = 0 + · simp [hx, hy] at hxy + · simp only [hx, hy, if_neg] at hxy + have hpayload := Sum.inr.inj hxy + have hparameter : x.1.1.1.2 = y.1.1.1.2 := + congrArg Subtype.val hpayload + have hxroot : x.1.1.1.1 = 0 := by + by_contra hroot + exact x.2 ⟨hx, Or.inl hroot⟩ + have hyroot : y.1.1.1.1 = 0 := by + by_contra hroot + exact y.2 ⟨hy, Or.inl hroot⟩ + have hxtag : x.1.2 = true := by + cases htag : x.1.2 + · exact (x.2 ⟨hx, Or.inr htag⟩).elim + · rfl + have hytag : y.1.2 = true := by + cases htag : y.1.2 + · exact (y.2 ⟨hy, Or.inr htag⟩).elim + · rfl + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext + exact Prod.ext (hxroot.trans hyroot.symm) hparameter + · exact hxtag.trans hytag.symm } + +/-- In a field of odd characteristic, a scalar has at most two square roots. -/ +private lemma natCard_sq_eq_le_two + {K : Type*} [Field K] [Fintype K] [DecidableEq K] (a : K) : + Nat.card {x : K // x ^ 2 = a} <= 2 := by + let f : K[X] := X ^ 2 - C a + have hf : f ≠ 0 := by + intro hzero + have hcoeff := congrArg (fun q : K[X] => q.coeff 2) hzero + simp [f] at hcoeff + let e : {x : K // x ^ 2 = a} ≃ {x : K // f.eval x = 0} := + Equiv.subtypeEquiv (Equiv.refl K) (by + intro x + simp [f, sub_eq_zero]) + calc + Nat.card {x : K // x ^ 2 = a} = Nat.card {x : K // f.eval x = 0} := + Nat.card_congr e + _ <= f.natDegree := natCard_eval_eq_zero_le_natDegree f hf + _ = 2 := by simp [f] + +/-- The diagonal exceptional set has size at most `4d + 4`: four signed +points can lie above `t = 0`, and every remaining exception is a zero of the +degree-`4d` pulled radicand. -/ +lemma natCard_badDiagonalTaggedPoint_le + (p : Nat) [Fact p.Prime] (xi : ZMod p) {d : Nat} (hd : 0 < d) + (hXi : xi ^ 2 - 4 ≠ 0) : + Nat.card {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z} <= 4 * d + 4 := by + have hradicand : cagePulledRadicand xi d ≠ 0 := by + intro hzero + have hcoeff := congrArg + (fun q : (ZMod p)[X] => q.coeff (4 * d)) hzero + rw [cagePulledRadicand_coeff_four_mul xi hd, coeff_zero] at hcoeff + exact hXi hcoeff + have hrootBound : + Nat.card {root : ZMod p // root ^ 2 = xi ^ 2 - 4} <= 2 := + natCard_sq_eq_le_two _ + have hradicandBound : + Nat.card {parameter : ZMod p // + (cagePulledRadicand xi d).eval parameter = 0} <= 4 * d := + (natCard_eval_eq_zero_le_natDegree _ hradicand).trans + (cagePulledRadicand_natDegree_le (ZMod p) xi d) + have hinjective := Nat.card_le_card_of_injective + (badDiagonalTaggedPointEmbedding p xi hd).toFun + (badDiagonalTaggedPointEmbedding p xi hd).injective + rw [Nat.card_sum, Nat.card_prod] at hinjective + have hbool : Nat.card Bool = 2 := by simp + rw [hbool] at hinjective + omega + +/-- Exact bookkeeping identity behind the diagonal comparison. -/ +lemma two_mul_diagonalPlanePoint_card_eq_pulled_add_bad + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi : ZMod p) (d : Nat) : + 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card = + Nat.card (CagePulledRootPair p xi xi d) + + Nat.card {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z} := by + classical + have hgood : + Nat.card {z : CageDiagonalTaggedPlanePoint p xi d // + IsGoodDiagonalTaggedPoint z} = + Nat.card (CagePulledRootPair p xi xi d) := + Nat.card_congr (goodDiagonalTaggedPointEquivPulled p hpTwo xi d) + have hplane : Nat.card (CageDiagonalPlanePoint p xi d) = + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card := by + simpa only [Nat.card_eq_fintype_card] using + Fintype.card_coe + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)) + have hbool : Nat.card Bool = 2 := by simp + calc + 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card = + Nat.card (CageDiagonalTaggedPlanePoint p xi d) := by + rw [Nat.card_prod, hplane, hbool] + omega + _ = Nat.card + ({z : CageDiagonalTaggedPlanePoint p xi d // + IsGoodDiagonalTaggedPoint z} ⊕ + {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z}) := + (Nat.card_congr + (Equiv.sumCompl (fun z : CageDiagonalTaggedPlanePoint p xi d => + IsGoodDiagonalTaggedPoint z))).symm + _ = Nat.card {z : CageDiagonalTaggedPlanePoint p xi d // + IsGoodDiagonalTaggedPoint z} + + Nat.card {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z} := Nat.card_sum + _ = Nat.card (CagePulledRootPair p xi xi d) + + Nat.card {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z} := by rw [hgood] + +/-- The pulled diagonal cover differs from twice its plane-model count by +at most the explicit exceptional contribution `4d + 4`. -/ +theorem cagePulledRootPair_diagonal_card_comparison + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi : ZMod p) {d : Nat} (hd : 0 < d) + (hXi : xi ^ 2 - 4 ≠ 0) : + |(Nat.card (CagePulledRootPair p xi xi d) : Int) - + 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card| <= 4 * d + 4 := by + have hexact := two_mul_diagonalPlanePoint_card_eq_pulled_add_bad + p hpTwo xi d + have hbad := natCard_badDiagonalTaggedPoint_le p xi hd hXi + let bad := {z : CageDiagonalTaggedPlanePoint p xi d // + ¬ IsGoodDiagonalTaggedPoint z} + have hid : + (Nat.card (CagePulledRootPair p xi xi d) : Int) - + 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card = + -(Nat.card bad : Int) := by + change 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card = + Nat.card (CagePulledRootPair p xi xi d) + Nat.card bad at hexact + exact_mod_cast (by omega : + (Nat.card (CagePulledRootPair p xi xi d) : Int) - + 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card = + -(Nat.card bad : Int)) + rw [hid, abs_neg, abs_of_nonneg (Int.ofNat_nonneg _)] + exact_mod_cast hbad + +abbrev CageOffDiagonalPlanePoint (p : Nat) [Fact p.Prime] + (xi eta : ZMod p) (d : Nat) := + ↥(BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)) + +def IsGoodOffDiagonalPlanePoint {p : Nat} [Fact p.Prime] + {xi eta : ZMod p} {d : Nat} (z : CageOffDiagonalPlanePoint p xi eta d) : Prop := + z.1.1 ≠ 0 ∧ z.1.2 ≠ 0 + +def IsGoodOffDiagonalPulledPair {p : Nat} [Fact p.Prime] + {xi eta : ZMod p} {d : Nat} (z : CagePulledRootPair p xi eta d) : Prop := + z.firstRoot + z.secondRoot ≠ 0 + +def goodOffDiagonalPulledToPlane + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (d : Nat) : + {z : CagePulledRootPair p xi eta d // IsGoodOffDiagonalPulledPair z} → + {z : CageOffDiagonalPlanePoint p xi eta d // + IsGoodOffDiagonalPlanePoint z} := fun z => by + let sumRoot := z.1.firstRoot + z.1.secondRoot + refine ⟨⟨(sumRoot, (z.1.parameter : ZMod p)), ?_⟩, + z.2, z.1.parameter.ne_zero⟩ + apply BGS.External.mem_affinePlaneCurveZeros_iff.mpr + apply (eval_cageOffDiagonalPlanePolynomial_eq_zero_iff_exists_rootPair + (two_ne_zero_zmod + (lt_of_le_of_ne (Fact.out : p.Prime).two_le (Ne.symm hpTwo))) + xi eta d z.2).mpr + exact ⟨z.1.firstRoot, z.1.secondRoot, z.1.firstEquation, + z.1.secondEquation, rfl⟩ + +lemma goodOffDiagonalPulledToPlane_bijective + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (d : Nat) : + Function.Bijective (goodOffDiagonalPulledToPlane p hpTwo xi eta d) := by + have h2 : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod + (lt_of_le_of_ne (Fact.out : p.Prime).two_le (Ne.symm hpTwo)) + constructor + · intro x y hxy + have hsum : x.1.firstRoot + x.1.secondRoot = + y.1.firstRoot + y.1.secondRoot := by + exact congrArg (fun z => z.1.1.1) hxy + have hparameter : x.1.parameter = y.1.parameter := by + apply Units.ext + exact congrArg (fun z => z.1.1.2) hxy + have hfirstSq : x.1.firstRoot ^ 2 = y.1.firstRoot ^ 2 := by + rw [x.1.firstEquation, y.1.firstEquation, hparameter] + have hsecondSq : x.1.secondRoot ^ 2 = y.1.secondRoot ^ 2 := by + rw [x.1.secondEquation, y.1.secondEquation, hparameter] + rcases sq_eq_sq_iff_eq_or_eq_neg.mp hfirstSq with hfirst | hfirst + · apply Subtype.ext + apply CagePulledRootPair.ext hparameter hfirst + linear_combination hsum - hfirst + · rcases sq_eq_sq_iff_eq_or_eq_neg.mp hsecondSq with hsecond | hsecond + · have hfirstZero : x.1.firstRoot = 0 := by + have : (2 : ZMod p) * x.1.firstRoot = 0 := by + rw [two_mul] + linear_combination hsum - hsecond + hfirst + exact (mul_eq_zero.mp this).resolve_left h2 + apply Subtype.ext + apply CagePulledRootPair.ext hparameter + · have hyfirstZero : y.1.firstRoot = 0 := by + linear_combination hfirst - hfirstZero + simp [hfirstZero, hyfirstZero] + · exact hsecond + · have hsumZero : x.1.firstRoot + x.1.secondRoot = 0 := by + have : (2 : ZMod p) * (x.1.firstRoot + x.1.secondRoot) = 0 := by + rw [two_mul] + linear_combination hsum + hfirst + hsecond + exact (mul_eq_zero.mp this).resolve_left h2 + exact (x.2 hsumZero).elim + · intro z + have hexists := + (eval_cageOffDiagonalPlanePolynomial_eq_zero_iff_exists_rootPair + h2 xi eta d z.2.1).mp + (BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.2) + rcases hexists with ⟨firstRoot, secondRoot, hfirst, hsecond, hsum⟩ + let parameter : (ZMod p)ˣ := Units.mk0 z.1.1.2 z.2.2 + let pulled : CagePulledRootPair p xi eta d := + { parameter := parameter + firstRoot := firstRoot + secondRoot := secondRoot + firstEquation := by simpa [parameter] using hfirst + secondEquation := by simpa [parameter] using hsecond } + have hpulledGood : IsGoodOffDiagonalPulledPair pulled := by + change firstRoot + secondRoot ≠ 0 + rw [hsum] + exact z.2.1 + refine ⟨⟨pulled, hpulledGood⟩, ?_⟩ + apply Subtype.ext + apply Subtype.ext + apply Prod.ext + · exact hsum + · rfl + +def goodOffDiagonalPulledEquivPlane + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (d : Nat) : + {z : CagePulledRootPair p xi eta d // IsGoodOffDiagonalPulledPair z} ≃ + {z : CageOffDiagonalPlanePoint p xi eta d // + IsGoodOffDiagonalPlanePoint z} := + Equiv.ofBijective _ (goodOffDiagonalPulledToPlane_bijective p hpTwo xi eta d) + +private lemma rootCount_le_natDegree + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + (f : K[X]) (hf : f ≠ 0) : + Nat.card {x : K // f.eval x = 0} ≤ f.natDegree := by + classical + let embedding : {x : K // f.eval x = 0} ↪ f.roots.toFinset := + { toFun := fun x => ⟨x, by + rw [Multiset.mem_toFinset, Polynomial.mem_roots hf] + exact x.2⟩ + inj' := by + intro x y h + apply Subtype.ext + exact congrArg (fun z : f.roots.toFinset => (z : K)) h } + letI : Fintype {x : K // f.eval x = 0} := Fintype.ofFinite _ + calc + Nat.card {x : K // f.eval x = 0} ≤ f.roots.toFinset.card := by + simpa only [Nat.card_eq_fintype_card, Fintype.card_coe] using + Fintype.card_le_of_injective embedding embedding.injective + _ ≤ f.roots.card := Multiset.toFinset_card_le _ + _ ≤ f.natDegree := Polynomial.card_roots' f + +private lemma sqRootCount_le_two + {K : Type*} [Field K] [Fintype K] [DecidableEq K] (a : K) : + Nat.card {x : K // x ^ 2 = a} ≤ 2 := by + let f : K[X] := X ^ 2 - C a + have hf : f ≠ 0 := by + intro h + have := congrArg (fun q : K[X] => q.coeff 2) h + simp [f] at this + let e : {x : K // x ^ 2 = a} ≃ {x : K // f.eval x = 0} := + Equiv.subtypeEquiv (Equiv.refl K) (by intro x; simp [f, sub_eq_zero]) + rw [Nat.card_congr e] + exact (rootCount_le_natDegree f hf).trans_eq (by simp [f]) + +private lemma powerRootCount_le + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {n : Nat} (hn : 0 < n) : Nat.card {x : K // x ^ n = 1} ≤ n := by + let f : K[X] := X ^ n - 1 + have hf : f ≠ 0 := by + simpa [f] using (monic_X_pow_sub_C (1 : K) hn.ne').ne_zero + let e : {x : K // x ^ n = 1} ≃ {x : K // f.eval x = 0} := + Equiv.subtypeEquiv (Equiv.refl K) (by intro x; simp [f, sub_eq_zero]) + rw [Nat.card_congr e] + exact (rootCount_le_natDegree f hf).trans_eq (by + simpa [f] using (natDegree_X_pow_sub_C (R := K) (n := n) (r := 1))) + +def badOffDiagonalPulledEmbedding + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) {d : Nat} (hd : 0 < d) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) : + {z : CagePulledRootPair p xi eta d // + ¬ IsGoodOffDiagonalPulledPair z} ↪ + (Σ parameter : {t : ZMod p // t ^ (2 * d) = 1}, + {root : ZMod p // root ^ 2 = + (cagePulledRadicand xi d).eval parameter.1}) := + { toFun := fun z => by + have hsum : z.1.firstRoot + z.1.secondRoot = 0 := + not_ne_iff.mp z.2 + have hsecond : z.1.secondRoot = -z.1.firstRoot := by + linear_combination hsum + have hevals : (cagePulledRadicand xi d).eval + (z.1.parameter : ZMod p) = + (cagePulledRadicand eta d).eval + (z.1.parameter : ZMod p) := by + rw [← z.1.firstEquation, ← z.1.secondEquation, hsecond] + ring + have hdifference := congrArg + (fun q : (ZMod p)[X] => q.eval (z.1.parameter : ZMod p)) + (cagePulledRadicand_sub xi eta d) + have hproduct : (xi ^ 2 - eta ^ 2) * + ((z.1.parameter : ZMod p) ^ (2 * d) - 1) ^ 2 = 0 := by + simpa [hevals] using hdifference + have hscalar : xi ^ 2 - eta ^ 2 ≠ 0 := sub_ne_zero.mpr hoffDiagonal + have hpower : (z.1.parameter : ZMod p) ^ (2 * d) = 1 := by + have hsquare := (mul_eq_zero.mp hproduct).resolve_left hscalar + have hbase : (z.1.parameter : ZMod p) ^ (2 * d) - 1 = 0 := by + apply mul_self_eq_zero.mp + simpa [pow_two] using hsquare + exact sub_eq_zero.mp hbase + exact ⟨⟨(z.1.parameter : ZMod p), hpower⟩, + ⟨z.1.firstRoot, z.1.firstEquation⟩⟩ + inj' := by + intro x y hxy + have hparameter : x.1.parameter = y.1.parameter := by + apply Units.ext + exact congrArg (fun z => (z.1.1 : ZMod p)) hxy + have hfirst : x.1.firstRoot = y.1.firstRoot := + congrArg (fun z => z.2.1) hxy + have hxsum : x.1.firstRoot + x.1.secondRoot = 0 := not_ne_iff.mp x.2 + have hysum : y.1.firstRoot + y.1.secondRoot = 0 := not_ne_iff.mp y.2 + apply Subtype.ext + apply CagePulledRootPair.ext hparameter hfirst + linear_combination hxsum - hysum - hfirst } + +lemma badOffDiagonalPulled_card_le + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) {d : Nat} (hd : 0 < d) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) : + Nat.card {z : CagePulledRootPair p xi eta d // + ¬ IsGoodOffDiagonalPulledPair z} ≤ 4 * d := by + let base := {t : ZMod p // t ^ (2 * d) = 1} + let fiber : base → Type := fun t => + {root : ZMod p // root ^ 2 = (cagePulledRadicand xi d).eval t.1} + have hinj := Nat.card_le_card_of_injective + (badOffDiagonalPulledEmbedding p hpTwo xi eta hd hoffDiagonal).toFun + (badOffDiagonalPulledEmbedding p hpTwo xi eta hd hoffDiagonal).injective + change Nat.card _ ≤ Nat.card (Σ t : base, fiber t) at hinj + rw [Nat.card_sigma] at hinj + have hfiber : ∀ t : base, Nat.card (fiber t) ≤ 2 := + fun t => sqRootCount_le_two _ + have hsum : ∑ t : base, Nat.card (fiber t) ≤ ∑ _t : base, 2 := by + exact Finset.sum_le_sum fun t _ => hfiber t + have hbase : Nat.card base ≤ 2 * d := powerRootCount_le (by omega) + have hsum' : ∑ t : base, Nat.card (fiber t) ≤ Nat.card base * 2 := by + simpa using hsum + omega + +def cageOffDiagonalZeroParameterPolynomial + {K : Type*} [Field K] (xi eta : K) (d : Nat) : K[X] := + (X ^ 2 - C ((cagePulledRadicand xi d).eval 0 + + (cagePulledRadicand eta d).eval 0)) ^ 2 - + C (4 * (cagePulledRadicand xi d).eval 0 * + (cagePulledRadicand eta d).eval 0) + +lemma eval_cageOffDiagonalZeroParameterPolynomial + {K : Type*} [Field K] (xi eta sumRoot : K) (d : Nat) : + (cageOffDiagonalZeroParameterPolynomial xi eta d).eval sumRoot = + MvPolynomial.eval ![sumRoot, 0] + (cageOffDiagonalPlanePolynomial xi eta d) := by + rw [eval_cageOffDiagonalPlanePolynomial] + simp [cageOffDiagonalZeroParameterPolynomial] + +lemma cageOffDiagonalZeroParameterPolynomial_natDegree_le + {K : Type*} [Field K] (xi eta : K) (d : Nat) : + (cageOffDiagonalZeroParameterPolynomial xi eta d).natDegree ≤ 4 := by + unfold cageOffDiagonalZeroParameterPolynomial + refine (natDegree_sub_le _ _).trans (max_le ?_ ?_) + · exact (natDegree_pow_le).trans (by + have hinside : (X ^ 2 - C ((cagePulledRadicand xi d).eval 0 + + (cagePulledRadicand eta d).eval 0) : K[X]).natDegree ≤ 2 := + (natDegree_sub_le _ _).trans (max_le + (natDegree_X_pow_le 2) ((natDegree_C _).le.trans (by omega))) + omega) + · exact (natDegree_C _).le.trans (by omega) + +lemma cageOffDiagonalZeroParameterPolynomial_ne_zero + {K : Type*} [Field K] (xi eta : K) (d : Nat) : + cageOffDiagonalZeroParameterPolynomial xi eta d ≠ 0 := by + have hquadratic : IsMonicOfDegree + (X ^ 2 - C ((cagePulledRadicand xi d).eval 0 + + (cagePulledRadicand eta d).eval 0) : K[X]) 2 := + (isMonicOfDegree_X_pow K 2).sub (by simp) + have hmonic : (cageOffDiagonalZeroParameterPolynomial xi eta d).Monic := by + unfold cageOffDiagonalZeroParameterPolynomial + exact ((hquadratic.pow 2).sub (by + have hpos : 0 < 2 * 2 := by norm_num + simpa only [natDegree_C] using hpos)).monic + exact hmonic.ne_zero + +def badOffDiagonalPlaneEmbedding + (p : Nat) [Fact p.Prime] (xi eta : ZMod p) {d : Nat} + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) : + {z : CageOffDiagonalPlanePoint p xi eta d // + ¬ IsGoodOffDiagonalPlanePoint z} ↪ + {sumRoot : ZMod p // + (cageOffDiagonalZeroParameterPolynomial xi eta d).eval sumRoot = 0} ⊕ + {parameter : ZMod p // parameter ^ (2 * d) = 1} := + { toFun := fun z => by + by_cases hparameter : z.1.1.2 = 0 + · exact Sum.inl ⟨z.1.1.1, by + rw [eval_cageOffDiagonalZeroParameterPolynomial] + simpa [hparameter] using + (BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.2)⟩ + · have hsumRoot : z.1.1.1 = 0 := by + by_contra hsum + exact z.2 ⟨hsum, hparameter⟩ + have hplane := BGS.External.mem_affinePlaneCurveZeros_iff.mp z.1.2 + have hquartic : + ((cagePulledRadicand xi d).eval z.1.1.2 - + (cagePulledRadicand eta d).eval z.1.1.2) ^ 2 = 0 := by + rw [eval_cageOffDiagonalPlanePolynomial] at hplane + rw [hsumRoot] at hplane + linear_combination hplane + have hevals : (cagePulledRadicand xi d).eval z.1.1.2 = + (cagePulledRadicand eta d).eval z.1.1.2 := by + exact sub_eq_zero.mp (mul_self_eq_zero.mp (by + simpa [pow_two] using hquartic)) + have hdifference := congrArg + (fun q : (ZMod p)[X] => q.eval z.1.1.2) + (cagePulledRadicand_sub xi eta d) + have hproduct : (xi ^ 2 - eta ^ 2) * + (z.1.1.2 ^ (2 * d) - 1) ^ 2 = 0 := by + simpa [hevals] using hdifference + have hsquare := (mul_eq_zero.mp hproduct).resolve_left + (sub_ne_zero.mpr hoffDiagonal) + have hbase : z.1.1.2 ^ (2 * d) - 1 = 0 := by + apply mul_self_eq_zero.mp + simpa [pow_two] using hsquare + exact Sum.inr ⟨z.1.1.2, sub_eq_zero.mp hbase⟩ + inj' := by + intro x y hxy + by_cases hx : x.1.1.2 = 0 + · by_cases hy : y.1.1.2 = 0 + · simp only [hx, hy, if_pos] at hxy + have hpayload := Sum.inl.inj hxy + apply Subtype.ext + apply Subtype.ext + exact Prod.ext (congrArg Subtype.val hpayload) (hx.trans hy.symm) + · simp [hx, hy] at hxy + · by_cases hy : y.1.1.2 = 0 + · simp [hx, hy] at hxy + · simp only [hx, hy, if_neg] at hxy + have hpayload := Sum.inr.inj hxy + have hparameter : x.1.1.2 = y.1.1.2 := congrArg Subtype.val hpayload + have hxsum : x.1.1.1 = 0 := by + by_contra hsum + exact x.2 ⟨hsum, hx⟩ + have hysum : y.1.1.1 = 0 := by + by_contra hsum + exact y.2 ⟨hsum, hy⟩ + apply Subtype.ext + apply Subtype.ext + exact Prod.ext (hxsum.trans hysum.symm) hparameter } + +lemma badOffDiagonalPlane_card_le + (p : Nat) [Fact p.Prime] (xi eta : ZMod p) {d : Nat} (hd : 0 < d) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) : + Nat.card {z : CageOffDiagonalPlanePoint p xi eta d // + ¬ IsGoodOffDiagonalPlanePoint z} ≤ 2 * d + 4 := by + have hinj := Nat.card_le_card_of_injective + (badOffDiagonalPlaneEmbedding p xi eta (d := d) hoffDiagonal).toFun + (badOffDiagonalPlaneEmbedding p xi eta (d := d) hoffDiagonal).injective + rw [Nat.card_sum] at hinj + have hzeroParameter : Nat.card {sumRoot : ZMod p // + (cageOffDiagonalZeroParameterPolynomial xi eta d).eval sumRoot = 0} ≤ 4 := + (rootCount_le_natDegree _ + (cageOffDiagonalZeroParameterPolynomial_ne_zero xi eta d)).trans + (cageOffDiagonalZeroParameterPolynomial_natDegree_le xi eta d) + have hpower : Nat.card {parameter : ZMod p // + parameter ^ (2 * d) = 1} ≤ 2 * d := powerRootCount_le (by omega) + omega + +theorem cagePulledRootPair_offDiagonal_card_comparison + (p : Nat) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) {d : Nat} (hd : 0 < d) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) : + |(Nat.card (CagePulledRootPair p xi eta d) : Int) - + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card| ≤ 6 * d + 4 := by + classical + letI : Finite (CagePulledRootPair p xi eta d) := + Finite.of_injective + (fun z => (z.parameter, z.firstRoot, z.secondRoot)) (by + intro x y h + apply CagePulledRootPair.ext + · exact congrArg Prod.fst h + · exact congrArg (fun q => q.2.1) h + · exact congrArg (fun q => q.2.2) h) + let goodPulled := {z : CagePulledRootPair p xi eta d // + IsGoodOffDiagonalPulledPair z} + let badPulled := {z : CagePulledRootPair p xi eta d // + ¬ IsGoodOffDiagonalPulledPair z} + let goodPlane := {z : CageOffDiagonalPlanePoint p xi eta d // + IsGoodOffDiagonalPlanePoint z} + let badPlane := {z : CageOffDiagonalPlanePoint p xi eta d // + ¬ IsGoodOffDiagonalPlanePoint z} + have hsplitPulled : Nat.card (CagePulledRootPair p xi eta d) = + Nat.card goodPulled + Nat.card badPulled := by + calc + Nat.card (CagePulledRootPair p xi eta d) = + Nat.card (goodPulled ⊕ badPulled) := + (Nat.card_congr (Equiv.sumCompl + (fun z : CagePulledRootPair p xi eta d => + IsGoodOffDiagonalPulledPair z))).symm + _ = Nat.card goodPulled + Nat.card badPulled := Nat.card_sum + have hplaneCard : Nat.card (CageOffDiagonalPlanePoint p xi eta d) = + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card := by + simpa only [Nat.card_eq_fintype_card] using Fintype.card_coe + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)) + have hsplitPlane : + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card = + Nat.card goodPlane + Nat.card badPlane := by + calc + _ = Nat.card (CageOffDiagonalPlanePoint p xi eta d) := hplaneCard.symm + _ = Nat.card (goodPlane ⊕ badPlane) := + (Nat.card_congr (Equiv.sumCompl + (fun z : CageOffDiagonalPlanePoint p xi eta d => + IsGoodOffDiagonalPlanePoint z))).symm + _ = Nat.card goodPlane + Nat.card badPlane := Nat.card_sum + have hgood : Nat.card goodPulled = Nat.card goodPlane := + Nat.card_congr (goodOffDiagonalPulledEquivPlane p hpTwo xi eta d) + have hbadPulled : Nat.card badPulled ≤ 4 * d := by + exact badOffDiagonalPulled_card_le p hpTwo xi eta hd hoffDiagonal + have hbadPlane : Nat.card badPlane ≤ 2 * d + 4 := by + exact badOffDiagonalPlane_card_le p xi eta hd hoffDiagonal + have herror : + |(Nat.card (CagePulledRootPair p xi eta d) : Int) - + (BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card| ≤ + Nat.card badPulled + Nat.card badPlane := by + rw [hsplitPulled, hsplitPlane, hgood] + push_cast + have habs := abs_sub (Nat.card badPulled : Int) + (Nat.card badPlane : Int) + simpa using habs + exact herror.trans (by exact_mod_cast (by omega : + Nat.card badPulled + Nat.card badPlane ≤ 6 * d + 4)) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean new file mode 100644 index 0000000000..60549d2217 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean @@ -0,0 +1,161 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption + +/-! +# Hasse--Weil estimates for the direct cage plane models + +This file applies the single allowed general affine Hasse--Weil theorem to +the two explicit cage models. It also proves that the divisor exponents +used by the cage are prime to the characteristic; that condition is not +left as a specialized assumption. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- A uniform point estimate for both direct cage plane models. -/ +def CagePlanePointEstimate (coefficient : ℕ) : Prop := + ∀ (p : ℕ) [Fact p.Prime], 7 ≤ p → + ∀ (xi eta : ZMod p), + IsSplitMaximalTrace p xi → IsSplitMaximalTrace p eta → + ∀ d : ℕ, d ∣ p - 1 → 0 < d → + |((BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card : ℝ) - p| ≤ + (coefficient : ℝ) * Real.sqrt p * d ∧ + (xi ^ 2 ≠ eta ^ 2 → + |((BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card : ℝ) - p| ≤ + (coefficient : ℝ) * Real.sqrt p * d) + +/-- A positive divisor of `p-1` is strictly smaller than `p`. -/ +lemma divisor_pred_lt_prime {p d : ℕ} (hpTwo : 2 ≤ p) + (hd : d ∣ p - 1) : + d < p := by + have hdLe : d ≤ p - 1 := Nat.le_of_dvd (by omega) hd + omega + +/-- The pulled-cover exponent `2d` is nonzero in `ZMod p` for every positive +divisor `d` of `p-1` and every prime `p ≥ 7`. -/ +lemma two_mul_divisor_pred_ne_zero_zmod + (p : ℕ) [Fact p.Prime] (hpSeven : 7 ≤ p) + {d : ℕ} (hd : d ∣ p - 1) (hdPositive : 0 < d) : + (((2 * d : ℕ) : ZMod p)) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 2 * d := (ZMod.natCast_eq_zero_iff (2 * d) p).mp hzero + rcases (Fact.out : p.Prime).dvd_mul.mp hpDvd with hpTwo | hpD + · have hpLeTwo := Nat.le_of_dvd (by norm_num) hpTwo + omega + · have hdLt := divisor_pred_lt_prime (by omega) hd + exact (Nat.not_dvd_of_pos_of_lt hdPositive hdLt) hpD + +/-- A fixed-coefficient affine Hasse--Weil bound gives fixed uniform estimates +for both cage plane models. -/ +theorem cagePlanePointEstimate_of_bivariateAffineHasseWeilBound + (generalCoefficient : ℕ) + (hgeneral : BGS.External.BivariateAffineHasseWeilBound generalCoefficient) : + CagePlanePointEstimate (32 * generalCoefficient) := by + let coefficient := 32 * generalCoefficient + change CagePlanePointEstimate coefficient + intro p _ hpSeven xi eta hxi heta d hd hdPositive + have h2 : (2 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (n := 2) (p := p) (by norm_num) (by omega) + have hdegree : (((2 * d : ℕ) : ZMod p)) ≠ 0 := + two_mul_divisor_pred_ne_zero_zmod p hpSeven hd hdPositive + have hxiNonzero := splitMaximalTrace_ne_zero p hpSeven xi hxi + have hetaNonzero := splitMaximalTrace_ne_zero p hpSeven eta heta + have hXi := sub_ne_zero.mpr (splitMaximalTrace_sq_ne_four p hpSeven xi hxi) + have hEta := sub_ne_zero.mpr (splitMaximalTrace_sq_ne_four p hpSeven eta heta) + have hDiagonal := hgeneral (ZMod p) + (cageDiagonalPlanePolynomial xi d) 2 (4 * d) + (by norm_num) (by omega) + (cageDiagonalPlanePolynomial_hasBidegreeAtMost xi d) + (cageDiagonalPlanePolynomial_absolutelyIrreducible + hxiNonzero hXi hdPositive h2 hdegree) + constructor + · have hcard : Fintype.card (ZMod p) = p := ZMod.card p + rw [hcard] at hDiagonal + dsimp [coefficient] + calc + |((BGS.External.affinePlaneCurveZeros (ZMod p) + (cageDiagonalPlanePolynomial xi d)).card : ℝ) - p| ≤ + (generalCoefficient : ℝ) * Real.sqrt p * + ((2 : ℕ) : ℝ) * (((4 * d : ℕ) : ℝ)) := hDiagonal + _ = (8 * generalCoefficient : ℝ) * Real.sqrt p * d := by + push_cast + ring + _ ≤ (((32 * generalCoefficient : ℕ) : ℝ)) * Real.sqrt p * d := by + push_cast + have hnonnegative : + 0 ≤ (generalCoefficient : ℝ) * Real.sqrt p * (d : ℝ) := by + positivity + nlinarith + · intro hoffDiagonal + have hOffDiagonal := hgeneral (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d) 4 (8 * d) + (by norm_num) (by omega) + (cageOffDiagonalPlanePolynomial_hasBidegreeAtMost xi eta d) + (cageOffDiagonalPlanePolynomial_absolutelyIrreducible + hxiNonzero hetaNonzero hXi hEta hoffDiagonal hdPositive h2 hdegree) + have hcard : Fintype.card (ZMod p) = p := ZMod.card p + rw [hcard] at hOffDiagonal + dsimp [coefficient] + calc + |((BGS.External.affinePlaneCurveZeros (ZMod p) + (cageOffDiagonalPlanePolynomial xi eta d)).card : ℝ) - p| ≤ + (generalCoefficient : ℝ) * Real.sqrt p * + ((4 : ℕ) : ℝ) * (((8 * d : ℕ) : ℝ)) := hOffDiagonal + _ = (((32 * generalCoefficient : ℕ) : ℝ)) * Real.sqrt p * d := by + push_cast + ring + +/-- The allowed general Hasse--Weil theorem gives uniform estimates for both +the diagonal and off-diagonal cage plane models. -/ +theorem exists_cagePlanePointEstimate_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + ∃ coefficient : ℕ, 0 < coefficient ∧ CagePlanePointEstimate coefficient := by + obtain ⟨generalCoefficient, hgeneralCoefficient, hgeneral⟩ := hHasse + exact ⟨32 * generalCoefficient, by omega, + cagePlanePointEstimate_of_bivariateAffineHasseWeilBound + generalCoefficient hgeneral⟩ + +/-- Divide an exact `d`-fold cover estimate by its fiber multiplicity. This +is the numerical step used after the geometric count comparison. -/ +lemma range_count_error_of_exact_cover + {coverCard rangeCard p d multiplicity : ℕ} {error : ℝ} + (hd : 0 < d) (hcover : coverCard = d * rangeCard) + (herror : + |(coverCard : ℝ) - (multiplicity : ℝ) * p| ≤ + error * d) : + |(rangeCard : ℝ) - (multiplicity : ℝ) * p / d| ≤ error := by + have hdReal : (d : ℝ) ≠ 0 := by exact_mod_cast hd.ne' + have hdNonnegative : (0 : ℝ) ≤ d := by positivity + have hidentity : + |(rangeCard : ℝ) - (multiplicity : ℝ) * p / d| = + |(coverCard : ℝ) - (multiplicity : ℝ) * p| / d := by + rw [hcover] + push_cast + calc + |(rangeCard : ℝ) - (multiplicity : ℝ) * p / d| = + |((d : ℝ) * rangeCard - (multiplicity : ℝ) * p) / d| := by + congr 1 + field_simp [hdReal] + _ = |(d : ℝ) * rangeCard - (multiplicity : ℝ) * p| / |(d : ℝ)| := + abs_div _ _ + _ = |(d : ℝ) * rangeCard - (multiplicity : ℝ) * p| / d := by + rw [abs_of_nonneg hdNonnegative] + rw [hidentity] + calc + |(coverCard : ℝ) - (multiplicity : ℝ) * p| / d ≤ + (error * d) / d := div_le_div_of_nonneg_right herror hdNonnegative + _ = error := by field_simp [hdReal] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean new file mode 100644 index 0000000000..40e7088beb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean @@ -0,0 +1,546 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems + +/-! +# Direct affine-plane models for the cage + +The first variable is the primitive root coordinate and the second variable +is the power parameter. Passing through `finTwoToIteratedPolynomial` makes +the defining equations polynomials in the root coordinate with coefficients +in the parameter polynomial ring. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The two-variable/iterated-polynomial equivalence commutes with extension +of scalar fields. -/ +lemma finTwoToIteratedPolynomial_map + {L : Type*} [Field L] (phi : K →+* L) + (p : MvPolynomial (Fin 2) K) : + finTwoToIteratedPolynomial (K := L) (MvPolynomial.map phi p) = + (finTwoToIteratedPolynomial (K := K) p).map + (Polynomial.mapRingHom phi) := by + let lhs : MvPolynomial (Fin 2) K →+* L[X][X] := + (finTwoToIteratedPolynomial (K := L)).toRingEquiv.toRingHom.comp + (MvPolynomial.map phi) + let rhs : MvPolynomial (Fin 2) K →+* L[X][X] := + (Polynomial.mapRingHom (Polynomial.mapRingHom phi)).comp + (finTwoToIteratedPolynomial (K := K)).toRingEquiv.toRingHom + have heq : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro r + simp [lhs, rhs, RingHom.comp_apply, finTwoToIteratedPolynomial_C] + · intro i + fin_cases i <;> + simp [lhs, rhs, RingHom.comp_apply, + finTwoToIteratedPolynomial_X_zero, + finTwoToIteratedPolynomial_X_one] + exact DFunLike.congr_fun heq p + +/-- The diagonal hyperelliptic model `L² = F_ξ(t)`, written as a polynomial +in `L` over `K[t]`. -/ +def cageDiagonalIteratedPolynomial (xi : K) (d : ℕ) : K[X][X] := + adjoinSquarePolynomial (cagePulledRadicand xi d) + +/-- The off-diagonal primitive-element model. Its root coordinate is +`S = L + M`; eliminating `L` and `M` gives +`(S² - F_ξ - F_η)² - 4 F_ξ F_η`. -/ +def cageOffDiagonalIteratedPolynomial (xi eta : K) (d : ℕ) : K[X][X] := + (X ^ 2 - C (cagePulledRadicand xi d + cagePulledRadicand eta d)) ^ 2 - + C (4 * (cagePulledRadicand xi d * cagePulledRadicand eta d)) + +/-- The pulled radicand placed in the second bivariate coordinate. -/ +def cagePulledRadicandSecondCoordinate (xi : K) (d : ℕ) : + MvPolynomial (Fin 2) K := + MvPolynomial.C (xi ^ 2 - 4) * MvPolynomial.X 1 ^ (4 * d) - + MvPolynomial.C (2 * (xi ^ 2 + 4)) * MvPolynomial.X 1 ^ (2 * d) + + MvPolynomial.C (xi ^ 2 - 4) + +@[simp] +lemma finTwoToIteratedPolynomial_cagePulledRadicandSecondCoordinate + (xi : K) (d : ℕ) : + finTwoToIteratedPolynomial (cagePulledRadicandSecondCoordinate xi d) = + C (cagePulledRadicand xi d) := by + rw [cagePulledRadicand_expanded] + simp [cagePulledRadicandSecondCoordinate] + +/-- The diagonal model as the displayed bivariate polynomial +`L² - F_ξ(t)`. -/ +def cageDiagonalPlanePolynomial (xi : K) (d : ℕ) : MvPolynomial (Fin 2) K := + MvPolynomial.X 0 ^ 2 - cagePulledRadicandSecondCoordinate xi d + +/-- The off-diagonal model as an honest bivariate polynomial. -/ +def cageOffDiagonalPlanePolynomial (xi eta : K) (d : ℕ) : + MvPolynomial (Fin 2) K := + (MvPolynomial.X 0 ^ 2 - + (cagePulledRadicandSecondCoordinate xi d + + cagePulledRadicandSecondCoordinate eta d)) ^ 2 - + MvPolynomial.C 4 * cagePulledRadicandSecondCoordinate xi d * + cagePulledRadicandSecondCoordinate eta d + +@[simp] +lemma finTwoToIteratedPolynomial_cageDiagonalPlanePolynomial (xi : K) (d : ℕ) : + finTwoToIteratedPolynomial (cageDiagonalPlanePolynomial xi d) = + cageDiagonalIteratedPolynomial xi d := by + simp [cageDiagonalPlanePolynomial, cageDiagonalIteratedPolynomial, + adjoinSquarePolynomial] + +@[simp] +lemma finTwoToIteratedPolynomial_cageOffDiagonalPlanePolynomial + (xi eta : K) (d : ℕ) : + finTwoToIteratedPolynomial (cageOffDiagonalPlanePolynomial xi eta d) = + cageOffDiagonalIteratedPolynomial xi eta d := by + simp only [cageOffDiagonalPlanePolynomial, + cageOffDiagonalIteratedPolynomial, map_sub, map_pow, map_add, map_mul, + finTwoToIteratedPolynomial_X_zero, + finTwoToIteratedPolynomial_cagePulledRadicandSecondCoordinate, + finTwoToIteratedPolynomial_C] + have hC4 : (C (4 : K) : K[X]) = 4 := + map_natCast (Polynomial.C : K →+* K[X]) 4 + rw [hC4] + ring + +/-- Gauss's lemma turns nonsquareness of the radicand in `K(t)` into +irreducibility of the diagonal plane equation over `K[t]`. -/ +lemma cageDiagonalIteratedPolynomial_irreducible + {xi : K} (hxi : xi ≠ 0) (hXi : xi ^ 2 - 4 ≠ 0) + {d : ℕ} (hd : 0 < d) (h2 : (2 : K) ≠ 0) + (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Irreducible (cageDiagonalIteratedPolynomial xi d) := by + have hsquarefree := + (cagePulledRadicand_separable h2 hxi hXi hd hdegree).squarefree + have hnonsquare : + ¬ IsSquare + (algebraMap K[X] (FractionRing K[X]) (cagePulledRadicand xi d)) := + not_isSquare_algebraMap_of_squarefree_not_isUnit hsquarefree + (cagePulledRadicand_not_isUnit hXi hd) + have hfraction : Irreducible + ((cageDiagonalIteratedPolynomial xi d).map + (algebraMap K[X] (FractionRing K[X]))) := by + simpa [cageDiagonalIteratedPolynomial, adjoinSquarePolynomial] using + adjoinSquarePolynomial_irreducible_of_not_isSquare hnonsquare + have hmonic : (cageDiagonalIteratedPolynomial xi d).Monic := + adjoinSquarePolynomial_monic _ + exact hmonic.isPrimitive.irreducible_iff_irreducible_map_fraction_map.mpr + hfraction + +/-- Ground-field irreducibility of the diagonal bivariate polynomial. -/ +lemma cageDiagonalPlanePolynomial_irreducible + {xi : K} (hxi : xi ≠ 0) (hXi : xi ^ 2 - 4 ≠ 0) + {d : ℕ} (hd : 0 < d) (h2 : (2 : K) ≠ 0) + (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Irreducible (cageDiagonalPlanePolynomial xi d) := by + have hiterated := cageDiagonalIteratedPolynomial_irreducible + hxi hXi hd h2 hdegree + have hback := hiterated.map (finTwoToIteratedPolynomial (K := K)).symm + have heq : + (finTwoToIteratedPolynomial (K := K)).symm + (cageDiagonalIteratedPolynomial xi d) = + cageDiagonalPlanePolynomial xi d := by + rw [← finTwoToIteratedPolynomial_cageDiagonalPlanePolynomial] + exact (finTwoToIteratedPolynomial (K := K)).symm_apply_apply _ + rw [heq] at hback + exact hback + +/-- The off-diagonal primitive quartic is irreducible over the parameter +polynomial ring. The only geometric input is the proved independence of the +three pulled-radicand square classes. -/ +lemma cageOffDiagonalIteratedPolynomial_irreducible + {xi eta : K} (hxi : xi ≠ 0) (heta : eta ≠ 0) + (hXi : xi ^ 2 - 4 ≠ 0) (hEta : eta ^ 2 - 4 ≠ 0) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) {d : ℕ} (hd : 0 < d) + (h2 : (2 : K) ≠ 0) (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Irreducible (cageOffDiagonalIteratedPolynomial xi eta d) := by + obtain ⟨hf, hg, hfg⟩ := + cagePulledRadicand_squareClasses_independent_ratFunc h2 hxi heta + hXi hEta hoffDiagonal hd hdegree + have h2Fraction : (2 : RatFunc K) ≠ 0 := by + intro hzero + apply h2 + apply FaithfulSMul.algebraMap_injective K (RatFunc K) + simpa only [map_ofNat, map_zero] using hzero + have hfg' : ¬ IsSquare + (algebraMap K[X] (RatFunc K) (cagePulledRadicand xi d) * + algebraMap K[X] (RatFunc K) (cagePulledRadicand eta d)) := by + simpa only [map_mul] using hfg + have hfractionGeneric := biquadraticPrimitiveQuartic_irreducible + h2Fraction hf hg hfg' + have hfraction : Irreducible + ((cageOffDiagonalIteratedPolynomial xi eta d).map + (algebraMap K[X] (RatFunc K))) := by + have heq : + (cageOffDiagonalIteratedPolynomial xi eta d).map + (algebraMap K[X] (RatFunc K)) = + biquadraticPrimitiveQuartic + (algebraMap K[X] (RatFunc K) (cagePulledRadicand xi d)) + (algebraMap K[X] (RatFunc K) (cagePulledRadicand eta d)) := by + simp only [cageOffDiagonalIteratedPolynomial, + biquadraticPrimitiveQuartic, Polynomial.map_sub, Polynomial.map_pow, + Polynomial.map_C, Polynomial.map_X, Polynomial.map_add, + Polynomial.map_mul, map_add, map_mul] + have hfour : algebraMap K[X] (RatFunc K) (4 : K[X]) = (4 : RatFunc K) := + map_natCast (algebraMap K[X] (RatFunc K)) 4 + rw [hfour] + ring + rw [heq] + exact hfractionGeneric + have hmonic : (cageOffDiagonalIteratedPolynomial xi eta d).Monic := by + have hquadratic : IsMonicOfDegree + (X ^ 2 - C (cagePulledRadicand xi d + cagePulledRadicand eta d) : K[X][X]) 2 := + (isMonicOfDegree_X_pow K[X] 2).sub (by simp) + exact ((hquadratic.pow 2).sub (by + have hpos : 0 < 2 * 2 := by norm_num + simpa only [← C_mul, natDegree_C] using hpos)).monic + exact hmonic.isPrimitive.irreducible_iff_irreducible_map_fraction_map.mpr + hfraction + +/-- Ground-field irreducibility of the off-diagonal bivariate polynomial. -/ +lemma cageOffDiagonalPlanePolynomial_irreducible + {xi eta : K} (hxi : xi ≠ 0) (heta : eta ≠ 0) + (hXi : xi ^ 2 - 4 ≠ 0) (hEta : eta ^ 2 - 4 ≠ 0) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) {d : ℕ} (hd : 0 < d) + (h2 : (2 : K) ≠ 0) (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Irreducible (cageOffDiagonalPlanePolynomial xi eta d) := by + have hiterated := cageOffDiagonalIteratedPolynomial_irreducible + hxi heta hXi hEta hoffDiagonal hd h2 hdegree + have hback := hiterated.map (finTwoToIteratedPolynomial (K := K)).symm + have heq : + (finTwoToIteratedPolynomial (K := K)).symm + (cageOffDiagonalIteratedPolynomial xi eta d) = + cageOffDiagonalPlanePolynomial xi eta d := by + rw [← finTwoToIteratedPolynomial_cageOffDiagonalPlanePolynomial] + exact (finTwoToIteratedPolynomial (K := K)).symm_apply_apply _ + rw [heq] at hback + exact hback + +/-- Scalar extension commutes with the explicit pulled radicand. -/ +lemma map_cagePulledRadicand + {L : Type*} [Field L] (phi : K →+* L) (xi : K) (d : ℕ) : + (cagePulledRadicand xi d).map phi = cagePulledRadicand (phi xi) d := by + have h4 : phi (4 : K) = (4 : L) := map_natCast phi 4 + simp only [cagePulledRadicand, Polynomial.map_sub, Polynomial.map_mul, + Polynomial.map_C, Polynomial.map_pow, Polynomial.map_X, + Polynomial.map_add, Polynomial.map_one, + map_sub, map_pow, map_mul] + rw [h4] + +/-- The diagonal plane model is absolutely irreducible. -/ +lemma cageDiagonalPlanePolynomial_absolutelyIrreducible + {xi : K} (hxi : xi ≠ 0) (hXi : xi ^ 2 - 4 ≠ 0) + {d : ℕ} (hd : 0 < d) (h2 : (2 : K) ≠ 0) + (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (cageDiagonalPlanePolynomial xi d)) := by + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + have hxi' : phi xi ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hxi + have hXi' : (phi xi) ^ 2 - 4 ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr hXi + rw [map_sub, map_pow] at hmapped + have hfour : phi (4 : K) = (4 : AlgebraicClosure K) := map_natCast phi 4 + rw [hfour] at hmapped + exact hmapped + have h2' : (2 : AlgebraicClosure K) ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr h2 + have htwo : phi (2 : K) = (2 : AlgebraicClosure K) := map_natCast phi 2 + rw [htwo] at hmapped + exact hmapped + have hdegree' : (((2 * d : ℕ) : AlgebraicClosure K)) ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr hdegree + have hcast : phi (((2 * d : ℕ) : K)) = + (((2 * d : ℕ) : AlgebraicClosure K)) := map_natCast phi (2 * d) + rw [hcast] at hmapped + exact hmapped + have hiterated := cageDiagonalIteratedPolynomial_irreducible + hxi' hXi' hd h2' hdegree' + have himage : + finTwoToIteratedPolynomial (K := AlgebraicClosure K) + (MvPolynomial.map phi (cageDiagonalPlanePolynomial xi d)) = + cageDiagonalIteratedPolynomial (phi xi) d := by + rw [finTwoToIteratedPolynomial_map] + simp [finTwoToIteratedPolynomial_cageDiagonalPlanePolynomial, + cageDiagonalIteratedPolynomial, adjoinSquarePolynomial, + map_cagePulledRadicand] + rw [← himage] at hiterated + have hback := hiterated.map + (finTwoToIteratedPolynomial (K := AlgebraicClosure K)).symm + simpa [phi] using hback + +/-- The off-diagonal primitive quartic is absolutely irreducible. -/ +lemma cageOffDiagonalPlanePolynomial_absolutelyIrreducible + {xi eta : K} (hxi : xi ≠ 0) (heta : eta ≠ 0) + (hXi : xi ^ 2 - 4 ≠ 0) (hEta : eta ^ 2 - 4 ≠ 0) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) {d : ℕ} (hd : 0 < d) + (h2 : (2 : K) ≠ 0) (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (cageOffDiagonalPlanePolynomial xi eta d)) := by + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + have hxi' : phi xi ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hxi + have heta' : phi eta ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr heta + have hXi' : (phi xi) ^ 2 - 4 ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr hXi + rw [map_sub, map_pow] at hmapped + have hfour : phi (4 : K) = (4 : AlgebraicClosure K) := map_natCast phi 4 + rw [hfour] at hmapped + exact hmapped + have hEta' : (phi eta) ^ 2 - 4 ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr hEta + rw [map_sub, map_pow] at hmapped + have hfour : phi (4 : K) = (4 : AlgebraicClosure K) := map_natCast phi 4 + rw [hfour] at hmapped + exact hmapped + have hoffDiagonal' : (phi xi) ^ 2 ≠ (phi eta) ^ 2 := by + intro h + apply hoffDiagonal + apply phi.injective + simpa only [map_pow] using h + have h2' : (2 : AlgebraicClosure K) ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr h2 + have htwo : phi (2 : K) = (2 : AlgebraicClosure K) := map_natCast phi 2 + rw [htwo] at hmapped + exact hmapped + have hdegree' : (((2 * d : ℕ) : AlgebraicClosure K)) ≠ 0 := by + have hmapped := (map_ne_zero_iff phi phi.injective).mpr hdegree + have hcast : phi (((2 * d : ℕ) : K)) = + (((2 * d : ℕ) : AlgebraicClosure K)) := map_natCast phi (2 * d) + rw [hcast] at hmapped + exact hmapped + have hiterated := cageOffDiagonalIteratedPolynomial_irreducible + hxi' heta' hXi' hEta' hoffDiagonal' hd h2' hdegree' + have himage : + finTwoToIteratedPolynomial (K := AlgebraicClosure K) + (MvPolynomial.map phi (cageOffDiagonalPlanePolynomial xi eta d)) = + cageOffDiagonalIteratedPolynomial (phi xi) (phi eta) d := by + rw [finTwoToIteratedPolynomial_map] + simp [finTwoToIteratedPolynomial_cageOffDiagonalPlanePolynomial, + cageOffDiagonalIteratedPolynomial, map_cagePulledRadicand] + rw [← himage] at hiterated + have hback := hiterated.map + (finTwoToIteratedPolynomial (K := AlgebraicClosure K)).symm + simpa [phi] using hback + +private lemma degreeOf_C_mul_X_one_pow_first_le (a : K) (n : ℕ) : + MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C a * MvPolynomial.X 1 ^ n) ≤ 0 := by + refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + rw [MvPolynomial.degreeOf_C, + MvPolynomial.degreeOf_X_pow_of_ne n (by decide : (0 : Fin 2) ≠ 1)] + +private lemma degreeOf_C_mul_X_one_pow_second_le (a : K) (n : ℕ) : + MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.C a * MvPolynomial.X 1 ^ n) ≤ n := by + refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + rw [MvPolynomial.degreeOf_C, MvPolynomial.degreeOf_X_self_pow] + omega + +/-- Coordinate-degree bound for a pulled radicand: it is independent of the +root coordinate. -/ +lemma cagePulledRadicandSecondCoordinate_degreeOf_first_le + (xi : K) (d : ℕ) : + MvPolynomial.degreeOf (0 : Fin 2) + (cagePulledRadicandSecondCoordinate xi d) ≤ 0 := by + unfold cagePulledRadicandSecondCoordinate + refine (MvPolynomial.degreeOf_add_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · exact degreeOf_C_mul_X_one_pow_first_le _ _ + · exact degreeOf_C_mul_X_one_pow_first_le _ _ + · rw [MvPolynomial.degreeOf_C] + +/-- Coordinate-degree bound for a pulled radicand in the power parameter. -/ +lemma cagePulledRadicandSecondCoordinate_degreeOf_second_le + (xi : K) (d : ℕ) : + MvPolynomial.degreeOf (1 : Fin 2) + (cagePulledRadicandSecondCoordinate xi d) ≤ 4 * d := by + unfold cagePulledRadicandSecondCoordinate + refine (MvPolynomial.degreeOf_add_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · exact degreeOf_C_mul_X_one_pow_second_le _ _ + · exact (degreeOf_C_mul_X_one_pow_second_le _ _).trans (by omega) + · rw [MvPolynomial.degreeOf_C] + omega + +/-- The diagonal model has bidegree at most `(2,4d)`. -/ +lemma cageDiagonalPlanePolynomial_hasBidegreeAtMost (xi : K) (d : ℕ) : + BGS.External.HasBidegreeAtMost + (cageDiagonalPlanePolynomial xi d) 2 (4 * d) := by + have hfirst : MvPolynomial.degreeOf (0 : Fin 2) + (cageDiagonalPlanePolynomial xi d) ≤ 2 := by + unfold cageDiagonalPlanePolynomial + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · simp + · exact (cagePulledRadicandSecondCoordinate_degreeOf_first_le xi d).trans + (by omega) + have hsecond : MvPolynomial.degreeOf (1 : Fin 2) + (cageDiagonalPlanePolynomial xi d) ≤ 4 * d := by + unfold cageDiagonalPlanePolynomial + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · rw [MvPolynomial.degreeOf_X_pow_of_ne 2 (by decide : (1 : Fin 2) ≠ 0)] + omega + · exact cagePulledRadicandSecondCoordinate_degreeOf_second_le xi d + intro monomial hmonomial + exact ⟨(MvPolynomial.degreeOf_le_iff.mp hfirst) monomial hmonomial, + (MvPolynomial.degreeOf_le_iff.mp hsecond) monomial hmonomial⟩ + +/-- The primitive off-diagonal quartic has bidegree at most `(4,8d)`. -/ +lemma cageOffDiagonalPlanePolynomial_hasBidegreeAtMost + (xi eta : K) (d : ℕ) : + BGS.External.HasBidegreeAtMost + (cageOffDiagonalPlanePolynomial xi eta d) 4 (8 * d) := by + have hfirst : MvPolynomial.degreeOf (0 : Fin 2) + (cageOffDiagonalPlanePolynomial xi eta d) ≤ 4 := by + unfold cageOffDiagonalPlanePolynomial + have hsum : MvPolynomial.degreeOf (0 : Fin 2) + (cagePulledRadicandSecondCoordinate xi d + + cagePulledRadicandSecondCoordinate eta d) ≤ 0 := + (MvPolynomial.degreeOf_add_le _ _ _).trans (max_le + (cagePulledRadicandSecondCoordinate_degreeOf_first_le xi d) + (cagePulledRadicandSecondCoordinate_degreeOf_first_le eta d)) + have hinside : MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.X 0 ^ 2 - + (cagePulledRadicandSecondCoordinate xi d + + cagePulledRadicandSecondCoordinate eta d)) ≤ 2 := + (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le (by simp) (hsum.trans (by omega))) + have hsquare := MvPolynomial.degreeOf_pow_le (0 : Fin 2) + (MvPolynomial.X 0 ^ 2 - + (cagePulledRadicandSecondCoordinate xi d + + cagePulledRadicandSecondCoordinate eta d)) 2 + have hproduct : MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C 4 * cagePulledRadicandSecondCoordinate xi d * + cagePulledRadicandSecondCoordinate eta d) ≤ 0 := by + have hleft : MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C 4 * cagePulledRadicandSecondCoordinate xi d) ≤ 0 := by + refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + rw [MvPolynomial.degreeOf_C] + simpa using cagePulledRadicandSecondCoordinate_degreeOf_first_le xi d + refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + exact (add_le_add hleft + (cagePulledRadicandSecondCoordinate_degreeOf_first_le eta d)).trans (by omega) + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · exact hsquare.trans (by omega) + · exact hproduct.trans (by omega) + have hsecond : MvPolynomial.degreeOf (1 : Fin 2) + (cageOffDiagonalPlanePolynomial xi eta d) ≤ 8 * d := by + unfold cageOffDiagonalPlanePolynomial + have hsum : MvPolynomial.degreeOf (1 : Fin 2) + (cagePulledRadicandSecondCoordinate xi d + + cagePulledRadicandSecondCoordinate eta d) ≤ 4 * d := + (MvPolynomial.degreeOf_add_le _ _ _).trans (max_le + (cagePulledRadicandSecondCoordinate_degreeOf_second_le xi d) + (cagePulledRadicandSecondCoordinate_degreeOf_second_le eta d)) + have hinside : MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.X 0 ^ 2 - + (cagePulledRadicandSecondCoordinate xi d + + cagePulledRadicandSecondCoordinate eta d)) ≤ 4 * d := by + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ hsum) + rw [MvPolynomial.degreeOf_X_pow_of_ne 2 (by decide : (1 : Fin 2) ≠ 0)] + omega + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · exact (MvPolynomial.degreeOf_pow_le _ _ _).trans + ((Nat.mul_le_mul_left 2 hinside).trans (by omega)) + · have hleft : MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.C 4 * cagePulledRadicandSecondCoordinate xi d) ≤ 4 * d := by + refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + rw [MvPolynomial.degreeOf_C] + simpa using cagePulledRadicandSecondCoordinate_degreeOf_second_le xi d + refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + exact (add_le_add hleft + (cagePulledRadicandSecondCoordinate_degreeOf_second_le eta d)).trans (by omega) + intro monomial hmonomial + exact ⟨(MvPolynomial.degreeOf_le_iff.mp hfirst) monomial hmonomial, + (MvPolynomial.degreeOf_le_iff.mp hsecond) monomial hmonomial⟩ + +/-- Evaluation of the embedded radicand is ordinary univariate evaluation +in the second coordinate. -/ +lemma eval_cagePulledRadicandSecondCoordinate + (xi : K) (d : ℕ) (root parameter : K) : + MvPolynomial.eval ![root, parameter] + (cagePulledRadicandSecondCoordinate xi d) = + (cagePulledRadicand xi d).eval parameter := by + rw [cagePulledRadicand_expanded] + simp [cagePulledRadicandSecondCoordinate] + +/-- Zeros of the diagonal plane model are exactly square roots of the +pulled radicand. -/ +lemma eval_cageDiagonalPlanePolynomial_eq_zero_iff + (xi : K) (d : ℕ) (root parameter : K) : + MvPolynomial.eval ![root, parameter] + (cageDiagonalPlanePolynomial xi d) = 0 ↔ + root ^ 2 = (cagePulledRadicand xi d).eval parameter := by + simp [cageDiagonalPlanePolynomial, + eval_cagePulledRadicandSecondCoordinate, sub_eq_zero] + +/-- Evaluation of the off-diagonal plane model is the primitive quartic in +the two scalar radicand values. -/ +lemma eval_cageOffDiagonalPlanePolynomial + (xi eta : K) (d : ℕ) (sumRoot parameter : K) : + MvPolynomial.eval ![sumRoot, parameter] + (cageOffDiagonalPlanePolynomial xi eta d) = + (sumRoot ^ 2 - + ((cagePulledRadicand xi d).eval parameter + + (cagePulledRadicand eta d).eval parameter)) ^ 2 - + 4 * (cagePulledRadicand xi d).eval parameter * + (cagePulledRadicand eta d).eval parameter := by + simp [cageOffDiagonalPlanePolynomial, + eval_cagePulledRadicandSecondCoordinate] + +/-- Away from the primitive-coordinate boundary `S = 0`, the quartic +equation is equivalent to retaining both quadratic roots. The explicit +inverse is +`L = (S² + f - g)/(2S)`, `M = (S² - f + g)/(2S)`. -/ +lemma primitiveQuarticEquation_iff_exists_rootPair + (h2 : (2 : K) ≠ 0) {f g sumRoot : K} (hsum : sumRoot ≠ 0) : + (sumRoot ^ 2 - (f + g)) ^ 2 - 4 * f * g = 0 ↔ + ∃ firstRoot secondRoot : K, + firstRoot ^ 2 = f ∧ secondRoot ^ 2 = g ∧ + firstRoot + secondRoot = sumRoot := by + constructor + · intro hequation + let firstRoot := (sumRoot ^ 2 + f - g) / (2 * sumRoot) + let secondRoot := (sumRoot ^ 2 - f + g) / (2 * sumRoot) + have hdenominator : 2 * sumRoot ≠ 0 := mul_ne_zero h2 hsum + refine ⟨firstRoot, secondRoot, ?_, ?_, ?_⟩ + · dsimp [firstRoot] + field_simp [hdenominator] + linear_combination hequation + · dsimp [secondRoot] + field_simp [hdenominator] + linear_combination hequation + · dsimp [firstRoot, secondRoot] + field_simp [hdenominator] + ring + · rintro ⟨firstRoot, secondRoot, hfirst, hsecond, hsumRoot⟩ + rw [← hfirst, ← hsecond, ← hsumRoot] + ring + +/-- The preceding primitive-element equivalence applied to the actual cage +plane equation. -/ +lemma eval_cageOffDiagonalPlanePolynomial_eq_zero_iff_exists_rootPair + (h2 : (2 : K) ≠ 0) (xi eta : K) (d : ℕ) + {sumRoot parameter : K} (hsum : sumRoot ≠ 0) : + MvPolynomial.eval ![sumRoot, parameter] + (cageOffDiagonalPlanePolynomial xi eta d) = 0 ↔ + ∃ firstRoot secondRoot : K, + firstRoot ^ 2 = (cagePulledRadicand xi d).eval parameter ∧ + secondRoot ^ 2 = (cagePulledRadicand eta d).eval parameter ∧ + firstRoot + secondRoot = sumRoot := by + rw [eval_cageOffDiagonalPlanePolynomial] + exact primitiveQuarticEquation_iff_exists_rootPair h2 hsum + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean new file mode 100644 index 0000000000..dcd27df818 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean @@ -0,0 +1,275 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations + +/-! +# The one-sided power cover of the cage witness equations + +This file identifies the exact `d`-fold cover counted before passage to the +power-map range with the two pulled radicand equations. Both incidence roots +remain part of the data. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Clearing the denominator in one incidence equation gives exactly the +pulled radicand. -/ +lemma scaled_incidenceEquation_iff_pulledRadicand + (u xi root : K) (hu : u ≠ 0) (d : ℕ) : + (xi ^ 2 - 4) * (u ^ d + (u ^ d)⁻¹) ^ 2 - root ^ 2 = 4 * xi ^ 2 ↔ + (u ^ d * root) ^ 2 = (cagePulledRadicand xi d).eval u := by + rw [cagePulledRadicand] + simp only [Polynomial.eval_sub, Polynomial.eval_mul, Polynomial.eval_C, + Polynomial.eval_pow, Polynomial.eval_X, Polynomial.eval_add, + Polynomial.eval_one] + have hpow : u ^ (2 * d) = (u ^ d) ^ 2 := by + rw [Nat.mul_comm, pow_mul] + rw [hpow] + have hud : u ^ d ≠ 0 := pow_ne_zero d hu + have hclear : + (u ^ d) ^ 2 * + ((xi ^ 2 - 4) * (u ^ d + (u ^ d)⁻¹) ^ 2 - root ^ 2) = + (xi ^ 2 - 4) * ((u ^ d) ^ 2 + 1) ^ 2 - + (u ^ d) ^ 2 * root ^ 2 := by + field_simp [hud] + constructor + · intro h + have hscaled : + (xi ^ 2 - 4) * ((u ^ d) ^ 2 + 1) ^ 2 - + (u ^ d) ^ 2 * root ^ 2 = + (u ^ d) ^ 2 * (4 * xi ^ 2) := by + rw [← hclear, h] + calc + (u ^ d * root) ^ 2 = (u ^ d) ^ 2 * root ^ 2 := by ring + _ = (xi ^ 2 - 4) * ((u ^ d) ^ 2 + 1) ^ 2 - + 4 * xi ^ 2 * (u ^ d) ^ 2 := by + linear_combination -hscaled + · intro h + apply (mul_left_cancel₀ (pow_ne_zero 2 hud)) + calc + (u ^ d) ^ 2 * + ((xi ^ 2 - 4) * (u ^ d + (u ^ d)⁻¹) ^ 2 - root ^ 2) = + (xi ^ 2 - 4) * ((u ^ d) ^ 2 + 1) ^ 2 - + (u ^ d) ^ 2 * root ^ 2 := hclear + _ = (u ^ d) ^ 2 * (4 * xi ^ 2) := by + linear_combination -h + _ = (u ^ d) ^ 2 * (4 * xi ^ 2) := rfl + +/-- The exact pulled pair of quadratic roots over a nonzero power parameter. -/ +structure CagePulledRootPair + (p : ℕ) [Fact p.Prime] (xi eta : ZMod p) (d : ℕ) where + /-- The parameter before applying the `d`-th power map. -/ + parameter : (ZMod p)ˣ + /-- The first denominator-cleared incidence root. -/ + firstRoot : ZMod p + /-- The second denominator-cleared incidence root. -/ + secondRoot : ZMod p + /-- First pulled radicand equation. -/ + firstEquation : + firstRoot ^ 2 = (cagePulledRadicand xi d).eval (parameter : ZMod p) + /-- Second pulled radicand equation. -/ + secondEquation : + secondRoot ^ 2 = (cagePulledRadicand eta d).eval (parameter : ZMod p) + +@[ext] +lemma CagePulledRootPair.ext + {p : ℕ} [Fact p.Prime] {xi eta : ZMod p} {d : ℕ} + {x y : CagePulledRootPair p xi eta d} + (hparameter : x.parameter = y.parameter) + (hfirst : x.firstRoot = y.firstRoot) + (hsecond : x.secondRoot = y.secondRoot) : x = y := by + cases x + cases y + simp_all + +/-- The canonical witness-bearing one-sided cover. -/ +abbrev canonicalCagePowerCoverSolutions + (p : ℕ) [Fact p.Prime] (xi eta : ZMod p) (d : ℕ) := + BGS.rightPowerTraceCoverSolutions + (cageMiddleWitnessTrace (p := p) (axis := .first) (other := .second) + (xi := xi) (eta := eta)) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d + +/-- Scale the two retained incidence roots by the common denominator. -/ +def canonicalCagePowerCoverToPulled + (p : ℕ) [Fact p.Prime] (xi eta : ZMod p) (d : ℕ) : + canonicalCagePowerCoverSolutions p xi eta d → + CagePulledRootPair p xi eta d := fun z => by + let equations := canonicalCageWitnessToEquations p xi eta z.1.1 + let parameter := z.1.2 + have hmiddle : equations.middle = splitTorusTrace (parameter ^ d) := by + simpa [equations, parameter, canonicalCageWitnessToEquations, + cageMiddleWitnessTrace, normalizedCoordinateAt, cageBridgeAxis] using z.2 + refine + { parameter := parameter + firstRoot := (parameter : ZMod p) ^ d * equations.firstRoot + secondRoot := (parameter : ZMod p) ^ d * equations.secondRoot + firstEquation := ?_ + secondEquation := ?_ } + · apply (scaled_incidenceEquation_iff_pulledRadicand + (parameter : ZMod p) xi equations.firstRoot parameter.ne_zero d).mp + have htrace : + (parameter : ZMod p) ^ d + ((parameter : ZMod p) ^ d)⁻¹ = + splitTorusTrace (parameter ^ d) := by + simp [splitTorusTrace] + rw [htrace, ← hmiddle] + exact equations.firstEquation + · apply (scaled_incidenceEquation_iff_pulledRadicand + (parameter : ZMod p) eta equations.secondRoot parameter.ne_zero d).mp + have htrace : + (parameter : ZMod p) ^ d + ((parameter : ZMod p) ^ d)⁻¹ = + splitTorusTrace (parameter ^ d) := by + simp [splitTorusTrace] + rw [htrace, ← hmiddle] + exact equations.secondEquation + +/-- Recover the unscaled incidence roots and the two actual Markoff points. -/ +def canonicalCagePulledToPowerCover + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (d : ℕ) : + CagePulledRootPair p xi eta d → + canonicalCagePowerCoverSolutions p xi eta d := fun z => by + let q : ZMod p := (z.parameter : ZMod p) ^ d + have hq : q ≠ 0 := pow_ne_zero d z.parameter.ne_zero + let equations : CageIncidenceEquationWitness p xi eta := + { middle := splitTorusTrace (z.parameter ^ d) + firstRoot := q⁻¹ * z.firstRoot + secondRoot := q⁻¹ * z.secondRoot + firstEquation := by + have h := (scaled_incidenceEquation_iff_pulledRadicand + (z.parameter : ZMod p) xi (q⁻¹ * z.firstRoot) + z.parameter.ne_zero d).mpr (by + simpa [q, hq] using z.firstEquation) + simpa [splitTorusTrace] using h + secondEquation := by + have h := (scaled_incidenceEquation_iff_pulledRadicand + (z.parameter : ZMod p) eta (q⁻¹ * z.secondRoot) + z.parameter.ne_zero d).mpr (by + simpa [q, hq] using z.secondEquation) + simpa [splitTorusTrace] using h } + let witness := canonicalCageEquationsToWitness p hpTwo xi eta equations + refine ⟨(witness, z.parameter), ?_⟩ + simp [witness, equations, canonicalCageEquationsToWitness, + cageMiddleWitnessTrace, normalizedCoordinateAt, cageBridgeAxis] + +@[simp] +lemma canonicalCageWitnessToEquations_equationsToWitness + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (z : CageIncidenceEquationWitness p xi eta) : + canonicalCageWitnessToEquations p xi eta + (canonicalCageEquationsToWitness p hpTwo xi eta z) = z := by + exact (canonicalCageWitnessEquivIncidenceEquations + p hpTwo xi eta).apply_symm_apply z + +/-- The canonical one-sided cage power cover is exactly the pulled pair of +radicand equations. -/ +def canonicalCagePowerCoverEquivPulled + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (d : ℕ) : + canonicalCagePowerCoverSolutions p xi eta d ≃ + CagePulledRootPair p xi eta d where + toFun := canonicalCagePowerCoverToPulled p xi eta d + invFun := canonicalCagePulledToPowerCover p hpTwo xi eta d + left_inv := by + intro z + have hTwo : (2 : ZMod p) ≠ 0 := by + exact two_ne_zero_zmod + (lt_of_le_of_ne (Fact.out : p.Prime).two_le (Ne.symm hpTwo)) + have hxiCoordinate : z.1.1.1.1.u1 = xi := by + simpa [normalizedFiberAt] using z.1.1.2.1.2 + have hetaCoordinate : z.1.1.1.2.u2 = eta := by + simpa [normalizedFiberAt] using z.1.1.2.2.1.2 + have hmiddleFirst : z.1.1.1.1.u3 = splitTorusTrace (z.1.2 ^ d) := by + simpa [cageMiddleWitnessTrace, normalizedCoordinateAt, + cageBridgeAxis] using z.2 + have hmiddleCommon : z.1.1.1.1.u3 = z.1.1.1.2.u3 := by + simpa [normalizedCoordinateAt, cageBridgeAxis] using z.1.1.2.2.2 + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext + apply Prod.ext <;> apply NormalizedPoint.ext + · simpa [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] using hxiCoordinate.symm + · simp [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] + rw [← hmiddleFirst] + field_simp [hTwo] + ring + · simpa [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] using hmiddleFirst.symm + · simp [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] + rw [← hmiddleFirst] + field_simp [hTwo] + ring + · simpa [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] using hetaCoordinate.symm + · simpa [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] using + hmiddleFirst.symm.trans hmiddleCommon + · rfl + right_inv := by + intro z + apply CagePulledRootPair.ext + · rfl + · simp [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations_equationsToWitness] + · simp [canonicalCagePowerCoverToPulled, + canonicalCagePulledToPowerCover, + canonicalCageWitnessToEquations_equationsToWitness] + +/-- Exact division of the pulled affine cover by the `d`-th power-map +fibers. -/ +theorem natCard_cagePulledRootPair_eq_mul_canonicalPowerRange + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (xi eta : ZMod p) (d : ℕ) (hd : d ∣ p - 1) : + Nat.card (CagePulledRootPair p xi eta d) = + d * Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) := by + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hdCard : d ∣ Nat.card (ZMod p)ˣ := by + rw [hcard] + exact hd + letI : Finite (CageMiddleWitnessPair p .first .second xi eta) := + Finite.of_injective Subtype.val Subtype.val_injective + calc + Nat.card (CagePulledRootPair p xi eta d) = + Nat.card (canonicalCagePowerCoverSolutions p xi eta d) := + Nat.card_congr (canonicalCagePowerCoverEquivPulled + p hpTwo xi eta d).symm + _ = d * Nat.card (cageMiddleWitnessPowerRangeSolutions + p .first .second xi eta d) := by + simpa [canonicalCagePowerCoverSolutions, + cageMiddleWitnessPowerRangeSolutions] using + (BGS.natCard_rightPowerTraceCoverSolutions_of_dvd + (cageMiddleWitnessTrace + (p := p) (axis := .first) (other := .second) + (xi := xi) (eta := eta)) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d hdCard) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean new file mode 100644 index 0000000000..03f5cda68c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean @@ -0,0 +1,266 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +import Mathlib.FieldTheory.IsAlgClosed.Basic + +/-! +# Pulled-back cage radicands + +After writing the common normalized trace as `t^d + t⁻ᵈ` and multiplying +an incidence root by `t^d`, the retained quadratic equation becomes + +`L² = (ξ² - 4) (t^(2d) + 1)² - 4 ξ² t^(2d)`. + +This file proves the square-class facts needed for the direct affine-plane +Hasse--Weil model. In particular, the off-diagonal argument is not hidden +behind a geometric-integrality assumption: the two pulled radicands are +proved squarefree and coprime explicitly. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The radicand obtained after pulling an incidence conic back along the +power-trace parameter `t ↦ t^d + t⁻ᵈ` and clearing `t⁻ᵈ`. -/ +def cagePulledRadicand (xi : K) (d : ℕ) : K[X] := + C (xi ^ 2 - 4) * (X ^ (2 * d) + 1) ^ 2 - + C (4 * xi ^ 2) * X ^ (2 * d) + +@[simp] +lemma cagePulledRadicand_eval_zero (xi : K) {d : ℕ} (hd : 0 < d) : + (cagePulledRadicand xi d).eval 0 = xi ^ 2 - 4 := by + simp [cagePulledRadicand, Nat.ne_of_gt hd] + +@[simp] +lemma cagePulledRadicand_eval_one (xi : K) (d : ℕ) : + (cagePulledRadicand xi d).eval 1 = -16 := by + simp [cagePulledRadicand] + ring + +/-- Distinct squared cage traces give radicands whose difference is a +nonzero scalar times `(t^(2d) - 1)²`. -/ +lemma cagePulledRadicand_sub (xi eta : K) (d : ℕ) : + cagePulledRadicand xi d - cagePulledRadicand eta d = + C (xi ^ 2 - eta ^ 2) * (X ^ (2 * d) - 1) ^ 2 := by + simp only [cagePulledRadicand, map_sub, map_pow, map_ofNat, map_mul] + ring + +/-- Formal derivative of the pulled radicand. -/ +lemma cagePulledRadicand_derivative (xi : K) (d : ℕ) : + (cagePulledRadicand xi d).derivative = + C (((2 * d : ℕ) : K)) * X ^ (2 * d - 1) * + (2 * C (xi ^ 2 - 4) * (X ^ (2 * d) + 1) - + C (4 * xi ^ 2)) := by + simp only [cagePulledRadicand, + derivative_sub, derivative_mul, derivative_C, zero_mul, zero_add, + derivative_add, derivative_one, add_zero, derivative_pow, derivative_X, + mul_one] + simp only [map_sub, map_pow, map_natCast, map_mul] + ring + +/-- The pulled radicand has no repeated geometric root under the exact +nondegeneracy assumptions used in the cage. -/ +lemma cagePulledRadicand_separable + (h2 : (2 : K) ≠ 0) {xi : K} (hxi : xi ≠ 0) + (hparabolic : xi ^ 2 - 4 ≠ 0) {d : ℕ} (hd : 0 < d) + (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + (cagePulledRadicand xi d).Separable := by + rw [separable_def] + apply (Polynomial.isCoprime_iff_aeval_ne_zero_of_isAlgClosed + (k := K) (AlgebraicClosure K) (cagePulledRadicand xi d) + (cagePulledRadicand xi d).derivative).2 + intro t + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + by_contra hcommon + push Not at hcommon + rcases hcommon with ⟨hroot, hderivative⟩ + have hphiTwo : phi 2 ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr h2 + have hphiXi : phi xi ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hxi + have hphiA : phi (xi ^ 2 - 4) ≠ 0 := + (map_ne_zero_iff phi phi.injective).mpr hparabolic + have hphiDegree : phi (((2 * d : ℕ) : K)) ≠ 0 := + (map_ne_zero_iff phi phi.injective).mpr hdegree + have ht : t ≠ 0 := by + intro ht + subst t + apply hphiA + simpa [cagePulledRadicand, phi, Nat.ne_of_gt hd] using hroot + have hcritical : + 2 * phi (xi ^ 2 - 4) * (t ^ (2 * d) + 1) - + phi (4 * xi ^ 2) = 0 := by + rw [cagePulledRadicand_derivative] at hderivative + have hderivative' : + phi (((2 * d : ℕ) : K)) * t ^ (2 * d - 1) * + (2 * phi (xi ^ 2 - 4) * (t ^ (2 * d) + 1) - + phi (4 * xi ^ 2)) = 0 := by + simpa only [aeval_def, eval₂_mul, eval₂_C, eval₂_pow, eval₂_X, + eval₂_sub, eval₂_add, eval₂_one, eval₂_ofNat] using hderivative + exact (mul_eq_zero.mp hderivative').resolve_left + (mul_ne_zero hphiDegree (pow_ne_zero _ ht)) + have hroot' : + phi (xi ^ 2 - 4) * (t ^ (2 * d) + 1) ^ 2 - + phi (4 * xi ^ 2) * t ^ (2 * d) = 0 := by + simpa only [cagePulledRadicand, aeval_def, eval₂_mul, eval₂_C, + eval₂_pow, eval₂_X, eval₂_sub, eval₂_add, eval₂_one] using hroot + have hone : t ^ (2 * d) = 1 := by + have hnonzero : phi (4 * xi ^ 2) ≠ 0 := by + apply (map_ne_zero_iff phi phi.injective).mpr + have h4 : (4 : K) ≠ 0 := by + rw [show (4 : K) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 h2 + exact mul_ne_zero h4 (pow_ne_zero 2 hxi) + have hproduct : + phi (4 * xi ^ 2) * (1 - t ^ (2 * d)) = 0 := by + linear_combination 2 * hroot' - (t ^ (2 * d) + 1) * hcritical + exact (sub_eq_zero.mp ((mul_eq_zero.mp hproduct).resolve_left hnonzero)).symm + have : phi (16 : K) = 0 := by + apply neg_eq_zero.mp + calc + -phi (16 : K) = + 2 * phi (xi ^ 2 - 4) * (1 + 1) - phi (4 * xi ^ 2) := by + simp only [map_sub, map_pow, map_ofNat, map_mul] + ring + _ = 0 := by simpa [hone] using hcritical + have h16 : (16 : K) ≠ 0 := by + rw [show (16 : K) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 h2 + exact (map_ne_zero_iff phi phi.injective).mpr h16 this + +/-- Expanded form, used to read off the leading coefficient and degree. -/ +lemma cagePulledRadicand_expanded (xi : K) (d : ℕ) : + cagePulledRadicand xi d = + C (xi ^ 2 - 4) * X ^ (4 * d) - + C (2 * (xi ^ 2 + 4)) * X ^ (2 * d) + C (xi ^ 2 - 4) := by + have hC2 : (C (2 : K) : K[X]) = 2 := + map_natCast (Polynomial.C : K →+* K[X]) 2 + have hC4 : (C (4 : K) : K[X]) = 4 := + map_natCast (Polynomial.C : K →+* K[X]) 4 + simp only [cagePulledRadicand, map_sub, map_pow, map_mul, map_add] + rw [hC2, hC4] + ring_nf + +/-- The coefficient of `t^(4d)` is the nonparabolic factor `xi² - 4`. -/ +lemma cagePulledRadicand_coeff_four_mul + (xi : K) {d : ℕ} (hd : 0 < d) : + (cagePulledRadicand xi d).coeff (4 * d) = xi ^ 2 - 4 := by + rw [cagePulledRadicand_expanded] + rw [coeff_add, coeff_sub, coeff_C_mul_X_pow, + coeff_C_mul_X_pow, coeff_C] + simp only [if_true, if_neg (show 4 * d ≠ 2 * d by omega), + if_neg (show 4 * d ≠ 0 by omega), sub_zero, add_zero] + +/-- A nonparabolic pulled radicand is not a polynomial unit. -/ +lemma cagePulledRadicand_not_isUnit + {xi : K} (hparabolic : xi ^ 2 - 4 ≠ 0) {d : ℕ} (hd : 0 < d) : + ¬ IsUnit (cagePulledRadicand xi d) := by + apply not_isUnit_of_natDegree_pos + have hcoeff : (cagePulledRadicand xi d).coeff (4 * d) ≠ 0 := by + simpa [cagePulledRadicand_coeff_four_mul xi hd] using hparabolic + have hle := Polynomial.le_natDegree_of_ne_zero hcoeff + omega + +/-- Off the diagonal, the two pulled radicands have disjoint geometric +zero sets. The displayed difference reduces a hypothetical common zero to +`t^(2d)=1`, where every radicand takes the value `-16`. -/ +lemma cagePulledRadicand_isCoprime + (h2 : (2 : K) ≠ 0) {xi eta : K} (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) + (d : ℕ) : + IsCoprime (cagePulledRadicand xi d) (cagePulledRadicand eta d) := by + apply (Polynomial.isCoprime_iff_aeval_ne_zero_of_isAlgClosed + (k := K) (AlgebraicClosure K) (cagePulledRadicand xi d) + (cagePulledRadicand eta d)).2 + intro t + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + by_contra hcommon + push Not at hcommon + rcases hcommon with ⟨hxiRoot, hetaRoot⟩ + have hdifference := congrArg (fun f : K[X] => aeval t f) + (cagePulledRadicand_sub xi eta d) + have hproduct : + phi (xi ^ 2 - eta ^ 2) * (t ^ (2 * d) - 1) ^ 2 = 0 := by + simpa only [map_sub, aeval_def, eval₂_sub, eval₂_mul, eval₂_C, + eval₂_pow, eval₂_X, eval₂_one, hxiRoot, hetaRoot, zero_sub, neg_zero] + using hdifference.symm + have hscalar : phi (xi ^ 2 - eta ^ 2) ≠ 0 := + (map_ne_zero_iff phi phi.injective).mpr (sub_ne_zero.mpr hoffDiagonal) + have hpower : t ^ (2 * d) = 1 := by + have hsquare : (t ^ (2 * d) - 1) ^ 2 = 0 := + (mul_eq_zero.mp hproduct).resolve_left hscalar + have hbase : t ^ (2 * d) - 1 = 0 := by + apply (mul_self_eq_zero.mp) + simpa [pow_two] using hsquare + exact sub_eq_zero.mp hbase + have hminusSixteen : phi (-16 : K) = 0 := by + calc + phi (-16 : K) = + phi (xi ^ 2 - 4) * (t ^ (2 * d) + 1) ^ 2 - + phi (4 * xi ^ 2) * t ^ (2 * d) := by + have hfour : ((1 : AlgebraicClosure K) + 1) ^ 2 = phi (4 : K) := by + calc + ((1 : AlgebraicClosure K) + 1) ^ 2 = 4 := by norm_num + _ = phi (4 : K) := (map_natCast phi 4).symm + rw [hpower, hfour, mul_one] + rw [← map_mul, ← map_sub] + congr 1 + ring + _ = aeval t (cagePulledRadicand xi d) := by + simp only [phi, cagePulledRadicand, aeval_def, eval₂_sub, eval₂_mul, + eval₂_C, eval₂_pow, eval₂_X, eval₂_add, eval₂_one] + _ = 0 := hxiRoot + have h16 : (16 : K) ≠ 0 := by + rw [show (16 : K) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 h2 + exact (map_ne_zero_iff phi phi.injective).mpr (neg_ne_zero.mpr h16) hminusSixteen + +/-- The two off-diagonal radicands and their product are squarefree. -/ +lemma cagePulledRadicand_squarefree_and_product + (h2 : (2 : K) ≠ 0) {xi eta : K} + (hxi : xi ≠ 0) (heta : eta ≠ 0) + (hXi : xi ^ 2 - 4 ≠ 0) (hEta : eta ^ 2 - 4 ≠ 0) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) {d : ℕ} (hd : 0 < d) + (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + Squarefree (cagePulledRadicand xi d) ∧ + Squarefree (cagePulledRadicand eta d) ∧ + Squarefree (cagePulledRadicand xi d * cagePulledRadicand eta d) := by + have hsepXi := cagePulledRadicand_separable h2 hxi hXi hd hdegree + have hsepEta := cagePulledRadicand_separable h2 heta hEta hd hdegree + have hcoprime := cagePulledRadicand_isCoprime h2 hoffDiagonal d + exact ⟨hsepXi.squarefree, hsepEta.squarefree, + (hsepXi.mul hsepEta hcoprime).squarefree⟩ + +/-- The pulled radicands define two independent quadratic square classes in +the rational function field. This is the algebraic content of the paper's +disjoint-branch argument. -/ +lemma cagePulledRadicand_squareClasses_independent_ratFunc + (h2 : (2 : K) ≠ 0) {xi eta : K} + (hxi : xi ≠ 0) (heta : eta ≠ 0) + (hXi : xi ^ 2 - 4 ≠ 0) (hEta : eta ^ 2 - 4 ≠ 0) + (hoffDiagonal : xi ^ 2 ≠ eta ^ 2) {d : ℕ} (hd : 0 < d) + (hdegree : (((2 * d : ℕ) : K)) ≠ 0) : + ¬ IsSquare (algebraMap K[X] (RatFunc K) (cagePulledRadicand xi d)) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) (cagePulledRadicand eta d)) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) + (cagePulledRadicand xi d * cagePulledRadicand eta d)) := by + obtain ⟨hsqXi, hsqEta, hsqProduct⟩ := + cagePulledRadicand_squarefree_and_product h2 hxi heta hXi hEta + hoffDiagonal hd hdegree + exact ⟨not_isSquare_algebraMap_of_squarefree_not_isUnit hsqXi + (cagePulledRadicand_not_isUnit hXi hd), + not_isSquare_algebraMap_of_squarefree_not_isUnit hsqEta + (cagePulledRadicand_not_isUnit hEta hd), + not_isSquare_algebraMap_of_squarefree_not_isUnit hsqProduct (by + intro hunit + exact cagePulledRadicand_not_isUnit hXi hd (IsUnit.mul_iff.mp hunit).1)⟩ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean new file mode 100644 index 0000000000..1c44af9c4e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean @@ -0,0 +1,335 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry + +/-! +# The shifted cage trace cover + +The off-diagonal cage base is the biquadratic incidence function field in the +common original coordinate `y`. The next cover adjoins a root `R` of + +`R^2 - (3y) * R + 1`. + +This file proves the genuinely new branch calculation: the discriminant +`9y^2 - 4` is independent of both incidence square classes, remains a +nonsquare after the two quadratic adjunctions, and hence makes the trace +quadratic irreducible over the exact incidence function-field presentation. + +It deliberately does not claim that `R` is not a `q`-th power. That +place-at-infinity statement is the remaining Kummer obstruction for the +full shifted Laurent cover. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The discriminant `9y² - 4` of the normalized trace quadratic. -/ +def cageTraceBranchPolynomial : K[X] := + C 9 * X ^ 2 - C 4 + +/-- The quadratic whose root is a unit with prescribed trace. -/ +def traceRootPolynomial {R : Type*} [CommRing R] (trace : R) : R[X] := + X ^ 2 - C trace * X + 1 + +/-- The prescribed-trace quadratic is monic. -/ +lemma traceRootPolynomial_monic {R : Type*} [Nontrivial R] [CommRing R] (trace : R) : + (traceRootPolynomial trace).Monic := by + simpa [traceRootPolynomial] using isMonicOfDegree_sub_add_two trace (1 : R) |>.monic + +/-- The prescribed-trace quadratic has degree two. -/ +@[simp] +lemma traceRootPolynomial_natDegree {R : Type*} [Nontrivial R] [CommRing R] (trace : R) : + (traceRootPolynomial trace).natDegree = 2 := by + simpa [traceRootPolynomial] using + isMonicOfDegree_sub_add_two trace (1 : R) |>.natDegree_eq + +/-- A prescribed-trace quadratic over a domain is irreducible when its +discriminant is not a square. -/ +lemma traceRootPolynomial_irreducible_of_discriminant_not_isSquare + {R : Type*} [CommRing R] [IsDomain R] + (trace : R) (hdisc : ¬ IsSquare (trace ^ 2 - 4)) : + Irreducible (traceRootPolynomial trace) := by + rw [(traceRootPolynomial_monic trace).irreducible_iff_roots_eq_zero_of_degree_le_three] + · apply Multiset.eq_zero_of_forall_notMem + intro root hroot + have heval := (mem_roots (traceRootPolynomial_monic trace).ne_zero).mp hroot + have heq : root ^ 2 - trace * root + 1 = 0 := by + simpa [traceRootPolynomial] using heval + apply hdisc + refine ⟨2 * root - trace, ?_⟩ + calc + trace ^ 2 - 4 = + (2 * root - trace) * (2 * root - trace) - + 4 * (root ^ 2 - trace * root + 1) := by ring + _ = (2 * root - trace) * (2 * root - trace) := by rw [heq]; ring + · simp + · simp + +/-- The trace discriminant polynomial has degree two outside characteristic three. -/ +lemma cageTraceBranchPolynomial_natDegree (h3 : (3 : K) ≠ 0) : + (cageTraceBranchPolynomial : K[X]).natDegree = 2 := by + rw [cageTraceBranchPolynomial, natDegree_sub_C, + natDegree_C_mul_X_pow 2 (9 : K)] + exact by + convert mul_ne_zero h3 h3 using 1 + norm_num + +/-- The trace discriminant polynomial is not a unit. -/ +lemma cageTraceBranchPolynomial_not_isUnit (h3 : (3 : K) ≠ 0) : + ¬ IsUnit (cageTraceBranchPolynomial : K[X]) := + not_isUnit_of_natDegree_pos _ <| by + rw [cageTraceBranchPolynomial_natDegree h3] + norm_num + +/-- The two trace branch points are distinct outside characteristics two and three. -/ +lemma cageTraceBranchPolynomial_separable + (h2 : (2 : K) ≠ 0) (h3 : (3 : K) ≠ 0) : + (cageTraceBranchPolynomial : K[X]).Separable := by + have h4 : (4 : K) ≠ 0 := by + convert mul_ne_zero h2 h2 using 1 + norm_num + have h9 : (9 : K) ≠ 0 := by + convert mul_ne_zero h3 h3 using 1 + norm_num + have hquot : (4 / 9 : K) ≠ 0 := div_ne_zero h4 h9 + have hsep : (X ^ 2 - C (4 / 9) : K[X]).Separable := + separable_X_pow_sub_C _ h2 hquot + have hunit : IsUnit (C (9 : K) : K[X]) := + isUnit_C.mpr (isUnit_iff_ne_zero.mpr h9) + have heq : (cageTraceBranchPolynomial : K[X]) = + C (9 : K) * (X ^ 2 - C (4 / 9)) := by + simp only [cageTraceBranchPolynomial, mul_sub] + rw [← C_mul, mul_div_cancel₀ (4 : K) h9] + rw [heq] + exact hsep.unit_mul hunit + +/-- An explicit constant Bezout combination of an incidence branch polynomial +and the trace discriminant polynomial. -/ +lemma incidenceBranchPolynomial_cageTrace_linearCombination (a : K) : + C (9 * a ^ 2 - 4) * cageTraceBranchPolynomial - + C 9 * incidenceBranchPolynomial a = C 16 := by + simp only [cageTraceBranchPolynomial, incidenceBranchPolynomial] + ring_nf + rw [← C_mul, ← C_neg, ← C_mul, ← C_add] + congr 1 + ring + +/-- Every nondegenerate incidence branch polynomial is coprime to the trace +discriminant polynomial; the Bezout constant is `16`. -/ +lemma incidenceBranchPolynomial_isCoprime_cageTrace + (h2 : (2 : K) ≠ 0) (a : K) : + IsCoprime (incidenceBranchPolynomial a) cageTraceBranchPolynomial := by + have h16 : (16 : K) ≠ 0 := by + rw [show (16 : K) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 h2 + refine ⟨-(C (16 : K)⁻¹ * C 9), + C (16 : K)⁻¹ * C (9 * a ^ 2 - 4), ?_⟩ + calc + -(C (16 : K)⁻¹ * C 9) * incidenceBranchPolynomial a + + (C (16 : K)⁻¹ * C (9 * a ^ 2 - 4)) * cageTraceBranchPolynomial = + C (16 : K)⁻¹ * + (C (9 * a ^ 2 - 4) * cageTraceBranchPolynomial - + C 9 * incidenceBranchPolynomial a) := by ring + _ = C (16 : K)⁻¹ * C 16 := by + rw [incidenceBranchPolynomial_cageTrace_linearCombination] + _ = 1 := by rw [← C_mul, inv_mul_cancel₀ h16, map_one] + +/-- The trace discriminant and its products with either incidence branch +class are all nonsquares in the rational function field. -/ +lemma cageTraceBranchSquareClasses_independent_ratFunc + (h2 : (2 : K) ≠ 0) (h3 : (3 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + ¬ IsSquare (algebraMap K[X] (RatFunc K) cageTraceBranchPolynomial) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) + (incidenceBranchPolynomial a * cageTraceBranchPolynomial)) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) + (incidenceBranchPolynomial b * cageTraceBranchPolynomial)) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) + (incidenceBranchPolynomial a * incidenceBranchPolynomial b * + cageTraceBranchPolynomial)) := by + have hsepA := incidenceBranchPolynomial_separable h2 ha hA + have hsepB := incidenceBranchPolynomial_separable h2 hb hB + have hsepTrace := cageTraceBranchPolynomial_separable h2 h3 + have hcopAB := incidenceBranchPolynomial_isCoprime h2 hab + have hcopATrace := incidenceBranchPolynomial_isCoprime_cageTrace h2 a + have hcopBTrace := incidenceBranchPolynomial_isCoprime_cageTrace h2 b + have hcopABTrace : IsCoprime + (incidenceBranchPolynomial a * incidenceBranchPolynomial b) + (cageTraceBranchPolynomial : K[X]) := + hcopATrace.mul_left hcopBTrace + have hsqTrace := hsepTrace.squarefree + have hsqATrace := (hsepA.mul hsepTrace hcopATrace).squarefree + have hsqBTrace := (hsepB.mul hsepTrace hcopBTrace).squarefree + have hsqABTrace := + ((hsepA.mul hsepB hcopAB).mul hsepTrace hcopABTrace).squarefree + refine ⟨not_isSquare_algebraMap_of_squarefree_not_isUnit hsqTrace + (cageTraceBranchPolynomial_not_isUnit h3), + not_isSquare_algebraMap_of_squarefree_not_isUnit hsqATrace ?_, + not_isSquare_algebraMap_of_squarefree_not_isUnit hsqBTrace ?_, + not_isSquare_algebraMap_of_squarefree_not_isUnit hsqABTrace ?_⟩ + · intro hunit + exact incidenceBranchPolynomial_not_isUnit hA (IsUnit.mul_iff.mp hunit).1 + · intro hunit + exact incidenceBranchPolynomial_not_isUnit hB (IsUnit.mul_iff.mp hunit).1 + · intro hunit + exact incidenceBranchPolynomial_not_isUnit hA + (IsUnit.mul_iff.mp (IsUnit.mul_iff.mp hunit).1).1 + +/-- The discriminant of the trace quadratic remains nonsquare after adjoining +both incidence square roots. -/ +theorem incidenceBiquadraticTraceBranch_not_isSquare + (h2 : (2 : K) ≠ 0) (h3 : (3 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + ¬ IsSquare + (algebraMap (IncidenceFirstQuadraticRatFuncRing K a) + (IncidenceBiquadraticRatFuncRing K a b) + (algebraMap (RatFunc K) (IncidenceFirstQuadraticRatFuncRing K a) + (algebraMap K[X] (RatFunc K) cageTraceBranchPolynomial))) := by + let fA : RatFunc K := + algebraMap K[X] (RatFunc K) (incidenceBranchPolynomial a) + let fB : RatFunc K := + algebraMap K[X] (RatFunc K) (incidenceBranchPolynomial b) + let traceBranch : RatFunc K := + algebraMap K[X] (RatFunc K) cageTraceBranchPolynomial + obtain ⟨hfA, hfB, hfAB⟩ := + incidenceBranchSquareClasses_independent_ratFunc h2 ha hb hA hB hab + obtain ⟨hTrace, hATrace, hBTrace, hABTrace⟩ := + cageTraceBranchSquareClasses_independent_ratFunc h2 h3 ha hb hA hB hab + have h2RatFunc : (2 : RatFunc K) ≠ 0 := by + intro hzero + apply h2 + apply FaithfulSMul.algebraMap_injective K (RatFunc K) + simpa only [map_ofNat, map_zero] using hzero + letI : Fact + (Irreducible + (adjoinSquarePolynomial + (algebraMap K[X] (RatFunc K) (incidenceBranchPolynomial a)))) := + ⟨adjoinSquarePolynomial_irreducible_of_not_isSquare hfA⟩ + let firstField := IncidenceFirstQuadraticRatFuncRing K a + let secondField := IncidenceBiquadraticRatFuncRing K a b + let fBFirst : firstField := + incidenceFirstQuadraticToRatFunc K a + (algebraMap K[X] (IncidenceFirstQuadraticRing K a) + (incidenceBranchPolynomial b)) + let traceFirst : firstField := algebraMap (RatFunc K) firstField traceBranch + have h2First : (2 : firstField) ≠ 0 := by + intro hzero + apply h2RatFunc + apply (algebraMap (RatFunc K) firstField).injective + simpa only [map_ofNat, map_zero] using hzero + have hfBFirst : ¬ IsSquare fBFirst := by + change ¬ IsSquare + (incidenceFirstQuadraticToRatFunc K a + (algebraMap K[X] (IncidenceFirstQuadraticRing K a) + (incidenceBranchPolynomial b))) + rw [incidenceFirstQuadraticToRatFunc_algebraMap] + apply not_isSquare_algebraMap_adjoinSquare_of_independent h2RatFunc hfA hfB + simpa only [map_mul] using hfAB + have hTraceFirst : ¬ IsSquare traceFirst := by + apply not_isSquare_algebraMap_adjoinSquare_of_independent h2RatFunc hfA hTrace + simpa only [map_mul] using hATrace + have hBTraceFirst : ¬ IsSquare (fBFirst * traceFirst) := by + have hMapped : ¬ IsSquare + (algebraMap (RatFunc K) firstField (fB * traceBranch)) := by + apply not_isSquare_algebraMap_adjoinSquare_of_independent h2RatFunc hfA + · simpa only [fB, traceBranch, map_mul] using hBTrace + · simpa only [fA, fB, traceBranch, map_mul, mul_assoc] using hABTrace + rw [show fBFirst = algebraMap (RatFunc K) firstField fB by + simp [fBFirst, fB, firstField, + incidenceFirstQuadraticToRatFunc_algebraMap]] + simpa only [traceFirst, map_mul] using hMapped + change ¬ IsSquare (algebraMap firstField secondField traceFirst) + exact not_isSquare_algebraMap_adjoinSquare_of_independent + h2First hfBFirst hTraceFirst hBTraceFirst + +/-- The normalized common coordinate `3y` inside the biquadratic incidence +function field. -/ +def incidenceBiquadraticNormalizedTrace (a b : K) : + IncidenceBiquadraticRatFuncRing K a b := + algebraMap (IncidenceFirstQuadraticRatFuncRing K a) + (IncidenceBiquadraticRatFuncRing K a b) + (algebraMap (RatFunc K) (IncidenceFirstQuadraticRatFuncRing K a) + (RatFunc.C 3 * RatFunc.X)) + +/-- The discriminant of the normalized trace inside the biquadratic field is +the image of `9y² - 4`. -/ +lemma incidenceBiquadraticNormalizedTrace_discriminant (a b : K) : + incidenceBiquadraticNormalizedTrace a b ^ 2 - 4 = + algebraMap (IncidenceFirstQuadraticRatFuncRing K a) + (IncidenceBiquadraticRatFuncRing K a b) + (algebraMap (RatFunc K) (IncidenceFirstQuadraticRatFuncRing K a) + (algebraMap K[X] (RatFunc K) cageTraceBranchPolynomial)) := by + simp only [incidenceBiquadraticNormalizedTrace, cageTraceBranchPolynomial, + map_sub, map_mul, map_pow, map_ofNat, RatFunc.algebraMap_X] + ring + +/-- The normalized trace discriminant remains nonsquare in the complete +biquadratic incidence function field. -/ +theorem incidenceBiquadraticNormalizedTrace_discriminant_not_isSquare + (h2 : (2 : K) ≠ 0) (h3 : (3 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + ¬ IsSquare (incidenceBiquadraticNormalizedTrace a b ^ 2 - 4) := by + rw [incidenceBiquadraticNormalizedTrace_discriminant] + exact incidenceBiquadraticTraceBranch_not_isSquare h2 h3 ha hb hA hB hab + +/-- The trace quadratic over the exact incidence biquadratic field +presentation. -/ +def incidenceBiquadraticTraceRootPolynomial (a b : K) : + Polynomial (IncidenceBiquadraticRatFuncRing K a b) := + X ^ 2 - C (incidenceBiquadraticNormalizedTrace a b) * X + 1 + +/-- The trace quadratic is irreducible over the off-diagonal incidence +biquadratic function field. -/ +theorem incidenceBiquadraticTraceRootPolynomial_irreducible + (h2 : (2 : K) ≠ 0) (h3 : (3 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + Irreducible (incidenceBiquadraticTraceRootPolynomial a b) := by + letI : IsDomain (IncidenceBiquadraticRatFuncRing K a b) := + incidenceBiquadraticRatFuncRing_isDomain K h2 ha hb hA hB hab + change Irreducible (traceRootPolynomial (incidenceBiquadraticNormalizedTrace a b)) + apply traceRootPolynomial_irreducible_of_discriminant_not_isSquare + exact incidenceBiquadraticNormalizedTrace_discriminant_not_isSquare + h2 h3 ha hb hA hB hab + +/-- The quadratic trace extension of the cage incidence function field. -/ +abbrev IncidenceTraceFunctionField (K : Type*) [Field K] (a b : K) := + AdjoinRoot (incidenceBiquadraticTraceRootPolynomial a b) + +/-- The canonical unit-trace root in the quadratic trace extension. -/ +def incidenceTraceRoot (a b : K) : IncidenceTraceFunctionField K a b := + AdjoinRoot.root (incidenceBiquadraticTraceRootPolynomial a b) + +/-- The canonical trace root satisfies `R² - (3y)R + 1 = 0`. -/ +lemma incidenceTraceRoot_quadratic_relation (a b : K) : + incidenceTraceRoot a b ^ 2 - + algebraMap (IncidenceBiquadraticRatFuncRing K a b) + (IncidenceTraceFunctionField K a b) + (incidenceBiquadraticNormalizedTrace a b) * incidenceTraceRoot a b + 1 = 0 := by + have h := AdjoinRoot.eval₂_root (incidenceBiquadraticTraceRootPolynomial a b) + rw [incidenceBiquadraticTraceRootPolynomial] at h + simp only [Polynomial.eval₂_add, Polynomial.eval₂_sub, Polynomial.eval₂_pow, + Polynomial.eval₂_X, Polynomial.eval₂_mul, Polynomial.eval₂_C, + Polynomial.eval₂_one] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean new file mode 100644 index 0000000000..8b8f27d31e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover + +/-! +# The small prime in the cage estimate + +The geometric cage proof starts at `p = 7`. The target interface also asks +for `p = 5`; this file handles that one finite field by a transparent ambient +cardinality bound, not by applying an inapplicable irreducibility statement. +-/ + +namespace BGS.Markoff + +noncomputable section + +local instance cageSmallPrime_factPrimeFive : Fact (Nat.Prime 5) := ⟨by norm_num⟩ + +private def cageRangeCoordinatesAtFive + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod 5) (d : ℕ) : + cageMiddleWitnessPowerRangeSolutions 5 axis other xi eta d → + Fin 7 → ZMod 5 := fun z i => + match i with + | 0 => z.1.1.1.1.u1 + | 1 => z.1.1.1.1.u2 + | 2 => z.1.1.1.1.u3 + | 3 => z.1.1.1.2.u1 + | 4 => z.1.1.1.2.u2 + | 5 => z.1.1.1.2.u3 + | 6 => z.1.2.1 + +private lemma cageRangeCoordinatesAtFive_injective + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod 5) (d : ℕ) : + Function.Injective (cageRangeCoordinatesAtFive axis other xi eta d) := by + intro z w h + apply Subtype.ext + apply Prod.ext + · apply Subtype.ext + apply Prod.ext <;> apply NormalizedPoint.ext + · simpa [cageRangeCoordinatesAtFive] using congrFun h (0 : Fin 7) + · simpa [cageRangeCoordinatesAtFive] using congrFun h (1 : Fin 7) + · simpa [cageRangeCoordinatesAtFive] using congrFun h (2 : Fin 7) + · simpa [cageRangeCoordinatesAtFive] using congrFun h (3 : Fin 7) + · simpa [cageRangeCoordinatesAtFive] using congrFun h (4 : Fin 7) + · simpa [cageRangeCoordinatesAtFive] using congrFun h (5 : Fin 7) + · apply Subtype.ext + apply Units.ext + simpa [cageRangeCoordinatesAtFive] using congrFun h (6 : Fin 7) + +/-- Every witness-bearing power-range set over `ZMod 5` has at most `5^7` +elements. -/ +lemma natCard_cageMiddleWitnessPowerRangeSolutions_five_le + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod 5) (d : ℕ) : + Nat.card (cageMiddleWitnessPowerRangeSolutions 5 axis other xi eta d) ≤ + 78125 := by + calc + Nat.card (cageMiddleWitnessPowerRangeSolutions 5 axis other xi eta d) ≤ + Nat.card (Fin 7 → ZMod 5) := + Nat.card_le_card_of_injective + (cageRangeCoordinatesAtFive axis other xi eta d) + (cageRangeCoordinatesAtFive_injective axis other xi eta d) + _ = 78125 := by + rw [Nat.card_fun] + norm_num [Nat.card_fin, Nat.card_zmod] + +/-- A coarse uniform estimate at `p=5`. Multiplicity one is sufficient for +this isolated finite case. -/ +lemma cageWitnessPointEstimate_five : + ∀ (axis other : NormalizedCoordinateAxis) (xi eta : ZMod 5), + IsSplitMaximalTrace 5 xi → IsSplitMaximalTrace 5 eta → + ∃ multiplicity : ℕ, 0 < multiplicity ∧ + ∀ d : ℕ, d ∣ Nat.card (ZMod 5)ˣ → 0 < d → + |(Nat.card (cageMiddleWitnessPowerRangeSolutions + 5 axis other xi eta d) : ℝ) - + (multiplicity : ℝ) * (5 : ℝ) / d| ≤ + (100000 : ℝ) * Real.sqrt 5 := by + intro axis other xi eta _ _ + refine ⟨1, by norm_num, ?_⟩ + intro d _ hd + have hcardNat := + natCard_cageMiddleWitnessPowerRangeSolutions_five_le axis other xi eta d + have hcardReal : + (Nat.card (cageMiddleWitnessPowerRangeSolutions + 5 axis other xi eta d) : ℝ) ≤ 78125 := by + exact_mod_cast hcardNat + have hdReal : (0 : ℝ) < d := by exact_mod_cast hd + have hsqrt : (1 : ℝ) ≤ Real.sqrt 5 := by + have hsquare := Real.sq_sqrt (by norm_num : (0 : ℝ) ≤ 5) + have hnonnegative := Real.sqrt_nonneg 5 + nlinarith + norm_num only [Nat.cast_one, one_mul] + have hdOne : (1 : ℝ) ≤ d := by exact_mod_cast hd + have hdivNonnegative : (0 : ℝ) ≤ 5 / d := + div_nonneg (by norm_num) hdReal.le + have hdivLe : (5 : ℝ) / d ≤ 5 := by + apply (div_le_iff₀ hdReal).mpr + nlinarith + apply abs_le.mpr + constructor <;> nlinarith + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean new file mode 100644 index 0000000000..5008e054e5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption + +/-! +# Witness-preserving equations for the cage fiber product + +This file gives the exact algebraic bridge for the canonical pair of axes. +It deliberately retains the two intersection witnesses. No point-count or +irreducibility assertion is made here. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Scalar coordinates of the two incidence witnesses with common third +coordinate. The roots record the two quadratic choices separately. -/ +structure CageIncidenceEquationWitness + (p : ℕ) [Fact p.Prime] (xi eta : ZMod p) where + /-- The common coordinate of the two incidence points. -/ + middle : ZMod p + /-- The discriminant root retaining the first incidence point. -/ + firstRoot : ZMod p + /-- The discriminant root retaining the second incidence point. -/ + secondRoot : ZMod p + /-- The quadratic incidence equation for the first fixed trace. -/ + firstEquation : + (xi ^ 2 - 4) * middle ^ 2 - firstRoot ^ 2 = 4 * xi ^ 2 + /-- The quadratic incidence equation for the second fixed trace. -/ + secondEquation : + (eta ^ 2 - 4) * middle ^ 2 - secondRoot ^ 2 = 4 * eta ^ 2 + +@[ext] +theorem CageIncidenceEquationWitness.ext + {p : ℕ} [Fact p.Prime] {xi eta : ZMod p} + {x y : CageIncidenceEquationWitness p xi eta} + (hmiddle : x.middle = y.middle) + (hfirst : x.firstRoot = y.firstRoot) + (hsecond : x.secondRoot = y.secondRoot) : x = y := by + cases x + cases y + simp_all + +private theorem first_incidence_discriminant_equation + {K : Type*} [CommRing K] (xi other middle : K) + (hSurface : + normalizedPolynomial + (⟨xi, other, middle⟩ : NormalizedPoint K) = 0) : + (xi ^ 2 - 4) * middle ^ 2 - (xi * middle - 2 * other) ^ 2 = + 4 * xi ^ 2 := by + simp only [normalizedPolynomial] at hSurface ⊢ + linear_combination -4 * hSurface + +private theorem second_incidence_discriminant_equation + {K : Type*} [CommRing K] (other eta middle : K) + (hSurface : + normalizedPolynomial + (⟨other, eta, middle⟩ : NormalizedPoint K) = 0) : + (eta ^ 2 - 4) * middle ^ 2 - (eta * middle - 2 * other) ^ 2 = + 4 * eta ^ 2 := by + simp only [normalizedPolynomial] at hSurface ⊢ + linear_combination -4 * hSurface + +private theorem normalized_first_third_point_of_discriminant_equation + {K : Type*} [Field K] (hTwo : (2 : K) ≠ 0) + (xi middle root : K) + (hEquation : + (xi ^ 2 - 4) * middle ^ 2 - root ^ 2 = 4 * xi ^ 2) : + normalizedPolynomial + (⟨xi, (xi * middle - root) / 2, middle⟩ : NormalizedPoint K) = 0 := by + simp only [normalizedPolynomial] + field_simp [hTwo] + linear_combination -hEquation + +private theorem normalized_second_third_point_of_discriminant_equation + {K : Type*} [Field K] (hTwo : (2 : K) ≠ 0) + (eta middle root : K) + (hEquation : + (eta ^ 2 - 4) * middle ^ 2 - root ^ 2 = 4 * eta ^ 2) : + normalizedPolynomial + (⟨(eta * middle - root) / 2, eta, middle⟩ : NormalizedPoint K) = 0 := by + change normalizedPolynomial + (normalizedSwap12 + (⟨eta, (eta * middle - root) / 2, middle⟩ : NormalizedPoint K)) = 0 + rw [normalizedPolynomial_swap12] + exact normalized_first_third_point_of_discriminant_equation + hTwo eta middle root hEquation + +/-- A canonical cage witness pair gives the two quadratic incidence roots, +without projecting either root away. -/ +def canonicalCageWitnessToEquations + (p : ℕ) [Fact p.Prime] (xi eta : ZMod p) : + CageMiddleWitnessPair p .first .second xi eta → + CageIncidenceEquationWitness p xi eta := fun z => + { middle := z.1.1.u3 + firstRoot := xi * z.1.1.u3 - 2 * z.1.1.u2 + secondRoot := eta * z.1.1.u3 - 2 * z.1.2.u1 + firstEquation := by + apply first_incidence_discriminant_equation xi z.1.1.u2 z.1.1.u3 + have hxi : z.1.1.u1 = xi := by + simpa [normalizedFiberAt] using z.2.1.2 + have hSurface : normalizedPolynomial z.1.1 = 0 := by + simpa [normalizedFiberAt, IsNormalizedMarkoff] using z.2.1.1 + calc + normalizedPolynomial + (⟨xi, z.1.1.u2, z.1.1.u3⟩ : NormalizedPoint (ZMod p)) = + normalizedPolynomial z.1.1 := by + congr 1 + exact NormalizedPoint.ext hxi.symm rfl rfl + _ = 0 := hSurface + secondEquation := by + apply second_incidence_discriminant_equation z.1.2.u1 eta z.1.1.u3 + have hSurface : normalizedPolynomial z.1.2 = 0 := by + simpa [normalizedFiberAt, IsNormalizedMarkoff] using z.2.2.1.1 + have heta : z.1.2.u2 = eta := by + simpa [normalizedFiberAt] using z.2.2.1.2 + have hmiddle : z.1.1.u3 = z.1.2.u3 := by + simpa [normalizedCoordinateAt, cageBridgeAxis] using z.2.2.2 + calc + normalizedPolynomial + (⟨z.1.2.u1, eta, z.1.1.u3⟩ : NormalizedPoint (ZMod p)) = + normalizedPolynomial z.1.2 := by + congr 1 + exact NormalizedPoint.ext rfl heta.symm hmiddle + _ = 0 := hSurface } + +/-- Reconstruct both actual Markoff points from the common coordinate and +the two retained roots. -/ +def canonicalCageEquationsToWitness + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (xi eta : ZMod p) : + CageIncidenceEquationWitness p xi eta → + CageMiddleWitnessPair p .first .second xi eta := fun z => by + have hTwo : (2 : ZMod p) ≠ 0 := by + have hpPrime : p.Prime := Fact.out + exact two_ne_zero_zmod + (lt_of_le_of_ne hpPrime.two_le (Ne.symm hpTwo)) + let firstPoint : NormalizedPoint (ZMod p) := + ⟨xi, (xi * z.middle - z.firstRoot) / 2, z.middle⟩ + let secondPoint : NormalizedPoint (ZMod p) := + ⟨(eta * z.middle - z.secondRoot) / 2, eta, z.middle⟩ + refine ⟨(firstPoint, secondPoint), ?_⟩ + refine ⟨⟨?_, rfl⟩, ⟨⟨?_, rfl⟩, rfl⟩⟩ + · exact normalized_first_third_point_of_discriminant_equation + hTwo xi z.middle z.firstRoot z.firstEquation + · exact normalized_second_third_point_of_discriminant_equation + hTwo eta z.middle z.secondRoot z.secondEquation + +/-- For odd characteristic, the canonical witness pair is exactly the pair +of quadratic equations. In particular this equivalence exposes the +diagonal case: the two root fields remain independent even when the two +equations coincide. -/ +def canonicalCageWitnessEquivIncidenceEquations + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (xi eta : ZMod p) : + CageMiddleWitnessPair p .first .second xi eta ≃ + CageIncidenceEquationWitness p xi eta where + toFun := canonicalCageWitnessToEquations p xi eta + invFun := canonicalCageEquationsToWitness p hpTwo xi eta + left_inv := by + intro z + have hpPrime : p.Prime := Fact.out + have hTwo : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod + (lt_of_le_of_ne hpPrime.two_le (Ne.symm hpTwo)) + have hxi : xi = z.1.1.u1 := by + simpa [normalizedFiberAt] using z.2.1.2.symm + have heta : eta = z.1.2.u2 := by + simpa [normalizedFiberAt] using z.2.2.1.2.symm + have hmiddle : z.1.1.u3 = z.1.2.u3 := by + simpa [normalizedCoordinateAt, cageBridgeAxis] using z.2.2.2 + apply Subtype.ext + apply Prod.ext <;> apply NormalizedPoint.ext <;> + simp [canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness, hTwo, hxi, heta, hmiddle] + right_inv := by + intro z + have hpPrime : p.Prime := Fact.out + have hTwo : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod + (lt_of_le_of_ne hpPrime.two_le (Ne.symm hpTwo)) + apply CageIncidenceEquationWitness.ext + · rfl + · simp only [canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] + field_simp [hTwo] + ring + · simp only [canonicalCageWitnessToEquations, + canonicalCageEquationsToWitness] + field_simp [hTwo] + ring + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core.lean new file mode 100644 index 0000000000..2c4b4a7684 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core.lean @@ -0,0 +1,20 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor +import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean new file mode 100644 index 0000000000..572301d1bd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean @@ -0,0 +1,454 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +/-! +# The Markoff group action + +This file turns the polynomial identities from `BGS.Markoff.Basic` into an action on the +Markoff surface itself. In particular, membership in the surface is part of the type of every +generator. The group `Gamma` is the subgroup generated by the three Vieta involutions and the +two adjacent coordinate transpositions. + +The origin is fixed by every generator, hence by all of `Gamma`. Consequently the same group +acts on the punctured surface; this is the action used in finite-field transitivity statements. +-/ + +namespace BGS.Markoff + +universe u + +/-- The Markoff surface as a subtype of affine three-space. -/ +abbrev MarkoffSurface (R : Type u) [CommRing R] := {x : Point R // IsMarkoff x} + +/-- The origin, regarded as a point of the Markoff surface. -/ +def surfaceOrigin (R : Type u) [CommRing R] : MarkoffSurface R := + ⟨origin, isMarkoff_origin⟩ + +@[simp] +theorem isMarkoff_swap12 {R : Type u} [CommRing R] (x : Point R) : + IsMarkoff (swap12 x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_swap12] + +@[simp] +theorem isMarkoff_swap23 {R : Type u} [CommRing R] (x : Point R) : + IsMarkoff (swap23 x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_swap23] + +/-- The first Vieta involution, restricted to the Markoff surface. -/ +def vieta1SurfacePerm (R : Type u) [CommRing R] : Equiv.Perm (MarkoffSurface R) where + __ := (vieta1Equiv R).subtypeEquiv fun x => (isMarkoff_vieta1 x).symm + +/-- The second Vieta involution, restricted to the Markoff surface. -/ +def vieta2SurfacePerm (R : Type u) [CommRing R] : Equiv.Perm (MarkoffSurface R) where + __ := (vieta2Equiv R).subtypeEquiv fun x => (isMarkoff_vieta2 x).symm + +/-- The third Vieta involution, restricted to the Markoff surface. -/ +def vieta3SurfacePerm (R : Type u) [CommRing R] : Equiv.Perm (MarkoffSurface R) where + __ := (vieta3Equiv R).subtypeEquiv fun x => (isMarkoff_vieta3 x).symm + +/-- The first coordinate transposition, restricted to the Markoff surface. -/ +def swap12SurfacePerm (R : Type u) [CommRing R] : Equiv.Perm (MarkoffSurface R) where + __ := (swap12Equiv R).subtypeEquiv fun x => (isMarkoff_swap12 x).symm + +/-- The second coordinate transposition, restricted to the Markoff surface. -/ +def swap23SurfacePerm (R : Type u) [CommRing R] : Equiv.Perm (MarkoffSurface R) where + __ := (swap23Equiv R).subtypeEquiv fun x => (isMarkoff_swap23 x).symm + +@[simp] +theorem coe_vieta1SurfacePerm {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((vieta1SurfacePerm R x : MarkoffSurface R) : Point R) = vieta1 x := rfl + +@[simp] +theorem coe_vieta2SurfacePerm {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((vieta2SurfacePerm R x : MarkoffSurface R) : Point R) = vieta2 x := rfl + +@[simp] +theorem coe_vieta3SurfacePerm {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((vieta3SurfacePerm R x : MarkoffSurface R) : Point R) = vieta3 x := rfl + +@[simp] +theorem coe_swap12SurfacePerm {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((swap12SurfacePerm R x : MarkoffSurface R) : Point R) = swap12 x := rfl + +@[simp] +theorem coe_swap23SurfacePerm {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((swap23SurfacePerm R x : MarkoffSurface R) : Point R) = swap23 x := rfl + +@[simp] +theorem vieta1SurfacePerm_surfaceOrigin (R : Type u) [CommRing R] : + vieta1SurfacePerm R (surfaceOrigin R) = surfaceOrigin R := by + ext <;> simp [vieta1SurfacePerm, vieta1Equiv, surfaceOrigin, vieta1, origin] + +@[simp] +theorem vieta2SurfacePerm_surfaceOrigin (R : Type u) [CommRing R] : + vieta2SurfacePerm R (surfaceOrigin R) = surfaceOrigin R := by + ext <;> simp [vieta2SurfacePerm, vieta2Equiv, surfaceOrigin, vieta2, origin] + +@[simp] +theorem vieta3SurfacePerm_surfaceOrigin (R : Type u) [CommRing R] : + vieta3SurfacePerm R (surfaceOrigin R) = surfaceOrigin R := by + ext <;> simp [vieta3SurfacePerm, vieta3Equiv, surfaceOrigin, vieta3, origin] + +@[simp] +theorem swap12SurfacePerm_surfaceOrigin (R : Type u) [CommRing R] : + swap12SurfacePerm R (surfaceOrigin R) = surfaceOrigin R := by + ext <;> rfl + +@[simp] +theorem swap23SurfacePerm_surfaceOrigin (R : Type u) [CommRing R] : + swap23SurfacePerm R (surfaceOrigin R) = surfaceOrigin R := by + ext <;> rfl + +private theorem perm_ne_fixed_iff {A : Type*} (e : Equiv.Perm A) (a : A) (h : e a = a) + (x : A) : e x ≠ a ↔ x ≠ a := by + constructor + · intro hex hxa + exact hex (hxa ▸ h) + · intro hxa hex + exact hxa (e.injective (hex.trans h.symm)) + +@[simp] +theorem vieta1SurfacePerm_ne_origin_iff {R : Type u} [CommRing R] (x : MarkoffSurface R) : + vieta1SurfacePerm R x ≠ surfaceOrigin R ↔ x ≠ surfaceOrigin R := + perm_ne_fixed_iff (vieta1SurfacePerm R) (surfaceOrigin R) + (vieta1SurfacePerm_surfaceOrigin R) x + +@[simp] +theorem vieta2SurfacePerm_ne_origin_iff {R : Type u} [CommRing R] (x : MarkoffSurface R) : + vieta2SurfacePerm R x ≠ surfaceOrigin R ↔ x ≠ surfaceOrigin R := + perm_ne_fixed_iff (vieta2SurfacePerm R) (surfaceOrigin R) + (vieta2SurfacePerm_surfaceOrigin R) x + +@[simp] +theorem vieta3SurfacePerm_ne_origin_iff {R : Type u} [CommRing R] (x : MarkoffSurface R) : + vieta3SurfacePerm R x ≠ surfaceOrigin R ↔ x ≠ surfaceOrigin R := + perm_ne_fixed_iff (vieta3SurfacePerm R) (surfaceOrigin R) + (vieta3SurfacePerm_surfaceOrigin R) x + +@[simp] +theorem swap12SurfacePerm_ne_origin_iff {R : Type u} [CommRing R] (x : MarkoffSurface R) : + swap12SurfacePerm R x ≠ surfaceOrigin R ↔ x ≠ surfaceOrigin R := + perm_ne_fixed_iff (swap12SurfacePerm R) (surfaceOrigin R) + (swap12SurfacePerm_surfaceOrigin R) x + +@[simp] +theorem swap23SurfacePerm_ne_origin_iff {R : Type u} [CommRing R] (x : MarkoffSurface R) : + swap23SurfacePerm R x ≠ surfaceOrigin R ↔ x ≠ surfaceOrigin R := + perm_ne_fixed_iff (swap23SurfacePerm R) (surfaceOrigin R) + (swap23SurfacePerm_surfaceOrigin R) x + +/-- The punctured Markoff surface, expressed as the complement of the surface origin. -/ +abbrev PuncturedMarkoffSurface (R : Type u) [CommRing R] := + {x : MarkoffSurface R // x ≠ surfaceOrigin R} + +/-- The action carrier is the same punctured surface as the set defined in `Basic`. -/ +def puncturedSurfaceEquiv (R : Type u) [CommRing R] : + PuncturedMarkoffSurface R ≃ ↑(puncturedSurface R) where + toFun x := + ⟨x.1.1, by + change IsMarkoff x.1.1 ∧ x.1.1 ≠ origin + exact ⟨x.1.2, fun hx => x.2 (Subtype.ext hx)⟩⟩ + invFun x := by + have hx := x.2 + change IsMarkoff x.1 ∧ x.1 ≠ origin at hx + exact ⟨⟨x.1, hx.1⟩, fun h => hx.2 (congrArg Subtype.val h)⟩ + left_inv x := by + apply Subtype.ext + rfl + right_inv x := by + apply Subtype.ext + rfl + +@[simp] +theorem puncturedSurfaceEquiv_coe {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : (puncturedSurfaceEquiv R x : Point R) = x.1.1 := + rfl + +/-- Restrict a permutation to the complement of one of its fixed points. -/ +def restrictPermNe {A : Type*} (e : Equiv.Perm A) (a : A) (h : e a = a) : + Equiv.Perm {x : A // x ≠ a} where + toFun x := + ⟨e x, fun hex => x.2 (e.injective (hex.trans h.symm))⟩ + invFun x := + ⟨e.symm x, fun hex => by + apply x.2 + calc + x.1 = e (e.symm x.1) := (e.apply_symm_apply x.1).symm + _ = e a := congrArg e hex + _ = a := h⟩ + left_inv x := Subtype.ext (e.symm_apply_apply x) + right_inv x := Subtype.ext (e.apply_symm_apply x) + +/-- The first Vieta involution on the punctured Markoff surface. -/ +def vieta1PuncturedPerm (R : Type u) [CommRing R] : Equiv.Perm (PuncturedMarkoffSurface R) := + restrictPermNe (vieta1SurfacePerm R) (surfaceOrigin R) (vieta1SurfacePerm_surfaceOrigin R) + +/-- The second Vieta involution on the punctured Markoff surface. -/ +def vieta2PuncturedPerm (R : Type u) [CommRing R] : Equiv.Perm (PuncturedMarkoffSurface R) := + restrictPermNe (vieta2SurfacePerm R) (surfaceOrigin R) (vieta2SurfacePerm_surfaceOrigin R) + +/-- The third Vieta involution on the punctured Markoff surface. -/ +def vieta3PuncturedPerm (R : Type u) [CommRing R] : Equiv.Perm (PuncturedMarkoffSurface R) := + restrictPermNe (vieta3SurfacePerm R) (surfaceOrigin R) (vieta3SurfacePerm_surfaceOrigin R) + +/-- The first coordinate transposition on the punctured Markoff surface. -/ +def swap12PuncturedPerm (R : Type u) [CommRing R] : Equiv.Perm (PuncturedMarkoffSurface R) := + restrictPermNe (swap12SurfacePerm R) (surfaceOrigin R) (swap12SurfacePerm_surfaceOrigin R) + +/-- The second coordinate transposition on the punctured Markoff surface. -/ +def swap23PuncturedPerm (R : Type u) [CommRing R] : Equiv.Perm (PuncturedMarkoffSurface R) := + restrictPermNe (swap23SurfacePerm R) (surfaceOrigin R) (swap23SurfacePerm_surfaceOrigin R) + +/-- The five standard generators of the Markoff group on the surface. -/ +def gammaGenerators (R : Type u) [CommRing R] : Set (Equiv.Perm (MarkoffSurface R)) := + {vieta1SurfacePerm R, vieta2SurfacePerm R, vieta3SurfacePerm R, swap12SurfacePerm R, + swap23SurfacePerm R} + +/-- The Markoff group generated by Vieta involutions and coordinate permutations. -/ +def Gamma (R : Type u) [CommRing R] : Subgroup (Equiv.Perm (MarkoffSurface R)) := + Subgroup.closure (gammaGenerators R) + +theorem vieta1SurfacePerm_mem_Gamma (R : Type u) [CommRing R] : + vieta1SurfacePerm R ∈ Gamma R := + Subgroup.subset_closure (by simp [gammaGenerators]) + +theorem vieta2SurfacePerm_mem_Gamma (R : Type u) [CommRing R] : + vieta2SurfacePerm R ∈ Gamma R := + Subgroup.subset_closure (by simp [gammaGenerators]) + +theorem vieta3SurfacePerm_mem_Gamma (R : Type u) [CommRing R] : + vieta3SurfacePerm R ∈ Gamma R := + Subgroup.subset_closure (by simp [gammaGenerators]) + +theorem swap12SurfacePerm_mem_Gamma (R : Type u) [CommRing R] : + swap12SurfacePerm R ∈ Gamma R := + Subgroup.subset_closure (by simp [gammaGenerators]) + +theorem swap23SurfacePerm_mem_Gamma (R : Type u) [CommRing R] : + swap23SurfacePerm R ∈ Gamma R := + Subgroup.subset_closure (by simp [gammaGenerators]) + +/-- The first Vieta generator as an element of `Gamma`. -/ +def gammaVieta1 (R : Type u) [CommRing R] : Gamma R := + ⟨vieta1SurfacePerm R, vieta1SurfacePerm_mem_Gamma R⟩ + +/-- The second Vieta generator as an element of `Gamma`. -/ +def gammaVieta2 (R : Type u) [CommRing R] : Gamma R := + ⟨vieta2SurfacePerm R, vieta2SurfacePerm_mem_Gamma R⟩ + +/-- The third Vieta generator as an element of `Gamma`. -/ +def gammaVieta3 (R : Type u) [CommRing R] : Gamma R := + ⟨vieta3SurfacePerm R, vieta3SurfacePerm_mem_Gamma R⟩ + +/-- The first adjacent transposition as an element of `Gamma`. -/ +def gammaSwap12 (R : Type u) [CommRing R] : Gamma R := + ⟨swap12SurfacePerm R, swap12SurfacePerm_mem_Gamma R⟩ + +/-- The second adjacent transposition as an element of `Gamma`. -/ +def gammaSwap23 (R : Type u) [CommRing R] : Gamma R := + ⟨swap23SurfacePerm R, swap23SurfacePerm_mem_Gamma R⟩ + +@[simp] +theorem gammaVieta1_smul_surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + gammaVieta1 R • x = vieta1SurfacePerm R x := rfl + +@[simp] +theorem gammaVieta2_smul_surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + gammaVieta2 R • x = vieta2SurfacePerm R x := rfl + +@[simp] +theorem gammaVieta3_smul_surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + gammaVieta3 R • x = vieta3SurfacePerm R x := rfl + +@[simp] +theorem gammaSwap12_smul_surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + gammaSwap12 R • x = swap12SurfacePerm R x := rfl + +@[simp] +theorem gammaSwap23_smul_surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + gammaSwap23 R • x = swap23SurfacePerm R x := rfl + +/-- Every standard generator fixes the origin. This is public so that the +standalone Comparator specification can reproduce the exact declaration +closure without depending on a module-private generated name. -/ +theorem gammaGenerator_fixes_origin {R : Type u} [CommRing R] + {g : Equiv.Perm (MarkoffSurface R)} (hg : g ∈ gammaGenerators R) : + g (surfaceOrigin R) = surfaceOrigin R := by + simp only [gammaGenerators, Set.mem_insert_iff, Set.mem_singleton_iff] at hg + rcases hg with rfl | rfl | rfl | rfl | rfl <;> simp + +/-- Every element of `Gamma` fixes the origin. -/ +theorem Gamma_le_origin_stabilizer (R : Type u) [CommRing R] : + Gamma R ≤ MulAction.stabilizer (Equiv.Perm (MarkoffSurface R)) (surfaceOrigin R) := + (Subgroup.closure_le _).2 fun g hg => by + change g (surfaceOrigin R) = surfaceOrigin R + exact gammaGenerator_fixes_origin hg + +@[simp] +theorem Gamma_fixes_surfaceOrigin {R : Type u} [CommRing R] (g : Gamma R) : + g • surfaceOrigin R = surfaceOrigin R := + Gamma_le_origin_stabilizer R g.2 + +/-- The action of `Gamma` on the surface restricts to its punctured complement. -/ +instance {R : Type u} [CommRing R] : MulAction (Gamma R) (PuncturedMarkoffSurface R) where + smul g x := + ⟨g • x.1, fun hgx => x.2 <| by + calc + x.1 = g⁻¹ • (g • x.1) := (inv_smul_smul g x.1).symm + _ = g⁻¹ • surfaceOrigin R := congrArg (g⁻¹ • ·) hgx + _ = surfaceOrigin R := Gamma_fixes_surfaceOrigin g⁻¹⟩ + one_smul x := Subtype.ext (one_smul (Gamma R) x.1) + mul_smul g h x := Subtype.ext (mul_smul g h x.1) + +@[simp] +theorem gammaVieta1_smul_punctured {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : gammaVieta1 R • x = vieta1PuncturedPerm R x := by + apply Subtype.ext + rfl + +@[simp] +theorem gammaVieta2_smul_punctured {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : gammaVieta2 R • x = vieta2PuncturedPerm R x := by + apply Subtype.ext + rfl + +@[simp] +theorem gammaVieta3_smul_punctured {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : gammaVieta3 R • x = vieta3PuncturedPerm R x := by + apply Subtype.ext + rfl + +@[simp] +theorem gammaSwap12_smul_punctured {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : gammaSwap12 R • x = swap12PuncturedPerm R x := by + apply Subtype.ext + rfl + +@[simp] +theorem gammaSwap23_smul_punctured {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : gammaSwap23 R • x = swap23PuncturedPerm R x := by + apply Subtype.ext + rfl + +/-- The orbit of a point on the Markoff surface under `Gamma`. -/ +def gammaOrbit {R : Type u} [CommRing R] (x : MarkoffSurface R) : Set (MarkoffSurface R) := + MulAction.orbit (Gamma R) x + +/-- Two surface points lie in the same Markoff component when they are in one `Gamma`-orbit. -/ +def SameComponent {R : Type u} [CommRing R] (x y : MarkoffSurface R) : Prop := + y ∈ gammaOrbit x + +theorem sameComponent_iff_exists {R : Type u} [CommRing R] (x y : MarkoffSurface R) : + SameComponent x y ↔ ∃ g : Gamma R, g • x = y := + Iff.rfl + +@[refl] +theorem sameComponent_refl {R : Type u} [CommRing R] (x : MarkoffSurface R) : + SameComponent x x := + MulAction.mem_orbit_self x + +@[symm] +theorem sameComponent_symm {R : Type u} [CommRing R] {x y : MarkoffSurface R} + (h : SameComponent x y) : SameComponent y x := + MulAction.mem_orbit_symm.mp h + +@[trans] +theorem sameComponent_trans {R : Type u} [CommRing R] {x y z : MarkoffSurface R} + (hxy : SameComponent x y) (hyz : SameComponent y z) : SameComponent x z := by + unfold SameComponent gammaOrbit at * + rwa [(MulAction.orbit_eq_iff).2 hxy] at hyz + +theorem sameComponent_iff_orbit_eq {R : Type u} [CommRing R] (x y : MarkoffSurface R) : + SameComponent x y ↔ gammaOrbit x = gammaOrbit y := by + unfold SameComponent gammaOrbit + exact MulAction.mem_orbit_symm.trans MulAction.orbit_eq_iff.symm + +theorem sameComponent_vieta1 {R : Type u} [CommRing R] (x : MarkoffSurface R) : + SameComponent x (vieta1SurfacePerm R x) := + (sameComponent_iff_exists x _).2 ⟨gammaVieta1 R, gammaVieta1_smul_surface x⟩ + +theorem sameComponent_vieta2 {R : Type u} [CommRing R] (x : MarkoffSurface R) : + SameComponent x (vieta2SurfacePerm R x) := + (sameComponent_iff_exists x _).2 ⟨gammaVieta2 R, gammaVieta2_smul_surface x⟩ + +theorem sameComponent_vieta3 {R : Type u} [CommRing R] (x : MarkoffSurface R) : + SameComponent x (vieta3SurfacePerm R x) := + (sameComponent_iff_exists x _).2 ⟨gammaVieta3 R, gammaVieta3_smul_surface x⟩ + +theorem sameComponent_swap12 {R : Type u} [CommRing R] (x : MarkoffSurface R) : + SameComponent x (swap12SurfacePerm R x) := + (sameComponent_iff_exists x _).2 ⟨gammaSwap12 R, gammaSwap12_smul_surface x⟩ + +theorem sameComponent_swap23 {R : Type u} [CommRing R] (x : MarkoffSurface R) : + SameComponent x (swap23SurfacePerm R x) := + (sameComponent_iff_exists x _).2 ⟨gammaSwap23 R, gammaSwap23_smul_surface x⟩ + +/-- The orbit of a punctured point under the restricted `Gamma` action. -/ +def puncturedGammaOrbit {R : Type u} [CommRing R] (x : PuncturedMarkoffSurface R) : + Set (PuncturedMarkoffSurface R) := + MulAction.orbit (Gamma R) x + +/-- The component relation on the punctured Markoff surface. -/ +def SamePuncturedComponent {R : Type u} [CommRing R] + (x y : PuncturedMarkoffSurface R) : Prop := + y ∈ puncturedGammaOrbit x + +theorem samePuncturedComponent_iff_exists {R : Type u} [CommRing R] + (x y : PuncturedMarkoffSurface R) : + SamePuncturedComponent x y ↔ ∃ g : Gamma R, g • x = y := + Iff.rfl + +@[refl] +theorem samePuncturedComponent_refl {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : SamePuncturedComponent x x := + MulAction.mem_orbit_self x + +@[symm] +theorem samePuncturedComponent_symm {R : Type u} [CommRing R] + {x y : PuncturedMarkoffSurface R} (h : SamePuncturedComponent x y) : + SamePuncturedComponent y x := + MulAction.mem_orbit_symm.mp h + +@[trans] +theorem samePuncturedComponent_trans {R : Type u} [CommRing R] + {x y z : PuncturedMarkoffSurface R} (hxy : SamePuncturedComponent x y) + (hyz : SamePuncturedComponent y z) : SamePuncturedComponent x z := by + unfold SamePuncturedComponent puncturedGammaOrbit at * + rwa [(MulAction.orbit_eq_iff).2 hxy] at hyz + +theorem samePuncturedComponent_vieta1 {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : + SamePuncturedComponent x (vieta1PuncturedPerm R x) := + (samePuncturedComponent_iff_exists x _).2 + ⟨gammaVieta1 R, gammaVieta1_smul_punctured x⟩ + +theorem samePuncturedComponent_vieta2 {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : + SamePuncturedComponent x (vieta2PuncturedPerm R x) := + (samePuncturedComponent_iff_exists x _).2 + ⟨gammaVieta2 R, gammaVieta2_smul_punctured x⟩ + +theorem samePuncturedComponent_vieta3 {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : + SamePuncturedComponent x (vieta3PuncturedPerm R x) := + (samePuncturedComponent_iff_exists x _).2 + ⟨gammaVieta3 R, gammaVieta3_smul_punctured x⟩ + +theorem samePuncturedComponent_swap12 {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : + SamePuncturedComponent x (swap12PuncturedPerm R x) := + (samePuncturedComponent_iff_exists x _).2 + ⟨gammaSwap12 R, gammaSwap12_smul_punctured x⟩ + +theorem samePuncturedComponent_swap23 {R : Type u} [CommRing R] + (x : PuncturedMarkoffSurface R) : + SamePuncturedComponent x (swap23PuncturedPerm R x) := + (samePuncturedComponent_iff_exists x _).2 + ⟨gammaSwap23 R, gammaSwap23_smul_punctured x⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean new file mode 100644 index 0000000000..c949f7c484 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean @@ -0,0 +1,196 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib + +/-! +# The elementary Markoff surface + +This file fixes the unscaled coordinates used in the introduction of +Bourgain--Gamburd--Sarnak, arXiv:1607.01530v1. Later parts of the paper use +trace coordinates obtained by multiplying each coordinate by three; that +normalization is deliberately kept separate. +-/ + +namespace BGS.Markoff + +universe u + +/-- A point of affine three-space over a type `R`. -/ +@[ext] +structure Point (R : Type u) where + /-- The first coordinate. -/ + x1 : R + /-- The second coordinate. -/ + x2 : R + /-- The third coordinate. -/ + x3 : R +deriving DecidableEq, Repr, Fintype + +/-- The origin in affine three-space. -/ +def origin {R : Type u} [Zero R] : Point R := ⟨0, 0, 0⟩ + +/-- The polynomial whose zero locus is the Markoff surface. -/ +def markoffPolynomial {R : Type u} [CommRing R] (x : Point R) : R := + x.x1 ^ 2 + x.x2 ^ 2 + x.x3 ^ 2 - 3 * x.x1 * x.x2 * x.x3 + +/-- The predicate that a point lies on the Markoff surface. -/ +def IsMarkoff {R : Type u} [CommRing R] (x : Point R) : Prop := + markoffPolynomial x = 0 + +/-- The Markoff surface as a set. -/ +def surface (R : Type u) [CommRing R] : Set (Point R) := + {x | IsMarkoff x} + +/-- The punctured Markoff surface, with the origin removed. -/ +def puncturedSurface (R : Type u) [CommRing R] : Set (Point R) := + surface R \ {origin} + +/-- The first Vieta involution. -/ +def vieta1 {R : Type u} [CommRing R] (x : Point R) : Point R := + ⟨3 * x.x2 * x.x3 - x.x1, x.x2, x.x3⟩ + +/-- The second Vieta involution. -/ +def vieta2 {R : Type u} [CommRing R] (x : Point R) : Point R := + ⟨x.x1, 3 * x.x1 * x.x3 - x.x2, x.x3⟩ + +/-- The third Vieta involution. -/ +def vieta3 {R : Type u} [CommRing R] (x : Point R) : Point R := + ⟨x.x1, x.x2, 3 * x.x1 * x.x2 - x.x3⟩ + +/-- Exchange the first two coordinates. -/ +def swap12 {R : Type u} (x : Point R) : Point R := + ⟨x.x2, x.x1, x.x3⟩ + +/-- Exchange the last two coordinates. -/ +def swap23 {R : Type u} (x : Point R) : Point R := + ⟨x.x1, x.x3, x.x2⟩ + +/-- The fundamental rotation fixing the first coordinate. -/ +def rotate1 {R : Type u} [CommRing R] (x : Point R) : Point R := + ⟨x.x1, x.x3, 3 * x.x1 * x.x3 - x.x2⟩ + +@[simp] +theorem markoffPolynomial_origin {R : Type u} [CommRing R] : + markoffPolynomial (origin : Point R) = 0 := by + simp [markoffPolynomial, origin] + +@[simp] +theorem isMarkoff_origin {R : Type u} [CommRing R] : + IsMarkoff (origin : Point R) := by + simp [IsMarkoff] + +theorem markoffPolynomial_vieta1 {R : Type u} [CommRing R] (x : Point R) : + markoffPolynomial (vieta1 x) = markoffPolynomial x := by + simp [markoffPolynomial, vieta1] + ring + +theorem markoffPolynomial_vieta2 {R : Type u} [CommRing R] (x : Point R) : + markoffPolynomial (vieta2 x) = markoffPolynomial x := by + simp [markoffPolynomial, vieta2] + ring + +theorem markoffPolynomial_vieta3 {R : Type u} [CommRing R] (x : Point R) : + markoffPolynomial (vieta3 x) = markoffPolynomial x := by + simp [markoffPolynomial, vieta3] + ring + +theorem markoffPolynomial_swap12 {R : Type u} [CommRing R] (x : Point R) : + markoffPolynomial (swap12 x) = markoffPolynomial x := by + simp [markoffPolynomial, swap12] + ring + +theorem markoffPolynomial_swap23 {R : Type u} [CommRing R] (x : Point R) : + markoffPolynomial (swap23 x) = markoffPolynomial x := by + simp [markoffPolynomial, swap23] + ring + +theorem markoffPolynomial_rotate1 {R : Type u} [CommRing R] (x : Point R) : + markoffPolynomial (rotate1 x) = markoffPolynomial x := by + simp [markoffPolynomial, rotate1] + ring + +@[simp] +theorem isMarkoff_vieta1 {R : Type u} [CommRing R] (x : Point R) : + IsMarkoff (vieta1 x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_vieta1] + +@[simp] +theorem isMarkoff_vieta2 {R : Type u} [CommRing R] (x : Point R) : + IsMarkoff (vieta2 x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_vieta2] + +@[simp] +theorem isMarkoff_vieta3 {R : Type u} [CommRing R] (x : Point R) : + IsMarkoff (vieta3 x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_vieta3] + +@[simp] +theorem isMarkoff_rotate1 {R : Type u} [CommRing R] (x : Point R) : + IsMarkoff (rotate1 x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_rotate1] + +@[simp] +theorem vieta1_involutive {R : Type u} [CommRing R] (x : Point R) : + vieta1 (vieta1 x) = x := by + ext <;> simp [vieta1] + +@[simp] +theorem vieta2_involutive {R : Type u} [CommRing R] (x : Point R) : + vieta2 (vieta2 x) = x := by + ext <;> simp [vieta2] + +@[simp] +theorem vieta3_involutive {R : Type u} [CommRing R] (x : Point R) : + vieta3 (vieta3 x) = x := by + ext <;> simp [vieta3] + +@[simp] +theorem swap12_involutive {R : Type u} (x : Point R) : + swap12 (swap12 x) = x := by + rfl + +@[simp] +theorem swap23_involutive {R : Type u} (x : Point R) : + swap23 (swap23 x) = x := by + rfl + +/-- The first Vieta move as a permutation of affine three-space. -/ +def vieta1Equiv (R : Type u) [CommRing R] : Equiv.Perm (Point R) where + toFun := vieta1 + invFun := vieta1 + left_inv := vieta1_involutive + right_inv := vieta1_involutive + +/-- The second Vieta move as a permutation of affine three-space. -/ +def vieta2Equiv (R : Type u) [CommRing R] : Equiv.Perm (Point R) where + toFun := vieta2 + invFun := vieta2 + left_inv := vieta2_involutive + right_inv := vieta2_involutive + +/-- The third Vieta move as a permutation of affine three-space. -/ +def vieta3Equiv (R : Type u) [CommRing R] : Equiv.Perm (Point R) where + toFun := vieta3 + invFun := vieta3 + left_inv := vieta3_involutive + right_inv := vieta3_involutive + +/-- The transposition of the first two coordinates as a permutation. -/ +def swap12Equiv (R : Type u) : Equiv.Perm (Point R) where + toFun := swap12 + invFun := swap12 + left_inv := swap12_involutive + right_inv := swap12_involutive + +/-- The transposition of the last two coordinates as a permutation. -/ +def swap23Equiv (R : Type u) : Equiv.Perm (Point R) where + toFun := swap23 + invFun := swap23 + left_inv := swap23_involutive + right_inv := swap23_involutive + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean new file mode 100644 index 0000000000..7e793d31ca --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean @@ -0,0 +1,1173 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +/-! +# Explicit parametrizations of normalized Markoff fibers + +This module formalizes the split and nonsplit parametrizations underlying Lemmas 4 and 5 of +Bourgain--Gamburd--Sarnak. The trace-zero fiber is deliberately kept visible: although its +rotation is semisimple, its conic is singular, so the paper's claimed single-torus +parametrization needs the additional hypothesis that the fixed normalized trace is nonzero. +-/ + +namespace BGS.Markoff + +universe u + +section SplitFiber + +variable {F : Type u} [Field F] + +/-- The scalar product of the two eigen-coordinates on a nonparabolic normalized fiber. -/ +def splitFiberProduct (w : Fˣ) : F := + splitTorusTrace w ^ 2 / (splitTorusTrace w ^ 2 - 4) + +/-- The point on the normalized fiber obtained from a nonzero first eigen-coordinate. -/ +def splitFiberPoint (w s : Fˣ) : NormalizedPoint F := + ⟨splitTorusTrace w, + (s : F) + splitFiberProduct w * ((s⁻¹ : Fˣ) : F), + (s : F) * (w : F) + + splitFiberProduct w * ((s⁻¹ : Fˣ) : F) * ((w⁻¹ : Fˣ) : F)⟩ + +/-- The first eigen-coordinate recovered from a point in the fixed-trace plane. -/ +def splitFiberFirstEigenCoordinate (w : Fˣ) (x : NormalizedPoint F) : F := + (x.u3 - ((w⁻¹ : Fˣ) : F) * x.u2) / + ((w : F) - ((w⁻¹ : Fˣ) : F)) + +/-- The second eigen-coordinate recovered from a point in the fixed-trace plane. -/ +def splitFiberSecondEigenCoordinate (w : Fˣ) (x : NormalizedPoint F) : F := + ((w : F) * x.u2 - x.u3) / + ((w : F) - ((w⁻¹ : Fˣ) : F)) + +theorem splitTorusTrace_sq_sub_four (w : Fˣ) : + splitTorusTrace w ^ 2 - 4 = + ((w : F) - ((w⁻¹ : Fˣ) : F)) ^ 2 := by + simp [splitTorusTrace] + field_simp + ring + +theorem splitEigenvalueDifference_ne_zero (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + (w : F) - ((w⁻¹ : Fˣ) : F) ≠ 0 := by + intro h + apply hw + have hinv : ((w⁻¹ : Fˣ) : F) = (w : F) := by + exact (sub_eq_zero.mp h).symm + rw [pow_two] + calc + (w : F) * (w : F) = ((w⁻¹ : Fˣ) : F) * (w : F) := by rw [hinv] + _ = 1 := by simp + +theorem splitFiberProduct_ne_zero (w : Fˣ) + (hw : (w : F) ^ 2 ≠ 1) (htrace : splitTorusTrace w ≠ 0) : + splitFiberProduct w ≠ 0 := by + apply div_ne_zero + · exact pow_ne_zero 2 htrace + · rw [splitTorusTrace_sq_sub_four] + exact pow_ne_zero 2 (splitEigenvalueDifference_ne_zero w hw) + +theorem normalizedPolynomial_splitEigenCoordinates (w : Fˣ) (a b : F) : + normalizedPolynomial + (⟨splitTorusTrace w, a + b, + a * (w : F) + b * ((w⁻¹ : Fˣ) : F)⟩ : NormalizedPoint F) = + splitTorusTrace w ^ 2 + (4 - splitTorusTrace w ^ 2) * a * b := by + simp [normalizedPolynomial, splitTorusTrace] + field_simp + ring + +theorem splitFiberPoint_mem (w s : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + splitFiberPoint w s ∈ normalizedFiber1 (splitTorusTrace w) := by + constructor + · change normalizedPolynomial (splitFiberPoint w s) = 0 + change normalizedPolynomial + (⟨splitTorusTrace w, + (s : F) + splitFiberProduct w * ((s⁻¹ : Fˣ) : F), + (s : F) * (w : F) + + (splitFiberProduct w * ((s⁻¹ : Fˣ) : F)) * ((w⁻¹ : Fˣ) : F)⟩ : + NormalizedPoint F) = 0 + rw [normalizedPolynomial_splitEigenCoordinates] + rw [splitFiberProduct, splitTorusTrace_sq_sub_four] + have hdifference := splitEigenvalueDifference_ne_zero w hw + field_simp + simp [splitTorusTrace] + right + field_simp + ring + · rfl + +theorem splitFiberFirstEigenCoordinate_point (w s : Fˣ) + (hw : (w : F) ^ 2 ≠ 1) : + splitFiberFirstEigenCoordinate w (splitFiberPoint w s) = (s : F) := by + rw [splitFiberFirstEigenCoordinate, splitFiberPoint] + have hdifference := splitEigenvalueDifference_ne_zero w hw + simp only [mul_assoc] + simp + field_simp + ring + +theorem splitFiberEigenCoordinates_add (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) + (x : NormalizedPoint F) : + splitFiberFirstEigenCoordinate w x + splitFiberSecondEigenCoordinate w x = x.u2 := by + rw [splitFiberFirstEigenCoordinate, splitFiberSecondEigenCoordinate] + have hdifference := splitEigenvalueDifference_ne_zero w hw + field_simp + ring + +theorem splitFiberEigenCoordinates_weighted_add + (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) (x : NormalizedPoint F) : + splitFiberFirstEigenCoordinate w x * (w : F) + + splitFiberSecondEigenCoordinate w x * ((w⁻¹ : Fˣ) : F) = x.u3 := by + rw [splitFiberFirstEigenCoordinate, splitFiberSecondEigenCoordinate] + have hdifference := splitEigenvalueDifference_ne_zero w hw + field_simp + simp + ring + +theorem splitFiberEigenCoordinates_product (w : Fˣ) + (hw : (w : F) ^ 2 ≠ 1) + (x : ↑(normalizedFiber1 (splitTorusTrace w))) : + splitFiberFirstEigenCoordinate w x * splitFiberSecondEigenCoordinate w x = + splitFiberProduct w := by + have hpoint : + (x : NormalizedPoint F) = + ⟨splitTorusTrace w, + splitFiberFirstEigenCoordinate w x + splitFiberSecondEigenCoordinate w x, + splitFiberFirstEigenCoordinate w x * (w : F) + + splitFiberSecondEigenCoordinate w x * ((w⁻¹ : Fˣ) : F)⟩ := by + ext + · exact x.property.2 + · exact (splitFiberEigenCoordinates_add w hw x).symm + · exact (splitFiberEigenCoordinates_weighted_add w hw x).symm + have hpolynomial : normalizedPolynomial (x : NormalizedPoint F) = 0 := x.property.1 + rw [hpoint, normalizedPolynomial_splitEigenCoordinates] at hpolynomial + rw [show 4 - splitTorusTrace w ^ 2 = -(splitTorusTrace w ^ 2 - 4) by ring, + splitTorusTrace_sq_sub_four] at hpolynomial + rw [splitFiberProduct, splitTorusTrace_sq_sub_four] + have hdifference := splitEigenvalueDifference_ne_zero w hw + field_simp + linear_combination -hpolynomial + +theorem splitFiberFirstEigenCoordinate_ne_zero (w : Fˣ) + (hw : (w : F) ^ 2 ≠ 1) (htrace : splitTorusTrace w ≠ 0) + (x : ↑(normalizedFiber1 (splitTorusTrace w))) : + splitFiberFirstEigenCoordinate w x ≠ 0 := by + intro hzero + have hproduct := splitFiberEigenCoordinates_product w hw x + rw [hzero, zero_mul] at hproduct + exact splitFiberProduct_ne_zero w hw htrace hproduct.symm + +/-- The split semisimple normalized fiber, away from trace zero, is explicitly equivalent to +the multiplicative group of the base field. -/ +noncomputable def splitFiberEquiv (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) + (htrace : splitTorusTrace w ≠ 0) : + Fˣ ≃ ↑(normalizedFiber1 (splitTorusTrace w)) where + toFun s := ⟨splitFiberPoint w s, splitFiberPoint_mem w s hw⟩ + invFun x := Units.mk0 (splitFiberFirstEigenCoordinate w x) + (splitFiberFirstEigenCoordinate_ne_zero w hw htrace x) + left_inv s := by + apply Units.ext + exact splitFiberFirstEigenCoordinate_point w s hw + right_inv x := by + apply Subtype.ext + let a := splitFiberFirstEigenCoordinate w x + let b := splitFiberSecondEigenCoordinate w x + have ha : a ≠ 0 := splitFiberFirstEigenCoordinate_ne_zero w hw htrace x + have hab : a * b = splitFiberProduct w := splitFiberEigenCoordinates_product w hw x + have hb : splitFiberProduct w * a⁻¹ = b := by + rw [← hab] + field_simp + ext + · exact x.property.2.symm + · change a + splitFiberProduct w * a⁻¹ = x.val.u2 + rw [hb] + exact splitFiberEigenCoordinates_add w hw x + · change a * (w : F) + splitFiberProduct w * a⁻¹ * ((w⁻¹ : Fˣ) : F) = + x.val.u3 + rw [hb] + exact splitFiberEigenCoordinates_weighted_add w hw x + +/-- Under the explicit split-fiber parametrization, normalized rotation is multiplication by +the chosen eigenvalue. -/ +theorem normalizedRotate1_splitFiberPoint (w s : Fˣ) : + normalizedRotate1 (splitFiberPoint w s) = splitFiberPoint w (s * w) := by + ext + · rfl + · simp [normalizedRotate1, splitFiberPoint, splitTorusTrace] + field_simp + · simp [normalizedRotate1, splitFiberPoint, splitTorusTrace] + field_simp + ring + +/-- Every iterate of the split-fiber rotation multiplies the eigen-coordinate by the matching +power of the eigenvalue. -/ +theorem iterate_normalizedRotate1_splitFiberPoint (w s : Fˣ) (n : ℕ) : + (normalizedRotate1^[n]) (splitFiberPoint w s) = splitFiberPoint w (s * w ^ n) := by + induction n with + | zero => simp + | succ n ih => + rw [Function.iterate_succ_apply', ih, normalizedRotate1_splitFiberPoint] + congr 1 + rw [pow_succ, mul_assoc] + +theorem iterate_normalizedRotate1_splitFiberPoint_eq_self_iff + (w s : Fˣ) (hw : (w : F) ^ 2 ≠ 1) (n : ℕ) : + (normalizedRotate1^[n]) (splitFiberPoint w s) = splitFiberPoint w s ↔ w ^ n = 1 := by + rw [iterate_normalizedRotate1_splitFiberPoint] + constructor + · intro hpoint + have hcoordinate := congrArg (splitFiberFirstEigenCoordinate w) hpoint + rw [splitFiberFirstEigenCoordinate_point w (s * w ^ n) hw, + splitFiberFirstEigenCoordinate_point w s hw] at hcoordinate + have hunit : s * w ^ n = s * 1 := by + apply Units.ext + simpa using hcoordinate + exact mul_left_cancel hunit + · intro hpower + rw [hpower, mul_one] + +/-- The finite cycle obtained from one full split rotation period. -/ +noncomputable def splitRotationCycle (w s : Fˣ) : Finset (NormalizedPoint F) := by + classical + exact (Finset.range (orderOf w)).image fun n => + (normalizedRotate1^[n]) (splitFiberPoint w s) + +/-- The split rotation cycle has exactly the multiplicative order of its eigenvalue. -/ +theorem splitRotationCycle_card (w s : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + (splitRotationCycle w s).card = orderOf w := by + classical + let f : ℕ → NormalizedPoint F := fun n => + (normalizedRotate1^[n]) (splitFiberPoint w s) + have hinjective : Set.InjOn f (Finset.range (orderOf w)) := by + intro n hn m hm hequal + have hn' : n < orderOf w := by simpa using hn + have hm' : m < orderOf w := by simpa using hm + change (normalizedRotate1^[n]) (splitFiberPoint w s) = + (normalizedRotate1^[m]) (splitFiberPoint w s) at hequal + rw [iterate_normalizedRotate1_splitFiberPoint, + iterate_normalizedRotate1_splitFiberPoint] at hequal + have hcoordinate := congrArg (splitFiberFirstEigenCoordinate w) hequal + rw [splitFiberFirstEigenCoordinate_point w (s * w ^ n) hw, + splitFiberFirstEigenCoordinate_point w (s * w ^ m) hw] at hcoordinate + have hpowers : w ^ n = w ^ m := by + have hunit : s * w ^ n = s * w ^ m := by + apply Units.ext + simpa using hcoordinate + exact mul_left_cancel hunit + exact pow_injOn_Iio_orderOf hn' hm' hpowers + calc + (splitRotationCycle w s).card = ((Finset.range (orderOf w)).image f).card := by + rfl + _ = (Finset.range (orderOf w)).card := Finset.card_image_iff.mpr hinjective + _ = orderOf w := Finset.card_range _ + +/-- Replacing the eigenvalue order by the already-proved matrix rotation order connects the +explicit split cycle to the project's canonical `rotationOrder`. -/ +theorem splitRotationCycle_card_eq_rotationOrder + (w s : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + (splitRotationCycle w s).card = rotationOrder (splitTorusTrace w) := by + rw [splitRotationCycle_card w s hw, rotationOrder_splitTorusTrace w hw] + +/-- Consequently a finite split fiber with nonzero trace has exactly one fewer point than the +base field. -/ +theorem splitFiber_card + [Finite F] (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) + (htrace : splitTorusTrace w ≠ 0) : + Nat.card ↑(normalizedFiber1 (splitTorusTrace w)) = Nat.card F - 1 := by + rw [← Nat.card_units] + exact Nat.card_congr (splitFiberEquiv w hw htrace).symm + +theorem splitNormalizedFiber_zmod_natCard + (p : ℕ) [Fact p.Prime] (w : (ZMod p)ˣ) + (hw : (w : ZMod p) ^ 2 ≠ 1) (htrace : splitTorusTrace w ≠ 0) : + Nat.card ↑(normalizedFiber1 (splitTorusTrace w)) = p - 1 := by + rw [splitFiber_card w hw htrace, Nat.card_zmod] + +end SplitFiber + +section TraceZeroObstruction + +/-- The punctured normalized fiber used by the paper's conic sections. -/ +def normalizedPuncturedFiber1 {R : Type u} [CommRing R] (a : R) : + Set (NormalizedPoint R) := + normalizedFiber1 a \ {normalizedOrigin} + +/-- A computable finite presentation of a normalized fixed-coordinate fiber. -/ +def normalizedFiber1Finset (R : Type u) [CommRing R] [Fintype R] [DecidableEq R] + (a : R) : Finset (NormalizedPoint R) := + Finset.univ.filter fun x => normalizedPolynomial x = 0 ∧ x.u1 = a + +/-- A computable finite presentation of a punctured normalized fixed-coordinate fiber. -/ +def normalizedPuncturedFiber1Finset + (R : Type u) [CommRing R] [Fintype R] [DecidableEq R] (a : R) : + Finset (NormalizedPoint R) := + (normalizedFiber1Finset R a).erase normalizedOrigin + +@[simp] +theorem mem_normalizedFiber1Finset_iff + {R : Type u} [CommRing R] [Fintype R] [DecidableEq R] + {a : R} {x : NormalizedPoint R} : + x ∈ normalizedFiber1Finset R a ↔ x ∈ normalizedFiber1 a := by + simp [normalizedFiber1Finset, normalizedFiber1, IsNormalizedMarkoff] + +@[simp] +theorem mem_normalizedPuncturedFiber1Finset_iff + {R : Type u} [CommRing R] [Fintype R] [DecidableEq R] + {a : R} {x : NormalizedPoint R} : + x ∈ normalizedPuncturedFiber1Finset R a ↔ x ∈ normalizedPuncturedFiber1 a := by + simp [normalizedPuncturedFiber1Finset, normalizedPuncturedFiber1, and_comm] + +/-- The set-theoretic and computable-finset presentations have the same elements. -/ +def normalizedPuncturedFiber1EquivFinset + (R : Type u) [CommRing R] [Fintype R] [DecidableEq R] (a : R) : + ↑(normalizedPuncturedFiber1 a) ≃ ↑(normalizedPuncturedFiber1Finset R a) where + toFun x := ⟨x, mem_normalizedPuncturedFiber1Finset_iff.mpr x.property⟩ + invFun x := ⟨x, mem_normalizedPuncturedFiber1Finset_iff.mp x.property⟩ + left_inv _ := rfl + right_inv _ := rfl + +/-- At the split semisimple trace zero over `ZMod 5`, the full affine fiber has nine points. -/ +theorem normalizedFiber1_zero_zmod_five_card : + (normalizedFiber1Finset (ZMod 5) 0).card = 9 := by + decide + +/-- Removing the singular origin leaves eight points, not the four predicted by the paper's +uniform `p - 1` assertion for split semisimple fibers. -/ +theorem normalizedPuncturedFiber1_zero_zmod_five_card : + (normalizedPuncturedFiber1Finset (ZMod 5) 0).card = 8 := by + decide + +/-- Thus the trace-zero punctured fiber cannot be equivalent to the multiplicative group, which +has four elements. This is the exact obstruction requiring the nonzero-trace hypothesis above. -/ +theorem no_split_torus_equiv_normalizedPuncturedFiber1_zero_zmod_five : + ¬ Nonempty ((ZMod 5)ˣ ≃ ↑(normalizedPuncturedFiber1 (0 : ZMod 5))) := by + rintro ⟨e⟩ + let e' := e.trans (normalizedPuncturedFiber1EquivFinset (ZMod 5) 0) + have hcard := Fintype.card_congr e' + have hunits : Fintype.card (ZMod 5)ˣ = 4 := by decide + rw [hunits, Fintype.card_coe, + normalizedPuncturedFiber1_zero_zmod_five_card] at hcard + omega + +end TraceZeroObstruction + +section QuadraticNormFiber + +variable (p : ℕ) [Fact p.Prime] + +/-- The norm homomorphism on units of the canonical quadratic extension. -/ +noncomputable def quadraticNormUnitsHom : + (quadraticFiniteField p)ˣ →* (ZMod p)ˣ := + Units.map (Algebra.norm (ZMod p) (S := quadraticFiniteField p)) + +/-- A nonzero norm fiber in the canonical quadratic extension. -/ +noncomputable def quadraticNormFiber (k : (ZMod p)ˣ) : + Set (quadraticFiniteField p)ˣ := + quadraticNormUnitsHom p ⁻¹' {k} + +/-- Every nonzero norm fiber is a torsor for the concrete quadratic norm-one torus. -/ +noncomputable def quadraticNormFiberEquivNormOne (k : (ZMod p)ˣ) : + ↑(quadraticNormFiber p k) ≃ quadraticNormOneTorus p := by + change ↑((quadraticNormUnitsHom p) ⁻¹' {k}) ≃ + (quadraticNormUnitsHom p).ker + exact MonoidHom.fiberEquivKerOfSurjective + (FiniteField.unitsMap_norm_surjective (ZMod p) (quadraticFiniteField p)) k + +/-- The equality-form fiber used by `Equiv.sigmaFiberEquiv` is the same norm torsor. -/ +noncomputable def quadraticNormEquationFiberEquivNormOne (k : (ZMod p)ˣ) : + {s : (quadraticFiniteField p)ˣ // quadraticNormUnitsHom p s = k} ≃ + quadraticNormOneTorus p := by + let equationToSet : + {s : (quadraticFiniteField p)ˣ // quadraticNormUnitsHom p s = k} ≃ + ↑(quadraticNormFiber p k) := + { toFun := fun s => ⟨s, by + change quadraticNormUnitsHom p s ∈ ({k} : Set (ZMod p)ˣ) + simpa using s.property⟩ + invFun := fun s => ⟨s, by + have hs := s.property + change quadraticNormUnitsHom p s ∈ ({k} : Set (ZMod p)ˣ) at hs + simpa using hs⟩ + left_inv := fun _ => rfl + right_inv := fun _ => rfl } + exact equationToSet.trans (quadraticNormFiberEquivNormOne p k) + +/-- The multiplicative group of the quadratic field is a product of the base-field units and +the norm-one torus, after making the canonical finite-field norm-fiber choices. -/ +noncomputable def quadraticUnitsEquivBaseUnitsProdNormOne : + (quadraticFiniteField p)ˣ ≃ (ZMod p)ˣ × quadraticNormOneTorus p := + (Equiv.sigmaFiberEquiv (quadraticNormUnitsHom p)).symm.trans <| + Equiv.sigmaEquivProdOfEquiv fun k => quadraticNormEquationFiberEquivNormOne p k + +/-- The concrete quadratic norm-one torus has exactly `p + 1` elements. -/ +theorem quadraticNormOneTorus_natCard : Nat.card (quadraticNormOneTorus p) = p + 1 := by + have hcard := Nat.card_congr (quadraticUnitsEquivBaseUnitsProdNormOne p) + rw [Nat.card_units, Nat.card_prod, Nat.card_units, + GaloisField.card p (n := 2) (by norm_num), Nat.card_zmod] at hcard + have hpPositive : 0 < p - 1 := Nat.sub_pos_of_lt (Fact.out : p.Prime).one_lt + apply Nat.eq_of_mul_eq_mul_left hpPositive + calc + (p - 1) * Nat.card (quadraticNormOneTorus p) = p ^ 2 - 1 := hcard.symm + _ = (p - 1) * (p + 1) := by + rw [show p ^ 2 - 1 = (p + 1) * (p - 1) by + simpa using (sq_tsub_sq p 1)] + ring + +/-- Every nonzero quadratic norm fiber has `p + 1` points. -/ +theorem quadraticNormFiber_natCard (k : (ZMod p)ˣ) : + Nat.card ↑(quadraticNormFiber p k) = p + 1 := by + rw [Nat.card_congr (quadraticNormFiberEquivNormOne p k)] + exact quadraticNormOneTorus_natCard p + +private theorem quadraticFiniteField_finrank : + Module.finrank (ZMod p) (quadraticFiniteField p) = 2 := + GaloisField.finrank p (n := 2) (by norm_num) + +/-- The quadratic field trace is the sum of an element and its `p`-power Frobenius conjugate. -/ +theorem algebraMap_quadraticTrace (x : quadraticFiniteField p) : + algebraMap (ZMod p) (quadraticFiniteField p) + (Algebra.trace (ZMod p) (quadraticFiniteField p) x) = + x + x ^ p := by + have h := FiniteField.algebraMap_trace_eq_sum_pow + (ZMod p) (quadraticFiniteField p) x + rw [quadraticFiniteField_finrank p, Nat.card_zmod] at h + simpa [Finset.sum_range_succ] using h + +/-- The quadratic field norm is the product of an element and its `p`-power Frobenius +conjugate. -/ +theorem algebraMap_quadraticNorm (x : quadraticFiniteField p) : + algebraMap (ZMod p) (quadraticFiniteField p) + (Algebra.norm (ZMod p) x) = x * x ^ p := by + have h := FiniteField.algebraMap_norm_eq_prod_pow + (ZMod p) (quadraticFiniteField p) x + rw [quadraticFiniteField_finrank p, Nat.card_zmod] at h + simpa [Finset.prod_range_succ] using h + +/-- Frobenius acts on a norm-one eigenvalue by inversion. -/ +theorem quadraticNormOne_frobenius_eq_inv (w : quadraticNormOneTorus p) : + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ p) = + (((w : (quadraticFiniteField p)ˣ)⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p) := by + have hwNorm : Algebra.norm (ZMod p) + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) = 1 := by + exact congrArg Units.val w.property + have hnorm := algebraMap_quadraticNorm p + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + rw [hwNorm, map_one] at hnorm + have hscalar : + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ p) = + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)⁻¹) := by + apply (mul_eq_one_iff_eq_inv₀ + (show ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ≠ 0 by + exact Units.ne_zero _)).mp + rw [mul_comm] + exact hnorm.symm + simpa using hscalar + +/-- Frobenius on a nonzero norm fiber is multiplication by the prescribed norm followed by +inversion. -/ +theorem quadraticNormFiber_frobenius_eq_norm_mul_inv + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) : + ((s.1 : quadraticFiniteField p) ^ p) = + algebraMap (ZMod p) (quadraticFiniteField p) (k : ZMod p) * + ((s.1 : quadraticFiniteField p)⁻¹) := by + have hsNormUnits : quadraticNormUnitsHom p s.1 = k := by + have hs := s.property + change quadraticNormUnitsHom p s.1 ∈ ({k} : Set (ZMod p)ˣ) at hs + simpa only [Set.mem_singleton_iff] using hs + have hsNorm : Algebra.norm (ZMod p) (s.1 : quadraticFiniteField p) = (k : ZMod p) := + congrArg Units.val hsNormUnits + have hnorm := algebraMap_quadraticNorm p (s.1 : quadraticFiniteField p) + rw [hsNorm] at hnorm + field_simp + simpa [mul_comm] using hnorm.symm + +/-- The scalar `t²/(t²-4)` controlling either eigen-coordinate parametrization. -/ +noncomputable def quadraticFiberProduct (t : ZMod p) : ZMod p := + t ^ 2 / (t ^ 2 - 4) + +theorem quadraticFiberProduct_ne_zero (t : ZMod p) + (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) : quadraticFiberProduct p t ≠ 0 := by + exact div_ne_zero (pow_ne_zero 2 ht0) (sub_ne_zero.mpr ht) + +/-- The nonzero scalar as a unit, used to index its norm fiber. -/ +noncomputable def quadraticFiberProductUnit + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) : + (ZMod p)ˣ := + Units.mk0 (quadraticFiberProduct p t) (quadraticFiberProduct_ne_zero p t ht ht0) + +/-- The norm fiber occurring in the paper's nonsplit conic parametrization. -/ +noncomputable def quadraticConicNormFiber + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) : + Set (quadraticFiniteField p)ˣ := + quadraticNormFiber p (quadraticFiberProductUnit p t ht ht0) + +/-- Coordinatewise scalar extension of a normalized point. -/ +noncomputable def algebraMapNormalizedPoint (x : NormalizedPoint (ZMod p)) : + NormalizedPoint (quadraticFiniteField p) := + ⟨algebraMap (ZMod p) (quadraticFiniteField p) x.u1, + algebraMap (ZMod p) (quadraticFiniteField p) x.u2, + algebraMap (ZMod p) (quadraticFiniteField p) x.u3⟩ + +theorem normalizedPolynomial_algebraMapNormalizedPoint + (x : NormalizedPoint (ZMod p)) : + normalizedPolynomial (algebraMapNormalizedPoint p x) = + algebraMap (ZMod p) (quadraticFiniteField p) (normalizedPolynomial x) := by + simp [normalizedPolynomial, algebraMapNormalizedPoint] + +/-- Trace coordinates turn a point of the prescribed norm fiber into a normalized base-field +point. -/ +noncomputable def quadraticNormFiberPoint + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : NormalizedPoint (ZMod p) := + ⟨t, + Algebra.trace (ZMod p) (quadraticFiniteField p) + (s.1 : quadraticFiniteField p), + Algebra.trace (ZMod p) (quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) * + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p))⟩ + +theorem algebraMap_quadraticFiberProduct + (t : ZMod p) (w : quadraticNormOneTorus p) + (htrace : quadraticNormOneTrace p w = t) : + algebraMap (ZMod p) (quadraticFiniteField p) (quadraticFiberProduct p t) = + splitFiberProduct (w : (quadraticFiniteField p)ˣ) := by + have htraceExtension : + algebraMap (ZMod p) (quadraticFiniteField p) t = + splitTorusTrace (w : (quadraticFiniteField p)ˣ) := by + rw [← htrace] + exact algebraMap_quadraticNormOneTrace p w + simp [quadraticFiberProduct, splitFiberProduct, htraceExtension, map_ofNat] + +theorem algebraMap_quadraticNormFiberPoint + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + algebraMapNormalizedPoint p (quadraticNormFiberPoint p t ht ht0 w s) = + splitFiberPoint (w : (quadraticFiniteField p)ˣ) s.1 := by + let k := quadraticFiberProductUnit p t ht ht0 + have hsFrobenius := quadraticNormFiber_frobenius_eq_norm_mul_inv p k s + have hwFrobenius := quadraticNormOne_frobenius_eq_inv p w + have hk : + algebraMap (ZMod p) (quadraticFiniteField p) (k : ZMod p) = + splitFiberProduct (w : (quadraticFiniteField p)ˣ) := by + exact algebraMap_quadraticFiberProduct p t w htrace + ext + · change algebraMap (ZMod p) (quadraticFiniteField p) t = + splitTorusTrace (w : (quadraticFiniteField p)ˣ) + rw [← htrace] + exact algebraMap_quadraticNormOneTrace p w + · change algebraMap (ZMod p) (quadraticFiniteField p) + (Algebra.trace (ZMod p) (quadraticFiniteField p) + (s.1 : quadraticFiniteField p)) = _ + rw [algebraMap_quadraticTrace, hsFrobenius, hk] + simp [splitFiberPoint] + · change algebraMap (ZMod p) (quadraticFiniteField p) + (Algebra.trace (ZMod p) (quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) * + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p))) = _ + rw [algebraMap_quadraticTrace, mul_pow, hsFrobenius, hwFrobenius, hk] + simp [splitFiberPoint] + +theorem quadraticNormFiberPoint_mem + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + quadraticNormFiberPoint p t ht ht0 w s ∈ normalizedFiber1 t := by + constructor + · change normalizedPolynomial (quadraticNormFiberPoint p t ht ht0 w s) = 0 + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + rw [← normalizedPolynomial_algebraMapNormalizedPoint] + rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace s] + rw [map_zero] + simpa only [IsNormalizedMarkoff] using + (splitFiberPoint_mem (w : (quadraticFiniteField p)ˣ) s.1 hw).1 + · rfl + +/-- Multiplication by a norm-one element preserves every nonzero norm fiber. -/ +noncomputable def quadraticNormFiberMulNormOne + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) + (g : quadraticNormOneTorus p) : ↑(quadraticNormFiber p k) := by + refine ⟨s.1 * (g : (quadraticFiniteField p)ˣ), ?_⟩ + have hs := s.property + change quadraticNormUnitsHom p s.1 ∈ ({k} : Set (ZMod p)ˣ) at hs + have hg := g.property + change quadraticNormUnitsHom p (g : (quadraticFiniteField p)ˣ) = 1 at hg + change quadraticNormUnitsHom p (s.1 * (g : (quadraticFiniteField p)ˣ)) ∈ + ({k} : Set (ZMod p)ˣ) + rw [Set.mem_singleton_iff, map_mul, Set.mem_singleton_iff.mp hs, hg, mul_one] + +theorem algebraMapNormalizedPoint_injective : + Function.Injective (algebraMapNormalizedPoint p) := by + intro x y h + ext + · apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + exact congrArg NormalizedPoint.u1 h + · apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + exact congrArg NormalizedPoint.u2 h + · apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + exact congrArg NormalizedPoint.u3 h + +theorem algebraMapNormalizedPoint_normalizedRotate1 (x : NormalizedPoint (ZMod p)) : + algebraMapNormalizedPoint p (normalizedRotate1 x) = + normalizedRotate1 (algebraMapNormalizedPoint p x) := by + ext <;> simp [algebraMapNormalizedPoint, normalizedRotate1] + +theorem algebraMap_zmod_pow_card (a : ZMod p) : + (algebraMap (ZMod p) (quadraticFiniteField p) a) ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) a := by + rw [← map_pow, ZMod.pow_card] + +/-- A base-field fiber point, viewed on the diagonalized fiber in the quadratic extension. -/ +noncomputable def algebraMapNormalizedFiberPoint + (t : ZMod p) (w : quadraticNormOneTorus p) + (htrace : quadraticNormOneTrace p w = t) + (x : ↑(normalizedFiber1 t)) : + ↑(normalizedFiber1 (splitTorusTrace (w : (quadraticFiniteField p)ˣ))) := by + refine ⟨algebraMapNormalizedPoint p x, ?_⟩ + constructor + · change normalizedPolynomial (algebraMapNormalizedPoint p x) = 0 + rw [normalizedPolynomial_algebraMapNormalizedPoint] + rw [x.property.1] + exact map_zero _ + · change algebraMap (ZMod p) (quadraticFiniteField p) x.val.u1 = + splitTorusTrace (w : (quadraticFiniteField p)ˣ) + rw [x.property.2, ← htrace] + exact algebraMap_quadraticNormOneTrace p w + +/-- For a base-field point, Frobenius exchanges its two eigen-coordinates in the quadratic +extension. -/ +theorem quadraticFiberFirstEigenCoordinate_frobenius + (t : ZMod p) (w : quadraticNormOneTorus p) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (x : ↑(normalizedFiber1 t)) : + (splitFiberFirstEigenCoordinate (w : (quadraticFiniteField p)ˣ) + (algebraMapNormalizedPoint p x)) ^ p = + splitFiberSecondEigenCoordinate (w : (quadraticFiniteField p)ˣ) + (algebraMapNormalizedPoint p x) := by + have hwFrobenius := quadraticNormOne_frobenius_eq_inv p w + have hwInverseFrobenius : + ((((w : (quadraticFiniteField p)ˣ)⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p) ^ p) = + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) := by + have hwFrobeniusScalar : + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ p) = + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)⁻¹) := by + simpa using hwFrobenius + have hscalar : + ((((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)⁻¹) ^ p) = + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) := by + rw [inv_pow, hwFrobeniusScalar, inv_inv] + simpa using hscalar + rw [splitFiberFirstEigenCoordinate, splitFiberSecondEigenCoordinate, div_pow, + sub_pow_char, mul_pow, sub_pow_char] + change + ((algebraMap (ZMod p) (quadraticFiniteField p) x.val.u3) ^ p - + ((((w : (quadraticFiniteField p)ˣ)⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p) ^ p) * + (algebraMap (ZMod p) (quadraticFiniteField p) x.val.u2) ^ p) / + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ p - + ((((w : (quadraticFiniteField p)ˣ)⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p) ^ p)) = _ + rw [algebraMap_zmod_pow_card, algebraMap_zmod_pow_card, + hwFrobenius, hwInverseFrobenius] + have hdifference := splitEigenvalueDifference_ne_zero + (w : (quadraticFiniteField p)ˣ) hw + simp only [algebraMapNormalizedPoint] + rw [show (((w : (quadraticFiniteField p)ˣ)⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p) - + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) = + -(((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) - + (((w : (quadraticFiniteField p)ˣ)⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) by ring] + field_simp [hdifference] + ring + +/-- Recover the first extension-field eigen-coordinate from a base-field conic point and prove +that it lies in the prescribed norm fiber. -/ +noncomputable def quadraticNormFiberParameter + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (x : ↑(normalizedFiber1 t)) : + ↑(quadraticConicNormFiber p t ht ht0) := by + let extensionPoint := algebraMapNormalizedFiberPoint p t w htrace x + have htraceExtension : + splitTorusTrace (w : (quadraticFiniteField p)ˣ) ≠ 0 := by + rw [← algebraMap_quadraticNormOneTrace p w, htrace] + simpa using (algebraMap (ZMod p) (quadraticFiniteField p)).injective.ne ht0 + let parameterValue := splitFiberFirstEigenCoordinate + (w : (quadraticFiniteField p)ˣ) extensionPoint + have hparameterValue : parameterValue ≠ 0 := + splitFiberFirstEigenCoordinate_ne_zero + (w : (quadraticFiniteField p)ˣ) hw htraceExtension extensionPoint + let parameterUnit : (quadraticFiniteField p)ˣ := + Units.mk0 parameterValue hparameterValue + refine ⟨parameterUnit, ?_⟩ + change parameterUnit ∈ quadraticNormFiber p (quadraticFiberProductUnit p t ht ht0) + change quadraticNormUnitsHom p parameterUnit ∈ + ({quadraticFiberProductUnit p t ht ht0} : Set (ZMod p)ˣ) + rw [Set.mem_singleton_iff] + apply Units.ext + change Algebra.norm (ZMod p) parameterValue = quadraticFiberProduct p t + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + rw [algebraMap_quadraticNorm] + rw [show parameterValue ^ p = + splitFiberSecondEigenCoordinate (w : (quadraticFiniteField p)ˣ) + (algebraMapNormalizedPoint p x) by + exact quadraticFiberFirstEigenCoordinate_frobenius p t w hw x] + rw [algebraMap_quadraticFiberProduct p t w htrace] + exact splitFiberEigenCoordinates_product + (w : (quadraticFiniteField p)ˣ) hw extensionPoint + +theorem quadraticNormFiberParameter_point + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + quadraticNormFiberParameter p t ht ht0 w htrace hw + ⟨quadraticNormFiberPoint p t ht ht0 w s, + quadraticNormFiberPoint_mem p t ht ht0 w htrace hw s⟩ = s := by + apply Subtype.ext + apply Units.ext + change splitFiberFirstEigenCoordinate (w : (quadraticFiniteField p)ˣ) + (algebraMapNormalizedPoint p (quadraticNormFiberPoint p t ht ht0 w s)) = + (s.1 : quadraticFiniteField p) + rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace s] + exact splitFiberFirstEigenCoordinate_point + (w : (quadraticFiniteField p)ˣ) s.1 hw + +theorem quadraticNormFiberPoint_parameter + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (x : ↑(normalizedFiber1 t)) : + quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberParameter p t ht ht0 w htrace hw x) = x := by + apply algebraMapNormalizedPoint_injective p + rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace] + let extensionPoint := algebraMapNormalizedFiberPoint p t w htrace x + have htraceExtension : + splitTorusTrace (w : (quadraticFiniteField p)ˣ) ≠ 0 := by + rw [← algebraMap_quadraticNormOneTrace p w, htrace] + simpa using (algebraMap (ZMod p) (quadraticFiniteField p)).injective.ne ht0 + have hright := (splitFiberEquiv + (w : (quadraticFiniteField p)ˣ) hw htraceExtension).apply_symm_apply extensionPoint + exact congrArg Subtype.val hright + +/-- The nonsplit nonzero normalized fiber is explicitly equivalent to its quadratic norm fiber. -/ +noncomputable def quadraticNormFiberEquiv + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) : + ↑(quadraticConicNormFiber p t ht ht0) ≃ ↑(normalizedFiber1 t) where + toFun s := ⟨quadraticNormFiberPoint p t ht ht0 w s, + quadraticNormFiberPoint_mem p t ht ht0 w htrace hw s⟩ + invFun := quadraticNormFiberParameter p t ht ht0 w htrace hw + left_inv := quadraticNormFiberParameter_point p t ht ht0 w htrace hw + right_inv x := by + apply Subtype.ext + exact quadraticNormFiberPoint_parameter p t ht ht0 w htrace hw x + +/-- Consequently the nonsplit nonzero normalized fiber has exactly `p + 1` points. -/ +theorem nonsplitNormalizedFiber_natCard + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) : + Nat.card ↑(normalizedFiber1 t) = p + 1 := by + rw [← Nat.card_congr (quadraticNormFiberEquiv p t ht ht0 w htrace hw)] + exact quadraticNormFiber_natCard p (quadraticFiberProductUnit p t ht ht0) + +/-- On the nonsplit norm-fiber parametrization, normalized rotation is multiplication by its +norm-one eigenvalue. -/ +theorem normalizedRotate1_quadraticNormFiberPoint + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + normalizedRotate1 (quadraticNormFiberPoint p t ht ht0 w s) = + quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberMulNormOne p (quadraticFiberProductUnit p t ht ht0) s w) := by + apply algebraMapNormalizedPoint_injective p + rw [algebraMapNormalizedPoint_normalizedRotate1] + rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace s] + rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace] + rw [normalizedRotate1_splitFiberPoint] + rfl + +theorem quadraticNormFiberMulNormOne_assoc + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) + (g h : quadraticNormOneTorus p) : + quadraticNormFiberMulNormOne p k (quadraticNormFiberMulNormOne p k s g) h = + quadraticNormFiberMulNormOne p k s (g * h) := by + apply Subtype.ext + simp [quadraticNormFiberMulNormOne, mul_assoc] + +theorem quadraticNormFiberMulNormOne_one + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) : + quadraticNormFiberMulNormOne p k s 1 = s := by + apply Subtype.ext + simp [quadraticNormFiberMulNormOne] + +theorem quadraticNormFiberMulNormOne_pow + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) + (g : quadraticNormOneTorus p) (n : ℕ) : + (quadraticNormFiberMulNormOne p k s (g ^ n)).1 = + s.1 * (g : (quadraticFiniteField p)ˣ) ^ n := by + rfl + +theorem quadraticNormFiberPoint_injective + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) : + Function.Injective (quadraticNormFiberPoint p t ht ht0 w) := by + intro s r hpoint + have hextension := congrArg (algebraMapNormalizedPoint p) hpoint + rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace s, + algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace r] at hextension + have hcoordinate := congrArg + (splitFiberFirstEigenCoordinate (w : (quadraticFiniteField p)ˣ)) hextension + rw [splitFiberFirstEigenCoordinate_point (w : (quadraticFiniteField p)ˣ) s.1 hw, + splitFiberFirstEigenCoordinate_point (w : (quadraticFiniteField p)ˣ) r.1 hw] at hcoordinate + apply Subtype.ext + apply Units.ext + exact hcoordinate + +theorem iterate_normalizedRotate1_quadraticNormFiberPoint + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↑(quadraticConicNormFiber p t ht ht0)) (n : ℕ) : + (normalizedRotate1^[n]) (quadraticNormFiberPoint p t ht ht0 w s) = + quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberMulNormOne p (quadraticFiberProductUnit p t ht ht0) s (w ^ n)) := by + induction n with + | zero => + simp [quadraticNormFiberMulNormOne_one] + | succ n ih => + rw [Function.iterate_succ_apply', ih, + normalizedRotate1_quadraticNormFiberPoint p t ht ht0 w htrace] + congr 1 + rw [quadraticNormFiberMulNormOne_assoc, pow_succ] + +theorem iterate_normalizedRotate1_quadraticNormFiberPoint_eq_self_iff + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (s : ↑(quadraticConicNormFiber p t ht ht0)) (n : ℕ) : + (normalizedRotate1^[n]) (quadraticNormFiberPoint p t ht ht0 w s) = + quadraticNormFiberPoint p t ht ht0 w s ↔ w ^ n = 1 := by + rw [iterate_normalizedRotate1_quadraticNormFiberPoint p t ht ht0 w htrace] + constructor + · intro hpoint + have hparameter := quadraticNormFiberPoint_injective p t ht ht0 w htrace hw hpoint + have hunit : s.1 * ((w ^ n : quadraticNormOneTorus p) : + (quadraticFiniteField p)ˣ) = s.1 * 1 := by + simpa [quadraticNormFiberMulNormOne] using congrArg Subtype.val hparameter + apply Subtype.ext + exact mul_left_cancel hunit + · intro hpower + rw [hpower, quadraticNormFiberMulNormOne_one] + +/-- One full nonsplit rotation cycle, represented in the base-field conic. -/ +noncomputable def quadraticNormFiberRotationCycle + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + Finset (NormalizedPoint (ZMod p)) := by + classical + exact (Finset.range (orderOf w)).image fun n => + (normalizedRotate1^[n]) (quadraticNormFiberPoint p t ht ht0 w s) + +theorem quadraticNormFiberRotationCycle_card + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + (quadraticNormFiberRotationCycle p t ht ht0 w s).card = orderOf w := by + classical + let f : ℕ → NormalizedPoint (ZMod p) := fun n => + (normalizedRotate1^[n]) (quadraticNormFiberPoint p t ht ht0 w s) + have hinjective : Set.InjOn f (Finset.range (orderOf w)) := by + intro n hn m hm hequal + have hn' : n < orderOf w := by simpa using hn + have hm' : m < orderOf w := by simpa using hm + change (normalizedRotate1^[n]) (quadraticNormFiberPoint p t ht ht0 w s) = + (normalizedRotate1^[m]) (quadraticNormFiberPoint p t ht ht0 w s) at hequal + rw [iterate_normalizedRotate1_quadraticNormFiberPoint p t ht ht0 w htrace, + iterate_normalizedRotate1_quadraticNormFiberPoint p t ht ht0 w htrace] at hequal + have hparameter := quadraticNormFiberPoint_injective p t ht ht0 w htrace hw hequal + have hpowers : w ^ n = w ^ m := by + apply Subtype.ext + have hunit : s.1 * ((w ^ n : quadraticNormOneTorus p) : + (quadraticFiniteField p)ˣ) = + s.1 * ((w ^ m : quadraticNormOneTorus p) : (quadraticFiniteField p)ˣ) := + by simpa [quadraticNormFiberMulNormOne] using congrArg Subtype.val hparameter + exact mul_left_cancel hunit + exact pow_injOn_Iio_orderOf hn' hm' hpowers + calc + (quadraticNormFiberRotationCycle p t ht ht0 w s).card = + ((Finset.range (orderOf w)).image f).card := by rfl + _ = (Finset.range (orderOf w)).card := Finset.card_image_iff.mpr hinjective + _ = orderOf w := Finset.card_range _ + +theorem quadraticNormFiberRotationCycle_card_eq_rotationOrder + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + (quadraticNormFiberRotationCycle p t ht ht0 w s).card = rotationOrder t := by + rw [quadraticNormFiberRotationCycle_card p t ht ht0 w htrace hw s] + rw [← htrace, rotationOrder_quadraticNormOneTrace p w hw] + +end QuadraticNormFiber + +section RotationCycles + +variable {F : Type u} [Field F] + +/-- The canonical finite cycle cut out by one full matrix rotation period. -/ +noncomputable def normalizedRotationCycle (t : F) (x : NormalizedPoint F) : + Finset (NormalizedPoint F) := by + classical + exact (Finset.range (rotationOrder t)).image fun n => (normalizedRotate1^[n]) x + +/-- Every point of a nonzero split semisimple fiber has orbit-cycle cardinality equal to the +canonical matrix rotation order. -/ +theorem normalizedRotationCycle_card_split + (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) (htrace : splitTorusTrace w ≠ 0) + (x : ↑(normalizedFiber1 (splitTorusTrace w))) : + (normalizedRotationCycle (splitTorusTrace w) x).card = + rotationOrder (splitTorusTrace w) := by + let s := (splitFiberEquiv w hw htrace).symm x + have hx : splitFiberPoint w s = x := + congrArg Subtype.val ((splitFiberEquiv w hw htrace).apply_symm_apply x) + simpa [normalizedRotationCycle, splitRotationCycle, hx, + rotationOrder_splitTorusTrace w hw] using + splitRotationCycle_card w s hw + +end RotationCycles + +section QuadraticRotationCycles + +variable (p : ℕ) [Fact p.Prime] + +/-- Every point of a nonzero nonsplit semisimple fiber has orbit-cycle cardinality equal to the +canonical matrix rotation order. -/ +theorem normalizedRotationCycle_card_nonsplit + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (x : ↑(normalizedFiber1 t)) : + (normalizedRotationCycle t x).card = rotationOrder t := by + let s := (quadraticNormFiberEquiv p t ht ht0 w htrace hw).symm x + have hx : quadraticNormFiberPoint p t ht ht0 w s = x := + congrArg Subtype.val + ((quadraticNormFiberEquiv p t ht ht0 w htrace hw).apply_symm_apply x) + have horder : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_quadraticNormOneTrace p w hw] + have hcycle : normalizedRotationCycle t x = + quadraticNormFiberRotationCycle p t ht ht0 w s := by + classical + ext y + simp [normalizedRotationCycle, quadraticNormFiberRotationCycle, hx, horder] + rw [hcycle] + exact quadraticNormFiberRotationCycle_card_eq_rotationOrder + p t ht ht0 w htrace hw s + +end QuadraticRotationCycles + +section ClassifiedRotationCycles + +/-- Every point of a nonzero nonparabolic normalized fiber has rotation-cycle cardinality equal +to the canonical matrix rotation order. The split/nonsplit classification is consumed here to +obtain the explicit eigenvalue witness required by the two parametrization kernels. -/ +theorem normalizedRotationCycle_card_of_nonzero_nonparabolic + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (x : ↑(normalizedFiber1 t)) : + (normalizedRotationCycle t x).card = rotationOrder t := by + rcases exists_split_or_quadraticNormOneTrace p hpTwo t ht with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · let xw : ↑(normalizedFiber1 (splitTorusTrace w)) := + ⟨x.1, x.property.1, by simpa [htrace] using x.property.2⟩ + simpa [htrace, xw] using normalizedRotationCycle_card_split w hw + (by simpa [htrace] using ht0) xw + · exact normalizedRotationCycle_card_nonsplit p t ht ht0 w htrace hw x + +end ClassifiedRotationCycles + +section ParabolicRotationCycles + +/-- An even number of trace-`-2` rotations stays on the same parabolic line and translates its +parameter by a multiple of `-4i`. -/ +theorem iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo + {R : Type u} [CommRing R] (k : ℕ) (i t : R) : + (normalizedRotate1^[2 * k]) (parabolicLineAtNegTwo i t) = + parabolicLineAtNegTwo i (t - (k : R) * (4 * i)) := by + induction k with + | zero => simp + | succ k ih => + rw [show 2 * (k + 1) = 2 + 2 * k by omega, + Function.iterate_add_apply, ih] + change normalizedRotate1 + (normalizedRotate1 (parabolicLineAtNegTwo i (t - (k : R) * (4 * i)))) = _ + rw [normalizedRotate1_twice_parabolicLineAtNegTwo] + congr 1 + push_cast + ring + +/-- An odd number of trace-`-2` rotations lands on the opposite parabolic line. -/ +theorem iterate_two_mul_add_one_normalizedRotate1_parabolicLineAtNegTwo + {R : Type u} [CommRing R] (k : ℕ) (i t : R) : + (normalizedRotate1^[2 * k + 1]) (parabolicLineAtNegTwo i t) = + parabolicLineAtNegTwo (-i) (-(t - (k : R) * (4 * i)) + 2 * i) := by + rw [Function.iterate_succ_apply', + iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo, + normalizedRotate1_parabolicLineAtNegTwo] + +/-- Every point on either trace-`2` parabolic line has a full rotation cycle of cardinality +`p`, matching the separately computed unipotent matrix order. -/ +theorem normalizedRotationCycle_card_parabolicLineAtTwo + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (i t : ZMod p) (hi : i ^ 2 = -1) : + (normalizedRotationCycle (2 : ZMod p) (parabolicLineAtTwo i t)).card = + rotationOrder (2 : ZMod p) := by + classical + let f : ℕ → NormalizedPoint (ZMod p) := fun n => + (normalizedRotate1^[n]) (parabolicLineAtTwo i t) + have hi0 : i ≠ 0 := by + intro hzero + subst i + norm_num at hi + have htwo : (2 : ZMod p) ≠ 0 := by + intro hzero + have hdvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).mp hzero + have hpLe : p ≤ 2 := Nat.le_of_dvd (by norm_num) hdvd + exact hpTwo (Nat.le_antisymm hpLe (Fact.out : p.Prime).two_le) + have hstep : (2 : ZMod p) * i ≠ 0 := mul_ne_zero htwo hi0 + have hinjective : Set.InjOn f (Finset.range p) := by + intro n hn m hm hequal + have hn' : n < p := by simpa using hn + have hm' : m < p := by simpa using hm + change (normalizedRotate1^[n]) (parabolicLineAtTwo i t) = + (normalizedRotate1^[m]) (parabolicLineAtTwo i t) at hequal + rw [iterate_normalizedRotate1_parabolicLineAtTwo, + iterate_normalizedRotate1_parabolicLineAtTwo] at hequal + have hparameter := congrArg NormalizedPoint.u2 hequal + change t + (n : ZMod p) * (2 * i) = t + (m : ZMod p) * (2 * i) at hparameter + have hproducts : (n : ZMod p) * (2 * i) = (m : ZMod p) * (2 * i) := by + exact add_left_cancel hparameter + have hcasts : (n : ZMod p) = (m : ZMod p) := + mul_right_cancel₀ hstep hproducts + rw [ZMod.natCast_eq_natCast_iff'] at hcasts + simpa [Nat.mod_eq_of_lt hn', Nat.mod_eq_of_lt hm'] using hcasts + have horder : rotationOrder (2 : ZMod p) = p := rotationOrder_two p + have hcycle : normalizedRotationCycle (2 : ZMod p) (parabolicLineAtTwo i t) = + (Finset.range p).image f := by + ext y + simp [normalizedRotationCycle, f, horder] + calc + (normalizedRotationCycle (2 : ZMod p) (parabolicLineAtTwo i t)).card = + ((Finset.range p).image f).card := congrArg Finset.card hcycle + _ = (Finset.range p).card := Finset.card_image_iff.mpr hinjective + _ = p := Finset.card_range _ + _ = rotationOrder (2 : ZMod p) := horder.symm + +/-- Every point on either trace-`-2` parabolic line has a full cycle of cardinality `2p`, +matching the separately computed matrix order. -/ +theorem normalizedRotationCycle_card_parabolicLineAtNegTwo + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (i t : ZMod p) (hi : i ^ 2 = -1) : + (normalizedRotationCycle (-2 : ZMod p) (parabolicLineAtNegTwo i t)).card = + rotationOrder (-2 : ZMod p) := by + classical + let f : ℕ → NormalizedPoint (ZMod p) := fun n => + (normalizedRotate1^[n]) (parabolicLineAtNegTwo i t) + have hi0 : i ≠ 0 := by + intro hzero + subst i + norm_num at hi + have htwo : (2 : ZMod p) ≠ 0 := by + intro hzero + have hdvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).mp hzero + have hpLe : p ≤ 2 := Nat.le_of_dvd (by norm_num) hdvd + exact hpTwo (Nat.le_antisymm hpLe (Fact.out : p.Prime).two_le) + have hfour : (4 : ZMod p) ≠ 0 := by + rw [show (4 : ZMod p) = (2 : ZMod p) ^ 2 by norm_num] + exact pow_ne_zero 2 htwo + have hstep : (4 : ZMod p) * i ≠ 0 := mul_ne_zero hfour hi0 + have hdisjoint := parabolicLineAtNegTwo_disjoint i hstep + have hinjective : Set.InjOn f (Finset.range (2 * p)) := by + intro n hn m hm hequal + have hn' : n < 2 * p := by simpa using hn + have hm' : m < 2 * p := by simpa using hm + rcases n.even_or_odd' with ⟨k, rfl | rfl⟩ + · rcases m.even_or_odd' with ⟨l, rfl | rfl⟩ + · have hk : k < p := by omega + have hl : l < p := by omega + change (normalizedRotate1^[2 * k]) (parabolicLineAtNegTwo i t) = + (normalizedRotate1^[2 * l]) (parabolicLineAtNegTwo i t) at hequal + rw [iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo, + iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo] at hequal + have hparameter := congrArg NormalizedPoint.u2 hequal + change t - (k : ZMod p) * (4 * i) = + t - (l : ZMod p) * (4 * i) at hparameter + have hproducts : (k : ZMod p) * (4 * i) = (l : ZMod p) * (4 * i) := by + linear_combination -hparameter + have hcasts : (k : ZMod p) = (l : ZMod p) := + mul_right_cancel₀ hstep hproducts + rw [ZMod.natCast_eq_natCast_iff'] at hcasts + have hkl : k = l := by + simpa [Nat.mod_eq_of_lt hk, Nat.mod_eq_of_lt hl] using hcasts + omega + · change (normalizedRotate1^[2 * k]) (parabolicLineAtNegTwo i t) = + (normalizedRotate1^[2 * l + 1]) (parabolicLineAtNegTwo i t) at hequal + rw [iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo, + iterate_two_mul_add_one_normalizedRotate1_parabolicLineAtNegTwo] at hequal + exfalso + exact Set.disjoint_left.mp hdisjoint + ⟨_, rfl⟩ ⟨_, hequal.symm⟩ + · rcases m.even_or_odd' with ⟨l, rfl | rfl⟩ + · change (normalizedRotate1^[2 * k + 1]) (parabolicLineAtNegTwo i t) = + (normalizedRotate1^[2 * l]) (parabolicLineAtNegTwo i t) at hequal + rw [iterate_two_mul_add_one_normalizedRotate1_parabolicLineAtNegTwo, + iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo] at hequal + exfalso + exact Set.disjoint_left.mp hdisjoint + ⟨_, rfl⟩ ⟨_, hequal⟩ + · have hk : k < p := by omega + have hl : l < p := by omega + change (normalizedRotate1^[2 * k + 1]) (parabolicLineAtNegTwo i t) = + (normalizedRotate1^[2 * l + 1]) (parabolicLineAtNegTwo i t) at hequal + rw [iterate_two_mul_add_one_normalizedRotate1_parabolicLineAtNegTwo, + iterate_two_mul_add_one_normalizedRotate1_parabolicLineAtNegTwo] at hequal + have hparameter := congrArg NormalizedPoint.u2 hequal + change -(t - (k : ZMod p) * (4 * i)) + 2 * i = + -(t - (l : ZMod p) * (4 * i)) + 2 * i at hparameter + have hproducts : (k : ZMod p) * (4 * i) = (l : ZMod p) * (4 * i) := by + linear_combination hparameter + have hcasts : (k : ZMod p) = (l : ZMod p) := + mul_right_cancel₀ hstep hproducts + rw [ZMod.natCast_eq_natCast_iff'] at hcasts + have hkl : k = l := by + simpa [Nat.mod_eq_of_lt hk, Nat.mod_eq_of_lt hl] using hcasts + omega + have horder : rotationOrder (-2 : ZMod p) = 2 * p := rotationOrder_neg_two p hpTwo + have hcycle : normalizedRotationCycle (-2 : ZMod p) (parabolicLineAtNegTwo i t) = + (Finset.range (2 * p)).image f := by + ext y + simp [normalizedRotationCycle, f, horder] + calc + (normalizedRotationCycle (-2 : ZMod p) (parabolicLineAtNegTwo i t)).card = + ((Finset.range (2 * p)).image f).card := congrArg Finset.card hcycle + _ = (Finset.range (2 * p)).card := Finset.card_image_iff.mpr hinjective + _ = 2 * p := Finset.card_range _ + _ = rotationOrder (-2 : ZMod p) := horder.symm + +end ParabolicRotationCycles + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean new file mode 100644 index 0000000000..8e8ae693b5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean @@ -0,0 +1,379 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action + +/-! +# Even sign changes on the Markoff surface + +Changing the signs of exactly two coordinates preserves the Markoff equation. +The four transformations form a Klein four-group. Vieta involutions commute +with them, and coordinate transpositions permute them. Thus `Gamma` normalizes +the even-sign subgroup. +-/ + +namespace BGS.Markoff + +universe u + +/-- The four sign vectors with product one. -/ +inductive EvenSign + | id + | neg12 + | neg13 + | neg23 + deriving DecidableEq, Fintype, Repr + +namespace EvenSign + +def mul : EvenSign → EvenSign → EvenSign + | .id, s => s + | s, .id => s + | .neg12, .neg12 => .id + | .neg12, .neg13 => .neg23 + | .neg12, .neg23 => .neg13 + | .neg13, .neg12 => .neg23 + | .neg13, .neg13 => .id + | .neg13, .neg23 => .neg12 + | .neg23, .neg12 => .neg13 + | .neg23, .neg13 => .neg12 + | .neg23, .neg23 => .id + +instance : One EvenSign := ⟨.id⟩ +instance : Mul EvenSign := ⟨mul⟩ +instance : Inv EvenSign := ⟨fun s => s⟩ + +instance : CommGroup EvenSign where + mul_assoc := by decide + one_mul := by decide + mul_one := by decide + inv_mul_cancel := by decide + mul_comm := by decide + +@[simp] theorem one_eq_id : (1 : EvenSign) = .id := rfl +@[simp] theorem inv_eq_self (s : EvenSign) : s⁻¹ = s := rfl +@[simp] theorem card_eq_four : Fintype.card EvenSign = 4 := by decide + +end EvenSign + +/-- Apply an even sign vector to an affine point. -/ +def evenSignPoint {R : Type u} [CommRing R] : EvenSign → Point R → Point R + | .id, x => x + | .neg12, x => ⟨-x.x1, -x.x2, x.x3⟩ + | .neg13, x => ⟨-x.x1, x.x2, -x.x3⟩ + | .neg23, x => ⟨x.x1, -x.x2, -x.x3⟩ + +@[simp] +theorem evenSignPoint_id {R : Type u} [CommRing R] (x : Point R) : + evenSignPoint .id x = x := rfl + +@[simp] +theorem evenSignPoint_mul {R : Type u} [CommRing R] + (s t : EvenSign) (x : Point R) : + evenSignPoint (s * t) x = evenSignPoint s (evenSignPoint t x) := by + change evenSignPoint (EvenSign.mul s t) x = + evenSignPoint s (evenSignPoint t x) + cases s <;> cases t <;> ext <;> simp [evenSignPoint, EvenSign.mul] + +@[simp] +theorem markoffPolynomial_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + markoffPolynomial (evenSignPoint s x) = markoffPolynomial x := by + cases s <;> simp [evenSignPoint, markoffPolynomial] + +@[simp] +theorem isMarkoff_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + IsMarkoff (evenSignPoint s x) ↔ IsMarkoff x := by + simp only [IsMarkoff, markoffPolynomial_evenSignPoint] + +instance evenSignMulActionMarkoffSurface {R : Type u} [CommRing R] : + MulAction EvenSign (MarkoffSurface R) where + smul s x := ⟨evenSignPoint s x.1, (isMarkoff_evenSignPoint s x.1).2 x.2⟩ + one_smul x := Subtype.ext (evenSignPoint_id x.1) + mul_smul s t x := Subtype.ext (evenSignPoint_mul s t x.1) + +@[simp] +theorem evenSign_smul_surface_coe {R : Type u} [CommRing R] + (s : EvenSign) (x : MarkoffSurface R) : + ((s • x : MarkoffSurface R) : Point R) = evenSignPoint s x.1 := rfl + +@[simp] +theorem evenSign_smul_surfaceOrigin {R : Type u} [CommRing R] (s : EvenSign) : + s • surfaceOrigin R = surfaceOrigin R := by + cases s <;> apply Subtype.ext <;> ext <;> + simp [evenSignPoint, surfaceOrigin, origin] + +theorem evenSign_smul_ne_surfaceOrigin_iff {R : Type u} [CommRing R] + (s : EvenSign) (x : MarkoffSurface R) : + s • x ≠ surfaceOrigin R ↔ x ≠ surfaceOrigin R := by + constructor + · intro hs hx + exact hs (hx ▸ evenSign_smul_surfaceOrigin s) + · intro hx hs + apply hx + calc + x = s⁻¹ • (s • x) := (inv_smul_smul s x).symm + _ = s⁻¹ • surfaceOrigin R := congrArg (s⁻¹ • ·) hs + _ = surfaceOrigin R := evenSign_smul_surfaceOrigin s⁻¹ + +instance evenSignMulActionPuncturedMarkoffSurface {R : Type u} [CommRing R] : + MulAction EvenSign (PuncturedMarkoffSurface R) where + smul s x := ⟨s • x.1, (evenSign_smul_ne_surfaceOrigin_iff s x.1).2 x.2⟩ + one_smul x := Subtype.ext (one_smul EvenSign x.1) + mul_smul s t x := Subtype.ext (mul_smul s t x.1) + +@[simp] +theorem evenSign_smul_punctured_coe {R : Type u} [CommRing R] + (s : EvenSign) (x : PuncturedMarkoffSurface R) : + ((s • x : PuncturedMarkoffSurface R) : MarkoffSurface R) = s • x.1 := rfl + +def evenSignSurfacePermHom (R : Type u) [CommRing R] : + EvenSign →* Equiv.Perm (MarkoffSurface R) := + MulAction.toPermHom EvenSign (MarkoffSurface R) + +@[simp] +theorem evenSignSurfacePermHom_apply {R : Type u} [CommRing R] + (s : EvenSign) (x : MarkoffSurface R) : + evenSignSurfacePermHom R s x = s • x := rfl + +def evenSignSurfaceSubgroup (R : Type u) [CommRing R] : + Subgroup (Equiv.Perm (MarkoffSurface R)) := + (evenSignSurfacePermHom R).range + +@[simp] +theorem vieta1_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + vieta1 (evenSignPoint s x) = evenSignPoint s (vieta1 x) := by + cases s <;> ext <;> simp [vieta1, evenSignPoint] <;> ring + +@[simp] +theorem vieta2_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + vieta2 (evenSignPoint s x) = evenSignPoint s (vieta2 x) := by + cases s <;> ext <;> simp [vieta2, evenSignPoint] <;> ring + +@[simp] +theorem vieta3_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + vieta3 (evenSignPoint s x) = evenSignPoint s (vieta3 x) := by + cases s <;> ext <;> simp [vieta3, evenSignPoint] <;> ring + +def EvenSign.swap12 : EvenSign → EvenSign + | .id => .id + | .neg12 => .neg12 + | .neg13 => .neg23 + | .neg23 => .neg13 + +def EvenSign.swap23 : EvenSign → EvenSign + | .id => .id + | .neg12 => .neg13 + | .neg13 => .neg12 + | .neg23 => .neg23 + +@[simp] theorem EvenSign.swap12_swap12 (s : EvenSign) : + s.swap12.swap12 = s := by cases s <;> rfl + +@[simp] theorem EvenSign.swap23_swap23 (s : EvenSign) : + s.swap23.swap23 = s := by cases s <;> rfl + +@[simp] +theorem swap12_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + swap12 (evenSignPoint s x) = evenSignPoint s.swap12 (swap12 x) := by + cases s <;> rfl + +@[simp] +theorem swap23_evenSignPoint {R : Type u} [CommRing R] + (s : EvenSign) (x : Point R) : + swap23 (evenSignPoint s x) = evenSignPoint s.swap23 (swap23 x) := by + cases s <;> rfl + +private theorem perm_ext_of_point_coe_eq {R : Type u} [CommRing R] + {f g : Equiv.Perm (MarkoffSurface R)} + (h : ∀ x : MarkoffSurface R, ((f x : MarkoffSurface R) : Point R) = g x) : + f = g := by + apply Equiv.ext + intro x + apply Subtype.ext + exact h x + +theorem vieta1SurfacePerm_commute_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + vieta1SurfacePerm R * evenSignSurfacePermHom R s = + evenSignSurfacePermHom R s * vieta1SurfacePerm R := by + apply perm_ext_of_point_coe_eq + intro x + exact vieta1_evenSignPoint s x.1 + +theorem vieta2SurfacePerm_commute_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + vieta2SurfacePerm R * evenSignSurfacePermHom R s = + evenSignSurfacePermHom R s * vieta2SurfacePerm R := by + apply perm_ext_of_point_coe_eq + intro x + exact vieta2_evenSignPoint s x.1 + +theorem vieta3SurfacePerm_commute_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + vieta3SurfacePerm R * evenSignSurfacePermHom R s = + evenSignSurfacePermHom R s * vieta3SurfacePerm R := by + apply perm_ext_of_point_coe_eq + intro x + exact vieta3_evenSignPoint s x.1 + +theorem swap12SurfacePerm_mul_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + swap12SurfacePerm R * evenSignSurfacePermHom R s = + evenSignSurfacePermHom R s.swap12 * swap12SurfacePerm R := by + apply perm_ext_of_point_coe_eq + intro x + exact swap12_evenSignPoint s x.1 + +theorem swap23SurfacePerm_mul_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + swap23SurfacePerm R * evenSignSurfacePermHom R s = + evenSignSurfacePermHom R s.swap23 * swap23SurfacePerm R := by + apply perm_ext_of_point_coe_eq + intro x + exact swap23_evenSignPoint s x.1 + +private theorem vieta1SurfacePerm_conj_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + vieta1SurfacePerm R * evenSignSurfacePermHom R s * + (vieta1SurfacePerm R)⁻¹ = + evenSignSurfacePermHom R s := by + rw [vieta1SurfacePerm_commute_evenSign] + simp + +private theorem vieta2SurfacePerm_conj_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + vieta2SurfacePerm R * evenSignSurfacePermHom R s * + (vieta2SurfacePerm R)⁻¹ = + evenSignSurfacePermHom R s := by + rw [vieta2SurfacePerm_commute_evenSign] + simp + +private theorem vieta3SurfacePerm_conj_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + vieta3SurfacePerm R * evenSignSurfacePermHom R s * + (vieta3SurfacePerm R)⁻¹ = + evenSignSurfacePermHom R s := by + rw [vieta3SurfacePerm_commute_evenSign] + simp + +private theorem swap12SurfacePerm_conj_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + swap12SurfacePerm R * evenSignSurfacePermHom R s * + (swap12SurfacePerm R)⁻¹ = + evenSignSurfacePermHom R s.swap12 := by + rw [swap12SurfacePerm_mul_evenSign] + simp + +private theorem swap23SurfacePerm_conj_evenSign {R : Type u} [CommRing R] + (s : EvenSign) : + swap23SurfacePerm R * evenSignSurfacePermHom R s * + (swap23SurfacePerm R)⁻¹ = + evenSignSurfacePermHom R s.swap23 := by + rw [swap23SurfacePerm_mul_evenSign] + simp + +private theorem mem_evenSign_normalizer_of_conj + {R : Type u} [CommRing R] + (q : Equiv.Perm (MarkoffSurface R)) (f : EvenSign → EvenSign) + (hconj : ∀ s, q * evenSignSurfacePermHom R s * q⁻¹ = + evenSignSurfacePermHom R (f s)) + (hsurj : Function.Surjective f) : + q ∈ Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := by + rw [Subgroup.mem_set_normalizer_iff] + intro r + constructor + · rintro ⟨s, rfl⟩ + exact ⟨f s, (hconj s).symm⟩ + · rintro ⟨s, hs⟩ + obtain ⟨t, rfl⟩ := hsurj s + refine ⟨t, ?_⟩ + apply (MulAut.conj q).injective + rw [MulAut.conj_apply, MulAut.conj_apply, hconj] + exact hs + +private theorem vieta1SurfacePerm_normalizes_evenSign {R : Type u} [CommRing R] : + vieta1SurfacePerm R ∈ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := + mem_evenSign_normalizer_of_conj (vieta1SurfacePerm R) id + vieta1SurfacePerm_conj_evenSign Function.surjective_id + +private theorem vieta2SurfacePerm_normalizes_evenSign {R : Type u} [CommRing R] : + vieta2SurfacePerm R ∈ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := + mem_evenSign_normalizer_of_conj (vieta2SurfacePerm R) id + vieta2SurfacePerm_conj_evenSign Function.surjective_id + +private theorem vieta3SurfacePerm_normalizes_evenSign {R : Type u} [CommRing R] : + vieta3SurfacePerm R ∈ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := + mem_evenSign_normalizer_of_conj (vieta3SurfacePerm R) id + vieta3SurfacePerm_conj_evenSign Function.surjective_id + +private theorem swap12SurfacePerm_normalizes_evenSign {R : Type u} [CommRing R] : + swap12SurfacePerm R ∈ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := + mem_evenSign_normalizer_of_conj (swap12SurfacePerm R) EvenSign.swap12 + swap12SurfacePerm_conj_evenSign + (fun s => ⟨s.swap12, by simp⟩) + +private theorem swap23SurfacePerm_normalizes_evenSign {R : Type u} [CommRing R] : + swap23SurfacePerm R ∈ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := + mem_evenSign_normalizer_of_conj (swap23SurfacePerm R) EvenSign.swap23 + swap23SurfacePerm_conj_evenSign + (fun s => ⟨s.swap23, by simp⟩) + +/-- Every Markoff-group element normalizes the subgroup of even sign changes. -/ +theorem Gamma_le_evenSignSurfaceSubgroup_normalizer + (R : Type u) [CommRing R] : + Gamma R ≤ Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := by + change Subgroup.closure (gammaGenerators R) ≤ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) + rw [Subgroup.closure_le] + intro q hq + simp only [gammaGenerators, Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl | rfl | rfl | rfl + · exact vieta1SurfacePerm_normalizes_evenSign + · exact vieta2SurfacePerm_normalizes_evenSign + · exact vieta3SurfacePerm_normalizes_evenSign + · exact swap12SurfacePerm_normalizes_evenSign + · exact swap23SurfacePerm_normalizes_evenSign + +/-- An even sign change can be moved through an arbitrary Gamma word. -/ +theorem exists_evenSign_smul_Gamma_smul + {R : Type u} [CommRing R] (s : EvenSign) (g : Gamma R) : + ∃ t : EvenSign, ∀ x : PuncturedMarkoffSurface R, + s • (g • x) = g • (t • x) := by + have hnormal : + (g⁻¹ : Gamma R).1 ∈ + Subgroup.normalizer (evenSignSurfaceSubgroup R : Set _) := + Gamma_le_evenSignSurfaceSubgroup_normalizer R g⁻¹.2 + have hsign : + (g⁻¹ : Gamma R).1 * evenSignSurfacePermHom R s * g.1 ∈ + evenSignSurfaceSubgroup R := by + simpa using + (Subgroup.mem_set_normalizer_iff.mp hnormal + (evenSignSurfacePermHom R s)).1 ⟨s, rfl⟩ + obtain ⟨t, ht⟩ := hsign + refine ⟨t, fun x => ?_⟩ + apply Subtype.ext + have hperm : + evenSignSurfacePermHom R s * g.1 = + g.1 * evenSignSurfacePermHom R t := by + calc + evenSignSurfacePermHom R s * g.1 = + g.1 * ((g⁻¹ : Gamma R).1 * evenSignSurfacePermHom R s * g.1) := by + simp [mul_assoc] + _ = g.1 * evenSignSurfacePermHom R t := by rw [← ht] + exact Equiv.congr_fun hperm x.1 + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean new file mode 100644 index 0000000000..80ca95a026 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus + +/-! +# Finite-order Markoff rotations have torsion eigenvalues + +This file isolates the algebraic kernel used in the opening argument of +Bourgain--Gamburd--Sarnak. Over an algebraically closed field, a finite-order +normalized rotation has an eigenvalue of finite multiplicative order, and its +trace is the sum of that eigenvalue and its inverse. + +The passage from a finite orbit of a *point* to finite order of the rotation +matrix is deliberately not assumed here. It is a separate geometric step, +and is delicate at the parabolic traces `2` and `-2`. +-/ + +namespace BGS.Markoff + +open scoped Matrix +open Polynomial + +variable {K : Type*} [Field K] [IsAlgClosed K] + +/-- A finite-order normalized rotation has a torsion eigenvalue whose +eigenvalue trace is the rotation parameter. + +This includes the parabolic eigenvalues. In that case the eigenvalue squares +to one, so it is visibly torsion; away from that case the existing +diagonalization theorem transfers finite order from the rotation to the +eigenvalue. -/ +theorem finiteOrderRotation_has_torsion_eigenvalue (t : K) + (hfinite : IsOfFinOrder (rhoSL t)) : + ∃ w : Kˣ, IsOfFinOrder w ∧ t = splitTorusTrace w := by + let f : K[X] := X ^ 2 - C t * X + 1 + have hfdegree : f.degree ≠ 0 := by + have hfshape : IsMonicOfDegree f 2 := by + simpa [f] using isMonicOfDegree_sub_add_two t (1 : K) + rw [degree_eq_natDegree hfshape.monic.ne_zero, hfshape.natDegree_eq] + norm_num + obtain ⟨r, hr⟩ := IsAlgClosed.exists_root f hfdegree + have hreigen : r ^ 2 - t * r + 1 = 0 := by + simpa [f] using hr + have hrne : r ≠ 0 := by + intro hrzero + simp [hrzero] at hreigen + let w : Kˣ := Units.mk0 r hrne + have htrace : t = splitTorusTrace w := by + have hmul : t * r = r ^ 2 + 1 := by + linear_combination -hreigen + change t = r + r⁻¹ + apply (mul_right_cancel₀ hrne) + rw [hmul] + field_simp + refine ⟨w, ?_, htrace⟩ + by_cases hparabolic : (w : K) ^ 2 = 1 + · rw [isOfFinOrder_iff_pow_eq_one] + refine ⟨2, by omega, ?_⟩ + apply Units.ext + exact hparabolic + · rw [← orderOf_pos_iff] + have hrotation : 0 < rotationOrder t := by + simpa [rotationOrder] using hfinite.orderOf_pos + rw [htrace, rotationOrder_splitTorusTrace w hparabolic] at hrotation + exact hrotation + +section ParabolicObstruction + +variable {R : Type*} [CommRing R] [CharZero R] + +/-- The trace-`2` unipotent rotation has infinite order in characteristic +zero. -/ +theorem rhoSL_two_not_finiteOrder : ¬ IsOfFinOrder (rhoSL (2 : R)) := by + intro hfinite + obtain ⟨n, hnpos, hpower⟩ := hfinite.exists_pow_eq_one + have hmatrix := congrArg + (fun g : Matrix.SpecialLinearGroup (Fin 2) R ↦ + (g : Matrix (Fin 2) (Fin 2) R)) hpower + have hoffDiagonal := congrArg + (fun m : Matrix (Fin 2) (Fin 2) R ↦ m 0 1) hmatrix + have hnzero : (n : R) = 0 := by + simpa [rhoSL, rho_two_pow] using hoffDiagonal + have : n = 0 := by exact_mod_cast hnzero + exact hnpos.ne' this + +/-- Periodicity of one vector under a coordinate rotation does not by itself +imply finite order of the rotation matrix. The nonzero vector `(1,1)` is +fixed by the trace-`2` rotation, while that matrix has infinite order in +characteristic zero. + +This is the parabolic obstruction that must be handled before the paper's +finite-orbit discussion can invoke `finiteOrderRotation_has_torsion_eigenvalue`. +-/ +theorem exists_nonzero_fixedVector_with_infiniteOrder_rotation : + ∃ v : Fin 2 → R, + v ≠ 0 ∧ rho (2 : R) *ᵥ v = v ∧ ¬ IsOfFinOrder (rhoSL (2 : R)) := by + refine ⟨![1, 1], ?_, ?_, ?_⟩ + · intro hzero + have hentry := congrFun hzero 0 + norm_num at hentry + · rw [rho_mulVec] + ext i + fin_cases i + · simp + · simp + ring + · exact rhoSL_two_not_finiteOrder + +end ParabolicObstruction + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean new file mode 100644 index 0000000000..b8e599519c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean @@ -0,0 +1,516 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor + +/-! +# Connectivity of natural-number Markoff solutions + +Every nonzero solution in natural numbers of + +`x₁² + x₂² + x₃² = 3 * x₁ * x₂ * x₃` + +is connected to `(1, 1, 1)` by coordinate transpositions and the natural-number Vieta moves. +The proof is the classical descent: after ordering the coordinates `a ≤ b ≤ c`, replace `c` by +`3ab - c`. Away from `(1, 1, 1)`, this is positive and strictly smaller than `c`. + +Natural subtraction is used only after proving the needed lower bound, so reduction to a ring +recovers the usual Vieta involution. +-/ + +namespace BGS.Markoff + +/-- The first Vieta replacement on points with natural-number coordinates. -/ +def natVieta1 (x : Point ℕ) : Point ℕ := + ⟨3 * x.x2 * x.x3 - x.x1, x.x2, x.x3⟩ + +/-- The second Vieta replacement on points with natural-number coordinates. -/ +def natVieta2 (x : Point ℕ) : Point ℕ := + ⟨x.x1, 3 * x.x1 * x.x3 - x.x2, x.x3⟩ + +/-- The third Vieta replacement on points with natural-number coordinates. -/ +def natVieta3 (x : Point ℕ) : Point ℕ := + ⟨x.x1, x.x2, 3 * x.x1 * x.x2 - x.x3⟩ + +private theorem coordinate_le_vietaProduct {a b c : ℕ} + (h : a ^ 2 + b ^ 2 + c ^ 2 = 3 * a * b * c) : + a ≤ 3 * b * c := by + by_cases ha : a = 0 + · simp [ha] + have haPos : 0 < a := Nat.pos_of_ne_zero ha + apply Nat.le_of_mul_le_mul_left _ haPos + calc + a * a ≤ a ^ 2 + b ^ 2 + c ^ 2 := by nlinarith + _ = 3 * a * b * c := h + _ = a * (3 * b * c) := by ring + +private theorem vietaReplacement_preserves {a b c : ℕ} + (h : a ^ 2 + b ^ 2 + c ^ 2 = 3 * a * b * c) : + (3 * b * c - a) ^ 2 + b ^ 2 + c ^ 2 = + 3 * (3 * b * c - a) * b * c := by + have hle : a ≤ 3 * b * c := coordinate_le_vietaProduct h + have hcast : ((3 * b * c - a : ℕ) : ℤ) = 3 * b * c - a := by + rw [Nat.cast_sub hle] + norm_num + have hz : (a : ℤ) ^ 2 + (b : ℤ) ^ 2 + (c : ℤ) ^ 2 = + 3 * a * b * c := by + exact_mod_cast h + apply_mod_cast (show ((3 * b * c - a : ℕ) : ℤ) ^ 2 + (b : ℤ) ^ 2 + + (c : ℤ) ^ 2 = 3 * ((3 * b * c - a : ℕ) : ℤ) * b * c by + rw [hcast] + nlinarith) + +theorem isSemiringMarkoff_natVieta1 (x : Point ℕ) (hx : IsSemiringMarkoff x) : + IsSemiringMarkoff (natVieta1 x) := by + exact vietaReplacement_preserves (by simpa [IsSemiringMarkoff] using hx) + +theorem isSemiringMarkoff_natVieta2 (x : Point ℕ) (hx : IsSemiringMarkoff x) : + IsSemiringMarkoff (natVieta2 x) := by + have hreorder : IsSemiringMarkoff x ↔ + x.x2 ^ 2 + x.x1 ^ 2 + x.x3 ^ 2 = 3 * x.x2 * x.x1 * x.x3 := by + simp only [IsSemiringMarkoff] + ring_nf + have hp := vietaReplacement_preserves (a := x.x2) (b := x.x1) (c := x.x3) + (hreorder.mp hx) + simpa [IsSemiringMarkoff, natVieta2, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using hp + +theorem isSemiringMarkoff_natVieta3 (x : Point ℕ) (hx : IsSemiringMarkoff x) : + IsSemiringMarkoff (natVieta3 x) := by + have hreorder : IsSemiringMarkoff x ↔ + x.x3 ^ 2 + x.x1 ^ 2 + x.x2 ^ 2 = 3 * x.x3 * x.x1 * x.x2 := by + simp only [IsSemiringMarkoff] + ring_nf + have hp := vietaReplacement_preserves (a := x.x3) (b := x.x1) (c := x.x2) + (hreorder.mp hx) + simpa [IsSemiringMarkoff, natVieta3, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using hp + +/-- The first natural-number Vieta move restricted to the Markoff surface. -/ +def natVieta1Surface (x : SemiringMarkoffSurface ℕ) : SemiringMarkoffSurface ℕ := + ⟨natVieta1 x.1, isSemiringMarkoff_natVieta1 x.1 x.2⟩ + +/-- The second natural-number Vieta move restricted to the Markoff surface. -/ +def natVieta2Surface (x : SemiringMarkoffSurface ℕ) : SemiringMarkoffSurface ℕ := + ⟨natVieta2 x.1, isSemiringMarkoff_natVieta2 x.1 x.2⟩ + +/-- The third natural-number Vieta move restricted to the Markoff surface. -/ +def natVieta3Surface (x : SemiringMarkoffSurface ℕ) : SemiringMarkoffSurface ℕ := + ⟨natVieta3 x.1, isSemiringMarkoff_natVieta3 x.1 x.2⟩ + +/-- Exchange the first two coordinates of a natural-number Markoff solution. -/ +def natSwap12Surface (x : SemiringMarkoffSurface ℕ) : SemiringMarkoffSurface ℕ := + ⟨swap12 x.1, by + simpa [IsSemiringMarkoff, swap12, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using x.2⟩ + +/-- Exchange the last two coordinates of a natural-number Markoff solution. -/ +def natSwap23Surface (x : SemiringMarkoffSurface ℕ) : SemiringMarkoffSurface ℕ := + ⟨swap23 x.1, by + simpa [IsSemiringMarkoff, swap23, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using x.2⟩ + +@[simp] theorem natVieta1Surface_coe (x : SemiringMarkoffSurface ℕ) : + (natVieta1Surface x).1 = natVieta1 x.1 := rfl + +@[simp] theorem natVieta2Surface_coe (x : SemiringMarkoffSurface ℕ) : + (natVieta2Surface x).1 = natVieta2 x.1 := rfl + +@[simp] theorem natVieta3Surface_coe (x : SemiringMarkoffSurface ℕ) : + (natVieta3Surface x).1 = natVieta3 x.1 := rfl + +@[simp] theorem natSwap12Surface_coe (x : SemiringMarkoffSurface ℕ) : + (natSwap12Surface x).1 = swap12 x.1 := rfl + +@[simp] theorem natSwap23Surface_coe (x : SemiringMarkoffSurface ℕ) : + (natSwap23Surface x).1 = swap23 x.1 := rfl + +@[simp] +theorem natVieta1Surface_involutive (x : SemiringMarkoffSurface ℕ) : + natVieta1Surface (natVieta1Surface x) = x := by + have hle : x.1.x1 ≤ 3 * x.1.x2 * x.1.x3 := + coordinate_le_vietaProduct x.2 + apply Subtype.ext + ext <;> simp [natVieta1Surface, natVieta1, Nat.sub_sub_self hle] + +@[simp] +theorem natVieta2Surface_involutive (x : SemiringMarkoffSurface ℕ) : + natVieta2Surface (natVieta2Surface x) = x := by + have hreorder : x.1.x2 ^ 2 + x.1.x1 ^ 2 + x.1.x3 ^ 2 = + 3 * x.1.x2 * x.1.x1 * x.1.x3 := by + simpa [IsSemiringMarkoff, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using x.2 + have hle : x.1.x2 ≤ 3 * x.1.x1 * x.1.x3 := + coordinate_le_vietaProduct hreorder + apply Subtype.ext + ext <;> simp [natVieta2Surface, natVieta2, Nat.sub_sub_self hle] + +@[simp] +theorem natVieta3Surface_involutive (x : SemiringMarkoffSurface ℕ) : + natVieta3Surface (natVieta3Surface x) = x := by + have hreorder : x.1.x3 ^ 2 + x.1.x1 ^ 2 + x.1.x2 ^ 2 = + 3 * x.1.x3 * x.1.x1 * x.1.x2 := by + simpa [IsSemiringMarkoff, add_comm, add_left_comm, add_assoc, + mul_comm, mul_left_comm, mul_assoc] using x.2 + have hle : x.1.x3 ≤ 3 * x.1.x1 * x.1.x2 := + coordinate_le_vietaProduct hreorder + apply Subtype.ext + ext <;> simp [natVieta3Surface, natVieta3, Nat.sub_sub_self hle] + +@[simp] +theorem natSwap12Surface_involutive (x : SemiringMarkoffSurface ℕ) : + natSwap12Surface (natSwap12Surface x) = x := by + apply Subtype.ext + rfl + +@[simp] +theorem natSwap23Surface_involutive (x : SemiringMarkoffSurface ℕ) : + natSwap23Surface (natSwap23Surface x) = x := by + apply Subtype.ext + rfl + +/-- The first natural Vieta move as a permutation of the natural Markoff surface. -/ +def natVieta1SurfaceEquiv : Equiv.Perm (SemiringMarkoffSurface ℕ) where + toFun := natVieta1Surface + invFun := natVieta1Surface + left_inv := natVieta1Surface_involutive + right_inv := natVieta1Surface_involutive + +/-- The second natural Vieta move as a permutation of the natural Markoff surface. -/ +def natVieta2SurfaceEquiv : Equiv.Perm (SemiringMarkoffSurface ℕ) where + toFun := natVieta2Surface + invFun := natVieta2Surface + left_inv := natVieta2Surface_involutive + right_inv := natVieta2Surface_involutive + +/-- The third natural Vieta move as a permutation of the natural Markoff surface. -/ +def natVieta3SurfaceEquiv : Equiv.Perm (SemiringMarkoffSurface ℕ) where + toFun := natVieta3Surface + invFun := natVieta3Surface + left_inv := natVieta3Surface_involutive + right_inv := natVieta3Surface_involutive + +/-- The first coordinate transposition as a permutation of the natural Markoff surface. -/ +def natSwap12SurfaceEquiv : Equiv.Perm (SemiringMarkoffSurface ℕ) where + toFun := natSwap12Surface + invFun := natSwap12Surface + left_inv := natSwap12Surface_involutive + right_inv := natSwap12Surface_involutive + +/-- The second coordinate transposition as a permutation of the natural Markoff surface. -/ +def natSwap23SurfaceEquiv : Equiv.Perm (SemiringMarkoffSurface ℕ) where + toFun := natSwap23Surface + invFun := natSwap23Surface + left_inv := natSwap23Surface_involutive + right_inv := natSwap23Surface_involutive + +/-- The five standard generators acting on natural-number Markoff solutions. -/ +def naturalGammaGenerators : Set (Equiv.Perm (SemiringMarkoffSurface ℕ)) := + {natVieta1SurfaceEquiv, natVieta2SurfaceEquiv, natVieta3SurfaceEquiv, + natSwap12SurfaceEquiv, natSwap23SurfaceEquiv} + +/-- The group generated by natural Vieta moves and coordinate transpositions. -/ +def NaturalGamma : Subgroup (Equiv.Perm (SemiringMarkoffSurface ℕ)) := + Subgroup.closure naturalGammaGenerators + +theorem natVieta1SurfaceEquiv_mem_NaturalGamma : natVieta1SurfaceEquiv ∈ NaturalGamma := + Subgroup.subset_closure (by simp [naturalGammaGenerators]) + +theorem natVieta2SurfaceEquiv_mem_NaturalGamma : natVieta2SurfaceEquiv ∈ NaturalGamma := + Subgroup.subset_closure (by simp [naturalGammaGenerators]) + +theorem natVieta3SurfaceEquiv_mem_NaturalGamma : natVieta3SurfaceEquiv ∈ NaturalGamma := + Subgroup.subset_closure (by simp [naturalGammaGenerators]) + +theorem natSwap12SurfaceEquiv_mem_NaturalGamma : natSwap12SurfaceEquiv ∈ NaturalGamma := + Subgroup.subset_closure (by simp [naturalGammaGenerators]) + +theorem natSwap23SurfaceEquiv_mem_NaturalGamma : natSwap23SurfaceEquiv ∈ NaturalGamma := + Subgroup.subset_closure (by simp [naturalGammaGenerators]) + +/-- The orbit relation for the natural Markoff group. -/ +def SameNatMarkoffComponent (x y : SemiringMarkoffSurface ℕ) : Prop := + y ∈ MulAction.orbit NaturalGamma x + +theorem sameNatMarkoffComponent_iff_exists (x y : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x y ↔ ∃ g : NaturalGamma, g • x = y := + Iff.rfl + +/-- A single standard move between natural-number Markoff solutions. -/ +inductive NatMarkoffStep : SemiringMarkoffSurface ℕ → SemiringMarkoffSurface ℕ → Prop + | vieta1 (x) : NatMarkoffStep x (natVieta1Surface x) + | vieta2 (x) : NatMarkoffStep x (natVieta2Surface x) + | vieta3 (x) : NatMarkoffStep x (natVieta3Surface x) + | swap12 (x) : NatMarkoffStep x (natSwap12Surface x) + | swap23 (x) : NatMarkoffStep x (natSwap23Surface x) + +@[refl] theorem sameNatMarkoffComponent_refl (x : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x x := + MulAction.mem_orbit_self x + +@[symm] theorem sameNatMarkoffComponent_symm {x y : SemiringMarkoffSurface ℕ} + (h : SameNatMarkoffComponent x y) : SameNatMarkoffComponent y x := + MulAction.mem_orbit_symm.mp h + +@[trans] theorem sameNatMarkoffComponent_trans {x y z : SemiringMarkoffSurface ℕ} + (hxy : SameNatMarkoffComponent x y) (hyz : SameNatMarkoffComponent y z) : + SameNatMarkoffComponent x z := by + unfold SameNatMarkoffComponent at * + rwa [(MulAction.orbit_eq_iff).2 hxy] at hyz + +theorem sameNatMarkoffComponent_vieta1 (x : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x (natVieta1Surface x) := by + exact ⟨⟨natVieta1SurfaceEquiv, natVieta1SurfaceEquiv_mem_NaturalGamma⟩, rfl⟩ + +theorem sameNatMarkoffComponent_vieta2 (x : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x (natVieta2Surface x) := by + exact ⟨⟨natVieta2SurfaceEquiv, natVieta2SurfaceEquiv_mem_NaturalGamma⟩, rfl⟩ + +theorem sameNatMarkoffComponent_vieta3 (x : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x (natVieta3Surface x) := by + exact ⟨⟨natVieta3SurfaceEquiv, natVieta3SurfaceEquiv_mem_NaturalGamma⟩, rfl⟩ + +theorem sameNatMarkoffComponent_swap12 (x : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x (natSwap12Surface x) := by + exact ⟨⟨natSwap12SurfaceEquiv, natSwap12SurfaceEquiv_mem_NaturalGamma⟩, rfl⟩ + +theorem sameNatMarkoffComponent_swap23 (x : SemiringMarkoffSurface ℕ) : + SameNatMarkoffComponent x (natSwap23Surface x) := by + exact ⟨⟨natSwap23SurfaceEquiv, natSwap23SurfaceEquiv_mem_NaturalGamma⟩, rfl⟩ + +/-- A generated sequence of standard natural moves lies in a single `NaturalGamma` orbit. -/ +theorem eqvGen_natMarkoffStep_sameComponent {x y : SemiringMarkoffSurface ℕ} + (h : Relation.EqvGen NatMarkoffStep x y) : SameNatMarkoffComponent x y := by + induction h with + | rel x y hxy => + cases hxy with + | vieta1 => exact sameNatMarkoffComponent_vieta1 x + | vieta2 => exact sameNatMarkoffComponent_vieta2 x + | vieta3 => exact sameNatMarkoffComponent_vieta3 x + | swap12 => exact sameNatMarkoffComponent_swap12 x + | swap23 => exact sameNatMarkoffComponent_swap23 x + | refl x => exact sameNatMarkoffComponent_refl x + | symm x y _ ih => exact sameNatMarkoffComponent_symm ih + | trans x y z _ _ ihxy ihyz => exact sameNatMarkoffComponent_trans ihxy ihyz + +/-- Sum of the coordinates, used as the well-founded descent measure. -/ +def natMarkoffHeight (x : SemiringMarkoffSurface ℕ) : ℕ := + x.1.x1 + x.1.x2 + x.1.x3 + +private theorem ordered_descending_vieta {a b c : ℕ} + (ha : 0 < a) (hab : a ≤ b) (hbc : b ≤ c) + (h : a ^ 2 + b ^ 2 + c ^ 2 = 3 * a * b * c) + (hnotRoot : ¬(a = 1 ∧ b = 1 ∧ c = 1)) : + 0 < 3 * a * b - c ∧ 3 * a * b - c < c := by + have hc_le : c ≤ 3 * a * b := by + have hcPos : 0 < c := lt_of_lt_of_le ha (hab.trans hbc) + apply Nat.le_of_mul_le_mul_left _ hcPos + calc + c * c ≤ a ^ 2 + b ^ 2 + c ^ 2 := by nlinarith + _ = 3 * a * b * c := h + _ = c * (3 * a * b) := by ring + have hc_lt : c < 3 * a * b := by + have hcPos : 0 < c := lt_of_lt_of_le ha (hab.trans hbc) + apply Nat.lt_of_mul_lt_mul_left + calc + c * c < a ^ 2 + b ^ 2 + c ^ 2 := by nlinarith [sq_pos_of_pos ha] + _ = 3 * a * b * c := h + _ = c * (3 * a * b) := by ring + have hb_lt : b < c := by + apply lt_of_le_of_ne hbc + intro hne + subst c + have haSqLe : a ^ 2 ≤ b ^ 2 := Nat.pow_le_pow_left hab 2 + have haOne : a = 1 := by + by_contra haNe + have haTwo : 2 ≤ a := by omega + have hmul : 2 * b ^ 2 ≤ a * b ^ 2 := + Nat.mul_le_mul_right (b ^ 2) haTwo + have hbPos : 0 < b := lt_of_lt_of_le ha hab + nlinarith [sq_pos_of_pos hbPos] + have hbOne : b = 1 := by + subst a + nlinarith + exact hnotRoot ⟨haOne, hbOne, hbOne⟩ + have haSqLe : a ^ 2 ≤ b ^ 2 := Nat.pow_le_pow_left hab 2 + have hbSqLe : b ^ 2 ≤ a * b ^ 2 := by + calc + b ^ 2 = 1 * b ^ 2 := by simp + _ ≤ a * b ^ 2 := Nat.mul_le_mul_right (b ^ 2) ha + have hf : a ^ 2 + 2 * b ^ 2 ≤ 3 * a * b ^ 2 := by + nlinarith + have hsum : 3 * a * b ≤ b + c := by + by_contra hnot + have hstrict : b + c < 3 * a * b := Nat.lt_of_not_ge hnot + have hEqZ : (a : ℤ) ^ 2 + (b : ℤ) ^ 2 + (c : ℤ) ^ 2 = + 3 * a * b * c := by + exact_mod_cast h + have hfZ : (a : ℤ) ^ 2 + 2 * (b : ℤ) ^ 2 ≤ 3 * a * b ^ 2 := by + exact_mod_cast hf + have hbLtZ : (b : ℤ) < c := by exact_mod_cast hb_lt + have hstrictZ : (b : ℤ) + c < 3 * a * b := by exact_mod_cast hstrict + have hprod : 0 < ((c : ℤ) - b) * (3 * a * b - b - c) := + mul_pos (sub_pos.mpr hbLtZ) (by omega) + nlinarith + exact ⟨Nat.sub_pos_of_lt hc_lt, by omega⟩ + +theorem natMarkoff_eq_origin_of_x1_eq_zero (x : SemiringMarkoffSurface ℕ) + (hx1 : x.1.x1 = 0) : x = semiringSurfaceOrigin ℕ := by + have heq := x.2 + change x.1.x1 ^ 2 + x.1.x2 ^ 2 + x.1.x3 ^ 2 = + 3 * x.1.x1 * x.1.x2 * x.1.x3 at heq + have hsum : x.1.x2 ^ 2 + x.1.x3 ^ 2 = 0 := by simpa [hx1] using heq + have hx2 : x.1.x2 = 0 := by nlinarith [hsum] + have hx3 : x.1.x3 = 0 := by nlinarith [hsum] + apply Subtype.ext + ext <;> simp [semiringSurfaceOrigin, origin, hx1, hx2, hx3] + +theorem natMarkoff_eq_origin_of_x2_eq_zero (x : SemiringMarkoffSurface ℕ) + (hx2 : x.1.x2 = 0) : x = semiringSurfaceOrigin ℕ := by + have heq := x.2 + change x.1.x1 ^ 2 + x.1.x2 ^ 2 + x.1.x3 ^ 2 = + 3 * x.1.x1 * x.1.x2 * x.1.x3 at heq + have hsum : x.1.x1 ^ 2 + x.1.x3 ^ 2 = 0 := by simpa [hx2] using heq + have hx1 : x.1.x1 = 0 := by nlinarith [hsum] + exact natMarkoff_eq_origin_of_x1_eq_zero x hx1 + +theorem natMarkoff_eq_origin_of_x3_eq_zero (x : SemiringMarkoffSurface ℕ) + (hx3 : x.1.x3 = 0) : x = semiringSurfaceOrigin ℕ := by + have heq := x.2 + change x.1.x1 ^ 2 + x.1.x2 ^ 2 + x.1.x3 ^ 2 = + 3 * x.1.x1 * x.1.x2 * x.1.x3 at heq + have hsum : x.1.x1 ^ 2 + x.1.x2 ^ 2 = 0 := by simpa [hx3] using heq + have hx1 : x.1.x1 = 0 := by nlinarith [hsum] + exact natMarkoff_eq_origin_of_x1_eq_zero x hx1 + +/-- Every coordinate of a nonzero natural Markoff solution is positive. -/ +theorem natMarkoff_coordinates_pos_of_ne_origin (x : SemiringMarkoffSurface ℕ) + (hx : x ≠ semiringSurfaceOrigin ℕ) : + 0 < x.1.x1 ∧ 0 < x.1.x2 ∧ 0 < x.1.x3 := by + refine ⟨Nat.pos_of_ne_zero fun h => hx (natMarkoff_eq_origin_of_x1_eq_zero x h), + Nat.pos_of_ne_zero fun h => hx (natMarkoff_eq_origin_of_x2_eq_zero x h), + Nat.pos_of_ne_zero fun h => hx (natMarkoff_eq_origin_of_x3_eq_zero x h)⟩ + +private theorem natMarkoff_eq_root_of_coordinates_eq_one + (x : SemiringMarkoffSurface ℕ) (hx1 : x.1.x1 = 1) + (hx2 : x.1.x2 = 1) (hx3 : x.1.x3 = 1) : + x = semiringSurfaceRoot ℕ := by + apply Subtype.ext + ext <;> simp [semiringSurfaceRoot, hx1, hx2, hx3] + +private theorem exists_ordered_sameNatMarkoffComponent (x : SemiringMarkoffSurface ℕ) : + ∃ y : SemiringMarkoffSurface ℕ, + SameNatMarkoffComponent x y ∧ + y.1.x1 ≤ y.1.x2 ∧ y.1.x2 ≤ y.1.x3 ∧ + natMarkoffHeight y = natMarkoffHeight x := by + by_cases h12 : x.1.x1 ≤ x.1.x2 + · by_cases h23 : x.1.x2 ≤ x.1.x3 + · exact ⟨x, sameNatMarkoffComponent_refl x, h12, h23, rfl⟩ + · have h32 : x.1.x3 < x.1.x2 := Nat.lt_of_not_ge h23 + by_cases h13 : x.1.x1 ≤ x.1.x3 + · refine ⟨natSwap23Surface x, sameNatMarkoffComponent_swap23 x, ?_, ?_, ?_⟩ + · exact h13 + · exact h32.le + · simp [natMarkoffHeight, natSwap23Surface, swap23] + omega + · have h31 : x.1.x3 < x.1.x1 := Nat.lt_of_not_ge h13 + let y := natSwap12Surface (natSwap23Surface x) + have hxy : SameNatMarkoffComponent x y := + sameNatMarkoffComponent_trans (sameNatMarkoffComponent_swap23 x) + (sameNatMarkoffComponent_swap12 (natSwap23Surface x)) + refine ⟨y, hxy, ?_, ?_, ?_⟩ + · exact h31.le + · exact h12 + · simp [y, natMarkoffHeight, natSwap12Surface, natSwap23Surface, swap12, swap23] + omega + · have h21 : x.1.x2 < x.1.x1 := Nat.lt_of_not_ge h12 + by_cases h13 : x.1.x1 ≤ x.1.x3 + · refine ⟨natSwap12Surface x, sameNatMarkoffComponent_swap12 x, ?_, ?_, ?_⟩ + · exact h21.le + · exact h13 + · simp [natMarkoffHeight, natSwap12Surface, swap12] + omega + · have h31 : x.1.x3 < x.1.x1 := Nat.lt_of_not_ge h13 + by_cases h23 : x.1.x2 ≤ x.1.x3 + · let y := natSwap23Surface (natSwap12Surface x) + have hxy : SameNatMarkoffComponent x y := + sameNatMarkoffComponent_trans (sameNatMarkoffComponent_swap12 x) + (sameNatMarkoffComponent_swap23 (natSwap12Surface x)) + refine ⟨y, hxy, ?_, ?_, ?_⟩ + · exact h23 + · exact h31.le + · simp [y, natMarkoffHeight, natSwap12Surface, natSwap23Surface, swap12, swap23] + omega + · have h32 : x.1.x3 < x.1.x2 := Nat.lt_of_not_ge h23 + let y := natSwap12Surface (natSwap23Surface (natSwap12Surface x)) + have hxy : SameNatMarkoffComponent x y := + sameNatMarkoffComponent_trans (sameNatMarkoffComponent_swap12 x) <| + sameNatMarkoffComponent_trans + (sameNatMarkoffComponent_swap23 (natSwap12Surface x)) + (sameNatMarkoffComponent_swap12 (natSwap23Surface (natSwap12Surface x))) + refine ⟨y, hxy, ?_, ?_, ?_⟩ + · exact h32.le + · exact h21.le + · simp [y, natMarkoffHeight, natSwap12Surface, natSwap23Surface, swap12, swap23] + omega + +/-- Every nonzero natural-number Markoff solution is in the `NaturalGamma` orbit of `(1,1,1)`. -/ +theorem natMarkoff_ne_origin_sameComponent_root : + ∀ x : SemiringMarkoffSurface ℕ, + x ≠ semiringSurfaceOrigin ℕ → + SameNatMarkoffComponent (semiringSurfaceRoot ℕ) x := by + intro x + induction x using (measure natMarkoffHeight).wf.induction with + | h x ih => + intro hx + obtain ⟨y, hxy, hy12, hy23, hyHeight⟩ := + exists_ordered_sameNatMarkoffComponent x + have hxPos := natMarkoff_coordinates_pos_of_ne_origin x hx + have hxHeightPos : 0 < natMarkoffHeight x := by + simp only [natMarkoffHeight] + omega + have hyHeightPos : 0 < natMarkoffHeight y := by omega + have hy : y ≠ semiringSurfaceOrigin ℕ := by + intro hyOrigin + subst y + simp [natMarkoffHeight, semiringSurfaceOrigin, origin] at hyHeightPos + have hyPos := natMarkoff_coordinates_pos_of_ne_origin y hy + by_cases hyRoot : y = semiringSurfaceRoot ℕ + · exact sameNatMarkoffComponent_symm (hyRoot ▸ hxy) + · have hnotRootCoords : + ¬(y.1.x1 = 1 ∧ y.1.x2 = 1 ∧ y.1.x3 = 1) := by + rintro ⟨hy1, hy2, hy3⟩ + exact hyRoot (natMarkoff_eq_root_of_coordinates_eq_one y hy1 hy2 hy3) + have hdesc := ordered_descending_vieta hyPos.1 hy12 hy23 y.2 hnotRootCoords + let z := natVieta3Surface y + have hzHeight : natMarkoffHeight z < natMarkoffHeight x := by + rw [← hyHeight] + simp only [z, natMarkoffHeight, natVieta3Surface, natVieta3] + omega + have hz : z ≠ semiringSurfaceOrigin ℕ := by + intro hzOrigin + have hz1 : z.1.x1 = 0 := by + rw [hzOrigin] + rfl + change y.1.x1 = 0 at hz1 + omega + have hRootZ : SameNatMarkoffComponent (semiringSurfaceRoot ℕ) z := + ih z hzHeight hz + have hzy : SameNatMarkoffComponent z y := + sameNatMarkoffComponent_symm (sameNatMarkoffComponent_vieta3 y) + exact sameNatMarkoffComponent_trans + (sameNatMarkoffComponent_trans hRootZ hzy) + (sameNatMarkoffComponent_symm hxy) + +/-- The natural Markoff surface consists of the origin and the single orbit rooted at `(1,1,1)`. -/ +theorem natMarkoff_eq_origin_or_sameComponent_root (x : SemiringMarkoffSurface ℕ) : + x = semiringSurfaceOrigin ℕ ∨ + SameNatMarkoffComponent (semiringSurfaceRoot ℕ) x := by + by_cases hx : x = semiringSurfaceOrigin ℕ + · exact Or.inl hx + · exact Or.inr (natMarkoff_ne_origin_sameComponent_root x hx) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean new file mode 100644 index 0000000000..79ac27cd65 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +/-! +# Normalized coordinates on the Markoff surface + +The paper silently passes from the original coordinates `x` to trace coordinates `u = 3x`. +This file gives the normalized affine space a distinct type, defines its Markoff equation and +Vieta moves, and proves that coordinatewise scaling by three identifies the two theories whenever +three is invertible. +-/ + +namespace BGS.Markoff + +universe u + +/-- A point in normalized trace coordinates. This is intentionally not definitionally equal to +the original-coordinate type `Point R`. -/ +@[ext] +structure NormalizedPoint (R : Type u) where + /-- The first normalized trace coordinate. -/ + u1 : R + /-- The second normalized trace coordinate. -/ + u2 : R + /-- The third normalized trace coordinate. -/ + u3 : R +deriving DecidableEq, Repr, Fintype + +/-- The origin in normalized trace coordinates. -/ +def normalizedOrigin {R : Type u} [Zero R] : NormalizedPoint R := ⟨0, 0, 0⟩ + +/-- The normalized Markoff polynomial `u₁² + u₂² + u₃² - u₁u₂u₃`. -/ +def normalizedPolynomial {R : Type u} [CommRing R] (x : NormalizedPoint R) : R := + x.u1 ^ 2 + x.u2 ^ 2 + x.u3 ^ 2 - x.u1 * x.u2 * x.u3 + +/-- The predicate that a normalized point lies on the normalized Markoff surface. -/ +def IsNormalizedMarkoff {R : Type u} [CommRing R] (x : NormalizedPoint R) : Prop := + normalizedPolynomial x = 0 + +/-- The normalized Markoff surface. -/ +def normalizedSurface (R : Type u) [CommRing R] : Set (NormalizedPoint R) := + {x | IsNormalizedMarkoff x} + +/-- The normalized Markoff surface with the origin removed. -/ +def normalizedPuncturedSurface (R : Type u) [CommRing R] : Set (NormalizedPoint R) := + normalizedSurface R \ {normalizedOrigin} + +/-- The normalized Markoff fiber obtained by fixing the first coordinate. -/ +def normalizedFiber1 {R : Type u} [CommRing R] (a : R) : Set (NormalizedPoint R) := + {x | IsNormalizedMarkoff x ∧ x.u1 = a} + +/-- The normalized Markoff fiber obtained by fixing the second coordinate. -/ +def normalizedFiber2 {R : Type u} [CommRing R] (a : R) : Set (NormalizedPoint R) := + {x | IsNormalizedMarkoff x ∧ x.u2 = a} + +/-- The normalized Markoff fiber obtained by fixing the third coordinate. -/ +def normalizedFiber3 {R : Type u} [CommRing R] (a : R) : Set (NormalizedPoint R) := + {x | IsNormalizedMarkoff x ∧ x.u3 = a} + +/-- The first Vieta involution in normalized coordinates. -/ +def normalizedVieta1 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + NormalizedPoint R := + ⟨x.u2 * x.u3 - x.u1, x.u2, x.u3⟩ + +/-- The second Vieta involution in normalized coordinates. -/ +def normalizedVieta2 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + NormalizedPoint R := + ⟨x.u1, x.u1 * x.u3 - x.u2, x.u3⟩ + +/-- The third Vieta involution in normalized coordinates. -/ +def normalizedVieta3 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + NormalizedPoint R := + ⟨x.u1, x.u2, x.u1 * x.u2 - x.u3⟩ + +/-- Exchange the first two normalized coordinates. -/ +def normalizedSwap12 {R : Type u} (x : NormalizedPoint R) : NormalizedPoint R := + ⟨x.u2, x.u1, x.u3⟩ + +/-- Exchange the last two normalized coordinates. -/ +def normalizedSwap23 {R : Type u} (x : NormalizedPoint R) : NormalizedPoint R := + ⟨x.u1, x.u3, x.u2⟩ + +/-- The fundamental rotation fixing the first normalized coordinate. -/ +def normalizedRotate1 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + NormalizedPoint R := + ⟨x.u1, x.u3, x.u1 * x.u3 - x.u2⟩ + +@[simp] +theorem normalizedPolynomial_origin {R : Type u} [CommRing R] : + normalizedPolynomial (normalizedOrigin : NormalizedPoint R) = 0 := by + simp [normalizedPolynomial, normalizedOrigin] + +@[simp] +theorem isNormalizedMarkoff_origin {R : Type u} [CommRing R] : + IsNormalizedMarkoff (normalizedOrigin : NormalizedPoint R) := by + simp [IsNormalizedMarkoff] + +theorem normalizedPolynomial_vieta1 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedPolynomial (normalizedVieta1 x) = normalizedPolynomial x := by + simp [normalizedPolynomial, normalizedVieta1] + ring + +theorem normalizedPolynomial_vieta2 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedPolynomial (normalizedVieta2 x) = normalizedPolynomial x := by + simp [normalizedPolynomial, normalizedVieta2] + ring + +theorem normalizedPolynomial_vieta3 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedPolynomial (normalizedVieta3 x) = normalizedPolynomial x := by + simp [normalizedPolynomial, normalizedVieta3] + ring + +theorem normalizedPolynomial_swap12 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedPolynomial (normalizedSwap12 x) = normalizedPolynomial x := by + simp [normalizedPolynomial, normalizedSwap12] + ring + +theorem normalizedPolynomial_swap23 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedPolynomial (normalizedSwap23 x) = normalizedPolynomial x := by + simp [normalizedPolynomial, normalizedSwap23] + ring + +theorem normalizedPolynomial_rotate1 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedPolynomial (normalizedRotate1 x) = normalizedPolynomial x := by + simp [normalizedPolynomial, normalizedRotate1] + ring + +@[simp] +theorem isNormalizedMarkoff_vieta1 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + IsNormalizedMarkoff (normalizedVieta1 x) ↔ IsNormalizedMarkoff x := by + simp only [IsNormalizedMarkoff, normalizedPolynomial_vieta1] + +@[simp] +theorem isNormalizedMarkoff_vieta2 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + IsNormalizedMarkoff (normalizedVieta2 x) ↔ IsNormalizedMarkoff x := by + simp only [IsNormalizedMarkoff, normalizedPolynomial_vieta2] + +@[simp] +theorem isNormalizedMarkoff_vieta3 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + IsNormalizedMarkoff (normalizedVieta3 x) ↔ IsNormalizedMarkoff x := by + simp only [IsNormalizedMarkoff, normalizedPolynomial_vieta3] + +@[simp] +theorem isNormalizedMarkoff_rotate1 {R : Type u} [CommRing R] (x : NormalizedPoint R) : + IsNormalizedMarkoff (normalizedRotate1 x) ↔ IsNormalizedMarkoff x := by + simp only [IsNormalizedMarkoff, normalizedPolynomial_rotate1] + +/-- The normalized rotation fixes, and therefore preserves, its first-coordinate fiber. -/ +theorem normalizedRotate1_mem_fiber1_iff + {R : Type u} [CommRing R] (a : R) (x : NormalizedPoint R) : + normalizedRotate1 x ∈ normalizedFiber1 a ↔ x ∈ normalizedFiber1 a := by + change (IsNormalizedMarkoff (normalizedRotate1 x) ∧ x.u1 = a) ↔ + IsNormalizedMarkoff x ∧ x.u1 = a + rw [isNormalizedMarkoff_rotate1] + +@[simp] +theorem normalizedVieta1_involutive {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedVieta1 (normalizedVieta1 x) = x := by + ext <;> simp [normalizedVieta1] + +@[simp] +theorem normalizedVieta2_involutive {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedVieta2 (normalizedVieta2 x) = x := by + ext <;> simp [normalizedVieta2] + +@[simp] +theorem normalizedVieta3_involutive {R : Type u} [CommRing R] (x : NormalizedPoint R) : + normalizedVieta3 (normalizedVieta3 x) = x := by + ext <;> simp [normalizedVieta3] + +/-- Coordinatewise multiplication by three, from original to normalized coordinates. -/ +def toNormalized {R : Type u} [CommRing R] (x : Point R) : NormalizedPoint R := + ⟨3 * x.x1, 3 * x.x2, 3 * x.x3⟩ + +/-- Coordinatewise multiplication by the specified inverse of three. -/ +def fromNormalized {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedPoint R) : Point R := + ⟨⅟(3 : R) * x.u1, ⅟(3 : R) * x.u2, ⅟(3 : R) * x.u3⟩ + +@[simp] +theorem toNormalized_origin {R : Type u} [CommRing R] : + toNormalized (origin : Point R) = normalizedOrigin := by + simp [toNormalized, origin, normalizedOrigin] + +@[simp] +theorem fromNormalized_origin {R : Type u} [CommRing R] [Invertible (3 : R)] : + fromNormalized (normalizedOrigin : NormalizedPoint R) = origin := by + simp [fromNormalized, normalizedOrigin, origin] + +/-- Scaling multiplies the Markoff polynomial by `3²`. This identity itself does not need three +to be invertible. -/ +theorem normalizedPolynomial_toNormalized {R : Type u} [CommRing R] (x : Point R) : + normalizedPolynomial (toNormalized x) = (3 : R) ^ 2 * markoffPolynomial x := by + simp [normalizedPolynomial, toNormalized, markoffPolynomial] + ring + +/-- When three is invertible, scaling takes the original Markoff equation to the normalized one +and reflects it. -/ +@[simp] +theorem isNormalizedMarkoff_toNormalized_iff {R : Type u} [CommRing R] + [Invertible (3 : R)] (x : Point R) : + IsNormalizedMarkoff (toNormalized x) ↔ IsMarkoff x := by + rw [IsNormalizedMarkoff, normalizedPolynomial_toNormalized, IsMarkoff] + exact ((isUnit_of_invertible (3 : R)).pow 2).mul_right_eq_zero + +/-- Coordinatewise scaling by three as an equivalence of the two ambient affine spaces. -/ +def normalizationEquiv (R : Type u) [CommRing R] [Invertible (3 : R)] : + Point R ≃ NormalizedPoint R where + toFun := toNormalized + invFun := fromNormalized + left_inv x := by + ext <;> simp [toNormalized, fromNormalized, ← mul_assoc] + right_inv x := by + ext <;> simp [toNormalized, fromNormalized, ← mul_assoc] + +/-- Scaling by three restricts to an equivalence of the original and normalized Markoff +surfaces. -/ +def normalizationSurfaceEquiv (R : Type u) [CommRing R] [Invertible (3 : R)] : + ↑(surface R) ≃ ↑(normalizedSurface R) := + (normalizationEquiv R).subtypeEquiv fun x => by + change IsMarkoff x ↔ IsNormalizedMarkoff (toNormalized x) + exact (isNormalizedMarkoff_toNormalized_iff x).symm + +@[simp] +theorem toNormalized_vieta1 {R : Type u} [CommRing R] (x : Point R) : + toNormalized (vieta1 x) = normalizedVieta1 (toNormalized x) := by + ext <;> simp [toNormalized, vieta1, normalizedVieta1] + ring + +@[simp] +theorem toNormalized_vieta2 {R : Type u} [CommRing R] (x : Point R) : + toNormalized (vieta2 x) = normalizedVieta2 (toNormalized x) := by + ext <;> simp [toNormalized, vieta2, normalizedVieta2] + ring + +@[simp] +theorem toNormalized_vieta3 {R : Type u} [CommRing R] (x : Point R) : + toNormalized (vieta3 x) = normalizedVieta3 (toNormalized x) := by + ext <;> simp [toNormalized, vieta3, normalizedVieta3] + ring + +@[simp] +theorem toNormalized_swap12 {R : Type u} [CommRing R] (x : Point R) : + toNormalized (swap12 x) = normalizedSwap12 (toNormalized x) := by + rfl + +@[simp] +theorem toNormalized_swap23 {R : Type u} [CommRing R] (x : Point R) : + toNormalized (swap23 x) = normalizedSwap23 (toNormalized x) := by + rfl + +@[simp] +theorem toNormalized_rotate1 {R : Type u} [CommRing R] (x : Point R) : + toNormalized (rotate1 x) = normalizedRotate1 (toNormalized x) := by + ext <;> simp [toNormalized, rotate1, normalizedRotate1] + ring + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean new file mode 100644 index 0000000000..fb9f4c4532 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean @@ -0,0 +1,340 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +/-! +# Markoff components in normalized coordinates + +The Markoff group is defined on the original-coordinate surface. This file transports its +permutations and component relation through `normalizationSurfaceEquiv`. It also records the +specific group word for the fundamental rotation and proves that every iterate of the normalized +rotation stays in the same transported component. +-/ + +namespace BGS.Markoff + +universe u + +/-- The normalized Markoff surface as a subtype. -/ +abbrev NormalizedMarkoffSurface (R : Type u) [CommRing R] := + ↑(normalizedSurface R) + +/-- The fundamental rotation, restricted to the original-coordinate Markoff surface. -/ +def rotate1Surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + MarkoffSurface R := + ⟨rotate1 x.1, (isMarkoff_rotate1 x.1).2 x.property⟩ + +@[simp] +theorem coe_rotate1Surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((rotate1Surface x : MarkoffSurface R) : Point R) = rotate1 x := + rfl + +/-- The rotation fixing the first coordinate is `swap23` after the second Vieta involution. -/ +theorem rotate1Surface_eq_swap23_after_vieta2 {R : Type u} [CommRing R] + (x : MarkoffSurface R) : + rotate1Surface x = swap23SurfacePerm R (vieta2SurfacePerm R x) := by + apply Subtype.ext + rfl + +/-- The explicit element of `Gamma` realizing the fundamental rotation. -/ +def gammaRotate1 (R : Type u) [CommRing R] : Gamma R := + gammaSwap23 R * gammaVieta2 R + +@[simp] +theorem gammaRotate1_smul_surface {R : Type u} [CommRing R] + (x : MarkoffSurface R) : + gammaRotate1 R • x = rotate1Surface x := by + rw [gammaRotate1, mul_smul, gammaVieta2_smul_surface, gammaSwap23_smul_surface] + exact (rotate1Surface_eq_swap23_after_vieta2 x).symm + +/-- A fundamental rotation is an honest move in the Markoff group. -/ +theorem sameComponent_rotate1Surface {R : Type u} [CommRing R] + (x : MarkoffSurface R) : + SameComponent x (rotate1Surface x) := by + rw [rotate1Surface_eq_swap23_after_vieta2] + exact sameComponent_trans (sameComponent_vieta2 x) + (sameComponent_swap23 (vieta2SurfacePerm R x)) + +/-- Conjugate an element of the original Markoff group to normalized coordinates. -/ +def normalizedGammaPerm (R : Type u) [CommRing R] [Invertible (3 : R)] + (g : Gamma R) : Equiv.Perm (NormalizedMarkoffSurface R) := + (normalizationSurfaceEquiv R).symm.trans + ((g : Equiv.Perm (MarkoffSurface R)).trans (normalizationSurfaceEquiv R)) + +@[simp] +theorem normalizedGammaPerm_apply {R : Type u} [CommRing R] [Invertible (3 : R)] + (g : Gamma R) (x : NormalizedMarkoffSurface R) : + normalizedGammaPerm R g x = + normalizationSurfaceEquiv R + ((g : Equiv.Perm (MarkoffSurface R)) ((normalizationSurfaceEquiv R).symm x)) := + rfl + +/-- The conjugated permutations give the transported `Gamma` action on the normalized surface. -/ +instance normalizedGammaMulAction + {R : Type u} [CommRing R] [Invertible (3 : R)] : + MulAction (Gamma R) (NormalizedMarkoffSurface R) where + smul g x := normalizedGammaPerm R g x + one_smul x := by + change normalizedGammaPerm R 1 x = x + change normalizationSurfaceEquiv R ((normalizationSurfaceEquiv R).symm x) = x + exact (normalizationSurfaceEquiv R).apply_symm_apply x + mul_smul g h x := by + change normalizedGammaPerm R (g * h) x = + normalizedGammaPerm R g (normalizedGammaPerm R h x) + change normalizationSurfaceEquiv R + (((g * h : Gamma R) : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x)) = + normalizationSurfaceEquiv R + ((g : Equiv.Perm (MarkoffSurface R)) ((normalizationSurfaceEquiv R).symm + (normalizationSurfaceEquiv R + ((h : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x))))) + rw [(normalizationSurfaceEquiv R).symm_apply_apply] + rfl + +@[simp] +theorem normalizedGamma_smul_eq_perm + {R : Type u} [CommRing R] [Invertible (3 : R)] + (g : Gamma R) (x : NormalizedMarkoffSurface R) : + g • x = normalizedGammaPerm R g x := + rfl + +/-- The orbit of a normalized point under the transported `Gamma` action. -/ +def normalizedGammaOrbit + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : Set (NormalizedMarkoffSurface R) := + MulAction.orbit (Gamma R) x + +/-- Two normalized points are in the same component exactly when their inverse normalizations are +in one original-coordinate `Gamma`-orbit. -/ +def SameNormalizedComponent {R : Type u} [CommRing R] [Invertible (3 : R)] + (x y : NormalizedMarkoffSurface R) : Prop := + SameComponent ((normalizationSurfaceEquiv R).symm x) + ((normalizationSurfaceEquiv R).symm y) + +/-- Orbit membership in normalized coordinates is witnessed by a conjugated element of `Gamma`. -/ +theorem sameNormalizedComponent_iff_exists_gamma + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x y : NormalizedMarkoffSurface R) : + SameNormalizedComponent x y ↔ ∃ g : Gamma R, normalizedGammaPerm R g x = y := by + rw [SameNormalizedComponent, sameComponent_iff_exists] + constructor + · rintro ⟨g, hg⟩ + refine ⟨g, ?_⟩ + rw [normalizedGammaPerm_apply] + change (g : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + (normalizationSurfaceEquiv R).symm y at hg + rw [hg, (normalizationSurfaceEquiv R).apply_symm_apply] + · rintro ⟨g, hg⟩ + refine ⟨g, ?_⟩ + rw [normalizedGammaPerm_apply] at hg + change (g : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + (normalizationSurfaceEquiv R).symm y + apply (normalizationSurfaceEquiv R).injective + simpa using hg + +/-- The transported component relation agrees with the orbit of the transported action. -/ +theorem sameNormalizedComponent_iff_mem_normalizedGammaOrbit + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x y : NormalizedMarkoffSurface R) : + SameNormalizedComponent x y ↔ y ∈ normalizedGammaOrbit x := by + rw [sameNormalizedComponent_iff_exists_gamma] + rfl + +@[refl] +theorem sameNormalizedComponent_refl + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + SameNormalizedComponent x x := + sameComponent_refl _ + +@[symm] +theorem sameNormalizedComponent_symm + {R : Type u} [CommRing R] [Invertible (3 : R)] + {x y : NormalizedMarkoffSurface R} + (h : SameNormalizedComponent x y) : + SameNormalizedComponent y x := + sameComponent_symm h + +@[trans] +theorem sameNormalizedComponent_trans + {R : Type u} [CommRing R] [Invertible (3 : R)] + {x y z : NormalizedMarkoffSurface R} + (hxy : SameNormalizedComponent x y) (hyz : SameNormalizedComponent y z) : + SameNormalizedComponent x z := + sameComponent_trans hxy hyz + +/-- Exchange the first two normalized coordinates on the normalized surface. -/ +def normalizedSwap12Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface R := + ⟨normalizedSwap12 x.1, by + change normalizedPolynomial (normalizedSwap12 x.1) = 0 + rw [normalizedPolynomial_swap12] + exact x.property⟩ + +/-- Exchange the last two normalized coordinates on the normalized surface. -/ +def normalizedSwap23Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface R := + ⟨normalizedSwap23 x.1, by + change normalizedPolynomial (normalizedSwap23 x.1) = 0 + rw [normalizedPolynomial_swap23] + exact x.property⟩ + +@[simp] +theorem coe_normalizedSwap12Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : + ((normalizedSwap12Surface x : NormalizedMarkoffSurface R) : NormalizedPoint R) = + normalizedSwap12 x := + rfl + +@[simp] +theorem coe_normalizedSwap23Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : + ((normalizedSwap23Surface x : NormalizedMarkoffSurface R) : NormalizedPoint R) = + normalizedSwap23 x := + rfl + +/-- The first normalized transposition is transported from the original surface. -/ +theorem normalizedSwap12Surface_eq_transport + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + normalizedSwap12Surface x = + normalizationSurfaceEquiv R + (swap12SurfacePerm R ((normalizationSurfaceEquiv R).symm x)) := by + apply Subtype.ext + change normalizedSwap12 x = + toNormalized (swap12 ((normalizationSurfaceEquiv R).symm x : Point R)) + rw [toNormalized_swap12] + rw [show toNormalized ((normalizationSurfaceEquiv R).symm x : Point R) = x by + exact congrArg Subtype.val ((normalizationSurfaceEquiv R).apply_symm_apply x)] + +/-- The second normalized transposition is transported from the original surface. -/ +theorem normalizedSwap23Surface_eq_transport + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + normalizedSwap23Surface x = + normalizationSurfaceEquiv R + (swap23SurfacePerm R ((normalizationSurfaceEquiv R).symm x)) := by + apply Subtype.ext + change normalizedSwap23 x = + toNormalized (swap23 ((normalizationSurfaceEquiv R).symm x : Point R)) + rw [toNormalized_swap23] + rw [show toNormalized ((normalizationSurfaceEquiv R).symm x : Point R) = x by + exact congrArg Subtype.val ((normalizationSurfaceEquiv R).apply_symm_apply x)] + +/-- The transported first coordinate transposition is the normalized swap. -/ +@[simp] +theorem gammaSwap12_smul_normalizedSurface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + gammaSwap12 R • x = normalizedSwap12Surface x := by + rw [normalizedGamma_smul_eq_perm, normalizedGammaPerm_apply] + rw [show (gammaSwap12 R : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + swap12SurfacePerm R ((normalizationSurfaceEquiv R).symm x) by + exact gammaSwap12_smul_surface ((normalizationSurfaceEquiv R).symm x)] + exact (normalizedSwap12Surface_eq_transport x).symm + +/-- The transported second coordinate transposition is the normalized swap. -/ +@[simp] +theorem gammaSwap23_smul_normalizedSurface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + gammaSwap23 R • x = normalizedSwap23Surface x := by + rw [normalizedGamma_smul_eq_perm, normalizedGammaPerm_apply] + rw [show (gammaSwap23 R : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + swap23SurfacePerm R ((normalizationSurfaceEquiv R).symm x) by + exact gammaSwap23_smul_surface ((normalizationSurfaceEquiv R).symm x)] + exact (normalizedSwap23Surface_eq_transport x).symm + +/-- Swapping the first two normalized coordinates stays in the same component. -/ +theorem sameNormalizedComponent_swap12Surface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + SameNormalizedComponent x (normalizedSwap12Surface x) := + (sameNormalizedComponent_iff_exists_gamma x _).2 + ⟨gammaSwap12 R, by simpa using gammaSwap12_smul_normalizedSurface x⟩ + +/-- Swapping the last two normalized coordinates stays in the same component. -/ +theorem sameNormalizedComponent_swap23Surface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + SameNormalizedComponent x (normalizedSwap23Surface x) := + (sameNormalizedComponent_iff_exists_gamma x _).2 + ⟨gammaSwap23 R, by simpa using gammaSwap23_smul_normalizedSurface x⟩ + +/-- The fundamental normalized rotation, restricted to the normalized surface. -/ +def normalizedRotate1Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface R := + ⟨normalizedRotate1 x.1, (isNormalizedMarkoff_rotate1 x.1).2 x.property⟩ + +@[simp] +theorem coe_normalizedRotate1Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : + ((normalizedRotate1Surface x : NormalizedMarkoffSurface R) : NormalizedPoint R) = + normalizedRotate1 x := + rfl + +/-- Normalized rotation is the normalization of the original surface rotation. -/ +theorem normalizedRotate1Surface_eq_transport + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + normalizedRotate1Surface x = + normalizationSurfaceEquiv R + (rotate1Surface ((normalizationSurfaceEquiv R).symm x)) := by + apply Subtype.ext + change normalizedRotate1 x = + toNormalized (rotate1 ((normalizationSurfaceEquiv R).symm x : Point R)) + rw [toNormalized_rotate1] + rw [show toNormalized ((normalizationSurfaceEquiv R).symm x : Point R) = x by + exact congrArg Subtype.val ((normalizationSurfaceEquiv R).apply_symm_apply x)] + +/-- The transported explicit rotation element acts by normalized rotation. -/ +@[simp] +theorem gammaRotate1_smul_normalizedSurface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + gammaRotate1 R • x = normalizedRotate1Surface x := by + rw [normalizedGamma_smul_eq_perm, normalizedGammaPerm_apply] + rw [show (gammaRotate1 R : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + rotate1Surface ((normalizationSurfaceEquiv R).symm x) by + exact gammaRotate1_smul_surface ((normalizationSurfaceEquiv R).symm x)] + exact (normalizedRotate1Surface_eq_transport x).symm + +/-- One normalized rotation stays in the transported Markoff component. -/ +theorem sameNormalizedComponent_rotate1Surface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) : + SameNormalizedComponent x (normalizedRotate1Surface x) := by + rw [SameNormalizedComponent, normalizedRotate1Surface_eq_transport] + simpa using sameComponent_rotate1Surface ((normalizationSurfaceEquiv R).symm x) + +/-- Every natural iterate of the normalized rotation stays in the same transported component. -/ +theorem sameNormalizedComponent_iterate_normalizedRotate1Surface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) (n : ℕ) : + SameNormalizedComponent x ((normalizedRotate1Surface^[n]) x) := by + induction n with + | zero => exact sameNormalizedComponent_refl x + | succ n ih => + rw [Function.iterate_succ_apply'] + exact sameNormalizedComponent_trans ih + (sameNormalizedComponent_rotate1Surface ((normalizedRotate1Surface^[n]) x)) + +/-- In particular, every positive iterate stays in the same transported component. -/ +theorem sameNormalizedComponent_positive_iterate_normalizedRotate1Surface + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : NormalizedMarkoffSurface R) (n : ℕ) (_hn : 0 < n) : + SameNormalizedComponent x ((normalizedRotate1Surface^[n]) x) := + sameNormalizedComponent_iterate_normalizedRotate1Surface x n + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean new file mode 100644 index 0000000000..9485f4f86e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean @@ -0,0 +1,456 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +import Mathlib.NumberTheory.LegendreSymbol.Basic + +/-! +# Parabolic fibers of the normalized Markoff surface + +This module exposes the elementary algebra suppressed in Lemma 3 of +Bourgain--Gamburd--Sarnak. The parameter fixed in the first coordinate is a normalized trace, +so the exceptional values are `2` and `-2`, not the original-coordinate values `2 / 3` and +`-2 / 3`. +-/ + +namespace BGS.Markoff + +universe u + +open scoped Matrix + +/-- One of the two affine lines above the normalized parabolic trace `2`. Replacing `i` by +`-i` gives the other line. -/ +def parabolicLineAtTwo {R : Type u} [CommRing R] (i t : R) : NormalizedPoint R := + ⟨2, t, t + 2 * i⟩ + +/-- One of the two affine lines above the normalized parabolic trace `-2`. Replacing `i` by +`-i` gives the other line. -/ +def parabolicLineAtNegTwo {R : Type u} [CommRing R] (i t : R) : NormalizedPoint R := + ⟨-2, t, -t + 2 * i⟩ + +/-- At normalized trace `2`, the Markoff equation is the factorized equation +`(u₃ - u₂)² = -4`. -/ +theorem normalizedPolynomial_at_two {R : Type u} [CommRing R] (t s : R) : + normalizedPolynomial (⟨(2 : R), t, s⟩ : NormalizedPoint R) = (s - t) ^ 2 + 4 := by + simp [normalizedPolynomial] + ring + +/-- At normalized trace `-2`, the Markoff equation is the factorized equation +`(u₃ + u₂)² = -4`. -/ +theorem normalizedPolynomial_at_neg_two {R : Type u} [CommRing R] (t s : R) : + normalizedPolynomial (⟨(-2 : R), t, s⟩ : NormalizedPoint R) = (s + t) ^ 2 + 4 := by + simp [normalizedPolynomial] + ring + +theorem isNormalizedMarkoff_at_two_iff {R : Type u} [CommRing R] (t s : R) : + IsNormalizedMarkoff (⟨(2 : R), t, s⟩ : NormalizedPoint R) ↔ + (s - t) ^ 2 = -(2 : R) ^ 2 := by + rw [IsNormalizedMarkoff, normalizedPolynomial_at_two] + constructor <;> intro h + · linear_combination h + · linear_combination h + +theorem isNormalizedMarkoff_at_neg_two_iff {R : Type u} [CommRing R] (t s : R) : + IsNormalizedMarkoff (⟨(-2 : R), t, s⟩ : NormalizedPoint R) ↔ + (s + t) ^ 2 = -(2 : R) ^ 2 := by + rw [IsNormalizedMarkoff, normalizedPolynomial_at_neg_two] + constructor <;> intro h + · linear_combination h + · linear_combination h + +/-- Once a square root `i` of `-1` is fixed, the trace-`2` equation has exactly the two +displayed line solutions. -/ +theorem isNormalizedMarkoff_at_two_iff_on_parabolic_lines + {R : Type u} [CommRing R] [NoZeroDivisors R] {i t s : R} (hi : i ^ 2 = -1) : + IsNormalizedMarkoff (⟨2, t, s⟩ : NormalizedPoint R) ↔ + s = t + 2 * i ∨ s = t + 2 * (-i) := by + rw [isNormalizedMarkoff_at_two_iff] + have hroot : (2 * i) ^ 2 = -(2 : R) ^ 2 := by + rw [mul_pow, hi] + ring + rw [← hroot, sq_eq_sq_iff_eq_or_eq_neg] + constructor + · rintro (h | h) + · left + linear_combination h + · right + linear_combination h + · rintro (h | h) + · left + linear_combination h + · right + linear_combination h + +/-- Once a square root `i` of `-1` is fixed, the trace-`-2` equation has exactly the two +displayed line solutions. -/ +theorem isNormalizedMarkoff_at_neg_two_iff_on_parabolic_lines + {R : Type u} [CommRing R] [NoZeroDivisors R] {i t s : R} (hi : i ^ 2 = -1) : + IsNormalizedMarkoff (⟨-2, t, s⟩ : NormalizedPoint R) ↔ + s = -t + 2 * i ∨ s = -t + 2 * (-i) := by + rw [isNormalizedMarkoff_at_neg_two_iff] + have hroot : (2 * i) ^ 2 = -(2 : R) ^ 2 := by + rw [mul_pow, hi] + ring + rw [← hroot, sq_eq_sq_iff_eq_or_eq_neg] + constructor + · rintro (h | h) + · left + linear_combination h + · right + linear_combination h + · rintro (h | h) + · left + linear_combination h + · right + linear_combination h + +/-- Set-theoretic classification of the normalized trace-`2` fiber as two affine lines. -/ +theorem normalizedFiber1_two_eq_parabolic_lines + {R : Type u} [CommRing R] [NoZeroDivisors R] (i : R) (hi : i ^ 2 = -1) : + normalizedFiber1 (2 : R) = + Set.range (parabolicLineAtTwo i) ∪ Set.range (parabolicLineAtTwo (-i)) := by + ext x + rcases x with ⟨u1, u2, u3⟩ + constructor + · rintro ⟨hx, hx1⟩ + change u1 = 2 at hx1 + subst u1 + rw [isNormalizedMarkoff_at_two_iff_on_parabolic_lines hi] at hx + rcases hx with hline | hline + · left + refine ⟨u2, ?_⟩ + ext <;> simp [parabolicLineAtTwo, hline] + · right + refine ⟨u2, ?_⟩ + ext <;> simp [parabolicLineAtTwo, hline] + · rintro (⟨t, ht⟩ | ⟨t, ht⟩) + · rw [← ht] + constructor + · change IsNormalizedMarkoff (⟨2, t, t + 2 * i⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_two_iff_on_parabolic_lines hi] + exact Or.inl rfl + · rfl + · rw [← ht] + constructor + · change IsNormalizedMarkoff (⟨2, t, t + 2 * (-i)⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_two_iff_on_parabolic_lines hi] + exact Or.inr rfl + · rfl + +/-- Set-theoretic classification of the normalized trace-`-2` fiber as two affine lines. -/ +theorem normalizedFiber1_neg_two_eq_parabolic_lines + {R : Type u} [CommRing R] [NoZeroDivisors R] (i : R) (hi : i ^ 2 = -1) : + normalizedFiber1 (-2 : R) = + Set.range (parabolicLineAtNegTwo i) ∪ Set.range (parabolicLineAtNegTwo (-i)) := by + ext x + rcases x with ⟨u1, u2, u3⟩ + constructor + · rintro ⟨hx, hx1⟩ + change u1 = -2 at hx1 + subst u1 + rw [isNormalizedMarkoff_at_neg_two_iff_on_parabolic_lines hi] at hx + rcases hx with hline | hline + · left + refine ⟨u2, ?_⟩ + ext <;> simp [parabolicLineAtNegTwo, hline] + · right + refine ⟨u2, ?_⟩ + ext <;> simp [parabolicLineAtNegTwo, hline] + · rintro (⟨t, ht⟩ | ⟨t, ht⟩) + · rw [← ht] + constructor + · change IsNormalizedMarkoff (⟨-2, t, -t + 2 * i⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_neg_two_iff_on_parabolic_lines hi] + exact Or.inl rfl + · rfl + · rw [← ht] + constructor + · change IsNormalizedMarkoff (⟨-2, t, -t + 2 * (-i)⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_neg_two_iff_on_parabolic_lines hi] + exact Or.inr rfl + · rfl + +/-- Each parabolic-line parametrization is injective because its second coordinate is the +parameter. -/ +theorem parabolicLineAtTwo_injective + {R : Type u} [CommRing R] (i : R) : Function.Injective (parabolicLineAtTwo i) := by + intro t s h + exact congrArg NormalizedPoint.u2 h + +/-- Each trace-`-2` parabolic-line parametrization is injective. -/ +theorem parabolicLineAtNegTwo_injective + {R : Type u} [CommRing R] (i : R) : Function.Injective (parabolicLineAtNegTwo i) := by + intro t s h + exact congrArg NormalizedPoint.u2 h + +/-- The two trace-`2` lines are disjoint whenever `4i` is nonzero. -/ +theorem parabolicLineAtTwo_disjoint + {R : Type u} [CommRing R] (i : R) (hfourI : (4 : R) * i ≠ 0) : + Disjoint (Set.range (parabolicLineAtTwo i)) (Set.range (parabolicLineAtTwo (-i))) := by + rw [Set.disjoint_left] + rintro x ⟨t, rfl⟩ ⟨s, hs⟩ + have hparameter := congrArg NormalizedPoint.u2 hs + have hst : s = t := by simpa [parabolicLineAtTwo] using hparameter + subst s + have hthird := congrArg NormalizedPoint.u3 hs + change t + 2 * (-i) = t + 2 * i at hthird + apply hfourI + linear_combination -hthird + +/-- The two trace-`-2` lines are disjoint whenever `4i` is nonzero. -/ +theorem parabolicLineAtNegTwo_disjoint + {R : Type u} [CommRing R] (i : R) (hfourI : (4 : R) * i ≠ 0) : + Disjoint (Set.range (parabolicLineAtNegTwo i)) + (Set.range (parabolicLineAtNegTwo (-i))) := by + rw [Set.disjoint_left] + rintro x ⟨t, rfl⟩ ⟨s, hs⟩ + have hparameter := congrArg NormalizedPoint.u2 hs + have hst : s = t := by simpa [parabolicLineAtNegTwo] using hparameter + subst s + have hthird := congrArg NormalizedPoint.u3 hs + change -t + 2 * (-i) = -t + 2 * i at hthird + apply hfourI + linear_combination -hthird + +/-- The normalized rotation at trace `2` acts by translation on either parabolic line. -/ +@[simp] +theorem normalizedRotate1_parabolicLineAtTwo + {R : Type u} [CommRing R] (i t : R) : + normalizedRotate1 (parabolicLineAtTwo i t) = parabolicLineAtTwo i (t + 2 * i) := by + ext <;> simp [normalizedRotate1, parabolicLineAtTwo] + ring + +/-- The normalized rotation at trace `-2` exchanges the two parabolic lines. -/ +@[simp] +theorem normalizedRotate1_parabolicLineAtNegTwo + {R : Type u} [CommRing R] (i t : R) : + normalizedRotate1 (parabolicLineAtNegTwo i t) = + parabolicLineAtNegTwo (-i) (-t + 2 * i) := by + ext <;> simp [normalizedRotate1, parabolicLineAtNegTwo] + ring + +/-- Two steps of the trace-`-2` rotation return to the same line and translate its parameter. -/ +theorem normalizedRotate1_twice_parabolicLineAtNegTwo + {R : Type u} [CommRing R] (i t : R) : + normalizedRotate1 (normalizedRotate1 (parabolicLineAtNegTwo i t)) = + parabolicLineAtNegTwo i (t - 4 * i) := by + ext <;> simp [normalizedRotate1, parabolicLineAtNegTwo] <;> ring + +/-- A natural number strictly between zero and the modulus remains nonzero in `ZMod p`. -/ +private theorem natCast_ne_zero_zmod_of_pos_of_lt + {n p : ℕ} (hn : 0 < n) (hnp : n < p) : (n : ZMod p) ≠ 0 := by + intro hzero + have hdvd : p ∣ n := (ZMod.natCast_eq_zero_iff n p).mp hzero + exact (Nat.not_le_of_gt hnp) (Nat.le_of_dvd hn hdvd) + +/-- If `p ≡ 3 (mod 4)`, the normalized trace-`2` fiber is empty. -/ +theorem normalizedFiber1_two_eq_empty_of_mod_four_eq_three + (p : ℕ) [Fact p.Prime] (hmod : p % 4 = 3) : + normalizedFiber1 (2 : ZMod p) = ∅ := by + ext x + simp only [Set.mem_empty_iff_false, iff_false] + rcases x with ⟨u1, u2, u3⟩ + rintro ⟨hsurface, hu1⟩ + change u1 = 2 at hu1 + subst u1 + have hpGreaterThanTwo : 2 < p := by + by_contra hp + have hpLe : p ≤ 2 := Nat.le_of_not_gt hp + interval_cases p <;> norm_num at hmod + have htwo : (2 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hpGreaterThanTwo + have hsquare : (u3 - u2) ^ 2 = -(2 : ZMod p) ^ 2 := + (isNormalizedMarkoff_at_two_iff u2 u3).mp hsurface + exact (ZMod.mod_four_ne_three_of_sq_eq_neg_sq' htwo hsquare) hmod + +/-- If `p ≡ 3 (mod 4)`, the normalized trace-`-2` fiber is empty. -/ +theorem normalizedFiber1_neg_two_eq_empty_of_mod_four_eq_three + (p : ℕ) [Fact p.Prime] (hmod : p % 4 = 3) : + normalizedFiber1 (-2 : ZMod p) = ∅ := by + ext x + simp only [Set.mem_empty_iff_false, iff_false] + rcases x with ⟨u1, u2, u3⟩ + rintro ⟨hsurface, hu1⟩ + change u1 = -2 at hu1 + subst u1 + have hpGreaterThanTwo : 2 < p := by + by_contra hp + have hpLe : p ≤ 2 := Nat.le_of_not_gt hp + interval_cases p <;> norm_num at hmod + have htwo : (2 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hpGreaterThanTwo + have hsquare : (u3 + u2) ^ 2 = -(2 : ZMod p) ^ 2 := + (isNormalizedMarkoff_at_neg_two_iff u2 u3).mp hsurface + exact (ZMod.mod_four_ne_three_of_sq_eq_neg_sq' htwo hsquare) hmod + +/-- If `p ≡ 1 (mod 4)`, a square root of `-1` exists and simultaneously supplies the two-line +descriptions of both normalized parabolic fibers. -/ +theorem exists_parabolic_line_decomposition_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hmod : p % 4 = 1) : + ∃ i : ZMod p, + i ^ 2 = -1 ∧ + normalizedFiber1 (2 : ZMod p) = + Set.range (parabolicLineAtTwo i) ∪ Set.range (parabolicLineAtTwo (-i)) ∧ + normalizedFiber1 (-2 : ZMod p) = + Set.range (parabolicLineAtNegTwo i) ∪ Set.range (parabolicLineAtNegTwo (-i)) := by + rcases (ZMod.exists_sq_eq_neg_one_iff (p := p)).2 (by omega) with ⟨i, hi⟩ + have hi' : i ^ 2 = -1 := by simpa [pow_two] using hi.symm + exact ⟨i, hi', normalizedFiber1_two_eq_parabolic_lines i hi', + normalizedFiber1_neg_two_eq_parabolic_lines i hi'⟩ + +/-- Iterating the trace-`2` rotation translates the line parameter by `2ni`. -/ +theorem iterate_normalizedRotate1_parabolicLineAtTwo + {R : Type u} [CommRing R] (n : ℕ) (i t : R) : + (normalizedRotate1^[n]) (parabolicLineAtTwo i t) = + parabolicLineAtTwo i (t + (n : R) * (2 * i)) := by + induction n with + | zero => simp + | succ n ih => + rw [Function.iterate_succ_apply', ih, + normalizedRotate1_parabolicLineAtTwo] + congr 1 + push_cast + ring + +/-- On either trace-`2` parabolic line over `ZMod p`, a rotation iterate returns to its starting +point exactly when the exponent is divisible by `p`. -/ +theorem iterate_normalizedRotate1_parabolicLineAtTwo_eq_self_iff + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (n : ℕ) (i t : ZMod p) + (hi : i ^ 2 = -1) : + (normalizedRotate1^[n]) (parabolicLineAtTwo i t) = parabolicLineAtTwo i t ↔ p ∣ n := by + rw [iterate_normalizedRotate1_parabolicLineAtTwo] + constructor + · intro hreturn + have hparameter := congrArg NormalizedPoint.u2 hreturn + change t + (n : ZMod p) * (2 * i) = t at hparameter + have hi0 : i ≠ 0 := by + intro hi0 + subst i + norm_num at hi + have htwo : (2 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) (by + have hpLower : 2 ≤ p := (Fact.out : p.Prime).two_le + exact lt_of_le_of_ne hpLower (Ne.symm hpTwo)) + have hnzero : (n : ZMod p) = 0 := by + apply (mul_eq_zero.mp ?_).resolve_right (mul_ne_zero htwo hi0) + linear_combination hparameter + exact (ZMod.natCast_eq_zero_iff n p).mp hnzero + · intro hn + have hnzero : (n : ZMod p) = 0 := (ZMod.natCast_eq_zero_iff n p).2 hn + simp [hnzero] + +/-- Closed formula for powers of the unipotent normalized rotation with trace `2`. -/ +theorem rho_two_pow {R : Type u} [CommRing R] (n : ℕ) : + rho (2 : R) ^ n = + !![(1 : R) - n, n; -(n : R), 1 + n] := by + induction n with + | zero => + ext a b + fin_cases a <;> fin_cases b <;> simp + | succ n ih => + rw [pow_succ, ih] + ext a b + fin_cases a <;> fin_cases b <;> + simp [rho, Matrix.mul_apply, Fin.sum_univ_two] <;> ring + +/-- A power of the trace-`2` rotation over `ZMod p` is the identity exactly at multiples of the +characteristic. -/ +theorem rhoSL_two_pow_eq_one_iff + (p : ℕ) [Fact p.Prime] (n : ℕ) : + rhoSL (2 : ZMod p) ^ n = 1 ↔ p ∣ n := by + constructor + · intro hpower + have hmatrix := congrArg + (fun g : Matrix.SpecialLinearGroup (Fin 2) (ZMod p) => + (g : Matrix (Fin 2) (Fin 2) (ZMod p))) hpower + have hentry := congrArg (fun m : Matrix (Fin 2) (Fin 2) (ZMod p) => m 0 1) hmatrix + simp [rhoSL, rho_two_pow] at hentry + exact (ZMod.natCast_eq_zero_iff n p).mp hentry + · intro hn + have hnzero : (n : ZMod p) = 0 := (ZMod.natCast_eq_zero_iff n p).2 hn + apply Matrix.SpecialLinearGroup.ext + intro a b + fin_cases a <;> fin_cases b <;> simp [rhoSL, rho_two_pow, hnzero] + +/-- The normalized trace-`2` rotation has exact group-theoretic order `p`. -/ +theorem rotationOrder_two (p : ℕ) [Fact p.Prime] : + rotationOrder (2 : ZMod p) = p := by + rw [rotationOrder, orderOf_eq_iff (Fact.out : p.Prime).pos] + constructor + · exact (rhoSL_two_pow_eq_one_iff p p).2 dvd_rfl + · intro m hmLower hmPositive hpower + exact (Nat.not_dvd_of_pos_of_lt hmPositive hmLower) + ((rhoSL_two_pow_eq_one_iff p m).mp hpower) + +/-- Closed formula for powers of the nontrivial parabolic normalized rotation with trace `-2`. +The scalar factor records its eigenvalue `-1`; the remaining matrix is unipotent. -/ +theorem rho_neg_two_pow {R : Type u} [CommRing R] (n : ℕ) : + rho (-2 : R) ^ n = + !![(-1 : R) ^ n * (1 - n), (-1 : R) ^ n * (-(n : R)); + (-1 : R) ^ n * n, (-1 : R) ^ n * (1 + n)] := by + induction n with + | zero => + ext a b + fin_cases a <;> fin_cases b <;> simp + | succ n ih => + rw [pow_succ, ih] + ext a b + fin_cases a <;> fin_cases b <;> + simp [rho, Matrix.mul_apply, Fin.sum_univ_two, pow_succ] <;> ring + +/-- A power of the trace-`-2` rotation over an odd prime field is the identity exactly at +multiples of `2p`. -/ +theorem rhoSL_neg_two_pow_eq_one_iff + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (n : ℕ) : + rhoSL (-2 : ZMod p) ^ n = 1 ↔ 2 * p ∣ n := by + have hnegOne : (-1 : ZMod p) ≠ 1 := by + intro h + have htwo : (2 : ZMod p) = 0 := by linear_combination -h + have hpLe : p ≤ 2 := Nat.le_of_dvd (by norm_num) + ((ZMod.natCast_eq_zero_iff 2 p).mp htwo) + exact hpTwo (Nat.le_antisymm hpLe (Fact.out : p.Prime).two_le) + constructor + · intro hpower + have hmatrix := congrArg + (fun g : Matrix.SpecialLinearGroup (Fin 2) (ZMod p) => + (g : Matrix (Fin 2) (Fin 2) (ZMod p))) hpower + have hoffDiagonal := congrArg + (fun m : Matrix (Fin 2) (Fin 2) (ZMod p) => m 0 1) hmatrix + have hnzero : (n : ZMod p) = 0 := by + simpa [rhoSL, rho_neg_two_pow] using hoffDiagonal + have hpdvd : p ∣ n := (ZMod.natCast_eq_zero_iff n p).mp hnzero + have hdiagonal := congrArg + (fun m : Matrix (Fin 2) (Fin 2) (ZMod p) => m 0 0) hmatrix + have hsign : (-1 : ZMod p) ^ n = 1 := by + simpa [rhoSL, rho_neg_two_pow, hnzero] using hdiagonal + have heven : Even n := (neg_one_pow_eq_one_iff_even hnegOne).mp hsign + exact (Fact.out : p.Prime).odd_of_ne_two hpTwo |>.coprime_two_left + |>.mul_dvd_of_dvd_of_dvd heven.two_dvd hpdvd + · intro hn + have hpdvd : p ∣ n := (dvd_mul_left p 2).trans hn + have htwoDvd : 2 ∣ n := (dvd_mul_right 2 p).trans hn + have heven : Even n := even_iff_two_dvd.mpr htwoDvd + have hnzero : (n : ZMod p) = 0 := (ZMod.natCast_eq_zero_iff n p).2 hpdvd + have hsign : (-1 : ZMod p) ^ n = 1 := heven.neg_one_pow + apply Matrix.SpecialLinearGroup.ext + intro a b + fin_cases a <;> fin_cases b <;> + simp [rhoSL, rho_neg_two_pow, hnzero, hsign] + +/-- The normalized trace-`-2` rotation has exact group-theoretic order `2p` for odd `p`. -/ +theorem rotationOrder_neg_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) : + rotationOrder (-2 : ZMod p) = 2 * p := by + rw [rotationOrder, orderOf_eq_iff (Nat.mul_pos (by norm_num) (Fact.out : p.Prime).pos)] + constructor + · exact (rhoSL_neg_two_pow_eq_one_iff p hpTwo (2 * p)).2 dvd_rfl + · intro m hmLower hmPositive hpower + exact (Nat.not_dvd_of_pos_of_lt hmPositive hmLower) + ((rhoSL_neg_two_pow_eq_one_iff p hpTwo m).mp hpower) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean new file mode 100644 index 0000000000..1af4c6cefd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +/-! +# Normalization on the punctured Markoff surface + +Scaling every original Markoff coordinate by three gives an equivalence with the normalized +punctured surface when three is invertible. The assembly-specific small-order sets transported +through this equivalence are defined in `BGS.Markoff.Assembly.PuncturedSmallOrderCount`. +-/ + +namespace BGS.Markoff + +universe u + +/-- Scaling by three identifies the action carrier of original punctured Markoff points with the +subtype of normalized punctured Markoff points. -/ +def puncturedNormalizationEquiv (R : Type u) [CommRing R] [Invertible (3 : R)] : + PuncturedMarkoffSurface R ≃ ↑(normalizedPuncturedSurface R) := + (puncturedSurfaceEquiv R).trans <| + (normalizationEquiv R).subtypeEquiv fun x => by + change (IsMarkoff x ∧ x ≠ origin) ↔ + (IsNormalizedMarkoff (toNormalized x) ∧ toNormalized x ≠ normalizedOrigin) + rw [isNormalizedMarkoff_toNormalized_iff] + constructor + · rintro ⟨hx, hx0⟩ + refine ⟨hx, ?_⟩ + intro hnormalize + apply hx0 + apply (normalizationEquiv R).injective + simpa [normalizationEquiv] using hnormalize + · rintro ⟨hx, hx0⟩ + refine ⟨hx, ?_⟩ + intro horigin + apply hx0 + simp [horigin] + +@[simp] +theorem puncturedNormalizationEquiv_coe + {R : Type u} [CommRing R] [Invertible (3 : R)] + (x : PuncturedMarkoffSurface R) : + ((puncturedNormalizationEquiv R x : ↑(normalizedPuncturedSurface R)) : + NormalizedPoint R) = toNormalized x.1.1 := + rfl + +/-- Pull a finite set of normalized punctured points back to original punctured coordinates. -/ +noncomputable def originalPuncturedFinsetOfNormalized + {R : Type u} [CommRing R] [Invertible (3 : R)] + (S : Finset ↑(normalizedPuncturedSurface R)) : Finset (PuncturedMarkoffSurface R) := + S.map (puncturedNormalizationEquiv R).symm.toEmbedding + +@[simp] +theorem mem_originalPuncturedFinsetOfNormalized_iff + {R : Type u} [CommRing R] [Invertible (3 : R)] + {S : Finset ↑(normalizedPuncturedSurface R)} {x : PuncturedMarkoffSurface R} : + x ∈ originalPuncturedFinsetOfNormalized S ↔ puncturedNormalizationEquiv R x ∈ S := by + classical + simp [originalPuncturedFinsetOfNormalized] + +/-- Pullback through normalization preserves the exact cardinality of every finite set. -/ +theorem originalPuncturedFinsetOfNormalized_card + {R : Type u} [CommRing R] [Invertible (3 : R)] + (S : Finset ↑(normalizedPuncturedSurface R)) : + (originalPuncturedFinsetOfNormalized S).card = S.card := by + simp [originalPuncturedFinsetOfNormalized] + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean new file mode 100644 index 0000000000..5f8f80932e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean @@ -0,0 +1,107 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +/-! +# The normalized Markoff rotation + +This file isolates the elementary two-dimensional linear algebra behind the fundamental +rotation. The parameter of `rho` is a normalized trace coordinate. Thus the rotation fixing an +original Markoff coordinate `x.x1` is obtained by specializing the parameter to `3 * x.x1`. +-/ + +namespace BGS.Markoff + +universe u + +open scoped Matrix + +section + +variable {R : Type u} [CommRing R] + +/-- The normalized rotation matrix `rho(t) = [[0, 1], [-1, t]]`. -/ +def rho (t : R) : Matrix (Fin 2) (Fin 2) R := + !![0, 1; -1, t] + +/-- Every normalized rotation matrix has determinant one. -/ +@[simp] +theorem rho_det (t : R) : (rho t).det = 1 := by + simp [rho, Matrix.det_fin_two_of] + +/-- The matrix parameter is exactly the trace of the normalized rotation. -/ +@[simp] +theorem rho_trace (t : R) : (rho t).trace = t := by + simp [rho, Matrix.trace_fin_two_of] + +/-- The characteristic polynomial is `T² - tT + 1`. -/ +@[simp] +theorem rho_charpoly [Nontrivial R] (t : R) : + (rho t).charpoly = Polynomial.X ^ 2 - Polynomial.C t * Polynomial.X + 1 := by + simpa using Matrix.charpoly_fin_two (rho t) + +/-- On a coordinate pair, `rho(t)` sends `(a, b)` to `(b, t * b - a)`. -/ +@[simp] +theorem rho_mulVec (t a b : R) : rho t *ᵥ ![a, b] = ![b, t * b - a] := by + ext i + fin_cases i + · simp [rho, Matrix.mulVec, dotProduct] + · simp [rho, Matrix.mulVec, dotProduct] + ring + +/-- The normalized rotation, regarded as an element of the special linear group. -/ +def rhoSL (t : R) : Matrix.SpecialLinearGroup (Fin 2) R := + ⟨rho t, rho_det t⟩ + +@[simp] +theorem rhoSL_coe (t : R) : (rhoSL t : Matrix (Fin 2) (Fin 2) R) = rho t := + rfl + +/-- The group-theoretic order of the normalized rotation. + +By the convention of `orderOf`, this is zero when the rotation has infinite order. +-/ +noncomputable def rotationOrder (t : R) : ℕ := + orderOf (rhoSL t) + +/-- Raising the rotation to `rotationOrder` gives the identity in `SL₂`. -/ +theorem rhoSL_pow_rotationOrder (t : R) : rhoSL t ^ rotationOrder t = 1 := by + simp [rotationOrder] + +/-- Over a finite coefficient ring, every normalized rotation has positive order. -/ +theorem rotationOrder_pos [Finite R] (t : R) : 0 < rotationOrder t := by + exact (isOfFinOrder_of_finite (rhoSL t)).orderOf_pos + +/-- The two coordinates moved by the fundamental rotation fixing the first coordinate. -/ +def movingCoordinates (x : Point R) : Fin 2 → R := + ![x.x2, x.x3] + +/-- The fundamental rotation is the action of `rho(3 * x.x1)` on the moving coordinates. -/ +theorem rho_mulVec_movingCoordinates (x : Point R) : + rho (3 * x.x1) *ᵥ movingCoordinates x = movingCoordinates (rotate1 x) := by + simpa [movingCoordinates, rotate1] using rho_mulVec (3 * x.x1) x.x2 x.x3 + +/-- The normalized trace parameter for the fundamental rotation is `3 * x.x1`. -/ +theorem rho_trace_fundamentalRotation (x : Point R) : (rho (3 * x.x1)).trace = 3 * x.x1 := by + simp + +/-- Reconstruct the full fundamental rotation from the fixed coordinate and the matrix action. -/ +theorem rotate1_eq_rho (x : Point R) : + rotate1 x = + ⟨x.x1, + (rho (3 * x.x1) *ᵥ movingCoordinates x) 0, + (rho (3 * x.x1) *ᵥ movingCoordinates x) 1⟩ := by + ext + · rfl + · simpa [rotate1, movingCoordinates] using + congrFun (rho_mulVec_movingCoordinates x).symm 0 + · simpa [rotate1, movingCoordinates] using + congrFun (rho_mulVec_movingCoordinates x).symm 1 + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean new file mode 100644 index 0000000000..b32d69d5e2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean @@ -0,0 +1,285 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +import Mathlib.FieldTheory.Finite.Trace + +/-! +# Split-torus traces and normalized Markoff rotations + +This module makes explicit the elementary diagonalization used when a normalized rotation has +split characteristic polynomial. The two parabolic parameters are excluded by the mathematical +hypothesis `w ^ 2 ≠ 1`; at those parameters the matrix need not have the same order as `w`. +-/ + +namespace BGS.Markoff + +open scoped Matrix + +section SplitTorus + +variable {F : Type*} [Field F] + +/-- The trace of the determinant-one diagonal matrix with eigenvalues `w` and `w⁻¹`. -/ +def splitTorusTrace (w : Fˣ) : F := + (w : F) + (w⁻¹ : Fˣ) + +/-- The determinant-one diagonal matrix with eigenvalues `w` and `w⁻¹`. -/ +noncomputable def splitDiagonalSL (w : Fˣ) : Matrix.SpecialLinearGroup (Fin 2) F := + Matrix.SpecialLinearGroup.diag2 (w : F) w.ne_zero + +@[simp] +theorem splitDiagonalSL_coe (w : Fˣ) : + (splitDiagonalSL w : Matrix (Fin 2) (Fin 2) F) = + !![(w : F), 0; 0, (w⁻¹ : Fˣ)] := by + simpa [splitDiagonalSL] using Matrix.SpecialLinearGroup.diag2_coe' w.ne_zero + +/-- An eigenbasis for a non-parabolic split trace. -/ +def splitEigenbasis (w : Fˣ) : Matrix (Fin 2) (Fin 2) F := + !![1, 1; (w : F), (w⁻¹ : Fˣ)] + +theorem splitEigenbasis_det (w : Fˣ) : + (splitEigenbasis w).det = (w⁻¹ : Fˣ) - (w : F) := by + simp [splitEigenbasis, Matrix.det_fin_two_of] + +theorem splitEigenbasis_det_ne_zero (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + (splitEigenbasis w).det ≠ 0 := by + rw [splitEigenbasis_det] + intro hdet + have hinv : ((w⁻¹ : Fˣ) : F) = (w : F) := sub_eq_zero.mp hdet + apply hw + rw [pow_two] + calc + (w : F) * (w : F) = ((w⁻¹ : Fˣ) : F) * (w : F) := by rw [hinv] + _ = 1 := by simp + +/-- The eigenbasis, regarded as an invertible matrix. -/ +noncomputable def splitEigenbasisGL (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + Matrix.GeneralLinearGroup (Fin 2) F := + Matrix.GeneralLinearGroup.mkOfDetNeZero (splitEigenbasis w) + (splitEigenbasis_det_ne_zero w hw) + +@[simp] +theorem splitEigenbasisGL_coe (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + (splitEigenbasisGL w hw : Matrix (Fin 2) (Fin 2) F) = splitEigenbasis w := + rfl + +/-- In the split eigenbasis, `rho (w + w⁻¹)` is diagonal. -/ +theorem splitEigenbasis_semiconj (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + SemiconjBy (splitEigenbasisGL w hw) + (Matrix.SpecialLinearGroup.toGL (splitDiagonalSL w)) + (Matrix.SpecialLinearGroup.toGL (rhoSL (splitTorusTrace w))) := by + apply Matrix.GeneralLinearGroup.ext + intro i j + fin_cases i <;> fin_cases j <;> + simp [splitEigenbasisGL, splitEigenbasis, splitDiagonalSL_coe, + splitTorusTrace, rho, Matrix.mul_apply] <;> + field_simp <;> ring + +/-- Diagonal determinant-one matrices multiply by multiplying their first eigenvalues. -/ +@[simp] +theorem splitDiagonalSL_mul (w z : Fˣ) : + splitDiagonalSL (w * z) = splitDiagonalSL w * splitDiagonalSL z := by + apply Subtype.ext + ext i j + fin_cases i <;> fin_cases j <;> + simp [splitDiagonalSL_coe, Matrix.mul_apply] + all_goals ring + +/-- Diagonal determinant-one matrices form the split-torus homomorphism into `SL₂`. -/ +noncomputable def splitDiagonalSLHom : Fˣ →* Matrix.SpecialLinearGroup (Fin 2) F where + toFun := splitDiagonalSL + map_one' := by + apply Subtype.ext + ext i j + fin_cases i <;> fin_cases j <;> simp [splitDiagonalSL_coe] + map_mul' := splitDiagonalSL_mul + +theorem splitDiagonalSLHom_injective : + Function.Injective (splitDiagonalSLHom : Fˣ → Matrix.SpecialLinearGroup (Fin 2) F) := by + intro w z h + apply Units.ext + have hentry := congrArg (fun A : Matrix.SpecialLinearGroup (Fin 2) F => + (A : Matrix (Fin 2) (Fin 2) F) 0 0) h + simpa [splitDiagonalSLHom, splitDiagonalSL_coe] using hentry + +/-- The diagonal `SL₂` element has exactly the multiplicative order of its first eigenvalue. -/ +theorem splitDiagonalSL_orderOf (w : Fˣ) : + orderOf (splitDiagonalSL w) = orderOf w := by + exact orderOf_injective splitDiagonalSLHom splitDiagonalSLHom_injective w + +/-- A non-parabolic split trace has rotation order equal to the order of either eigenvalue. -/ +theorem rotationOrder_splitTorusTrace (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : + rotationOrder (splitTorusTrace w) = orderOf w := by + calc + rotationOrder (splitTorusTrace w) = + orderOf (Matrix.SpecialLinearGroup.toGL (rhoSL (splitTorusTrace w))) := by + rw [rotationOrder] + symm + exact orderOf_injective Matrix.SpecialLinearGroup.toGL + Matrix.SpecialLinearGroup.toGL_injective _ + _ = orderOf (Matrix.SpecialLinearGroup.toGL (splitDiagonalSL w)) := + (splitEigenbasis_semiconj w hw).orderOf_eq.symm + _ = orderOf (splitDiagonalSL w) := + orderOf_injective Matrix.SpecialLinearGroup.toGL + Matrix.SpecialLinearGroup.toGL_injective _ + _ = orderOf w := splitDiagonalSL_orderOf w + +/-- A small non-parabolic split rotation parameter belongs to the canonical bounded-order +split-trace set used by the giant-orbit count. -/ +theorem splitTorusTrace_mem_boundedOrderTraceSet_of_rotationOrder_lt + [Fintype Fˣ] [DecidableEq F] (w : Fˣ) (hw : (w : F) ^ 2 ≠ 1) (bound : ℕ) + (hsmall : rotationOrder (splitTorusTrace w) < bound) : + splitTorusTrace w ∈ boundedOrderTraceSet splitTorusTrace bound := by + rw [boundedOrderTraceSet, Finset.mem_image] + refine ⟨w, ?_, rfl⟩ + rw [elementsOfOrderLessThan, Finset.mem_filter] + exact ⟨Finset.mem_univ _, (rotationOrder_splitTorusTrace w hw) ▸ hsmall⟩ + +end SplitTorus + +section ExtensionEigenvalues + +variable {F E : Type*} [Field F] [Field E] [Algebra F E] + +/-- Diagonalization after extending scalars. This is the common kernel for both split +eigenvalues and eigenvalues in a quadratic nonsplit torus. -/ +theorem extensionEigenbasis_semiconj (t : F) (w : Eˣ) + (hw : (w : E) ^ 2 ≠ 1) (htrace : algebraMap F E t = splitTorusTrace w) : + SemiconjBy (splitEigenbasisGL w hw) + (Matrix.SpecialLinearGroup.toGL (splitDiagonalSL w)) + (Matrix.SpecialLinearGroup.mapGL E (rhoSL t)) := by + apply Matrix.GeneralLinearGroup.ext + intro i j + fin_cases i <;> fin_cases j <;> + simp [splitEigenbasisGL, splitEigenbasis, splitDiagonalSL_coe, + splitTorusTrace, rho, Matrix.mul_apply, htrace] <;> + field_simp <;> ring + +/-- If the eigenvalues of a non-parabolic normalized rotation lie in an injective scalar +extension, its rotation order is exactly the multiplicative order of either eigenvalue. -/ +theorem rotationOrder_eq_orderOf_extensionEigenvalue [FaithfulSMul F E] + (t : F) (w : Eˣ) (hw : (w : E) ^ 2 ≠ 1) + (htrace : algebraMap F E t = splitTorusTrace w) : + rotationOrder t = orderOf w := by + calc + rotationOrder t = orderOf (Matrix.SpecialLinearGroup.mapGL E (rhoSL t)) := by + rw [rotationOrder] + symm + exact orderOf_injective (Matrix.SpecialLinearGroup.mapGL E) + Matrix.SpecialLinearGroup.mapGL_injective _ + _ = orderOf (Matrix.SpecialLinearGroup.toGL (splitDiagonalSL w)) := + (extensionEigenbasis_semiconj t w hw htrace).orderOf_eq.symm + _ = orderOf (splitDiagonalSL w) := + orderOf_injective Matrix.SpecialLinearGroup.toGL + Matrix.SpecialLinearGroup.toGL_injective _ + _ = orderOf w := splitDiagonalSL_orderOf w + +/-- The scalar-extension order calculation feeds directly into the canonical bounded-order trace +set for any honestly embedded torus. In the nonsplit application, `H` is the norm-one subgroup +of a quadratic extension and `includeEigenvalue` is its subtype map. -/ +theorem extensionTrace_mem_boundedOrderTraceSet_of_rotationOrder_lt + [FaithfulSMul F E] {H : Type*} [Group H] [Fintype H] [DecidableEq F] + (includeEigenvalue : H →* Eˣ) (hinclude : Function.Injective includeEigenvalue) + (trace : H → F) (g : H) (hw : ((includeEigenvalue g : Eˣ) : E) ^ 2 ≠ 1) + (htrace : algebraMap F E (trace g) = splitTorusTrace (includeEigenvalue g)) + (bound : ℕ) (hsmall : rotationOrder (trace g) < bound) : + trace g ∈ boundedOrderTraceSet trace bound := by + rw [boundedOrderTraceSet, Finset.mem_image] + refine ⟨g, ?_, rfl⟩ + rw [elementsOfOrderLessThan, Finset.mem_filter] + refine ⟨Finset.mem_univ _, ?_⟩ + rw [rotationOrder_eq_orderOf_extensionEigenvalue (trace g) (includeEigenvalue g) hw htrace, + orderOf_injective includeEigenvalue hinclude] at hsmall + exact hsmall + +end ExtensionEigenvalues + +section QuadraticFiniteField + +variable (p : ℕ) [Fact p.Prime] + +/-- The canonical quadratic extension of `ZMod p` supplied by Mathlib. -/ +abbrev quadraticFiniteField := GaloisField p 2 + +/-- The norm-one subgroup of the multiplicative group of the quadratic finite field. -/ +noncomputable def quadraticNormOneTorus : Subgroup (quadraticFiniteField p)ˣ := + MonoidHom.ker (Units.map (Algebra.norm (ZMod p) (S := quadraticFiniteField p))) + +noncomputable instance quadraticNormOneTorusFintype : Fintype (quadraticNormOneTorus p) := + Fintype.ofFinite (quadraticNormOneTorus p) + +/-- The base-field trace on the quadratic norm-one torus. -/ +noncomputable def quadraticNormOneTrace (w : quadraticNormOneTorus p) : ZMod p := + Algebra.trace (ZMod p) (quadraticFiniteField p) + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + +/-- For a norm-one element in the quadratic extension, its field trace is the eigenvalue trace +`w + w⁻¹`. -/ +theorem algebraMap_quadraticNormOneTrace (w : quadraticNormOneTorus p) : + algebraMap (ZMod p) (quadraticFiniteField p) (quadraticNormOneTrace p w) = + splitTorusTrace (w : (quadraticFiniteField p)ˣ) := by + have hfinrank : Module.finrank (ZMod p) (quadraticFiniteField p) = 2 := + GaloisField.finrank p (by norm_num) + have htrace := FiniteField.algebraMap_trace_eq_sum_pow + (ZMod p) (quadraticFiniteField p) + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + have hnorm := FiniteField.algebraMap_norm_eq_prod_pow + (ZMod p) (quadraticFiniteField p) + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + rw [hfinrank, Nat.card_zmod] at htrace hnorm + simp only [Finset.sum_range_succ, Finset.sum_range_zero, Finset.prod_range_succ, + Finset.prod_range_zero, pow_zero, pow_one, zero_add, one_mul] at htrace hnorm + have hwNorm : Algebra.norm (ZMod p) + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) = 1 := by + have hwMem := w.property + exact congrArg Units.val hwMem + rw [hwNorm, map_one] at hnorm + have hFrob : ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ p = + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)⁻¹) := by + apply (mul_eq_one_iff_eq_inv₀ + (show ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ≠ 0 by + exact Units.ne_zero _)).mp + rw [mul_comm] + exact hnorm.symm + rw [quadraticNormOneTrace, htrace, hFrob] + simp [splitTorusTrace] + +/-- Away from the two parabolic eigenvalues, the normalized rotation order equals the order of +the corresponding norm-one element in the quadratic extension. -/ +theorem rotationOrder_quadraticNormOneTrace (w : quadraticNormOneTorus p) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2) ≠ 1) : + rotationOrder (quadraticNormOneTrace p w) = orderOf w := by + calc + rotationOrder (quadraticNormOneTrace p w) = + orderOf (w : (quadraticFiniteField p)ˣ) := + rotationOrder_eq_orderOf_extensionEigenvalue + (quadraticNormOneTrace p w) (w : (quadraticFiniteField p)ˣ) hw + (algebraMap_quadraticNormOneTrace p w) + _ = orderOf w := + orderOf_injective (quadraticNormOneTorus p).subtype Subtype.coe_injective w + +/-- A small non-parabolic nonsplit rotation trace belongs to the canonical bounded-order trace +set of the quadratic norm-one torus. -/ +theorem quadraticNormOneTrace_mem_boundedOrderTraceSet_of_rotationOrder_lt + (w : quadraticNormOneTorus p) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2) ≠ 1) + (bound : ℕ) (hsmall : rotationOrder (quadraticNormOneTrace p w) < bound) : + quadraticNormOneTrace p w ∈ boundedOrderTraceSet (quadraticNormOneTrace p) bound := by + exact extensionTrace_mem_boundedOrderTraceSet_of_rotationOrder_lt + (quadraticNormOneTorus p).subtype Subtype.coe_injective (quadraticNormOneTrace p) w hw + (algebraMap_quadraticNormOneTrace p w) bound hsmall + +/-- The nonsplit bounded-order trace set has the same crude quadratic bound used by the final +giant-orbit count. -/ +theorem quadraticNormOneTraceSet_card_le_bound_sq (bound : ℕ) : + (boundedOrderTraceSet (quadraticNormOneTrace p) bound).card ≤ bound ^ 2 := + boundedOrderTraceSet_card_le_bound_sq (quadraticNormOneTrace p) bound + +end QuadraticFiniteField + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean new file mode 100644 index 0000000000..749bd0a002 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean @@ -0,0 +1,301 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action + +/-! +# The Markoff surface on commutative semirings + +The usual polynomial presentation by subtraction only makes sense over rings. For strong +approximation from natural-number solutions, the equation itself is the more fundamental +definition: + +`x₁² + x₂² + x₃² = 3 * x₁ * x₂ * x₃`. + +This file defines that solution type over every commutative semiring and its covariant map along +semiring homomorphisms. It also records the canonical reduction from `ℕ` to `ZMod p` and compares +the semiring definition with the existing ring-level `MarkoffSurface`. +-/ + +open CategoryTheory + +namespace BGS + +/-- The Markoff surface, functorially evaluated on commutative semirings. -/ +def Markoff : CommSemiRingCat ⥤ Type where + obj R := {⟨x, y, z⟩ : R × R × R | x ^ 2 + y ^ 2 + z ^ 2 = 3 * x * y * z} + map f := ↾fun ⟨⟨x, y, z⟩, h⟩ ↦ ⟨⟨f.hom x, f.hom y, f.hom z⟩, by + simpa only [Set.mem_setOf_eq, map_add, map_pow, map_mul, map_ofNat] using congrArg f.hom h⟩ + +end BGS + +namespace BGS.Markoff + +universe u v w + +open CategoryTheory + +/-- Strong approximation at modulus `p`: every Markoff solution modulo `p` is the +reduction of a natural-number solution. -/ +def StrongApproximationAt (p : ℕ) : Prop := + Function.Surjective + (BGS.Markoff.map (CommSemiRingCat.ofHom (Nat.castRingHom (ZMod p)))) + +/-- A point satisfies the Markoff equation over a commutative semiring. -/ +def IsSemiringMarkoff {R : Type u} [CommSemiring R] (x : Point R) : Prop := + x.x1 ^ 2 + x.x2 ^ 2 + x.x3 ^ 2 = 3 * x.x1 * x.x2 * x.x3 + +/-- Markoff solutions over a commutative semiring. -/ +abbrev SemiringMarkoffSurface (R : Type u) [CommSemiring R] := + {x : Point R // IsSemiringMarkoff x} + +/-- A concise name for the semiring-valued solution type of the Markoff equation. -/ +abbrev MarkoffSolutions (R : Type u) [CommSemiring R] := SemiringMarkoffSurface R + +/-- Apply a semiring homomorphism coordinatewise to a point of affine three-space. -/ +def semiringPointMap {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : Point R) : Point S := + ⟨f x.x1, f x.x2, f x.x3⟩ + +@[simp] +theorem semiringPointMap_x1 {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : Point R) : (semiringPointMap f x).x1 = f x.x1 := + rfl + +@[simp] +theorem semiringPointMap_x2 {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : Point R) : (semiringPointMap f x).x2 = f x.x2 := + rfl + +@[simp] +theorem semiringPointMap_x3 {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : Point R) : (semiringPointMap f x).x3 = f x.x3 := + rfl + +theorem isSemiringMarkoff_semiringPointMap + {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) {x : Point R} (hx : IsSemiringMarkoff x) : + IsSemiringMarkoff (semiringPointMap f x) := by + simpa only [IsSemiringMarkoff, semiringPointMap, map_add, map_mul, map_pow, map_ofNat] using + congrArg f hx + +namespace SemiringMarkoffSurface + +/-- Map a Markoff solution along a homomorphism of commutative semirings. -/ +def map {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : SemiringMarkoffSurface R) : SemiringMarkoffSurface S := + ⟨semiringPointMap f x.1, isSemiringMarkoff_semiringPointMap f x.2⟩ + +@[simp] +theorem map_coe {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : SemiringMarkoffSurface R) : + (map f x : Point S) = semiringPointMap f x.1 := + rfl + +@[simp] +theorem map_x1 {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : SemiringMarkoffSurface R) : + (map f x).1.x1 = f x.1.x1 := + rfl + +@[simp] +theorem map_x2 {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : SemiringMarkoffSurface R) : + (map f x).1.x2 = f x.1.x2 := + rfl + +@[simp] +theorem map_x3 {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : SemiringMarkoffSurface R) : + (map f x).1.x3 = f x.1.x3 := + rfl + +@[simp] +theorem map_id {R : Type u} [CommSemiring R] (x : SemiringMarkoffSurface R) : + map (RingHom.id R) x = x := by + apply Subtype.ext + ext <;> rfl + +@[simp] +theorem map_comp {R : Type u} {S : Type v} {T : Type w} + [CommSemiring R] [CommSemiring S] [CommSemiring T] + (g : S →+* T) (f : R →+* S) (x : SemiringMarkoffSurface R) : + map (g.comp f) x = map g (map f x) := by + apply Subtype.ext + ext <;> rfl + +end SemiringMarkoffSurface + +/-- The covariant functor of Markoff solutions on commutative semirings. -/ +def markoffFunctor : CommSemiRingCat.{u} ⥤ Type u where + obj R := SemiringMarkoffSurface R + map f := ↾SemiringMarkoffSurface.map f.hom + map_id R := by + apply ConcreteCategory.hom_ext + intro x + exact SemiringMarkoffSurface.map_id x + map_comp f g := by + apply ConcreteCategory.hom_ext + intro x + exact SemiringMarkoffSurface.map_comp g.hom f.hom x + +/-- The public triple presentation of `Markoff` agrees with the structured presentation used +internally by the dynamical development. -/ +def markoffEquivSemiringMarkoffSurface (R : Type) [CommSemiring R] : + BGS.Markoff.obj (CommSemiRingCat.of R) ≃ SemiringMarkoffSurface R where + toFun x := ⟨⟨x.1.1, x.1.2.1, x.1.2.2⟩, x.2⟩ + invFun x := ⟨⟨x.1.x1, x.1.x2, x.1.x3⟩, x.2⟩ + left_inv x := Subtype.ext rfl + right_inv x := by + apply Subtype.ext + cases x.1 + rfl + +@[simp] +theorem markoffEquivSemiringMarkoffSurface_map + {R S : Type} [CommSemiring R] [CommSemiring S] + (f : R →+* S) (x : BGS.Markoff.obj (CommSemiRingCat.of R)) : + markoffEquivSemiringMarkoffSurface S + (BGS.Markoff.map (CommSemiRingCat.ofHom f) x) = + SemiringMarkoffSurface.map f (markoffEquivSemiringMarkoffSurface R x) := by + apply Subtype.ext + ext <;> rfl + +@[simp] +theorem markoffFunctor_obj (R : CommSemiRingCat.{u}) : + markoffFunctor.obj R = SemiringMarkoffSurface R := + rfl + +@[simp] +theorem markoffFunctor_map {R S : CommSemiRingCat.{u}} (f : R ⟶ S) + (x : SemiringMarkoffSurface R) : + markoffFunctor.map f x = SemiringMarkoffSurface.map f.hom x := + rfl + +/-- The origin as a Markoff solution over a commutative semiring. -/ +def semiringSurfaceOrigin (R : Type u) [CommSemiring R] : SemiringMarkoffSurface R := + ⟨origin, by simp [IsSemiringMarkoff, origin]⟩ + +/-- The distinguished positive Markoff solution `(1, 1, 1)`. -/ +def semiringSurfaceRoot (R : Type u) [CommSemiring R] : SemiringMarkoffSurface R := + ⟨⟨1, 1, 1⟩, by norm_num [IsSemiringMarkoff]⟩ + +@[simp] +theorem SemiringMarkoffSurface.map_origin + {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] (f : R →+* S) : + SemiringMarkoffSurface.map f (semiringSurfaceOrigin R) = semiringSurfaceOrigin S := by + apply Subtype.ext + ext <;> simp [SemiringMarkoffSurface.map, semiringPointMap, semiringSurfaceOrigin, origin] + +@[simp] +theorem SemiringMarkoffSurface.map_root + {R : Type u} {S : Type v} [CommSemiring R] [CommSemiring S] (f : R →+* S) : + SemiringMarkoffSurface.map f (semiringSurfaceRoot R) = semiringSurfaceRoot S := by + apply Subtype.ext + ext <;> simp [SemiringMarkoffSurface.map, semiringPointMap, semiringSurfaceRoot] + +/-- Coordinatewise reduction of natural-number Markoff solutions modulo `p`. -/ +def markoffReduction (p : ℕ) : + SemiringMarkoffSurface ℕ → SemiringMarkoffSurface (ZMod p) := + SemiringMarkoffSurface.map (Nat.castRingHom (ZMod p)) + +/-- The public functor formulation of strong approximation agrees with the structured +reduction map used internally. -/ +theorem strongApproximationAt_iff_markoffReduction_surjective (p : ℕ) : + StrongApproximationAt p ↔ Function.Surjective (markoffReduction p) := by + constructor + · intro h y + obtain ⟨x, hx⟩ := h ((markoffEquivSemiringMarkoffSurface (ZMod p)).symm y) + refine ⟨markoffEquivSemiringMarkoffSurface ℕ x, ?_⟩ + simpa [markoffReduction] using + congrArg (markoffEquivSemiringMarkoffSurface (ZMod p)) hx + · intro h y + obtain ⟨x, hx⟩ := h (markoffEquivSemiringMarkoffSurface (ZMod p) y) + refine ⟨(markoffEquivSemiringMarkoffSurface ℕ).symm x, ?_⟩ + apply (markoffEquivSemiringMarkoffSurface (ZMod p)).injective + simpa [markoffReduction] using hx + +@[simp] +theorem markoffReduction_eq_markoffFunctor_map (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + markoffReduction p x = + markoffFunctor.map (CommSemiRingCat.ofHom (Nat.castRingHom (ZMod p))) x := + rfl + +@[simp] +theorem markoffReduction_x1 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + (markoffReduction p x).1.x1 = (x.1.x1 : ZMod p) := + rfl + +@[simp] +theorem markoffReduction_x2 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + (markoffReduction p x).1.x2 = (x.1.x2 : ZMod p) := + rfl + +@[simp] +theorem markoffReduction_x3 (p : ℕ) (x : SemiringMarkoffSurface ℕ) : + (markoffReduction p x).1.x3 = (x.1.x3 : ZMod p) := + rfl + +@[simp] +theorem markoffReduction_origin (p : ℕ) : + markoffReduction p (semiringSurfaceOrigin ℕ) = semiringSurfaceOrigin (ZMod p) := + SemiringMarkoffSurface.map_origin _ + +@[simp] +theorem markoffReduction_root (p : ℕ) : + markoffReduction p (semiringSurfaceRoot ℕ) = semiringSurfaceRoot (ZMod p) := + SemiringMarkoffSurface.map_root _ + +/-- Over a commutative ring, the equation-based semiring surface agrees with the existing +zero-locus definition using `markoffPolynomial`. -/ +def semiringMarkoffSurfaceEquiv (R : Type u) [CommRing R] : + SemiringMarkoffSurface R ≃ MarkoffSurface R where + toFun x := + ⟨x.1, by + change x.1.x1 ^ 2 + x.1.x2 ^ 2 + x.1.x3 ^ 2 - + 3 * x.1.x1 * x.1.x2 * x.1.x3 = 0 + exact sub_eq_zero.mpr x.2⟩ + invFun x := + ⟨x.1, by + apply sub_eq_zero.mp + exact x.2⟩ + left_inv x := Subtype.ext rfl + right_inv x := Subtype.ext rfl + +@[simp] +theorem semiringMarkoffSurfaceEquiv_apply_coe + {R : Type u} [CommRing R] (x : SemiringMarkoffSurface R) : + ((semiringMarkoffSurfaceEquiv R x : MarkoffSurface R) : Point R) = x.1 := + rfl + +@[simp] +theorem semiringMarkoffSurfaceEquiv_symm_apply_coe + {R : Type u} [CommRing R] (x : MarkoffSurface R) : + ((semiringMarkoffSurfaceEquiv R).symm x : Point R) = x.1 := + rfl + +/-- The distinguished solution `(1, 1, 1)` on the existing ring-level Markoff surface. -/ +def surfaceRoot (R : Type u) [CommRing R] : MarkoffSurface R := + ⟨⟨1, 1, 1⟩, by norm_num [IsMarkoff, markoffPolynomial]⟩ + +@[simp] +theorem surfaceRoot_coe (R : Type u) [CommRing R] : + ((surfaceRoot R : MarkoffSurface R) : Point R) = ⟨1, 1, 1⟩ := + rfl + +@[simp] +theorem semiringMarkoffSurfaceEquiv_origin (R : Type u) [CommRing R] : + semiringMarkoffSurfaceEquiv R (semiringSurfaceOrigin R) = surfaceOrigin R := by + apply Subtype.ext + rfl + +@[simp] +theorem semiringMarkoffSurfaceEquiv_root (R : Type u) [CommRing R] : + semiringMarkoffSurfaceEquiv R (semiringSurfaceRoot R) = surfaceRoot R := by + apply Subtype.ext + rfl + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean new file mode 100644 index 0000000000..5990a40770 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean @@ -0,0 +1,87 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor + +/-! +# Formal statements of the main results + +This file fixes the logical meaning of the two main theorems before their proofs are attempted. +In particular, the threshold in the giant-orbit assertion may depend on `epsilon`, while the +constant in the lower bound for every orbit is absolute. +-/ + +namespace BGS.Markoff + +/-- Punctured Markoff transitivity at a prime `p`: the Markoff group has one orbit on the +nonzero solutions modulo `p`. -/ +def PuncturedMarkoffTransitiveAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ x y : PuncturedMarkoffSurface (ZMod p), ∃ g : Gamma (ZMod p), g • x = y + +/-- The complement size of the orbit of `x` inside the punctured surface over `ZMod p`. -/ +noncomputable def orbitComplementCard {p : ℕ} [Fact p.Prime] + (x : PuncturedMarkoffSurface (ZMod p)) : ℕ := + (Set.univ \ puncturedGammaOrbit x).ncard + +/-- At `p`, there is an orbit whose complement has at most `p ^ epsilon` points. -/ +def HasGiantOrbitAt (p : ℕ) (hp : p.Prime) (epsilon : ℝ) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∃ x : PuncturedMarkoffSurface (ZMod p), + (orbitComplementCard x : ℝ) ≤ Real.rpow p epsilon + +/-- A finite set containing an orbit complement bounds that complement's cardinality. -/ +theorem orbitComplementCard_le_finset_of_subset + {p : ℕ} [Fact p.Prime] (x : PuncturedMarkoffSurface (ZMod p)) + (bad : Finset (PuncturedMarkoffSurface (ZMod p))) + (hbad : Set.univ \ puncturedGammaOrbit x ⊆ (bad : Set _)) : + orbitComplementCard x ≤ bad.card := by + rw [orbitComplementCard, ← Set.ncard_coe_finset bad] + exact Set.ncard_le_ncard hbad + +/-- The final giant-orbit conclusion once the complement has been put inside a counted set. -/ +theorem hasGiantOrbitAt_of_complement_subset_finset + (p : ℕ) (hp : p.Prime) (epsilon : ℝ) + (x : PuncturedMarkoffSurface (ZMod p)) + (bad : Finset (PuncturedMarkoffSurface (ZMod p))) + (hbad : Set.univ \ puncturedGammaOrbit x ⊆ (bad : Set _)) + (hcard : (bad.card : ℝ) ≤ Real.rpow p epsilon) : + HasGiantOrbitAt p hp epsilon := by + letI : Fact p.Prime := ⟨hp⟩ + refine ⟨x, ?_⟩ + have hnat := orbitComplementCard_le_finset_of_subset x bad hbad + have hreal : (orbitComplementCard x : ℝ) ≤ bad.card := by + exact_mod_cast hnat + exact hreal.trans hcard + +/-- At `p`, every punctured Markoff orbit has the asserted logarithmic lower bound. -/ +def EveryOrbitLargeAt (p : ℕ) (hp : p.Prime) (c : ℝ) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ x : PuncturedMarkoffSurface (ZMod p), + c * Real.rpow (Real.log p) (1 / ((3 : ℕ) : ℝ)) ≤ (puncturedGammaOrbit x).ncard + +/-- The exact quantifier structure of Theorem 1 in arXiv:1607.01530v1. -/ +def TheoremOneStatement : Prop := + (∀ epsilon : ℝ, 0 < epsilon → + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → HasGiantOrbitAt p hp epsilon) ∧ + ∃ c : ℝ, 0 < c ∧ + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → EveryOrbitLargeAt p hp c + +/-- A prime is exceptional when strong approximation fails at that prime. -/ +def IsExceptionalPrime (p : ℕ) : Prop := + p.Prime ∧ ¬ StrongApproximationAt p + +/-- The number of exceptional primes at most `T`. -/ +noncomputable def exceptionalPrimeCount (T : ℕ) : ℕ := + {p : ℕ | p ≤ T ∧ IsExceptionalPrime p}.ncard + +/-- The exact quantifier structure of Theorem 2 in arXiv:1607.01530v1. -/ +def TheoremTwoStatement : Prop := + ∀ epsilon : ℝ, 0 < epsilon → + ∃ T0 : ℕ, ∀ T : ℕ, T0 ≤ T → + (exceptionalPrimeCount T : ℝ) ≤ Real.rpow T epsilon + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean new file mode 100644 index 0000000000..d35b397b7f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean @@ -0,0 +1,302 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +import Mathlib.FieldTheory.PrimeField + +/-! +# Split and nonsplit trace classification + +This module proves the elementary representation of every normalized trace over an odd +prime field by either the split torus or the concrete norm-one torus in the canonical quadratic +extension. +-/ + +namespace BGS.Markoff + +open scoped Polynomial + +section QuadraticExtensionSquares + +variable (p : ℕ) [Fact p.Prime] + +private theorem quadraticFiniteField_natCard : + Nat.card (quadraticFiniteField p) = p ^ 2 := + GaloisField.card p (n := 2) (by norm_num) + +/-- Every base-field scalar becomes a square in the canonical quadratic extension. -/ +theorem isSquare_algebraMap_quadraticFiniteField (hpTwo : p ≠ 2) (a : ZMod p) : + IsSquare (algebraMap (ZMod p) (quadraticFiniteField p) a) := by + let E := quadraticFiniteField p + letI : Fintype E := Fintype.ofFinite _ + change IsSquare (algebraMap (ZMod p) E a) + by_cases ha : a = 0 + · subst a + exact ⟨0, by simp⟩ + have hpOddCard : Odd p := (Fact.out : p.Prime).odd_of_ne_two hpTwo + have hcharE : ringChar E ≠ 2 := by + rw [show ringChar E = p from ringChar.eq (R := E) p] + exact hpTwo + have hmap_ne : algebraMap (ZMod p) E a ≠ 0 := + (map_ne_zero (algebraMap (ZMod p) E)).2 ha + rw [FiniteField.isSquare_iff hcharE hmap_ne] + rw [show Fintype.card E = p ^ 2 by + rw [Fintype.card_eq_nat_card] + exact quadraticFiniteField_natCard p] + have hbasePow : a ^ (p - 1) = 1 := ZMod.pow_card_sub_one_eq_one ha + have hexponent : p ^ 2 / 2 = (p - 1) * ((p + 1) / 2) := by + apply Nat.eq_of_mul_eq_mul_left (by norm_num : 0 < 2) + calc + 2 * (p ^ 2 / 2) = p ^ 2 - 1 := + Nat.two_mul_odd_div_two (Nat.odd_iff.mp (Odd.pow hpOddCard)) + _ = (p - 1) * (p + 1) := by + rw [show p ^ 2 - 1 = (p + 1) * (p - 1) by + simpa using (sq_tsub_sq p 1)] + exact mul_comm _ _ + _ = (p - 1) * (2 * ((p + 1) / 2)) := by + rw [Nat.two_mul_div_two_of_even (Odd.add_one hpOddCard)] + _ = 2 * ((p - 1) * ((p + 1) / 2)) := by ring + rw [hexponent, pow_mul, ← map_pow, hbasePow, map_one, one_pow] + +end QuadraticExtensionSquares + +section TraceClassification + +variable (p : ℕ) [Fact p.Prime] + +private theorem two_ne_zero_zmod (hpTwo : p ≠ 2) : (2 : ZMod p) ≠ 0 := by + intro hzero + have hdiv : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).1 hzero + have hpLe : p ≤ 2 := Nat.le_of_dvd (by norm_num) hdiv + exact hpTwo (Nat.le_antisymm hpLe (Fact.out : p.Prime).two_le) + +private theorem nonparabolic_split_eigenvalue + (t : ZMod p) (ht : t ^ 2 ≠ 4) (w : (ZMod p)ˣ) + (htrace : splitTorusTrace w = t) : (w : ZMod p) ^ 2 ≠ 1 := by + intro hw + apply ht + rw [← htrace] + have hinv : ((w⁻¹ : (ZMod p)ˣ) : ZMod p) = (w : ZMod p) := by + exact Units.inv_eq_of_mul_eq_one_right (by simpa [pow_two] using hw) + change ((w : ZMod p) + ((w⁻¹ : (ZMod p)ˣ) : ZMod p)) ^ 2 = 4 + rw [hinv] + calc + ((w : ZMod p) + (w : ZMod p)) ^ 2 = 4 * (w : ZMod p) ^ 2 := by ring + _ = 4 := by rw [hw, mul_one] + +private theorem nonparabolic_extension_eigenvalue + (t : ZMod p) (ht : t ^ 2 ≠ 4) (w : (quadraticFiniteField p)ˣ) + (htrace : algebraMap (ZMod p) (quadraticFiniteField p) t = splitTorusTrace w) : + (w : quadraticFiniteField p) ^ 2 ≠ 1 := by + intro hw + apply ht + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + rw [map_pow, map_ofNat, htrace] + have hinv : ((w⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) = + (w : quadraticFiniteField p) := by + exact Units.inv_eq_of_mul_eq_one_right (by simpa [pow_two] using hw) + change ((w : quadraticFiniteField p) + + ((w⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)) ^ 2 = 4 + rw [hinv] + calc + ((w : quadraticFiniteField p) + (w : quadraticFiniteField p)) ^ 2 = + 4 * (w : quadraticFiniteField p) ^ 2 := by ring + _ = 4 := by rw [hw, mul_one] + +/-- Every nonparabolic normalized trace over an odd prime field is represented by either the +split torus or the concrete norm-one torus in the canonical quadratic extension. -/ +theorem exists_split_or_quadraticNormOneTrace + (hpTwo : p ≠ 2) (t : ZMod p) (ht : t ^ 2 ≠ 4) : + (∃ w : (ZMod p)ˣ, + splitTorusTrace w = t ∧ (w : ZMod p) ^ 2 ≠ 1) ∨ + (∃ w : quadraticNormOneTorus p, + quadraticNormOneTrace p w = t ∧ + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) := by + let d : ZMod p := t ^ 2 - 4 + have hd : d ≠ 0 := sub_ne_zero.mpr ht + have htwoF : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod p hpTwo + by_cases hdsquare : IsSquare d + · obtain ⟨s, hs⟩ := hdsquare + have hsDisc : s ^ 2 = t ^ 2 - 4 := by + simpa [d, pow_two] using hs.symm + let w0 : ZMod p := (t + s) / 2 + let v0 : ZMod p := (t - s) / 2 + have hwv : w0 * v0 = 1 := by + dsimp [w0, v0] + field_simp [htwoF] + linear_combination -hsDisc + have hw0 : w0 ≠ 0 := by + intro hw + rw [hw, zero_mul] at hwv + exact zero_ne_one hwv + let w : (ZMod p)ˣ := Units.mk0 w0 hw0 + have hinv : ((w⁻¹ : (ZMod p)ˣ) : ZMod p) = v0 := + Units.inv_eq_of_mul_eq_one_right hwv + have htrace : splitTorusTrace w = t := by + change w0 + ((w⁻¹ : (ZMod p)ˣ) : ZMod p) = t + rw [hinv] + dsimp [w0, v0] + field_simp [htwoF] + ring + exact Or.inl ⟨w, htrace, nonparabolic_split_eigenvalue p t ht w htrace⟩ + · let E := quadraticFiniteField p + letI : Fintype E := Fintype.ofFinite _ + obtain ⟨s, hs⟩ := isSquare_algebraMap_quadraticFiniteField p hpTwo d + have hsDiscBase : s ^ 2 = algebraMap (ZMod p) E d := by + simpa [pow_two] using hs.symm + have hsFrobeniusSquare : (s ^ p) ^ 2 = s ^ 2 := by + calc + (s ^ p) ^ 2 = s ^ (p * 2) := (pow_mul s p 2).symm + _ = s ^ (2 * p) := by rw [mul_comm] + _ = (s ^ 2) ^ p := pow_mul s 2 p + _ = (algebraMap (ZMod p) E d) ^ p := by rw [hsDiscBase] + _ = algebraMap (ZMod p) E (d ^ p) := by rw [map_pow] + _ = algebraMap (ZMod p) E d := by rw [ZMod.pow_card] + _ = s ^ 2 := hsDiscBase.symm + have hsFrobeniusCases : s ^ p = s ∨ s ^ p = -s := by + have hfactor : (s ^ p - s) * (s ^ p + s) = 0 := by + calc + (s ^ p - s) * (s ^ p + s) = (s ^ p) ^ 2 - s ^ 2 := by ring + _ = 0 := sub_eq_zero.mpr hsFrobeniusSquare + rcases mul_eq_zero.mp hfactor with h | h + · exact Or.inl (sub_eq_zero.mp h) + · exact Or.inr (eq_neg_of_add_eq_zero_left h) + have hsFrobenius : s ^ p = -s := by + rcases hsFrobeniusCases with hfixed | hneg + · exfalso + apply hdsquare + have hmem : s ∈ (⊥ : Subfield E) := + (Subfield.mem_bot_iff_pow_eq_self E p).2 hfixed + obtain ⟨n, hn⟩ := (mem_bot_iff_intCast p E).1 hmem + have hbaseSquare : d = (n : ZMod p) ^ 2 := by + apply (algebraMap (ZMod p) E).injective + calc + algebraMap (ZMod p) E d = s ^ 2 := hsDiscBase.symm + _ = (n : E) ^ 2 := by rw [hn] + _ = algebraMap (ZMod p) E ((n : ZMod p) ^ 2) := by norm_cast + exact ⟨(n : ZMod p), by simpa [pow_two] using hbaseSquare⟩ + · exact hneg + let T : E := algebraMap (ZMod p) E t + have hsDisc : s ^ 2 = T ^ 2 - 4 := by + simpa only [d, T, map_sub, map_pow, map_ofNat] using hsDiscBase + have htwoE : (2 : E) ≠ 0 := by + exact (map_ne_zero (algebraMap (ZMod p) E)).2 htwoF + let w0 : E := (T + s) / 2 + let v0 : E := (T - s) / 2 + have hwv : w0 * v0 = 1 := by + dsimp [w0, v0] + rw [div_mul_div_comm] + apply (div_eq_iff (mul_ne_zero htwoE htwoE)).2 + linear_combination -hsDisc + have hw0 : w0 ≠ 0 := by + intro hw + rw [hw, zero_mul] at hwv + exact zero_ne_one hwv + let w : Eˣ := Units.mk0 w0 hw0 + have hinv : ((w⁻¹ : Eˣ) : E) = v0 := + Units.inv_eq_of_mul_eq_one_right hwv + have htrace : splitTorusTrace w = T := by + change w0 + ((w⁻¹ : Eˣ) : E) = T + rw [hinv] + dsimp [w0, v0] + rw [← add_div] + apply (div_eq_iff htwoE).2 + ring + have hTpow : T ^ p = T := by + dsimp [T] + rw [← map_pow, ZMod.pow_card] + have htwoPow : (2 : E) ^ p = 2 := by + change (algebraMap (ZMod p) E (2 : ZMod p)) ^ p = + algebraMap (ZMod p) E (2 : ZMod p) + rw [← map_pow, ZMod.pow_card] + have hwpow : w0 ^ p = v0 := by + dsimp [w0, v0] + rw [div_pow, add_pow_char, hTpow, hsFrobenius, htwoPow] + simp [sub_eq_add_neg] + have hfinrank : Module.finrank (ZMod p) E = 2 := + GaloisField.finrank p (n := 2) (by norm_num) + have hnormFormula := FiniteField.algebraMap_norm_eq_prod_pow + (ZMod p) E w0 + rw [hfinrank, Nat.card_zmod] at hnormFormula + simp only [Finset.prod_range_succ, Finset.prod_range_zero, pow_zero, pow_one, + one_mul] at hnormFormula + have hnorm : Algebra.norm (ZMod p) w0 = 1 := by + apply (algebraMap (ZMod p) E).injective + rw [hnormFormula, hwpow, hwv, map_one] + have hwMem : w ∈ quadraticNormOneTorus p := by + rw [quadraticNormOneTorus, MonoidHom.mem_ker] + apply Units.ext + simpa [w] using hnorm + let normOneW : quadraticNormOneTorus p := ⟨w, hwMem⟩ + have hnormOneTrace : quadraticNormOneTrace p normOneW = t := by + apply (algebraMap (ZMod p) E).injective + rw [algebraMap_quadraticNormOneTrace] + exact htrace + refine Or.inr ⟨normOneW, hnormOneTrace, ?_⟩ + exact nonparabolic_extension_eigenvalue p t ht w (hnormOneTrace ▸ + algebraMap_quadraticNormOneTrace p normOneW) + +/-- The two normalized parabolic trace parameters. -/ +def normalizedParabolicTraceSet : Finset (ZMod p) := + {2, -2} + +/-- The concrete low-order trace set used for normalized Markoff rotations over `ZMod p`. -/ +noncomputable def concreteLowOrderTraceSet (bound : ℕ) : Finset (ZMod p) := + lowOrderTraceSet (normalizedParabolicTraceSet p) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) (quadraticNormOneTrace p) bound + +/-- The concrete trace set has the quadratic cardinality bound needed in the giant-orbit count. -/ +theorem concreteLowOrderTraceSet_card_le (bound : ℕ) : + (concreteLowOrderTraceSet p bound).card ≤ 2 + 2 * bound ^ 2 := by + calc + (concreteLowOrderTraceSet p bound).card ≤ + (normalizedParabolicTraceSet p).card + 2 * bound ^ 2 := by + exact lowOrderTraceSet_card_le_parabolic_add_two_mul_bound_sq + (normalizedParabolicTraceSet p) (splitTorusTrace : (ZMod p)ˣ → ZMod p) + (quadraticNormOneTrace p) bound + _ ≤ 2 + 2 * bound ^ 2 := by + gcongr + exact Finset.card_le_two + +/-- A normalized trace of small rotation order lies in the concrete union of the parabolic, +split-torus, and quadratic norm-one bounded-order trace sets. -/ +theorem mem_concreteLowOrderTraceSet_of_rotationOrder_lt + (hpTwo : p ≠ 2) (t : ZMod p) (bound : ℕ) + (hsmall : rotationOrder t < bound) : + t ∈ concreteLowOrderTraceSet p bound := by + by_cases ht : t ^ 2 = 4 + · have hfactor : (t - 2) * (t + 2) = 0 := by + calc + (t - 2) * (t + 2) = t ^ 2 - 4 := by ring + _ = 0 := sub_eq_zero.mpr ht + have htCases : t = 2 ∨ t = -2 := by + rcases mul_eq_zero.mp hfactor with h | h + · exact Or.inl (sub_eq_zero.mp h) + · exact Or.inr (eq_neg_of_add_eq_zero_left h) + have hparabolic : t ∈ normalizedParabolicTraceSet p := by + rcases htCases with rfl | rfl <;> simp [normalizedParabolicTraceSet] + rw [concreteLowOrderTraceSet, lowOrderTraceSet] + exact Finset.mem_union_left _ (Finset.mem_union_left _ hparabolic) + · rcases exists_split_or_quadraticNormOneTrace p hpTwo t ht with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · have hsplit : splitTorusTrace w ∈ + boundedOrderTraceSet (splitTorusTrace : (ZMod p)ˣ → ZMod p) bound := + splitTorusTrace_mem_boundedOrderTraceSet_of_rotationOrder_lt w hw bound (by + simpa [htrace] using hsmall) + rw [concreteLowOrderTraceSet, lowOrderTraceSet] + rw [← htrace] + exact Finset.mem_union_left _ (Finset.mem_union_right _ hsplit) + · have hnonsplit : quadraticNormOneTrace p w ∈ + boundedOrderTraceSet (quadraticNormOneTrace p) bound := + quadraticNormOneTrace_mem_boundedOrderTraceSet_of_rotationOrder_lt p w hw bound (by + simpa [htrace] using hsmall) + rw [concreteLowOrderTraceSet, lowOrderTraceSet] + rw [← htrace] + exact Finset.mem_union_right _ hnonsplit + +end TraceClassification + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean new file mode 100644 index 0000000000..eb3d7c6968 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean @@ -0,0 +1,10 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean new file mode 100644 index 0000000000..45e97da87f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts + +/-! +# Exact first-coordinate product formula + +This file formalizes the exact finite-product identity preceding the asymptotic estimate in +published Section 7. A first coordinate is coprime to the squarefree product modulus exactly +when it is nonzero in every prime factor. The carrier below records that local condition +directly; no real-valued comparison with `exp (-2 * L)` is asserted here. +-/ + +namespace BGS.Markoff + +open Finset + +/-- Punctured Markoff points whose first coordinate is nonzero. This is definitionally the +complement of the zero-coordinate locus counted in `LocalCounts`. -/ +def puncturedMarkoffFirstCoordinateNonzero (R : Type*) [CommRing R] : + Set (PuncturedMarkoffSurface R) := + (puncturedMarkoffFirstCoordinateZero R)ᶜ + +@[simp] theorem mem_puncturedMarkoffFirstCoordinateNonzero_iff + {R : Type*} [CommRing R] (x : PuncturedMarkoffSurface R) : + x ∈ puncturedMarkoffFirstCoordinateNonzero R ↔ x.1.1.x1 ≠ 0 := by + simp [puncturedMarkoffFirstCoordinateNonzero, puncturedMarkoffFirstCoordinateZero] + +/-- Exact local numerator in published equation (97). -/ +theorem puncturedMarkoffFirstCoordinateNonzero_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card ↑(puncturedMarkoffFirstCoordinateNonzero (ZMod p)) = p ^ 2 + p + 2 := by + change (puncturedMarkoffFirstCoordinateZero (ZMod p))ᶜ.ncard = p ^ 2 + p + 2 + rw [Set.ncard_compl, ← Nat.card_coe_set_eq, + puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one p hpModFour, + puncturedMarkoffSurface_zmod_card_eq_of_mod_four_eq_one p hpModFour] + have hpTwo : 2 ≤ p := (Fact.out : p.Prime).two_le + omega + +/-- Primewise-punctured points whose first coordinate is nonzero at every factor. -/ +def primewisePuncturedFirstCoordinateNonzero {ι : Type*} (a : ι → ℕ) : + Set (PrimewisePuncturedMarkoffSurface a) := + {x | ∀ i, x i ∈ puncturedMarkoffFirstCoordinateNonzero (ZMod (a i))} + +/-- The primewise nonzero-coordinate carrier is the product of its local subtypes. -/ +def primewisePuncturedFirstCoordinateNonzeroEquivPi {ι : Type*} (a : ι → ℕ) : + ↑(primewisePuncturedFirstCoordinateNonzero a) ≃ + ∀ i, ↑(puncturedMarkoffFirstCoordinateNonzero (ZMod (a i))) where + toFun x i := ⟨x.1 i, x.2 i⟩ + invFun x := ⟨fun i => (x i).1, fun i => (x i).2⟩ + left_inv x := by apply Subtype.ext; funext i; rfl + right_inv x := by funext i; apply Subtype.ext; rfl + +/-- Exact product numerator for points whose first coordinate is nonzero at every prime. -/ +theorem primewisePuncturedFirstCoordinateNonzero_card_eq_of_mod_four_eq_one + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (hmod : ∀ i, a i % 4 = 1) : + Nat.card ↑(primewisePuncturedFirstCoordinateNonzero a) = + ∏ i, (a i ^ 2 + a i + 2) := by + rw [Nat.card_congr (primewisePuncturedFirstCoordinateNonzeroEquivPi a), Nat.card_pi] + apply Finset.prod_congr rfl + intro i _ + exact puncturedMarkoffFirstCoordinateNonzero_zmod_card_eq_of_mod_four_eq_one + (a i) (hmod i) + +/-- First-coordinate nonvanishing pulled back to the single-residue-ring CRT presentation. -/ +def crtPrimewisePuncturedFirstCoordinateNonzero {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Function.onFun Nat.Coprime a)) : + Set (CRTPrimewisePuncturedMarkoffSurface a coprime) := + {x | ∀ i, primewisePuncturedCRTEquiv a coprime x i ∈ + puncturedMarkoffFirstCoordinateNonzero (ZMod (a i))} + +/-- CRT restricts to the first-coordinate-nonzero carriers. -/ +noncomputable def crtPrimewisePuncturedFirstCoordinateNonzeroEquiv + {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Function.onFun Nat.Coprime a)) : + ↑(crtPrimewisePuncturedFirstCoordinateNonzero a coprime) ≃ + ↑(primewisePuncturedFirstCoordinateNonzero a) := + (primewisePuncturedCRTEquiv a coprime).subtypeEquiv fun _ => Iff.rfl + +/-- The CRT presentation has the same exact product numerator. -/ +theorem crtPrimewisePuncturedFirstCoordinateNonzero_card_eq_of_mod_four_eq_one + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (coprime : Pairwise (Function.onFun Nat.Coprime a)) (hmod : ∀ i, a i % 4 = 1) : + Nat.card ↑(crtPrimewisePuncturedFirstCoordinateNonzero a coprime) = + ∏ i, (a i ^ 2 + a i + 2) := by + rw [Nat.card_congr (crtPrimewisePuncturedFirstCoordinateNonzeroEquiv a coprime)] + exact primewisePuncturedFirstCoordinateNonzero_card_eq_of_mod_four_eq_one a hmod + +/-- Exact rational proportion in product-numerator form. This deliberately stops before the +paper's real-valued asymptotic comparison. -/ +theorem primewisePuncturedFirstCoordinateNonzero_proportion_eq_product + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (hmod : ∀ i, a i % 4 = 1) : + (Nat.card ↑(primewisePuncturedFirstCoordinateNonzero a) : ℚ) / + Nat.card (PrimewisePuncturedMarkoffSurface a) = + ∏ i, ((a i ^ 2 + a i + 2 : ℕ) : ℚ) / (a i ^ 2 + 3 * a i : ℕ) := by + rw [primewisePuncturedFirstCoordinateNonzero_card_eq_of_mod_four_eq_one a hmod, + primewisePuncturedMarkoffSurface_card_eq_of_mod_four_eq_one a hmod] + push_cast + exact (Finset.prod_div_distrib _ _).symm + +/-- A local numerator factor is exactly one minus the zero-coordinate proportion. -/ +theorem firstCoordinateNonzero_proportion_factor_eq_one_sub + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + ((p ^ 2 + p + 2 : ℕ) : ℚ) / (p ^ 2 + 3 * p : ℕ) = + 1 - ((2 * p - 2 : ℕ) : ℚ) / (p ^ 2 + 3 * p : ℕ) := by + have hpTwo : 2 ≤ p := (Fact.out : p.Prime).two_le + have hsub : 2 ≤ 2 * p := by omega + have hdenNat : 0 < p ^ 2 + 3 * p := by omega + have hden : ((p ^ 2 + 3 * p : ℕ) : ℚ) ≠ 0 := by exact_mod_cast hdenNat.ne' + push_cast [Nat.cast_sub hsub] + field_simp [hden] + ring + +/-- Exact rational form of published equation (97), with one local zero-coordinate factor +removed at each prime. -/ +theorem primewisePuncturedFirstCoordinateNonzero_proportion_eq_product_one_sub + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (hmod : ∀ i, a i % 4 = 1) : + (Nat.card ↑(primewisePuncturedFirstCoordinateNonzero a) : ℚ) / + Nat.card (PrimewisePuncturedMarkoffSurface a) = + ∏ i, (1 - ((2 * a i - 2 : ℕ) : ℚ) / (a i ^ 2 + 3 * a i : ℕ)) := by + rw [primewisePuncturedFirstCoordinateNonzero_proportion_eq_product a hmod] + apply Finset.prod_congr rfl + intro i _ + exact firstCoordinateNonzero_proportion_factor_eq_one_sub (a i) (hmod i) + +/-- The same exact rational proportion on the single-residue-ring CRT carrier. -/ +theorem crtPrimewisePuncturedFirstCoordinateNonzero_proportion_eq_product_one_sub + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (coprime : Pairwise (Function.onFun Nat.Coprime a)) (hmod : ∀ i, a i % 4 = 1) : + (Nat.card ↑(crtPrimewisePuncturedFirstCoordinateNonzero a coprime) : ℚ) / + Nat.card (CRTPrimewisePuncturedMarkoffSurface a coprime) = + ∏ i, (1 - ((2 * a i - 2 : ℕ) : ℚ) / (a i ^ 2 + 3 * a i : ℕ)) := by + rw [crtPrimewisePuncturedFirstCoordinateNonzero_card_eq_of_mod_four_eq_one a coprime hmod, + crtPrimewisePuncturedMarkoffSurface_card_eq_of_mod_four_eq_one a coprime hmod] + rw [← primewisePuncturedFirstCoordinateNonzero_card_eq_of_mod_four_eq_one a hmod, + ← primewisePuncturedMarkoffSurface_card_eq_of_mod_four_eq_one a hmod] + exact primewisePuncturedFirstCoordinateNonzero_proportion_eq_product_one_sub a hmod + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean new file mode 100644 index 0000000000..155598b3ae --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct + +/-! +# Exact coordinate-zero patterns over a squarefree modulus + +This file continues the elementary finite counting in published Section 7. It counts points +whose first coordinate vanishes at exactly a prescribed collection of prime factors. The result +is an exact finite product; no real asymptotic estimate is used. +-/ + +namespace BGS.Markoff + +open Finset + +/-- Primewise-punctured points whose first coordinate vanishes exactly at the indices in `R`. -/ +def primewisePuncturedFirstCoordinateZeroExactlyOn + {ι : Type*} [DecidableEq ι] (a : ι → ℕ) (R : Finset ι) : + Set (PrimewisePuncturedMarkoffSurface a) := + {x | ∀ i, + x i ∈ if i ∈ R then puncturedMarkoffFirstCoordinateZero (ZMod (a i)) + else puncturedMarkoffFirstCoordinateNonzero (ZMod (a i))} + +@[simp] theorem mem_primewisePuncturedFirstCoordinateZeroExactlyOn_iff + {ι : Type*} [DecidableEq ι] {a : ι → ℕ} {R : Finset ι} + (x : PrimewisePuncturedMarkoffSurface a) : + x ∈ primewisePuncturedFirstCoordinateZeroExactlyOn a R ↔ + ∀ i, x i ∈ puncturedMarkoffFirstCoordinateZero (ZMod (a i)) ↔ i ∈ R := by + constructor + · intro hx i + specialize hx i + by_cases hi : i ∈ R + · simpa [primewisePuncturedFirstCoordinateZeroExactlyOn, hi] using hx + · have hxNonzero : + x i ∈ puncturedMarkoffFirstCoordinateNonzero (ZMod (a i)) := by + simpa [primewisePuncturedFirstCoordinateZeroExactlyOn, hi] using hx + simp only [puncturedMarkoffFirstCoordinateNonzero, Set.mem_compl_iff] at hxNonzero + exact iff_of_false hxNonzero hi + · intro hx i + by_cases hi : i ∈ R + · simpa [primewisePuncturedFirstCoordinateZeroExactlyOn, hi] using (hx i).mpr hi + · have hzero : x i ∉ puncturedMarkoffFirstCoordinateZero (ZMod (a i)) := by + intro h + exact hi ((hx i).mp h) + simpa [primewisePuncturedFirstCoordinateZeroExactlyOn, hi, + puncturedMarkoffFirstCoordinateNonzero] using hzero + +/-- An exact zero pattern is the product of the corresponding local zero and nonzero loci. -/ +def primewisePuncturedFirstCoordinateZeroExactlyOnEquivPi + {ι : Type*} [DecidableEq ι] (a : ι → ℕ) (R : Finset ι) : + ↑(primewisePuncturedFirstCoordinateZeroExactlyOn a R) ≃ + ∀ i, ↑(if i ∈ R then puncturedMarkoffFirstCoordinateZero (ZMod (a i)) + else puncturedMarkoffFirstCoordinateNonzero (ZMod (a i))) where + toFun x i := ⟨x.1 i, x.2 i⟩ + invFun x := ⟨fun i => (x i).1, fun i => (x i).2⟩ + left_inv x := by apply Subtype.ext; funext i; rfl + right_inv x := by funext i; apply Subtype.ext; rfl + +/-- Exact product count for a prescribed set `R` of zero-coordinate prime factors. -/ +theorem primewisePuncturedFirstCoordinateZeroExactlyOn_card_eq_of_mod_four_eq_one + {ι : Type*} [Fintype ι] [DecidableEq ι] (a : ι → ℕ) + [∀ i, Fact (a i).Prime] (hmod : ∀ i, a i % 4 = 1) (R : Finset ι) : + Nat.card ↑(primewisePuncturedFirstCoordinateZeroExactlyOn a R) = + ∏ i, if i ∈ R then 2 * a i - 2 else a i ^ 2 + a i + 2 := by + rw [Nat.card_congr (primewisePuncturedFirstCoordinateZeroExactlyOnEquivPi a R), + Nat.card_pi] + apply Finset.prod_congr rfl + intro i _ + by_cases hi : i ∈ R + · simp only [hi, if_true] + exact puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one + (a i) (hmod i) + · simp only [hi, if_false] + exact puncturedMarkoffFirstCoordinateNonzero_zmod_card_eq_of_mod_four_eq_one + (a i) (hmod i) + +/-- The same prescribed zero pattern on the single-residue-ring CRT carrier. -/ +def crtPrimewisePuncturedFirstCoordinateZeroExactlyOn + {ι : Type*} [Fintype ι] [DecidableEq ι] (a : ι → ℕ) + (coprime : Pairwise (Function.onFun Nat.Coprime a)) (R : Finset ι) : + Set (CRTPrimewisePuncturedMarkoffSurface a coprime) := + {x | primewisePuncturedCRTEquiv a coprime x ∈ + primewisePuncturedFirstCoordinateZeroExactlyOn a R} + +/-- CRT restricts to each prescribed zero-pattern carrier. -/ +noncomputable def crtPrimewisePuncturedFirstCoordinateZeroExactlyOnEquiv + {ι : Type*} [Fintype ι] [DecidableEq ι] (a : ι → ℕ) + (coprime : Pairwise (Function.onFun Nat.Coprime a)) (R : Finset ι) : + ↑(crtPrimewisePuncturedFirstCoordinateZeroExactlyOn a coprime R) ≃ + ↑(primewisePuncturedFirstCoordinateZeroExactlyOn a R) := + (primewisePuncturedCRTEquiv a coprime).subtypeEquiv fun _ => Iff.rfl + +/-- Exact prescribed-pattern count in the CRT presentation. -/ +theorem crtPrimewisePuncturedFirstCoordinateZeroExactlyOn_card_eq_of_mod_four_eq_one + {ι : Type*} [Fintype ι] [DecidableEq ι] (a : ι → ℕ) + [∀ i, Fact (a i).Prime] (coprime : Pairwise (Function.onFun Nat.Coprime a)) + (hmod : ∀ i, a i % 4 = 1) (R : Finset ι) : + Nat.card ↑(crtPrimewisePuncturedFirstCoordinateZeroExactlyOn a coprime R) = + ∏ i, if i ∈ R then 2 * a i - 2 else a i ^ 2 + a i + 2 := by + rw [Nat.card_congr + (crtPrimewisePuncturedFirstCoordinateZeroExactlyOnEquiv a coprime R)] + exact primewisePuncturedFirstCoordinateZeroExactlyOn_card_eq_of_mod_four_eq_one + a hmod R + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean new file mode 100644 index 0000000000..3f44d84c8f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean @@ -0,0 +1,505 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT +import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization + +/-! +# Elementary local counts on the Markoff surface + +This file proves the two exact finite-field counts used in Section 7 of the published +Bourgain--Gamburd--Sarnak paper. The full surface count is reduced to an explicit quadratic- +character sum, including the exceptional fibers at normalized traces `0`, `2`, and `-2`. +Coordinatewise normalization then transports the results back to the original Markoff surface. +-/ + +namespace BGS.Markoff + +open Finset +open BGS.FiniteField + +variable {F : Type*} [Field F] [Fintype F] [DecidableEq F] + +private lemma quadraticChar_neg_four_eq_one + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + quadraticChar F (-4) = 1 := by + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + rw [show (-4 : F) = (-1) * 2 ^ 2 by norm_num, map_mul, + hneg, quadraticChar_sq_one' htwo, one_mul] + +private lemma sum_quadraticChar_neg_four_mul_sq + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + ∑ x : F, quadraticChar F ((-4) * x ^ 2) = (Fintype.card F : ℤ) - 1 := by + have hnegFour := quadraticChar_neg_four_eq_one hF hneg + calc + ∑ x : F, quadraticChar F ((-4) * x ^ 2) = + ∑ x : F, if x = 0 then 0 else 1 := by + apply sum_congr rfl + intro x _ + by_cases hx : x = 0 + · simp [hx] + · rw [map_mul, hnegFour, one_mul, quadraticChar_sq_one' hx] + simp [hx] + _ = (Fintype.card F : ℤ) - 1 := by + rw [sum_ite] + simp only [sum_const_zero, sum_const, nsmul_eq_mul, mul_one] + have hfilter : (univ.filter fun x : F ↦ ¬x = 0) = univ.erase 0 := by + ext x + simp + rw [hfilter, card_erase_of_mem (mem_univ 0)] + rw [card_univ] + have hcard : 0 < Fintype.card F := Fintype.card_pos + omega + +private lemma quadraticChar_neg_sixteen_eq_one + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + quadraticChar F (-16) = 1 := by + have hfour : (4 : F) ≠ 0 := by + rw [show (4 : F) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 (Ring.two_ne_zero hF) + rw [show (-16 : F) = (-1) * 4 ^ 2 by norm_num, map_mul, + hneg, quadraticChar_sq_one' hfour, one_mul] + +private lemma markoffDiscriminant_inner_sum + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) (y : F) : + ∑ x : F, quadraticChar F ((y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2) = + -quadraticChar F (y ^ 2 - 4) + + (if y = 0 then (Fintype.card F : ℤ) else 0) + + (if y ^ 2 = 4 then (Fintype.card F : ℤ) else 0) := by + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + have hfour : (4 : F) ≠ 0 := by + rw [show (4 : F) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 htwo + by_cases hy : y = 0 + · subst y + have hrewrite (x : F) : + ((0 : F) ^ 2 - 4) * x ^ 2 - 4 * (0 : F) ^ 2 = (-4) * x ^ 2 := by ring + simp_rw [hrewrite] + rw [sum_quadraticChar_neg_four_mul_sq hF hneg] + have hzeroFour : (0 : F) ^ 2 ≠ 4 := by + simpa using hfour.symm + simp only [if_true, if_neg hzeroFour] + rw [show quadraticChar F ((0 : F) ^ 2 - 4) = 1 by + simpa using quadraticChar_neg_four_eq_one hF hneg] + ring + · by_cases hspecial : y ^ 2 = 4 + · have hconstant (x : F) : (y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2 = (-16 : F) := by + rw [hspecial] + ring + simp_rw [hconstant, quadraticChar_neg_sixteen_eq_one hF hneg] + rw [if_neg hy, if_pos hspecial] + simp [hspecial] + · have hA : y ^ 2 - 4 ≠ 0 := sub_ne_zero.mpr hspecial + have hC : (4 : F) * y ^ 2 ≠ 0 := mul_ne_zero hfour (pow_ne_zero 2 hy) + rw [BGS.FiniteField.sum_quadraticChar_mul_sq_sub hF hA hC] + rw [if_neg hy, if_neg hspecial] + ring + +private lemma markoffDiscriminant_double_sum + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + ∑ y : F, ∑ x : F, quadraticChar F ((y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2) = + 3 * (Fintype.card F : ℤ) + 1 := by + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + have hfour : (4 : F) ≠ 0 := by + rw [show (4 : F) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 htwo + have hchiFour : quadraticChar F (4 : F) = 1 := by + rw [show (4 : F) = 2 ^ 2 by norm_num, quadraticChar_sq_one' htwo] + have hquadratic : + ∑ y : F, quadraticChar F (y ^ 2 - 4) = -1 := by + simpa using + (BGS.FiniteField.sum_quadraticChar_mul_sq_sub hF (A := (1 : F)) + (C := (4 : F)) one_ne_zero hfour) + have hzeroIndicator : + ∑ y : F, (if y = 0 then (Fintype.card F : ℤ) else 0) = + Fintype.card F := by + simp + have hrootCard : (univ.filter fun y : F ↦ y ^ 2 = 4).card = 2 := by + have hroots := quadraticChar_card_sqrts hF (4 : F) + rw [hchiFour] at hroots + norm_num [Set.toFinset_setOf] at hroots + exact_mod_cast hroots + have hspecialIndicator : + ∑ y : F, (if y ^ 2 = 4 then (Fintype.card F : ℤ) else 0) = + 2 * Fintype.card F := by + rw [sum_ite] + simp only [sum_const_zero, add_zero, sum_const, nsmul_eq_mul] + rw [hrootCard] + ring + simp_rw [markoffDiscriminant_inner_sum hF hneg] + rw [sum_add_distrib, sum_add_distrib] + rw [sum_neg_distrib, hquadratic, hzeroIndicator, hspecialIndicator] + ring + +private def normalizedMarkoffThirdCoordinateEquivDiscriminantRoots + (hF : ringChar F ≠ 2) (x y : F) : + {z : F // IsNormalizedMarkoff (⟨x, y, z⟩ : NormalizedPoint F)} ≃ + {d : F // d ^ 2 = (y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2} where + toFun z := ⟨2 * z.1 - x * y, by + have hz := z.2 + change x ^ 2 + y ^ 2 + z.1 ^ 2 - x * y * z.1 = 0 at hz + linear_combination 4 * hz⟩ + invFun d := ⟨(d.1 + x * y) / 2, by + change x ^ 2 + y ^ 2 + ((d.1 + x * y) / 2) ^ 2 - + x * y * ((d.1 + x * y) / 2) = 0 + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + field_simp [htwo] + linear_combination d.2⟩ + left_inv z := by + apply Subtype.ext + dsimp + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + field_simp [htwo] + ring + right_inv d := by + apply Subtype.ext + dsimp + have htwo : (2 : F) ≠ 0 := Ring.two_ne_zero hF + field_simp [htwo] + ring + +private def normalizedSurfaceEquivDiscriminantRoots + (hF : ringChar F ≠ 2) : + ↑(normalizedSurface F) ≃ + Σ x : F, Σ y : F, + {d : F // d ^ 2 = (y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2} where + toFun u := + ⟨u.1.u1, u.1.u2, + normalizedMarkoffThirdCoordinateEquivDiscriminantRoots hF u.1.u1 u.1.u2 + ⟨u.1.u3, u.2⟩⟩ + invFun u := + ⟨⟨u.1, u.2.1, + (normalizedMarkoffThirdCoordinateEquivDiscriminantRoots hF u.1 u.2.1).symm + u.2.2⟩, + ((normalizedMarkoffThirdCoordinateEquivDiscriminantRoots hF u.1 u.2.1).symm + u.2.2).2⟩ + left_inv u := by + apply Subtype.ext + ext <;> simp + right_inv u := by + rcases u with ⟨x, y, d⟩ + simp + +private lemma squareRootSubtypeCard_eq_quadraticChar_add_one + (hF : ringChar F ≠ 2) (t : F) : + (Fintype.card {d : F // d ^ 2 = t} : ℤ) = quadraticChar F t + 1 := by + calc + (Fintype.card {d : F // d ^ 2 = t} : ℤ) = + ((({d : F | d ^ 2 = t} : Set F).toFinset.card : ℕ) : ℤ) := by + rw [Set.toFinset_card] + exact_mod_cast Fintype.card_congr (Equiv.refl _) + _ = quadraticChar F t + 1 := quadraticChar_card_sqrts hF t + +/-- If the field has odd characteristic and `-1` has quadratic character `1`, the normalized +Markoff surface has `q² + 3q + 1` points, including the origin. -/ +theorem normalizedSurface_card_eq_of_quadraticChar_neg_one_eq_one + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(normalizedSurface F) = + Fintype.card F ^ 2 + 3 * Fintype.card F + 1 := by + classical + letI := Fintype.ofFinite ↑(normalizedSurface F) + rw [Nat.card_eq_fintype_card] + rw [Fintype.card_congr (normalizedSurfaceEquivDiscriminantRoots hF)] + rw [Fintype.card_sigma] + simp_rw [Fintype.card_sigma] + have hroots (x y : F) : + (Fintype.card {d : F // + d ^ 2 = (y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2} : ℤ) = + quadraticChar F ((y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2) + 1 := by + exact squareRootSubtypeCard_eq_quadraticChar_add_one hF _ + apply Nat.cast_injective (R := ℤ) + push_cast + simp_rw [hroots] + simp_rw [sum_add_distrib] + rw [sum_comm] + rw [markoffDiscriminant_double_sum hF hneg] + simp + ring + +/-- Removing the origin from the normalized surface leaves `q² + 3q` points. -/ +theorem normalizedPuncturedSurface_card_eq_of_quadraticChar_neg_one_eq_one + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(normalizedPuncturedSurface F) = + Fintype.card F ^ 2 + 3 * Fintype.card F := by + change (normalizedPuncturedSurface F).ncard = _ + rw [normalizedPuncturedSurface, Set.ncard_sdiff_singleton_of_mem] + · rw [← Nat.card_coe_set_eq, + normalizedSurface_card_eq_of_quadraticChar_neg_one_eq_one hF hneg] + omega + · exact isNormalizedMarkoff_origin + +/-- Published equation (95) in normalized coordinates: for prime `p ≡ 1 (mod 4)`, the +punctured surface has exactly `p² + 3p` points. -/ +theorem normalizedPuncturedSurface_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card ↑(normalizedPuncturedSurface (ZMod p)) = p ^ 2 + 3 * p := by + have hpTwo : p ≠ 2 := by + intro hp + subst p + norm_num at hpModFour + have hchar : ringChar (ZMod p) ≠ 2 := (ZMod.ringChar_zmod_n p).substr hpTwo + have hneg : quadraticChar (ZMod p) (-1) = 1 := by + rw [quadraticChar_neg_one hchar, ZMod.χ₄_nat_eq_if_mod_four, ZMod.card p, hpModFour] + simp only [if_true] + have hpOdd : p % 2 = 1 := by omega + rw [hpOdd] + norm_num + simpa [ZMod.card p] using + normalizedPuncturedSurface_card_eq_of_quadraticChar_neg_one_eq_one hchar hneg + +private def normalizedFiber1ZeroEquivSquareRoots : + ↑(normalizedFiber1 (0 : F)) ≃ Σ y : F, {z : F // z ^ 2 = -y ^ 2} where + toFun u := ⟨u.1.u2, u.1.u3, by + have hu := u.2.1 + change u.1.u1 ^ 2 + u.1.u2 ^ 2 + u.1.u3 ^ 2 - + u.1.u1 * u.1.u2 * u.1.u3 = 0 at hu + rw [u.2.2] at hu + linear_combination hu⟩ + invFun u := ⟨⟨0, u.1, u.2.1⟩, by + constructor + · change (0 : F) ^ 2 + u.1 ^ 2 + u.2.1 ^ 2 - 0 * u.1 * u.2.1 = 0 + rw [u.2.2] + ring + · rfl⟩ + left_inv u := by + apply Subtype.ext + ext + · exact u.2.2.symm + · rfl + · rfl + right_inv u := by + rcases u with ⟨y, z⟩ + rfl + +/-- The full first-coordinate-zero fiber has `2q - 1` points; the extra point is the origin. -/ +theorem normalizedFiber1_zero_card_eq_of_quadraticChar_neg_one_eq_one + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(normalizedFiber1 (0 : F)) = 2 * Fintype.card F - 1 := by + classical + letI := Fintype.ofFinite ↑(normalizedFiber1 (0 : F)) + rw [Nat.card_eq_fintype_card] + rw [Fintype.card_congr normalizedFiber1ZeroEquivSquareRoots] + rw [Fintype.card_sigma] + apply Nat.cast_injective (R := ℤ) + push_cast + simp_rw [squareRootSubtypeCard_eq_quadraticChar_add_one hF] + have hchar (y : F) : + quadraticChar F (-y ^ 2) = if y = 0 then 0 else 1 := by + by_cases hy : y = 0 + · simp [hy] + · rw [show -y ^ 2 = (-1) * y ^ 2 by ring, map_mul, hneg, + quadraticChar_sq_one' hy, one_mul] + simp [hy] + simp_rw [hchar, sum_add_distrib] + have hfilter : (univ.filter fun y : F ↦ ¬y = 0) = univ.erase 0 := by + ext y + simp + rw [sum_ite] + simp only [sum_const_zero, sum_const, nsmul_eq_mul] + rw [hfilter, card_erase_of_mem (mem_univ 0), card_univ] + have hcard : 0 < Fintype.card F := Fintype.card_pos + omega + +/-- After removing the origin, a normalized coordinate-zero fiber has `2q - 2` points. -/ +theorem normalizedPuncturedFiber1_zero_card_eq_of_quadraticChar_neg_one_eq_one + (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(normalizedFiber1 (0 : F) \ {normalizedOrigin}) = + 2 * Fintype.card F - 2 := by + change (normalizedFiber1 (0 : F) \ {normalizedOrigin}).ncard = _ + rw [Set.ncard_sdiff_singleton_of_mem] + · rw [← Nat.card_coe_set_eq, + normalizedFiber1_zero_card_eq_of_quadraticChar_neg_one_eq_one hF hneg] + have hcard : 0 < Fintype.card F := Fintype.card_pos + omega + · exact ⟨isNormalizedMarkoff_origin, rfl⟩ + +/-- Published equation (96) for the first normalized coordinate. -/ +theorem normalizedPuncturedFiber1_zero_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card ↑(normalizedFiber1 (0 : ZMod p) \ {normalizedOrigin}) = 2 * p - 2 := by + have hpTwo : p ≠ 2 := by + intro hp + subst p + norm_num at hpModFour + have hchar : ringChar (ZMod p) ≠ 2 := (ZMod.ringChar_zmod_n p).substr hpTwo + have hneg : quadraticChar (ZMod p) (-1) = 1 := by + rw [quadraticChar_neg_one hchar, ZMod.χ₄_nat_eq_if_mod_four, ZMod.card p, hpModFour] + simp only [if_true] + have hpOdd : p % 2 = 1 := by omega + rw [hpOdd] + norm_num + simpa [ZMod.card p] using + normalizedPuncturedFiber1_zero_card_eq_of_quadraticChar_neg_one_eq_one hchar hneg + +/-- Original-coordinate punctured Markoff points whose first coordinate vanishes. -/ +def puncturedMarkoffFirstCoordinateZero (R : Type*) [CommRing R] : + Set (PuncturedMarkoffSurface R) := + {x | x.1.1.x1 = 0} + +/-- Original-coordinate punctured Markoff points whose second coordinate vanishes. -/ +def puncturedMarkoffSecondCoordinateZero (R : Type*) [CommRing R] : + Set (PuncturedMarkoffSurface R) := + {x | x.1.1.x2 = 0} + +/-- Original-coordinate punctured Markoff points whose third coordinate vanishes. -/ +def puncturedMarkoffThirdCoordinateZero (R : Type*) [CommRing R] : + Set (PuncturedMarkoffSurface R) := + {x | x.1.1.x3 = 0} + +/-- Swapping the first two coordinates identifies their zero-coordinate loci. -/ +def puncturedMarkoffSecondCoordinateZeroEquivFirst (R : Type*) [CommRing R] : + ↑(puncturedMarkoffSecondCoordinateZero R) ≃ + ↑(puncturedMarkoffFirstCoordinateZero R) := + (swap12PuncturedPerm R).subtypeEquiv fun _ ↦ Iff.rfl + +/-- Swapping the last two coordinates and then the first two identifies the third and first +zero-coordinate loci. -/ +def puncturedMarkoffThirdCoordinateZeroEquivFirst (R : Type*) [CommRing R] : + ↑(puncturedMarkoffThirdCoordinateZero R) ≃ + ↑(puncturedMarkoffFirstCoordinateZero R) := + ((swap23PuncturedPerm R).trans (swap12PuncturedPerm R)).subtypeEquiv fun _ ↦ Iff.rfl + +private def puncturedMarkoffFirstCoordinateZeroEquivNormalized + [Invertible (3 : F)] : + ↑(puncturedMarkoffFirstCoordinateZero F) ≃ + ↑(normalizedFiber1 (0 : F) \ {normalizedOrigin}) where + toFun x := by + let u := puncturedNormalizationEquiv F x.1 + refine ⟨u.1, ⟨⟨u.2.1, ?_⟩, u.2.2⟩⟩ + rw [show (u.1 : NormalizedPoint F) = toNormalized x.1.1.1 by rfl] + change (3 : F) * x.1.1.1.x1 = 0 + rw [x.2, mul_zero] + invFun u := by + let v : ↑(normalizedPuncturedSurface F) := ⟨u.1, ⟨u.2.1.1, u.2.2⟩⟩ + let x := (puncturedNormalizationEquiv F).symm v + refine ⟨x, ?_⟩ + have hnormalize : puncturedNormalizationEquiv F x = v := + (puncturedNormalizationEquiv F).apply_symm_apply v + have hcoordinate : (3 : F) * x.1.1.x1 = 0 := by + have := congrArg (fun w : ↑(normalizedPuncturedSurface F) ↦ w.1.u1) hnormalize + simpa [v, puncturedNormalizationEquiv_coe, toNormalized] using this.trans u.2.1.2 + exact (mul_eq_zero.mp hcoordinate).resolve_left (isUnit_of_invertible (3 : F)).ne_zero + left_inv x := by + apply Subtype.ext + change (puncturedNormalizationEquiv F).symm (puncturedNormalizationEquiv F x.1) = x.1 + exact (puncturedNormalizationEquiv F).symm_apply_apply x.1 + right_inv u := by + apply Subtype.ext + change ((puncturedNormalizationEquiv F) + ((puncturedNormalizationEquiv F).symm + ⟨u.1, ⟨u.2.1.1, u.2.2⟩⟩)).1 = u.1 + rw [(puncturedNormalizationEquiv F).apply_symm_apply] + +/-- Normalization transports the coordinate-zero count to original Markoff coordinates. -/ +theorem puncturedMarkoffFirstCoordinateZero_card_eq_of_quadraticChar_neg_one_eq_one + [Invertible (3 : F)] (hF : ringChar F ≠ 2) + (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(puncturedMarkoffFirstCoordinateZero F) = + 2 * Fintype.card F - 2 := by + rw [Nat.card_congr puncturedMarkoffFirstCoordinateZeroEquivNormalized] + exact normalizedPuncturedFiber1_zero_card_eq_of_quadraticChar_neg_one_eq_one hF hneg + +/-- The second-coordinate-zero locus has the same exact local count. -/ +theorem puncturedMarkoffSecondCoordinateZero_card_eq_of_quadraticChar_neg_one_eq_one + [Invertible (3 : F)] (hF : ringChar F ≠ 2) + (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(puncturedMarkoffSecondCoordinateZero F) = + 2 * Fintype.card F - 2 := by + rw [Nat.card_congr (puncturedMarkoffSecondCoordinateZeroEquivFirst F)] + exact puncturedMarkoffFirstCoordinateZero_card_eq_of_quadraticChar_neg_one_eq_one hF hneg + +/-- The third-coordinate-zero locus has the same exact local count. -/ +theorem puncturedMarkoffThirdCoordinateZero_card_eq_of_quadraticChar_neg_one_eq_one + [Invertible (3 : F)] (hF : ringChar F ≠ 2) + (hneg : quadraticChar F (-1) = 1) : + Nat.card ↑(puncturedMarkoffThirdCoordinateZero F) = + 2 * Fintype.card F - 2 := by + rw [Nat.card_congr (puncturedMarkoffThirdCoordinateZeroEquivFirst F)] + exact puncturedMarkoffFirstCoordinateZero_card_eq_of_quadraticChar_neg_one_eq_one hF hneg + +/-- Published equation (95) for the original-coordinate punctured Markoff surface. -/ +theorem puncturedMarkoffSurface_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card (PuncturedMarkoffSurface (ZMod p)) = p ^ 2 + 3 * p := by + have hp := (Fact.out : p.Prime) + have hpThree : 3 < p := by + by_contra h + have hpLe : p ≤ 3 := by omega + have hpTwo : 2 ≤ p := hp.two_le + have hpCases : p = 2 ∨ p = 3 := by omega + rcases hpCases with rfl | rfl <;> norm_num at hpModFour + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (by + intro hzero + have hdvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + exact (Nat.not_le_of_gt hpThree) (Nat.le_of_dvd (by norm_num) hdvd)) + rw [Nat.card_congr (puncturedNormalizationEquiv (ZMod p))] + exact normalizedPuncturedSurface_zmod_card_eq_of_mod_four_eq_one p hpModFour + +/-- The primewise-punctured carrier has the product cardinality asserted after published +equation (95). -/ +theorem primewisePuncturedMarkoffSurface_card_eq_of_mod_four_eq_one + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (hmod : ∀ i, a i % 4 = 1) : + Nat.card (PrimewisePuncturedMarkoffSurface a) = + ∏ i, (a i ^ 2 + 3 * a i) := by + rw [Nat.card_pi] + apply Finset.prod_congr rfl + intro i _ + exact puncturedMarkoffSurface_zmod_card_eq_of_mod_four_eq_one (a i) (hmod i) + +/-- The single-residue-ring CRT presentation has the same exact product cardinality. -/ +theorem crtPrimewisePuncturedMarkoffSurface_card_eq_of_mod_four_eq_one + {ι : Type*} [Fintype ι] (a : ι → ℕ) [∀ i, Fact (a i).Prime] + (coprime : Pairwise (Function.onFun Nat.Coprime a)) (hmod : ∀ i, a i % 4 = 1) : + Nat.card (CRTPrimewisePuncturedMarkoffSurface a coprime) = + ∏ i, (a i ^ 2 + 3 * a i) := by + rw [Nat.card_congr (primewisePuncturedCRTEquiv a coprime)] + exact primewisePuncturedMarkoffSurface_card_eq_of_mod_four_eq_one a hmod + +/-- Published equation (96) in original Markoff coordinates, for the first coordinate. -/ +theorem puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card ↑(puncturedMarkoffFirstCoordinateZero (ZMod p)) = 2 * p - 2 := by + have hp := (Fact.out : p.Prime) + have hpThree : 3 < p := by + by_contra h + have hpLe : p ≤ 3 := by omega + have hpTwo : 2 ≤ p := hp.two_le + have hpCases : p = 2 ∨ p = 3 := by omega + rcases hpCases with rfl | rfl <;> norm_num at hpModFour + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (by + intro hzero + have hdvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + exact (Nat.not_le_of_gt hpThree) (Nat.le_of_dvd (by norm_num) hdvd)) + have hpTwo : p ≠ 2 := by omega + have hchar : ringChar (ZMod p) ≠ 2 := (ZMod.ringChar_zmod_n p).substr hpTwo + have hneg : quadraticChar (ZMod p) (-1) = 1 := by + rw [quadraticChar_neg_one hchar, ZMod.χ₄_nat_eq_if_mod_four, ZMod.card p, hpModFour] + simp only [if_true] + have hpOdd : p % 2 = 1 := by omega + rw [hpOdd] + norm_num + simpa [ZMod.card p] using + puncturedMarkoffFirstCoordinateZero_card_eq_of_quadraticChar_neg_one_eq_one hchar hneg + +/-- Published equation (96) for the second original Markoff coordinate. -/ +theorem puncturedMarkoffSecondCoordinateZero_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card ↑(puncturedMarkoffSecondCoordinateZero (ZMod p)) = 2 * p - 2 := by + rw [Nat.card_congr (puncturedMarkoffSecondCoordinateZeroEquivFirst (ZMod p))] + exact puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one p hpModFour + +/-- Published equation (96) for the third original Markoff coordinate. -/ +theorem puncturedMarkoffThirdCoordinateZero_zmod_card_eq_of_mod_four_eq_one + (p : ℕ) [Fact p.Prime] (hpModFour : p % 4 = 1) : + Nat.card ↑(puncturedMarkoffThirdCoordinateZero (ZMod p)) = 2 * p - 2 := by + rw [Nat.card_congr (puncturedMarkoffThirdCoordinateZeroEquivFirst (ZMod p))] + exact puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one p hpModFour + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean new file mode 100644 index 0000000000..7458684064 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean @@ -0,0 +1,401 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +import Mathlib.Data.ZMod.QuotientRing + +/-! +# Primewise puncturing and the Chinese remainder theorem + +For a finite pairwise-coprime family of moduli, the Chinese remainder theorem identifies the +Markoff surface modulo their product with the product of the local Markoff surfaces. There are +two different punctures on these objects: + +* the naive puncture removes only the single global origin, and hence asks that *some* local + component be nonzero; +* the primewise puncture used in Section 7 of Bourgain--Gamburd--Sarnak asks that *every* local + component be nonzero. + +This file keeps those carriers distinct and proves that CRT and all five standard Markoff moves +respect the primewise carrier. No point-counting result is included here. +-/ + +namespace BGS.Markoff + +universe u v + +open scoped Function + +/-- Apply a ring homomorphism coordinatewise to an affine point. -/ +def Point.map {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : Point R) : Point S := + ⟨f x.x1, f x.x2, f x.x3⟩ + +@[simp] theorem Point.map_x1 {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : Point R) : (x.map f).x1 = f x.x1 := rfl + +@[simp] theorem Point.map_x2 {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : Point R) : (x.map f).x2 = f x.x2 := rfl + +@[simp] theorem Point.map_x3 {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : Point R) : (x.map f).x3 = f x.x3 := rfl + +@[simp] theorem Point.map_origin {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) : (origin : Point R).map f = origin := by + ext <;> simp [Point.map, origin] + +@[simp] theorem markoffPolynomial_map {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : Point R) : markoffPolynomial (x.map f) = f (markoffPolynomial x) := by + simp only [markoffPolynomial, Point.map, map_sub, map_add, map_mul, map_pow, map_ofNat] + +/-- A ring equivalence transports affine three-space coordinatewise. -/ +def pointRingEquiv {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (e : R ≃+* S) : Point R ≃ Point S where + toFun := Point.map e + invFun := Point.map e.symm + left_inv x := by ext <;> simp [Point.map] + right_inv x := by ext <;> simp [Point.map] + +/-- A ring equivalence transports the original Markoff surface. -/ +def markoffSurfaceRingEquiv {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (e : R ≃+* S) : MarkoffSurface R ≃ MarkoffSurface S where + toFun x := + ⟨Point.map e.toRingHom x.val, by + change markoffPolynomial (Point.map e.toRingHom x.val) = 0 + rw [markoffPolynomial_map, x.2, map_zero]⟩ + invFun x := + ⟨Point.map e.symm.toRingHom x.val, by + change markoffPolynomial (Point.map e.symm.toRingHom x.val) = 0 + rw [markoffPolynomial_map, x.2, map_zero]⟩ + left_inv x := by apply Subtype.ext; exact (pointRingEquiv e).left_inv x.1 + right_inv x := by apply Subtype.ext; exact (pointRingEquiv e).right_inv x.1 + +@[simp] theorem coe_markoffSurfaceRingEquiv {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (e : R ≃+* S) (x : MarkoffSurface R) : + ((markoffSurfaceRingEquiv e x : MarkoffSurface S) : Point S) = + Point.map e.toRingHom x.1 := rfl + +/-- A Markoff point over a product ring is the same thing as a family of local Markoff points. -/ +def markoffSurfacePiEquiv {ι : Type*} {R : ι → Type u} [∀ i, CommRing (R i)] : + MarkoffSurface (∀ i, R i) ≃ ∀ i, MarkoffSurface (R i) where + toFun x i := + ⟨⟨x.1.x1 i, x.1.x2 i, x.1.x3 i⟩, by + exact congrFun x.2 i⟩ + invFun x := + ⟨⟨fun i => (x i).1.x1, fun i => (x i).1.x2, fun i => (x i).1.x3⟩, by + funext i + exact (x i).2⟩ + left_inv x := by apply Subtype.ext; ext i <;> rfl + right_inv x := by funext i; apply Subtype.ext; rfl + +/-- CRT on the original Markoff surface, before imposing either notion of puncture. -/ +noncomputable def markoffSurfaceCRTEquiv {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + MarkoffSurface (ZMod (∏ i, a i)) ≃ ∀ i, MarkoffSurface (ZMod (a i)) := + (markoffSurfaceRingEquiv (ZMod.prodEquivPi a coprime)).trans markoffSurfacePiEquiv + +@[simp] theorem markoffSurfaceCRTEquiv_coordinate_one {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) (i : ι) : + ((markoffSurfaceCRTEquiv a coprime x i : MarkoffSurface (ZMod (a i))) : + Point (ZMod (a i))).x1 = + ZMod.castHom (Finset.dvd_prod_of_mem a (Finset.mem_univ i)) _ x.1.x1 := by + exact ZMod.prodEquivPi_apply a coprime x.1.x1 i + +@[simp] theorem markoffSurfaceCRTEquiv_coordinate_two {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) (i : ι) : + ((markoffSurfaceCRTEquiv a coprime x i : MarkoffSurface (ZMod (a i))) : + Point (ZMod (a i))).x2 = + ZMod.castHom (Finset.dvd_prod_of_mem a (Finset.mem_univ i)) _ x.1.x2 := by + exact ZMod.prodEquivPi_apply a coprime x.1.x2 i + +@[simp] theorem markoffSurfaceCRTEquiv_coordinate_three {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) (i : ι) : + ((markoffSurfaceCRTEquiv a coprime x i : MarkoffSurface (ZMod (a i))) : + Point (ZMod (a i))).x3 = + ZMod.castHom (Finset.dvd_prod_of_mem a (Finset.mem_univ i)) _ x.1.x3 := by + exact ZMod.prodEquivPi_apply a coprime x.1.x3 i + +@[simp] theorem markoffSurfaceCRTEquiv_origin {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) : + markoffSurfaceCRTEquiv a coprime (surfaceOrigin (ZMod (∏ i, a i))) = + fun i => surfaceOrigin (ZMod (a i)) := by + funext i + apply Subtype.ext + ext <;> simp [surfaceOrigin, origin] + +/-- A global point is naively punctured exactly when at least one CRT component is nonzero. -/ +theorem ne_surfaceOrigin_iff_exists_crt_ne_surfaceOrigin {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + x ≠ surfaceOrigin (ZMod (∏ i, a i)) ↔ + ∃ i, markoffSurfaceCRTEquiv a coprime x i ≠ surfaceOrigin (ZMod (a i)) := by + constructor + · contrapose! + intro h + apply (markoffSurfaceCRTEquiv a coprime).injective + rw [markoffSurfaceCRTEquiv_origin] + funext i + exact h i + · rintro ⟨i, hi⟩ rfl + exact hi (congrFun (markoffSurfaceCRTEquiv_origin a coprime) i) + +/-- The published Section 7 carrier: every local Markoff point is punctured. -/ +abbrev PrimewisePuncturedMarkoffSurface {ι : Type*} (a : ι → ℕ) := + ∀ i, PuncturedMarkoffSurface (ZMod (a i)) + +/-- The primewise-puncture predicate on the single CRT residue ring. -/ +def IsPrimewisePunctured {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : Prop := + ∀ i, markoffSurfaceCRTEquiv a coprime x i ≠ surfaceOrigin (ZMod (a i)) + +/-- Global residue-ring presentation of the primewise-punctured carrier. -/ +abbrev CRTPrimewisePuncturedMarkoffSurface {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) := + {x : MarkoffSurface (ZMod (∏ i, a i)) // IsPrimewisePunctured a coprime x} + +/-- CRT restricted to the primewise-punctured Markoff surface. -/ +noncomputable def primewisePuncturedCRTEquiv {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + CRTPrimewisePuncturedMarkoffSurface a coprime ≃ PrimewisePuncturedMarkoffSurface a where + toFun x i := ⟨markoffSurfaceCRTEquiv a coprime x.1 i, x.2 i⟩ + invFun x := + ⟨(markoffSurfaceCRTEquiv a coprime).symm (fun i => (x i).1), by + intro i hi + apply (x i).2 + have heq := + congrFun ((markoffSurfaceCRTEquiv a coprime).apply_symm_apply (fun j => (x j).1)) i + exact heq.symm.trans hi⟩ + left_inv x := by + apply Subtype.ext + exact (markoffSurfaceCRTEquiv a coprime).symm_apply_apply x.1 + right_inv x := by + funext i + apply Subtype.ext + exact congrFun ((markoffSurfaceCRTEquiv a coprime).apply_symm_apply (fun j => (x j).1)) i + +/-- Every primewise-punctured global point is naively punctured, provided there is a local +factor. The converse is false in general; see `exists_naivePunctured_not_primewisePunctured`. -/ +def primewisePuncturedToNaive {ι : Type*} [Fintype ι] [Nonempty ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + CRTPrimewisePuncturedMarkoffSurface a coprime → + PuncturedMarkoffSurface (ZMod (∏ i, a i)) := + fun x => + ⟨x.1, (ne_surfaceOrigin_iff_exists_crt_ne_surfaceOrigin a coprime x.1).2 + ⟨Classical.choice inferInstance, x.2 _⟩⟩ + +/-- The point `(1,1,1)` on the original Markoff surface. -/ +def unitMarkoffPoint (R : Type u) [CommRing R] : MarkoffSurface R := + ⟨⟨1, 1, 1⟩, by + simp only [IsMarkoff, markoffPolynomial] + ring⟩ + +theorem unitMarkoffPoint_ne_surfaceOrigin {R : Type u} [CommRing R] [Nontrivial R] : + unitMarkoffPoint R ≠ surfaceOrigin R := by + intro h + have := congrArg (fun x : MarkoffSurface R => x.1.x1) h + change (1 : R) = 0 at this + exact (one_ne_zero : (1 : R) ≠ 0) this + +/-- With two distinct factors and one nontrivial local ring, the naive puncture is strictly +larger than the primewise puncture. -/ +theorem exists_naivePunctured_not_primewisePunctured {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) {i j : ι} (hij : i ≠ j) + (hj : a j ≠ 1) : + ∃ x : PuncturedMarkoffSurface (ZMod (∏ k, a k)), + ¬ IsPrimewisePunctured a coprime x.1 := by + classical + haveI : Nontrivial (ZMod (a j)) := ZMod.nontrivial_iff.mpr hj + let localPoints : ∀ k, MarkoffSurface (ZMod (a k)) := + fun k => if k = i then surfaceOrigin (ZMod (a k)) else unitMarkoffPoint (ZMod (a k)) + let globalPoint := (markoffSurfaceCRTEquiv a coprime).symm localPoints + have hglobal : globalPoint ≠ surfaceOrigin (ZMod (∏ k, a k)) := by + apply (ne_surfaceOrigin_iff_exists_crt_ne_surfaceOrigin a coprime globalPoint).2 + refine ⟨j, ?_⟩ + rw [show markoffSurfaceCRTEquiv a coprime globalPoint j = localPoints j by + exact congrFun ((markoffSurfaceCRTEquiv a coprime).apply_symm_apply localPoints) j] + simp only [localPoints, if_neg hij.symm] + exact unitMarkoffPoint_ne_surfaceOrigin + refine ⟨⟨globalPoint, hglobal⟩, ?_⟩ + intro hprimewise + apply hprimewise i + rw [show markoffSurfaceCRTEquiv a coprime globalPoint i = localPoints i by + exact congrFun ((markoffSurfaceCRTEquiv a coprime).apply_symm_apply localPoints) i] + simp [localPoints] + +@[simp] theorem markoffSurfaceCRTEquiv_vieta1 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + markoffSurfaceCRTEquiv a coprime (vieta1SurfacePerm _ x) = + fun i => vieta1SurfacePerm _ (markoffSurfaceCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + have hdiv : a i ∣ ∏ k, a k := Finset.dvd_prod_of_mem a (Finset.mem_univ i) + have hthree : (ZMod.cast (3 : ZMod (∏ k, a k)) : ZMod (a i)) = 3 := + ZMod.cast_natCast hdiv 3 + ext <;> simp [vieta1, ZMod.cast_sub hdiv, ZMod.cast_mul hdiv, hthree] + +@[simp] theorem markoffSurfaceCRTEquiv_vieta2 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + markoffSurfaceCRTEquiv a coprime (vieta2SurfacePerm _ x) = + fun i => vieta2SurfacePerm _ (markoffSurfaceCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + have hdiv : a i ∣ ∏ k, a k := Finset.dvd_prod_of_mem a (Finset.mem_univ i) + have hthree : (ZMod.cast (3 : ZMod (∏ k, a k)) : ZMod (a i)) = 3 := + ZMod.cast_natCast hdiv 3 + ext <;> simp [vieta2, ZMod.cast_sub hdiv, ZMod.cast_mul hdiv, hthree] + +@[simp] theorem markoffSurfaceCRTEquiv_vieta3 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + markoffSurfaceCRTEquiv a coprime (vieta3SurfacePerm _ x) = + fun i => vieta3SurfacePerm _ (markoffSurfaceCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + have hdiv : a i ∣ ∏ k, a k := Finset.dvd_prod_of_mem a (Finset.mem_univ i) + have hthree : (ZMod.cast (3 : ZMod (∏ k, a k)) : ZMod (a i)) = 3 := + ZMod.cast_natCast hdiv 3 + ext <;> simp [vieta3, ZMod.cast_sub hdiv, ZMod.cast_mul hdiv, hthree] + +@[simp] theorem markoffSurfaceCRTEquiv_swap12 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + markoffSurfaceCRTEquiv a coprime (swap12SurfacePerm _ x) = + fun i => swap12SurfacePerm _ (markoffSurfaceCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + ext <;> simp [swap12] + +@[simp] theorem markoffSurfaceCRTEquiv_swap23 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + markoffSurfaceCRTEquiv a coprime (swap23SurfacePerm _ x) = + fun i => swap23SurfacePerm _ (markoffSurfaceCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + ext <;> simp [swap23] + +@[simp] theorem isPrimewisePunctured_vieta1_iff {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + IsPrimewisePunctured a coprime (vieta1SurfacePerm _ x) ↔ + IsPrimewisePunctured a coprime x := by + simp only [IsPrimewisePunctured, markoffSurfaceCRTEquiv_vieta1, + vieta1SurfacePerm_ne_origin_iff] + +@[simp] theorem isPrimewisePunctured_vieta2_iff {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + IsPrimewisePunctured a coprime (vieta2SurfacePerm _ x) ↔ + IsPrimewisePunctured a coprime x := by + simp only [IsPrimewisePunctured, markoffSurfaceCRTEquiv_vieta2, + vieta2SurfacePerm_ne_origin_iff] + +@[simp] theorem isPrimewisePunctured_vieta3_iff {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + IsPrimewisePunctured a coprime (vieta3SurfacePerm _ x) ↔ + IsPrimewisePunctured a coprime x := by + simp only [IsPrimewisePunctured, markoffSurfaceCRTEquiv_vieta3, + vieta3SurfacePerm_ne_origin_iff] + +@[simp] theorem isPrimewisePunctured_swap12_iff {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + IsPrimewisePunctured a coprime (swap12SurfacePerm _ x) ↔ + IsPrimewisePunctured a coprime x := by + simp only [IsPrimewisePunctured, markoffSurfaceCRTEquiv_swap12, + swap12SurfacePerm_ne_origin_iff] + +@[simp] theorem isPrimewisePunctured_swap23_iff {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : MarkoffSurface (ZMod (∏ i, a i))) : + IsPrimewisePunctured a coprime (swap23SurfacePerm _ x) ↔ + IsPrimewisePunctured a coprime x := by + simp only [IsPrimewisePunctured, markoffSurfaceCRTEquiv_swap23, + swap23SurfacePerm_ne_origin_iff] + +/-- The first global Vieta move restricted to the primewise-punctured CRT carrier. -/ +noncomputable def vieta1CRTPrimewisePerm {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + Equiv.Perm (CRTPrimewisePuncturedMarkoffSurface a coprime) := + (vieta1SurfacePerm _).subtypeEquiv fun x => (isPrimewisePunctured_vieta1_iff a coprime x).symm + +/-- The second global Vieta move restricted to the primewise-punctured CRT carrier. -/ +noncomputable def vieta2CRTPrimewisePerm {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + Equiv.Perm (CRTPrimewisePuncturedMarkoffSurface a coprime) := + (vieta2SurfacePerm _).subtypeEquiv fun x => (isPrimewisePunctured_vieta2_iff a coprime x).symm + +/-- The third global Vieta move restricted to the primewise-punctured CRT carrier. -/ +noncomputable def vieta3CRTPrimewisePerm {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + Equiv.Perm (CRTPrimewisePuncturedMarkoffSurface a coprime) := + (vieta3SurfacePerm _).subtypeEquiv fun x => (isPrimewisePunctured_vieta3_iff a coprime x).symm + +/-- The first coordinate swap restricted to the primewise-punctured CRT carrier. -/ +noncomputable def swap12CRTPrimewisePerm {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + Equiv.Perm (CRTPrimewisePuncturedMarkoffSurface a coprime) := + (swap12SurfacePerm _).subtypeEquiv fun x => (isPrimewisePunctured_swap12_iff a coprime x).symm + +/-- The second coordinate swap restricted to the primewise-punctured CRT carrier. -/ +noncomputable def swap23CRTPrimewisePerm {ι : Type*} [Fintype ι] (a : ι → ℕ) + (coprime : Pairwise (Nat.Coprime on a)) : + Equiv.Perm (CRTPrimewisePuncturedMarkoffSurface a coprime) := + (swap23SurfacePerm _).subtypeEquiv fun x => (isPrimewisePunctured_swap23_iff a coprime x).symm + +@[simp] theorem primewisePuncturedCRTEquiv_vieta1 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : CRTPrimewisePuncturedMarkoffSurface a coprime) : + primewisePuncturedCRTEquiv a coprime (vieta1CRTPrimewisePerm a coprime x) = + fun i => vieta1PuncturedPerm _ (primewisePuncturedCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + exact congrFun (markoffSurfaceCRTEquiv_vieta1 a coprime x.1) i + +@[simp] theorem primewisePuncturedCRTEquiv_vieta2 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : CRTPrimewisePuncturedMarkoffSurface a coprime) : + primewisePuncturedCRTEquiv a coprime (vieta2CRTPrimewisePerm a coprime x) = + fun i => vieta2PuncturedPerm _ (primewisePuncturedCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + exact congrFun (markoffSurfaceCRTEquiv_vieta2 a coprime x.1) i + +@[simp] theorem primewisePuncturedCRTEquiv_vieta3 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : CRTPrimewisePuncturedMarkoffSurface a coprime) : + primewisePuncturedCRTEquiv a coprime (vieta3CRTPrimewisePerm a coprime x) = + fun i => vieta3PuncturedPerm _ (primewisePuncturedCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + exact congrFun (markoffSurfaceCRTEquiv_vieta3 a coprime x.1) i + +@[simp] theorem primewisePuncturedCRTEquiv_swap12 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : CRTPrimewisePuncturedMarkoffSurface a coprime) : + primewisePuncturedCRTEquiv a coprime (swap12CRTPrimewisePerm a coprime x) = + fun i => swap12PuncturedPerm _ (primewisePuncturedCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + exact congrFun (markoffSurfaceCRTEquiv_swap12 a coprime x.1) i + +@[simp] theorem primewisePuncturedCRTEquiv_swap23 {ι : Type*} [Fintype ι] + (a : ι → ℕ) (coprime : Pairwise (Nat.Coprime on a)) + (x : CRTPrimewisePuncturedMarkoffSurface a coprime) : + primewisePuncturedCRTEquiv a coprime (swap23CRTPrimewisePerm a coprime x) = + fun i => swap23PuncturedPerm _ (primewisePuncturedCRTEquiv a coprime x i) := by + funext i + apply Subtype.ext + exact congrFun (markoffSurfaceCRTEquiv_swap23 a coprime x.1) i + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean new file mode 100644 index 0000000000..7adc5dc3e2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean @@ -0,0 +1,15 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean new file mode 100644 index 0000000000..ea55378452 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean @@ -0,0 +1,110 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit + +/-! +# Large order in any coordinate reaches a maximal rotation + +This packages the first-coordinate endgame with the normalized coordinate permutations and the +Markoff-component relation. +-/ + +namespace BGS.Markoff + +noncomputable section + +private theorem three_ne_zero_zmod_of_prime_ne_three + (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero + rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq + · exact (Fact.out : p.Prime).ne_one hpOne + · exact hpThree hpEq + +/-- A large first-coordinate rotation reaches a same-component point with maximal second +rotation. -/ +theorem exists_threshold_sameComponent_maximalRotation_of_large_firstCoordinate + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + ∀ x : NormalizedMarkoffSurface (ZMod p), + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u1 → + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ rotationOrder y.1.u2 = p - 1 := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_point_with_maximal_secondRotation + splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ + refine ⟨max threshold 5, ?_⟩ + intro p hp _ hpThree + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + intro x hlarge + have hpThreshold : threshold ≤ p := (le_max_left threshold 5).trans hp + let xf : ↥(normalizedFiber1 x.1.u1) := ⟨x.1, x.property, rfl⟩ + obtain ⟨n, hrotation⟩ := hthreshold p hpThreshold x.1.u1 xf hlarge + let y := (normalizedRotate1Surface^[n]) x + refine ⟨y, sameNormalizedComponent_iterate_normalizedRotate1Surface x n, ?_⟩ + rw [show y.1 = (normalizedRotate1^[n]) x.1 by + exact coe_iterate_normalizedRotate1Surface x n] + exact hrotation + +/-- Published Proposition 10: if any coordinate rotation is large, the point is connected to +a point with a maximal split rotation. -/ +theorem exists_threshold_sameComponent_maximalRotation_of_some_largeCoordinate + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + ∀ x : NormalizedMarkoffSurface (ZMod p), + ((p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u3) → + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ rotationOrder y.1.u2 = p - 1 := by + obtain ⟨threshold, hfirst⟩ := + exists_threshold_sameComponent_maximalRotation_of_large_firstCoordinate + splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ + refine ⟨threshold, ?_⟩ + intro p hp _ hpThree + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + intro x hlarge + rcases hlarge with hfirstLarge | hsecondLarge | hthirdLarge + · exact hfirst p hp hpThree x hfirstLarge + · let x' := normalizedSwap12Surface x + have hx' : SameNormalizedComponent x x' := sameNormalizedComponent_swap12Surface x + have hlarge' : + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, coe_normalizedSwap12Surface] using hsecondLarge + obtain ⟨y, hy, hyOrder⟩ := hfirst p hp hpThree x' hlarge' + exact ⟨y, sameNormalizedComponent_trans hx' hy, hyOrder⟩ + · let x' := normalizedSwap12Surface (normalizedSwap23Surface x) + have hx23 : SameNormalizedComponent x (normalizedSwap23Surface x) := + sameNormalizedComponent_swap23Surface x + have hx12 : SameNormalizedComponent (normalizedSwap23Surface x) x' := + sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x) + have hlarge' : + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, normalizedSwap23, coe_normalizedSwap12Surface, + coe_normalizedSwap23Surface] using hthirdLarge + obtain ⟨y, hy, hyOrder⟩ := hfirst p hp hpThree x' hlarge' + exact ⟨y, sameNormalizedComponent_trans + (sameNormalizedComponent_trans hx23 hx12) hy, hyOrder⟩ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean new file mode 100644 index 0000000000..eaff540f44 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean new file mode 100644 index 0000000000..fee67b6147 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean @@ -0,0 +1,299 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic + +/-! +# Cayley coordinates on the nonsplit norm-one torus + +This file gives the rational coordinate needed to descend the nonsplit end-game cover from the +quadratic finite field to `ZMod p`. A point `delta` outside the base field identifies the affine +line with the norm-one torus minus its identity by + +`z |-> (z - delta ^ p) / (z - delta)`. + +The inverse is `(w * delta - delta ^ p) / (w - 1)`. The proof records the Frobenius identities +explicitly; these are the identities used when the pulled-back trace equation is cleared of +denominators over the base field. +-/ + +namespace BGS.Markoff + +section + +variable (p : ℕ) [Fact p.Prime] + +private abbrev F := ZMod p +private abbrev E := quadraticFiniteField p + +noncomputable local instance : Fintype (E p) := Fintype.ofFinite (E p) +noncomputable local instance : Fintype {w : quadraticNormOneTorus p // w ≠ 1} := + Fintype.ofFinite _ + +private theorem quadraticExtension_finrank : Module.finrank (F p) (E p) = 2 := by + simpa [F, E] using GaloisField.finrank p (n := 2) + +private theorem exists_quadraticNonbaseElement : + ∃ delta : E p, delta ∉ Set.range (algebraMap (F p) (E p)) := by + classical + have hnotSurjective : ¬ Function.Surjective (algebraMap (F p) (E p)) := by + intro hsurjective + have hbijective : Function.Bijective (algebraMap (F p) (E p)) := + ⟨(algebraMap (F p) (E p)).injective, hsurjective⟩ + have hone : Module.finrank (F p) (E p) = 1 := + Algebra.finrank_eq_one_iff_bijective_algebraMap.mpr hbijective + rw [quadraticExtension_finrank p] at hone + omega + change ¬ ∀ y, ∃ x, algebraMap (F p) (E p) x = y at hnotSurjective + exact Classical.not_forall.mp hnotSurjective + +/-- A chosen element of the quadratic finite field which is not defined over the base field. -/ +noncomputable def quadraticNonbaseElement : E p := + Classical.choose (exists_quadraticNonbaseElement p) + +theorem quadraticNonbaseElement_not_mem_range : + quadraticNonbaseElement p ∉ Set.range (algebraMap (F p) (E p)) := by + classical + exact Classical.choose_spec (exists_quadraticNonbaseElement p) + +private theorem quadraticExtension_card : Fintype.card (E p) = p ^ 2 := by + rw [Module.card_eq_pow_finrank (K := F p), quadraticExtension_finrank p, ZMod.card] + +theorem quadraticNonbaseElement_frobenius_ne_self : + quadraticNonbaseElement p ^ p ≠ quadraticNonbaseElement p := by + intro hfixed + apply quadraticNonbaseElement_not_mem_range p + have hmem : quadraticNonbaseElement p ∈ (⊥ : Subfield (E p)) := + (Subfield.mem_bot_iff_pow_eq_self (F := E p) (p := p)).mpr hfixed + rw [mem_bot_iff_intCast p (E p)] at hmem + rcases hmem with ⟨n, hn⟩ + refine ⟨(n : F p), ?_⟩ + simpa using hn + +theorem quadraticNonbaseElement_frobenius_not_mem_range : + quadraticNonbaseElement p ^ p ∉ Set.range (algebraMap (F p) (E p)) := by + intro hmem + rcases hmem with ⟨z, hz⟩ + apply quadraticNonbaseElement_frobenius_ne_self p + calc + quadraticNonbaseElement p ^ p + = algebraMap (F p) (E p) z := hz.symm + _ = (algebraMap (F p) (E p) z) ^ p := by + symm + calc + (algebraMap (F p) (E p) z) ^ p = + algebraMap (F p) (E p) (z ^ p) := (map_pow _ z p).symm + _ = algebraMap (F p) (E p) z := by rw [ZMod.pow_card] + _ = (quadraticNonbaseElement p ^ p) ^ p := by rw [← hz] + _ = quadraticNonbaseElement p := by + rw [← pow_mul, ← pow_two, ← quadraticExtension_card p] + exact FiniteField.pow_card _ + +private theorem algebraMap_sub_nonzero (z : F p) : + algebraMap (F p) (E p) z - quadraticNonbaseElement p ≠ 0 := by + rw [sub_ne_zero] + exact fun h => quadraticNonbaseElement_not_mem_range p ⟨z, h⟩ + +private theorem algebraMap_sub_frobenius_nonzero (z : F p) : + algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p ≠ 0 := by + rw [sub_ne_zero] + exact fun h => quadraticNonbaseElement_frobenius_not_mem_range p ⟨z, h⟩ + +/-- The Cayley fraction before it is packaged as a norm-one unit. -/ +noncomputable def quadraticCayleyValue (z : F p) : E p := + (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) / + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) + +theorem quadraticCayleyValue_ne_zero (z : F p) : quadraticCayleyValue p z ≠ 0 := by + exact div_ne_zero (algebraMap_sub_frobenius_nonzero p z) (algebraMap_sub_nonzero p z) + +theorem quadraticNonbaseElement_frobenius_frobenius : + (quadraticNonbaseElement p ^ p) ^ p = quadraticNonbaseElement p := by + rw [← pow_mul, ← pow_two, ← quadraticExtension_card p] + exact FiniteField.pow_card _ + +theorem quadraticCayleyValue_frobenius (z : F p) : + quadraticCayleyValue p z ^ p = (quadraticCayleyValue p z)⁻¹ := by + rw [quadraticCayleyValue, div_pow, sub_pow_char (R := E p), sub_pow_char (R := E p), + ← map_pow, ZMod.pow_card, quadraticNonbaseElement_frobenius_frobenius p] + rw [inv_div] + +/-- Frobenius exchanges the two linear factors occurring in the Cayley coordinate. -/ +theorem quadraticCayleyBaseFactor_frobenius (z : F p) : + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ p = + algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p := by + rw [sub_pow_char (R := E p)] + calc + algebraMap (F p) (E p) z ^ p - quadraticNonbaseElement p ^ p = + algebraMap (F p) (E p) (z ^ p) - quadraticNonbaseElement p ^ p := by + rw [map_pow] + _ = algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p := by + rw [ZMod.pow_card] + +/-- Applying Frobenius again returns the other Cayley linear factor. -/ +theorem quadraticCayleyConjugateFactor_frobenius (z : F p) : + (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ p = + algebraMap (F p) (E p) z - quadraticNonbaseElement p := by + rw [sub_pow_char (R := E p)] + calc + algebraMap (F p) (E p) z ^ p - (quadraticNonbaseElement p ^ p) ^ p = + algebraMap (F p) (E p) (z ^ p) - quadraticNonbaseElement p := by + rw [map_pow, quadraticNonbaseElement_frobenius_frobenius p] + _ = algebraMap (F p) (E p) z - quadraticNonbaseElement p := by + rw [ZMod.pow_card] + +/-- The product of the conjugate Cayley factors is Frobenius-fixed, hence is a base-field +coefficient in the descended equation. -/ +theorem quadraticCayleyFactorProduct_frobenius (z : F p) : + ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ p = + (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) := by + rw [mul_pow, quadraticCayleyConjugateFactor_frobenius p, + quadraticCayleyBaseFactor_frobenius p, mul_comm] + +private theorem div_pow_add_inv_pow (A B : E p) (hA : A ≠ 0) (hB : B ≠ 0) (d : ℕ) : + (A / B) ^ d + ((A / B) ^ d)⁻¹ = + (A ^ (2 * d) + B ^ (2 * d)) / ((A * B) ^ d) := by + rw [Nat.mul_comm 2 d, pow_mul, pow_mul, div_pow, inv_div, mul_pow] + field_simp [pow_ne_zero d hA, pow_ne_zero d hB] + +/-- Clearing the Cayley denominator gives the symmetric numerator used for powers of a +norm-one parameter. -/ +theorem quadraticCayleyValue_pow_add_inv_pow (z : F p) (d : ℕ) : + quadraticCayleyValue p z ^ d + (quadraticCayleyValue p z ^ d)⁻¹ = + ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ (2 * d)) / + (((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ d) := by + exact div_pow_add_inv_pow p _ _ (algebraMap_sub_frobenius_nonzero p z) + (algebraMap_sub_nonzero p z) d + +theorem quadraticCayleyValue_ne_one (z : F p) : quadraticCayleyValue p z ≠ 1 := by + intro hone + have hnumerator : + algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p = + algebraMap (F p) (E p) z - quadraticNonbaseElement p := by + exact (div_eq_one_iff_eq (algebraMap_sub_nonzero p z)).mp hone + exact quadraticNonbaseElement_frobenius_ne_self p (sub_right_inj.mp hnumerator) + +/-- The Cayley coordinate as a unit of the quadratic finite field. -/ +noncomputable def quadraticCayleyUnit (z : F p) : (E p)ˣ := + Units.mk0 (quadraticCayleyValue p z) (quadraticCayleyValue_ne_zero p z) + +theorem quadraticCayleyUnit_norm (z : F p) : + Algebra.norm (F p) (quadraticCayleyUnit p z : E p) = 1 := by + apply (algebraMap (F p) (E p)).injective + rw [map_one, algebraMap_quadraticNorm p] + change quadraticCayleyValue p z * quadraticCayleyValue p z ^ p = 1 + rw [quadraticCayleyValue_frobenius p] + exact mul_inv_cancel₀ (quadraticCayleyValue_ne_zero p z) + +/-- The Cayley coordinate, regarded as a point of the norm-one torus. -/ +noncomputable def quadraticCayleyPoint (z : F p) : quadraticNormOneTorus p := + ⟨quadraticCayleyUnit p z, by + change Units.map (Algebra.norm (F p) (S := E p)) (quadraticCayleyUnit p z) = 1 + apply Units.ext + exact quadraticCayleyUnit_norm p z⟩ + +theorem quadraticCayleyPoint_ne_one (z : F p) : quadraticCayleyPoint p z ≠ 1 := by + intro h + have hval := congrArg (fun w : quadraticNormOneTorus p => + (((w : (E p)ˣ) : E p))) h + exact quadraticCayleyValue_ne_one p z (by simpa [quadraticCayleyPoint, quadraticCayleyUnit] using hval) + +/-- The base-field trace of a powered Cayley point is the cleared symmetric Cayley fraction. -/ +theorem algebraMap_quadraticNormOneTrace_quadraticCayleyPoint_pow + (z : F p) (d : ℕ) : + algebraMap (F p) (E p) (quadraticNormOneTrace p (quadraticCayleyPoint p z ^ d)) = + ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ (2 * d)) / + (((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ d) := by + rw [algebraMap_quadraticNormOneTrace] + simpa [splitTorusTrace, quadraticCayleyPoint, quadraticCayleyUnit] using + quadraticCayleyValue_pow_add_inv_pow p z d + +/-- Solving the Cayley fraction for its base-field coordinate gives the expected inverse +fraction. -/ +theorem quadraticCayleyInverseFormula_point (z : F p) : + ((quadraticCayleyValue p z * quadraticNonbaseElement p - + quadraticNonbaseElement p ^ p) / + (quadraticCayleyValue p z - 1)) = algebraMap (F p) (E p) z := by + have hdelta : quadraticNonbaseElement p - quadraticNonbaseElement p ^ p ≠ 0 := + sub_ne_zero.mpr (quadraticNonbaseElement_frobenius_ne_self p).symm + rw [quadraticCayleyValue] + field_simp [algebraMap_sub_nonzero p z, algebraMap_sub_frobenius_nonzero p z, + quadraticNonbaseElement_frobenius_ne_self p, hdelta] + ring + +private theorem quadraticCayleyPoint_injective : + Function.Injective (fun z : F p => + (⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ : + {w : quadraticNormOneTorus p // w ≠ 1})) := by + intro z r h + have hvalue : quadraticCayleyValue p z = quadraticCayleyValue p r := by + have htorus := congrArg Subtype.val h + have hunit := congrArg (fun w : quadraticNormOneTorus p => (w : (E p)ˣ)) htorus + exact congrArg Units.val hunit + apply (algebraMap (F p) (E p)).injective + rw [← quadraticCayleyInverseFormula_point p z, + ← quadraticCayleyInverseFormula_point p r, hvalue] + +private theorem quadraticCayleyTarget_card : + Fintype.card {w : quadraticNormOneTorus p // w ≠ 1} = p := by + classical + rw [Fintype.card_subtype_compl (fun w : quadraticNormOneTorus p => w = 1)] + rw [Fintype.card_subtype_eq] + rw [Fintype.card_eq_nat_card, quadraticNormOneTorus_natCard p] + omega + +private theorem quadraticCayleyPoint_bijective : + Function.Bijective (fun z : F p => + (⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ : + {w : quadraticNormOneTorus p // w ≠ 1})) := by + rw [Fintype.bijective_iff_injective_and_card] + exact ⟨quadraticCayleyPoint_injective p, by + rw [ZMod.card, quadraticCayleyTarget_card p]⟩ + +/-- Cayley coordinates identify the affine line with the norm-one torus minus its identity. -/ +noncomputable def quadraticCayleyParameterEquiv : + F p ≃ {w : quadraticNormOneTorus p // w ≠ 1} := + Equiv.ofBijective (fun z => + (⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ : + {w : quadraticNormOneTorus p // w ≠ 1})) + (quadraticCayleyPoint_bijective p) + +@[simp] +theorem quadraticCayleyParameterEquiv_apply (z : F p) : + quadraticCayleyParameterEquiv p z = + ⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ := rfl + +/-- The inverse coordinate has the explicit fraction used in the descent calculation. -/ +theorem algebraMap_quadraticCayleyParameterEquiv_symm + (w : {w : quadraticNormOneTorus p // w ≠ 1}) : + algebraMap (F p) (E p) ((quadraticCayleyParameterEquiv p).symm w) = + (((w.1 : (E p)ˣ) : E p) * quadraticNonbaseElement p - + quadraticNonbaseElement p ^ p) / + (((w.1 : (E p)ˣ) : E p) - 1) := by + have happly := (quadraticCayleyParameterEquiv p).apply_symm_apply w + have hvalue : + quadraticCayleyValue p ((quadraticCayleyParameterEquiv p).symm w) = + ((w.1 : (E p)ˣ) : E p) := by + have htorus := congrArg Subtype.val happly + change quadraticCayleyPoint p ((quadraticCayleyParameterEquiv p).symm w) = w.1 at htorus + have hunit := congrArg Subtype.val htorus + change quadraticCayleyUnit p ((quadraticCayleyParameterEquiv p).symm w) = + (w.1 : (E p)ˣ) at hunit + have h := congrArg Units.val hunit + exact h + rw [← quadraticCayleyInverseFormula_point p] + rw [hvalue] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean new file mode 100644 index 0000000000..1e5562767b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean @@ -0,0 +1,450 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution + +/-! +# Absolute irreducibility of the descended nonsplit trace curve + +The descended coordinates are `(z, u)`, whereas the split cover uses `(u, w)`. We therefore +keep `u` as the outer polynomial variable and treat the Cayley change `w = (z-δ^p)/(z-δ)` as +an automorphism of the rational function coefficient field. +-/ + +namespace BGS.Markoff + +noncomputable section + +open Polynomial + +/-- View a bivariate polynomial as a polynomial in coordinate `1`, with coefficients in +coordinate `0`. This is the coordinate order needed after the descended curve's `(z,u)` +coordinates are compared with the split cover's `(u,w)` coordinates. -/ +def finTwoSecondToIteratedPolynomial {K : Type*} [Field K] : + MvPolynomial (Fin 2) K ≃+* Polynomial K[X] := + (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1)).toRingEquiv.trans + (finTwoToIteratedPolynomial (K := K)) + +@[simp] +theorem finTwoSecondToIteratedPolynomial_X_zero + {K : Type*} [Field K] : + finTwoSecondToIteratedPolynomial (K := K) (MvPolynomial.X 0) = C X := by + simp [finTwoSecondToIteratedPolynomial, MvPolynomial.renameEquiv_apply] + +@[simp] +theorem finTwoSecondToIteratedPolynomial_X_one + {K : Type*} [Field K] : + finTwoSecondToIteratedPolynomial (K := K) (MvPolynomial.X 1) = X := by + simp [finTwoSecondToIteratedPolynomial, MvPolynomial.renameEquiv_apply] + +@[simp] +theorem finTwoSecondToIteratedPolynomial_C + {K : Type*} [Field K] (r : K) : + finTwoSecondToIteratedPolynomial (K := K) (MvPolynomial.C r) = C (C r) := by + simp [finTwoSecondToIteratedPolynomial, MvPolynomial.renameEquiv_apply] + +/-- The descended coordinate-order equivalence commutes with scalar extension. -/ +theorem finTwoSecondToIteratedPolynomial_map + {K L : Type*} [Field K] [Field L] (phi : K →+* L) + (P : MvPolynomial (Fin 2) K) : + finTwoSecondToIteratedPolynomial (K := L) (MvPolynomial.map phi P) = + (finTwoSecondToIteratedPolynomial (K := K) P).map + (Polynomial.mapRingHom phi) := by + let lhs : MvPolynomial (Fin 2) K →+* L[X][X] := + (finTwoSecondToIteratedPolynomial (K := L)).toRingHom.comp + (MvPolynomial.map phi) + let rhs : MvPolynomial (Fin 2) K →+* L[X][X] := + (Polynomial.mapRingHom (Polynomial.mapRingHom phi)).comp + (finTwoSecondToIteratedPolynomial (K := K)).toRingHom + have heq : lhs = rhs := by + apply MvPolynomial.ringHom_ext + · intro r + simp [lhs, rhs, RingHom.comp_apply] + · intro i + fin_cases i <;> simp [lhs, rhs, RingHom.comp_apply] + exact DFunLike.congr_fun heq P + +theorem finTwoSecondToIteratedPolynomial_splitTraceCoverPolynomial + {K : Type*} [Field K] (alpha beta : K) (e d : ℕ) : + finTwoSecondToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d) = + C (C alpha * X ^ e) * X ^ (2 * d) + C (C beta * X ^ e) - + C (X ^ (2 * e) + 1) * X ^ d := by + simp [splitTraceCoverPolynomial] + ring + +theorem finTwoToIteratedPolynomial_splitTraceCoverPolynomial_general + {K : Type*} [Field K] (alpha beta : K) (e d : ℕ) : + finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d) = + monomial (2 * e) (-(X ^ d)) + + monomial e (C alpha * X ^ (2 * d) + C beta) + C (-(X ^ d)) := by + simp [splitTraceCoverPolynomial, ← C_mul_X_pow_eq_monomial] + ring + +theorem finTwoToIteratedPolynomial_splitTraceCoverPolynomial_general_natDegree + {K : Type*} [Field K] (alpha beta : K) (e d : ℕ) (he : 0 < e) : + (finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d)).natDegree = 2 * e := by + rw [finTwoToIteratedPolynomial_splitTraceCoverPolynomial_general] + have htwoNe : 2 * e ≠ e := by omega + have heTwoNe : e ≠ 2 * e := by omega + have heNe : e ≠ 0 := by omega + have htwoZero : 2 * e ≠ 0 := by omega + have hcoeff : + (monomial (2 * e) (-(X ^ d)) + + monomial e (C alpha * X ^ (2 * d) + C beta) + C (-(X ^ d))).coeff + (2 * e) = -(X ^ d) := by + rw [coeff_add, coeff_add, coeff_monomial, if_pos rfl, + coeff_monomial, if_neg heTwoNe, coeff_C_ne_zero htwoZero] + simp + have hnonzero : -(X ^ d : Polynomial K) ≠ 0 := neg_ne_zero.mpr (pow_ne_zero d X_ne_zero) + apply le_antisymm + · refine (natDegree_add_le _ _).trans (max_le ?_ ?_) + · refine (natDegree_add_le _ _).trans (max_le ?_ ?_) + · exact natDegree_monomial_le _ + · exact (natDegree_monomial_le _).trans (by omega) + · simp + · exact le_natDegree_of_ne_zero (by rwa [hcoeff]) + +theorem descendedIteratedPolynomial_isPrimitive_of_isCoprime + {K : Type*} [Field K] (Q N : Polynomial K) (e : ℕ) (he : 0 < e) + (hcoprime : IsCoprime Q N) : + (monomial (2 * e) (-Q) + monomial e N + C (-Q)).IsPrimitive := by + rw [isPrimitive_iff_isUnit_of_C_dvd] + intro g hg + have hall := (C_dvd_iff_dvd_coeff g _).mp hg + have heNe : e ≠ 0 := he.ne' + have htwoNe : 2 * e ≠ e := by omega + have hcoeffZero : + (monomial (2 * e) (-Q) + monomial e N + C (-Q)).coeff 0 = -Q := by + simp [coeff_add, coeff_monomial, heNe] + have hcoeffE : + (monomial (2 * e) (-Q) + monomial e N + C (-Q)).coeff e = N := by + rw [coeff_add, coeff_add, coeff_monomial, if_neg htwoNe, + coeff_monomial, if_pos rfl, coeff_C_ne_zero heNe] + simp + have hgQ : g ∣ Q := by + have : g ∣ -Q := hcoeffZero ▸ hall 0 + simpa using this.neg_right + have hgN : g ∣ N := hcoeffE ▸ hall e + exact hcoprime.isUnit_of_dvd' hgQ hgN + +section DescendedFormula + +variable (p : ℕ) [Fact p.Prime] + +private abbrev F := ZMod p +private abbrev E := quadraticFiniteField p + +def extendedCayleyNumeratorFactor : Polynomial (E p) := + X - C (quadraticNonbaseElement p ^ p) + +def extendedCayleyDenominatorFactor : Polynomial (E p) := + X - C (quadraticNonbaseElement p) + +def extendedSeededCayleyNumerator (s : (E p)ˣ) (d : ℕ) : Polynomial (E p) := + C (s : E p) * extendedCayleyNumeratorFactor p ^ (2 * d) + + C ((s : E p) ^ p) * extendedCayleyDenominatorFactor p ^ (2 * d) + +def extendedCayleyNormFactor : Polynomial (E p) := + extendedCayleyNumeratorFactor p * extendedCayleyDenominatorFactor p + +theorem extendedCayleyNormFactor_isCoprime_extendedSeededCayleyNumerator + (s : (E p)ˣ) (d : ℕ) (hd : 0 < d) : + IsCoprime (extendedCayleyNormFactor p) + (extendedSeededCayleyNumerator p s d) := by + have hnonbase : quadraticNonbaseElement p ^ p ≠ quadraticNonbaseElement p := + quadraticNonbaseElement_frobenius_ne_self p + have hleftDifference : + quadraticNonbaseElement p ^ p - quadraticNonbaseElement p ≠ 0 := + sub_ne_zero.mpr hnonbase + have hrightDifference : + quadraticNonbaseElement p - quadraticNonbaseElement p ^ p ≠ 0 := + sub_ne_zero.mpr hnonbase.symm + have hleftEval : + (extendedSeededCayleyNumerator p s d).eval + (quadraticNonbaseElement p ^ p) ≠ 0 := by + simp [extendedSeededCayleyNumerator, extendedCayleyNumeratorFactor, + extendedCayleyDenominatorFactor, hleftDifference, + show 2 * d ≠ 0 by omega] + have hrightEval : + (extendedSeededCayleyNumerator p s d).eval + (quadraticNonbaseElement p) ≠ 0 := by + simp [extendedSeededCayleyNumerator, extendedCayleyNumeratorFactor, + extendedCayleyDenominatorFactor, hrightDifference, + show 2 * d ≠ 0 by omega] + have hleft : IsCoprime (extendedCayleyNumeratorFactor p) + (extendedSeededCayleyNumerator p s d) := by + apply (irreducible_X_sub_C (quadraticNonbaseElement p ^ p)).coprime_iff_not_dvd.mpr + rw [dvd_iff_isRoot, IsRoot] + exact hleftEval + have hright : IsCoprime (extendedCayleyDenominatorFactor p) + (extendedSeededCayleyNumerator p s d) := by + apply (irreducible_X_sub_C (quadraticNonbaseElement p)).coprime_iff_not_dvd.mpr + rw [dvd_iff_isRoot, IsRoot] + exact hrightEval + exact IsCoprime.mul_left hleft hright + +theorem finTwoSecondToIteratedPolynomial_map_univariateInFirstCoordinate + {K L : Type*} [Field K] [Field L] (phi : K →+* L) (P : Polynomial K) : + finTwoSecondToIteratedPolynomial + (MvPolynomial.map phi (univariateInFirstCoordinate P)) = C (P.map phi) := by + classical + have hmap : P.map phi = + P.support.sum fun n ↦ C (phi (P.coeff n)) * X ^ n := by + ext n + simp [coeff_map] + simp [finTwoSecondToIteratedPolynomial, univariateInFirstCoordinate, + Polynomial.sum_def, MvPolynomial.renameEquiv_apply, hmap] + +theorem finTwoSecondToIteratedPolynomial_map_seededNonsplitDescendedPolynomial + (s : (E p)ˣ) (d e : ℕ) : + finTwoSecondToIteratedPolynomial + (MvPolynomial.map (algebraMap (F p) (E p)) + (seededNonsplitDescendedPolynomial p s d e)) = + monomial (2 * e) (-(extendedCayleyNormFactor p ^ d)) + + monomial e (extendedSeededCayleyNumerator p s d) + + C (-(extendedCayleyNormFactor p ^ d)) := by + rw [seededNonsplitDescendedPolynomial] + simp only [map_sub, map_mul, map_pow, map_add, map_one, + finTwoSecondToIteratedPolynomial_map_univariateInFirstCoordinate, + map_X, finTwoSecondToIteratedPolynomial_X_one] + rw [seededCayleyTraceNumeratorPolynomial_map, quadraticCayleyNormPolynomial_map] + simp [← C_mul_X_pow_eq_monomial, extendedSeededCayleyNumerator, extendedCayleyNormFactor, + extendedCayleyNumeratorFactor, extendedCayleyDenominatorFactor, + Nat.mul_comm] + ring + +theorem cayleyTransport_splitIteratedPolynomial + {K : Type*} [Field K] (alpha beta r t : K) (e d : ℕ) (hrt : r ≠ t) + (hdet : (1 : K) * (-t) - (-r) * 1 ≠ 0) : + let phi := BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : K) (-r) 1 (-t) hdet + let A : RatFunc K := RatFunc.X - RatFunc.C r + let B : RatFunc K := RatFunc.X - RatFunc.C t + let Q : Polynomial K := (X - C r) * (X - C t) + let N : Polynomial K := C alpha * (X - C r) ^ (2 * d) + + C beta * (X - C t) ^ (2 * d) + C (B ^ (2 * d)) * + ((finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d)).map + (algebraMap K[X] (RatFunc K))).map phi.toRingHom = + (monomial (2 * e) (-(Q ^ d)) + monomial e N + C (-(Q ^ d))).map + (algebraMap K[X] (RatFunc K)) := by + have hphi (f : K[X]) : + (BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : K) (-r) 1 (-t) hdet).toRingEquiv.toRingHom + (algebraMap K[X] (RatFunc K) f) = + aeval (BGS.Algebra.ratFuncLinearFractionalValue + (1 : K) (-r) 1 (-t)) f := by + change BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : K) (-r) 1 (-t) hdet (algebraMap K[X] (RatFunc K) f) = _ + exact BGS.Algebra.ratFuncLinearFractionalEquiv_apply_algebraMap + (1 : K) (-r) 1 (-t) hdet f + have hconst (x : K) : + BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : K) (-r) 1 (-t) hdet (RatFunc.C x) = RatFunc.C x := by + change BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : K) (-r) 1 (-t) hdet (algebraMap K (RatFunc K) x) = + algebraMap K (RatFunc K) x + exact (BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : K) (-r) 1 (-t) hdet).commutes x + dsimp only + rw [finTwoToIteratedPolynomial_splitTraceCoverPolynomial_general] + simp only [← C_mul_X_pow_eq_monomial, Polynomial.map_add, Polynomial.map_mul, + Polynomial.map_neg, Polynomial.map_pow, Polynomial.map_C, Polynomial.map_X] + rw [hphi] + simp [BGS.Algebra.ratFuncLinearFractionalValue, aeval_def, + eval₂_add, eval₂_sub, eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, + ← C_mul_X_pow_eq_monomial] + rw [hconst, hconst] + let A : RatFunc K := RatFunc.X - RatFunc.C r + let B : RatFunc K := RatFunc.X - RatFunc.C t + let q : RatFunc K := A / B + have hqExpanded : + (RatFunc.X + -RatFunc.C r) / (RatFunc.X + -RatFunc.C t) = q := by + simp [q, A, B, sub_eq_add_neg] + have hB : RatFunc.X - RatFunc.C t ≠ (0 : RatFunc K) := by + simpa only [map_sub, RatFunc.algebraMap_X, RatFunc.algebraMap_C] using + RatFunc.algebraMap_ne_zero (X_sub_C_ne_zero t) + rw [hqExpanded] + have hqD : B ^ (2 * d) * q ^ d = (A * B) ^ d := by + have hB' : B ≠ 0 := by simpa [B] using hB + dsimp only [q] + rw [pow_mul, ← mul_pow] + congr 1 + field_simp [hB'] + have hqTwoD : B ^ (2 * d) * q ^ (2 * d) = A ^ (2 * d) := by + have hB' : B ≠ 0 := by simpa [B] using hB + dsimp only [q] + rw [← mul_pow] + congr 1 + field_simp [hB'] + have hmiddle : + B ^ (2 * d) * (RatFunc.C alpha * q ^ (2 * d) + RatFunc.C beta) = + RatFunc.C alpha * A ^ (2 * d) + RatFunc.C beta * B ^ (2 * d) := by + calc + _ = RatFunc.C alpha * (B ^ (2 * d) * q ^ (2 * d)) + + RatFunc.C beta * B ^ (2 * d) := by ring + _ = _ := by rw [hqTwoD] + have hnegative : B ^ (2 * d) * (-q ^ d) = -(A * B) ^ d := by + rw [mul_neg, hqD] + calc + _ = C (B ^ (2 * d) * (-q ^ d)) * X ^ (2 * e) + + C (B ^ (2 * d) * + (RatFunc.C alpha * q ^ (2 * d) + RatFunc.C beta)) * X ^ e + + C (B ^ (2 * d) * (-q ^ d)) := by + dsimp [B] + simp only [map_add, map_sub, map_mul, map_pow, map_neg] + ring + _ = _ := by + rw [hnegative, hmiddle] + dsimp [A, B] + simp only [map_add, map_mul, map_pow, map_sub, map_neg] + ring + +/-- Irreducibility descends through the nonsplit Cayley model after any field extension of +the quadratic splitting field. This is the algebraic core used below with an algebraic +closure as the target field. -/ +theorem map_seededNonsplitDescendedPolynomial_irreducible_of_map_splitCover + {L : Type*} [Field L] (ι : E p →+* L) (s : (E p)ˣ) (d e : ℕ) + (hd : 0 < d) (he : 0 < e) + (hcover : Irreducible + (MvPolynomial.map ι + (splitTraceCoverPolynomial (s : E p) ((s : E p) ^ p) e d))) : + Irreducible + (MvPolynomial.map (ι.comp (algebraMap (F p) (E p))) + (seededNonsplitDescendedPolynomial p s d e)) := by + let alpha : L := ι (s : E p) + let beta : L := ι ((s : E p) ^ p) + let r : L := ι (quadraticNonbaseElement p ^ p) + let t : L := ι (quadraticNonbaseElement p) + have hsplit : + MvPolynomial.map ι + (splitTraceCoverPolynomial (s : E p) ((s : E p) ^ p) e d) = + splitTraceCoverPolynomial alpha beta e d := by + simp [splitTraceCoverPolynomial, alpha, beta] + have hq : Irreducible + (finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d)) := by + have := hcover.map (finTwoToIteratedPolynomial (K := L)) + rwa [hsplit] at this + have hqPrimitive : + (finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d)).IsPrimitive := by + apply hq.isPrimitive + rw [finTwoToIteratedPolynomial_splitTraceCoverPolynomial_general_natDegree + alpha beta e d he] + omega + have hqFraction : Irreducible + ((finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d)).map + (algebraMap L[X] (RatFunc L))) := + hqPrimitive.irreducible_iff_irreducible_map_fraction_map.mp hq + have hrt : r ≠ t := by + exact ι.injective.ne (quadraticNonbaseElement_frobenius_ne_self p) + have hdet : (1 : L) * (-t) - (-r) * 1 ≠ 0 := by + rw [show (1 : L) * (-t) - (-r) * 1 = r - t by ring] + exact sub_ne_zero.mpr hrt + let phi := BGS.Algebra.ratFuncLinearFractionalEquiv + (1 : L) (-r) 1 (-t) hdet + have hqTransported : Irreducible + (((finTwoToIteratedPolynomial + (splitTraceCoverPolynomial alpha beta e d)).map + (algebraMap L[X] (RatFunc L))).map phi.toRingHom) := by + exact hqFraction.map (Polynomial.mapAlgEquiv phi) + let A : RatFunc L := RatFunc.X - RatFunc.C r + let B : RatFunc L := RatFunc.X - RatFunc.C t + let Q : Polynomial L := (X - C r) * (X - C t) + let N : Polynomial L := + C alpha * (X - C r) ^ (2 * d) + C beta * (X - C t) ^ (2 * d) + let R : Polynomial L[X] := + monomial (2 * e) (-(Q ^ d)) + monomial e N + C (-(Q ^ d)) + have hB : B ≠ 0 := by + dsimp [B, t] + simpa only [map_sub, RatFunc.algebraMap_X, RatFunc.algebraMap_C] using + RatFunc.algebraMap_ne_zero (X_sub_C_ne_zero (ι (quadraticNonbaseElement p))) + have hscale : IsUnit (C (B ^ (2 * d)) : Polynomial (RatFunc L)) := by + rw [Polynomial.isUnit_C] + exact isUnit_iff_ne_zero.mpr (pow_ne_zero _ hB) + have hRFraction : Irreducible (R.map (algebraMap L[X] (RatFunc L))) := by + rw [← cayleyTransport_splitIteratedPolynomial alpha beta r t e d hrt hdet] + exact (irreducible_isUnit_mul hscale).2 hqTransported + have hcoprime : IsCoprime Q N := by + have h := (extendedCayleyNormFactor_isCoprime_extendedSeededCayleyNumerator + p s d hd).map (Polynomial.mapRingHom ι) + simpa [Q, N, alpha, beta, r, t, extendedCayleyNormFactor, + extendedSeededCayleyNumerator, extendedCayleyNumeratorFactor, + extendedCayleyDenominatorFactor] using h + have hRPrimitive : R.IsPrimitive := by + have hcoprimePow : IsCoprime (Q ^ d) N := hcoprime.pow_left + have hprimitive := + descendedIteratedPolynomial_isPrimitive_of_isCoprime (Q ^ d) N e he hcoprimePow + simpa only [R] using hprimitive + have hR : Irreducible R := + hRPrimitive.irreducible_iff_irreducible_map_fraction_map.mpr hRFraction + have hdescendedIterated : + finTwoSecondToIteratedPolynomial + (MvPolynomial.map (ι.comp (algebraMap (F p) (E p))) + (seededNonsplitDescendedPolynomial p s d e)) = R := by + rw [← MvPolynomial.map_map] + rw [finTwoSecondToIteratedPolynomial_map] + rw [finTwoSecondToIteratedPolynomial_map_seededNonsplitDescendedPolynomial] + simp [R, Q, N, alpha, beta, r, t, extendedCayleyNormFactor, + extendedSeededCayleyNumerator, extendedCayleyNumeratorFactor, + extendedCayleyDenominatorFactor] + have hback := hR.map (finTwoSecondToIteratedPolynomial (K := L)).symm + simpa [← hdescendedIterated] using hback + +/-- Absolute irreducibility of the descended nonsplit trace curve follows from absolute +irreducibility of its split cover. The proof applies the split-cover premise over the +quadratic field's algebraic closure, performs the explicit Cayley descent there, and then +uses uniqueness of algebraic closures over the base field. -/ +theorem seededNonsplitDescendedPolynomial_absolutelyIrreducible_of_splitCover + (s : (E p)ˣ) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hcover : Irreducible + (MvPolynomial.map + (algebraMap (E p) (AlgebraicClosure (E p))) + (splitTraceCoverPolynomial (s : E p) ((s : E p) ^ p) e d))) : + Irreducible + (MvPolynomial.map + (algebraMap (F p) (AlgebraicClosure (F p))) + (seededNonsplitDescendedPolynomial p s d e)) := by + let K := AlgebraicClosure (E p) + have hdescendedOverK : Irreducible + (MvPolynomial.map + ((algebraMap (E p) K).comp (algebraMap (F p) (E p))) + (seededNonsplitDescendedPolynomial p s d e)) := by + exact map_seededNonsplitDescendedPolynomial_irreducible_of_map_splitCover + p (algebraMap (E p) K) s d e hd he hcover + let closureEquiv : K ≃ₐ[F p] AlgebraicClosure (F p) := + IsAlgClosure.equivOfAlgebraic (F p) (E p) K (AlgebraicClosure (F p)) + have hmapped := hdescendedOverK.map + (MvPolynomial.mapAlgEquiv (Fin 2) closureEquiv) + have hcomp : + (closureEquiv : K →+* AlgebraicClosure (F p)).comp + ((algebraMap (E p) K).comp (algebraMap (F p) (E p))) = + algebraMap (F p) (AlgebraicClosure (F p)) := by + ext x + simp only [RingHom.comp_apply, ← IsScalarTower.algebraMap_apply] + exact closureEquiv.commutes x + have hmapped' : Irreducible + (MvPolynomial.map + ((closureEquiv : K →+* AlgebraicClosure (F p)).comp + ((algebraMap (E p) K).comp (algebraMap (F p) (E p)))) + (seededNonsplitDescendedPolynomial p s d e)) := by + simpa only [MvPolynomial.mapAlgEquiv_apply, MvPolynomial.map_map] using hmapped + rw [hcomp] at hmapped' + exact hmapped' + +end DescendedFormula + +end + + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean new file mode 100644 index 0000000000..a9478f1644 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean @@ -0,0 +1,730 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import Mathlib.Algebra.Polynomial.Eval.Degree + +/-! +# The descended seeded nonsplit trace curve + +The Cayley coordinate converts the seeded nonsplit equation into one polynomial equation over +the base field. This file constructs that polynomial, proves the scalar-extension formula and +its bidegree bounds, and compares its base-field solutions exactly with the original torus +solutions. Absolute irreducibility is deliberately a theorem to be proved, not an assumption. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable (p : ℕ) [Fact p.Prime] + +private abbrev F := ZMod p +private abbrev E := quadraticFiniteField p + +noncomputable local instance : Fintype (E p) := Fintype.ofFinite (E p) +noncomputable local instance : DecidableEq (quadraticNormOneTorus p) := Classical.decEq _ + +/-- Apply the quadratic field trace coefficientwise to a polynomial. -/ +def quadraticCoefficientTracePolynomial (P : Polynomial (E p)) : Polynomial (F p) := + P.sum fun n c => Polynomial.monomial n (Algebra.trace (F p) (E p) c) + +@[simp] +theorem quadraticCoefficientTracePolynomial_coeff (P : Polynomial (E p)) (n : ℕ) : + (quadraticCoefficientTracePolynomial p P).coeff n = + Algebra.trace (F p) (E p) (P.coeff n) := by + classical + rw [quadraticCoefficientTracePolynomial, Polynomial.coeff_sum] + simp only [Polynomial.sum_def] + by_cases hn : n ∈ P.support + · rw [Finset.sum_eq_single n] + · simp + · intro b hb hbn + rw [Polynomial.coeff_monomial, if_neg hbn] + · exact fun h => (h hn).elim + · rw [Finset.sum_eq_zero] + · rw [Polynomial.notMem_support_iff.mp hn, map_zero] + · intro b hb + rw [Polynomial.coeff_monomial] + exact if_neg (fun h : b = n => hn (h ▸ hb)) + +/-- After scalar extension, coefficientwise trace is `P + Frobenius(P)`. -/ +theorem quadraticCoefficientTracePolynomial_map (P : Polynomial (E p)) : + (quadraticCoefficientTracePolynomial p P).map (algebraMap (F p) (E p)) = + P + P.map (_root_.frobenius (E p) p) := by + ext n + simp [algebraMap_quadraticTrace p, frobenius_def] + +/-- The linear Cayley factor whose zero is the Frobenius conjugate of the chosen nonbase +element. -/ +def quadraticCayleyConjugateFactorPolynomial : Polynomial (E p) := + Polynomial.X - Polynomial.C (quadraticNonbaseElement p ^ p) + +/-- The seed-dependent numerator before descent. -/ +def seededCayleyTraceNumeratorPolynomial + (s : (E p)ˣ) (d : ℕ) : Polynomial (F p) := + quadraticCoefficientTracePolynomial p + (Polynomial.C (s : E p) * quadraticCayleyConjugateFactorPolynomial p ^ (2 * d)) + +theorem seededCayleyTraceNumeratorPolynomial_map (s : (E p)ˣ) (d : ℕ) : + (seededCayleyTraceNumeratorPolynomial p s d).map (algebraMap (F p) (E p)) = + Polynomial.C (s : E p) * + (Polynomial.X - Polynomial.C (quadraticNonbaseElement p ^ p)) ^ (2 * d) + + Polynomial.C ((s : E p) ^ p) * + (Polynomial.X - Polynomial.C (quadraticNonbaseElement p)) ^ (2 * d) := by + rw [seededCayleyTraceNumeratorPolynomial, quadraticCoefficientTracePolynomial_map] + rw [quadraticCayleyConjugateFactorPolynomial] + rw [Polynomial.map_mul, Polynomial.map_C, Polynomial.map_pow, + Polynomial.map_sub, Polynomial.map_X, Polynomial.map_C] + change Polynomial.C (s : E p) * + (Polynomial.X - Polynomial.C (quadraticNonbaseElement p ^ p)) ^ (2 * d) + + Polynomial.C ((s : E p) ^ p) * + (Polynomial.X - Polynomial.C ((quadraticNonbaseElement p ^ p) ^ p)) ^ (2 * d) = _ + rw [quadraticNonbaseElement_frobenius_frobenius p] + +/-- The norm of the Cayley linear factor, written directly over the base field. -/ +def quadraticCayleyNormPolynomial : Polynomial (F p) := + Polynomial.X ^ 2 - + Polynomial.C (Algebra.trace (F p) (E p) (quadraticNonbaseElement p)) * Polynomial.X + + Polynomial.C (Algebra.norm (F p) (quadraticNonbaseElement p)) + +theorem quadraticCayleyNormPolynomial_map : + (quadraticCayleyNormPolynomial p).map (algebraMap (F p) (E p)) = + (Polynomial.X - Polynomial.C (quadraticNonbaseElement p ^ p)) * + (Polynomial.X - Polynomial.C (quadraticNonbaseElement p)) := by + rw [quadraticCayleyNormPolynomial, Polynomial.map_add, Polynomial.map_sub, + Polynomial.map_mul, Polynomial.map_pow, Polynomial.map_X, Polynomial.map_C, + Polynomial.map_C, algebraMap_quadraticTrace p, algebraMap_quadraticNorm p] + rw [Polynomial.C_add, Polynomial.C_mul] + ring + +theorem algebraMap_eval_seededCayleyTraceNumeratorPolynomial + (s : (E p)ˣ) (d : ℕ) (z : F p) : + algebraMap (F p) (E p) ((seededCayleyTraceNumeratorPolynomial p s d).eval z) = + (s : E p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + + (s : E p) ^ p * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ (2 * d) := by + calc + algebraMap (F p) (E p) ((seededCayleyTraceNumeratorPolynomial p s d).eval z) = + ((seededCayleyTraceNumeratorPolynomial p s d).map + (algebraMap (F p) (E p))).eval (algebraMap (F p) (E p) z) := by + rw [← Polynomial.eval₂_eq_eval_map] + exact (Polynomial.eval₂_at_apply (algebraMap (F p) (E p)) z).symm + _ = _ := by rw [seededCayleyTraceNumeratorPolynomial_map]; simp + +theorem algebraMap_eval_quadraticCayleyNormPolynomial (z : F p) : + algebraMap (F p) (E p) ((quadraticCayleyNormPolynomial p).eval z) = + (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) := by + calc + algebraMap (F p) (E p) ((quadraticCayleyNormPolynomial p).eval z) = + ((quadraticCayleyNormPolynomial p).map + (algebraMap (F p) (E p))).eval (algebraMap (F p) (E p) z) := by + rw [← Polynomial.eval₂_eq_eval_map] + exact (Polynomial.eval₂_at_apply (algebraMap (F p) (E p)) z).symm + _ = _ := by rw [quadraticCayleyNormPolynomial_map]; simp + +/-- Embed a univariate polynomial in the first coordinate of a bivariate polynomial. -/ +def univariateInFirstCoordinate {K : Type*} [CommSemiring K] + (P : Polynomial K) : MvPolynomial (Fin 2) K := + P.sum fun n c => MvPolynomial.C c * MvPolynomial.X 0 ^ n + +@[simp] +theorem eval_univariateInFirstCoordinate {K : Type*} [CommSemiring K] + (P : Polynomial K) (x y : K) : + MvPolynomial.eval ![x, y] (univariateInFirstCoordinate P) = P.eval x := by + classical + simp [univariateInFirstCoordinate, Polynomial.sum_def, Polynomial.eval_eq_sum] + +private theorem degreeOf_finset_sum_le {K ι : Type*} [CommSemiring K] + (coordinate : Fin 2) (terms : ι → MvPolynomial (Fin 2) K) + (indices : Finset ι) (bound : ℕ) + (hterms : ∀ i ∈ indices, MvPolynomial.degreeOf coordinate (terms i) ≤ bound) : + MvPolynomial.degreeOf coordinate (∑ i ∈ indices, terms i) ≤ bound := by + classical + induction indices using Finset.induction_on with + | empty => simp + | @insert i indices hi ih => + rw [Finset.sum_insert hi] + exact (MvPolynomial.degreeOf_add_le _ _ _).trans + (max_le (hterms i (Finset.mem_insert_self i indices)) + (ih fun j hj => hterms j (Finset.mem_insert_of_mem hj))) + +theorem univariateInFirstCoordinate_degreeOf_first_le + {K : Type*} [CommSemiring K] [Nontrivial K] (P : Polynomial K) : + MvPolynomial.degreeOf (0 : Fin 2) (univariateInFirstCoordinate P) ≤ P.natDegree := by + classical + rw [univariateInFirstCoordinate, Polynomial.sum_def] + apply degreeOf_finset_sum_le (0 : Fin 2) _ P.support P.natDegree + intro n hn + calc + MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C (P.coeff n) * MvPolynomial.X 0 ^ n) ≤ + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.C (P.coeff n)) + + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 0 ^ n) := + MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ 0 + n := by + gcongr + · rw [MvPolynomial.degreeOf_C] + · calc + MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.X 0 ^ n : MvPolynomial (Fin 2) K) ≤ + n * MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 0) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = n := by rw [MvPolynomial.degreeOf_X]; simp + _ ≤ P.natDegree := by simpa using Polynomial.le_natDegree_of_mem_supp n hn + +theorem univariateInFirstCoordinate_degreeOf_second_le + {K : Type*} [CommSemiring K] [Nontrivial K] (P : Polynomial K) : + MvPolynomial.degreeOf (1 : Fin 2) (univariateInFirstCoordinate P) ≤ 0 := by + classical + rw [univariateInFirstCoordinate, Polynomial.sum_def] + apply degreeOf_finset_sum_le (1 : Fin 2) _ P.support 0 + intro n hn + calc + MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.C (P.coeff n) * MvPolynomial.X 0 ^ n) ≤ + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.C (P.coeff n)) + + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 0 ^ n) := + MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ 0 := by + have hpow : MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.X 0 ^ n : MvPolynomial (Fin 2) K) ≤ 0 := by + calc + _ ≤ n * MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 0) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = 0 := by rw [MvPolynomial.degreeOf_X]; norm_num + rw [MvPolynomial.degreeOf_C] + simpa using hpow + +private theorem natDegree_linearFactor_le_one {K : Type*} [Ring K] [Nontrivial K] (a : K) : + (Polynomial.X - Polynomial.C a).natDegree ≤ 1 := + (Polynomial.natDegree_sub_le _ _).trans (by simp) + +theorem seededCayleyTraceNumeratorPolynomial_natDegree_le + (s : (E p)ˣ) (d : ℕ) : + (seededCayleyTraceNumeratorPolynomial p s d).natDegree ≤ 2 * d := by + rw [← Polynomial.natDegree_map_eq_of_injective + (algebraMap (F p) (E p)).injective, + seededCayleyTraceNumeratorPolynomial_map] + refine (Polynomial.natDegree_add_le _ _).trans (max_le ?_ ?_) + · have hlinear := natDegree_linearFactor_le_one + (quadraticNonbaseElement p ^ p) + have hpow : ((Polynomial.X - Polynomial.C (quadraticNonbaseElement p ^ p)) ^ + (2 * d)).natDegree ≤ 2 * d := + Polynomial.natDegree_pow_le.trans (by + simpa using Nat.mul_le_mul_left (2 * d) hlinear) + exact Polynomial.natDegree_mul_le.trans (by simpa using hpow) + · have hlinear := natDegree_linearFactor_le_one (quadraticNonbaseElement p) + have hpow : ((Polynomial.X - Polynomial.C (quadraticNonbaseElement p)) ^ + (2 * d)).natDegree ≤ 2 * d := + Polynomial.natDegree_pow_le.trans (by + simpa using Nat.mul_le_mul_left (2 * d) hlinear) + exact Polynomial.natDegree_mul_le.trans (by simpa using hpow) + +theorem quadraticCayleyNormPolynomial_natDegree_le : + (quadraticCayleyNormPolynomial p).natDegree ≤ 2 := by + rw [← Polynomial.natDegree_map_eq_of_injective + (algebraMap (F p) (E p)).injective, + quadraticCayleyNormPolynomial_map] + calc + _ ≤ (Polynomial.X - Polynomial.C (quadraticNonbaseElement p ^ p)).natDegree + + (Polynomial.X - Polynomial.C (quadraticNonbaseElement p)).natDegree := + Polynomial.natDegree_mul_le + _ ≤ 2 := by + have hleft := natDegree_linearFactor_le_one (quadraticNonbaseElement p ^ p) + have hright := natDegree_linearFactor_le_one (quadraticNonbaseElement p) + omega + +/-- The explicit bivariate polynomial over `ZMod p` defining the descended seeded nonsplit +cover. Coordinate `0` is the Cayley affine coordinate and coordinate `1` is the base-field +unit parameter. -/ +def seededNonsplitDescendedPolynomial (s : (E p)ˣ) (d e : ℕ) : + MvPolynomial (Fin 2) (F p) := + univariateInFirstCoordinate (seededCayleyTraceNumeratorPolynomial p s d) * + MvPolynomial.X 1 ^ e - + univariateInFirstCoordinate (quadraticCayleyNormPolynomial p) ^ d * + (MvPolynomial.X 1 ^ (2 * e) + 1) + +theorem eval_seededNonsplitDescendedPolynomial + (s : (E p)ˣ) (d e : ℕ) (z u : F p) : + MvPolynomial.eval ![z, u] (seededNonsplitDescendedPolynomial p s d e) = + (seededCayleyTraceNumeratorPolynomial p s d).eval z * u ^ e - + (quadraticCayleyNormPolynomial p).eval z ^ d * (u ^ (2 * e) + 1) := by + simp [seededNonsplitDescendedPolynomial] + +private theorem degreeOf_first_X_one_pow_le {K : Type*} [CommSemiring K] + [Nontrivial K] (n : ℕ) : + MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.X 1 ^ n : MvPolynomial (Fin 2) K) ≤ 0 := by + calc + _ ≤ n * MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 1) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = 0 := by rw [MvPolynomial.degreeOf_X]; norm_num + +private theorem degreeOf_second_X_one_pow_le {K : Type*} [CommSemiring K] + [Nontrivial K] (n : ℕ) : + MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.X 1 ^ n : MvPolynomial (Fin 2) K) ≤ n := by + calc + _ ≤ n * MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 1) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = n := by rw [MvPolynomial.degreeOf_X]; norm_num + +theorem seededNonsplitDescendedPolynomial_degreeOf_first_le + (s : (E p)ˣ) (d e : ℕ) : + MvPolynomial.degreeOf (0 : Fin 2) (seededNonsplitDescendedPolynomial p s d e) ≤ + 2 * d := by + rw [seededNonsplitDescendedPolynomial] + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + have hnum := (univariateInFirstCoordinate_degreeOf_first_le + (seededCayleyTraceNumeratorPolynomial p s d)).trans + (seededCayleyTraceNumeratorPolynomial_natDegree_le p s d) + have hu := degreeOf_first_X_one_pow_le (K := F p) e + omega + · refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + have hnormBase := (univariateInFirstCoordinate_degreeOf_first_le + (quadraticCayleyNormPolynomial p)).trans + (quadraticCayleyNormPolynomial_natDegree_le p) + have hnormPow := (MvPolynomial.degreeOf_pow_le (0 : Fin 2) + (univariateInFirstCoordinate (quadraticCayleyNormPolynomial p)) d).trans + (Nat.mul_le_mul_left d hnormBase) + have hsum := (MvPolynomial.degreeOf_add_le (0 : Fin 2) + (MvPolynomial.X 1 ^ (2 * e) : MvPolynomial (Fin 2) (F p)) 1).trans + (max_le (degreeOf_first_X_one_pow_le (K := F p) (2 * e)) (by simp)) + omega + +theorem seededNonsplitDescendedPolynomial_degreeOf_second_le + (s : (E p)ˣ) (d e : ℕ) : + MvPolynomial.degreeOf (1 : Fin 2) (seededNonsplitDescendedPolynomial p s d e) ≤ + 2 * e := by + rw [seededNonsplitDescendedPolynomial] + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + have hnum := univariateInFirstCoordinate_degreeOf_second_le + (seededCayleyTraceNumeratorPolynomial p s d) + have hu := degreeOf_second_X_one_pow_le (K := F p) e + omega + · refine (MvPolynomial.degreeOf_mul_le _ _ _).trans ?_ + have hnormBase := univariateInFirstCoordinate_degreeOf_second_le + (quadraticCayleyNormPolynomial p) + have hnormPow := (MvPolynomial.degreeOf_pow_le (1 : Fin 2) + (univariateInFirstCoordinate (quadraticCayleyNormPolynomial p)) d).trans + (Nat.mul_le_mul_left d hnormBase) + have hsum := (MvPolynomial.degreeOf_add_le (1 : Fin 2) + (MvPolynomial.X 1 ^ (2 * e) : MvPolynomial (Fin 2) (F p)) 1).trans + (max_le (degreeOf_second_X_one_pow_le (K := F p) (2 * e)) (by simp)) + omega + +theorem seededNonsplitDescendedPolynomial_hasBidegreeAtMost + (s : (E p)ˣ) (d e : ℕ) : + BGS.External.HasBidegreeAtMost + (seededNonsplitDescendedPolynomial p s d e) (2 * d) (2 * e) := by + intro monomial hmonomial + exact ⟨ + (MvPolynomial.degreeOf_le_iff.mp + (seededNonsplitDescendedPolynomial_degreeOf_first_le p s d e)) monomial hmonomial, + (MvPolynomial.degreeOf_le_iff.mp + (seededNonsplitDescendedPolynomial_degreeOf_second_le p s d e)) monomial hmonomial⟩ + +private theorem clearedSeededFractionEquation_iff + {K : Type*} [Field K] (seed conjugateSeed X Y V : K) + (hX : X ≠ 0) (hY : Y ≠ 0) (hV : V ≠ 0) : + (seed * X ^ 2 + conjugateSeed * Y ^ 2) * V - X * Y * (V ^ 2 + 1) = 0 ↔ + seed * (X / Y) + conjugateSeed * (X / Y)⁻¹ = V + V⁻¹ := by + field_simp [hX, hY, hV] + constructor <;> intro h <;> linear_combination h + +private theorem clearedSeededCayleyEquation_iff + {K : Type*} [Field K] (seed conjugateSeed A B u : K) (d e : ℕ) + (hA : A ≠ 0) (hB : B ≠ 0) (hu : u ≠ 0) : + (seed * A ^ (2 * d) + conjugateSeed * B ^ (2 * d)) * u ^ e - + (A * B) ^ d * (u ^ (2 * e) + 1) = 0 ↔ + seed * (A / B) ^ d + conjugateSeed * ((A / B) ^ d)⁻¹ = + u ^ e + (u ^ e)⁻¹ := by + rw [Nat.mul_comm 2 d, pow_mul, pow_mul, Nat.mul_comm 2 e, pow_mul, + div_pow, mul_pow] + exact clearedSeededFractionEquation_iff seed conjugateSeed (A ^ d) (B ^ d) (u ^ e) + (pow_ne_zero d hA) (pow_ne_zero d hB) (pow_ne_zero e hu) + +/-- Vanishing of the descended base-field polynomial is exactly the seeded nonsplit trace +equation at the Cayley point. -/ +theorem eval_seededNonsplitDescendedPolynomial_eq_zero_iff + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) + (z : F p) (u : (F p)ˣ) : + MvPolynomial.eval ![z, (u : F p)] + (seededNonsplitDescendedPolynomial p s.1 d e) = 0 ↔ + SeededNonsplitTraceCoverEquation p k s d e (quadraticCayleyPoint p z) u := by + rw [eval_seededNonsplitDescendedPolynomial] + rw [seededNonsplitTraceCoverEquation_iff_weightedSplitTraceCover] + have hmapZero : + (seededCayleyTraceNumeratorPolynomial p s.1 d).eval z * (u : F p) ^ e - + (quadraticCayleyNormPolynomial p).eval z ^ d * ((u : F p) ^ (2 * e) + 1) = 0 ↔ + algebraMap (F p) (E p) + ((seededCayleyTraceNumeratorPolynomial p s.1 d).eval z * (u : F p) ^ e - + (quadraticCayleyNormPolynomial p).eval z ^ d * + ((u : F p) ^ (2 * e) + 1)) = 0 := by + constructor + · intro h; rw [h, map_zero] + · intro h; exact (algebraMap (F p) (E p)).injective (by simpa using h) + rw [hmapZero] + simp only [map_sub, map_mul, map_pow, map_add, map_one] + rw [algebraMap_eval_seededCayleyTraceNumeratorPolynomial, + algebraMap_eval_quadraticCayleyNormPolynomial] + unfold SplitTraceCurveEquation weightedSplitTorusTrace splitTorusTrace + change + (((s.1 : E p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + + (s.1 : E p) ^ p * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ (2 * d)) * + algebraMap (F p) (E p) (u : F p) ^ e - + ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ d * + (algebraMap (F p) (E p) (u : F p) ^ (2 * e) + 1) = 0) ↔ _ + have hA : algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p ≠ 0 := by + rw [sub_ne_zero] + exact fun h => quadraticNonbaseElement_frobenius_not_mem_range p ⟨z, h⟩ + have hB : algebraMap (F p) (E p) z - quadraticNonbaseElement p ≠ 0 := by + rw [sub_ne_zero] + exact fun h => quadraticNonbaseElement_not_mem_range p ⟨z, h⟩ + have hu : algebraMap (F p) (E p) (u : F p) ≠ 0 := + (map_ne_zero (algebraMap (F p) (E p))).mpr (Units.ne_zero u) + rw [clearedSeededCayleyEquation_iff _ _ _ _ _ d e + hA hB hu] + simp only [seededBaseUnitInQuadraticField, quadraticCayleyPoint, + quadraticCayleyUnit, Units.val_mk0, Units.val_pow_eq_pow_val, + Units.val_inv_eq_inv_val] + rfl + +/-- Base-field solutions of the descended affine equation with the second coordinate restricted +to a unit. -/ +def seededNonsplitDescendedSolutions + (s : (E p)ˣ) (d e : ℕ) : Finset (F p × (F p)ˣ) := by + classical + exact Finset.univ.filter fun z => + MvPolynomial.eval ![z.1, (z.2 : F p)] + (seededNonsplitDescendedPolynomial p s d e) = 0 + +@[simp] +theorem mem_seededNonsplitDescendedSolutions_iff + (s : (E p)ˣ) (d e : ℕ) (z : F p × (F p)ˣ) : + z ∈ seededNonsplitDescendedSolutions p s d e ↔ + MvPolynomial.eval ![z.1, (z.2 : F p)] + (seededNonsplitDescendedPolynomial p s d e) = 0 := by + classical + simp [seededNonsplitDescendedSolutions] + +/-- Seeded nonsplit solutions with the identity point removed from the norm-one torus. -/ +def seededNonsplitNonidentitySolutions + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : + Finset ({w : quadraticNormOneTorus p // w ≠ 1} × (F p)ˣ) := by + classical + exact Finset.univ.filter fun z => + SeededNonsplitTraceCoverEquation p k s d e z.1.1 z.2 + +@[simp] +theorem mem_seededNonsplitNonidentitySolutions_iff + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) + (z : {w : quadraticNormOneTorus p // w ≠ 1} × (F p)ˣ) : + z ∈ seededNonsplitNonidentitySolutions p k s d e ↔ + SeededNonsplitTraceCoverEquation p k s d e z.1.1 z.2 := by + classical + simp [seededNonsplitNonidentitySolutions] + +/-- Cayley parametrization gives an exact bijection, with no multiplicity, between descended +solutions and nonidentity torus solutions. -/ +theorem seededNonsplitDescendedSolutions_card_eq_nonidentity_card + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : + (seededNonsplitDescendedSolutions p s.1 d e).card = + (seededNonsplitNonidentitySolutions p k s d e).card := by + classical + apply Finset.card_bij' + (fun z _ => ((quadraticCayleyParameterEquiv p z.1), z.2)) + (fun z _ => ((quadraticCayleyParameterEquiv p).symm z.1, z.2)) + · intro z hz + rw [mem_seededNonsplitNonidentitySolutions_iff] + change SeededNonsplitTraceCoverEquation p k s d e + (quadraticCayleyPoint p z.1) z.2 + rw [← eval_seededNonsplitDescendedPolynomial_eq_zero_iff p k s d e z.1 z.2] + exact (mem_seededNonsplitDescendedSolutions_iff p s.1 d e z).mp hz + · intro z hz + apply Prod.ext + · exact (quadraticCayleyParameterEquiv p).symm_apply_apply z.1 + · rfl + · intro z hz + apply Prod.ext + · exact (quadraticCayleyParameterEquiv p).apply_symm_apply z.1 + · rfl + · intro z hz + rw [mem_seededNonsplitDescendedSolutions_iff] + rw [eval_seededNonsplitDescendedPolynomial_eq_zero_iff p k s d e] + have hzEquation := (mem_seededNonsplitNonidentitySolutions_iff p k s d e z).mp hz + have hpoint := congrArg Subtype.val + ((quadraticCayleyParameterEquiv p).apply_symm_apply z.1) + change quadraticCayleyPoint p ((quadraticCayleyParameterEquiv p).symm z.1) = z.1.1 at hpoint + rw [hpoint] + exact hzEquation + +theorem quadraticCayleyNormPolynomial_eval_ne_zero (z : F p) : + (quadraticCayleyNormPolynomial p).eval z ≠ 0 := by + intro hzero + have hmapped := congrArg (algebraMap (F p) (E p)) hzero + rw [map_zero, algebraMap_eval_quadraticCayleyNormPolynomial] at hmapped + have hleft : algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p ≠ 0 := by + rw [sub_ne_zero] + exact fun h => quadraticNonbaseElement_frobenius_not_mem_range p ⟨z, h⟩ + have hright : algebraMap (F p) (E p) z - quadraticNonbaseElement p ≠ 0 := by + rw [sub_ne_zero] + exact fun h => quadraticNonbaseElement_not_mem_range p ⟨z, h⟩ + exact (mul_ne_zero hleft hright) hmapped + +/-- For positive exponents the descended plane curve has no affine zero with second coordinate +zero. Thus the affine Hasse--Weil count introduces no hidden `u = 0` boundary. -/ +theorem eval_seededNonsplitDescendedPolynomial_zero_second_ne_zero + (s : (E p)ˣ) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (z : F p) : + MvPolynomial.eval ![z, (0 : F p)] + (seededNonsplitDescendedPolynomial p s d e) ≠ 0 := by + rw [eval_seededNonsplitDescendedPolynomial] + have he0 : e ≠ 0 := Nat.ne_of_gt he + have htwoe0 : 2 * e ≠ 0 := by omega + rw [zero_pow he0, zero_pow htwoe0] + simp only [mul_zero, zero_add, add_zero, mul_one, zero_sub, neg_ne_zero] + exact pow_ne_zero d (quadraticCayleyNormPolynomial_eval_ne_zero p z) + +private theorem affineDescendedZero_second_ne_zero + (s : (E p)ˣ) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (z : F p × F p) + (hz : z ∈ BGS.External.affinePlaneCurveZeros (F p) + (seededNonsplitDescendedPolynomial p s d e)) : z.2 ≠ 0 := by + intro hzero + have hzEval := (BGS.External.mem_affinePlaneCurveZeros_iff).mp hz + rw [hzero] at hzEval + exact eval_seededNonsplitDescendedPolynomial_zero_second_ne_zero + p s d e hd he z.1 hzEval + +/-- The general affine-plane zero set and the unit-restricted descended set have exactly the +same cardinality for positive exponents. -/ +theorem affinePlaneCurveZeros_seededNonsplitDescendedPolynomial_card_eq + (s : (E p)ˣ) (d e : ℕ) (hd : 0 < d) (he : 0 < e) : + (BGS.External.affinePlaneCurveZeros (F p) + (seededNonsplitDescendedPolynomial p s d e)).card = + (seededNonsplitDescendedSolutions p s d e).card := by + classical + apply Finset.card_bij' + (fun z hz => (z.1, Units.mk0 z.2 + (affineDescendedZero_second_ne_zero p s d e hd he z hz))) + (fun z _ => (z.1, (z.2 : F p))) + · intro z hz + rw [mem_seededNonsplitDescendedSolutions_iff] + exact (BGS.External.mem_affinePlaneCurveZeros_iff).mp hz + · intro z hz + apply Prod.ext <;> rfl + · intro z hz + apply Prod.ext + · rfl + · apply Units.ext; rfl + · intro z hz + rw [BGS.External.mem_affinePlaneCurveZeros_iff] + exact (mem_seededNonsplitDescendedSolutions_iff p s d e z).mp hz + +/-- All seeded nonsplit torus solutions, including the identity point. -/ +def seededNonsplitTraceCurveSolutions + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : + Finset (quadraticNormOneTorus p × (F p)ˣ) := by + classical + exact Finset.univ.filter fun z => + SeededNonsplitTraceCoverEquation p k s d e z.1 z.2 + +@[simp] +theorem mem_seededNonsplitTraceCurveSolutions_iff + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) + (z : quadraticNormOneTorus p × (F p)ˣ) : + z ∈ seededNonsplitTraceCurveSolutions p k s d e ↔ + SeededNonsplitTraceCoverEquation p k s d e z.1 z.2 := by + classical + simp [seededNonsplitTraceCurveSolutions] + +/-- The precise omitted Cayley boundary: solutions lying above the identity of the norm-one +torus. -/ +def seededNonsplitIdentityBoundarySolutions + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : Finset (F p)ˣ := by + classical + exact Finset.univ.filter fun u => + SeededNonsplitTraceCoverEquation p k s d e 1 u + +@[simp] +theorem mem_seededNonsplitIdentityBoundarySolutions_iff + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) (u : (F p)ˣ) : + u ∈ seededNonsplitIdentityBoundarySolutions p k s d e ↔ + SeededNonsplitTraceCoverEquation p k s d e 1 u := by + classical + simp [seededNonsplitIdentityBoundarySolutions] + +private theorem nonidentityFilter_card_eq + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : + ((seededNonsplitTraceCurveSolutions p k s d e).filter fun z => z.1 ≠ 1).card = + (seededNonsplitNonidentitySolutions p k s d e).card := by + classical + apply Finset.card_bij' + (fun z hz => (⟨z.1, (Finset.mem_filter.mp hz).2⟩, z.2)) + (fun z _ => (z.1.1, z.2)) + · intro z hz + apply Prod.ext <;> rfl + · intro z hz + apply Prod.ext + · apply Subtype.ext; rfl + · rfl + · intro z hz + rw [mem_seededNonsplitNonidentitySolutions_iff] + exact (mem_seededNonsplitTraceCurveSolutions_iff p k s d e z).mp + (Finset.mem_filter.mp hz).1 + · intro z hz + rw [Finset.mem_filter] + exact ⟨(mem_seededNonsplitTraceCurveSolutions_iff p k s d e _).mpr + ((mem_seededNonsplitNonidentitySolutions_iff p k s d e z).mp hz), z.1.2⟩ + +private theorem identityFilter_card_eq + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : + ((seededNonsplitTraceCurveSolutions p k s d e).filter fun z => ¬ z.1 ≠ 1).card = + (seededNonsplitIdentityBoundarySolutions p k s d e).card := by + classical + apply Finset.card_bij' + (fun z _ => z.2) + (fun u _ => (1, u)) + · intro z hz + have hzMem := Finset.mem_filter.mp hz + apply Prod.ext + · exact (not_ne_iff.mp (Finset.mem_filter.mp hz).2).symm + · rfl + · intro u hu + rfl + · intro z hz + rw [mem_seededNonsplitIdentityBoundarySolutions_iff] + have hzMem := Finset.mem_filter.mp hz + have hone : z.1 = 1 := not_ne_iff.mp hzMem.2 + simpa [hone] using + (mem_seededNonsplitTraceCurveSolutions_iff p k s d e z).mp hzMem.1 + · intro u hu + rw [Finset.mem_filter] + exact ⟨(mem_seededNonsplitTraceCurveSolutions_iff p k s d e _).mpr + ((mem_seededNonsplitIdentityBoundarySolutions_iff p k s d e u).mp hu), by simp⟩ + +/-- Exact count comparison, including the unique missing Cayley chart fiber `w = 1`. -/ +theorem seededNonsplitTraceCurveSolutions_card_eq_descended_add_identityBoundary + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) : + (seededNonsplitTraceCurveSolutions p k s d e).card = + (seededNonsplitDescendedSolutions p s.1 d e).card + + (seededNonsplitIdentityBoundarySolutions p k s d e).card := by + classical + have hsplit := Finset.card_filter_add_card_filter_not + (s := seededNonsplitTraceCurveSolutions p k s d e) (fun z => z.1 ≠ 1) + rw [nonidentityFilter_card_eq p k s d e, + ← seededNonsplitDescendedSolutions_card_eq_nonidentity_card p k s d e, + identityFilter_card_eq p k s d e] at hsplit + exact hsplit.symm + +/-- The one-variable polynomial cutting out the identity Cayley boundary. -/ +def seededNonsplitIdentityBoundaryPolynomial + (s : E p) (e : ℕ) : Polynomial (F p) := + Polynomial.X ^ (2 * e) - + Polynomial.C (Algebra.trace (F p) (E p) s) * Polynomial.X ^ e + 1 + +theorem seededNonsplitIdentityBoundaryEquation_iff + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) (u : (F p)ˣ) : + SeededNonsplitTraceCoverEquation p k s d e 1 u ↔ + (seededNonsplitIdentityBoundaryPolynomial p (s.1 : E p) e).eval (u : F p) = 0 := by + unfold SeededNonsplitTraceCoverEquation seededNonsplitIdentityBoundaryPolynomial + simp only [one_pow, Subgroup.coe_one, Units.val_one, mul_one, splitTorusTrace, + Units.val_pow_eq_pow_val, Units.val_inv_eq_inv_val, Polynomial.eval_add, + Polynomial.eval_sub, Polynomial.eval_mul, Polynomial.eval_pow, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_one] + rw [Nat.mul_comm 2 e, pow_mul] + constructor + · intro h + field_simp [Units.ne_zero u] at h + linear_combination -h + · intro h + field_simp [Units.ne_zero u] + linear_combination -h + +theorem seededNonsplitIdentityBoundaryPolynomial_ne_zero + (s : E p) (e : ℕ) (he : 0 < e) : + seededNonsplitIdentityBoundaryPolynomial p s e ≠ 0 := by + intro hzero + have hcoeff := congrArg (fun P : Polynomial (F p) => P.coeff 0) hzero + have he0 : e ≠ 0 := Nat.ne_of_gt he + have h0e : 0 ≠ e := he0.symm + have htwoe0 : 2 * e ≠ 0 := by omega + have h0twoe : 0 ≠ 2 * e := htwoe0.symm + simp [seededNonsplitIdentityBoundaryPolynomial, he0, h0e, htwoe0, h0twoe] at hcoeff + +theorem seededNonsplitIdentityBoundaryPolynomial_natDegree_le + (s : E p) (e : ℕ) : + (seededNonsplitIdentityBoundaryPolynomial p s e).natDegree ≤ 2 * e := by + unfold seededNonsplitIdentityBoundaryPolynomial + refine (Polynomial.natDegree_add_le _ _).trans (max_le ?_ (by simp)) + refine (Polynomial.natDegree_sub_le _ _).trans (max_le (by simp) ?_) + exact Polynomial.natDegree_mul_le.trans (by simp; omega) + +/-- The omitted identity fiber contributes at most `2e` points. -/ +theorem seededNonsplitIdentityBoundarySolutions_card_le + (k : (F p)ˣ) (s : ↑(quadraticNormFiber p k)) (d e : ℕ) (he : 0 < e) : + (seededNonsplitIdentityBoundarySolutions p k s d e).card ≤ 2 * e := by + classical + let P := seededNonsplitIdentityBoundaryPolynomial p (s.1 : E p) e + have hP : P ≠ 0 := seededNonsplitIdentityBoundaryPolynomial_ne_zero p _ e he + have hmaps : Set.MapsTo (fun u : (F p)ˣ => (u : F p)) + ↑(seededNonsplitIdentityBoundarySolutions p k s d e) ↑P.roots.toFinset := by + intro u hu + change (u : F p) ∈ P.roots.toFinset + rw [Multiset.mem_toFinset, Polynomial.mem_roots hP] + exact (seededNonsplitIdentityBoundaryEquation_iff p k s d e u).mp + ((mem_seededNonsplitIdentityBoundarySolutions_iff p k s d e u).mp hu) + have hinj : Set.InjOn (fun u : (F p)ˣ => (u : F p)) + ↑(seededNonsplitIdentityBoundarySolutions p k s d e) := by + intro u hu v hv huv + exact Units.ext huv + calc + _ ≤ P.roots.toFinset.card := Finset.card_le_card_of_injOn _ hmaps hinj + _ ≤ P.roots.card := Multiset.toFinset_card_le _ + _ ≤ P.natDegree := Polynomial.card_roots' P + _ ≤ 2 * e := seededNonsplitIdentityBoundaryPolynomial_natDegree_le p _ e + +/-- The generic seeded solution set is definitionally the existing-conic solution set after +specializing its norm-fiber index. -/ +theorem existingConicSeedNonsplitTraceCurveSolutions_eq_seeded + (t : F p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↑(quadraticConicNormFiber p t ht ht0)) (d e : ℕ) : + existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e = + seededNonsplitTraceCurveSolutions p + (quadraticFiberProductUnit p t ht ht0) s d e := by + ext z + simp [existingConicSeedNonsplitTraceCurveSolutions, + seededNonsplitTraceCurveSolutions, ExistingConicSeedNonsplitTraceCoverEquation] + +/-- Exact existing-conic count comparison with both affine boundaries exposed: `u = 0` +contributes nothing for positive exponents, while `w = 1` is the displayed boundary term. -/ +theorem existingConicSeedNonsplitTraceCurveSolutions_card_eq_affine_add_identityBoundary + (t : F p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↑(quadraticConicNormFiber p t ht ht0)) (d e : ℕ) + (hd : 0 < d) (he : 0 < e) : + (existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e).card = + (BGS.External.affinePlaneCurveZeros (F p) + (seededNonsplitDescendedPolynomial p s.1 d e)).card + + (seededNonsplitIdentityBoundarySolutions p + (quadraticFiberProductUnit p t ht ht0) s d e).card := by + rw [existingConicSeedNonsplitTraceCurveSolutions_eq_seeded] + rw [seededNonsplitTraceCurveSolutions_card_eq_descended_add_identityBoundary] + rw [← affinePlaneCurveZeros_seededNonsplitDescendedPolynomial_card_eq p s.1 d e hd he] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean new file mode 100644 index 0000000000..228cf5a466 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean @@ -0,0 +1,109 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption + +/-! +# The nonsplit endgame estimate from the general affine Hasse--Weil theorem + +This file applies the single permitted general Hasse--Weil input to the explicit descended +plane curve. The identity point omitted by the Cayley chart is kept visible and bounded +separately; it is not folded into a specialized estimate assumption. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- A fixed-coefficient affine Hasse--Weil bound supplies the correspondingly +fixed seeded nonsplit estimate. The coefficient `4*C + 2` records the +`(2d,2e)` bidegree and the at-most `2e` Cayley-chart boundary. -/ +theorem seededNonsplitTraceWeilBoundAssumption_of_bivariateAffineHasseWeilBound + (generalCoefficient : ℕ) + (hgeneral : BGS.External.BivariateAffineHasseWeilBound generalCoefficient) : + SeededNonsplitTraceWeilBoundAssumption (4 * generalCoefficient + 2) := by + let coefficient := 4 * generalCoefficient + 2 + change SeededNonsplitTraceWeilBoundAssumption coefficient + refine ⟨by dsimp [coefficient]; omega, ?_⟩ + intro p _ hpTwo t ht ht0 s d e hd he hirreducible + have hDescendedIrreducible := + seededNonsplitDescendedPolynomial_absolutelyIrreducible_of_splitCover + p s.1 d e hd he hirreducible + have hAffine := hgeneral (ZMod p) + (seededNonsplitDescendedPolynomial p s.1 d e) + (2 * d) (2 * e) (by omega) (by omega) + (seededNonsplitDescendedPolynomial_hasBidegreeAtMost p s.1 d e) + hDescendedIrreducible + have hCardNat := + existingConicSeedNonsplitTraceCurveSolutions_card_eq_affine_add_identityBoundary + p t ht ht0 s d e hd he + have hBoundaryNat := seededNonsplitIdentityBoundarySolutions_card_le p + (quadraticFiberProductUnit p t ht ht0) s d e he + let affineCard := + (BGS.External.affinePlaneCurveZeros (ZMod p) + (seededNonsplitDescendedPolynomial p s.1 d e)).card + let boundaryCard := + (seededNonsplitIdentityBoundarySolutions p + (quadraticFiberProductUnit p t ht ht0) s d e).card + let x : ℝ := Real.sqrt (p : ℝ) * (d : ℝ) * (e : ℝ) + have hCardReal : + ((existingConicSeedNonsplitTraceCurveSolutions + p t ht ht0 s d e).card : ℝ) = affineCard + boundaryCard := by + dsimp only [affineCard, boundaryCard] + exact_mod_cast hCardNat + have hBoundaryReal : (boundaryCard : ℝ) ≤ 2 * (e : ℝ) := by + exact_mod_cast hBoundaryNat + have hpOneNat : 1 ≤ p := (Fact.out : p.Prime).one_le + have hsqrtOne : (1 : ℝ) ≤ Real.sqrt (p : ℝ) := by + exact Real.one_le_sqrt.mpr (by exact_mod_cast hpOneNat) + have hdOne : (1 : ℝ) ≤ d := by exact_mod_cast hd + have heNonnegative : (0 : ℝ) ≤ e := by positivity + have hBoundaryAbsorb : (boundaryCard : ℝ) ≤ 2 * x := by + have hscaleOne : (1 : ℝ) ≤ Real.sqrt (p : ℝ) * (d : ℝ) := by + nlinarith + have heScale : (e : ℝ) ≤ + (Real.sqrt (p : ℝ) * (d : ℝ)) * (e : ℝ) := by + simpa only [one_mul] using + mul_le_mul_of_nonneg_right hscaleOne heNonnegative + calc + (boundaryCard : ℝ) ≤ 2 * (e : ℝ) := hBoundaryReal + _ ≤ 2 * (Real.sqrt (p : ℝ) * (d : ℝ) * (e : ℝ)) := by gcongr + _ = 2 * x := by rfl + have hAffine' : + |(affineCard : ℝ) - (p : ℝ)| ≤ + 4 * (generalCoefficient : ℝ) * x := by + dsimp only [affineCard] + rw [ZMod.card] at hAffine + norm_num only [Nat.cast_mul, Nat.cast_ofNat] at hAffine + convert hAffine using 1 <;> dsimp [x] <;> ring + rw [hCardReal] + calc + |((affineCard : ℝ) + boundaryCard) - (p : ℝ)| = + |((affineCard : ℝ) - (p : ℝ)) + boundaryCard| := by ring_nf + _ ≤ |(affineCard : ℝ) - (p : ℝ)| + |(boundaryCard : ℝ)| := abs_add_le _ _ + _ = |(affineCard : ℝ) - (p : ℝ)| + boundaryCard := by + have hbabs : |(boundaryCard : ℝ)| = boundaryCard := + abs_of_nonneg (Nat.cast_nonneg boundaryCard) + rw [hbabs] + _ ≤ 4 * (generalCoefficient : ℝ) * x + 2 * x := by gcongr + _ = (coefficient : ℝ) * Real.sqrt (p : ℝ) * (d : ℝ) * (e : ℝ) := by + dsimp [coefficient, x] + norm_num only [Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] + ring + +/-- The general affine Hasse--Weil theorem supplies the seeded nonsplit estimate. -/ +theorem exists_seededNonsplitTraceWeilBoundAssumption_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + ∃ coefficient : ℕ, SeededNonsplitTraceWeilBoundAssumption coefficient := by + obtain ⟨generalCoefficient, _hgeneralCoefficient, hgeneral⟩ := hHasse + exact ⟨4 * generalCoefficient + 2, + seededNonsplitTraceWeilBoundAssumption_of_bivariateAffineHasseWeilBound + generalCoefficient hgeneral⟩ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean new file mode 100644 index 0000000000..20ae9f447a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility + +/-! +# The seeded nonsplit endgame cover + +The endgame curve is not the trace of a bare norm-one element. A fixed seed `s` in a +nontrivial norm fibre is multiplied by the varying norm-one coordinate. After scalar extension +the two weights are `s` and `s^p`; their product is `Norm(s)`, not one. +-/ + +namespace BGS.Markoff + +section GeneralSeed + +variable (p : ℕ) [Fact p.Prime] + +/-- A split base-field unit transported to the canonical quadratic extension. -/ +noncomputable def seededBaseUnitInQuadraticField (u : (ZMod p)ˣ) : + (quadraticFiniteField p)ˣ := + Units.map (algebraMap (ZMod p) (quadraticFiniteField p)).toMonoidHom u + +/-- The actual seeded nonsplit cover. The seed lies in the norm-`k` torsor and the varying +coordinate lies in the norm-one torus. -/ +def SeededNonsplitTraceCoverEquation (k : (ZMod p)ˣ) + (s : ↑(quadraticNormFiber p k)) (d e : ℕ) + (w : quadraticNormOneTorus p) (u : (ZMod p)ˣ) : Prop := + Algebra.trace (ZMod p) (quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) * + (((w ^ d : quadraticNormOneTorus p) : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) = + splitTorusTrace (u ^ e) + +/-- The scalar extension of the seeded trace is the weighted trace with coefficients +`alpha = s` and `beta = s^p`. -/ +theorem algebraMap_seededQuadraticTrace_eq_weightedSplitTorusTrace + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) + (d : ℕ) (w : quadraticNormOneTorus p) : + algebraMap (ZMod p) (quadraticFiniteField p) + (Algebra.trace (ZMod p) (quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) * + (((w ^ d : quadraticNormOneTorus p) : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p))) = + weightedSplitTorusTrace + (s.1 : quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) ^ p) + ((w : (quadraticFiniteField p)ˣ) ^ d) := by + have hwcoe : + ((((w ^ d : quadraticNormOneTorus p) : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) = + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ d) := rfl + rw [algebraMap_quadraticTrace] + unfold weightedSplitTorusTrace + rw [mul_pow] + rw [quadraticNormOne_frobenius_eq_inv p (w ^ d)] + simp only [Units.val_pow_eq_pow_val, Units.val_inv_eq_inv_val] + rw [hwcoe] + +/-- The actual nonsplit cover is exactly the existing weighted split cover over the quadratic +field. The exponent order in `SplitTraceCurveEquation` is `(e,d)`. -/ +theorem seededNonsplitTraceCoverEquation_iff_weightedSplitTraceCover + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) + (d e : ℕ) (w : quadraticNormOneTorus p) (u : (ZMod p)ˣ) : + SeededNonsplitTraceCoverEquation p k s d e w u ↔ + SplitTraceCurveEquation + (s.1 : quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) ^ p) e d + (seededBaseUnitInQuadraticField p u) + (w : (quadraticFiniteField p)ˣ) := by + unfold SeededNonsplitTraceCoverEquation SplitTraceCurveEquation + have hleft := algebraMap_seededQuadraticTrace_eq_weightedSplitTorusTrace + p k s d w + constructor + · intro h + rw [← hleft, h] + simp [seededBaseUnitInQuadraticField, splitTorusTrace] + · intro h + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + rw [hleft, h] + simp [seededBaseUnitInQuadraticField, splitTorusTrace] + +/-- The product of the scalar-extended weights is exactly the prescribed seed norm. -/ +theorem seededNonsplitWeights_mul + (k : (ZMod p)ˣ) (s : ↑(quadraticNormFiber p k)) : + (s.1 : quadraticFiniteField p) * (s.1 : quadraticFiniteField p) ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) (k : ZMod p) := by + rw [quadraticNormFiber_frobenius_eq_norm_mul_inv p k s] + field_simp + +/-- A seed of norm different from one supplies exactly the coefficient hypotheses required by +the weighted split-cover irreducibility theorem. -/ +theorem seededNonsplitWeights_nondegenerate + (k : (ZMod p)ˣ) (hk : k ≠ 1) (s : ↑(quadraticNormFiber p k)) : + (s.1 : quadraticFiniteField p) ≠ 0 ∧ + (s.1 : quadraticFiniteField p) ^ p ≠ 0 ∧ + (s.1 : quadraticFiniteField p) * (s.1 : quadraticFiniteField p) ^ p ≠ 1 := by + refine ⟨Units.ne_zero s.1, pow_ne_zero p (Units.ne_zero s.1), ?_⟩ + rw [seededNonsplitWeights_mul p k s] + intro hmap + apply hk + apply Units.ext + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + simpa using hmap + +end GeneralSeed + +section ExistingConicSeed + +variable (p : ℕ) [Fact p.Prime] + +/-- For an odd prime, the existing nonzero nonparabolic conic invariant +`kappa(t) = t^2/(t^2-4)` is not one. -/ +theorem quadraticFiberProduct_ne_one_of_prime_ne_two + (hpTwo : p ≠ 2) (t : ZMod p) (ht : t ^ 2 ≠ 4) : + quadraticFiberProduct p t ≠ 1 := by + have hfourE := four_ne_zero_quadraticFiniteField_of_prime_ne_two p hpTwo + have hfour : (4 : ZMod p) ≠ 0 := + (map_ne_zero (algebraMap (ZMod p) (quadraticFiniteField p))).mp hfourE + intro hkappa + have hden : t ^ 2 - 4 ≠ 0 := sub_ne_zero.mpr ht + have heq : t ^ 2 = 1 * (t ^ 2 - 4) := by + exact (div_eq_iff hden).mp hkappa + apply hfour + linear_combination heq + +/-- The unit indexing the existing conic norm fibre is nontrivial. -/ +theorem quadraticFiberProductUnit_ne_one + (hpTwo : p ≠ 2) (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) : + quadraticFiberProductUnit p t ht ht0 ≠ 1 := by + intro h + have hval := congrArg Units.val h + apply quadraticFiberProduct_ne_one_of_prime_ne_two p hpTwo t ht + change quadraticFiberProduct p t = 1 at hval + exact hval + +/-- Every seed from the existing nonsplit conic construction has nonzero weighted coefficients +whose product is the embedded invariant `kappa(t)`, and this product is not one. -/ +theorem existingConicSeed_nonsplitWeights_nondegenerate + (hpTwo : p ≠ 2) (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↑(quadraticConicNormFiber p t ht ht0)) : + (s.1 : quadraticFiniteField p) ≠ 0 ∧ + (s.1 : quadraticFiniteField p) ^ p ≠ 0 ∧ + (s.1 : quadraticFiniteField p) * (s.1 : quadraticFiniteField p) ^ p ≠ 1 := by + exact seededNonsplitWeights_nondegenerate p + (quadraticFiberProductUnit p t ht ht0) + (quadraticFiberProductUnit_ne_one p hpTwo t ht ht0) s + +/-- The corrected nonsplit cover lands in the already-proved arbitrary positive-exponent +weighted-cover theorem after quadratic scalar extension. In the polynomial convention the +base-field exponent `e` is the first exponent and the norm-one exponent `d` is the second, so +the characteristic hypothesis is required on `d`. -/ +theorem existingConicSeed_weightedCover_absolutelyIrreducible + (hpTwo : p ≠ 2) (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hdChar : (d : quadraticFiniteField p) ≠ 0) : + Irreducible + (MvPolynomial.map + (algebraMap (quadraticFiniteField p) (AlgebraicClosure (quadraticFiniteField p))) + (splitTraceCoverPolynomial + (s.1 : quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) ^ p) e d)) := by + obtain ⟨halpha, hbeta, hproduct⟩ := + existingConicSeed_nonsplitWeights_nondegenerate p hpTwo t ht ht0 s + exact splitTraceCoverPolynomial_absolutelyIrreducible_of_positiveExponents + (s.1 : quadraticFiniteField p) ((s.1 : quadraticFiniteField p) ^ p) + halpha hbeta hproduct d e hd he hdChar + +/-- The endgame equation specialized to the seed type already constructed by the conic +parametrization module. -/ +def ExistingConicSeedNonsplitTraceCoverEquation + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↑(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) (w : quadraticNormOneTorus p) (u : (ZMod p)ˣ) : Prop := + SeededNonsplitTraceCoverEquation p + (quadraticFiberProductUnit p t ht ht0) s d e w u + +theorem existingConicSeedNonsplitTraceCoverEquation_iff_weightedSplitTraceCover + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↑(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) (w : quadraticNormOneTorus p) (u : (ZMod p)ˣ) : + ExistingConicSeedNonsplitTraceCoverEquation p t ht ht0 s d e w u ↔ + SplitTraceCurveEquation + (s.1 : quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) ^ p) e d + (seededBaseUnitInQuadraticField p u) + (w : (quadraticFiniteField p)ˣ) := by + exact seededNonsplitTraceCoverEquation_iff_weightedSplitTraceCover p + (quadraticFiberProductUnit p t ht ht0) s d e w u + +end ExistingConicSeed + +namespace DegenerateUnseededCountermodel + +variable (p : ℕ) [Fact p.Prime] + +/-- This is the tempting but incorrect unseeded model. It is retained only to state the +degeneracy explicitly. -/ +def UnseededNormOneTraceCountermodel (d e : ℕ) + (w : quadraticNormOneTorus p) (u : (ZMod p)ˣ) : Prop := + quadraticNormOneTrace p (w ^ d) = splitTorusTrace (u ^ e) + +theorem unseededCountermodel_weights_product_eq_one : + (1 : quadraticFiniteField p) * 1 = 1 := by simp + +end DegenerateUnseededCountermodel + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean new file mode 100644 index 0000000000..49f70ae98f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean @@ -0,0 +1,216 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers + +/-! +# The parabolic branch of the endgame + +The two parabolic fibers are affine lines. Their explicit rotation formulas make the second +coordinate run through the whole base field, so in particular through the trace of a generator +of the split torus. +-/ + +namespace BGS.Markoff + +noncomputable section + +private theorem exists_fullOrderBaseUnit (p : ℕ) [Fact p.Prime] : + ∃ u : (ZMod p)ˣ, orderOf u = Nat.card (ZMod p)ˣ := by + obtain ⟨u, hu⟩ := IsCyclic.exists_generator (α := (ZMod p)ˣ) + exact ⟨u, orderOf_eq_card_of_forall_mem_zpowers hu⟩ + +private theorem two_ne_zero_zmod_of_prime_ne_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) : (2 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).mp hzero + have hpLe : p ≤ 2 := Nat.le_of_dvd (by norm_num) hpDvd + exact hpTwo (Nat.le_antisymm hpLe (Fact.out : p.Prime).two_le) + +/-- Every point of the trace-`2` fiber reaches a primitive split trace in its second +coordinate. -/ +theorem exists_iterate_parabolicTwoPoint_with_primitive_secondTrace + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (x : ↥(normalizedFiber1 (2 : ZMod p))) : + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) (x : NormalizedPoint (ZMod p))).u2 = + splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + have htwo := two_ne_zero_zmod_of_prime_ne_two p hpTwo + let i : ZMod p := (x.1.u3 - x.1.u2) / 2 + have hi : i ^ 2 = -1 := by + have hsurface : + IsNormalizedMarkoff + (⟨(2 : ZMod p), x.1.u2, x.1.u3⟩ : NormalizedPoint (ZMod p)) := by + simpa [← x.property.2] using x.property.1 + have hsquare := (isNormalizedMarkoff_at_two_iff x.1.u2 x.1.u3).mp hsurface + dsimp [i] + field_simp [htwo] + linear_combination hsquare + have hx : (x : NormalizedPoint (ZMod p)) = parabolicLineAtTwo i x.1.u2 := by + ext + · exact x.property.2 + · rfl + · dsimp [parabolicLineAtTwo, i] + field_simp [htwo] + ring + have hi0 : i ≠ 0 := by + intro hzero + rw [hzero] at hi + norm_num at hi + have hstep : (2 : ZMod p) * i ≠ 0 := mul_ne_zero htwo hi0 + obtain ⟨u, huOrder⟩ := exists_fullOrderBaseUnit p + let a : ZMod p := (splitTorusTrace u - x.1.u2) / (2 * i) + let n : ℕ := a.val + have hn : (n : ZMod p) = a := by + exact ZMod.natCast_zmod_val a + refine ⟨n, u, ?_, huOrder⟩ + rw [hx, iterate_normalizedRotate1_parabolicLineAtTwo] + change x.1.u2 + (n : ZMod p) * (2 * i) = splitTorusTrace u + rw [hn] + dsimp [a] + field_simp [hstep] + ring + +/-- Every point of the trace-`-2` fiber reaches a primitive split trace in its second +coordinate. -/ +theorem exists_iterate_parabolicNegTwoPoint_with_primitive_secondTrace + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (x : ↥(normalizedFiber1 (-2 : ZMod p))) : + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) (x : NormalizedPoint (ZMod p))).u2 = + splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + have htwo := two_ne_zero_zmod_of_prime_ne_two p hpTwo + let i : ZMod p := (x.1.u3 + x.1.u2) / 2 + have hi : i ^ 2 = -1 := by + have hsurface : + IsNormalizedMarkoff + (⟨(-2 : ZMod p), x.1.u2, x.1.u3⟩ : NormalizedPoint (ZMod p)) := by + simpa [← x.property.2] using x.property.1 + have hsquare := (isNormalizedMarkoff_at_neg_two_iff x.1.u2 x.1.u3).mp hsurface + dsimp [i] + field_simp [htwo] + linear_combination hsquare + have hx : (x : NormalizedPoint (ZMod p)) = parabolicLineAtNegTwo i x.1.u2 := by + ext + · exact x.property.2 + · rfl + · dsimp [parabolicLineAtNegTwo, i] + field_simp [htwo] + ring + have hi0 : i ≠ 0 := by + intro hzero + rw [hzero] at hi + norm_num at hi + have hfour : (4 : ZMod p) ≠ 0 := by + rw [show (4 : ZMod p) = 2 * 2 by norm_num] + exact mul_ne_zero htwo htwo + have hstep : (4 : ZMod p) * i ≠ 0 := mul_ne_zero hfour hi0 + obtain ⟨u, huOrder⟩ := exists_fullOrderBaseUnit p + let a : ZMod p := (x.1.u2 - splitTorusTrace u) / (4 * i) + let k : ℕ := a.val + have hk : (k : ZMod p) = a := ZMod.natCast_zmod_val a + refine ⟨2 * k, u, ?_, huOrder⟩ + rw [hx, iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo] + change x.1.u2 - (k : ZMod p) * (4 * i) = splitTorusTrace u + rw [hk] + dsimp [a] + field_simp [hstep] + ring + +/-- Unified parabolic branch. -/ +theorem exists_iterate_parabolicPoint_with_primitive_secondTrace + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 = 4) (x : ↥(normalizedFiber1 t)) : + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) (x : NormalizedPoint (ZMod p))).u2 = + splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + have htCases : t = 2 ∨ t = -2 := by + apply (sq_eq_sq_iff_eq_or_eq_neg).mp + calc + t ^ 2 = 4 := ht + _ = (2 : ZMod p) ^ 2 := by norm_num + rcases htCases with rfl | rfl + · exact exists_iterate_parabolicTwoPoint_with_primitive_secondTrace p hpTwo x + · exact exists_iterate_parabolicNegTwoPoint_with_primitive_secondTrace p hpTwo x + +/-- For primes at least five, the primitive trace reached in the parabolic branch has maximal +split rotation order `p - 1`. -/ +theorem exists_iterate_parabolicPoint_with_maximal_secondRotation + (p : ℕ) [Fact p.Prime] (hpFive : 5 ≤ p) + (t : ZMod p) (ht : t ^ 2 = 4) (x : ↥(normalizedFiber1 t)) : + ∃ n : ℕ, + rotationOrder + (((normalizedRotate1^[n]) + (x : NormalizedPoint (ZMod p))).u2) = p - 1 := by + obtain ⟨n, u, hcoordinate, huOrder⟩ := + exists_iterate_parabolicPoint_with_primitive_secondTrace p (by omega) t ht x + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huPower + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huPower + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + omega + refine ⟨n, ?_⟩ + rw [hcoordinate, rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + +/-- Full first-coordinate form of Proposition 10, including semisimple, parabolic, and the +trace-zero exclusion. -/ +theorem exists_threshold_point_with_maximal_secondRotation + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (t : ZMod p) (x : ↥(normalizedFiber1 t)), + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder t → + ∃ n : ℕ, + rotationOrder + (((normalizedRotate1^[n]) + (x : NormalizedPoint (ZMod p))).u2) = p - 1 := by + obtain ⟨semisimpleThreshold, hSemisimple⟩ := + exists_threshold_nonparabolicPoint_with_maximal_secondRotation + splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ + have hexponent : (0 : ℝ) < (1 : ℝ) / 2 + δ := by linarith + have hZeroAbsorb : + ∀ᶠ p : ℕ in Filter.atTop, + 4 < (p : ℝ) ^ ((1 : ℝ) / 2 + δ) := by + simpa using + (eventually_const_mul_rpow_lt_rpow + (C := (4 : ℝ)) (a := (0 : ℝ)) (b := (1 : ℝ) / 2 + δ) hexponent) + obtain ⟨zeroThreshold, hZeroThreshold⟩ := Filter.eventually_atTop.mp hZeroAbsorb + refine ⟨max (max semisimpleThreshold zeroThreshold) 5, ?_⟩ + intro p hp _ t x hlarge + have hpSemisimple : semisimpleThreshold ≤ p := + (le_max_left semisimpleThreshold zeroThreshold).trans + ((le_max_left (max semisimpleThreshold zeroThreshold) 5).trans hp) + have hpZero : zeroThreshold ≤ p := + (le_max_right semisimpleThreshold zeroThreshold).trans + ((le_max_left (max semisimpleThreshold zeroThreshold) 5).trans hp) + by_cases htParabolic : t ^ 2 = 4 + · exact exists_iterate_parabolicPoint_with_maximal_secondRotation + p (by omega) t htParabolic x + · have ht0 : t ≠ 0 := by + intro htZero + subst t + have horderSmall := rotationOrder_zero_le_four p + have hlargeLe : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ 4 := + hlarge.trans (by exact_mod_cast horderSmall) + exact (not_lt_of_ge hlargeLe) (hZeroThreshold p hpZero) + exact hSemisimple p hpSemisimple t htParabolic ht0 x hlarge + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean new file mode 100644 index 0000000000..b9f5b3a248 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean @@ -0,0 +1,106 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.GroupTheory.SpecificGroups.Cyclic +import Mathlib.GroupTheory.Coset.Basic + +/-! +# Exact power-cover multiplicities in the endgame + +The paper divides its trace-cover point count by the two power-map degrees. This module proves +that step exactly for finite cyclic groups: a cover solution is a target trace solution together +with one point in each power-map fiber, and every such fiber is equivalent to the corresponding +kernel. No asymptotic or geometric estimate enters this multiplicity identity. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {G H T : Type*} [CommGroup G] [CommGroup H] + +/-- Solutions of a trace equation after applying power maps to two finite groups. -/ +def powerTraceCoverSolutions + (leftTrace : G → T) (rightTrace : H → T) (d e : ℕ) := + {z : G × H // leftTrace (z.1 ^ d) = rightTrace (z.2 ^ e)} + +/-- The corresponding equation on the two power-map images. -/ +def powerTraceRangeSolutions + (leftTrace : G → T) (rightTrace : H → T) (d e : ℕ) := + {z : (powMonoidHom d : G →* G).range × (powMonoidHom e : H →* H).range // + leftTrace z.1 = rightTrace z.2} + +/-- A power-cover solution is a target solution together with one point in each power-map fiber. -/ +def powerTraceCoverEquivSigmaFibers + (leftTrace : G → T) (rightTrace : H → T) (d e : ℕ) : + powerTraceCoverSolutions leftTrace rightTrace d e ≃ + Σ s : powerTraceRangeSolutions leftTrace rightTrace d e, + ((powMonoidHom d : G →* G) ⁻¹' {(s.1.1 : G)} : Set G) × + ((powMonoidHom e : H →* H) ⁻¹' {(s.1.2 : H)} : Set H) where + toFun z := ⟨⟨⟨⟨z.1.1 ^ d, ⟨z.1.1, by simp⟩⟩, + ⟨z.1.2 ^ e, ⟨z.1.2, by simp⟩⟩⟩, z.2⟩, + ⟨⟨z.1.1, by simp⟩, ⟨z.1.2, by simp⟩⟩⟩ + invFun w := ⟨(w.2.1.1, w.2.2.1), by + have hx : (powMonoidHom d : G →* G) w.2.1.1 = (w.1.1.1 : G) := w.2.1.2 + have hy : (powMonoidHom e : H →* H) w.2.2.1 = (w.1.1.2 : H) := w.2.2.2 + change leftTrace (w.2.1.1 ^ d) = rightTrace (w.2.2.1 ^ e) + rw [show w.2.1.1 ^ d = w.1.1.1 by exact hx, + show w.2.2.1 ^ e = w.1.1.2 by exact hy] + exact w.1.2⟩ + left_inv z := by rfl + right_inv w := by + rcases w with ⟨⟨⟨⟨sx, hsx⟩, ⟨sy, hsy⟩⟩, hs⟩, + ⟨⟨x, hx⟩, ⟨y, hy⟩⟩⟩ + simp only [Set.mem_preimage, Set.mem_singleton_iff] at hx hy + dsimp at hx hy ⊢ + subst sx + subst sy + rfl + +theorem natCard_powerMapFiber_eq_ker + [Finite G] (d : ℕ) (x : (powMonoidHom d : G →* G).range) : + Nat.card ((powMonoidHom d : G →* G) ⁻¹' {x.1} : Set G) = + Nat.card (powMonoidHom d : G →* G).ker := by + obtain ⟨a, ha⟩ := x.2 + have hset : + (powMonoidHom d : G →* G) ⁻¹' {x.1} = + (powMonoidHom d : G →* G) ⁻¹' {(powMonoidHom d) a} := by + rw [ha] + rw [hset] + exact Nat.card_congr ((powMonoidHom d : G →* G).fiberEquivKer a) + +theorem natCard_powerTraceCoverSolutions + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (d e : ℕ) : + Nat.card (powerTraceCoverSolutions leftTrace rightTrace d e) = + Nat.card (powMonoidHom d : G →* G).ker * + Nat.card (powMonoidHom e : H →* H).ker * + Nat.card (powerTraceRangeSolutions leftTrace rightTrace d e) := by + letI : Finite (powMonoidHom d : G →* G).range := + Finite.of_injective Subtype.val Subtype.val_injective + letI : Finite (powMonoidHom e : H →* H).range := + Finite.of_injective Subtype.val Subtype.val_injective + letI : Finite (powerTraceRangeSolutions leftTrace rightTrace d e) := + Finite.of_injective Subtype.val Subtype.val_injective + letI := Fintype.ofFinite (powerTraceRangeSolutions leftTrace rightTrace d e) + rw [Nat.card_congr (powerTraceCoverEquivSigmaFibers leftTrace rightTrace d e), + Nat.card_sigma] + simp_rw [Nat.card_prod, natCard_powerMapFiber_eq_ker] + simp [mul_comm] + +theorem natCard_powerTraceCoverSolutions_of_dvd + [Finite G] [Finite H] [IsCyclic G] [IsCyclic H] + (leftTrace : G → T) (rightTrace : H → T) (d e : ℕ) + (hd : d ∣ Nat.card G) (he : e ∣ Nat.card H) : + Nat.card (powerTraceCoverSolutions leftTrace rightTrace d e) = + d * e * Nat.card (powerTraceRangeSolutions leftTrace rightTrace d e) := by + rw [natCard_powerTraceCoverSolutions, + IsCyclic.card_powMonoidHom_ker, IsCyclic.card_powMonoidHom_ker, + Nat.gcd_eq_right_iff_dvd.mpr hd, Nat.gcd_eq_right_iff_dvd.mpr he] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean new file mode 100644 index 0000000000..0a26352a0f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean @@ -0,0 +1,933 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +import Mathlib.NumberTheory.ArithmeticFunction.Moebius + +/-! +# Möbius inclusion--exclusion for primitive endgame traces + +This file formalizes published equations (35)--(36). For a fixed left power-map image and a +finite cyclic right group, it partitions trace coincidences by the exact order of the right-hand +element, applies Möbius inversion, and identifies the cumulative order-divisibility count with the +corresponding right power-map image. +-/ + +namespace BGS.Markoff + +open scoped ArithmeticFunction.Moebius BigOperators +open Filter + +noncomputable section + +variable {G H T : Type*} [CommGroup G] [CommGroup H] + +/-- In a finite cyclic group, the image of the `d`-th power map is the kernel of the +`(card / d)`-th power map whenever `d` divides the group order. -/ +theorem powMonoidHom_range_eq_ker_complementaryExponent + [Finite H] [IsCyclic H] (d : ℕ) (hdvd : d ∣ Nat.card H) : + (powMonoidHom d : H →* H).range = + (powMonoidHom (Nat.card H / d) : H →* H).ker := by + letI := Fintype.ofFinite H + apply Subgroup.eq_of_le_of_card_ge + · rintro y ⟨x, rfl⟩ + change (x ^ d) ^ (Nat.card H / d) = 1 + rw [← pow_mul, Nat.mul_div_cancel' hdvd, Nat.card_eq_fintype_card, pow_card_eq_one] + · rw [IsCyclic.card_powMonoidHom_ker, IsCyclic.card_powMonoidHom_range] + rw [Nat.gcd_eq_right (Nat.div_dvd_of_dvd hdvd)] + rw [Nat.gcd_eq_right hdvd] + +/-- In a finite cyclic group, the image of the complementary power map is exactly the cyclic +subgroup generated by the element whose order defines that complementary exponent. This is +the bridge between the endgame count, which is naturally stated on a power-map image, and the +rotation orbit, which is naturally stated as `Subgroup.zpowers w`. -/ +theorem powMonoidHom_range_eq_zpowers_of_complementaryOrder + {K : Type*} [CommGroup K] [Finite K] [IsCyclic K] (w : K) : + (powMonoidHom (Nat.card K / orderOf w) : K →* K).range = + Subgroup.zpowers w := by + let n := Nat.card K + let m := orderOf w + let e := n / m + have hn : 0 < n := Nat.card_pos + have hm : 0 < m := orderOf_pos w + have hmDvd : m ∣ n := orderOf_dvd_natCard w + have hmLe : m ≤ n := Nat.le_of_dvd hn hmDvd + have he : 0 < e := Nat.div_pos hmLe hm + have heDvd : e ∣ n := Nat.div_dvd_of_dvd hmDvd + have hComplement : n / e = m := by + apply (Nat.div_eq_iff_eq_mul_right he heDvd).2 + exact (Nat.div_mul_cancel hmDvd).symm + symm + apply Subgroup.eq_of_le_of_card_ge + · rw [Subgroup.zpowers_le] + rw [powMonoidHom_range_eq_ker_complementaryExponent (H := K) e heDvd] + change w ^ (n / e) = 1 + rw [hComplement] + exact pow_orderOf_eq_one w + · rw [Nat.card_zpowers, IsCyclic.card_powMonoidHom_range] + change n / n.gcd e ≤ m + rw [Nat.gcd_eq_right_iff_dvd.mpr heDvd, hComplement] + +/-- All trace coincidences with the left coordinate restricted to one power-map image. -/ +noncomputable def traceRelationPairs + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent : ℕ) : + Finset ((powMonoidHom leftExponent : G →* G).range × H) := by + classical + letI := Fintype.ofFinite G + letI := Fintype.ofFinite H + exact Finset.univ.filter fun z => leftTrace z.1 = rightTrace z.2 + +/-- Trace coincidences whose right coordinate has one exact multiplicative order. -/ +noncomputable def traceExactOrderSolutions + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent order : ℕ) : + Finset ((powMonoidHom leftExponent : G →* G).range × H) := by + classical + exact (traceRelationPairs leftTrace rightTrace leftExponent).filter fun z => + orderOf z.2 = order + +/-- Trace coincidences whose right coordinate is killed by one power. -/ +noncomputable def tracePowerKernelSolutions + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent exponent : ℕ) : + Finset ((powMonoidHom leftExponent : G →* G).range × H) := by + classical + exact (traceRelationPairs leftTrace rightTrace leftExponent).filter fun z => + z.2 ^ exponent = 1 + +@[simp] +theorem mem_traceExactOrderSolutions_iff + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent order : ℕ) + (z : (powMonoidHom leftExponent : G →* G).range × H) : + z ∈ traceExactOrderSolutions leftTrace rightTrace leftExponent order ↔ + leftTrace z.1 = rightTrace z.2 ∧ orderOf z.2 = order := by + classical + simp [traceExactOrderSolutions, traceRelationPairs] + +@[simp] +theorem mem_tracePowerKernelSolutions_iff + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent exponent : ℕ) + (z : (powMonoidHom leftExponent : G →* G).range × H) : + z ∈ tracePowerKernelSolutions leftTrace rightTrace leftExponent exponent ↔ + leftTrace z.1 = rightTrace z.2 ∧ z.2 ^ exponent = 1 := by + classical + simp [tracePowerKernelSolutions, traceRelationPairs] + +/-- Exact-order classes partition the trace coincidences killed by the `m`-th power map. -/ +theorem sum_traceExactOrderSolutions_card_eq_tracePowerKernelSolutions_card + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent m : ℕ) (hm : 0 < m) : + ∑ order ∈ m.divisors, + (traceExactOrderSolutions leftTrace rightTrace leftExponent order).card = + (tracePowerKernelSolutions leftTrace rightTrace leftExponent m).card := by + classical + simp only [traceExactOrderSolutions] + rw [Finset.sum_card_fiberwise_eq_card_filter] + apply congrArg Finset.card + ext z + simp [tracePowerKernelSolutions, Nat.mem_divisors, hm.ne', + orderOf_dvd_iff_pow_eq_one] + +/-- Möbius inversion recovers the exact-order trace count from the power-kernel counts. -/ +theorem moebius_sum_tracePowerKernelSolutions_card_eq_traceExactOrderSolutions_card + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent n : ℕ) (hn : 0 < n) : + ∑ x ∈ n.divisorsAntidiagonal, + (μ x.fst : ℤ) * + (tracePowerKernelSolutions leftTrace rightTrace leftExponent x.snd).card = + (traceExactOrderSolutions leftTrace rightTrace leftExponent n).card := by + have hinversion := + (ArithmeticFunction.sum_eq_iff_sum_mul_moebius_eq + (R := ℤ) + (f := fun order => + ((traceExactOrderSolutions leftTrace rightTrace leftExponent order).card : ℤ)) + (g := fun exponent => + ((tracePowerKernelSolutions leftTrace rightTrace leftExponent exponent).card : ℤ))).mp + (fun m hm => by + exact_mod_cast + sum_traceExactOrderSolutions_card_eq_tracePowerKernelSolutions_card + leftTrace rightTrace leftExponent m hm) + exact hinversion n hn + +/-- A right power-range solution is a right power-kernel solution whenever the two subgroups are +identified. -/ +def powerTraceRangeSolutionsEquivTracePowerKernelSolutions + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent rightExponent kernelExponent : ℕ) + (hsubgroup : + (powMonoidHom rightExponent : H →* H).range = + (powMonoidHom kernelExponent : H →* H).ker) : + powerTraceRangeSolutions leftTrace rightTrace leftExponent rightExponent ≃ + ↥(tracePowerKernelSolutions leftTrace rightTrace leftExponent kernelExponent) where + toFun z := ⟨(z.1.1, z.1.2.1), by + rw [mem_tracePowerKernelSolutions_iff] + refine ⟨z.2, ?_⟩ + have hzker : z.1.2.1 ∈ (powMonoidHom kernelExponent : H →* H).ker := by + rw [← hsubgroup] + exact z.1.2.2 + exact hzker⟩ + invFun z := ⟨(z.1.1, ⟨z.1.2, by + rw [hsubgroup] + exact (mem_tracePowerKernelSolutions_iff + leftTrace rightTrace leftExponent kernelExponent z.1).mp z.2 |>.2⟩), + (mem_tracePowerKernelSolutions_iff + leftTrace rightTrace leftExponent kernelExponent z.1).mp z.2 |>.1⟩ + left_inv z := by rfl + right_inv z := by rfl + +/-- Cardinal form of `powerTraceRangeSolutionsEquivTracePowerKernelSolutions`. -/ +theorem natCard_powerTraceRangeSolutions_eq_tracePowerKernelSolutions_card + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent rightExponent kernelExponent : ℕ) + (hsubgroup : + (powMonoidHom rightExponent : H →* H).range = + (powMonoidHom kernelExponent : H →* H).ker) : + Nat.card (powerTraceRangeSolutions leftTrace rightTrace leftExponent rightExponent) = + (tracePowerKernelSolutions leftTrace rightTrace leftExponent kernelExponent).card := by + calc + Nat.card (powerTraceRangeSolutions leftTrace rightTrace leftExponent rightExponent) = + Nat.card ↥(tracePowerKernelSolutions leftTrace rightTrace + leftExponent kernelExponent) := + Nat.card_congr + (powerTraceRangeSolutionsEquivTracePowerKernelSolutions + leftTrace rightTrace leftExponent rightExponent kernelExponent hsubgroup) + _ = (tracePowerKernelSolutions leftTrace rightTrace + leftExponent kernelExponent).card := by + rw [Nat.card_eq_fintype_card, Fintype.card_coe] + +/-- Published equation (35): the exact-order trace count is the Möbius-weighted sum of the +counts on right power-map images. -/ +theorem moebius_sum_powerTraceRangeSolutions_card_eq_traceExactOrderSolutions_card + [Finite G] [Finite H] [IsCyclic H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent : ℕ) : + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℤ) * + Nat.card (powerTraceRangeSolutions + leftTrace rightTrace leftExponent x.fst) = + (traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card := by + rw [← moebius_sum_tracePowerKernelSolutions_card_eq_traceExactOrderSolutions_card + leftTrace rightTrace leftExponent (Nat.card H) Nat.card_pos] + apply Finset.sum_congr rfl + intro x hx + congr 1 + have hproduct := (Nat.mem_divisorsAntidiagonal.mp hx).1 + have hleftNe : x.fst ≠ 0 := Nat.left_ne_zero_of_mem_divisorsAntidiagonal hx + have hdvd : x.fst ∣ Nat.card H := ⟨x.snd, hproduct.symm⟩ + have hquotient : Nat.card H / x.fst = x.snd := by + rw [← hproduct, Nat.mul_comm x.fst x.snd, + Nat.mul_div_left x.snd (Nat.pos_of_ne_zero hleftNe)] + rw [natCard_powerTraceRangeSolutions_eq_tracePowerKernelSolutions_card + leftTrace rightTrace leftExponent x.fst x.snd] + simpa [hquotient] using + powMonoidHom_range_eq_ker_complementaryExponent (H := H) x.fst hdvd + +/-- Swapping the two coordinates preserves a power-range trace equation. -/ +def powerTraceRangeSolutionsSwapEquiv + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent rightExponent : ℕ) : + powerTraceRangeSolutions leftTrace rightTrace leftExponent rightExponent ≃ + powerTraceRangeSolutions rightTrace leftTrace rightExponent leftExponent where + toFun z := ⟨(z.1.2, z.1.1), z.2.symm⟩ + invFun z := ⟨(z.1.2, z.1.1), z.2.symm⟩ + left_inv z := by rfl + right_inv z := by rfl + +theorem natCard_powerTraceRangeSolutions_swap + [Finite G] [Finite H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent rightExponent : ℕ) : + Nat.card (powerTraceRangeSolutions leftTrace rightTrace leftExponent rightExponent) = + Nat.card (powerTraceRangeSolutions rightTrace leftTrace rightExponent leftExponent) := + Nat.card_congr + (powerTraceRangeSolutionsSwapEquiv leftTrace rightTrace leftExponent rightExponent) + +/-- The number of divisor-antidiagonal pairs equals the number of divisors. -/ +theorem card_divisorsAntidiagonal_eq_card_divisors (n : ℕ) : + n.divisorsAntidiagonal.card = n.divisors.card := by + simpa only [Finset.card_eq_sum_ones] using + (Nat.sum_divisorsAntidiagonal (fun _ _ => (1 : ℕ)) (n := n)) + +/-- Summing individually bounded errors with Möbius coefficients costs at most the divisor count. -/ +theorem abs_moebius_weighted_sum_sub_le_divisors_card_mul + (n : ℕ) (count mainTerm : ℕ × ℕ → ℝ) (error : ℝ) + (hterm : ∀ x ∈ n.divisorsAntidiagonal, + |count x - mainTerm x| ≤ error) : + |(∑ x ∈ n.divisorsAntidiagonal, (μ x.fst : ℝ) * count x) - + ∑ x ∈ n.divisorsAntidiagonal, (μ x.fst : ℝ) * mainTerm x| ≤ + (n.divisors.card : ℝ) * error := by + let s := n.divisorsAntidiagonal + have hrewrite : + (∑ x ∈ s, (μ x.fst : ℝ) * count x) - + ∑ x ∈ s, (μ x.fst : ℝ) * mainTerm x = + ∑ x ∈ s, (μ x.fst : ℝ) * (count x - mainTerm x) := by + rw [← Finset.sum_sub_distrib] + apply Finset.sum_congr rfl + intro x hx + ring + rw [hrewrite] + calc + |∑ x ∈ s, (μ x.fst : ℝ) * (count x - mainTerm x)| ≤ + ∑ x ∈ s, |(μ x.fst : ℝ) * (count x - mainTerm x)| := + Finset.abs_sum_le_sum_abs _ _ + _ ≤ ∑ _x ∈ s, error := by + apply Finset.sum_le_sum + intro x hx + rw [abs_mul] + have hmu : |(μ x.fst : ℝ)| ≤ 1 := by + exact_mod_cast ArithmeticFunction.abs_moebius_le_one (n := x.fst) + calc + |(μ x.fst : ℝ)| * |count x - mainTerm x| ≤ 1 * error := + mul_le_mul hmu (hterm x hx) (abs_nonneg _) zero_le_one + _ = error := one_mul error + _ = (s.card : ℝ) * error := by simp + _ = (n.divisors.card : ℝ) * error := by + rw [card_divisorsAntidiagonal_eq_card_divisors] + +/-- Equation (36), before simplifying its main term: pointwise range-count estimates give a +divisor-count error envelope for the primitive trace count. -/ +theorem traceExactOrderSolutions_card_error_le_moebiusMain + [Finite G] [Finite H] [IsCyclic H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent : ℕ) + (mainTerm : ℕ → ℝ) (error : ℝ) + (hRange : ∀ d : ℕ, d ∣ Nat.card H → 0 < d → + |(Nat.card (powerTraceRangeSolutions + leftTrace rightTrace leftExponent d) : ℝ) - mainTerm d| ≤ error) : + |((traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card : ℝ) - + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst| ≤ + ((Nat.card H).divisors.card : ℝ) * error := by + have hExact := + moebius_sum_powerTraceRangeSolutions_card_eq_traceExactOrderSolutions_card + leftTrace rightTrace leftExponent + have hExactReal : + ((traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card : ℝ) = + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * + (Nat.card (powerTraceRangeSolutions + leftTrace rightTrace leftExponent x.fst) : ℝ) := by + exact_mod_cast hExact.symm + rw [hExactReal] + apply abs_moebius_weighted_sum_sub_le_divisors_card_mul + (Nat.card H) + (fun x => (Nat.card (powerTraceRangeSolutions + leftTrace rightTrace leftExponent x.fst) : ℝ)) + (fun x => mainTerm x.fst) error + intro x hx + have hproduct := (Nat.mem_divisorsAntidiagonal.mp hx).1 + have hdvd : x.fst ∣ Nat.card H := ⟨x.snd, hproduct.symm⟩ + exact hRange x.fst hdvd + (Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hx)) + +/-- A positive Möbius main term larger than the error envelope forces an actual primitive trace +solution. -/ +theorem traceExactOrderSolutions_nonempty_of_divisorsError_lt_moebiusMain + [Finite G] [Finite H] [IsCyclic H] + (leftTrace : G → T) (rightTrace : H → T) (leftExponent : ℕ) + (mainTerm : ℕ → ℝ) (error : ℝ) + (hRange : ∀ d : ℕ, d ∣ Nat.card H → 0 < d → + |(Nat.card (powerTraceRangeSolutions + leftTrace rightTrace leftExponent d) : ℝ) - mainTerm d| ≤ error) + (hpositive : + ((Nat.card H).divisors.card : ℝ) * error < + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst) : + (traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).Nonempty := by + have henvelope := traceExactOrderSolutions_card_error_le_moebiusMain + leftTrace rightTrace leftExponent mainTerm error hRange + have hcardReal : + 0 < ((traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card : ℝ) := by + have hlower : + (∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst) - + ((traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card : ℝ) ≤ + |((traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card : ℝ) - + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst| := by + simpa only [neg_sub] using + neg_le_abs + (((traceExactOrderSolutions + leftTrace rightTrace leftExponent (Nat.card H)).card : ℝ) - + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst) + linarith + exact Finset.card_pos.mp (by exact_mod_cast hcardReal) + +/-- The common Möbius main term for a field of size `fieldCard`, a fixed power exponent, and a +primitive target group of order `groupOrder`. -/ +noncomputable def primitiveTraceMoebiusMainTerm + (groupOrder fieldCard fixedExponent : ℕ) : ℝ := + ∑ x ∈ groupOrder.divisorsAntidiagonal, + (μ x.fst : ℝ) * + ((fieldCard : ℝ) / ((x.fst : ℝ) * (fixedExponent : ℝ))) + +/-- Möbius inversion of `sum_totient`: the signed complementary-divisor sum is the totient. -/ +theorem sum_moebius_mul_complementaryDivisor_eq_totient (n : ℕ) (hn : 0 < n) : + ∑ x ∈ n.divisorsAntidiagonal, + (μ x.fst : ℤ) * (x.snd : ℤ) = (n.totient : ℤ) := by + have hsum : ∀ m : ℕ, m > 0 → + ∑ d ∈ m.divisors, (d.totient : ℤ) = (m : ℤ) := by + intro m hm + exact_mod_cast Nat.sum_totient m + exact + (ArithmeticFunction.sum_eq_iff_sum_mul_moebius_eq + (R := ℤ) + (f := fun d : ℕ => (d.totient : ℤ)) + (g := fun m : ℕ => (m : ℤ))).mp hsum n hn + +/-- Closed form of the primitive-trace Möbius main term. -/ +theorem primitiveTraceMoebiusMainTerm_eq_totient + (groupOrder fieldCard fixedExponent : ℕ) + (hgroup : 0 < groupOrder) (hfixed : 0 < fixedExponent) : + primitiveTraceMoebiusMainTerm groupOrder fieldCard fixedExponent = + (fieldCard : ℝ) * (groupOrder.totient : ℝ) / + ((fixedExponent : ℝ) * (groupOrder : ℝ)) := by + have hfixedReal : (fixedExponent : ℝ) ≠ 0 := by positivity + have hgroupReal : (groupOrder : ℝ) ≠ 0 := by positivity + unfold primitiveTraceMoebiusMainTerm + calc + (∑ x ∈ groupOrder.divisorsAntidiagonal, + (μ x.fst : ℝ) * + ((fieldCard : ℝ) / ((x.fst : ℝ) * (fixedExponent : ℝ)))) = + ∑ x ∈ groupOrder.divisorsAntidiagonal, + ((fieldCard : ℝ) / ((fixedExponent : ℝ) * (groupOrder : ℝ))) * + ((μ x.fst : ℝ) * (x.snd : ℝ)) := by + apply Finset.sum_congr rfl + intro x hx + have hproduct := (Nat.mem_divisorsAntidiagonal.mp hx).1 + have hleftNe := Nat.left_ne_zero_of_mem_divisorsAntidiagonal hx + have hleftReal : (x.fst : ℝ) ≠ 0 := by exact_mod_cast hleftNe + have hproductReal : (x.fst : ℝ) * (x.snd : ℝ) = groupOrder := by + exact_mod_cast hproduct + field_simp + rw [← hproductReal] + ring + _ = ((fieldCard : ℝ) / ((fixedExponent : ℝ) * (groupOrder : ℝ))) * + ∑ x ∈ groupOrder.divisorsAntidiagonal, + ((μ x.fst : ℝ) * (x.snd : ℝ)) := by + rw [Finset.mul_sum] + _ = ((fieldCard : ℝ) / ((fixedExponent : ℝ) * (groupOrder : ℝ))) * + (groupOrder.totient : ℝ) := by + congr 1 + exact_mod_cast sum_moebius_mul_complementaryDivisor_eq_totient + groupOrder hgroup + _ = (fieldCard : ℝ) * (groupOrder.totient : ℝ) / + ((fixedExponent : ℝ) * (groupOrder : ℝ)) := by ring + +/-- The totient times the divisor count dominates the integer itself. -/ +theorem le_totient_mul_card_divisors (n : ℕ) (hn : 0 < n) : + n ≤ n.totient * n.divisors.card := by + calc + n = ∑ d ∈ n.divisors, d.totient := (Nat.sum_totient n).symm + _ ≤ + ∑ _d ∈ n.divisors, n.totient := by + apply Finset.sum_le_sum + intro d hd + exact Nat.le_of_dvd (Nat.totient_pos.mpr hn) + (Nat.totient_dvd_of_dvd (Nat.dvd_of_mem_divisors hd)) + _ = n.totient * n.divisors.card := by + simp [Nat.mul_comm] + +/-- The elementary lower envelope for the Möbius main term used in the endgame. -/ +theorem fieldCard_div_fixed_mul_divisors_le_primitiveTraceMoebiusMainTerm + (groupOrder fieldCard fixedExponent : ℕ) + (hgroup : 0 < groupOrder) (hfixed : 0 < fixedExponent) : + (fieldCard : ℝ) / + ((fixedExponent : ℝ) * (groupOrder.divisors.card : ℝ)) ≤ + primitiveTraceMoebiusMainTerm groupOrder fieldCard fixedExponent := by + rw [primitiveTraceMoebiusMainTerm_eq_totient + groupOrder fieldCard fixedExponent hgroup hfixed] + have hdivisors : 0 < groupOrder.divisors.card := + (Nat.nonempty_divisors.mpr hgroup.ne').card_pos + have hfixedReal : (0 : ℝ) < fixedExponent := by exact_mod_cast hfixed + have hgroupReal : (0 : ℝ) < groupOrder := by exact_mod_cast hgroup + have hdivisorsReal : (0 : ℝ) < groupOrder.divisors.card := by exact_mod_cast hdivisors + have htotientBound : + (groupOrder : ℝ) ≤ + (groupOrder.totient : ℝ) * (groupOrder.divisors.card : ℝ) := by + exact_mod_cast le_totient_mul_card_divisors groupOrder hgroup + have hfieldNonnegative : (0 : ℝ) ≤ fieldCard := by positivity + have hratio : + (1 : ℝ) / (groupOrder.divisors.card : ℝ) ≤ + (groupOrder.totient : ℝ) / (groupOrder : ℝ) := by + apply (div_le_div_iff₀ hdivisorsReal hgroupReal).2 + simpa using htotientBound + have hscale : 0 ≤ (fieldCard : ℝ) / (fixedExponent : ℝ) := + div_nonneg hfieldNonnegative hfixedReal.le + calc + (fieldCard : ℝ) / + ((fixedExponent : ℝ) * (groupOrder.divisors.card : ℝ)) = + ((fieldCard : ℝ) / (fixedExponent : ℝ)) * + ((1 : ℝ) / (groupOrder.divisors.card : ℝ)) := by field_simp + _ ≤ ((fieldCard : ℝ) / (fixedExponent : ℝ)) * + ((groupOrder.totient : ℝ) / (groupOrder : ℝ)) := + mul_le_mul_of_nonneg_left hratio hscale + _ = (fieldCard : ℝ) * (groupOrder.totient : ℝ) / + ((fixedExponent : ℝ) * (groupOrder : ℝ)) := by field_simp + +/-- The explicit inequality used after the divisor bound is sufficient for primitive-trace +positivity. -/ +theorem divisorsError_lt_primitiveTraceMoebiusMainTerm_of_explicitInequality + (groupOrder fieldCard fixedExponent coefficient : ℕ) + (hgroup : 0 < groupOrder) (hfixed : 0 < fixedExponent) + (hexplicit : + (fixedExponent : ℝ) * (groupOrder.divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (fieldCard : ℝ)) < fieldCard) : + (groupOrder.divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (fieldCard : ℝ)) < + primitiveTraceMoebiusMainTerm groupOrder fieldCard fixedExponent := by + have hlower := + fieldCard_div_fixed_mul_divisors_le_primitiveTraceMoebiusMainTerm + groupOrder fieldCard fixedExponent hgroup hfixed + have hfixedReal : (0 : ℝ) < fixedExponent := by exact_mod_cast hfixed + have hdivisorsReal : (0 : ℝ) < groupOrder.divisors.card := by + exact_mod_cast (Nat.nonempty_divisors.mpr hgroup.ne').card_pos + apply lt_of_lt_of_le ?_ hlower + apply (lt_div_iff₀ (mul_pos hfixedReal hdivisorsReal)).2 + calc + (groupOrder.divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (fieldCard : ℝ)) * + ((fixedExponent : ℝ) * (groupOrder.divisors.card : ℝ)) = + (fixedExponent : ℝ) * (groupOrder.divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (fieldCard : ℝ)) := by ring + _ < fieldCard := hexplicit + +/-- Uniformly for large `p`, an orbit exponent at most `p^(1/2-δ)` satisfies the explicit +primitive-trace inequality. This is the asymptotic calculation behind the last sentence after +published equation (36). -/ +theorem eventually_endgamePrimitiveTrace_explicitInequality + (coefficient : ℕ) {δ : ℝ} (hδ : 0 < δ) : + ∀ᶠ p : ℕ in atTop, ∀ orbitExponent : ℕ, + (orbitExponent : ℝ) ≤ (p : ℝ) ^ ((1 : ℝ) / 2 - δ) → + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + let ε : ℝ := δ / 8 + have hε : 0 < ε := by dsimp [ε]; positivity + obtain ⟨divisorThreshold, hDivisorThreshold⟩ := + BGS.NumberTheory.exists_threshold_card_divisors_le_rpow hε + have hExponent : 1 - δ + 2 * ε < 1 := by + dsimp [ε] + linarith + have hDominance : + ∀ᶠ p : ℕ in atTop, + (coefficient : ℝ) * (p : ℝ) ^ (1 - δ + 2 * ε) < (p : ℝ) ^ (1 : ℝ) := + eventually_const_mul_rpow_lt_rpow hExponent + filter_upwards [hDominance, eventually_ge_atTop (divisorThreshold + 1), + eventually_ge_atTop 1] with p hDominance hpThreshold hpOne + intro orbitExponent horbit + have hpMinusThreshold : divisorThreshold ≤ p - 1 := by omega + have hDivisorRaw := hDivisorThreshold (p - 1) hpMinusThreshold + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast (show 0 < p by omega) + have hpRealNonnegative : (0 : ℝ) ≤ p := hpRealPos.le + have hpMinusLe : (((p - 1 : ℕ) : ℝ)) ≤ (p : ℝ) := by exact_mod_cast Nat.sub_le p 1 + have hDivisorPower : (((p - 1 : ℕ) : ℝ)) ^ ε ≤ (p : ℝ) ^ ε := + Real.rpow_le_rpow (Nat.cast_nonneg _) hpMinusLe hε.le + have hDivisor : ((p - 1).divisors.card : ℝ) ≤ (p : ℝ) ^ ε := + hDivisorRaw.trans hDivisorPower + have hCoefficientNonnegative : (0 : ℝ) ≤ coefficient := by positivity + have hOrbitNonnegative : (0 : ℝ) ≤ orbitExponent := by positivity + have hDivisorNonnegative : (0 : ℝ) ≤ (p - 1).divisors.card := by positivity + have hPowerIdentity : + (p : ℝ) ^ ((1 : ℝ) / 2 - δ) * ((p : ℝ) ^ ε) ^ 2 * + Real.sqrt (p : ℝ) = + (p : ℝ) ^ (1 - δ + 2 * ε) := by + rw [Real.sqrt_eq_rpow] + rw [← Real.rpow_mul_natCast hpRealNonnegative ε 2] + rw [← Real.rpow_add hpRealPos, ← Real.rpow_add hpRealPos] + congr 1 + ring + calc + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) = + (coefficient : ℝ) * + ((orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + Real.sqrt (p : ℝ)) := by ring + _ ≤ (coefficient : ℝ) * + ((p : ℝ) ^ ((1 : ℝ) / 2 - δ) * ((p : ℝ) ^ ε) ^ 2 * + Real.sqrt (p : ℝ)) := by + gcongr + _ = (coefficient : ℝ) * (p : ℝ) ^ (1 - δ + 2 * ε) := by + rw [hPowerIdentity] + _ < (p : ℝ) ^ (1 : ℝ) := hDominance + _ = p := by simp + +/-- Threshold form of `eventually_endgamePrimitiveTrace_explicitInequality`. -/ +theorem exists_threshold_endgamePrimitiveTrace_explicitInequality + (coefficient : ℕ) {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → ∀ orbitExponent : ℕ, + (orbitExponent : ℝ) ≤ (p : ℝ) ^ ((1 : ℝ) / 2 - δ) → + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := + eventually_atTop.mp (eventually_endgamePrimitiveTrace_explicitInequality coefficient hδ) + +/-- A large orbit order gives the upper bound on its complementary power exponent used by the +primitive-trace asymptotic. -/ +theorem orbitExponent_le_rpow_of_mul_order_eq_card_sub_one + (p orbitExponent orbitOrder : ℕ) {δ : ℝ} (hp : 0 < p) + (hmul : orbitExponent * orbitOrder = p - 1) + (horder : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ orbitOrder) : + (orbitExponent : ℝ) ≤ (p : ℝ) ^ ((1 : ℝ) / 2 - δ) := by + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast hp + have horderPositive : (0 : ℝ) < orbitOrder := + (Real.rpow_pos_of_pos hpRealPos _).trans_le horder + have hmulReal : + (orbitExponent : ℝ) * (orbitOrder : ℝ) = ((p - 1 : ℕ) : ℝ) := by + exact_mod_cast hmul + have hproductLe : + (orbitExponent : ℝ) * (orbitOrder : ℝ) ≤ (p : ℝ) := by + rw [hmulReal] + exact_mod_cast Nat.sub_le p 1 + have horbitExponentLe : + (orbitExponent : ℝ) ≤ (p : ℝ) / (orbitOrder : ℝ) := + (le_div_iff₀ horderPositive).2 hproductLe + calc + (orbitExponent : ℝ) ≤ (p : ℝ) / (orbitOrder : ℝ) := horbitExponentLe + _ ≤ (p : ℝ) / ((p : ℝ) ^ ((1 : ℝ) / 2 + δ)) := by + exact div_le_div_of_nonneg_left (Nat.cast_nonneg p) + (Real.rpow_pos_of_pos hpRealPos _) + horder + _ = (p : ℝ) ^ (1 : ℝ) / ((p : ℝ) ^ ((1 : ℝ) / 2 + δ)) := by + rw [Real.rpow_one] + _ = (p : ℝ) ^ ((1 : ℝ) - ((1 : ℝ) / 2 + δ)) := + (Real.rpow_sub hpRealPos (1 : ℝ) ((1 : ℝ) / 2 + δ)).symm + _ = (p : ℝ) ^ ((1 : ℝ) / 2 - δ) := by + congr 1 + ring + +/-- In the nonsplit torus, whose order is `p + 1`, a large orbit gives the same complementary +exponent bound up to the harmless fixed factor two. -/ +theorem orbitExponent_le_two_mul_rpow_of_mul_order_eq_card_add_one + (p orbitExponent orbitOrder : ℕ) {δ : ℝ} (hp : 0 < p) + (hmul : orbitExponent * orbitOrder = p + 1) + (horder : (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ orbitOrder) : + (orbitExponent : ℝ) ≤ 2 * (p : ℝ) ^ ((1 : ℝ) / 2 - δ) := by + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast hp + have horderPositive : (0 : ℝ) < orbitOrder := + (Real.rpow_pos_of_pos hpRealPos _).trans_le horder + have hmulReal : + (orbitExponent : ℝ) * (orbitOrder : ℝ) = ((p + 1 : ℕ) : ℝ) := by + exact_mod_cast hmul + have hproductLe : + (orbitExponent : ℝ) * (orbitOrder : ℝ) ≤ 2 * (p : ℝ) := by + rw [hmulReal] + exact_mod_cast (show p + 1 ≤ 2 * p by omega) + have horbitExponentLe : + (orbitExponent : ℝ) ≤ (2 * (p : ℝ)) / (orbitOrder : ℝ) := + (le_div_iff₀ horderPositive).2 hproductLe + calc + (orbitExponent : ℝ) ≤ (2 * (p : ℝ)) / (orbitOrder : ℝ) := horbitExponentLe + _ ≤ (2 * (p : ℝ)) / ((p : ℝ) ^ ((1 : ℝ) / 2 + δ)) := by + exact div_le_div_of_nonneg_left (by positivity) + (Real.rpow_pos_of_pos hpRealPos _) horder + _ = 2 * ((p : ℝ) / ((p : ℝ) ^ ((1 : ℝ) / 2 + δ))) := by ring + _ = 2 * ((p : ℝ) ^ ((1 : ℝ) / 2 - δ)) := by + congr 1 + calc + (p : ℝ) / ((p : ℝ) ^ ((1 : ℝ) / 2 + δ)) = + (p : ℝ) ^ (1 : ℝ) / + ((p : ℝ) ^ ((1 : ℝ) / 2 + δ)) := by rw [Real.rpow_one] + _ = (p : ℝ) ^ ((1 : ℝ) - ((1 : ℝ) / 2 + δ)) := + (Real.rpow_sub hpRealPos (1 : ℝ) ((1 : ℝ) / 2 + δ)).symm + _ = (p : ℝ) ^ ((1 : ℝ) / 2 - δ) := by + congr 1 + ring + +/-- Nonsplit threshold form: a complementary exponent in the norm-one torus of order `p + 1` +satisfies the same primitive-trace inequality for all sufficiently large `p`. -/ +theorem exists_threshold_endgamePrimitiveTrace_explicitInequality_of_largeNonsplitOrder + (coefficient : ℕ) {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → + ∀ orbitExponent orbitOrder : ℕ, + orbitExponent * orbitOrder = p + 1 → + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ orbitOrder → + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + have hhalfδ : 0 < δ / 2 := by linarith + obtain ⟨inequalityThreshold, hInequality⟩ := + exists_threshold_endgamePrimitiveTrace_explicitInequality coefficient hhalfδ + have hexponents : (1 : ℝ) / 2 - δ < (1 : ℝ) / 2 - δ / 2 := by linarith + have hAbsorb : + ∀ᶠ p : ℕ in atTop, + 2 * (p : ℝ) ^ ((1 : ℝ) / 2 - δ) < + (p : ℝ) ^ ((1 : ℝ) / 2 - δ / 2) := + eventually_const_mul_rpow_lt_rpow hexponents + obtain ⟨absorbThreshold, hAbsorbThreshold⟩ := eventually_atTop.mp hAbsorb + refine ⟨max (max inequalityThreshold absorbThreshold) 1, ?_⟩ + intro p hp orbitExponent orbitOrder hmul horder + have hpInequality : inequalityThreshold ≤ p := + (le_max_left inequalityThreshold absorbThreshold).trans + ((le_max_left (max inequalityThreshold absorbThreshold) 1).trans hp) + have hpAbsorb : absorbThreshold ≤ p := + (le_max_right inequalityThreshold absorbThreshold).trans + ((le_max_left (max inequalityThreshold absorbThreshold) 1).trans hp) + have hpPositive : 0 < p := by omega + apply hInequality p hpInequality orbitExponent + exact (orbitExponent_le_two_mul_rpow_of_mul_order_eq_card_add_one + p orbitExponent orbitOrder hpPositive hmul horder).trans + (hAbsorbThreshold p hpAbsorb).le + +/-- Threshold form directly in terms of the large orbit order and its complementary exponent. -/ +theorem exists_threshold_endgamePrimitiveTrace_explicitInequality_of_largeOrder + (coefficient : ℕ) {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → + ∀ orbitExponent orbitOrder : ℕ, + orbitExponent * orbitOrder = p - 1 → + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ orbitOrder → + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_endgamePrimitiveTrace_explicitInequality coefficient hδ + refine ⟨max threshold 1, ?_⟩ + intro p hp orbitExponent orbitOrder hmul horder + have hpThreshold : threshold ≤ p := (le_max_left threshold 1).trans hp + have hpPositive : 0 < p := by omega + exact hthreshold p hpThreshold orbitExponent + (orbitExponent_le_rpow_of_mul_order_eq_card_sub_one + p orbitExponent orbitOrder hpPositive hmul horder) + +/-- A numerical main-term domination criterion turns a point-count envelope into nonemptiness. -/ +theorem finset_nonempty_of_card_error_le_and_error_lt_main + {α : Type*} (s : Finset α) (mainTerm error : ℝ) + (henvelope : |(s.card : ℝ) - mainTerm| ≤ error) + (hpositive : error < mainTerm) : s.Nonempty := by + apply Finset.card_pos.mp + have hlower : mainTerm - (s.card : ℝ) ≤ |(s.card : ℝ) - mainTerm| := by + simpa only [neg_sub] using neg_le_abs ((s.card : ℝ) - mainTerm) + have hcardReal : (0 : ℝ) < s.card := by linarith + exact_mod_cast hcardReal + +section SplitApplication + +/-- Split trace coincidences with the orbit coordinate in the fixed power image and the other +coordinate primitive in the full base-field multiplicative group. -/ +abbrev splitPrimitiveTraceSolutions + (p : ℕ) [Fact p.Prime] + (alpha beta : ZMod p) (orbitExponent : ℕ) := + traceExactOrderSolutions + (weightedSplitTorusTrace alpha beta) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) + orbitExponent (Nat.card (ZMod p)ˣ) + +/-- Published equation (36) for the split branch, with every error and multiplicity supplied by +the preceding formal interfaces. -/ +theorem splitPrimitiveTraceSolutions_card_error_le_of_weilBoundAssumption + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (alpha beta : ZMod p) (orbitExponent : ℕ) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (hnondegenerate : alpha * beta ≠ 1) + (horbitPositive : 0 < orbitExponent) + (horbitChar : (orbitExponent : ZMod p) ≠ 0) + (horbitDvd : orbitExponent ∣ Nat.card (ZMod p)ˣ) : + |((splitPrimitiveTraceSolutions p alpha beta orbitExponent).card : ℝ) - + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p orbitExponent| ≤ + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) := by + have hRange : ∀ d : ℕ, d ∣ Nat.card (ZMod p)ˣ → 0 < d → + |(Nat.card (powerTraceRangeSolutions + (weightedSplitTorusTrace alpha beta) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) orbitExponent d) : ℝ) - + (p : ℝ) / ((d : ℝ) * (orbitExponent : ℝ))| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) := by + intro d hdvd hd + have hestimate := + splitTracePowerRangeSolutions_count_error_le_of_weilBoundAssumption + (ZMod p) coefficient hWeil alpha beta d orbitExponent + halpha hbeta hnondegenerate hd horbitPositive horbitChar hdvd horbitDvd + rw [natCard_powerTraceRangeSolutions_swap + (weightedSplitTorusTrace alpha beta) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) orbitExponent d] + simpa [ZMod.card] using hestimate + simpa [splitPrimitiveTraceSolutions, primitiveTraceMoebiusMainTerm] using + traceExactOrderSolutions_card_error_le_moebiusMain + (weightedSplitTorusTrace alpha beta) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) + orbitExponent + (fun d => (p : ℝ) / ((d : ℝ) * (orbitExponent : ℝ))) + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) hRange + +/-- Once the explicit Möbius main term dominates the accumulated Weil errors, an actual split +primitive trace pair exists. -/ +theorem splitPrimitiveTraceSolutions_nonempty_of_moebiusMain_gt_divisorsError + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (alpha beta : ZMod p) (orbitExponent : ℕ) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (hnondegenerate : alpha * beta ≠ 1) + (horbitPositive : 0 < orbitExponent) + (horbitChar : (orbitExponent : ZMod p) ≠ 0) + (horbitDvd : orbitExponent ∣ Nat.card (ZMod p)ˣ) + (hmain : + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p orbitExponent) : + (splitPrimitiveTraceSolutions p alpha beta orbitExponent).Nonempty := by + apply finset_nonempty_of_card_error_le_and_error_lt_main + (splitPrimitiveTraceSolutions p alpha beta orbitExponent) + (primitiveTraceMoebiusMainTerm (Nat.card (ZMod p)ˣ) p orbitExponent) + (((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ))) + · exact splitPrimitiveTraceSolutions_card_error_le_of_weilBoundAssumption + p coefficient hWeil alpha beta orbitExponent halpha hbeta hnondegenerate + horbitPositive horbitChar horbitDvd + · exact hmain + +/-- The fully numerical split inclusion--exclusion criterion produces a primitive trace pair. -/ +theorem exists_splitPrimitiveTracePair_of_explicitInequality + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (alpha beta : ZMod p) (orbitExponent : ℕ) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (hnondegenerate : alpha * beta ≠ 1) + (horbitPositive : 0 < orbitExponent) + (horbitChar : (orbitExponent : ZMod p) ≠ 0) + (horbitDvd : orbitExponent ∣ Nat.card (ZMod p)ˣ) + (hexplicit : + (orbitExponent : ℝ) * ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p) : + ∃ z : (powMonoidHom orbitExponent : (ZMod p)ˣ →* (ZMod p)ˣ).range × (ZMod p)ˣ, + weightedSplitTorusTrace alpha beta z.1 = splitTorusTrace z.2 ∧ + orderOf z.2 = Nat.card (ZMod p)ˣ := by + have hmain := + divisorsError_lt_primitiveTraceMoebiusMainTerm_of_explicitInequality + (Nat.card (ZMod p)ˣ) p orbitExponent coefficient + Nat.card_pos horbitPositive hexplicit + obtain ⟨z, hz⟩ := + splitPrimitiveTraceSolutions_nonempty_of_moebiusMain_gt_divisorsError + p coefficient hWeil alpha beta orbitExponent halpha hbeta hnondegenerate + horbitPositive horbitChar horbitDvd hmain + exact ⟨z, (mem_traceExactOrderSolutions_iff + (weightedSplitTorusTrace alpha beta) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) + orbitExponent (Nat.card (ZMod p)ˣ) z).mp hz⟩ + +end SplitApplication + +section NonsplitApplication + +/-- Corrected seeded nonsplit trace coincidences with primitive base-field right coordinate. -/ +abbrev existingConicSeedNonsplitPrimitiveTraceSolutions + (p : ℕ) [Fact p.Prime] + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (orbitExponent : ℕ) := + traceExactOrderSolutions + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) + orbitExponent (Nat.card (ZMod p)ˣ) + +/-- Published equation (36) for the corrected seeded nonsplit branch. -/ +theorem existingConicSeedNonsplitPrimitiveTraceSolutions_card_error_le_of_weilBoundAssumption + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (orbitExponent : ℕ) (horbitPositive : 0 < orbitExponent) + (horbitChar : (orbitExponent : quadraticFiniteField p) ≠ 0) + (horbitDvd : orbitExponent ∣ Nat.card (quadraticNormOneTorus p)) : + |((existingConicSeedNonsplitPrimitiveTraceSolutions + p t ht ht0 s orbitExponent).card : ℝ) - + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p orbitExponent| ≤ + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) := by + have hRange : ∀ e : ℕ, e ∣ Nat.card (ZMod p)ˣ → 0 < e → + |(Nat.card (powerTraceRangeSolutions + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) orbitExponent e) : ℝ) - + (p : ℝ) / ((e : ℝ) * (orbitExponent : ℝ))| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) := by + intro e hedvd he + have hestimate := + existingConicSeedNonsplitPowerRangeSolutions_count_error_le_of_weilBoundAssumption + p coefficient hWeil hpTwo t ht ht0 s orbitExponent e + horbitPositive he horbitChar horbitDvd hedvd + simpa [mul_comm] using hestimate + simpa [existingConicSeedNonsplitPrimitiveTraceSolutions, + primitiveTraceMoebiusMainTerm] using + traceExactOrderSolutions_card_error_le_moebiusMain + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) + orbitExponent + (fun e => (p : ℝ) / ((e : ℝ) * (orbitExponent : ℝ))) + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) hRange + +/-- Numerical main-term domination produces an actual primitive base-field trace pair in the +corrected nonsplit branch. -/ +theorem existingConicSeedNonsplitPrimitiveTraceSolutions_nonempty_of_moebiusMain_gt_divisorsError + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (orbitExponent : ℕ) (horbitPositive : 0 < orbitExponent) + (horbitChar : (orbitExponent : quadraticFiniteField p) ≠ 0) + (horbitDvd : orbitExponent ∣ Nat.card (quadraticNormOneTorus p)) + (hmain : + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < + primitiveTraceMoebiusMainTerm + (Nat.card (ZMod p)ˣ) p orbitExponent) : + (existingConicSeedNonsplitPrimitiveTraceSolutions + p t ht ht0 s orbitExponent).Nonempty := by + apply finset_nonempty_of_card_error_le_and_error_lt_main + (existingConicSeedNonsplitPrimitiveTraceSolutions + p t ht ht0 s orbitExponent) + (primitiveTraceMoebiusMainTerm (Nat.card (ZMod p)ˣ) p orbitExponent) + (((Nat.card (ZMod p)ˣ).divisors.card : ℝ) * + ((coefficient : ℝ) * Real.sqrt (p : ℝ))) + · exact + existingConicSeedNonsplitPrimitiveTraceSolutions_card_error_le_of_weilBoundAssumption + p coefficient hWeil hpTwo t ht ht0 s orbitExponent + horbitPositive horbitChar horbitDvd + · exact hmain + +/-- The fully numerical nonsplit inclusion--exclusion criterion produces a primitive base-field +trace pair on the corrected seeded norm-one orbit. -/ +theorem exists_existingConicSeedNonsplitPrimitiveTracePair_of_explicitInequality + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (orbitExponent : ℕ) (horbitPositive : 0 < orbitExponent) + (horbitChar : (orbitExponent : quadraticFiniteField p) ≠ 0) + (horbitDvd : orbitExponent ∣ Nat.card (quadraticNormOneTorus p)) + (hexplicit : + (orbitExponent : ℝ) * ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p) : + ∃ z : (powMonoidHom orbitExponent : + quadraticNormOneTorus p →* quadraticNormOneTorus p).range × (ZMod p)ˣ, + existingConicSeedNonsplitTorusTrace p t ht ht0 s z.1 = splitTorusTrace z.2 ∧ + orderOf z.2 = Nat.card (ZMod p)ˣ := by + have hmain := + divisorsError_lt_primitiveTraceMoebiusMainTerm_of_explicitInequality + (Nat.card (ZMod p)ˣ) p orbitExponent coefficient + Nat.card_pos horbitPositive hexplicit + obtain ⟨z, hz⟩ := + existingConicSeedNonsplitPrimitiveTraceSolutions_nonempty_of_moebiusMain_gt_divisorsError + p coefficient hWeil hpTwo t ht ht0 s orbitExponent + horbitPositive horbitChar horbitDvd hmain + exact ⟨z, (mem_traceExactOrderSolutions_iff + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) + orbitExponent (Nat.card (ZMod p)ˣ) z).mp hz⟩ + +end NonsplitApplication + +end + + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean new file mode 100644 index 0000000000..6490643d4b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean @@ -0,0 +1,429 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring + +/-! +# Transporting primitive trace pairs back to rotation orbits + +The endgame count returns an element of a complementary power-map image. The rotation +parametrizations use the cyclic subgroup generated by the rotation eigenvalue. This file +proves the exact transport between those two representations in the split and nonsplit cases. +-/ + +namespace BGS.Markoff + +noncomputable section + +theorem complementaryExponent_pos + {G : Type*} [Group G] [Finite G] (w : G) : + 0 < Nat.card G / orderOf w := by + exact Nat.div_pos (Nat.le_of_dvd Nat.card_pos (orderOf_dvd_natCard w)) (orderOf_pos w) + +theorem complementaryExponent_dvd_natCard + {G : Type*} [Group G] [Finite G] (w : G) : + Nat.card G / orderOf w ∣ Nat.card G := + Nat.div_dvd_of_dvd (orderOf_dvd_natCard w) + +theorem splitComplementaryExponent_cast_ne_zero + (p : ℕ) [Fact p.Prime] (w : (ZMod p)ˣ) : + ((Nat.card (ZMod p)ˣ / orderOf w : ℕ) : ZMod p) ≠ 0 := by + intro hzero + have hpDvd := (CharP.cast_eq_zero_iff (ZMod p) p _).mp hzero + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + rw [hcard] at hpDvd + have heDvd := complementaryExponent_dvd_natCard w + rw [hcard] at heDvd + have hpSub : p ∣ p - 1 := hpDvd.trans heDvd + have hpPrime : p.Prime := Fact.out + have hpTwo : 2 ≤ p := hpPrime.two_le + exact (Nat.not_dvd_of_pos_of_lt (by omega) (by omega)) hpSub + +theorem nonsplitComplementaryExponent_cast_ne_zero + (p : ℕ) [Fact p.Prime] (w : quadraticNormOneTorus p) : + ((Nat.card (quadraticNormOneTorus p) / orderOf w : ℕ) : + quadraticFiniteField p) ≠ 0 := by + intro hzero + have hpDvd := (CharP.cast_eq_zero_iff (quadraticFiniteField p) p _).mp hzero + rw [quadraticNormOneTorus_natCard] at hpDvd + have heDvd := complementaryExponent_dvd_natCard w + rw [quadraticNormOneTorus_natCard] at heDvd + have hpAdd : p ∣ p + 1 := hpDvd.trans heDvd + have hpOne : p ∣ 1 := by + apply (Nat.dvd_add_iff_left (dvd_refl p)).mpr + simpa [add_comm] using hpAdd + exact (Fact.out : p.Prime).ne_one (Nat.dvd_one.mp hpOne) + +/-- A point in the complementary power-map image is reached by a natural power of the element +whose order defines the complementary exponent. -/ +theorem exists_pow_eq_of_mem_complementaryPowerRange + {G : Type*} [CommGroup G] [Finite G] [IsCyclic G] + (w : G) + (h : (powMonoidHom (Nat.card G / orderOf w) : G →* G).range) : + ∃ n : ℕ, w ^ n = h.1 := by + have hhZpowers : h.1 ∈ Subgroup.zpowers w := by + rw [← powMonoidHom_range_eq_zpowers_of_complementaryOrder w] + exact h.2 + have hhPowers : h.1 ∈ Submonoid.powers w := + mem_powers_iff_mem_zpowers.mpr hhZpowers + exact (Submonoid.mem_powers_iff h.1 w).mp hhPowers + +/-- Split transport: every parameter returned by the primitive count is an actual forward +iterate of the starting split-fiber point. -/ +theorem exists_iterate_splitFiberPoint_eq_of_mem_complementaryPowerRange + {F : Type*} [Field F] [Finite F] [IsCyclic Fˣ] + (w s : Fˣ) + (h : (powMonoidHom (Nat.card Fˣ / orderOf w) : Fˣ →* Fˣ).range) : + ∃ n : ℕ, + (normalizedRotate1^[n]) (splitFiberPoint w s) = + splitFiberPoint w (s * h.1) := by + obtain ⟨n, hn⟩ := exists_pow_eq_of_mem_complementaryPowerRange w h + refine ⟨n, ?_⟩ + rw [iterate_normalizedRotate1_splitFiberPoint, hn] + +/-- The split primitive-count theorem, with its power-image output transported all the way to +an actual forward rotation iterate. Only the explicit Weil estimate and its arithmetic +hypotheses remain as inputs. -/ +theorem exists_iterate_splitFiberPoint_with_primitive_secondTrace + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (hpTwo : p ≠ 2) (w s : (ZMod p)ˣ) + (hw : (w : ZMod p) ^ 2 ≠ 1) + (htrace : splitTorusTrace w ≠ 0) + (horbitPositive : 0 < Nat.card (ZMod p)ˣ / orderOf w) + (horbitChar : ((Nat.card (ZMod p)ˣ / orderOf w : ℕ) : ZMod p) ≠ 0) + (horbitDvd : Nat.card (ZMod p)ˣ / orderOf w ∣ Nat.card (ZMod p)ˣ) + (hexplicit : + ((Nat.card (ZMod p)ˣ / orderOf w : ℕ) : ℝ) * + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p) : + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) (splitFiberPoint w s)).u2 = splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + let orbitExponent := Nat.card (ZMod p)ˣ / orderOf w + let alpha : ZMod p := s + let beta : ZMod p := splitFiberProduct w * ((s⁻¹ : (ZMod p)ˣ) : ZMod p) + have ht : splitTorusTrace w ^ 2 ≠ 4 := by + apply sub_ne_zero.mp + rw [splitTorusTrace_sq_sub_four] + exact pow_ne_zero 2 (splitEigenvalueDifference_ne_zero w hw) + have hproductNe : splitFiberProduct w ≠ 1 := by + simpa [splitFiberProduct, quadraticFiberProduct] using + quadraticFiberProduct_ne_one_of_prime_ne_two p hpTwo (splitTorusTrace w) ht + have halpha : alpha ≠ 0 := Units.ne_zero s + have hbeta : beta ≠ 0 := by + exact mul_ne_zero (splitFiberProduct_ne_zero w hw htrace) (Units.ne_zero s⁻¹) + have hnondegenerate : alpha * beta ≠ 1 := by + change (s : ZMod p) * + (splitFiberProduct w * ((s⁻¹ : (ZMod p)ˣ) : ZMod p)) ≠ 1 + rw [splitFiberOrbit_weights_mul] + exact hproductNe + obtain ⟨z, hzTrace, hzOrder⟩ := + exists_splitPrimitiveTracePair_of_explicitInequality + p coefficient hWeil alpha beta orbitExponent halpha hbeta hnondegenerate + horbitPositive horbitChar horbitDvd (by simpa [orbitExponent] using hexplicit) + obtain ⟨n, hn⟩ := + exists_iterate_splitFiberPoint_eq_of_mem_complementaryPowerRange w s z.1 + refine ⟨n, z.2, ?_, hzOrder⟩ + rw [hn, splitFiberOrbit_secondCoordinate_eq_weightedSplitTorusTrace] + exact hzTrace + +/-- Nonsplit transport: every norm-one parameter returned by the seeded primitive count is an +actual forward iterate of the starting point on the base-field conic. -/ +theorem exists_iterate_quadraticNormFiberPoint_eq_of_mem_complementaryPowerRange + (p : ℕ) [Fact p.Prime] + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (h : (powMonoidHom + (Nat.card (quadraticNormOneTorus p) / orderOf w) : + quadraticNormOneTorus p →* quadraticNormOneTorus p).range) : + ∃ n : ℕ, + (normalizedRotate1^[n]) (quadraticNormFiberPoint p t ht ht0 w s) = + quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberMulNormOne p + (quadraticFiberProductUnit p t ht ht0) s h.1) := by + obtain ⟨n, hn⟩ := exists_pow_eq_of_mem_complementaryPowerRange w h + refine ⟨n, ?_⟩ + rw [iterate_normalizedRotate1_quadraticNormFiberPoint p t ht ht0 w htrace, hn] + +/-- The seeded trace counted in the nonsplit endgame is exactly the second coordinate of the +corresponding point in the base-field conic parametrization. -/ +theorem existingConicSeedNonsplitTorusTrace_eq_quadraticNormFiberPoint_u2 + (p : ℕ) [Fact p.Prime] + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (h : quadraticNormOneTorus p) : + existingConicSeedNonsplitTorusTrace p t ht ht0 s h = + (quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberMulNormOne p + (quadraticFiberProductUnit p t ht ht0) s h)).u2 := by + let r := quadraticNormFiberMulNormOne p + (quadraticFiberProductUnit p t ht ht0) s h + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + have hpoint := algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace r + have hu2 := congrArg NormalizedPoint.u2 hpoint + change algebraMap (ZMod p) (quadraticFiniteField p) + (quadraticNormFiberPoint p t ht ht0 w r).u2 = + (splitFiberPoint (w : (quadraticFiniteField p)ˣ) r.1).u2 at hu2 + rw [hu2] + rw [existingConicSeedNonsplitTorusTrace, algebraMap_quadraticTrace] + change (r.1 : quadraticFiniteField p) + (r.1 : quadraticFiniteField p) ^ p = + (splitFiberPoint (w : (quadraticFiniteField p)ˣ) r.1).u2 + rw [quadraticNormFiber_frobenius_eq_norm_mul_inv p + (quadraticFiberProductUnit p t ht ht0) r] + simp only [splitFiberPoint] + congr 1 + rw [show ((quadraticFiberProductUnit p t ht ht0 : (ZMod p)ˣ) : ZMod p) = + quadraticFiberProduct p t by rfl] + rw [show algebraMap (ZMod p) (quadraticFiniteField p) + (quadraticFiberProduct p t) = + splitFiberProduct (w : (quadraticFiniteField p)ˣ) by + rw [splitFiberProduct, ← htrace, quadraticFiberProduct, map_div₀, map_sub, + map_pow, map_ofNat, algebraMap_quadraticNormOneTrace]] + simp only [Units.val_inv_eq_inv_val] + +/-- The corrected nonsplit primitive-count theorem, transported to an actual forward iterate +on the base-field conic. -/ +theorem exists_iterate_quadraticNormFiberPoint_with_primitive_secondTrace + (p : ℕ) [Fact p.Prime] + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (horbitPositive : + 0 < Nat.card (quadraticNormOneTorus p) / orderOf w) + (horbitChar : + ((Nat.card (quadraticNormOneTorus p) / orderOf w : ℕ) : + quadraticFiniteField p) ≠ 0) + (horbitDvd : + Nat.card (quadraticNormOneTorus p) / orderOf w ∣ + Nat.card (quadraticNormOneTorus p)) + (hexplicit : + ((Nat.card (quadraticNormOneTorus p) / orderOf w : ℕ) : ℝ) * + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p) : + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) + (quadraticNormFiberPoint p t ht ht0 w s)).u2 = splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + let orbitExponent := Nat.card (quadraticNormOneTorus p) / orderOf w + obtain ⟨z, hzTrace, hzOrder⟩ := + exists_existingConicSeedNonsplitPrimitiveTracePair_of_explicitInequality + p coefficient hWeil hpTwo t ht ht0 s orbitExponent + horbitPositive horbitChar horbitDvd (by simpa [orbitExponent] using hexplicit) + obtain ⟨n, hn⟩ := + exists_iterate_quadraticNormFiberPoint_eq_of_mem_complementaryPowerRange + p t ht ht0 w htrace s z.1 + refine ⟨n, z.2, ?_, hzOrder⟩ + rw [hn, ← existingConicSeedNonsplitTorusTrace_eq_quadraticNormFiberPoint_u2 + p t ht ht0 w htrace s z.1] + exact hzTrace + +/-- Uniform large-order split endgame, still expressed in the explicit split-fiber +parametrization. -/ +theorem exists_threshold_splitFiberPoint_with_primitive_secondTrace + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (w s : (ZMod p)ˣ), + (w : ZMod p) ^ 2 ≠ 1 → splitTorusTrace w ≠ 0 → + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ orderOf w → + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) (splitFiberPoint w s)).u2 = splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_endgamePrimitiveTrace_explicitInequality_of_largeOrder + coefficient hδ + refine ⟨max threshold 3, ?_⟩ + intro p hp _ w s hw htrace hlarge + have hpThreshold : threshold ≤ p := (le_max_left threshold 3).trans hp + have hpTwo : p ≠ 2 := by omega + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hmul := Nat.div_mul_cancel (orderOf_dvd_natCard w) + rw [hcard] at hmul + have hexplicit := hthreshold p hpThreshold + ((p - 1) / orderOf w) (orderOf w) hmul hlarge + have hexplicit' : + ((Nat.card (ZMod p)ˣ / orderOf w : ℕ) : ℝ) * + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + rw [hcard] + exact hexplicit + exact exists_iterate_splitFiberPoint_with_primitive_secondTrace + p coefficient hWeil hpTwo w s hw htrace + (complementaryExponent_pos w) + (splitComplementaryExponent_cast_ne_zero p w) + (complementaryExponent_dvd_natCard w) hexplicit' + +/-- Uniform large-order nonsplit endgame in the corrected seeded conic parametrization. -/ +theorem exists_threshold_quadraticNormFiberPoint_with_primitive_secondTrace + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p), + quadraticNormOneTrace p w = t → + ∀ s : ↥(quadraticConicNormFiber p t ht ht0), + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ orderOf w → + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) + (quadraticNormFiberPoint p t ht ht0 w s)).u2 = splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_endgamePrimitiveTrace_explicitInequality_of_largeNonsplitOrder + coefficient hδ + refine ⟨max threshold 3, ?_⟩ + intro p hp _ t ht ht0 w htrace s hlarge + have hpThreshold : threshold ≤ p := (le_max_left threshold 3).trans hp + have hpTwo : p ≠ 2 := by omega + have hmul := Nat.div_mul_cancel (orderOf_dvd_natCard w) + rw [quadraticNormOneTorus_natCard] at hmul + have hexplicit := hthreshold p hpThreshold + ((p + 1) / orderOf w) (orderOf w) hmul hlarge + have hcardUnits : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hexplicit' : + ((Nat.card (quadraticNormOneTorus p) / orderOf w : ℕ) : ℝ) * + ((Nat.card (ZMod p)ˣ).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + rw [quadraticNormOneTorus_natCard, hcardUnits] + exact hexplicit + exact exists_iterate_quadraticNormFiberPoint_with_primitive_secondTrace + p coefficient hWeil hpTwo t ht ht0 w htrace s + (complementaryExponent_pos w) + (nonsplitComplementaryExponent_cast_ne_zero p w) + (complementaryExponent_dvd_natCard w) hexplicit' + +/-- The missing classified witness bridge: an arbitrary point on a nonzero nonparabolic fiber +is represented by the explicit split or nonsplit conic parametrization attached to the +eigenvalue supplied by trace classification. -/ +theorem exists_split_or_nonsplitFiberParameter + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (x : ↥(normalizedFiber1 t)) : + (∃ (w : (ZMod p)ˣ), splitTorusTrace w = t ∧ + (w : ZMod p) ^ 2 ≠ 1 ∧ ∃ s : (ZMod p)ˣ, + splitFiberPoint w s = (x : NormalizedPoint (ZMod p))) ∨ + (∃ (w : quadraticNormOneTorus p), quadraticNormOneTrace p w = t ∧ + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1) ∧ + ∃ s : ↥(quadraticConicNormFiber p t ht ht0), + quadraticNormFiberPoint p t ht ht0 w s = + (x : NormalizedPoint (ZMod p))) := by + rcases exists_split_or_quadraticNormOneTrace p hpTwo t ht with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · let xw : ↥(normalizedFiber1 (splitTorusTrace w)) := + ⟨x.1, x.property.1, by simpa [htrace] using x.property.2⟩ + let s := (splitFiberEquiv w hw (by simpa [htrace] using ht0)).symm xw + have hx : splitFiberPoint w s = (x : NormalizedPoint (ZMod p)) := + congrArg Subtype.val + ((splitFiberEquiv w hw (by simpa [htrace] using ht0)).apply_symm_apply xw) + exact Or.inl ⟨w, htrace, hw, s, hx⟩ + · let s := (quadraticNormFiberEquiv p t ht ht0 w htrace hw).symm x + have hx : quadraticNormFiberPoint p t ht ht0 w s = + (x : NormalizedPoint (ZMod p)) := + congrArg Subtype.val + ((quadraticNormFiberEquiv p t ht ht0 w htrace hw).apply_symm_apply x) + exact Or.inr ⟨w, htrace, hw, s, hx⟩ + +/-- Classified semisimple endgame: every nonzero nonparabolic normalized Markoff point with a +large first-coordinate rotation reaches a point whose second coordinate is the trace of a +primitive base-field unit. -/ +theorem exists_threshold_nonparabolicPoint_with_primitive_secondTrace + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (x : ↥(normalizedFiber1 t)), + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder t → + ∃ n : ℕ, ∃ u : (ZMod p)ˣ, + ((normalizedRotate1^[n]) (x : NormalizedPoint (ZMod p))).u2 = + splitTorusTrace u ∧ + orderOf u = Nat.card (ZMod p)ˣ := by + obtain ⟨splitThreshold, hSplitThreshold⟩ := + exists_threshold_splitFiberPoint_with_primitive_secondTrace + splitCoefficient hSplitWeil hδ + obtain ⟨nonsplitThreshold, hNonsplitThreshold⟩ := + exists_threshold_quadraticNormFiberPoint_with_primitive_secondTrace + nonsplitCoefficient hNonsplitWeil hδ + refine ⟨max (max splitThreshold nonsplitThreshold) 3, ?_⟩ + intro p hp _ t ht ht0 x hlarge + have hpSplit : splitThreshold ≤ p := + (le_max_left splitThreshold nonsplitThreshold).trans + ((le_max_left (max splitThreshold nonsplitThreshold) 3).trans hp) + have hpNonsplit : nonsplitThreshold ≤ p := + (le_max_right splitThreshold nonsplitThreshold).trans + ((le_max_left (max splitThreshold nonsplitThreshold) 3).trans hp) + have hpTwo : p ≠ 2 := by omega + rcases exists_split_or_nonsplitFiberParameter p hpTwo t ht ht0 x with + ⟨w, htrace, hw, s, hx⟩ | ⟨w, htrace, hw, s, hx⟩ + · + have horder : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_splitTorusTrace w hw] + obtain ⟨n, u, hcoordinate, huOrder⟩ := + hSplitThreshold p hpSplit w s hw (by simpa [htrace] using ht0) + (by simpa [horder] using hlarge) + refine ⟨n, u, ?_, huOrder⟩ + rw [← hx] + exact hcoordinate + · + have horder : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_quadraticNormOneTrace p w hw] + obtain ⟨n, u, hcoordinate, huOrder⟩ := + hNonsplitThreshold p hpNonsplit t ht ht0 w htrace s + (by simpa [horder] using hlarge) + refine ⟨n, u, ?_, huOrder⟩ + rw [← hx] + exact hcoordinate + +/-- Proposition 10 for the nonparabolic branches, stated directly as maximal matrix rotation +order in the newly reached second coordinate. -/ +theorem exists_threshold_nonparabolicPoint_with_maximal_secondRotation + (splitCoefficient : ℕ) + (hSplitWeil : WeightedSplitTraceWeilBoundAssumption splitCoefficient) + (nonsplitCoefficient : ℕ) + (hNonsplitWeil : SeededNonsplitTraceWeilBoundAssumption nonsplitCoefficient) + {δ : ℝ} (hδ : 0 < δ) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → + ∀ (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (x : ↥(normalizedFiber1 t)), + (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder t → + ∃ n : ℕ, + rotationOrder + (((normalizedRotate1^[n]) + (x : NormalizedPoint (ZMod p))).u2) = p - 1 := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_nonparabolicPoint_with_primitive_secondTrace + splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ + refine ⟨max threshold 5, ?_⟩ + intro p hp _ t ht ht0 x hlarge + have hpThreshold : threshold ≤ p := (le_max_left threshold 5).trans hp + obtain ⟨n, u, hcoordinate, huOrder⟩ := + hthreshold p hpThreshold t ht ht0 x hlarge + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huPower + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huPower + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + omega + refine ⟨n, ?_⟩ + rw [hcoordinate, rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean new file mode 100644 index 0000000000..0b6a815ab0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean @@ -0,0 +1,215 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting + +/-! +# Endgame point estimates after quotienting by the power maps + +The Weil interfaces count points on the power-cover curves. The paper's inclusion--exclusion +argument instead counts solutions on the two power-map images. This file connects those two +levels exactly. It proves the source's division by `d * e`, then divides the point-count error by +the same positive factor to obtain the uniform `O(sqrt q)` error used in equations (34)--(36). + +Both split and corrected seeded nonsplit branches are covered. The nonsplit equivalence uses the +actual base-field solution finset on the norm-one torus; it never replaces that finset by all +quadratic-field points. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Dividing an exact `d * e`-sheeted cover count divides its Weil error by the same factor. -/ +theorem rangeCount_error_le_of_coverCount_error_and_exactMultiplicity + (coverCount rangeCount fieldCard coefficient d e : ℕ) + (hd : 0 < d) (he : 0 < e) + (hcover : coverCount = d * e * rangeCount) + (herror : + |(coverCount : ℝ) - (fieldCard : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (fieldCard : ℝ) * (d : ℝ) * (e : ℝ)) : + |(rangeCount : ℝ) - + (fieldCard : ℝ) / ((d : ℝ) * (e : ℝ))| ≤ + (coefficient : ℝ) * Real.sqrt (fieldCard : ℝ) := by + have hdReal : (0 : ℝ) < d := by exact_mod_cast hd + have heReal : (0 : ℝ) < e := by exact_mod_cast he + have hdeReal : (0 : ℝ) < (d : ℝ) * (e : ℝ) := mul_pos hdReal heReal + have hcoverReal : + (coverCount : ℝ) = (d : ℝ) * (e : ℝ) * (rangeCount : ℝ) := by + exact_mod_cast hcover + rw [hcoverReal] at herror + have hidentity : + (rangeCount : ℝ) - (fieldCard : ℝ) / ((d : ℝ) * (e : ℝ)) = + (((d : ℝ) * (e : ℝ) * (rangeCount : ℝ) - (fieldCard : ℝ)) / + ((d : ℝ) * (e : ℝ))) := by + field_simp + rw [hidentity, abs_div, abs_of_pos hdeReal] + apply (div_le_iff₀ hdeReal).2 + simpa [mul_assoc] using herror + +section Split + +variable (K : Type) [Field K] [Fintype K] [DecidableEq K] + +/-- Solutions on the two power-map images for the weighted split trace equation. -/ +abbrev splitTracePowerRangeSolutions + (alpha beta : K) (d e : ℕ) := + powerTraceRangeSolutions + (splitTorusTrace : Kˣ → K) (weightedSplitTorusTrace alpha beta) d e + +/-- The finite-set model of the split trace cover is definitionally the same equation as the +generic two-power cover, up to reversing the displayed equality. -/ +def splitTraceCurveSolutionsEquivPowerTraceCoverSolutions + (alpha beta : K) (d e : ℕ) : + ↥(splitTraceCurveSolutions K alpha beta d e) ≃ + powerTraceCoverSolutions + (splitTorusTrace : Kˣ → K) (weightedSplitTorusTrace alpha beta) d e where + toFun z := ⟨z.1, (mem_splitTraceCurveSolutions_iff K alpha beta d e z.1).mp z.2 |>.symm⟩ + invFun z := ⟨z.1, + (mem_splitTraceCurveSolutions_iff K alpha beta d e z.1).mpr z.2.symm⟩ + left_inv z := by rfl + right_inv z := by rfl + +/-- Exact source equation (32) for the split trace cover. -/ +theorem splitTraceCurveSolutions_card_eq_mul_natCard_powerTraceRangeSolutions + (alpha beta : K) (d e : ℕ) + (hdvd : d ∣ Nat.card Kˣ) (hedvd : e ∣ Nat.card Kˣ) : + (splitTraceCurveSolutions K alpha beta d e).card = + d * e * Nat.card (splitTracePowerRangeSolutions K alpha beta d e) := by + calc + (splitTraceCurveSolutions K alpha beta d e).card = + Nat.card ↥(splitTraceCurveSolutions K alpha beta d e) := by + rw [Nat.card_eq_fintype_card] + exact (Fintype.card_coe _).symm + _ = Nat.card + (powerTraceCoverSolutions + (splitTorusTrace : Kˣ → K) (weightedSplitTorusTrace alpha beta) d e) := + Nat.card_congr + (splitTraceCurveSolutionsEquivPowerTraceCoverSolutions K alpha beta d e) + _ = d * e * Nat.card (splitTracePowerRangeSolutions K alpha beta d e) := + natCard_powerTraceCoverSolutions_of_dvd + (splitTorusTrace : Kˣ → K) (weightedSplitTorusTrace alpha beta) d e hdvd hedvd + +/-- Equation (34) for a concrete weighted split trace cover, derived from the explicit Weil +assumption only after Lean proves the cover's absolute irreducibility. -/ +theorem splitTracePowerRangeSolutions_count_error_le_of_weilBoundAssumption + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (alpha beta : K) (d e : ℕ) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (hnondegenerate : alpha * beta ≠ 1) + (hd : 0 < d) (he : 0 < e) (heChar : (e : K) ≠ 0) + (hdvd : d ∣ Nat.card Kˣ) (hedvd : e ∣ Nat.card Kˣ) : + |(Nat.card (splitTracePowerRangeSolutions K alpha beta d e) : ℝ) - + (Fintype.card K : ℝ) / ((d : ℝ) * (e : ℝ))| ≤ + (coefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) := by + apply rangeCount_error_le_of_coverCount_error_and_exactMultiplicity + (splitTraceCurveSolutions K alpha beta d e).card + (Nat.card (splitTracePowerRangeSolutions K alpha beta d e)) + (Fintype.card K) coefficient d e hd he + (splitTraceCurveSolutions_card_eq_mul_natCard_powerTraceRangeSolutions + K alpha beta d e hdvd hedvd) + exact splitTraceCurveSolutions_count_error_le_of_weilBoundAssumption_and_positiveExponents + K coefficient hWeil alpha beta d e halpha hbeta hnondegenerate hd he heChar + +end Split + +section Nonsplit + +variable (p : ℕ) [Fact p.Prime] + +/-- The unpowered left trace in the corrected seeded nonsplit equation. -/ +def existingConicSeedNonsplitTorusTrace + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (w : quadraticNormOneTorus p) : ZMod p := + Algebra.trace (ZMod p) (quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) * + ((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)) + +/-- Solutions on the two power-map images for the corrected seeded nonsplit equation. -/ +abbrev existingConicSeedNonsplitPowerRangeSolutions + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) (d e : ℕ) := + powerTraceRangeSolutions + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d e + +/-- The corrected nonsplit solution finset is exactly the corresponding generic two-power +cover over the norm-one torus and the base-field unit group. -/ +def existingConicSeedNonsplitTraceCurveSolutionsEquivPowerTraceCoverSolutions + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) (d e : ℕ) : + ↥(existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e) ≃ + powerTraceCoverSolutions + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d e where + toFun z := ⟨z.1, by + have hz := + (mem_existingConicSeedNonsplitTraceCurveSolutions_iff + p t ht ht0 s d e z.1).mp z.2 + exact hz⟩ + invFun z := ⟨z.1, + (mem_existingConicSeedNonsplitTraceCurveSolutions_iff + p t ht ht0 s d e z.1).mpr z.2⟩ + left_inv z := by rfl + right_inv z := by rfl + +/-- Exact source equation (32) for the corrected seeded nonsplit trace cover. -/ +theorem existingConicSeedNonsplitTraceCurveSolutions_card_eq_mul_natCard_powerTraceRangeSolutions + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) (d e : ℕ) + (hdvd : d ∣ Nat.card (quadraticNormOneTorus p)) + (hedvd : e ∣ Nat.card (ZMod p)ˣ) : + (existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e).card = + d * e * Nat.card + (existingConicSeedNonsplitPowerRangeSolutions p t ht ht0 s d e) := by + calc + (existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e).card = + Nat.card ↥(existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e) := by + rw [Nat.card_eq_fintype_card] + exact (Fintype.card_coe _).symm + _ = Nat.card + (powerTraceCoverSolutions + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d e) := + Nat.card_congr + (existingConicSeedNonsplitTraceCurveSolutionsEquivPowerTraceCoverSolutions + p t ht ht0 s d e) + _ = d * e * Nat.card + (existingConicSeedNonsplitPowerRangeSolutions p t ht ht0 s d e) := + natCard_powerTraceCoverSolutions_of_dvd + (existingConicSeedNonsplitTorusTrace p t ht ht0 s) + (splitTorusTrace : (ZMod p)ˣ → ZMod p) d e hdvd hedvd + +/-- Equation (34) for the corrected seeded nonsplit cover. Its main term is `p / (d * e)` +because the counted solution set is over the base field. -/ +theorem existingConicSeedNonsplitPowerRangeSolutions_count_error_le_of_weilBoundAssumption + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) (d e : ℕ) + (hd : 0 < d) (he : 0 < e) (hdChar : (d : quadraticFiniteField p) ≠ 0) + (hdvd : d ∣ Nat.card (quadraticNormOneTorus p)) + (hedvd : e ∣ Nat.card (ZMod p)ˣ) : + |(Nat.card + (existingConicSeedNonsplitPowerRangeSolutions p t ht ht0 s d e) : ℝ) - + (p : ℝ) / ((d : ℝ) * (e : ℝ))| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) := by + apply rangeCount_error_le_of_coverCount_error_and_exactMultiplicity + (existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e).card + (Nat.card (existingConicSeedNonsplitPowerRangeSolutions p t ht ht0 s d e)) + p coefficient d e hd he + (existingConicSeedNonsplitTraceCurveSolutions_card_eq_mul_natCard_powerTraceRangeSolutions + p t ht ht0 s d e hdvd hedvd) + exact + existingConicSeedNonsplitTraceCurveSolutions_count_error_le_of_weilBoundAssumption_and_positiveExponents + coefficient hWeil p hpTwo t ht ht0 s d e hd he hdChar + +end Nonsplit + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean new file mode 100644 index 0000000000..46b46442fc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean @@ -0,0 +1,194 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# The explicit endgame Weil-bound assumption + +The paper's endgame needs a point estimate for the weighted split trace covers + +`alpha * (x^d + x^(-d)) = beta * (y^e + y^(-e))`. + +The project accepts each relevant affine Hasse--Weil specialization as an ordinary theorem +parameter. It is not a Lean axiom, a `sorry`, a typeclass, or a structure field. The constant is +fixed before the finite field, the weights, and the covering exponents are chosen, so the +interface expresses the uniformity required by Theorem 1. + +The assumption does not assert that a concrete Markoff trace cover is geometrically irreducible. +That hypothesis remains visible. The application theorem at the end of this file discharges it +using the in-repository absolute-irreducibility proof. + +Constructing a smooth projective normalization, bounding its genus and boundary, and applying the +classical projective Hasse--Weil theorem is one route to proving this assumption. Those objects +are intentionally not part of the downstream interface: they belong to a proof of the accepted +external theorem, not to each use of it. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The uniform weighted split trace-cover estimate accepted by the endgame. + +`coefficient` is independent of the finite field, weights, and covering exponents. Every +algebraic hypothesis needed to apply the estimate to a concrete cover is an explicit argument. +In particular, absolute irreducibility is stated as irreducibility after scalar extension to the +algebraic closure. -/ +def WeightedSplitTraceWeilBoundAssumption (coefficient : ℕ) : Prop := + 0 < coefficient ∧ + ∀ (K : Type) [Field K] [Fintype K] [DecidableEq K] + (alpha beta : K) (d e : ℕ), + alpha ≠ 0 → + beta ≠ 0 → + alpha * beta ≠ 1 → + 0 < d → + 0 < e → + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (splitTraceCoverPolynomial alpha beta d e)) → + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) * + (d : ℝ) * (e : ℝ) + +variable (K : Type) [Field K] [Fintype K] [DecidableEq K] + +/-- Apply the accepted Weil estimate after supplying the concrete cover's absolute +irreducibility. This theorem is the raw interface adapter; the next theorem proves that +irreducibility from the trace-cover hypotheses used in the paper. -/ +theorem splitTraceCurveSolutions_count_error_le_of_weilBoundAssumption + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (alpha beta : K) (d e : ℕ) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (hnondegenerate : alpha * beta ≠ 1) + (hd : 0 < d) (he : 0 < e) + (hirreducible : + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (splitTraceCoverPolynomial alpha beta d e))) : + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) * + (d : ℝ) * (e : ℝ) := + hWeil.2 K alpha beta d e halpha hbeta hnondegenerate hd he hirreducible + +/-- The endgame-ready point estimate for a concrete weighted trace cover. + +The only unproved mathematical input is `hWeil`. Lean proves the required absolute +irreducibility from nonzero/nondegenerate weights, positive exponents, and the condition that the +second covering exponent is nonzero in the ground field. For the paper's split endgame this last +condition follows because the exponent divides the prime-to-characteristic torus order. -/ +theorem splitTraceCurveSolutions_count_error_le_of_weilBoundAssumption_and_positiveExponents + (coefficient : ℕ) (hWeil : WeightedSplitTraceWeilBoundAssumption coefficient) + (alpha beta : K) (d e : ℕ) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (hnondegenerate : alpha * beta ≠ 1) + (hd : 0 < d) (he : 0 < e) (heChar : (e : K) ≠ 0) : + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) * + (d : ℝ) * (e : ℝ) := by + apply splitTraceCurveSolutions_count_error_le_of_weilBoundAssumption + K coefficient hWeil alpha beta d e halpha hbeta hnondegenerate hd he + exact splitTraceCoverPolynomial_absolutelyIrreducible_of_positiveExponents + alpha beta halpha hbeta hnondegenerate e d he hd heChar + +/-! ## The seeded nonsplit branch -/ + +/-- Solutions of the paper's corrected nonsplit endgame equation on the norm-one torus and the +base-field multiplicative group. Keeping this finite set over `ZMod p`, rather than replacing it +by all quadratic-field points of the scalar-extended split curve, preserves the actual count +needed by Theorem 1. -/ +noncomputable def existingConicSeedNonsplitTraceCurveSolutions + (p : ℕ) [Fact p.Prime] + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) : Finset (quadraticNormOneTorus p × (ZMod p)ˣ) := by + classical + exact Finset.univ.filter fun z => + ExistingConicSeedNonsplitTraceCoverEquation p t ht ht0 s d e z.1 z.2 + +@[simp] +theorem mem_existingConicSeedNonsplitTraceCurveSolutions_iff + (p : ℕ) [Fact p.Prime] + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) (z : quadraticNormOneTorus p × (ZMod p)ˣ) : + z ∈ existingConicSeedNonsplitTraceCurveSolutions p t ht ht0 s d e ↔ + ExistingConicSeedNonsplitTraceCoverEquation p t ht ht0 s d e z.1 z.2 := by + classical + simp [existingConicSeedNonsplitTraceCurveSolutions] + +/-- The uniform affine Weil estimate accepted for the seeded nonsplit endgame family. + +The conclusion counts the base-field solution set above, not every point of the scalar-extended +curve over the quadratic field. The explicit irreducibility premise is the polynomial statement +already proved for the scalar extension of the corrected seeded equation. -/ +def SeededNonsplitTraceWeilBoundAssumption (coefficient : ℕ) : Prop := + 0 < coefficient ∧ + ∀ (p : ℕ) [Fact p.Prime], + p ≠ 2 → + ∀ (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) (d e : ℕ), + 0 < d → + 0 < e → + Irreducible + (MvPolynomial.map + (algebraMap (quadraticFiniteField p) + (AlgebraicClosure (quadraticFiniteField p))) + (splitTraceCoverPolynomial + (s.1 : quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) ^ p) e d)) → + |((existingConicSeedNonsplitTraceCurveSolutions + p t ht ht0 s d e).card : ℝ) - (p : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) * (d : ℝ) * (e : ℝ) + +/-- Apply the accepted nonsplit Weil estimate after supplying the scalar-extended cover's +absolute irreducibility. -/ +theorem existingConicSeedNonsplitTraceCurveSolutions_count_error_le_of_weilBoundAssumption + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hirreducible : + Irreducible + (MvPolynomial.map + (algebraMap (quadraticFiniteField p) + (AlgebraicClosure (quadraticFiniteField p))) + (splitTraceCoverPolynomial + (s.1 : quadraticFiniteField p) + ((s.1 : quadraticFiniteField p) ^ p) e d))) : + |((existingConicSeedNonsplitTraceCurveSolutions + p t ht ht0 s d e).card : ℝ) - (p : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) * (d : ℝ) * (e : ℝ) := + hWeil.2 p hpTwo t ht ht0 s d e hd he hirreducible + +/-- The endgame-ready point estimate for the corrected seeded nonsplit cover. + +As in the split adapter, the only external input is `hWeil`. Lean supplies the +scalar-extended absolute irreducibility theorem from the actual conic seed and the visible +prime-to-characteristic condition on the norm-one covering exponent. -/ +theorem existingConicSeedNonsplitTraceCurveSolutions_count_error_le_of_weilBoundAssumption_and_positiveExponents + (coefficient : ℕ) (hWeil : SeededNonsplitTraceWeilBoundAssumption coefficient) + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (s : ↥(quadraticConicNormFiber p t ht ht0)) + (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hdChar : (d : quadraticFiniteField p) ≠ 0) : + |((existingConicSeedNonsplitTraceCurveSolutions + p t ht ht0 s d e).card : ℝ) - (p : ℝ)| ≤ + (coefficient : ℝ) * Real.sqrt (p : ℝ) * (d : ℝ) * (e : ℝ) := by + apply existingConicSeedNonsplitTraceCurveSolutions_count_error_le_of_weilBoundAssumption + coefficient hWeil p hpTwo t ht ht0 s d e hd he + exact existingConicSeed_weightedCover_absolutelyIrreducible + p hpTwo t ht ht0 s d e hd he hdChar + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean new file mode 100644 index 0000000000..c71ccfe6da --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean @@ -0,0 +1,227 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary + +/-! +# Applying the general affine Hasse--Weil theorem to split trace covers +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +private theorem degreeOf_first_monomial_le + (c : K) (a b : ℕ) : + MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C c * MvPolynomial.X 0 ^ a * MvPolynomial.X 1 ^ b) ≤ a := by + calc + _ ≤ MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.C c * MvPolynomial.X 0 ^ a) + + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 1 ^ b) := + MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ (MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.C c) + + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 0 ^ a)) + + MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 1 ^ b) := by + gcongr + exact MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ a := by + have ha : MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.X 0 ^ a : MvPolynomial (Fin 2) K) ≤ a := by + calc + _ ≤ a * MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 0) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = a := by rw [MvPolynomial.degreeOf_X]; norm_num + have hb : MvPolynomial.degreeOf (0 : Fin 2) + (MvPolynomial.X 1 ^ b : MvPolynomial (Fin 2) K) ≤ 0 := by + calc + _ ≤ b * MvPolynomial.degreeOf (0 : Fin 2) (MvPolynomial.X 1) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = 0 := by rw [MvPolynomial.degreeOf_X]; norm_num + rw [MvPolynomial.degreeOf_C] + omega + +private theorem degreeOf_second_monomial_le + (c : K) (a b : ℕ) : + MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.C c * MvPolynomial.X 0 ^ a * MvPolynomial.X 1 ^ b) ≤ b := by + calc + _ ≤ MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.C c * MvPolynomial.X 0 ^ a) + + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 1 ^ b) := + MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ (MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.C c) + + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 0 ^ a)) + + MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 1 ^ b) := by + gcongr + exact MvPolynomial.degreeOf_mul_le _ _ _ + _ ≤ b := by + have ha : MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.X 0 ^ a : MvPolynomial (Fin 2) K) ≤ 0 := by + calc + _ ≤ a * MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 0) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = 0 := by rw [MvPolynomial.degreeOf_X]; norm_num + have hb : MvPolynomial.degreeOf (1 : Fin 2) + (MvPolynomial.X 1 ^ b : MvPolynomial (Fin 2) K) ≤ b := by + calc + _ ≤ b * MvPolynomial.degreeOf (1 : Fin 2) (MvPolynomial.X 1) := + MvPolynomial.degreeOf_pow_le _ _ _ + _ = b := by rw [MvPolynomial.degreeOf_X]; norm_num + rw [MvPolynomial.degreeOf_C] + omega + +theorem splitTraceCoverPolynomial_degreeOf_first_le + (alpha beta : K) (d e : ℕ) : + MvPolynomial.degreeOf (0 : Fin 2) + (splitTraceCoverPolynomial alpha beta d e) ≤ 2 * d := by + unfold splitTraceCoverPolynomial + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_add_le _ _ _).trans (max_le ?_ ?_) + · exact (degreeOf_first_monomial_le alpha d (2 * e)).trans + (show d ≤ 2 * d by omega) + · simpa using + (degreeOf_first_monomial_le beta d 0).trans + (show d ≤ 2 * d by omega) + · simpa using + (degreeOf_first_monomial_le (1 : K) (2 * d) e) + · simpa using + (degreeOf_first_monomial_le (1 : K) 0 e).trans + (show 0 ≤ 2 * d by omega) + +theorem splitTraceCoverPolynomial_degreeOf_second_le + (alpha beta : K) (d e : ℕ) : + MvPolynomial.degreeOf (1 : Fin 2) + (splitTraceCoverPolynomial alpha beta d e) ≤ 2 * e := by + unfold splitTraceCoverPolynomial + refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_sub_le _ _ _).trans (max_le ?_ ?_) + · refine (MvPolynomial.degreeOf_add_le _ _ _).trans (max_le ?_ ?_) + · exact degreeOf_second_monomial_le alpha d (2 * e) + · simpa using + (degreeOf_second_monomial_le beta d 0).trans + (show 0 ≤ 2 * e by omega) + · simpa using + (degreeOf_second_monomial_le (1 : K) (2 * d) e).trans + (show e ≤ 2 * e by omega) + · simpa using + (degreeOf_second_monomial_le (1 : K) 0 e).trans + (show e ≤ 2 * e by omega) + +theorem splitTraceCoverPolynomial_hasBidegreeAtMost + (alpha beta : K) (d e : ℕ) : + BGS.External.HasBidegreeAtMost + (splitTraceCoverPolynomial alpha beta d e) (2 * d) (2 * e) := by + intro monomial hmonomial + exact ⟨ + (MvPolynomial.degreeOf_le_iff.mp + (splitTraceCoverPolynomial_degreeOf_first_le alpha beta d e)) + monomial hmonomial, + (MvPolynomial.degreeOf_le_iff.mp + (splitTraceCoverPolynomial_degreeOf_second_le alpha beta d e)) + monomial hmonomial⟩ + +/-- A fixed-coefficient affine Hasse--Weil bound supplies the correspondingly +fixed split trace estimate. -/ +theorem weightedSplitTraceWeilBoundAssumption_of_bivariateAffineHasseWeilBound + (generalCoefficient : ℕ) + (hgeneral : BGS.External.BivariateAffineHasseWeilBound generalCoefficient) : + WeightedSplitTraceWeilBoundAssumption (4 * generalCoefficient + 1) := by + let coefficient := 4 * generalCoefficient + 1 + change WeightedSplitTraceWeilBoundAssumption coefficient + refine ⟨by dsimp [coefficient]; omega, ?_⟩ + intro K _ _ _ alpha beta d e halpha hbeta hnondegenerate hd he hirreducible + have hAffine := hgeneral K (splitTraceCoverPolynomial alpha beta d e) + (2 * d) (2 * e) (by omega) (by omega) + (splitTraceCoverPolynomial_hasBidegreeAtMost alpha beta d e) hirreducible + have hcardNat : + (BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card = + (splitTraceCurveSolutions K alpha beta d e).card + 1 := by + calc + (BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card = + (affineSplitTraceCoverZeros K alpha beta d e).card := by rfl + _ = (torusSplitTraceCoverZeros K alpha beta d e).card + 1 := + affineSplitTraceCoverZeros_card_eq_torus_card_add_one + K alpha beta d e hd he hbeta + _ = (splitTraceCurveSolutions K alpha beta d e).card + 1 := by + rw [torusSplitTraceCoverZeros_card_eq_splitTraceCurveSolutions_card] + have hcardReal : + ((BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card : ℝ) = + (splitTraceCurveSolutions K alpha beta d e).card + 1 := by + exact_mod_cast hcardNat + let x : ℝ := Real.sqrt (Fintype.card K : ℝ) * (d : ℝ) * (e : ℝ) + have hcardOne : (1 : ℝ) ≤ (Fintype.card K : ℝ) := by + have hcardPositive : 0 < Fintype.card K := + Fintype.card_pos_iff.mpr ⟨(0 : K)⟩ + exact_mod_cast hcardPositive + have hsqrtOne : (1 : ℝ) ≤ Real.sqrt (Fintype.card K : ℝ) := + Real.one_le_sqrt.mpr hcardOne + have hdOne : (1 : ℝ) ≤ d := by exact_mod_cast hd + have heOne : (1 : ℝ) ≤ e := by exact_mod_cast he + have hxOne : (1 : ℝ) ≤ x := by + dsimp [x] + calc + (1 : ℝ) = 1 * 1 * 1 := by ring + _ ≤ Real.sqrt (Fintype.card K : ℝ) * d * e := by gcongr + have hAffine' : + |((BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + 4 * (generalCoefficient : ℝ) * x := by + norm_num only [Nat.cast_mul, Nat.cast_ofNat] at hAffine + convert hAffine using 1 <;> dsimp [x] <;> ring + have herrorIdentity : + ((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ) = + (((BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card : ℝ) - + (Fintype.card K : ℝ)) - 1 := by + rw [hcardReal] + ring + rw [herrorIdentity] + calc + |(((BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card : ℝ) - + (Fintype.card K : ℝ)) - 1| ≤ + |((BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card : ℝ) - + (Fintype.card K : ℝ)| + 1 := by + simpa using abs_sub + (((BGS.External.affinePlaneCurveZeros K + (splitTraceCoverPolynomial alpha beta d e)).card : ℝ) - + (Fintype.card K : ℝ)) (1 : ℝ) + _ ≤ 4 * (generalCoefficient : ℝ) * x + 1 := by gcongr + _ ≤ (4 * (generalCoefficient : ℝ) + 1) * x := by + nlinarith [hxOne] + _ = (coefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) * + (d : ℝ) * (e : ℝ) := by + dsimp [coefficient, x] + norm_num only [Nat.cast_add, Nat.cast_mul, Nat.cast_one, Nat.cast_ofNat] + ring + +/-- The general affine Hasse--Weil theorem supplies the uniform split trace +estimate. Absolute irreducibility remains an explicit premise of the target +interface and the unique affine boundary point is absorbed into the uniform +coefficient. -/ +theorem exists_weightedSplitTraceWeilBoundAssumption_of_generalHasseWeil + (hHasse : BGS.External.GeneralBivariateAffineHasseWeilTheorem) : + ∃ coefficient : ℕ, WeightedSplitTraceWeilBoundAssumption coefficient := by + obtain ⟨generalCoefficient, _hgeneralCoefficient, hgeneral⟩ := hHasse + exact ⟨4 * generalCoefficient + 1, + weightedSplitTraceWeilBoundAssumption_of_bivariateAffineHasseWeilBound + generalCoefficient hgeneral⟩ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean new file mode 100644 index 0000000000..610f5c6e48 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean @@ -0,0 +1,339 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity + +/-! +# Explicit endgame and cage connectivity + +This file separates the finite-prime endgame wiring from its closed numerical +certificates. The structural lemmas below consume the exact primitive-trace +inequalities at a fixed prime; the final wrappers discharge those inequalities +from `explicitStrongApproximationCutoff`. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The fixed-prime semisimple endgame. Its only numerical inputs are the +two displayed primitive-trace inequalities, with the fixed coefficients `33` +and `34` already obtained from the coefficient-`8` affine Hasse--Weil bound. -/ +theorem exists_iterate_nonparabolicPoint_with_maximal_secondRotation_of_explicitInequalities + (p : ℕ) [Fact p.Prime] (hpFive : 5 ≤ p) + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (x : ↑(normalizedFiber1 t)) + (hSplitExplicit : ∀ orbitExponent orbitOrder : ℕ, + orbitExponent * orbitOrder = p - 1 → + (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder → + (orbitExponent : ℝ) * (((p - 1).divisors.card : ℕ) : ℝ) ^ 2 * + ((33 : ℝ) * Real.sqrt (p : ℝ)) < p) + (hNonsplitExplicit : ∀ orbitExponent orbitOrder : ℕ, + orbitExponent * orbitOrder = p + 1 → + (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder → + (orbitExponent : ℝ) * (((p - 1).divisors.card : ℕ) : ℝ) ^ 2 * + ((34 : ℝ) * Real.sqrt (p : ℝ)) < p) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder t) : + ∃ n : ℕ, + rotationOrder + (((normalizedRotate1^[n]) + (x : NormalizedPoint (ZMod p))).u2) = p - 1 := by + have hpTwo : p ≠ 2 := by omega + rcases exists_split_or_nonsplitFiberParameter p hpTwo t ht ht0 x with + ⟨w, htrace, hw, s, hx⟩ | ⟨w, htrace, hw, s, hx⟩ + · have horder : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_splitTorusTrace w hw] + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hmul := Nat.div_mul_cancel (orderOf_dvd_natCard w) + rw [hcard] at hmul + have hexplicit := hSplitExplicit + ((p - 1) / orderOf w) (orderOf w) hmul (by simpa [horder] using hlarge) + obtain ⟨n, u, hcoordinate, huOrder⟩ := + exists_iterate_splitFiberPoint_with_primitive_secondTrace + p 33 weightedSplitTraceWeilBoundAssumption_thirtyThree hpTwo w s hw + (by simpa [htrace] using ht0) + (complementaryExponent_pos w) + (splitComplementaryExponent_cast_ne_zero p w) + (complementaryExponent_dvd_natCard w) (by + rw [hcard] + exact hexplicit) + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huPower + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huPower + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + omega + refine ⟨n, ?_⟩ + rw [← hx, hcoordinate, rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + · have horder : rotationOrder t = orderOf w := by + rw [← htrace, rotationOrder_quadraticNormOneTrace p w hw] + have hmul := Nat.div_mul_cancel (orderOf_dvd_natCard w) + rw [quadraticNormOneTorus_natCard] at hmul + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have hexplicit := hNonsplitExplicit + ((p + 1) / orderOf w) (orderOf w) hmul (by simpa [horder] using hlarge) + obtain ⟨n, u, hcoordinate, huOrder⟩ := + exists_iterate_quadraticNormFiberPoint_with_primitive_secondTrace + p 34 seededNonsplitTraceWeilBoundAssumption_thirtyFour hpTwo + t ht ht0 w htrace s + (complementaryExponent_pos w) + (nonsplitComplementaryExponent_cast_ne_zero p w) + (complementaryExponent_dvd_natCard w) (by + rw [quadraticNormOneTorus_natCard, hcard] + exact hexplicit) + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huPower + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huPower + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + omega + refine ⟨n, ?_⟩ + rw [← hx, hcoordinate, rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + +/-- Fixed-prime first-coordinate endgame, including the parabolic branch and +the trace-zero exclusion. -/ +theorem exists_iterate_point_with_maximal_secondRotation_of_explicitInequalities + (p : ℕ) [Fact p.Prime] (hpFive : 5 ≤ p) + (t : ZMod p) (x : ↑(normalizedFiber1 t)) + (hSplitExplicit : ∀ orbitExponent orbitOrder : ℕ, + orbitExponent * orbitOrder = p - 1 → + (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder → + (orbitExponent : ℝ) * (((p - 1).divisors.card : ℕ) : ℝ) ^ 2 * + ((33 : ℝ) * Real.sqrt (p : ℝ)) < p) + (hNonsplitExplicit : ∀ orbitExponent orbitOrder : ℕ, + orbitExponent * orbitOrder = p + 1 → + (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder → + (orbitExponent : ℝ) * (((p - 1).divisors.card : ℕ) : ℝ) ^ 2 * + ((34 : ℝ) * Real.sqrt (p : ℝ)) < p) + (hzero : 4 < (p : ℝ) ^ (5 / 6 : ℝ)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder t) : + ∃ n : ℕ, + rotationOrder + (((normalizedRotate1^[n]) + (x : NormalizedPoint (ZMod p))).u2) = p - 1 := by + by_cases htParabolic : t ^ 2 = 4 + · exact exists_iterate_parabolicPoint_with_maximal_secondRotation + p hpFive t htParabolic x + · have ht0 : t ≠ 0 := by + intro htZero + subst t + have horderSmall := rotationOrder_zero_le_four p + have hlargeLe : (p : ℝ) ^ (5 / 6 : ℝ) ≤ 4 := + hlarge.trans (by exact_mod_cast horderSmall) + exact (not_lt_of_ge hlargeLe) hzero + exact exists_iterate_nonparabolicPoint_with_maximal_secondRotation_of_explicitInequalities + p hpFive t htParabolic ht0 x hSplitExplicit hNonsplitExplicit hlarge + +/-- The pointwise primitive cage relation converted into the fiber bridge +used by cage connectivity. -/ +theorem exists_splitMaximalFiberBridge_of_explicitInequality + (p : ℕ) [Fact p.Prime] (hpFive : 5 ≤ p) + (hexplicit : + (((p - 1).divisors.card : ℕ) : ℝ) ^ 2 * + ((100522 : ℝ) * Real.sqrt (p : ℝ)) < p) + (axis other : NormalizedCoordinateAxis) (xi eta : ZMod p) + (hxi : IsSplitMaximalTrace p xi) (heta : IsSplitMaximalTrace p eta) : + ∃ middle : NormalizedCoordinateAxis, ∃ y : ZMod p, + middle ≠ axis ∧ middle ≠ other ∧ IsSplitMaximalTrace p y ∧ + NormalizedFibersMeet + (normalizedFiberAt axis xi) (normalizedFiberAt middle y) ∧ + NormalizedFibersMeet + (normalizedFiberAt other eta) (normalizedFiberAt middle y) := by + obtain ⟨u, huRelation, huOrder⟩ := + exists_primitive_cageMiddleUnit_of_explicitInequality + 100522 cageWitnessPointEstimate_oneHundredThousandFiveHundredTwentyTwo + p hpFive axis other xi eta hxi heta (by + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + rw [hcard] + exact hexplicit) + have hcard : Nat.card (ZMod p)ˣ = p - 1 := by + rw [Nat.card_units, Nat.card_zmod] + have huSq : (u : ZMod p) ^ 2 ≠ 1 := by + intro huPower + have huDvd : orderOf u ∣ 2 := orderOf_dvd_of_pow_eq_one <| by + apply Units.ext + exact huPower + have huLe : orderOf u ≤ 2 := Nat.le_of_dvd (by norm_num) huDvd + rw [huOrder, hcard] at huLe + omega + refine ⟨cageBridgeAxis axis other, splitTorusTrace u, + cageBridgeAxis_ne_left axis other, cageBridgeAxis_ne_right axis other, ?_, + huRelation.1, huRelation.2⟩ + rw [IsSplitMaximalTrace, rotationOrder_splitTorusTrace u huSq, huOrder, hcard] + +/-- Pointwise connectivity of the selected cage from its closed numerical +inequality. -/ +theorem splitCage_connected_of_explicitInequality + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpSeven : 7 ≤ p) + (hexplicit : + (((p - 1).divisors.card : ℕ) : ℝ) ^ 2 * + ((100522 : ℝ) * Real.sqrt (p : ℝ)) < p) + (x y : NormalizedMarkoffSurface (ZMod p)) + (hxCage : IsInSplitCage p x) (hyCage : IsInSplitCage p y) : + SameNormalizedComponent x y := by + rcases hxCage with ⟨axis, hxi⟩ + rcases hyCage with ⟨other, heta⟩ + let xi := normalizedCoordinateAt axis x.1 + let eta := normalizedCoordinateAt other y.1 + obtain ⟨middle, z, hmiddleAxis, hmiddleOther, hzMax, hxMeet, hyMeet⟩ := + exists_splitMaximalFiberBridge_of_explicitInequality + p (by omega) hexplicit axis other xi eta hxi heta + rcases hxMeet with ⟨px, hpxAxis, hpxMiddle⟩ + rcases hyMeet with ⟨py, hpyOther, hpyMiddle⟩ + let pxs : NormalizedMarkoffSurface (ZMod p) := + ⟨px, isNormalizedMarkoff_of_mem_normalizedFiberAt hpxAxis⟩ + let pys : NormalizedMarkoffSurface (ZMod p) := + ⟨py, isNormalizedMarkoff_of_mem_normalizedFiberAt hpyOther⟩ + have hxFiber : x.1 ∈ normalizedFiberAt axis xi := + mem_normalizedFiberAt_coordinate axis x + have hyFiber : y.1 ∈ normalizedFiberAt other eta := + mem_normalizedFiberAt_coordinate other y + have hxpx : SameNormalizedComponent x pxs := + sameNormalizedComponent_of_mem_same_splitMaximalFiber + p hpSeven axis xi hxi x pxs hxFiber hpxAxis + have hpxpy : SameNormalizedComponent pxs pys := + sameNormalizedComponent_of_mem_same_splitMaximalFiber + p hpSeven middle z hzMax pxs pys hpxMiddle hpyMiddle + have hypy : SameNormalizedComponent y pys := + sameNormalizedComponent_of_mem_same_splitMaximalFiber + p hpSeven other eta heta y pys hyFiber hpyOther + exact sameNormalizedComponent_trans hxpx + (sameNormalizedComponent_trans hpxpy (sameNormalizedComponent_symm hypy)) + +private theorem explicitCutoff_seven_le + {p : ℕ} [Fact p.Prime] + (hp : explicitStrongApproximationCutoff ≤ p) : 7 ≤ p := by + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (explicitCutoff_gt_one.trans_le hp).le + have hrootLe : (p : ℝ) ^ (1 / 8 : ℝ) ≤ p := by + simpa using Real.rpow_le_self_of_one_le hpOne (by norm_num : (1 / 8 : ℝ) ≤ 1) + have hfiveRoot : (5 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + small_fixed_lt_rpow_one_div_eight_of_explicitCutoff hp (by norm_num) + have hfive : 5 < p := by + exact_mod_cast hfiveRoot.trans_le hrootLe + have hpSix : p ≠ 6 := by + intro hpEq + subst p + have hprime : Nat.Prime 6 := Fact.out + norm_num at hprime + omega + +/-- At the closed cutoff, the first-coordinate endgame reaches a maximal +split rotation with no residual numerical or geometric assumptions. -/ +theorem exists_explicit_sameComponent_maximalRotation_of_large_firstCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : explicitStrongApproximationCutoff ≤ p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ rotationOrder y.1.u2 = p - 1 := by + let xf : ↑(normalizedFiber1 x.1.u1) := ⟨x.1, x.property, rfl⟩ + obtain ⟨n, hrotation⟩ := + exists_iterate_point_with_maximal_secondRotation_of_explicitInequalities + p ((by norm_num : 5 ≤ 7).trans (explicitCutoff_seven_le hp)) x.1.u1 xf + (fun orbitExponent orbitOrder hmul horder ↦ + explicit_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + hp hmul horder (by norm_num)) + (fun orbitExponent orbitOrder hmul horder ↦ + explicit_endgamePrimitiveTrace_explicitInequality_of_card_add_one + hp hmul horder (by norm_num)) + (explicit_four_lt_rpow_five_div_six hp) hlarge + let y := (normalizedRotate1Surface^[n]) x + refine ⟨y, sameNormalizedComponent_iterate_normalizedRotate1Surface x n, ?_⟩ + rw [show y.1 = (normalizedRotate1^[n]) x.1 by + exact coe_iterate_normalizedRotate1Surface x n] + exact hrotation + +/-- First-coordinate form of the explicit large-order-to-cage endgame. -/ +theorem exists_explicit_sameComponent_splitCage_of_large_firstCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : explicitStrongApproximationCutoff ≤ p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + obtain ⟨y, hxy, hyOrder⟩ := + exists_explicit_sameComponent_maximalRotation_of_large_firstCoordinate hp x hlarge + exact ⟨y, hxy, .second, hyOrder⟩ + +/-- If one of the three coordinate rotations is explicitly large, the point +reaches the selected split cage. -/ +theorem exists_explicit_sameComponent_splitCage_of_some_largeCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : explicitStrongApproximationCutoff ≤ p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u3) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + rcases hlarge with hfirst | hsecond | hthird + · exact exists_explicit_sameComponent_splitCage_of_large_firstCoordinate hp x hfirst + · let x' := normalizedSwap12Surface x + have hx' : SameNormalizedComponent x x' := sameNormalizedComponent_swap12Surface x + have hlarge' : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, coe_normalizedSwap12Surface] using hsecond + obtain ⟨y, hy, hyOrder⟩ := + exists_explicit_sameComponent_maximalRotation_of_large_firstCoordinate hp x' hlarge' + exact ⟨y, sameNormalizedComponent_trans hx' hy, .second, hyOrder⟩ + · let x' := normalizedSwap12Surface (normalizedSwap23Surface x) + have hx23 : SameNormalizedComponent x (normalizedSwap23Surface x) := + sameNormalizedComponent_swap23Surface x + have hx12 : SameNormalizedComponent (normalizedSwap23Surface x) x' := + sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x) + have hlarge' : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, normalizedSwap23, coe_normalizedSwap12Surface, + coe_normalizedSwap23Surface] using hthird + obtain ⟨y, hy, hyOrder⟩ := + exists_explicit_sameComponent_maximalRotation_of_large_firstCoordinate hp x' hlarge' + exact ⟨y, sameNormalizedComponent_trans + (sameNormalizedComponent_trans hx23 hx12) hy, .second, hyOrder⟩ + +/-- The selected split cage is connected at the closed cutoff. -/ +theorem explicit_splitCage_connected + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : explicitStrongApproximationCutoff ≤ p) + (x y : NormalizedMarkoffSurface (ZMod p)) + (hx : IsInSplitCage p x) (hy : IsInSplitCage p y) : + SameNormalizedComponent x y := by + exact splitCage_connected_of_explicitInequality p (explicitCutoff_seven_le hp) + (explicit_cageWitness_explicitInequality hp (by norm_num)) x y hx hy + +/-- A large-order point is in the component of any chosen base point of the +selected split cage. This is the endgame statement consumed by the maximal +bad-orbit argument. -/ +theorem explicit_sameNormalizedComponent_of_largeOrder_to_splitCage + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : explicitStrongApproximationCutoff ≤ p) + (base x : NormalizedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p base) + (hlarge : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u3) : + SameNormalizedComponent base x := by + obtain ⟨y, hxy, hy⟩ := + exists_explicit_sameComponent_splitCage_of_some_largeCoordinate hp x hlarge + exact sameNormalizedComponent_trans + (explicit_splitCage_connected hp base y hbase hy) + (sameNormalizedComponent_symm hxy) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean new file mode 100644 index 0000000000..eaacb2496f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean @@ -0,0 +1,55 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil + +/-! +# Fixed point-count estimates for explicit strong approximation + +The general affine Hasse--Weil theorem in this repository has coefficient +`8`. This file records, without existentially choosing any constants, the +four numerical specializations used by the explicit Markoff argument. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The fixed split trace estimate obtained from affine coefficient `8`. -/ +theorem weightedSplitTraceWeilBoundAssumption_thirtyThree : + WeightedSplitTraceWeilBoundAssumption 33 := by + simpa using + weightedSplitTraceWeilBoundAssumption_of_bivariateAffineHasseWeilBound 8 + BGS.HasseWeil.bivariateAffineHasseWeilBound_eight + +/-- The fixed nonsplit trace estimate obtained from affine coefficient `8`. -/ +theorem seededNonsplitTraceWeilBoundAssumption_thirtyFour : + SeededNonsplitTraceWeilBoundAssumption 34 := by + simpa using + seededNonsplitTraceWeilBoundAssumption_of_bivariateAffineHasseWeilBound 8 + BGS.HasseWeil.bivariateAffineHasseWeilBound_eight + +/-- The fixed cage-plane estimate obtained from affine coefficient `8`. -/ +theorem cagePlanePointEstimate_twoHundredFiftySix : + CagePlanePointEstimate 256 := by + simpa using + cagePlanePointEstimate_of_bivariateAffineHasseWeilBound 8 + BGS.HasseWeil.bivariateAffineHasseWeilBound_eight + +/-- The resulting fixed cage-witness estimate. -/ +theorem cageWitnessPointEstimate_oneHundredThousandFiveHundredTwentyTwo : + CageWitnessPointEstimate 100522 := by + simpa using + cageWitnessPointEstimate_of_cagePlanePointEstimate 256 + cagePlanePointEstimate_twoHundredFiftySix + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean new file mode 100644 index 0000000000..c255ee77ee --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean @@ -0,0 +1,596 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics + +/-! +# Numerical certificates for the explicit strong-approximation cutoff + +This file packages the closed real-power and natural-power calculations used +by the explicit middle game, endgame, cage, and small-order argument. +-/ + +namespace BGS.Markoff + +open scoped Topology + +/-! The certificates for the first explicit record remain available for +comparison, but the canonical declarations below use the ninth-moment cutoff. -/ +namespace Legacy + +private theorem fixed_pow_thirtyTwo_le_explicitDivisorConstant_of_le_32_pow + {fixed : ℕ} (hfixed : fixed ≤ 32 ^ 32) : + fixed ^ 32 ≤ BGS.NumberTheory.explicitDivisorConstant := by + rw [BGS.NumberTheory.explicitDivisorConstant_eq] + calc + fixed ^ 32 ≤ (32 ^ 32) ^ 32 := Nat.pow_le_pow_left hfixed 32 + _ ≤ (32 ^ 32) ^ (2 ^ 32) := + pow_le_pow_right₀ (by norm_num) (by norm_num) + +private theorem explicit_prime_one_lt + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (1 : ℝ) < p := by + exact_mod_cast explicitCutoff_gt_one.trans_le hp + +private theorem rpow_lt_self_of_exponent_lt_one + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + {a : ℝ} (ha : a < 1) : + (p : ℝ) ^ a < p := by + simpa only [Real.rpow_one] using + Real.rpow_lt_rpow_of_exponent_lt (explicit_prime_one_lt hp) ha + +/-- At the explicit cutoff, the all-divisors Corvaja--Zannier estimate obeys +both finite size conditions throughout the range +`p^(7/32) < currentOrder < p^(25/32)`. -/ +theorem explicit_middleGame_corvajaZannier_sizeBounds + {p currentOrder : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hLower : (p : ℝ) ^ (7 / 32 : ℝ) < currentOrder) + (hUpper : (currentOrder : ℝ) < (p : ℝ) ^ (25 / 32 : ℝ)) : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < currentOrder ∧ + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p := by + let A : ℕ := corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hpRealNonneg : (0 : ℝ) ≤ p := hpRealPos.le + have hA : (A : ℝ) ≤ 144 * (p : ℝ) ^ (2 / 32 : ℝ) := by + dsimp [A] + convert explicit_corvajaZannier_divisor_term_le hp using 1 <;> norm_num + have h144cube : (144 ^ 3 : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + by + have h := fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp + (fixed_pow_thirtyTwo_le_explicitDivisorConstant_of_le_32_pow + (fixed := 144 ^ 3) (by norm_num)) + norm_num at h ⊢ + exact h + have h144 : (144 : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp + (fixed_pow_thirtyTwo_le_explicitDivisorConstant_of_le_32_pow + (fixed := 144) (by norm_num)) + have hCubePower : + (144 * (p : ℝ) ^ (2 / 32 : ℝ)) ^ 3 = + 144 ^ 3 * (p : ℝ) ^ (6 / 32 : ℝ) := by + rw [mul_pow, ← Real.rpow_mul_natCast hpRealNonneg (2 / 32 : ℝ) 3] + congr 2 + norm_num + have hCube : (A : ℝ) ^ 3 < (currentOrder : ℝ) := by + calc + (A : ℝ) ^ 3 ≤ (144 * (p : ℝ) ^ (2 / 32 : ℝ)) ^ 3 := by + exact pow_le_pow_left₀ (Nat.cast_nonneg A) hA 3 + _ = 144 ^ 3 * (p : ℝ) ^ (6 / 32 : ℝ) := hCubePower + _ < (p : ℝ) ^ (1 / 32 : ℝ) * + (p : ℝ) ^ (6 / 32 : ℝ) := by + exact mul_lt_mul_of_pos_right h144cube + (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) ^ (7 / 32 : ℝ) := by + rw [← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < currentOrder := hLower + have hLinear : (A : ℝ) * currentOrder < p := by + calc + (A : ℝ) * currentOrder ≤ + (144 * (p : ℝ) ^ (2 / 32 : ℝ)) * currentOrder := by + exact mul_le_mul_of_nonneg_right hA (Nat.cast_nonneg currentOrder) + _ < (144 * (p : ℝ) ^ (2 / 32 : ℝ)) * + (p : ℝ) ^ (25 / 32 : ℝ) := by + exact mul_lt_mul_of_pos_left hUpper + (mul_pos (by norm_num) (Real.rpow_pos_of_pos hpRealPos _)) + _ = 144 * ((p : ℝ) ^ (2 / 32 : ℝ) * + (p : ℝ) ^ (25 / 32 : ℝ)) := by ring + _ < (p : ℝ) ^ (1 / 32 : ℝ) * + ((p : ℝ) ^ (2 / 32 : ℝ) * + (p : ℝ) ^ (25 / 32 : ℝ)) := by + exact mul_lt_mul_of_pos_right h144 + (mul_pos (Real.rpow_pos_of_pos hpRealPos _) + (Real.rpow_pos_of_pos hpRealPos _)) + _ = (p : ℝ) ^ (28 / 32 : ℝ) := by + rw [← Real.rpow_add hpRealPos, ← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := rpow_lt_self_of_exponent_lt_one hp (by norm_num) + constructor + · exact_mod_cast hCube + · exact_mod_cast hLinear + +/-- The primitive-inclusion--exclusion error is strictly smaller than its +main term for an exponent at most `2*p^(9/32)` and every coefficient at most +`34`. -/ +theorem explicit_endgamePrimitiveTrace_explicitInequality + {p orbitExponent coefficient : ℕ} + (hp : explicitStrongApproximationCutoff ≤ p) + (horbit : (orbitExponent : ℝ) ≤ 2 * (p : ℝ) ^ (9 / 32 : ℝ)) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hdivisorSum := explicit_divisor_sum_le_three_mul_rpow hp + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ + 3 * (p : ℝ) ^ (2 / 32 : ℝ) := by + norm_num only [Nat.cast_add] at hdivisorSum + have hle : ((p - 1).divisors.card : ℝ) ≤ + ((p - 1).divisors.card : ℝ) + ((p + 1).divisors.card : ℝ) := by + exact le_add_of_nonneg_right (Nat.cast_nonneg _) + calc + ((p - 1).divisors.card : ℝ) ≤ + ((p - 1).divisors.card : ℝ) + ((p + 1).divisors.card : ℝ) := hle + _ ≤ 3 * (p : ℝ) ^ (1 / 16 : ℝ) := hdivisorSum + _ = 3 * (p : ℝ) ^ (2 / 32 : ℝ) := by norm_num + have hfixed : (2 * 3 ^ 2 * 34 : ℝ) < + (p : ℝ) ^ (1 / 32 : ℝ) := + by + have h := fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp + (fixed_pow_thirtyTwo_le_explicitDivisorConstant_of_le_32_pow + (fixed := 2 * 3 ^ 2 * 34) (by norm_num)) + norm_num at h ⊢ + exact h + have hsqrt : Real.sqrt (p : ℝ) = (p : ℝ) ^ (16 / 32 : ℝ) := by + rw [Real.sqrt_eq_rpow] + congr 1 + norm_num + calc + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + (2 * (p : ℝ) ^ (9 / 32 : ℝ)) * + (3 * (p : ℝ) ^ (2 / 32 : ℝ)) ^ 2 * + (34 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = (2 * 3 ^ 2 * 34) * + ((p : ℝ) ^ (9 / 32 : ℝ) * + ((p : ℝ) ^ (2 / 32 : ℝ)) ^ 2 * + (p : ℝ) ^ (16 / 32 : ℝ)) := by rw [hsqrt]; ring + _ = (2 * 3 ^ 2 * 34) * (p : ℝ) ^ (29 / 32 : ℝ) := by + rw [← Real.rpow_mul_natCast hpRealPos.le (2 / 32 : ℝ) 2, + ← Real.rpow_add hpRealPos, ← Real.rpow_add hpRealPos] + congr 2 + norm_num + _ < (p : ℝ) ^ (1 / 32 : ℝ) * + (p : ℝ) ^ (29 / 32 : ℝ) := by + exact mul_lt_mul_of_pos_right hfixed (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) ^ (30 / 32 : ℝ) := by + rw [← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := rpow_lt_self_of_exponent_lt_one hp (by norm_num) + +/-- Split-torus form of the explicit primitive-trace certificate. -/ +theorem explicit_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : explicitStrongApproximationCutoff ≤ p) + (hmul : orbitExponent * orbitOrder = p - 1) + (horder : (p : ℝ) ^ (23 / 32 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply explicit_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := by + exact Nat.zero_lt_one.trans (explicitCutoff_gt_one.trans_le hp) + have horder' : (p : ℝ) ^ ((1 : ℝ) / 2 + 7 / 32) ≤ orbitOrder := by + convert horder using 1 <;> norm_num + have horbit := orbitExponent_le_rpow_of_mul_order_eq_card_sub_one + p orbitExponent orbitOrder hpNat hmul horder' + calc + (orbitExponent : ℝ) ≤ (p : ℝ) ^ ((1 : ℝ) / 2 - 7 / 32) := horbit + _ = (p : ℝ) ^ (9 / 32 : ℝ) := by norm_num + _ ≤ 2 * (p : ℝ) ^ (9 / 32 : ℝ) := by + have hnonneg : (0 : ℝ) ≤ (p : ℝ) ^ (9 / 32 : ℝ) := + Real.rpow_nonneg (Nat.cast_nonneg p) _ + linarith + +/-- Nonsplit-torus form of the explicit primitive-trace certificate. -/ +theorem explicit_endgamePrimitiveTrace_explicitInequality_of_card_add_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : explicitStrongApproximationCutoff ≤ p) + (hmul : orbitExponent * orbitOrder = p + 1) + (horder : (p : ℝ) ^ (23 / 32 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply explicit_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := by + exact Nat.zero_lt_one.trans (explicitCutoff_gt_one.trans_le hp) + have horder' : (p : ℝ) ^ ((1 : ℝ) / 2 + 7 / 32) ≤ orbitOrder := by + convert horder using 1 <;> norm_num + have horbit := orbitExponent_le_two_mul_rpow_of_mul_order_eq_card_add_one + p orbitExponent orbitOrder hpNat hmul horder' + convert horbit using 1 <;> norm_num + +/-- The trace-zero order bound `4` lies below the explicit endgame threshold. -/ +theorem explicit_four_lt_rpow_twentyThree_div_thirtyTwo + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (4 : ℝ) < (p : ℝ) ^ (23 / 32 : ℝ) := by + have hfour : (4 : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + small_fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp (by norm_num) + have hpOne := explicit_prime_one_lt hp + exact hfour.trans (Real.rpow_lt_rpow_of_exponent_lt hpOne (by norm_num)) + +/-- The middle-game lower threshold also dominates the order-four exceptional +case. -/ +theorem explicit_four_lt_rpow_seven_div_thirtyTwo + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (4 : ℝ) < (p : ℝ) ^ (7 / 32 : ℝ) := by + have hfour : (4 : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + small_fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp (by norm_num) + have hpOne := explicit_prime_one_lt hp + exact hfour.trans (Real.rpow_lt_rpow_of_exponent_lt hpOne (by norm_num)) + +/-- The coefficient `100522` cage error is dominated by `p` at the explicit +cutoff. -/ +theorem explicit_cageWitness_explicitInequality + {p coefficient : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hcoefficient : coefficient ≤ 100522) : + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hdivisorSum := explicit_divisor_sum_le_three_mul_rpow hp + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ + 3 * (p : ℝ) ^ (2 / 32 : ℝ) := by + norm_num only [Nat.cast_add] at hdivisorSum + have hle : ((p - 1).divisors.card : ℝ) ≤ + ((p - 1).divisors.card : ℝ) + ((p + 1).divisors.card : ℝ) := by + exact le_add_of_nonneg_right (Nat.cast_nonneg _) + calc + ((p - 1).divisors.card : ℝ) ≤ + ((p - 1).divisors.card : ℝ) + ((p + 1).divisors.card : ℝ) := hle + _ ≤ 3 * (p : ℝ) ^ (1 / 16 : ℝ) := hdivisorSum + _ = 3 * (p : ℝ) ^ (2 / 32 : ℝ) := by norm_num + have hfixed : (3 ^ 2 * 100522 : ℝ) < + (p : ℝ) ^ (1 / 32 : ℝ) := + by + have h := fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp + (fixed_pow_thirtyTwo_le_explicitDivisorConstant_of_le_32_pow + (fixed := 3 ^ 2 * 100522) (by norm_num)) + norm_num at h ⊢ + exact h + have hsqrt : Real.sqrt (p : ℝ) = (p : ℝ) ^ (16 / 32 : ℝ) := by + rw [Real.sqrt_eq_rpow] + congr 1 + norm_num + calc + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + (3 * (p : ℝ) ^ (2 / 32 : ℝ)) ^ 2 * + (100522 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = (3 ^ 2 * 100522) * + (((p : ℝ) ^ (2 / 32 : ℝ)) ^ 2 * + (p : ℝ) ^ (16 / 32 : ℝ)) := by rw [hsqrt]; ring + _ = (3 ^ 2 * 100522) * (p : ℝ) ^ (20 / 32 : ℝ) := by + rw [← Real.rpow_mul_natCast hpRealPos.le (2 / 32 : ℝ) 2, + ← Real.rpow_add hpRealPos] + congr 2 + norm_num + _ < (p : ℝ) ^ (1 / 32 : ℝ) * + (p : ℝ) ^ (20 / 32 : ℝ) := by + exact mul_lt_mul_of_pos_right hfixed (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) ^ (21 / 32 : ℝ) := by + rw [← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := rpow_lt_self_of_exponent_lt_one hp (by norm_num) + +/-- The elementary low-order count cannot contain a nonempty orbit whose +cardinality is divisible by `p` once `d ≤ p^(7/32)`. -/ +theorem explicit_lowOrder_contradiction + {p d : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hpLe : p ≤ 32 * d ^ 4) + (hd : (d : ℝ) ≤ (p : ℝ) ^ (7 / 32 : ℝ)) : False := by + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hfixed : (32 : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + small_fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp (by norm_num) + have hpLeReal : (p : ℝ) ≤ 32 * (d : ℝ) ^ 4 := by exact_mod_cast hpLe + have hbound : (32 : ℝ) * (d : ℝ) ^ 4 < p := by + calc + (32 : ℝ) * (d : ℝ) ^ 4 ≤ + 32 * ((p : ℝ) ^ (7 / 32 : ℝ)) ^ 4 := by + gcongr + _ < (p : ℝ) ^ (1 / 32 : ℝ) * + ((p : ℝ) ^ (7 / 32 : ℝ)) ^ 4 := by + exact mul_lt_mul_of_pos_right hfixed (pow_pos (Real.rpow_pos_of_pos hpRealPos _) _) + _ = (p : ℝ) ^ (29 / 32 : ℝ) := by + rw [← Real.rpow_mul_natCast hpRealPos.le (7 / 32 : ℝ) 4, + ← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := rpow_lt_self_of_exponent_lt_one hp (by norm_num) + exact (not_lt_of_ge hpLeReal) hbound + +/-- Variant of `explicit_lowOrder_contradiction` for the `d + 1` cutoff used +when maximality turns a strict order bound into a finite-set inclusion. -/ +theorem explicit_lowOrder_contradiction_512 + {p d : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hpLe : p ≤ 512 * d ^ 4) + (hd : (d : ℝ) ≤ (p : ℝ) ^ (7 / 32 : ℝ)) : False := by + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hfixed : (512 : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + small_fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp (by norm_num) + have hpLeReal : (p : ℝ) ≤ 512 * (d : ℝ) ^ 4 := by exact_mod_cast hpLe + have hbound : (512 : ℝ) * (d : ℝ) ^ 4 < p := by + calc + (512 : ℝ) * (d : ℝ) ^ 4 ≤ + 512 * ((p : ℝ) ^ (7 / 32 : ℝ)) ^ 4 := by + gcongr + _ < (p : ℝ) ^ (1 / 32 : ℝ) * + ((p : ℝ) ^ (7 / 32 : ℝ)) ^ 4 := by + exact mul_lt_mul_of_pos_right hfixed (pow_pos (Real.rpow_pos_of_pos hpRealPos _) _) + _ = (p : ℝ) ^ (29 / 32 : ℝ) := by + rw [← Real.rpow_mul_natCast hpRealPos.le (7 / 32 : ℝ) 4, + ← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := rpow_lt_self_of_exponent_lt_one hp (by norm_num) + exact (not_lt_of_ge hpLeReal) hbound + +end Legacy + +private theorem explicit_prime_one_lt + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (1 : ℝ) < p := by + exact_mod_cast explicitCutoff_gt_one.trans_le hp + +private theorem rpow_lt_self_of_exponent_lt_one + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + {a : ℝ} (ha : a < 1) : + (p : ℝ) ^ a < p := by + simpa only [Real.rpow_one] using + Real.rpow_lt_rpow_of_exponent_lt (explicit_prime_one_lt hp) ha + +/-- Below the five-sixths threshold, the coefficient-48 divisor term times +the current order is strictly smaller than `p`. -/ +theorem explicit_middleGame_corvajaZannier_linear_of_lt_fiveSixths + {p currentOrder : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hUpper : (currentOrder : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ)) : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p := by + let A : ℕ := corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hA : (A : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) := by + simpa [A] using explicit_corvajaZannier_divisor_term_lt_rpow_one_div_six hp + have hLinearPower : (p : ℝ) ^ (1 / 6 : ℝ) * + (p : ℝ) ^ (5 / 6 : ℝ) = (p : ℝ) := by + rw [← Real.rpow_add hpRealPos] + norm_num + have hLinear : (A : ℝ) * currentOrder < p := by + calc + (A : ℝ) * currentOrder ≤ + (p : ℝ) ^ (1 / 6 : ℝ) * currentOrder := + mul_le_mul_of_nonneg_right hA.le (Nat.cast_nonneg currentOrder) + _ < (p : ℝ) ^ (1 / 6 : ℝ) * (p : ℝ) ^ (5 / 6 : ℝ) := + mul_lt_mul_of_pos_left hUpper (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) := hLinearPower + exact_mod_cast hLinear + +/-- Assembly-facing alias for the five-sixths middle-game certificate. -/ +theorem explicit_middleGame_corvajaZannier_linearBound + {p currentOrder : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hUpper : (currentOrder : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ)) : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p := + explicit_middleGame_corvajaZannier_linear_of_lt_fiveSixths hp hUpper + +/-- Primitive-trace inclusion--exclusion at exponent at most `2*p^(1/6)`. -/ +theorem explicit_endgamePrimitiveTrace_explicitInequality + {p orbitExponent coefficient : ℕ} + (hp : explicitStrongApproximationCutoff ≤ p) + (horbit : (orbitExponent : ℝ) ≤ 2 * (p : ℝ) ^ (1 / 6 : ℝ)) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ (T : ℝ) := by + exact_mod_cast (show (p - 1).divisors.card ≤ T by + dsimp [T] + omega) + have hweighted : (68 : ℝ) * (T : ℝ) ^ 2 < + (p : ℝ) ^ (1 / 3 : ℝ) := by + simpa [T] using explicit_weighted_divisor_sum_sq_lt_rpow_one_div_three hp + calc + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + (2 * (p : ℝ) ^ (1 / 6 : ℝ)) * (T : ℝ) ^ 2 * + (34 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = (68 * (T : ℝ) ^ 2) * + ((p : ℝ) ^ (1 / 6 : ℝ) * Real.sqrt (p : ℝ)) := by ring + _ < (p : ℝ) ^ (1 / 3 : ℝ) * + ((p : ℝ) ^ (1 / 6 : ℝ) * Real.sqrt (p : ℝ)) := by + exact mul_lt_mul_of_pos_right hweighted <| + mul_pos (Real.rpow_pos_of_pos hpRealPos _) (Real.sqrt_pos.2 hpRealPos) + _ = (p : ℝ) := by + rw [Real.sqrt_eq_rpow, ← Real.rpow_add hpRealPos, + ← Real.rpow_add hpRealPos] + norm_num + +/-- Split-torus form of the improved primitive-trace certificate. -/ +theorem explicit_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : explicitStrongApproximationCutoff ≤ p) + (hmul : orbitExponent * orbitOrder = p - 1) + (horder : (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply explicit_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := Nat.zero_lt_one.trans (explicitCutoff_gt_one.trans_le hp) + have horbit := orbitExponent_le_rpow_of_mul_order_eq_card_sub_one + p orbitExponent orbitOrder (δ := (1 / 3 : ℝ)) hpNat hmul (by + convert horder using 1 <;> norm_num) + calc + (orbitExponent : ℝ) ≤ (p : ℝ) ^ (1 / 6 : ℝ) := by + convert horbit using 1 <;> norm_num + _ ≤ 2 * (p : ℝ) ^ (1 / 6 : ℝ) := by + nlinarith [Real.rpow_nonneg (Nat.cast_nonneg p) (1 / 6 : ℝ)] + +/-- Nonsplit-torus form of the improved primitive-trace certificate. -/ +theorem explicit_endgamePrimitiveTrace_explicitInequality_of_card_add_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : explicitStrongApproximationCutoff ≤ p) + (hmul : orbitExponent * orbitOrder = p + 1) + (horder : (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply explicit_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := Nat.zero_lt_one.trans (explicitCutoff_gt_one.trans_le hp) + have horbit := orbitExponent_le_two_mul_rpow_of_mul_order_eq_card_add_one + p orbitExponent orbitOrder (δ := (1 / 3 : ℝ)) hpNat hmul (by + convert horder using 1 <;> norm_num) + convert horbit using 1 <;> norm_num + +/-- The trace-zero order bound lies below the improved endgame threshold. -/ +theorem explicit_four_lt_rpow_five_div_six + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (4 : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + have hfour : (4 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + small_fixed_lt_rpow_one_div_eight_of_explicitCutoff hp (by norm_num) + exact hfour.trans <| + Real.rpow_lt_rpow_of_exponent_lt (explicit_prime_one_lt hp) (by norm_num) + +/-- The coefficient-`100522` cage error is dominated by `p`. -/ +theorem explicit_cageWitness_explicitInequality + {p coefficient : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hcoefficient : coefficient ≤ 100522) : + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + have hpRealPos : (0 : ℝ) < p := (explicit_prime_one_lt hp).trans' zero_lt_one + have hpRealNonneg : (0 : ℝ) ≤ p := hpRealPos.le + have hsum := explicit_divisor_sum_lt_rpow_one_div_eight hp + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ + (p : ℝ) ^ (1 / 8 : ℝ) := by + norm_num only [Nat.cast_add] at hsum + exact (le_add_of_nonneg_right (Nat.cast_nonneg _)).trans hsum.le + have hfixed : (100522 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + small_fixed_lt_rpow_one_div_eight_of_explicitCutoff hp (by norm_num) + have hsqrt : Real.sqrt (p : ℝ) = (p : ℝ) ^ (4 / 8 : ℝ) := by + rw [Real.sqrt_eq_rpow] + congr 1 + norm_num + have hpower : ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 2 * Real.sqrt (p : ℝ) = + (p : ℝ) ^ (6 / 8 : ℝ) := by + rw [hsqrt, ← Real.rpow_mul_natCast hpRealNonneg, ← Real.rpow_add hpRealPos] + congr 1 + norm_num + calc + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 2 * + (100522 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = 100522 * (p : ℝ) ^ (6 / 8 : ℝ) := by rw [← hpower]; ring + _ < (p : ℝ) ^ (1 / 8 : ℝ) * (p : ℝ) ^ (6 / 8 : ℝ) := by + exact mul_lt_mul_of_pos_right hfixed (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) ^ (7 / 8 : ℝ) := by + rw [← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := rpow_lt_self_of_exponent_lt_one hp (by norm_num) + +/-- A divisor-sensitive small-order set large enough to contain a nonempty +`p`-divisible orbit forces the Corvaja--Zannier cube below the maximal order. -/ +theorem explicit_lowOrder_forces_corvajaZannier_cube + {p d : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hdPos : 0 < d) + (hpLe : p ≤ 2 * (2 + d * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2) : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < d := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let B := 48 ^ 3 + 1 + have hpTwo : 2 ≤ p := by + have := explicitCutoff_gt_one.trans_le hp + omega + have hminusNonempty : (p - 1).divisors.Nonempty := + (Nat.nonempty_divisors).2 (by omega) + have hplusNonempty : (p + 1).divisors.Nonempty := + (Nat.nonempty_divisors).2 (by omega) + have hTtwo : 2 ≤ T := by + have hm : 0 < (p - 1).divisors.card := Finset.card_pos.mpr hminusNonempty + have hp' : 0 < (p + 1).divisors.card := Finset.card_pos.mpr hplusNonempty + dsimp [T] + omega + have hTfour : 2 ≤ T ^ 4 := by + calc + 2 ≤ T := hTtwo + _ = T * 1 := by ring + _ ≤ T * T ^ 3 := by + gcongr + exact Nat.one_le_pow 3 T (by omega) + _ = T ^ 4 := by ring + change (48 * T) ^ 3 < d + by_contra hcube + have hdUpper : d ≤ (48 * T) ^ 3 := by omega + have hinner : 2 + d * T ≤ B * T ^ 4 := by + calc + 2 + d * T ≤ T ^ 4 + d * T := Nat.add_le_add_right hTfour _ + _ ≤ T ^ 4 + (48 * T) ^ 3 * T := by gcongr + _ = B * T ^ 4 := by dsimp [B]; ring + have hpLeCoarse : p ≤ 2 * B ^ 2 * T ^ 8 := by + calc + p ≤ 2 * (2 + d * T) ^ 2 := by simpa [T] using hpLe + _ ≤ 2 * (B * T ^ 4) ^ 2 := by gcongr + _ = 2 * B ^ 2 * T ^ 8 := by ring + have hmoment : T ^ 9 ≤ explicitDivisorMomentConstant * p := by + simpa [T] using explicit_divisor_sum_pow_nine_le hpTwo + have hpPowLe : p ^ 9 ≤ + (2 ^ 9 * B ^ 18 * explicitDivisorMomentConstant ^ 8) * p ^ 8 := by + calc + p ^ 9 ≤ (2 * B ^ 2 * T ^ 8) ^ 9 := Nat.pow_le_pow_left hpLeCoarse _ + _ = 2 ^ 9 * B ^ 18 * (T ^ 9) ^ 8 := by ring + _ ≤ 2 ^ 9 * B ^ 18 * + (explicitDivisorMomentConstant * p) ^ 8 := by gcongr + _ = (2 ^ 9 * B ^ 18 * explicitDivisorMomentConstant ^ 8) * p ^ 8 := by + ring + have hconstant : + 2 ^ 9 * B ^ 18 * explicitDivisorMomentConstant ^ 8 < p := by + simpa [B] using explicitCutoff_constant_lt hp + have hstrict : + (2 ^ 9 * B ^ 18 * explicitDivisorMomentConstant ^ 8) * p ^ 8 < + p ^ 9 := by + calc + (2 ^ 9 * B ^ 18 * explicitDivisorMomentConstant ^ 8) * p ^ 8 < + p * p ^ 8 := + mul_lt_mul_of_pos_right hconstant (pow_pos (by omega) 8) + _ = p ^ 9 := by ring + exact (not_lt_of_ge hpPowLe) hstrict + +/-- Assembly-facing alias for the divisor-sensitive cube certificate. -/ +theorem explicit_lowOrder_divisorSensitive_cube + {p d : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hdPos : 0 < d) + (hpLe : p ≤ 2 * (2 + d * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2) : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < d := + explicit_lowOrder_forces_corvajaZannier_cube hp hdPos hpLe + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean new file mode 100644 index 0000000000..dba7a6d3d6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean @@ -0,0 +1,401 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion + +/-! +# Closed numerical bounds for explicit strong approximation + +All constants in this file are closed natural-number expressions. In +particular, no witness is extracted from an eventual or asymptotic theorem. +-/ + +namespace BGS.Markoff + +open scoped Topology + +/-! The first explicit record is retained in a namespace for comparison. -/ +namespace Legacy + +/-- Sealed data for the deliberately conservative project cutoff. -/ +opaque explicitStrongApproximationCutoffData : + {n : ℕ // n = BGS.NumberTheory.explicitDivisorConstant + 1} := + ⟨BGS.NumberTheory.explicitDivisorConstant + 1, rfl⟩ + +/-- The deliberately conservative project cutoff. It is not the primorial +constant from arXiv:2308.07579. -/ +def explicitStrongApproximationCutoff : ℕ := + explicitStrongApproximationCutoffData.1 + +theorem explicitStrongApproximationCutoff_eq : + explicitStrongApproximationCutoff = + BGS.NumberTheory.explicitDivisorConstant + 1 := + explicitStrongApproximationCutoffData.2 + +private theorem fixedNumeral_pow_thirtyTwo_le_explicitDivisorConstant : + 100522 ^ 32 ≤ BGS.NumberTheory.explicitDivisorConstant := by + rw [BGS.NumberTheory.explicitDivisorConstant_eq] + calc + 100522 ^ 32 ≤ (32 ^ 32) ^ 32 := + Nat.pow_le_pow_left (by norm_num) 32 + _ ≤ (32 ^ 32) ^ (2 ^ 32) := + pow_le_pow_right₀ (by norm_num) (by norm_num) + +theorem explicitCutoff_gt_one : 1 < explicitStrongApproximationCutoff := by + have hconstant : 0 < BGS.NumberTheory.explicitDivisorConstant := + BGS.NumberTheory.explicitDivisorConstant_pos + rw [explicitStrongApproximationCutoff_eq] + exact Nat.succ_lt_succ hconstant + +private theorem explicitCutoff_constant_lt + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + BGS.NumberTheory.explicitDivisorConstant < p := by + rw [explicitStrongApproximationCutoff_eq] at hp + exact (Nat.lt_succ_self _).trans_le hp + +theorem fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff + {p fixed : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hfixed : fixed ^ 32 ≤ BGS.NumberTheory.explicitDivisorConstant) : + (fixed : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := by + have hpPos : 0 < p := + Nat.zero_lt_one.trans (explicitCutoff_gt_one.trans_le hp) + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowNat : fixed ^ 32 < p := + hfixed.trans_lt (explicitCutoff_constant_lt hp) + have hpowReal : + (fixed : ℝ) ^ 32 < (p : ℝ) := by + exact_mod_cast hpowNat + have hrootPow : ((p : ℝ) ^ (1 / 32 : ℝ)) ^ 32 = (p : ℝ) := by + calc + ((p : ℝ) ^ (1 / 32 : ℝ)) ^ 32 = + (p : ℝ) ^ ((1 / 32 : ℝ) * 32) := + (Real.rpow_mul_natCast hpNonnegative (1 / 32 : ℝ) 32).symm + _ = (p : ℝ) := by norm_num + apply lt_of_pow_lt_pow_left₀ 32 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +theorem small_fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff + {p fixed : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hfixed : fixed ≤ 100522) : + (fixed : ℝ) < (p : ℝ) ^ (1 / 32 : ℝ) := + fixed_lt_rpow_one_div_thirtyTwo_of_explicitCutoff hp + ((Nat.pow_le_pow_left hfixed 32).trans + fixedNumeral_pow_thirtyTwo_le_explicitDivisorConstant) + +private theorem explicitDivisorConstant_le_pred + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + BGS.NumberTheory.explicitDivisorConstant ≤ p - 1 := by + have hconstant := explicitCutoff_constant_lt hp + omega + +private theorem explicitDivisorConstant_le_succ + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + BGS.NumberTheory.explicitDivisorConstant ≤ p + 1 := by + have hconstant := explicitCutoff_constant_lt hp + omega + +/-- Both divisor counts occurring in the all-divisors Corvaja--Zannier +union bound are controlled by one sixteenth root of `p`. -/ +theorem explicit_divisor_sum_le_three_mul_rpow + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) ≤ + 3 * (p : ℝ) ^ (1 / 16 : ℝ) := by + have hpOne : 1 ≤ p := (explicitCutoff_gt_one.trans_le hp).le + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hminusRaw := BGS.NumberTheory.card_divisors_le_rpow_one_div_sixteen + (p - 1) (explicitDivisorConstant_le_pred hp) + have hminusBase : (((p - 1 : ℕ) : ℝ) : ℝ) ≤ (p : ℝ) := by + exact_mod_cast Nat.sub_le p 1 + have hminus : ((p - 1).divisors.card : ℝ) ≤ + (p : ℝ) ^ (1 / 16 : ℝ) := + hminusRaw.trans (Real.rpow_le_rpow (Nat.cast_nonneg _) hminusBase (by norm_num)) + have hplusRaw := BGS.NumberTheory.card_divisors_le_rpow_one_div_sixteen + (p + 1) (explicitDivisorConstant_le_succ hp) + have hplusBase : (((p + 1 : ℕ) : ℝ) : ℝ) ≤ 2 * (p : ℝ) := by + exact_mod_cast (show p + 1 ≤ 2 * p by omega) + have htwo : (2 : ℝ) ^ (1 / 16 : ℝ) ≤ 2 := + Real.rpow_le_self_of_one_le (by norm_num) (by norm_num) + have hplus : ((p + 1).divisors.card : ℝ) ≤ + 2 * (p : ℝ) ^ (1 / 16 : ℝ) := by + calc + ((p + 1).divisors.card : ℝ) ≤ (((p + 1 : ℕ) : ℝ) : ℝ) ^ (1 / 16 : ℝ) := + hplusRaw + _ ≤ (2 * (p : ℝ)) ^ (1 / 16 : ℝ) := + Real.rpow_le_rpow (Nat.cast_nonneg _) hplusBase (by norm_num) + _ = (2 : ℝ) ^ (1 / 16 : ℝ) * (p : ℝ) ^ (1 / 16 : ℝ) := by + rw [Real.mul_rpow (by norm_num) hpNonnegative] + _ ≤ 2 * (p : ℝ) ^ (1 / 16 : ℝ) := by gcongr + norm_num only [Nat.cast_add] + linarith + +/-- The coefficient-48 all-divisors term used by the middle game. -/ +theorem explicit_corvajaZannier_divisor_term_le + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + ((corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℕ) : ℝ) ≤ + 144 * (p : ℝ) ^ (1 / 16 : ℝ) := by + have h := explicit_divisor_sum_le_three_mul_rpow hp + norm_num [corvajaZannierCorollaryTwoSafeCoefficient] at h ⊢ + linarith + +end Legacy + +/-! ## Ninth-moment adaptive cutoff -/ + +/-- The coefficient in the simultaneous ninth-moment bound for the divisor +counts of `p - 1` and `p + 1`. -/ +opaque explicitDivisorMomentConstantData : + {n : ℕ // n = 2 ^ 9 * (9 ^ 9) ^ (2 ^ 9)} := + ⟨2 ^ 9 * (9 ^ 9) ^ (2 ^ 9), rfl⟩ + +def explicitDivisorMomentConstant : ℕ := + explicitDivisorMomentConstantData.1 + +theorem explicitDivisorMomentConstant_eq : + explicitDivisorMomentConstant = 2 ^ 9 * (9 ^ 9) ^ (2 ^ 9) := + explicitDivisorMomentConstantData.2 + +theorem explicitDivisorMomentConstant_pos : + 0 < explicitDivisorMomentConstant := by + rw [explicitDivisorMomentConstant_eq] + positivity + +/-- Sealed data for the improved project cutoff. -/ +opaque explicitStrongApproximationCutoffData : + {n : ℕ // n = + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1} := + ⟨2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1, rfl⟩ + +/-- The explicit project cutoff. It is deliberately different from the +primorial constant in arXiv:2308.07579. -/ +def explicitStrongApproximationCutoff : ℕ := + explicitStrongApproximationCutoffData.1 + +theorem explicitStrongApproximationCutoff_eq : + explicitStrongApproximationCutoff = + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1 := + explicitStrongApproximationCutoffData.2 + +theorem explicitCutoff_gt_one : 1 < explicitStrongApproximationCutoff := by + rw [explicitStrongApproximationCutoff_eq] + exact Nat.succ_lt_succ <| + Nat.mul_pos (Nat.mul_pos (by positivity) (by positivity)) + (pow_pos explicitDivisorMomentConstant_pos _) + +theorem explicitCutoff_constant_lt + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 < p := by + rw [explicitStrongApproximationCutoff_eq] at hp + omega + +/-- The elementary factorization estimate, specialized to the simultaneous +ninth moment needed below. -/ +theorem explicit_divisor_sum_pow_nine_le + {p : ℕ} (hp : 2 ≤ p) : + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 9 ≤ + explicitDivisorMomentConstant * p := by + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + have hminus := BGS.NumberTheory.card_divisors_pow_le_explicit_constant_mul + 9 (by norm_num) (p - 1) hminusNe + have hplus := BGS.NumberTheory.card_divisors_pow_le_explicit_constant_mul + 9 (by norm_num) (p + 1) hplusNe + calc + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 9 ≤ + 2 ^ (9 - 1) * + ((p - 1).divisors.card ^ 9 + (p + 1).divisors.card ^ 9) := + add_pow_le (Nat.zero_le _) (Nat.zero_le _) 9 + _ ≤ 2 ^ (9 - 1) * (((9 ^ 9) ^ (2 ^ 9) * (p - 1)) + + ((9 ^ 9) ^ (2 ^ 9) * (p + 1))) := by + gcongr + _ = explicitDivisorMomentConstant * p := by + let D := (9 ^ 9) ^ (2 ^ 9) + have hsub : p - 1 + (p + 1) = 2 * p := by omega + rw [explicitDivisorMomentConstant_eq] + change 2 ^ (9 - 1) * (D * (p - 1) + D * (p + 1)) = + (2 ^ 9 * D) * p + calc + 2 ^ (9 - 1) * (D * (p - 1) + D * (p + 1)) = + 2 ^ 8 * D * (p - 1 + (p + 1)) := by norm_num; ring + _ = 2 ^ 8 * D * (2 * p) := by rw [hsub] + _ = (2 ^ 9 * D) * p := by norm_num; ring + +private theorem explicitDivisorMomentConstant_pow_two_le_pow_eight : + explicitDivisorMomentConstant ^ 2 ≤ explicitDivisorMomentConstant ^ 8 := + Nat.pow_le_pow_right explicitDivisorMomentConstant_pos (by norm_num) + +/-- The complete coefficient-48 divisor term lies below the sixth root of +`p`. This is the linear middle-game estimate used up to order `p^(5/6)`. -/ +theorem explicit_corvajaZannier_divisor_term_lt_rpow_one_div_six + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℕ) < + (p : ℝ) ^ (1 / 6 : ℝ) := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpTwo : 2 ≤ p := by + have hcutoffTwo : 2 ≤ explicitStrongApproximationCutoff := + explicitCutoff_gt_one + omega + have hmoment : T ^ 9 ≤ explicitDivisorMomentConstant * p := + explicit_divisor_sum_pow_nine_le hpTwo + have hcoefficient : + 48 ^ 18 * explicitDivisorMomentConstant ^ 2 ≤ + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 := by + exact Nat.mul_le_mul (by norm_num) + explicitDivisorMomentConstant_pow_two_le_pow_eight + have hconstant := explicitCutoff_constant_lt hp + have hpowNat : (48 * T) ^ 18 < p ^ 3 := by + calc + (48 * T) ^ 18 = 48 ^ 18 * (T ^ 9) ^ 2 := by + rw [mul_pow] + congr 1 + rw [show (18 : ℕ) = 9 * 2 by norm_num, pow_mul] + _ ≤ 48 ^ 18 * (explicitDivisorMomentConstant * p) ^ 2 := by gcongr + _ = (48 ^ 18 * explicitDivisorMomentConstant ^ 2) * p ^ 2 := by + rw [mul_pow] + ring + _ ≤ (2 ^ 9 * (48 ^ 3 + 1) ^ 18 * + explicitDivisorMomentConstant ^ 8) * p ^ 2 := + Nat.mul_le_mul_right _ hcoefficient + _ < p * p ^ 2 := by gcongr + _ = p ^ 3 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((48 * T : ℕ) : ℝ) ^ 18 < (p : ℝ) ^ 3 := by + exact_mod_cast hpowNat + have hrootPow : (((p : ℝ) ^ (1 / 6 : ℝ)) ^ 18 = (p : ℝ) ^ 3) := by + calc + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 18 = + (p : ℝ) ^ ((1 / 6 : ℝ) * 18) := + (Real.rpow_mul_natCast hpNonnegative (1 / 6 : ℝ) 18).symm + _ = (p : ℝ) ^ 3 := by norm_num + norm_num only [corvajaZannierCorollaryTwoSafeCoefficient] + change ((48 * T : ℕ) : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) + apply lt_of_pow_lt_pow_left₀ 18 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- The weighted square of the simultaneous divisor count lies below the +one-third power needed by the primitive endgame. -/ +theorem explicit_weighted_divisor_sum_sq_lt_rpow_one_div_three + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + ((68 * ((p - 1).divisors.card + (p + 1).divisors.card) ^ 2 : ℕ) : ℝ) < + (p : ℝ) ^ (1 / 3 : ℝ) := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpTwo : 2 ≤ p := by + have hcutoffTwo : 2 ≤ explicitStrongApproximationCutoff := + explicitCutoff_gt_one + omega + have hmoment : T ^ 9 ≤ explicitDivisorMomentConstant * p := + explicit_divisor_sum_pow_nine_le hpTwo + have hcoefficient : + 68 ^ 9 * explicitDivisorMomentConstant ^ 2 ≤ + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 := by + exact Nat.mul_le_mul (by norm_num) + explicitDivisorMomentConstant_pow_two_le_pow_eight + have hconstant := explicitCutoff_constant_lt hp + have hpowNat : (68 * T ^ 2) ^ 9 < p ^ 3 := by + calc + (68 * T ^ 2) ^ 9 = 68 ^ 9 * (T ^ 9) ^ 2 := by ring + _ ≤ 68 ^ 9 * (explicitDivisorMomentConstant * p) ^ 2 := by gcongr + _ = (68 ^ 9 * explicitDivisorMomentConstant ^ 2) * p ^ 2 := by + rw [mul_pow] + ring + _ ≤ (2 ^ 9 * (48 ^ 3 + 1) ^ 18 * + explicitDivisorMomentConstant ^ 8) * p ^ 2 := + Nat.mul_le_mul_right _ hcoefficient + _ < p * p ^ 2 := by gcongr + _ = p ^ 3 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((68 * T ^ 2 : ℕ) : ℝ) ^ 9 < (p : ℝ) ^ 3 := by + exact_mod_cast hpowNat + have hrootPow : (((p : ℝ) ^ (1 / 3 : ℝ)) ^ 9 = (p : ℝ) ^ 3) := by + calc + ((p : ℝ) ^ (1 / 3 : ℝ)) ^ 9 = + (p : ℝ) ^ ((1 / 3 : ℝ) * 9) := + (Real.rpow_mul_natCast hpNonnegative (1 / 3 : ℝ) 9).symm + _ = (p : ℝ) ^ 3 := by norm_num + change ((68 * T ^ 2 : ℕ) : ℝ) < (p : ℝ) ^ (1 / 3 : ℝ) + apply lt_of_pow_lt_pow_left₀ 9 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- The simultaneous divisor count itself remains below the eighth root of +`p`; this sharper unweighted estimate is retained for the cage. -/ +theorem explicit_divisor_sum_lt_rpow_one_div_eight + {p : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) : + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) < + (p : ℝ) ^ (1 / 8 : ℝ) := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpTwo : 2 ≤ p := by + have hcutoffTwo : 2 ≤ explicitStrongApproximationCutoff := + explicitCutoff_gt_one + omega + have hmoment : T ^ 9 ≤ explicitDivisorMomentConstant * p := + explicit_divisor_sum_pow_nine_le hpTwo + have hcoefficient : explicitDivisorMomentConstant ^ 8 ≤ + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 := by + have hfactor : 1 ≤ 2 ^ 9 * (48 ^ 3 + 1) ^ 18 := by norm_num + simpa only [one_mul] using + Nat.mul_le_mul_right (explicitDivisorMomentConstant ^ 8) hfactor + have hconstant := explicitCutoff_constant_lt hp + have hpowNat : T ^ 72 < p ^ 9 := by + calc + T ^ 72 = (T ^ 9) ^ 8 := by + rw [show (72 : ℕ) = 9 * 8 by norm_num, pow_mul] + _ ≤ (explicitDivisorMomentConstant * p) ^ 8 := by gcongr + _ = explicitDivisorMomentConstant ^ 8 * p ^ 8 := by rw [mul_pow] + _ ≤ (2 ^ 9 * (48 ^ 3 + 1) ^ 18 * + explicitDivisorMomentConstant ^ 8) * p ^ 8 := + Nat.mul_le_mul_right _ hcoefficient + _ < p * p ^ 8 := by gcongr + _ = p ^ 9 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : (T : ℝ) ^ 72 < (p : ℝ) ^ 9 := by exact_mod_cast hpowNat + have hrootPow : (((p : ℝ) ^ (1 / 8 : ℝ)) ^ 72 = (p : ℝ) ^ 9) := by + calc + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 72 = + (p : ℝ) ^ ((1 / 8 : ℝ) * 72) := + (Real.rpow_mul_natCast hpNonnegative (1 / 8 : ℝ) 72).symm + _ = (p : ℝ) ^ 9 := by norm_num + change (T : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) + apply lt_of_pow_lt_pow_left₀ 72 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- Every fixed coefficient used by the explicit proof is also below the +eighth root of `p`. -/ +theorem small_fixed_lt_rpow_one_div_eight_of_explicitCutoff + {p fixed : ℕ} (hp : explicitStrongApproximationCutoff ≤ p) + (hfixed : fixed ≤ 100522) : + (fixed : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := by + have hmomentOne : 1 ≤ explicitDivisorMomentConstant ^ 8 := + Nat.one_le_pow _ _ explicitDivisorMomentConstant_pos + have hfixedPower : 100522 ^ 8 ≤ + 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 := by + have hnumeric : 100522 ^ 8 ≤ 2 ^ 9 * (48 ^ 3 + 1) ^ 18 := by norm_num + simpa only [mul_one] using Nat.mul_le_mul hnumeric hmomentOne + have hpowNat : fixed ^ 8 < p := by + calc + fixed ^ 8 ≤ 100522 ^ 8 := Nat.pow_le_pow_left hfixed _ + _ ≤ 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 := + hfixedPower + _ < p := explicitCutoff_constant_lt hp + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : (fixed : ℝ) ^ 8 < (p : ℝ) := by exact_mod_cast hpowNat + have hrootPow : ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 8 = (p : ℝ) := by + calc + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 8 = + (p : ℝ) ^ ((1 / 8 : ℝ) * 8) := + (Real.rpow_mul_natCast hpNonnegative (1 / 8 : ℝ) 8).symm + _ = (p : ℝ) := by norm_num + apply lt_of_pow_lt_pow_left₀ 8 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean new file mode 100644 index 0000000000..68f55b0e04 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean @@ -0,0 +1,12 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean new file mode 100644 index 0000000000..49e4aca091 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean @@ -0,0 +1,843 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +import Mathlib.FieldTheory.KummerPolynomial +import Mathlib.RingTheory.TensorProduct.MvPolynomial +import Mathlib.RingTheory.TensorProduct.Quotient + +/-! +# Geometric integrality of the incidence auxiliary coordinate ring + +This module proves the missing coordinate-ring algebra by an explicit base change and rank-four +biquadratic normal form. Every declaration is proved; there are no placeholder axioms. +-/ + +namespace BGS.Markoff + +open MvPolynomial +open scoped TensorProduct + +noncomputable section + +universe u v + +variable (K : Type u) [Field K] +variable (L : Type v) [Field L] [Algebra K L] + +/-- The explicit two-equation ideal after extending coefficients from `K` to `L`. -/ +def incidenceAuxBaseChangeIdeal (a b : K) : Ideal (MvPolynomial (Fin 3) L) := + Ideal.span + {MvPolynomial.map (algebraMap K L) (incidenceAuxPolynomial1 a), + MvPolynomial.map (algebraMap K L) (incidenceAuxPolynomial2 b)} + +lemma incidenceAuxBaseChangeIdeal_eq_map (a b : K) : + incidenceAuxBaseChangeIdeal K L a b = + (incidenceAuxIdeal a b).map + (MvPolynomial.map (σ := Fin 3) (algebraMap K L)) := by + simp only [incidenceAuxBaseChangeIdeal, incidenceAuxIdeal, Ideal.map_span, + Set.image_insert_eq, Set.image_singleton] + +lemma incidenceAuxBaseChangeIdeal_eq_incidenceAuxIdeal (a b : K) : + incidenceAuxBaseChangeIdeal K L a b = + incidenceAuxIdeal (algebraMap K L a) (algebraMap K L b) := by + simp [incidenceAuxBaseChangeIdeal, incidenceAuxIdeal, incidenceAuxPolynomial1, + incidenceAuxPolynomial2, map_sub, map_mul, map_pow, map_ofNat] + +lemma algebraTensorAlgEquiv_comp_includeRight : + (MvPolynomial.algebraTensorAlgEquiv (σ := Fin 3) K L).toRingHom.comp + (Algebra.TensorProduct.includeRight (R := K) (A := L)).toRingHom = + MvPolynomial.map (σ := Fin 3) (algebraMap K L) := by + apply MvPolynomial.ringHom_ext + · intro r + simp [RingHom.comp_apply] + · intro i + simp [RingHom.comp_apply] + +/-- Base change commutes with the explicit presentation of the incidence auxiliary curve. -/ +noncomputable def incidenceAuxCoordinateRingBaseChangeEquiv (a b : K) : + L ⊗[K] IncidenceAuxCoordinateRing K a b ≃ₐ[L] + MvPolynomial (Fin 3) L ⧸ incidenceAuxBaseChangeIdeal K L a b := + (Algebra.TensorProduct.tensorQuotientEquiv + (R := K) L (MvPolynomial (Fin 3) K) L (incidenceAuxIdeal a b)).trans + (Ideal.quotientEquivAlg + ((incidenceAuxIdeal a b).map + (Algebra.TensorProduct.includeRight (R := K) (A := L)).toRingHom) + (incidenceAuxBaseChangeIdeal K L a b) + (MvPolynomial.algebraTensorAlgEquiv (σ := Fin 3) K L) + (by + rw [incidenceAuxBaseChangeIdeal_eq_map] + rw [Ideal.map_map] + congr 1 + exact (algebraTensorAlgEquiv_comp_includeRight K L).symm)) + +/-- Base change identifies the original coordinate ring with the same two equations over the +larger coefficient field. -/ +noncomputable def incidenceAuxCoordinateRingBaseChangeExplicitEquiv (a b : K) : + L ⊗[K] IncidenceAuxCoordinateRing K a b ≃ₐ[L] + IncidenceAuxCoordinateRing L (algebraMap K L a) (algebraMap K L b) := + (incidenceAuxCoordinateRingBaseChangeEquiv K L a b).trans + (Ideal.quotientEquivAlgOfEq L + (incidenceAuxBaseChangeIdeal_eq_incidenceAuxIdeal K L a b)) + +/-- The monic quadratic used to adjoin a square root of an element. -/ +def adjoinSquarePolynomial {R : Type*} [CommRing R] (f : R) : Polynomial R := + Polynomial.X ^ 2 - Polynomial.C f + +lemma adjoinSquarePolynomial_monic {R : Type*} [CommRing R] (f : R) : + (adjoinSquarePolynomial f).Monic := by + exact Polynomial.monic_X_pow_sub_C f (by norm_num) + +lemma adjoinSquarePolynomial_natDegree {R : Type*} [Nontrivial R] [CommRing R] (f : R) : + (adjoinSquarePolynomial f).natDegree = 2 := by + simp [adjoinSquarePolynomial] + +lemma adjoinSquareRoot_sq {R : Type*} [CommRing R] (f : R) : + (AdjoinRoot.root (adjoinSquarePolynomial f)) ^ 2 = + algebraMap R (AdjoinRoot (adjoinSquarePolynomial f)) f := by + have h := AdjoinRoot.eval₂_root (adjoinSquarePolynomial f) + rw [adjoinSquarePolynomial, Polynomial.eval₂_sub, Polynomial.eval₂_pow, + Polynomial.eval₂_X, Polynomial.eval₂_C, sub_eq_zero] at h + exact h + +lemma adjoinSquarePolynomial_irreducible_of_not_isSquare + {F : Type*} [Field F] {f : F} (hf : ¬ IsSquare f) : + Irreducible (adjoinSquarePolynomial f) := by + apply X_pow_sub_C_irreducible_of_prime Nat.prime_two + intro z hz + apply hf + exact ⟨z, by simpa [pow_two] using hz.symm⟩ + +/-- In a quadratic extension generated by `sqrt f`, a base-field element `g` can become a +square only if `g` or `f * g` was already a square. -/ +lemma not_isSquare_algebraMap_adjoinSquare_of_independent + {F : Type*} [Field F] (h2 : (2 : F) ≠ 0) {f g : F} + (hf : ¬ IsSquare f) (hg : ¬ IsSquare g) (hfg : ¬ IsSquare (f * g)) : + ¬ IsSquare + (algebraMap F (AdjoinRoot (adjoinSquarePolynomial f)) g) := by + let q : Polynomial F := adjoinSquarePolynomial f + have hqIrreducible : Irreducible q := + adjoinSquarePolynomial_irreducible_of_not_isSquare hf + letI : Fact (Irreducible q) := ⟨hqIrreducible⟩ + change ¬ IsSquare (algebraMap F (AdjoinRoot q) g) + have hqMonic : q.Monic := by simpa [q] using adjoinSquarePolynomial_monic f + have hqNatDegree : q.natDegree = 2 := by + simpa [q] using adjoinSquarePolynomial_natDegree f + let b : Module.Basis (Fin 2) F (AdjoinRoot q) := + (AdjoinRoot.powerBasis' hqMonic).basis.reindex (finCongr hqNatDegree) + rintro ⟨z, hzSquare⟩ + let x : F := b.repr z 0 + let y : F := b.repr z 1 + have hb0 : b 0 = 1 := by + simp [b, PowerBasis.coe_basis] + have hb1 : b 1 = AdjoinRoot.root q := by + simp [b, PowerBasis.coe_basis] + have hz : z = algebraMap F (AdjoinRoot q) x + + algebraMap F (AdjoinRoot q) y * AdjoinRoot.root q := by + have hsum := b.sum_repr z + rw [Fin.sum_univ_two] at hsum + simpa [hb0, hb1, x, y, Algebra.smul_def] using hsum.symm + have hroot : (AdjoinRoot.root q) ^ 2 = algebraMap F (AdjoinRoot q) f := by + simpa [q] using adjoinSquareRoot_sq f + have hexpand : + algebraMap F (AdjoinRoot q) g = + algebraMap F (AdjoinRoot q) (x * x + y * y * f) + + algebraMap F (AdjoinRoot q) (2 * x * y) * AdjoinRoot.root q := by + rw [hzSquare, hz] + calc + (algebraMap F (AdjoinRoot q) x + + algebraMap F (AdjoinRoot q) y * AdjoinRoot.root q) * + (algebraMap F (AdjoinRoot q) x + + algebraMap F (AdjoinRoot q) y * AdjoinRoot.root q) = + algebraMap F (AdjoinRoot q) x * algebraMap F (AdjoinRoot q) x + + 2 * algebraMap F (AdjoinRoot q) x * algebraMap F (AdjoinRoot q) y * + AdjoinRoot.root q + + algebraMap F (AdjoinRoot q) y * algebraMap F (AdjoinRoot q) y * + (AdjoinRoot.root q) ^ 2 := by ring + _ = _ := by + rw [hroot] + simp only [map_add, map_mul, map_ofNat] + ring + have hbasisExpression : + g • b 0 = (x * x + y * y * f) • b 0 + (2 * x * y) • b 1 := by + simpa [hb0, hb1, Algebra.smul_def] using hexpand + have hconstant := congrArg (b.coord 0) hbasisExpression + have hlinear := congrArg (b.coord 1) hbasisExpression + have hgExpression : g = x * x + y * y * f := by + simpa using hconstant + have hxy : x * y = 0 := by + have htwoXY : (2 : F) * (x * y) = 0 := by + simpa [mul_assoc] using hlinear.symm + exact (mul_eq_zero.mp htwoXY).resolve_left h2 + rcases mul_eq_zero.mp hxy with hx | hy + · apply hfg + refine ⟨y * f, ?_⟩ + rw [hgExpression, hx] + ring + · apply hg + refine ⟨x, ?_⟩ + rw [hgExpression, hy] + ring + +/-- Extend coefficients in a quadratic `AdjoinRoot` presentation. -/ +def adjoinSquareMap {R S : Type*} [CommRing R] [CommRing S] + (φ : R →+* S) (f : R) : + AdjoinRoot (adjoinSquarePolynomial f) →+* + AdjoinRoot (adjoinSquarePolynomial (φ f)) := + AdjoinRoot.map φ (adjoinSquarePolynomial f) (adjoinSquarePolynomial (φ f)) + (by simp [adjoinSquarePolynomial]) + +/-- Extending coefficients in a monic quadratic presentation preserves injectivity. -/ +lemma adjoinSquareMap_injective {R S : Type*} [CommRing R] [CommRing S] + [Nontrivial R] [Nontrivial S] (φ : R →+* S) (hφ : Function.Injective φ) (f : R) : + Function.Injective (adjoinSquareMap φ f) := by + let qR : Polynomial R := adjoinSquarePolynomial f + let qS : Polynomial S := adjoinSquarePolynomial (φ f) + have hqRMonic : qR.Monic := by simpa [qR] using adjoinSquarePolynomial_monic f + have hqSMonic : qS.Monic := by simpa [qS] using adjoinSquarePolynomial_monic (φ f) + have hqRNatDegree : qR.natDegree = 2 := by + simpa [qR] using adjoinSquarePolynomial_natDegree f + have hqSNatDegree : qS.natDegree = 2 := by + simpa [qS] using adjoinSquarePolynomial_natDegree (φ f) + let bR : Module.Basis (Fin 2) R (AdjoinRoot qR) := + (AdjoinRoot.powerBasis' hqRMonic).basis.reindex (finCongr hqRNatDegree) + let bS : Module.Basis (Fin 2) S (AdjoinRoot qS) := + (AdjoinRoot.powerBasis' hqSMonic).basis.reindex (finCongr hqSNatDegree) + have hbR0 : bR 0 = 1 := by simp [bR, PowerBasis.coe_basis] + have hbR1 : bR 1 = AdjoinRoot.root qR := by simp [bR, PowerBasis.coe_basis] + have hbS0 : bS 0 = 1 := by simp [bS, PowerBasis.coe_basis] + have hbS1 : bS 1 = AdjoinRoot.root qS := by simp [bS, PowerBasis.coe_basis] + rw [injective_iff_map_eq_zero] + intro z hzMap + let x : R := bR.repr z 0 + let y : R := bR.repr z 1 + have hz : z = algebraMap R (AdjoinRoot qR) x + + algebraMap R (AdjoinRoot qR) y * AdjoinRoot.root qR := by + have hsum := bR.sum_repr z + rw [Fin.sum_univ_two] at hsum + simpa [hbR0, hbR1, x, y, Algebra.smul_def] using hsum.symm + have htarget : + algebraMap S (AdjoinRoot qS) (φ x) + + algebraMap S (AdjoinRoot qS) (φ y) * AdjoinRoot.root qS = 0 := by + rw [hz] at hzMap + simpa [adjoinSquareMap, qR, qS] using hzMap + have hbasisTarget : φ x • bS 0 + φ y • bS 1 = 0 := by + simpa [hbS0, hbS1, Algebra.smul_def] using htarget + have hxMap := congrArg (bS.coord 0) hbasisTarget + have hyMap := congrArg (bS.coord 1) hbasisTarget + have hx : x = 0 := hφ (by simpa using hxMap) + have hy : y = 0 := hφ (by simpa using hyMap) + rw [hz, hx, hy] + simp + +/-- Adjoin the first branch square root over the polynomial ring in the `y`-coordinate. -/ +abbrev IncidenceFirstQuadraticRing (a : L) := + AdjoinRoot (adjoinSquarePolynomial (incidenceBranchPolynomial a)) + +noncomputable local instance incidenceFirstQuadraticRing_nontrivial (a : L) : + Nontrivial (IncidenceFirstQuadraticRing L a) := + AdjoinRoot.nontrivial _ (by + rw [Polynomial.degree_eq_natDegree (adjoinSquarePolynomial_monic _).ne_zero, + adjoinSquarePolynomial_natDegree] + norm_num) + +/-- Over the first quadratic cover, adjoin the second branch square root. -/ +def incidenceSecondQuadraticPolynomial (a b : L) : + Polynomial (IncidenceFirstQuadraticRing L a) := + adjoinSquarePolynomial + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) + (incidenceBranchPolynomial b)) + +/-- The iterated quadratic algebra with generators satisfying the two incidence equations. -/ +abbrev IncidenceBiquadraticRing (a b : L) := + AdjoinRoot (incidenceSecondQuadraticPolynomial L a b) + +/-- The first quadratic extension after passing from `L[y]` to its rational function field. -/ +abbrev IncidenceFirstQuadraticRatFuncRing (a : L) := + AdjoinRoot + (adjoinSquarePolynomial + (algebraMap (Polynomial L) (RatFunc L) (incidenceBranchPolynomial a))) + +noncomputable local instance incidenceFirstQuadraticRatFuncRing_nontrivial (a : L) : + Nontrivial (IncidenceFirstQuadraticRatFuncRing L a) := + AdjoinRoot.nontrivial _ (by + rw [Polynomial.degree_eq_natDegree (adjoinSquarePolynomial_monic _).ne_zero, + adjoinSquarePolynomial_natDegree] + norm_num) + +/-- Extend the first quadratic cover from `L[y]` to `L(y)`. -/ +def incidenceFirstQuadraticToRatFunc (a : L) : + IncidenceFirstQuadraticRing L a →+* IncidenceFirstQuadraticRatFuncRing L a := + adjoinSquareMap (algebraMap (Polynomial L) (RatFunc L)) + (incidenceBranchPolynomial a) + +lemma incidenceFirstQuadraticToRatFunc_algebraMap (a : L) (r : Polynomial L) : + incidenceFirstQuadraticToRatFunc L a + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) r) = + algebraMap (RatFunc L) (IncidenceFirstQuadraticRatFuncRing L a) + (algebraMap (Polynomial L) (RatFunc L) r) := by + simp [incidenceFirstQuadraticToRatFunc, adjoinSquareMap] + +/-- The second quadratic polynomial over the first rational-function-field extension. -/ +def incidenceSecondQuadraticRatFuncPolynomial (a b : L) : + Polynomial (IncidenceFirstQuadraticRatFuncRing L a) := + adjoinSquarePolynomial + (incidenceFirstQuadraticToRatFunc L a + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) + (incidenceBranchPolynomial b))) + +/-- The biquadratic field presentation over `L(y)`. Field instances are installed below from +the two irreducibility proofs. -/ +abbrev IncidenceBiquadraticRatFuncRing (a b : L) := + AdjoinRoot (incidenceSecondQuadraticRatFuncPolynomial L a b) + +/-- Extend both successive quadratic presentations from `L[y]` to `L(y)`. -/ +def incidenceBiquadraticToRatFunc (a b : L) : + IncidenceBiquadraticRing L a b →+* IncidenceBiquadraticRatFuncRing L a b := + adjoinSquareMap (incidenceFirstQuadraticToRatFunc L a) + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) + (incidenceBranchPolynomial b)) + +lemma incidenceFirstQuadraticToRatFunc_injective (a : L) : + Function.Injective (incidenceFirstQuadraticToRatFunc L a) := by + exact adjoinSquareMap_injective _ + (FaithfulSMul.algebraMap_injective (Polynomial L) (RatFunc L)) _ + +lemma incidenceBiquadraticToRatFunc_injective (a b : L) : + Function.Injective (incidenceBiquadraticToRatFunc L a b) := by + exact adjoinSquareMap_injective _ (incidenceFirstQuadraticToRatFunc_injective L a) _ + +/-- The rational-function-field biquadratic presentation is a domain when the three square +classes supplied by the branch-polynomial calculation are nontrivial. -/ +theorem incidenceBiquadraticRatFuncRing_isDomain + (h2 : (2 : L) ≠ 0) {a b : L} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + IsDomain (IncidenceBiquadraticRatFuncRing L a b) := by + obtain ⟨hf, hg, hfg⟩ := + incidenceBranchSquareClasses_independent_ratFunc h2 ha hb hA hB hab + have h2RatFunc : (2 : RatFunc L) ≠ 0 := by + intro hzero + apply h2 + apply FaithfulSMul.algebraMap_injective L (RatFunc L) + simpa only [map_ofNat, map_zero] using hzero + letI : Fact + (Irreducible + (adjoinSquarePolynomial + (algebraMap (Polynomial L) (RatFunc L) (incidenceBranchPolynomial a)))) := + ⟨adjoinSquarePolynomial_irreducible_of_not_isSquare hf⟩ + have hsecondNotSquare : + ¬ IsSquare + (incidenceFirstQuadraticToRatFunc L a + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) + (incidenceBranchPolynomial b))) := by + rw [incidenceFirstQuadraticToRatFunc_algebraMap] + apply not_isSquare_algebraMap_adjoinSquare_of_independent h2RatFunc hf hg + simpa only [map_mul] using hfg + letI : Fact (Irreducible (incidenceSecondQuadraticRatFuncPolynomial L a b)) := + ⟨adjoinSquarePolynomial_irreducible_of_not_isSquare hsecondNotSquare⟩ + letI : Field (IncidenceBiquadraticRatFuncRing L a b) := AdjoinRoot.instField + infer_instance + +/-- The rank-four algebra over `L[y]` is a domain because it injects into the preceding +biquadratic field presentation. -/ +theorem incidenceBiquadraticRing_isDomain + (h2 : (2 : L) ≠ 0) {a b : L} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + IsDomain (IncidenceBiquadraticRing L a b) := by + letI : IsDomain (IncidenceBiquadraticRatFuncRing L a b) := + incidenceBiquadraticRatFuncRing_isDomain L h2 ha hb hA hB hab + exact (incidenceBiquadraticToRatFunc_injective L a b).isDomain + (incidenceBiquadraticToRatFunc L a b) + +lemma incidenceSecondQuadraticPolynomial_monic (a b : L) : + (incidenceSecondQuadraticPolynomial L a b).Monic := by + exact adjoinSquarePolynomial_monic _ + +lemma incidenceSecondQuadraticPolynomial_natDegree (a b : L) : + (incidenceSecondQuadraticPolynomial L a b).natDegree = 2 := by + exact adjoinSquarePolynomial_natDegree _ + +/-- The canonical product basis of the two successive monic quadratic extensions. -/ +noncomputable def incidenceBiquadraticTowerBasis (a b : L) : + Module.Basis + (Fin (adjoinSquarePolynomial (incidenceBranchPolynomial a)).natDegree × + Fin (incidenceSecondQuadraticPolynomial L a b).natDegree) + (Polynomial L) (IncidenceBiquadraticRing L a b) := + (AdjoinRoot.powerBasis' (adjoinSquarePolynomial_monic + (incidenceBranchPolynomial a))).basis.smulTower + (AdjoinRoot.powerBasis' (incidenceSecondQuadraticPolynomial_monic L a b)).basis + +/-- The unreduced two-equation algebra has the expected rank four over `L[y]`. -/ +theorem incidenceBiquadraticRing_finrank (a b : L) : + Module.finrank (Polynomial L) (IncidenceBiquadraticRing L a b) = 4 := by + rw [Module.finrank_eq_card_basis (incidenceBiquadraticTowerBasis L a b)] + simp [adjoinSquarePolynomial_natDegree, incidenceSecondQuadraticPolynomial_natDegree] + +lemma incidenceFirstQuadraticRoot_sq (a : L) : + (AdjoinRoot.root + (adjoinSquarePolynomial (incidenceBranchPolynomial a))) ^ 2 = + algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) + (incidenceBranchPolynomial a) := by + exact adjoinSquareRoot_sq _ + +lemma incidenceSecondQuadraticRoot_sq (a b : L) : + (AdjoinRoot.root (incidenceSecondQuadraticPolynomial L a b)) ^ 2 = + algebraMap (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) + (incidenceBranchPolynomial b)) := by + exact adjoinSquareRoot_sq _ + +/-- The `y`-coordinate in the iterated quadratic presentation. -/ +def incidenceBiquadraticY (a b : L) : IncidenceBiquadraticRing L a b := + algebraMap (Polynomial L) (IncidenceBiquadraticRing L a b) Polynomial.X + +/-- The first square-root coordinate in the iterated quadratic presentation. -/ +def incidenceBiquadraticLambda (a b : L) : IncidenceBiquadraticRing L a b := + algebraMap (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) + (AdjoinRoot.root (adjoinSquarePolynomial (incidenceBranchPolynomial a))) + +/-- The second square-root coordinate in the iterated quadratic presentation. -/ +def incidenceBiquadraticMu (a b : L) : IncidenceBiquadraticRing L a b := + AdjoinRoot.root (incidenceSecondQuadraticPolynomial L a b) + +/-- Evaluate the three-variable incidence presentation in the iterated quadratic algebra. -/ +def incidenceAuxAevalToBiquadratic (a b : L) : + MvPolynomial (Fin 3) L →ₐ[L] IncidenceBiquadraticRing L a b := + MvPolynomial.aeval ![incidenceBiquadraticY L a b, + incidenceBiquadraticLambda L a b, incidenceBiquadraticMu L a b] + +lemma incidenceAuxAevalToBiquadratic_polynomial1 (a b : L) : + incidenceAuxAevalToBiquadratic L a b (incidenceAuxPolynomial1 a) = 0 := by + simp only [incidenceAuxAevalToBiquadratic, incidenceAuxPolynomial1, map_sub, map_mul, + map_pow, MvPolynomial.aeval_C, MvPolynomial.aeval_X] + change + ((algebraMap L (IncidenceBiquadraticRing L a b)) 9 * + (algebraMap L (IncidenceBiquadraticRing L a b)) a ^ 2 - + (algebraMap L (IncidenceBiquadraticRing L a b)) 4) * + (incidenceBiquadraticY L a b) ^ 2 - + (incidenceBiquadraticLambda L a b) ^ 2 - + (algebraMap L (IncidenceBiquadraticRing L a b)) 4 * + (algebraMap L (IncidenceBiquadraticRing L a b)) a ^ 2 = 0 + rw [show (incidenceBiquadraticLambda L a b) ^ 2 = + algebraMap (Polynomial L) (IncidenceBiquadraticRing L a b) + (incidenceBranchPolynomial a) by + simp only [incidenceBiquadraticLambda] + rw [← map_pow, incidenceFirstQuadraticRoot_sq] + exact IsScalarTower.algebraMap_apply (Polynomial L) + (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) _] + simp only [incidenceBiquadraticY, incidenceBranchPolynomial] + simp [map_sub, map_mul, map_pow, + IsScalarTower.algebraMap_apply L (Polynomial L) (IncidenceBiquadraticRing L a b)] + +lemma incidenceAuxAevalToBiquadratic_polynomial2 (a b : L) : + incidenceAuxAevalToBiquadratic L a b (incidenceAuxPolynomial2 b) = 0 := by + simp only [incidenceAuxAevalToBiquadratic, incidenceAuxPolynomial2, map_sub, map_mul, + map_pow, MvPolynomial.aeval_C, MvPolynomial.aeval_X] + change + ((algebraMap L (IncidenceBiquadraticRing L a b)) 9 * + (algebraMap L (IncidenceBiquadraticRing L a b)) b ^ 2 - + (algebraMap L (IncidenceBiquadraticRing L a b)) 4) * + (incidenceBiquadraticY L a b) ^ 2 - + (incidenceBiquadraticMu L a b) ^ 2 - + (algebraMap L (IncidenceBiquadraticRing L a b)) 4 * + (algebraMap L (IncidenceBiquadraticRing L a b)) b ^ 2 = 0 + rw [show (incidenceBiquadraticMu L a b) ^ 2 = + algebraMap (Polynomial L) (IncidenceBiquadraticRing L a b) + (incidenceBranchPolynomial b) by + simp only [incidenceBiquadraticMu] + rw [incidenceSecondQuadraticRoot_sq] + exact IsScalarTower.algebraMap_apply (Polynomial L) + (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) _] + simp only [incidenceBiquadraticY, incidenceBranchPolynomial] + simp [map_sub, map_mul, map_pow, + IsScalarTower.algebraMap_apply L (Polynomial L) (IncidenceBiquadraticRing L a b)] + +lemma incidenceAuxIdeal_le_aevalToBiquadratic_ker (a b : L) : + incidenceAuxIdeal a b ≤ + RingHom.ker (incidenceAuxAevalToBiquadratic L a b).toRingHom := by + rw [incidenceAuxIdeal, Ideal.span_le] + rintro p (rfl | hp) + · exact incidenceAuxAevalToBiquadratic_polynomial1 L a b + · rw [Set.mem_singleton_iff.mp hp] + exact incidenceAuxAevalToBiquadratic_polynomial2 L a b + +/-- The canonical map from the explicit coordinate-ring quotient to the iterated quadratic +normal form. -/ +def incidenceAuxCoordinateRingToBiquadratic (a b : L) : + IncidenceAuxCoordinateRing L a b →ₐ[L] IncidenceBiquadraticRing L a b := + Ideal.Quotient.liftₐ (incidenceAuxIdeal a b) + (incidenceAuxAevalToBiquadratic L a b) + (fun _p hp => incidenceAuxIdeal_le_aevalToBiquadratic_ker L a b hp) + +lemma incidenceBiquadraticY_mem_aeval_range (a b : L) : + incidenceBiquadraticY L a b ∈ (incidenceAuxAevalToBiquadratic L a b).range := by + refine ⟨MvPolynomial.X 0, ?_⟩ + simp [incidenceAuxAevalToBiquadratic] + +lemma incidenceBiquadraticLambda_mem_aeval_range (a b : L) : + incidenceBiquadraticLambda L a b ∈ + (incidenceAuxAevalToBiquadratic L a b).range := by + refine ⟨MvPolynomial.X 1, ?_⟩ + simp [incidenceAuxAevalToBiquadratic] + +lemma incidenceBiquadraticMu_mem_aeval_range (a b : L) : + incidenceBiquadraticMu L a b ∈ (incidenceAuxAevalToBiquadratic L a b).range := by + refine ⟨MvPolynomial.X 2, ?_⟩ + simp [incidenceAuxAevalToBiquadratic] + +lemma polynomialAlgebraMap_mem_incidenceAevalRange (a b : L) (r : Polynomial L) : + algebraMap (Polynomial L) (IncidenceBiquadraticRing L a b) r ∈ + (incidenceAuxAevalToBiquadratic L a b).range := by + induction r using Polynomial.induction_on' with + | add p q hp hq => + rw [map_add] + exact Subalgebra.add_mem _ hp hq + | monomial n c => + have hy := incidenceBiquadraticY_mem_aeval_range L a b + have hc := (incidenceAuxAevalToBiquadratic L a b).range.algebraMap_mem c + rw [← Polynomial.C_mul_X_pow_eq_monomial, map_mul, map_pow] + simpa [incidenceBiquadraticY, + IsScalarTower.algebraMap_apply L (Polynomial L) (IncidenceBiquadraticRing L a b)] + using Subalgebra.mul_mem _ hc (Subalgebra.pow_mem _ hy n) + +lemma firstQuadraticAlgebraMap_mem_incidenceAevalRange (a b : L) + (s : IncidenceFirstQuadraticRing L a) : + algebraMap (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) s ∈ + (incidenceAuxAevalToBiquadratic L a b).range := by + induction s using AdjoinRoot.induction_on with + | ih p => + induction p using Polynomial.induction_on' with + | add p q hp hq => + simpa only [map_add] using Subalgebra.add_mem _ hp hq + | monomial n r => + have hr := polynomialAlgebraMap_mem_incidenceAevalRange L a b r + have hlambda := incidenceBiquadraticLambda_mem_aeval_range L a b + have heq : + algebraMap (IncidenceFirstQuadraticRing L a) + (IncidenceBiquadraticRing L a b) + (AdjoinRoot.mk + (adjoinSquarePolynomial (incidenceBranchPolynomial a)) + (Polynomial.monomial n r)) = + algebraMap (Polynomial L) (IncidenceBiquadraticRing L a b) r * + (incidenceBiquadraticLambda L a b) ^ n := by + rw [← AdjoinRoot.aeval_eq, ← Polynomial.C_mul_X_pow_eq_monomial] + simp [incidenceBiquadraticLambda, + IsScalarTower.algebraMap_apply (Polynomial L) + (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b)] + rw [heq] + exact Subalgebra.mul_mem _ hr (Subalgebra.pow_mem _ hlambda n) + +lemma incidenceAuxAevalToBiquadratic_surjective (a b : L) : + Function.Surjective (incidenceAuxAevalToBiquadratic L a b) := by + rw [← AlgHom.range_eq_top] + apply Algebra.eq_top_iff.mpr + intro t + induction t using AdjoinRoot.induction_on with + | ih p => + induction p using Polynomial.induction_on' with + | add p q hp hq => + simpa only [map_add] using Subalgebra.add_mem _ hp hq + | monomial n s => + have hs := firstQuadraticAlgebraMap_mem_incidenceAevalRange L a b s + have hmu := incidenceBiquadraticMu_mem_aeval_range L a b + have heq : + AdjoinRoot.mk (incidenceSecondQuadraticPolynomial L a b) + (Polynomial.monomial n s) = + algebraMap (IncidenceFirstQuadraticRing L a) + (IncidenceBiquadraticRing L a b) s * + (incidenceBiquadraticMu L a b) ^ n := by + rw [← AdjoinRoot.aeval_eq, ← Polynomial.C_mul_X_pow_eq_monomial] + simp [incidenceBiquadraticMu] + rw [heq] + exact Subalgebra.mul_mem _ hs (Subalgebra.pow_mem _ hmu n) + +lemma incidenceAuxCoordinateRingToBiquadratic_surjective (a b : L) : + Function.Surjective (incidenceAuxCoordinateRingToBiquadratic L a b) := by + intro t + obtain ⟨p, rfl⟩ := incidenceAuxAevalToBiquadratic_surjective L a b t + exact ⟨Ideal.Quotient.mk (incidenceAuxIdeal a b) p, rfl⟩ + +/-- The class of one of the three coordinate variables in the auxiliary coordinate ring. -/ +def incidenceAuxCoordinateClass (a b : L) (i : Fin 3) : + IncidenceAuxCoordinateRing L a b := + Ideal.Quotient.mk (incidenceAuxIdeal a b) (MvPolynomial.X i) + +/-- The polynomial algebra in `y` maps to the auxiliary coordinate ring by sending `X` to the +class of the `y`-coordinate. -/ +def incidenceAuxPolynomialAlgebraMap (a b : L) : + Polynomial L →ₐ[L] IncidenceAuxCoordinateRing L a b := + Polynomial.aeval (incidenceAuxCoordinateClass L a b 0) + +lemma incidenceAuxPolynomial1_class_eq_zero (a b : L) : + Ideal.Quotient.mk (incidenceAuxIdeal a b) (incidenceAuxPolynomial1 a) = 0 := by + rw [Ideal.Quotient.eq_zero_iff_mem] + exact Ideal.subset_span (by simp) + +lemma incidenceAuxPolynomial2_class_eq_zero (a b : L) : + Ideal.Quotient.mk (incidenceAuxIdeal a b) (incidenceAuxPolynomial2 b) = 0 := by + rw [Ideal.Quotient.eq_zero_iff_mem] + exact Ideal.subset_span (by simp) + +lemma incidenceAuxLambdaClass_sq (a b : L) : + (incidenceAuxCoordinateClass L a b 1) ^ 2 = + incidenceAuxPolynomialAlgebraMap L a b (incidenceBranchPolynomial a) := by + have h := incidenceAuxPolynomial1_class_eq_zero L a b + simp only [incidenceAuxPolynomial1, map_sub, map_mul, map_pow] at h + simp only [incidenceAuxPolynomialAlgebraMap, incidenceBranchPolynomial, + map_sub, map_mul, map_pow, Polynomial.aeval_C, Polynomial.aeval_X] + change + (incidenceAuxCoordinateClass L a b 1) ^ 2 = + ((algebraMap L (IncidenceAuxCoordinateRing L a b)) 9 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) a ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4) * + (incidenceAuxCoordinateClass L a b 0) ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) a ^ 2 + change + ((algebraMap L (IncidenceAuxCoordinateRing L a b)) 9 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) a ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4) * + (incidenceAuxCoordinateClass L a b 0) ^ 2 - + (incidenceAuxCoordinateClass L a b 1) ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) a ^ 2 = 0 at h + linear_combination -h + +lemma incidenceAuxMuClass_sq (a b : L) : + (incidenceAuxCoordinateClass L a b 2) ^ 2 = + incidenceAuxPolynomialAlgebraMap L a b (incidenceBranchPolynomial b) := by + have h := incidenceAuxPolynomial2_class_eq_zero L a b + simp only [incidenceAuxPolynomial2, map_sub, map_mul, map_pow] at h + simp only [incidenceAuxPolynomialAlgebraMap, incidenceBranchPolynomial, + map_sub, map_mul, map_pow, Polynomial.aeval_C, Polynomial.aeval_X] + change + (incidenceAuxCoordinateClass L a b 2) ^ 2 = + ((algebraMap L (IncidenceAuxCoordinateRing L a b)) 9 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) b ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4) * + (incidenceAuxCoordinateClass L a b 0) ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) b ^ 2 + change + ((algebraMap L (IncidenceAuxCoordinateRing L a b)) 9 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) b ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4) * + (incidenceAuxCoordinateClass L a b 0) ^ 2 - + (incidenceAuxCoordinateClass L a b 2) ^ 2 - + (algebraMap L (IncidenceAuxCoordinateRing L a b)) 4 * + (algebraMap L (IncidenceAuxCoordinateRing L a b)) b ^ 2 = 0 at h + linear_combination -h + +/-- Map the first quadratic extension back to the explicit coordinate ring. -/ +def incidenceFirstQuadraticToAuxCoordinateRing (a b : L) : + IncidenceFirstQuadraticRing L a →ₐ[L] IncidenceAuxCoordinateRing L a b := + AdjoinRoot.liftAlgHom + (adjoinSquarePolynomial (incidenceBranchPolynomial a)) + (incidenceAuxPolynomialAlgebraMap L a b) + (incidenceAuxCoordinateClass L a b 1) + (by + simp [adjoinSquarePolynomial, incidenceAuxLambdaClass_sq]) + +/-- Map the iterated quadratic normal form back to the explicit coordinate ring. -/ +def incidenceBiquadraticToAuxCoordinateRing (a b : L) : + IncidenceBiquadraticRing L a b →ₐ[L] IncidenceAuxCoordinateRing L a b := + AdjoinRoot.liftAlgHom + (incidenceSecondQuadraticPolynomial L a b) + (incidenceFirstQuadraticToAuxCoordinateRing L a b) + (incidenceAuxCoordinateClass L a b 2) + (by + simp only [incidenceSecondQuadraticPolynomial, adjoinSquarePolynomial, + Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] + rw [incidenceAuxMuClass_sq] + change + incidenceAuxPolynomialAlgebraMap L a b (incidenceBranchPolynomial b) - + incidenceFirstQuadraticToAuxCoordinateRing L a b + (AdjoinRoot.of + (adjoinSquarePolynomial (incidenceBranchPolynomial a)) + (incidenceBranchPolynomial b)) = 0 + rw [incidenceFirstQuadraticToAuxCoordinateRing, AdjoinRoot.liftAlgHom_of] + exact sub_self _) + +@[simp] +lemma incidenceAuxCoordinateRingToBiquadratic_coordinateClass (a b : L) (i : Fin 3) : + incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceAuxCoordinateClass L a b i) = + ![incidenceBiquadraticY L a b, incidenceBiquadraticLambda L a b, + incidenceBiquadraticMu L a b] i := by + simp [incidenceAuxCoordinateRingToBiquadratic, incidenceAuxCoordinateClass, + incidenceAuxAevalToBiquadratic] + +@[simp] +lemma incidenceBiquadraticToAuxCoordinateRing_y (a b : L) : + incidenceBiquadraticToAuxCoordinateRing L a b (incidenceBiquadraticY L a b) = + incidenceAuxCoordinateClass L a b 0 := by + rw [incidenceBiquadraticY, + IsScalarTower.algebraMap_apply (Polynomial L) (IncidenceFirstQuadraticRing L a) + (IncidenceBiquadraticRing L a b)] + simp [incidenceBiquadraticToAuxCoordinateRing, + incidenceFirstQuadraticToAuxCoordinateRing, incidenceAuxPolynomialAlgebraMap] + +@[simp] +lemma incidenceBiquadraticToAuxCoordinateRing_lambda (a b : L) : + incidenceBiquadraticToAuxCoordinateRing L a b + (incidenceBiquadraticLambda L a b) = + incidenceAuxCoordinateClass L a b 1 := by + simp [incidenceBiquadraticToAuxCoordinateRing, incidenceBiquadraticLambda, + incidenceFirstQuadraticToAuxCoordinateRing] + +@[simp] +lemma incidenceBiquadraticToAuxCoordinateRing_mu (a b : L) : + incidenceBiquadraticToAuxCoordinateRing L a b (incidenceBiquadraticMu L a b) = + incidenceAuxCoordinateClass L a b 2 := by + simp [incidenceBiquadraticToAuxCoordinateRing, incidenceBiquadraticMu] + +lemma incidenceBiquadraticToAux_comp_auxToBiquadratic (a b : L) : + (incidenceBiquadraticToAuxCoordinateRing L a b).comp + (incidenceAuxCoordinateRingToBiquadratic L a b) = + AlgHom.id L (IncidenceAuxCoordinateRing L a b) := by + apply Ideal.Quotient.algHom_ext L + apply MvPolynomial.algHom_ext + intro i + fin_cases i + · change incidenceBiquadraticToAuxCoordinateRing L a b + (incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceAuxCoordinateClass L a b 0)) = incidenceAuxCoordinateClass L a b 0 + rw [incidenceAuxCoordinateRingToBiquadratic_coordinateClass] + exact incidenceBiquadraticToAuxCoordinateRing_y L a b + · change incidenceBiquadraticToAuxCoordinateRing L a b + (incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceAuxCoordinateClass L a b 1)) = incidenceAuxCoordinateClass L a b 1 + rw [incidenceAuxCoordinateRingToBiquadratic_coordinateClass] + exact incidenceBiquadraticToAuxCoordinateRing_lambda L a b + · change incidenceBiquadraticToAuxCoordinateRing L a b + (incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceAuxCoordinateClass L a b 2)) = incidenceAuxCoordinateClass L a b 2 + rw [incidenceAuxCoordinateRingToBiquadratic_coordinateClass] + exact incidenceBiquadraticToAuxCoordinateRing_mu L a b + +lemma incidenceAuxToBiquadratic_comp_biquadraticToAux (a b : L) : + (incidenceAuxCoordinateRingToBiquadratic L a b).comp + (incidenceBiquadraticToAuxCoordinateRing L a b) = + AlgHom.id L (IncidenceBiquadraticRing L a b) := by + apply AdjoinRoot.algHom_ext' + · apply AdjoinRoot.algHom_ext' + · apply Polynomial.algHom_ext + change incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceBiquadraticToAuxCoordinateRing L a b + (algebraMap (IncidenceFirstQuadraticRing L a) + (IncidenceBiquadraticRing L a b) + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) Polynomial.X))) = _ + rw [show algebraMap (IncidenceFirstQuadraticRing L a) + (IncidenceBiquadraticRing L a b) + (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) Polynomial.X) = + incidenceBiquadraticY L a b by + exact (IsScalarTower.algebraMap_apply (Polynomial L) + (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) _).symm] + rw [incidenceBiquadraticToAuxCoordinateRing_y] + rw [incidenceAuxCoordinateRingToBiquadratic_coordinateClass] + exact IsScalarTower.algebraMap_apply (Polynomial L) + (IncidenceFirstQuadraticRing L a) (IncidenceBiquadraticRing L a b) _ + · change incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceBiquadraticToAuxCoordinateRing L a b + (incidenceBiquadraticLambda L a b)) = incidenceBiquadraticLambda L a b + rw [incidenceBiquadraticToAuxCoordinateRing_lambda] + rw [incidenceAuxCoordinateRingToBiquadratic_coordinateClass] + simp + · change incidenceAuxCoordinateRingToBiquadratic L a b + (incidenceBiquadraticToAuxCoordinateRing L a b + (incidenceBiquadraticMu L a b)) = incidenceBiquadraticMu L a b + rw [incidenceBiquadraticToAuxCoordinateRing_mu] + rw [incidenceAuxCoordinateRingToBiquadratic_coordinateClass] + simp + +/-- The two-equation coordinate quotient is exactly the rank-four iterated quadratic algebra. -/ +noncomputable def incidenceAuxCoordinateRingEquivBiquadratic (a b : L) : + IncidenceAuxCoordinateRing L a b ≃ₐ[L] IncidenceBiquadraticRing L a b := + AlgEquiv.ofAlgHom + (incidenceAuxCoordinateRingToBiquadratic L a b) + (incidenceBiquadraticToAuxCoordinateRing L a b) + (incidenceAuxToBiquadratic_comp_biquadraticToAux L a b) + (incidenceBiquadraticToAux_comp_auxToBiquadratic L a b) + +/-- The explicit two-equation coordinate quotient is a domain under the off-diagonal +nondegeneracy hypotheses. -/ +theorem incidenceAuxCoordinateRing_isDomain + (h2 : (2 : L) ≠ 0) {a b : L} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + IsDomain (IncidenceAuxCoordinateRing L a b) := by + letI : IsDomain (IncidenceBiquadraticRing L a b) := + incidenceBiquadraticRing_isDomain L h2 ha hb hA hB hab + exact (incidenceAuxCoordinateRingEquivBiquadratic L a b).injective.isDomain + (incidenceAuxCoordinateRingEquivBiquadratic L a b).toRingEquiv.toRingHom + +/-- The actual geometric-integrality statement follows after explicit scalar extension to the +algebraic closure; no irreducibility assertion is hidden in a structure field. -/ +theorem incidenceAuxGeometricallyIntegral_of_nondegenerate + {K : Type*} [Field K] (h2 : (2 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + IncidenceAuxGeometricallyIntegral a b := by + let L := AlgebraicClosure K + have hmapNeZero {x : K} (hx : x ≠ 0) : algebraMap K L x ≠ 0 := by + intro hzero + apply hx + apply FaithfulSMul.algebraMap_injective K L + simpa only [map_zero] using hzero + have h2L : (2 : L) ≠ 0 := by + simpa only [map_ofNat] using hmapNeZero h2 + have haL : algebraMap K L a ≠ 0 := hmapNeZero ha + have hbL : algebraMap K L b ≠ 0 := hmapNeZero hb + have hAL : 9 * (algebraMap K L a) ^ 2 - 4 ≠ 0 := by + simpa only [map_sub, map_mul, map_pow, map_ofNat] using hmapNeZero hA + have hBL : 9 * (algebraMap K L b) ^ 2 - 4 ≠ 0 := by + simpa only [map_sub, map_mul, map_pow, map_ofNat] using hmapNeZero hB + have habL : (algebraMap K L a) ^ 2 ≠ (algebraMap K L b) ^ 2 := by + intro heq + apply hab + apply FaithfulSMul.algebraMap_injective K L + simpa only [map_pow] using heq + letI : IsDomain + (IncidenceAuxCoordinateRing L (algebraMap K L a) (algebraMap K L b)) := + incidenceAuxCoordinateRing_isDomain L h2L haL hbL hAL hBL habL + exact (incidenceAuxCoordinateRingBaseChangeExplicitEquiv K L a b).injective.isDomain + (incidenceAuxCoordinateRingBaseChangeExplicitEquiv K L a b).toRingEquiv.toRingHom + +/-- Specialization to the paper's admissible off-diagonal coordinates. The threshold `3` only +excludes characteristic two; no large-prime estimate is used in this geometric step. -/ +theorem incidenceAux_offDiagonal_geometricallyIntegral : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → + IncidenceAuxOffDiagonalGeometryAt p hp := by + refine ⟨3, ?_⟩ + intro p hp hpLarge + letI : Fact p.Prime := ⟨hp⟩ + intro a b ha hb hab + apply incidenceAuxGeometricallyIntegral_of_nondegenerate + · exact two_ne_zero_zmod (by omega) + · exact ha.1 + · exact hb.1 + · intro hzero + apply ha.2 + calc + (3 * a) ^ 2 = 9 * a ^ 2 := by ring + _ = 4 := sub_eq_zero.mp hzero + · intro hzero + apply hb.2 + calc + (3 * b) ^ 2 = 9 * b ^ 2 := by ring + _ = 4 := sub_eq_zero.mp hzero + · exact hab + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean new file mode 100644 index 0000000000..8519133388 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean @@ -0,0 +1,56 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers + +/-! +# Small-prime counterexamples to the printed incidence threshold + +These kernel-checked examples show that the paper's claim for every prime `p > 10` is false for +the exact admissible auxiliary-point statement used by its diameter-two argument. +-/ + +namespace BGS.Markoff + +local instance {p : ℕ} [Fact p.Prime] (a : ZMod p) : + Decidable (IsAdmissibleCoordinate a) := by + unfold IsAdmissibleCoordinate + infer_instance + +local instance {K : Type*} [Field K] [DecidableEq K] (a b y lambda mu : K) : + Decidable (IncidenceAux a b y lambda mu) := by + unfold IncidenceAux + infer_instance + +section Prime13 + +local instance : Fact (Nat.Prime 13) := ⟨by norm_num⟩ + +theorem no_admissible_incidenceAux_point_at_thirteen : + IsAdmissibleCoordinate (1 : ZMod 13) ∧ + IsAdmissibleCoordinate (4 : ZMod 13) ∧ + (1 : ZMod 13) ^ 2 ≠ (4 : ZMod 13) ^ 2 ∧ + ¬ ∃ y lambda mu : ZMod 13, + IsAdmissibleCoordinate y ∧ IncidenceAux 1 4 y lambda mu := by + decide + +end Prime13 + +section Prime17 + +local instance : Fact (Nat.Prime 17) := ⟨by norm_num⟩ + +theorem no_admissible_incidenceAux_point_at_seventeen : + IsAdmissibleCoordinate (1 : ZMod 17) ∧ + IsAdmissibleCoordinate (6 : ZMod 17) ∧ + (1 : ZMod 17) ^ 2 ≠ (6 : ZMod 17) ^ 2 ∧ + ¬ ∃ y lambda mu : ZMod 17, + IsAdmissibleCoordinate y ∧ IncidenceAux 1 6 y lambda mu := by + decide + +end Prime17 + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean new file mode 100644 index 0000000000..063b8bf979 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean @@ -0,0 +1,426 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount + +/-! +# Incidence of Markoff conic fibers + +This file formalizes the algebra behind Proposition 6 of Bourgain--Gamburd--Sarnak. Geometric +integrality is proved in `BGS.Markoff.IncidenceCoordinateRing`; the independent Hasse point-count +gap is isolated in `BGS.FiniteField.EllipticCharacterSum`. +-/ + +namespace BGS.Markoff + +universe u + +variable {F : Type u} [Field F] + +/-- The Markoff fiber obtained by fixing the first coordinate. -/ +def fiber1 (a : F) : Set (Point F) := + {x | IsMarkoff x ∧ x.x1 = a} + +/-- The Markoff fiber obtained by fixing the second coordinate. -/ +def fiber2 (a : F) : Set (Point F) := + {x | IsMarkoff x ∧ x.x2 = a} + +/-- The Markoff fiber obtained by fixing the third coordinate. -/ +def fiber3 (a : F) : Set (Point F) := + {x | IsMarkoff x ∧ x.x3 = a} + +/-- Two fibers meet when their set-theoretic intersection is nonempty. -/ +def FibersMeet (s t : Set (Point F)) : Prop := + (s ∩ t).Nonempty + +/-- +The affine auxiliary equations used in the paper to find one third-coordinate fiber meeting +the fibers with first-coordinate value `a` and second-coordinate value `b`. +-/ +def IncidenceAux (a b y lambda mu : F) : Prop := + (9 * a ^ 2 - 4) * y ^ 2 - lambda ^ 2 = 4 * a ^ 2 ∧ + (9 * b ^ 2 - 4) * y ^ 2 - mu ^ 2 = 4 * b ^ 2 + +open MvPolynomial +open scoped TensorProduct + +noncomputable section + +/-- The first equation of the auxiliary curve, with variables `(y, lambda, mu)`. -/ +def incidenceAuxPolynomial1 {K : Type u} [Field K] (a : K) : + MvPolynomial (Fin 3) K := + C (9 * a ^ 2 - 4) * X 0 ^ 2 - X 1 ^ 2 - C (4 * a ^ 2) + +/-- The second equation of the auxiliary curve, with variables `(y, lambda, mu)`. -/ +def incidenceAuxPolynomial2 {K : Type u} [Field K] (b : K) : + MvPolynomial (Fin 3) K := + C (9 * b ^ 2 - 4) * X 0 ^ 2 - X 2 ^ 2 - C (4 * b ^ 2) + +/-- The ideal cutting out the affine auxiliary curve from Proposition 6. -/ +def incidenceAuxIdeal {K : Type u} [Field K] (a b : K) : + Ideal (MvPolynomial (Fin 3) K) := + Ideal.span {incidenceAuxPolynomial1 a, incidenceAuxPolynomial2 b} + +/-- The affine coordinate ring of the auxiliary curve. -/ +abbrev IncidenceAuxCoordinateRing (K : Type u) [Field K] (a b : K) := + MvPolynomial (Fin 3) K ⧸ incidenceAuxIdeal a b + +/-- The actual geometric-integrality condition required before applying a Weil bound. -/ +def IncidenceAuxGeometricallyIntegral {K : Type u} [Field K] (a b : K) : Prop := + IsDomain (AlgebraicClosure K ⊗[K] IncidenceAuxCoordinateRing K a b) + +end + +@[simp] +theorem eval_incidenceAuxPolynomial1_vec + {K : Type u} [Field K] (a y lambda mu : K) : + aeval ![y, lambda, mu] (incidenceAuxPolynomial1 a) = + (9 * a ^ 2 - 4) * y ^ 2 - lambda ^ 2 - 4 * a ^ 2 := by + simp [incidenceAuxPolynomial1] + +@[simp] +theorem eval_incidenceAuxPolynomial2_vec + {K : Type u} [Field K] (b y lambda mu : K) : + aeval ![y, lambda, mu] (incidenceAuxPolynomial2 b) = + (9 * b ^ 2 - 4) * y ^ 2 - mu ^ 2 - 4 * b ^ 2 := by + simp [incidenceAuxPolynomial2] + +/-- The coordinate-ring equations are exactly the two scalar equations used in the incidence +argument. -/ +theorem incidenceAux_iff_aeval_eq_zero + {K : Type u} [Field K] (a b y lambda mu : K) : + IncidenceAux a b y lambda mu ↔ + aeval ![y, lambda, mu] (incidenceAuxPolynomial1 a) = 0 ∧ + aeval ![y, lambda, mu] (incidenceAuxPolynomial2 b) = 0 := by + simp [IncidenceAux, sub_eq_zero] + +/-- A chosen root of the quadratic defining the intersection of two coordinate fibers. -/ +def conicRoot (a y discriminantRoot : F) : F := + (3 * a * y + discriminantRoot) / 2 + +lemma markoffPolynomial_conicRoot + (h2 : (2 : F) ≠ 0) {a y discriminantRoot : F} + (h : (9 * a ^ 2 - 4) * y ^ 2 - discriminantRoot ^ 2 = 4 * a ^ 2) : + markoffPolynomial ⟨a, conicRoot a y discriminantRoot, y⟩ = 0 := by + have h4 : (4 : F) ≠ 0 := by + intro h4 + apply (mul_ne_zero h2 h2) + calc + (2 : F) * 2 = 4 := by norm_num + _ = 0 := h4 + calc + markoffPolynomial ⟨a, conicRoot a y discriminantRoot, y⟩ = + -(((9 * a ^ 2 - 4) * y ^ 2 - discriminantRoot ^ 2) - 4 * a ^ 2) / 4 := by + simp only [markoffPolynomial, conicRoot] + field_simp [h2, h4] + ring + _ = 0 := by rw [h]; simp + +lemma point_mem_fiber1_inter_fiber3 + (h2 : (2 : F) ≠ 0) {a y discriminantRoot : F} + (h : (9 * a ^ 2 - 4) * y ^ 2 - discriminantRoot ^ 2 = 4 * a ^ 2) : + ⟨a, conicRoot a y discriminantRoot, y⟩ ∈ fiber1 a ∩ fiber3 y := by + constructor + · exact ⟨markoffPolynomial_conicRoot h2 h, rfl⟩ + · exact ⟨markoffPolynomial_conicRoot h2 h, rfl⟩ + +lemma point_mem_fiber2_inter_fiber3 + (h2 : (2 : F) ≠ 0) {b y discriminantRoot : F} + (h : (9 * b ^ 2 - 4) * y ^ 2 - discriminantRoot ^ 2 = 4 * b ^ 2) : + ⟨conicRoot b y discriminantRoot, b, y⟩ ∈ fiber2 b ∩ fiber3 y := by + have hmarkoff : IsMarkoff ⟨conicRoot b y discriminantRoot, b, y⟩ := by + change markoffPolynomial (swap12 ⟨b, conicRoot b y discriminantRoot, y⟩) = 0 + rw [markoffPolynomial_swap12] + exact markoffPolynomial_conicRoot h2 h + constructor + · exact ⟨hmarkoff, rfl⟩ + · exact ⟨hmarkoff, rfl⟩ + +theorem incidenceAux_implies_common_fiber + (h2 : (2 : F) ≠ 0) {a b y lambda mu : F} + (h : IncidenceAux a b y lambda mu) : + FibersMeet (fiber1 a) (fiber3 y) ∧ FibersMeet (fiber2 b) (fiber3 y) := by + refine ⟨?_, ?_⟩ + · exact ⟨_, point_mem_fiber1_inter_fiber3 h2 h.1⟩ + · exact ⟨_, point_mem_fiber2_inter_fiber3 h2 h.2⟩ + +/-- A point on the auxiliary curve gives a common fiber, while retaining any extra predicate +required of its `y`-coordinate. -/ +theorem incidenceAux_exists_implies_common_fiber_with + (h2 : (2 : F) ≠ 0) {P : F → Prop} {a b : F} + (h : ∃ y lambda mu, P y ∧ IncidenceAux a b y lambda mu) : + ∃ y, P y ∧ FibersMeet (fiber1 a) (fiber3 y) ∧ + FibersMeet (fiber2 b) (fiber3 y) := by + obtain ⟨y, lambda, mu, hy, haux⟩ := h + exact ⟨y, hy, incidenceAux_implies_common_fiber h2 haux⟩ + +/-- On the diagonal `a² = b²`, one equation supplies both auxiliary square roots. -/ +theorem diagonal_incidenceAux_of_firstEquation + {a b y lambda : F} (hab : a ^ 2 = b ^ 2) + (h : (9 * a ^ 2 - 4) * y ^ 2 - lambda ^ 2 = 4 * a ^ 2) : + IncidenceAux a b y lambda lambda := by + refine ⟨h, ?_⟩ + simpa only [← hab] using h + +/-- Combine the diagonal and off-diagonal point-existence problems. -/ +theorem auxPointExists_of_diagonal_offDiagonal {P : F → Prop} + (hdiag : ∀ a : F, P a → + ∃ y lambda, P y ∧ + (9 * a ^ 2 - 4) * y ^ 2 - lambda ^ 2 = 4 * a ^ 2) + (hoff : ∀ a b : F, P a → P b → a ^ 2 ≠ b ^ 2 → + ∃ y lambda mu, P y ∧ IncidenceAux a b y lambda mu) : + ∀ a b : F, P a → P b → + ∃ y lambda mu, P y ∧ IncidenceAux a b y lambda mu := by + intro a b ha hb + by_cases hab : a ^ 2 = b ^ 2 + · obtain ⟨y, lambda, hy, heq⟩ := hdiag a ha + exact ⟨y, lambda, lambda, hy, diagonal_incidenceAux_of_firstEquation hab heq⟩ + · exact hoff a b ha hb hab + +/-- Coordinates retained as vertices of the paper's incidence graph. -/ +def IsAdmissibleCoordinate {p : ℕ} (a : ZMod p) : Prop := + a ≠ 0 ∧ (3 * a) ^ 2 ≠ 4 + +/-- The three first-coordinate values excluded from the incidence graph. -/ +def forbiddenIntermediateCoordinates (p : ℕ) [Fact p.Prime] : Finset (ZMod p) := + {0, 2 / 3, -(2 / 3)} + +theorem forbiddenIntermediateCoordinates_card_le_three + (p : ℕ) [Fact p.Prime] : (forbiddenIntermediateCoordinates p).card ≤ 3 := by + exact Finset.card_le_three + +/-- A natural number smaller than the modulus remains nonzero in `ZMod p`. -/ +theorem natCast_ne_zero_zmod_of_pos_of_lt + {n p : ℕ} (hn : 0 < n) (hnp : n < p) : (n : ZMod p) ≠ 0 := by + intro hzero + have hdvd : p ∣ n := (ZMod.natCast_eq_zero_iff n p).mp hzero + exact (Nat.not_le_of_gt hnp) (Nat.le_of_dvd hn hdvd) + +/-- Outside the three forbidden values, a coordinate is admissible. -/ +theorem admissible_of_not_mem_forbiddenIntermediateCoordinates + {p : ℕ} [Fact p.Prime] (h3 : (3 : ZMod p) ≠ 0) {y : ZMod p} + (hy : y ∉ forbiddenIntermediateCoordinates p) : IsAdmissibleCoordinate y := by + constructor + · intro hzero + exact hy (by simp [forbiddenIntermediateCoordinates, hzero]) + · intro hsquare + have hsquare' : (3 * y) ^ 2 = (2 : ZMod p) ^ 2 := by + calc + (3 * y) ^ 2 = 4 := hsquare + _ = (2 : ZMod p) ^ 2 := by norm_num + rcases sq_eq_sq_iff_eq_or_eq_neg.mp hsquare' with hpositive | hnegative + · have hyvalue : y = 2 / 3 := + (eq_div_iff h3).2 (by simpa [mul_comm] using hpositive) + exact hy (by simp [forbiddenIntermediateCoordinates, hyvalue]) + · have hyvalue : y = -(2 / 3) := by + rw [← neg_div] + exact (eq_div_iff h3).2 (by simpa [mul_comm] using hnegative) + exact hy (by simp [forbiddenIntermediateCoordinates, hyvalue]) + +/-- The exact auxiliary-point conclusion, including the condition that the new fiber remains a +vertex of the incidence graph. -/ +def IncidenceAuxPointAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ a b : ZMod p, + IsAdmissibleCoordinate a → + IsAdmissibleCoordinate b → + ∃ y lambda mu : ZMod p, + IsAdmissibleCoordinate y ∧ IncidenceAux a b y lambda mu + +/-- The common-fiber conclusion actually needed for the diameter-two incidence argument. -/ +def IncidenceBridgeAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ a b : ZMod p, + IsAdmissibleCoordinate a → + IsAdmissibleCoordinate b → + ∃ y : ZMod p, + IsAdmissibleCoordinate y ∧ + FibersMeet (fiber1 a) (fiber3 y) ∧ FibersMeet (fiber2 b) (fiber3 y) + +/-- +The diagonal finite-field point problem suppressed in line 661 of the paper. + +Besides finding an affine conic point, the proof must avoid the three possible forbidden +coordinates `y = 0, ±2/3`. +-/ +theorem incidenceAux_diagonal_point : + ∃ p0 : ℕ, ∀ (p : ℕ) (_hp : p.Prime), p0 ≤ p → + ∀ a : ZMod p, IsAdmissibleCoordinate a → + ∃ y lambda : ZMod p, + IsAdmissibleCoordinate y ∧ + (9 * a ^ 2 - 4) * y ^ 2 - lambda ^ 2 = 4 * a ^ 2 := by + refine ⟨11, ?_⟩ + intro p hp hpLarge a ha + letI : Fact p.Prime := ⟨hp⟩ + have h3lt : 3 < p := by omega + have h4lt : 4 < p := by omega + have h3 : (3 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) h3lt + have h4 : (4 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) h4lt + have hchar : ringChar (ZMod p) ≠ 2 := by + rw [ZMod.ringChar_zmod_n] + omega + have hcard : 8 ≤ Fintype.card (ZMod p) := by + rw [ZMod.card] + omega + have hA : (9 * a ^ 2 - 4 : ZMod p) ≠ 0 := by + intro hzero + apply ha.2 + calc + (3 * a) ^ 2 = 9 * a ^ 2 := by ring + _ = 4 := sub_eq_zero.mp hzero + have hC : (4 * a ^ 2 : ZMod p) ≠ 0 := by + exact mul_ne_zero h4 (pow_ne_zero 2 ha.1) + obtain ⟨y, hy, lambda, hlambda⟩ := + BGS.FiniteField.exists_quadratic_conic_point_away_from_three + hchar hcard hA hC (forbiddenIntermediateCoordinates p) + (forbiddenIntermediateCoordinates_card_le_three p) + refine ⟨y, lambda, admissible_of_not_mem_forbiddenIntermediateCoordinates h3 hy, ?_⟩ + linear_combination -hlambda + +/-- +The geometric-integrality assertion needed in the off-diagonal case. + +The paper merely calls the affine curve irreducible. A Weil argument needs geometric +integrality of an appropriate model, and the assertion still requires a proof. +-/ +def IncidenceAuxOffDiagonalGeometryAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ a b : ZMod p, + IsAdmissibleCoordinate a → IsAdmissibleCoordinate b → a ^ 2 ≠ b ^ 2 → + IncidenceAuxGeometricallyIntegral a b + +/-- The off-diagonal auxiliary-point statement reduced to the explicit elliptic character sum. -/ +def IncidenceAuxOffDiagonalPointAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ a b : ZMod p, + IsAdmissibleCoordinate a → IsAdmissibleCoordinate b → a ^ 2 ≠ b ^ 2 → + ∃ y lambda mu : ZMod p, + IsAdmissibleCoordinate y ∧ IncidenceAux a b y lambda mu + +/-- Optional Legendre Hasse premise for the incidence-diameter route. The +selected Theorem 1 proof does not use this route. -/ +def ZModLegendrePointCardHasseBound : Prop := + ∀ (p : ℕ) [Fact p.Prime], + BGS.FiniteField.LegendrePointCardHasseBound (ZMod p) + +/-- +The off-diagonal auxiliary point follows from the narrow Hasse bound for +`Y² = X (X - u) (X - v)`. This direct route does not pretend that geometric integrality alone +contains the missing genus and point-count estimates. +-/ +theorem incidenceAux_offDiagonal_point + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (_hp : p.Prime), p0 ≤ p → + IncidenceAuxOffDiagonalPointAt p _hp := by + refine ⟨29, ?_⟩ + intro p hp hpLarge a b ha hb hab + letI : Fact p.Prime := ⟨hp⟩ + have h3lt : 3 < p := by omega + have h4lt : 4 < p := by omega + have h16lt : 16 < p := by omega + have h3 : (3 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) h3lt + have h4 : (4 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) h4lt + have h16 : (16 : ZMod p) ≠ 0 := + natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) h16lt + have hchar : ringChar (ZMod p) ≠ 2 := by + rw [ZMod.ringChar_zmod_n] + omega + have hcard : 26 ≤ Fintype.card (ZMod p) := by + rw [ZMod.card] + omega + have hA : (9 * a ^ 2 - 4 : ZMod p) ≠ 0 := by + intro hzero + apply ha.2 + calc + (3 * a) ^ 2 = 9 * a ^ 2 := by ring + _ = 4 := sub_eq_zero.mp hzero + have hB : (9 * b ^ 2 - 4 : ZMod p) ≠ 0 := by + intro hzero + apply hb.2 + calc + (3 * b) ^ 2 = 9 * b ^ 2 := by ring + _ = 4 := sub_eq_zero.mp hzero + have hC : (4 * a ^ 2 : ZMod p) ≠ 0 := + mul_ne_zero h4 (pow_ne_zero 2 ha.1) + have hD : (4 * b ^ 2 : ZMod p) ≠ 0 := + mul_ne_zero h4 (pow_ne_zero 2 hb.1) + have hcross : + (9 * a ^ 2 - 4) * (4 * b ^ 2) ≠ (9 * b ^ 2 - 4) * (4 * a ^ 2) := by + intro h + have hzero : (16 : ZMod p) * (a ^ 2 - b ^ 2) = 0 := by + calc + (16 : ZMod p) * (a ^ 2 - b ^ 2) = + (9 * a ^ 2 - 4) * (4 * b ^ 2) - + (9 * b ^ 2 - 4) * (4 * a ^ 2) := by ring + _ = 0 := sub_eq_zero.mpr h + exact (mul_ne_zero h16 (sub_ne_zero.mpr hab)) hzero + obtain ⟨y, hy, lambda, mu, hlambda, hmu⟩ := + exists_auxiliary_triple_away_from_three (hHasse p) hchar hcard hA hB hC hD hcross + (forbiddenIntermediateCoordinates p) (forbiddenIntermediateCoordinates_card_le_three p) + refine ⟨y, lambda, mu, + admissible_of_not_mem_forbiddenIntermediateCoordinates h3 hy, ?_, ?_⟩ + · dsimp [branchValue] at hlambda + linear_combination -hlambda + · dsimp [branchValue] at hmu + linear_combination -hmu + +/-- For all sufficiently large primes, the explicit auxiliary equations have an admissible +solution for every pair of admissible coordinates. -/ +theorem incidenceAuxPoint_eventually + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → IncidenceAuxPointAt p hp := by + obtain ⟨pDiag, hDiag⟩ := incidenceAux_diagonal_point + obtain ⟨pOff, hOff⟩ := incidenceAux_offDiagonal_point hHasse + refine ⟨pDiag + pOff, ?_⟩ + intro p hp hpLarge + letI : Fact p.Prime := ⟨hp⟩ + exact auxPointExists_of_diagonal_offDiagonal + (hDiag p hp (by omega)) (hOff p hp (by omega)) + +/-- A prime larger than two has `2 ≠ 0` in its prime field. -/ +theorem two_ne_zero_zmod {p : ℕ} (hp : 2 < p) : (2 : ZMod p) ≠ 0 := by + exact natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hp + +/-- An admissible solution of the auxiliary equations gives the required graph bridge. -/ +theorem incidenceBridgeAt_of_auxPoint + (p : ℕ) (hp : p.Prime) (h2 : (2 : ZMod p) ≠ 0) + (haux : IncidenceAuxPointAt p hp) : IncidenceBridgeAt p hp := by + letI : Fact p.Prime := ⟨hp⟩ + intro a b ha hb + exact incidenceAux_exists_implies_common_fiber_with h2 (haux a b ha hb) + +/-- The bridge is a consequence of the exposed point-existence problems, not an assumption. -/ +theorem incidenceBridge_eventually + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → IncidenceBridgeAt p hp := by + obtain ⟨pAux, hAux⟩ := incidenceAuxPoint_eventually hHasse + refine ⟨3 + pAux, ?_⟩ + intro p hp hpLarge + exact incidenceBridgeAt_of_auxPoint p hp (two_ne_zero_zmod (by omega)) + (hAux p hp (by omega)) + +/-- The bridge specialized to primes congruent to three modulo four. -/ +theorem incidenceBridge_mod_three + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → p % 4 = 3 → IncidenceBridgeAt p hp := by + obtain ⟨p0, h⟩ := incidenceBridge_eventually hHasse + exact ⟨p0, fun p hp hpLarge _ => h p hp hpLarge⟩ + +/-- The admissible-fiber bridge specialized to primes congruent to one modulo four. -/ +theorem incidenceBridge_mod_one_admissible + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → p % 4 = 1 → IncidenceBridgeAt p hp := by + obtain ⟨p0, h⟩ := incidenceBridge_eventually hHasse + exact ⟨p0, fun p hp hpLarge _ => h p hp hpLarge⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean new file mode 100644 index 0000000000..3da561422e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean @@ -0,0 +1,177 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +/-! +# Square classes for the incidence auxiliary curve + +This file proves the polynomial and rational-function-field algebra behind geometric integrality +of the off-diagonal incidence curve. The remaining coordinate-ring normal-form argument is +stated separately in `BGS.Markoff.Incidence`. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- A nonunit squarefree element of a UFD does not become a square in its fraction field. -/ +lemma not_isSquare_algebraMap_of_squarefree_not_isUnit + {R Q : Type*} [CommRing R] [IsDomain R] [UniqueFactorizationMonoid R] + [Field Q] [Algebra R Q] [IsFractionRing R Q] + {f : R} (hsq : Squarefree f) (hf : ¬ IsUnit f) : + ¬ IsSquare (algebraMap R Q f) := by + rintro ⟨x, hx⟩ + obtain ⟨a, b, hab, hrepr⟩ := IsFractionRing.exists_reduced_fraction R x + have hbQ : algebraMap R Q (b : R) ≠ 0 := + IsFractionRing.to_map_ne_zero_of_mem_nonZeroDivisors b.2 + have hmap : + algebraMap R Q (f * (b : R) ^ 2) = algebraMap R Q (a ^ 2) := by + simp only [map_mul, map_pow] + rw [hx, ← hrepr, IsFractionRing.mk'_eq_div] + field_simp [hbQ] + have heq : f * (b : R) ^ 2 = a ^ 2 := + FaithfulSMul.algebraMap_injective R Q hmap + have hfa2 : f ∣ a ^ 2 := ⟨(b : R) ^ 2, heq.symm⟩ + have hfa : f ∣ a := (hsq.dvd_pow_iff_dvd (by norm_num : (2 : ℕ) ≠ 0)).mp hfa2 + obtain ⟨c, hac⟩ := hfa + have heq2 : (b : R) ^ 2 = f * c ^ 2 := by + apply mul_left_cancel₀ hsq.ne_zero + calc + f * (b : R) ^ 2 = a ^ 2 := heq + _ = (f * c) ^ 2 := by rw [hac] + _ = f * (f * c ^ 2) := by ring + have hfb2 : f ∣ (b : R) ^ 2 := ⟨c ^ 2, heq2⟩ + have hfb : f ∣ (b : R) := + (hsq.dvd_pow_iff_dvd (by norm_num : (2 : ℕ) ≠ 0)).mp hfb2 + exact hf (hab ⟨c, hac⟩ hfb) + +/-- The twofold-cover polynomial whose square root is the auxiliary `lambda` coordinate. -/ +def incidenceBranchPolynomial (a : K) : K[X] := + C (9 * a ^ 2 - 4) * X ^ 2 - C (4 * a ^ 2) + +lemma incidenceBranchPolynomial_natDegree {a : K} (hA : 9 * a ^ 2 - 4 ≠ 0) : + (incidenceBranchPolynomial a).natDegree = 2 := by + rw [incidenceBranchPolynomial, natDegree_sub_C, + natDegree_C_mul_X_pow 2 (9 * a ^ 2 - 4) hA] + +lemma incidenceBranchPolynomial_not_isUnit {a : K} (hA : 9 * a ^ 2 - 4 ≠ 0) : + ¬ IsUnit (incidenceBranchPolynomial a) := + not_isUnit_of_natDegree_pos _ <| by + rw [incidenceBranchPolynomial_natDegree hA] + norm_num + +/-- The branch polynomials for two parameters have an explicit constant Bezout combination. -/ +lemma incidenceBranchPolynomial_linearCombination (a b : K) : + C (9 * b ^ 2 - 4) * incidenceBranchPolynomial a - + C (9 * a ^ 2 - 4) * incidenceBranchPolynomial b = + C (16 * (a ^ 2 - b ^ 2)) := by + simp only [incidenceBranchPolynomial] + ring_nf + rw [← C_mul, ← C_neg, ← C_mul, ← C_add] + congr 1 + ring + +/-- Away from characteristic two, distinct parameter squares give coprime branch polynomials. -/ +lemma incidenceBranchPolynomial_isCoprime + (h2 : (2 : K) ≠ 0) {a b : K} (hab : a ^ 2 ≠ b ^ 2) : + IsCoprime (incidenceBranchPolynomial a) (incidenceBranchPolynomial b) := by + have h16 : (16 : K) ≠ 0 := by + rw [show (16 : K) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 h2 + have hc : (16 * (a ^ 2 - b ^ 2) : K) ≠ 0 := + mul_ne_zero h16 (sub_ne_zero.mpr hab) + let c : K := 16 * (a ^ 2 - b ^ 2) + refine ⟨C c⁻¹ * C (9 * b ^ 2 - 4), -(C c⁻¹ * C (9 * a ^ 2 - 4)), ?_⟩ + calc + (C c⁻¹ * C (9 * b ^ 2 - 4)) * incidenceBranchPolynomial a + + -(C c⁻¹ * C (9 * a ^ 2 - 4)) * incidenceBranchPolynomial b = + C c⁻¹ * + (C (9 * b ^ 2 - 4) * incidenceBranchPolynomial a - + C (9 * a ^ 2 - 4) * incidenceBranchPolynomial b) := by ring + _ = C c⁻¹ * C c := by rw [incidenceBranchPolynomial_linearCombination] + _ = 1 := by rw [← C_mul, inv_mul_cancel₀ hc, map_one] + +/-- Each branch polynomial is separable under exactly the nondegeneracy hypotheses used in the +incidence graph. -/ +lemma incidenceBranchPolynomial_separable + (h2 : (2 : K) ≠ 0) {a : K} (ha : a ≠ 0) (hA : 9 * a ^ 2 - 4 ≠ 0) : + (incidenceBranchPolynomial a).Separable := by + have h4 : (4 : K) ≠ 0 := by + rw [show (4 : K) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 h2 + have hquot : (4 * a ^ 2 / (9 * a ^ 2 - 4) : K) ≠ 0 := + div_ne_zero (mul_ne_zero h4 (pow_ne_zero 2 ha)) hA + have hsep : + (X ^ 2 - C (4 * a ^ 2 / (9 * a ^ 2 - 4)) : K[X]).Separable := + separable_X_pow_sub_C _ h2 hquot + have hunit : IsUnit (C (9 * a ^ 2 - 4) : K[X]) := + isUnit_C.mpr (isUnit_iff_ne_zero.mpr hA) + have heq : + incidenceBranchPolynomial a = + C (9 * a ^ 2 - 4) * + (X ^ 2 - C (4 * a ^ 2 / (9 * a ^ 2 - 4))) := by + simp only [incidenceBranchPolynomial, mul_sub] + rw [← C_mul] + rw [mul_div_cancel₀ (4 * a ^ 2) hA] + rw [heq] + exact hsep.unit_mul hunit + +/-- The product has no repeated irreducible factor. This is the polynomial shadow of the +independence of the two quadratic square classes. -/ +lemma incidenceBranchPolynomial_product_squarefree + (h2 : (2 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + Squarefree (incidenceBranchPolynomial a * incidenceBranchPolynomial b) := by + exact ((incidenceBranchPolynomial_separable h2 ha hA).mul + (incidenceBranchPolynomial_separable h2 hb hB) + (incidenceBranchPolynomial_isCoprime h2 hab)).squarefree + +/-- The three nonzero elements of the span of the two branch square classes are nonsquares in the +rational function field. Equivalently, the two classes are linearly independent over `ZMod 2`. -/ +lemma incidenceBranchSquareClasses_independent_ratFunc + (h2 : (2 : K) ≠ 0) {a b : K} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + ¬ IsSquare (algebraMap K[X] (RatFunc K) (incidenceBranchPolynomial a)) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) (incidenceBranchPolynomial b)) ∧ + ¬ IsSquare (algebraMap K[X] (RatFunc K) + (incidenceBranchPolynomial a * incidenceBranchPolynomial b)) := by + have hsqA := (incidenceBranchPolynomial_separable h2 ha hA).squarefree + have hsqB := (incidenceBranchPolynomial_separable h2 hb hB).squarefree + have hsqAB := incidenceBranchPolynomial_product_squarefree h2 ha hb hA hB hab + refine ⟨not_isSquare_algebraMap_of_squarefree_not_isUnit hsqA + (incidenceBranchPolynomial_not_isUnit hA), + not_isSquare_algebraMap_of_squarefree_not_isUnit hsqB + (incidenceBranchPolynomial_not_isUnit hB), ?_⟩ + apply not_isSquare_algebraMap_of_squarefree_not_isUnit hsqAB + intro hunit + exact incidenceBranchPolynomial_not_isUnit hA (IsUnit.mul_iff.mp hunit).1 + +/-- Equality of the squared branch locations forces equality of the parameter squares. -/ +lemma incidenceBranchLocation_injective + (h2 : (2 : K) ≠ 0) {a b : K} + (h : a ^ 2 * (9 * b ^ 2 - 4) = b ^ 2 * (9 * a ^ 2 - 4)) : + a ^ 2 = b ^ 2 := by + have h4 : (4 : K) ≠ 0 := by + rw [show (4 : K) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 h2 + apply (mul_left_cancel₀ h4) + calc + 4 * a ^ 2 = -(a ^ 2 * (9 * b ^ 2 - 4) - 9 * a ^ 2 * b ^ 2) := by ring + _ = -(b ^ 2 * (9 * a ^ 2 - 4) - 9 * a ^ 2 * b ^ 2) := by rw [h] + _ = 4 * b ^ 2 := by ring + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean new file mode 100644 index 0000000000..5280becefc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean @@ -0,0 +1,692 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers + +/-! +# The normalized incidence graph and its parabolic vertices + +The published proof of Proposition 8 dismisses the case `p ≡ 1 (mod 4)` as simpler +because of the parabolic lines. This file records the missing argument without folding +normalized trace coordinates back into the original Markoff coordinates. + +The key fact is stronger than mere connectivity: after choosing `i² = -1`, a fiber whose +normalized coordinate is `2` or `-2` meets every fiber on either different coordinate axis. +-/ + +namespace BGS.Markoff + +universe u + +/-- The three coordinate axes used to index normalized conic fibers. -/ +inductive NormalizedCoordinateAxis + | first + | second + | third + deriving DecidableEq, Fintype, Repr + +/-- A normalized conic fiber, indexed without identifying normalized and original coordinates. -/ +def normalizedFiberAt {R : Type u} [CommRing R] : + NormalizedCoordinateAxis → R → Set (NormalizedPoint R) + | .first, a => normalizedFiber1 a + | .second, a => normalizedFiber2 a + | .third, a => normalizedFiber3 a + +/-- The action of swapping the first two coordinates on axis labels. -/ +def normalizedSwap12Axis : NormalizedCoordinateAxis → NormalizedCoordinateAxis + | .first => .second + | .second => .first + | .third => .third + +/-- The action of swapping the last two coordinates on axis labels. -/ +def normalizedSwap23Axis : NormalizedCoordinateAxis → NormalizedCoordinateAxis + | .first => .first + | .second => .third + | .third => .second + +theorem normalizedSwap12_mem_fiberAt + {R : Type u} [CommRing R] {axis : NormalizedCoordinateAxis} {a : R} + {x : NormalizedPoint R} (hx : x ∈ normalizedFiberAt axis a) : + normalizedSwap12 x ∈ normalizedFiberAt (normalizedSwap12Axis axis) a := by + rcases axis with _ | _ | _ + all_goals + refine ⟨?_, hx.2⟩ + change normalizedPolynomial (normalizedSwap12 x) = 0 + rw [normalizedPolynomial_swap12] + exact hx.1 + +theorem normalizedSwap23_mem_fiberAt + {R : Type u} [CommRing R] {axis : NormalizedCoordinateAxis} {a : R} + {x : NormalizedPoint R} (hx : x ∈ normalizedFiberAt axis a) : + normalizedSwap23 x ∈ normalizedFiberAt (normalizedSwap23Axis axis) a := by + rcases axis with _ | _ | _ + all_goals + refine ⟨?_, hx.2⟩ + change normalizedPolynomial (normalizedSwap23 x) = 0 + rw [normalizedPolynomial_swap23] + exact hx.1 + +/-- Two normalized conic fibers meet when their set-theoretic intersection is nonempty. -/ +def NormalizedFibersMeet {R : Type u} (s t : Set (NormalizedPoint R)) : Prop := + (s ∩ t).Nonempty + +theorem normalizedFibersMeet_comm {R : Type u} {s t : Set (NormalizedPoint R)} : + NormalizedFibersMeet s t ↔ NormalizedFibersMeet t s := by + simp only [NormalizedFibersMeet, Set.inter_comm] + +/-- Coordinate swapping transports a meeting of normalized fibers. -/ +theorem normalizedFibersMeet_swap12 + {R : Type u} [CommRing R] + {axis other : NormalizedCoordinateAxis} {a b : R} + (h : NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt other b)) : + NormalizedFibersMeet + (normalizedFiberAt (normalizedSwap12Axis axis) a) + (normalizedFiberAt (normalizedSwap12Axis other) b) := by + rcases h with ⟨x, hx, hy⟩ + exact ⟨normalizedSwap12 x, normalizedSwap12_mem_fiberAt hx, + normalizedSwap12_mem_fiberAt hy⟩ + +/-- Swapping the last two coordinates transports a meeting of normalized fibers. -/ +theorem normalizedFibersMeet_swap23 + {R : Type u} [CommRing R] + {axis other : NormalizedCoordinateAxis} {a b : R} + (h : NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt other b)) : + NormalizedFibersMeet + (normalizedFiberAt (normalizedSwap23Axis axis) a) + (normalizedFiberAt (normalizedSwap23Axis other) b) := by + rcases h with ⟨x, hx, hy⟩ + exact ⟨normalizedSwap23 x, normalizedSwap23_mem_fiberAt hx, + normalizedSwap23_mem_fiberAt hy⟩ + +/-- The intrinsic normalized-coordinate condition for a parabolic trace. -/ +def IsNormalizedParabolicCoordinate {R : Type u} [OfNat R 4] [Pow R ℕ] + (a : R) : Prop := + a ^ 2 = 4 + +/-- The normalized coordinates excluded by the existing admissible-incidence argument. -/ +def IsNormalizedExceptionalCoordinate {R : Type u} [OfNat R 0] [OfNat R 4] [Pow R ℕ] + (a : R) : Prop := + a = 0 ∨ IsNormalizedParabolicCoordinate a + +/-- Divide a normalized trace coordinate by three without identifying its type with an +original Markoff coordinate. -/ +def unscaleNormalizedCoordinate {R : Type u} [CommRing R] [Invertible (3 : R)] + (u : R) : R := + ⅟(3 : R) * u + +@[simp] +theorem three_mul_unscaleNormalizedCoordinate + {R : Type u} [CommRing R] [Invertible (3 : R)] (u : R) : + 3 * unscaleNormalizedCoordinate u = u := by + simp [unscaleNormalizedCoordinate, ← mul_assoc] + +@[simp] +theorem unscaleNormalizedCoordinate_three_mul + {R : Type u} [CommRing R] [Invertible (3 : R)] (a : R) : + unscaleNormalizedCoordinate (3 * a) = a := by + simp [unscaleNormalizedCoordinate, ← mul_assoc] + +/-- Original-coordinate admissibility is exactly the complement of the zero and parabolic +normalized trace values. -/ +theorem isAdmissibleCoordinate_unscaleNormalizedCoordinate_iff + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] (u : ZMod p) : + IsAdmissibleCoordinate (unscaleNormalizedCoordinate u) ↔ + ¬ IsNormalizedExceptionalCoordinate u := by + rw [show (¬ IsNormalizedExceptionalCoordinate u) ↔ + u ≠ 0 ∧ ¬ IsNormalizedParabolicCoordinate u by + simp [IsNormalizedExceptionalCoordinate]] + simp only [IsAdmissibleCoordinate, IsNormalizedParabolicCoordinate, + three_mul_unscaleNormalizedCoordinate] + constructor + · rintro ⟨hu, hsquare⟩ + refine ⟨?_, hsquare⟩ + intro hzero + apply hu + simp [hzero, unscaleNormalizedCoordinate] + · rintro ⟨hu, hsquare⟩ + refine ⟨?_, hsquare⟩ + intro hzero + apply hu + calc + u = 3 * unscaleNormalizedCoordinate u := + (three_mul_unscaleNormalizedCoordinate u).symm + _ = 0 := by rw [hzero, mul_zero] + +/-- Scaling a meeting of an original first-axis and third-axis fiber gives the corresponding +meeting in normalized trace coordinates. -/ +theorem normalizedFibersMeet_fiber1_fiber3_of_original + {R : Type u} [Field R] [Invertible (3 : R)] {a c : R} + (h : FibersMeet (fiber1 a) (fiber3 c)) : + NormalizedFibersMeet (normalizedFiber1 (3 * a)) (normalizedFiber3 (3 * c)) := by + rcases h with ⟨x, hx1, hx3⟩ + have hsurface : IsNormalizedMarkoff (toNormalized x) := + (isNormalizedMarkoff_toNormalized_iff x).2 hx1.1 + exact ⟨toNormalized x, + ⟨hsurface, by simp [toNormalized, hx1.2]⟩, + ⟨hsurface, by simp [toNormalized, hx3.2]⟩⟩ + +/-- Scaling a meeting of an original second-axis and third-axis fiber gives the corresponding +meeting in normalized trace coordinates. -/ +theorem normalizedFibersMeet_fiber2_fiber3_of_original + {R : Type u} [Field R] [Invertible (3 : R)] {b c : R} + (h : FibersMeet (fiber2 b) (fiber3 c)) : + NormalizedFibersMeet (normalizedFiber2 (3 * b)) (normalizedFiber3 (3 * c)) := by + rcases h with ⟨x, hx2, hx3⟩ + have hsurface : IsNormalizedMarkoff (toNormalized x) := + (isNormalizedMarkoff_toNormalized_iff x).2 hx2.1 + exact ⟨toNormalized x, + ⟨hsurface, by simp [toNormalized, hx2.2]⟩, + ⟨hsurface, by simp [toNormalized, hx3.2]⟩⟩ + +/-- The normalized, type-distinct form of the existing admissible bridge for the first two +axes. -/ +def NormalizedAdmissibleBridgeAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ u v : ZMod p, + ¬ IsNormalizedExceptionalCoordinate u → + ¬ IsNormalizedExceptionalCoordinate v → + ∃ w : ZMod p, + ¬ IsNormalizedExceptionalCoordinate w ∧ + NormalizedFibersMeet (normalizedFiber1 u) (normalizedFiber3 w) ∧ + NormalizedFibersMeet (normalizedFiber2 v) (normalizedFiber3 w) + +/-- Transport the proved original-coordinate admissible bridge through the explicit scaling +equivalence. -/ +theorem normalizedAdmissibleBridgeAt_of_incidenceBridgeAt + (p : ℕ) (hp : p.Prime) [Invertible (3 : ZMod p)] + (hbridge : IncidenceBridgeAt p hp) : NormalizedAdmissibleBridgeAt p hp := by + letI : Fact p.Prime := ⟨hp⟩ + intro u v hu hv + let a := unscaleNormalizedCoordinate u + let b := unscaleNormalizedCoordinate v + have ha : IsAdmissibleCoordinate a := + (isAdmissibleCoordinate_unscaleNormalizedCoordinate_iff u).2 hu + have hb : IsAdmissibleCoordinate b := + (isAdmissibleCoordinate_unscaleNormalizedCoordinate_iff v).2 hv + obtain ⟨c, hc, hac, hbc⟩ := hbridge a b ha hb + have hw : ¬ IsNormalizedExceptionalCoordinate (3 * c) := by + apply (isAdmissibleCoordinate_unscaleNormalizedCoordinate_iff (3 * c)).1 + simpa using hc + refine ⟨3 * c, hw, ?_, ?_⟩ + · simpa [a] using normalizedFibersMeet_fiber1_fiber3_of_original hac + · simpa [b] using normalizedFibersMeet_fiber2_fiber3_of_original hbc + +/-- The normalized admissible bridge for primes congruent to one modulo four. -/ +theorem normalizedAdmissibleBridge_mod_one + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → p % 4 = 1 → + NormalizedAdmissibleBridgeAt p hp := by + obtain ⟨p0, hbridge⟩ := incidenceBridge_mod_one_admissible hHasse + refine ⟨p0, ?_⟩ + intro p hp hpLarge hmod + letI : Fact p.Prime := ⟨hp⟩ + have hpThree : 3 < p := by + by_contra h + have hpLe : p ≤ 3 := by omega + have hpTwo : 2 ≤ p := hp.two_le + have hpCases : p = 2 ∨ p = 3 := by omega + rcases hpCases with rfl | rfl <;> norm_num at hmod + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hpThree) + exact normalizedAdmissibleBridgeAt_of_incidenceBridgeAt p hp + (hbridge p hp hpLarge hmod) + +/-- The graph-level admissible bridge, with coordinate permutations made explicit. -/ +def NormalizedAdmissibleGraphBridgeAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ (axis other : NormalizedCoordinateAxis) (u v : ZMod p), + ¬ IsNormalizedExceptionalCoordinate u → + ¬ IsNormalizedExceptionalCoordinate v → + ∃ middle : NormalizedCoordinateAxis, ∃ w : ZMod p, + middle ≠ axis ∧ middle ≠ other ∧ + NormalizedFibersMeet (normalizedFiberAt axis u) (normalizedFiberAt middle w) ∧ + NormalizedFibersMeet (normalizedFiberAt other v) (normalizedFiberAt middle w) + +/-- The fixed-axis admissible bridge implies the full graph-level bridge. Every coordinate +permutation is applied to the actual intersection witness. -/ +theorem normalizedAdmissibleGraphBridgeAt_of_fixedAxes + {p : ℕ} {hp : p.Prime} + (hbridge : NormalizedAdmissibleBridgeAt p hp) : + NormalizedAdmissibleGraphBridgeAt p hp := by + letI : Fact p.Prime := ⟨hp⟩ + intro axis other u v hu hv + rcases axis with _ | _ | _ <;> rcases other with _ | _ | _ + · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv + refine ⟨.third, w, by decide, by decide, h13, ?_⟩ + simpa [normalizedSwap12Axis] using + normalizedFibersMeet_swap12 (axis := .second) (other := .third) h23 + · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv + exact ⟨.third, w, by decide, by decide, h13, h23⟩ + · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv + refine ⟨.second, w, by decide, by decide, ?_, ?_⟩ + · simpa [normalizedSwap23Axis] using + normalizedFibersMeet_swap23 (axis := .first) (other := .third) h13 + · simpa [normalizedSwap23Axis] using + normalizedFibersMeet_swap23 (axis := .second) (other := .third) h23 + · obtain ⟨w, hw, h13, h23⟩ := hbridge v u hv hu + exact ⟨.third, w, by decide, by decide, h23, h13⟩ + · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv + refine ⟨.third, w, by decide, by decide, ?_, h23⟩ + simpa [normalizedSwap12Axis] using + normalizedFibersMeet_swap12 (axis := .first) (other := .third) h13 + · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv + refine ⟨.first, w, by decide, by decide, ?_, ?_⟩ + · simpa [normalizedSwap12Axis, normalizedSwap23Axis] using + normalizedFibersMeet_swap12 (axis := .first) (other := .second) + (normalizedFibersMeet_swap23 (axis := .first) (other := .third) h13) + · simpa [normalizedSwap12Axis, normalizedSwap23Axis] using + normalizedFibersMeet_swap12 (axis := .third) (other := .second) + (normalizedFibersMeet_swap23 (axis := .second) (other := .third) h23) + · obtain ⟨w, hw, h13, h23⟩ := hbridge v u hv hu + refine ⟨.second, w, by decide, by decide, ?_, ?_⟩ + · simpa [normalizedSwap23Axis] using + normalizedFibersMeet_swap23 (axis := .second) (other := .third) h23 + · simpa [normalizedSwap23Axis] using + normalizedFibersMeet_swap23 (axis := .first) (other := .third) h13 + · obtain ⟨w, hw, h13, h23⟩ := hbridge v u hv hu + refine ⟨.first, w, by decide, by decide, ?_, ?_⟩ + · simpa [normalizedSwap12Axis, normalizedSwap23Axis] using + normalizedFibersMeet_swap12 (axis := .third) (other := .second) + (normalizedFibersMeet_swap23 (axis := .second) (other := .third) h23) + · simpa [normalizedSwap12Axis, normalizedSwap23Axis] using + normalizedFibersMeet_swap12 (axis := .first) (other := .second) + (normalizedFibersMeet_swap23 (axis := .first) (other := .third) h13) + · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv + refine ⟨.first, w, by decide, by decide, ?_, ?_⟩ + · simpa [normalizedSwap12Axis, normalizedSwap23Axis] using + normalizedFibersMeet_swap12 (axis := .third) (other := .second) + (normalizedFibersMeet_swap23 (axis := .second) (other := .third) + (normalizedFibersMeet_swap12 (axis := .first) (other := .third) h13)) + · simpa [normalizedSwap12Axis, normalizedSwap23Axis] using + normalizedFibersMeet_swap12 (axis := .third) (other := .second) + (normalizedFibersMeet_swap23 (axis := .second) (other := .third) h23) + +/-- The graph-level admissible bridge for all sufficiently large primes congruent to one modulo +four. -/ +theorem normalizedAdmissibleGraphBridge_mod_one + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → p % 4 = 1 → + NormalizedAdmissibleGraphBridgeAt p hp := by + obtain ⟨p0, hbridge⟩ := normalizedAdmissibleBridge_mod_one hHasse + exact ⟨p0, fun p hp hpLarge hmod => + normalizedAdmissibleGraphBridgeAt_of_fixedAxes (hbridge p hp hpLarge hmod)⟩ + +private theorem parabolic_eq_two_or_neg_two + {R : Type u} [CommRing R] [NoZeroDivisors R] {a : R} + (ha : IsNormalizedParabolicCoordinate a) : a = 2 ∨ a = -2 := by + apply sq_eq_sq_iff_eq_or_eq_neg.mp + calc + a ^ 2 = 4 := ha + _ = (2 : R) ^ 2 := by norm_num + +/-- The trace-`2` fiber on the first axis meets every second-axis fiber. -/ +theorem normalizedFiber1_two_meets_fiber2 + {R : Type u} [CommRing R] [NoZeroDivisors R] (i b : R) (hi : i ^ 2 = -1) : + NormalizedFibersMeet (normalizedFiber1 (2 : R)) (normalizedFiber2 b) := by + let x := parabolicLineAtTwo i b + have hx : IsNormalizedMarkoff x := by + change IsNormalizedMarkoff (⟨2, b, b + 2 * i⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_two_iff_on_parabolic_lines hi] + exact Or.inl rfl + exact ⟨x, ⟨hx, rfl⟩, ⟨hx, rfl⟩⟩ + +/-- The trace-`-2` fiber on the first axis meets every second-axis fiber. -/ +theorem normalizedFiber1_neg_two_meets_fiber2 + {R : Type u} [CommRing R] [NoZeroDivisors R] (i b : R) (hi : i ^ 2 = -1) : + NormalizedFibersMeet (normalizedFiber1 (-2 : R)) (normalizedFiber2 b) := by + let x := parabolicLineAtNegTwo i b + have hx : IsNormalizedMarkoff x := by + change IsNormalizedMarkoff (⟨-2, b, -b + 2 * i⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_neg_two_iff_on_parabolic_lines hi] + exact Or.inl rfl + exact ⟨x, ⟨hx, rfl⟩, ⟨hx, rfl⟩⟩ + +/-- A parabolic first-axis fiber meets every second-axis fiber. -/ +theorem normalizedFiber1_parabolic_meets_fiber2 + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) {a : R} (ha : IsNormalizedParabolicCoordinate a) + (b : R) : + NormalizedFibersMeet (normalizedFiber1 a) (normalizedFiber2 b) := by + rcases parabolic_eq_two_or_neg_two ha with rfl | rfl + · exact normalizedFiber1_two_meets_fiber2 i b hi + · exact normalizedFiber1_neg_two_meets_fiber2 i b hi + +/-- The trace-`2` fiber on the first axis meets every third-axis fiber. -/ +theorem normalizedFiber1_two_meets_fiber3 + {R : Type u} [CommRing R] [NoZeroDivisors R] (i c : R) (hi : i ^ 2 = -1) : + NormalizedFibersMeet (normalizedFiber1 (2 : R)) (normalizedFiber3 c) := by + let x := parabolicLineAtTwo i (c - 2 * i) + have hx : IsNormalizedMarkoff x := by + change IsNormalizedMarkoff + (⟨2, c - 2 * i, (c - 2 * i) + 2 * i⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_two_iff_on_parabolic_lines hi] + exact Or.inl rfl + refine ⟨x, ⟨hx, rfl⟩, hx, ?_⟩ + simp [x, parabolicLineAtTwo] + +/-- The trace-`-2` fiber on the first axis meets every third-axis fiber. -/ +theorem normalizedFiber1_neg_two_meets_fiber3 + {R : Type u} [CommRing R] [NoZeroDivisors R] (i c : R) (hi : i ^ 2 = -1) : + NormalizedFibersMeet (normalizedFiber1 (-2 : R)) (normalizedFiber3 c) := by + let x := parabolicLineAtNegTwo i (2 * i - c) + have hx : IsNormalizedMarkoff x := by + change IsNormalizedMarkoff + (⟨-2, 2 * i - c, -(2 * i - c) + 2 * i⟩ : NormalizedPoint R) + rw [isNormalizedMarkoff_at_neg_two_iff_on_parabolic_lines hi] + exact Or.inl rfl + refine ⟨x, ⟨hx, rfl⟩, hx, ?_⟩ + simp [x, parabolicLineAtNegTwo] + +/-- A parabolic first-axis fiber meets every third-axis fiber. -/ +theorem normalizedFiber1_parabolic_meets_fiber3 + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) {a : R} (ha : IsNormalizedParabolicCoordinate a) + (c : R) : + NormalizedFibersMeet (normalizedFiber1 a) (normalizedFiber3 c) := by + rcases parabolic_eq_two_or_neg_two ha with rfl | rfl + · exact normalizedFiber1_two_meets_fiber3 i c hi + · exact normalizedFiber1_neg_two_meets_fiber3 i c hi + +/-- When `i² = -1`, the zero fiber on the first axis meets every second-axis fiber. -/ +theorem normalizedFiber1_zero_meets_fiber2 + {R : Type u} [CommRing R] (i b : R) (hi : i ^ 2 = -1) : + NormalizedFibersMeet (normalizedFiber1 (0 : R)) (normalizedFiber2 b) := by + let x : NormalizedPoint R := ⟨0, b, i * b⟩ + have hx : IsNormalizedMarkoff x := by + simp only [IsNormalizedMarkoff, normalizedPolynomial, x] + rw [mul_pow, hi] + ring + exact ⟨x, ⟨hx, rfl⟩, ⟨hx, rfl⟩⟩ + +/-- When `i² = -1`, the zero fiber on the first axis meets every third-axis fiber. -/ +theorem normalizedFiber1_zero_meets_fiber3 + {R : Type u} [CommRing R] (i c : R) (hi : i ^ 2 = -1) : + NormalizedFibersMeet (normalizedFiber1 (0 : R)) (normalizedFiber3 c) := by + let x : NormalizedPoint R := ⟨0, i * c, c⟩ + have hx : IsNormalizedMarkoff x := by + simp only [IsNormalizedMarkoff, normalizedPolynomial, x] + rw [mul_pow, hi] + ring + exact ⟨x, ⟨hx, rfl⟩, ⟨hx, rfl⟩⟩ + +/-- A parabolic fiber on any axis meets every fiber on a different axis. -/ +theorem normalizedParabolicFiber_meets_distinctAxis + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) + {axis other : NormalizedCoordinateAxis} (haxis : axis ≠ other) + {a : R} (ha : IsNormalizedParabolicCoordinate a) (b : R) : + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt other b) := by + rcases axis with _ | _ | _ <;> rcases other with _ | _ | _ + · exact (haxis rfl).elim + · exact normalizedFiber1_parabolic_meets_fiber2 i hi ha b + · exact normalizedFiber1_parabolic_meets_fiber3 i hi ha b + · -- Swap the first two coordinates in a first/second-axis witness. + rcases normalizedFiber1_parabolic_meets_fiber2 i hi ha b with ⟨x, hx1, hx2⟩ + let y := normalizedSwap12 x + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 x) = 0 + rw [normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx2.2⟩⟩ + · exact (haxis rfl).elim + · -- Swap the first two coordinates in the preceding first/third-axis witness. + rcases normalizedFiber1_parabolic_meets_fiber3 i hi ha b with ⟨x, hx1, hx3⟩ + let y := normalizedSwap12 x + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 x) = 0 + rw [normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx3.2⟩⟩ + · -- Swap the first and third coordinates in a first/third-axis witness. + rcases normalizedFiber1_parabolic_meets_fiber3 i hi ha b with ⟨x, hx1, hx3⟩ + let y := normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x)) + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x))) = 0 + rw [normalizedPolynomial_swap12, normalizedPolynomial_swap23, + normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx3.2⟩⟩ + · -- Swap the first and third coordinates in a first/second-axis witness. + rcases normalizedFiber1_parabolic_meets_fiber2 i hi ha b with ⟨x, hx1, hx2⟩ + let y := normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x)) + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x))) = 0 + rw [normalizedPolynomial_swap12, normalizedPolynomial_swap23, + normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx2.2⟩⟩ + · exact (haxis rfl).elim + +/-- A zero-coordinate fiber meets every fiber on a different axis when `-1` is a square. -/ +theorem normalizedZeroFiber_meets_distinctAxis + {R : Type u} [CommRing R] + (i : R) (hi : i ^ 2 = -1) + {axis other : NormalizedCoordinateAxis} (haxis : axis ≠ other) (b : R) : + NormalizedFibersMeet (normalizedFiberAt axis 0) (normalizedFiberAt other b) := by + rcases axis with _ | _ | _ <;> rcases other with _ | _ | _ + · exact (haxis rfl).elim + · exact normalizedFiber1_zero_meets_fiber2 i b hi + · exact normalizedFiber1_zero_meets_fiber3 i b hi + · rcases normalizedFiber1_zero_meets_fiber2 i b hi with ⟨x, hx1, hx2⟩ + let y := normalizedSwap12 x + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 x) = 0 + rw [normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx2.2⟩⟩ + · exact (haxis rfl).elim + · rcases normalizedFiber1_zero_meets_fiber3 i b hi with ⟨x, hx1, hx3⟩ + let y := normalizedSwap12 x + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 x) = 0 + rw [normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx3.2⟩⟩ + · rcases normalizedFiber1_zero_meets_fiber3 i b hi with ⟨x, hx1, hx3⟩ + let y := normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x)) + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x))) = 0 + rw [normalizedPolynomial_swap12, normalizedPolynomial_swap23, + normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx3.2⟩⟩ + · rcases normalizedFiber1_zero_meets_fiber2 i b hi with ⟨x, hx1, hx2⟩ + let y := normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x)) + have hy : IsNormalizedMarkoff y := by + change normalizedPolynomial (normalizedSwap12 (normalizedSwap23 (normalizedSwap12 x))) = 0 + rw [normalizedPolynomial_swap12, normalizedPolynomial_swap23, + normalizedPolynomial_swap12] + exact hx1.1 + exact ⟨y, ⟨hy, hx1.2⟩, ⟨hy, hx2.2⟩⟩ + · exact (haxis rfl).elim + +/-- Every coordinate excluded by admissibility meets every fiber on a different axis when +`-1` is a square. -/ +theorem normalizedExceptionalFiber_meets_distinctAxis + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) + {axis other : NormalizedCoordinateAxis} (haxis : axis ≠ other) + {a : R} (ha : IsNormalizedExceptionalCoordinate a) (b : R) : + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt other b) := by + rcases ha with rfl | ha + · exact normalizedZeroFiber_meets_distinctAxis i hi haxis b + · exact normalizedParabolicFiber_meets_distinctAxis i hi haxis ha b + +/-- If one vertex is parabolic and the other vertex is on the same axis, any point of the +other fiber supplies a common neighbor on either different axis. -/ +theorem normalizedParabolicFiber_commonNeighbor_sameAxis + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) (axis other : NormalizedCoordinateAxis) + (haxis : axis ≠ other) {a b : R} (ha : IsNormalizedParabolicCoordinate a) + (hb : (normalizedFiberAt axis b).Nonempty) : + ∃ c : R, + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt other c) ∧ + NormalizedFibersMeet (normalizedFiberAt axis b) (normalizedFiberAt other c) := by + rcases hb with ⟨x, hx⟩ + rcases axis with _ | _ | _ <;> rcases other with _ | _ | _ + · exact (haxis rfl).elim + · refine ⟨x.u2, normalizedParabolicFiber_meets_distinctAxis i hi haxis ha x.u2, ?_⟩ + exact ⟨x, hx, ⟨hx.1, rfl⟩⟩ + · refine ⟨x.u3, normalizedParabolicFiber_meets_distinctAxis i hi haxis ha x.u3, ?_⟩ + exact ⟨x, hx, ⟨hx.1, rfl⟩⟩ + · refine ⟨x.u1, normalizedParabolicFiber_meets_distinctAxis i hi haxis ha x.u1, ?_⟩ + exact ⟨x, hx, ⟨hx.1, rfl⟩⟩ + · exact (haxis rfl).elim + · refine ⟨x.u3, normalizedParabolicFiber_meets_distinctAxis i hi haxis ha x.u3, ?_⟩ + exact ⟨x, hx, ⟨hx.1, rfl⟩⟩ + · refine ⟨x.u1, normalizedParabolicFiber_meets_distinctAxis i hi haxis ha x.u1, ?_⟩ + exact ⟨x, hx, ⟨hx.1, rfl⟩⟩ + · refine ⟨x.u2, normalizedParabolicFiber_meets_distinctAxis i hi haxis ha x.u2, ?_⟩ + exact ⟨x, hx, ⟨hx.1, rfl⟩⟩ + · exact (haxis rfl).elim + +/-- A deterministic choice of an axis different from each of two supplied axes. -/ +def normalizedBridgeAxis : + NormalizedCoordinateAxis → NormalizedCoordinateAxis → NormalizedCoordinateAxis + | .first, .first => .second + | .first, .second => .third + | .first, .third => .second + | .second, .first => .third + | .second, .second => .first + | .second, .third => .first + | .third, .first => .second + | .third, .second => .first + | .third, .third => .first + +theorem normalizedBridgeAxis_ne_left (axis other : NormalizedCoordinateAxis) : + normalizedBridgeAxis axis other ≠ axis := by + cases axis <;> cases other <;> decide + +theorem normalizedBridgeAxis_ne_right (axis other : NormalizedCoordinateAxis) : + normalizedBridgeAxis axis other ≠ other := by + cases axis <;> cases other <;> decide + +/-- A nonempty fiber meets some fiber on every different axis: use the corresponding +coordinate of a point already in the first fiber. -/ +theorem normalizedFiber_meets_some_fiber_on_distinctAxis + {R : Type u} [CommRing R] + {axis other : NormalizedCoordinateAxis} (haxis : axis ≠ other) {b : R} + (hb : (normalizedFiberAt axis b).Nonempty) : + ∃ c : R, NormalizedFibersMeet (normalizedFiberAt axis b) (normalizedFiberAt other c) := by + rcases hb with ⟨x, hx⟩ + rcases axis with _ | _ | _ <;> rcases other with _ | _ | _ + · exact (haxis rfl).elim + · exact ⟨x.u2, x, hx, ⟨hx.1, rfl⟩⟩ + · exact ⟨x.u3, x, hx, ⟨hx.1, rfl⟩⟩ + · exact ⟨x.u1, x, hx, ⟨hx.1, rfl⟩⟩ + · exact (haxis rfl).elim + · exact ⟨x.u3, x, hx, ⟨hx.1, rfl⟩⟩ + · exact ⟨x.u1, x, hx, ⟨hx.1, rfl⟩⟩ + · exact ⟨x.u2, x, hx, ⟨hx.1, rfl⟩⟩ + · exact (haxis rfl).elim + +/-- The complete parabolic bridge suppressed by the published proof. + +For a parabolic vertex on `axis` and any nonempty vertex on `other`, this produces a common +neighbor on an axis different from both. Thus all interactions involving a parabolic vertex +have graph distance at most two; no admissibility hypothesis is imposed on the other vertex. -/ +theorem normalizedParabolicFiber_has_commonNeighbor + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) + (axis other : NormalizedCoordinateAxis) {a b : R} + (ha : IsNormalizedParabolicCoordinate a) + (hb : (normalizedFiberAt other b).Nonempty) : + ∃ middle : NormalizedCoordinateAxis, ∃ c : R, + middle ≠ axis ∧ middle ≠ other ∧ + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt middle c) ∧ + NormalizedFibersMeet (normalizedFiberAt other b) (normalizedFiberAt middle c) := by + let middle := normalizedBridgeAxis axis other + have hleft : middle ≠ axis := normalizedBridgeAxis_ne_left axis other + have hright : middle ≠ other := normalizedBridgeAxis_ne_right axis other + obtain ⟨c, hc⟩ := normalizedFiber_meets_some_fiber_on_distinctAxis hright.symm hb + exact ⟨middle, c, hleft, hright, + normalizedParabolicFiber_meets_distinctAxis i hi hleft.symm ha c, hc⟩ + +/-- The same graph-level bridge for every coordinate omitted by the admissible argument, +including the zero-coordinate lines that also occur when `-1` is a square. -/ +theorem normalizedExceptionalFiber_has_commonNeighbor + {R : Type u} [CommRing R] [NoZeroDivisors R] + (i : R) (hi : i ^ 2 = -1) + (axis other : NormalizedCoordinateAxis) {a b : R} + (ha : IsNormalizedExceptionalCoordinate a) + (hb : (normalizedFiberAt other b).Nonempty) : + ∃ middle : NormalizedCoordinateAxis, ∃ c : R, + middle ≠ axis ∧ middle ≠ other ∧ + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt middle c) ∧ + NormalizedFibersMeet (normalizedFiberAt other b) (normalizedFiberAt middle c) := by + let middle := normalizedBridgeAxis axis other + have hleft : middle ≠ axis := normalizedBridgeAxis_ne_left axis other + have hright : middle ≠ other := normalizedBridgeAxis_ne_right axis other + obtain ⟨c, hc⟩ := normalizedFiber_meets_some_fiber_on_distinctAxis hright.symm hb + exact ⟨middle, c, hleft, hright, + normalizedExceptionalFiber_meets_distinctAxis i hi hleft.symm ha c, hc⟩ + +/-- For primes congruent to one modulo four, every parabolic incidence vertex has a common +neighbor with every nonempty incidence vertex, uniformly over all coordinate axes. -/ +theorem normalizedParabolicIncidenceBridge_mod_one + (p : ℕ) [Fact p.Prime] (hmod : p % 4 = 1) : + ∀ (axis other : NormalizedCoordinateAxis) {a b : ZMod p}, + IsNormalizedParabolicCoordinate a → + (normalizedFiberAt other b).Nonempty → + ∃ middle : NormalizedCoordinateAxis, ∃ c : ZMod p, + middle ≠ axis ∧ middle ≠ other ∧ + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt middle c) ∧ + NormalizedFibersMeet (normalizedFiberAt other b) (normalizedFiberAt middle c) := by + obtain ⟨i, hi, _, _⟩ := exists_parabolic_line_decomposition_of_mod_four_eq_one p hmod + intro axis other a b ha hb + exact normalizedParabolicFiber_has_commonNeighbor i hi axis other ha hb + +/-- At primes congruent to one modulo four, the zero and parabolic fibers omitted by the +admissible incidence argument all have distance at most two from every nonempty fiber. -/ +theorem normalizedExceptionalIncidenceBridge_mod_one + (p : ℕ) [Fact p.Prime] (hmod : p % 4 = 1) : + ∀ (axis other : NormalizedCoordinateAxis) {a b : ZMod p}, + IsNormalizedExceptionalCoordinate a → + (normalizedFiberAt other b).Nonempty → + ∃ middle : NormalizedCoordinateAxis, ∃ c : ZMod p, + middle ≠ axis ∧ middle ≠ other ∧ + NormalizedFibersMeet (normalizedFiberAt axis a) (normalizedFiberAt middle c) ∧ + NormalizedFibersMeet (normalizedFiberAt other b) (normalizedFiberAt middle c) := by + obtain ⟨i, hi, _, _⟩ := exists_parabolic_line_decomposition_of_mod_four_eq_one p hmod + intro axis other a b ha hb + exact normalizedExceptionalFiber_has_commonNeighbor i hi axis other ha hb + +/-- A full-surface fiber bridge. This does not yet remove the normalized origin from +intersection witnesses, so it is intentionally not called the punctured incidence graph. -/ +def NormalizedFullSurfaceFiberBridgeAt (p : ℕ) (hp : p.Prime) : Prop := + letI : Fact p.Prime := ⟨hp⟩ + ∀ (axis other : NormalizedCoordinateAxis) (u v : ZMod p), + (normalizedFiberAt axis u).Nonempty → + (normalizedFiberAt other v).Nonempty → + ∃ middle : NormalizedCoordinateAxis, ∃ w : ZMod p, + middle ≠ axis ∧ middle ≠ other ∧ + NormalizedFibersMeet (normalizedFiberAt axis u) (normalizedFiberAt middle w) ∧ + NormalizedFibersMeet (normalizedFiberAt other v) (normalizedFiberAt middle w) + +/-- The complete incidence bridge for sufficiently large primes congruent to one modulo four. +The proof combines the transported admissible bridge with the separately proved zero and +parabolic line geometry. -/ +theorem normalizedFullSurfaceFiberBridge_mod_one + (hHasse : ZModLegendrePointCardHasseBound) : + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → p % 4 = 1 → + NormalizedFullSurfaceFiberBridgeAt p hp := by + obtain ⟨p0, hadmissible⟩ := normalizedAdmissibleGraphBridge_mod_one hHasse + refine ⟨p0, ?_⟩ + intro p hp hpLarge hmod + letI : Fact p.Prime := ⟨hp⟩ + obtain ⟨i, hi, _, _⟩ := exists_parabolic_line_decomposition_of_mod_four_eq_one p hmod + have hgood := hadmissible p hp hpLarge hmod + intro axis other u v huNonempty hvNonempty + by_cases hu : IsNormalizedExceptionalCoordinate u + · exact normalizedExceptionalFiber_has_commonNeighbor i hi axis other hu hvNonempty + · by_cases hv : IsNormalizedExceptionalCoordinate v + · obtain ⟨middle, w, hmiddleOther, hmiddleAxis, hvMeet, huMeet⟩ := + normalizedExceptionalFiber_has_commonNeighbor i hi other axis hv huNonempty + exact ⟨middle, w, hmiddleAxis, hmiddleOther, huMeet, hvMeet⟩ + · exact hgood axis other u v hu hv + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean new file mode 100644 index 0000000000..17045b6d9c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean @@ -0,0 +1,364 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter + +/-! +# Point-count algebra for the incidence auxiliary curve + +This file reduces the off-diagonal auxiliary-curve count to the exact Hasse character sum exposed +in `BGS.FiniteField.EllipticCharacterSum`. +-/ + +namespace BGS.Markoff + +open Finset + +variable {F : Type*} [Field F] [Fintype F] [DecidableEq F] + +/-- The number of square roots of `t`, regarded as an integer. -/ +def squareRootCount (t : F) : ℤ := + ((univ.filter fun x : F ↦ x ^ 2 = t).card : ℕ) + +theorem squareRootCount_eq_quadraticChar_add_one + (hF : ringChar F ≠ 2) (t : F) : + squareRootCount t = quadraticChar F t + 1 := by + simpa [squareRootCount, Set.toFinset_setOf] using quadraticChar_card_sqrts hF t + +/-- The generic quadratic branch value occurring in each auxiliary equation. -/ +def branchValue (A C y : F) : F := + A * y ^ 2 - C + +/-- The weighted number of affine triples `(y, lambda, mu)` on two quadratic branches. -/ +def auxiliaryTripleCount (A B C D : F) : ℤ := + ∑ y : F, squareRootCount (branchValue A C y) * squareRootCount (branchValue B D y) + +/-- Exact character expansion of the number of affine auxiliary triples. -/ +theorem auxiliaryTripleCount_eq + (hF : ringChar F ≠ 2) {A B C D : F} + (hA : A ≠ 0) (hB : B ≠ 0) (hC : C ≠ 0) (hD : D ≠ 0) : + auxiliaryTripleCount A B C D = + (Fintype.card F : ℤ) - quadraticChar F A - quadraticChar F B + + ∑ y : F, quadraticChar F (branchValue A C y * branchValue B D y) := by + let chi := quadraticChar F + calc + auxiliaryTripleCount A B C D = + ∑ y : F, (chi (branchValue A C y) + 1) * (chi (branchValue B D y) + 1) := by + apply sum_congr rfl + intro y _ + rw [squareRootCount_eq_quadraticChar_add_one hF, + squareRootCount_eq_quadraticChar_add_one hF] + _ = ∑ y : F, + (chi (branchValue A C y * branchValue B D y) + + chi (branchValue A C y) + chi (branchValue B D y) + 1) := by + apply sum_congr rfl + intro y _ + rw [map_mul] + ring + _ = (∑ y : F, chi (branchValue A C y * branchValue B D y)) + + (∑ y : F, chi (branchValue A C y)) + + (∑ y : F, chi (branchValue B D y)) + ∑ _y : F, 1 := by + simp_rw [sum_add_distrib] + _ = (∑ y : F, chi (branchValue A C y * branchValue B D y)) - + chi A - chi B + (Fintype.card F : ℤ) := by + rw [show (∑ y : F, chi (branchValue A C y)) = -chi A by + simpa [chi, branchValue] using + BGS.FiniteField.sum_quadraticChar_mul_sq_sub hF hA hC] + rw [show (∑ y : F, chi (branchValue B D y)) = -chi B by + simpa [chi, branchValue] using + BGS.FiniteField.sum_quadraticChar_mul_sq_sub hF hB hD] + simp + ring + _ = (Fintype.card F : ℤ) - chi A - chi B + + ∑ y : F, chi (branchValue A C y * branchValue B D y) := by ring + +/-- A quadratic with two distinct roots has character sum minus the character of its leading +coefficient. -/ +theorem sum_quadraticChar_two_linear_factors + (hF : ringChar F ≠ 2) {A B C D : F} + (hA : A ≠ 0) (hB : B ≠ 0) (hcross : A * D ≠ B * C) : + ∑ x : F, quadraticChar F ((A * x - C) * (B * x - D)) = + -quadraticChar F (A * B) := by + let L : F := A * B + let center : F := (A * D + B * C) / (2 * L) + let constant : F := (A * D - B * C) ^ 2 / (4 * L) + have h2 : (2 : F) ≠ 0 := Ring.two_ne_zero hF + have h4 : (4 : F) ≠ 0 := by + rw [show (4 : F) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 h2 + have hL : L ≠ 0 := mul_ne_zero hA hB + have hconstant : constant ≠ 0 := by + exact div_ne_zero (pow_ne_zero 2 (sub_ne_zero.mpr hcross)) (mul_ne_zero h4 hL) + let e : F ≃ F := Equiv.addRight center + calc + ∑ x : F, quadraticChar F ((A * x - C) * (B * x - D)) = + ∑ x : F, quadraticChar F ((A * (e x) - C) * (B * (e x) - D)) := by + exact (e.sum_comp fun x ↦ quadraticChar F ((A * x - C) * (B * x - D))).symm + _ = ∑ x : F, quadraticChar F (L * x ^ 2 - constant) := by + apply sum_congr rfl + intro x _ + congr 1 + dsimp [e, center, constant, L] + field_simp [h2, hA, hB] + ring + _ = -quadraticChar F L := + BGS.FiniteField.sum_quadraticChar_mul_sq_sub hF hL hconstant + _ = -quadraticChar F (A * B) := rfl + +/-- Replacing the square variable in the quartic trace sum by a free variable produces the cubic +trace sum, including the correction at infinity. -/ +theorem quarticTrace_add_leadingChar_eq_cubicTrace + (hF : ringChar F ≠ 2) {A B C D : F} + (hA : A ≠ 0) (hB : B ≠ 0) (hcross : A * D ≠ B * C) : + (∑ y : F, quadraticChar F (branchValue A C y * branchValue B D y)) + + quadraticChar F (A * B) = + ∑ x : F, quadraticChar F (x * (A * x - C) * (B * x - D)) := by + let chi := quadraticChar F + have hsquareMap := + BGS.FiniteField.sum_comp_sq_eq_sum_quadraticChar_add_one hF + (fun x : F ↦ chi ((A * x - C) * (B * x - D))) + have hquadratic := sum_quadraticChar_two_linear_factors hF hA hB hcross + calc + (∑ y : F, chi (branchValue A C y * branchValue B D y)) + chi (A * B) = + (∑ y : F, chi ((A * y ^ 2 - C) * (B * y ^ 2 - D))) + chi (A * B) := by + simp only [branchValue] + _ = (∑ x : F, (chi x + 1) * chi ((A * x - C) * (B * x - D))) + + chi (A * B) := by rw [hsquareMap] + _ = (∑ x : F, + (chi (x * (A * x - C) * (B * x - D)) + + chi ((A * x - C) * (B * x - D)))) + chi (A * B) := by + congr 1 + apply sum_congr rfl + intro x _ + rw [add_mul, one_mul, ← map_mul, mul_assoc] + _ = (∑ x : F, chi (x * (A * x - C) * (B * x - D))) + + (∑ x : F, chi ((A * x - C) * (B * x - D))) + chi (A * B) := by + rw [sum_add_distrib] + _ = ∑ x : F, chi (x * (A * x - C) * (B * x - D)) := by + rw [hquadratic] + ring + +/-- Scaling `X = A * B * x` turns the cubic trace polynomial into the monic cubic with roots +`0`, `B * C`, and `A * D`. -/ +theorem cubicTrace_eq_monicCubicTrace + {A B C D : F} (hA : A ≠ 0) (hB : B ≠ 0) : + (∑ x : F, quadraticChar F (x * (A * x - C) * (B * x - D))) = + ∑ X : F, quadraticChar F (X * (X - B * C) * (X - A * D)) := by + let chi := quadraticChar F + have hAB : A * B ≠ 0 := mul_ne_zero hA hB + let e : F ≃ F := Equiv.mulLeft₀ (A * B) hAB + calc + (∑ x : F, chi (x * (A * x - C) * (B * x - D))) = + ∑ x : F, chi ((e x) * ((e x) - B * C) * ((e x) - A * D)) := by + apply sum_congr rfl + intro x _ + have hpoly : + (e x) * ((e x) - B * C) * ((e x) - A * D) = + (A * B) ^ 2 * (x * (A * x - C) * (B * x - D)) := by + change + (A * B * x) * (A * B * x - B * C) * (A * B * x - A * D) = + (A * B) ^ 2 * (x * (A * x - C) * (B * x - D)) + ring + rw [hpoly] + conv_rhs => rw [map_mul, quadraticChar_sq_one' hAB, one_mul] + _ = ∑ X : F, chi (X * (X - B * C) * (X - A * D)) := + e.sum_comp (fun X ↦ chi (X * (X - B * C) * (X - A * D))) + +/-- The quartic trace, including its leading-coefficient correction, is exactly the character +trace of the monic cubic model. -/ +theorem quarticTrace_add_leadingChar_eq_monicCubicTrace + (hF : ringChar F ≠ 2) {A B C D : F} + (hA : A ≠ 0) (hB : B ≠ 0) (hcross : A * D ≠ B * C) : + (∑ y : F, quadraticChar F (branchValue A C y * branchValue B D y)) + + quadraticChar F (A * B) = + ∑ X : F, quadraticChar F (X * (X - B * C) * (X - A * D)) := by + rw [quarticTrace_add_leadingChar_eq_cubicTrace hF hA hB hcross, + cubicTrace_eq_monicCubicTrace hA hB] + +/-- The monic Weierstrass model obtained from the cubic trace sum. Its equation is +`Y^2 = X * (X - u) * (X - v)`. -/ +def auxiliaryEllipticCurve (u v : F) : WeierstrassCurve F := + ⟨0, -(u + v), 0, u * v, 0⟩ + +omit [Fintype F] [DecidableEq F] in +theorem auxiliaryEllipticCurve_equation_iff (u v x y : F) : + (auxiliaryEllipticCurve u v).toAffine.Equation x y ↔ + y ^ 2 = x * (x - u) * (x - v) := by + rw [WeierstrassCurve.Affine.equation_iff] + simp only [auxiliaryEllipticCurve, zero_mul, add_zero] + ring_nf + +omit [Fintype F] [DecidableEq F] in +theorem auxiliaryEllipticCurve_delta (u v : F) : + (auxiliaryEllipticCurve u v).Δ = 16 * u ^ 2 * v ^ 2 * (u - v) ^ 2 := by + simp only [auxiliaryEllipticCurve, WeierstrassCurve.Δ, WeierstrassCurve.b₂, + WeierstrassCurve.b₄, WeierstrassCurve.b₆, WeierstrassCurve.b₈] + ring + +omit [Fintype F] [DecidableEq F] in +theorem auxiliaryEllipticCurve_delta_ne_zero + (hF : ringChar F ≠ 2) {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + (auxiliaryEllipticCurve u v).Δ ≠ 0 := by + have h2 : (2 : F) ≠ 0 := Ring.two_ne_zero hF + have h16 : (16 : F) ≠ 0 := by + rw [show (16 : F) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 h2 + rw [auxiliaryEllipticCurve_delta] + exact mul_ne_zero (mul_ne_zero (mul_ne_zero h16 (pow_ne_zero 2 hu)) (pow_ne_zero 2 hv)) + (pow_ne_zero 2 (sub_ne_zero.mpr huv)) + +omit [Fintype F] [DecidableEq F] in +theorem auxiliaryEllipticCurve_isElliptic + (hF : ringChar F ≠ 2) {u v : F} (hu : u ≠ 0) (hv : v ≠ 0) (huv : u ≠ v) : + (auxiliaryEllipticCurve u v).IsElliptic := + ⟨isUnit_iff_ne_zero.mpr (auxiliaryEllipticCurve_delta_ne_zero hF hu hv huv)⟩ + +omit [Fintype F] [DecidableEq F] in +/-- The cubic model associated to two distinct quadratic branches is elliptic. -/ +theorem auxiliaryEllipticCurve_branches_delta_ne_zero + (hF : ringChar F ≠ 2) {A B C D : F} + (hA : A ≠ 0) (hB : B ≠ 0) (hC : C ≠ 0) (hD : D ≠ 0) + (hcross : A * D ≠ B * C) : + (auxiliaryEllipticCurve (B * C) (A * D)).Δ ≠ 0 := + auxiliaryEllipticCurve_delta_ne_zero hF (mul_ne_zero hB hC) (mul_ne_zero hA hD) + (Ne.symm hcross) + +omit [Fintype F] [DecidableEq F] in +theorem auxiliaryEllipticCurve_branches_isElliptic + (hF : ringChar F ≠ 2) {A B C D : F} + (hA : A ≠ 0) (hB : B ≠ 0) (hC : C ≠ 0) (hD : D ≠ 0) + (hcross : A * D ≠ B * C) : + (auxiliaryEllipticCurve (B * C) (A * D)).IsElliptic := + auxiliaryEllipticCurve_isElliptic hF (mul_ne_zero hB hC) (mul_ne_zero hA hD) + (Ne.symm hcross) + +/-- The Weierstrass curve attached to the two Markoff auxiliary branches. -/ +def markoffAuxiliaryEllipticCurve (a b : F) : WeierstrassCurve F := + auxiliaryEllipticCurve + ((9 * b ^ 2 - 4) * (4 * a ^ 2)) + ((9 * a ^ 2 - 4) * (4 * b ^ 2)) + +omit [Fintype F] [DecidableEq F] in +/-- Admissibility and the off-diagonal condition make the Markoff cubic model elliptic. -/ +theorem markoffAuxiliaryEllipticCurve_delta_ne_zero + (hF : ringChar F ≠ 2) {a b : F} + (ha : a ≠ 0) (hb : b ≠ 0) + (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) + (hab : a ^ 2 ≠ b ^ 2) : + (markoffAuxiliaryEllipticCurve a b).Δ ≠ 0 := by + have h2 : (2 : F) ≠ 0 := Ring.two_ne_zero hF + have h4 : (4 : F) ≠ 0 := by + rw [show (4 : F) = 2 ^ 2 by norm_num] + exact pow_ne_zero 2 h2 + have hC : (4 * a ^ 2 : F) ≠ 0 := mul_ne_zero h4 (pow_ne_zero 2 ha) + have hD : (4 * b ^ 2 : F) ≠ 0 := mul_ne_zero h4 (pow_ne_zero 2 hb) + have h16 : (16 : F) ≠ 0 := by + rw [show (16 : F) = 2 ^ 4 by norm_num] + exact pow_ne_zero 4 h2 + have hcross : + (9 * a ^ 2 - 4) * (4 * b ^ 2) ≠ (9 * b ^ 2 - 4) * (4 * a ^ 2) := by + intro h + have hzero : (16 : F) * (a ^ 2 - b ^ 2) = 0 := by + calc + (16 : F) * (a ^ 2 - b ^ 2) = + (9 * a ^ 2 - 4) * (4 * b ^ 2) - + (9 * b ^ 2 - 4) * (4 * a ^ 2) := by ring + _ = 0 := sub_eq_zero.mpr h + exact (mul_ne_zero h16 (sub_ne_zero.mpr hab)) hzero + simpa only [markoffAuxiliaryEllipticCurve] using + auxiliaryEllipticCurve_branches_delta_ne_zero hF hA hB hC hD hcross + +theorem squareRootCount_nonnegative (t : F) : 0 ≤ squareRootCount t := by + simp [squareRootCount] + +theorem squareRootCount_le_two (hF : ringChar F ≠ 2) (t : F) : + squareRootCount t ≤ 2 := by + rw [squareRootCount_eq_quadraticChar_add_one hF] + by_cases ht : t = 0 + · simp [ht] + · rcases quadraticChar_dichotomy ht with h | h <;> rw [h] <;> norm_num + +theorem squareRootCount_eq_zero_of_no_root {t : F} (h : ¬ ∃ x : F, x ^ 2 = t) : + squareRootCount t = 0 := by + change (((univ.filter fun x : F ↦ x ^ 2 = t).card : ℕ) : ℤ) = 0 + norm_cast + rw [card_eq_zero, filter_eq_empty_iff] + intro x _ hx + exact h ⟨x, hx⟩ + +/-- The exact Hasse input makes the total number of affine auxiliary triples exceed the twelve +triples that can lie above three forbidden first coordinates. -/ +theorem twelve_lt_auxiliaryTripleCount + (hHasse : BGS.FiniteField.LegendrePointCardHasseBound F) + (hF : ringChar F ≠ 2) (hcard : 26 ≤ Fintype.card F) + {A B C D : F} (hA : A ≠ 0) (hB : B ≠ 0) (hC : C ≠ 0) (hD : D ≠ 0) + (hcross : A * D ≠ B * C) : + 12 < auxiliaryTripleCount A B C D := by + have hu : B * C ≠ 0 := mul_ne_zero hB hC + have hv : A * D ≠ 0 := mul_ne_zero hA hD + have huv : B * C ≠ A * D := Ne.symm hcross + have htrace := BGS.FiniteField.fifteen_sub_card_lt_ellipticCubicCharacterSum + hHasse hF hcard hu hv huv + have hquartic := quarticTrace_add_leadingChar_eq_monicCubicTrace + hF hA hB hcross + have hcount := auxiliaryTripleCount_eq hF hA hB hC hD + have hchiA : quadraticChar F A ≤ 1 := by + rcases quadraticChar_dichotomy hA with h | h <;> omega + have hchiB : quadraticChar F B ≤ 1 := by + rcases quadraticChar_dichotomy hB with h | h <;> omega + have hchiAB : quadraticChar F (A * B) ≤ 1 := by + rcases quadraticChar_dichotomy (mul_ne_zero hA hB) with h | h <;> omega + dsimp [BGS.FiniteField.ellipticCubicCharacterSum] at htrace + omega + +/-- Hasse's bound for the explicit elliptic model yields an auxiliary point away from any three +forbidden first coordinates. -/ +theorem exists_auxiliary_triple_away_from_three + (hHasse : BGS.FiniteField.LegendrePointCardHasseBound F) + (hF : ringChar F ≠ 2) (hcard : 26 ≤ Fintype.card F) + {A B C D : F} (hA : A ≠ 0) (hB : B ≠ 0) (hC : C ≠ 0) (hD : D ≠ 0) + (hcross : A * D ≠ B * C) (bad : Finset F) (hbad : bad.card ≤ 3) : + ∃ y, y ∉ bad ∧ ∃ lambda mu, + lambda ^ 2 = branchValue A C y ∧ mu ^ 2 = branchValue B D y := by + classical + let term (y : F) : ℤ := + squareRootCount (branchValue A C y) * squareRootCount (branchValue B D y) + have htermNonnegative (y : F) : 0 ≤ term y := + mul_nonneg (squareRootCount_nonnegative _) (squareRootCount_nonnegative _) + have htermLeFour (y : F) : term y ≤ 4 := by + dsimp [term] + nlinarith [squareRootCount_nonnegative (branchValue A C y), + squareRootCount_nonnegative (branchValue B D y), + squareRootCount_le_two hF (branchValue A C y), + squareRootCount_le_two hF (branchValue B D y)] + by_contra hExists + have hzeroOutside (y : F) (hy : y ∉ bad) : term y = 0 := by + by_cases hfirst : ∃ lambda : F, lambda ^ 2 = branchValue A C y + · have hsecond : ¬ ∃ mu : F, mu ^ 2 = branchValue B D y := by + rintro ⟨mu, hmu⟩ + obtain ⟨lambda, hlambda⟩ := hfirst + exact hExists ⟨y, hy, lambda, mu, hlambda, hmu⟩ + simp [term, squareRootCount_eq_zero_of_no_root hsecond] + · simp [term, squareRootCount_eq_zero_of_no_root hfirst] + have hrestrict : ∑ y ∈ bad, term y = ∑ y : F, term y := by + apply sum_subset (subset_univ bad) + intro y _ hy + exact hzeroOutside y hy + have hupper : ∑ y : F, term y ≤ 12 := by + rw [← hrestrict] + calc + ∑ y ∈ bad, term y ≤ ∑ _y ∈ bad, (4 : ℤ) := + sum_le_sum fun y _ ↦ htermLeFour y + _ = (bad.card : ℤ) * 4 := by simp + _ ≤ 12 := by exact_mod_cast Nat.mul_le_mul_right 4 hbad + have hlower : 12 < ∑ y : F, term y := by + simpa [auxiliaryTripleCount, term] using + twelve_lt_auxiliaryTripleCount hHasse hF hcard hA hB hC hD hcross + omega + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean new file mode 100644 index 0000000000..b4f20a3ef9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean @@ -0,0 +1,24 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean new file mode 100644 index 0000000000..8f4610da69 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights + +/-! +# Feeding the geometric Corvaja--Zannier estimate into a Markoff move + +This module connects the weighted torsion-intersection bound to the already completed middle-game +order-escape chain. The actual weighted trace curve's admissibility is proved from its Markoff +coefficients. + +Given those premises, Lean returns a natural iterate of the Markoff rotation with strictly larger +neighboring rotation order. No independent weighted-finset estimate remains between the cited +curve theorem and the dynamical conclusion. +-/ + +namespace BGS.Markoff + +/-- The uniform weighted-trace bound, after Lean verifies every concrete diagonalized Markoff +trace curve, produces an actual middle-game order-increasing iterate. -/ +theorem exists_iterate_with_larger_secondRotationOrder_of_weightedTraceBound + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < + rotationOrder x.u1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * + rotationOrder x.u1 < p) + (hBound : WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) : + ∃ n : ℕ, + rotationOrder x.u1 < rotationOrder ((normalizedRotate1^[n]) x).u2 := by + apply exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic + p hpTwo delta hdelta x hx hnonzero hnonparabolic hbelowEndgame hcube hlinear + intro w s hw hpoint _hnondegenerate d hd + let alpha : quadraticFiniteField p := s + let beta : quadraticFiniteField p := + splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + let H₁ : Subgroup (quadraticFiniteField p)ˣ := Subgroup.zpowers w + let H₂ : Subgroup (quadraticFiniteField p)ˣ := middleGameRightSubgroup p d + have hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta := by + simpa [alpha, beta] using + diagonalizedFiber_weightedTraceCurve_isCorvajaZannierAdmissible + p hpTwo x hnonzero w s hw hpoint + have hbound := + weightedTraceEquationSolutions_card_cast_le_of_weightedTraceBound + p (quadraticFiniteField p) hBound alpha beta H₁ H₂ hadmissible + have htrace : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have horder : orderOf w = rotationOrder x.u1 := by + rw [← rotationOrder_eq_orderOf_extensionEigenvalue x.u1 w hw htrace] + have hleftCard : Nat.card H₁ = rotationOrder x.u1 := by + rw [Nat.card_zpowers, horder] + simpa [alpha, beta, H₁, H₂, hleftCard] using hbound + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean new file mode 100644 index 0000000000..4699f6d60c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean @@ -0,0 +1,133 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier + +/-! +# Applying general Corvaja--Zannier to the weighted trace curve +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +theorem weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + (alpha beta : K) (hbeta : beta ≠ 0) : + MvPolynomial.pderiv 0 + (weightedTraceTorusClosurePolynomial alpha beta) ≠ 0 := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + intro hzero + have heval := congrArg + (MvPolynomial.eval ![(0 : K), (0 : K)]) hzero + simp [splitTraceCoverPolynomial] at heval + exact hbeta heval + +theorem weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + (alpha beta : K) (hbeta : beta ≠ 0) : + MvPolynomial.pderiv 1 + (weightedTraceTorusClosurePolynomial alpha beta) ≠ 0 := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + intro hzero + have heval := congrArg + (MvPolynomial.eval ![(0 : K), (0 : K)]) hzero + simp [splitTraceCoverPolynomial] at heval + +theorem weightedTraceCurveNotSubtorusTranslate_general + (alpha beta : K) (hbeta : beta ≠ 0) + (hnot : WeightedTraceCurveNotSubtorusTranslate alpha beta) : + BGS.External.TorusCurveNotSubtorusTranslate + (weightedTraceTorusClosurePolynomial alpha beta) := by + intro a b hab c + obtain ⟨x, y, hcurve, hcharacter⟩ := hnot a b hab c + refine ⟨x, y, ?_, hcharacter⟩ + rw [map_weightedTraceTorusClosurePolynomial_of_beta_ne_zero + (algebraMap K (AlgebraicClosure K)) alpha beta hbeta] + exact (eval_weightedTraceTorusClosurePolynomial_eq_zero_iff + (algebraMap K (AlgebraicClosure K) alpha) + (algebraMap K (AlgebraicClosure K) beta) x y).2 hcurve + +theorem weightedTraceTorusClosurePolynomial_hasBidegreeAtMost + (alpha beta : K) (hbeta : beta ≠ 0) : + BGS.External.HasBidegreeAtMost + (weightedTraceTorusClosurePolynomial alpha beta) 2 2 := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + simpa using splitTraceCoverPolynomial_hasBidegreeAtMost alpha beta 1 1 + +theorem weightedTraceCurve_isGeneralCorvajaZannierPlaneCurve + (alpha beta : K) (hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) : + BGS.External.IsCorvajaZannierPlaneCurve + (weightedTraceTorusClosurePolynomial alpha beta) := by + refine ⟨hadmissible.2.2.2.1, + weightedTraceCurveNotSubtorusTranslate_general + alpha beta hadmissible.2.1 hadmissible.2.2.2.2, + weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + alpha beta hadmissible.2.1, + weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1⟩ + +section Finite + +variable [Fintype K] [DecidableEq K] + +theorem generalTorusTorsionIntersection_weightedTrace_eq + (alpha beta : K) (leftOrder rightOrder : ℕ) : + BGS.External.torusCurveTorsionIntersection K + (weightedTraceTorusClosurePolynomial alpha beta) rightOrder leftOrder = + weightedTraceCurveTorsionIntersection alpha beta leftOrder rightOrder := by + ext z + rw [BGS.External.mem_torusCurveTorsionIntersection_iff, + mem_weightedTraceCurveTorsionIntersection_iff, + eval_weightedTraceTorusClosurePolynomial_eq_zero_iff] + tauto + +end Finite + +/-- The weighted-trace estimate is a proved application of the one general +Corvaja--Zannier plane-curve theorem. -/ +theorem corvajaZannierWeightedTraceBound_of_generalTheorem + (hGeneral : BGS.External.GeneralCorvajaZannierPlaneCurveTheorem) + (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] : + WeightedTraceTorsionIntersectionBound p K := by + intro alpha beta leftOrder rightOrder hadmissible + hleftPositive hrightPositive hleftPrime hrightPrime + have hsource := hGeneral p K + (weightedTraceTorusClosurePolynomial alpha beta) + 2 2 rightOrder leftOrder (by norm_num) (by norm_num) + (weightedTraceTorusClosurePolynomial_hasBidegreeAtMost + alpha beta hadmissible.2.1) + (weightedTraceCurve_isGeneralCorvajaZannierPlaneCurve + alpha beta hadmissible) + hrightPositive hleftPositive hrightPrime hleftPrime + rw [generalTorusTorsionIntersection_weightedTrace_eq] at hsource + rw [show BGS.External.planeTorusEulerCharacteristicBound 2 2 = 8 by + norm_num [BGS.External.planeTorusEulerCharacteristicBound]] at hsource + exact hsource.trans <| by + simpa [corvajaZannierTraceUpperBound, + mul_comm, mul_left_comm, mul_assoc] using + (corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_eight_le + p rightOrder leftOrder) + +/-- The weighted-trace Corvaja--Zannier estimate, obtained by instantiating +the unconditional general plane-curve theorem proved in this repository. -/ +theorem corvajaZannierWeightedTraceBound + (p : ℕ) [Fact p.Prime] + (K : Type) [Field K] [Fintype K] [DecidableEq K] [CharP K p] : + WeightedTraceTorsionIntersectionBound p K := + corvajaZannierWeightedTraceBound_of_generalTheorem + BGS.CorvajaZannier.generalCorvajaZannierPlaneCurveTheorem p K + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean new file mode 100644 index 0000000000..4665c1e14e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean @@ -0,0 +1,192 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +import Mathlib.FieldTheory.IsAlgClosed.Basic + +/-! +# The geometric Corvaja--Zannier interface for the middle game + +Corvaja--Zannier, JEMS 15 (2013), Corollary 2, bounds torsion points on an +absolutely irreducible curve in a two-dimensional torus which is not a translate of a +subtorus. The actual Markoff middle-game finset consists of solutions of + +`alpha * h + beta * h⁻¹ = k + k⁻¹`, with `h ∈ H₁` and `k ∈ H₂`. + +This module embeds that finset into the exact geometric torsion intersection of the +weighted trace curve. It keeps all hypotheses of the cited result visible. In particular, +`alpha * beta ≠ 1` is not silently identified with absolute irreducibility or with the +non-subtorus condition. + +The constant `20` printed in the Markoff paper is not the direct specialization of +Corvaja--Zannier Corollary 2. For the `(2,2)` trace curve, the `12 d₁ d₂ / p` term alone +gives `48 m₁ m₂ / p`. Accordingly the source-backed envelope in this module has constant +`48`; obtaining `20` requires a separate argument. +-/ + +namespace BGS.Markoff + +section GeometricCurve + +variable {K : Type*} [Field K] + +/-- The affine closure polynomial of the weighted trace curve after removing the boundary +monomial which appears when `beta = 0`. Variable `0` is the right trace parameter `k` and +variable `1` is the left parameter `h`. + +Removing this monomial is essential: Corvaja--Zannier concerns the curve in the torus, not +the extra coordinate-axis component introduced by clearing denominators. -/ +noncomputable def weightedTraceTorusClosurePolynomial (alpha beta : K) : + MvPolynomial (Fin 2) K := by + classical + exact if beta = 0 then + MvPolynomial.C alpha * MvPolynomial.X 0 * MvPolynomial.X 1 - + MvPolynomial.X 0 ^ 2 - 1 + else + splitTraceCoverPolynomial alpha beta 1 1 + +/-- On nonzero coordinates, the reduced affine polynomial cuts out exactly the weighted +trace equation. -/ +theorem eval_weightedTraceTorusClosurePolynomial_eq_zero_iff + (alpha beta : K) (k h : Kˣ) : + MvPolynomial.eval ![(k : K), (h : K)] + (weightedTraceTorusClosurePolynomial alpha beta) = 0 ↔ + weightedSplitTorusTrace alpha beta h = splitTorusTrace k := by + by_cases hbeta : beta = 0 + · subst beta + simp only [weightedTraceTorusClosurePolynomial, if_pos, map_sub, map_mul, + MvPolynomial.eval_C, MvPolynomial.eval_X, Matrix.cons_val_zero, + Matrix.cons_val_one, map_pow, map_one, weightedSplitTorusTrace, + splitTorusTrace, zero_mul, add_zero, Units.val_inv_eq_inv_val] + have hk : (k : K) ≠ 0 := Units.ne_zero k + field_simp [hk] + constructor <;> intro heq <;> linear_combination heq + · rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + simpa [SplitTraceCurveEquation] using + eval_splitTraceCoverPolynomial_eq_zero_iff alpha beta 1 1 k h + +/-- Absolute irreducibility of the actual torus closure, expressed as irreducibility after +base change to an algebraic closure. This is a proposition, not a typeclass. -/ +def WeightedTraceCurveAbsolutelyIrreducible (alpha beta : K) : Prop := + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (weightedTraceTorusClosurePolynomial alpha beta)) + +/-- Exact geometric non-specialness: over an algebraic closure, no nontrivial character is +constant on the whole weighted trace curve. For an irreducible curve in `G_m^2`, this is +equivalent to not being a translate of a one-dimensional subtorus. -/ +def WeightedTraceCurveNotSubtorusTranslate (alpha beta : K) : Prop := + ∀ (a b : ℤ), (a ≠ 0 ∨ b ≠ 0) → + ∀ c : (AlgebraicClosure K)ˣ, + ∃ k h : (AlgebraicClosure K)ˣ, + weightedSplitTorusTrace + (algebraMap K (AlgebraicClosure K) alpha) + (algebraMap K (AlgebraicClosure K) beta) h = + splitTorusTrace k ∧ + k ^ a * h ^ b ≠ c + +/-- The concrete curve hypotheses needed by the weighted-trace specialization of +Corvaja--Zannier Corollary 2. Both weights are nonzero, the curve is nondegenerate and +absolutely irreducible, and it is not a translate of a subtorus. These conditions are +kept separate from the external cardinal estimate. -/ +def WeightedTraceCurveIsCorvajaZannierAdmissible (alpha beta : K) : Prop := + alpha ≠ 0 ∧ + beta ≠ 0 ∧ + alpha * beta ≠ 1 ∧ + WeightedTraceCurveAbsolutelyIrreducible alpha beta ∧ + WeightedTraceCurveNotSubtorusTranslate alpha beta + +end GeometricCurve + +section FiniteTorsionIntersection + +variable {E : Type*} [Field E] [Fintype E] + +/-- The geometric torsion intersection to which Corvaja--Zannier Corollary 2 applies. +Coordinates are ordered `(k, h)` to match `splitTraceCoverPolynomial`. -/ +noncomputable def weightedTraceCurveTorsionIntersection + (alpha beta : E) (leftOrder rightOrder : ℕ) : Finset (Eˣ × Eˣ) := by + classical + exact Finset.univ.filter fun z ↦ + weightedSplitTorusTrace alpha beta z.2 = splitTorusTrace z.1 ∧ + z.2 ^ leftOrder = 1 ∧ z.1 ^ rightOrder = 1 + +@[simp] +theorem mem_weightedTraceCurveTorsionIntersection_iff + (alpha beta : E) (leftOrder rightOrder : ℕ) (z : Eˣ × Eˣ) : + z ∈ weightedTraceCurveTorsionIntersection alpha beta leftOrder rightOrder ↔ + weightedSplitTorusTrace alpha beta z.2 = splitTorusTrace z.1 ∧ + z.2 ^ leftOrder = 1 ∧ z.1 ^ rightOrder = 1 := by + classical + simp [weightedTraceCurveTorsionIntersection] + +/-- The same intersection stated with the explicit affine closure polynomial. This is the +line-level bridge from the finite set to the algebraic curve consumed by Corollary 2. -/ +theorem mem_weightedTraceCurveTorsionIntersection_iff_polynomial + (alpha beta : E) (leftOrder rightOrder : ℕ) (z : Eˣ × Eˣ) : + z ∈ weightedTraceCurveTorsionIntersection alpha beta leftOrder rightOrder ↔ + MvPolynomial.eval ![(z.1 : E), (z.2 : E)] + (weightedTraceTorusClosurePolynomial alpha beta) = 0 ∧ + z.2 ^ leftOrder = 1 ∧ z.1 ^ rightOrder = 1 := by + rw [mem_weightedTraceCurveTorsionIntersection_iff, + eval_weightedTraceTorusClosurePolynomial_eq_zero_iff] + +/-- Swap a subgroup solution into the geometric coordinate order `(k, h)`. -/ +def weightedTraceSubgroupSolutionToCurvePoint + (H₁ H₂ : Subgroup Eˣ) : H₁ × H₂ → Eˣ × Eˣ := + fun z ↦ ((z.2 : Eˣ), (z.1 : Eˣ)) + +omit [Fintype E] in +theorem weightedTraceSubgroupSolutionToCurvePoint_injective + (H₁ H₂ : Subgroup Eˣ) : + Function.Injective (weightedTraceSubgroupSolutionToCurvePoint H₁ H₂) := by + intro x y hxy + apply Prod.ext + · apply Subtype.ext + exact congrArg Prod.snd hxy + · apply Subtype.ext + exact congrArg Prod.fst hxy + +/-- Every actual subgroup solution gives a point in the corresponding geometric torsion +intersection. The subgroup cardinalities become the two root-of-unity exponents by +Lagrange's theorem. -/ +theorem weightedTraceSubgroupSolutionToCurvePoint_mem_torsionIntersection + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) (z : H₁ × H₂) + (hz : z ∈ weightedTraceEquationSolutions alpha beta H₁ H₂) : + weightedTraceSubgroupSolutionToCurvePoint H₁ H₂ z ∈ + weightedTraceCurveTorsionIntersection alpha beta (Nat.card H₁) (Nat.card H₂) := by + letI := Fintype.ofFinite H₁ + letI := Fintype.ofFinite H₂ + rw [mem_weightedTraceCurveTorsionIntersection_iff] + refine ⟨mem_weightedTraceEquationSolutions_iff.mp hz, ?_, ?_⟩ + · have hpow : z.1 ^ Fintype.card H₁ = 1 := pow_card_eq_one + have hval := congrArg (fun u : H₁ ↦ (u : Eˣ)) hpow + change ((z.1 : Eˣ) ^ Fintype.card H₁) = 1 at hval + simpa only [weightedTraceSubgroupSolutionToCurvePoint, + Fintype.card_eq_nat_card] using hval + · have hpow : z.2 ^ Fintype.card H₂ = 1 := pow_card_eq_one + have hval := congrArg (fun u : H₂ ↦ (u : Eˣ)) hpow + change ((z.2 : Eˣ) ^ Fintype.card H₂) = 1 at hval + simpa only [weightedTraceSubgroupSolutionToCurvePoint, + Fintype.card_eq_nat_card] using hval + +/-- The actual weighted solution count is bounded by the exact geometric torsion +intersection count. This theorem contains no Corvaja--Zannier assumption. -/ +theorem weightedTraceEquationSolutions_card_le_curveTorsionIntersection + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : + (weightedTraceEquationSolutions alpha beta H₁ H₂).card ≤ + (weightedTraceCurveTorsionIntersection alpha beta + (Nat.card H₁) (Nat.card H₂)).card := by + classical + exact Finset.card_le_card_of_injOn + (weightedTraceSubgroupSolutionToCurvePoint H₁ H₂) + (fun z hz ↦ weightedTraceSubgroupSolutionToCurvePoint_mem_torsionIntersection + alpha beta H₁ H₂ z hz) + (weightedTraceSubgroupSolutionToCurvePoint_injective H₁ H₂).injOn + +end FiniteTorsionIntersection + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean new file mode 100644 index 0000000000..6fb6310c2f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +import Mathlib.FieldTheory.Separable +import Mathlib.RingTheory.Derivation.Basic + +/-! +# Prime-to-characteristic torsion exponents for Corvaja--Zannier + +Corvaja--Zannier, Theorem 2, assumes that the two rational functions have nonzero +differentials. In Corollary 2 those functions are coordinate powers whose exponents are +the orders of the two root-of-unity groups. The source suppresses the resulting +prime-to-characteristic check. + +For the actual Markoff application, both exponents are cardinalities of subgroups of the +multiplicative group of a finite field. This file proves that they are prime to the +characteristic, that the associated root-of-unity polynomials are separable, and that +raising a nonzero coordinate with nonzero differential to either exponent preserves a +nonzero differential. Thus inseparability is not part of the remaining +Corvaja--Zannier wall. +-/ + +namespace BGS.Markoff + +open Polynomial + +section FiniteFieldSubgroupOrders + +variable {E : Type*} [Field E] [Fintype E] + +/-- The order of a multiplicative subgroup of a finite field is prime to the field +characteristic. This is the hidden separability check in the passage from +Corvaja--Zannier Theorem 2 to Corollary 2. -/ +theorem characteristic_not_dvd_multiplicativeSubgroup_natCard + (p : ℕ) [Fact p.Prime] [CharP E p] (H : Subgroup Eˣ) : + ¬ p ∣ Nat.card H := by + have hHdiv : Nat.card H ∣ Nat.card Eˣ := H.card_subgroup_dvd_card + intro hpH + have hpUnits : p ∣ Nat.card Eˣ := hpH.trans hHdiv + rcases FiniteField.card E p with ⟨n, -, hcard⟩ + have hpE : p ∣ Nat.card E := by + rw [← Fintype.card_eq_nat_card, hcard] + exact dvd_pow_self p n.ne_zero + have hdiff : Nat.card E - Nat.card Eˣ = 1 := by + rw [Nat.card_eq_card_units_add_one E] + omega + have hpOne : p ∣ 1 := by + rw [← hdiff] + exact Nat.dvd_sub hpE hpUnits + exact (Fact.out : p.Prime).not_dvd_one hpOne + +/-- Both exponents occurring in the exact weighted torsion intersection are prime to the +characteristic. -/ +theorem weightedTraceCurveTorsionIntersection_orders_primeToCharacteristic + (p : ℕ) [Fact p.Prime] [CharP E p] (H₁ H₂ : Subgroup Eˣ) : + ¬ p ∣ Nat.card H₁ ∧ ¬ p ∣ Nat.card H₂ := + ⟨characteristic_not_dvd_multiplicativeSubgroup_natCard p H₁, + characteristic_not_dvd_multiplicativeSubgroup_natCard p H₂⟩ + +/-- The root-of-unity polynomial attached to an actual finite-field subgroup has no +inseparable multiplicity. -/ +theorem multiplicativeSubgroup_torsionPolynomial_separable + (p : ℕ) [Fact p.Prime] [CharP E p] (H : Subgroup Eˣ) : + (Polynomial.X ^ Nat.card H - 1 : E[X]).Separable := by + simpa only [Polynomial.C_1] using + Polynomial.separable_X_pow_sub_C' p (Nat.card H) (1 : E) + (characteristic_not_dvd_multiplicativeSubgroup_natCard p H) one_ne_zero + +/-- The two torsion equations defining the exact geometric intersection are reduced. -/ +theorem weightedTraceCurveTorsionIntersection_torsionPolynomials_separable + (p : ℕ) [Fact p.Prime] [CharP E p] (H₁ H₂ : Subgroup Eˣ) : + (Polynomial.X ^ Nat.card H₁ - 1 : E[X]).Separable ∧ + (Polynomial.X ^ Nat.card H₂ - 1 : E[X]).Separable := + ⟨multiplicativeSubgroup_torsionPolynomial_separable p H₁, + multiplicativeSubgroup_torsionPolynomial_separable p H₂⟩ + +end FiniteFieldSubgroupOrders + +section NonzeroDifferentials + +variable {k L M : Type*} [CommRing k] [Field L] [AddCommGroup M] [Module L M] + [Algebra k L] [Module k M] + +/-- A prime-to-characteristic power of a nonzero function with nonzero differential +again has nonzero differential. This is the exact derivation calculation used when +Corvaja--Zannier Theorem 2 is specialized to root-of-unity exponents. -/ +theorem derivation_pow_ne_zero + (D : Derivation k L M) (x : L) (n : ℕ) + (hn : (n : L) ≠ 0) (hx : x ≠ 0) (hDx : D x ≠ 0) : + D (x ^ n) ≠ 0 := by + rw [D.leibniz_pow] + rw [← Nat.cast_smul_eq_nsmul L, smul_smul] + exact smul_ne_zero (mul_ne_zero hn (pow_ne_zero _ hx)) hDx + +/-- Actual finite-field subgroup orders satisfy the nonzero-differential condition after +transport to any function field of the same characteristic. -/ +theorem multiplicativeSubgroup_order_pow_has_nonzeroDifferential + {E : Type*} [Field E] [Fintype E] + (p : ℕ) [Fact p.Prime] [CharP E p] [CharP L p] + (H : Subgroup Eˣ) (D : Derivation k L M) (x : L) + (hx : x ≠ 0) (hDx : D x ≠ 0) : + D (x ^ Nat.card H) ≠ 0 := by + apply derivation_pow_ne_zero D x (Nat.card H) + · rw [ne_eq, CharP.cast_eq_zero_iff L p] + exact characteristic_not_dvd_multiplicativeSubgroup_natCard p H + · exact hx + · exact hDx + +/-- The two coordinate powers in Corvaja--Zannier Corollary 2 retain nonzero +differentials for the exact pair of subgroup orders used in the Markoff middle game. -/ +theorem weightedTraceCurveTorsionIntersection_coordinatePowers_haveNonzeroDifferentials + {E : Type*} [Field E] [Fintype E] + (p : ℕ) [Fact p.Prime] [CharP E p] [CharP L p] + (H₁ H₂ : Subgroup Eˣ) (D : Derivation k L M) (x y : L) + (hx : x ≠ 0) (hy : y ≠ 0) (hDx : D x ≠ 0) (hDy : D y ≠ 0) : + D (x ^ Nat.card H₁) ≠ 0 ∧ D (y ^ Nat.card H₂) ≠ 0 := + ⟨multiplicativeSubgroup_order_pow_has_nonzeroDifferential p H₁ D x hx hDx, + multiplicativeSubgroup_order_pow_has_nonzeroDifferential p H₂ D y hy hDy⟩ + +end NonzeroDifferentials + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean new file mode 100644 index 0000000000..324c4a1c9c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound + +/-! +# The source-faithful Corvaja--Zannier numerical specialization + +Corvaja--Zannier, Corollary 2, gives a torsion-intersection bound for a curve of +bidegree `(d₁, d₂)` and Euler characteristic `χ`. This file records its printed +right-hand side and proves that the specialization `(d₁, d₂, χ) = (2, 2, 4)` is +dominated by the coefficient-`48` envelope used by the Markoff middle game. + +This is only the numerical specialization. It does not postulate or prove the geometric +torsion-intersection estimate. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The numerical right-hand side printed in Corvaja--Zannier, Corollary 2. -/ +def corvajaZannierCorollaryTwoNumericalBound + (p leftOrder rightOrder firstDegree secondDegree : ℕ) (eulerCharacteristic : ℝ) : ℝ := + max + (3 * (2 * ((leftOrder * rightOrder * firstDegree * secondDegree : ℕ) : ℝ) * + eulerCharacteristic) ^ ((1 : ℝ) / 3)) + (12 * ((leftOrder * rightOrder * firstDegree * secondDegree : ℕ) : ℝ) / p) + +private lemma thirtyTwo_rpow_one_third_le_sixteen : + (32 : ℝ) ^ ((1 : ℝ) / 3) ≤ 16 := by + have hpow : (4096 : ℝ) ^ ((1 : ℝ) / 3) = 16 := by + rw [show (4096 : ℝ) = 16 ^ (3 : ℕ) by norm_num] + convert Real.pow_rpow_inv_natCast (by norm_num : (0 : ℝ) ≤ 16) + (by norm_num : (3 : ℕ) ≠ 0) using 1 + all_goals norm_num + rw [← hpow] + exact Real.rpow_le_rpow (by norm_num) (by norm_num) (by norm_num) + +private lemma sixtyFour_rpow_one_third_eq_four : + (64 : ℝ) ^ ((1 : ℝ) / 3) = 4 := by + rw [show (64 : ℝ) = 4 ^ (3 : ℕ) by norm_num] + convert Real.pow_rpow_inv_natCast (by norm_num : (0 : ℝ) ≤ 4) + (by norm_num : (3 : ℕ) ≠ 0) using 1 + all_goals norm_num + +/-- The exact `(2,2)` and Euler-characteristic-four specialization used by the +Markoff middle game is dominated by the source-faithful coefficient `48`. -/ +theorem corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_four_le + (p leftOrder rightOrder : ℕ) : + corvajaZannierCorollaryTwoNumericalBound p leftOrder rightOrder 2 2 4 ≤ + corvajaZannierTraceUpperBound p leftOrder rightOrder := by + let x : ℝ := (leftOrder * rightOrder : ℕ) + have hx : 0 ≤ x := by positivity + have hroot : 0 ≤ x ^ ((1 : ℝ) / 3) := Real.rpow_nonneg hx _ + have hfirst : 3 * (32 * x) ^ ((1 : ℝ) / 3) ≤ 48 * x ^ ((1 : ℝ) / 3) := by + rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 32) hx] + have hproduct : + 0 ≤ (16 - (32 : ℝ) ^ ((1 : ℝ) / 3)) * x ^ ((1 : ℝ) / 3) := + mul_nonneg (sub_nonneg.mpr thirtyTwo_rpow_one_third_le_sixteen) hroot + nlinarith + unfold corvajaZannierCorollaryTwoNumericalBound corvajaZannierTraceUpperBound + simp only [corvajaZannierCorollaryTwoSafeCoefficient] + have hdegrees : + ((leftOrder * rightOrder * 2 * 2 : ℕ) : ℝ) = 4 * x := by + simp [x] + ring + rw [hdegrees] + ring_nf + apply max_le + · have h := hfirst.trans + (mul_le_mul_of_nonneg_left + (le_max_left (x ^ ((1 : ℝ) / 3)) (x / p)) (by norm_num)) + simpa [x, div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc] using h + · have h := mul_le_mul_of_nonneg_left + (le_max_right (x ^ ((1 : ℝ) / 3)) (x / p)) (by norm_num : (0 : ℝ) ≤ 48) + simpa [x, div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc] using h + +/-- The degree-only Euler-characteristic bound `χ ≤ 2 d₁ d₂` gives `χ = 8` +at bidegree `(2,2)`. This slightly weaker but genuinely general specialization +is still dominated by the coefficient-`48` envelope used downstream. -/ +theorem corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_eight_le + (p leftOrder rightOrder : ℕ) : + corvajaZannierCorollaryTwoNumericalBound p leftOrder rightOrder 2 2 8 ≤ + corvajaZannierTraceUpperBound p leftOrder rightOrder := by + let x : ℝ := (leftOrder * rightOrder : ℕ) + have hx : 0 ≤ x := by positivity + have hroot : 0 ≤ x ^ ((1 : ℝ) / 3) := Real.rpow_nonneg hx _ + have hfirst : 3 * (64 * x) ^ ((1 : ℝ) / 3) ≤ + 48 * x ^ ((1 : ℝ) / 3) := by + rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 64) hx, + sixtyFour_rpow_one_third_eq_four] + nlinarith + unfold corvajaZannierCorollaryTwoNumericalBound corvajaZannierTraceUpperBound + simp only [corvajaZannierCorollaryTwoSafeCoefficient] + have hdegrees : + ((leftOrder * rightOrder * 2 * 2 : ℕ) : ℝ) = 4 * x := by + simp [x] + ring + rw [hdegrees] + ring_nf + apply max_le + · have h := hfirst.trans + (mul_le_mul_of_nonneg_left + (le_max_left (x ^ ((1 : ℝ) / 3)) (x / p)) (by norm_num)) + simpa [x, div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc] using h + · have h := mul_le_mul_of_nonneg_left + (le_max_right (x ^ ((1 : ℝ) / 3)) (x / p)) (by norm_num : (0 : ℝ) ≤ 48) + simpa [x, div_eq_mul_inv, mul_comm, mul_left_comm, mul_assoc] using h + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean new file mode 100644 index 0000000000..25d4c8f6fd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean @@ -0,0 +1,259 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound + +/-! +# The Corvaja--Zannier middle-game escape step + +This module connects the published Corvaja--Zannier estimate to the already formalized +bad-order union. The deep estimate remains an explicit hypothesis about the actual +trace-equation solution sets. Two details that are easy to lose in an abstract union bound +are kept in the statement: + +* `sigma != 1`, as required in equation (62) of the published paper; +* the subgroup indexed by `d` must actually have cardinality `d`. + +The theorem below reduces the paper-specific order-increase step to one visible numerical +inequality. It does not postulate the Corvaja--Zannier theorem. +-/ + +namespace BGS.Markoff + +variable {E : Type*} [Field E] [Fintype E] + +/-- A common Corvaja--Zannier bound for every candidate order not exceeding the current order. -/ +noncomputable def corvajaZannierCurrentOrderEnvelope + (p currentOrder : ℕ) : ℝ := + corvajaZannierCorollaryTwoSafeCoefficient * max + (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) + (((currentOrder * currentOrder : ℕ) : ℝ) / p) + +/-- Replacing a candidate right order by the current left order only enlarges the quoted +Corvaja--Zannier bound. -/ +theorem corvajaZannierTraceUpperBound_le_currentOrderEnvelope + (p currentOrder d : ℕ) (hd : d ≤ currentOrder) : + corvajaZannierTraceUpperBound p currentOrder d ≤ + corvajaZannierCurrentOrderEnvelope p currentOrder := by + have hmulNat : currentOrder * d ≤ currentOrder * currentOrder := + Nat.mul_le_mul_left currentOrder hd + have hmul : (((currentOrder * d : ℕ) : ℝ)) ≤ + (((currentOrder * currentOrder : ℕ) : ℝ)) := by + exact_mod_cast hmulNat + unfold corvajaZannierTraceUpperBound corvajaZannierCurrentOrderEnvelope + apply mul_le_mul_of_nonneg_left _ (by norm_num) + exact max_le_max + (Real.rpow_le_rpow (by positivity) hmul (by norm_num)) + (div_le_div_of_nonneg_right hmul (Nat.cast_nonneg p)) + +/-- The summed Corvaja--Zannier expression is bounded by the divisor count times the common +current-order envelope. -/ +theorem middleGameCorvajaZannierSum_le_divisorCount_mul_envelope + (p currentOrder : ℕ) : + (∑ d ∈ middleGameCandidateOrders p currentOrder, + corvajaZannierTraceUpperBound p currentOrder d) ≤ + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder := by + classical + calc + (∑ d ∈ middleGameCandidateOrders p currentOrder, + corvajaZannierTraceUpperBound p currentOrder d) ≤ + ∑ _d ∈ middleGameCandidateOrders p currentOrder, + corvajaZannierCurrentOrderEnvelope p currentOrder := by + exact Finset.sum_le_sum fun d hd ↦ + corvajaZannierTraceUpperBound_le_currentOrderEnvelope p currentOrder d + (mem_middleGameCandidateOrders_iff.mp hd).1 + _ = ((middleGameCandidateOrders p currentOrder).card : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder := by + simp + _ ≤ (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder := by + apply mul_le_mul_of_nonneg_right _ (by + unfold corvajaZannierCurrentOrderEnvelope + positivity) + exact_mod_cast middleGameCandidateOrders_card_le p currentOrder + +/-- Two elementary natural-number inequalities imply that the entire divisor-counted +Corvaja--Zannier envelope is smaller than the current order. Writing +`D = tau(p - 1) + tau(p + 1)`, these are exactly + +* `(48 D)^3 < currentOrder` for the cube-root term, and +* `48 D * currentOrder < p` for the term divided by `p`. + +Thus the remaining asymptotic work is reduced to the proved subpolynomial divisor bound and +the chosen middle-game range for `currentOrder`. -/ +theorem divisorCount_mul_corvajaZannierEnvelope_lt_currentOrder + (p currentOrder : ℕ) (hcurrentOrder : 0 < currentOrder) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < currentOrder) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p) : + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder < + (currentOrder : ℝ) := by + let divisorCount : ℕ := (p - 1).divisors.card + (p + 1).divisors.card + let coefficient : ℝ := corvajaZannierCorollaryTwoSafeCoefficient * divisorCount + have horderPos : (0 : ℝ) < currentOrder := by exact_mod_cast hcurrentOrder + have horderNonneg : (0 : ℝ) ≤ currentOrder := horderPos.le + have hcoefficientNonneg : 0 ≤ coefficient := by + dsimp [coefficient] + positivity + have hcubeReal : coefficient ^ (3 : ℕ) < (currentOrder : ℝ) := by + dsimp [coefficient, divisorCount] + exact_mod_cast hcube + have hcoefficientRoot : + coefficient < (currentOrder : ℝ) ^ ((1 : ℝ) / 3) := by + have h := (Real.lt_rpow_inv_iff_of_pos hcoefficientNonneg horderNonneg + (by norm_num : (0 : ℝ) < 3)).2 + have h' : coefficient < (currentOrder : ℝ) ^ (3 : ℝ)⁻¹ := + h (by simpa [Real.rpow_natCast] using hcubeReal) + simpa only [one_div] using h' + have hrootPositive : + 0 < (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) := by + positivity + have hcubeRootIdentity : + (currentOrder : ℝ) ^ ((1 : ℝ) / 3) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) = + (currentOrder : ℝ) := by + rw [Nat.cast_mul] + rw [← Real.mul_rpow horderNonneg (mul_nonneg horderNonneg horderNonneg)] + convert Real.pow_rpow_inv_natCast horderNonneg + (by norm_num : (3 : ℕ) ≠ 0) using 1 + all_goals ring_nf + have hrootTerm : + coefficient * (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) < + (currentOrder : ℝ) := by + calc + coefficient * (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) < + (currentOrder : ℝ) ^ ((1 : ℝ) / 3) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) := + mul_lt_mul_of_pos_right hcoefficientRoot hrootPositive + _ = (currentOrder : ℝ) := hcubeRootIdentity + have hlinearReal : coefficient * (currentOrder : ℝ) < (p : ℝ) := by + dsimp [coefficient, divisorCount] + exact_mod_cast hlinear + have hpPos : (0 : ℝ) < p := by + have : 0 < p := by omega + exact_mod_cast this + have hquotientTerm : + coefficient * (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) < + (currentOrder : ℝ) := by + have hratio : coefficient * (currentOrder : ℝ) / (p : ℝ) < 1 := + (div_lt_one hpPos).2 hlinearReal + calc + coefficient * (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) = + (coefficient * (currentOrder : ℝ) / (p : ℝ)) * (currentOrder : ℝ) := by + rw [Nat.cast_mul] + ring + _ < 1 * (currentOrder : ℝ) := mul_lt_mul_of_pos_right hratio horderPos + _ = (currentOrder : ℝ) := one_mul _ + calc + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder = + coefficient * max + (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) := by + simp only [corvajaZannierCurrentOrderEnvelope] + dsimp [coefficient, divisorCount] + ring + _ = max + (coefficient * (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3))) + (coefficient * (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ))) := + mul_max_of_nonneg _ _ hcoefficientNonneg + _ < (currentOrder : ℝ) := max_lt hrootTerm hquotientTerm + +/-- The paper's middle-game pigeonhole step, now fed by the real-valued Corvaja--Zannier +estimate. The estimate is stated using the actual subgroup cardinality, and `hrightOrder` +performs the indispensable identification of that cardinality with the divisor `d` indexing the +union. + +The sole remaining numerical premise is exactly the inequality needed after summing over all +candidate orders. -/ +theorem exists_left_element_escaping_of_corvajaZannierEstimate + (p : ℕ) (sigma : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + Nat.card (rightSubgroup d) = d) + (hCZ : sigma ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((traceEquationSolutions sigma H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) + (Nat.card (rightSubgroup d))) + (hsigma : sigma ≠ 1) + (hsmall : + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p (Nat.card H₁) < + (Nat.card H₁ : ℝ)) : + ∃ h₁ : H₁, ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ∀ h₂ : rightSubgroup d, + twistedUnitTrace sigma h₁ ≠ twistedUnitTrace 1 h₂ := by + classical + let orders := middleGameCandidateOrders p (Nat.card H₁) + let bad := badOrderTraceSupport sigma H₁ orders rightSubgroup + have hCZIndexed : ∀ d ∈ orders, + ((traceEquationSolutions sigma H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) d := by + intro d hd + have hd' : d ∈ middleGameCandidateOrders p (Nat.card H₁) := by + simpa [orders] using hd + have hEstimate := hCZ hsigma d hd' + rw [hrightOrder d hd'] at hEstimate + exact hEstimate + have hbadReal : (bad.card : ℝ) < (Nat.card H₁ : ℝ) := by + calc + (bad.card : ℝ) ≤ + ∑ d ∈ orders, corvajaZannierTraceUpperBound p (Nat.card H₁) d := by + exact badOrderTraceSupport_card_cast_le_sum sigma H₁ orders rightSubgroup _ hCZIndexed + _ ≤ (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p (Nat.card H₁) := by + simpa [orders] using + middleGameCorvajaZannierSum_le_divisorCount_mul_envelope p (Nat.card H₁) + _ < (Nat.card H₁ : ℝ) := hsmall + have hbad : bad.card < Nat.card H₁ := by exact_mod_cast hbadReal + have hexists : ∃ h₁ : H₁, h₁ ∉ bad := by + by_contra hall + push Not at hall + have hle : (Finset.univ : Finset H₁).card ≤ bad.card := + Finset.card_le_card fun h₁ _ ↦ hall h₁ + rw [Finset.card_univ, Fintype.card_eq_nat_card] at hle + exact (Nat.not_le_of_lt hbad) hle + obtain ⟨h₁, hh₁⟩ := hexists + refine ⟨h₁, ?_⟩ + intro d hd h₂ heq + apply hh₁ + exact mem_badOrderTraceSupport_iff.mpr ⟨d, by simpa [orders] using hd, h₂, heq⟩ + +/-- A fully finite version of the paper's Corvaja--Zannier order-escape step. Apart from the +deep estimate itself, its hypotheses are natural-number cardinality and size inequalities. -/ +theorem exists_left_element_escaping_of_corvajaZannierEstimate_and_sizeBounds + (p : ℕ) (sigma : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + Nat.card (rightSubgroup d) = d) + (hCZ : sigma ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((traceEquationSolutions sigma H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) + (Nat.card (rightSubgroup d))) + (hsigma : sigma ≠ 1) + (hcurrentOrder : 0 < Nat.card H₁) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < Nat.card H₁) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * Nat.card H₁ < p) : + ∃ h₁ : H₁, ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ∀ h₂ : rightSubgroup d, + twistedUnitTrace sigma h₁ ≠ twistedUnitTrace 1 h₂ := by + exact exists_left_element_escaping_of_corvajaZannierEstimate p sigma H₁ rightSubgroup + hrightOrder hCZ hsigma + (divisorCount_mul_corvajaZannierEnvelope_lt_currentOrder p (Nat.card H₁) + hcurrentOrder hcube hlinear) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean new file mode 100644 index 0000000000..d8619d621e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean @@ -0,0 +1,124 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +/-! +# The coset form of the middle-game trace equation + +For a general point on a Markoff rotation fiber, the moving torus parameter is not a subgroup +element but an element of a multiplicative coset. This module records the exact change of +variables from the weighted equation + +`alpha * h + beta * h⁻¹ = k + k⁻¹` + +to the paper's twisted equation + +`g + (alpha * beta) * g⁻¹ = k + k⁻¹`, + +where `g` ranges over the coset `alpha * H₁`. In particular, this change of variables does not +turn the coset into a subgroup. Any Corvaja--Zannier input used for an arbitrary starting point +must therefore cover these multiplicative cosets. +-/ + +namespace BGS.Markoff + +variable {E : Type*} [Field E] [Fintype E] + +/-- Regard a nonzero scalar as a unit. -/ +def scalarUnit (alpha : E) (halpha : alpha ≠ 0) : Eˣ := Units.mk0 alpha halpha + +/-- The left coset of `H` obtained by multiplying by the nonzero scalar `alpha`. -/ +noncomputable def scaledLeftCoset + (alpha : E) (halpha : alpha ≠ 0) (H : Subgroup Eˣ) : Finset Eˣ := by + classical + exact Finset.univ.image fun h : H ↦ scalarUnit alpha halpha * (h : Eˣ) + +@[simp] +theorem mem_scaledLeftCoset_iff + (alpha : E) (halpha : alpha ≠ 0) (H : Subgroup Eˣ) (g : Eˣ) : + g ∈ scaledLeftCoset alpha halpha H ↔ + ∃ h : H, scalarUnit alpha halpha * (h : Eˣ) = g := by + classical + simp [scaledLeftCoset] + +/-- Scale the left coordinate of a pair by `alpha`. -/ +def scaleLeftPair + (alpha : E) (halpha : alpha ≠ 0) (H₁ H₂ : Subgroup Eˣ) : + H₁ × H₂ → Eˣ × H₂ := + fun h ↦ (scalarUnit alpha halpha * (h.1 : Eˣ), h.2) + +omit [Fintype E] in +theorem scaleLeftPair_injective + (alpha : E) (halpha : alpha ≠ 0) (H₁ H₂ : Subgroup Eˣ) : + Function.Injective (scaleLeftPair alpha halpha H₁ H₂) := by + intro x y hxy + apply Prod.ext + · apply Subtype.ext + apply Units.ext + have hfirst := congrArg (fun z : Eˣ × H₂ ↦ (z.1 : E)) hxy + simpa [scaleLeftPair, scalarUnit] using + (mul_left_cancel₀ halpha hfirst) + · simpa [scaleLeftPair] using congrArg Prod.snd hxy + +omit [Fintype E] in +/-- The weighted and coset equations agree pointwise after the change of variables +`g = alpha * h`. -/ +theorem weightedSplitTorusTrace_eq_twistedUnitTrace_scaled + (alpha beta : E) (halpha : alpha ≠ 0) (h : Eˣ) : + weightedSplitTorusTrace alpha beta h = + twistedUnitTrace (alpha * beta) (scalarUnit alpha halpha * h) := by + simp only [weightedSplitTorusTrace, twistedUnitTrace, scalarUnit, Units.val_mul, + Units.val_mk0, Units.val_inv_eq_inv_val] + field_simp [halpha, Units.ne_zero h] + +/-- The actual solution finset, transported to the multiplicative coset in the left variable. -/ +noncomputable def cosetTraceEquationSolutionsOfWeights + (alpha beta : E) (halpha : alpha ≠ 0) (H₁ H₂ : Subgroup Eˣ) : + Finset (Eˣ × H₂) := by + classical + exact (weightedTraceEquationSolutions alpha beta H₁ H₂).image + (scaleLeftPair alpha halpha H₁ H₂) + +@[simp] +theorem mem_cosetTraceEquationSolutionsOfWeights_iff + (alpha beta : E) (halpha : alpha ≠ 0) (H₁ H₂ : Subgroup Eˣ) + (g : Eˣ × H₂) : + g ∈ cosetTraceEquationSolutionsOfWeights alpha beta halpha H₁ H₂ ↔ + g.1 ∈ scaledLeftCoset alpha halpha H₁ ∧ + twistedUnitTrace (alpha * beta) g.1 = splitTorusTrace g.2 := by + classical + constructor + · intro hg + rw [cosetTraceEquationSolutionsOfWeights, Finset.mem_image] at hg + obtain ⟨h, hh, rfl⟩ := hg + constructor + · exact (mem_scaledLeftCoset_iff alpha halpha H₁ _).2 ⟨h.1, rfl⟩ + · change twistedUnitTrace (alpha * beta) + (scalarUnit alpha halpha * (h.1 : Eˣ)) = splitTorusTrace h.2 + rw [← weightedSplitTorusTrace_eq_twistedUnitTrace_scaled alpha beta halpha h.1] + exact mem_weightedTraceEquationSolutions_iff.mp hh + · rintro ⟨hcoset, hequation⟩ + obtain ⟨h₁, hh₁⟩ := + (mem_scaledLeftCoset_iff alpha halpha H₁ g.1).mp hcoset + rw [cosetTraceEquationSolutionsOfWeights, Finset.mem_image] + refine ⟨(h₁, g.2), ?_, ?_⟩ + · apply mem_weightedTraceEquationSolutions_iff.mpr + rw [weightedSplitTorusTrace_eq_twistedUnitTrace_scaled alpha beta halpha h₁] + simpa [hh₁] using hequation + · exact Prod.ext hh₁ (Subtype.ext rfl) + +/-- Scaling the left variable is injective, so the weighted subgroup equation and its exact +coset form have the same number of solutions. -/ +theorem cosetTraceEquationSolutionsOfWeights_card + (alpha beta : E) (halpha : alpha ≠ 0) (H₁ H₂ : Subgroup Eˣ) : + (cosetTraceEquationSolutionsOfWeights alpha beta halpha H₁ H₂).card = + (weightedTraceEquationSolutions alpha beta H₁ H₂).card := by + classical + exact Finset.card_image_of_injective _ + (scaleLeftPair_injective alpha halpha H₁ H₂) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean new file mode 100644 index 0000000000..928e051d30 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean @@ -0,0 +1,151 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape + +/-! +# Diagonalizing an arbitrary nonzero nonparabolic Markoff fiber + +This module closes the algebraic interface required by the weighted middle-game order escape. +Every normalized Markoff point whose fixed coordinate is nonzero and nonparabolic becomes an +explicit `splitFiberPoint w s` after scalar extension to the canonical quadratic field. + +The trace-zero fiber is excluded explicitly. Its conic is singular and the existing +`splitFiberEquiv` / `quadraticNormFiberEquiv` APIs correctly require nonzero trace; no false torus +parametrization is introduced for that branch. +-/ + +namespace BGS.Markoff + +/-- The singular trace-zero rotation has order at most four. This keeps the trace-zero fiber +outside every middle-game range whose current order is greater than four, without pretending +that its singular conic is a torus. -/ +theorem rotationOrder_zero_le_four + (p : ℕ) [Fact p.Prime] : rotationOrder (0 : ZMod p) ≤ 4 := by + rw [rotationOrder] + apply orderOf_le_of_pow_eq_one (by norm_num) + apply Matrix.SpecialLinearGroup.ext + intro i j + fin_cases i <;> fin_cases j <;> + norm_num [rhoSL, rho, pow_succ, Matrix.mul_apply, Fin.sum_univ_two] + +/-- Scalar extension carries the explicit split fiber parametrization to the corresponding +parametrization over the quadratic field. -/ +theorem algebraMapNormalizedPoint_splitFiberPoint + (p : ℕ) [Fact p.Prime] (w s : (ZMod p)ˣ) : + algebraMapNormalizedPoint p (splitFiberPoint w s) = + splitFiberPoint + (Units.map (algebraMap (ZMod p) (quadraticFiniteField p)).toMonoidHom w) + (Units.map (algebraMap (ZMod p) (quadraticFiniteField p)).toMonoidHom s) := by + let phi := algebraMap (ZMod p) (quadraticFiniteField p) + let mapUnit : (ZMod p)ˣ →* (quadraticFiniteField p)ˣ := Units.map phi.toMonoidHom + have htrace : phi (splitTorusTrace w) = splitTorusTrace (mapUnit w) := by + rw [splitTorusTrace, splitTorusTrace, map_add] + rfl + have hproduct : phi (splitFiberProduct w) = splitFiberProduct (mapUnit w) := by + rw [splitFiberProduct, splitFiberProduct, map_div₀, map_sub, map_pow, map_ofNat, htrace] + ext + · exact htrace + · change phi ((s : ZMod p) + splitFiberProduct w * ((s⁻¹ : (ZMod p)ˣ) : ZMod p)) = _ + rw [map_add, map_mul, hproduct] + rfl + · change phi ((s : ZMod p) * (w : ZMod p) + + splitFiberProduct w * ((s⁻¹ : (ZMod p)ˣ) : ZMod p) * + ((w⁻¹ : (ZMod p)ˣ) : ZMod p)) = _ + rw [map_add, map_mul, map_mul, map_mul, hproduct] + rfl + +/-- Every normalized nonzero nonparabolic fiber point admits the diagonalized scalar-extension +presentation consumed by `exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber`. -/ +theorem exists_diagonalizedFiberPoint_of_nonzero_nonparabolic + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) : + ∃ w s : (quadraticFiniteField p)ˣ, + (w : quadraticFiniteField p) ^ 2 ≠ 1 ∧ + algebraMapNormalizedPoint p x = splitFiberPoint w s := by + rcases exists_split_or_quadraticNormOneTrace p hpTwo x.u1 hnonparabolic with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · let xp : ↑(normalizedFiber1 (splitTorusTrace w)) := + ⟨x, hx, htrace.symm⟩ + have htraceNonzero : splitTorusTrace w ≠ 0 := by + rw [htrace] + exact hnonzero + let s : (ZMod p)ˣ := (splitFiberEquiv w hw htraceNonzero).symm xp + have hsPoint : splitFiberPoint w s = x := + congrArg Subtype.val ((splitFiberEquiv w hw htraceNonzero).apply_symm_apply xp) + let embedding : (ZMod p)ˣ →* (quadraticFiniteField p)ˣ := + Units.map (algebraMap (ZMod p) (quadraticFiniteField p)).toMonoidHom + let extensionW : (quadraticFiniteField p)ˣ := embedding w + let extensionS : (quadraticFiniteField p)ˣ := embedding s + have hExtensionW : (extensionW : quadraticFiniteField p) ^ 2 ≠ 1 := by + intro hpower + apply hw + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + rw [map_pow, map_one] + exact hpower + refine ⟨extensionW, extensionS, hExtensionW, ?_⟩ + calc + algebraMapNormalizedPoint p x = + algebraMapNormalizedPoint p (splitFiberPoint w s) := by rw [hsPoint] + _ = splitFiberPoint extensionW extensionS := by + exact algebraMapNormalizedPoint_splitFiberPoint p w s + · let xp : ↑(normalizedFiber1 x.u1) := ⟨x, hx, rfl⟩ + let s := (quadraticNormFiberEquiv p x.u1 hnonparabolic hnonzero w htrace hw).symm xp + have hsPoint : quadraticNormFiberPoint p x.u1 hnonparabolic hnonzero w s = x := + congrArg Subtype.val + ((quadraticNormFiberEquiv p x.u1 hnonparabolic hnonzero w htrace hw).apply_symm_apply xp) + refine ⟨(w : (quadraticFiniteField p)ˣ), s.1, hw, ?_⟩ + calc + algebraMapNormalizedPoint p x = + algebraMapNormalizedPoint p + (quadraticNormFiberPoint p x.u1 hnonparabolic hnonzero w s) := by rw [hsPoint] + _ = splitFiberPoint (w : (quadraticFiniteField p)ˣ) s.1 := + algebraMap_quadraticNormFiberPoint p x.u1 hnonparabolic hnonzero w htrace s + +/-- Complete nonzero nonparabolic middle-game order escape. All algebraic and combinatorial +wiring is discharged internally. The only deep hypothesis is the weighted Corvaja--Zannier +estimate, stated uniformly for whichever split or norm-one diagonalization the point has. -/ +theorem exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < + rotationOrder x.u1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * + rotationOrder x.u1 < p) + (hCZ : + ∀ (w s : (quadraticFiniteField p)ˣ), + (w : quadraticFiniteField p) ^ 2 ≠ 1 → + algebraMapNormalizedPoint p x = splitFiberPoint w s → + (s : quadraticFiniteField p) * + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (rotationOrder x.u1), + ((weightedTraceEquationSolutions + (s : quadraticFiniteField p) + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) + (Subgroup.zpowers w) (middleGameRightSubgroup p d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (rotationOrder x.u1) + (Nat.card (middleGameRightSubgroup p d))) : + ∃ n : ℕ, + rotationOrder x.u1 < rotationOrder ((normalizedRotate1^[n]) x).u2 := by + obtain ⟨w, s, hw, hpoint⟩ := + exists_diagonalizedFiberPoint_of_nonzero_nonparabolic + p hpTwo x hx hnonzero hnonparabolic + exact exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber + p hpTwo delta hdelta x w s hw hpoint hbelowEndgame hcube hlinear + (hCZ w s hw hpoint) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean new file mode 100644 index 0000000000..24e8d810d5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean @@ -0,0 +1,183 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep + +namespace BGS.Markoff + +open Filter +open scoped Topology + +theorem eventually_const_mul_rpow_lt_rpow + {C a b : ℝ} (hab : a < b) : + ∀ᶠ n : ℕ in atTop, C * (n : ℝ) ^ a < (n : ℝ) ^ b := by + have hExponent : 0 < b - a := sub_pos.mpr hab + have hEventuallyConstant : + ∀ᶠ n : ℕ in atTop, C < (n : ℝ) ^ (b - a) := + ((tendsto_rpow_atTop hExponent).comp tendsto_natCast_atTop_atTop).eventually + (eventually_gt_atTop C) + filter_upwards [hEventuallyConstant, eventually_gt_atTop 0] with n hC hn + have hnRealPos : (0 : ℝ) < n := by exact_mod_cast hn + calc + C * (n : ℝ) ^ a < (n : ℝ) ^ (b - a) * (n : ℝ) ^ a := + mul_lt_mul_of_pos_right hC (Real.rpow_pos_of_pos hnRealPos _) + _ = (n : ℝ) ^ b := by + rw [← Real.rpow_add hnRealPos] + congr 1 + ring + +theorem exists_threshold_middleGameDivisorCount_le_two_mul_rpow + {ε : ℝ} (hε : 0 < ε) : + ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) ≤ + 2 * ((p + 1 : ℕ) : ℝ) ^ ε := by + obtain ⟨N, hN⟩ := BGS.NumberTheory.exists_threshold_card_divisors_le_rpow hε + refine ⟨N + 1, ?_⟩ + intro p hp + have hpMinus : N ≤ p - 1 := by omega + have hpPlus : N ≤ p + 1 := by omega + have hMinus := hN (p - 1) hpMinus + have hPlus := hN (p + 1) hpPlus + have hBase : (((p - 1 : ℕ) : ℝ)) ≤ (((p + 1 : ℕ) : ℝ)) := by + exact_mod_cast (show p - 1 ≤ p + 1 by omega) + have hPower : (((p - 1 : ℕ) : ℝ)) ^ ε ≤ (((p + 1 : ℕ) : ℝ)) ^ ε := + Real.rpow_le_rpow (Nat.cast_nonneg _) hBase hε.le + have hPlus' : ((p + 1).divisors.card : ℝ) ≤ ((p : ℝ) + 1) ^ ε := by + simpa only [Nat.cast_add, Nat.cast_one] using hPlus + have hPower' : (((p - 1 : ℕ) : ℝ)) ^ ε ≤ ((p : ℝ) + 1) ^ ε := by + simpa only [Nat.cast_add, Nat.cast_one] using hPower + norm_num only [Nat.cast_add, Nat.cast_one] + calc + ((p - 1).divisors.card : ℝ) + ((p + 1).divisors.card : ℝ) ≤ + (((p - 1 : ℕ) : ℝ)) ^ ε + ((p : ℝ) + 1) ^ ε := + add_le_add hMinus hPlus' + _ ≤ ((p : ℝ) + 1) ^ ε + ((p : ℝ) + 1) ^ ε := + add_le_add hPower' (le_refl _) + _ = 2 * ((p : ℝ) + 1) ^ ε := by ring + +theorem eventually_corvajaZannierDivisorCount_le_rpow + {ε : ℝ} (hε : 0 < ε) : + ∀ᶠ p : ℕ in atTop, + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℝ) ≤ + ((2 * corvajaZannierCorollaryTwoSafeCoefficient : ℕ) * (2 : ℝ) ^ ε) * + (p : ℝ) ^ ε := by + obtain ⟨threshold, hthreshold⟩ := + exists_threshold_middleGameDivisorCount_le_two_mul_rpow hε + filter_upwards [eventually_ge_atTop threshold, eventually_ge_atTop 1] with p hp hpOne + have hdivisor := hthreshold p hp + have hpCast : (0 : ℝ) ≤ p := Nat.cast_nonneg p + have hbase : (((p + 1 : ℕ) : ℝ)) ≤ 2 * (p : ℝ) := by + norm_num only [Nat.cast_add, Nat.cast_one] + exact_mod_cast (show p + 1 ≤ 2 * p by omega) + have hpower : (((p + 1 : ℕ) : ℝ)) ^ ε ≤ (2 * (p : ℝ)) ^ ε := + Real.rpow_le_rpow (Nat.cast_nonneg _) hbase hε.le + calc + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℝ) = + corvajaZannierCorollaryTwoSafeCoefficient * + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) := by + norm_num + _ ≤ corvajaZannierCorollaryTwoSafeCoefficient * + (2 * (((p + 1 : ℕ) : ℝ)) ^ ε) := + mul_le_mul_of_nonneg_left hdivisor (by + simp [corvajaZannierCorollaryTwoSafeCoefficient]) + _ ≤ corvajaZannierCorollaryTwoSafeCoefficient * + (2 * (2 * (p : ℝ)) ^ ε) := by gcongr + _ = ((2 * corvajaZannierCorollaryTwoSafeCoefficient : ℕ) * (2 : ℝ) ^ ε) * + (p : ℝ) ^ ε := by + rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 2) hpCast] + norm_num [corvajaZannierCorollaryTwoSafeCoefficient] + ring + +/-- Throughout the genuine middle range, the two finite inequalities needed by the +Corvaja--Zannier escape theorem eventually hold uniformly in the current order. -/ +theorem eventually_middleGame_corvajaZannier_sizeBounds + {δ : ℝ} (hδ : 0 < δ) : + ∀ᶠ p : ℕ in atTop, ∀ currentOrder : ℕ, + (p : ℝ) ^ δ < currentOrder → + (currentOrder : ℝ) < (p : ℝ) ^ (1 - δ) → + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < currentOrder ∧ + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p := by + let ε : ℝ := δ / 6 + let C : ℝ := + (2 * corvajaZannierCorollaryTwoSafeCoefficient : ℕ) * (2 : ℝ) ^ ε + have hε : 0 < ε := by dsimp [ε]; positivity + have hThreeε : 3 * ε < δ := by dsimp [ε]; linarith + have hLinearExponent : 1 - δ + ε < 1 := by dsimp [ε]; linarith + have hDivisor := eventually_corvajaZannierDivisorCount_le_rpow hε + have hCubeDominance : + ∀ᶠ p : ℕ in atTop, C ^ 3 * (p : ℝ) ^ (3 * ε) < (p : ℝ) ^ δ := + eventually_const_mul_rpow_lt_rpow hThreeε + have hLinearDominance : + ∀ᶠ p : ℕ in atTop, C * (p : ℝ) ^ (1 - δ + ε) < (p : ℝ) ^ (1 : ℝ) := + eventually_const_mul_rpow_lt_rpow hLinearExponent + filter_upwards [hDivisor, hCubeDominance, hLinearDominance, + eventually_ge_atTop 1] with p hDivisor hCubeDominance hLinearDominance hpOne + intro currentOrder hLower hUpper + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast (show 0 < p by omega) + have hpRealNonneg : (0 : ℝ) ≤ p := hpRealPos.le + have hCPos : 0 < C := by + dsimp [C] + simp only [corvajaZannierCorollaryTwoSafeCoefficient] + positivity + have hCurrentNonneg : (0 : ℝ) ≤ currentOrder := Nat.cast_nonneg currentOrder + have hCoeffNonneg : + (0 : ℝ) ≤ corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) := by + simp only [corvajaZannierCorollaryTwoSafeCoefficient] + positivity + have hPowerIdentity : + (C * (p : ℝ) ^ ε) ^ 3 = C ^ 3 * (p : ℝ) ^ (3 * ε) := by + rw [mul_pow] + rw [← Real.rpow_mul_natCast hpRealNonneg ε 3] + congr 2 + ring + have hCubeReal : + (((corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 : ℕ) : ℝ) < + (currentOrder : ℝ) := by + calc + (((corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 : ℕ) : ℝ) = + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℝ) ^ 3 := by + norm_num + _ ≤ (C * (p : ℝ) ^ ε) ^ 3 := + pow_le_pow_left₀ hCoeffNonneg hDivisor 3 + _ = C ^ 3 * (p : ℝ) ^ (3 * ε) := hPowerIdentity + _ < (p : ℝ) ^ δ := hCubeDominance + _ < (currentOrder : ℝ) := hLower + have hLinearIdentity : + (C * (p : ℝ) ^ ε) * (p : ℝ) ^ (1 - δ) = + C * (p : ℝ) ^ (1 - δ + ε) := by + rw [mul_assoc, ← Real.rpow_add hpRealPos] + congr 2 + ring + have hLinearReal : + (((corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder : ℕ) : ℝ)) < + (p : ℝ) := by + calc + (((corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder : ℕ) : ℝ)) = + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℝ) * + (currentOrder : ℝ) := by norm_num + _ ≤ (C * (p : ℝ) ^ ε) * (currentOrder : ℝ) := + mul_le_mul_of_nonneg_right hDivisor hCurrentNonneg + _ < (C * (p : ℝ) ^ ε) * (p : ℝ) ^ (1 - δ) := + mul_lt_mul_of_pos_left hUpper (mul_pos hCPos (Real.rpow_pos_of_pos hpRealPos _)) + _ = C * (p : ℝ) ^ (1 - δ + ε) := hLinearIdentity + _ < (p : ℝ) ^ (1 : ℝ) := hLinearDominance + _ = (p : ℝ) := by simp + constructor + · exact_mod_cast hCubeReal + · exact_mod_cast hLinearReal + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean new file mode 100644 index 0000000000..7ea5068683 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean @@ -0,0 +1,122 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing +import Mathlib.Tactic + +/-! +# Right-inversion pairing with Euler budget seven + +For bidegree `(2,2)` and Euler budget `7`, the source cube-root branch is +`3 * (56mn)^(1/3)`. Right-coordinate inversion divides the nonparabolic +support by two. The resulting root coefficient has cube + +`((3/2) * 56^(1/3))^3 = 189`. + +The quotient-by-characteristic coefficient remains exactly `24`. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The exact right-inversion-paired χ≤7 numerical bound. -/ +def pairedEulerSevenCorvajaZannierTraceUpperBound + (p leftOrder rightOrder : ℕ) : ℝ := + max + ((3 / 2 : ℝ) * + (56 * ((leftOrder * rightOrder : ℕ) : ℝ)) ^ ((1 : ℝ) / 3)) + (24 * (((leftOrder * rightOrder : ℕ) : ℝ) / p)) + +/-- The source χ≤7 bound is exactly twice the paired bound. -/ +theorem + corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_seven_eq_twice_paired + (p leftOrder rightOrder : ℕ) : + corvajaZannierCorollaryTwoNumericalBound + p leftOrder rightOrder 2 2 7 = + 2 * pairedEulerSevenCorvajaZannierTraceUpperBound + p leftOrder rightOrder := by + let x : ℝ := ((leftOrder * rightOrder : ℕ) : ℝ) + have horders : + (((leftOrder * rightOrder * 2 * 2 : ℕ) : ℝ)) = 4 * x := by + simp [x] + ring + unfold corvajaZannierCorollaryTwoNumericalBound + pairedEulerSevenCorvajaZannierTraceUpperBound + rw [horders] + rw [mul_max_of_nonneg _ _ (by norm_num : (0 : ℝ) ≤ 2)] + rw [show 2 * (4 * x) * 7 = 56 * x by ring] + dsimp only [x] + congr 1 <;> ring + +/-- The weighted-trace χ≤7 theorem combined with right inversion gives the +exact nonparabolic left-support estimate whose root coefficient cubes to +`189`. -/ +theorem + weightedTraceEquationNonparabolicLeftSupport_card_cast_le_pairedEulerSeven + (p : ℕ) [Fact p.Prime] + (E : Type*) [Field E] [Fintype E] [DecidableEq E] [CharP E p] + (alpha beta : E) (Hleft Hright : Subgroup Eˣ) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) : + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft Hright).card : ℝ) ≤ + pairedEulerSevenCorvajaZannierTraceUpperBound + p (Nat.card Hleft) (Nat.card Hright) := by + obtain ⟨hleftPositive, hrightPositive, hleftPrime, hrightPrime⟩ := + multiplicativeSubgroups_satisfy_weightedTraceBoundOrderHypotheses + p E Hleft Hright + have hsource := + weightedTraceTorsionIntersection_card_cast_le_eulerSeven + (p := p) alpha beta hadmissible + (Nat.card Hright) (Nat.card Hleft) + hrightPositive hleftPositive hrightPrime hleftPrime + rw [generalTorusTorsionIntersection_weightedTrace_eq] at hsource + have hsolutions : + ((weightedTraceEquationSolutions alpha beta Hleft Hright).card : ℝ) ≤ + corvajaZannierCorollaryTwoNumericalBound + p (Nat.card Hleft) (Nat.card Hright) 2 2 7 := by + calc + ((weightedTraceEquationSolutions alpha beta Hleft Hright).card : ℝ) ≤ + ((weightedTraceCurveTorsionIntersection alpha beta + (Nat.card Hleft) (Nat.card Hright)).card : ℝ) := by + exact_mod_cast + weightedTraceEquationSolutions_card_le_curveTorsionIntersection + alpha beta Hleft Hright + _ ≤ corvajaZannierCorollaryTwoNumericalBound + p (Nat.card Hright) (Nat.card Hleft) 2 2 7 := hsource + _ = corvajaZannierCorollaryTwoNumericalBound + p (Nat.card Hleft) (Nat.card Hright) 2 2 7 := by + unfold corvajaZannierCorollaryTwoNumericalBound + congr 1 <;> simp [Nat.mul_comm] + have hpaired : + 2 * ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft Hright).card : ℝ) ≤ + ((weightedTraceEquationSolutions alpha beta Hleft Hright).card : ℝ) := by + exact_mod_cast + two_mul_weightedTraceEquationNonparabolicLeftSupport_card_le_solutions + alpha beta Hleft Hright + have htwice : + 2 * ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft Hright).card : ℝ) ≤ + 2 * pairedEulerSevenCorvajaZannierTraceUpperBound + p (Nat.card Hleft) (Nat.card Hright) := by + calc + 2 * ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft Hright).card : ℝ) ≤ + ((weightedTraceEquationSolutions + alpha beta Hleft Hright).card : ℝ) := hpaired + _ ≤ corvajaZannierCorollaryTwoNumericalBound + p (Nat.card Hleft) (Nat.card Hright) 2 2 7 := hsolutions + _ = 2 * pairedEulerSevenCorvajaZannierTraceUpperBound + p (Nat.card Hleft) (Nat.card Hright) := by + rw [ + corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_seven_eq_twice_paired] + nlinarith + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean new file mode 100644 index 0000000000..2f1de113b0 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean @@ -0,0 +1,57 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights + +/-! +# Unconditional Euler-seven paired maximal-divisor middle-game escape + +The exact support-index and Euler-characteristic calculation improves the +paired cube condition from `(6 * K)^3 < d` to `189 * K^3 < d`. +-/ + +namespace BGS.Markoff + +/-- Diagonalize a nonzero nonparabolic fiber and apply the exact +Euler-seven paired maximal-order escape theorem. -/ +theorem + exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic_eulerSevenPairedMaximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + 189 * + (middleGameMaximalOrders p (rotationOrder x.u1)).card ^ 3 < + rotationOrder x.u1) + (hlinear : + 24 * (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + obtain ⟨w, s, hw, hpoint⟩ := + exists_diagonalizedFiberPoint_of_nonzero_nonparabolic + p hpTwo x hx hnonzero hnonparabolic + have hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible + (s : quadraticFiniteField p) + (splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)) := + diagonalizedFiber_weightedTraceCurve_isCorvajaZannierAdmissible + p hpTwo x hnonzero w s hw hpoint + exact + exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber_eulerSevenPairedMaximalOrders + p hpTwo delta hdelta x w s hw hpoint hadmissible + hbelowEndgame hcube hlinear + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean new file mode 100644 index 0000000000..eb3db991e3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound +import Mathlib.Tactic + +/-! +# Euler-seven paired escape over maximal candidate orders + +The exact χ≤7 paired bound gives two sufficient inequalities: + +* `189 * K^3 < currentOrder`; +* `24 * K * currentOrder < p`. + +Here `K` is the number of divisibility-maximal candidate orders. The first +coefficient is exact: it is the cube of the paired χ≤7 root coefficient. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {E : Type*} [Field E] [Fintype E] + +private theorem rpow_one_third_cube_eulerSeven {x : ℝ} (hx : 0 ≤ x) : + (x ^ ((1 : ℝ) / 3)) ^ (3 : ℕ) = x := by + rw [← Real.rpow_mul_natCast hx] + norm_num + +/-- A common χ≤7 paired bound for every candidate right order at most the +current left order. -/ +def pairedEulerSevenCurrentOrderEnvelope + (p currentOrder : ℕ) : ℝ := + max + ((3 / 2 : ℝ) * + (56 * ((currentOrder * currentOrder : ℕ) : ℝ)) ^ + ((1 : ℝ) / 3)) + (24 * (((currentOrder * currentOrder : ℕ) : ℝ) / p)) + +theorem pairedEulerSevenTraceUpperBound_le_currentOrderEnvelope + (p currentOrder d : ℕ) (hd : d ≤ currentOrder) : + pairedEulerSevenCorvajaZannierTraceUpperBound p currentOrder d ≤ + pairedEulerSevenCurrentOrderEnvelope p currentOrder := by + have hmulNat : currentOrder * d ≤ currentOrder * currentOrder := + Nat.mul_le_mul_left currentOrder hd + have hmul : (((currentOrder * d : ℕ) : ℝ)) ≤ + (((currentOrder * currentOrder : ℕ) : ℝ)) := by + exact_mod_cast hmulNat + unfold pairedEulerSevenCorvajaZannierTraceUpperBound + pairedEulerSevenCurrentOrderEnvelope + exact max_le_max + (mul_le_mul_of_nonneg_left + (Real.rpow_le_rpow + (by positivity : (0 : ℝ) ≤ 56 * ((currentOrder * d : ℕ) : ℝ)) + (mul_le_mul_of_nonneg_left hmul (by norm_num)) + (by norm_num)) + (by norm_num)) + (mul_le_mul_of_nonneg_left + (div_le_div_of_nonneg_right hmul (Nat.cast_nonneg p)) + (by norm_num)) + +theorem + middleGameMaximalPairedEulerSevenSum_le_card_mul_envelope + (p currentOrder : ℕ) (hp : 1 < p) : + (∑ d ∈ middleGameMaximalOrders p currentOrder, + pairedEulerSevenCorvajaZannierTraceUpperBound + p currentOrder d) ≤ + ((middleGameMaximalOrders p currentOrder).card : ℝ) * + pairedEulerSevenCurrentOrderEnvelope p currentOrder := by + classical + calc + (∑ d ∈ middleGameMaximalOrders p currentOrder, + pairedEulerSevenCorvajaZannierTraceUpperBound + p currentOrder d) ≤ + ∑ _d ∈ middleGameMaximalOrders p currentOrder, + pairedEulerSevenCurrentOrderEnvelope p currentOrder := by + exact Finset.sum_le_sum fun d hd ↦ + pairedEulerSevenTraceUpperBound_le_currentOrderEnvelope + p currentOrder d + (mem_middleGameCandidateOrders_iff.mp + (middleGameMaximalOrders_subset_candidateOrders hp hd)).1 + _ = ((middleGameMaximalOrders p currentOrder).card : ℝ) * + pairedEulerSevenCurrentOrderEnvelope p currentOrder := by + simp + +/-- The exact coefficient-`189` cube condition and the coefficient-`24` +linear condition make the whole maximal-order envelope smaller than the +current order. -/ +theorem orderCount_mul_pairedEulerSevenEnvelope_lt_currentOrder + (p currentOrder orderCount : ℕ) + (hcurrentOrder : 0 < currentOrder) + (hcube : 189 * orderCount ^ 3 < currentOrder) + (hlinear : 24 * orderCount * currentOrder < p) : + (orderCount : ℝ) * + pairedEulerSevenCurrentOrderEnvelope p currentOrder < + (currentOrder : ℝ) := by + let rootTerm : ℝ := + (orderCount : ℝ) * ((3 / 2 : ℝ) * + (56 * ((currentOrder * currentOrder : ℕ) : ℝ)) ^ + ((1 : ℝ) / 3)) + let linearCoefficient : ℝ := 24 * orderCount + have horderPos : (0 : ℝ) < currentOrder := by + exact_mod_cast hcurrentOrder + have hradicand : + (0 : ℝ) ≤ + 56 * ((currentOrder * currentOrder : ℕ) : ℝ) := by + positivity + have hrootCube : + ((56 * ((currentOrder * currentOrder : ℕ) : ℝ)) ^ + ((1 : ℝ) / 3)) ^ (3 : ℕ) = + 56 * ((currentOrder * currentOrder : ℕ) : ℝ) := + rpow_one_third_cube_eulerSeven hradicand + have hrootTermCube : + rootTerm ^ 3 = + 189 * (orderCount : ℝ) ^ 3 * (currentOrder : ℝ) ^ 2 := by + dsimp only [rootTerm] + rw [mul_pow, mul_pow, hrootCube] + push_cast + ring + have hcubeScaledNat : + 189 * orderCount ^ 3 * currentOrder ^ 2 < + currentOrder ^ 3 := by + have h := + Nat.mul_lt_mul_of_pos_right hcube + (show 0 < currentOrder ^ 2 from Nat.pow_pos hcurrentOrder) + simpa [pow_succ, mul_assoc] using h + have hcubeScaled : + 189 * (orderCount : ℝ) ^ 3 * (currentOrder : ℝ) ^ 2 < + (currentOrder : ℝ) ^ 3 := by + exact_mod_cast hcubeScaledNat + have hrootTerm : rootTerm < (currentOrder : ℝ) := by + apply lt_of_pow_lt_pow_left₀ 3 (Nat.cast_nonneg currentOrder) + rw [hrootTermCube] + exact hcubeScaled + have hlinearReal : + linearCoefficient * (currentOrder : ℝ) < (p : ℝ) := by + dsimp only [linearCoefficient] + exact_mod_cast hlinear + have hpPos : (0 : ℝ) < p := by + have : 0 < p := by omega + exact_mod_cast this + have hquotientTerm : + linearCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) < + (currentOrder : ℝ) := by + have hratio : + linearCoefficient * (currentOrder : ℝ) / (p : ℝ) < 1 := + (div_lt_one hpPos).2 hlinearReal + calc + linearCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) = + (linearCoefficient * (currentOrder : ℝ) / (p : ℝ)) * + (currentOrder : ℝ) := by + rw [Nat.cast_mul] + ring + _ < 1 * (currentOrder : ℝ) := + mul_lt_mul_of_pos_right hratio horderPos + _ = (currentOrder : ℝ) := one_mul _ + calc + (orderCount : ℝ) * + pairedEulerSevenCurrentOrderEnvelope p currentOrder = + max rootTerm + (linearCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ))) := by + rw [pairedEulerSevenCurrentOrderEnvelope, + mul_max_of_nonneg _ _ (Nat.cast_nonneg orderCount)] + dsimp only [rootTerm, linearCoefficient] + push_cast + congr 1 <;> ring + _ < (currentOrder : ℝ) := max_lt hrootTerm hquotientTerm + +/-- Finite nonparabolic escape over maximal candidate orders with the exact +χ≤7 cube coefficient `189`. -/ +theorem exists_left_element_escaping_nonparabolic_maximalOrders_eulerSeven + (p : ℕ) [Fact p.Prime] + (E : Type*) [Field E] [Fintype E] [DecidableEq E] [CharP E p] + (alpha beta : E) (Hleft : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + Nat.card (rightSubgroup d) = d) + (hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (hcurrentOrder : 0 < Nat.card Hleft) + (hp : 1 < p) + (hcube : + 189 * (middleGameMaximalOrders p (Nat.card Hleft)).card ^ 3 < + Nat.card Hleft) + (hlinear : + 24 * (middleGameMaximalOrders p (Nat.card Hleft)).card * + Nat.card Hleft < p) : + ∃ hleft : Hleft, + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + ∀ hright : rightSubgroup d, + ((hright : Eˣ) ^ 2) ≠ 1 → + weightedSplitTorusTrace alpha beta hleft ≠ + splitTorusTrace hright := by + classical + let orders := middleGameMaximalOrders p (Nat.card Hleft) + let bound : ℕ → ℝ := + fun d ↦ pairedEulerSevenCorvajaZannierTraceUpperBound + p (Nat.card Hleft) d + have hbound : + ∀ d ∈ orders, + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d)).card : ℝ) ≤ bound d := by + intro d hd + have hd' : d ∈ middleGameMaximalOrders p (Nat.card Hleft) := by + simpa [orders] using hd + have h := + weightedTraceEquationNonparabolicLeftSupport_card_cast_le_pairedEulerSeven + p E alpha beta Hleft (rightSubgroup d) hadmissible + rw [hrightOrder d hd'] at h + simpa [bound] using h + have hsmall : (∑ d ∈ orders, bound d) < (Nat.card Hleft : ℝ) := by + calc + (∑ d ∈ orders, bound d) = + ∑ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + pairedEulerSevenCorvajaZannierTraceUpperBound + p (Nat.card Hleft) d := by + simp [orders, bound] + _ ≤ ((middleGameMaximalOrders p (Nat.card Hleft)).card : ℝ) * + pairedEulerSevenCurrentOrderEnvelope + p (Nat.card Hleft) := + middleGameMaximalPairedEulerSevenSum_le_card_mul_envelope + p (Nat.card Hleft) hp + _ < (Nat.card Hleft : ℝ) := + orderCount_mul_pairedEulerSevenEnvelope_lt_currentOrder + p (Nat.card Hleft) + (middleGameMaximalOrders p (Nat.card Hleft)).card + hcurrentOrder hcube hlinear + obtain ⟨hleft, hleftEscapes⟩ := + exists_left_element_escaping_nonparabolic_orders_of_sum_bound + alpha beta Hleft orders rightSubgroup bound hbound hsmall + refine ⟨hleft, ?_⟩ + intro d hd hright hrightSq + exact hleftEscapes d (by simpa [orders] using hd) hright hrightSq + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean new file mode 100644 index 0000000000..a925dda3d8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep + +/-! +# Euler-seven paired nonparabolic order escape + +This is the diagonalized-fiber wiring for the exact cube condition +`189*K^3 < currentOrder`. +-/ + +namespace BGS.Markoff + +theorem + exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber_eulerSevenPairedMaximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) + (w s : (quadraticFiniteField p)ˣ) + (hw : (w : quadraticFiniteField p) ^ 2 ≠ 1) + (hpoint : algebraMapNormalizedPoint p x = splitFiberPoint w s) + (hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible + (s : quadraticFiniteField p) + (splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p))) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + 189 * + (middleGameMaximalOrders p (rotationOrder x.u1)).card ^ 3 < + rotationOrder x.u1) + (hlinear : + 24 * (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + classical + let alpha : quadraticFiniteField p := s + let beta : quadraticFiniteField p := + splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + let Hleft : Subgroup (quadraticFiniteField p)ˣ := Subgroup.zpowers w + have htrace : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = + splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have horder : orderOf w = rotationOrder x.u1 := by + rw [← rotationOrder_eq_orderOf_extensionEigenvalue x.u1 w hw htrace] + have hleftCard : Nat.card Hleft = rotationOrder x.u1 := by + rw [Nat.card_zpowers, horder] + have hp : 1 < p := (Fact.out : p.Prime).one_lt + have hcurrentOrder : 0 < Nat.card Hleft := by + rw [hleftCard] + exact rotationOrder_pos x.u1 + have hrightOrder : + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + Nat.card (middleGameRightSubgroup p d) = d := by + intro d hd + exact middleGameMaximalOrder_rightSubgroup_natCard + p (Nat.card Hleft) d hp hd + have hcube' : + 189 * + (middleGameMaximalOrders p (Nat.card Hleft)).card ^ 3 < + Nat.card Hleft := by + rw [hleftCard] + exact hcube + have hlinear' : + 24 * (middleGameMaximalOrders p (Nat.card Hleft)).card * + Nat.card Hleft < p := by + rw [hleftCard] + exact hlinear + obtain ⟨h, hEscapes⟩ := + exists_left_element_escaping_nonparabolic_maximalOrders_eulerSeven + p (quadraticFiniteField p) alpha beta Hleft + (fun d ↦ middleGameRightSubgroup p d) + hrightOrder (by simpa [alpha, beta] using hadmissible) + hcurrentOrder hp hcube' hlinear' + obtain ⟨n, hn⟩ := exists_iterate_splitFiberPoint_eq_mul_zpowers w s h + refine ⟨n, ?_⟩ + let y := (normalizedRotate1^[n]) x + have hyPoint : algebraMapNormalizedPoint p y = + splitFiberPoint w (s * (h : (quadraticFiniteField p)ˣ)) := by + calc + algebraMapNormalizedPoint p y = + (normalizedRotate1^[n]) (algebraMapNormalizedPoint p x) := + algebraMapNormalizedPoint_iterate_normalizedRotate1 p n x + _ = (normalizedRotate1^[n]) (splitFiberPoint w s) := by rw [hpoint] + _ = splitFiberPoint w + (s * (h : (quadraticFiniteField p)ˣ)) := hn + apply lt_of_not_ge + intro hsmall + have hnonparabolicY : y.u2 ^ 2 ≠ 4 := by + intro hparabolic + have hcases := + (normalizedTrace_sq_eq_four_iff_parabolic p y.u2).mp hparabolic + have hthreshold := + endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + p hpTwo delta hdelta y.u2 hcases + have hsmallReal : + (rotationOrder y.u2 : ℝ) ≤ (rotationOrder x.u1 : ℝ) := by + exact_mod_cast hsmall + exact (not_le_of_gt hbelowEndgame) (hthreshold.trans hsmallReal) + obtain ⟨m, hm, hright, hrightTrace, hrightSq⟩ := + exists_middleGameMaximalOrder_nonparabolic_trace + p (rotationOrder x.u1) hpTwo hp y.u2 hnonparabolicY hsmall + have hm' : m ∈ middleGameMaximalOrders p (Nat.card Hleft) := by + rw [hleftCard] + exact hm + apply hEscapes m hm' hright hrightSq + have hyCoordinate := congrArg NormalizedPoint.u2 hyPoint + change algebraMap (ZMod p) (quadraticFiniteField p) y.u2 = + (splitFiberPoint w + (s * (h : (quadraticFiniteField p)ˣ))).u2 at hyCoordinate + rw [splitFiberOrbit_secondCoordinate_eq_weightedSplitTorusTrace] + at hyCoordinate + change weightedSplitTorusTrace alpha beta h = splitTorusTrace hright + rw [← hrightTrace] + simpa [alpha, beta] using hyCoordinate.symm + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean new file mode 100644 index 0000000000..6ca2c473f8 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean @@ -0,0 +1,119 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound + +/-! +# Feeding the weighted trace bound into maximal-divisor escape + +The general Corvaja--Zannier theorem already provides a uniform estimate for +all finite multiplicative subgroups. This adapter applies it only to the +divisibility-maximal right subgroups required by the improved middle game. +-/ + +namespace BGS.Markoff + +/-- Diagonalize a nonzero nonparabolic fiber and apply the maximal-order +escape theorem. -/ +theorem exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic_maximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x.u1)).card) ^ 3 < + rotationOrder x.u1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) + (hCZ : + ∀ (w s : (quadraticFiniteField p)ˣ), + (w : quadraticFiniteField p) ^ 2 ≠ 1 → + algebraMapNormalizedPoint p x = splitFiberPoint w s → + (s : quadraticFiniteField p) * + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) ≠ 1 → + ∀ d ∈ middleGameMaximalOrders p (rotationOrder x.u1), + ((weightedTraceEquationSolutions + (s : quadraticFiniteField p) + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) + (Subgroup.zpowers w) (middleGameRightSubgroup p d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (rotationOrder x.u1) + (Nat.card (middleGameRightSubgroup p d))) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + obtain ⟨w, s, hw, hpoint⟩ := + exists_diagonalizedFiberPoint_of_nonzero_nonparabolic + p hpTwo x hx hnonzero hnonparabolic + exact + exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber_maximalOrders + p hpTwo delta hdelta x w s hw hpoint hbelowEndgame hcube hlinear + (hCZ w s hw hpoint) + +/-- The in-repository weighted torsion-intersection theorem supplies every +maximal-order estimate needed by the improved escape step. -/ +theorem exists_iterate_with_larger_secondRotationOrder_of_weightedTraceBound_maximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x.u1)).card) ^ 3 < + rotationOrder x.u1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) + (hBound : + WeightedTraceTorsionIntersectionBound p (quadraticFiniteField p)) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + apply + exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic_maximalOrders + p hpTwo delta hdelta x hx hnonzero hnonparabolic hbelowEndgame + hcube hlinear + intro w s hw hpoint _hnondegenerate d _hd + let alpha : quadraticFiniteField p := s + let beta : quadraticFiniteField p := + splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + let Hleft : Subgroup (quadraticFiniteField p)ˣ := Subgroup.zpowers w + let Hright : Subgroup (quadraticFiniteField p)ˣ := + middleGameRightSubgroup p d + have hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta := by + simpa [alpha, beta] using + diagonalizedFiber_weightedTraceCurve_isCorvajaZannierAdmissible + p hpTwo x hnonzero w s hw hpoint + have hbound := + weightedTraceEquationSolutions_card_cast_le_of_weightedTraceBound + p (quadraticFiniteField p) hBound alpha beta Hleft Hright hadmissible + have htrace : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = + splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have horder : orderOf w = rotationOrder x.u1 := by + rw [← rotationOrder_eq_orderOf_extensionEigenvalue x.u1 w hw htrace] + have hleftCard : Nat.card Hleft = rotationOrder x.u1 := by + rw [Nat.card_zpowers, horder] + simpa [alpha, beta, Hleft, Hright, hleftCard] using hbound + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean new file mode 100644 index 0000000000..54ca308a14 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean @@ -0,0 +1,238 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover + +/-! +# Corvaja--Zannier escape over maximal candidate orders + +The published middle-game union runs over every candidate divisor of `p - 1` +or `p + 1`. Divisibility monotonicity of roots-of-unity subgroups shows that +it is enough to run the union over `middleGameMaximalOrders`: every smaller +candidate subgroup is contained in one of these maximal subgroups. + +This file performs the finite union and its numerical reduction. The deep +Corvaja--Zannier estimate remains an explicit hypothesis about the actual +weighted trace-equation solution sets. +-/ + +namespace BGS.Markoff + +variable {E : Type*} [Field E] [Fintype E] + +/-- The Corvaja--Zannier sum over maximal candidate orders is bounded by the +number of those orders times the common current-order envelope. -/ +theorem middleGameMaximalCorvajaZannierSum_le_card_mul_envelope + (p currentOrder : ℕ) (hp : 1 < p) : + (∑ d ∈ middleGameMaximalOrders p currentOrder, + corvajaZannierTraceUpperBound p currentOrder d) ≤ + ((middleGameMaximalOrders p currentOrder).card : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder := by + classical + calc + (∑ d ∈ middleGameMaximalOrders p currentOrder, + corvajaZannierTraceUpperBound p currentOrder d) ≤ + ∑ _d ∈ middleGameMaximalOrders p currentOrder, + corvajaZannierCurrentOrderEnvelope p currentOrder := by + exact Finset.sum_le_sum fun d hd ↦ + corvajaZannierTraceUpperBound_le_currentOrderEnvelope p currentOrder d + (mem_middleGameCandidateOrders_iff.mp + (middleGameMaximalOrders_subset_candidateOrders hp hd)).1 + _ = ((middleGameMaximalOrders p currentOrder).card : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder := by + simp + +/-- A generic version of the two elementary inequalities controlling the +Corvaja--Zannier envelope. It is deliberately parameterized by the number of +orders in the union, so the maximal-divisor cover can use its much smaller +cardinality. + +Writing `K` for `orderCount`, the hypotheses are + +* `(48 K)^3 < currentOrder`; +* `48 K * currentOrder < p`. +-/ +theorem orderCount_mul_corvajaZannierEnvelope_lt_currentOrder + (p currentOrder orderCount : ℕ) + (hcurrentOrder : 0 < currentOrder) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * orderCount) ^ 3 < + currentOrder) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * orderCount * + currentOrder < p) : + (orderCount : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder < + (currentOrder : ℝ) := by + let coefficient : ℕ := + corvajaZannierCorollaryTwoSafeCoefficient * orderCount + have horderPos : (0 : ℝ) < currentOrder := by + exact_mod_cast hcurrentOrder + have horderNonneg : (0 : ℝ) ≤ currentOrder := horderPos.le + have hcoefficientNonneg : (0 : ℝ) ≤ coefficient := by positivity + have hcubeReal : (coefficient : ℝ) ^ (3 : ℕ) < + (currentOrder : ℝ) := by + dsimp [coefficient] + exact_mod_cast hcube + have hcoefficientRoot : + (coefficient : ℝ) < (currentOrder : ℝ) ^ ((1 : ℝ) / 3) := by + have h := (Real.lt_rpow_inv_iff_of_pos hcoefficientNonneg horderNonneg + (by norm_num : (0 : ℝ) < 3)).2 + have h' : (coefficient : ℝ) < + (currentOrder : ℝ) ^ (3 : ℝ)⁻¹ := + h (by simpa [Real.rpow_natCast] using hcubeReal) + simpa only [one_div] using h' + have hrootPositive : + 0 < (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) := by + positivity + have hcubeRootIdentity : + (currentOrder : ℝ) ^ ((1 : ℝ) / 3) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) = + (currentOrder : ℝ) := by + rw [Nat.cast_mul] + rw [← Real.mul_rpow horderNonneg + (mul_nonneg horderNonneg horderNonneg)] + convert Real.pow_rpow_inv_natCast horderNonneg + (by norm_num : (3 : ℕ) ≠ 0) using 1 + all_goals ring_nf + have hrootTerm : + (coefficient : ℝ) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) < + (currentOrder : ℝ) := by + calc + (coefficient : ℝ) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) < + (currentOrder : ℝ) ^ ((1 : ℝ) / 3) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) := + mul_lt_mul_of_pos_right hcoefficientRoot hrootPositive + _ = (currentOrder : ℝ) := hcubeRootIdentity + have hlinearReal : + (coefficient : ℝ) * (currentOrder : ℝ) < (p : ℝ) := by + dsimp [coefficient] + exact_mod_cast hlinear + have hpPos : (0 : ℝ) < p := by + have : 0 < p := by omega + exact_mod_cast this + have hquotientTerm : + (coefficient : ℝ) * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) < + (currentOrder : ℝ) := by + have hratio : + (coefficient : ℝ) * (currentOrder : ℝ) / (p : ℝ) < 1 := + (div_lt_one hpPos).2 hlinearReal + calc + (coefficient : ℝ) * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) = + ((coefficient : ℝ) * (currentOrder : ℝ) / (p : ℝ)) * + (currentOrder : ℝ) := by + push_cast + ring + _ < 1 * (currentOrder : ℝ) := + mul_lt_mul_of_pos_right hratio horderPos + _ = (currentOrder : ℝ) := one_mul _ + calc + (orderCount : ℝ) * + corvajaZannierCurrentOrderEnvelope p currentOrder = + (coefficient : ℝ) * max + ((((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3))) + ((((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ))) := by + simp only [corvajaZannierCurrentOrderEnvelope] + dsimp [coefficient] + push_cast + ring + _ = max + ((coefficient : ℝ) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3))) + ((coefficient : ℝ) * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ))) := + mul_max_of_nonneg _ _ hcoefficientNonneg + _ < (currentOrder : ℝ) := max_lt hrootTerm hquotientTerm + +/-- The finite weighted Corvaja--Zannier escape step over maximal candidate +orders only. -/ +theorem exists_left_element_escaping_of_weightedCorvajaZannierEstimate_maximalOrders + (p : ℕ) (alpha beta : E) (Hleft : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + Nat.card (rightSubgroup d) = d) + (hCZ : alpha * beta ≠ 1 → + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + ((weightedTraceEquationSolutions alpha beta Hleft + (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card Hleft) + (Nat.card (rightSubgroup d))) + (hnondegenerate : alpha * beta ≠ 1) + (hcurrentOrder : 0 < Nat.card Hleft) + (hp : 1 < p) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (Nat.card Hleft)).card) ^ 3 < + Nat.card Hleft) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (Nat.card Hleft)).card * + Nat.card Hleft < p) : + ∃ hleft : Hleft, + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + ∀ hright : rightSubgroup d, + weightedSplitTorusTrace alpha beta hleft ≠ + splitTorusTrace hright := by + classical + let orders := middleGameMaximalOrders p (Nat.card Hleft) + let bad := + weightedBadOrderTraceSupport alpha beta Hleft orders rightSubgroup + have hCZIndexed : ∀ d ∈ orders, + ((weightedTraceEquationSolutions alpha beta Hleft + (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card Hleft) d := by + intro d hd + have hd' : d ∈ middleGameMaximalOrders p (Nat.card Hleft) := by + simpa [orders] using hd + have hEstimate := hCZ hnondegenerate d hd' + rw [hrightOrder d hd'] at hEstimate + exact hEstimate + have hbadReal : (bad.card : ℝ) < (Nat.card Hleft : ℝ) := by + calc + (bad.card : ℝ) ≤ + ∑ d ∈ orders, + corvajaZannierTraceUpperBound p (Nat.card Hleft) d := by + exact weightedBadOrderTraceSupport_card_cast_le_sum + alpha beta Hleft orders rightSubgroup _ hCZIndexed + _ ≤ ((middleGameMaximalOrders p (Nat.card Hleft)).card : ℝ) * + corvajaZannierCurrentOrderEnvelope p (Nat.card Hleft) := by + simpa [orders] using + middleGameMaximalCorvajaZannierSum_le_card_mul_envelope + p (Nat.card Hleft) hp + _ < (Nat.card Hleft : ℝ) := + orderCount_mul_corvajaZannierEnvelope_lt_currentOrder + p (Nat.card Hleft) + (middleGameMaximalOrders p (Nat.card Hleft)).card + hcurrentOrder hcube hlinear + have hbad : bad.card < Nat.card Hleft := by + exact_mod_cast hbadReal + have hexists : ∃ hleft : Hleft, hleft ∉ bad := by + by_contra hall + push Not at hall + have hle : (Finset.univ : Finset Hleft).card ≤ bad.card := + Finset.card_le_card fun hleft _ ↦ hall hleft + rw [Finset.card_univ, Fintype.card_eq_nat_card] at hle + exact (Nat.not_le_of_lt hbad) hle + obtain ⟨hleft, hleftNotBad⟩ := hexists + refine ⟨hleft, ?_⟩ + intro d hd hright heq + apply hleftNotBad + exact mem_weightedBadOrderTraceSupport_iff.mpr + ⟨d, by simpa [orders] using hd, hright, heq⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean new file mode 100644 index 0000000000..ca35e0750f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean @@ -0,0 +1,62 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover + +/-! +# Nonparabolic witnesses in maximal right-order subgroups + +The maximal-divisor cover already represents every bounded nonparabolic trace +inside a divisibility-maximal right subgroup. This module records the extra +fact needed for inversion pairing: the representing eigenvalue is not fixed +by inversion. +-/ + +namespace BGS.Markoff + +/-- A square-one eigenvalue has parabolic split trace. -/ +theorem splitTorusTrace_sq_eq_four_of_sq_eq_one + {K : Type*} [Field K] (h : Kˣ) (hsq : h ^ 2 = 1) : + (splitTorusTrace h) ^ 2 = 4 := by + have hinv : h = h⁻¹ := by + apply (mul_eq_one_iff_eq_inv.mp) + simpa only [pow_two] using hsq + have hinvValue : ((h⁻¹ : Kˣ) : K) = (h : K) := by + exact congrArg (fun u : Kˣ ↦ (u : K)) hinv.symm + have hsqValue : (h : K) ^ 2 = 1 := by + exact congrArg (fun u : Kˣ ↦ (u : K)) hsq + unfold splitTorusTrace + rw [hinvValue] + calc + ((h : K) + (h : K)) ^ 2 = 4 * (h : K) ^ 2 := by ring + _ = 4 := by rw [hsqValue, mul_one] + +/-- Every bounded nonparabolic trace is represented in a maximal candidate +right subgroup by a non-two-torsion eigenvalue. -/ +theorem exists_middleGameMaximalOrder_nonparabolic_trace + (p currentOrder : ℕ) [Fact p.Prime] + (hpTwo : p ≠ 2) (hp : 1 < p) + (t : ZMod p) (hnonparabolic : t ^ 2 ≠ 4) + (hsmall : rotationOrder t ≤ currentOrder) : + ∃ m ∈ middleGameMaximalOrders p currentOrder, + ∃ h₂ : middleGameRightSubgroup p m, + algebraMap (ZMod p) (quadraticFiniteField p) t = + splitTorusTrace h₂ ∧ + (((h₂ : (quadraticFiniteField p)ˣ) ^ 2) ≠ 1) := by + obtain ⟨m, hm, h₂, htrace⟩ := + exists_middleGameMaximalOrder_trace_of_nonparabolic + p currentOrder hpTwo hp t hnonparabolic hsmall + refine ⟨m, hm, h₂, htrace, ?_⟩ + intro hsq + apply hnonparabolic + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective + have htraceSq : + (splitTorusTrace (h₂ : (quadraticFiniteField p)ˣ)) ^ 2 = 4 := + splitTorusTrace_sq_eq_four_of_sq_eq_one + (h₂ : (quadraticFiniteField p)ˣ) hsq + simpa only [map_pow, map_ofNat, htrace] using htraceSq + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean new file mode 100644 index 0000000000..82fb598224 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean @@ -0,0 +1,102 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds + +/-! +# Maximal candidate orders in the Markoff middle game + +Every ordinary candidate order divides a divisibility-maximal candidate, and +the canonical roots-of-unity subgroups are monotone under that divisibility. +Hence the Corvaja--Zannier union only needs maximal orders. +-/ + +namespace BGS.Markoff + +open BGS.NumberTheory + +def middleGameMaximalOrders (p currentOrder : ℕ) : Finset ℕ := + maximalDivisorsBelow (p - 1) (currentOrder + 1) ∪ + maximalDivisorsBelow (p + 1) (currentOrder + 1) + +theorem middleGameMaximalOrders_card_le + (p currentOrder : ℕ) : + (middleGameMaximalOrders p currentOrder).card ≤ + (maximalDivisorsBelow (p - 1) (currentOrder + 1)).card + + (maximalDivisorsBelow (p + 1) (currentOrder + 1)).card := + Finset.card_union_le _ _ + +theorem middleGameMaximalOrders_subset_candidateOrders + {p currentOrder : ℕ} (hp : 1 < p) : + middleGameMaximalOrders p currentOrder ⊆ + middleGameCandidateOrders p currentOrder := by + intro m hm + rw [middleGameMaximalOrders, Finset.mem_union] at hm + rw [mem_middleGameCandidateOrders_iff] + rcases hm with hm | hm + · have hdata := mem_maximalDivisorsBelow_iff.mp hm + refine ⟨by omega, Or.inl ?_⟩ + exact ⟨(Nat.mem_divisors.mp hdata.1).1, by omega⟩ + · have hdata := mem_maximalDivisorsBelow_iff.mp hm + exact ⟨by omega, Or.inr (Nat.mem_divisors.mp hdata.1).1⟩ + +theorem exists_dvd_middleGameMaximalOrder + {p currentOrder d : ℕ} (hp : 1 < p) + (hd : d ∈ middleGameCandidateOrders p currentOrder) : + ∃ m ∈ middleGameMaximalOrders p currentOrder, d ∣ m := by + have hdbound : d < currentOrder + 1 := + Nat.lt_succ_of_le (mem_middleGameCandidateOrders_iff.mp hd).1 + rcases (mem_middleGameCandidateOrders_iff.mp hd).2 with hminus | hplus + · obtain ⟨m, hm, hdm⟩ := + exists_dvd_maximalDivisorBelow hminus.2 hminus.1 hdbound + exact ⟨m, by + rw [middleGameMaximalOrders, Finset.mem_union] + exact Or.inl hm, hdm⟩ + · obtain ⟨m, hm, hdm⟩ := + exists_dvd_maximalDivisorBelow (by omega : p + 1 ≠ 0) hplus hdbound + exact ⟨m, by + rw [middleGameMaximalOrders, Finset.mem_union] + exact Or.inr hm, hdm⟩ + +theorem middleGameRightSubgroup_mono + (p d m : ℕ) [Fact p.Prime] (hdm : d ∣ m) : + middleGameRightSubgroup p d ≤ middleGameRightSubgroup p m := by + intro u hu + rw [mem_middleGameRightSubgroup_iff_pow_eq_one] at hu ⊢ + obtain ⟨k, rfl⟩ := hdm + rw [pow_mul, hu, one_pow] + +theorem exists_middleGameMaximalOrder_trace_of_nonparabolic + (p currentOrder : ℕ) [Fact p.Prime] + (hpTwo : p ≠ 2) (hp : 1 < p) + (t : ZMod p) (hnonparabolic : t ^ 2 ≠ 4) + (hsmall : rotationOrder t ≤ currentOrder) : + ∃ m ∈ middleGameMaximalOrders p currentOrder, + ∃ h₂ : middleGameRightSubgroup p m, + algebraMap (ZMod p) (quadraticFiniteField p) t = + splitTorusTrace h₂ := by + have hd : + rotationOrder t ∈ middleGameCandidateOrders p currentOrder := + rotationOrder_mem_middleGameCandidateOrders_of_nonparabolic + p currentOrder hpTwo t hnonparabolic hsmall + obtain ⟨m, hm, horderDvd⟩ := + exists_dvd_middleGameMaximalOrder hp hd + obtain ⟨h₂, htrace⟩ := + exists_middleGameRightSubgroup_trace_of_nonparabolic_rotationOrder + p (rotationOrder t) hpTwo t hnonparabolic rfl + let h₂max : middleGameRightSubgroup p m := + ⟨h₂, middleGameRightSubgroup_mono p (rotationOrder t) m horderDvd h₂.2⟩ + exact ⟨m, hm, h₂max, htrace⟩ + +theorem middleGameMaximalOrder_rightSubgroup_natCard + (p currentOrder m : ℕ) [Fact p.Prime] (hp : 1 < p) + (hm : m ∈ middleGameMaximalOrders p currentOrder) : + Nat.card (middleGameRightSubgroup p m) = m := + middleGameRightSubgroup_natCard p currentOrder m + (middleGameMaximalOrders_subset_candidateOrders hp hm) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean new file mode 100644 index 0000000000..b605e62d21 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep + +/-! +# Nonparabolic order escape using maximal divisors + +This is the geometric middle-game step with the maximal-divisor cover wired +all the way through. The Corvaja--Zannier hypothesis and both numerical +inequalities are required only for divisibility-maximal candidate orders. +-/ + +namespace BGS.Markoff + +/-- Complete nonparabolic order escape from a diagonalized fiber, with the +Corvaja--Zannier union restricted to maximal candidate orders. -/ +theorem exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber_maximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) + (w s : (quadraticFiniteField p)ˣ) + (hw : (w : quadraticFiniteField p) ^ 2 ≠ 1) + (hpoint : algebraMapNormalizedPoint p x = splitFiberPoint w s) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x.u1)).card) ^ 3 < + rotationOrder x.u1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) + (hCZ : + (s : quadraticFiniteField p) * + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) ≠ 1 → + ∀ d ∈ middleGameMaximalOrders p (rotationOrder x.u1), + ((weightedTraceEquationSolutions + (s : quadraticFiniteField p) + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) + (Subgroup.zpowers w) (middleGameRightSubgroup p d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (rotationOrder x.u1) + (Nat.card (middleGameRightSubgroup p d))) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + let alpha : quadraticFiniteField p := s + let beta : quadraticFiniteField p := + splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + let Hleft : Subgroup (quadraticFiniteField p)ˣ := Subgroup.zpowers w + have htrace : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = + splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have horder : orderOf w = rotationOrder x.u1 := by + rw [← rotationOrder_eq_orderOf_extensionEigenvalue x.u1 w hw htrace] + have hleftCard : Nat.card Hleft = rotationOrder x.u1 := by + rw [Nat.card_zpowers, horder] + have hp : 1 < p := (Fact.out : p.Prime).one_lt + have hfour : (4 : quadraticFiniteField p) ≠ 0 := by + exact (map_ne_zero + (algebraMap (ZMod p) (quadraticFiniteField p))).mpr (by + intro hzero + have hpDvd : p ∣ 4 := (ZMod.natCast_eq_zero_iff 4 p).mp hzero + have hpPrime := (Fact.out : p.Prime) + have hpDvdPow : p ∣ 2 ^ 2 := by simpa using hpDvd + have hpDvdTwo : p ∣ 2 := hpPrime.dvd_of_dvd_pow hpDvdPow + have hpLeTwo : p ≤ 2 := Nat.le_of_dvd (by norm_num) hpDvdTwo + exact hpTwo (Nat.le_antisymm hpLeTwo hpPrime.two_le)) + have hnondegenerate : alpha * beta ≠ 1 := by + rw [show alpha * beta = splitFiberProduct w by + exact splitFiberOrbit_weights_mul w s] + exact splitFiberProduct_ne_one_of_four_ne_zero w hfour + have hcurrentOrder : 0 < Nat.card Hleft := by + rw [hleftCard] + exact rotationOrder_pos x.u1 + have hrightOrder : + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + Nat.card (middleGameRightSubgroup p d) = d := by + intro d hd + exact middleGameMaximalOrder_rightSubgroup_natCard + p (Nat.card Hleft) d hp hd + have hCZ' : alpha * beta ≠ 1 → + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + ((weightedTraceEquationSolutions alpha beta Hleft + (middleGameRightSubgroup p d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card Hleft) + (Nat.card (middleGameRightSubgroup p d)) := by + intro _ d hd + simpa [alpha, beta, Hleft, hleftCard] using + hCZ hnondegenerate d (by simpa [hleftCard] using hd) + obtain ⟨h, hEscapes⟩ := + exists_left_element_escaping_of_weightedCorvajaZannierEstimate_maximalOrders + p alpha beta Hleft (fun d ↦ middleGameRightSubgroup p d) + hrightOrder hCZ' hnondegenerate hcurrentOrder hp + (by simpa [hleftCard] using hcube) + (by simpa [hleftCard] using hlinear) + obtain ⟨n, hn⟩ := exists_iterate_splitFiberPoint_eq_mul_zpowers w s h + refine ⟨n, ?_⟩ + let y := (normalizedRotate1^[n]) x + have hyPoint : algebraMapNormalizedPoint p y = + splitFiberPoint w (s * (h : (quadraticFiniteField p)ˣ)) := by + calc + algebraMapNormalizedPoint p y = + (normalizedRotate1^[n]) (algebraMapNormalizedPoint p x) := + algebraMapNormalizedPoint_iterate_normalizedRotate1 p n x + _ = (normalizedRotate1^[n]) (splitFiberPoint w s) := by rw [hpoint] + _ = splitFiberPoint w + (s * (h : (quadraticFiniteField p)ˣ)) := hn + apply lt_of_not_ge + intro hsmall + have hnonparabolicY : y.u2 ^ 2 ≠ 4 := by + intro hparabolic + have hcases := + (normalizedTrace_sq_eq_four_iff_parabolic p y.u2).mp hparabolic + have hthreshold := + endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + p hpTwo delta hdelta y.u2 hcases + have hsmallReal : + (rotationOrder y.u2 : ℝ) ≤ (rotationOrder x.u1 : ℝ) := by + exact_mod_cast hsmall + exact (not_le_of_gt hbelowEndgame) (hthreshold.trans hsmallReal) + obtain ⟨m, hm, hright, hrightTrace⟩ := + exists_middleGameMaximalOrder_trace_of_nonparabolic + p (rotationOrder x.u1) hpTwo hp y.u2 hnonparabolicY hsmall + apply hEscapes m (by simpa [hleftCard] using hm) hright + have hyCoordinate := congrArg NormalizedPoint.u2 hyPoint + change algebraMap (ZMod p) (quadraticFiniteField p) y.u2 = + (splitFiberPoint w + (s * (h : (quadraticFiniteField p)ˣ))).u2 at hyCoordinate + rw [splitFiberOrbit_secondCoordinate_eq_weightedSplitTorusTrace] at hyCoordinate + change weightedSplitTorusTrace alpha beta h = splitTorusTrace hright + rw [← hrightTrace] + simpa [alpha, beta] using hyCoordinate.symm + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean new file mode 100644 index 0000000000..75da7ad713 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry + +/-! +# Wiring the middle-game trace escape to Markoff moves + +The orbit of a split fiber point with parameter `s` is parametrized by the coset +`s * Subgroup.zpowers w`. Its second coordinate is therefore a *scaled* twisted trace, not +the unscaled subgroup trace used in `MiddleGameCorvajaZannierStep`. The first two theorems make +this discrepancy explicit. + +For the distinguished parameter `s = 1`, the scaling disappears. The final theorem wires the +existing Corvaja--Zannier escape theorem all the way to a point in the same rotation orbit whose +second coordinate has strictly larger rotation order. Its remaining `htraceCoverage` hypothesis +states the separate split/nonsplit classification interface that must be constructed for the +chosen family of right subgroups. +-/ + +namespace BGS.Markoff + +variable {E : Type*} [Field E] + +/-- The exact second-coordinate formula on a translated split rotation orbit. The factor `s` +and the replacement of `splitFiberProduct w` by `splitFiberProduct w / s^2` are indispensable. -/ +theorem splitFiberOrbit_secondCoordinate_eq_scaledTwistedTrace + (w s h : Eˣ) : + (splitFiberPoint w (s * h)).u2 = + (s : E) * twistedUnitTrace + (splitFiberProduct w / (s : E) ^ 2) h := by + simp only [splitFiberPoint, twistedUnitTrace] + change (s : E) * h + + splitFiberProduct w * (((s * h)⁻¹ : Eˣ) : E) = + (s : E) * + ((h : E) + (splitFiberProduct w / (s : E) ^ 2) * ((h⁻¹ : Eˣ) : E)) + simp only [Units.val_mul, Units.val_inv_eq_inv_val] + field_simp [Units.ne_zero s, Units.ne_zero h] + +/-- Source-faithful weighted form of the orbit-coordinate identity. Here +`alpha = s`, `beta = splitFiberProduct w / s`, and hence `alpha * beta` is the invariant +`splitFiberProduct w`. This is the correct subgroup equation for an arbitrary starting point; +it avoids incorrectly replacing a coset by a subgroup. -/ +theorem splitFiberOrbit_secondCoordinate_eq_weightedSplitTorusTrace + (w s h : Eˣ) : + (splitFiberPoint w (s * h)).u2 = + weightedSplitTorusTrace (s : E) + (splitFiberProduct w * ((s⁻¹ : Eˣ) : E)) h := by + rw [splitFiberOrbit_secondCoordinate_eq_scaledTwistedTrace] + simp only [twistedUnitTrace, weightedSplitTorusTrace, Units.val_inv_eq_inv_val] + field_simp [Units.ne_zero s] + +/-- The product of the two weights in the preceding identity is exactly the fiber invariant. +Thus the paper's nondegeneracy condition is `alpha * beta != 1`. -/ +theorem splitFiberOrbit_weights_mul (w s : Eˣ) : + (s : E) * (splitFiberProduct w * ((s⁻¹ : Eˣ) : E)) = splitFiberProduct w := by + simp only [Units.val_inv_eq_inv_val] + field_simp [Units.ne_zero s] + +/-- Every translated parameter `s * h` with `h` in the cyclic subgroup generated by `w` is an +actual forward iterate of the normalized Markoff rotation through `splitFiberPoint w s`. -/ +theorem exists_iterate_splitFiberPoint_eq_mul_zpowers + [Finite E] (w s : Eˣ) (h : Subgroup.zpowers w) : + ∃ n : ℕ, + (normalizedRotate1^[n]) (splitFiberPoint w s) = + splitFiberPoint w (s * (h : Eˣ)) := by + have hhPowers : (h : Eˣ) ∈ Submonoid.powers w := + mem_powers_iff_mem_zpowers.mpr h.property + obtain ⟨n, hn⟩ := (Submonoid.mem_powers_iff (h : Eˣ) w).mp hhPowers + refine ⟨n, ?_⟩ + rw [iterate_normalizedRotate1_splitFiberPoint] + congr 1 + exact congrArg (fun u : Eˣ ↦ s * u) hn + +/-- At the base parameter `1`, the orbit-coordinate formula is exactly the unscaled trace +equation used by the Corvaja--Zannier counting module. -/ +theorem splitFiberBaseOrbit_secondCoordinate_eq_twistedUnitTrace + (w : Eˣ) (h : Subgroup.zpowers w) : + (splitFiberPoint w (h : Eˣ)).u2 = + twistedUnitTrace (splitFiberProduct w) (h : Eˣ) := by + simpa using splitFiberOrbit_secondCoordinate_eq_scaledTwistedTrace w 1 (h : Eˣ) + +section NonsplitFiber + +variable (p : ℕ) [Fact p.Prime] + +/-- The nonsplit conic parametrization has the same translated-coset obstruction after scalar +extension to the quadratic field. This is the exact formula that an eventual coset form of the +Corvaja--Zannier estimate must consume. -/ +theorem algebraMap_quadraticNormFiberOrbit_secondCoordinate_eq_scaledTwistedTrace + (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) + (w : quadraticNormOneTorus p) (htrace : quadraticNormOneTrace p w = t) + (s : ↑(quadraticConicNormFiber p t ht ht0)) + (h : quadraticNormOneTorus p) : + algebraMap (ZMod p) (quadraticFiniteField p) + (quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberMulNormOne p + (quadraticFiberProductUnit p t ht ht0) s h)).u2 = + (s.1 : quadraticFiniteField p) * + twistedUnitTrace + (splitFiberProduct (w : (quadraticFiniteField p)ˣ) / + (s.1 : quadraticFiniteField p) ^ 2) + (h : (quadraticFiniteField p)ˣ) := by + have hpoint := algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace + (quadraticNormFiberMulNormOne p (quadraticFiberProductUnit p t ht ht0) s h) + have hcoordinate := congrArg NormalizedPoint.u2 hpoint + change algebraMap (ZMod p) (quadraticFiniteField p) + (quadraticNormFiberPoint p t ht ht0 w + (quadraticNormFiberMulNormOne p + (quadraticFiberProductUnit p t ht ht0) s h)).u2 = + (splitFiberPoint (w : (quadraticFiniteField p)ˣ) + (s.1 * (h : (quadraticFiniteField p)ˣ))).u2 at hcoordinate + rw [hcoordinate] + exact splitFiberOrbit_secondCoordinate_eq_scaledTwistedTrace + (w : (quadraticFiniteField p)ˣ) s.1 (h : (quadraticFiniteField p)ˣ) + +end NonsplitFiber + +section FiniteSplitField + +variable [Fintype E] + +/-- The Corvaja--Zannier escape, specialized to the cyclic subgroup generated by the current +split eigenvalue, produces an actual Markoff rotation iterate whose second-coordinate order is +strictly larger. + +`htraceCoverage` is not the deep Corvaja--Zannier bound. It is the still-missing concrete +classification assertion that every trace of order at most the current order is represented in +the chosen indexed right subgroup. Keeping it explicit prevents the split and norm-one torus +cases from being conflated. -/ +theorem exists_splitFiberBaseOrbitPoint_with_larger_secondRotationOrder + (p : ℕ) (w : Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : + ∀ d ∈ middleGameCandidateOrders p (Nat.card (Subgroup.zpowers w)), + Nat.card (rightSubgroup d) = d) + (hCZ : splitFiberProduct w ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card (Subgroup.zpowers w)), + ((traceEquationSolutions (splitFiberProduct w) (Subgroup.zpowers w) + (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card (Subgroup.zpowers w)) + (Nat.card (rightSubgroup d))) + (hsigma : splitFiberProduct w ≠ 1) + (hcurrentOrder : 0 < Nat.card (Subgroup.zpowers w)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < + Nat.card (Subgroup.zpowers w)) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * + Nat.card (Subgroup.zpowers w) < p) + (htraceCoverage : + ∀ t : E, rotationOrder t ≤ Nat.card (Subgroup.zpowers w) → + ∃ d ∈ middleGameCandidateOrders p (Nat.card (Subgroup.zpowers w)), + ∃ h₂ : rightSubgroup d, t = twistedUnitTrace 1 h₂) : + ∃ h : Subgroup.zpowers w, + Nat.card (Subgroup.zpowers w) < + rotationOrder (splitFiberPoint w (h : Eˣ)).u2 ∧ + ∃ n : ℕ, + (normalizedRotate1^[n]) (splitFiberPoint w 1) = + splitFiberPoint w (h : Eˣ) := by + obtain ⟨h, hEscapes⟩ := + exists_left_element_escaping_of_corvajaZannierEstimate_and_sizeBounds + p (splitFiberProduct w) (Subgroup.zpowers w) rightSubgroup + hrightOrder hCZ hsigma hcurrentOrder hcube hlinear + refine ⟨h, ?_, ?_⟩ + · apply lt_of_not_ge + intro hsmall + obtain ⟨d, hd, h₂, htrace⟩ := + htraceCoverage (splitFiberPoint w (h : Eˣ)).u2 hsmall + exact hEscapes d hd h₂ <| by + rw [← htrace] + exact (splitFiberBaseOrbit_secondCoordinate_eq_twistedUnitTrace w h).symm + · simpa using exists_iterate_splitFiberPoint_eq_mul_zpowers w 1 h + +end FiniteSplitField + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean new file mode 100644 index 0000000000..adcab6b37d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean @@ -0,0 +1,108 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing + +/-! +# Finite unions of nonparabolic trace supports + +The middle game only needs to exclude right traces coming from nonparabolic +coordinates: a parabolic target already lies above the endgame threshold. +This module packages that logical split before any numerical estimate is +inserted. In particular, the inversion-pairing factor can be applied to each +right subgroup without counting its two fixed points. +-/ + +namespace BGS.Markoff + +variable {E : Type*} [Field E] [Fintype E] + +/-- Left elements meeting a nonparabolic point in one of a finite family of +right subgroups. -/ +noncomputable def weightedNonparabolicBadOrderTraceSupport + (alpha beta : E) (Hleft : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) : Finset Hleft := by + classical + exact orders.biUnion fun d ↦ + weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d) + +@[simp] +theorem mem_weightedNonparabolicBadOrderTraceSupport_iff + {alpha beta : E} {Hleft : Subgroup Eˣ} {orders : Finset ℕ} + {rightSubgroup : ℕ → Subgroup Eˣ} {hleft : Hleft} : + hleft ∈ weightedNonparabolicBadOrderTraceSupport + alpha beta Hleft orders rightSubgroup ↔ + ∃ d ∈ orders, ∃ hright : rightSubgroup d, + weightedSplitTorusTrace alpha beta hleft = + splitTorusTrace hright ∧ + ((hright : Eˣ) ^ 2) ≠ 1 := by + classical + simp [weightedNonparabolicBadOrderTraceSupport] + +/-- Bounds on the individual nonparabolic left supports sum over an arbitrary +finite family of candidate right subgroups. -/ +theorem weightedNonparabolicBadOrderTraceSupport_card_cast_le_sum + (alpha beta : E) (Hleft : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ → ℝ) + (hbound : ∀ d ∈ orders, + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d)).card : ℝ) ≤ bound d) : + ((weightedNonparabolicBadOrderTraceSupport + alpha beta Hleft orders rightSubgroup).card : ℝ) ≤ + ∑ d ∈ orders, bound d := by + classical + calc + ((weightedNonparabolicBadOrderTraceSupport + alpha beta Hleft orders rightSubgroup).card : ℝ) ≤ + ∑ d ∈ orders, + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d)).card : ℝ) := by + exact_mod_cast (Finset.card_biUnion_le : + (weightedNonparabolicBadOrderTraceSupport + alpha beta Hleft orders rightSubgroup).card ≤ + ∑ d ∈ orders, + (weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d)).card) + _ ≤ ∑ d ∈ orders, bound d := Finset.sum_le_sum hbound + +/-- If the summed nonparabolic support bound is smaller than the left +subgroup, one left element avoids every nonparabolic candidate trace. -/ +theorem exists_left_element_escaping_nonparabolic_orders_of_sum_bound + (alpha beta : E) (Hleft : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ → ℝ) + (hbound : ∀ d ∈ orders, + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d)).card : ℝ) ≤ bound d) + (hsmall : (∑ d ∈ orders, bound d) < Nat.card Hleft) : + ∃ hleft : Hleft, ∀ d ∈ orders, ∀ hright : rightSubgroup d, + ((hright : Eˣ) ^ 2) ≠ 1 → + weightedSplitTorusTrace alpha beta hleft ≠ + splitTorusTrace hright := by + classical + let bad := + weightedNonparabolicBadOrderTraceSupport + alpha beta Hleft orders rightSubgroup + have hbadReal : (bad.card : ℝ) < (Nat.card Hleft : ℝ) := + (weightedNonparabolicBadOrderTraceSupport_card_cast_le_sum + alpha beta Hleft orders rightSubgroup bound hbound).trans_lt hsmall + have hbad : bad.card < Nat.card Hleft := by + exact_mod_cast hbadReal + have hexists : ∃ hleft : Hleft, hleft ∉ bad := by + by_contra hall + push Not at hall + have hle : (Finset.univ : Finset Hleft).card ≤ bad.card := + Finset.card_le_card fun hleft _ ↦ hall hleft + rw [Finset.card_univ, Fintype.card_eq_nat_card] at hle + exact (Nat.not_le_of_lt hbad) hle + obtain ⟨hleft, hleftNotBad⟩ := hexists + refine ⟨hleft, ?_⟩ + intro d hd hright hrightSq heq + apply hleftNotBad + exact mem_weightedNonparabolicBadOrderTraceSupport_iff.mpr + ⟨d, hd, hright, heq, hrightSq⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean new file mode 100644 index 0000000000..77ed2c65de --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean @@ -0,0 +1,188 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +/-! +# The nonparabolic middle-game order-escape step + +This module composes the weighted finite escape, the concrete roots-of-unity right subgroups, +the split/nonsplit trace classification, and the weighted coset coordinate identity. The only +deep input is the weighted Corvaja--Zannier cardinal estimate on the actual solution finsets. +-/ + +namespace BGS.Markoff + +/-- Scalar extension commutes with every iterate of the normalized rotation. -/ +theorem algebraMapNormalizedPoint_iterate_normalizedRotate1 + (p n : ℕ) [Fact p.Prime] (x : NormalizedPoint (ZMod p)) : + algebraMapNormalizedPoint p ((normalizedRotate1^[n]) x) = + (normalizedRotate1^[n]) (algebraMapNormalizedPoint p x) := by + induction n with + | zero => rfl + | succ n ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply', + algebraMapNormalizedPoint_normalizedRotate1, ih] + +/-- A nonparabolic trace whose rotation order is at most `currentOrder` has a candidate order +dividing `p - 1` or `p + 1`. -/ +theorem rotationOrder_mem_middleGameCandidateOrders_of_nonparabolic + (p currentOrder : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (hnonparabolic : t ^ 2 ≠ 4) + (hsmall : rotationOrder t ≤ currentOrder) : + rotationOrder t ∈ middleGameCandidateOrders p currentOrder := by + have hpMinus : p - 1 ≠ 0 := by + have hpLower := (Fact.out : p.Prime).two_le + omega + rcases exists_split_or_quadraticNormOneTrace p hpTwo t hnonparabolic with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · have horder : orderOf w = rotationOrder t := by + rw [← rotationOrder_splitTorusTrace w hw, htrace] + have hdvd : rotationOrder t ∣ p - 1 := by + rw [← horder] + simpa [ZMod.card_units_eq_totient, Nat.totient_prime (Fact.out : p.Prime)] using + orderOf_dvd_natCard w + exact mem_middleGameCandidateOrders_iff.mpr + ⟨hsmall, Or.inl ⟨hdvd, hpMinus⟩⟩ + · have horder : orderOf w = rotationOrder t := by + rw [← rotationOrder_quadraticNormOneTrace p w hw, htrace] + have hdvd : rotationOrder t ∣ p + 1 := by + rw [← horder, ← quadraticNormOneTorus_natCard p] + exact orderOf_dvd_natCard w + exact mem_middleGameCandidateOrders_iff.mpr ⟨hsmall, Or.inr hdvd⟩ + +/-- The split-fiber invariant is never one in odd characteristic. -/ +theorem splitFiberProduct_ne_one_of_four_ne_zero + {E : Type*} [Field E] (w : Eˣ) (hfour : (4 : E) ≠ 0) : + splitFiberProduct w ≠ 1 := by + intro hone + by_cases hdenom : splitTorusTrace w ^ 2 - 4 = 0 + · simp [splitFiberProduct, hdenom] at hone + · rw [splitFiberProduct] at hone + field_simp [hdenom] at hone + exact hfour (by linear_combination hone) + +/-- Complete nonparabolic order escape from a diagonalized presentation of the current fiber. + +The numeric hypotheses are the already-isolated finite middle-game range. `hCZ` is the sole +deep premise: the weighted Corvaja--Zannier estimate for the actual cyclic left subgroup and the +canonical right subgroups. -/ +theorem exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) + (w s : (quadraticFiniteField p)ˣ) + (hw : (w : quadraticFiniteField p) ^ 2 ≠ 1) + (hpoint : algebraMapNormalizedPoint p x = splitFiberPoint w s) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < + rotationOrder x.u1) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * + rotationOrder x.u1 < p) + (hCZ : + (s : quadraticFiniteField p) * + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (rotationOrder x.u1), + ((weightedTraceEquationSolutions + (s : quadraticFiniteField p) + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) + (Subgroup.zpowers w) (middleGameRightSubgroup p d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (rotationOrder x.u1) + (Nat.card (middleGameRightSubgroup p d))) : + ∃ n : ℕ, + rotationOrder x.u1 < rotationOrder ((normalizedRotate1^[n]) x).u2 := by + let alpha : quadraticFiniteField p := s + let beta : quadraticFiniteField p := + splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + let H₁ : Subgroup (quadraticFiniteField p)ˣ := Subgroup.zpowers w + have htrace : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have horder : orderOf w = rotationOrder x.u1 := by + rw [← rotationOrder_eq_orderOf_extensionEigenvalue x.u1 w hw htrace] + have hleftCard : Nat.card H₁ = rotationOrder x.u1 := by + rw [Nat.card_zpowers, horder] + have hfour : (4 : quadraticFiniteField p) ≠ 0 := by + exact (map_ne_zero (algebraMap (ZMod p) (quadraticFiniteField p))).mpr (by + intro hzero + have hpDvd : p ∣ 4 := (ZMod.natCast_eq_zero_iff 4 p).mp hzero + have hpPrime := (Fact.out : p.Prime) + have hpDvdPow : p ∣ 2 ^ 2 := by simpa using hpDvd + have hpDvdTwo : p ∣ 2 := hpPrime.dvd_of_dvd_pow hpDvdPow + have hpLeTwo : p ≤ 2 := Nat.le_of_dvd (by norm_num) hpDvdTwo + exact hpTwo (Nat.le_antisymm hpLeTwo hpPrime.two_le)) + have hnondegenerate : alpha * beta ≠ 1 := by + rw [show alpha * beta = splitFiberProduct w by + exact splitFiberOrbit_weights_mul w s] + exact splitFiberProduct_ne_one_of_four_ne_zero w hfour + have hcurrentOrder : 0 < Nat.card H₁ := by + rw [hleftCard] + exact rotationOrder_pos x.u1 + have hrightOrder : + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + Nat.card (middleGameRightSubgroup p d) = d := by + intro d hd + exact middleGameRightSubgroup_natCard p (Nat.card H₁) d hd + have hCZ' : alpha * beta ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((weightedTraceEquationSolutions alpha beta H₁ + (middleGameRightSubgroup p d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) + (Nat.card (middleGameRightSubgroup p d)) := by + intro _ d hd + simpa [alpha, beta, H₁, hleftCard] using + hCZ hnondegenerate d (by simpa [hleftCard] using hd) + obtain ⟨h, hEscapes⟩ := + exists_left_element_escaping_of_weightedCorvajaZannierEstimate_and_sizeBounds + p alpha beta H₁ (fun d ↦ middleGameRightSubgroup p d) + hrightOrder hCZ' hnondegenerate + hcurrentOrder (by simpa [hleftCard] using hcube) (by simpa [hleftCard] using hlinear) + obtain ⟨n, hn⟩ := exists_iterate_splitFiberPoint_eq_mul_zpowers w s h + refine ⟨n, ?_⟩ + let y := (normalizedRotate1^[n]) x + have hyPoint : algebraMapNormalizedPoint p y = + splitFiberPoint w (s * (h : (quadraticFiniteField p)ˣ)) := by + calc + algebraMapNormalizedPoint p y = + (normalizedRotate1^[n]) (algebraMapNormalizedPoint p x) := + algebraMapNormalizedPoint_iterate_normalizedRotate1 p n x + _ = (normalizedRotate1^[n]) (splitFiberPoint w s) := by rw [hpoint] + _ = splitFiberPoint w (s * (h : (quadraticFiniteField p)ˣ)) := hn + apply lt_of_not_ge + intro hsmall + have hnonparabolicY : y.u2 ^ 2 ≠ 4 := by + intro hparabolic + have hcases := (normalizedTrace_sq_eq_four_iff_parabolic p y.u2).mp hparabolic + have hthreshold := endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + p hpTwo delta hdelta y.u2 hcases + have hsmallReal : (rotationOrder y.u2 : ℝ) ≤ (rotationOrder x.u1 : ℝ) := by + exact_mod_cast hsmall + exact (not_le_of_gt hbelowEndgame) (hthreshold.trans hsmallReal) + have hd := rotationOrder_mem_middleGameCandidateOrders_of_nonparabolic + p (rotationOrder x.u1) hpTwo y.u2 hnonparabolicY hsmall + obtain ⟨h₂, h₂trace⟩ := + exists_middleGameRightSubgroup_trace_of_nonparabolic_rotationOrder + p (rotationOrder y.u2) hpTwo y.u2 hnonparabolicY rfl + apply hEscapes (rotationOrder y.u2) (by simpa [hleftCard] using hd) h₂ + have hyCoordinate := congrArg NormalizedPoint.u2 hyPoint + change algebraMap (ZMod p) (quadraticFiniteField p) y.u2 = + (splitFiberPoint w (s * (h : (quadraticFiniteField p)ˣ))).u2 at hyCoordinate + rw [splitFiberOrbit_secondCoordinate_eq_weightedSplitTorusTrace] at hyCoordinate + change weightedSplitTorusTrace alpha beta h = splitTorusTrace h₂ + rw [← h₂trace] + simpa [alpha, beta] using hyCoordinate.symm + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean new file mode 100644 index 0000000000..66d2f58d44 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing + +/-! +# The sharp Corvaja--Zannier bound after right-inversion pairing + +The unconditional general plane-curve theorem specializes at bidegree `(2, 2)` +to Euler-characteristic bound `8`. Its two numerical branches are + +* `12 * (leftOrder * rightOrder)^(1/3)`, and +* `48 * leftOrder * rightOrder / p`. + +Right-coordinate inversion pairs all solutions whose right coordinate is not +two-torsion. Dividing the exact source bound by two therefore gives +coefficients `6` and `24` for the nonparabolic left support. + +No genus-one or Euler-characteristic-`3` assertion is used here. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The exact coefficient improvement obtained by pairing the two +right-coordinate inverses before taking the left support. -/ +def pairedCorvajaZannierTraceUpperBound + (p leftOrder rightOrder : ℕ) : ℝ := + max + (6 * (((leftOrder * rightOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3))) + (24 * (((leftOrder * rightOrder : ℕ) : ℝ) / p)) + +private lemma sixtyFour_rpow_one_third_eq_four : + (64 : ℝ) ^ ((1 : ℝ) / 3) = 4 := by + rw [show (64 : ℝ) = 4 ^ (3 : ℕ) by norm_num] + convert Real.pow_rpow_inv_natCast (by norm_num : (0 : ℝ) ≤ 4) + (by norm_num : (3 : ℕ) ≠ 0) using 1 + all_goals norm_num + +/-- At bidegree `(2,2)` and the unconditional Euler bound `8`, the +source-faithful Corvaja--Zannier right-hand side is exactly twice the paired +bound. Keeping this equality explicit prevents the cube-root branch from +being weakened to the older coefficient-`48` envelope before pairing. -/ +theorem corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_eight_eq_twice_paired + (p leftOrder rightOrder : ℕ) : + corvajaZannierCorollaryTwoNumericalBound + p leftOrder rightOrder 2 2 8 = + 2 * pairedCorvajaZannierTraceUpperBound + p leftOrder rightOrder := by + let x : ℝ := ((leftOrder * rightOrder : ℕ) : ℝ) + have hx : 0 ≤ x := by positivity + unfold corvajaZannierCorollaryTwoNumericalBound + pairedCorvajaZannierTraceUpperBound + have horders : + (((leftOrder * rightOrder * 2 * 2 : ℕ) : ℝ)) = 4 * x := by + simp [x] + ring + rw [horders] + rw [show 2 * (4 * x) * 8 = (64 : ℝ) * x by ring] + rw [Real.mul_rpow (by norm_num : (0 : ℝ) ≤ 64) hx, + sixtyFour_rpow_one_third_eq_four] + rw [mul_max_of_nonneg _ _ (by norm_num : (0 : ℝ) ≤ 2)] + congr 1 <;> ring + +/-- The unconditional bidegree-`(2,2)`, Euler-bound-`8` +Corvaja--Zannier theorem, combined with right inversion, gives the sharp +nonparabolic left-support estimate + +`max (6 * (|H₁| |H₂|)^(1/3), 24 * |H₁| |H₂| / p)`. +-/ +theorem weightedTraceEquationNonparabolicLeftSupport_card_cast_le_pairedCorvajaZannier + (p : ℕ) [Fact p.Prime] + (E : Type) [Field E] [Fintype E] [DecidableEq E] [CharP E p] + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) : + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta H₁ H₂).card : ℝ) ≤ + pairedCorvajaZannierTraceUpperBound + p (Nat.card H₁) (Nat.card H₂) := by + obtain ⟨hleftPositive, hrightPositive, hleftPrime, hrightPrime⟩ := + multiplicativeSubgroups_satisfy_weightedTraceBoundOrderHypotheses + p E H₁ H₂ + have hsource := + BGS.CorvajaZannier.generalCorvajaZannierPlaneCurveTheorem + p E (weightedTraceTorusClosurePolynomial alpha beta) + 2 2 (Nat.card H₂) (Nat.card H₁) + (by norm_num) (by norm_num) + (weightedTraceTorusClosurePolynomial_hasBidegreeAtMost + alpha beta hadmissible.2.1) + (weightedTraceCurve_isGeneralCorvajaZannierPlaneCurve + alpha beta hadmissible) + hrightPositive hleftPositive hrightPrime hleftPrime + rw [generalTorusTorsionIntersection_weightedTrace_eq] at hsource + rw [show BGS.External.planeTorusEulerCharacteristicBound 2 2 = 8 by + norm_num [BGS.External.planeTorusEulerCharacteristicBound]] at hsource + have hsolutions : + ((weightedTraceEquationSolutions alpha beta H₁ H₂).card : ℝ) ≤ + corvajaZannierCorollaryTwoNumericalBound + p (Nat.card H₂) (Nat.card H₁) 2 2 8 := by + calc + ((weightedTraceEquationSolutions alpha beta H₁ H₂).card : ℝ) ≤ + ((weightedTraceCurveTorsionIntersection alpha beta + (Nat.card H₁) (Nat.card H₂)).card : ℝ) := by + exact_mod_cast + weightedTraceEquationSolutions_card_le_curveTorsionIntersection + alpha beta H₁ H₂ + _ ≤ corvajaZannierCorollaryTwoNumericalBound + p (Nat.card H₂) (Nat.card H₁) 2 2 8 := hsource + have hpaired : + 2 * ((weightedTraceEquationNonparabolicLeftSupport + alpha beta H₁ H₂).card : ℝ) ≤ + ((weightedTraceEquationSolutions alpha beta H₁ H₂).card : ℝ) := by + exact_mod_cast + two_mul_weightedTraceEquationNonparabolicLeftSupport_card_le_solutions + alpha beta H₁ H₂ + have htwice : + 2 * ((weightedTraceEquationNonparabolicLeftSupport + alpha beta H₁ H₂).card : ℝ) ≤ + 2 * pairedCorvajaZannierTraceUpperBound + p (Nat.card H₁) (Nat.card H₂) := by + calc + 2 * ((weightedTraceEquationNonparabolicLeftSupport + alpha beta H₁ H₂).card : ℝ) ≤ + ((weightedTraceEquationSolutions alpha beta H₁ H₂).card : ℝ) := + hpaired + _ ≤ corvajaZannierCorollaryTwoNumericalBound + p (Nat.card H₂) (Nat.card H₁) 2 2 8 := hsolutions + _ = 2 * pairedCorvajaZannierTraceUpperBound + p (Nat.card H₁) (Nat.card H₂) := by + rw [ + corvajaZannierCorollaryTwoNumericalBound_bidegree_two_euler_eight_eq_twice_paired] + unfold pairedCorvajaZannierTraceUpperBound + congr 1 <;> simp [Nat.mul_comm] + nlinarith + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean new file mode 100644 index 0000000000..38fb86bb1a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean @@ -0,0 +1,59 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights + +/-! +# Unconditional paired maximal-divisor middle-game escape + +The weighted trace curve arising from a diagonalized nonzero nonparabolic +Markoff fiber is admissible for the in-repository general Corvaja--Zannier +theorem. Thus the paired maximal-order escape applies with no additional +geometric hypothesis. +-/ + +namespace BGS.Markoff + +/-- Diagonalize a nonzero nonparabolic fiber and apply the unconditional +paired maximal-order escape theorem. -/ +theorem + exists_iterate_with_larger_secondRotationOrder_of_nonzero_nonparabolic_pairedMaximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hnonzero : x.u1 ≠ 0) (hnonparabolic : x.u1 ^ 2 ≠ 4) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (6 * + (middleGameMaximalOrders p (rotationOrder x.u1)).card) ^ 3 < + rotationOrder x.u1) + (hlinear : + 24 * (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + obtain ⟨w, s, hw, hpoint⟩ := + exists_diagonalizedFiberPoint_of_nonzero_nonparabolic + p hpTwo x hx hnonzero hnonparabolic + have hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible + (s : quadraticFiniteField p) + (splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p)) := + diagonalizedFiber_weightedTraceCurve_isCorvajaZannierAdmissible + p hpTwo x hnonzero w s hw hpoint + exact + exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber_pairedMaximalOrders + p hpTwo delta hdelta x w s hw hpoint hadmissible + hbelowEndgame hcube hlinear + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean new file mode 100644 index 0000000000..0bb5fa81e7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound + +/-! +# Paired Corvaja--Zannier escape over maximal candidate orders + +Right-coordinate inversion halves the unconditional bidegree-`(2,2)` +Corvaja--Zannier estimate on the nonparabolic support. Combining that factor +with the maximal-divisor cover gives two separate sufficient inequalities: + +* `(6 * K)^3 < currentOrder` for the cube-root branch; +* `24 * K * currentOrder < p` for the branch divided by `p`, + +where `K` is the number of divisibility-maximal candidate orders. + +No Euler-characteristic improvement is used in this module. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {E : Type*} [Field E] [Fintype E] + +/-- A common paired Corvaja--Zannier bound for every right order at most the +current left order. -/ +def pairedCorvajaZannierCurrentOrderEnvelope + (p currentOrder : ℕ) : ℝ := + max + (6 * (((currentOrder * currentOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3))) + (24 * (((currentOrder * currentOrder : ℕ) : ℝ) / p)) + +/-- Replacing a candidate right order by the current left order enlarges both +branches of the paired bound. -/ +theorem pairedCorvajaZannierTraceUpperBound_le_currentOrderEnvelope + (p currentOrder d : ℕ) (hd : d ≤ currentOrder) : + pairedCorvajaZannierTraceUpperBound p currentOrder d ≤ + pairedCorvajaZannierCurrentOrderEnvelope p currentOrder := by + have hmulNat : currentOrder * d ≤ currentOrder * currentOrder := + Nat.mul_le_mul_left currentOrder hd + have hmul : (((currentOrder * d : ℕ) : ℝ)) ≤ + (((currentOrder * currentOrder : ℕ) : ℝ)) := by + exact_mod_cast hmulNat + unfold pairedCorvajaZannierTraceUpperBound + pairedCorvajaZannierCurrentOrderEnvelope + exact max_le_max + (mul_le_mul_of_nonneg_left + (Real.rpow_le_rpow (by positivity) hmul (by norm_num)) + (by norm_num)) + (mul_le_mul_of_nonneg_left + (div_le_div_of_nonneg_right hmul (Nat.cast_nonneg p)) + (by norm_num)) + +/-- The paired bounds over the maximal candidate orders are controlled by the +number of those orders times the common current-order envelope. -/ +theorem middleGameMaximalPairedCorvajaZannierSum_le_card_mul_envelope + (p currentOrder : ℕ) (hp : 1 < p) : + (∑ d ∈ middleGameMaximalOrders p currentOrder, + pairedCorvajaZannierTraceUpperBound p currentOrder d) ≤ + ((middleGameMaximalOrders p currentOrder).card : ℝ) * + pairedCorvajaZannierCurrentOrderEnvelope p currentOrder := by + classical + calc + (∑ d ∈ middleGameMaximalOrders p currentOrder, + pairedCorvajaZannierTraceUpperBound p currentOrder d) ≤ + ∑ _d ∈ middleGameMaximalOrders p currentOrder, + pairedCorvajaZannierCurrentOrderEnvelope p currentOrder := by + exact Finset.sum_le_sum fun d hd ↦ + pairedCorvajaZannierTraceUpperBound_le_currentOrderEnvelope + p currentOrder d + (mem_middleGameCandidateOrders_iff.mp + (middleGameMaximalOrders_subset_candidateOrders hp hd)).1 + _ = ((middleGameMaximalOrders p currentOrder).card : ℝ) * + pairedCorvajaZannierCurrentOrderEnvelope p currentOrder := by + simp + +/-- The two coefficient-sensitive natural-number inequalities imply that the +whole paired maximal-order envelope is smaller than the current order. -/ +theorem orderCount_mul_pairedCorvajaZannierEnvelope_lt_currentOrder + (p currentOrder orderCount : ℕ) + (hcurrentOrder : 0 < currentOrder) + (hcube : (6 * orderCount) ^ 3 < currentOrder) + (hlinear : 24 * orderCount * currentOrder < p) : + (orderCount : ℝ) * + pairedCorvajaZannierCurrentOrderEnvelope p currentOrder < + (currentOrder : ℝ) := by + let rootCoefficient : ℝ := 6 * orderCount + let linearCoefficient : ℝ := 24 * orderCount + have horderPos : (0 : ℝ) < currentOrder := by + exact_mod_cast hcurrentOrder + have horderNonneg : (0 : ℝ) ≤ currentOrder := horderPos.le + have hrootCoefficientNonneg : 0 ≤ rootCoefficient := by + dsimp [rootCoefficient] + positivity + have hlinearCoefficientNonneg : 0 ≤ linearCoefficient := by + dsimp [linearCoefficient] + positivity + have hcubeReal : + rootCoefficient ^ (3 : ℕ) < (currentOrder : ℝ) := by + dsimp [rootCoefficient] + exact_mod_cast hcube + have hrootCoefficient : + rootCoefficient < (currentOrder : ℝ) ^ ((1 : ℝ) / 3) := by + have h := (Real.lt_rpow_inv_iff_of_pos hrootCoefficientNonneg + horderNonneg (by norm_num : (0 : ℝ) < 3)).2 + have h' : + rootCoefficient < (currentOrder : ℝ) ^ (3 : ℝ)⁻¹ := + h (by simpa [Real.rpow_natCast] using hcubeReal) + simpa only [one_div] using h' + have hrootPositive : + 0 < (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) := by + positivity + have hcubeRootIdentity : + (currentOrder : ℝ) ^ ((1 : ℝ) / 3) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) = + (currentOrder : ℝ) := by + rw [Nat.cast_mul] + rw [← Real.mul_rpow horderNonneg + (mul_nonneg horderNonneg horderNonneg)] + convert Real.pow_rpow_inv_natCast horderNonneg + (by norm_num : (3 : ℕ) ≠ 0) using 1 + all_goals ring_nf + have hrootTerm : + rootCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) < + (currentOrder : ℝ) := by + calc + rootCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) < + (currentOrder : ℝ) ^ ((1 : ℝ) / 3) * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3)) := + mul_lt_mul_of_pos_right hrootCoefficient hrootPositive + _ = (currentOrder : ℝ) := hcubeRootIdentity + have hlinearReal : + linearCoefficient * (currentOrder : ℝ) < (p : ℝ) := by + dsimp [linearCoefficient] + exact_mod_cast hlinear + have hpPos : (0 : ℝ) < p := by + have : 0 < p := by omega + exact_mod_cast this + have hquotientTerm : + linearCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) < + (currentOrder : ℝ) := by + have hratio : + linearCoefficient * (currentOrder : ℝ) / (p : ℝ) < 1 := + (div_lt_one hpPos).2 hlinearReal + calc + linearCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ)) = + (linearCoefficient * (currentOrder : ℝ) / (p : ℝ)) * + (currentOrder : ℝ) := by + rw [Nat.cast_mul] + ring + _ < 1 * (currentOrder : ℝ) := + mul_lt_mul_of_pos_right hratio horderPos + _ = (currentOrder : ℝ) := one_mul _ + calc + (orderCount : ℝ) * + pairedCorvajaZannierCurrentOrderEnvelope p currentOrder = + max + (rootCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) ^ + ((1 : ℝ) / 3))) + (linearCoefficient * + (((currentOrder * currentOrder : ℕ) : ℝ) / (p : ℝ))) := by + rw [pairedCorvajaZannierCurrentOrderEnvelope, + mul_max_of_nonneg _ _ (Nat.cast_nonneg orderCount)] + dsimp [rootCoefficient, linearCoefficient] + push_cast + congr 1 <;> ring + _ < (currentOrder : ℝ) := max_lt hrootTerm hquotientTerm + +/-- The finite nonparabolic escape theorem over maximal candidate orders. +The Corvaja--Zannier estimate is supplied by the in-repository general +bidegree-`(2,2)` theorem and right-inversion pairing. -/ +theorem exists_left_element_escaping_nonparabolic_maximalOrders + (p : ℕ) [Fact p.Prime] + (E : Type) [Field E] [Fintype E] [DecidableEq E] [CharP E p] + (alpha beta : E) (Hleft : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + Nat.card (rightSubgroup d) = d) + (hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (hcurrentOrder : 0 < Nat.card Hleft) + (hp : 1 < p) + (hcube : + (6 * (middleGameMaximalOrders p (Nat.card Hleft)).card) ^ 3 < + Nat.card Hleft) + (hlinear : + 24 * (middleGameMaximalOrders p (Nat.card Hleft)).card * + Nat.card Hleft < p) : + ∃ hleft : Hleft, + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + ∀ hright : rightSubgroup d, + ((hright : Eˣ) ^ 2) ≠ 1 → + weightedSplitTorusTrace alpha beta hleft ≠ + splitTorusTrace hright := by + classical + let orders := middleGameMaximalOrders p (Nat.card Hleft) + let bound : ℕ → ℝ := + fun d ↦ pairedCorvajaZannierTraceUpperBound p (Nat.card Hleft) d + have hbound : + ∀ d ∈ orders, + ((weightedTraceEquationNonparabolicLeftSupport + alpha beta Hleft (rightSubgroup d)).card : ℝ) ≤ bound d := by + intro d hd + have hd' : d ∈ middleGameMaximalOrders p (Nat.card Hleft) := by + simpa [orders] using hd + have h := + weightedTraceEquationNonparabolicLeftSupport_card_cast_le_pairedCorvajaZannier + p E alpha beta Hleft (rightSubgroup d) hadmissible + rw [hrightOrder d hd'] at h + simpa [bound] using h + have hsmall : (∑ d ∈ orders, bound d) < (Nat.card Hleft : ℝ) := by + calc + (∑ d ∈ orders, bound d) = + ∑ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + pairedCorvajaZannierTraceUpperBound + p (Nat.card Hleft) d := by + simp [orders, bound] + _ ≤ ((middleGameMaximalOrders p (Nat.card Hleft)).card : ℝ) * + pairedCorvajaZannierCurrentOrderEnvelope + p (Nat.card Hleft) := + middleGameMaximalPairedCorvajaZannierSum_le_card_mul_envelope + p (Nat.card Hleft) hp + _ < (Nat.card Hleft : ℝ) := + orderCount_mul_pairedCorvajaZannierEnvelope_lt_currentOrder + p (Nat.card Hleft) + (middleGameMaximalOrders p (Nat.card Hleft)).card + hcurrentOrder hcube hlinear + obtain ⟨hleft, hleftEscapes⟩ := + exists_left_element_escaping_nonparabolic_orders_of_sum_bound + alpha beta Hleft orders rightSubgroup bound hbound hsmall + refine ⟨hleft, ?_⟩ + intro d hd hright hrightSq + exact hleftEscapes d (by simpa [orders] using hd) hright hrightSq + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean new file mode 100644 index 0000000000..95f766de2f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean @@ -0,0 +1,134 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep + +/-! +# Paired nonparabolic order escape using maximal divisors + +This is the geometric diagonalized-fiber step for the paired maximal-order +union. A hypothetical bounded target coordinate is first shown to be +nonparabolic. Its trace is then represented by a non-two-torsion element of +a maximal candidate subgroup, exactly the kind of witness excluded by the +paired finite escape theorem. +-/ + +namespace BGS.Markoff + +/-- Complete order escape from a diagonalized fiber under the paired +coefficient conditions `(6*K)^3 < currentOrder` and +`24*K*currentOrder < p`. -/ +theorem + exists_iterate_with_larger_secondRotationOrder_of_diagonalizedFiber_pairedMaximalOrders + (p : ℕ) [Fact p.Prime] [Fintype (quadraticFiniteField p)] + (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) + (w s : (quadraticFiniteField p)ˣ) + (hw : (w : quadraticFiniteField p) ^ 2 ≠ 1) + (hpoint : algebraMapNormalizedPoint p x = splitFiberPoint w s) + (hadmissible : + WeightedTraceCurveIsCorvajaZannierAdmissible + (s : quadraticFiniteField p) + (splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p))) + (hbelowEndgame : + (rotationOrder x.u1 : ℝ) < + (p : ℝ) ^ ((1 : ℝ) / 2 + delta)) + (hcube : + (6 * + (middleGameMaximalOrders p (rotationOrder x.u1)).card) ^ 3 < + rotationOrder x.u1) + (hlinear : + 24 * (middleGameMaximalOrders p (rotationOrder x.u1)).card * + rotationOrder x.u1 < p) : + ∃ n : ℕ, + rotationOrder x.u1 < + rotationOrder ((normalizedRotate1^[n]) x).u2 := by + classical + let alpha : quadraticFiniteField p := s + let beta : quadraticFiniteField p := + splitFiberProduct w * + ((s⁻¹ : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) + let Hleft : Subgroup (quadraticFiniteField p)ˣ := Subgroup.zpowers w + have htrace : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = + splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have horder : orderOf w = rotationOrder x.u1 := by + rw [← rotationOrder_eq_orderOf_extensionEigenvalue x.u1 w hw htrace] + have hleftCard : Nat.card Hleft = rotationOrder x.u1 := by + rw [Nat.card_zpowers, horder] + have hp : 1 < p := (Fact.out : p.Prime).one_lt + have hcurrentOrder : 0 < Nat.card Hleft := by + rw [hleftCard] + exact rotationOrder_pos x.u1 + have hrightOrder : + ∀ d ∈ middleGameMaximalOrders p (Nat.card Hleft), + Nat.card (middleGameRightSubgroup p d) = d := by + intro d hd + exact middleGameMaximalOrder_rightSubgroup_natCard + p (Nat.card Hleft) d hp hd + have hcube' : + (6 * (middleGameMaximalOrders p (Nat.card Hleft)).card) ^ 3 < + Nat.card Hleft := by + rw [hleftCard] + exact hcube + have hlinear' : + 24 * (middleGameMaximalOrders p (Nat.card Hleft)).card * + Nat.card Hleft < p := by + rw [hleftCard] + exact hlinear + obtain ⟨h, hEscapes⟩ := + exists_left_element_escaping_nonparabolic_maximalOrders + p (quadraticFiniteField p) alpha beta Hleft + (fun d ↦ middleGameRightSubgroup p d) + hrightOrder (by simpa [alpha, beta] using hadmissible) + hcurrentOrder hp hcube' hlinear' + obtain ⟨n, hn⟩ := exists_iterate_splitFiberPoint_eq_mul_zpowers w s h + refine ⟨n, ?_⟩ + let y := (normalizedRotate1^[n]) x + have hyPoint : algebraMapNormalizedPoint p y = + splitFiberPoint w (s * (h : (quadraticFiniteField p)ˣ)) := by + calc + algebraMapNormalizedPoint p y = + (normalizedRotate1^[n]) (algebraMapNormalizedPoint p x) := + algebraMapNormalizedPoint_iterate_normalizedRotate1 p n x + _ = (normalizedRotate1^[n]) (splitFiberPoint w s) := by rw [hpoint] + _ = splitFiberPoint w + (s * (h : (quadraticFiniteField p)ˣ)) := hn + apply lt_of_not_ge + intro hsmall + have hnonparabolicY : y.u2 ^ 2 ≠ 4 := by + intro hparabolic + have hcases := + (normalizedTrace_sq_eq_four_iff_parabolic p y.u2).mp hparabolic + have hthreshold := + endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + p hpTwo delta hdelta y.u2 hcases + have hsmallReal : + (rotationOrder y.u2 : ℝ) ≤ (rotationOrder x.u1 : ℝ) := by + exact_mod_cast hsmall + exact (not_le_of_gt hbelowEndgame) (hthreshold.trans hsmallReal) + obtain ⟨m, hm, hright, hrightTrace, hrightSq⟩ := + exists_middleGameMaximalOrder_nonparabolic_trace + p (rotationOrder x.u1) hpTwo hp y.u2 hnonparabolicY hsmall + have hm' : m ∈ middleGameMaximalOrders p (Nat.card Hleft) := by + rw [hleftCard] + exact hm + apply hEscapes m hm' hright hrightSq + have hyCoordinate := congrArg NormalizedPoint.u2 hyPoint + change algebraMap (ZMod p) (quadraticFiniteField p) y.u2 = + (splitFiberPoint w + (s * (h : (quadraticFiniteField p)ˣ))).u2 at hyCoordinate + rw [splitFiberOrbit_secondCoordinate_eq_weightedSplitTorusTrace] + at hyCoordinate + change weightedSplitTorusTrace alpha beta h = splitTorusTrace hright + rw [← hrightTrace] + simpa [alpha, beta] using hyCoordinate.symm + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean new file mode 100644 index 0000000000..84fe3be412 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean @@ -0,0 +1,120 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups + +/-! +# The parabolic middle-game branch + +The weighted Corvaja--Zannier argument is only needed for semisimple coordinate traces. +The two parabolic traces have exact rotation orders `p` and `2 * p`, already beyond every +endgame threshold `p ^ (1 / 2 + delta)` with `delta <= 1 / 2`. + +For primes congruent to one modulo four, this module also connects the explicit affine-line +parametrizations to the concrete rotation cycles through every point on the two parabolic fibers. +For primes congruent to three modulo four those fibers are empty by the existing results in +`ParabolicFibers`. +-/ + +namespace BGS.Markoff + +/-- Every endgame power threshold with exponent at most one is bounded by `p`. -/ +theorem endgamePowerThreshold_le_prime + (p : ℕ) [Fact p.Prime] (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ (p : ℝ) := by + have hp : (1 : ℝ) ≤ p := by + exact_mod_cast (Fact.out : p.Prime).one_le + calc + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ (p : ℝ) ^ (1 : ℝ) := + Real.rpow_le_rpow_of_exponent_le hp (by linarith) + _ = (p : ℝ) := Real.rpow_one _ + +/-- The trace-`2` rotation already meets the endgame power threshold. -/ +theorem endgamePowerThreshold_le_rotationOrder_two + (p : ℕ) [Fact p.Prime] (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ + (rotationOrder (2 : ZMod p) : ℝ) := by + rw [rotationOrder_two p] + exact endgamePowerThreshold_le_prime p delta hdelta + +/-- The trace-`-2` rotation has order `2 * p`, hence also meets the endgame threshold. -/ +theorem endgamePowerThreshold_le_rotationOrder_neg_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ + (rotationOrder (-2 : ZMod p) : ℝ) := by + rw [rotationOrder_neg_two p hpTwo] + have hthreshold := endgamePowerThreshold_le_prime p delta hdelta + exact hthreshold.trans (by + exact_mod_cast (show p ≤ 2 * p by omega)) + +/-- Unified parabolic branch: either normalized parabolic trace is already in the endgame +large-order range. -/ +theorem endgamePowerThreshold_le_rotationOrder_of_parabolicTrace + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (t : ZMod p) (ht : t = 2 ∨ t = -2) : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ (rotationOrder t : ℝ) := by + rcases ht with rfl | rfl + · exact endgamePowerThreshold_le_rotationOrder_two p delta hdelta + · exact endgamePowerThreshold_le_rotationOrder_neg_two p hpTwo delta hdelta + +/-- Every point on the normalized trace-`2` fiber for `p = 1 mod 4` has a rotation cycle of +exactly `p` points. -/ +theorem normalizedRotationCycle_card_of_mem_fiber_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hmod : p % 4 = 1) + (x : NormalizedPoint (ZMod p)) (hx : x ∈ normalizedFiber1 (2 : ZMod p)) : + (normalizedRotationCycle (2 : ZMod p) x).card = p := by + obtain ⟨i, hi, hfiberTwo, _⟩ := + exists_parabolic_line_decomposition_of_mod_four_eq_one p hmod + rw [hfiberTwo] at hx + rcases hx with ⟨s, rfl⟩ | ⟨s, rfl⟩ + · simpa [rotationOrder_two p] using + normalizedRotationCycle_card_parabolicLineAtTwo p hpTwo i s hi + · have hnegI : (-i) ^ 2 = -(1 : ZMod p) := by simpa using hi + simpa [rotationOrder_two p] using + normalizedRotationCycle_card_parabolicLineAtTwo p hpTwo (-i) s hnegI + +/-- Every point on the normalized trace-`-2` fiber for `p = 1 mod 4` has a rotation cycle of +exactly `2 * p` points. -/ +theorem normalizedRotationCycle_card_of_mem_fiber_neg_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hmod : p % 4 = 1) + (x : NormalizedPoint (ZMod p)) (hx : x ∈ normalizedFiber1 (-2 : ZMod p)) : + (normalizedRotationCycle (-2 : ZMod p) x).card = 2 * p := by + obtain ⟨i, hi, _, hfiberNegTwo⟩ := + exists_parabolic_line_decomposition_of_mod_four_eq_one p hmod + rw [hfiberNegTwo] at hx + rcases hx with ⟨s, rfl⟩ | ⟨s, rfl⟩ + · simpa [rotationOrder_neg_two p hpTwo] using + normalizedRotationCycle_card_parabolicLineAtNegTwo p hpTwo i s hi + · have hnegI : (-i) ^ 2 = -(1 : ZMod p) := by simpa using hi + simpa [rotationOrder_neg_two p hpTwo] using + normalizedRotationCycle_card_parabolicLineAtNegTwo p hpTwo (-i) s hnegI + +/-- The exact trace-`2` cycle through any fiber point meets the endgame power threshold. -/ +theorem endgamePowerThreshold_le_parabolicFiberTwo_cycleCard + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hmod : p % 4 = 1) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : x ∈ normalizedFiber1 (2 : ZMod p)) : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ + ((normalizedRotationCycle (2 : ZMod p) x).card : ℝ) := by + rw [normalizedRotationCycle_card_of_mem_fiber_two p hpTwo hmod x hx] + exact endgamePowerThreshold_le_prime p delta hdelta + +/-- The exact trace-`-2` cycle through any fiber point meets the endgame power threshold. -/ +theorem endgamePowerThreshold_le_parabolicFiberNegTwo_cycleCard + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hmod : p % 4 = 1) + (delta : ℝ) (hdelta : delta ≤ (1 : ℝ) / 2) + (x : NormalizedPoint (ZMod p)) (hx : x ∈ normalizedFiber1 (-2 : ZMod p)) : + (p : ℝ) ^ ((1 : ℝ) / 2 + delta) ≤ + ((normalizedRotationCycle (-2 : ZMod p) x).card : ℝ) := by + rw [normalizedRotationCycle_card_of_mem_fiber_neg_two p hpTwo hmod x hx] + have hthreshold := endgamePowerThreshold_le_prime p delta hdelta + exact hthreshold.trans (by + exact_mod_cast (show p ≤ 2 * p by omega)) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean new file mode 100644 index 0000000000..cfdaddc727 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean @@ -0,0 +1,163 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +/-! +# The right-coordinate inversion pairing + +The right-hand trace in the weighted middle-game equation is invariant under +inversion. Away from the two-torsion points, every solution therefore occurs +with a distinct partner having the same left coordinate. This gives a genuine +factor of two for the nonparabolic left support, while leaving the existing +parabolic escape branch responsible for the two fixed points. +-/ + +namespace BGS.Markoff + +variable {E : Type*} [Field E] [Fintype E] + +omit [Fintype E] in +/-- The ordinary split trace is invariant under inversion. -/ +theorem splitTorusTrace_right_inv (h : Eˣ) : + splitTorusTrace h⁻¹ = splitTorusTrace h := by + simp only [splitTorusTrace, Units.val_inv_eq_inv_val, inv_inv] + exact add_comm _ _ + +/-- Inverting the right coordinate preserves every weighted trace-equation +solution and leaves its left coordinate unchanged. -/ +theorem weightedTraceEquationSolutions_right_inv_mem + {alpha beta : E} {H₁ H₂ : Subgroup Eˣ} {z : H₁ × H₂} + (hz : z ∈ weightedTraceEquationSolutions alpha beta H₁ H₂) : + (z.1, z.2⁻¹) ∈ weightedTraceEquationSolutions alpha beta H₁ H₂ := by + rw [mem_weightedTraceEquationSolutions_iff] at hz ⊢ + change weightedSplitTorusTrace alpha beta (z.1 : Eˣ) = + splitTorusTrace ((z.2 : Eˣ)⁻¹) + rw [splitTorusTrace_right_inv] + exact hz + +omit [Fintype E] in +/-- A subgroup element whose square is not one is distinct from its inverse. -/ +theorem subgroupElement_ne_inv_of_sq_ne_one + {H : Subgroup Eˣ} (h : H) (hsq : ((h : Eˣ) ^ 2) ≠ 1) : + h ≠ h⁻¹ := by + intro hinv + apply hsq + have hinv' : (h : Eˣ) = ((h⁻¹ : H) : Eˣ) := + congrArg (fun u : H ↦ (u : Eˣ)) hinv + calc + (h : Eˣ) ^ 2 = (h : Eˣ) * (h : Eˣ) := pow_two _ + _ = (h : Eˣ) * ((h⁻¹ : H) : Eˣ) := congrArg ((h : Eˣ) * ·) hinv' + _ = 1 := by simp + +/-- The nonparabolic part of a weighted trace-equation solution set. -/ +noncomputable def weightedTraceEquationNonparabolicSolutions + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : Finset (H₁ × H₂) := by + classical + exact (weightedTraceEquationSolutions alpha beta H₁ H₂).filter fun z ↦ + ((z.2 : Eˣ) ^ 2) ≠ 1 + +@[simp] +theorem mem_weightedTraceEquationNonparabolicSolutions_iff + {alpha beta : E} {H₁ H₂ : Subgroup Eˣ} {z : H₁ × H₂} : + z ∈ weightedTraceEquationNonparabolicSolutions alpha beta H₁ H₂ ↔ + z ∈ weightedTraceEquationSolutions alpha beta H₁ H₂ ∧ + ((z.2 : Eˣ) ^ 2) ≠ 1 := by + classical + simp [weightedTraceEquationNonparabolicSolutions] + +/-- Left elements occurring in a nonparabolic weighted solution. -/ +noncomputable def weightedTraceEquationNonparabolicLeftSupport + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : Finset H₁ := by + classical + exact + (weightedTraceEquationNonparabolicSolutions alpha beta H₁ H₂).image Prod.fst + +@[simp] +theorem mem_weightedTraceEquationNonparabolicLeftSupport_iff + {alpha beta : E} {H₁ H₂ : Subgroup Eˣ} {h₁ : H₁} : + h₁ ∈ weightedTraceEquationNonparabolicLeftSupport alpha beta H₁ H₂ ↔ + ∃ h₂ : H₂, + weightedSplitTorusTrace alpha beta h₁ = splitTorusTrace h₂ ∧ + ((h₂ : Eˣ) ^ 2) ≠ 1 := by + classical + simp only [weightedTraceEquationNonparabolicLeftSupport, Finset.mem_image] + constructor + · rintro ⟨z, hz, rfl⟩ + rw [mem_weightedTraceEquationNonparabolicSolutions_iff] at hz + exact ⟨z.2, mem_weightedTraceEquationSolutions_iff.mp hz.1, hz.2⟩ + · rintro ⟨h₂, heq, hsq⟩ + exact ⟨(h₁, h₂), mem_weightedTraceEquationNonparabolicSolutions_iff.mpr + ⟨mem_weightedTraceEquationSolutions_iff.mpr heq, hsq⟩, rfl⟩ + +/-- Every fiber of the nonparabolic right-inversion quotient has at least two +points. Consequently twice the left-support cardinality is bounded by the +full Corvaja--Zannier solution count. -/ +theorem two_mul_weightedTraceEquationNonparabolicLeftSupport_card_le_solutions + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : + 2 * (weightedTraceEquationNonparabolicLeftSupport + alpha beta H₁ H₂).card ≤ + (weightedTraceEquationSolutions alpha beta H₁ H₂).card := by + classical + let solutions := + weightedTraceEquationSolutions alpha beta H₁ H₂ + let nonparabolic := + weightedTraceEquationNonparabolicSolutions alpha beta H₁ H₂ + have hfiber : + ∀ h₁ ∈ nonparabolic.image Prod.fst, + 2 ≤ (nonparabolic.filter fun z ↦ Prod.fst z = h₁).card := by + intro h₁ hh₁ + obtain ⟨z, hz, rfl⟩ := Finset.mem_image.mp hh₁ + have hzData : + z ∈ solutions ∧ ((z.2 : Eˣ) ^ 2) ≠ 1 := by + simpa [nonparabolic, solutions] using + (mem_weightedTraceEquationNonparabolicSolutions_iff.mp hz) + have hzInvSolutions : + (z.1, z.2⁻¹) ∈ solutions := by + simpa [solutions] using + weightedTraceEquationSolutions_right_inv_mem hzData.1 + have hzInvSq : ((((z.2⁻¹ : H₂) : Eˣ) ^ 2) ≠ 1) := by + intro h + apply hzData.2 + have h' := congrArg Inv.inv h + simpa using h' + have hzInv : + (z.1, z.2⁻¹) ∈ nonparabolic := by + rw [show nonparabolic = + weightedTraceEquationNonparabolicSolutions alpha beta H₁ H₂ by rfl, + mem_weightedTraceEquationNonparabolicSolutions_iff] + exact ⟨by simpa [solutions] using hzInvSolutions, hzInvSq⟩ + have hne : z ≠ (z.1, z.2⁻¹) := by + intro h + exact subgroupElement_ne_inv_of_sq_ne_one z.2 hzData.2 + (congrArg Prod.snd h) + have hsubset : + ({z, (z.1, z.2⁻¹)} : Finset (H₁ × H₂)) ⊆ + nonparabolic.filter fun w ↦ Prod.fst w = z.1 := by + intro w hw + simp only [Finset.mem_insert, Finset.mem_singleton] at hw + rw [Finset.mem_filter] + rcases hw with rfl | rfl + · exact ⟨hz, rfl⟩ + · exact ⟨hzInv, rfl⟩ + have hcard := Finset.card_le_card hsubset + simpa [hne] using hcard + have hpaired : + 2 * (nonparabolic.image Prod.fst).card ≤ nonparabolic.card := + Finset.mul_card_image_le_card nonparabolic 2 hfiber + calc + 2 * (weightedTraceEquationNonparabolicLeftSupport + alpha beta H₁ H₂).card = + 2 * (nonparabolic.image Prod.fst).card := by + rfl + _ ≤ nonparabolic.card := hpaired + _ ≤ solutions.card := by + exact Finset.card_le_card fun z hz ↦ by + exact + (mem_weightedTraceEquationNonparabolicSolutions_iff.mp + (by simpa [nonparabolic] using hz)).1 + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean new file mode 100644 index 0000000000..d0d7ba868d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean @@ -0,0 +1,189 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification +import Mathlib.RingTheory.RootsOfUnity.PrimitiveRoots + +/-! +# Concrete right subgroups for the middle game + +All split and nonsplit semisimple eigenvalues are placed in the common quadratic extension. +For a candidate order `d`, the right subgroup is the subgroup of `d`-th roots of unity in that +extension. Candidate divisibility by `p - 1` or `p + 1` implies that this subgroup has exactly +`d` elements. + +Parabolic traces are deliberately excluded from the representation theorem: their rotation +orders are `p` or `2 * p`, not semisimple torus orders dividing `p - 1` or `p + 1`. +-/ + +namespace BGS.Markoff + +/-- The canonical right subgroup of order `d` inside the common quadratic extension. -/ +noncomputable def middleGameRightSubgroup (p d : ℕ) [Fact p.Prime] : + Subgroup (quadraticFiniteField p)ˣ := + rootsOfUnity d (quadraticFiniteField p) + +theorem mem_middleGameRightSubgroup_iff_pow_eq_one + (p d : ℕ) [Fact p.Prime] (u : (quadraticFiniteField p)ˣ) : + u ∈ middleGameRightSubgroup p d ↔ u ^ d = 1 := by + exact mem_rootsOfUnity d u + +/-- Every element whose multiplicative order is `d` belongs to the canonical right subgroup. -/ +theorem mem_middleGameRightSubgroup_of_orderOf_eq + (p d : ℕ) [Fact p.Prime] (u : (quadraticFiniteField p)ˣ) + (hu : orderOf u = d) : + u ∈ middleGameRightSubgroup p d := by + rw [mem_middleGameRightSubgroup_iff_pow_eq_one, ← hu] + exact pow_orderOf_eq_one u + +/-- Candidate divisibility by `p - 1` or `p + 1` implies divisibility by the order of the +multiplicative group of the quadratic extension. -/ +theorem middleGameCandidateOrder_dvd_quadraticUnitsCard + (p currentOrder d : ℕ) [Fact p.Prime] + (hd : d ∈ middleGameCandidateOrders p currentOrder) : + d ∣ Nat.card (quadraticFiniteField p)ˣ := by + have hfieldCard : Nat.card (quadraticFiniteField p) = p ^ 2 := + GaloisField.card p (n := 2) (by norm_num) + have hunitsCard : Nat.card (quadraticFiniteField p)ˣ = p ^ 2 - 1 := by + rw [Nat.card_units, hfieldCard] + rw [hunitsCard] + have hfactor : p ^ 2 - 1 = (p + 1) * (p - 1) := by + simpa using (sq_tsub_sq p 1) + rw [hfactor] + rcases (mem_middleGameCandidateOrders_iff.mp hd).2 with hminus | hplus + · exact dvd_mul_of_dvd_right hminus.1 (p + 1) + · exact dvd_mul_of_dvd_left hplus (p - 1) + +/-- The canonical right subgroup indexed by a candidate order has exactly that cardinality. -/ +theorem middleGameRightSubgroup_natCard + (p currentOrder d : ℕ) [Fact p.Prime] + (hd : d ∈ middleGameCandidateOrders p currentOrder) : + Nat.card (middleGameRightSubgroup p d) = d := by + let E := quadraticFiniteField p + letI : Fintype E := Fintype.ofFinite E + have hdvd : d ∣ Nat.card Eˣ := + middleGameCandidateOrder_dvd_quadraticUnitsCard p currentOrder d hd + have hdpos : 0 < d := Nat.pos_of_dvd_of_pos hdvd Nat.card_pos + letI : NeZero d := ⟨hdpos.ne'⟩ + obtain ⟨g, hg⟩ := IsCyclic.exists_ofOrder_eq_natCard (α := Eˣ) + let zeta : Eˣ := g ^ (orderOf g / d) + have horder : orderOf zeta = d := by + apply orderOf_pow_orderOf_div + · rw [hg] + exact Nat.card_pos.ne' + · rwa [hg] + have hprimitive : IsPrimitiveRoot zeta d := IsPrimitiveRoot.iff_orderOf.mpr horder + exact hprimitive.card_rootsOfUnity' + +/-- A split eigenvalue of rotation order `d`, embedded in the quadratic extension, lies in the +canonical right subgroup and has the required reciprocal trace. -/ +theorem exists_middleGameRightSubgroup_trace_of_split + (p d : ℕ) [Fact p.Prime] + (t : ZMod p) (w : (ZMod p)ˣ) + (htrace : splitTorusTrace w = t) + (hw : (w : ZMod p) ^ 2 ≠ 1) + (hrotation : rotationOrder t = d) : + ∃ h₂ : middleGameRightSubgroup p d, + algebraMap (ZMod p) (quadraticFiniteField p) t = splitTorusTrace h₂ := by + let embedding : (ZMod p)ˣ →* (quadraticFiniteField p)ˣ := + Units.map (algebraMap (ZMod p) (quadraticFiniteField p)).toMonoidHom + let u : (quadraticFiniteField p)ˣ := embedding w + have horder : orderOf w = d := by + rw [← rotationOrder_splitTorusTrace w hw, htrace] + exact hrotation + have hupow : u ^ d = 1 := by + calc + u ^ d = embedding (w ^ d) := (map_pow embedding w d).symm + _ = embedding 1 := by rw [← horder, pow_orderOf_eq_one] + _ = 1 := map_one embedding + let h₂ : middleGameRightSubgroup p d := + ⟨u, (mem_middleGameRightSubgroup_iff_pow_eq_one p d u).mpr hupow⟩ + refine ⟨h₂, ?_⟩ + rw [← htrace] + change algebraMap (ZMod p) (quadraticFiniteField p) (splitTorusTrace w) = + splitTorusTrace (embedding w) + rw [splitTorusTrace, splitTorusTrace, map_add] + rfl + +/-- A nonsplit norm-one eigenvalue of rotation order `d` lies in the same canonical quadratic +right subgroup and represents the scalar-extended base-field trace. -/ +theorem exists_middleGameRightSubgroup_trace_of_nonsplit + (p d : ℕ) [Fact p.Prime] + (t : ZMod p) (w : quadraticNormOneTorus p) + (htrace : quadraticNormOneTrace p w = t) + (hw : (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) ^ 2 ≠ 1)) + (hrotation : rotationOrder t = d) : + ∃ h₂ : middleGameRightSubgroup p d, + algebraMap (ZMod p) (quadraticFiniteField p) t = splitTorusTrace h₂ := by + let u : (quadraticFiniteField p)ˣ := w + have horder : orderOf w = d := by + rw [← rotationOrder_quadraticNormOneTrace p w hw, htrace] + exact hrotation + have hwpow : w ^ d = 1 := by + rw [← horder] + exact pow_orderOf_eq_one w + have hupow : u ^ d = 1 := by + exact congrArg Subtype.val hwpow + let h₂ : middleGameRightSubgroup p d := + ⟨u, (mem_middleGameRightSubgroup_iff_pow_eq_one p d u).mpr hupow⟩ + refine ⟨h₂, ?_⟩ + rw [← htrace] + exact algebraMap_quadraticNormOneTrace p w + +/-- Every nonparabolic normalized trace of rotation order `d` is represented in the canonical +right subgroup. The hypothesis `t^2 != 4` is the explicit boundary separating this theorem +from the parabolic orders `p` and `2 * p`. -/ +theorem exists_middleGameRightSubgroup_trace_of_nonparabolic_rotationOrder + (p d : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (t : ZMod p) (hnonparabolic : t ^ 2 ≠ 4) + (hrotation : rotationOrder t = d) : + ∃ h₂ : middleGameRightSubgroup p d, + algebraMap (ZMod p) (quadraticFiniteField p) t = splitTorusTrace h₂ := by + rcases exists_split_or_quadraticNormOneTrace p hpTwo t hnonparabolic with + ⟨w, htrace, hw⟩ | ⟨w, htrace, hw⟩ + · exact exists_middleGameRightSubgroup_trace_of_split + p d t w htrace hw hrotation + · exact exists_middleGameRightSubgroup_trace_of_nonsplit + p d t w htrace hw hrotation + +/-- Over a prime field, the equation `t^2 = 4` is exactly the explicit parabolic alternative +`t = 2` or `t = -2`. -/ +theorem normalizedTrace_sq_eq_four_iff_parabolic + (p : ℕ) [Fact p.Prime] (t : ZMod p) : + t ^ 2 = 4 ↔ t = 2 ∨ t = -2 := by + constructor + · intro ht + have hfactor : (t - 2) * (t + 2) = 0 := by + calc + (t - 2) * (t + 2) = t ^ 2 - 4 := by ring + _ = 0 := sub_eq_zero.mpr ht + rcases mul_eq_zero.mp hfactor with h | h + · exact Or.inl (sub_eq_zero.mp h) + · exact Or.inr (eq_neg_of_add_eq_zero_left h) + · rintro (rfl | rfl) <;> ring + +/-- Complete candidate-order classification. The canonical right subgroup always has exact +cardinality `d`; a trace of rotation order `d` is either one of the two parabolic parameters or +is represented by a reciprocal trace in that subgroup. -/ +theorem middleGameRightSubgroup_exactCard_and_traceClassification + (p currentOrder d : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (hd : d ∈ middleGameCandidateOrders p currentOrder) + (t : ZMod p) (hrotation : rotationOrder t = d) : + Nat.card (middleGameRightSubgroup p d) = d ∧ + (t = 2 ∨ t = -2 ∨ + ∃ h₂ : middleGameRightSubgroup p d, + algebraMap (ZMod p) (quadraticFiniteField p) t = splitTorusTrace h₂) := by + refine ⟨middleGameRightSubgroup_natCard p currentOrder d hd, ?_⟩ + by_cases hparabolic : t ^ 2 = 4 + · rcases (normalizedTrace_sq_eq_four_iff_parabolic p t).mp hparabolic with h | h + · exact Or.inl h + · exact Or.inr (Or.inl h) + · exact Or.inr (Or.inr + (exists_middleGameRightSubgroup_trace_of_nonparabolic_rotationOrder + p d hpTwo t hparabolic hrotation)) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean new file mode 100644 index 0000000000..0011179063 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus + +/-! +# Nondegeneracy of the actual middle-game trace-curve coefficients + +The geometric Corvaja--Zannier theorem needs more than a formal weighted equation. This module +proves that the two weights coming from every nonzero nonparabolic Markoff fiber are nonzero and +that their product is not one. These are the exact coefficient hypotheses used by the subsequent +absolute-irreducibility and non-subtorus proofs. +-/ + +namespace BGS.Markoff + +/-- The explicit nonzero and nondegeneracy conditions imply every geometric +Corvaja--Zannier admissibility condition for the weighted trace curve. -/ +theorem weightedTraceCurve_isCorvajaZannierAdmissible_of_nondegenerateWeights + {K : Type*} [Field K] (alpha beta : K) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) : + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta := by + apply weightedTraceCurve_isCorvajaZannierAdmissible_of_absoluteIrreducible + alpha beta halpha hbeta hnondegenerate + exact weightedTraceCurve_absolutelyIrreducible + alpha beta halpha hbeta hnondegenerate + +/-- The two weighted trace coefficients attached to a nonzero split-fiber trace are both nonzero, +and their product is the nondegenerate fiber invariant. -/ +theorem splitFiberOrbit_weightedTraceCoefficients_nondegenerate + {E : Type*} [Field E] (w s : Eˣ) + (hw : (w : E) ^ 2 ≠ 1) (htrace : splitTorusTrace w ≠ 0) + (hfour : (4 : E) ≠ 0) : + (s : E) ≠ 0 ∧ + splitFiberProduct w * ((s⁻¹ : Eˣ) : E) ≠ 0 ∧ + (s : E) * (splitFiberProduct w * ((s⁻¹ : Eˣ) : E)) ≠ 1 := by + refine ⟨Units.ne_zero s, ?_, ?_⟩ + · exact mul_ne_zero (splitFiberProduct_ne_zero w hw htrace) (Units.ne_zero (s⁻¹)) + · rw [splitFiberOrbit_weights_mul] + exact splitFiberProduct_ne_one_of_four_ne_zero w hfour + +/-- Four remains nonzero in the canonical quadratic extension of an odd prime field. -/ +theorem four_ne_zero_quadraticFiniteField_of_prime_ne_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) : + (4 : quadraticFiniteField p) ≠ 0 := by + apply (map_ne_zero (algebraMap (ZMod p) (quadraticFiniteField p))).mpr + intro hzero + have hpDvd : p ∣ 4 := (ZMod.natCast_eq_zero_iff 4 p).mp hzero + have hpPrime := (Fact.out : p.Prime) + have hpDvdPow : p ∣ 2 ^ 2 := by simpa using hpDvd + have hpDvdTwo : p ∣ 2 := hpPrime.dvd_of_dvd_pow hpDvdPow + have hpLeTwo : p ≤ 2 := Nat.le_of_dvd (by norm_num) hpDvdTwo + exact hpTwo (Nat.le_antisymm hpLeTwo hpPrime.two_le) + +/-- Concrete nondegeneracy for every diagonalized presentation of a nonzero nonparabolic +normalized Markoff fiber. -/ +theorem diagonalizedFiber_weightedTraceCoefficients_nondegenerate + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (x : NormalizedPoint (ZMod p)) (hnonzero : x.u1 ≠ 0) + (w s : (quadraticFiniteField p)ˣ) + (hw : (w : quadraticFiniteField p) ^ 2 ≠ 1) + (hpoint : algebraMapNormalizedPoint p x = splitFiberPoint w s) : + (s : quadraticFiniteField p) ≠ 0 ∧ + splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p) ≠ 0 ∧ + (s : quadraticFiniteField p) * + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) ≠ 1 := by + have htraceEq : + algebraMap (ZMod p) (quadraticFiniteField p) x.u1 = splitTorusTrace w := + congrArg NormalizedPoint.u1 hpoint + have htrace : splitTorusTrace w ≠ 0 := by + rw [← htraceEq] + exact (map_ne_zero (algebraMap (ZMod p) (quadraticFiniteField p))).mpr hnonzero + exact splitFiberOrbit_weightedTraceCoefficients_nondegenerate + w s hw htrace (four_ne_zero_quadraticFiniteField_of_prime_ne_two p hpTwo) + +/-- Every actual diagonalized nonzero nonparabolic Markoff fiber supplies a +Corvaja--Zannier-admissible weighted trace curve; this is no longer an +independent geometric premise of the order-escape theorem. -/ +theorem diagonalizedFiber_weightedTraceCurve_isCorvajaZannierAdmissible + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (x : NormalizedPoint (ZMod p)) (hnonzero : x.u1 ≠ 0) + (w s : (quadraticFiniteField p)ˣ) + (hw : (w : quadraticFiniteField p) ^ 2 ≠ 1) + (hpoint : algebraMapNormalizedPoint p x = splitFiberPoint w s) : + WeightedTraceCurveIsCorvajaZannierAdmissible + (s : quadraticFiniteField p) + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) := by + obtain ⟨halpha, hbeta, hnondegenerate⟩ := + diagonalizedFiber_weightedTraceCoefficients_nondegenerate + p hpTwo x hnonzero w s hw hpoint + exact weightedTraceCurve_isCorvajaZannierAdmissible_of_nondegenerateWeights + (s : quadraticFiniteField p) + (splitFiberProduct w * ((s⁻¹ : (quadraticFiniteField p)ˣ) : + quadraticFiniteField p)) halpha hbeta hnondegenerate + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean new file mode 100644 index 0000000000..197802f0ee --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +/-! +# The middle-game trace equation + +This module gives the exact finite solution set for equation (41) and proves the elementary +quadratic-fiber bound used when one subgroup is small. The genuinely deep uniform power-saving +estimate remains a separate Blueprint input. +-/ + +namespace BGS.Markoff + +open Polynomial + +variable {E : Type*} [Field E] [Fintype E] + +/-- The twisted eigenvalue trace `h + sigma / h`. -/ +noncomputable def twistedUnitTrace (sigma : E) (h : Eˣ) : E := + (h : E) + sigma * (h⁻¹ : Eˣ) + +/-- The possible left-hand elements above one fixed right-hand trace. -/ +noncomputable def traceEquationLeftFiber + (sigma : E) (H₁ : Subgroup Eˣ) (h₂ : Eˣ) : Finset H₁ := by + classical + exact Finset.univ.filter fun h₁ => + twistedUnitTrace sigma h₁ = twistedUnitTrace 1 h₂ + +/-- Solutions of the middle-game trace equation inside two finite subgroups. -/ +noncomputable def traceEquationSolutions + (sigma : E) (H₁ H₂ : Subgroup Eˣ) : Finset (H₁ × H₂) := by + classical + exact Finset.univ.biUnion fun h₂ : H₂ => + (traceEquationLeftFiber sigma H₁ h₂).image fun h₁ => (h₁, h₂) + +@[simp] +theorem mem_traceEquationSolutions_iff + {sigma : E} {H₁ H₂ : Subgroup Eˣ} {h : H₁ × H₂} : + h ∈ traceEquationSolutions sigma H₁ H₂ ↔ + twistedUnitTrace sigma h.1 = twistedUnitTrace 1 h.2 := by + classical + constructor + · intro hh + rw [traceEquationSolutions, Finset.mem_biUnion] at hh + obtain ⟨h₂, _, hh⟩ := hh + obtain ⟨h₁, hh₁, heq⟩ := Finset.mem_image.mp hh + have hfirst : h₁ = h.1 := congrArg Prod.fst heq + have hsecond : h₂ = h.2 := congrArg Prod.snd heq + simpa [traceEquationLeftFiber, hfirst, hsecond] using hh₁ + · intro hh + rw [traceEquationSolutions, Finset.mem_biUnion] + refine ⟨h.2, Finset.mem_univ _, ?_⟩ + exact Finset.mem_image.mpr + ⟨h.1, by simpa [traceEquationLeftFiber] using hh, rfl⟩ + +/-- After one trace value is fixed, the other unit satisfies a monic quadratic. -/ +noncomputable def twistedTracePolynomial (sigma trace : E) : E[X] := + X ^ 2 - C trace * X + C sigma + +omit [Fintype E] in +theorem twistedTracePolynomial_monic (sigma trace : E) : + (twistedTracePolynomial sigma trace).Monic := by + exact (isMonicOfDegree_sub_add_two trace sigma).monic + +omit [Fintype E] in +@[simp] +theorem twistedTracePolynomial_natDegree (sigma trace : E) : + (twistedTracePolynomial sigma trace).natDegree = 2 := by + exact (isMonicOfDegree_sub_add_two trace sigma).natDegree_eq + +omit [Fintype E] in +theorem eval_twistedTracePolynomial_eq_zero_iff + (sigma trace : E) (h : Eˣ) : + (twistedTracePolynomial sigma trace).eval (h : E) = 0 ↔ + twistedUnitTrace sigma h = trace := by + have hh : (h : E) ≠ 0 := Units.ne_zero h + simp only [twistedTracePolynomial, eval_add, eval_sub, eval_pow, eval_X, eval_mul, + eval_C] + rw [show twistedUnitTrace sigma h = (h : E) + sigma * (h : E)⁻¹ by + simp [twistedUnitTrace]] + constructor <;> intro heq + · apply (mul_left_cancel₀ hh) + field_simp [hh] + linear_combination heq + · field_simp [hh] at heq + linear_combination heq + +/-- For a fixed right-hand trace, at most two elements of the left subgroup solve the equation. -/ +theorem traceEquationLeftFiber_card_le_two + (sigma : E) (H₁ : Subgroup Eˣ) (h₂ : Eˣ) : + (traceEquationLeftFiber sigma H₁ h₂).card ≤ 2 := by + classical + let f := twistedTracePolynomial sigma (twistedUnitTrace 1 h₂) + have hf : f ≠ 0 := (twistedTracePolynomial_monic sigma _).ne_zero + let rootEmbedding : ↥(traceEquationLeftFiber sigma H₁ h₂) ↪ ↥f.roots.toFinset := + { toFun := fun h₁ => ⟨((h₁.1 : Eˣ) : E), by + rw [Multiset.mem_toFinset, Polynomial.mem_roots hf] + apply (eval_twistedTracePolynomial_eq_zero_iff sigma _ h₁.1).2 + simpa only [traceEquationLeftFiber, Finset.mem_filter, Finset.mem_univ, true_and] + using h₁.2⟩ + inj' := by + intro x y hxy + apply Subtype.ext + apply Subtype.ext + apply Units.ext + exact congrArg Subtype.val hxy } + have hcard : + (traceEquationLeftFiber sigma H₁ h₂).card ≤ f.roots.toFinset.card := by + simpa only [Fintype.card_coe] using + Fintype.card_le_of_injective rootEmbedding rootEmbedding.injective + calc + (traceEquationLeftFiber sigma H₁ h₂).card ≤ f.roots.toFinset.card := hcard + _ ≤ f.roots.card := Multiset.toFinset_card_le _ + _ ≤ f.natDegree := Polynomial.card_roots' f + _ = 2 := twistedTracePolynomial_natDegree sigma _ + +/-- The elementary bounded-right-subgroup estimate: every right element has at most two lifts. -/ +theorem traceEquationSolutions_card_le_two_mul_right + (sigma : E) (H₁ H₂ : Subgroup Eˣ) : + (traceEquationSolutions sigma H₁ H₂).card ≤ 2 * Nat.card H₂ := by + classical + unfold traceEquationSolutions + calc + (Finset.univ.biUnion fun h₂ : H₂ => + (traceEquationLeftFiber sigma H₁ h₂).image fun h₁ => (h₁, h₂)).card ≤ + Finset.univ.card * 2 := by + apply Finset.card_biUnion_le_card_mul + intro h₂ _ + exact Finset.card_image_le.trans + (traceEquationLeftFiber_card_le_two sigma H₁ h₂) + _ = 2 * Nat.card H₂ := by + rw [Finset.card_univ, Fintype.card_eq_nat_card] + omega + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean new file mode 100644 index 0000000000..6a43de2580 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean @@ -0,0 +1,248 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound + +/-! +# The middle-game bad-order union + +The published middle game considers, for a left rotation group `H₁`, every possible right +rotation order `d ≤ |H₁|` dividing `p - 1` or `p + 1`. A power-saving estimate for the +trace equation bounds the left elements that can meet a right subgroup of each such order. The +divisor bound then makes the union of all those exceptional left elements smaller than `H₁`. + +This file formalizes that finite combinatorial wiring. It deliberately does not postulate the +Corvaja--Zannier estimate: the estimate appears below as an ordinary theorem hypothesis on the +actual trace-equation solution finsets. +-/ + +namespace BGS.Markoff + +/-- Candidate right rotation orders in the middle game: divisors of `p - 1` or `p + 1` that do +not exceed the current left rotation order. -/ +def middleGameCandidateOrders (p currentOrder : ℕ) : Finset ℕ := + ((p - 1).divisors ∪ (p + 1).divisors).filter fun d ↦ d ≤ currentOrder + +theorem mem_middleGameCandidateOrders_iff {p currentOrder d : ℕ} : + d ∈ middleGameCandidateOrders p currentOrder ↔ + d ≤ currentOrder ∧ (d ∣ p - 1 ∧ p - 1 ≠ 0 ∨ d ∣ p + 1) := by + simp only [middleGameCandidateOrders, Finset.mem_filter, Finset.mem_union, + Nat.mem_divisors] + constructor + · rintro ⟨hd, hle⟩ + refine ⟨hle, ?_⟩ + rcases hd with hd | hd + · exact Or.inl hd + · exact Or.inr hd.1 + · rintro ⟨hle, hd⟩ + refine ⟨?_, hle⟩ + rcases hd with hd | hd + · exact Or.inl hd + · exact Or.inr ⟨hd, by omega⟩ + +/-- There are no more candidate orders than the sum of the two divisor counts. -/ +theorem middleGameCandidateOrders_card_le (p currentOrder : ℕ) : + (middleGameCandidateOrders p currentOrder).card ≤ + (p - 1).divisors.card + (p + 1).divisors.card := by + calc + (middleGameCandidateOrders p currentOrder).card ≤ + ((p - 1).divisors ∪ (p + 1).divisors).card := + Finset.card_le_card (Finset.filter_subset _ _) + _ ≤ (p - 1).divisors.card + (p + 1).divisors.card := Finset.card_union_le _ _ + +/-- The proved subpolynomial divisor estimate controls both possible torus orders at once. This +is the analytic input needed after taking the finite union over candidate right rotation orders. -/ +theorem exists_threshold_middleGameCandidateOrders_card_le_two_mul_rpow + {ε : ℝ} (hε : 0 < ε) : + ∃ threshold : ℕ, ∀ p currentOrder : ℕ, threshold ≤ p → + ((middleGameCandidateOrders p currentOrder).card : ℝ) ≤ + 2 * ((p + 1 : ℕ) : ℝ) ^ ε := by + obtain ⟨N, hN⟩ := BGS.NumberTheory.exists_threshold_card_divisors_le_rpow hε + refine ⟨N + 1, ?_⟩ + intro p currentOrder hp + have hpMinus : N ≤ p - 1 := by omega + have hpPlus : N ≤ p + 1 := by omega + have hMinus := hN (p - 1) hpMinus + have hPlus := hN (p + 1) hpPlus + have hCandidate : + ((middleGameCandidateOrders p currentOrder).card : ℝ) ≤ + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) := by + exact_mod_cast middleGameCandidateOrders_card_le p currentOrder + have hBase : (((p - 1 : ℕ) : ℝ)) ≤ (((p + 1 : ℕ) : ℝ)) := by + exact_mod_cast (show p - 1 ≤ p + 1 by omega) + have hPower : (((p - 1 : ℕ) : ℝ)) ^ ε ≤ (((p + 1 : ℕ) : ℝ)) ^ ε := + Real.rpow_le_rpow (Nat.cast_nonneg _) hBase hε.le + calc + ((middleGameCandidateOrders p currentOrder).card : ℝ) ≤ + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) := hCandidate + _ = ((p - 1).divisors.card : ℝ) + ((p + 1).divisors.card : ℝ) := by + norm_num + _ ≤ (((p - 1 : ℕ) : ℝ)) ^ ε + (((p + 1 : ℕ) : ℝ)) ^ ε := + add_le_add hMinus hPlus + _ ≤ (((p + 1 : ℕ) : ℝ)) ^ ε + (((p + 1 : ℕ) : ℝ)) ^ ε := + add_le_add hPower (le_refl _) + _ = 2 * (((p + 1 : ℕ) : ℝ)) ^ ε := by ring + +variable {E : Type*} [Field E] [Fintype E] + +/-- Left elements of `H₁` occurring in the trace equation with some element of `H₂`. -/ +noncomputable def traceEquationLeftSupport + (sigma : E) (H₁ H₂ : Subgroup Eˣ) : Finset H₁ := by + classical + exact (traceEquationSolutions sigma H₁ H₂).image Prod.fst + +@[simp] +theorem mem_traceEquationLeftSupport_iff + {sigma : E} {H₁ H₂ : Subgroup Eˣ} {h₁ : H₁} : + h₁ ∈ traceEquationLeftSupport sigma H₁ H₂ ↔ + ∃ h₂ : H₂, twistedUnitTrace sigma h₁ = twistedUnitTrace 1 h₂ := by + classical + simp only [traceEquationLeftSupport, Finset.mem_image] + constructor + · rintro ⟨h, hh, rfl⟩ + exact ⟨h.2, (mem_traceEquationSolutions_iff.mp hh)⟩ + · rintro ⟨h₂, heq⟩ + exact ⟨(h₁, h₂), mem_traceEquationSolutions_iff.mpr heq, rfl⟩ + +/-- Projection to the left coordinate cannot increase the number of trace-equation solutions. -/ +theorem traceEquationLeftSupport_card_le_solutions + (sigma : E) (H₁ H₂ : Subgroup Eˣ) : + (traceEquationLeftSupport sigma H₁ H₂).card ≤ + (traceEquationSolutions sigma H₁ H₂).card := by + classical + exact Finset.card_image_le + +/-- The safe coefficient obtained from Corvaja--Zannier, Corollary 2, after specializing its +explicit constants to the middle-game trace curve. -/ +def corvajaZannierCorollaryTwoSafeCoefficient : ℕ := 48 + +/-- The numerical right-hand side of the Corvaja--Zannier trace estimate used in the published +paper, with the source-justified safe coefficient from Corollary 2 kept explicit. -/ +noncomputable def corvajaZannierTraceUpperBound + (p leftOrder rightOrder : ℕ) : ℝ := + corvajaZannierCorollaryTwoSafeCoefficient * max + (((leftOrder * rightOrder : ℕ) : ℝ) ^ ((1 : ℝ) / 3)) + (((leftOrder * rightOrder : ℕ) : ℝ) / p) + +/-- All left elements that meet at least one member of a supplied family of right subgroups. -/ +noncomputable def badOrderTraceSupport + (sigma : E) (H₁ : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) : Finset H₁ := by + classical + exact orders.biUnion fun d ↦ traceEquationLeftSupport sigma H₁ (rightSubgroup d) + +@[simp] +theorem mem_badOrderTraceSupport_iff + {sigma : E} {H₁ : Subgroup Eˣ} {orders : Finset ℕ} + {rightSubgroup : ℕ → Subgroup Eˣ} {h₁ : H₁} : + h₁ ∈ badOrderTraceSupport sigma H₁ orders rightSubgroup ↔ + ∃ d ∈ orders, ∃ h₂ : rightSubgroup d, + twistedUnitTrace sigma h₁ = twistedUnitTrace 1 h₂ := by + classical + simp [badOrderTraceSupport] + +/-- A uniform bound for each trace-equation solution set gives the expected finite-union bound. -/ +theorem badOrderTraceSupport_card_le + (sigma : E) (H₁ : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ) + (hbound : ∀ d ∈ orders, + (traceEquationSolutions sigma H₁ (rightSubgroup d)).card ≤ bound) : + (badOrderTraceSupport sigma H₁ orders rightSubgroup).card ≤ orders.card * bound := by + classical + unfold badOrderTraceSupport + apply Finset.card_biUnion_le_card_mul + intro d hd + exact (traceEquationLeftSupport_card_le_solutions sigma H₁ (rightSubgroup d)).trans + (hbound d hd) + +/-- A nonuniform real-valued estimate for the individual trace equations sums over the candidate +orders. This form accepts the quoted Corvaja--Zannier bound without rounding it to a natural +number. -/ +theorem badOrderTraceSupport_card_cast_le_sum + (sigma : E) (H₁ : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ → ℝ) + (hbound : ∀ d ∈ orders, + ((traceEquationSolutions sigma H₁ (rightSubgroup d)).card : ℝ) ≤ bound d) : + ((badOrderTraceSupport sigma H₁ orders rightSubgroup).card : ℝ) ≤ + ∑ d ∈ orders, bound d := by + classical + calc + ((badOrderTraceSupport sigma H₁ orders rightSubgroup).card : ℝ) ≤ + ∑ d ∈ orders, ((traceEquationLeftSupport sigma H₁ (rightSubgroup d)).card : ℝ) := by + exact_mod_cast (Finset.card_biUnion_le : + (badOrderTraceSupport sigma H₁ orders rightSubgroup).card ≤ + ∑ d ∈ orders, (traceEquationLeftSupport sigma H₁ (rightSubgroup d)).card) + _ ≤ ∑ d ∈ orders, + ((traceEquationSolutions sigma H₁ (rightSubgroup d)).card : ℝ) := by + exact Finset.sum_le_sum fun d _ ↦ by + exact_mod_cast traceEquationLeftSupport_card_le_solutions sigma H₁ (rightSubgroup d) + _ ≤ ∑ d ∈ orders, bound d := Finset.sum_le_sum hbound + +/-- Direct wiring of the quoted Corvaja--Zannier estimate into the finite bad-order union. The +deep estimate is the explicit hypothesis `hCZ`; this theorem proves only its combinatorial use. -/ +theorem middleGameBadOrderTraceSupport_card_cast_le_corvajaZannierSum + (p : ℕ) (sigma : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hCZ : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((traceEquationSolutions sigma H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) d) : + ((badOrderTraceSupport sigma H₁ (middleGameCandidateOrders p (Nat.card H₁)) + rightSubgroup).card : ℝ) ≤ + ∑ d ∈ middleGameCandidateOrders p (Nat.card H₁), + corvajaZannierTraceUpperBound p (Nat.card H₁) d := + badOrderTraceSupport_card_cast_le_sum sigma H₁ _ rightSubgroup _ hCZ + +/-- The published bad-order union bound, with the deep estimate exposed as a bound on each actual +trace-equation solution set. -/ +theorem middleGameBadOrderTraceSupport_card_le + (p : ℕ) (sigma : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ) + (hbound : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + (traceEquationSolutions sigma H₁ (rightSubgroup d)).card ≤ bound) : + (badOrderTraceSupport sigma H₁ (middleGameCandidateOrders p (Nat.card H₁)) + rightSubgroup).card ≤ + ((p - 1).divisors.card + (p + 1).divisors.card) * bound := by + calc + (badOrderTraceSupport sigma H₁ (middleGameCandidateOrders p (Nat.card H₁)) + rightSubgroup).card ≤ + (middleGameCandidateOrders p (Nat.card H₁)).card * bound := + badOrderTraceSupport_card_le sigma H₁ _ rightSubgroup bound hbound + _ ≤ ((p - 1).divisors.card + (p + 1).divisors.card) * bound := + Nat.mul_le_mul_right bound (middleGameCandidateOrders_card_le p (Nat.card H₁)) + +/-- If the divisor-counted union is strictly smaller than `H₁`, some left rotation element +cannot meet any right subgroup of candidate order. This is the exact pigeonhole step used to +increase the maximal rotation order in the published middle game. -/ +theorem exists_left_element_escaping_middleGameCandidateOrders + (p : ℕ) (sigma : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ) + (hbound : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + (traceEquationSolutions sigma H₁ (rightSubgroup d)).card ≤ bound) + (hsmall : ((p - 1).divisors.card + (p + 1).divisors.card) * bound < Nat.card H₁) : + ∃ h₁ : H₁, ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ∀ h₂ : rightSubgroup d, + twistedUnitTrace sigma h₁ ≠ twistedUnitTrace 1 h₂ := by + classical + let bad := badOrderTraceSupport sigma H₁ + (middleGameCandidateOrders p (Nat.card H₁)) rightSubgroup + have hbad : bad.card < Nat.card H₁ := + (middleGameBadOrderTraceSupport_card_le p sigma H₁ rightSubgroup bound hbound).trans_lt + hsmall + have hexists : ∃ h₁ : H₁, h₁ ∉ bad := by + by_contra hall + push Not at hall + have hle : (Finset.univ : Finset H₁).card ≤ bad.card := + Finset.card_le_card fun h₁ _ ↦ hall h₁ + rw [Finset.card_univ, Fintype.card_eq_nat_card] at hle + exact (Nat.not_le_of_lt hbad) hle + obtain ⟨h₁, hh₁⟩ := hexists + refine ⟨h₁, ?_⟩ + intro d hd h₂ heq + apply hh₁ + exact mem_badOrderTraceSupport_iff.mpr ⟨d, hd, h₂, heq⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean new file mode 100644 index 0000000000..b3871af3bf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound + +/-! +# The weighted-trace torsion-intersection bound + +This module records the exact numerical statement consumed by the Markoff middle game. The +statement is intentionally independent of how the estimate is proved, so low-level escape lemmas +do not import the full general Corvaja--Zannier development. + +The bound is uniform in the two weights and the two torsion orders. Its hypotheses expose the +actual curve admissibility, positivity, and prime-to-characteristic requirements. The completed +producer `corvajaZannierWeightedTraceBound` supplies this statement from the in-repository general +Corvaja--Zannier theorem. + +The conclusion is the safe coefficient-`48` envelope used by the downstream middle game. This +permits the genuine degree-only Euler bound `χ ≤ 8` for a general bidegree-`(2,2)` torus curve; no +unsupported genus-one identification is built into the interface. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The numerical weighted-trace torsion-intersection statement used by the middle game. + +This is a lightweight internal proof boundary, not an external assumption. The selected BGS path +constructs it with `corvajaZannierWeightedTraceBound`. -/ +def WeightedTraceTorsionIntersectionBound + (p : ℕ) [Fact p.Prime] + (E : Type*) [Field E] [Fintype E] [CharP E p] : Prop := + ∀ (alpha beta : E) (leftOrder rightOrder : ℕ), + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta → + 0 < leftOrder → + 0 < rightOrder → + ¬ p ∣ leftOrder → + ¬ p ∣ rightOrder → + ((weightedTraceCurveTorsionIntersection alpha beta + leftOrder rightOrder).card : ℝ) ≤ + corvajaZannierTraceUpperBound p leftOrder rightOrder + +variable (p : ℕ) [Fact p.Prime] +variable (E : Type*) [Field E] [Fintype E] [CharP E p] + +/-- Multiplicative subgroup orders satisfy every arithmetic side condition in the weighted-trace +torsion-intersection bound. -/ +theorem multiplicativeSubgroups_satisfy_weightedTraceBoundOrderHypotheses + (H₁ H₂ : Subgroup Eˣ) : + 0 < Nat.card H₁ ∧ 0 < Nat.card H₂ ∧ + ¬ p ∣ Nat.card H₁ ∧ ¬ p ∣ Nat.card H₂ := by + refine ⟨Nat.card_pos, Nat.card_pos, ?_⟩ + exact weightedTraceCurveTorsionIntersection_orders_primeToCharacteristic p H₁ H₂ + +/-- Apply the weighted-trace torsion-intersection bound after Lean has proved the concrete curve is +admissible and both subgroup orders satisfy the source's arithmetic hypotheses. -/ +theorem weightedTraceEquationSolutions_card_cast_le_of_weightedTraceBound + (hBound : WeightedTraceTorsionIntersectionBound p E) + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) : + ((weightedTraceEquationSolutions alpha beta H₁ H₂).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) (Nat.card H₂) := by + have hfinite : + ((weightedTraceEquationSolutions alpha beta H₁ H₂).card : ℝ) ≤ + ((weightedTraceCurveTorsionIntersection alpha beta + (Nat.card H₁) (Nat.card H₂)).card : ℝ) := by + exact_mod_cast weightedTraceEquationSolutions_card_le_curveTorsionIntersection + alpha beta H₁ H₂ + obtain ⟨hleftPositive, hrightPositive, hleftPrime, hrightPrime⟩ := + multiplicativeSubgroups_satisfy_weightedTraceBoundOrderHypotheses p E H₁ H₂ + have hsource := hBound alpha beta (Nat.card H₁) (Nat.card H₂) + hadmissible hleftPositive hrightPositive hleftPrime hrightPrime + exact hfinite.trans hsource + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean new file mode 100644 index 0000000000..c12a5f1c8d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean @@ -0,0 +1,357 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry + +/-! +# The weighted middle-game trace equation + +An arbitrary Markoff rotation orbit produces the equation + +`alpha * h₁ + beta / h₁ = h₂ + 1 / h₂`, + +with `h₁` in the cyclic rotation subgroup. This module formalizes its finite solution sets, +the elementary quadratic-fiber bound, and the complete bad-order union and pigeonhole reduction. +The deep weighted Corvaja--Zannier estimate is an explicit theorem hypothesis; it is not encoded +as an axiom, class, or structure field. +-/ + +namespace BGS.Markoff + +open Polynomial + +variable {E : Type*} [Field E] [Fintype E] + +/-- The possible left subgroup elements above one fixed right trace in the weighted equation. -/ +noncomputable def weightedTraceEquationLeftFiber + (alpha beta : E) (H₁ : Subgroup Eˣ) (h₂ : Eˣ) : Finset H₁ := by + classical + exact Finset.univ.filter fun h₁ ↦ + weightedSplitTorusTrace alpha beta h₁ = splitTorusTrace h₂ + +/-- Solutions of the weighted middle-game trace equation inside two finite subgroups. -/ +noncomputable def weightedTraceEquationSolutions + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : Finset (H₁ × H₂) := by + classical + exact Finset.univ.biUnion fun h₂ : H₂ ↦ + (weightedTraceEquationLeftFiber alpha beta H₁ h₂).image fun h₁ ↦ (h₁, h₂) + +@[simp] +theorem mem_weightedTraceEquationSolutions_iff + {alpha beta : E} {H₁ H₂ : Subgroup Eˣ} {h : H₁ × H₂} : + h ∈ weightedTraceEquationSolutions alpha beta H₁ H₂ ↔ + weightedSplitTorusTrace alpha beta h.1 = splitTorusTrace h.2 := by + classical + constructor + · intro hh + rw [weightedTraceEquationSolutions, Finset.mem_biUnion] at hh + obtain ⟨h₂, _, hh⟩ := hh + obtain ⟨h₁, hh₁, heq⟩ := Finset.mem_image.mp hh + have hfirst : h₁ = h.1 := congrArg Prod.fst heq + have hsecond : h₂ = h.2 := congrArg Prod.snd heq + simpa [weightedTraceEquationLeftFiber, hfirst, hsecond] using hh₁ + · intro hh + rw [weightedTraceEquationSolutions, Finset.mem_biUnion] + refine ⟨h.2, Finset.mem_univ _, ?_⟩ + exact Finset.mem_image.mpr + ⟨h.1, by simpa [weightedTraceEquationLeftFiber] using hh, rfl⟩ + +omit [Fintype E] in +/-- Dividing the weighted equation by its nonzero leading weight gives the monic twisted-trace +equation used by the existing quadratic polynomial API. -/ +theorem weightedSplitTorusTrace_eq_iff_twistedUnitTrace_eq + (alpha beta trace : E) (h : Eˣ) (halpha : alpha ≠ 0) : + weightedSplitTorusTrace alpha beta h = trace ↔ + twistedUnitTrace (beta / alpha) h = trace / alpha := by + simp only [weightedSplitTorusTrace, twistedUnitTrace] + have hh : (h : E) ≠ 0 := Units.ne_zero h + field_simp [halpha, hh] + +/-- For a fixed right-hand trace, at most two left subgroup elements solve the weighted +equation when the leading weight is nonzero. -/ +theorem weightedTraceEquationLeftFiber_card_le_two + (alpha beta : E) (H₁ : Subgroup Eˣ) (h₂ : Eˣ) (halpha : alpha ≠ 0) : + (weightedTraceEquationLeftFiber alpha beta H₁ h₂).card ≤ 2 := by + classical + let f := twistedTracePolynomial (beta / alpha) (splitTorusTrace h₂ / alpha) + have hf : f ≠ 0 := (twistedTracePolynomial_monic (beta / alpha) _).ne_zero + let rootEmbedding : ↥(weightedTraceEquationLeftFiber alpha beta H₁ h₂) ↪ + ↥f.roots.toFinset := + { toFun := fun h₁ ↦ ⟨((h₁.1 : Eˣ) : E), by + rw [Multiset.mem_toFinset, Polynomial.mem_roots hf] + apply (eval_twistedTracePolynomial_eq_zero_iff (beta / alpha) _ h₁.1).2 + apply (weightedSplitTorusTrace_eq_iff_twistedUnitTrace_eq + alpha beta (splitTorusTrace h₂) h₁.1 halpha).mp + simpa only [weightedTraceEquationLeftFiber, Finset.mem_filter, + Finset.mem_univ, true_and] using h₁.2⟩ + inj' := by + intro x y hxy + apply Subtype.ext + apply Subtype.ext + apply Units.ext + exact congrArg Subtype.val hxy } + have hcard : + (weightedTraceEquationLeftFiber alpha beta H₁ h₂).card ≤ f.roots.toFinset.card := by + simpa only [Fintype.card_coe] using + Fintype.card_le_of_injective rootEmbedding rootEmbedding.injective + calc + (weightedTraceEquationLeftFiber alpha beta H₁ h₂).card ≤ f.roots.toFinset.card := hcard + _ ≤ f.roots.card := Multiset.toFinset_card_le _ + _ ≤ f.natDegree := Polynomial.card_roots' f + _ = 2 := twistedTracePolynomial_natDegree (beta / alpha) _ + +/-- The elementary weighted estimate: every right subgroup element has at most two lifts. -/ +theorem weightedTraceEquationSolutions_card_le_two_mul_right + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) (halpha : alpha ≠ 0) : + (weightedTraceEquationSolutions alpha beta H₁ H₂).card ≤ 2 * Nat.card H₂ := by + classical + unfold weightedTraceEquationSolutions + calc + (Finset.univ.biUnion fun h₂ : H₂ ↦ + (weightedTraceEquationLeftFiber alpha beta H₁ h₂).image fun h₁ ↦ (h₁, h₂)).card ≤ + Finset.univ.card * 2 := by + apply Finset.card_biUnion_le_card_mul + intro h₂ _ + exact Finset.card_image_le.trans + (weightedTraceEquationLeftFiber_card_le_two alpha beta H₁ h₂ halpha) + _ = 2 * Nat.card H₂ := by + rw [Finset.card_univ, Fintype.card_eq_nat_card] + omega + +/-- Left elements occurring in the weighted trace equation with some right subgroup element. -/ +noncomputable def weightedTraceEquationLeftSupport + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : Finset H₁ := by + classical + exact (weightedTraceEquationSolutions alpha beta H₁ H₂).image Prod.fst + +@[simp] +theorem mem_weightedTraceEquationLeftSupport_iff + {alpha beta : E} {H₁ H₂ : Subgroup Eˣ} {h₁ : H₁} : + h₁ ∈ weightedTraceEquationLeftSupport alpha beta H₁ H₂ ↔ + ∃ h₂ : H₂, + weightedSplitTorusTrace alpha beta h₁ = splitTorusTrace h₂ := by + classical + simp only [weightedTraceEquationLeftSupport, Finset.mem_image] + constructor + · rintro ⟨h, hh, rfl⟩ + exact ⟨h.2, mem_weightedTraceEquationSolutions_iff.mp hh⟩ + · rintro ⟨h₂, heq⟩ + exact ⟨(h₁, h₂), mem_weightedTraceEquationSolutions_iff.mpr heq, rfl⟩ + +/-- Projection to the left coordinate cannot increase the weighted solution count. -/ +theorem weightedTraceEquationLeftSupport_card_le_solutions + (alpha beta : E) (H₁ H₂ : Subgroup Eˣ) : + (weightedTraceEquationLeftSupport alpha beta H₁ H₂).card ≤ + (weightedTraceEquationSolutions alpha beta H₁ H₂).card := by + classical + exact Finset.card_image_le + +/-- Left elements meeting at least one member of an indexed family of right subgroups. -/ +noncomputable def weightedBadOrderTraceSupport + (alpha beta : E) (H₁ : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) : Finset H₁ := by + classical + exact orders.biUnion fun d ↦ + weightedTraceEquationLeftSupport alpha beta H₁ (rightSubgroup d) + +@[simp] +theorem mem_weightedBadOrderTraceSupport_iff + {alpha beta : E} {H₁ : Subgroup Eˣ} {orders : Finset ℕ} + {rightSubgroup : ℕ → Subgroup Eˣ} {h₁ : H₁} : + h₁ ∈ weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup ↔ + ∃ d ∈ orders, ∃ h₂ : rightSubgroup d, + weightedSplitTorusTrace alpha beta h₁ = splitTorusTrace h₂ := by + classical + simp [weightedBadOrderTraceSupport] + +/-- A real-valued estimate for each weighted solution set sums over an arbitrary finite family +of candidate right orders. -/ +theorem weightedBadOrderTraceSupport_card_cast_le_sum + (alpha beta : E) (H₁ : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ → ℝ) + (hbound : ∀ d ∈ orders, + ((weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card : ℝ) ≤ + bound d) : + ((weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup).card : ℝ) ≤ + ∑ d ∈ orders, bound d := by + classical + calc + ((weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup).card : ℝ) ≤ + ∑ d ∈ orders, + ((weightedTraceEquationLeftSupport alpha beta H₁ (rightSubgroup d)).card : ℝ) := by + exact_mod_cast (Finset.card_biUnion_le : + (weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup).card ≤ + ∑ d ∈ orders, + (weightedTraceEquationLeftSupport alpha beta H₁ (rightSubgroup d)).card) + _ ≤ ∑ d ∈ orders, + ((weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card : ℝ) := by + exact Finset.sum_le_sum fun d _ ↦ by + exact_mod_cast weightedTraceEquationLeftSupport_card_le_solutions + alpha beta H₁ (rightSubgroup d) + _ ≤ ∑ d ∈ orders, bound d := Finset.sum_le_sum hbound + +/-- A uniform natural-valued bound gives the corresponding weighted finite-union bound. -/ +theorem weightedBadOrderTraceSupport_card_le + (alpha beta : E) (H₁ : Subgroup Eˣ) (orders : Finset ℕ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ) + (hbound : ∀ d ∈ orders, + (weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card ≤ bound) : + (weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup).card ≤ + orders.card * bound := by + classical + unfold weightedBadOrderTraceSupport + apply Finset.card_biUnion_le_card_mul + intro d hd + exact (weightedTraceEquationLeftSupport_card_le_solutions + alpha beta H₁ (rightSubgroup d)).trans (hbound d hd) + +/-- The published divisor-counted natural-valued weighted bad-order bound. -/ +theorem middleGameWeightedBadOrderTraceSupport_card_le + (p : ℕ) (alpha beta : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ) + (hbound : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + (weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card ≤ bound) : + (weightedBadOrderTraceSupport alpha beta H₁ + (middleGameCandidateOrders p (Nat.card H₁)) rightSubgroup).card ≤ + ((p - 1).divisors.card + (p + 1).divisors.card) * bound := by + calc + (weightedBadOrderTraceSupport alpha beta H₁ + (middleGameCandidateOrders p (Nat.card H₁)) rightSubgroup).card ≤ + (middleGameCandidateOrders p (Nat.card H₁)).card * bound := + weightedBadOrderTraceSupport_card_le alpha beta H₁ _ rightSubgroup bound hbound + _ ≤ ((p - 1).divisors.card + (p + 1).divisors.card) * bound := + Nat.mul_le_mul_right bound (middleGameCandidateOrders_card_le p (Nat.card H₁)) + +/-- The weighted Corvaja--Zannier estimate, when supplied for each actual right subgroup, +sums to the same numerical expression as in the normalized equation. The essential +nondegeneracy `alpha * beta != 1` is an explicit premise of the estimate. -/ +theorem middleGameWeightedBadOrderTraceSupport_card_cast_le_corvajaZannierSum + (p : ℕ) (alpha beta : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + Nat.card (rightSubgroup d) = d) + (hCZ : alpha * beta ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) + (Nat.card (rightSubgroup d))) + (hnondegenerate : alpha * beta ≠ 1) : + ((weightedBadOrderTraceSupport alpha beta H₁ + (middleGameCandidateOrders p (Nat.card H₁)) rightSubgroup).card : ℝ) ≤ + ∑ d ∈ middleGameCandidateOrders p (Nat.card H₁), + corvajaZannierTraceUpperBound p (Nat.card H₁) d := by + apply weightedBadOrderTraceSupport_card_cast_le_sum + intro d hd + have hEstimate := hCZ hnondegenerate d hd + rw [hrightOrder d hd] at hEstimate + exact hEstimate + +/-- Combining the weighted Corvaja--Zannier estimate with the common current-order envelope. -/ +theorem middleGameWeightedBadOrderTraceSupport_card_cast_le_divisorEnvelope + (p : ℕ) (alpha beta : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + Nat.card (rightSubgroup d) = d) + (hCZ : alpha * beta ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) + (Nat.card (rightSubgroup d))) + (hnondegenerate : alpha * beta ≠ 1) : + ((weightedBadOrderTraceSupport alpha beta H₁ + (middleGameCandidateOrders p (Nat.card H₁)) rightSubgroup).card : ℝ) ≤ + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p (Nat.card H₁) := by + exact (middleGameWeightedBadOrderTraceSupport_card_cast_le_corvajaZannierSum + p alpha beta H₁ rightSubgroup hrightOrder hCZ hnondegenerate).trans + (middleGameCorvajaZannierSum_le_divisorCount_mul_envelope p (Nat.card H₁)) + +/-- If the divisor-counted weighted bad set is smaller than the left subgroup, one left element +avoids every candidate right-order trace. -/ +theorem exists_left_element_escaping_weightedCandidateOrders + (p : ℕ) (alpha beta : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) (bound : ℕ) + (hbound : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + (weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card ≤ bound) + (hsmall : ((p - 1).divisors.card + (p + 1).divisors.card) * bound < Nat.card H₁) : + ∃ h₁ : H₁, ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ∀ h₂ : rightSubgroup d, + weightedSplitTorusTrace alpha beta h₁ ≠ splitTorusTrace h₂ := by + classical + let orders := middleGameCandidateOrders p (Nat.card H₁) + let bad := weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup + have hbad : bad.card < Nat.card H₁ := + (middleGameWeightedBadOrderTraceSupport_card_le + p alpha beta H₁ rightSubgroup bound hbound).trans_lt hsmall + have hexists : ∃ h₁ : H₁, h₁ ∉ bad := by + by_contra hall + push Not at hall + have hle : (Finset.univ : Finset H₁).card ≤ bad.card := + Finset.card_le_card fun h₁ _ ↦ hall h₁ + rw [Finset.card_univ, Fintype.card_eq_nat_card] at hle + exact (Nat.not_le_of_lt hbad) hle + obtain ⟨h₁, hh₁⟩ := hexists + refine ⟨h₁, ?_⟩ + intro d hd h₂ heq + apply hh₁ + exact mem_weightedBadOrderTraceSupport_iff.mpr + ⟨d, by simpa [orders] using hd, h₂, heq⟩ + +/-- The complete finite weighted Corvaja--Zannier escape reduction. The only deep premise is +`hCZ`; the remaining hypotheses are actual subgroup cardinalities and the two explicit size +inequalities controlling the cube-root and `1 / p` terms. -/ +theorem exists_left_element_escaping_of_weightedCorvajaZannierEstimate_and_sizeBounds + (p : ℕ) (alpha beta : E) (H₁ : Subgroup Eˣ) + (rightSubgroup : ℕ → Subgroup Eˣ) + (hrightOrder : ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + Nat.card (rightSubgroup d) = d) + (hCZ : alpha * beta ≠ 1 → + ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ((weightedTraceEquationSolutions alpha beta H₁ (rightSubgroup d)).card : ℝ) ≤ + corvajaZannierTraceUpperBound p (Nat.card H₁) + (Nat.card (rightSubgroup d))) + (hnondegenerate : alpha * beta ≠ 1) + (hcurrentOrder : 0 < Nat.card H₁) + (hcube : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < Nat.card H₁) + (hlinear : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * Nat.card H₁ < p) : + ∃ h₁ : H₁, ∀ d ∈ middleGameCandidateOrders p (Nat.card H₁), + ∀ h₂ : rightSubgroup d, + weightedSplitTorusTrace alpha beta h₁ ≠ splitTorusTrace h₂ := by + classical + let orders := middleGameCandidateOrders p (Nat.card H₁) + let bad := weightedBadOrderTraceSupport alpha beta H₁ orders rightSubgroup + have hbadReal : (bad.card : ℝ) < (Nat.card H₁ : ℝ) := by + calc + (bad.card : ℝ) ≤ + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) * + corvajaZannierCurrentOrderEnvelope p (Nat.card H₁) := by + simpa [orders, bad] using + middleGameWeightedBadOrderTraceSupport_card_cast_le_divisorEnvelope + p alpha beta H₁ rightSubgroup hrightOrder hCZ hnondegenerate + _ < (Nat.card H₁ : ℝ) := + divisorCount_mul_corvajaZannierEnvelope_lt_currentOrder p (Nat.card H₁) + hcurrentOrder hcube hlinear + have hbad : bad.card < Nat.card H₁ := by exact_mod_cast hbadReal + have hexists : ∃ h₁ : H₁, h₁ ∉ bad := by + by_contra hall + push Not at hall + have hle : (Finset.univ : Finset H₁).card ≤ bad.card := + Finset.card_le_card fun h₁ _ ↦ hall h₁ + rw [Finset.card_univ, Fintype.card_eq_nat_card] at hle + exact (Nat.not_le_of_lt hbad) hle + obtain ⟨h₁, hh₁⟩ := hexists + refine ⟨h₁, ?_⟩ + intro d hd h₂ heq + apply hh₁ + exact mem_weightedBadOrderTraceSupport_iff.mpr + ⟨d, by simpa [orders] using hd, h₂, heq⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean new file mode 100644 index 0000000000..b13e642ccf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean @@ -0,0 +1,162 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +import Mathlib.Tactic + +/-! +# Euler budget seven for the weighted trace curve + +The reduced weighted trace closure has bidegree `(2,2)` and, when the second +weight is nonzero, contains the affine origin. Both coordinate functions +vanish at the finite place selected above that origin. Combining this shared +place with the generic canonical-divisor estimate lowers the sound +log-canonical degree budget from `8` to `7`. + +This is deliberately weaker than the paper's unsupported value `3`, but it +uses only the normalization-place machinery proved in the repository. +-/ + +open scoped Polynomial BigOperators + +namespace BGS.Markoff + +open BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The first actual coordinate degree of the weighted trace closure. -/ +theorem weightedTraceTorusClosurePolynomial_degreeOf_first + (alpha beta : K) (hbeta : beta ≠ 0) : + MvPolynomial.degreeOf 0 + (weightedTraceTorusClosurePolynomial alpha beta) = 2 := by + rw [← planeCurveToBivariate_natDegree_eq_degreeOf_zero] + change (finTwoToIteratedPolynomial (K := K) + (weightedTraceTorusClosurePolynomial alpha beta)).natDegree = 2 + rw [finTwoToIteratedPolynomial_weightedTraceTorusClosurePolynomial + alpha beta hbeta] + exact weightedTraceIteratedPolynomial_right_natDegree alpha beta + +/-- The second actual coordinate degree of the weighted trace closure. -/ +theorem weightedTraceTorusClosurePolynomial_degreeOf_second + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) : + MvPolynomial.degreeOf 1 + (weightedTraceTorusClosurePolynomial alpha beta) = 2 := by + rw [← bivariateEquiv_symm_natDegree_eq_degreeOf_one] + rw [← transposeBivariate_planeCurveToBivariate] + rw [transposeBivariate_eq_bivariateSwap] + change (Polynomial.Bivariate.swap + (finTwoToIteratedPolynomial (K := K) + (weightedTraceTorusClosurePolynomial alpha beta))).natDegree = 2 + rw [finTwoToIteratedPolynomial_weightedTraceTorusClosurePolynomial + alpha beta hbeta] + exact weightedTraceIteratedPolynomial_left_natDegree alpha beta halpha + +/-- The common affine origin of the two coordinate divisors. -/ +def weightedTraceTorusClosureOrigin + (alpha beta : K) (hbeta : beta ≠ 0) : + AffinePlaneCurvePoint + (weightedTraceTorusClosurePolynomial alpha beta) := + ⟨(0, 0), by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + exact splitTraceCoverPolynomial_origin_zero + alpha beta 1 1 (by norm_num) (by norm_num)⟩ + +section Finite + +variable [Fintype K] [DecidableEq K] + +/-- The sound log-canonical degree budget for the weighted trace curve is at +most seven. The sole field-size premise is the one needed by the canonical +different estimate. -/ +theorem weightedTraceTorusClosure_canonicalExceptionalDegree_le_seven + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (hcardK : 2 < Fintype.card K) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + weightedTraceTorusClosurePolynomial_irreducible + alpha beta halpha hbeta hnondegenerate + letI := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero + (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hbeta)) + letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + hf (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hbeta) + letI := separable_planeCurveFunctionField_over_ratFunc + hf (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hbeta) + finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) + (finiteExtensionCanonicalDifferentDivisor K + (PlaneCurveFunctionField f) + (finiteExtensionFiniteDifferentIdeal_ne_bot K + (PlaneCurveFunctionField f))) + + (∑ w ∈ propositionTwoExceptionalPlaces K + (PlaneCurveFunctionField f) + ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), + finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℤ) ≤ + 7 := by + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + weightedTraceTorusClosurePolynomial_irreducible + alpha beta halpha hbeta hnondegenerate + let hpartialFirst : + MvPolynomial.pderiv 0 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + alpha beta hbeta + let hpartialSecond : + MvPolynomial.pderiv 1 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hbeta + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + planeCurveFirstCoordinateRatFuncAlgebra f hx + letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc + hf hpartialSecond + letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + have hdegreeFirst : + MvPolynomial.degreeOf 0 f = 2 := + weightedTraceTorusClosurePolynomial_degreeOf_first alpha beta hbeta + have hdegreeSecond : + MvPolynomial.degreeOf 1 f = 2 := + weightedTraceTorusClosurePolynomial_degreeOf_second + alpha beta halpha hbeta + have hcardCurve : + MvPolynomial.degreeOf 1 f < Fintype.card K := by + rw [hdegreeSecond] + exact hcardK + have hEulerPlusOne := + planeCurve_canonicalDifferent_add_propositionTwoExceptional_add_one_le + hf hpartialFirst hpartialSecond hcardCurve + (weightedTraceTorusClosureOrigin alpha beta hbeta) + rfl rfl m n hm hn + rw [hdegreeFirst, hdegreeSecond] at hEulerPlusOne + dsimp only [f] at hEulerPlusOne + norm_num at hEulerPlusOne ⊢ + omega + +end Finite + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean new file mode 100644 index 0000000000..952bb6f3a9 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean @@ -0,0 +1,80 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound +import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +import Mathlib.Tactic + +/-! +# The exact Euler-seven weighted trace bound + +Above the elementary range this is the χ≤7 Proposition Two endpoint. Below +that range the roots-of-unity count lands directly in the unchanged +quotient-by-characteristic branch. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- The χ≤7 weighted trace estimate in every characteristic. -/ +theorem weightedTraceTorsionIntersection_card_cast_le_eulerSeven + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + (alpha beta : K) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) : + ((BGS.External.torusCurveTorsionIntersection K + (weightedTraceTorusClosurePolynomial alpha beta) m n).card : ℝ) ≤ + corvajaZannierCorollaryTwoNumericalBound p m n 2 2 7 := by + by_cases hlarge : 48 < p + · exact + weightedTraceTorsionIntersection_card_cast_le_eulerSeven_of_largeChar + alpha beta hadmissible m n hm hn hmPrime hnPrime hlarge + · have hsmall : p ≤ 48 := Nat.le_of_not_gt hlarge + have hcardNat := + BGS.External.torusCurveTorsionIntersection_card_le_orders + (weightedTraceTorusClosurePolynomial alpha beta) m n hm hn + have hcardReal : + ((BGS.External.torusCurveTorsionIntersection K + (weightedTraceTorusClosurePolynomial alpha beta) m n).card : ℝ) ≤ + ((m * n : ℕ) : ℝ) := by + exact_mod_cast hcardNat + have hpReal : (0 : ℝ) < p := by + exact_mod_cast (Fact.out : p.Prime).pos + have hscaledNat : p * (m * n) ≤ 48 * (m * n) := + Nat.mul_le_mul_right (m * n) hsmall + have hscaledReal : + (p : ℝ) * ((m * n : ℕ) : ℝ) ≤ + 48 * ((m * n : ℕ) : ℝ) := by + exact_mod_cast hscaledNat + have hquotient : + ((m * n : ℕ) : ℝ) ≤ + 48 * ((m * n : ℕ) : ℝ) / (p : ℝ) := by + apply (le_div_iff₀ hpReal).2 + simpa [mul_comm] using hscaledReal + have hright : + 48 * ((m * n : ℕ) : ℝ) / (p : ℝ) = + 12 * ((m * n * 2 * 2 : ℕ) : ℝ) / (p : ℝ) := by + push_cast + ring + unfold corvajaZannierCorollaryTwoNumericalBound + calc + ((BGS.External.torusCurveTorsionIntersection K + (weightedTraceTorusClosurePolynomial alpha beta) m n).card : ℝ) + ≤ ((m * n : ℕ) : ℝ) := hcardReal + _ ≤ 48 * ((m * n : ℕ) : ℝ) / (p : ℝ) := hquotient + _ = 12 * ((m * n * 2 * 2 : ℕ) : ℝ) / (p : ℝ) := hright + _ ≤ max + (3 * (2 * ((m * n * 2 * 2 : ℕ) : ℝ) * 7) ^ + ((1 : ℝ) / 3)) + (12 * ((m * n * 2 * 2 : ℕ) : ℝ) / (p : ℝ)) := + le_max_right _ _ + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean new file mode 100644 index 0000000000..a3f448fead --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean @@ -0,0 +1,135 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +import Mathlib.Tactic + +/-! +# The Euler-seven weighted trace bound above the elementary range + +This module converts the exact χ≤7 Proposition Two result into its numerical +torsion-intersection estimate when `48 < p`. +-/ + +namespace BGS.Markoff + +open BGS.CorvajaZannier + +noncomputable section + + +theorem weightedTraceTorsionIntersection_card_cast_le_eulerSeven_of_largeChar + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + (alpha beta : K) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) + (hlarge : 48 < p) : + ((BGS.External.torusCurveTorsionIntersection K + (weightedTraceTorusClosurePolynomial alpha beta) m n).card : ℝ) ≤ + corvajaZannierCorollaryTwoNumericalBound p m n 2 2 7 := by + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + let hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + alpha beta hadmissible.2.1 + let hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + let card : ℕ := + (BGS.External.torusCurveTorsionIntersection K f m n).card + let gcdDegree : ℕ := + planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n + have hdegreeFirst : + MvPolynomial.degreeOf 0 f = 2 := + weightedTraceTorusClosurePolynomial_degreeOf_first + alpha beta hadmissible.2.1 + have hdegreeSecond : + MvPolynomial.degreeOf 1 f = 2 := + weightedTraceTorusClosurePolynomial_degreeOf_second + alpha beta hadmissible.1 hadmissible.2.1 + have hlargeActual : + 12 * MvPolynomial.degreeOf 0 f * + MvPolynomial.degreeOf 1 f < p := by + rw [hdegreeFirst, hdegreeSecond] + norm_num at hlarge ⊢ + exact hlarge + have hcardK : 2 < Fintype.card K := by + have hdegreeCard := + planeCurve_degreeOf_second_lt_card_of_twelve_mul_degrees_lt_char + hpartialFirst hpartialSecond hlargeActual + rw [hdegreeSecond] at hdegreeCard + exact hdegreeCard + have hpropositionGcd := + weightedTracePropositionTwo_eulerSeven + (p := p) alpha beta hadmissible m n hm hn + hmPrime hnPrime hcardK + have hcurve := + weightedTraceCurve_isGeneralCorvajaZannierPlaneCurve + alpha beta hadmissible + have hbidegree := + weightedTraceTorusClosurePolynomial_hasBidegreeAtMost + alpha beta hadmissible.2.1 + have hnonzero := + poweredTorsionFunctions_ne_zero_of_isCorvajaZannierPlaneCurve + hcurve m n hm hn + have hcardGcd : card ≤ gcdDegree := by + dsimp only [card, gcdDegree] + rw [torusCurveTorsionIntersection_card_eq_torsionPoint_card] + exact torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree + hf hpartialSecond m n hnonzero.1 hnonzero.2 + have hcardTrivial : + card ≤ planeCurveTorsionLowerDegree 2 2 m n := by + dsimp only [card, planeCurveTorsionLowerDegree] + simpa only [min_comm] using + torusCurveTorsionIntersection_card_le_min_bidegree_order + f 2 2 m n hbidegree hcurve hm hn + have hpropositionCard : PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree 2 2 m n) + (planeCurveTorsionUpperDegree 2 2 m n) + p 7 (card : ℝ) := by + apply propositionTwoNumericalAlternatives_mono + (G := (card : ℝ)) (H := (gcdDegree : ℝ)) + · exact_mod_cast hcardGcd + · simpa only [f, hf, gcdDegree, hdegreeFirst, hdegreeSecond] using + hpropositionGcd + let a := planeCurveTorsionLowerDegree 2 2 m n + let b := planeCurveTorsionUpperDegree 2 2 m n + have ha : 0 < a := by + dsimp only [a, planeCurveTorsionLowerDegree] + exact lt_min (Nat.mul_pos hn (by norm_num)) + (Nat.mul_pos hm (by norm_num)) + have hab : a ≤ b := by + dsimp only [a, b, planeCurveTorsionLowerDegree, + planeCurveTorsionUpperDegree] + exact min_le_max + have hbound := + theoremTwo_maxBound_of_propositionTwo + a b 7 p (card : ℝ) ha hab (by norm_num) + (Fact.out : p.Prime).pos (Nat.cast_nonneg card) + (by exact_mod_cast hcardTrivial) (by + simpa only [a, b] using hpropositionCard) + have habProduct : a * b = m * n * 2 * 2 := by + simpa only [a, b] using + planeCurveTorsionLowerDegree_mul_upperDegree 2 2 m n + have habProductReal : + (a : ℝ) * (b : ℝ) = ((m * n * 2 * 2 : ℕ) : ℝ) := by + exact_mod_cast habProduct + rw [habProductReal] at hbound + simpa only [card, f, corvajaZannierCorollaryTwoNumericalBound, + Nat.cast_ofNat, mul_assoc] using hbound + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean new file mode 100644 index 0000000000..e06bf93298 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean @@ -0,0 +1,262 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +import Mathlib.Tactic + +/-! +# Proposition Two with Euler budget seven for the weighted trace curve + +The general bidegree endpoint uses the ambient budget `8`. For the weighted +trace curve, the common affine origin saves one boundary degree, while the +sparse support determinant bounds the powered-image index by `2`. This module +feeds both exact inputs into the natural and swapped Proposition Two proofs. +-/ + +namespace BGS.Markoff + +open BGS.CorvajaZannier + +noncomputable section + + +theorem weightedTracePropositionTwo_natural_eulerSeven + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + (alpha beta : K) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) + (hcardK : 2 < Fintype.card K) : + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + PropositionTwoNumericalAlternatives + (n * MvPolynomial.degreeOf 0 f) + (m * MvPolynomial.degreeOf 1 f) p 7 + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf + (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1) + m n : ℝ) := by + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + let hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + alpha beta hadmissible.2.1 + let hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + have hindexTwo : + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ 2 := by + simpa only [f, hf] using + weightedTraceTorusClosure_poweredImageIndex_le_two + (p := p) alpha beta hadmissible m n hm hn hmPrime hnPrime + have hindexSeven : + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ 7 := + hindexTwo.trans (by omega) + apply planeCurvePropositionTwo_natural_of_auxiliaryBounds + hf hpartialFirst hpartialSecond m n p 7 hm hn hindexSeven + intro h k hh hk hparameters hexcluded + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n + let g := poweredCoordinateFrobeniusImageRelation + (p := p) hf hpartialSecond m hm n + have hbidegree := poweredCoordinateImageRelation_bidegree_le + hf hpartialFirst hpartialSecond m hm n hn + have hdegreeG : g.natDegree ≤ n * MvPolynomial.degreeOf 0 f := by + dsimp only [g] + rw [poweredCoordinateFrobeniusImageRelation_natDegree] + exact hbidegree.2 + have hdegreeTranspose : (transposeBivariate g).natDegree ≤ + m * MvPolynomial.degreeOf 1 f := by + dsimp only [g] + rw [transposeBivariate_poweredCoordinateFrobeniusImageRelation_natDegree] + exact hbidegree.1 + have hsize : g.natDegree * h + + (transposeBivariate g).natDegree * k < p := by + apply lt_of_le_of_lt _ hparameters.2 + exact Nat.add_le_add + (Nat.mul_le_mul_right h hdegreeG) + (Nat.mul_le_mul_right k hdegreeTranspose) + have hexcludedG : ¬ (g.natDegree ≤ k ∧ + (transposeBivariate g).natDegree ≤ h) := by + dsimp only [g, gK] at hexcluded ⊢ + rw [poweredCoordinateFrobeniusImageRelation_natDegree, + transposeBivariate_poweredCoordinateFrobeniusImageRelation_natDegree] + exact hexcluded + have hLI := + poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent + (p := p) hadmissible.2.2.2.1 hf hpartialFirst hpartialSecond + m n hm hnPrime h k hh hk hsize hexcludedG + have hEuler := + weightedTraceTorusClosure_canonicalExceptionalDegree_le_seven + alpha beta hadmissible.1 hadmissible.2.1 hadmissible.2.2.1 + hcardK m n hm hn + exact finiteExtensionGcdBound_planeCurvePowers_of_auxiliaryFamily_linearIndependent + (p := p) hf hpartialFirst hpartialSecond m n hm hn + h k hparameters.1 7 hLI (by + simpa only [f, hf, Nat.cast_ofNat] using hEuler) + +theorem weightedTracePropositionTwo_swapped_eulerSeven + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + (alpha beta : K) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) + (hcardK : 2 < Fintype.card K) : + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + PropositionTwoNumericalAlternatives + (m * MvPolynomial.degreeOf 1 f) + (n * MvPolynomial.degreeOf 0 f) p 7 + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf + (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1) + m n : ℝ) := by + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + let hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + alpha beta hadmissible.2.1 + let hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0 := + weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + letI : DecidableEq (RatFunc K) := Classical.decEq _ + have hindexTwo : + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ 2 := by + simpa only [f, hf] using + weightedTraceTorusClosure_poweredImageIndex_le_two + (p := p) alpha beta hadmissible m n hm hn hmPrime hnPrime + have hindexSeven : + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ 7 := + hindexTwo.trans (by omega) + apply planeCurvePropositionTwo_swapped_of_auxiliaryBounds + hf hpartialFirst hpartialSecond m n p 7 hm hn hindexSeven + intro h k hh hk hparameters hexcluded + let L := PlaneCurveFunctionField f + letI : CharP L p := charP_of_injective_algebraMap + (algebraMap K L).injective p + let F := frobeniusSubfield L p + let ι : K →+* F := + perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) + let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n + let g : Polynomial (Polynomial F) := gK.map (Polynomial.mapRingHom ι) + have hι : Function.Injective ι := + perfectConstantsToFrobeniusSubfield_injective + (K := K) (L := L) (p := p) + have hmap : Function.Injective (Polynomial.mapRingHom ι) := + Polynomial.map_injective ι hι + have hdegreeG : g.natDegree = gK.natDegree := by + dsimp only [g] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have hdegreeTranspose : (transposeBivariate g).natDegree = + (transposeBivariate gK).natDegree := by + dsimp only [g] + rw [transposeBivariate_map] + exact Polynomial.natDegree_map_eq_of_injective hmap _ + have hbidegree := poweredCoordinateImageRelation_bidegree_le + hf hpartialFirst hpartialSecond m hm n hn + have hsize : g.natDegree * h + + (transposeBivariate g).natDegree * k < p := by + apply lt_of_le_of_lt _ hparameters.2 + rw [hdegreeG, hdegreeTranspose] + exact Nat.add_le_add + (Nat.mul_le_mul_right h hbidegree.1) + (Nat.mul_le_mul_right k hbidegree.2) + have hexcludedG : ¬ (g.natDegree ≤ k ∧ + (transposeBivariate g).natDegree ≤ h) := by + rw [hdegreeG, hdegreeTranspose] + exact hexcluded + have hLI := + poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent_swapped + (p := p) hadmissible.2.2.2.1 hf hpartialFirst hpartialSecond + m n hm hn hmPrime h k hh hk hsize hexcludedG + have hEuler := + weightedTraceTorusClosure_canonicalExceptionalDegree_le_seven + alpha beta hadmissible.1 hadmissible.2.1 hadmissible.2.2.1 + hcardK m n hm hn + exact + finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_linearIndependent + (p := p) hf hpartialFirst hpartialSecond m n hm hn + h k hparameters.1 7 hLI (by + simpa only [f, hf, propositionTwoExceptionalPlaces, + Finset.union_comm, Nat.cast_ofNat] using hEuler) + +/-- The natural and swapped orientations give the minimum/maximum form with +Euler budget exactly seven. -/ +theorem weightedTracePropositionTwo_eulerSeven + {K : Type*} [Field K] [Fintype K] [DecidableEq K] + {p : ℕ} [Fact p.Prime] [CharP K p] + (alpha beta : K) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) + (hcardK : 2 < Fintype.card K) : + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + PropositionTwoNumericalAlternatives + (planeCurveTorsionLowerDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) m n) + (planeCurveTorsionUpperDegree + (MvPolynomial.degreeOf 0 f) (MvPolynomial.degreeOf 1 f) m n) + p 7 + (planeCurveExhaustiveTorsionGcdWeightedDegree + hf + (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1) + m n : ℝ) := by + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + by_cases horient : n * MvPolynomial.degreeOf 0 f ≤ + m * MvPolynomial.degreeOf 1 f + · have hnatural := + weightedTracePropositionTwo_natural_eulerSeven + (p := p) alpha beta hadmissible m n hm hn + hmPrime hnPrime hcardK + simpa only [f, hf, planeCurveTorsionLowerDegree, + planeCurveTorsionUpperDegree, min_eq_left horient, + max_eq_right horient] using hnatural + · have horient' : m * MvPolynomial.degreeOf 1 f ≤ + n * MvPolynomial.degreeOf 0 f := + Nat.le_of_lt (lt_of_not_ge horient) + have hswapped := + weightedTracePropositionTwo_swapped_eulerSeven + (p := p) alpha beta hadmissible m n hm hn + hmPrime hnPrime hcardK + simpa only [f, hf, planeCurveTorsionLowerDegree, + planeCurveTorsionUpperDegree, min_eq_right horient', + max_eq_left horient'] using hswapped + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean new file mode 100644 index 0000000000..79520f91f3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean @@ -0,0 +1,146 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +import Mathlib.Tactic + +/-! +# Powered-image index two for the weighted trace curve + +Three always-present monomials of the nonzero-weight trace closure have +exponents `(1,0)`, `(2,1)`, and `(0,1)`. Their support determinant is `2`. +Retaining this exact sparse-support certificate lowers the source-to-powered +image index bound from the generic bidegree value `8` to `2`. +-/ + +namespace BGS.Markoff + +open BGS.CorvajaZannier + +noncomputable section + +variable {K : Type*} [Field K] + +private def weightedTraceSupportAlpha : Fin 2 →₀ ℕ := + Finsupp.single 0 1 + Finsupp.single 1 2 + +private def weightedTraceSupportRightConstant : Fin 2 →₀ ℕ := + Finsupp.single 0 1 + +private def weightedTraceSupportMixed : Fin 2 →₀ ℕ := + Finsupp.single 0 2 + Finsupp.single 1 1 + +private def weightedTraceSupportLeftConstant : Fin 2 →₀ ℕ := + Finsupp.single 1 1 + +private theorem weightedTraceX_eq_monomial (i : Fin 2) : + (MvPolynomial.X i : MvPolynomial (Fin 2) K) = + MvPolynomial.monomial (Finsupp.single i 1) 1 := by + rw [← pow_one (MvPolynomial.X i), MvPolynomial.X_pow_eq_monomial] + +private theorem splitTraceCoverPolynomial_one_one_eq_monomials + (alpha beta : K) : + splitTraceCoverPolynomial alpha beta 1 1 = + MvPolynomial.monomial weightedTraceSupportAlpha alpha + + MvPolynomial.monomial weightedTraceSupportRightConstant beta - + MvPolynomial.monomial weightedTraceSupportMixed 1 - + MvPolynomial.monomial weightedTraceSupportLeftConstant 1 := by + rw [splitTraceCoverPolynomial] + norm_num only [pow_one, mul_one] + rw [MvPolynomial.C_mul_X_eq_monomial, + MvPolynomial.C_mul_X_eq_monomial, + MvPolynomial.X_pow_eq_monomial, + weightedTraceX_eq_monomial, weightedTraceX_eq_monomial] + simp [MvPolynomial.monomial_pow, weightedTraceSupportAlpha, + weightedTraceSupportRightConstant, weightedTraceSupportMixed, + weightedTraceSupportLeftConstant] + +private theorem weightedTraceSupportRightConstant_mem + (alpha beta : K) (hbeta : beta ≠ 0) : + weightedTraceSupportRightConstant ∈ + (weightedTraceTorusClosurePolynomial alpha beta).support := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [splitTraceCoverPolynomial_one_one_eq_monomials] + rw [MvPolynomial.mem_support_iff] + simp [weightedTraceSupportAlpha, weightedTraceSupportRightConstant, + weightedTraceSupportMixed, weightedTraceSupportLeftConstant, hbeta, + Finsupp.ext_iff] + +private theorem weightedTraceSupportMixed_mem + (alpha beta : K) (hbeta : beta ≠ 0) : + weightedTraceSupportMixed ∈ + (weightedTraceTorusClosurePolynomial alpha beta).support := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [splitTraceCoverPolynomial_one_one_eq_monomials] + rw [MvPolynomial.mem_support_iff] + simp [weightedTraceSupportAlpha, weightedTraceSupportRightConstant, + weightedTraceSupportMixed, weightedTraceSupportLeftConstant, + Finsupp.ext_iff] + +private theorem weightedTraceSupportLeftConstant_mem + (alpha beta : K) (hbeta : beta ≠ 0) : + weightedTraceSupportLeftConstant ∈ + (weightedTraceTorusClosurePolynomial alpha beta).support := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [splitTraceCoverPolynomial_one_one_eq_monomials] + rw [MvPolynomial.mem_support_iff] + simp [weightedTraceSupportAlpha, weightedTraceSupportRightConstant, + weightedTraceSupportMixed, weightedTraceSupportLeftConstant, + Finsupp.ext_iff] + +private theorem weightedTraceSupportDeterminant : + planeCurveSupportDifferenceDet + weightedTraceSupportRightConstant + weightedTraceSupportMixed + weightedTraceSupportLeftConstant = 2 := by + simp [planeCurveSupportDifferenceDet, + weightedTraceSupportRightConstant, weightedTraceSupportMixed, + weightedTraceSupportLeftConstant] + +/-- The exact support determinant gives powered-image index at most two for +every prime-to-characteristic pair of powers. -/ +theorem weightedTraceTorusClosure_poweredImageIndex_le_two + {p : ℕ} [Fact p.Prime] [CharP K p] + (alpha beta : K) + (hadmissible : WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta) + (m n : ℕ) (hm : 0 < m) (hn : 0 < n) + (hmPrime : ¬ p ∣ m) (hnPrime : ¬ p ∣ n) : + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + letI := planeCurveCoordinateRing_isDomain hf + Module.finrank (PoweredImageOverFirst f m n) + (PlaneCurveFunctionField f) ≤ 2 := by + let f := weightedTraceTorusClosurePolynomial alpha beta + let hf : Irreducible f := + irreducible_of_irreducible_map_algebraicClosure + hadmissible.2.2.2.1 + letI : IsDomain (PlaneCurveCoordinateRing f) := + planeCurveCoordinateRing_isDomain hf + have hindex := + finrank_poweredImageOverFirst_le_supportDet + (p := p) hadmissible.2.2.2.1 + (weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero + alpha beta hadmissible.2.1) + (weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero + alpha beta hadmissible.2.1) + (weightedTraceSupportRightConstant_mem + alpha beta hadmissible.2.1) + (weightedTraceSupportMixed_mem + alpha beta hadmissible.2.1) + (weightedTraceSupportLeftConstant_mem + alpha beta hadmissible.2.1) + (by rw [weightedTraceSupportDeterminant]; norm_num) + m n hm hn hmPrime hnPrime + rw [weightedTraceSupportDeterminant] at hindex + norm_num at hindex ⊢ + exact hindex + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean new file mode 100644 index 0000000000..5b8707661a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean @@ -0,0 +1,22 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction +import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic +import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound +import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean new file mode 100644 index 0000000000..90654e12a1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean @@ -0,0 +1,288 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure + +/-! +# Transporting the characteristic-zero opening through an algebraic closure + +The archimedean argument is proved over `ℂ`, while the paper formulates the opening over an +algebraic closure of `ℚ`. This file records the missing functorial step. A field embedding sends +normalized Markoff points coordinatewise and intertwines the five generators. Closure induction +on `Gamma` then shows that a finite orbit over the source field has finite image orbit over `ℂ`. +-/ + +namespace BGS.Markoff + +universe u v + +/-- Apply a ring homomorphism coordinatewise to a normalized trace point. -/ +def NormalizedPoint.map {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedPoint R) : NormalizedPoint S := + ⟨f x.u1, f x.u2, f x.u3⟩ + +@[simp] +theorem NormalizedPoint.map_u1 {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedPoint R) : (x.map f).u1 = f x.u1 := + rfl + +@[simp] +theorem NormalizedPoint.map_u2 {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedPoint R) : (x.map f).u2 = f x.u2 := + rfl + +@[simp] +theorem NormalizedPoint.map_u3 {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedPoint R) : (x.map f).u3 = f x.u3 := + rfl + +@[simp] +theorem NormalizedPoint.map_origin {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) : (normalizedOrigin : NormalizedPoint R).map f = normalizedOrigin := by + ext <;> simp [NormalizedPoint.map, normalizedOrigin] + +@[simp] +theorem normalizedPolynomial_map {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedPoint R) : + normalizedPolynomial (x.map f) = f (normalizedPolynomial x) := by + simp [normalizedPolynomial, NormalizedPoint.map] + +/-- A ring homomorphism sends the normalized Markoff surface to the normalized Markoff surface. -/ +def normalizedSurfaceMap {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface S := + ⟨x.1.map f, by + change normalizedPolynomial (x.1.map f) = 0 + rw [normalizedPolynomial_map, x.property, map_zero]⟩ + +@[simp] +theorem coe_normalizedSurfaceMap {R : Type u} {S : Type v} [CommRing R] [CommRing S] + (f : R →+* S) (x : NormalizedMarkoffSurface R) : + (normalizedSurfaceMap f x).1 = x.1.map f := + rfl + +theorem normalizedSurfaceMap_injective {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (f : R →+* S) (hf : Function.Injective f) : + Function.Injective (normalizedSurfaceMap f) := by + intro x y hxy + apply Subtype.ext + apply NormalizedPoint.ext + · exact hf (congrArg NormalizedPoint.u1 (congrArg Subtype.val hxy)) + · exact hf (congrArg NormalizedPoint.u2 (congrArg Subtype.val hxy)) + · exact hf (congrArg NormalizedPoint.u3 (congrArg Subtype.val hxy)) + +private def normalizedVieta1Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface R := + ⟨normalizedVieta1 x.1, (isNormalizedMarkoff_vieta1 x.1).2 x.property⟩ + +private def normalizedVieta2Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface R := + ⟨normalizedVieta2 x.1, (isNormalizedMarkoff_vieta2 x.1).2 x.property⟩ + +private def normalizedVieta3Surface {R : Type u} [CommRing R] + (x : NormalizedMarkoffSurface R) : NormalizedMarkoffSurface R := + ⟨normalizedVieta3 x.1, (isNormalizedMarkoff_vieta3 x.1).2 x.property⟩ + +private theorem gammaVieta1_smul_normalizedSurface + {R : Type u} [CommRing R] [Invertible (3 : R)] (x : NormalizedMarkoffSurface R) : + gammaVieta1 R • x = normalizedVieta1Surface x := by + rw [normalizedGamma_smul_eq_perm, normalizedGammaPerm_apply] + rw [show (gammaVieta1 R : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + vieta1SurfacePerm R ((normalizationSurfaceEquiv R).symm x) by + exact gammaVieta1_smul_surface ((normalizationSurfaceEquiv R).symm x)] + apply Subtype.ext + change toNormalized (vieta1 ((normalizationSurfaceEquiv R).symm x : Point R)) = + normalizedVieta1 x + rw [toNormalized_vieta1] + rw [show toNormalized ((normalizationSurfaceEquiv R).symm x : Point R) = x by + exact congrArg Subtype.val ((normalizationSurfaceEquiv R).apply_symm_apply x)] + +private theorem gammaVieta2_smul_normalizedSurface + {R : Type u} [CommRing R] [Invertible (3 : R)] (x : NormalizedMarkoffSurface R) : + gammaVieta2 R • x = normalizedVieta2Surface x := by + rw [normalizedGamma_smul_eq_perm, normalizedGammaPerm_apply] + rw [show (gammaVieta2 R : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + vieta2SurfacePerm R ((normalizationSurfaceEquiv R).symm x) by + exact gammaVieta2_smul_surface ((normalizationSurfaceEquiv R).symm x)] + apply Subtype.ext + change toNormalized (vieta2 ((normalizationSurfaceEquiv R).symm x : Point R)) = + normalizedVieta2 x + rw [toNormalized_vieta2] + rw [show toNormalized ((normalizationSurfaceEquiv R).symm x : Point R) = x by + exact congrArg Subtype.val ((normalizationSurfaceEquiv R).apply_symm_apply x)] + +private theorem gammaVieta3_smul_normalizedSurface + {R : Type u} [CommRing R] [Invertible (3 : R)] (x : NormalizedMarkoffSurface R) : + gammaVieta3 R • x = normalizedVieta3Surface x := by + rw [normalizedGamma_smul_eq_perm, normalizedGammaPerm_apply] + rw [show (gammaVieta3 R : Equiv.Perm (MarkoffSurface R)) + ((normalizationSurfaceEquiv R).symm x) = + vieta3SurfacePerm R ((normalizationSurfaceEquiv R).symm x) by + exact gammaVieta3_smul_surface ((normalizationSurfaceEquiv R).symm x)] + apply Subtype.ext + change toNormalized (vieta3 ((normalizationSurfaceEquiv R).symm x : Point R)) = + normalizedVieta3 x + rw [toNormalized_vieta3] + rw [show toNormalized ((normalizationSurfaceEquiv R).symm x : Point R) = x by + exact congrArg Subtype.val ((normalizationSurfaceEquiv R).apply_symm_apply x)] + +private theorem normalizedSurfaceMap_vieta1 {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (f : R →+* S) (x : NormalizedMarkoffSurface R) : + normalizedSurfaceMap f (normalizedVieta1Surface x) = + normalizedVieta1Surface (normalizedSurfaceMap f x) := by + apply Subtype.ext + ext <;> simp [normalizedSurfaceMap, NormalizedPoint.map, normalizedVieta1Surface, + normalizedVieta1] + +private theorem normalizedSurfaceMap_vieta2 {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (f : R →+* S) (x : NormalizedMarkoffSurface R) : + normalizedSurfaceMap f (normalizedVieta2Surface x) = + normalizedVieta2Surface (normalizedSurfaceMap f x) := by + apply Subtype.ext + ext <;> simp [normalizedSurfaceMap, NormalizedPoint.map, normalizedVieta2Surface, + normalizedVieta2] + +private theorem normalizedSurfaceMap_vieta3 {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (f : R →+* S) (x : NormalizedMarkoffSurface R) : + normalizedSurfaceMap f (normalizedVieta3Surface x) = + normalizedVieta3Surface (normalizedSurfaceMap f x) := by + apply Subtype.ext + ext <;> simp [normalizedSurfaceMap, NormalizedPoint.map, normalizedVieta3Surface, + normalizedVieta3] + +private theorem normalizedSurfaceMap_swap12 {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (f : R →+* S) (x : NormalizedMarkoffSurface R) : + normalizedSurfaceMap f (normalizedSwap12Surface x) = + normalizedSwap12Surface (normalizedSurfaceMap f x) := by + apply Subtype.ext + ext <;> simp [normalizedSurfaceMap, NormalizedPoint.map, normalizedSwap12Surface, + normalizedSwap12] + +private theorem normalizedSurfaceMap_swap23 {R : Type u} {S : Type v} + [CommRing R] [CommRing S] (f : R →+* S) (x : NormalizedMarkoffSurface R) : + normalizedSurfaceMap f (normalizedSwap23Surface x) = + normalizedSwap23Surface (normalizedSurfaceMap f x) := by + apply Subtype.ext + ext <;> simp [normalizedSurfaceMap, NormalizedPoint.map, normalizedSwap23Surface, + normalizedSwap23] + +/-- Every normalized `Gamma` word over the target field has a source-field word with the same +action after applying a field embedding. -/ +theorem exists_normalizedGamma_lift_along_fieldHom + {K : Type u} {L : Type v} [Field K] [Field L] + [Invertible (3 : K)] [Invertible (3 : L)] (f : K →+* L) (g : Gamma L) : + ∃ h : Gamma K, ∀ x : NormalizedMarkoffSurface K, + normalizedSurfaceMap f (h • x) = g • normalizedSurfaceMap f x := by + let motive : ∀ q : Equiv.Perm (MarkoffSurface L), q ∈ Subgroup.closure (gammaGenerators L) → Prop := + fun q hq ↦ ∃ h : Gamma K, ∀ x : NormalizedMarkoffSurface K, + normalizedSurfaceMap f (h • x) = + (⟨q, hq⟩ : Gamma L) • normalizedSurfaceMap f x + apply Subgroup.closure_induction (p := motive) + · intro q hq + simp only [gammaGenerators, Set.mem_insert_iff, Set.mem_singleton_iff] at hq + rcases hq with rfl | rfl | rfl | rfl | rfl + · refine ⟨gammaVieta1 K, fun x ↦ ?_⟩ + change normalizedSurfaceMap f (gammaVieta1 K • x) = + gammaVieta1 L • normalizedSurfaceMap f x + rw [gammaVieta1_smul_normalizedSurface, gammaVieta1_smul_normalizedSurface] + exact normalizedSurfaceMap_vieta1 f x + · refine ⟨gammaVieta2 K, fun x ↦ ?_⟩ + change normalizedSurfaceMap f (gammaVieta2 K • x) = + gammaVieta2 L • normalizedSurfaceMap f x + rw [gammaVieta2_smul_normalizedSurface, gammaVieta2_smul_normalizedSurface] + exact normalizedSurfaceMap_vieta2 f x + · refine ⟨gammaVieta3 K, fun x ↦ ?_⟩ + change normalizedSurfaceMap f (gammaVieta3 K • x) = + gammaVieta3 L • normalizedSurfaceMap f x + rw [gammaVieta3_smul_normalizedSurface, gammaVieta3_smul_normalizedSurface] + exact normalizedSurfaceMap_vieta3 f x + · refine ⟨gammaSwap12 K, fun x ↦ ?_⟩ + change normalizedSurfaceMap f (gammaSwap12 K • x) = + gammaSwap12 L • normalizedSurfaceMap f x + rw [gammaSwap12_smul_normalizedSurface, gammaSwap12_smul_normalizedSurface] + exact normalizedSurfaceMap_swap12 f x + · refine ⟨gammaSwap23 K, fun x ↦ ?_⟩ + change normalizedSurfaceMap f (gammaSwap23 K • x) = + gammaSwap23 L • normalizedSurfaceMap f x + rw [gammaSwap23_smul_normalizedSurface, gammaSwap23_smul_normalizedSurface] + exact normalizedSurfaceMap_swap23 f x + · refine ⟨1, fun x ↦ ?_⟩ + simp + · intro q r hq hr hqLift hrLift + obtain ⟨qK, hqK⟩ := hqLift + obtain ⟨rK, hrK⟩ := hrLift + refine ⟨qK * rK, fun x ↦ ?_⟩ + change normalizedSurfaceMap f ((qK * rK) • x) = + ((⟨q, hq⟩ : Gamma L) * (⟨r, hr⟩ : Gamma L)) • normalizedSurfaceMap f x + rw [mul_smul, mul_smul, hqK, hrK] + · intro q hq hqLift + obtain ⟨qK, hqK⟩ := hqLift + refine ⟨qK⁻¹, fun x ↦ ?_⟩ + have h := congrArg (fun y ↦ (⟨q, hq⟩ : Gamma L)⁻¹ • y) (hqK (qK⁻¹ • x)) + simpa [mul_smul] using h.symm + +/-- The target-field orbit of the mapped point is contained in the image of the source orbit. -/ +theorem normalizedGammaOrbit_map_subset + {K : Type u} {L : Type v} [Field K] [Field L] + [Invertible (3 : K)] [Invertible (3 : L)] (f : K →+* L) + (x : NormalizedMarkoffSurface K) : + normalizedGammaOrbit (normalizedSurfaceMap f x) ⊆ + normalizedSurfaceMap f '' normalizedGammaOrbit x := by + intro y hy + change y ∈ MulAction.orbit (Gamma L) (normalizedSurfaceMap f x) at hy + rw [MulAction.mem_orbit_iff] at hy + obtain ⟨g, rfl⟩ := hy + obtain ⟨h, hh⟩ := exists_normalizedGamma_lift_along_fieldHom f g + refine ⟨h • x, (MulAction.mem_orbit_iff).2 ⟨h, rfl⟩, hh x⟩ + +/-- A finite normalized orbit stays finite after applying a field embedding. -/ +theorem finite_normalizedGammaOrbit_map + {K : Type u} {L : Type v} [Field K] [Field L] + [Invertible (3 : K)] [Invertible (3 : L)] (f : K →+* L) + (x : NormalizedMarkoffSurface K) (hfinite : (normalizedGammaOrbit x).Finite) : + (normalizedGammaOrbit (normalizedSurfaceMap f x)).Finite := + (hfinite.image (normalizedSurfaceMap f)).subset (normalizedGammaOrbit_map_subset f x) + +/-- The complex opening theorem descends along any field embedding into `ℂ`. -/ +theorem normalizedGammaOrbit_infinite_of_ne_origin_of_complexEmbedding + {K : Type u} [Field K] [Invertible (3 : K)] (f : K →+* ℂ) + (x : NormalizedMarkoffSurface K) (hx : x.1 ≠ normalizedOrigin) : + (normalizedGammaOrbit x).Infinite := by + intro hfinite + have hmapNe : (normalizedSurfaceMap f x).1 ≠ normalizedOrigin := by + intro hzero + apply hx + apply NormalizedPoint.ext + · apply f.injective + simpa [normalizedSurfaceMap, NormalizedPoint.map, normalizedOrigin] using + congrArg NormalizedPoint.u1 hzero + · apply f.injective + simpa [normalizedSurfaceMap, NormalizedPoint.map, normalizedOrigin] using + congrArg NormalizedPoint.u2 hzero + · apply f.injective + simpa [normalizedSurfaceMap, NormalizedPoint.map, normalizedOrigin] using + congrArg NormalizedPoint.u3 hzero + exact complex_normalizedGammaOrbit_infinite_of_ne_origin (normalizedSurfaceMap f x) hmapNe + (finite_normalizedGammaOrbit_map f x hfinite) + +/-- A chosen embedding of the canonical algebraic closure of `ℚ` into `ℂ`. -/ +noncomputable def algebraicClosureRatComplexEmbedding : AlgebraicClosure ℚ →+* ℂ := + letI : Algebra.IsAlgebraic ℚ (AlgebraicClosure ℚ) := + AlgebraicClosure.isAlgebraic ℚ + (IsAlgClosed.lift (R := ℚ) (S := AlgebraicClosure ℚ) (M := ℂ)).toRingHom + +/-- The published characteristic-zero opening: every nonzero normalized Markoff point over the +canonical algebraic closure of `ℚ` has infinite `Gamma`-orbit. -/ +theorem algebraicClosureRat_normalizedGammaOrbit_infinite_of_ne_origin + (x : NormalizedMarkoffSurface (AlgebraicClosure ℚ)) + (hx : x.1 ≠ normalizedOrigin) : + (normalizedGammaOrbit x).Infinite := + normalizedGammaOrbit_infinite_of_ne_origin_of_complexEmbedding + algebraicClosureRatComplexEmbedding x hx + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean new file mode 100644 index 0000000000..f936d4b32e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean @@ -0,0 +1,44 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed + +namespace BGS.Markoff + +variable {K : Type*} [Field K] [IsAlgClosed K] [CharZero K] + +theorem exists_common_primitiveRoot_powers (n : ℕ) [NeZero n] + (w₁ w₂ w₃ : K) (hw₁ : w₁ ^ n = 1) (hw₂ : w₂ ^ n = 1) + (hw₃ : w₃ ^ n = 1) : + ∃ ζ : K, ∃ a₁ a₂ a₃ : ℕ, + IsPrimitiveRoot ζ n ∧ a₁ < n ∧ a₂ < n ∧ a₃ < n ∧ + ζ ^ a₁ = w₁ ∧ ζ ^ a₂ = w₂ ∧ ζ ^ a₃ = w₃ := by + haveI : NeZero (n : K) := ⟨by exact_mod_cast (NeZero.ne n)⟩ + obtain ⟨ζ, hζ⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot K n + obtain ⟨a₁, ha₁n, ha₁⟩ := hζ.eq_pow_of_pow_eq_one hw₁ + obtain ⟨a₂, ha₂n, ha₂⟩ := hζ.eq_pow_of_pow_eq_one hw₂ + obtain ⟨a₃, ha₃n, ha₃⟩ := hζ.eq_pow_of_pow_eq_one hw₃ + exact ⟨ζ, a₁, a₂, a₃, hζ, ha₁n, ha₂n, ha₃n, ha₁, ha₂, ha₃⟩ + +/-- Three units whose exact orders divide `n` are simultaneous powers of one primitive +`n`-th root. This is the group-theoretic core of the compatible cyclotomic lift. -/ +theorem exists_common_primitiveRoot_powers_of_orderOf_dvd + (n : ℕ) [NeZero n] (w₁ w₂ w₃ : Kˣ) + (hw₁ : orderOf w₁ ∣ n) (hw₂ : orderOf w₂ ∣ n) + (hw₃ : orderOf w₃ ∣ n) : + ∃ ζ : K, ∃ a₁ a₂ a₃ : ℕ, + IsPrimitiveRoot ζ n ∧ a₁ < n ∧ a₂ < n ∧ a₃ < n ∧ + ζ ^ a₁ = (w₁ : K) ∧ ζ ^ a₂ = (w₂ : K) ∧ ζ ^ a₃ = (w₃ : K) := by + have hpow₁ : (w₁ : K) ^ n = 1 := by + simpa using congrArg Units.val (orderOf_dvd_iff_pow_eq_one.mp hw₁) + have hpow₂ : (w₂ : K) ^ n = 1 := by + simpa using congrArg Units.val (orderOf_dvd_iff_pow_eq_one.mp hw₂) + have hpow₃ : (w₃ : K) ^ n = 1 := by + simpa using congrArg Units.val (orderOf_dvd_iff_pow_eq_one.mp hw₃) + exact exists_common_primitiveRoot_powers n (w₁ : K) (w₂ : K) (w₃ : K) + hpow₁ hpow₂ hpow₃ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean new file mode 100644 index 0000000000..bb8ee4dbdf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean @@ -0,0 +1,271 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction + +/-! +# The concrete cyclotomic opening bound + +This file evaluates the integral cyclotomic defect at the compatible residue prime and connects +that vanishing to the archimedean norm estimate. +-/ + +open scoped NumberField + +namespace BGS.Markoff + +/-- An integral reciprocal trace, written polynomially using `ζⁿ = 1`. -/ +noncomputable def openingCyclotomicIntegerTrace + (n a : ℕ) [NeZero n] : OpeningCyclotomicIntegers n := + openingCyclotomicIntegerRoot n ^ a + openingCyclotomicIntegerRoot n ^ (n - a) + +/-- The integral defect formed from three polynomial reciprocal traces. -/ +noncomputable def openingCyclotomicIntegerDefect + (n a₁ a₂ a₃ : ℕ) [NeZero n] : OpeningCyclotomicIntegers n := + let t₁ := openingCyclotomicIntegerTrace n a₁ + let t₂ := openingCyclotomicIntegerTrace n a₂ + let t₃ := openingCyclotomicIntegerTrace n a₃ + t₁ ^ 2 + t₂ ^ 2 + t₃ ^ 2 - t₁ * t₂ * t₃ + +private theorem openingCyclotomicRoot_pow_mul_complement + (n a : ℕ) [NeZero n] (ha : a ≤ n) : + openingCyclotomicRoot n ^ a * openingCyclotomicRoot n ^ (n - a) = 1 := by + rw [← pow_add, Nat.add_sub_of_le ha] + exact (openingCyclotomicRoot_isPrimitive n).pow_eq_one + +private theorem residueRoot_pow_mul_complement + {K : Type*} [Field K] {n a : ℕ} {w : K} + (hw : IsPrimitiveRoot w n) (ha : a ≤ n) : + w ^ a * w ^ (n - a) = 1 := by + rw [← pow_add, Nat.add_sub_of_le ha] + exact hw.pow_eq_one + +private theorem coe_openingCyclotomicIntegerRoot (n : ℕ) [NeZero n] : + algebraMap (OpeningCyclotomicIntegers n) (OpeningCyclotomicField n) + (openingCyclotomicIntegerRoot n) = openingCyclotomicRoot n := by + exact (openingCyclotomicRoot_isPrimitive n).coe_toInteger + +/-- Coercing the integral polynomial trace to the cyclotomic field gives the reciprocal trace. -/ +theorem coe_openingCyclotomicIntegerTrace + (n a : ℕ) [NeZero n] (ha : a ≤ n) : + ((openingCyclotomicIntegerTrace n a : OpeningCyclotomicIntegers n) : + OpeningCyclotomicField n) = + cyclotomicTrace (openingCyclotomicRoot n ^ a) := by + rw [openingCyclotomicIntegerTrace, cyclotomicTrace] + simp only [map_add, map_pow] + rw [coe_openingCyclotomicIntegerRoot n] + rw [eq_inv_of_mul_eq_one_right (openingCyclotomicRoot_pow_mul_complement n a ha)] + +/-- Coercing the integral polynomial defect gives the characteristic-zero cyclotomic defect. -/ +theorem coe_openingCyclotomicIntegerDefect + (n a₁ a₂ a₃ : ℕ) [NeZero n] + (ha₁ : a₁ ≤ n) (ha₂ : a₂ ≤ n) (ha₃ : a₃ ≤ n) : + ((openingCyclotomicIntegerDefect n a₁ a₂ a₃ : OpeningCyclotomicIntegers n) : + OpeningCyclotomicField n) = + cyclotomicDefect (openingCyclotomicRoot n ^ a₁) + (openingCyclotomicRoot n ^ a₂) (openingCyclotomicRoot n ^ a₃) := by + simp only [openingCyclotomicIntegerDefect, map_sub, map_add, map_mul, map_pow] + rw [show algebraMap (OpeningCyclotomicIntegers n) (OpeningCyclotomicField n) + (openingCyclotomicIntegerTrace n a₁) = + cyclotomicTrace (openingCyclotomicRoot n ^ a₁) from + coe_openingCyclotomicIntegerTrace n a₁ ha₁, + show algebraMap (OpeningCyclotomicIntegers n) (OpeningCyclotomicField n) + (openingCyclotomicIntegerTrace n a₂) = + cyclotomicTrace (openingCyclotomicRoot n ^ a₂) from + coe_openingCyclotomicIntegerTrace n a₂ ha₂, + show algebraMap (OpeningCyclotomicIntegers n) (OpeningCyclotomicField n) + (openingCyclotomicIntegerTrace n a₃) = + cyclotomicTrace (openingCyclotomicRoot n ^ a₃) from + coe_openingCyclotomicIntegerTrace n a₃ ha₃] + rfl + +/-- Compatible reduction sends the polynomial integral trace to the prescribed residue trace. -/ +theorem openingCyclotomicReduction_integerTrace + (p n a : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) (ha : a ≤ n) : + openingCyclotomicReduction p n hcoprime ω hω + (openingCyclotomicIntegerTrace n a) = + cyclotomicTrace (ω ^ a) := by + rw [openingCyclotomicIntegerTrace, map_add, map_pow, map_pow, + openingCyclotomicReduction_integerRoot, cyclotomicTrace] + rw [eq_inv_of_mul_eq_one_right (residueRoot_pow_mul_complement hω ha)] + +/-- Compatible reduction sends the integral defect to the residue-field cyclotomic defect. -/ +theorem openingCyclotomicReduction_integerDefect + (p n a₁ a₂ a₃ : ℕ) [Fact p.Prime] [NeZero n] + (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) + (ha₁ : a₁ ≤ n) (ha₂ : a₂ ≤ n) (ha₃ : a₃ ≤ n) : + openingCyclotomicReduction p n hcoprime ω hω + (openingCyclotomicIntegerDefect n a₁ a₂ a₃) = + cyclotomicDefect (ω ^ a₁) (ω ^ a₂) (ω ^ a₃) := by + simp only [openingCyclotomicIntegerDefect, map_sub, map_add, map_mul, map_pow] + rw [openingCyclotomicReduction_integerTrace p n a₁ hcoprime ω hω ha₁, + openingCyclotomicReduction_integerTrace p n a₂ hcoprime ω hω ha₂, + openingCyclotomicReduction_integerTrace p n a₃ hcoprime ω hω ha₃] + rfl + +/-- A normalized residue Markoff point makes the corresponding residue cyclotomic defect vanish. -/ +theorem residueCyclotomicDefect_eq_zero_of_normalizedMarkoff + {p : ℕ} [Fact p.Prime] (x : NormalizedPoint (OpeningResidueClosure p)) + (hx : IsNormalizedMarkoff x) + {z₁ z₂ z₃ : OpeningResidueClosure p} + (h₁ : x.u1 = cyclotomicTrace z₁) (h₂ : x.u2 = cyclotomicTrace z₂) + (h₃ : x.u3 = cyclotomicTrace z₃) : + cyclotomicDefect z₁ z₂ z₃ = 0 := by + simpa [IsNormalizedMarkoff, normalizedPolynomial, cyclotomicDefect, h₁, h₂, h₃] using hx + +/-- The integral defect therefore belongs to the compatible prime selected by the residue root. -/ +theorem openingCyclotomicIntegerDefect_mem_prime_of_normalizedMarkoff + (p n a₁ a₂ a₃ : ℕ) [Fact p.Prime] [NeZero n] + (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) + (ha₁ : a₁ ≤ n) (ha₂ : a₂ ≤ n) (ha₃ : a₃ ≤ n) + (x : NormalizedPoint (OpeningResidueClosure p)) (hx : IsNormalizedMarkoff x) + (h₁ : x.u1 = cyclotomicTrace (ω ^ a₁)) + (h₂ : x.u2 = cyclotomicTrace (ω ^ a₂)) + (h₃ : x.u3 = cyclotomicTrace (ω ^ a₃)) : + openingCyclotomicIntegerDefect n a₁ a₂ a₃ ∈ + openingCyclotomicPrime p n hcoprime ω hω := by + rw [openingCyclotomicPrime, RingHom.mem_ker] + rw [show (openingCyclotomicReduction p n hcoprime ω hω).toRingHom + (openingCyclotomicIntegerDefect n a₁ a₂ a₃) = + cyclotomicDefect (ω ^ a₁) (ω ^ a₂) (ω ^ a₃) from + openingCyclotomicReduction_integerDefect p n a₁ a₂ a₃ hcoprime ω hω + ha₁ ha₂ ha₃] + exact residueCyclotomicDefect_eq_zero_of_normalizedMarkoff x hx h₁ h₂ h₃ + +private theorem openingCyclotomicRoot_pow_isOfFinOrder + (n a : ℕ) [NeZero n] : IsOfFinOrder (openingCyclotomicRoot n ^ a) := by + rw [isOfFinOrder_iff_pow_eq_one] + refine ⟨n, NeZero.pos n, ?_⟩ + rw [pow_right_comm, (openingCyclotomicRoot_isPrimitive n).pow_eq_one, one_pow] + +/-- If the residue traces form a nonorigin point, the characteristic-zero cyclotomic defect of +the compatible powers is nonzero. -/ +theorem openingCyclotomicDefect_ne_zero_of_residuePoint_ne_origin + (p n a₁ a₂ a₃ : ℕ) [Fact p.Prime] [NeZero n] + (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) + (ha₁ : a₁ ≤ n) (ha₂ : a₂ ≤ n) (ha₃ : a₃ ≤ n) + (x : NormalizedPoint (OpeningResidueClosure p)) + (h₁ : x.u1 = cyclotomicTrace (ω ^ a₁)) + (h₂ : x.u2 = cyclotomicTrace (ω ^ a₂)) + (h₃ : x.u3 = cyclotomicTrace (ω ^ a₃)) + (hxne : x ≠ normalizedOrigin) : + cyclotomicDefect (openingCyclotomicRoot n ^ a₁) + (openingCyclotomicRoot n ^ a₂) (openingCyclotomicRoot n ^ a₃) ≠ 0 := by + intro hzero + let σ : OpeningCyclotomicField n →ₐ[ℚ] ℂ := IsAlgClosed.lift + let z₁ := openingCyclotomicRoot n ^ a₁ + let z₂ := openingCyclotomicRoot n ^ a₂ + let z₃ := openingCyclotomicRoot n ^ a₃ + have hz₁fin : IsOfFinOrder z₁ := openingCyclotomicRoot_pow_isOfFinOrder n a₁ + have hz₂fin : IsOfFinOrder z₂ := openingCyclotomicRoot_pow_isOfFinOrder n a₂ + have hz₃fin : IsOfFinOrder z₃ := openingCyclotomicRoot_pow_isOfFinOrder n a₃ + have hz₁prim : IsPrimitiveRoot z₁ (orderOf z₁) := IsPrimitiveRoot.orderOf z₁ + have hz₂prim : IsPrimitiveRoot z₂ (orderOf z₂) := IsPrimitiveRoot.orderOf z₂ + have hz₃prim : IsPrimitiveRoot z₃ (orderOf z₃) := IsPrimitiveRoot.orderOf z₃ + have hnorm₁ : ‖σ z₁‖ = 1 := + (hz₁prim.map_of_injective σ.injective).norm'_eq_one hz₁fin.orderOf_pos.ne' + have hnorm₂ : ‖σ z₂‖ = 1 := + (hz₂prim.map_of_injective σ.injective).norm'_eq_one hz₂fin.orderOf_pos.ne' + have hnorm₃ : ‖σ z₃‖ = 1 := + (hz₃prim.map_of_injective σ.injective).norm'_eq_one hz₃fin.orderOf_pos.ne' + have hzeroComplex : cyclotomicDefect (σ z₁) (σ z₂) (σ z₃) = 0 := by + simpa [z₁, z₂, z₃, cyclotomicDefect, cyclotomicTrace] using congrArg σ hzero + obtain ⟨htrace₁Complex, htrace₂Complex, htrace₃Complex⟩ := + cyclotomicTrace_eq_zero_of_defect_eq_zero hnorm₁ hnorm₂ hnorm₃ hzeroComplex + have htrace₁ : cyclotomicTrace z₁ = 0 := by + apply σ.injective + simpa [cyclotomicTrace] using htrace₁Complex + have htrace₂ : cyclotomicTrace z₂ = 0 := by + apply σ.injective + simpa [cyclotomicTrace] using htrace₂Complex + have htrace₃ : cyclotomicTrace z₃ = 0 := by + apply σ.injective + simpa [cyclotomicTrace] using htrace₃Complex + have hIntegerTrace₁ : openingCyclotomicIntegerTrace n a₁ = 0 := by + apply NumberField.RingOfIntegers.coe_injective + simpa [z₁, coe_openingCyclotomicIntegerTrace n a₁ ha₁] using htrace₁ + have hIntegerTrace₂ : openingCyclotomicIntegerTrace n a₂ = 0 := by + apply NumberField.RingOfIntegers.coe_injective + simpa [z₂, coe_openingCyclotomicIntegerTrace n a₂ ha₂] using htrace₂ + have hIntegerTrace₃ : openingCyclotomicIntegerTrace n a₃ = 0 := by + apply NumberField.RingOfIntegers.coe_injective + simpa [z₃, coe_openingCyclotomicIntegerTrace n a₃ ha₃] using htrace₃ + have hResidueTrace₁ : cyclotomicTrace (ω ^ a₁) = 0 := by + simpa [hIntegerTrace₁] using + (openingCyclotomicReduction_integerTrace p n a₁ hcoprime ω hω ha₁).symm + have hResidueTrace₂ : cyclotomicTrace (ω ^ a₂) = 0 := by + simpa [hIntegerTrace₂] using + (openingCyclotomicReduction_integerTrace p n a₂ hcoprime ω hω ha₂).symm + have hResidueTrace₃ : cyclotomicTrace (ω ^ a₃) = 0 := by + simpa [hIntegerTrace₃] using + (openingCyclotomicReduction_integerTrace p n a₃ hcoprime ω hω ha₃).symm + apply hxne + apply NormalizedPoint.ext + · simpa [normalizedOrigin, h₁] using hResidueTrace₁ + · simpa [normalizedOrigin, h₂] using hResidueTrace₂ + · simpa [normalizedOrigin, h₃] using hResidueTrace₃ + +/-- The concrete cyclotomic opening inequality. A nonorigin normalized Markoff point whose three +coordinates are reciprocal traces of powers of one primitive residue root forces +`p ≤ 20 ^ φ(n)`. -/ +theorem modulus_le_twenty_pow_totient_of_compatible_residue_traces + (p n a₁ a₂ a₃ : ℕ) [Fact p.Prime] [NeZero n] + (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) + (ha₁ : a₁ ≤ n) (ha₂ : a₂ ≤ n) (ha₃ : a₃ ≤ n) + (x : NormalizedPoint (OpeningResidueClosure p)) (hx : IsNormalizedMarkoff x) + (h₁ : x.u1 = cyclotomicTrace (ω ^ a₁)) + (h₂ : x.u2 = cyclotomicTrace (ω ^ a₂)) + (h₃ : x.u3 = cyclotomicTrace (ω ^ a₃)) + (hxne : x ≠ normalizedOrigin) : + p ≤ 20 ^ n.totient := by + letI : NeZero (n : ℚ) := ⟨by exact_mod_cast (NeZero.ne n)⟩ + letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + CyclotomicField.isCyclotomicExtension n ℚ + let z₁ := openingCyclotomicRoot n ^ a₁ + let z₂ := openingCyclotomicRoot n ^ a₂ + let z₃ := openingCyclotomicRoot n ^ a₃ + let l₁ := orderOf z₁ + let l₂ := orderOf z₂ + let l₃ := orderOf z₃ + have hz₁fin : IsOfFinOrder z₁ := openingCyclotomicRoot_pow_isOfFinOrder n a₁ + have hz₂fin : IsOfFinOrder z₂ := openingCyclotomicRoot_pow_isOfFinOrder n a₂ + have hz₃fin : IsOfFinOrder z₃ := openingCyclotomicRoot_pow_isOfFinOrder n a₃ + have hz₁ : IsPrimitiveRoot z₁ l₁ := IsPrimitiveRoot.orderOf z₁ + have hz₂ : IsPrimitiveRoot z₂ l₂ := IsPrimitiveRoot.orderOf z₂ + have hz₃ : IsPrimitiveRoot z₃ l₃ := IsPrimitiveRoot.orderOf z₃ + have hl₁ : 0 < l₁ := hz₁fin.orderOf_pos + have hl₂ : 0 < l₂ := hz₂fin.orderOf_pos + have hl₃ : 0 < l₃ := hz₃fin.orderOf_pos + let P := openingCyclotomicPrime p n hcoprime ω hω + have hdefectNe : cyclotomicDefect z₁ z₂ z₃ ≠ 0 := by + exact openingCyclotomicDefect_ne_zero_of_residuePoint_ne_origin + p n a₁ a₂ a₃ hcoprime ω hω ha₁ ha₂ ha₃ x h₁ h₂ h₃ hxne + have hred : + let γ : OpeningCyclotomicIntegers n := + ⟨cyclotomicDefect z₁ z₂ z₃, + isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ + Ideal.Quotient.mk P γ = 0 := by + dsimp only + rw [Ideal.Quotient.eq_zero_iff_mem] + have hmem := openingCyclotomicIntegerDefect_mem_prime_of_normalizedMarkoff + p n a₁ a₂ a₃ hcoprime ω hω ha₁ ha₂ ha₃ x hx h₁ h₂ h₃ + rw [show (⟨cyclotomicDefect z₁ z₂ z₃, + isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ : + OpeningCyclotomicIntegers n) = openingCyclotomicIntegerDefect n a₁ a₂ a₃ by + apply Subtype.ext + exact (coe_openingCyclotomicIntegerDefect n a₁ a₂ a₃ ha₁ ha₂ ha₃).symm] + exact hmem + exact modulus_le_twenty_pow_totient_of_cyclotomicDefect_reduction + (n := n) hz₁ hl₁ hz₂ hl₂ hz₃ hl₃ P p + (by simpa [P] using openingCyclotomicPrime_under p n hcoprime ω hω) + hdefectNe hred + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean new file mode 100644 index 0000000000..1ad7427665 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean @@ -0,0 +1,123 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle +import Mathlib.Analysis.Complex.Basic +import Mathlib.Analysis.Complex.Norm + +/-! +# The cyclotomic defect in the opening + +This module isolates the characteristic-zero algebra used after compatible finite-field +eigenvalues have been lifted to roots of unity. The difficult number-field reduction interface +is not assumed here: given three complex unit-circle lifts, we define the symmetric defect, +prove its uniform archimedean bound, and prove that it cannot vanish unless all three traces do. +-/ + +namespace BGS.Markoff + +/-- The trace associated to a nonzero eigenvalue and its reciprocal. -/ +def cyclotomicTrace {K : Type*} [Field K] (z : K) : K := + z + z⁻¹ + +/-- The symmetric Markoff defect of three lifted eigenvalues. -/ +def cyclotomicDefect {K : Type*} [Field K] (z₁ z₂ z₃ : K) : K := + cyclotomicTrace z₁ ^ 2 + cyclotomicTrace z₂ ^ 2 + cyclotomicTrace z₃ ^ 2 - + cyclotomicTrace z₁ * cyclotomicTrace z₂ * cyclotomicTrace z₃ + +/-- On the complex unit circle, reciprocal-eigenvalue trace is twice the real part. -/ +theorem cyclotomicTrace_eq_two_mul_re {z : ℂ} (hz : ‖z‖ = 1) : + cyclotomicTrace z = (2 * z.re : ℝ) := by + rw [cyclotomicTrace, Complex.inv_eq_conj hz] + apply Complex.ext + · simp + ring + · simp + +/-- A unit-circle trace has complex norm at most two. -/ +theorem norm_cyclotomicTrace_le_two {z : ℂ} (hz : ‖z‖ = 1) : + ‖cyclotomicTrace z‖ ≤ 2 := by + rw [cyclotomicTrace] + calc + ‖z + z⁻¹‖ ≤ ‖z‖ + ‖z⁻¹‖ := norm_add_le _ _ + _ = 2 := by simp [hz]; norm_num + +/-- Every complex embedding of the symmetric cyclotomic defect has absolute value at most +`20`, provided the three eigenvalues lie on the unit circle. -/ +theorem norm_cyclotomicDefect_le_twenty + {z₁ z₂ z₃ : ℂ} (hz₁ : ‖z₁‖ = 1) (hz₂ : ‖z₂‖ = 1) (hz₃ : ‖z₃‖ = 1) : + ‖cyclotomicDefect z₁ z₂ z₃‖ ≤ 20 := by + let t₁ := cyclotomicTrace z₁ + let t₂ := cyclotomicTrace z₂ + let t₃ := cyclotomicTrace z₃ + have ht₁ : ‖t₁‖ ≤ 2 := norm_cyclotomicTrace_le_two hz₁ + have ht₂ : ‖t₂‖ ≤ 2 := norm_cyclotomicTrace_le_two hz₂ + have ht₃ : ‖t₃‖ ≤ 2 := norm_cyclotomicTrace_le_two hz₃ + have ht₁sq : ‖t₁ ^ 2‖ ≤ 4 := by rw [norm_pow]; nlinarith [norm_nonneg t₁] + have ht₂sq : ‖t₂ ^ 2‖ ≤ 4 := by rw [norm_pow]; nlinarith [norm_nonneg t₂] + have ht₃sq : ‖t₃ ^ 2‖ ≤ 4 := by rw [norm_pow]; nlinarith [norm_nonneg t₃] + have htprod : ‖t₁ * t₂ * t₃‖ ≤ 8 := by + rw [norm_mul, norm_mul] + nlinarith [norm_nonneg t₁, norm_nonneg t₂, norm_nonneg t₃, + mul_nonneg (norm_nonneg t₁) (norm_nonneg t₂)] + change ‖t₁ ^ 2 + t₂ ^ 2 + t₃ ^ 2 - t₁ * t₂ * t₃‖ ≤ 20 + have hsum : ‖t₁ ^ 2 + t₂ ^ 2 + t₃ ^ 2‖ ≤ + ‖t₁ ^ 2‖ + ‖t₂ ^ 2‖ + ‖t₃ ^ 2‖ := by + calc + ‖t₁ ^ 2 + t₂ ^ 2 + t₃ ^ 2‖ ≤ ‖t₁ ^ 2 + t₂ ^ 2‖ + ‖t₃ ^ 2‖ := + norm_add_le _ _ + _ ≤ (‖t₁ ^ 2‖ + ‖t₂ ^ 2‖) + ‖t₃ ^ 2‖ := by + linarith [norm_add_le (t₁ ^ 2) (t₂ ^ 2)] + calc + ‖t₁ ^ 2 + t₂ ^ 2 + t₃ ^ 2 - t₁ * t₂ * t₃‖ ≤ + ‖t₁ ^ 2 + t₂ ^ 2 + t₃ ^ 2‖ + ‖t₁ * t₂ * t₃‖ := norm_sub_le _ _ + _ ≤ (‖t₁ ^ 2‖ + ‖t₂ ^ 2‖ + ‖t₃ ^ 2‖) + ‖t₁ * t₂ * t₃‖ := by + linarith + _ ≤ 20 := by linarith + +/-- Three unit-circle lifts with vanishing cyclotomic defect have zero trace in every +coordinate. -/ +theorem cyclotomicTrace_eq_zero_of_defect_eq_zero + {z₁ z₂ z₃ : ℂ} (hz₁ : ‖z₁‖ = 1) (hz₂ : ‖z₂‖ = 1) (hz₃ : ‖z₃‖ = 1) + (hdefect : cyclotomicDefect z₁ z₂ z₃ = 0) : + cyclotomicTrace z₁ = 0 ∧ cyclotomicTrace z₂ = 0 ∧ cyclotomicTrace z₃ = 0 := by + let a : ℝ := 2 * z₁.re + let b : ℝ := 2 * z₂.re + let c : ℝ := 2 * z₃.re + have ht₁ : cyclotomicTrace z₁ = (a : ℂ) := cyclotomicTrace_eq_two_mul_re hz₁ + have ht₂ : cyclotomicTrace z₂ = (b : ℂ) := cyclotomicTrace_eq_two_mul_re hz₂ + have ht₃ : cyclotomicTrace z₃ = (c : ℂ) := cyclotomicTrace_eq_two_mul_re hz₃ + have hreal : a ^ 2 + b ^ 2 + c ^ 2 - a * b * c = 0 := by + rw [cyclotomicDefect, ht₁, ht₂, ht₃] at hdefect + exact_mod_cast hdefect + let x : NormalizedPoint ℝ := ⟨a, b, c⟩ + have hx : IsNormalizedMarkoff x := hreal + have haBound : a ∈ Set.Icc (-2 : ℝ) 2 := by + dsimp [a] + have hre := Complex.abs_re_le_norm z₁ + rw [hz₁] at hre + obtain ⟨hreLower, hreUpper⟩ := abs_le.mp hre + constructor <;> nlinarith + have hxOrigin := real_normalizedMarkoff_eq_origin_of_firstCoordinate_mem_Icc x hx haBound + have ha : a = 0 := congrArg NormalizedPoint.u1 hxOrigin + have hb : b = 0 := congrArg NormalizedPoint.u2 hxOrigin + have hc : c = 0 := congrArg NormalizedPoint.u3 hxOrigin + exact ⟨ht₁.trans (by simp [ha]), ht₂.trans (by simp [hb]), ht₃.trans (by simp [hc])⟩ + +/-- Unless all three reciprocal-eigenvalue traces vanish, the cyclotomic defect is nonzero. -/ +theorem cyclotomicDefect_ne_zero_of_some_trace_ne_zero + {z₁ z₂ z₃ : ℂ} (hz₁ : ‖z₁‖ = 1) (hz₂ : ‖z₂‖ = 1) (hz₃ : ‖z₃‖ = 1) + (htrace : cyclotomicTrace z₁ ≠ 0 ∨ cyclotomicTrace z₂ ≠ 0 ∨ + cyclotomicTrace z₃ ≠ 0) : + cyclotomicDefect z₁ z₂ z₃ ≠ 0 := by + intro hzero + obtain ⟨h₁, h₂, h₃⟩ := cyclotomicTrace_eq_zero_of_defect_eq_zero hz₁ hz₂ hz₃ hzero + rcases htrace with htrace | htrace | htrace + · exact htrace h₁ + · exact htrace h₂ + · exact htrace h₃ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean new file mode 100644 index 0000000000..de7fc09fdd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +import Mathlib.NumberTheory.NumberField.Cyclotomic.Basic +import Mathlib.RingTheory.Ideal.Int + +/-! +# The norm and reduction bridge in the cyclotomic opening + +This module connects the already formalized archimedean estimate for the symmetric cyclotomic +defect to the arithmetic norm used in the opening argument. It also records the exact ideal +theoretic step turning vanishing modulo a prime above `p` into divisibility of the integer norm +by `p`. + +The construction of simultaneous compatible lifts and of the prime ideal realizing their +finite-field reduction is deliberately not assumed here. Those are the remaining inputs needed +before `prime_dvd_integerNorm_of_quotient_eq_zero` can be applied to the defect. +-/ + +open scoped NumberField + +namespace BGS.Markoff + +/-- If every complex embedding of a number-field element has norm at most `B`, then its rational +field norm has norm at most `B` to the field degree. -/ +theorem algebraNorm_norm_le_pow_of_embeddings + {K : Type*} [Field K] [NumberField K] + (x : K) (B : ℝ) (hB : ∀ σ : K →+* ℂ, ‖σ x‖ ≤ B) : + ‖Algebra.norm ℚ x‖ ≤ B ^ Module.finrank ℚ K := by + classical + calc + ‖Algebra.norm ℚ x‖ = ‖((Algebra.norm ℚ x : ℚ) : ℝ)‖ := by + exact (Rat.norm_cast_real _).symm + _ = |((Algebra.norm ℚ x : ℚ) : ℝ)| := Real.norm_eq_abs _ + _ = ‖(algebraMap ℚ ℂ) (Algebra.norm ℚ x)‖ := by + change |((Algebra.norm ℚ x : ℚ) : ℝ)| = ‖((Algebra.norm ℚ x : ℚ) : ℂ)‖ + rw [Complex.norm_ratCast] + _ = ‖∏ σ : K →ₐ[ℚ] ℂ, σ x‖ := by rw [Algebra.norm_eq_prod_embeddings] + _ ≤ ∏ σ : K →ₐ[ℚ] ℂ, ‖σ x‖ := Finset.norm_prod_le _ _ + _ ≤ ∏ _σ : K →ₐ[ℚ] ℂ, B := by + exact Finset.prod_le_prod (fun _ _ ↦ norm_nonneg _) (fun σ _ ↦ hB σ) + _ = B ^ Module.finrank ℚ K := by simp [AlgHom.card] + +/-- Integral version of `algebraNorm_norm_le_pow_of_embeddings`, with an integer-valued bound. -/ +theorem integerNorm_natAbs_le_pow_of_embeddings + {K : Type*} [Field K] [NumberField K] + (x : 𝓞 K) (B : ℕ) (hB : ∀ σ : K →+* ℂ, ‖σ (x : K)‖ ≤ B) : + (Algebra.norm ℤ x).natAbs ≤ B ^ Module.finrank ℚ K := by + rw [← Nat.cast_le (α := ℝ), Nat.cast_natAbs, Int.cast_abs] + have h := algebraNorm_norm_le_pow_of_embeddings (x : K) (B : ℝ) hB + rw [← Algebra.coe_norm_int] at h + rw [← Rat.norm_cast_real, Real.norm_eq_abs] at h + simpa only [Rat.cast_intCast, Int.cast_abs, Rat.cast_natCast, Nat.cast_pow] using h + +/-- A nonzero algebraic integer has a nonzero, hence positive-natural-absolute, integer norm. -/ +theorem integerNorm_natAbs_pos + {K : Type*} [Field K] [NumberField K] {x : 𝓞 K} (hx : x ≠ 0) : + 0 < (Algebra.norm ℤ x).natAbs := by + rw [Int.natAbs_pos] + exact Algebra.norm_ne_zero_iff.mpr hx + +/-- If an algebraic integer lies in an ideal above the rational ideal `(p)`, then `p` divides its +integer norm. Primality is not needed for this algebraic implication; it is needed when the ideal +above `p` is constructed. -/ +theorem prime_dvd_integerNorm_of_mem_idealAbove + {K : Type*} [Field K] [NumberField K] + (P : Ideal (𝓞 K)) (p : ℕ) (x : 𝓞 K) + (hP : P.under ℤ = Ideal.span {(p : ℤ)}) (hx : x ∈ P) : + (p : ℤ) ∣ Algebra.norm ℤ x := by + have h_under : p ∣ Ideal.absNorm P := by + have h := Int.absNorm_under_dvd_absNorm P + rw [hP, Ideal.absNorm_span_singleton] at h + simpa using h + exact (Int.natCast_dvd_natCast.mpr h_under).trans (Ideal.absNorm_dvd_norm_of_mem hx) + +/-- Quotient-map form of `prime_dvd_integerNorm_of_mem_idealAbove`, matching the reduction step in +the paper: reduction of `x` to zero modulo a prime above `p` forces `p ∣ N(x)`. -/ +theorem prime_dvd_integerNorm_of_quotient_eq_zero + {K : Type*} [Field K] [NumberField K] + (P : Ideal (𝓞 K)) (p : ℕ) (x : 𝓞 K) + (hP : P.under ℤ = Ideal.span {(p : ℤ)}) + (hx : Ideal.Quotient.mk P x = 0) : + (p : ℤ) ∣ Algebra.norm ℤ x := by + apply prime_dvd_integerNorm_of_mem_idealAbove P p x hP + exact Ideal.Quotient.eq_zero_iff_mem.mp hx + +/-- If a nonzero algebraic integer reduces to zero modulo an ideal above `(p)`, then `p` is at +most the natural absolute value of its integer norm. -/ +theorem modulus_le_integerNorm_natAbs_of_quotient_eq_zero + {K : Type*} [Field K] [NumberField K] + (P : Ideal (𝓞 K)) (p : ℕ) (x : 𝓞 K) + (hP : P.under ℤ = Ideal.span {(p : ℤ)}) + (hx : Ideal.Quotient.mk P x = 0) (hxne : x ≠ 0) : + p ≤ (Algebra.norm ℤ x).natAbs := by + apply Nat.le_of_dvd (integerNorm_natAbs_pos hxne) + change (p : ℤ).natAbs ∣ (Algebra.norm ℤ x).natAbs + rw [Int.natAbs_dvd_natAbs] + simpa using prime_dvd_integerNorm_of_quotient_eq_zero P p x hP hx + +/-- Reciprocal trace preserves integrality when both the eigenvalue and its inverse are integral. -/ +theorem isIntegral_cyclotomicTrace + {K : Type*} [Field K] {z : K} + (hz : IsIntegral ℤ z) (hzinv : IsIntegral ℤ z⁻¹) : + IsIntegral ℤ (cyclotomicTrace z) := by + exact hz.add hzinv + +/-- The symmetric defect is integral when the three reciprocal traces are integral. -/ +theorem isIntegral_cyclotomicDefect + {K : Type*} [Field K] {z₁ z₂ z₃ : K} + (hz₁ : IsIntegral ℤ z₁) (hz₁inv : IsIntegral ℤ z₁⁻¹) + (hz₂ : IsIntegral ℤ z₂) (hz₂inv : IsIntegral ℤ z₂⁻¹) + (hz₃ : IsIntegral ℤ z₃) (hz₃inv : IsIntegral ℤ z₃⁻¹) : + IsIntegral ℤ (cyclotomicDefect z₁ z₂ z₃) := by + have h₁ := isIntegral_cyclotomicTrace hz₁ hz₁inv + have h₂ := isIntegral_cyclotomicTrace hz₂ hz₂inv + have h₃ := isIntegral_cyclotomicTrace hz₃ hz₃inv + exact ((h₁.pow 2).add (h₂.pow 2) |>.add (h₃.pow 2)).sub ((h₁.mul h₂).mul h₃) + +/-- The cyclotomic defect of three primitive roots of positive orders is an algebraic integer. -/ +theorem isIntegral_cyclotomicDefect_of_primitiveRoots + {K : Type*} [Field K] {z₁ z₂ z₃ : K} {l₁ l₂ l₃ : ℕ} + (hz₁ : IsPrimitiveRoot z₁ l₁) (hl₁ : 0 < l₁) + (hz₂ : IsPrimitiveRoot z₂ l₂) (hl₂ : 0 < l₂) + (hz₃ : IsPrimitiveRoot z₃ l₃) (hl₃ : 0 < l₃) : + IsIntegral ℤ (cyclotomicDefect z₁ z₂ z₃) := by + exact BGS.Markoff.isIntegral_cyclotomicDefect + (hz₁.isIntegral hl₁) (hz₁.inv.isIntegral hl₁) + (hz₂.isIntegral hl₂) (hz₂.inv.isIntegral hl₂) + (hz₃.isIntegral hl₃) (hz₃.inv.isIntegral hl₃) + +/-- The exact archimedean norm conclusion needed in the opening: the integer norm of a +cyclotomic defect is bounded by `20 ^ φ(n)`. -/ +theorem cyclotomicDefect_integerNorm_natAbs_le_twenty_pow_totient + {K : Type*} [Field K] [NumberField K] + {n l₁ l₂ l₃ : ℕ} [NeZero n] [IsCyclotomicExtension {n} ℚ K] + {z₁ z₂ z₃ : K} + (hz₁ : IsPrimitiveRoot z₁ l₁) (hl₁ : 0 < l₁) + (hz₂ : IsPrimitiveRoot z₂ l₂) (hl₂ : 0 < l₂) + (hz₃ : IsPrimitiveRoot z₃ l₃) (hl₃ : 0 < l₃) : + let η : 𝓞 K := ⟨cyclotomicDefect z₁ z₂ z₃, + isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ + (Algebra.norm ℤ η).natAbs ≤ 20 ^ n.totient := by + dsimp only + rw [← IsCyclotomicExtension.Rat.finrank n K] + apply integerNorm_natAbs_le_pow_of_embeddings + intro σ + simpa [cyclotomicDefect, cyclotomicTrace] using + norm_cyclotomicDefect_le_twenty + ((hz₁.map_of_injective σ.injective).norm'_eq_one hl₁.ne') + ((hz₂.map_of_injective σ.injective).norm'_eq_one hl₂.ne') + ((hz₃.map_of_injective σ.injective).norm'_eq_one hl₃.ne') + +/-- A nonzero cyclotomic defect has positive natural absolute integer norm. -/ +theorem cyclotomicDefect_integerNorm_natAbs_pos + {K : Type*} [Field K] [NumberField K] + {z₁ z₂ z₃ : K} {l₁ l₂ l₃ : ℕ} + (hz₁ : IsPrimitiveRoot z₁ l₁) (hl₁ : 0 < l₁) + (hz₂ : IsPrimitiveRoot z₂ l₂) (hl₂ : 0 < l₂) + (hz₃ : IsPrimitiveRoot z₃ l₃) (hl₃ : 0 < l₃) + (hη : cyclotomicDefect z₁ z₂ z₃ ≠ 0) : + let η : 𝓞 K := ⟨cyclotomicDefect z₁ z₂ z₃, + isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ + 0 < (Algebra.norm ℤ η).natAbs := by + dsimp only + apply integerNorm_natAbs_pos + intro hzero + apply hη + simpa using congrArg (fun x : 𝓞 K ↦ (x : K)) hzero + +/-- The completed norm-and-reduction implication: if the nonzero cyclotomic defect reduces to zero +at an ideal above `(p)`, then `p ≤ 20 ^ φ(n)`. Constructing the compatible reduction data is the +remaining opening problem, not an assumption hidden in this theorem. -/ +theorem modulus_le_twenty_pow_totient_of_cyclotomicDefect_reduction + {K : Type*} [Field K] [NumberField K] + {n l₁ l₂ l₃ : ℕ} [NeZero n] [IsCyclotomicExtension {n} ℚ K] + {z₁ z₂ z₃ : K} + (hz₁ : IsPrimitiveRoot z₁ l₁) (hl₁ : 0 < l₁) + (hz₂ : IsPrimitiveRoot z₂ l₂) (hl₂ : 0 < l₂) + (hz₃ : IsPrimitiveRoot z₃ l₃) (hl₃ : 0 < l₃) + (P : Ideal (𝓞 K)) (p : ℕ) + (hP : P.under ℤ = Ideal.span {(p : ℤ)}) + (hη : cyclotomicDefect z₁ z₂ z₃ ≠ 0) + (hred : let η : 𝓞 K := ⟨cyclotomicDefect z₁ z₂ z₃, + isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ + Ideal.Quotient.mk P η = 0) : + p ≤ 20 ^ n.totient := by + let η : 𝓞 K := ⟨cyclotomicDefect z₁ z₂ z₃, + isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ + have hηne : η ≠ 0 := by + intro hzero + apply hη + simpa [η] using congrArg (fun x : 𝓞 K ↦ (x : K)) hzero + have hp_le : p ≤ (Algebra.norm ℤ η).natAbs := + modulus_le_integerNorm_natAbs_of_quotient_eq_zero P p η hP (by simpa [η] using hred) hηne + exact hp_le.trans <| by + simpa [η] using + cyclotomicDefect_integerNorm_natAbs_le_twenty_pow_totient + hz₁ hl₁ hz₂ hl₂ hz₃ hl₃ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean new file mode 100644 index 0000000000..e422c745af --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean @@ -0,0 +1,217 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +import Mathlib.NumberTheory.NumberField.Cyclotomic.Basic +import Mathlib.RingTheory.Polynomial.Cyclotomic.Roots + +/-! +# A compatible prime and reduction for the cyclotomic opening + +For `p ∤ n`, a prescribed primitive `n`-th root in an algebraic closure of `ZMod p` +determines a homomorphism from the ring of integers of `ℚ(ζₙ)`. Its kernel is a prime above +`(p)`, and the induced quotient map sends all powers of the characteristic-zero generator to the +corresponding powers of the prescribed finite-characteristic root. +-/ + +open scoped NumberField +open Polynomial + +namespace BGS.Markoff + +/-- The canonical cyclotomic number field used for a common order `n`. -/ +abbrev OpeningCyclotomicField (n : ℕ) := CyclotomicField n ℚ + +/-- The ring of integers of the canonical cyclotomic number field. -/ +abbrev OpeningCyclotomicIntegers (n : ℕ) := + NumberField.RingOfIntegers (OpeningCyclotomicField n) + +/-- The algebraic closure in which the prescribed characteristic-`p` roots live. -/ +abbrev OpeningResidueClosure (p : ℕ) [Fact p.Prime] := AlgebraicClosure (ZMod p) + +private theorem neZero_ratCast (n : ℕ) [NeZero n] : (n : ℚ) ≠ 0 := by + exact_mod_cast (NeZero.ne n) + +/-- Coprimality with the characteristic makes `n` nonzero in the chosen residue closure. -/ +theorem residueClosure_natCast_ne_zero_of_coprime + (p n : ℕ) [Fact p.Prime] (hcoprime : Nat.Coprime p n) : + (n : OpeningResidueClosure p) ≠ 0 := by + have hnmod : (n : ZMod p) ≠ 0 := by + rw [ne_eq, ZMod.natCast_eq_zero_iff] + intro hpn + have hdiv : p ∣ Nat.gcd p n := Nat.dvd_gcd (dvd_refl p) hpn + rw [hcoprime.gcd_eq_one] at hdiv + exact (Fact.out : p.Prime).not_dvd_one hdiv + change algebraMap (ZMod p) (OpeningResidueClosure p) (n : ZMod p) ≠ 0 + exact (map_ne_zero_iff _ (algebraMap (ZMod p) (OpeningResidueClosure p)).injective).2 hnmod + +/-- Three `n`-th roots in the residue closure are powers of one primitive `n`-th root. The +coprimality hypothesis supplies the nonvanishing of `n` that was previously obtained from +characteristic zero. -/ +theorem exists_residue_common_primitiveRoot_powers + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (w₁ w₂ w₃ : OpeningResidueClosure p) + (hw₁ : w₁ ^ n = 1) (hw₂ : w₂ ^ n = 1) (hw₃ : w₃ ^ n = 1) : + ∃ ω : OpeningResidueClosure p, ∃ a₁ a₂ a₃ : ℕ, + IsPrimitiveRoot ω n ∧ a₁ < n ∧ a₂ < n ∧ a₃ < n ∧ + ω ^ a₁ = w₁ ∧ ω ^ a₂ = w₂ ∧ ω ^ a₃ = w₃ := by + letI : NeZero (n : OpeningResidueClosure p) := + ⟨residueClosure_natCast_ne_zero_of_coprime p n hcoprime⟩ + obtain ⟨ω, hω⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot (OpeningResidueClosure p) n + obtain ⟨a₁, ha₁lt, ha₁⟩ := hω.eq_pow_of_pow_eq_one hw₁ + obtain ⟨a₂, ha₂lt, ha₂⟩ := hω.eq_pow_of_pow_eq_one hw₂ + obtain ⟨a₃, ha₃lt, ha₃⟩ := hω.eq_pow_of_pow_eq_one hw₃ + exact ⟨ω, a₁, a₂, a₃, hω, ha₁lt, ha₂lt, ha₃lt, ha₁, ha₂, ha₃⟩ + +/-- The canonical primitive `n`-th root in the chosen characteristic-zero cyclotomic field. -/ +noncomputable def openingCyclotomicRoot (n : ℕ) [NeZero n] : OpeningCyclotomicField n := by + letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + CyclotomicField.isCyclotomicExtension n ℚ + exact IsCyclotomicExtension.zeta n ℚ (OpeningCyclotomicField n) + +/-- The canonical characteristic-zero root has exact order `n`. -/ +theorem openingCyclotomicRoot_isPrimitive (n : ℕ) [NeZero n] : + IsPrimitiveRoot (openingCyclotomicRoot n) n := by + letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + CyclotomicField.isCyclotomicExtension n ℚ + simp [openingCyclotomicRoot] + +/-- The canonical cyclotomic root, regarded as an algebraic integer. -/ +noncomputable def openingCyclotomicIntegerRoot (n : ℕ) [NeZero n] : + OpeningCyclotomicIntegers n := + (openingCyclotomicRoot_isPrimitive n).toInteger + +/-- The integral power basis generated by the canonical cyclotomic root. -/ +noncomputable def openingCyclotomicIntegralPowerBasis (n : ℕ) [NeZero n] : + PowerBasis ℤ (OpeningCyclotomicIntegers n) := by + letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + CyclotomicField.isCyclotomicExtension n ℚ + exact (openingCyclotomicRoot_isPrimitive n).integralPowerBasis + +@[simp] +theorem openingCyclotomicIntegralPowerBasis_gen (n : ℕ) [NeZero n] : + (openingCyclotomicIntegralPowerBasis n).gen = openingCyclotomicIntegerRoot n := by + letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + CyclotomicField.isCyclotomicExtension n ℚ + exact (openingCyclotomicRoot_isPrimitive n).integralPowerBasis_gen + +private theorem primitiveRoot_isRoot_integralPowerBasis_minpoly + (p n : ℕ) [Fact p.Prime] [NeZero n] (_hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + aeval ω (minpoly ℤ (openingCyclotomicIntegralPowerBasis n).gen) = 0 := by + letI : NeZero (n : OpeningResidueClosure p) := + ⟨residueClosure_natCast_ne_zero_of_coprime p n _hcoprime⟩ + have hrootCyclotomic : aeval ω (cyclotomic n ℤ) = 0 := by + rw [aeval_def, ← eval_map, map_cyclotomic] + exact hω.isRoot_cyclotomic (NeZero.pos n) + letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + CyclotomicField.isCyclotomicExtension n ℚ + simpa [openingCyclotomicIntegralPowerBasis, + ← NumberField.RingOfIntegers.minpoly_coe, + ← cyclotomic_eq_minpoly (openingCyclotomicRoot_isPrimitive n) (NeZero.pos n)] using + hrootCyclotomic + +/-- The compatible reduction homomorphism determined by the prescribed primitive root `ω`. -/ +noncomputable def openingCyclotomicReduction + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + OpeningCyclotomicIntegers n →ₐ[ℤ] OpeningResidueClosure p := + (openingCyclotomicIntegralPowerBasis n).lift ω + (primitiveRoot_isRoot_integralPowerBasis_minpoly p n hcoprime ω hω) + +/-- The compatible reduction sends the characteristic-zero generator to the prescribed root. -/ +@[simp] +theorem openingCyclotomicReduction_integerRoot + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + openingCyclotomicReduction p n hcoprime ω hω (openingCyclotomicIntegerRoot n) = ω := by + rw [← openingCyclotomicIntegralPowerBasis_gen n] + exact PowerBasis.lift_gen _ _ _ + +/-- The prime ideal of the cyclotomic integers selected by the prescribed residue root. -/ +noncomputable def openingCyclotomicPrime + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + Ideal (OpeningCyclotomicIntegers n) := + RingHom.ker (openingCyclotomicReduction p n hcoprime ω hω).toRingHom + +/-- The selected kernel is prime because the residue closure is a field. -/ +theorem openingCyclotomicPrime_isPrime + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + (openingCyclotomicPrime p n hcoprime ω hω).IsPrime := + RingHom.ker_isPrime _ + +/-- The selected prime lies above the rational prime `(p)`. -/ +theorem openingCyclotomicPrime_under + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + (openingCyclotomicPrime p n hcoprime ω hω).under ℤ = + Ideal.span {(p : ℤ)} := by + unfold openingCyclotomicPrime Ideal.under + rw [RingHom.comap_ker] + have hcomp : + (openingCyclotomicReduction p n hcoprime ω hω).toRingHom.comp + (algebraMap ℤ (OpeningCyclotomicIntegers n)) = + algebraMap ℤ (OpeningResidueClosure p) := by + ext z + exact (openingCyclotomicReduction p n hcoprime ω hω).commutes z + rw [hcomp] + exact CharP.ker_intAlgebraMap_eq_span p + +/-- The quotient by the compatible prime embeds in the chosen residue closure. -/ +noncomputable def openingCyclotomicQuotientReduction + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + (OpeningCyclotomicIntegers n ⧸ openingCyclotomicPrime p n hcoprime ω hω) →+* + OpeningResidueClosure p := + (openingCyclotomicReduction p n hcoprime ω hω).toRingHom.kerLift + +/-- The quotient reduction is injective: its source is exactly the quotient by the kernel. -/ +theorem openingCyclotomicQuotientReduction_injective + (p n : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + Function.Injective (openingCyclotomicQuotientReduction p n hcoprime ω hω) := by + unfold openingCyclotomicQuotientReduction openingCyclotomicPrime + exact RingHom.kerLift_injective _ + +/-- The quotient reduction sends every power of the integral generator to the matching power of +the prescribed residue root. -/ +theorem openingCyclotomicQuotientReduction_integerRoot_pow + (p n a : ℕ) [Fact p.Prime] [NeZero n] (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + openingCyclotomicQuotientReduction p n hcoprime ω hω + (Ideal.Quotient.mk (openingCyclotomicPrime p n hcoprime ω hω) + (openingCyclotomicIntegerRoot n ^ a)) = + ω ^ a := by + unfold openingCyclotomicQuotientReduction openingCyclotomicPrime + rw [RingHom.kerLift_mk, map_pow] + exact congrArg (fun z : OpeningResidueClosure p ↦ z ^ a) + (openingCyclotomicReduction_integerRoot p n hcoprime ω hω) + +/-- One chosen prime therefore realizes three prescribed powers simultaneously. -/ +theorem openingCyclotomicQuotientReduction_three_powers + (p n a₁ a₂ a₃ : ℕ) [Fact p.Prime] [NeZero n] + (hcoprime : Nat.Coprime p n) + (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : + let reduce := openingCyclotomicQuotientReduction p n hcoprime ω hω + let quotient := Ideal.Quotient.mk (openingCyclotomicPrime p n hcoprime ω hω) + reduce (quotient (openingCyclotomicIntegerRoot n ^ a₁)) = ω ^ a₁ ∧ + reduce (quotient (openingCyclotomicIntegerRoot n ^ a₂)) = ω ^ a₂ ∧ + reduce (quotient (openingCyclotomicIntegerRoot n ^ a₃)) = ω ^ a₃ := by + dsimp only + exact ⟨openingCyclotomicQuotientReduction_integerRoot_pow p n a₁ hcoprime ω hω, + openingCyclotomicQuotientReduction_integerRoot_pow p n a₂ hcoprime ω hω, + openingCyclotomicQuotientReduction_integerRoot_pow p n a₃ hcoprime ω hω⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean new file mode 100644 index 0000000000..af07b2ce04 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean @@ -0,0 +1,144 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements + +/-! +# The logarithmic lower-bound half of Theorem 1 + +The opening proves the exact inequality `p ≤ 20 ^ m ^ 3` for every punctured orbit of cardinality +`m`. This file performs the analytic conversion that the paper calls immediate and packages it +with the quantifiers of `EveryOrbitLargeAt` and `TheoremOneStatement`. +-/ + +namespace BGS.Markoff + +noncomputable section + +/-- Forgetting the proof that a point is nonzero maps its punctured orbit onto its orbit in the +full Markoff surface. -/ +theorem subtypeVal_image_puncturedGammaOrbit + {R : Type*} [CommRing R] (x : PuncturedMarkoffSurface R) : + Subtype.val '' puncturedGammaOrbit x = gammaOrbit x.1 := by + ext y + constructor + · rintro ⟨z, hz, rfl⟩ + change ∃ g : Gamma R, g • x.1 = z.1 + change ∃ g : Gamma R, g • x = z at hz + obtain ⟨g, rfl⟩ := hz + exact ⟨g, rfl⟩ + · intro hy + change ∃ g : Gamma R, g • x.1 = y at hy + obtain ⟨g, hgy⟩ := hy + refine ⟨g • x, ?_, ?_⟩ + · change ∃ h : Gamma R, h • x = g • x + exact ⟨g, rfl⟩ + · exact hgy + +/-- Puncturing does not change the cardinality of a nonzero Gamma orbit. -/ +theorem puncturedGammaOrbit_ncard_eq_gammaOrbit_ncard + {R : Type*} [CommRing R] (x : PuncturedMarkoffSurface R) : + (puncturedGammaOrbit x).ncard = (gammaOrbit x.1).ncard := by + rw [← subtypeVal_image_puncturedGammaOrbit x] + exact (Set.ncard_image_of_injective _ Subtype.val_injective).symm + +/-- Punctured-orbit form of the exact opening inequality. -/ +theorem prime_le_twenty_pow_puncturedGammaOrbit_ncard_cube + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hpThree : p ≠ 3) + (x : PuncturedMarkoffSurface (ZMod p)) : + p ≤ 20 ^ (puncturedGammaOrbit x).ncard ^ 3 := by + have hxne : x.1.1 ≠ origin := by + intro hx + apply x.2 + apply Subtype.ext + exact hx + have h := prime_le_twenty_pow_gammaOrbit_ncard_cube p hpTwo hpThree x.1 hxne + rwa [puncturedGammaOrbit_ncard_eq_gammaOrbit_ncard] + +/-- The exact exponential opening bound implies a uniform cube-root logarithmic lower bound. +The deliberately coarse constant `1 / 3` avoids introducing an artificial transcendental +constant into Theorem 1. -/ +theorem one_third_mul_log_rpow_le_of_prime_le_twenty_pow_cube + (p orbitCard : ℕ) (hp : p.Prime) + (hbound : p ≤ 20 ^ orbitCard ^ 3) : + (1 / 3 : ℝ) * Real.rpow (Real.log p) (1 / 3 : ℝ) ≤ orbitCard := by + have hpOne : 1 ≤ p := hp.one_le + have hpRealPos : (0 : ℝ) < p := by exact_mod_cast hp.pos + have hlogNonnegative : 0 ≤ Real.log (p : ℝ) := Real.log_nonneg (by exact_mod_cast hpOne) + have hboundReal : (p : ℝ) ≤ (20 : ℝ) ^ (orbitCard ^ 3) := by + exact_mod_cast hbound + have hlogBound : + Real.log (p : ℝ) ≤ (orbitCard ^ 3 : ℕ) * Real.log (20 : ℝ) := by + calc + Real.log (p : ℝ) ≤ Real.log ((20 : ℝ) ^ (orbitCard ^ 3)) := + Real.log_le_log hpRealPos hboundReal + _ = (orbitCard ^ 3 : ℕ) * Real.log (20 : ℝ) := by + rw [Real.log_pow] + have hlogTwenty : Real.log (20 : ℝ) ≤ 27 := by + calc + Real.log (20 : ℝ) ≤ 20 - 1 := Real.log_le_sub_one_of_pos (by norm_num) + _ ≤ 27 := by norm_num + have hlogBoundCoarse : + Real.log (p : ℝ) ≤ 27 * (orbitCard : ℝ) ^ 3 := by + calc + Real.log (p : ℝ) ≤ (orbitCard ^ 3 : ℕ) * Real.log (20 : ℝ) := hlogBound + _ ≤ (orbitCard ^ 3 : ℕ) * 27 := by + gcongr + _ = 27 * (orbitCard : ℝ) ^ 3 := by + norm_num [mul_comm] + have hcuberootNonnegative : + 0 ≤ Real.rpow (Real.log (p : ℝ)) (1 / 3 : ℝ) := + Real.rpow_nonneg hlogNonnegative _ + have hcuberootCube : + (Real.rpow (Real.log (p : ℝ)) (1 / 3 : ℝ)) ^ 3 = Real.log (p : ℝ) := by + calc + (Real.rpow (Real.log (p : ℝ)) (1 / 3 : ℝ)) ^ 3 = + Real.rpow (Real.log (p : ℝ)) ((1 / 3 : ℝ) * (3 : ℕ)) := + (Real.rpow_mul_natCast hlogNonnegative (1 / 3 : ℝ) 3).symm + _ = Real.log (p : ℝ) := by norm_num + have hleftNonnegative : + 0 ≤ (1 / 3 : ℝ) * Real.rpow (Real.log (p : ℝ)) (1 / 3 : ℝ) := by + positivity + have horbitNonnegative : (0 : ℝ) ≤ orbitCard := by positivity + apply (pow_le_pow_iff_left₀ hleftNonnegative horbitNonnegative (by norm_num : 3 ≠ 0)).mp + rw [mul_pow, hcuberootCube] + norm_num + nlinarith + +/-- Every punctured orbit over every prime `p ≥ 5` satisfies the lower bound in Theorem 1 with +the absolute constant `1 / 3`. -/ +theorem everyOrbitLargeAt_one_third + (p : ℕ) (hp : p.Prime) (hpFive : 5 ≤ p) : + EveryOrbitLargeAt p hp (1 / 3 : ℝ) := by + letI : Fact p.Prime := ⟨hp⟩ + intro x + exact one_third_mul_log_rpow_le_of_prime_le_twenty_pow_cube + p (puncturedGammaOrbit x).ncard hp + (prime_le_twenty_pow_puncturedGammaOrbit_ncard_cube p (by omega) (by omega) x) + +/-- The second conjunct of `TheoremOneStatement`, including its absolute constant and threshold, +is completely formalized. -/ +theorem theoremOne_everyOrbitLarge : + ∃ c : ℝ, 0 < c ∧ + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → EveryOrbitLargeAt p hp c := by + refine ⟨1 / 3, by norm_num, 5, ?_⟩ + intro p hp hpFive + exact everyOrbitLargeAt_one_third p hp hpFive + +/-- With the every-orbit lower bound now proved, `TheoremOneStatement` is reduced exactly to its +giant-orbit conjunct. -/ +theorem theoremOneStatement_of_eventually_hasGiantOrbit + (hgiant : + ∀ epsilon : ℝ, 0 < epsilon → + ∃ p0 : ℕ, ∀ (p : ℕ) (hp : p.Prime), p0 ≤ p → HasGiantOrbitAt p hp epsilon) : + TheoremOneStatement := + ⟨hgiant, theoremOne_everyOrbitLarge⟩ + +end + + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean new file mode 100644 index 0000000000..53f99f5c15 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean @@ -0,0 +1,126 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces + +namespace BGS.Markoff + +universe u + +theorem normalizedRotate1Surface_injective + {R : Type u} [CommRing R] [Invertible (3 : R)] : + Function.Injective (normalizedRotate1Surface (R := R)) := by + intro x y hxy + have hx : normalizedGammaPerm R (gammaRotate1 R) x = normalizedRotate1Surface x := by + change gammaRotate1 R • x = normalizedRotate1Surface x + exact gammaRotate1_smul_normalizedSurface x + have hy : normalizedGammaPerm R (gammaRotate1 R) y = normalizedRotate1Surface y := by + change gammaRotate1 R • y = normalizedRotate1Surface y + exact gammaRotate1_smul_normalizedSurface y + apply (normalizedGammaPerm R (gammaRotate1 R)).injective + exact hx.trans (hxy.trans hy.symm) + +theorem coe_iterate_normalizedRotate1Surface + {R : Type u} [CommRing R] (x : NormalizedMarkoffSurface R) (n : ℕ) : + ((normalizedRotate1Surface^[n]) x).1 = (normalizedRotate1^[n]) x.1 := by + induction n with + | zero => rfl + | succ n ih => + rw [Function.iterate_succ_apply', Function.iterate_succ_apply'] + change normalizedRotate1 ((normalizedRotate1Surface^[n]) x).1 = + normalizedRotate1 ((normalizedRotate1^[n]) x.1) + rw [ih] + +theorem exists_positive_normalizedRotate1Surface_return_of_finite_component + {R : Type u} [CommRing R] [Invertible (3 : R)] + {x y : NormalizedMarkoffSurface R} + (hfinite : (normalizedGammaOrbit x).Finite) + (hxy : SameNormalizedComponent x y) : + ∃ n : ℕ, 0 < n ∧ (normalizedRotate1Surface^[n]) y = y := by + apply BGS.exists_positive_iterate_eq_self_of_forwardOrbit_subset + normalizedRotate1Surface_injective hfinite + rintro _ ⟨n, rfl⟩ + apply (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + exact sameNormalizedComponent_trans hxy + (sameNormalizedComponent_iterate_normalizedRotate1Surface y n) + +variable {K : Type u} [Field K] [IsAlgClosed K] [CharZero K] [Invertible (3 : K)] + +omit [CharZero K] [Invertible (3 : K)] in +private theorem exists_root_neg_one : ∃ i : K, i ^ 2 = -1 := by + exact IsAlgClosed.exists_pow_nat_eq (-1 : K) (by norm_num) + +theorem finite_component_coordinate1_has_torsion_trace + {x y : NormalizedMarkoffSurface K} + (hfinite : (normalizedGammaOrbit x).Finite) + (hxy : SameNormalizedComponent x y) : + ∃ w : Kˣ, IsOfFinOrder w ∧ y.1.u1 = splitTorusTrace w := by + obtain ⟨n, hn, hreturn⟩ := + exists_positive_normalizedRotate1Surface_return_of_finite_component hfinite hxy + have hpointReturn : (normalizedRotate1^[n]) y.1 = y.1 := by + rw [← coe_iterate_normalizedRotate1Surface] + exact congrArg Subtype.val hreturn + have hyFiber : y.1 ∈ normalizedFiber1 y.1.u1 := ⟨y.property, rfl⟩ + by_cases hsemisimple : y.1.u1 ^ 2 ≠ 4 + · exact periodic_nonparabolic_fiber_has_torsion_eigenvalue + hsemisimple hyFiber hn hpointReturn + · exfalso + obtain ⟨i, hi⟩ := exists_root_neg_one (K := K) + have hsq : y.1.u1 ^ 2 = 4 := not_ne_iff.mp hsemisimple + have hfactor : (y.1.u1 - 2) * (y.1.u1 + 2) = 0 := by + calc + (y.1.u1 - 2) * (y.1.u1 + 2) = y.1.u1 ^ 2 - 4 := by ring + _ = 0 := sub_eq_zero.mpr hsq + rcases mul_eq_zero.mp hfactor with htwo | hnegTwo + · have ht : y.1.u1 = 2 := sub_eq_zero.mp htwo + exact (iterate_normalizedRotate1_ne_self_of_mem_fiber1_two i hi + (by simpa [ht] using hyFiber) n hn) hpointReturn + · have ht : y.1.u1 = -2 := by linear_combination hnegTwo + exact (iterate_normalizedRotate1_ne_self_of_mem_fiber1_neg_two i hi + (by simpa [ht] using hyFiber) n hn) hpointReturn + +theorem finite_normalizedGammaOrbit_has_torsion_traces + (x : NormalizedMarkoffSurface K) + (hfinite : (normalizedGammaOrbit x).Finite) : + ∃ w₁ w₂ w₃ : Kˣ, + IsOfFinOrder w₁ ∧ IsOfFinOrder w₂ ∧ IsOfFinOrder w₃ ∧ + x.1.u1 = splitTorusTrace w₁ ∧ x.1.u2 = splitTorusTrace w₂ ∧ + x.1.u3 = splitTorusTrace w₃ := by + obtain ⟨w₁, hw₁, htrace₁⟩ := finite_component_coordinate1_has_torsion_trace + hfinite (sameNormalizedComponent_refl x) + obtain ⟨w₂, hw₂, htrace₂⟩ := finite_component_coordinate1_has_torsion_trace + hfinite (sameNormalizedComponent_swap12Surface x) + let x₃ := normalizedSwap12Surface (normalizedSwap23Surface x) + have hx₃ : SameNormalizedComponent x x₃ := + sameNormalizedComponent_trans (sameNormalizedComponent_swap23Surface x) + (sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x)) + obtain ⟨w₃, hw₃, htrace₃⟩ := finite_component_coordinate1_has_torsion_trace + hfinite hx₃ + refine ⟨w₁, w₂, w₃, hw₁, hw₂, hw₃, htrace₁, ?_, ?_⟩ + · simpa [normalizedSwap12Surface, normalizedSwap12] using htrace₂ + · simpa [x₃, normalizedSwap12Surface, normalizedSwap23Surface, + normalizedSwap12, normalizedSwap23] using htrace₃ + +theorem complex_normalizedPoint_eq_origin_of_finite_normalizedGammaOrbit + (x : NormalizedMarkoffSurface ℂ) + (hfinite : (normalizedGammaOrbit x).Finite) : + x.1 = normalizedOrigin := by + obtain ⟨w₁, w₂, w₃, hw₁, hw₂, hw₃, h₁, h₂, h₃⟩ := + finite_normalizedGammaOrbit_has_torsion_traces x hfinite + exact complex_normalizedMarkoff_eq_origin_of_torsion_traces x.1 x.property + ⟨w₁, hw₁, h₁⟩ ⟨w₂, hw₂, h₂⟩ ⟨w₃, hw₃, h₃⟩ + +theorem complex_normalizedGammaOrbit_infinite_of_ne_origin + (x : NormalizedMarkoffSurface ℂ) (hx : x.1 ≠ normalizedOrigin) : + (normalizedGammaOrbit x).Infinite := by + intro hfinite + exact hx (complex_normalizedPoint_eq_origin_of_finite_normalizedGammaOrbit x hfinite) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean new file mode 100644 index 0000000000..6c2f2436ac --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean @@ -0,0 +1,372 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound + +/-! +# Bounding the opening orders by the full Gamma orbit + +The nonzero semisimple fibers use the existing conic parametrizations. Trace zero and the two +parabolic traces are handled explicitly, since the generic parametrizations deliberately exclude +those values. +-/ + +namespace BGS.Markoff + +private theorem two_ne_zero_zmod_of_prime_ne_two + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) : (2 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 2 := (ZMod.natCast_eq_zero_iff 2 p).1 hzero + exact hpTwo (Nat.le_antisymm (Nat.le_of_dvd (by norm_num) hpDvd) + (Fact.out : p.Prime).two_le) + +private theorem four_le_normalizedGammaOrbit_ncard_of_firstCoordinate_zero + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) + (x : NormalizedMarkoffSurface (ZMod p)) (hxzero : x.1.u1 = 0) + (hxne : x.1 ≠ normalizedOrigin) : + 4 ≤ (normalizedGammaOrbit x).ncard := by + classical + have hsurface : x.1.u2 ^ 2 + x.1.u3 ^ 2 = 0 := by + have := x.property + change normalizedPolynomial x.1 = 0 at this + rw [normalizedPolynomial, hxzero] at this + simpa using this + have h₂ : x.1.u2 ≠ 0 := by + intro hzero + rw [hzero] at hsurface + have h₃sq : x.1.u3 ^ 2 = 0 := by simpa using hsurface + have h₃ : x.1.u3 = 0 := sq_eq_zero_iff.mp h₃sq + apply hxne + ext + · simpa [normalizedOrigin] using hxzero + · simpa [normalizedOrigin] using hzero + · simpa [normalizedOrigin] using h₃ + have h₃ : x.1.u3 ≠ 0 := by + intro hzero + rw [hzero] at hsurface + have h₂sq : x.1.u2 ^ 2 = 0 := by simpa using hsurface + exact h₂ (sq_eq_zero_iff.mp h₂sq) + have h₂₃ : x.1.u2 ≠ x.1.u3 := by + intro heq + have htwo : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod_of_prime_ne_two p hpTwo + have hsq : 2 * x.1.u2 ^ 2 = 0 := by + rw [← heq] at hsurface + linear_combination hsurface + have : x.1.u2 ^ 2 = 0 := (mul_eq_zero.mp hsq).resolve_left htwo + exact h₂ (sq_eq_zero_iff.mp this) + let x₁₂ := normalizedSwap12Surface x + let x₂₃ := normalizedSwap23Surface x + let x₂₃₁₂ := normalizedSwap12Surface x₂₃ + let f : Fin 4 → NormalizedMarkoffSurface (ZMod p) := ![x, x₁₂, x₂₃, x₂₃₁₂] + have hf : Function.Injective f := by + intro i j hij + fin_cases i <;> fin_cases j <;> try rfl + all_goals + exfalso + have hval := congrArg Subtype.val hij + have hfirst := congrArg NormalizedPoint.u1 hval + have hsecond := congrArg NormalizedPoint.u2 hval + have hthird := congrArg NormalizedPoint.u3 hval + simp [f, x₁₂, x₂₃, x₂₃₁₂, normalizedSwap12Surface, + normalizedSwap23Surface, normalizedSwap12, normalizedSwap23, hxzero] at hfirst hsecond hthird + first + | exact h₂ hfirst + | exact h₂ hfirst.symm + | exact h₂ hsecond + | exact h₂ hsecond.symm + | exact h₂ hthird + | exact h₂ hthird.symm + | exact h₃ hfirst + | exact h₃ hfirst.symm + | exact h₃ hsecond + | exact h₃ hsecond.symm + | exact h₃ hthird + | exact h₃ hthird.symm + | exact h₂₃ hfirst + | exact h₂₃ hfirst.symm + | exact h₂₃ hsecond + | exact h₂₃ hsecond.symm + let cycle : Finset (NormalizedMarkoffSurface (ZMod p)) := Finset.univ.image f + have hcard : cycle.card = 4 := by + change (Finset.univ.image f).card = 4 + rw [Finset.card_image_of_injective _ hf] + simp + have hsubset : (cycle : Set (NormalizedMarkoffSurface (ZMod p))) ⊆ normalizedGammaOrbit x := by + change ((↑(Finset.univ.image f) : Set _) ⊆ normalizedGammaOrbit x) + intro y hy + rw [Finset.mem_coe, Finset.mem_image] at hy + obtain ⟨i, _hi, rfl⟩ := hy + fin_cases i + · exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + (sameNormalizedComponent_refl x) + · exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + (sameNormalizedComponent_swap12Surface x) + · exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + (sameNormalizedComponent_swap23Surface x) + · exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + (sameNormalizedComponent_trans (sameNormalizedComponent_swap23Surface x) + (sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x))) + rw [← hcard, ← Set.ncard_coe_finset] + exact Set.ncard_le_ncard hsubset + +private theorem two_le_normalizedGammaOrbit_ncard_of_parabolic_firstCoordinate + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) + (x : NormalizedMarkoffSurface (ZMod p)) (hxparabolic : x.1.u1 ^ 2 = 4) : + 2 ≤ (normalizedGammaOrbit x).ncard := by + classical + have hrotateNe : normalizedRotate1Surface x ≠ x := by + intro hfix + have hval := congrArg Subtype.val hfix + have h₂ := congrArg NormalizedPoint.u2 hval + have h₃ := congrArg NormalizedPoint.u3 hval + change x.1.u3 = x.1.u2 at h₂ + change x.1.u1 * x.1.u3 - x.1.u2 = x.1.u3 at h₃ + have hcases : x.1.u1 = 2 ∨ x.1.u1 = -2 := by + have hfactor : (x.1.u1 - 2) * (x.1.u1 + 2) = 0 := by + calc + (x.1.u1 - 2) * (x.1.u1 + 2) = x.1.u1 ^ 2 - 4 := by ring + _ = 0 := sub_eq_zero.mpr hxparabolic + rcases mul_eq_zero.mp hfactor with h | h + · exact Or.inl (sub_eq_zero.mp h) + · exact Or.inr (eq_neg_of_add_eq_zero_left h) + have htwo : (2 : ZMod p) ≠ 0 := two_ne_zero_zmod_of_prime_ne_two p hpTwo + rcases hcases with ht | ht + · have hsurface : normalizedPolynomial x.1 = 0 := x.property + rw [normalizedPolynomial, ht, h₂] at hsurface + have hfourZero : (4 : ZMod p) = 0 := by linear_combination hsurface + have hfour : (4 : ZMod p) ≠ 0 := by + (convert pow_ne_zero 2 htwo using 1; norm_num [pow_two]) + exact hfour hfourZero + · have hy : x.1.u2 = 0 := by + rw [ht, h₂] at h₃ + have hfour : (4 : ZMod p) ≠ 0 := by + (convert pow_ne_zero 2 htwo using 1; norm_num [pow_two]) + exact (mul_eq_zero.mp (by linear_combination -h₃)).resolve_left hfour + have hsurface : normalizedPolynomial x.1 = 0 := x.property + rw [normalizedPolynomial, ht, h₂, hy] at hsurface + have hfourZero : (4 : ZMod p) = 0 := by linear_combination hsurface + have hfour : (4 : ZMod p) ≠ 0 := by + (convert pow_ne_zero 2 htwo using 1; norm_num [pow_two]) + exact hfour hfourZero + let pair : Finset (NormalizedMarkoffSurface (ZMod p)) := {x, normalizedRotate1Surface x} + have hcard : pair.card = 2 := by + change ({x, normalizedRotate1Surface x} : Finset _).card = 2 + exact Finset.card_pair hrotateNe.symm + have hsubset : (pair : Set (NormalizedMarkoffSurface (ZMod p))) ⊆ normalizedGammaOrbit x := by + change ((↑({x, normalizedRotate1Surface x} : Finset _) : Set _) ⊆ normalizedGammaOrbit x) + intro y hy + simp only [Finset.mem_coe, Finset.mem_insert, Finset.mem_singleton] at hy + rcases hy with hy | hy + · subst y + apply (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + exact sameNormalizedComponent_refl x + · subst y + apply (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + exact sameNormalizedComponent_rotate1Surface x + rw [← hcard, ← Set.ncard_coe_finset] + exact Set.ncard_le_ncard hsubset + +/-- The exact order of any residue-closure eigenvalue representing the first trace is bounded by +the full normalized Gamma orbit. Nonzero semisimple traces use the conic rotation cycles; trace +zero and parabolic traces use the explicit exceptional lower bounds above. -/ +theorem eigenvalueOrder_le_normalizedGammaOrbit_ncard + (p : ℕ) [Fact p.Prime] [Invertible (3 : ZMod p)] (hpTwo : p ≠ 2) + (x : NormalizedMarkoffSurface (ZMod p)) (hxne : x.1 ≠ normalizedOrigin) + (W : (OpeningResidueClosure p)ˣ) + (htrace : algebraMap (ZMod p) (OpeningResidueClosure p) x.1.u1 = splitTorusTrace W) : + orderOf W ≤ (normalizedGammaOrbit x).ncard := by + by_cases hparabolic : x.1.u1 ^ 2 = 4 + · have htraceSq : (splitTorusTrace W) ^ 2 = 4 := by + rw [← htrace, ← map_pow, hparabolic, map_ofNat] + have hdiffSq : + ((W : OpeningResidueClosure p) - ((W⁻¹ : (OpeningResidueClosure p)ˣ) : + OpeningResidueClosure p)) ^ 2 = 0 := by + have hmul : (W : OpeningResidueClosure p) * + ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p) = 1 := by simp + rw [splitTorusTrace] at htraceSq + linear_combination htraceSq - 4 * hmul + have hinv : ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p) = W := by + exact (sub_eq_zero.mp (sq_eq_zero_iff.mp hdiffSq)).symm + have hWsq : W ^ 2 = 1 := by + apply Units.ext + change (W : OpeningResidueClosure p) ^ 2 = 1 + calc + (W : OpeningResidueClosure p) ^ 2 = W * W := pow_two _ + _ = W * ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p) := by rw [hinv] + _ = 1 := by simp + have horder : orderOf W ≤ 2 := + Nat.le_of_dvd (by norm_num) (orderOf_dvd_iff_pow_eq_one.mpr hWsq) + exact horder.trans + (two_le_normalizedGammaOrbit_ncard_of_parabolic_firstCoordinate p hpTwo x hparabolic) + · by_cases hzero : x.1.u1 = 0 + · have hsum : splitTorusTrace W = 0 := by rw [← htrace, hzero, map_zero] + have hWsq : ((W : OpeningResidueClosure p) ^ 2) = -1 := by + have hmul : (W : OpeningResidueClosure p) * + ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p) = 1 := by simp + rw [splitTorusTrace] at hsum + calc + (W : OpeningResidueClosure p) ^ 2 = + W * (W + ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p)) - + W * ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p) := by ring + _ = 0 - 1 := by rw [hsum, mul_zero, hmul] + _ = -1 := by ring + have hWfour : W ^ 4 = 1 := by + apply Units.ext + change (W : OpeningResidueClosure p) ^ 4 = 1 + calc + (W : OpeningResidueClosure p) ^ 4 = ((W : OpeningResidueClosure p) ^ 2) ^ 2 := by ring + _ = (-1 : OpeningResidueClosure p) ^ 2 := by rw [hWsq] + _ = 1 := by ring + have horder : orderOf W ≤ 4 := + Nat.le_of_dvd (by norm_num) (orderOf_dvd_iff_pow_eq_one.mpr hWfour) + exact horder.trans + (four_le_normalizedGammaOrbit_ncard_of_firstCoordinate_zero p hpTwo x hzero hxne) + · have hWnonparabolic : (W : OpeningResidueClosure p) ^ 2 ≠ 1 := by + intro hW + apply hparabolic + apply (algebraMap (ZMod p) (OpeningResidueClosure p)).injective + rw [map_pow, map_ofNat, htrace] + have hinv : ((W⁻¹ : (OpeningResidueClosure p)ˣ) : OpeningResidueClosure p) = W := + Units.inv_eq_of_mul_eq_one_right (by simpa [pow_two] using hW) + rw [splitTorusTrace, hinv] + calc + ((W : OpeningResidueClosure p) + W) ^ 2 = 4 * (W : OpeningResidueClosure p) ^ 2 := by ring + _ = 4 := by rw [hW, mul_one] + have hrotation : rotationOrder x.1.u1 = orderOf W := + rotationOrder_eq_orderOf_extensionEigenvalue x.1.u1 W hWnonparabolic htrace + let xf : ↑(normalizedFiber1 x.1.u1) := ⟨x.1, x.property, rfl⟩ + have hcycle : (normalizedRotationCycle x.1.u1 x.1).card = rotationOrder x.1.u1 := by + simpa [xf] using normalizedRotationCycle_card_of_nonzero_nonparabolic + p hpTwo x.1.u1 hparabolic hzero xf + calc + orderOf W = rotationOrder x.1.u1 := hrotation.symm + _ = (normalizedRotationCycle x.1.u1 x.1).card := hcycle.symm + _ ≤ (normalizedGammaOrbit x).ncard := + normalizedRotationCycle_card_le_normalizedGammaOrbit_ncard x + +private theorem three_ne_zero_zmod_of_prime_ne_three + (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by + intro hzero + have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).1 hzero + have hpLe : p ≤ 3 := Nat.le_of_dvd (by norm_num) hpDvd + have hpGe : 2 ≤ p := (Fact.out : p.Prime).two_le + have hpTwoOrThree : p = 2 ∨ p = 3 := by omega + rcases hpTwoOrThree with hpTwo | hpThreeEq + · subst p + norm_num at hpDvd + · exact hpThree hpThreeEq + +/-- The concrete opening exponent can be bounded by the cardinality of the full normalized Gamma +orbit. The exclusions `p ≠ 2, 3` are explicit: oddness is used by the trace classification and +`3` must be invertible for the transported normalized action. -/ +theorem prime_le_twenty_pow_normalizedGammaOrbit_ncard_cube + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hpThree : p ≠ 3) + (x : NormalizedMarkoffSurface (ZMod p)) (hxne : x.1 ≠ normalizedOrigin) : + p ≤ 20 ^ (letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + normalizedGammaOrbit x).ncard ^ 3 := by + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + obtain ⟨W₁, W₂, W₃, htrace₁, htrace₂, htrace₃, _hfin₁, _hfin₂, _hfin₃, + _hcoprime₁, _hcoprime₂, _hcoprime₃, hpBound⟩ := + exists_exact_eigenvalue_orders_with_cyclotomic_bound p hpTwo x.1 x.property hxne + let m := (normalizedGammaOrbit x).ncard + have horder₁ : orderOf W₁ ≤ m := + eigenvalueOrder_le_normalizedGammaOrbit_ncard p hpTwo x hxne W₁ htrace₁ + let x₂ := normalizedSwap12Surface x + have hx₂ne : x₂.1 ≠ normalizedOrigin := by + intro hzero + simp [x₂, normalizedSwap12Surface, normalizedSwap12, normalizedOrigin] at hzero + apply hxne + ext + · exact hzero.2.1 + · exact hzero.1 + · exact hzero.2.2 + have horbit₂ : normalizedGammaOrbit x₂ = normalizedGammaOrbit x := by + apply MulAction.orbit_eq_iff.mpr + exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + (sameNormalizedComponent_swap12Surface x) + have horder₂ : orderOf W₂ ≤ m := by + have h := eigenvalueOrder_le_normalizedGammaOrbit_ncard p hpTwo x₂ hx₂ne W₂ (by + simpa [x₂, normalizedSwap12Surface, normalizedSwap12] using htrace₂) + simpa [m, horbit₂] using h + let x₃ := normalizedSwap12Surface (normalizedSwap23Surface x) + have hx₃ne : x₃.1 ≠ normalizedOrigin := by + intro hzero + simp [x₃, normalizedSwap12Surface, normalizedSwap23Surface, + normalizedSwap12, normalizedSwap23, normalizedOrigin] at hzero + apply hxne + ext + · exact hzero.2.1 + · exact hzero.2.2 + · exact hzero.1 + have hx₃component : SameNormalizedComponent x x₃ := + sameNormalizedComponent_trans (sameNormalizedComponent_swap23Surface x) + (sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x)) + have horbit₃ : normalizedGammaOrbit x₃ = normalizedGammaOrbit x := by + apply MulAction.orbit_eq_iff.mpr + exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp hx₃component + have horder₃ : orderOf W₃ ≤ m := by + have h := eigenvalueOrder_le_normalizedGammaOrbit_ncard p hpTwo x₃ hx₃ne W₃ (by + simpa [x₃, normalizedSwap12Surface, normalizedSwap23Surface, + normalizedSwap12, normalizedSwap23] using htrace₃) + simpa [m, horbit₃] using h + have hmax : max (orderOf W₁) (max (orderOf W₂) (orderOf W₃)) ≤ m := by + exact max_le horder₁ (max_le horder₂ horder₃) + exact hpBound.trans (Nat.pow_le_pow_right (by norm_num) (Nat.pow_le_pow_left hmax 3)) + +/-- Normalization carries the original Gamma orbit bijectively onto the transported normalized +Gamma orbit. -/ +theorem normalizedGammaOrbit_normalization_eq_image + {R : Type*} [Field R] [Invertible (3 : R)] (x : MarkoffSurface R) : + normalizedGammaOrbit (normalizationSurfaceEquiv R x) = + normalizationSurfaceEquiv R '' gammaOrbit x := by + ext y + constructor + · intro hy + have hcomponent : SameNormalizedComponent (normalizationSurfaceEquiv R x) y := + (sameNormalizedComponent_iff_mem_normalizedGammaOrbit _ _).2 hy + have horiginal : SameComponent x ((normalizationSurfaceEquiv R).symm y) := by + simpa [SameNormalizedComponent] using hcomponent + exact ⟨(normalizationSurfaceEquiv R).symm y, horiginal, + (normalizationSurfaceEquiv R).apply_symm_apply y⟩ + · rintro ⟨z, hz, rfl⟩ + apply (sameNormalizedComponent_iff_mem_normalizedGammaOrbit _ _).1 + have horiginal : SameComponent x z := hz + simpa [SameNormalizedComponent] using horiginal + +/-- Original and normalized Gamma orbits have the same cardinality. -/ +theorem normalizedGammaOrbit_normalization_ncard + {R : Type*} [Field R] [Invertible (3 : R)] (x : MarkoffSurface R) : + (normalizedGammaOrbit (normalizationSurfaceEquiv R x)).ncard = (gammaOrbit x).ncard := by + rw [normalizedGammaOrbit_normalization_eq_image] + exact Set.ncard_image_of_injective _ (normalizationSurfaceEquiv R).injective + +/-- Original-coordinate form of the orbit-card opening bound. -/ +theorem prime_le_twenty_pow_gammaOrbit_ncard_cube + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hpThree : p ≠ 3) + (x : MarkoffSurface (ZMod p)) (hxne : x.1 ≠ origin) : + p ≤ 20 ^ (gammaOrbit x).ncard ^ 3 := by + letI : Invertible (3 : ZMod p) := + invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + let xn := normalizationSurfaceEquiv (ZMod p) x + have hxnNe : xn.1 ≠ normalizedOrigin := by + intro hzero + apply hxne + change toNormalized x.1 = normalizedOrigin at hzero + have hsurfaceOriginal : x = ⟨origin, markoffPolynomial_origin⟩ := by + apply (normalizationSurfaceEquiv (ZMod p)).injective + apply Subtype.ext + change toNormalized x.1 = toNormalized origin + simpa using hzero + exact congrArg Subtype.val hsurfaceOriginal + have hbound := prime_le_twenty_pow_normalizedGammaOrbit_ncard_cube + p hpTwo hpThree xn hxnNe + rw [normalizedGammaOrbit_normalization_ncard] at hbound + exact hbound + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean new file mode 100644 index 0000000000..fb0cc51e48 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean @@ -0,0 +1,50 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Data.Nat.Totient +import Mathlib.Data.Nat.GCD.Basic + +namespace BGS.Markoff + +/-- The totient exponent is no larger than the conductor exponent. -/ +theorem twenty_pow_totient_le_twenty_pow (n : ℕ) : + 20 ^ n.totient ≤ 20 ^ n := + Nat.pow_le_pow_right (by norm_num) (Nat.totient_le n) + +/-- The least common multiple of three positive orders is bounded by their product. -/ +theorem lcm_three_le_product {l₁ l₂ l₃ : ℕ} + (hl₁ : 0 < l₁) (hl₂ : 0 < l₂) (hl₃ : 0 < l₃) : + Nat.lcm (Nat.lcm l₁ l₂) l₃ ≤ l₁ * l₂ * l₃ := by + apply Nat.le_of_dvd (mul_pos (mul_pos hl₁ hl₂) hl₃) + exact (Nat.lcm_dvd_mul (Nat.lcm l₁ l₂) l₃).trans + (Nat.mul_dvd_mul_right (Nat.lcm_dvd_mul l₁ l₂) l₃) + +/-- Three orders are bounded by the cube of their maximum. -/ +theorem product_le_max_cube (l₁ l₂ l₃ : ℕ) : + l₁ * l₂ * l₃ ≤ max (max l₁ l₂) l₃ ^ 3 := by + have h₁ : l₁ ≤ max (max l₁ l₂) l₃ := le_trans (le_max_left _ _) (le_max_left _ _) + have h₂ : l₂ ≤ max (max l₁ l₂) l₃ := le_trans (le_max_right _ _) (le_max_left _ _) + have h₃ : l₃ ≤ max (max l₁ l₂) l₃ := le_max_right _ _ + calc + l₁ * l₂ * l₃ ≤ max (max l₁ l₂) l₃ * max (max l₁ l₂) l₃ * + max (max l₁ l₂) l₃ := Nat.mul_le_mul (Nat.mul_le_mul h₁ h₂) h₃ + _ = max (max l₁ l₂) l₃ ^ 3 := by ring + +/-- The numerical conclusion of the opening norm argument in maximum-order form. -/ +theorem modulus_le_twenty_pow_max_order_cube_of_lcm_totient_bound + {p l₁ l₂ l₃ : ℕ} (hl₁ : 0 < l₁) (hl₂ : 0 < l₂) (hl₃ : 0 < l₃) + (hbound : p ≤ 20 ^ (Nat.lcm (Nat.lcm l₁ l₂) l₃).totient) : + p ≤ 20 ^ (max (max l₁ l₂) l₃ ^ 3) := by + calc + p ≤ 20 ^ (Nat.lcm (Nat.lcm l₁ l₂) l₃).totient := hbound + _ ≤ 20 ^ Nat.lcm (Nat.lcm l₁ l₂) l₃ := + twenty_pow_totient_le_twenty_pow _ + _ ≤ 20 ^ (l₁ * l₂ * l₃) := + Nat.pow_le_pow_right (by norm_num) (lcm_three_le_product hl₁ hl₂ hl₃) + _ ≤ 20 ^ (max (max l₁ l₂) l₃ ^ 3) := + Nat.pow_le_pow_right (by norm_num) (product_le_max_cube l₁ l₂ l₃) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean new file mode 100644 index 0000000000..39a7f9723d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean @@ -0,0 +1,92 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization + +/-! +# Parabolic fibers are aperiodic in characteristic zero + +Finite periodicity of a point does not imply finite order of the ambient rotation matrix. The +opening therefore needs a point-level argument at normalized traces `2` and `-2`. The explicit +parabolic-line translations give that argument in characteristic zero. +-/ + +namespace BGS.Markoff + +universe u + +variable {K : Type u} [Field K] [CharZero K] + +private theorem root_neg_one_ne_zero {i : K} (hi : i ^ 2 = -1) : i ≠ 0 := by + intro hzero + subst i + norm_num at hi + +/-- No positive iterate of the trace-`2` rotation fixes a point on either parabolic line in +characteristic zero. -/ +theorem iterate_normalizedRotate1_parabolicLineAtTwo_ne_self_of_pos + (n : ℕ) (hn : 0 < n) (i t : K) (hi : i ^ 2 = -1) : + (normalizedRotate1^[n]) (parabolicLineAtTwo i t) ≠ parabolicLineAtTwo i t := by + rw [iterate_normalizedRotate1_parabolicLineAtTwo] + intro hreturn + have hparameter := congrArg NormalizedPoint.u2 hreturn + change t + (n : K) * (2 * i) = t at hparameter + have hnCast : (n : K) ≠ 0 := by exact_mod_cast hn.ne' + have htwo : (2 : K) ≠ 0 := by norm_num + exact (mul_ne_zero hnCast (mul_ne_zero htwo (root_neg_one_ne_zero hi))) <| by + linear_combination hparameter + +/-- No positive iterate of the trace-`-2` rotation fixes a point on either parabolic line in +characteristic zero. -/ +theorem iterate_normalizedRotate1_parabolicLineAtNegTwo_ne_self_of_pos + (n : ℕ) (hn : 0 < n) (i t : K) (hi : i ^ 2 = -1) : + (normalizedRotate1^[n]) (parabolicLineAtNegTwo i t) ≠ parabolicLineAtNegTwo i t := by + rcases n.even_or_odd' with ⟨k, rfl | rfl⟩ + · rw [iterate_two_mul_normalizedRotate1_parabolicLineAtNegTwo] + intro hreturn + have hparameter := congrArg NormalizedPoint.u2 hreturn + change t - (k : K) * (4 * i) = t at hparameter + have hk : 0 < k := by omega + have hkCast : (k : K) ≠ 0 := by exact_mod_cast hk.ne' + have hfour : (4 : K) ≠ 0 := by norm_num + exact (mul_ne_zero hkCast (mul_ne_zero hfour (root_neg_one_ne_zero hi))) <| by + linear_combination -hparameter + · rw [iterate_two_mul_add_one_normalizedRotate1_parabolicLineAtNegTwo] + intro hreturn + have hsecond := congrArg NormalizedPoint.u2 hreturn + have hthird := congrArg NormalizedPoint.u3 hreturn + change -(t - (k : K) * (4 * i)) + 2 * i = t at hsecond + change -(-(t - (k : K) * (4 * i)) + 2 * i) + 2 * (-i) = -t + 2 * i at hthird + rw [hsecond] at hthird + have hfour : (4 : K) ≠ 0 := by norm_num + exact (mul_ne_zero hfour (root_neg_one_ne_zero hi)) <| by + linear_combination -hthird + +/-- Every point of the normalized trace-`2` fiber is aperiodic once a square root of `-1` is +fixed. -/ +theorem iterate_normalizedRotate1_ne_self_of_mem_fiber1_two + (i : K) (hi : i ^ 2 = -1) {x : NormalizedPoint K} + (hx : x ∈ normalizedFiber1 (2 : K)) (n : ℕ) (hn : 0 < n) : + (normalizedRotate1^[n]) x ≠ x := by + rw [normalizedFiber1_two_eq_parabolic_lines i hi] at hx + rcases hx with ⟨t, rfl⟩ | ⟨t, rfl⟩ + · exact iterate_normalizedRotate1_parabolicLineAtTwo_ne_self_of_pos n hn i t hi + · exact iterate_normalizedRotate1_parabolicLineAtTwo_ne_self_of_pos n hn (-i) t <| by + rw [neg_sq, hi] + +/-- Every point of the normalized trace-`-2` fiber is aperiodic once a square root of `-1` is +fixed. -/ +theorem iterate_normalizedRotate1_ne_self_of_mem_fiber1_neg_two + (i : K) (hi : i ^ 2 = -1) {x : NormalizedPoint K} + (hx : x ∈ normalizedFiber1 (-2 : K)) (n : ℕ) (hn : 0 < n) : + (normalizedRotate1^[n]) x ≠ x := by + rw [normalizedFiber1_neg_two_eq_parabolic_lines i hi] at hx + rcases hx with ⟨t, rfl⟩ | ⟨t, rfl⟩ + · exact iterate_normalizedRotate1_parabolicLineAtNegTwo_ne_self_of_pos n hn i t hi + · exact iterate_normalizedRotate1_parabolicLineAtNegTwo_ne_self_of_pos n hn (-i) t <| by + rw [neg_sq, hi] + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean new file mode 100644 index 0000000000..7992a450f1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues + +/-! +# Periodic points on semisimple fibers + +This module proves the point-level implication needed in the opening. It does not infer finite +matrix order from periodicity of a single vector. Instead it uses the explicit conic +parametrization: on a nonparabolic fiber, rotation multiplies the eigen-coordinate by a chosen +matrix eigenvalue, so a positive return forces that eigenvalue to be torsion. +-/ + +namespace BGS.Markoff + +open Polynomial + +variable {K : Type*} [Field K] [IsAlgClosed K] + +/-- Every trace parameter over an algebraically closed field is `w + w⁻¹` for a nonzero +eigenvalue `w`. -/ +theorem exists_splitTorusTrace_eq (t : K) : + ∃ w : Kˣ, t = splitTorusTrace w := by + let f : K[X] := X ^ 2 - C t * X + 1 + have hfdegree : f.degree ≠ 0 := by + have hfshape : IsMonicOfDegree f 2 := by + simpa [f] using isMonicOfDegree_sub_add_two t (1 : K) + rw [degree_eq_natDegree hfshape.monic.ne_zero, hfshape.natDegree_eq] + norm_num + obtain ⟨r, hr⟩ := IsAlgClosed.exists_root f hfdegree + have hreigen : r ^ 2 - t * r + 1 = 0 := by simpa [f] using hr + have hrne : r ≠ 0 := by + intro hrzero + simp [hrzero] at hreigen + let w : Kˣ := Units.mk0 r hrne + refine ⟨w, ?_⟩ + have hmul : t * r = r ^ 2 + 1 := by linear_combination -hreigen + change t = r + r⁻¹ + apply mul_right_cancel₀ hrne + rw [hmul] + field_simp + +omit [IsAlgClosed K] in +private theorem eigenvalue_nonparabolic + {t : K} {w : Kˣ} (htrace : t = splitTorusTrace w) (ht : t ^ 2 ≠ 4) : + (w : K) ^ 2 ≠ 1 := by + intro hw + apply ht + have hinv : ((w⁻¹ : Kˣ) : K) = (w : K) := by + apply (mul_right_cancel₀ (Units.ne_zero w)) + simpa [pow_two] using hw.symm + apply sub_eq_zero.mp + rw [htrace, splitTorusTrace_sq_sub_four, hinv, sub_self, zero_pow] + norm_num + +omit [IsAlgClosed K] in +private theorem torsion_of_trace_zero {w : Kˣ} (htrace : splitTorusTrace w = 0) : + IsOfFinOrder w := by + have hwSquare : (w : K) ^ 2 = -1 := by + have h : (w : K) + (w : K)⁻¹ = 0 := by + simpa [splitTorusTrace] using htrace + have hmul := congrArg (fun q : K => q * (w : K)) h + simp [add_mul, Units.ne_zero w] at hmul + linear_combination hmul + rw [isOfFinOrder_iff_pow_eq_one] + refine ⟨4, by norm_num, ?_⟩ + apply Units.ext + change (w : K) ^ 4 = 1 + rw [show (4 : ℕ) = 2 * 2 by norm_num, pow_mul, hwSquare] + norm_num + +/-- A positive return of a point on a nonparabolic normalized fiber produces a torsion +eigenvalue representing the fixed trace coordinate. -/ +theorem periodic_nonparabolic_fiber_has_torsion_eigenvalue + {t : K} (ht : t ^ 2 ≠ 4) {x : NormalizedPoint K} + (hx : x ∈ normalizedFiber1 t) {n : ℕ} (hn : 0 < n) + (hperiodic : (normalizedRotate1^[n]) x = x) : + ∃ w : Kˣ, IsOfFinOrder w ∧ t = splitTorusTrace w := by + obtain ⟨w, htrace⟩ := exists_splitTorusTrace_eq t + have hw := eigenvalue_nonparabolic htrace ht + by_cases htZero : t = 0 + · refine ⟨w, torsion_of_trace_zero ?_, htrace⟩ + rw [← htrace, htZero] + · let xp : ↑(normalizedFiber1 (splitTorusTrace w)) := ⟨x, by + rw [← htrace] + exact hx⟩ + let s : Kˣ := (splitFiberEquiv w hw (htrace ▸ htZero)).symm xp + have hxrepr : splitFiberPoint w s = x := by + exact congrArg Subtype.val ((splitFiberEquiv w hw (htrace ▸ htZero)).apply_symm_apply xp) + rw [← hxrepr] at hperiodic + have hpower := (iterate_normalizedRotate1_splitFiberPoint_eq_self_iff w s hw n).mp hperiodic + refine ⟨w, ?_, htrace⟩ + rw [isOfFinOrder_iff_pow_eq_one] + exact ⟨n, hn, hpower⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean new file mode 100644 index 0000000000..2c68b3945b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean @@ -0,0 +1,69 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization + +namespace BGS.Markoff + +universe u + +variable {R : Type u} [Field R] [DecidableEq R] [Invertible (3 : R)] + +/-- The finite segment of normalized surface iterates cut out by the matrix rotation order. -/ +noncomputable def normalizedSurfaceRotationCycle (x : NormalizedMarkoffSurface R) : + Finset (NormalizedMarkoffSurface R) := by + classical + exact (Finset.range (rotationOrder x.1.u1)).image fun n => + (normalizedRotate1Surface^[n]) x + +/-- Every point of the normalized rotation cycle belongs to the full transported Gamma orbit. -/ +theorem normalizedSurfaceRotationCycle_subset_normalizedGammaOrbit + (x : NormalizedMarkoffSurface R) : + (normalizedSurfaceRotationCycle x : Set (NormalizedMarkoffSurface R)) ⊆ + normalizedGammaOrbit x := by + classical + intro y hy + rw [Finset.mem_coe, normalizedSurfaceRotationCycle, Finset.mem_image] at hy + obtain ⟨n, _hn, rfl⟩ := hy + exact (sameNormalizedComponent_iff_mem_normalizedGammaOrbit x _).mp + (sameNormalizedComponent_iterate_normalizedRotate1Surface x n) + +omit [Invertible (3 : R)] in +/-- Forgetting the surface proof identifies the surface cycle with the existing point cycle. -/ +theorem normalizedSurfaceRotationCycle_image_val + (x : NormalizedMarkoffSurface R) : + (normalizedSurfaceRotationCycle x).image Subtype.val = + normalizedRotationCycle x.1.u1 x.1 := by + classical + ext y + simp only [normalizedSurfaceRotationCycle, normalizedRotationCycle, Finset.mem_image, + Finset.mem_range] + constructor + · rintro ⟨z, ⟨n, hn, rfl⟩, rfl⟩ + exact ⟨n, hn, (coe_iterate_normalizedRotate1Surface x n).symm⟩ + · rintro ⟨n, hn, rfl⟩ + exact ⟨(normalizedRotate1Surface^[n]) x, ⟨n, hn, rfl⟩, + coe_iterate_normalizedRotate1Surface x n⟩ + +omit [Invertible (3 : R)] in +/-- Surface and point rotation cycles have the same cardinality. -/ +theorem normalizedSurfaceRotationCycle_card + (x : NormalizedMarkoffSurface R) : + (normalizedSurfaceRotationCycle x).card = + (normalizedRotationCycle x.1.u1 x.1).card := by + rw [← normalizedSurfaceRotationCycle_image_val x] + exact (Finset.card_image_of_injective _ Subtype.val_injective).symm + +/-- A normalized rotation cycle injects into the full Gamma orbit, so its cardinality is an +honest lower bound for the orbit cardinality. -/ +theorem normalizedRotationCycle_card_le_normalizedGammaOrbit_ncard + [Fintype R] (x : NormalizedMarkoffSurface R) : + (normalizedRotationCycle x.1.u1 x.1).card ≤ (normalizedGammaOrbit x).ncard := by + rw [← normalizedSurfaceRotationCycle_card x, ← Set.ncard_coe_finset] + exact Set.ncard_le_ncard (normalizedSurfaceRotationCycle_subset_normalizedGammaOrbit x) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean new file mode 100644 index 0000000000..fc39e6860b --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple + +/-! +# Torsion eigenvalue traces force the complex Markoff origin + +This is the characteristic-zero contradiction at the heart of the opening. Once each +coordinate of a complex normalized Markoff point is represented by a torsion eigenvalue and its +reciprocal, the unit-circle defect argument forces all three coordinates to vanish. +-/ + +namespace BGS.Markoff + +/-- A finite-order complex unit has norm one. -/ +theorem norm_coe_eq_one_of_isOfFinOrder (w : ℂˣ) (hw : IsOfFinOrder w) : + ‖(w : ℂ)‖ = 1 := by + rw [isOfFinOrder_iff_pow_eq_one] at hw + obtain ⟨n, hn, hpower⟩ := hw + have hpowerComplex : (w : ℂ) ^ n = 1 := by + exact congrArg Units.val hpower + exact Complex.norm_eq_one_of_pow_eq_one hpowerComplex hn.ne' + +/-- A complex normalized Markoff point whose three coordinates are reciprocal traces of torsion +eigenvalues is the origin. -/ +theorem complex_normalizedMarkoff_eq_origin_of_torsion_traces + (x : NormalizedPoint ℂ) (hx : IsNormalizedMarkoff x) + (h₁ : ∃ w₁ : ℂˣ, IsOfFinOrder w₁ ∧ x.u1 = splitTorusTrace w₁) + (h₂ : ∃ w₂ : ℂˣ, IsOfFinOrder w₂ ∧ x.u2 = splitTorusTrace w₂) + (h₃ : ∃ w₃ : ℂˣ, IsOfFinOrder w₃ ∧ x.u3 = splitTorusTrace w₃) : + x = normalizedOrigin := by + obtain ⟨w₁, hw₁, hx₁⟩ := h₁ + obtain ⟨w₂, hw₂, hx₂⟩ := h₂ + obtain ⟨w₃, hw₃, hx₃⟩ := h₃ + have hn₁ := norm_coe_eq_one_of_isOfFinOrder w₁ hw₁ + have hn₂ := norm_coe_eq_one_of_isOfFinOrder w₂ hw₂ + have hn₃ := norm_coe_eq_one_of_isOfFinOrder w₃ hw₃ + have ht₁' : cyclotomicTrace (w₁ : ℂ) = x.u1 := by + rw [hx₁] + simp [cyclotomicTrace, splitTorusTrace] + have ht₂' : cyclotomicTrace (w₂ : ℂ) = x.u2 := by + rw [hx₂] + simp [cyclotomicTrace, splitTorusTrace] + have ht₃' : cyclotomicTrace (w₃ : ℂ) = x.u3 := by + rw [hx₃] + simp [cyclotomicTrace, splitTorusTrace] + have hdefect : cyclotomicDefect (w₁ : ℂ) (w₂ : ℂ) (w₃ : ℂ) = 0 := by + calc + cyclotomicDefect (w₁ : ℂ) (w₂ : ℂ) (w₃ : ℂ) = normalizedPolynomial x := by + rw [cyclotomicDefect, ht₁', ht₂', ht₃'] + rfl + _ = 0 := hx + obtain ⟨ht₁, ht₂, ht₃⟩ := + cyclotomicTrace_eq_zero_of_defect_eq_zero hn₁ hn₂ hn₃ hdefect + apply NormalizedPoint.ext + · change x.u1 = 0 + rw [← ht₁'] + exact ht₁ + · change x.u2 = 0 + rw [← ht₂'] + exact ht₂ + · change x.u3 = 0 + rw [← ht₃'] + exact ht₃ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean new file mode 100644 index 0000000000..cd2a1127b1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean @@ -0,0 +1,224 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +/-! +# From residue traces to the concrete cyclotomic opening bound + +This file chooses eigenvalues for arbitrary normalized traces over `ZMod p`, including the two +parabolic traces, and combines their exact orders by an lcm. +-/ + +namespace BGS.Markoff + +private theorem prime_coprime_orderOf_splitUnit + (p : ℕ) [Fact p.Prime] (w : (ZMod p)ˣ) : + Nat.Coprime p (orderOf w) := by + apply Nat.Coprime.of_dvd_right (orderOf_dvd_card : orderOf w ∣ Fintype.card (ZMod p)ˣ) + rw [ZMod.card_units] + exact (Nat.coprime_self_sub_right (Fact.out : p.Prime).one_le).2 (Nat.coprime_one_right p) + +private theorem prime_coprime_orderOf_quadraticNormOne + (p : ℕ) [Fact p.Prime] (w : quadraticNormOneTorus p) : + Nat.Coprime p (orderOf w) := by + apply Nat.Coprime.of_dvd_right + (orderOf_dvd_card : orderOf w ∣ Fintype.card (quadraticNormOneTorus p)) + rw [Fintype.card_eq_nat_card, quadraticNormOneTorus_natCard] + rw [add_comm, Nat.coprime_add_self_right] + exact Nat.coprime_one_right p + +private theorem mapped_split_eigenvalue + (p : ℕ) [Fact p.Prime] (t : ZMod p) (w : (ZMod p)ˣ) + (htrace : splitTorusTrace w = t) : + ∃ W : (OpeningResidueClosure p)ˣ, + algebraMap (ZMod p) (OpeningResidueClosure p) t = splitTorusTrace W ∧ + IsOfFinOrder W ∧ Nat.Coprime p (orderOf W) := by + let f := algebraMap (ZMod p) (OpeningResidueClosure p) + let W : (OpeningResidueClosure p)ˣ := Units.map f.toMonoidHom w + refine ⟨W, ?_, ?_, ?_⟩ + · rw [← htrace] + change f ((w : ZMod p) + ((w⁻¹ : (ZMod p)ˣ) : ZMod p)) = + f (w : ZMod p) + f ((w⁻¹ : (ZMod p)ˣ) : ZMod p) + exact map_add f _ _ + · exact (Units.map f.toMonoidHom).isOfFinOrder (isOfFinOrder_of_finite w) + · rw [show orderOf W = orderOf w by + exact orderOf_injective (Units.map f.toMonoidHom) + (Units.map_injective f.injective) w] + exact prime_coprime_orderOf_splitUnit p w + +private theorem mapped_quadraticNormOne_eigenvalue + (p : ℕ) [Fact p.Prime] (t : ZMod p) (w : quadraticNormOneTorus p) + (htrace : quadraticNormOneTrace p w = t) : + ∃ W : (OpeningResidueClosure p)ˣ, + algebraMap (ZMod p) (OpeningResidueClosure p) t = splitTorusTrace W ∧ + IsOfFinOrder W ∧ Nat.Coprime p (orderOf W) := by + let σ : quadraticFiniteField p →ₐ[ZMod p] OpeningResidueClosure p := IsAlgClosed.lift + let W : (OpeningResidueClosure p)ˣ := + Units.map σ.toRingHom.toMonoidHom (w : (quadraticFiniteField p)ˣ) + refine ⟨W, ?_, ?_, ?_⟩ + · calc + algebraMap (ZMod p) (OpeningResidueClosure p) t = + σ (algebraMap (ZMod p) (quadraticFiniteField p) t) := (σ.commutes t).symm + _ = σ (splitTorusTrace (w : (quadraticFiniteField p)ˣ)) := by + rw [← algebraMap_quadraticNormOneTrace p w, htrace] + _ = splitTorusTrace W := by simp [W, splitTorusTrace] + · exact (Units.map σ.toRingHom.toMonoidHom).isOfFinOrder + (isOfFinOrder_of_finite (w : (quadraticFiniteField p)ˣ)) + · rw [show orderOf W = orderOf w by + calc + orderOf W = orderOf (w : (quadraticFiniteField p)ˣ) := + orderOf_injective (Units.map σ.toRingHom.toMonoidHom) + (Units.map_injective σ.injective) _ + _ = orderOf w := orderOf_injective (quadraticNormOneTorus p).subtype + Subtype.coe_injective w] + exact prime_coprime_orderOf_quadraticNormOne p w + +/-- Every normalized trace over an odd prime field has a finite-order eigenvalue in the fixed +residue closure. Parabolic traces are represented explicitly by `1` or `-1`; all other traces +use the split/norm-one classification. -/ +theorem exists_residueClosure_eigenvalue_of_trace + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (t : ZMod p) : + ∃ W : (OpeningResidueClosure p)ˣ, + algebraMap (ZMod p) (OpeningResidueClosure p) t = splitTorusTrace W ∧ + IsOfFinOrder W ∧ Nat.Coprime p (orderOf W) := by + by_cases ht : t ^ 2 = 4 + · have hfactor : (t - 2) * (t + 2) = 0 := by + calc + (t - 2) * (t + 2) = t ^ 2 - 4 := by ring + _ = 0 := sub_eq_zero.mpr ht + rcases mul_eq_zero.mp hfactor with h | h + · have htTwo : t = 2 := sub_eq_zero.mp h + exact mapped_split_eigenvalue p t 1 (by + rw [htTwo] + change (1 : ZMod p) + 1 = 2 + ring) + · have htNegTwo : t = -2 := eq_neg_of_add_eq_zero_left h + exact mapped_split_eigenvalue p t (-1) (by + rw [htNegTwo] + change (-1 : ZMod p) + -1 = -2 + ring) + · rcases exists_split_or_quadraticNormOneTrace p hpTwo t ht with + ⟨w, htrace, _⟩ | ⟨w, htrace, _⟩ + · exact mapped_split_eigenvalue p t w htrace + · exact mapped_quadraticNormOne_eigenvalue p t w htrace + +/-- Every nonorigin normalized Markoff point over an odd prime field admits three compatible +residue-closure eigenvalues. Their exact orders control the concrete cyclotomic opening bound. -/ +theorem exists_exact_eigenvalue_orders_with_cyclotomic_bound + (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) + (x : NormalizedPoint (ZMod p)) (hx : IsNormalizedMarkoff x) + (hxne : x ≠ normalizedOrigin) : + ∃ W₁ W₂ W₃ : (OpeningResidueClosure p)ˣ, + algebraMap (ZMod p) (OpeningResidueClosure p) x.u1 = splitTorusTrace W₁ ∧ + algebraMap (ZMod p) (OpeningResidueClosure p) x.u2 = splitTorusTrace W₂ ∧ + algebraMap (ZMod p) (OpeningResidueClosure p) x.u3 = splitTorusTrace W₃ ∧ + IsOfFinOrder W₁ ∧ IsOfFinOrder W₂ ∧ IsOfFinOrder W₃ ∧ + Nat.Coprime p (orderOf W₁) ∧ Nat.Coprime p (orderOf W₂) ∧ + Nat.Coprime p (orderOf W₃) ∧ + p ≤ 20 ^ (max (orderOf W₁) (max (orderOf W₂) (orderOf W₃))) ^ 3 := by + obtain ⟨W₁, htrace₁, hfin₁, hcoprime₁⟩ := + exists_residueClosure_eigenvalue_of_trace p hpTwo x.u1 + obtain ⟨W₂, htrace₂, hfin₂, hcoprime₂⟩ := + exists_residueClosure_eigenvalue_of_trace p hpTwo x.u2 + obtain ⟨W₃, htrace₃, hfin₃, hcoprime₃⟩ := + exists_residueClosure_eigenvalue_of_trace p hpTwo x.u3 + let l₁ := orderOf W₁ + let l₂ := orderOf W₂ + let l₃ := orderOf W₃ + let n := Nat.lcm l₁ (Nat.lcm l₂ l₃) + let m := max l₁ (max l₂ l₃) + have hl₁ : 0 < l₁ := hfin₁.orderOf_pos + have hl₂ : 0 < l₂ := hfin₂.orderOf_pos + have hl₃ : 0 < l₃ := hfin₃.orderOf_pos + have hn : 0 < n := Nat.lcm_pos hl₁ (Nat.lcm_pos hl₂ hl₃) + letI : NeZero n := ⟨hn.ne'⟩ + have hcoprimeN : Nat.Coprime p n := by + apply (Fact.out : p.Prime).coprime_iff_not_dvd.2 + exact (Fact.out : p.Prime).not_dvd_lcm + ((Fact.out : p.Prime).coprime_iff_not_dvd.mp hcoprime₁) + ((Fact.out : p.Prime).not_dvd_lcm + ((Fact.out : p.Prime).coprime_iff_not_dvd.mp hcoprime₂) + ((Fact.out : p.Prime).coprime_iff_not_dvd.mp hcoprime₃)) + have hW₁pow : (W₁ : OpeningResidueClosure p) ^ n = 1 := by + simpa using congrArg Units.val + (orderOf_dvd_iff_pow_eq_one.mp (Nat.dvd_lcm_left l₁ (Nat.lcm l₂ l₃))) + have hW₂pow : (W₂ : OpeningResidueClosure p) ^ n = 1 := by + have hdvd : l₂ ∣ n := + (Nat.dvd_lcm_left l₂ l₃).trans (Nat.dvd_lcm_right l₁ (Nat.lcm l₂ l₃)) + simpa using congrArg Units.val (orderOf_dvd_iff_pow_eq_one.mp hdvd) + have hW₃pow : (W₃ : OpeningResidueClosure p) ^ n = 1 := by + have hdvd : l₃ ∣ n := + (Nat.dvd_lcm_right l₂ l₃).trans (Nat.dvd_lcm_right l₁ (Nat.lcm l₂ l₃)) + simpa using congrArg Units.val (orderOf_dvd_iff_pow_eq_one.mp hdvd) + obtain ⟨ω, a₁, a₂, a₃, hω, ha₁lt, ha₂lt, ha₃lt, ha₁, ha₂, ha₃⟩ := + exists_residue_common_primitiveRoot_powers p n hcoprimeN + (W₁ : OpeningResidueClosure p) (W₂ : OpeningResidueClosure p) + (W₃ : OpeningResidueClosure p) hW₁pow hW₂pow hW₃pow + let f := algebraMap (ZMod p) (OpeningResidueClosure p) + let xResidue : NormalizedPoint (OpeningResidueClosure p) := x.map f + have hxResidue : IsNormalizedMarkoff xResidue := by + change normalizedPolynomial (x.map f) = 0 + rw [normalizedPolynomial_map, hx, map_zero] + have hxResidueNe : xResidue ≠ normalizedOrigin := by + intro hzero + apply hxne + apply NormalizedPoint.ext + · apply f.injective + simpa [xResidue, f, NormalizedPoint.map, normalizedOrigin] using + congrArg NormalizedPoint.u1 hzero + · apply f.injective + simpa [xResidue, f, NormalizedPoint.map, normalizedOrigin] using + congrArg NormalizedPoint.u2 hzero + · apply f.injective + simpa [xResidue, f, NormalizedPoint.map, normalizedOrigin] using + congrArg NormalizedPoint.u3 hzero + have hcoord₁ : xResidue.u1 = cyclotomicTrace (ω ^ a₁) := by + calc + xResidue.u1 = f x.u1 := rfl + _ = splitTorusTrace W₁ := htrace₁ + _ = cyclotomicTrace (W₁ : OpeningResidueClosure p) := by + simp [splitTorusTrace, cyclotomicTrace] + _ = cyclotomicTrace (ω ^ a₁) := by rw [ha₁] + have hcoord₂ : xResidue.u2 = cyclotomicTrace (ω ^ a₂) := by + calc + xResidue.u2 = f x.u2 := rfl + _ = splitTorusTrace W₂ := htrace₂ + _ = cyclotomicTrace (W₂ : OpeningResidueClosure p) := by + simp [splitTorusTrace, cyclotomicTrace] + _ = cyclotomicTrace (ω ^ a₂) := by rw [ha₂] + have hcoord₃ : xResidue.u3 = cyclotomicTrace (ω ^ a₃) := by + calc + xResidue.u3 = f x.u3 := rfl + _ = splitTorusTrace W₃ := htrace₃ + _ = cyclotomicTrace (W₃ : OpeningResidueClosure p) := by + simp [splitTorusTrace, cyclotomicTrace] + _ = cyclotomicTrace (ω ^ a₃) := by rw [ha₃] + have hpCyclotomic : p ≤ 20 ^ n.totient := + modulus_le_twenty_pow_totient_of_compatible_residue_traces + p n a₁ a₂ a₃ hcoprimeN ω hω (Nat.le_of_lt ha₁lt) (Nat.le_of_lt ha₂lt) + (Nat.le_of_lt ha₃lt) xResidue hxResidue hcoord₁ hcoord₂ hcoord₃ hxResidueNe + have hn_le_m_cube : n ≤ m ^ 3 := by + have hl₁m : l₁ ≤ m := le_max_left _ _ + have hl₂m : l₂ ≤ m := (le_max_left _ _).trans (le_max_right _ _) + have hl₃m : l₃ ≤ m := (le_max_right _ _).trans (le_max_right _ _) + calc + n ≤ l₁ * Nat.lcm l₂ l₃ := Nat.lcm_le_mul hl₁ (Nat.lcm_pos hl₂ hl₃) + _ ≤ l₁ * (l₂ * l₃) := + Nat.mul_le_mul_left l₁ (Nat.lcm_le_mul hl₂ hl₃) + _ = l₁ * l₂ * l₃ := by ring + _ ≤ m * m * m := Nat.mul_le_mul (Nat.mul_le_mul hl₁m hl₂m) hl₃m + _ = m ^ 3 := by ring + have htotient : n.totient ≤ m ^ 3 := (Nat.totient_le n).trans hn_le_m_cube + have hpMax : p ≤ 20 ^ m ^ 3 := + hpCyclotomic.trans (Nat.pow_le_pow_right (by norm_num) htotient) + exact ⟨W₁, W₂, W₃, htrace₁, htrace₂, htrace₃, hfin₁, hfin₂, hfin₃, + hcoprime₁, hcoprime₂, hcoprime₃, by simpa [l₁, l₂, l₃, m] using hpMax⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean new file mode 100644 index 0000000000..e9a69fbc09 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean @@ -0,0 +1,73 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +/-! +# The real compactness lemma in the opening + +The published opening rules out finite characteristic-zero orbits by first placing all three +normalized trace coordinates in `[-2, 2]`. The elementary real inequality used at that point is +proved here independently of the later cyclotomic lifting argument. +-/ + +namespace BGS.Markoff + +/-- A real normalized Markoff point whose first trace coordinate lies in `[-2, 2]` is the +origin. In particular, the published hypothesis that all three coordinates lie in this interval +is more than is needed. + +The proof uses `2|bc| ≤ b² + c²`. Since the Markoff equation makes `abc` equal to the +nonnegative sum of three squares and `|a| ≤ 2`, it follows that `a² ≤ 0`; the remaining two +squares then vanish as well. -/ +theorem real_normalizedMarkoff_eq_origin_of_firstCoordinate_mem_Icc + (x : NormalizedPoint ℝ) (hx : IsNormalizedMarkoff x) + (hfirst : x.u1 ∈ Set.Icc (-2 : ℝ) 2) : + x = normalizedOrigin := by + rcases x with ⟨a, b, c⟩ + change a ^ 2 + b ^ 2 + c ^ 2 - a * b * c = 0 at hx + have haAbs : |a| ≤ 2 := (abs_le).2 hfirst + have hsumNonnegative : 0 ≤ a ^ 2 + b ^ 2 + c ^ 2 := by positivity + have hproductEq : a * b * c = a ^ 2 + b ^ 2 + c ^ 2 := by linarith + have hproductNonnegative : 0 ≤ a * b * c := hproductEq ▸ hsumNonnegative + have habsProduct : |a * b * c| = a * b * c := abs_of_nonneg hproductNonnegative + have habsBCNonnegative : 0 ≤ |b| * |c| := mul_nonneg (abs_nonneg b) (abs_nonneg c) + have hproductBound : |a * b * c| ≤ 2 * |b| * |c| := by + rw [abs_mul, abs_mul] + nlinarith + have hbcBound : 2 * |b| * |c| ≤ b ^ 2 + c ^ 2 := by + have hsquare := sq_nonneg (|b| - |c|) + have hbAbsSquare : |b| ^ 2 = b ^ 2 := sq_abs b + have hcAbsSquare : |c| ^ 2 = c ^ 2 := sq_abs c + nlinarith + have haSquareNonpositive : a ^ 2 ≤ 0 := by + rw [habsProduct] at hproductBound + nlinarith + have ha : a = 0 := sq_eq_zero_iff.mp (le_antisymm haSquareNonpositive (sq_nonneg a)) + have hbSquareNonpositive : b ^ 2 ≤ 0 := by + rw [ha] at hx + norm_num at hx + nlinarith [sq_nonneg c] + have hb : b = 0 := sq_eq_zero_iff.mp (le_antisymm hbSquareNonpositive (sq_nonneg b)) + have hc : c = 0 := by + rw [ha, hb] at hx + norm_num at hx + exact hx + subst a + subst b + subst c + rfl + +/-- Published Proposition 16's real inequality, stated with all three interval hypotheses. -/ +theorem real_normalizedMarkoff_eq_origin_of_coordinates_mem_Icc + (x : NormalizedPoint ℝ) (hx : IsNormalizedMarkoff x) + (hfirst : x.u1 ∈ Set.Icc (-2 : ℝ) 2) + (_hsecond : x.u2 ∈ Set.Icc (-2 : ℝ) 2) + (_hthird : x.u3 ∈ Set.Icc (-2 : ℝ) 2) : + x = normalizedOrigin := + real_normalizedMarkoff_eq_origin_of_firstCoordinate_mem_Icc x hx hfirst + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean new file mode 100644 index 0000000000..e4289077fd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean @@ -0,0 +1,153 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics + +/-! +# Endgame wrappers for the elementary preliminary route + +The geometry and incidence estimates are the already proved explicit endgame +and cage theorems. This file supplies them with the smaller preliminary-route +numerical certificates. +-/ + +namespace BGS.Markoff + +noncomputable section + +private theorem preliminaryCutoff_seven_le + {p : ℕ} [Fact p.Prime] + (hp : preliminaryStrongApproximationCutoff ≤ p) : 7 ≤ p := by + have hpOne : (1 : ℝ) ≤ p := by + exact_mod_cast (preliminaryCutoff_gt_one.trans_le hp).le + have hrootLe : (p : ℝ) ^ (1 / 8 : ℝ) ≤ p := by + simpa using + Real.rpow_le_self_of_one_le hpOne (by norm_num : (1 / 8 : ℝ) ≤ 1) + have hfiveRoot : (5 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + preliminary_small_fixed_lt_rpow_one_div_eight hp (by norm_num) + have hfive : 5 < p := by + exact_mod_cast hfiveRoot.trans_le hrootLe + have hpSix : p ≠ 6 := by + intro hpEq + subst p + have hprime : Nat.Prime 6 := Fact.out + norm_num at hprime + omega + +/-- At the elementary preliminary cutoff, a large first-coordinate rotation +reaches a maximal split rotation. -/ +theorem exists_preliminary_sameComponent_maximalRotation_of_large_firstCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : preliminaryStrongApproximationCutoff ≤ p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ rotationOrder y.1.u2 = p - 1 := by + let xf : ↑(normalizedFiber1 x.1.u1) := ⟨x.1, x.property, rfl⟩ + obtain ⟨n, hrotation⟩ := + exists_iterate_point_with_maximal_secondRotation_of_explicitInequalities + p ((by norm_num : 5 ≤ 7).trans (preliminaryCutoff_seven_le hp)) + x.1.u1 xf + (fun orbitExponent orbitOrder hmul horder ↦ + preliminary_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + hp hmul horder (by norm_num)) + (fun orbitExponent orbitOrder hmul horder ↦ + preliminary_endgamePrimitiveTrace_explicitInequality_of_card_add_one + hp hmul horder (by norm_num)) + (preliminary_four_lt_rpow_five_div_six hp) hlarge + let y := (normalizedRotate1Surface^[n]) x + refine ⟨y, sameNormalizedComponent_iterate_normalizedRotate1Surface x n, ?_⟩ + rw [show y.1 = (normalizedRotate1^[n]) x.1 by + exact coe_iterate_normalizedRotate1Surface x n] + exact hrotation + +/-- First-coordinate form of the preliminary large-order-to-cage endgame. -/ +theorem exists_preliminary_sameComponent_splitCage_of_large_firstCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : preliminaryStrongApproximationCutoff ≤ p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + obtain ⟨y, hxy, hyOrder⟩ := + exists_preliminary_sameComponent_maximalRotation_of_large_firstCoordinate + hp x hlarge + exact ⟨y, hxy, .second, hyOrder⟩ + +/-- If one coordinate rotation is large, the point reaches the split cage. -/ +theorem exists_preliminary_sameComponent_splitCage_of_some_largeCoordinate + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : preliminaryStrongApproximationCutoff ≤ p) + (x : NormalizedMarkoffSurface (ZMod p)) + (hlarge : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u3) : + ∃ y : NormalizedMarkoffSurface (ZMod p), + SameNormalizedComponent x y ∧ IsInSplitCage p y := by + rcases hlarge with hfirst | hsecond | hthird + · exact + exists_preliminary_sameComponent_splitCage_of_large_firstCoordinate + hp x hfirst + · let x' := normalizedSwap12Surface x + have hx' : SameNormalizedComponent x x' := + sameNormalizedComponent_swap12Surface x + have hlarge' : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, coe_normalizedSwap12Surface] using hsecond + obtain ⟨y, hy, hyOrder⟩ := + exists_preliminary_sameComponent_maximalRotation_of_large_firstCoordinate + hp x' hlarge' + exact ⟨y, sameNormalizedComponent_trans hx' hy, .second, hyOrder⟩ + · let x' := normalizedSwap12Surface (normalizedSwap23Surface x) + have hx23 : SameNormalizedComponent x (normalizedSwap23Surface x) := + sameNormalizedComponent_swap23Surface x + have hx12 : SameNormalizedComponent (normalizedSwap23Surface x) x' := + sameNormalizedComponent_swap12Surface (normalizedSwap23Surface x) + have hlarge' : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x'.1.u1 := by + simpa [x', normalizedSwap12, normalizedSwap23, + coe_normalizedSwap12Surface, coe_normalizedSwap23Surface] using hthird + obtain ⟨y, hy, hyOrder⟩ := + exists_preliminary_sameComponent_maximalRotation_of_large_firstCoordinate + hp x' hlarge' + exact ⟨y, sameNormalizedComponent_trans + (sameNormalizedComponent_trans hx23 hx12) hy, .second, hyOrder⟩ + +/-- The selected split cage is connected at the preliminary cutoff. -/ +theorem preliminary_splitCage_connected + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : preliminaryStrongApproximationCutoff ≤ p) + (x y : NormalizedMarkoffSurface (ZMod p)) + (hx : IsInSplitCage p x) (hy : IsInSplitCage p y) : + SameNormalizedComponent x y := by + exact splitCage_connected_of_explicitInequality p + (preliminaryCutoff_seven_le hp) + (preliminary_cageWitness_explicitInequality hp (by norm_num)) + x y hx hy + +/-- A large-order point lies in the component of any chosen cage base point. -/ +theorem preliminary_sameNormalizedComponent_of_largeOrder_to_splitCage + {p : ℕ} [Fact p.Prime] [Invertible (3 : ZMod p)] + (hp : preliminaryStrongApproximationCutoff ≤ p) + (base x : NormalizedMarkoffSurface (ZMod p)) + (hbase : IsInSplitCage p base) + (hlarge : + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u1 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u2 ∨ + (p : ℝ) ^ (5 / 6 : ℝ) ≤ rotationOrder x.1.u3) : + SameNormalizedComponent base x := by + obtain ⟨y, hxy, hy⟩ := + exists_preliminary_sameComponent_splitCage_of_some_largeCoordinate + hp x hlarge + exact sameNormalizedComponent_trans + (preliminary_splitCage_connected hp base y hbase hy) + (sameNormalizedComponent_symm hxy) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean new file mode 100644 index 0000000000..8e427e996e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean @@ -0,0 +1,581 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound + +/-! +# Elementary numerical certificates for the paper's preliminary route + +The published preliminary argument uses Nicolas' explicit divisor bound to +obtain the threshold `10^532`. Here we formalize the same all-divisors +Corvaja--Zannier route using a completely elementary tenth-moment estimate. +The resulting cutoff is somewhat larger, but every numerical input is checked +inside Lean. +-/ + +namespace BGS.Markoff + +/-- The simultaneous tenth-moment constant for the divisor counts of `p - 1` +and `p + 1`. -/ +def preliminaryDivisorMomentConstant : ℕ := 2 ^ 457 + +theorem preliminaryDivisorMomentConstant_eq : + preliminaryDivisorMomentConstant = 2 ^ 457 := rfl + +theorem preliminaryDivisorMomentConstant_pos : + 0 < preliminaryDivisorMomentConstant := by + rw [preliminaryDivisorMomentConstant_eq] + positivity + +/-- Sealed data for the elementary preliminary-route cutoff. -/ +opaque preliminaryStrongApproximationCutoffData : + {n : ℕ // n = 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1} := + ⟨2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1, rfl⟩ + +/-- A fully elementary replacement for the paper's `10^532` threshold. -/ +def preliminaryStrongApproximationCutoff : ℕ := + preliminaryStrongApproximationCutoffData.1 + +theorem preliminaryStrongApproximationCutoff_eq : + preliminaryStrongApproximationCutoff = + 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1 := + preliminaryStrongApproximationCutoffData.2 + +theorem preliminaryCutoff_gt_one : + 1 < preliminaryStrongApproximationCutoff := by + rw [preliminaryStrongApproximationCutoff_eq] + have h : 0 < 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 := + Nat.mul_pos (pow_pos (by norm_num) _) (pow_pos (by norm_num) _) + omega + +theorem preliminaryCutoff_constant_lt + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) : + 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 < p := by + rw [preliminaryStrongApproximationCutoff_eq] at hp + omega + +/-- The two divisor counts needed by the preliminary route satisfy one +simultaneous tenth-moment estimate. -/ +theorem preliminary_divisor_sum_pow_ten_le + {p : ℕ} (hp : 2 ≤ p) : + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 10 ≤ + preliminaryDivisorMomentConstant * p := by + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + have hminus := + BGS.NumberTheory.card_divisors_pow_ten_le_preliminary_constant_mul + (p - 1) hminusNe + have hplus := + BGS.NumberTheory.card_divisors_pow_ten_le_preliminary_constant_mul + (p + 1) hplusNe + calc + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 10 ≤ + 2 ^ (10 - 1) * + ((p - 1).divisors.card ^ 10 + (p + 1).divisors.card ^ 10) := + add_pow_le (Nat.zero_le _) (Nat.zero_le _) 10 + _ ≤ 2 ^ 9 * + (2 ^ 447 * (p - 1) + 2 ^ 447 * (p + 1)) := by + norm_num + gcongr + _ = preliminaryDivisorMomentConstant * p := by + rw [preliminaryDivisorMomentConstant_eq] + have hsum : p - 1 + (p + 1) = 2 * p := by omega + have hpow : 2 ^ 9 * 2 ^ 447 * 2 = 2 ^ 457 := by + have h447 : 2 ^ 447 * 2 = 2 ^ 448 := by + simpa using (pow_succ 2 447).symm + calc + 2 ^ 9 * 2 ^ 447 * 2 = 2 ^ 9 * (2 ^ 447 * 2) := by ring + _ = 2 ^ 9 * 2 ^ 448 := by rw [h447] + _ = 2 ^ (9 + 448) := (pow_add 2 9 448).symm + _ = 2 ^ 457 := by norm_num + calc + 2 ^ 9 * (2 ^ 447 * (p - 1) + 2 ^ 447 * (p + 1)) = + 2 ^ 9 * 2 ^ 447 * (p - 1 + (p + 1)) := by ring + _ = 2 ^ 9 * 2 ^ 447 * (2 * p) := by rw [hsum] + _ = (2 ^ 9 * 2 ^ 447 * 2) * p := by ring + _ = 2 ^ 457 * p := by rw [hpow] + +private theorem preliminary_moment_pow_eight_le_cutoff_sq : + preliminaryDivisorMomentConstant ^ 8 ≤ + (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 2 := by + rw [preliminaryDivisorMomentConstant_eq] + calc + (2 ^ 457) ^ 8 = 2 ^ 3656 := by + rw [show (3656 : ℕ) = 457 * 8 by norm_num, pow_mul] + _ ≤ 2 ^ 3666 := Nat.pow_le_pow_right (by norm_num) (by norm_num) + _ = (2 ^ 1833) ^ 2 := by + rw [show (3666 : ℕ) = 1833 * 2 by norm_num, pow_mul] + _ ≤ (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 2 := by + gcongr + exact Nat.le_mul_of_pos_right _ (by positivity) + +private theorem preliminary_middle_coefficient_le_cutoff_pow_four : + 48 ^ 60 * preliminaryDivisorMomentConstant ^ 6 ≤ + (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 4 := by + rw [preliminaryDivisorMomentConstant_eq] + have htwo : (2 ^ 457) ^ 6 ≤ 2 ^ 7332 := by + calc + (2 ^ 457) ^ 6 = 2 ^ 2742 := by + rw [show (2742 : ℕ) = 457 * 6 by norm_num, pow_mul] + _ ≤ 2 ^ 7332 := Nat.pow_le_pow_right (by norm_num) (by norm_num) + have hbase : 48 ^ 60 ≤ (48 ^ 3 + 1) ^ 40 := by + calc + 48 ^ 60 = (48 ^ 3) ^ 20 := by + rw [show (60 : ℕ) = 3 * 20 by norm_num, pow_mul] + _ ≤ (48 ^ 3 + 1) ^ 20 := Nat.pow_le_pow_left (by omega) _ + _ ≤ (48 ^ 3 + 1) ^ 40 := + Nat.pow_le_pow_right (by positivity) (by norm_num) + calc + 48 ^ 60 * (2 ^ 457) ^ 6 = (2 ^ 457) ^ 6 * 48 ^ 60 := by ring + _ ≤ 2 ^ 7332 * (48 ^ 3 + 1) ^ 40 := Nat.mul_le_mul htwo hbase + _ = (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 4 := by + norm_num [mul_pow, ← pow_mul] + +private theorem preliminary_endgame_coefficient_le_cutoff_pow_four : + 68 ^ 30 * preliminaryDivisorMomentConstant ^ 6 ≤ + (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 4 := by + rw [preliminaryDivisorMomentConstant_eq] + have htwo : (2 ^ 457) ^ 6 ≤ 2 ^ 7332 := by + calc + (2 ^ 457) ^ 6 = 2 ^ 2742 := by + rw [show (2742 : ℕ) = 457 * 6 by norm_num, pow_mul] + _ ≤ 2 ^ 7332 := Nat.pow_le_pow_right (by norm_num) (by norm_num) + have hbase : 68 ^ 30 ≤ (48 ^ 3 + 1) ^ 40 := by + calc + 68 ^ 30 ≤ (48 ^ 3 + 1) ^ 30 := + Nat.pow_le_pow_left (by norm_num) _ + _ ≤ (48 ^ 3 + 1) ^ 40 := + Nat.pow_le_pow_right (by positivity) (by norm_num) + calc + 68 ^ 30 * (2 ^ 457) ^ 6 = (2 ^ 457) ^ 6 * 68 ^ 30 := by ring + _ ≤ 2 ^ 7332 * (48 ^ 3 + 1) ^ 40 := Nat.mul_le_mul htwo hbase + _ = (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 4 := by + norm_num [mul_pow, ← pow_mul] + +private theorem preliminary_fixed_pow_eight_le_cutoff : + 100522 ^ 8 ≤ 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 := by + calc + 100522 ^ 8 ≤ (2 ^ 17) ^ 8 := Nat.pow_le_pow_left (by norm_num) _ + _ = 2 ^ 136 := by + rw [show (136 : ℕ) = 17 * 8 by norm_num, pow_mul] + _ ≤ 2 ^ 1833 := Nat.pow_le_pow_right (by norm_num) (by norm_num) + _ ≤ 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 := + Nat.le_mul_of_pos_right _ (pow_pos (by norm_num) _) +private theorem preliminary_lowOrder_coefficient_eq_cutoff_sq : + 2 ^ 10 * (48 ^ 3 + 1) ^ 20 * preliminaryDivisorMomentConstant ^ 8 = + (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 2 := by + rw [preliminaryDivisorMomentConstant_eq] + have htwo457 : (2 ^ 457) ^ 8 = 2 ^ 3656 := by + rw [show (3656 : ℕ) = 457 * 8 by norm_num, pow_mul] + have htwo : 2 ^ 10 * (2 ^ 457) ^ 8 = 2 ^ 3666 := by + rw [htwo457] + exact (pow_add 2 10 3656).symm.trans (by norm_num) + have htwo' : (2 ^ 1833) ^ 2 = 2 ^ 3666 := by + rw [show (3666 : ℕ) = 1833 * 2 by norm_num, pow_mul] + have hbase : + (48 ^ 3 + 1) ^ 20 = ((48 ^ 3 + 1) ^ 10) ^ 2 := by + rw [show (20 : ℕ) = 10 * 2 by norm_num, pow_mul] + calc + 2 ^ 10 * (48 ^ 3 + 1) ^ 20 * (2 ^ 457) ^ 8 = + (2 ^ 10 * (2 ^ 457) ^ 8) * (48 ^ 3 + 1) ^ 20 := by ring + _ = 2 ^ 3666 * (48 ^ 3 + 1) ^ 20 := by rw [htwo] + _ = (2 ^ 1833) ^ 2 * ((48 ^ 3 + 1) ^ 10) ^ 2 := by + rw [htwo', hbase] + _ = (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 2 := by rw [mul_pow] +/-- The simultaneous divisor count is smaller than the eighth root of `p`. -/ +theorem preliminary_divisor_sum_lt_rpow_one_div_eight + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) : + (((p - 1).divisors.card + (p + 1).divisors.card : ℕ) : ℝ) < + (p : ℝ) ^ (1 / 8 : ℝ) := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let Q := 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + have hpTwo : 2 ≤ p := by + have := preliminaryCutoff_gt_one.trans_le hp + omega + have hmoment : T ^ 10 ≤ preliminaryDivisorMomentConstant * p := by + simpa [T] using preliminary_divisor_sum_pow_ten_le hpTwo + have hQ : Q < p := by + simpa [Q] using preliminaryCutoff_constant_lt hp + have hpowNat : T ^ 80 < p ^ 10 := by + calc + T ^ 80 = (T ^ 10) ^ 8 := by + rw [show (80 : ℕ) = 10 * 8 by norm_num, pow_mul] + _ ≤ (preliminaryDivisorMomentConstant * p) ^ 8 := by gcongr + _ = preliminaryDivisorMomentConstant ^ 8 * p ^ 8 := by rw [mul_pow] + _ ≤ Q ^ 2 * p ^ 8 := by + exact Nat.mul_le_mul_right _ <| by + simpa [Q] using preliminary_moment_pow_eight_le_cutoff_sq + _ < p ^ 2 * p ^ 8 := by gcongr + _ = p ^ 10 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : (T : ℝ) ^ 80 < (p : ℝ) ^ 10 := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 80 = (p : ℝ) ^ 10 := by + calc + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 80 = + (p : ℝ) ^ ((1 / 8 : ℝ) * 80) := + (Real.rpow_mul_natCast hpNonnegative (1 / 8 : ℝ) 80).symm + _ = (p : ℝ) ^ 10 := by norm_num + change (T : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) + apply lt_of_pow_lt_pow_left₀ 80 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- The coefficient-48 all-divisors term is smaller than the sixth root of +`p`, as required by the preliminary middle game. -/ +theorem preliminary_corvajaZannier_divisor_term_lt_rpow_one_div_six + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) : ℕ) < + (p : ℝ) ^ (1 / 6 : ℝ) := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let Q := 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + have hpTwo : 2 ≤ p := by + have := preliminaryCutoff_gt_one.trans_le hp + omega + have hmoment : T ^ 10 ≤ preliminaryDivisorMomentConstant * p := by + simpa [T] using preliminary_divisor_sum_pow_ten_le hpTwo + have hQ : Q < p := by + simpa [Q] using preliminaryCutoff_constant_lt hp + have hpowNat : (48 * T) ^ 60 < p ^ 10 := by + calc + (48 * T) ^ 60 = 48 ^ 60 * (T ^ 10) ^ 6 := by ring + _ ≤ 48 ^ 60 * (preliminaryDivisorMomentConstant * p) ^ 6 := by gcongr + _ = (48 ^ 60 * preliminaryDivisorMomentConstant ^ 6) * p ^ 6 := by + rw [mul_pow] + ring + _ ≤ Q ^ 4 * p ^ 6 := by + exact Nat.mul_le_mul_right _ <| by + simpa [Q] using preliminary_middle_coefficient_le_cutoff_pow_four + _ < p ^ 4 * p ^ 6 := by gcongr + _ = p ^ 10 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((48 * T : ℕ) : ℝ) ^ 60 < (p : ℝ) ^ 10 := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 60 = (p : ℝ) ^ 10 := by + calc + ((p : ℝ) ^ (1 / 6 : ℝ)) ^ 60 = + (p : ℝ) ^ ((1 / 6 : ℝ) * 60) := + (Real.rpow_mul_natCast hpNonnegative (1 / 6 : ℝ) 60).symm + _ = (p : ℝ) ^ 10 := by norm_num + norm_num only [corvajaZannierCorollaryTwoSafeCoefficient] + change ((48 * T : ℕ) : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) + apply lt_of_pow_lt_pow_left₀ 60 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- The weighted divisor square is smaller than the one-third power needed +by the primitive-trace endgame. -/ +theorem preliminary_weighted_divisor_sum_sq_lt_rpow_one_div_three + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) : + ((68 * ((p - 1).divisors.card + (p + 1).divisors.card) ^ 2 : ℕ) : ℝ) < + (p : ℝ) ^ (1 / 3 : ℝ) := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let Q := 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + have hpTwo : 2 ≤ p := by + have := preliminaryCutoff_gt_one.trans_le hp + omega + have hmoment : T ^ 10 ≤ preliminaryDivisorMomentConstant * p := by + simpa [T] using preliminary_divisor_sum_pow_ten_le hpTwo + have hQ : Q < p := by + simpa [Q] using preliminaryCutoff_constant_lt hp + have hpowNat : (68 * T ^ 2) ^ 30 < p ^ 10 := by + calc + (68 * T ^ 2) ^ 30 = 68 ^ 30 * (T ^ 10) ^ 6 := by ring + _ ≤ 68 ^ 30 * (preliminaryDivisorMomentConstant * p) ^ 6 := by gcongr + _ = (68 ^ 30 * preliminaryDivisorMomentConstant ^ 6) * p ^ 6 := by + rw [mul_pow] + ring + _ ≤ Q ^ 4 * p ^ 6 := by + exact Nat.mul_le_mul_right _ <| by + simpa [Q] using preliminary_endgame_coefficient_le_cutoff_pow_four + _ < p ^ 4 * p ^ 6 := by gcongr + _ = p ^ 10 := by ring + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : ((68 * T ^ 2 : ℕ) : ℝ) ^ 30 < (p : ℝ) ^ 10 := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 3 : ℝ)) ^ 30 = (p : ℝ) ^ 10 := by + calc + ((p : ℝ) ^ (1 / 3 : ℝ)) ^ 30 = + (p : ℝ) ^ ((1 / 3 : ℝ) * 30) := + (Real.rpow_mul_natCast hpNonnegative (1 / 3 : ℝ) 30).symm + _ = (p : ℝ) ^ 10 := by norm_num + change ((68 * T ^ 2 : ℕ) : ℝ) < (p : ℝ) ^ (1 / 3 : ℝ) + apply lt_of_pow_lt_pow_left₀ 30 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +/-- Every fixed coefficient used in the cage is smaller than the eighth root +of `p`. -/ +theorem preliminary_small_fixed_lt_rpow_one_div_eight + {p fixed : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) + (hfixed : fixed ≤ 100522) : + (fixed : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := by + have hpowNat : fixed ^ 8 < p := by + calc + fixed ^ 8 ≤ 100522 ^ 8 := Nat.pow_le_pow_left hfixed _ + _ ≤ 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 := + preliminary_fixed_pow_eight_le_cutoff + _ < p := preliminaryCutoff_constant_lt hp + have hpNonnegative : (0 : ℝ) ≤ p := by positivity + have hpowReal : (fixed : ℝ) ^ 8 < (p : ℝ) := by + exact_mod_cast hpowNat + have hrootPow : + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 8 = (p : ℝ) := by + calc + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 8 = + (p : ℝ) ^ ((1 / 8 : ℝ) * 8) := + (Real.rpow_mul_natCast hpNonnegative (1 / 8 : ℝ) 8).symm + _ = (p : ℝ) := by norm_num + apply lt_of_pow_lt_pow_left₀ 8 (Real.rpow_nonneg hpNonnegative _) + rw [hrootPow] + exact hpowReal + +private theorem preliminary_prime_one_lt + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) : + (1 : ℝ) < p := by + exact_mod_cast preliminaryCutoff_gt_one.trans_le hp + +private theorem preliminary_rpow_lt_self_of_exponent_lt_one + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) + {a : ℝ} (ha : a < 1) : + (p : ℝ) ^ a < p := by + simpa only [Real.rpow_one] using + Real.rpow_lt_rpow_of_exponent_lt (preliminary_prime_one_lt hp) ha + +/-- Assembly-facing preliminary middle-game certificate. -/ +theorem preliminary_middleGame_corvajaZannier_linearBound + {p currentOrder : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) + (hUpper : (currentOrder : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ)) : + corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) * currentOrder < p := by + let A : ℕ := corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card) + have hpRealPos : (0 : ℝ) < p := + (preliminary_prime_one_lt hp).trans' zero_lt_one + have hA : (A : ℝ) < (p : ℝ) ^ (1 / 6 : ℝ) := by + simpa [A] using + preliminary_corvajaZannier_divisor_term_lt_rpow_one_div_six hp + have hLinearPower : + (p : ℝ) ^ (1 / 6 : ℝ) * (p : ℝ) ^ (5 / 6 : ℝ) = (p : ℝ) := by + rw [← Real.rpow_add hpRealPos] + norm_num + have hLinear : (A : ℝ) * currentOrder < p := by + calc + (A : ℝ) * currentOrder ≤ + (p : ℝ) ^ (1 / 6 : ℝ) * currentOrder := + mul_le_mul_of_nonneg_right hA.le (Nat.cast_nonneg currentOrder) + _ < (p : ℝ) ^ (1 / 6 : ℝ) * (p : ℝ) ^ (5 / 6 : ℝ) := + mul_lt_mul_of_pos_left hUpper (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) := hLinearPower + exact_mod_cast hLinear + +/-- Preliminary primitive-trace inclusion--exclusion certificate. -/ +theorem preliminary_endgamePrimitiveTrace_explicitInequality + {p orbitExponent coefficient : ℕ} + (hp : preliminaryStrongApproximationCutoff ≤ p) + (horbit : (orbitExponent : ℝ) ≤ 2 * (p : ℝ) ^ (1 / 6 : ℝ)) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + have hpRealPos : (0 : ℝ) < p := + (preliminary_prime_one_lt hp).trans' zero_lt_one + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ (T : ℝ) := by + exact_mod_cast (show (p - 1).divisors.card ≤ T by + dsimp [T] + omega) + have hweighted : (68 : ℝ) * (T : ℝ) ^ 2 < + (p : ℝ) ^ (1 / 3 : ℝ) := by + simpa [T] using + preliminary_weighted_divisor_sum_sq_lt_rpow_one_div_three hp + calc + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + (2 * (p : ℝ) ^ (1 / 6 : ℝ)) * (T : ℝ) ^ 2 * + (34 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = (68 * (T : ℝ) ^ 2) * + ((p : ℝ) ^ (1 / 6 : ℝ) * Real.sqrt (p : ℝ)) := by ring + _ < (p : ℝ) ^ (1 / 3 : ℝ) * + ((p : ℝ) ^ (1 / 6 : ℝ) * Real.sqrt (p : ℝ)) := by + exact mul_lt_mul_of_pos_right hweighted <| + mul_pos (Real.rpow_pos_of_pos hpRealPos _) (Real.sqrt_pos.2 hpRealPos) + _ = (p : ℝ) := by + rw [Real.sqrt_eq_rpow, ← Real.rpow_add hpRealPos, + ← Real.rpow_add hpRealPos] + norm_num + +theorem preliminary_endgamePrimitiveTrace_explicitInequality_of_card_sub_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : preliminaryStrongApproximationCutoff ≤ p) + (hmul : orbitExponent * orbitOrder = p - 1) + (horder : (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply preliminary_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := + Nat.zero_lt_one.trans (preliminaryCutoff_gt_one.trans_le hp) + have horbit := orbitExponent_le_rpow_of_mul_order_eq_card_sub_one + p orbitExponent orbitOrder (δ := (1 / 3 : ℝ)) hpNat hmul (by + convert horder using 1 <;> norm_num) + calc + (orbitExponent : ℝ) ≤ (p : ℝ) ^ (1 / 6 : ℝ) := by + convert horbit using 1 <;> norm_num + _ ≤ 2 * (p : ℝ) ^ (1 / 6 : ℝ) := by + nlinarith [Real.rpow_nonneg (Nat.cast_nonneg p) (1 / 6 : ℝ)] + +theorem preliminary_endgamePrimitiveTrace_explicitInequality_of_card_add_one + {p orbitExponent orbitOrder coefficient : ℕ} + (hp : preliminaryStrongApproximationCutoff ≤ p) + (hmul : orbitExponent * orbitOrder = p + 1) + (horder : (p : ℝ) ^ (5 / 6 : ℝ) ≤ orbitOrder) + (hcoefficient : coefficient ≤ 34) : + (orbitExponent : ℝ) * ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + apply preliminary_endgamePrimitiveTrace_explicitInequality hp ?_ hcoefficient + have hpNat : 0 < p := + Nat.zero_lt_one.trans (preliminaryCutoff_gt_one.trans_le hp) + have horbit := orbitExponent_le_two_mul_rpow_of_mul_order_eq_card_add_one + p orbitExponent orbitOrder (δ := (1 / 3 : ℝ)) hpNat hmul (by + convert horder using 1 <;> norm_num) + convert horbit using 1 <;> norm_num + +theorem preliminary_four_lt_rpow_five_div_six + {p : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) : + (4 : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) := by + have hfour : (4 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + preliminary_small_fixed_lt_rpow_one_div_eight hp (by norm_num) + exact hfour.trans <| + Real.rpow_lt_rpow_of_exponent_lt (preliminary_prime_one_lt hp) (by norm_num) + +/-- Preliminary cage inequality with the existing point-count coefficient. -/ +theorem preliminary_cageWitness_explicitInequality + {p coefficient : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) + (hcoefficient : coefficient ≤ 100522) : + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) < p := by + have hpRealPos : (0 : ℝ) < p := + (preliminary_prime_one_lt hp).trans' zero_lt_one + have hpRealNonneg : (0 : ℝ) ≤ p := hpRealPos.le + have hsum := preliminary_divisor_sum_lt_rpow_one_div_eight hp + have hdivisor : ((p - 1).divisors.card : ℝ) ≤ + (p : ℝ) ^ (1 / 8 : ℝ) := by + norm_num only [Nat.cast_add] at hsum + exact (le_add_of_nonneg_right (Nat.cast_nonneg _)).trans hsum.le + have hfixed : (100522 : ℝ) < (p : ℝ) ^ (1 / 8 : ℝ) := + preliminary_small_fixed_lt_rpow_one_div_eight hp (by norm_num) + have hsqrt : Real.sqrt (p : ℝ) = (p : ℝ) ^ (4 / 8 : ℝ) := by + rw [Real.sqrt_eq_rpow] + congr 1 + norm_num + have hpower : ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 2 * Real.sqrt (p : ℝ) = + (p : ℝ) ^ (6 / 8 : ℝ) := by + rw [hsqrt, ← Real.rpow_mul_natCast hpRealNonneg, + ← Real.rpow_add hpRealPos] + congr 1 + norm_num + calc + ((p - 1).divisors.card : ℝ) ^ 2 * + ((coefficient : ℝ) * Real.sqrt (p : ℝ)) ≤ + ((p : ℝ) ^ (1 / 8 : ℝ)) ^ 2 * + (100522 * Real.sqrt (p : ℝ)) := by + gcongr + exact_mod_cast hcoefficient + _ = 100522 * (p : ℝ) ^ (6 / 8 : ℝ) := by + rw [← hpower] + ring + _ < (p : ℝ) ^ (1 / 8 : ℝ) * (p : ℝ) ^ (6 / 8 : ℝ) := by + exact mul_lt_mul_of_pos_right hfixed (Real.rpow_pos_of_pos hpRealPos _) + _ = (p : ℝ) ^ (7 / 8 : ℝ) := by + rw [← Real.rpow_add hpRealPos] + congr 1 + norm_num + _ < p := + preliminary_rpow_lt_self_of_exponent_lt_one hp (by norm_num) + +/-- The low-order Corvaja--Zannier cube contradiction, now driven by the +elementary tenth moment. -/ +theorem preliminary_lowOrder_divisorSensitive_cube + {p d : ℕ} (hp : preliminaryStrongApproximationCutoff ≤ p) + (hdPos : 0 < d) + (hpLe : p ≤ 2 * (2 + d * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 2) : + (corvajaZannierCorollaryTwoSafeCoefficient * + ((p - 1).divisors.card + (p + 1).divisors.card)) ^ 3 < d := by + let T := (p - 1).divisors.card + (p + 1).divisors.card + let B := 48 ^ 3 + 1 + let Q := 2 ^ 1833 * B ^ 10 + have hpTwo : 2 ≤ p := by + have := preliminaryCutoff_gt_one.trans_le hp + omega + have hminusNonempty : (p - 1).divisors.Nonempty := + (Nat.nonempty_divisors).2 (by omega) + have hplusNonempty : (p + 1).divisors.Nonempty := + (Nat.nonempty_divisors).2 (by omega) + have hTtwo : 2 ≤ T := by + have hm : 0 < (p - 1).divisors.card := + Finset.card_pos.mpr hminusNonempty + have hp' : 0 < (p + 1).divisors.card := + Finset.card_pos.mpr hplusNonempty + dsimp [T] + omega + have hTfour : 2 ≤ T ^ 4 := by + calc + 2 ≤ T := hTtwo + _ = T * 1 := by ring + _ ≤ T * T ^ 3 := by + gcongr + exact Nat.one_le_pow 3 T (by omega) + _ = T ^ 4 := by ring + change (48 * T) ^ 3 < d + by_contra hcube + have hdUpper : d ≤ (48 * T) ^ 3 := by omega + have hinner : 2 + d * T ≤ B * T ^ 4 := by + calc + 2 + d * T ≤ T ^ 4 + d * T := Nat.add_le_add_right hTfour _ + _ ≤ T ^ 4 + (48 * T) ^ 3 * T := by gcongr + _ = B * T ^ 4 := by + dsimp [B] + ring + have hpLeCoarse : p ≤ 2 * B ^ 2 * T ^ 8 := by + calc + p ≤ 2 * (2 + d * T) ^ 2 := by simpa [T] using hpLe + _ ≤ 2 * (B * T ^ 4) ^ 2 := by gcongr + _ = 2 * B ^ 2 * T ^ 8 := by ring + have hmoment : T ^ 10 ≤ preliminaryDivisorMomentConstant * p := by + simpa [T] using preliminary_divisor_sum_pow_ten_le hpTwo + have hpPowLe : + p ^ 10 ≤ Q ^ 2 * p ^ 8 := by + calc + p ^ 10 ≤ (2 * B ^ 2 * T ^ 8) ^ 10 := + Nat.pow_le_pow_left hpLeCoarse _ + _ = 2 ^ 10 * B ^ 20 * (T ^ 10) ^ 8 := by ring + _ ≤ 2 ^ 10 * B ^ 20 * + (preliminaryDivisorMomentConstant * p) ^ 8 := by gcongr + _ = (2 ^ 10 * B ^ 20 * + preliminaryDivisorMomentConstant ^ 8) * p ^ 8 := by ring + _ = Q ^ 2 * p ^ 8 := by + change (2 ^ 10 * (48 ^ 3 + 1) ^ 20 * + preliminaryDivisorMomentConstant ^ 8) * p ^ 8 = + (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 2 * p ^ 8 + exact congrArg (fun n : ℕ => n * p ^ 8) + preliminary_lowOrder_coefficient_eq_cutoff_sq + have hQ : Q < p := by + simpa [Q, B] using preliminaryCutoff_constant_lt hp + have hstrict : Q ^ 2 * p ^ 8 < p ^ 10 := by + calc + Q ^ 2 * p ^ 8 < p ^ 2 * p ^ 8 := by gcongr + _ = p ^ 10 := by ring + exact (not_lt_of_ge hpPowLe) hstrict + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean new file mode 100644 index 0000000000..1d84422776 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean @@ -0,0 +1,39 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean new file mode 100644 index 0000000000..f15e70468a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean @@ -0,0 +1,129 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +import Mathlib.AlgebraicGeometry.Normalization + +/-! +# Affine normalization of the weighted trace cover + +This module constructs the actual relative normalization of the irreducible affine trace-cover +scheme inside its fraction field. It connects the proved polynomial irreducibility theorem to +Mathlib's scheme-theoretic normalization construction. + +This is only the affine normalization. The endgame still requires compatible normalizations of +the other three biprojective charts, their gluing into a proper curve, the boundary-branch labels, +and the genus and Hasse--Weil estimates. +-/ + +namespace BGS.Markoff + +open CategoryTheory +open AlgebraicGeometry + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Coordinate ring of the weighted denominator-cleared affine trace cover. -/ +abbrev WeightedSplitTraceAffineCoordinateRing (alpha beta : K) (d e : ℕ) := + MvPolynomial (Fin 2) K ⧸ Ideal.span {splitTraceCoverPolynomial alpha beta d e} + +/-- Irreducibility of the defining polynomial makes the affine coordinate ring a domain. -/ +theorem weightedSplitTraceAffineCoordinateRing_isDomain + (alpha beta : K) (d e : ℕ) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := by + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial alpha beta d e} + have hprime : I.IsPrime := + (Ideal.span_singleton_prime h.ne_zero).mpr h.prime + exact (Ideal.Quotient.isDomain_iff_prime I).mpr hprime + +/-- The generic-point morphism from the fraction field to the irreducible affine curve. -/ +def weightedSplitTraceAffineGenericPointMorphism + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e)] : + Spec (CommRingCat.of + (FractionRing (WeightedSplitTraceAffineCoordinateRing alpha beta d e))) ⟶ + Spec (CommRingCat.of (WeightedSplitTraceAffineCoordinateRing alpha beta d e)) := + Spec.map (CommRingCat.ofHom + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (FractionRing (WeightedSplitTraceAffineCoordinateRing alpha beta d e)))) + +/-- The relative normalization of the affine trace cover inside its fraction field. -/ +def weightedSplitTraceAffineNormalization + (alpha beta : K) (d e : ℕ) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : Scheme := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + exact (weightedSplitTraceAffineGenericPointMorphism alpha beta d e).normalization + +/-- The integral morphism from the affine normalization to the original affine curve. -/ +def weightedSplitTraceAffineNormalizationToCurve + (alpha beta : K) (d e : ℕ) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + weightedSplitTraceAffineNormalization alpha beta d e h ⟶ + Spec (CommRingCat.of + (WeightedSplitTraceAffineCoordinateRing alpha beta d e)) := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + exact (weightedSplitTraceAffineGenericPointMorphism alpha beta d e).fromNormalization + +instance weightedSplitTraceAffineNormalizationToCurve_isIntegral + (alpha beta : K) (d e : ℕ) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + IsIntegralHom (weightedSplitTraceAffineNormalizationToCurve alpha beta d e h) := by + dsimp [weightedSplitTraceAffineNormalizationToCurve, + weightedSplitTraceAffineNormalization] + infer_instance + +instance weightedSplitTraceAffineNormalization_isIntegral + (alpha beta : K) (d e : ℕ) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + IsIntegral (weightedSplitTraceAffineNormalization alpha beta d e h) := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + dsimp [weightedSplitTraceAffineNormalization] + infer_instance + +instance weightedSplitTraceAffineNormalization_isReduced + (alpha beta : K) (d e : ℕ) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + IsReduced (weightedSplitTraceAffineNormalization alpha beta d e h) := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + dsimp [weightedSplitTraceAffineNormalization] + infer_instance + +/-- The actual geometric affine normalization in the paper's positive-exponent range, obtained by +combining absolute irreducibility with the relative-normalization construction. -/ +def weightedSplitTraceGeometricAffineNormalization + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (d e : ℕ) (hd : 0 < d) (he : 0 < e) (heChar : (e : K) ≠ 0) : Scheme := by + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + have hirred := splitTraceCoverPolynomial_absolutelyIrreducible_of_positiveExponents + alpha beta halpha hbeta hnondegenerate e d he hd heChar + rw [map_splitTraceCoverPolynomial phi alpha beta d e] at hirred + exact weightedSplitTraceAffineNormalization (phi alpha) (phi beta) d e hirred + +/-- The two affine normalizations needed for all four standard charts of the biprojective closure. +The first-coordinate inversion preserves the weights, while the second-coordinate inversion swaps +them. This pair is not yet a glued projective scheme. -/ +def weightedSplitTraceGeometricChartNormalizations + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (d e : ℕ) (hd : 0 < d) (he : 0 < e) (heChar : (e : K) ≠ 0) : + Scheme × Scheme := + (weightedSplitTraceGeometricAffineNormalization alpha beta halpha hbeta + hnondegenerate d e hd he heChar, + weightedSplitTraceGeometricAffineNormalization beta alpha hbeta halpha + (by simpa [mul_comm] using hnondegenerate) d e hd he heChar) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean new file mode 100644 index 0000000000..182f5ba10c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean @@ -0,0 +1,471 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +import Mathlib.FieldTheory.KummerExtension + +/-! +# Explicit biprojective closure of the trace cover + +This uses `Option K` as the standard affine chart plus the point at infinity of `P^1(K)`. +It controls the raw closure in `P^1 × P^1`; it does not identify that generally singular closure +with its normalization. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The bidegree-`(2d,2e)` homogenization of the cleared trace-cover polynomial. -/ +def splitTraceBihomogeneousValue (alpha beta : K) (d e : ℕ) + (X₀ X₁ Y₀ Y₁ : K) : K := + alpha * X₀ ^ d * X₁ ^ d * Y₀ ^ (2 * e) + + beta * X₀ ^ d * X₁ ^ d * Y₁ ^ (2 * e) - + X₀ ^ (2 * d) * Y₀ ^ e * Y₁ ^ e - + X₁ ^ (2 * d) * Y₀ ^ e * Y₁ ^ e + +/-- Canonical homogeneous coordinates for the affine chart and infinity of `P^1(K)`. -/ +def projectiveLineChartCoordinates : Option K → K × K + | some x => (x, 1) + | none => (1, 0) + +/-- Evaluation of the raw biprojective closure on canonical chart representatives. -/ +def splitTraceBiprojectiveValue (alpha beta : K) (d e : ℕ) + (z : Option K × Option K) : K := + let X := projectiveLineChartCoordinates z.1 + let Y := projectiveLineChartCoordinates z.2 + splitTraceBihomogeneousValue alpha beta d e X.1 X.2 Y.1 Y.2 + +theorem splitTraceBiprojectiveValue_affine (alpha beta : K) (d e : ℕ) (x y : K) : + splitTraceBiprojectiveValue alpha beta d e (some x, some y) = + MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial alpha beta d e) := by + rw [eval_splitTraceCoverPolynomial] + simp [splitTraceBiprojectiveValue, projectiveLineChartCoordinates, + splitTraceBihomogeneousValue] + +theorem splitTraceBiprojectiveValue_infinity_affine + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (y : K) : + splitTraceBiprojectiveValue alpha beta d e (none, some y) = -(y ^ e) := by + have hd0 : d ≠ 0 := hd.ne' + have h2d0 : 2 * d ≠ 0 := by omega + simp [splitTraceBiprojectiveValue, projectiveLineChartCoordinates, + splitTraceBihomogeneousValue, hd0, h2d0] + +theorem splitTraceBiprojectiveValue_affine_infinity + (alpha beta : K) (d e : ℕ) (he : 0 < e) (x : K) : + splitTraceBiprojectiveValue alpha beta d e (some x, none) = alpha * x ^ d := by + have he0 : e ≠ 0 := he.ne' + have h2e0 : 2 * e ≠ 0 := by omega + simp [splitTraceBiprojectiveValue, projectiveLineChartCoordinates, + splitTraceBihomogeneousValue, he0, h2e0] + +theorem splitTraceBiprojectiveValue_infinity_infinity + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) : + splitTraceBiprojectiveValue alpha beta d e (none, none) = 0 := by + have hd0 : d ≠ 0 := hd.ne' + have he0 : e ≠ 0 := he.ne' + have h2d0 : 2 * d ≠ 0 := by omega + have h2e0 : 2 * e ≠ 0 := by omega + simp [splitTraceBiprojectiveValue, projectiveLineChartCoordinates, + splitTraceBihomogeneousValue, hd0, he0, h2d0, h2e0] + +/-- The same bihomogeneous equation as a four-variable polynomial, ordered as +`X₀, X₁, Y₀, Y₁`. -/ +def splitTraceBihomogeneousPolynomial (alpha beta : K) (d e : ℕ) : + MvPolynomial (Fin 4) K := + MvPolynomial.C alpha * MvPolynomial.X 0 ^ d * MvPolynomial.X 1 ^ d * + MvPolynomial.X 2 ^ (2 * e) + + MvPolynomial.C beta * MvPolynomial.X 0 ^ d * MvPolynomial.X 1 ^ d * + MvPolynomial.X 3 ^ (2 * e) - + MvPolynomial.X 0 ^ (2 * d) * MvPolynomial.X 2 ^ e * MvPolynomial.X 3 ^ e - + MvPolynomial.X 1 ^ (2 * d) * MvPolynomial.X 2 ^ e * MvPolynomial.X 3 ^ e + +theorem eval_splitTraceBihomogeneousPolynomial + (alpha beta : K) (d e : ℕ) (X₀ X₁ Y₀ Y₁ : K) : + MvPolynomial.eval ![X₀, X₁, Y₀, Y₁] + (splitTraceBihomogeneousPolynomial alpha beta d e) = + splitTraceBihomogeneousValue alpha beta d e X₀ X₁ Y₀ Y₁ := by + simp [splitTraceBihomogeneousPolynomial, splitTraceBihomogeneousValue] + +/-! ### The four standard biprojective charts -/ + +/-- The finite-finite chart is the original cleared affine polynomial. -/ +theorem splitTraceBihomogeneousValue_zero_zero_chart + (alpha beta : K) (d e : ℕ) (x y : K) : + splitTraceBihomogeneousValue alpha beta d e x 1 y 1 = + MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial alpha beta d e) := by + rw [eval_splitTraceCoverPolynomial] + simp [splitTraceBihomogeneousValue] + +/-- Inverting the first projective coordinate leaves the affine polynomial unchanged. -/ +theorem splitTraceBihomogeneousValue_infinity_zero_chart + (alpha beta : K) (d e : ℕ) (x y : K) : + splitTraceBihomogeneousValue alpha beta d e 1 x y 1 = + MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial alpha beta d e) := by + rw [eval_splitTraceCoverPolynomial] + simp [splitTraceBihomogeneousValue] + ring + +/-- Inverting the second projective coordinate swaps the two trace weights. -/ +theorem splitTraceBihomogeneousValue_zero_infinity_chart + (alpha beta : K) (d e : ℕ) (x y : K) : + splitTraceBihomogeneousValue alpha beta d e x 1 1 y = + MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial beta alpha d e) := by + rw [eval_splitTraceCoverPolynomial] + simp [splitTraceBihomogeneousValue] + ring + +/-- Inverting both coordinates again gives the affine polynomial with swapped weights. -/ +theorem splitTraceBihomogeneousValue_infinity_infinity_chart + (alpha beta : K) (d e : ℕ) (x y : K) : + splitTraceBihomogeneousValue alpha beta d e 1 x 1 y = + MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial beta alpha d e) := by + rw [eval_splitTraceCoverPolynomial] + simp [splitTraceBihomogeneousValue] + ring + +/-- Torus points of the weighted trace cover, as a finite-type-independent subtype. -/ +abbrev WeightedSplitTraceTorusCurve (alpha beta : K) (d e : ℕ) := + {z : Kˣ × Kˣ // SplitTraceCurveEquation alpha beta d e z.1 z.2} + +/-- First-coordinate inversion is a transition automorphism of the torus curve. -/ +theorem splitTraceCurveEquation_left_inv_iff + (alpha beta : K) (d e : ℕ) (x y : Kˣ) : + SplitTraceCurveEquation alpha beta d e x⁻¹ y ↔ + SplitTraceCurveEquation alpha beta d e x y := by + simp [SplitTraceCurveEquation, splitTorusTrace] + ring_nf + +/-- Second-coordinate inversion is the transition map to the chart with swapped weights. -/ +theorem splitTraceCurveEquation_right_inv_iff_swapped + (alpha beta : K) (d e : ℕ) (x y : Kˣ) : + SplitTraceCurveEquation alpha beta d e x y⁻¹ ↔ + SplitTraceCurveEquation beta alpha d e x y := by + simp [SplitTraceCurveEquation, weightedSplitTorusTrace, splitTorusTrace] + constructor <;> intro h <;> linear_combination h + +/-- The involutive first-coordinate transition on torus points. -/ +def weightedSplitTraceTorusCurveLeftInversionEquiv + (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceTorusCurve alpha beta d e ≃ + WeightedSplitTraceTorusCurve alpha beta d e where + toFun z := ⟨(z.1.1⁻¹, z.1.2), + (splitTraceCurveEquation_left_inv_iff alpha beta d e z.1.1 z.1.2).2 z.2⟩ + invFun z := ⟨(z.1.1⁻¹, z.1.2), + (splitTraceCurveEquation_left_inv_iff alpha beta d e z.1.1 z.1.2).2 z.2⟩ + left_inv z := by ext <;> simp + right_inv z := by ext <;> simp + +/-- The involutive second-coordinate transition between the two weight orderings. -/ +def weightedSplitTraceTorusCurveRightInversionEquiv + (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceTorusCurve alpha beta d e ≃ + WeightedSplitTraceTorusCurve beta alpha d e where + toFun z := ⟨(z.1.1, z.1.2⁻¹), + (splitTraceCurveEquation_right_inv_iff_swapped + beta alpha d e z.1.1 z.1.2).2 z.2⟩ + invFun z := ⟨(z.1.1, z.1.2⁻¹), + (splitTraceCurveEquation_right_inv_iff_swapped + alpha beta d e z.1.1 z.1.2).2 z.2⟩ + left_inv z := by ext <;> simp + right_inv z := by ext <;> simp + +/-- For covering degrees greater than one, the corner `(∞,∞)` of the raw closure has zero +formal gradient. Thus the raw closure cannot be substituted for its normalization in the +Hasse--Weil step. -/ +theorem splitTraceBihomogeneousPolynomial_pderiv_eval_infinity_infinity + (alpha beta : K) (d e : ℕ) (hd : 1 < d) (he : 1 < e) (i : Fin 4) : + MvPolynomial.eval ![(1 : K), 0, 1, 0] + (MvPolynomial.pderiv i (splitTraceBihomogeneousPolynomial alpha beta d e)) = 0 := by + have hd0 : d ≠ 0 := by omega + have hd1 : d - 1 ≠ 0 := by omega + have he0 : e ≠ 0 := by omega + have he1 : e - 1 ≠ 0 := by omega + have h2d0 : 2 * d ≠ 0 := by omega + have h2d1 : 2 * d - 1 ≠ 0 := by omega + have h2e0 : 2 * e ≠ 0 := by omega + have h2e1 : 2 * e - 1 ≠ 0 := by omega + fin_cases i <;> + simp [splitTraceBihomogeneousPolynomial, hd0, hd1, he0, he1, + h2d0, h2d1, h2e0, h2e1] + +/-! ### Weighted local equations at the projective corners -/ + +/-- In the `(∞,∞)` chart, weighted scaling `x ↦ T^e x`, `y ↦ T^d y` separates +the binomial of weighted degree `de` from the terms of weighted degree `3de`. -/ +theorem splitTraceBihomogeneousValue_infinity_infinity_weightedScaling + (alpha beta : K) (d e : ℕ) (T x y : K) : + splitTraceBihomogeneousValue alpha beta d e + 1 (T ^ e * x) 1 (T ^ d * y) = + T ^ (d * e) * (alpha * x ^ d - y ^ e) + + T ^ (3 * (d * e)) * + (beta * x ^ d * y ^ (2 * e) - x ^ (2 * d) * y ^ e) := by + simp only [splitTraceBihomogeneousValue, one_pow, one_mul, mul_one, mul_pow] + ring_nf + +/-- The `(0,∞)` corner has the same weighted local equation as `(∞,∞)`. -/ +theorem splitTraceBihomogeneousValue_zero_infinity_weightedScaling + (alpha beta : K) (d e : ℕ) (T x y : K) : + splitTraceBihomogeneousValue alpha beta d e + (T ^ e * x) 1 1 (T ^ d * y) = + T ^ (d * e) * (alpha * x ^ d - y ^ e) + + T ^ (3 * (d * e)) * + (beta * x ^ d * y ^ (2 * e) - x ^ (2 * d) * y ^ e) := by + simp only [splitTraceBihomogeneousValue, one_pow, one_mul, mul_one, mul_pow] + ring_nf + +/-- In the `(∞,0)` chart the leading coefficient is the second weight `beta`. -/ +theorem splitTraceBihomogeneousValue_infinity_zero_weightedScaling + (alpha beta : K) (d e : ℕ) (T x y : K) : + splitTraceBihomogeneousValue alpha beta d e + 1 (T ^ e * x) (T ^ d * y) 1 = + T ^ (d * e) * (beta * x ^ d - y ^ e) + + T ^ (3 * (d * e)) * + (alpha * x ^ d * y ^ (2 * e) - x ^ (2 * d) * y ^ e) := by + simp only [splitTraceBihomogeneousValue, one_pow, one_mul, mul_one, mul_pow] + ring_nf + +/-- The `(0,0)` corner has the same weighted local equation as `(∞,0)`. -/ +theorem splitTraceBihomogeneousValue_zero_zero_weightedScaling + (alpha beta : K) (d e : ℕ) (T x y : K) : + splitTraceBihomogeneousValue alpha beta d e + (T ^ e * x) 1 (T ^ d * y) 1 = + T ^ (d * e) * (beta * x ^ d - y ^ e) + + T ^ (3 * (d * e)) * + (alpha * x ^ d * y ^ (2 * e) - x ^ (2 * d) * y ^ e) := by + simp only [splitTraceBihomogeneousValue, one_pow, one_mul, mul_one, mul_pow] + ring_nf + +/-- The common weighted initial polynomial at a corner, with coefficient `gamma`. -/ +noncomputable def splitTraceCornerInitialPolynomial (gamma : K) (d e : ℕ) : + MvPolynomial (Fin 2) K := + MvPolynomial.C gamma * MvPolynomial.X 0 ^ d - MvPolynomial.X 1 ^ e + +/-- If both exponents have a common factor `q` and the leading coefficient is a `q`-th power, +the weighted initial polynomial has the corresponding binomial factor. Over an algebraic closure +the coefficient condition is automatic. -/ +theorem splitTraceCornerInitialPolynomial_factor_of_commonScaling + (a : K) (q d e : ℕ) : + MvPolynomial.C a * MvPolynomial.X 0 ^ d - MvPolynomial.X 1 ^ e ∣ + splitTraceCornerInitialPolynomial (a ^ q) (q * d) (q * e) := by + change MvPolynomial.C a * MvPolynomial.X 0 ^ d - MvPolynomial.X 1 ^ e ∣ + MvPolynomial.C (a ^ q) * MvPolynomial.X 0 ^ (q * d) - + MvPolynomial.X 1 ^ (q * e) + rw [map_pow] + rw [show MvPolynomial.X (0 : Fin 2) ^ (q * d) = + (MvPolynomial.X 0 ^ d) ^ q by rw [Nat.mul_comm, pow_mul]] + rw [show MvPolynomial.X (1 : Fin 2) ^ (q * e) = + (MvPolynomial.X 1 ^ e) ^ q by rw [Nat.mul_comm, pow_mul]] + rw [← mul_pow] + exact sub_dvd_pow_sub_pow + (MvPolynomial.C a * MvPolynomial.X (0 : Fin 2) ^ d) + (MvPolynomial.X (1 : Fin 2) ^ e) q + +/-- Over an algebraically closed field every positive common scaling of the corner exponents +produces an explicit binomial factor of the weighted initial polynomial. -/ +theorem exists_splitTraceCornerInitialPolynomial_factor_of_commonScaling + [IsAlgClosed K] (gamma : K) (q d e : ℕ) (hq : 0 < q) : + ∃ a : K, a ^ q = gamma ∧ + MvPolynomial.C a * MvPolynomial.X 0 ^ d - MvPolynomial.X 1 ^ e ∣ + splitTraceCornerInitialPolynomial gamma (q * d) (q * e) := by + obtain ⟨a, ha⟩ := IsAlgClosed.exists_pow_nat_eq gamma hq + refine ⟨a, ha, ?_⟩ + rw [← ha] + exact splitTraceCornerInitialPolynomial_factor_of_commonScaling a q d e + +/-- With a primitive `q`-th root of unity, the corner initial polynomial factors into exactly +the expected `q` binomials. This is the algebraic input for counting branches above a corner; +lifting these initial factors to the normalization remains a separate theorem. -/ +theorem splitTraceCornerInitialPolynomial_eq_prod_factors + (gamma a zeta : K) (q d e : ℕ) (hq : 0 < q) + (ha : a ^ q = gamma) (hzeta : IsPrimitiveRoot zeta q) : + splitTraceCornerInitialPolynomial gamma (q * d) (q * e) = + ∏ i ∈ Finset.range q, + (MvPolynomial.C a * MvPolynomial.X 0 ^ d - + MvPolynomial.C (zeta ^ i) * MvPolynomial.X 1 ^ e) := by + let R := MvPolynomial (Fin 2) K + let A : R := MvPolynomial.C a * MvPolynomial.X 0 ^ d + let B : R := MvPolynomial.X 1 ^ e + have hzetaR : IsPrimitiveRoot (MvPolynomial.C zeta : R) q := + hzeta.map_of_injective (MvPolynomial.C_injective (Fin 2) K) + have hpoly := X_pow_sub_C_eq_prod hzetaR hq (show B ^ q = B ^ q from rfl) + have heval := congrArg (Polynomial.eval A) hpoly + simp only [Polynomial.eval_sub, Polynomial.eval_pow, Polynomial.eval_X, + Polynomial.eval_C, Polynomial.eval_prod] at heval + rw [splitTraceCornerInitialPolynomial, ← ha] + change MvPolynomial.C (a ^ q) * MvPolynomial.X 0 ^ (q * d) - + MvPolynomial.X 1 ^ (q * e) = _ + rw [map_pow] + rw [show MvPolynomial.X (0 : Fin 2) ^ (q * d) = + (MvPolynomial.X 0 ^ d) ^ q by rw [Nat.mul_comm, pow_mul]] + rw [show MvPolynomial.X (1 : Fin 2) ^ (q * e) = + (MvPolynomial.X 1 ^ e) ^ q by rw [Nat.mul_comm, pow_mul]] + rw [← mul_pow] + rw [heval] + simp [A, B, R, map_pow] + +/-- The `q` binomials in the preceding factorization are pairwise distinct. -/ +theorem splitTraceCornerInitialPolynomial_factors_injective + (a zeta : K) (q d e : ℕ) (hzeta : IsPrimitiveRoot zeta q) : + Function.Injective (fun i : Fin q => + (MvPolynomial.C a : MvPolynomial (Fin 2) K) * MvPolynomial.X 0 ^ d - + MvPolynomial.C (zeta ^ (i : ℕ)) * MvPolynomial.X 1 ^ e) := by + intro i j hij + have hvalue := congrArg + (fun P : MvPolynomial (Fin 2) K => MvPolynomial.eval ![(1 : K), 1] P) hij + simp at hvalue + apply Fin.ext + exact hzeta.pow_inj i.isLt j.isLt hvalue + +/-- For the actual exponents, the number of distinct factors in the weighted initial form is +controlled by `gcd d e`. The characteristic hypothesis is automatic in the endgame because both +covering degrees are prime to the field characteristic. -/ +theorem exists_splitTraceCornerInitialPolynomial_gcd_factorization + [IsAlgClosed K] (gamma : K) (d e : ℕ) (hd : 0 < d) + (hgChar : ((Nat.gcd d e : ℕ) : K) ≠ 0) : + ∃ a zeta : K, + a ^ Nat.gcd d e = gamma ∧ IsPrimitiveRoot zeta (Nat.gcd d e) ∧ + splitTraceCornerInitialPolynomial gamma d e = + ∏ i ∈ Finset.range (Nat.gcd d e), + (MvPolynomial.C a * MvPolynomial.X 0 ^ (d / Nat.gcd d e) - + MvPolynomial.C (zeta ^ i) * MvPolynomial.X 1 ^ (e / Nat.gcd d e)) := by + let q := Nat.gcd d e + change ∃ a zeta : K, + a ^ q = gamma ∧ IsPrimitiveRoot zeta q ∧ + splitTraceCornerInitialPolynomial gamma d e = + ∏ i ∈ Finset.range q, + (MvPolynomial.C a * MvPolynomial.X 0 ^ (d / q) - + MvPolynomial.C (zeta ^ i) * MvPolynomial.X 1 ^ (e / q)) + have hq : 0 < q := Nat.gcd_pos_of_pos_left e hd + letI : NeZero q := ⟨hq.ne'⟩ + letI : NeZero (q : K) := ⟨by simpa [q] using hgChar⟩ + obtain ⟨a, ha⟩ := IsAlgClosed.exists_pow_nat_eq gamma hq + obtain ⟨zeta, hzeta⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot K q + have hqd : q ∣ d := Nat.gcd_dvd_left d e + have hqe : q ∣ e := Nat.gcd_dvd_right d e + have hdEq : q * (d / q) = d := Nat.mul_div_cancel' hqd + have heEq : q * (e / q) = e := Nat.mul_div_cancel' hqe + refine ⟨a, zeta, ha, hzeta, ?_⟩ + calc + splitTraceCornerInitialPolynomial gamma d e = + splitTraceCornerInitialPolynomial gamma (q * (d / q)) (q * (e / q)) := by + rw [hdEq, heEq] + _ = _ := splitTraceCornerInitialPolynomial_eq_prod_factors + gamma a zeta q (d / q) (e / q) hq ha hzeta + +section Finite + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + +/-- Rational points of the raw closure in the canonical `P^1 × P^1` charts. -/ +def splitTraceBiprojectiveZeros (alpha beta : K) (d e : ℕ) : + Finset (Option K × Option K) := + Finset.univ.filter fun z => splitTraceBiprojectiveValue alpha beta d e z = 0 + +/-- Points of the raw closure outside the affine `A^1 × A^1` chart. -/ +def splitTraceBiprojectiveAffineBoundary (alpha beta : K) (d e : ℕ) : + Finset (Option K × Option K) := + (splitTraceBiprojectiveZeros K alpha beta d e).filter fun z => + z.1.isNone || z.2.isNone + +/-- The three raw boundary points outside `A^1 × A^1`. Together with the affine origin these +are the four boundary points of the torus chart. -/ +def splitTraceBiprojectiveBoundaryCorners : Finset (Option K × Option K) := + {(none, some 0), (none, none), (some 0, none)} + +theorem splitTraceBiprojectiveAffineBoundary_eq_corners + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) : + splitTraceBiprojectiveAffineBoundary K alpha beta d e = + splitTraceBiprojectiveBoundaryCorners K := by + ext z + rcases z with ⟨x, y⟩ + cases x with + | none => + cases y with + | none => + simp [splitTraceBiprojectiveAffineBoundary, splitTraceBiprojectiveZeros, + splitTraceBiprojectiveBoundaryCorners, + splitTraceBiprojectiveValue_infinity_infinity alpha beta d e hd he] + | some y => + simp [splitTraceBiprojectiveAffineBoundary, splitTraceBiprojectiveZeros, + splitTraceBiprojectiveBoundaryCorners, + splitTraceBiprojectiveValue_infinity_affine alpha beta d e hd y, + pow_eq_zero_iff he.ne'] + | some x => + cases y with + | none => + simp [splitTraceBiprojectiveAffineBoundary, splitTraceBiprojectiveZeros, + splitTraceBiprojectiveBoundaryCorners, + splitTraceBiprojectiveValue_affine_infinity alpha beta d e he x, + halpha, pow_eq_zero_iff hd.ne'] + | some y => + simp [splitTraceBiprojectiveAffineBoundary, splitTraceBiprojectiveZeros, + splitTraceBiprojectiveBoundaryCorners] + +theorem splitTraceBiprojectiveAffineBoundary_card + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) : + (splitTraceBiprojectiveAffineBoundary K alpha beta d e).card = 3 := by + rw [splitTraceBiprojectiveAffineBoundary_eq_corners K alpha beta d e hd he halpha] + simp [splitTraceBiprojectiveBoundaryCorners] + +/-- The denominator-cleared affine zero set is exactly the affine chart of the raw +biprojective closure. -/ +def affineSplitTraceCoverZerosEquivBiprojectiveOffBoundary + (alpha beta : K) (d e : ℕ) : + ↥(affineSplitTraceCoverZeros K alpha beta d e) ≃ + ↥(splitTraceBiprojectiveZeros K alpha beta d e \ + splitTraceBiprojectiveAffineBoundary K alpha beta d e) := + Equiv.ofBijective + (fun z => + ⟨(some z.1.1, some z.1.2), by + rw [Finset.mem_sdiff] + constructor + · rw [splitTraceBiprojectiveZeros, Finset.mem_filter] + refine ⟨Finset.mem_univ _, ?_⟩ + rw [splitTraceBiprojectiveValue_affine] + exact (mem_affineSplitTraceCoverZeros_iff K alpha beta d e z.1).mp z.2 + · simp [splitTraceBiprojectiveAffineBoundary]⟩) + ⟨by + intro z w h + apply Subtype.ext + apply Prod.ext + · exact Option.some.inj (congrArg (fun q => q.1.1) h) + · exact Option.some.inj (congrArg (fun q => q.1.2) h), by + rintro ⟨⟨x, y⟩, hxy⟩ + rcases Finset.mem_sdiff.mp hxy with ⟨hzero, hnotBoundary⟩ + cases x with + | none => + exfalso + apply hnotBoundary + simp [splitTraceBiprojectiveAffineBoundary, hzero] + | some x => + cases y with + | none => + exfalso + apply hnotBoundary + simp [splitTraceBiprojectiveAffineBoundary, hzero] + | some y => + have hvalue : splitTraceBiprojectiveValue alpha beta d e (some x, some y) = 0 := + (Finset.mem_filter.mp (show + (some x, some y) ∈ Finset.univ.filter + (fun z => splitTraceBiprojectiveValue alpha beta d e z = 0) by + exact hzero)).2 + refine ⟨⟨(x, y), ?_⟩, rfl⟩ + rw [mem_affineSplitTraceCoverZeros_iff] + rw [← splitTraceBiprojectiveValue_affine] + exact hvalue⟩ + +end Finite + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean new file mode 100644 index 0000000000..66f3a07e55 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean @@ -0,0 +1,157 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +import Mathlib.AlgebraicGeometry.OpenImmersion + +/-! +# The biprojective trace curve as a glued scheme + +The published trace curve has four standard affine charts. This module glues the corresponding +affine hypersurface schemes along their common Laurent torus, using the explicit coordinate +inversions already proved for the chart rings. +-/ + +namespace BGS.Markoff + +open CategoryTheory +open AlgebraicGeometry + +noncomputable section + +universe u + +variable {K : Type u} [Field K] + +/-- One affine equation chart of the biprojective trace curve. -/ +def weightedSplitTraceAffineCurveSpec (alpha beta : K) (d e : ℕ) : Scheme := + Spec (CommRingCat.of (WeightedSplitTraceAffineCoordinateRing alpha beta d e)) + +/-- The Laurent torus open in an affine equation chart. -/ +def weightedSplitTraceLaurentCurveSpec (alpha beta : K) (d e : ℕ) : Scheme := + Spec (CommRingCat.of (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)) + +/-- The torus-open immersion into an affine equation chart. -/ +def weightedSplitTraceLaurentCurveOpenImmersion (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLaurentCurveSpec alpha beta d e ⟶ + weightedSplitTraceAffineCurveSpec alpha beta d e := + Spec.map (CommRingCat.ofHom + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e))) + +instance weightedSplitTraceLaurentCurveOpenImmersion_isOpen + (alpha beta : K) (d e : ℕ) : + IsOpenImmersion (weightedSplitTraceLaurentCurveOpenImmersion alpha beta d e) := by + dsimp only [weightedSplitTraceLaurentCurveOpenImmersion, + weightedSplitTraceLaurentCurveSpec, weightedSplitTraceAffineCurveSpec, + WeightedSplitTraceLaurentCoordinateRing] + infer_instance + +/-- First-coordinate inversion on the raw Laurent curve scheme. -/ +def weightedSplitTraceLeftInversionLaurentCurveSchemeIso + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLaurentCurveSpec alpha beta d e ≅ + weightedSplitTraceLaurentCurveSpec alpha beta d e := + BGS.specIsoOfRingEquiv + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e) + +/-- Second-coordinate inversion between the two weight orderings of the raw Laurent curve. -/ +def weightedSplitTraceRightInversionLaurentCurveSchemeIso + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLaurentCurveSpec alpha beta d e ≅ + weightedSplitTraceLaurentCurveSpec beta alpha d e := + BGS.specIsoOfRingEquiv + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e) + +/-- Raw affine equation scheme used by each standard projective chart. -/ +def weightedSplitTraceProjectiveChartScheme + (alpha beta : K) (d e : ℕ) : WeightedSplitTraceProjectiveChart → Scheme + | .affine | .invertFirst => weightedSplitTraceAffineCurveSpec alpha beta d e + | .invertSecond | .invertBoth => weightedSplitTraceAffineCurveSpec beta alpha d e + +/-- Raw Laurent overlap in each standard projective chart. -/ +def weightedSplitTraceProjectiveChartOpen + (alpha beta : K) (d e : ℕ) : WeightedSplitTraceProjectiveChart → Scheme + | .affine | .invertFirst => weightedSplitTraceLaurentCurveSpec alpha beta d e + | .invertSecond | .invertBoth => weightedSplitTraceLaurentCurveSpec beta alpha d e + +/-- The Laurent-open immersion in each raw projective chart. -/ +def weightedSplitTraceProjectiveChartOpenImmersion + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChart) : + weightedSplitTraceProjectiveChartOpen alpha beta d e i ⟶ + weightedSplitTraceProjectiveChartScheme alpha beta d e i := by + cases i with + | affine | invertFirst => exact weightedSplitTraceLaurentCurveOpenImmersion alpha beta d e + | invertSecond | invertBoth => exact weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e + +instance weightedSplitTraceProjectiveChartOpenImmersion_isOpen + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChart) : + IsOpenImmersion (weightedSplitTraceProjectiveChartOpenImmersion alpha beta d e i) := by + cases i with + | affine | invertFirst => + exact weightedSplitTraceLaurentCurveOpenImmersion_isOpen alpha beta d e + | invertSecond | invertBoth => + exact weightedSplitTraceLaurentCurveOpenImmersion_isOpen beta alpha d e + +/-- Every raw chart overlap identified with the Laurent curve in the original coordinates. -/ +def weightedSplitTraceProjectiveChartOpenIsoCommon + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChart) : + weightedSplitTraceProjectiveChartOpen alpha beta d e i ≅ + weightedSplitTraceLaurentCurveSpec alpha beta d e := by + let left := weightedSplitTraceLeftInversionLaurentCurveSchemeIso alpha beta d e + let right := weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e + cases i with + | affine => exact Iso.refl _ + | invertFirst => exact left + | invertSecond => exact right.symm + | invertBoth => exact right.symm.trans left + +/-- Four-chart gluing datum for the biprojective trace curve itself. -/ +def weightedSplitTraceBiprojectiveCurveGlueData + (alpha beta : K) (d e : ℕ) : Scheme.GlueData := + BGS.constantOpenGlueDataOfCommonTarget + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartScheme alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpen alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpenImmersion alpha beta d e i.down) + (weightedSplitTraceLaurentCurveSpec alpha beta d e) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpenIsoCommon alpha beta d e i.down) + +/-- The biprojective trace curve obtained by gluing its four standard affine equation charts. -/ +def weightedSplitTraceBiprojectiveCurve (alpha beta : K) (d e : ℕ) : Scheme := + (weightedSplitTraceBiprojectiveCurveGlueData alpha beta d e).glued + +/-- Open immersion of a standard raw chart into the biprojective trace curve. -/ +def weightedSplitTraceProjectiveChartMap + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChartIndex) : + weightedSplitTraceProjectiveChartScheme alpha beta d e i.down ⟶ + weightedSplitTraceBiprojectiveCurve alpha beta d e := + (weightedSplitTraceBiprojectiveCurveGlueData alpha beta d e).ι i + +instance weightedSplitTraceProjectiveChartMap_isOpen + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChartIndex) : + IsOpenImmersion (weightedSplitTraceProjectiveChartMap alpha beta d e i) := + Scheme.GlueData.ι_isOpenImmersion + (weightedSplitTraceBiprojectiveCurveGlueData alpha beta d e) i + +/-- The four raw affine charts jointly cover the biprojective trace curve. -/ +theorem weightedSplitTraceProjectiveChartMap_jointly_surjective + (alpha beta : K) (d e : ℕ) + (x : (weightedSplitTraceBiprojectiveCurve alpha beta d e).carrier) : + ∃ (i : WeightedSplitTraceProjectiveChartIndex) + (y : (weightedSplitTraceProjectiveChartScheme alpha beta d e i.down).carrier), + weightedSplitTraceProjectiveChartMap alpha beta d e i y = x := + (weightedSplitTraceBiprojectiveCurveGlueData alpha beta d e).ι_jointly_surjective x + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean new file mode 100644 index 0000000000..97eb67d6b6 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean @@ -0,0 +1,210 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry + +/-! +# Affine boundary of the split trace cover + +The split trace equation is naturally an equation on `G_m × G_m`, whereas +`splitTraceCoverPolynomial` is its denominator-cleared affine model. Weil estimates are often +stated for an affine or projective model, so the points introduced on the coordinate axes must be +accounted for explicitly. For positive covering exponents and nonzero second weight, the affine +model adds exactly the origin and no other coordinate-axis point. +-/ + +namespace BGS.Markoff + +open Polynomial + +section Boundary + +variable {K : Type*} [Field K] + +/-- A zero of the denominator-cleared split trace polynomial on either coordinate axis is the +origin. The positivity hypotheses are essential: they ensure that clearing the Laurent +denominators really contributes powers of both coordinates. -/ +theorem splitTraceCoverPolynomial_axis_zero_eq_origin + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (x y : K) + (hzero : MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial alpha beta d e) = 0) + (haxis : x = 0 ∨ y = 0) : + x = 0 ∧ y = 0 := by + rw [eval_splitTraceCoverPolynomial] at hzero + have htwoD : 2 * d ≠ 0 := by omega + have htwoE : 2 * e ≠ 0 := by omega + rcases haxis with rfl | rfl + · constructor + · rfl + · have hyPow : y ^ e = 0 := by + have hneg : -(y ^ e) = 0 := by + simpa only [zero_pow hd.ne', zero_pow htwoD, zero_mul, mul_zero, + add_zero, sub_zero, zero_sub] using hzero + exact neg_eq_zero.mp hneg + exact (pow_eq_zero_iff he.ne').mp hyPow + · constructor + · have hxPow : x ^ d = 0 := by + have hbetaPow : beta * x ^ d = 0 := by + simpa only [zero_pow he.ne', zero_pow htwoE, mul_zero, + add_zero, sub_zero, zero_add] using hzero + exact (mul_eq_zero.mp hbetaPow).resolve_left hbeta + exact (pow_eq_zero_iff hd.ne').mp hxPow + · rfl + +/-- The origin is always the affine boundary point added by clearing denominators when both +covering exponents are positive. -/ +theorem splitTraceCoverPolynomial_origin_zero + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) : + MvPolynomial.eval ![(0 : K), (0 : K)] + (splitTraceCoverPolynomial alpha beta d e) = 0 := by + rw [eval_splitTraceCoverPolynomial] + have htwoD : 2 * d ≠ 0 := by omega + have htwoE : 2 * e ≠ 0 := by omega + simp only [zero_pow hd.ne', zero_pow he.ne', + zero_pow htwoD, zero_pow htwoE, mul_zero, + add_zero, sub_zero] + +/-- Away from the single affine boundary point, every zero of the cleared polynomial has two +nonzero coordinates and therefore is genuinely a point of the original Laurent trace curve. -/ +theorem splitTraceCoverPolynomial_nonorigin_has_nonzero_coordinates + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (x y : K) + (hzero : MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial alpha beta d e) = 0) + (hnonorigin : (x, y) ≠ (0, 0)) : + x ≠ 0 ∧ y ≠ 0 := by + constructor + · intro hx + exact hnonorigin (Prod.ext hx + (splitTraceCoverPolynomial_axis_zero_eq_origin alpha beta d e hd he hbeta x y hzero + (Or.inl hx)).2) + · intro hy + exact hnonorigin (Prod.ext + (splitTraceCoverPolynomial_axis_zero_eq_origin alpha beta d e hd he hbeta x y hzero + (Or.inr hy)).1 hy) + +end Boundary + +section FiniteBoundaryCount + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + +/-- Affine zeros of the denominator-cleared split trace polynomial. -/ +noncomputable def affineSplitTraceCoverZeros + (alpha beta : K) (d e : ℕ) : Finset (K × K) := by + classical + exact Finset.univ.filter fun z => + MvPolynomial.eval ![z.1, z.2] (splitTraceCoverPolynomial alpha beta d e) = 0 + +/-- Zeros of the cleared polynomial that lie on the original two-dimensional torus. -/ +noncomputable def torusSplitTraceCoverZeros + (alpha beta : K) (d e : ℕ) : Finset (K × K) := by + classical + exact (affineSplitTraceCoverZeros K alpha beta d e).filter fun z => + z.1 ≠ 0 ∧ z.2 ≠ 0 + +/-- Solutions of the original Laurent trace equation, represented on `Kˣ × Kˣ` rather +than in the denominator-cleared affine plane. -/ +noncomputable def splitTraceCurveSolutions + (alpha beta : K) (d e : ℕ) : Finset (Kˣ × Kˣ) := by + classical + exact Finset.univ.filter fun z => SplitTraceCurveEquation alpha beta d e z.1 z.2 + +@[simp] +theorem mem_affineSplitTraceCoverZeros_iff + (alpha beta : K) (d e : ℕ) (z : K × K) : + z ∈ affineSplitTraceCoverZeros K alpha beta d e ↔ + MvPolynomial.eval ![z.1, z.2] (splitTraceCoverPolynomial alpha beta d e) = 0 := by + classical + simp [affineSplitTraceCoverZeros] + +@[simp] +theorem mem_torusSplitTraceCoverZeros_iff + (alpha beta : K) (d e : ℕ) (z : K × K) : + z ∈ torusSplitTraceCoverZeros K alpha beta d e ↔ + MvPolynomial.eval ![z.1, z.2] (splitTraceCoverPolynomial alpha beta d e) = 0 ∧ + z.1 ≠ 0 ∧ z.2 ≠ 0 := by + classical + simp [torusSplitTraceCoverZeros] + +@[simp] +theorem mem_splitTraceCurveSolutions_iff + (alpha beta : K) (d e : ℕ) (z : Kˣ × Kˣ) : + z ∈ splitTraceCurveSolutions K alpha beta d e ↔ + SplitTraceCurveEquation alpha beta d e z.1 z.2 := by + classical + simp [splitTraceCurveSolutions] + +/-- The nonzero affine zeros of the cleared polynomial and the solutions of the original Laurent +equation have exactly the same cardinality. This is the finite-field bridge needed before a +point estimate for one model can be used for the other. -/ +theorem torusSplitTraceCoverZeros_card_eq_splitTraceCurveSolutions_card + (alpha beta : K) (d e : ℕ) : + (torusSplitTraceCoverZeros K alpha beta d e).card = + (splitTraceCurveSolutions K alpha beta d e).card := by + classical + symm + apply Finset.card_bij + (fun z (_hz : z ∈ splitTraceCurveSolutions K alpha beta d e) => + (((z.1 : K), (z.2 : K)) : K × K)) + · intro z hz + rw [mem_torusSplitTraceCoverZeros_iff] + refine ⟨(eval_splitTraceCoverPolynomial_eq_zero_iff alpha beta d e z.1 z.2).2 ?_, + z.1.ne_zero, z.2.ne_zero⟩ + exact (mem_splitTraceCurveSolutions_iff K alpha beta d e z).1 hz + · intro z₁ hz₁ z₂ hz₂ heq + apply Prod.ext + · apply Units.ext + exact congrArg Prod.fst heq + · apply Units.ext + exact congrArg Prod.snd heq + · intro z hz + rw [mem_torusSplitTraceCoverZeros_iff] at hz + let ux : Kˣ := Units.mk0 z.1 hz.2.1 + let uy : Kˣ := Units.mk0 z.2 hz.2.2 + refine ⟨(ux, uy), ?_, ?_⟩ + · rw [mem_splitTraceCurveSolutions_iff] + exact (eval_splitTraceCoverPolynomial_eq_zero_iff alpha beta d e ux uy).1 (by + simpa [ux, uy] using hz.1) + · simp [ux, uy] + +/-- Erasing the unique coordinate-axis point from the affine zero set leaves exactly the genuine +torus zero set. -/ +theorem affineSplitTraceCoverZeros_erase_origin + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) : + (affineSplitTraceCoverZeros K alpha beta d e).erase ((0, 0) : K × K) = + torusSplitTraceCoverZeros K alpha beta d e := by + classical + ext z + simp only [Finset.mem_erase, mem_affineSplitTraceCoverZeros_iff, + mem_torusSplitTraceCoverZeros_iff] + constructor + · rintro ⟨hnonorigin, hz⟩ + exact ⟨hz, + splitTraceCoverPolynomial_nonorigin_has_nonzero_coordinates alpha beta d e hd he hbeta + z.1 z.2 hz (by simpa using hnonorigin)⟩ + · rintro ⟨hz, hx, hy⟩ + refine ⟨?_, hz⟩ + intro horigin + exact hx (congrArg Prod.fst horigin) + +/-- Clearing Laurent denominators adds exactly one affine point. This is the exact boundary +correction required when a point estimate for the affine polynomial is converted to the torus +count used in the paper's endgame. -/ +theorem affineSplitTraceCoverZeros_card_eq_torus_card_add_one + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) : + (affineSplitTraceCoverZeros K alpha beta d e).card = + (torusSplitTraceCoverZeros K alpha beta d e).card + 1 := by + classical + have horiginMem : ((0, 0) : K × K) ∈ + affineSplitTraceCoverZeros K alpha beta d e := by + rw [mem_affineSplitTraceCoverZeros_iff] + exact splitTraceCoverPolynomial_origin_zero alpha beta d e hd he + rw [← affineSplitTraceCoverZeros_erase_origin K alpha beta d e hd he hbeta] + exact (Finset.card_erase_add_one horiginMem).symm + +end FiniteBoundaryCount + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean new file mode 100644 index 0000000000..0b20556301 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import Mathlib.Algebra.CharP.Lemmas + +/-! +# The characteristic restriction in the split trace-cover lemma + +The published absolute-irreducibility statement for the split trace cover does not require the +covering exponents to be prime to the characteristic. This omission is substantive: when both +exponents equal the positive characteristic, the cleared trace polynomial is a Frobenius power. + +This file records the obstruction directly on the polynomial used by the endgame. It is kept +separate from the positive Kummer descent: the theorem below is a counterexample to an omitted +hypothesis, not another assumption on which downstream formalization may rely. +-/ + +namespace BGS.Markoff + +open Polynomial + +variable {K : Type*} [Field K] + +/-- Simultaneously multiplying both covering exponents by the characteristic turns the cover +with Frobenius-powered coefficients into a Frobenius power. -/ +theorem splitTraceCoverPolynomial_frobenius_pullback + (alpha beta : K) (d e p : ℕ) [Fact p.Prime] [CharP K p] : + splitTraceCoverPolynomial (alpha ^ p) (beta ^ p) (p * d) (p * e) = + (splitTraceCoverPolynomial alpha beta d e) ^ p := by + simp only [splitTraceCoverPolynomial] + rw [sub_pow_char, sub_pow_char, add_pow_char, mul_pow, mul_pow, mul_pow, mul_pow] + simp only [pow_mul] + have hpd : p * d = d * p := Nat.mul_comm p d + have hpe : p * e = e * p := Nat.mul_comm p e + have htwoPD : 2 * p * d = 2 * d * p := by ac_rfl + have htwoPE : 2 * p * e = 2 * e * p := by ac_rfl + simp only [← pow_mul, hpd, hpe, htwoPD, htwoPE] + simp only [MvPolynomial.C_pow] + +/-- In characteristic `p`, the trace-cover polynomial with both exponents `p` is the `p`-th +power of its degree-one counterpart. The parameters `(1, 0)` satisfy the published conditions +"not both zero" and `alpha * beta ≠ 1`. -/ +theorem splitTraceCoverPolynomial_frobenius_factorization + (p : ℕ) [Fact p.Prime] [CharP K p] : + splitTraceCoverPolynomial (1 : K) 0 p p = + (splitTraceCoverPolynomial (1 : K) 0 1 1) ^ p := by + simpa [zero_pow (Fact.out : p.Prime).ne_zero] using + splitTraceCoverPolynomial_frobenius_pullback (K := K) 1 0 1 1 p + +/-- Therefore the published irreducibility conclusion is false without a restriction excluding +covering exponents divisible by the characteristic. This is reducibility over the ground field, +so in particular it also rules out absolute irreducibility. -/ +theorem splitTraceCoverPolynomial_not_irreducible_when_exponents_equal_char + (p : ℕ) [Fact p.Prime] [CharP K p] : + ¬ Irreducible (splitTraceCoverPolynomial (1 : K) 0 p p) := by + rw [splitTraceCoverPolynomial_frobenius_factorization] + exact not_irreducible_pow (Fact.out : p.Prime).ne_one + +/-- A direct formal counterexample to Lemma 11 as printed: its two parameter hypotheses hold, +but the conclusion fails when both covering exponents equal the characteristic. -/ +theorem publishedTraceCoverIrreducibility_requiresCharacteristicHypothesis + (p : ℕ) [Fact p.Prime] [CharP K p] : + (((1 : K) ≠ 0 ∨ (0 : K) ≠ 0) ∧ (1 : K) * 0 ≠ 1) ∧ + ¬ Irreducible (splitTraceCoverPolynomial (1 : K) 0 p p) := by + exact ⟨by simp, splitTraceCoverPolynomial_not_irreducible_when_exponents_equal_char p⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean new file mode 100644 index 0000000000..1dccfb1d85 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean @@ -0,0 +1,566 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +import Mathlib.RingTheory.Localization.Away.Basic + +/-! +# Localized transition maps for the weighted trace-cover charts + +The four standard charts of the biprojective trace cover have two affine coordinate rings, +corresponding to the weight orders `(alpha, beta)` and `(beta, alpha)`. This file localizes each +ring away from the coordinate axes and constructs the actual algebra isomorphisms induced by +`x ↦ x⁻¹` and `y ↦ y⁻¹`. + +These are coordinate-ring isomorphisms, not merely equivalences of torus-valued points. The next +geometric wall is to identify these localizations with overlap opens in the affine normalizations +and use the maps in a scheme-gluing datum. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +def weightedSplitTraceAffineX (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + Ideal.Quotient.mk _ (MvPolynomial.X 0) + +def weightedSplitTraceAffineY (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + Ideal.Quotient.mk _ (MvPolynomial.X 1) + +def weightedSplitTraceAffineCoordinateProduct (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + weightedSplitTraceAffineX alpha beta d e * weightedSplitTraceAffineY alpha beta d e + +abbrev WeightedSplitTraceLaurentCoordinateRing (alpha beta : K) (d e : ℕ) := + Localization.Away (weightedSplitTraceAffineCoordinateProduct alpha beta d e) + +def weightedSplitTraceLaurentX (alpha beta : K) (d e : ℕ) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + algebraMap _ _ (weightedSplitTraceAffineX alpha beta d e) + +def weightedSplitTraceLaurentY (alpha beta : K) (d e : ℕ) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + algebraMap _ _ (weightedSplitTraceAffineY alpha beta d e) + +theorem weightedSplitTraceLaurentCoordinateProduct_isUnit (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTraceLaurentX alpha beta d e * weightedSplitTraceLaurentY alpha beta d e) := by + simpa only [weightedSplitTraceLaurentX, weightedSplitTraceLaurentY, weightedSplitTraceAffineCoordinateProduct, map_mul] using + (IsLocalization.Away.algebraMap_isUnit + (S := WeightedSplitTraceLaurentCoordinateRing alpha beta d e) (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) + +theorem weightedSplitTraceLaurentX_isUnit (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTraceLaurentX alpha beta d e) := + ((Commute.all _ _).isUnit_mul_iff.mp + (weightedSplitTraceLaurentCoordinateProduct_isUnit alpha beta d e)).1 + +theorem weightedSplitTraceLaurentY_isUnit (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTraceLaurentY alpha beta d e) := + ((Commute.all _ _).isUnit_mul_iff.mp + (weightedSplitTraceLaurentCoordinateProduct_isUnit alpha beta d e)).2 + +def weightedSplitTraceLaurentXUnit (alpha beta : K) (d e : ℕ) : + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)ˣ := + (weightedSplitTraceLaurentX_isUnit alpha beta d e).unit + +def weightedSplitTraceLaurentYUnit (alpha beta : K) (d e : ℕ) : + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)ˣ := + (weightedSplitTraceLaurentY_isUnit alpha beta d e).unit + +@[simp] +theorem weightedSplitTraceLaurentXUnit_val (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceLaurentXUnit alpha beta d e : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) = + weightedSplitTraceLaurentX alpha beta d e := + (weightedSplitTraceLaurentX_isUnit alpha beta d e).unit_spec + +@[simp] +theorem weightedSplitTraceLaurentYUnit_val (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceLaurentYUnit alpha beta d e : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) = + weightedSplitTraceLaurentY alpha beta d e := + (weightedSplitTraceLaurentY_isUnit alpha beta d e).unit_spec + +def weightedSplitTraceLaurentXInverse (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + ↑(weightedSplitTraceLaurentXUnit alpha beta d e)⁻¹ + +def weightedSplitTraceLaurentYInverse (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + ↑(weightedSplitTraceLaurentYUnit alpha beta d e)⁻¹ + +theorem weightedSplitTraceAffineDefiningRelation (alpha beta : K) (d e : ℕ) : + Ideal.Quotient.mk (Ideal.span {splitTraceCoverPolynomial alpha beta d e}) + (splitTraceCoverPolynomial alpha beta d e) = 0 := by + rw [Ideal.Quotient.eq_zero_iff_mem] + exact Ideal.subset_span (Set.mem_singleton _) + +theorem weightedSplitTraceLaurentDefiningRelation (alpha beta : K) (d e : ℕ) : + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentX alpha beta d e ^ d * weightedSplitTraceLaurentY alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentX alpha beta d e ^ d - + weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) * weightedSplitTraceLaurentY alpha beta d e ^ e - + weightedSplitTraceLaurentY alpha beta d e ^ e = 0 := by + let ev : MvPolynomial (Fin 2) K →+* WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + MvPolynomial.eval₂Hom (algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)) + ![weightedSplitTraceLaurentX alpha beta d e, weightedSplitTraceLaurentY alpha beta d e] + have hev : ev = + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)).comp + (Ideal.Quotient.mk (Ideal.span {splitTraceCoverPolynomial alpha beta d e})) := by + ext a + · simp only [RingHom.comp_apply, ev, MvPolynomial.eval₂Hom_C] + exact IsScalarTower.algebraMap_apply K + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) a + · fin_cases a <;> + simp [RingHom.comp_apply, ev, weightedSplitTraceLaurentX, weightedSplitTraceLaurentY, weightedSplitTraceAffineX, weightedSplitTraceAffineY] + have hp : ev (splitTraceCoverPolynomial alpha beta d e) = 0 := by + rw [hev] + simpa only [RingHom.comp_apply, map_zero] using congrArg + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)) + (weightedSplitTraceAffineDefiningRelation alpha beta d e) + simpa [ev, splitTraceCoverPolynomial] using hp + +theorem weightedSplitTraceLeftInverseDefiningRelation (alpha beta : K) (d e : ℕ) : + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentXInverse alpha beta d e ^ d * + weightedSplitTraceLaurentY alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentXInverse alpha beta d e ^ d - + weightedSplitTraceLaurentXInverse alpha beta d e ^ (2 * d) * + weightedSplitTraceLaurentY alpha beta d e ^ e - + weightedSplitTraceLaurentY alpha beta d e ^ e = 0 := by + let u := weightedSplitTraceLaurentXUnit alpha beta d e + have hcancel : + ((↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ (2 * d)) * + ((↑u : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ d) = + (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ d := by + norm_cast + simp [two_mul, pow_add] + have hcancelTwo : + ((↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ (2 * d)) * + ((↑u : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ (2 * d)) = 1 := by + norm_cast + simp + dsimp [u] at hcancel hcancelTwo + calc + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentXInverse alpha beta d e ^ d * + weightedSplitTraceLaurentY alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentXInverse alpha beta d e ^ d - + weightedSplitTraceLaurentXInverse alpha beta d e ^ (2 * d) * + weightedSplitTraceLaurentY alpha beta d e ^ e - + weightedSplitTraceLaurentY alpha beta d e ^ e = + weightedSplitTraceLaurentXInverse alpha beta d e ^ (2 * d) * + (algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentX alpha beta d e ^ d * + weightedSplitTraceLaurentY alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentX alpha beta d e ^ d - + weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) * + weightedSplitTraceLaurentY alpha beta d e ^ e - + weightedSplitTraceLaurentY alpha beta d e ^ e) := by + dsimp [weightedSplitTraceLaurentXInverse] + rw [← weightedSplitTraceLaurentXUnit_val] + linear_combination + -(algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentY alpha beta d e ^ (2 * e)) * hcancel - + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * hcancel + + weightedSplitTraceLaurentY alpha beta d e ^ e * hcancelTwo + _ = 0 := by rw [weightedSplitTraceLaurentDefiningRelation, mul_zero] + +def weightedSplitTraceLeftInversionPolynomialMap (alpha beta : K) (d e : ℕ) : + MvPolynomial (Fin 2) K →ₐ[K] WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + MvPolynomial.aeval + ![weightedSplitTraceLaurentXInverse alpha beta d e, weightedSplitTraceLaurentY alpha beta d e] + +theorem weightedSplitTraceLeftInversionPolynomialMap_relation (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionPolynomialMap alpha beta d e + (splitTraceCoverPolynomial alpha beta d e) = 0 := by + simpa [weightedSplitTraceLeftInversionPolynomialMap, MvPolynomial.aeval_def, splitTraceCoverPolynomial] using + weightedSplitTraceLeftInverseDefiningRelation alpha beta d e + +def weightedSplitTraceLeftInversionAffineMap (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e →ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := by + refine Ideal.Quotient.liftₐ + (Ideal.span {splitTraceCoverPolynomial alpha beta d e}) + (weightedSplitTraceLeftInversionPolynomialMap alpha beta d e) ?_ + intro p hp + have hle : Ideal.span {splitTraceCoverPolynomial alpha beta d e} ≤ + RingHom.ker (weightedSplitTraceLeftInversionPolynomialMap alpha beta d e).toRingHom := by + rw [Ideal.span_le] + intro q hq + simp only [Set.mem_singleton_iff] at hq + subst q + exact weightedSplitTraceLeftInversionPolynomialMap_relation alpha beta d e + exact hle hp + +@[simp] +theorem weightedSplitTraceLeftInversionAffineMap_x (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionAffineMap alpha beta d e (weightedSplitTraceAffineX alpha beta d e) = + weightedSplitTraceLaurentXInverse alpha beta d e := by + simp [weightedSplitTraceLeftInversionAffineMap, weightedSplitTraceLeftInversionPolynomialMap, weightedSplitTraceAffineX] + +@[simp] +theorem weightedSplitTraceLeftInversionAffineMap_y (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionAffineMap alpha beta d e (weightedSplitTraceAffineY alpha beta d e) = + weightedSplitTraceLaurentY alpha beta d e := by + simp [weightedSplitTraceLeftInversionAffineMap, weightedSplitTraceLeftInversionPolynomialMap, weightedSplitTraceAffineY] + +theorem weightedSplitTraceLeftInversionAffineMap_coordinateProduct_isUnit (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTraceLeftInversionAffineMap alpha beta d e (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) := by + simpa [weightedSplitTraceAffineCoordinateProduct, weightedSplitTraceLaurentXInverse] using + (Units.isUnit (weightedSplitTraceLaurentXUnit alpha beta d e)⁻¹).mul + (weightedSplitTraceLaurentY_isUnit alpha beta d e) + +def weightedSplitTraceLeftInversionLaurentMap (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e →ₐ[K] WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + IsLocalization.Away.liftAlgHom (weightedSplitTraceAffineCoordinateProduct alpha beta d e) + (weightedSplitTraceLeftInversionAffineMap_coordinateProduct_isUnit alpha beta d e) + +@[simp] +theorem weightedSplitTraceLeftInversionLaurentMap_x (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionLaurentMap alpha beta d e (weightedSplitTraceLaurentX alpha beta d e) = + weightedSplitTraceLaurentXInverse alpha beta d e := by + simp only [weightedSplitTraceLeftInversionLaurentMap, weightedSplitTraceLaurentX, IsLocalization.Away.liftAlgHom_apply] + rw [IsLocalization.Away.lift_eq] + exact weightedSplitTraceLeftInversionAffineMap_x alpha beta d e + +@[simp] +theorem weightedSplitTraceLeftInversionLaurentMap_y (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionLaurentMap alpha beta d e (weightedSplitTraceLaurentY alpha beta d e) = + weightedSplitTraceLaurentY alpha beta d e := by + simp only [weightedSplitTraceLeftInversionLaurentMap, weightedSplitTraceLaurentY, IsLocalization.Away.liftAlgHom_apply] + rw [IsLocalization.Away.lift_eq] + exact weightedSplitTraceLeftInversionAffineMap_y alpha beta d e + +@[simp] +theorem weightedSplitTraceLeftInversionLaurentMap_xInverse (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionLaurentMap alpha beta d e (weightedSplitTraceLaurentXInverse alpha beta d e) = + weightedSplitTraceLaurentX alpha beta d e := by + let u := weightedSplitTraceLaurentXUnit alpha beta d e + let f := weightedSplitTraceLeftInversionLaurentMap alpha beta d e + have hu : Units.map f.toMonoidHom u = u⁻¹ := by + ext + simp [f, u, weightedSplitTraceLaurentXInverse] + change f (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) = + (↑u : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + calc + f (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) = + ↑(Units.map f.toMonoidHom (u⁻¹)) := + (Units.coe_map f.toMonoidHom (u⁻¹)).symm + _ = ↑((Units.map f.toMonoidHom u)⁻¹) := by rw [map_inv] + _ = ↑((u⁻¹)⁻¹) := by rw [hu] + _ = (↑u : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by simp + +@[simp] +theorem weightedSplitTraceLeftInversionLaurentMap_yInverse + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceLeftInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentYInverse alpha beta d e) = + weightedSplitTraceLaurentYInverse alpha beta d e := by + let u := weightedSplitTraceLaurentYUnit alpha beta d e + let f := weightedSplitTraceLeftInversionLaurentMap alpha beta d e + have hu : Units.map f.toMonoidHom u = u := by + ext + simp [f, u] + change f (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) = + (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + calc + f (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) = + ↑(Units.map f.toMonoidHom (u⁻¹)) := + (Units.coe_map f.toMonoidHom (u⁻¹)).symm + _ = ↑((Units.map f.toMonoidHom u)⁻¹) := by rw [map_inv] + _ = (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by rw [hu] + +theorem weightedSplitTraceLeftInversionLaurentMap_involutive (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceLeftInversionLaurentMap alpha beta d e).comp + (weightedSplitTraceLeftInversionLaurentMap alpha beta d e) = + AlgHom.id K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by + apply IsLocalization.algHom_ext + (Submonoid.powers (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) + apply Ideal.Quotient.algHom_ext K + apply MvPolynomial.algHom_ext + intro i + fin_cases i + · change weightedSplitTraceLeftInversionLaurentMap alpha beta d e + (weightedSplitTraceLeftInversionLaurentMap alpha beta d e (weightedSplitTraceLaurentX alpha beta d e)) = + weightedSplitTraceLaurentX alpha beta d e + rw [weightedSplitTraceLeftInversionLaurentMap_x, weightedSplitTraceLeftInversionLaurentMap_xInverse] + · change weightedSplitTraceLeftInversionLaurentMap alpha beta d e + (weightedSplitTraceLeftInversionLaurentMap alpha beta d e (weightedSplitTraceLaurentY alpha beta d e)) = + weightedSplitTraceLaurentY alpha beta d e + rw [weightedSplitTraceLeftInversionLaurentMap_y, weightedSplitTraceLeftInversionLaurentMap_y] + +def weightedSplitTraceLeftInversionLaurentEquiv (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e ≃ₐ[K] WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + AlgEquiv.ofAlgHom (weightedSplitTraceLeftInversionLaurentMap alpha beta d e) + (weightedSplitTraceLeftInversionLaurentMap alpha beta d e) + (weightedSplitTraceLeftInversionLaurentMap_involutive alpha beta d e) + (weightedSplitTraceLeftInversionLaurentMap_involutive alpha beta d e) + +/-! ### The weight-swapping second-coordinate transition -/ + +/-- Substituting `y⁻¹` changes the defining equation with weights `(alpha, beta)` into the +defining equation with weights `(beta, alpha)`. -/ +theorem weightedSplitTraceRightInverseDefiningRelation + (alpha beta : K) (d e : ℕ) : + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentX alpha beta d e ^ d * + weightedSplitTraceLaurentYInverse alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentX alpha beta d e ^ d - + weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) * + weightedSplitTraceLaurentYInverse alpha beta d e ^ e - + weightedSplitTraceLaurentYInverse alpha beta d e ^ e = 0 := by + let u := weightedSplitTraceLaurentYUnit alpha beta d e + have hcancel : + ((↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ (2 * e)) * + ((↑u : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ e) = + (↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ e := by + norm_cast + simp [two_mul, pow_add] + have hcancelTwo : + ((↑(u⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ (2 * e)) * + ((↑u : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) ^ (2 * e)) = 1 := by + norm_cast + simp + dsimp [u] at hcancel hcancelTwo + calc + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentX alpha beta d e ^ d * + weightedSplitTraceLaurentYInverse alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentX alpha beta d e ^ d - + weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) * + weightedSplitTraceLaurentYInverse alpha beta d e ^ e - + weightedSplitTraceLaurentYInverse alpha beta d e ^ e = + weightedSplitTraceLaurentYInverse alpha beta d e ^ (2 * e) * + (algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentX alpha beta d e ^ d * + weightedSplitTraceLaurentY alpha beta d e ^ (2 * e) + + algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) beta * + weightedSplitTraceLaurentX alpha beta d e ^ d - + weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) * + weightedSplitTraceLaurentY alpha beta d e ^ e - + weightedSplitTraceLaurentY alpha beta d e ^ e) := by + dsimp [weightedSplitTraceLaurentYInverse] + rw [← weightedSplitTraceLaurentYUnit_val] + linear_combination + (weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) + 1) * hcancel - + (algebraMap K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) alpha * + weightedSplitTraceLaurentX alpha beta d e ^ d) * hcancelTwo + _ = 0 := by rw [weightedSplitTraceLaurentDefiningRelation, mul_zero] + +/-- Polynomial substitution defining the second-coordinate transition from the swapped chart. -/ +def weightedSplitTraceRightInversionPolynomialMap (alpha beta : K) (d e : ℕ) : + MvPolynomial (Fin 2) K →ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentYInverse alpha beta d e] + +theorem weightedSplitTraceRightInversionPolynomialMap_relation + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionPolynomialMap alpha beta d e + (splitTraceCoverPolynomial beta alpha d e) = 0 := by + simpa [weightedSplitTraceRightInversionPolynomialMap, MvPolynomial.aeval_def, + splitTraceCoverPolynomial] using + weightedSplitTraceRightInverseDefiningRelation alpha beta d e + +/-- The swapped affine chart maps to the original Laurent chart by `x ↦ x`, `y ↦ y⁻¹`. -/ +def weightedSplitTraceRightInversionAffineMap (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing beta alpha d e →ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := by + refine Ideal.Quotient.liftₐ + (Ideal.span {splitTraceCoverPolynomial beta alpha d e}) + (weightedSplitTraceRightInversionPolynomialMap alpha beta d e) ?_ + intro p hp + have hle : Ideal.span {splitTraceCoverPolynomial beta alpha d e} ≤ + RingHom.ker + (weightedSplitTraceRightInversionPolynomialMap alpha beta d e).toRingHom := by + rw [Ideal.span_le] + intro q hq + simp only [Set.mem_singleton_iff] at hq + subst q + exact weightedSplitTraceRightInversionPolynomialMap_relation alpha beta d e + exact hle hp + +@[simp] +theorem weightedSplitTraceRightInversionAffineMap_x + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionAffineMap alpha beta d e + (weightedSplitTraceAffineX beta alpha d e) = + weightedSplitTraceLaurentX alpha beta d e := by + simp [weightedSplitTraceRightInversionAffineMap, + weightedSplitTraceRightInversionPolynomialMap, weightedSplitTraceAffineX] + +@[simp] +theorem weightedSplitTraceRightInversionAffineMap_y + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionAffineMap alpha beta d e + (weightedSplitTraceAffineY beta alpha d e) = + weightedSplitTraceLaurentYInverse alpha beta d e := by + simp [weightedSplitTraceRightInversionAffineMap, + weightedSplitTraceRightInversionPolynomialMap, weightedSplitTraceAffineY] + +theorem weightedSplitTraceRightInversionAffineMap_coordinateProduct_isUnit + (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTraceRightInversionAffineMap alpha beta d e + (weightedSplitTraceAffineCoordinateProduct beta alpha d e)) := by + simpa [weightedSplitTraceAffineCoordinateProduct, + weightedSplitTraceLaurentYInverse] using + (weightedSplitTraceLaurentX_isUnit alpha beta d e).mul + (Units.isUnit (weightedSplitTraceLaurentYUnit alpha beta d e)⁻¹) + +/-- The localized coordinate-ring map for second-coordinate inversion. -/ +def weightedSplitTraceRightInversionLaurentMap (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing beta alpha d e →ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + IsLocalization.Away.liftAlgHom + (weightedSplitTraceAffineCoordinateProduct beta alpha d e) + (weightedSplitTraceRightInversionAffineMap_coordinateProduct_isUnit alpha beta d e) + +@[simp] +theorem weightedSplitTraceRightInversionLaurentMap_x + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentX beta alpha d e) = + weightedSplitTraceLaurentX alpha beta d e := by + simp only [weightedSplitTraceRightInversionLaurentMap, weightedSplitTraceLaurentX, + IsLocalization.Away.liftAlgHom_apply] + rw [IsLocalization.Away.lift_eq] + exact weightedSplitTraceRightInversionAffineMap_x alpha beta d e + +@[simp] +theorem weightedSplitTraceRightInversionLaurentMap_y + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentY beta alpha d e) = + weightedSplitTraceLaurentYInverse alpha beta d e := by + simp only [weightedSplitTraceRightInversionLaurentMap, weightedSplitTraceLaurentY, + IsLocalization.Away.liftAlgHom_apply] + rw [IsLocalization.Away.lift_eq] + exact weightedSplitTraceRightInversionAffineMap_y alpha beta d e + +@[simp] +theorem weightedSplitTraceRightInversionLaurentMap_yInverse + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentYInverse beta alpha d e) = + weightedSplitTraceLaurentY alpha beta d e := by + let sourceUnit := weightedSplitTraceLaurentYUnit beta alpha d e + let targetUnit := weightedSplitTraceLaurentYUnit alpha beta d e + let f := weightedSplitTraceRightInversionLaurentMap alpha beta d e + have hu : Units.map f.toMonoidHom sourceUnit = targetUnit⁻¹ := by + ext + simp [f, sourceUnit, targetUnit, weightedSplitTraceLaurentYInverse] + change f (↑(sourceUnit⁻¹) : WeightedSplitTraceLaurentCoordinateRing beta alpha d e) = + (↑targetUnit : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + calc + f (↑(sourceUnit⁻¹) : WeightedSplitTraceLaurentCoordinateRing beta alpha d e) = + ↑(Units.map f.toMonoidHom (sourceUnit⁻¹)) := + (Units.coe_map f.toMonoidHom (sourceUnit⁻¹)).symm + _ = ↑((Units.map f.toMonoidHom sourceUnit)⁻¹) := by rw [map_inv] + _ = ↑((targetUnit⁻¹)⁻¹) := by rw [hu] + _ = (↑targetUnit : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by simp + +@[simp] +theorem weightedSplitTraceRightInversionLaurentMap_xInverse + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentXInverse beta alpha d e) = + weightedSplitTraceLaurentXInverse alpha beta d e := by + let sourceUnit := weightedSplitTraceLaurentXUnit beta alpha d e + let targetUnit := weightedSplitTraceLaurentXUnit alpha beta d e + let f := weightedSplitTraceRightInversionLaurentMap alpha beta d e + have hu : Units.map f.toMonoidHom sourceUnit = targetUnit := by + ext + simp [f, sourceUnit, targetUnit] + change f (↑(sourceUnit⁻¹) : WeightedSplitTraceLaurentCoordinateRing beta alpha d e) = + (↑(targetUnit⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + calc + f (↑(sourceUnit⁻¹) : WeightedSplitTraceLaurentCoordinateRing beta alpha d e) = + ↑(Units.map f.toMonoidHom (sourceUnit⁻¹)) := + (Units.coe_map f.toMonoidHom (sourceUnit⁻¹)).symm + _ = ↑((Units.map f.toMonoidHom sourceUnit)⁻¹) := by rw [map_inv] + _ = (↑(targetUnit⁻¹) : WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by rw [hu] + +theorem weightedSplitTraceRightInversionLaurentMap_inverseComposition + (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceRightInversionLaurentMap alpha beta d e).comp + (weightedSplitTraceRightInversionLaurentMap beta alpha d e) = + AlgHom.id K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by + apply IsLocalization.algHom_ext + (Submonoid.powers (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) + apply Ideal.Quotient.algHom_ext K + apply MvPolynomial.algHom_ext + intro i + fin_cases i + · change weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceRightInversionLaurentMap beta alpha d e + (weightedSplitTraceLaurentX alpha beta d e)) = + weightedSplitTraceLaurentX alpha beta d e + rw [weightedSplitTraceRightInversionLaurentMap_x, + weightedSplitTraceRightInversionLaurentMap_x] + · change weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceRightInversionLaurentMap beta alpha d e + (weightedSplitTraceLaurentY alpha beta d e)) = + weightedSplitTraceLaurentY alpha beta d e + rw [weightedSplitTraceRightInversionLaurentMap_y, + weightedSplitTraceRightInversionLaurentMap_yInverse] + +/-- The two coordinate inversions commute on the Laurent overlap. This is the algebraic cocycle +square needed by the four-chart gluing datum. -/ +theorem weightedSplitTraceLaurentInversions_commute + (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceLeftInversionLaurentMap alpha beta d e).comp + (weightedSplitTraceRightInversionLaurentMap alpha beta d e) = + (weightedSplitTraceRightInversionLaurentMap alpha beta d e).comp + (weightedSplitTraceLeftInversionLaurentMap beta alpha d e) := by + apply IsLocalization.algHom_ext + (Submonoid.powers (weightedSplitTraceAffineCoordinateProduct beta alpha d e)) + apply Ideal.Quotient.algHom_ext K + apply MvPolynomial.algHom_ext + intro i + fin_cases i + · change weightedSplitTraceLeftInversionLaurentMap alpha beta d e + (weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentX beta alpha d e)) = + weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLeftInversionLaurentMap beta alpha d e + (weightedSplitTraceLaurentX beta alpha d e)) + rw [weightedSplitTraceRightInversionLaurentMap_x, + weightedSplitTraceLeftInversionLaurentMap_x, + weightedSplitTraceLeftInversionLaurentMap_x, + weightedSplitTraceRightInversionLaurentMap_xInverse] + · change weightedSplitTraceLeftInversionLaurentMap alpha beta d e + (weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLaurentY beta alpha d e)) = + weightedSplitTraceRightInversionLaurentMap alpha beta d e + (weightedSplitTraceLeftInversionLaurentMap beta alpha d e + (weightedSplitTraceLaurentY beta alpha d e)) + rw [weightedSplitTraceRightInversionLaurentMap_y, + weightedSplitTraceLeftInversionLaurentMap_yInverse, + weightedSplitTraceLeftInversionLaurentMap_y, + weightedSplitTraceRightInversionLaurentMap_y] + +/-- The Laurent coordinate rings of the two weight orderings are isomorphic by `y ↦ y⁻¹`. -/ +def weightedSplitTraceRightInversionLaurentEquiv (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing beta alpha d e ≃ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + AlgEquiv.ofAlgHom (weightedSplitTraceRightInversionLaurentMap alpha beta d e) + (weightedSplitTraceRightInversionLaurentMap beta alpha d e) + (weightedSplitTraceRightInversionLaurentMap_inverseComposition alpha beta d e) + (weightedSplitTraceRightInversionLaurentMap_inverseComposition beta alpha d e) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean new file mode 100644 index 0000000000..4d57483ccd --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean @@ -0,0 +1,172 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing + +/-! +# Kummer-class independence for common cover primes + +When a prime divides both cover exponents, the successive norm-degree argument used for coprime +covers loses exactly the common-prime information. This module begins the required replacement +by treating the exceptional prime `2` directly. In the quadratic presentation of the degree-one +trace curve, it proves that the product of the two torus coordinates remains nonsquare. + +The odd common-prime classes and the roots-of-unity eigencharacter descent are deliberately not +assumed here; they remain the next noncoprime wall. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +private lemma ratFunc_sigma_ratio_not_square + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (z : RatFunc K) : + z ^ 2 ≠ + (1 - RatFunc.C sigma * RatFunc.X) / (1 - RatFunc.X) := by + intro hpow + have hdenPoly : (1 - X : K[X]) ≠ 0 := by + intro h + have hval := congrArg (Polynomial.eval (0 : K)) h + simp at hval + have hdenRat : (1 - RatFunc.X : RatFunc K) ≠ 0 := by + simpa [← RatFunc.algebraMap_X, ← RatFunc.algebraMap_C] using + (map_ne_zero_iff (algebraMap K[X] (RatFunc K)) + (RatFunc.algebraMap_injective K)).mpr hdenPoly + have hcrossRat : + algebraMap K[X] (RatFunc K) (z.num ^ 2 * (1 - X)) = + algebraMap K[X] (RatFunc K) ((1 - C sigma * X) * z.denom ^ 2) := by + simp only [map_mul, map_pow, map_sub, map_one, RatFunc.algebraMap_X, + RatFunc.algebraMap_C] + have hzden : algebraMap K[X] (RatFunc K) z.denom ≠ 0 := + (map_ne_zero_iff (algebraMap K[X] (RatFunc K)) + (RatFunc.algebraMap_injective K)).mpr z.denom_ne_zero + rw [← RatFunc.num_div_denom z] at hpow + field_simp [hzden, hdenRat] at hpow + simpa [mul_assoc, mul_left_comm, mul_comm] using hpow + have hcross : z.num ^ 2 * (1 - X) = + (1 - C sigma * X) * z.denom ^ 2 := + (RatFunc.algebraMap_injective K) hcrossRat + let l : K[X] := normalizedSplitTraceEisensteinPrime sigma + have hlIrred : Irreducible l := + normalizedSplitTraceEisensteinPrime_irreducible sigma hsigma + have hlPrime : Prime l := hlIrred.prime + have hlNotDvdDenPoly : ¬ l ∣ (1 - X : K[X]) := by + intro h + apply normalizedSplitTraceEisensteinPrime_not_dvd_leading + sigma hsigma hnondegenerate + simpa [l, normalizedSplitTraceLeadingCoefficient] using + (dvd_mul_of_dvd_right h X) + have hlDvdNumSq : l ∣ z.num ^ 2 := by + have hprod : l ∣ z.num ^ 2 * (1 - X) := by + rw [hcross] + refine ⟨-(z.denom ^ 2), ?_⟩ + simp [l, normalizedSplitTraceEisensteinPrime] + ring + exact (hlPrime.dvd_mul.mp hprod).resolve_right hlNotDvdDenPoly + have hlDvdNum : l ∣ z.num := hlPrime.dvd_of_dvd_pow hlDvdNumSq + have hlNotDvdDen : ¬ l ∣ z.denom := by + intro hlDvdDen + exact hlIrred.not_isUnit + (z.isCoprime_num_denom.isUnit_of_dvd' hlDvdNum hlDvdDen) + obtain ⟨num', hnum⟩ := hlDvdNum + have hlNe : l ≠ 0 := hlIrred.ne_zero + have hcancel : l * (num' ^ 2 * (1 - X)) = -(z.denom ^ 2) := by + apply mul_left_cancel₀ hlNe + calc + l * (l * (num' ^ 2 * (1 - X))) = + (l * num') ^ 2 * (1 - X) := by ring + _ = z.num ^ 2 * (1 - X) := by rw [← hnum] + _ = (1 - C sigma * X) * z.denom ^ 2 := hcross + _ = l * (-(z.denom ^ 2)) := by + simp [l, normalizedSplitTraceEisensteinPrime] + ring + have hlDvdDenSq : l ∣ z.denom ^ 2 := by + refine ⟨-(num' ^ 2 * (1 - X)), ?_⟩ + calc + z.denom ^ 2 = -(l * (num' ^ 2 * (1 - X))) := by rw [hcancel]; simp + _ = l * (-(num' ^ 2 * (1 - X))) := by ring + exact hlNotDvdDen (hlPrime.dvd_of_dvd_pow hlDvdDenSq) + +private lemma ratFunc_X_mul_splitTraceRadicand_eq_sigma_ratio + (sigma : K) : + RatFunc.X * splitTraceRadicand sigma = + (1 - RatFunc.C sigma * RatFunc.X) / (1 - RatFunc.X) := by + have hX : (RatFunc.X : RatFunc K) ≠ 0 := RatFunc.X_ne_zero + have hOneSubX : (1 - RatFunc.X : RatFunc K) ≠ 0 := by + intro h + have honeX : (1 : RatFunc K) = RatFunc.X := sub_eq_zero.mp h + have hdegree := congrArg RatFunc.intDegree honeX + norm_num at hdegree + simp only [splitTraceRadicand, splitTraceRadicandNumerator, + splitTraceRadicandDenominator, map_sub, map_one, map_mul, + RatFunc.algebraMap_C, RatFunc.algebraMap_X] + field_simp [hX, hOneSubX] + +private lemma splitTraceRadicand_mul_X_mul_splitTraceRadicand_intDegree + (sigma : K) (hsigma : sigma ≠ 0) : + (splitTraceRadicand sigma * + (RatFunc.X * splitTraceRadicand sigma)).intDegree = -1 := by + have hr : splitTraceRadicand sigma ≠ 0 := + splitTraceRadicand_ne_zero sigma hsigma + rw [RatFunc.intDegree_mul hr (mul_ne_zero RatFunc.X_ne_zero hr), + RatFunc.intDegree_mul RatFunc.X_ne_zero hr, + RatFunc.intDegree_X, splitTraceRadicand_intDegree sigma hsigma] + norm_num + +/-- The sole two-primary residue class left invisible by the four boundary +valuations is nevertheless nontrivial: on the degree-one trace curve, the +product of the two torus coordinates is not a square. -/ +theorem splitTraceCoordinateProduct_quadraticPresentation_not_isSquare + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (h2 : (2 : K) ≠ 0) : + ¬ IsSquare (algebraMap (RatFunc K) + (AdjoinRoot (adjoinSquarePolynomial (splitTraceRadicand sigma))) + (RatFunc.X * splitTraceRadicand sigma)) := by + let f : RatFunc K := splitTraceRadicand sigma + let g : RatFunc K := RatFunc.X * splitTraceRadicand sigma + have hf0 : f ≠ 0 := splitTraceRadicand_ne_zero sigma hsigma + have hg0 : g ≠ 0 := mul_ne_zero RatFunc.X_ne_zero hf0 + have hf : ¬ IsSquare f := by + rintro ⟨z, hz⟩ + exact RatFunc.pow_ne_of_not_dvd_intDegree f hf0 2 + (by rw [splitTraceRadicand_intDegree sigma hsigma]; norm_num) z + (by simpa [pow_two] using hz.symm) + have hg : ¬ IsSquare g := by + rintro ⟨z, hz⟩ + apply ratFunc_sigma_ratio_not_square sigma hsigma hnondegenerate z + rw [← ratFunc_X_mul_splitTraceRadicand_eq_sigma_ratio sigma] + simpa [g, pow_two] using hz.symm + have hfg0 : f * g ≠ 0 := mul_ne_zero hf0 hg0 + have hfg : ¬ IsSquare (f * g) := by + rintro ⟨z, hz⟩ + exact RatFunc.pow_ne_of_not_dvd_intDegree (f * g) hfg0 2 + (by + change ¬ (2 : ℤ) ∣ + (splitTraceRadicand sigma * + (RatFunc.X * splitTraceRadicand sigma)).intDegree + rw [splitTraceRadicand_mul_X_mul_splitTraceRadicand_intDegree sigma hsigma] + norm_num) z + (by simpa [pow_two] using hz.symm) + have h2Rat : (2 : RatFunc K) ≠ 0 := by + intro hzero + apply h2 + apply FaithfulSMul.algebraMap_injective K (RatFunc K) + simpa only [map_ofNat, map_zero] using hzero + have hnotMapped : ¬ IsSquare + (algebraMap (RatFunc K) (AdjoinRoot (adjoinSquarePolynomial f)) g) := + not_isSquare_algebraMap_adjoinSquare_of_independent + (F := RatFunc K) (f := f) (g := g) h2Rat hf hg hfg + simpa only [f, g] using hnotMapped + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean new file mode 100644 index 0000000000..685d124afb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean @@ -0,0 +1,411 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility + +/-! +# The split trace Kummer tower for arbitrary positive exponents + +This module combines cyclic eigencharacter descent with the trace curve's explicit Kummer-class +calculations. It handles primes common to both covering exponents, proving that the second +radicand remains non-power after adjoining an arbitrary positive root of the first coordinate. +Consequently the second Kummer polynomial is irreducible without a coprimality assumption, under +the explicit roots-of-unity hypotheses used by the descent. +-/ + +namespace BGS.Markoff + +open Polynomial AdjoinRoot + +noncomputable section + +variable {K : Type*} [Field K] + +private lemma two_ne_zero_of_primitive_even_root + {e : ℕ} (he : 0 < e) (h2e : 2 ∣ e) {zeta : K} + (hzeta : IsPrimitiveRoot zeta e) : (2 : K) ≠ 0 := by + let zetaTwo := zeta ^ (e / 2) + have hfactor : e = (e / 2) * 2 := (Nat.div_mul_cancel h2e).symm + have hzetaTwo : IsPrimitiveRoot zetaTwo 2 := hzeta.pow he hfactor + intro htwo + have hnegOne : (-1 : K) = 1 := by + rw [neg_eq_iff_add_eq_zero] + simpa [one_add_one_eq_two] using htwo + apply hzetaTwo.ne_one (by norm_num) + rw [hzetaTwo.eq_neg_one_of_two_right, hnegOne] + +private lemma splitTraceBaseUV_not_square + (sigma : K) (hsigma : sigma ≠ 0) + (c : SplitTraceBaseFunctionField K sigma) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + c ^ 2 ≠ splitTraceBaseU sigma * splitTraceBaseV sigma := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let baseField := SplitTraceBaseFunctionField K sigma + let U : baseField := splitTraceBaseU sigma + let V : baseField := splitTraceBaseV sigma + have hV : V ≠ 0 := by + change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr + (splitTraceRadicand_ne_zero sigma hsigma) + have hU : U ≠ 0 := by + exact (map_ne_zero_iff _ (algebraMap (RatFunc K) baseField).injective).mpr + RatFunc.X_ne_zero + have hUV : U * V ≠ 0 := mul_ne_zero hU hV + intro hpow + have hc : c ≠ 0 := by + intro hc + apply hUV + simpa [hc] using hpow.symm + letI : Module.Finite (RatFunc K) baseField := + (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot + have hnorm := congrArg (Algebra.norm (RatFunc K)) hpow + rw [map_pow] at hnorm + have hnormC : Algebra.norm (RatFunc K) c ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hc + have hdegree := congrArg RatFunc.intDegree hnorm + rw [RatFunc.intDegree_pow _ hnormC, + norm_splitTraceBaseU_mul_V_intDegree sigma hsigma] at hdegree + omega + +/-- The second trace radicand is not a common-prime power after adjoining an arbitrary +positive `e`-th root of the first coordinate. -/ +theorem splitTraceXiRadicand_not_primePower_of_commonPrime + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (i : K) (hi : i ^ 2 = -1) + (e : ℕ) (he : 0 < e) (zeta : K) (hzeta : IsPrimitiveRoot zeta e) + (q : ℕ) (hq : q.Prime) (hqe : q ∣ e) + (z : letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + SplitTraceEtaFunctionField K sigma e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + z ^ q ≠ splitTraceXiRadicand sigma e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let baseField := SplitTraceBaseFunctionField K sigma + let etaField := SplitTraceEtaFunctionField K sigma e + let U : baseField := splitTraceBaseU sigma + let V : baseField := splitTraceBaseV sigma + have hV : V ≠ 0 := by + change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr + (splitTraceRadicand_ne_zero sigma hsigma) + have hU : U ≠ 0 := by + exact (map_ne_zero_iff _ (algebraMap (RatFunc K) baseField).injective).mpr + RatFunc.X_ne_zero + have hUV : U * V ≠ 0 := mul_ne_zero hU hV + intro hpow + have hzetaBase : IsPrimitiveRoot (algebraMap K baseField zeta) e := + hzeta.map_of_injective (algebraMap K baseField).injective + have hpowBase : z ^ q = algebraMap baseField etaField (U * V) := by + change z ^ q = algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) + (splitTraceBaseU sigma * splitTraceBaseV sigma) + exact hpow + obtain ⟨k, hklt, hdiv, c, hc⟩ := + BGS.Algebra.exists_rootMonomial_of_primePower_mem_base + (v := splitTraceBaseV sigma) + (ζ := algebraMap K (SplitTraceBaseFunctionField K sigma) zeta) + (a := splitTraceBaseU sigma * splitTraceBaseV sigma) + he hzetaBase (by simpa [splitTraceEtaKummerPolynomial] using hEtaIrred) + hq hqe z hpowBase + have hc' : z = algebraMap baseField etaField c * + AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e) ^ k := by + change z = algebraMap baseField etaField c * + AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e) ^ k at hc + exact hc + let r := q * k / e + have hrlt : r < q := by + apply (Nat.div_lt_iff_lt_mul he).2 + simpa [Nat.mul_comm] using (Nat.mul_lt_mul_left hq.pos).2 hklt + have hqk : e * r = q * k := by + exact Nat.mul_div_cancel' hdiv + have hetaRoot : + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ e = + algebraMap baseField etaField V := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceEtaKummerPolynomial sigma e) + rw [splitTraceEtaKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hetaPow : (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ (q * k) = + algebraMap baseField etaField (V ^ r) := by + calc + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ (q * k) = + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ (e * r) := by + rw [hqk] + _ = ((AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ e) ^ r := by + rw [pow_mul] + _ = (algebraMap baseField etaField V) ^ r := by + rw [hetaRoot] + _ = algebraMap baseField etaField (V ^ r) := by rw [map_pow] + have hbaseEq : c ^ q * V ^ r = U * V := by + apply (algebraMap baseField etaField).injective + calc + algebraMap baseField etaField (c ^ q * V ^ r) = + (algebraMap baseField etaField c) ^ q * + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ (q * k) := by + rw [map_mul, map_pow, hetaPow] + _ = (algebraMap baseField etaField c * + AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e) ^ k) ^ q := by + rw [mul_pow, ← pow_mul, Nat.mul_comm q k] + _ = z ^ q := by rw [← hc'] + _ = algebraMap baseField etaField (U * V) := by + simpa [splitTraceXiRadicand, U, V, baseField, etaField] using hpow + by_cases hqTwo : q = 2 + · subst q + have h2 : (2 : K) ≠ 0 := + two_ne_zero_of_primitive_even_root he hqe hzeta + have hrCases : r = 0 ∨ r = 1 := by + generalize hrr : r = rr at hrlt ⊢ + omega + rcases hrCases with hrZero | hrOne + · apply splitTraceBaseUV_not_square sigma hsigma c + simpa [hrZero, U, V, baseField] using hbaseEq + · have hcSquareU : c ^ 2 = U := by + apply mul_right_cancel₀ hV + simpa [hrOne, pow_one, mul_assoc] using hbaseEq + have hnot := splitTraceCoordinateProduct_quadraticPresentation_not_isSquare + sigma hsigma hnondegenerate h2 + apply hnot + change IsSquare (algebraMap (RatFunc K) baseField + (RatFunc.X * splitTraceRadicand sigma)) + refine ⟨c * V, ?_⟩ + have hrootSquare : V ^ 2 = + algebraMap (RatFunc K) baseField (splitTraceRadicand sigma) := by + change AdjoinRoot.root (X ^ 2 - C (splitTraceRadicand sigma)) ^ 2 = _ + exact root_X_pow_sub_C_pow 2 (splitTraceRadicand sigma) + calc + algebraMap (RatFunc K) baseField + (RatFunc.X * splitTraceRadicand sigma) = + U * algebraMap (RatFunc K) baseField (splitTraceRadicand sigma) := by + simp [U, baseField, splitTraceBaseU] + _ = U * V ^ 2 := by rw [hrootSquare] + _ = c ^ 2 * V ^ 2 := by rw [hcSquareU] + _ = (c * V) * (c * V) := by ring + · by_cases hrZero : r = 0 + · apply splitTraceBaseCoordinates_mixedPower_ne_oddPrimePower + sigma hsigma hnondegenerate q 1 0 hq hqTwo hq.one_lt hq.pos (by simp) c + simpa [hrZero, U, V, baseField] using hbaseEq + · have hrPositive : 0 < r := Nat.pos_of_ne_zero hrZero + have hrLe : r ≤ q := Nat.le_of_lt hrlt + have hEq : (c * V) ^ q = (U * V) ^ 1 * V ^ (q - r) := by + rw [mul_pow, pow_one] + have hv : V ^ q = V ^ r * V ^ (q - r) := by + rw [← pow_add, Nat.add_sub_of_le hrLe] + calc + c ^ q * V ^ q = c ^ q * (V ^ r * V ^ (q - r)) := by rw [hv] + _ = (c ^ q * V ^ r) * V ^ (q - r) := by rw [mul_assoc] + _ = (U * V) * V ^ (q - r) := by rw [hbaseEq] + apply splitTraceBaseCoordinates_mixedPower_ne_oddPrimePower + sigma hsigma hnondegenerate q 1 (q - r) hq hqTwo hq.one_lt + (Nat.sub_lt (Nat.pos_of_ne_zero hq.ne_zero) hrPositive) (by simp) (c * V) + simpa [U, V, baseField] using hEq + +/-- With a primitive `e`-th root in the constant field, the xi Kummer polynomial is +irreducible for arbitrary positive exponents; coprimality is no longer required. -/ +theorem splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) + (zeta : K) (hzeta : IsPrimitiveRoot zeta e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + Irreducible (splitTraceXiKummerPolynomial sigma e d) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + rw [splitTraceXiKummerPolynomial] + apply X_pow_sub_C_irreducible_of_sqrt_neg_one + (algebraMap K (SplitTraceEtaFunctionField K sigma e) i) + · rw [← map_pow, hi, map_neg, map_one] + · exact hd.ne' + · intro q hq hqd z + by_cases hqe : q ∣ e + · exact splitTraceXiRadicand_not_primePower_of_commonPrime + sigma hsigma hnondegenerate i hi e he zeta hzeta q hq hqe z + · exact splitTraceXiRadicand_not_primePower_of_sqrt_neg_one + sigma hsigma i hi e he q hq hqe z + +/-- The roots of the arbitrary positive-exponent Kummer tower satisfy the cleared affine cover +equation. -/ +theorem generalSplitTraceKummerTower_cover_maps_to_zero_of_primitiveRoot + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) + (zeta : K) (hzeta : IsPrimitiveRoot zeta e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot + sigma hsigma hnondegenerate i hi e d he hd zeta hzeta⟩ + generalSplitTracePolynomialToKummerTop sigma e d + (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot + sigma hsigma hnondegenerate i hi e d he hd zeta hzeta + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let baseToXi : SplitTraceBaseFunctionField K sigma →+* + SplitTraceXiFunctionField K sigma e d := + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)).comp + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)) + have hBase := splitTraceBaseU_V_equation sigma hsigma + have hBaseTop := congrArg baseToXi hBase + simp only [map_add, map_sub, map_mul, map_pow, map_one, map_zero] at hBaseTop + have hEtaRoot : + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ e = + algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) (splitTraceBaseV sigma) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceEtaKummerPolynomial sigma e) + rw [splitTraceEtaKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hEtaTop := congrArg + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)) hEtaRoot + simp only [map_pow] at hEtaTop + have hXiRoot : + splitTraceXiRoot sigma e d ^ d = + algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d) (splitTraceXiRadicand sigma e) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceXiKummerPolynomial sigma e d) + rw [splitTraceXiKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hCover := eval_splitTraceCoverPolynomial_of_powerRootRelations + (splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma))) + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseU sigma)) + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseV sigma)) + (splitTraceXiRoot sigma e d) (splitTraceEtaRootInXiField sigma e d) d e + (by simpa [baseToXi, splitTraceBaseElementInXiField] using hBaseTop) + (by simpa [splitTraceEtaRootInXiField, splitTraceBaseElementInXiField, baseToXi] + using hEtaTop) + (by simpa [splitTraceXiRadicand, splitTraceBaseElementInXiField, baseToXi, + splitTraceXiRoot] using hXiRoot) + have hsigmaTop : + splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma)) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) sigma := by + change algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d) + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) + (algebraMap K (RatFunc K) sigma))) = _ + rw [← IsScalarTower.algebraMap_apply K (RatFunc K) + (SplitTraceBaseFunctionField K sigma)] + rw [← IsScalarTower.algebraMap_apply K + (SplitTraceBaseFunctionField K sigma) (SplitTraceEtaFunctionField K sigma e)] + rw [← IsScalarTower.algebraMap_apply K + (SplitTraceEtaFunctionField K sigma e) (SplitTraceXiFunctionField K sigma e d)] + rw [hsigmaTop] at hCover + simpa [generalSplitTracePolynomialToKummerTop, MvPolynomial.aeval_def, + splitTraceCoverPolynomial] using hCover + +private lemma arbitrarySplitTraceCoverPolynomial_ne_zero + (sigma : K) (d e : ℕ) (hd : 0 < d) : + splitTraceCoverPolynomial (1 : K) sigma d e ≠ 0 := by + intro hzero + have heval := congrArg + (MvPolynomial.eval ![(0 : K), (1 : K)]) hzero + rw [eval_splitTraceCoverPolynomial] at heval + norm_num [hd.ne'] at heval + +/-- The normalized split trace-cover polynomial is irreducible for arbitrary positive exponents +over a field containing a square root of `-1` and a primitive `e`-th root of unity. -/ +theorem splitTraceCoverPolynomial_irreducible_of_primitiveRoot + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) + (zeta : K) (hzeta : IsPrimitiveRoot zeta e) : + Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot + sigma hsigma hnondegenerate i hi e d he hd zeta hzeta + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + AdjoinRoot.isDomain_of_prime hXiIrred.prime + let f : MvPolynomial (Fin 2) K →+* SplitTraceXiFunctionField K sigma e d := + (generalSplitTracePolynomialToKummerTop sigma e d).toRingHom + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + have hCoverZero : + generalSplitTracePolynomialToKummerTop sigma e d + (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := + generalSplitTraceKummerTower_cover_maps_to_zero_of_primitiveRoot + sigma hsigma hnondegenerate i hi e d he hd zeta hzeta + have hI_le : I ≤ RingHom.ker f := by + change Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} ≤ RingHom.ker f + rw [Ideal.span_le] + intro p hp + simp only [Set.mem_singleton_iff] at hp + subst p + exact hCoverZero + have hker_le : RingHom.ker f ≤ I := by + intro p hp + apply generalSplitTracePolynomialSyntacticNormalForm_division + sigma hsigma i hi e d he hd hnondegenerate p + apply (generalSplitTracePolynomialSyntacticNormalForm_eq_zero_iff + sigma hsigma i hi e d he hd p).2 + exact hp + let quotientToTop : MvPolynomial (Fin 2) K ⧸ I →+* + SplitTraceXiFunctionField K sigma e d := + Ideal.Quotient.lift I f hI_le + have hInjective : Function.Injective quotientToTop := + RingHom.lift_injective_of_ker_le_ideal I hI_le hker_le + letI : IsDomain (MvPolynomial (Fin 2) K ⧸ I) := + hInjective.isDomain quotientToTop + have hprimeIdeal : I.IsPrime := + (Ideal.Quotient.isDomain_iff_prime I).mp inferInstance + have hprimeElement : Prime (splitTraceCoverPolynomial (1 : K) sigma d e) := + (Ideal.span_singleton_prime + (arbitrarySplitTraceCoverPolynomial_ne_zero sigma d e hd)).1 (by + simpa [I] using hprimeIdeal) + exact irreducible_iff_prime.mpr hprimeElement + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean new file mode 100644 index 0000000000..0828881c98 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean @@ -0,0 +1,249 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +import Mathlib.RingTheory.Polynomial.Eisenstein.Basic +import Mathlib.Algebra.MvPolynomial.NoZeroDivisors + +/-! +# Split trace curves: an exact polynomial model and the first irreducibility wall + +The source equation is a Laurent equation on a two-dimensional torus. We keep that torus +equation separate from its cleared affine polynomial, because boundary monomials are units on the +torus but not in an affine polynomial ring. + +For the degree-one cover, the birational change `u = x / y` turns the normalized equation into + +`u * (1 - u) * y^2 + sigma * u - 1 = 0`. + +The latter polynomial is Eisenstein at `sigma * u - 1` when `sigma` is neither zero nor one. This +gives an irreducibility proof that survives every field extension. The higher power-cover descent +required by the paper is deliberately not encoded in this theorem: irreducibility of the quotient +curve does not imply irreducibility after adjoining the two power roots. +-/ + +namespace BGS.Markoff + +open Polynomial + +section ExactTraceCurve + +variable {K : Type*} [Field K] + +/-- A weighted split-torus trace. The paper's orbit coordinates have this form. -/ +def weightedSplitTorusTrace (alpha beta : K) (w : Kˣ) : K := + alpha * (w : K) + beta * (w⁻¹ : Kˣ) + +@[simp] +theorem weightedSplitTorusTrace_one_one (w : Kˣ) : + weightedSplitTorusTrace 1 1 w = splitTorusTrace w := by + simp [weightedSplitTorusTrace, splitTorusTrace] + +/-- The exact split trace-cover equation from source equation (31). -/ +def SplitTraceCurveEquation (alpha beta : K) (d e : ℕ) (x y : Kˣ) : Prop := + weightedSplitTorusTrace alpha beta (y ^ e) = splitTorusTrace (x ^ d) + +/-- The affine polynomial obtained by multiplying the Laurent equation by `x^d * y^e`. + +Variable `0` is `x` and variable `1` is `y`. In particular, the third term contains the factor +`y^e`; this is the factor missing from the displayed polynomial on source line 749. +-/ +noncomputable def splitTraceCoverPolynomial (alpha beta : K) (d e : ℕ) : + MvPolynomial (Fin 2) K := + MvPolynomial.C alpha * MvPolynomial.X 0 ^ d * MvPolynomial.X 1 ^ (2 * e) + + MvPolynomial.C beta * MvPolynomial.X 0 ^ d - + MvPolynomial.X 0 ^ (2 * d) * MvPolynomial.X 1 ^ e - + MvPolynomial.X 1 ^ e + +theorem eval_splitTraceCoverPolynomial (alpha beta : K) (d e : ℕ) (x y : K) : + MvPolynomial.eval ![x, y] (splitTraceCoverPolynomial alpha beta d e) = + alpha * x ^ d * y ^ (2 * e) + beta * x ^ d - x ^ (2 * d) * y ^ e - y ^ e := by + simp [splitTraceCoverPolynomial] + +/-- On the torus, vanishing of the cleared polynomial is exactly the source Laurent equation. +No affine boundary point is silently added to this statement. -/ +theorem eval_splitTraceCoverPolynomial_eq_zero_iff + (alpha beta : K) (d e : ℕ) (x y : Kˣ) : + MvPolynomial.eval ![(x : K), (y : K)] (splitTraceCoverPolynomial alpha beta d e) = 0 ↔ + SplitTraceCurveEquation alpha beta d e x y := by + rw [eval_splitTraceCoverPolynomial] + unfold SplitTraceCurveEquation weightedSplitTorusTrace splitTorusTrace + simp only [Units.val_pow_eq_pow_val, Units.val_inv_eq_inv_val] + change alpha * (x : K) ^ d * (y : K) ^ (2 * e) + beta * (x : K) ^ d - + (x : K) ^ (2 * d) * (y : K) ^ e - (y : K) ^ e = 0 ↔ + alpha * (y : K) ^ e + beta * ((y : K) ^ e)⁻¹ = + (x : K) ^ d + ((x : K) ^ d)⁻¹ + field_simp + constructor <;> intro h <;> linear_combination h + +/-- At the excluded parameter `alpha * beta = 1`, the normalized cleared polynomial visibly +factors. This proves that the paper's nondegeneracy condition is mathematically necessary. -/ +theorem splitTraceCoverPolynomial_degenerate_factorization (d e : ℕ) : + splitTraceCoverPolynomial (1 : K) 1 d e = + (MvPolynomial.X 1 ^ e - MvPolynomial.X 0 ^ d) * + (MvPolynomial.X 0 ^ d * MvPolynomial.X 1 ^ e - 1) := by + simp only [splitTraceCoverPolynomial, MvPolynomial.C_1] + ring + +/-- The birational degree-one equation obtained from the normalized cleared equation by setting +`u = x / y` and removing the invertible factor `y`. -/ +def normalizedSplitTraceBirationalEquation (sigma u y : K) : K := + u * (1 - u) * y ^ 2 + sigma * u - 1 + +theorem normalizedSplitTrace_birational_change (sigma x y : K) (hy : y ≠ 0) : + x * y ^ 2 + sigma * x - x ^ 2 * y - y = + y * normalizedSplitTraceBirationalEquation sigma (x / y) y := by + change x * y ^ 2 + sigma * x - x ^ 2 * y - y = + y * ((x / y) * (1 - x / y) * y ^ 2 + sigma * (x / y) - 1) + field_simp [hy] + ring + +end ExactTraceCurve + +section BirationalIrreducibility + +variable {K : Type*} [Field K] + +/-- The coefficient of `y^2` in the birational degree-one trace equation. -/ +noncomputable def normalizedSplitTraceLeadingCoefficient : K[X] := + X * (1 - X) + +/-- The prime used in the Eisenstein proof. -/ +noncomputable def normalizedSplitTraceEisensteinPrime (sigma : K) : K[X] := + C sigma * X - 1 + +/-- The birational degree-one trace equation, as a polynomial in `y` over `K[u]`. -/ +noncomputable def normalizedSplitTraceBirationalPolynomial (sigma : K) : Polynomial K[X] := + C normalizedSplitTraceLeadingCoefficient * X ^ 2 + + C (normalizedSplitTraceEisensteinPrime sigma) + +@[simp] +theorem eval_normalizedSplitTraceBirationalPolynomial (sigma u y : K) : + ((normalizedSplitTraceBirationalPolynomial sigma).eval (C y)).eval u = + normalizedSplitTraceBirationalEquation sigma u y := by + simp [normalizedSplitTraceBirationalPolynomial, normalizedSplitTraceLeadingCoefficient, + normalizedSplitTraceEisensteinPrime, normalizedSplitTraceBirationalEquation] + ring + +lemma normalizedSplitTraceEisensteinPrime_irreducible (sigma : K) (hsigma : sigma ≠ 0) : + Irreducible (normalizedSplitTraceEisensteinPrime sigma) := by + simpa [normalizedSplitTraceEisensteinPrime, sub_eq_add_neg] using + (Polynomial.irreducible_C_mul_X_add_C hsigma + ((isUnit_neg_one : IsUnit (-1 : K)).isRelPrime_right)) + +lemma normalizedSplitTraceEisensteinPrime_not_dvd_leading + (sigma : K) (hsigma : sigma ≠ 0) (hsigmaOne : sigma ≠ 1) : + ¬ normalizedSplitTraceEisensteinPrime sigma ∣ + (normalizedSplitTraceLeadingCoefficient : K[X]) := by + intro hdvd + have hdvdEval := map_dvd (Polynomial.evalRingHom (sigma⁻¹)) hdvd + have hinv : sigma⁻¹ ≠ 0 := inv_ne_zero hsigma + have hinvOne : sigma⁻¹ ≠ 1 := inv_ne_one.mpr hsigmaOne + have hzero : 1 - sigma⁻¹ = 0 := by + simpa [normalizedSplitTraceEisensteinPrime, normalizedSplitTraceLeadingCoefficient, + hsigma, hinv] using hdvdEval + exact (sub_ne_zero.mpr (Ne.symm hinvOne)) hzero + +lemma normalizedSplitTraceBirationalPolynomial_natDegree (sigma : K) : + (normalizedSplitTraceBirationalPolynomial sigma).natDegree = 2 := by + have hOneSubX : (1 - X : K[X]) ≠ 0 := by + intro h + have hval : (1 : K) = 0 := by + simpa using congrArg (Polynomial.eval (0 : K)) h + exact one_ne_zero hval + have hLeading : (normalizedSplitTraceLeadingCoefficient : K[X]) ≠ 0 := + mul_ne_zero Polynomial.X_ne_zero hOneSubX + simp [normalizedSplitTraceBirationalPolynomial, hLeading] + +lemma normalizedSplitTraceBirationalPolynomial_isPrimitive + (sigma : K) (hsigma : sigma ≠ 0) (hsigmaOne : sigma ≠ 1) : + (normalizedSplitTraceBirationalPolynomial sigma).IsPrimitive := by + rw [Polynomial.isPrimitive_iff_isUnit_of_C_dvd] + intro r hr + have hcoeff := (Polynomial.C_dvd_iff_dvd_coeff r + (normalizedSplitTraceBirationalPolynomial sigma)).mp hr + have hrPrime : r ∣ normalizedSplitTraceEisensteinPrime sigma := by + simpa [normalizedSplitTraceBirationalPolynomial] using hcoeff 0 + have hrLeading : r ∣ (normalizedSplitTraceLeadingCoefficient : K[X]) := by + simpa [normalizedSplitTraceBirationalPolynomial] using hcoeff 2 + exact ((normalizedSplitTraceEisensteinPrime_irreducible sigma hsigma).coprime_iff_not_dvd.mpr + (normalizedSplitTraceEisensteinPrime_not_dvd_leading sigma hsigma hsigmaOne)).isUnit_of_dvd' + hrPrime hrLeading + +lemma normalizedSplitTraceBirationalPolynomial_isEisenstein + (sigma : K) (hsigma : sigma ≠ 0) (hsigmaOne : sigma ≠ 1) : + (normalizedSplitTraceBirationalPolynomial sigma).IsEisensteinAt + (Ideal.span {normalizedSplitTraceEisensteinPrime sigma}) := by + have hPrimeIrred := normalizedSplitTraceEisensteinPrime_irreducible sigma hsigma + have hDegree := normalizedSplitTraceBirationalPolynomial_natDegree sigma + have hLeadingCoeff : + (normalizedSplitTraceBirationalPolynomial sigma).leadingCoeff = + (normalizedSplitTraceLeadingCoefficient : K[X]) := by + rw [leadingCoeff, hDegree] + simp [normalizedSplitTraceBirationalPolynomial] + have hCoeffZero : + (normalizedSplitTraceBirationalPolynomial sigma).coeff 0 = + normalizedSplitTraceEisensteinPrime sigma := by + simp [normalizedSplitTraceBirationalPolynomial] + refine { + leading := ?_ + mem := ?_ + notMem := ?_ } + · rw [Ideal.mem_span_singleton] + rw [hLeadingCoeff] + exact normalizedSplitTraceEisensteinPrime_not_dvd_leading sigma hsigma hsigmaOne + · intro n hn + rw [hDegree] at hn + interval_cases n <;> + simp [normalizedSplitTraceBirationalPolynomial] + · rw [hCoeffZero, Ideal.span_singleton_pow, Ideal.mem_span_singleton] + intro hdvd + have hDegreePrime : (normalizedSplitTraceEisensteinPrime sigma).natDegree = 1 := by + rw [← Polynomial.degree_eq_iff_natDegree_eq_of_pos (by norm_num : 0 < 1)] + rw [normalizedSplitTraceEisensteinPrime] + compute_degree! + have hle := Polynomial.natDegree_le_of_dvd hdvd hPrimeIrred.ne_zero + norm_num [Polynomial.natDegree_pow, hDegreePrime] at hle + +/-- The degree-one birational trace polynomial is irreducible over every field, under exactly the +two nondegeneracy conditions used by the Eisenstein argument. -/ +theorem normalizedSplitTraceBirationalPolynomial_irreducible + (sigma : K) (hsigma : sigma ≠ 0) (hsigmaOne : sigma ≠ 1) : + Irreducible (normalizedSplitTraceBirationalPolynomial sigma) := by + have hPrimeIrred := normalizedSplitTraceEisensteinPrime_irreducible sigma hsigma + have hIdealPrime : (Ideal.span {normalizedSplitTraceEisensteinPrime sigma}).IsPrime := + (Ideal.span_singleton_prime hPrimeIrred.ne_zero).mpr hPrimeIrred.prime + apply (normalizedSplitTraceBirationalPolynomial_isEisenstein sigma hsigma hsigmaOne).irreducible + hIdealPrime + (normalizedSplitTraceBirationalPolynomial_isPrimitive sigma hsigma hsigmaOne) + rw [normalizedSplitTraceBirationalPolynomial_natDegree] + norm_num + +theorem map_normalizedSplitTraceBirationalPolynomial + {L : Type*} [Field L] (phi : K →+* L) (sigma : K) : + (normalizedSplitTraceBirationalPolynomial sigma).map (Polynomial.mapRingHom phi) = + normalizedSplitTraceBirationalPolynomial (phi sigma) := by + simp [normalizedSplitTraceBirationalPolynomial, normalizedSplitTraceLeadingCoefficient, + normalizedSplitTraceEisensteinPrime] + +/-- Universal scalar-extension irreducibility. In particular, taking an algebraic closure gives +absolute irreducibility of this explicit birational degree-one model. -/ +theorem normalizedSplitTraceBirationalPolynomial_irreducible_after_baseChange + {L : Type*} [Field L] (phi : K →+* L) (sigma : K) + (hsigma : sigma ≠ 0) (hsigmaOne : sigma ≠ 1) : + Irreducible + ((normalizedSplitTraceBirationalPolynomial sigma).map (Polynomial.mapRingHom phi)) := by + rw [map_normalizedSplitTraceBirationalPolynomial] + apply normalizedSplitTraceBirationalPolynomial_irreducible + · exact (map_ne_zero_iff phi phi.injective).mpr hsigma + · intro h + apply hsigmaOne + apply phi.injective + simpa using h + +end BirationalIrreducibility + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean new file mode 100644 index 0000000000..2e286b9e11 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean @@ -0,0 +1,147 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +import Mathlib.FieldTheory.Perfect + +/-! +# Exact obstructions to the published trace-cover irreducibility statement + +The counterexample in `TraceCurveCharacteristic` uses a zero second weight. That already +falsifies the published statement as written, but it does not test the normalized family used by +the current split endgame. This file records the stronger obstruction: over a perfect field of +positive characteristic, every normalized coefficient has a Frobenius root, so simultaneously +multiplying both cover exponents by the characteristic makes the normalized cover a Frobenius +power. This remains true when `sigma` is nonzero and different from one. +-/ + +namespace BGS.Markoff + +open Polynomial + +variable {K : Type*} [Field K] + +section ZeroSecondWeight + +/-- If the second trace weight is zero, denominator clearing introduces the coordinate factor +`y^e`. Thus the polynomial displayed in the published proof is not the torus closure in this +case. -/ +theorem splitTraceCoverPolynomial_zero_second_weight_factorization + (alpha : K) (d e : ℕ) : + splitTraceCoverPolynomial alpha 0 d e = + MvPolynomial.X 1 ^ e * + (MvPolynomial.C alpha * MvPolynomial.X 0 ^ d * MvPolynomial.X 1 ^ e - + MvPolynomial.X 0 ^ (2 * d) - 1) := by + simp only [splitTraceCoverPolynomial, MvPolynomial.C_0, zero_mul, add_zero] + ring + +lemma splitTraceCoverPolynomial_zero_second_weight_coordinateFactor_not_isUnit + (e : ℕ) (he : 0 < e) : + ¬ IsUnit (MvPolynomial.X (R := K) (1 : Fin 2) ^ e) := by + intro hunit + obtain ⟨r, _hr, heq⟩ := + (MvPolynomial.isUnit_iff_eq_C_of_isReduced.mp hunit) + have hzero := congrArg + (MvPolynomial.eval₂ (σ := Fin 2) (RingHom.id K) (![0, 0] : Fin 2 → K)) heq + have hone := congrArg + (MvPolynomial.eval₂ (σ := Fin 2) (RingHom.id K) (![0, 1] : Fin 2 → K)) heq + simp [he.ne'] at hzero hone + exact zero_ne_one (hzero.trans hone.symm) + +lemma splitTraceCoverPolynomial_zero_second_weight_remainingFactor_not_isUnit + (alpha : K) (halpha : alpha ≠ 0) (d e : ℕ) (he : 0 < e) : + ¬ IsUnit + (MvPolynomial.C alpha * MvPolynomial.X 0 ^ d * MvPolynomial.X 1 ^ e - + MvPolynomial.X (0 : Fin 2) ^ (2 * d) - 1 : MvPolynomial (Fin 2) K) := by + intro hunit + obtain ⟨r, _hr, heq⟩ := + (MvPolynomial.isUnit_iff_eq_C_of_isReduced.mp hunit) + have hzero := congrArg + (MvPolynomial.eval₂ (σ := Fin 2) (RingHom.id K) (![1, 0] : Fin 2 → K)) heq + have hone := congrArg + (MvPolynomial.eval₂ (σ := Fin 2) (RingHom.id K) (![1, 1] : Fin 2 → K)) heq + simp [he.ne'] at hzero hone + apply halpha + linear_combination hone - hzero + +/-- The printed hypotheses "the weights are not both zero" and `alpha * beta ≠ 1` do not imply +irreducibility of the cleared polynomial: whenever `beta = 0`, `alpha ≠ 0`, and `e > 0`, both +factors above are nonunits. This obstruction already occurs in characteristic zero. -/ +theorem splitTraceCoverPolynomial_zero_second_weight_not_irreducible + (alpha : K) (halpha : alpha ≠ 0) (d e : ℕ) (he : 0 < e) : + ¬ Irreducible (splitTraceCoverPolynomial alpha 0 d e) := by + intro hirreducible + have hfactor := splitTraceCoverPolynomial_zero_second_weight_factorization alpha d e + rcases hirreducible.isUnit_or_isUnit hfactor with hcoordinate | hremaining + · exact splitTraceCoverPolynomial_zero_second_weight_coordinateFactor_not_isUnit e he hcoordinate + · exact splitTraceCoverPolynomial_zero_second_weight_remainingFactor_not_isUnit + alpha halpha d e he hremaining + +/-- A direct counterexample to the published lemma in its own logical form, independent of any +positive-characteristic issue. -/ +theorem publishedTraceCoverIrreducibility_requires_nonzero_secondWeight + (alpha : K) (halpha : alpha ≠ 0) (d e : ℕ) (he : 0 < e) : + ((alpha ≠ 0 ∨ (0 : K) ≠ 0) ∧ alpha * 0 ≠ 1) ∧ + ¬ Irreducible (splitTraceCoverPolynomial alpha 0 d e) := by + exact ⟨⟨Or.inl halpha, by simp⟩, + splitTraceCoverPolynomial_zero_second_weight_not_irreducible alpha halpha d e he⟩ + +end ZeroSecondWeight + +/-- In a perfect field of characteristic `p`, the normalized cover with exponents `(p*d,p*e)` +is a `p`-th power after choosing a Frobenius root of `sigma`. -/ +theorem exists_splitTraceCoverPolynomial_normalized_frobenius_factorization + [PerfectField K] (p : ℕ) [Fact p.Prime] [CharP K p] + (sigma : K) (d e : ℕ) : + ∃ tau : K, + tau ^ p = sigma ∧ + splitTraceCoverPolynomial (1 : K) sigma (p * d) (p * e) = + (splitTraceCoverPolynomial (1 : K) tau d e) ^ p := by + obtain ⟨tau, htau⟩ := surjective_frobenius K p sigma + have htauPow : tau ^ p = sigma := by + simpa [frobenius] using htau + refine ⟨tau, ?_, ?_⟩ + · exact htauPow + · rw [← htauPow] + simpa using + (splitTraceCoverPolynomial_frobenius_pullback + (K := K) (1 : K) tau d e p) + +/-- Any normalized cover for which the characteristic divides both exponents is a nontrivial +power over a perfect field, regardless of the residual exponents. -/ +theorem splitTraceCoverPolynomial_normalized_not_irreducible_when_char_mul_exponents + [PerfectField K] (p : ℕ) [Fact p.Prime] [CharP K p] + (sigma : K) (d e : ℕ) : + ¬ Irreducible + (splitTraceCoverPolynomial (1 : K) sigma (p * d) (p * e)) := by + obtain ⟨tau, _htau, hfactor⟩ := + exists_splitTraceCoverPolynomial_normalized_frobenius_factorization + (K := K) p sigma d e + rw [hfactor] + exact not_irreducible_pow (Fact.out : p.Prime).ne_one + +/-- Hence the normalized cover is not irreducible whenever the characteristic divides both +covering exponents. The hypotheses `sigma ≠ 0,1` do not repair this obstruction. -/ +theorem splitTraceCoverPolynomial_normalized_not_irreducible_when_exponents_equal_char + [PerfectField K] (p : ℕ) [Fact p.Prime] [CharP K p] + (sigma : K) : + ¬ Irreducible (splitTraceCoverPolynomial (1 : K) sigma p p) := by + simpa using + (splitTraceCoverPolynomial_normalized_not_irreducible_when_char_mul_exponents + (K := K) p sigma 1 1) + +/-- Direct logical form of the repaired counterexample: even after imposing the current +normalized nondegeneracy assumptions, the published conclusion fails if the characteristic +divides both exponents. -/ +theorem normalizedTraceCoverIrreducibility_requires_commonCharacteristicExclusion + [PerfectField K] (p : ℕ) [Fact p.Prime] [CharP K p] + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) : + (sigma ≠ 0 ∧ sigma ≠ 1) ∧ + ¬ Irreducible (splitTraceCoverPolynomial (1 : K) sigma p p) := by + exact ⟨⟨hsigma, hnondegenerate⟩, + splitTraceCoverPolynomial_normalized_not_irreducible_when_exponents_equal_char p sigma⟩ + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean new file mode 100644 index 0000000000..fa6f62199f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean @@ -0,0 +1,586 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import Mathlib.FieldTheory.KummerExtension +import Mathlib.FieldTheory.RatFunc.Degree +import Mathlib.RingTheory.Norm.Basic + +/-! +# Kummer descent for the split trace power cover + +The normalized split trace cover is obtained from the base curve + +`u * (1 - u) * v^2 + sigma * u - 1 = 0` + +by adjoining `eta` and `xi` with `eta^e = v` and `xi^d = u * v`. This file makes that +two-stage Kummer construction explicit. Oddness is imposed because Mathlib's composite-binomial +criterion currently covers odd exponents; coprimality of `d` and `e` is used in the second norm +argument. Neither hypothesis is hidden in a structure field. +-/ + +namespace BGS.Markoff + +open Polynomial AdjoinRoot + +noncomputable section + +section ExactPowerSubstitution + +variable {L : Type*} [Field L] + +/-- The two Kummer root relations really land on the correctly cleared trace-cover polynomial. -/ +theorem eval_splitTraceCoverPolynomial_of_powerRootRelations + (sigma u v xi eta : L) (d e : ℕ) + (hbase : u * (1 - u) * v ^ 2 + sigma * u - 1 = 0) + (heta : eta ^ e = v) (hxi : xi ^ d = u * v) : + MvPolynomial.eval ![xi, eta] (splitTraceCoverPolynomial 1 sigma d e) = 0 := by + rw [eval_splitTraceCoverPolynomial] + have hetaTwo : eta ^ (2 * e) = (eta ^ e) ^ 2 := by + simpa [Nat.mul_comm] using (pow_mul eta e 2) + have hxiTwo : xi ^ (2 * d) = (xi ^ d) ^ 2 := by + simpa [Nat.mul_comm] using (pow_mul xi d 2) + rw [hetaTwo, hxiTwo, heta, hxi] + linear_combination v * hbase + +end ExactPowerSubstitution + +section RationalBase + +variable {K : Type*} [Field K] + +/-- Numerator of the quadratic radicand on the rational `u`-line. -/ +def splitTraceRadicandNumerator (sigma : K) : K[X] := + 1 - C sigma * X + +/-- Denominator of the quadratic radicand on the rational `u`-line. -/ +def splitTraceRadicandDenominator : K[X] := + X * (1 - X) + +/-- The base trace curve has function equation `v^2 = splitTraceRadicand sigma`. -/ +def splitTraceRadicand (sigma : K) : RatFunc K := + algebraMap K[X] (RatFunc K) (splitTraceRadicandNumerator sigma) / + algebraMap K[X] (RatFunc K) splitTraceRadicandDenominator + +lemma splitTraceRadicandNumerator_natDegree (sigma : K) (hsigma : sigma ≠ 0) : + (splitTraceRadicandNumerator sigma).natDegree = 1 := by + rw [← Polynomial.degree_eq_iff_natDegree_eq_of_pos (by norm_num : 0 < 1)] + rw [splitTraceRadicandNumerator] + compute_degree! + +lemma splitTraceRadicandDenominator_natDegree : + (splitTraceRadicandDenominator : K[X]).natDegree = 2 := by + rw [← Polynomial.degree_eq_iff_natDegree_eq_of_pos (by norm_num : 0 < 2)] + rw [splitTraceRadicandDenominator] + compute_degree! + +lemma splitTraceRadicandNumerator_ne_zero (sigma : K) (hsigma : sigma ≠ 0) : + splitTraceRadicandNumerator sigma ≠ 0 := by + intro h + have := congrArg Polynomial.natDegree h + simp [splitTraceRadicandNumerator_natDegree sigma hsigma] at this + +lemma splitTraceRadicandDenominator_ne_zero : + (splitTraceRadicandDenominator : K[X]) ≠ 0 := by + intro h + have := congrArg Polynomial.natDegree h + simp [splitTraceRadicandDenominator_natDegree (K := K)] at this + +lemma splitTraceRadicand_ne_zero (sigma : K) (hsigma : sigma ≠ 0) : + splitTraceRadicand sigma ≠ 0 := by + apply div_ne_zero + · exact (map_ne_zero_iff _ (RatFunc.algebraMap_injective K)).mpr + (splitTraceRadicandNumerator_ne_zero sigma hsigma) + · exact (map_ne_zero_iff _ (RatFunc.algebraMap_injective K)).mpr + (splitTraceRadicandDenominator_ne_zero (K := K)) + +lemma splitTraceRadicand_intDegree (sigma : K) (hsigma : sigma ≠ 0) : + (splitTraceRadicand sigma).intDegree = -1 := by + rw [splitTraceRadicand, RatFunc.intDegree_div] + · rw [RatFunc.intDegree_polynomial, RatFunc.intDegree_polynomial, + splitTraceRadicandNumerator_natDegree sigma hsigma, + splitTraceRadicandDenominator_natDegree] + norm_num + · exact (map_ne_zero_iff _ (RatFunc.algebraMap_injective K)).mpr + (splitTraceRadicandNumerator_ne_zero sigma hsigma) + · exact (map_ne_zero_iff _ (RatFunc.algebraMap_injective K)).mpr + (splitTraceRadicandDenominator_ne_zero (K := K)) + +/-- The rational radicand satisfies the cleared base trace equation before adjoining its square +root. -/ +lemma splitTraceRadicand_equation (sigma : K) : + RatFunc.X * (1 - RatFunc.X) * splitTraceRadicand sigma + + RatFunc.C sigma * RatFunc.X - 1 = 0 := by + have hOneNeX : (1 : RatFunc K) ≠ RatFunc.X := by + intro h + have hDegree := congrArg RatFunc.intDegree h + norm_num at hDegree + have hDenominator : + RatFunc.X * (1 - RatFunc.X) ≠ (0 : RatFunc K) := + mul_ne_zero RatFunc.X_ne_zero (sub_ne_zero.mpr hOneNeX) + simp only [splitTraceRadicand, splitTraceRadicandNumerator, + splitTraceRadicandDenominator, map_sub, map_one, map_mul, + RatFunc.algebraMap_C, RatFunc.algebraMap_X] + field_simp [hDenominator] + ring_nf + simp [RatFunc.X_ne_zero] + +lemma RatFunc.intDegree_pow (z : RatFunc K) (hz : z ≠ 0) (n : ℕ) : + (z ^ n).intDegree = (n : ℤ) * z.intDegree := by + induction n with + | zero => simp + | succ n ih => + rw [pow_succ, RatFunc.intDegree_mul (pow_ne_zero n hz) hz, ih] + push_cast + ring + +/-- An element of rational-function degree not divisible by `q` cannot be a `q`-th power. -/ +lemma RatFunc.pow_ne_of_not_dvd_intDegree + (a : RatFunc K) (ha : a ≠ 0) (q : ℕ) (hdegree : ¬ (q : ℤ) ∣ a.intDegree) + (z : RatFunc K) : + z ^ q ≠ a := by + intro hpow + by_cases hq : q = 0 + · subst q + apply hdegree + rw [← hpow] + simp + have hz : z ≠ 0 := by + intro hz + apply ha + simpa [hz, hq] using hpow.symm + apply hdegree + refine ⟨z.intDegree, ?_⟩ + rw [← hpow, RatFunc.intDegree_pow z hz q] + +/-- The monic quadratic defining the base function field. -/ +def splitTraceBaseKummerPolynomial (sigma : K) : Polynomial (RatFunc K) := + X ^ 2 - C (splitTraceRadicand sigma) + +theorem splitTraceBaseKummerPolynomial_irreducible + (sigma : K) (hsigma : sigma ≠ 0) : + Irreducible (splitTraceBaseKummerPolynomial sigma) := by + rw [splitTraceBaseKummerPolynomial] + apply X_pow_sub_C_irreducible_of_prime Nat.prime_two + intro z + apply RatFunc.pow_ne_of_not_dvd_intDegree + (splitTraceRadicand sigma) (splitTraceRadicand_ne_zero sigma hsigma) + rw [splitTraceRadicand_intDegree sigma hsigma] + norm_num + +/-- The quadratic base root has norm `-splitTraceRadicand sigma`. -/ +lemma norm_splitTraceBaseRoot + (sigma : K) (hsigma : sigma ≠ 0) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + Algebra.norm (RatFunc K) + (AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma)) = + -splitTraceRadicand sigma := by + let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + let pb := AdjoinRoot.powerBasis hIrred.ne_zero + change Algebra.norm (RatFunc K) pb.gen = -splitTraceRadicand sigma + rw [Algebra.PowerBasis.norm_gen_eq_coeff_zero_minpoly, + AdjoinRoot.minpoly_powerBasis_gen_of_monic] + · simp [pb, splitTraceBaseKummerPolynomial] + · exact monic_X_pow_sub_C _ (by norm_num) + +/-- A prime-power root of the base coordinate `v` cannot already lie in the quadratic base +function field. The obstruction is the rational-function degree `-1` of its norm. -/ +theorem splitTraceBaseRoot_not_primePower + (sigma : K) (hsigma : sigma ≠ 0) (q : ℕ) (hq : q.Prime) + (z : AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) : + z ^ q ≠ AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) := by + let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + intro hpow + have hnorm := congrArg (Algebra.norm (RatFunc K)) hpow + rw [map_pow, norm_splitTraceBaseRoot sigma hsigma] at hnorm + have hRadicandNegNe : -splitTraceRadicand sigma ≠ 0 := + neg_ne_zero.mpr (splitTraceRadicand_ne_zero sigma hsigma) + have hNotDvd : ¬ (q : ℤ) ∣ (-splitTraceRadicand sigma).intDegree := by + rw [RatFunc.intDegree_neg, splitTraceRadicand_intDegree sigma hsigma] + intro hdvd + rw [Int.natCast_dvd] at hdvd + exact hq.ne_one (Nat.eq_one_of_dvd_one hdvd) + exact RatFunc.pow_ne_of_not_dvd_intDegree + (-splitTraceRadicand sigma) hRadicandNegNe q hNotDvd + (Algebra.norm (RatFunc K) z) hnorm + +/-- For every positive odd `e`, adjoining an `e`-th root of the base coordinate `v` is a genuine +degree-`e` Kummer extension. -/ +theorem splitTraceEtaKummerPolynomial_irreducible + (sigma : K) (hsigma : sigma ≠ 0) (e : ℕ) (heOdd : Odd e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + Irreducible + (X ^ e - C (AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma))) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + apply X_pow_sub_C_irreducible_of_odd heOdd + intro q hq _ z + exact splitTraceBaseRoot_not_primePower sigma hsigma q hq z + +/-- The rational parameter `u`, embedded in the quadratic base function field. -/ +def splitTraceBaseU (sigma : K) : + AdjoinRoot (splitTraceBaseKummerPolynomial sigma) := + algebraMap (RatFunc K) _ RatFunc.X + +/-- The quadratic coordinate `v` in the base function field. -/ +def splitTraceBaseV (sigma : K) : + AdjoinRoot (splitTraceBaseKummerPolynomial sigma) := + AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) + +/-- The two base coordinates satisfy the birational trace equation inside the quadratic function +field. -/ +lemma splitTraceBaseU_V_equation + (sigma : K) (hsigma : sigma ≠ 0) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + splitTraceBaseU sigma * (1 - splitTraceBaseU sigma) * splitTraceBaseV sigma ^ 2 + + algebraMap (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (RatFunc.C sigma) * splitTraceBaseU sigma - 1 = 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + have hRootSquare : splitTraceBaseV sigma ^ 2 = + algebraMap (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (splitTraceRadicand sigma) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceBaseKummerPolynomial sigma) + rw [splitTraceBaseKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hMapped := congrArg + (algebraMap (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma))) + (splitTraceRadicand_equation sigma) + simp only [map_add, map_sub, map_mul, map_one, map_zero] at hMapped + rw [splitTraceBaseU, hRootSquare] + exact hMapped + +lemma splitTraceBaseFunctionField_finrank + (sigma : K) (hsigma : sigma ≠ 0) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + Module.finrank (RatFunc K) + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) = 2 := by + let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + rw [PowerBasis.finrank (AdjoinRoot.powerBasis hIrred.ne_zero)] + simp [splitTraceBaseKummerPolynomial] + +/-- The norm of `u * v` has rational-function degree one. This is the second independent divisor +obstruction used after adjoining the `e`-th root of `v`. -/ +lemma norm_splitTraceBaseU_mul_V_intDegree + (sigma : K) (hsigma : sigma ≠ 0) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + (Algebra.norm (RatFunc K) (splitTraceBaseU sigma * splitTraceBaseV sigma)).intDegree = 1 := by + let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + have hNorm : Algebra.norm (RatFunc K) (splitTraceBaseU sigma * splitTraceBaseV sigma) = + RatFunc.X ^ 2 * (-splitTraceRadicand sigma) := by + rw [map_mul] + rw [splitTraceBaseU, Algebra.norm_algebraMap, + splitTraceBaseFunctionField_finrank sigma hsigma] + rw [splitTraceBaseV, norm_splitTraceBaseRoot sigma hsigma] + rw [hNorm, RatFunc.intDegree_mul] + · rw [RatFunc.intDegree_pow RatFunc.X RatFunc.X_ne_zero, + RatFunc.intDegree_X, RatFunc.intDegree_neg, + splitTraceRadicand_intDegree sigma hsigma] + norm_num + · exact pow_ne_zero 2 RatFunc.X_ne_zero + · exact neg_ne_zero.mpr (splitTraceRadicand_ne_zero sigma hsigma) + +/-- The first Kummer polynomial, adjoining `eta` with `eta^e = v`. -/ +def splitTraceEtaKummerPolynomial (sigma : K) (e : ℕ) : + Polynomial (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + X ^ e - C (splitTraceBaseV sigma) + +lemma splitTraceEtaKummerPolynomial_irreducible' + (sigma : K) (hsigma : sigma ≠ 0) (e : ℕ) (heOdd : Odd e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + Irreducible (splitTraceEtaKummerPolynomial sigma e) := by + simpa [splitTraceEtaKummerPolynomial, splitTraceBaseV] using + splitTraceEtaKummerPolynomial_irreducible sigma hsigma e heOdd + +lemma splitTraceEtaFunctionField_finrank + (sigma : K) (hsigma : sigma ≠ 0) (e : ℕ) (heOdd : Odd e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + Module.finrank (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) = e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + rw [PowerBasis.finrank (AdjoinRoot.powerBasis hEtaIrred.ne_zero)] + simp [splitTraceEtaKummerPolynomial] + +/-- The second Kummer radicand, corresponding to `xi^d = u * v`. -/ +def splitTraceXiRadicand (sigma : K) (e : ℕ) : + AdjoinRoot (splitTraceEtaKummerPolynomial sigma e) := + algebraMap (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) _ + (splitTraceBaseU sigma * splitTraceBaseV sigma) + +/-- After adjoining the `e`-th root of `v`, the element `u*v` is not a `q`-th power whenever +`q` is prime and coprime to `e`. The proof takes two successive norms; their rational-function +degree forces `q` to divide `e`, a contradiction. -/ +theorem splitTraceXiRadicand_not_primePower + (sigma : K) (hsigma : sigma ≠ 0) (e : ℕ) (heOdd : Odd e) + (q : ℕ) (hq : q.Prime) (hqe : ¬ q ∣ e) + (z : AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) : + z ^ q ≠ splitTraceXiRadicand sigma e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + letI : Module.Finite (RatFunc K) + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot + have he : e ≠ 0 := by + rintro rfl + simp at heOdd + letI : Module.Finite (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + (monic_X_pow_sub_C _ he).finite_adjoinRoot + have hBaseV : splitTraceBaseV sigma ≠ 0 := by + change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 + have hroot := (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr + (splitTraceRadicand_ne_zero sigma hsigma) + exact hroot + have hBaseU : splitTraceBaseU sigma ≠ 0 := by + exact (map_ne_zero_iff _ + (algebraMap (RatFunc K) + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma))).injective).mpr RatFunc.X_ne_zero + have hBaseUV : splitTraceBaseU sigma * splitTraceBaseV sigma ≠ 0 := + mul_ne_zero hBaseU hBaseV + have hXiRadicand : splitTraceXiRadicand sigma e ≠ 0 := by + exact (map_ne_zero_iff _ + (algebraMap (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e))).injective).mpr hBaseUV + intro hpow + have hz : z ≠ 0 := by + intro hz + apply hXiRadicand + simpa [hz, hq.ne_zero] using hpow.symm + have hFirstNorm := congrArg + (Algebra.norm (AdjoinRoot (splitTraceBaseKummerPolynomial sigma))) hpow + rw [map_pow, splitTraceXiRadicand, Algebra.norm_algebraMap, + splitTraceEtaFunctionField_finrank sigma hsigma e heOdd] at hFirstNorm + have hSecondNorm := congrArg (Algebra.norm (RatFunc K)) hFirstNorm + rw [map_pow, map_pow] at hSecondNorm + have hNormZNe : + Algebra.norm (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) z ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hz + have hDoubleNormZNe : + Algebra.norm (RatFunc K) + (Algebra.norm (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) z) ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hNormZNe + have hNormBaseUVNe : + Algebra.norm (RatFunc K) (splitTraceBaseU sigma * splitTraceBaseV sigma) ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hBaseUV + have hDegree := congrArg RatFunc.intDegree hSecondNorm + rw [RatFunc.intDegree_pow _ hDoubleNormZNe, + RatFunc.intDegree_pow _ hNormBaseUVNe, + norm_splitTraceBaseU_mul_V_intDegree sigma hsigma] at hDegree + apply hqe + rw [← Int.natCast_dvd_natCast] + exact ⟨_, by simpa using hDegree.symm⟩ + +/-- The second Kummer polynomial, adjoining `xi` with `xi^d = u*v`. -/ +def splitTraceXiKummerPolynomial (sigma : K) (e d : ℕ) : + Polynomial (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + X ^ d - C (splitTraceXiRadicand sigma e) + +/-- The three fields in the explicit Kummer tower. -/ +abbrev SplitTraceBaseFunctionField (K : Type*) [Field K] (sigma : K) := + AdjoinRoot (splitTraceBaseKummerPolynomial sigma) + +abbrev SplitTraceEtaFunctionField (K : Type*) [Field K] (sigma : K) (e : ℕ) := + AdjoinRoot (splitTraceEtaKummerPolynomial sigma e) + +abbrev SplitTraceXiFunctionField (K : Type*) [Field K] (sigma : K) (e d : ℕ) := + AdjoinRoot (splitTraceXiKummerPolynomial sigma e d) + +/-- Embed a base-function-field element through both Kummer stages. -/ +def splitTraceBaseElementInXiField (sigma : K) (e d : ℕ) + (a : SplitTraceBaseFunctionField K sigma) : + SplitTraceXiFunctionField K sigma e d := + algebraMap (SplitTraceEtaFunctionField K sigma e) _ + (algebraMap (SplitTraceBaseFunctionField K sigma) _ a) + +/-- The canonical `eta` root, embedded into the top Kummer field. -/ +def splitTraceEtaRootInXiField (sigma : K) (e d : ℕ) : + SplitTraceXiFunctionField K sigma e d := + algebraMap (SplitTraceEtaFunctionField K sigma e) _ + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) + +/-- The canonical `xi` root in the top Kummer field. -/ +def splitTraceXiRoot (sigma : K) (e d : ℕ) : + SplitTraceXiFunctionField K sigma e d := + AdjoinRoot.root (splitTraceXiKummerPolynomial sigma e d) + +/-- For positive odd coprime exponents, the second Kummer polynomial is irreducible. This is the +connectedness step that the printed translate argument does not supply. -/ +theorem splitTraceXiKummerPolynomial_irreducible + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + Irreducible (splitTraceXiKummerPolynomial sigma e d) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + rw [splitTraceXiKummerPolynomial] + apply X_pow_sub_C_irreducible_of_odd hdOdd + intro q hq hqd z + have hqe : ¬ q ∣ e := + (hq.coprime_iff_not_dvd.mp (Nat.Coprime.of_dvd_left hqd hde)) + exact splitTraceXiRadicand_not_primePower sigma hsigma e heOdd q hq hqe z + +/-- The canonical roots of the proved Kummer tower lie on the exact cleared trace-cover +polynomial. This connects the function-field construction back to `splitTraceCoverPolynomial`. -/ +theorem splitTraceKummerTower_roots_on_cover + (sigma : K) (hsigma : sigma ≠ 0) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + MvPolynomial.eval + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] + (splitTraceCoverPolynomial 1 + (splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma))) + d e) = 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let baseToXi : SplitTraceBaseFunctionField K sigma →+* + SplitTraceXiFunctionField K sigma e d := + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)).comp + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)) + have hBase := splitTraceBaseU_V_equation sigma hsigma + have hBaseTop := congrArg baseToXi hBase + simp only [map_add, map_sub, map_mul, map_pow, map_one, map_zero] at hBaseTop + have hEtaRoot : + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ e = + algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) (splitTraceBaseV sigma) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceEtaKummerPolynomial sigma e) + rw [splitTraceEtaKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hEtaTop := congrArg + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)) hEtaRoot + simp only [map_pow] at hEtaTop + have hXiRoot : + (splitTraceXiRoot sigma e d) ^ d = + algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d) (splitTraceXiRadicand sigma e) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceXiKummerPolynomial sigma e d) + rw [splitTraceXiKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + apply eval_splitTraceCoverPolynomial_of_powerRootRelations + (splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma))) + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseU sigma)) + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseV sigma)) + (splitTraceXiRoot sigma e d) (splitTraceEtaRootInXiField sigma e d) d e + · simpa [baseToXi, splitTraceBaseElementInXiField] using hBaseTop + · simpa [splitTraceEtaRootInXiField, splitTraceBaseElementInXiField, baseToXi] using hEtaTop + · simpa [splitTraceXiRadicand, splitTraceBaseElementInXiField, baseToXi, + splitTraceXiRoot] using hXiRoot + +lemma splitTraceXiFunctionField_finrank + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + Module.finrank (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) + (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) = d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + rw [PowerBasis.finrank (AdjoinRoot.powerBasis hXiIrred.ne_zero)] + simp [splitTraceXiKummerPolynomial] + +/-- The iterated Kummer function-field tower for the odd, coprime split trace power cover is a +domain. All three irreducibility facts are constructed from the explicit norm-degree arguments +above; none is assumed as a field or typeclass parameter. This theorem does not yet identify the +tower with a localization or tensor base change of the affine coordinate ring. -/ +theorem splitTraceOddCoprimeKummerTower_isDomain + (sigma : K) (hsigma : sigma ≠ 0) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + IsDomain (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + exact AdjoinRoot.isDomain_of_prime hXiIrred.prime + +/-- Reconstructing the same explicit Kummer tower after an arbitrary extension of the constant +field again gives a domain. The remaining scheme-level wall is to identify this reconstructed +tower with the localization of the tensor-product base change of the original coordinate ring. -/ +theorem splitTraceOddCoprimeKummerTower_isDomain_afterConstantExtension + {L : Type*} [Field L] (phi : K →+* L) + (sigma : K) (hsigma : sigma ≠ 0) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial (phi sigma))) := + ⟨splitTraceBaseKummerPolynomial_irreducible (phi sigma) + ((map_ne_zero_iff phi phi.injective).mpr hsigma)⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial (phi sigma) e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' (phi sigma) + ((map_ne_zero_iff phi phi.injective).mpr hsigma) e heOdd⟩ + IsDomain (AdjoinRoot (splitTraceXiKummerPolynomial (phi sigma) e d)) := by + exact splitTraceOddCoprimeKummerTower_isDomain + (phi sigma) ((map_ne_zero_iff phi phi.injective).mpr hsigma) + e d heOdd hdOdd hde + +end RationalBase + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean new file mode 100644 index 0000000000..f0e2fa8a50 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean @@ -0,0 +1,366 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +import Mathlib.FieldTheory.RatFunc.IntermediateField + +/-! +# Injectivity of the Laurent comparison from cover irreducibility + +This file identifies the remaining Laurent-to-Kummer comparison wall with the actual +irreducibility assertion in the paper. The canonical `eta` coordinate in the Kummer tower is +proved transcendental over the constant field. Consequently it may be used as the coefficient +parameter in a rational-function field. An irreducible cleared cover polynomial then becomes the +minimal polynomial of the `xi` coordinate, so evaluation has exactly the expected principal +kernel. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +section Transcendence + +/-- The rational radicand is not a constant rational function. -/ +theorem splitTraceRadicand_not_constant (sigma : K) (hsigma : sigma ≠ 0) : + ¬ ∃ c : K, splitTraceRadicand sigma = RatFunc.C c := by + rintro ⟨c, hc⟩ + have hdegree := congrArg RatFunc.intDegree hc + rw [splitTraceRadicand_intDegree sigma hsigma] at hdegree + by_cases hc0 : c = 0 + · subst c + exact splitTraceRadicand_ne_zero sigma hsigma (by simpa using hc) + · simp at hdegree + +/-- The quadratic base coordinate is transcendental over the constant field. -/ +theorem splitTraceBaseV_transcendental (sigma : K) (hsigma : sigma ≠ 0) : + Transcendental K (splitTraceBaseV sigma) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + have hradicand : Transcendental K (splitTraceRadicand sigma) := + RatFunc.transcendental_of_ne_C _ + (splitTraceRadicand_not_constant sigma hsigma) + have hmapped : Transcendental K + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) + (splitTraceRadicand sigma)) := + (transcendental_algebraMap_iff + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)).injective).2 + hradicand + rw [← splitTraceBaseV_sq (sigma := sigma)] at hmapped + intro hV + exact hmapped (hV.pow 2) + +/-- The `eta` coordinate of the explicit odd-coprime Kummer tower is transcendental over `K`. +This is the coefficient-field input needed to turn bivariate evaluation into honest univariate +minimal-polynomial evaluation. -/ +theorem splitTraceEtaRootInXiField_transcendental + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Transcendental K (splitTraceEtaRootInXiField sigma e d) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + have hBaseV : Transcendental K (splitTraceBaseV sigma) := + splitTraceBaseV_transcendental sigma hsigma + have hBaseVTop : Transcendental K + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseV sigma)) := by + have hmap : Transcendental K + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma e d) (splitTraceBaseV sigma)) := + (transcendental_algebraMap_iff + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma e d)).injective).2 hBaseV + rw [splitTraceBaseElementInXiField, + ← IsScalarTower.algebraMap_apply + (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)] + exact hmap + rw [← splitTraceEtaRootInXiField_pow (sigma := sigma) (e := e) (d := d)] at hBaseVTop + intro hEta + exact hBaseVTop (hEta.pow e) + +end Transcendence + +section IteratedPresentation + +/-- The cleared cover, viewed as a polynomial in `x` with coefficients in `K[y]`. -/ +noncomputable def splitTraceCoverIteratedPolynomial + (sigma : K) (d e : ℕ) : Polynomial K[X] := + monomial (2 * d) (-(X ^ e)) + + monomial d (X ^ (2 * e) + C sigma) + + C (-(X ^ e)) + +theorem finTwoToIteratedPolynomial_splitTraceCoverPolynomial + (sigma : K) (d e : ℕ) : + finTwoToIteratedPolynomial (K := K) + (splitTraceCoverPolynomial (1 : K) sigma d e) = + splitTraceCoverIteratedPolynomial sigma d e := by + simp [splitTraceCoverPolynomial, splitTraceCoverIteratedPolynomial, + ← Polynomial.C_mul_X_pow_eq_monomial] + ring + +theorem splitTraceCoverIteratedPolynomial_coeff_two_mul + (sigma : K) (d e : ℕ) (hd : d ≠ 0) : + (splitTraceCoverIteratedPolynomial sigma d e).coeff (2 * d) = -(X ^ e) := by + have htwo_d_ne_d : 2 * d ≠ d := by omega + have hd_ne_two_d : d ≠ 2 * d := by omega + have htwo_d_ne_zero : 2 * d ≠ 0 := by omega + rw [splitTraceCoverIteratedPolynomial, coeff_add, coeff_add, + coeff_monomial, coeff_monomial, coeff_C_of_ne_zero htwo_d_ne_zero] + simp [hd_ne_two_d] + +theorem splitTraceCoverIteratedPolynomial_natDegree_ne_zero + (sigma : K) (d e : ℕ) (hd : d ≠ 0) : + (splitTraceCoverIteratedPolynomial sigma d e).natDegree ≠ 0 := by + have hcoeff : (splitTraceCoverIteratedPolynomial sigma d e).coeff (2 * d) ≠ 0 := by + rw [splitTraceCoverIteratedPolynomial_coeff_two_mul sigma d e hd] + exact neg_ne_zero.mpr (pow_ne_zero e X_ne_zero) + have hle := Polynomial.le_natDegree_of_ne_zero hcoeff + omega + +/-- Evaluation through the iterated-polynomial presentation is ordinary bivariate evaluation. +The outer polynomial variable is coordinate `0`, while the coefficient-polynomial variable is +coordinate `1`. -/ +theorem finTwoToIteratedPolynomial_aeval + {A : Type*} [CommRing A] [Algebra K A] + (p : MvPolynomial (Fin 2) K) (x y : A) : + Polynomial.aevalTower (Polynomial.aeval y) x + (finTwoToIteratedPolynomial (K := K) p) = + MvPolynomial.aeval ![x, y] p := by + let lhs : MvPolynomial (Fin 2) K →ₐ[K] A := + (Polynomial.aevalTower (Polynomial.aeval y) x).comp + (finTwoToIteratedPolynomial (K := K)).toAlgHom + let rhs : MvPolynomial (Fin 2) K →ₐ[K] A := + MvPolynomial.aeval ![x, y] + have heq : lhs = rhs := by + apply MvPolynomial.algHom_ext + intro i + fin_cases i <;> + simp [lhs, rhs, finTwoToIteratedPolynomial_X_zero, + finTwoToIteratedPolynomial_X_one] + exact DFunLike.congr_fun heq p + +private def splitTraceEtaPolynomialEvaluation + (sigma : K) (e d : ℕ) : + K[X] →ₐ[K] SplitTraceXiFunctionField K sigma e d := + Polynomial.aeval (splitTraceEtaRootInXiField sigma e d) + +private theorem splitTraceEtaPolynomialEvaluation_injective + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Function.Injective (splitTraceEtaPolynomialEvaluation sigma e d) := by + exact transcendental_iff_injective.mp + (splitTraceEtaRootInXiField_transcendental + sigma hsigma e d heOdd hdOdd hde) + +private def splitTraceEtaRatFuncEvaluation + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + RatFunc K →ₐ[K] SplitTraceXiFunctionField K sigma e d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + AdjoinRoot.isDomain_of_prime hXiIrred.prime + exact RatFunc.liftAlgHom (K := K) (S := K) + (L := SplitTraceXiFunctionField K sigma e d) + (splitTraceEtaPolynomialEvaluation sigma e d) + (nonZeroDivisors_le_comap_nonZeroDivisors_of_injective _ + (splitTraceEtaPolynomialEvaluation_injective + sigma hsigma e d heOdd hdOdd hde)) + +private theorem splitTraceEtaRatFuncEvaluation_algebraMap + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + (q : K[X]) : + splitTraceEtaRatFuncEvaluation sigma hsigma e d heOdd hdOdd hde + (algebraMap K[X] (RatFunc K) q) = + splitTraceEtaPolynomialEvaluation sigma e d q := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + exact RatFunc.liftRingHom_algebraMap _ _ q + +/-- Mapping an iterated polynomial to `K(y)[x]` and then specializing the transcendental +coefficient parameter `y` to the Kummer `eta` coordinate recovers direct bivariate evaluation. -/ +theorem splitTraceIteratedFractionEvaluation + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + (p : MvPolynomial (Fin 2) K) : + Polynomial.eval₂ + (splitTraceEtaRatFuncEvaluation sigma hsigma e d heOdd hdOdd hde).toRingHom + (splitTraceXiRoot sigma e d) + ((finTwoToIteratedPolynomial (K := K) p).map + (algebraMap K[X] (RatFunc K))) = + MvPolynomial.aeval + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] p := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + rw [Polynomial.eval₂_map] + have hcomp : + (splitTraceEtaRatFuncEvaluation sigma hsigma e d heOdd hdOdd hde).toRingHom.comp + (algebraMap K[X] (RatFunc K)) = + (splitTraceEtaPolynomialEvaluation sigma e d).toRingHom := by + apply DFunLike.ext _ _ + intro q + exact splitTraceEtaRatFuncEvaluation_algebraMap + sigma hsigma e d heOdd hdOdd hde q + rw [hcomp] + exact finTwoToIteratedPolynomial_aeval p + (splitTraceXiRoot sigma e d) (splitTraceEtaRootInXiField sigma e d) + +/-- Once the actual cleared cover polynomial is irreducible, its principal ideal is the full +kernel of evaluation at the Kummer coordinates. The proof uses `eta` as a transcendental +coefficient parameter and the irreducible iterated polynomial as the minimal polynomial of +`xi`. -/ +theorem splitTracePolynomial_mem_span_of_cover_irreducible_and_maps_to_zero + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + (hcover : Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e)) + (p : MvPolynomial (Fin 2) K) + (hp : splitTracePolynomialToKummerTop + sigma hsigma e d heOdd hdOdd hde p = 0) : + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + AdjoinRoot.isDomain_of_prime hXiIrred.prime + have hd : d ≠ 0 := by + rintro rfl + simp at hdOdd + let q : Polynomial K[X] := splitTraceCoverIteratedPolynomial sigma d e + let r : Polynomial K[X] := finTwoToIteratedPolynomial (K := K) p + have hqIrred : Irreducible q := by + have hmapped := hcover.map (finTwoToIteratedPolynomial (K := K)) + simpa [q, finTwoToIteratedPolynomial_splitTraceCoverPolynomial] using hmapped + have hqPrimitive : q.IsPrimitive := + hqIrred.isPrimitive + (splitTraceCoverIteratedPolynomial_natDegree_ne_zero sigma d e hd) + have hqFractionIrred : Irreducible + (q.map (algebraMap K[X] (RatFunc K))) := + hqPrimitive.irreducible_iff_irreducible_map_fraction_map.mp hqIrred + have hcoverEval : MvPolynomial.aeval + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] + (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := by + simpa [splitTracePolynomialToKummerTop, MvPolynomial.aeval_def] using + splitTracePolynomialToKummerTop_relation + sigma hsigma e d heOdd hdOdd hde + have hpEval : MvPolynomial.aeval + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] p = 0 := by + simpa [splitTracePolynomialToKummerTop, MvPolynomial.aeval_def] using hp + let phi : RatFunc K →ₐ[K] SplitTraceXiFunctionField K sigma e d := + splitTraceEtaRatFuncEvaluation sigma hsigma e d heOdd hdOdd hde + letI : Algebra (RatFunc K) (SplitTraceXiFunctionField K sigma e d) := + phi.toRingHom.toAlgebra + have hqRoot : Polynomial.aeval (splitTraceXiRoot sigma e d) + (q.map (algebraMap K[X] (RatFunc K))) = 0 := by + rw [Polynomial.aeval_def] + change Polynomial.eval₂ phi.toRingHom (splitTraceXiRoot sigma e d) + (q.map (algebraMap K[X] (RatFunc K))) = 0 + simpa [phi, q, finTwoToIteratedPolynomial_splitTraceCoverPolynomial] using + (splitTraceIteratedFractionEvaluation + sigma hsigma e d heOdd hdOdd hde + (splitTraceCoverPolynomial (1 : K) sigma d e)).trans hcoverEval + have hpRoot : Polynomial.aeval (splitTraceXiRoot sigma e d) + (r.map (algebraMap K[X] (RatFunc K))) = 0 := by + rw [Polynomial.aeval_def] + change Polynomial.eval₂ phi.toRingHom (splitTraceXiRoot sigma e d) + (r.map (algebraMap K[X] (RatFunc K))) = 0 + simpa [phi, r] using + (splitTraceIteratedFractionEvaluation + sigma hsigma e d heOdd hdOdd hde p).trans hpEval + have hminpoly : + q.map (algebraMap K[X] (RatFunc K)) * + C (q.map (algebraMap K[X] (RatFunc K))).leadingCoeff⁻¹ = + minpoly (RatFunc K) (splitTraceXiRoot sigma e d) := + minpoly.eq_of_irreducible hqFractionIrred hqRoot + have hqDvdMinpoly : + q.map (algebraMap K[X] (RatFunc K)) ∣ + minpoly (RatFunc K) (splitTraceXiRoot sigma e d) := + ⟨C (q.map (algebraMap K[X] (RatFunc K))).leadingCoeff⁻¹, + hminpoly.symm⟩ + have hminpolyDvd : + minpoly (RatFunc K) (splitTraceXiRoot sigma e d) ∣ + r.map (algebraMap K[X] (RatFunc K)) := + minpoly.dvd (RatFunc K) (splitTraceXiRoot sigma e d) hpRoot + have hqDvdFraction : + q.map (algebraMap K[X] (RatFunc K)) ∣ + r.map (algebraMap K[X] (RatFunc K)) := + hqDvdMinpoly.trans hminpolyDvd + have hqDvd : q ∣ r := + hqPrimitive.dvd_of_fraction_map_dvd_fraction_map hqDvdFraction + rw [Ideal.mem_span_singleton] + rcases hqDvd with ⟨s, hs⟩ + refine ⟨(finTwoToIteratedPolynomial (K := K)).symm s, ?_⟩ + apply (finTwoToIteratedPolynomial (K := K)).injective + simpa [q, r, finTwoToIteratedPolynomial_splitTraceCoverPolynomial] using hs + +/-- The paper's irreducibility assertion is sufficient for injectivity of the explicit +Laurent-to-Kummer comparison map. There is no additional hidden localization hypothesis: the +coordinate-product localization was already proved faithful. -/ +theorem splitTraceLaurentToKummerTop_injective_of_coverPolynomial_irreducible + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + (hcover : Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e)) : + Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + apply (splitTracePolynomialSyntacticNormalForm_division_iff_laurentInjective + sigma hsigma e d heOdd hdOdd hde hnondegenerate).1 + intro p hnormal + apply splitTracePolynomial_mem_span_of_cover_irreducible_and_maps_to_zero + sigma hsigma e d heOdd hdOdd hde hcover p + exact (splitTracePolynomialSyntacticNormalForm_eq_zero_iff + sigma hsigma e d heOdd hdOdd hde p).1 hnormal + +/-- Exact endgame wall: in the nondegenerate odd-coprime case, injectivity of the constructed +Laurent comparison is equivalent to irreducibility of the paper's cleared trace-cover polynomial. +Thus proving the published irreducibility lemma closes the comparison; no extra quotient-division +axiom is required. -/ +theorem splitTraceLaurentToKummerTop_injective_iff_coverPolynomial_irreducible + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) ↔ + Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by + constructor + · exact splitTraceCoverPolynomial_irreducible_of_laurentInjective + sigma hsigma e d heOdd hdOdd hde + · exact splitTraceLaurentToKummerTop_injective_of_coverPolynomial_irreducible + sigma hsigma hnondegenerate e d heOdd hdOdd hde + +end IteratedPresentation + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean new file mode 100644 index 0000000000..453060fbc7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean @@ -0,0 +1,204 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization + +/-! +# Jacobian control on the Laurent trace cover + +This file proves the algebraic nonsingularity calculation needed to identify the normalization +with the original trace curve away from the coordinate boundary. The two formal partial +derivatives generate the unit ideal in the Laurent coordinate ring when `2`, `d`, and `e` are +nonzero and the paper's parameter condition `alpha * beta ≠ 1` holds. + +The proof exposes the characteristic assumptions and gives an explicit ideal calculation. It does +not assume smoothness or normality as a structure field. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The nonunit-free factor of the partial derivative with respect to `x`. -/ +def weightedSplitTraceLaurentJacobianXFactor (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + algebraMap K _ alpha * weightedSplitTraceLaurentY alpha beta d e ^ (2 * e) + + algebraMap K _ beta - + 2 * weightedSplitTraceLaurentX alpha beta d e ^ d * + weightedSplitTraceLaurentY alpha beta d e ^ e + +/-- The nonunit-free factor of the partial derivative with respect to `y`. -/ +def weightedSplitTraceLaurentJacobianYFactor (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + 2 * algebraMap K _ alpha * weightedSplitTraceLaurentX alpha beta d e ^ d * + weightedSplitTraceLaurentY alpha beta d e ^ e - + weightedSplitTraceLaurentX alpha beta d e ^ (2 * d) - 1 + +/-- Exact evaluation formula for the first formal partial derivative. -/ +theorem splitTraceCoverPolynomial_pderiv_zero_eval + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (x y : K) : + MvPolynomial.eval ![x, y] + (MvPolynomial.pderiv 0 (splitTraceCoverPolynomial alpha beta d e)) = + (d : K) * x ^ (d - 1) * + (alpha * y ^ (2 * e) + beta - 2 * x ^ d * y ^ e) := by + have htwoD : 2 * d - 1 = (d - 1) + d := by omega + simp [splitTraceCoverPolynomial, htwoD, pow_add] + ring + +/-- Exact evaluation formula for the second formal partial derivative. -/ +theorem splitTraceCoverPolynomial_pderiv_one_eval + (alpha beta : K) (d e : ℕ) (he : 0 < e) (x y : K) : + MvPolynomial.eval ![x, y] + (MvPolynomial.pderiv 1 (splitTraceCoverPolynomial alpha beta d e)) = + (e : K) * y ^ (e - 1) * + (2 * alpha * x ^ d * y ^ e - x ^ (2 * d) - 1) := by + have htwoE : 2 * e - 1 = (e - 1) + e := by omega + simp [splitTraceCoverPolynomial, htwoE, pow_add] + ring + +/-- The first formal partial derivative evaluated in the Laurent coordinate ring. -/ +def weightedSplitTraceLaurentPartialX (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentY alpha beta d e] + (MvPolynomial.pderiv 0 (splitTraceCoverPolynomial alpha beta d e)) + +/-- The second formal partial derivative evaluated in the Laurent coordinate ring. -/ +def weightedSplitTraceLaurentPartialY (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentY alpha beta d e] + (MvPolynomial.pderiv 1 (splitTraceCoverPolynomial alpha beta d e)) + +theorem weightedSplitTraceLaurentPartialX_eq (alpha beta : K) (d e : ℕ) (hd : 0 < d) : + weightedSplitTraceLaurentPartialX alpha beta d e = + algebraMap K _ (d : K) * weightedSplitTraceLaurentX alpha beta d e ^ (d - 1) * + weightedSplitTraceLaurentJacobianXFactor alpha beta d e := by + have htwoD : 2 * d - 1 = (d - 1) + d := by omega + simp [weightedSplitTraceLaurentPartialX, weightedSplitTraceLaurentJacobianXFactor, MvPolynomial.aeval_def, + splitTraceCoverPolynomial, htwoD, pow_add] + ring + +theorem weightedSplitTraceLaurentPartialY_eq (alpha beta : K) (d e : ℕ) (he : 0 < e) : + weightedSplitTraceLaurentPartialY alpha beta d e = + algebraMap K _ (e : K) * weightedSplitTraceLaurentY alpha beta d e ^ (e - 1) * + weightedSplitTraceLaurentJacobianYFactor alpha beta d e := by + have htwoE : 2 * e - 1 = (e - 1) + e := by omega + simp [weightedSplitTraceLaurentPartialY, weightedSplitTraceLaurentJacobianYFactor, MvPolynomial.aeval_def, + splitTraceCoverPolynomial, htwoE, pow_add] + ring + +theorem weightedSplitTraceLaurentJacobianFactors_span_top + (alpha beta : K) (hnondegenerate : alpha * beta ≠ 1) + (htwo : (2 : K) ≠ 0) (d e : ℕ) : + Ideal.span {weightedSplitTraceLaurentJacobianXFactor alpha beta d e, + weightedSplitTraceLaurentJacobianYFactor alpha beta d e} = ⊤ := by + let L := WeightedSplitTraceLaurentCoordinateRing alpha beta d e + let x : L := weightedSplitTraceLaurentX alpha beta d e + let y : L := weightedSplitTraceLaurentY alpha beta d e + let X : L := x ^ d + let Y : L := y ^ e + let a : L := algebraMap K L alpha + let b : L := algebraMap K L beta + let A : L := weightedSplitTraceLaurentJacobianXFactor alpha beta d e + let B : L := weightedSplitTraceLaurentJacobianYFactor alpha beta d e + let I : Ideal L := Ideal.span {A, B} + change I = ⊤ + have hAeq : A = a * Y ^ 2 + b - 2 * X * Y := by + simp [A, a, b, X, Y, x, y, L, weightedSplitTraceLaurentJacobianXFactor, Nat.mul_comm, pow_mul] + have hBeq : B = 2 * a * X * Y - X ^ 2 - 1 := by + simp [B, a, X, Y, x, y, L, weightedSplitTraceLaurentJacobianYFactor, Nat.mul_comm, pow_mul] + have hA : A ∈ I := Ideal.subset_span (by simp) + have hB : B ∈ I := Ideal.subset_span (by simp) + have hF : a * X * Y ^ 2 + b * X - X ^ 2 * Y - Y = 0 := by + have h := weightedSplitTraceLaurentDefiningRelation alpha beta d e + change a * x ^ d * y ^ (2 * e) + b * x ^ d - + x ^ (2 * d) * y ^ e - y ^ e = 0 at h + rw [show y ^ (2 * e) = Y ^ 2 by simp [Y, Nat.mul_comm, pow_mul], + show x ^ (2 * d) = X ^ 2 by simp [X, Nat.mul_comm, pow_mul]] at h + exact h + have hYUnit : IsUnit Y := by + exact (weightedSplitTraceLaurentY_isUnit alpha beta d e).pow e + have hTwoUnit : IsUnit (2 : L) := by + simpa only [map_ofNat] using + (isUnit_iff_ne_zero.mpr htwo).map (algebraMap K L) + have hXSquare : X ^ 2 - 1 ∈ I := by + apply (I.unit_mul_mem_iff_mem hYUnit).mp + have hXA : X * A ∈ I := I.mul_mem_left X hA + have : Y * (X ^ 2 - 1) = -(X * A) := by + rw [hAeq] + linear_combination hF + rw [this] + exact I.neg_mem hXA + have hAlphaXY : a * X * Y - 1 ∈ I := by + apply (I.unit_mul_mem_iff_mem hTwoUnit).mp + have hsum : B + (X ^ 2 - 1) ∈ I := I.add_mem hB hXSquare + rw [hBeq] at hsum + convert hsum using 1 + all_goals ring + have hAlphaSquareY : a ^ 2 * Y ^ 2 - 1 ∈ I := by + have hproduct : (a * X * Y - 1) * (a * X * Y + 1) ∈ I := + I.mul_mem_right (a * X * Y + 1) hAlphaXY + have hcorrection : a ^ 2 * Y ^ 2 * (X ^ 2 - 1) ∈ I := + I.mul_mem_left (a ^ 2 * Y ^ 2) hXSquare + have hsub := I.sub_mem hproduct hcorrection + convert hsub using 1 + all_goals ring + have hProductMinusOne : a * b - 1 ∈ I := by + have haA : a * A ∈ I := I.mul_mem_left a hA + rw [hAeq] at haA + have htwice : 2 * (a * X * Y - 1) ∈ I := I.mul_mem_left 2 hAlphaXY + have hcombination := I.add_mem (I.sub_mem haA hAlphaSquareY) htwice + convert hcombination using 1 + all_goals ring + have hProductUnit : IsUnit (a * b - 1) := by + have h : IsUnit (alpha * beta - 1) := + isUnit_iff_ne_zero.mpr (sub_ne_zero.mpr hnondegenerate) + simpa [a, b, L] using h.map (algebraMap K L) + exact I.eq_top_of_isUnit_mem hProductMinusOne hProductUnit + +theorem weightedSplitTraceLaurentPartials_span_top + (alpha beta : K) (hnondegenerate : alpha * beta ≠ 1) + (htwo : (2 : K) ≠ 0) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hdChar : (d : K) ≠ 0) (heChar : (e : K) ≠ 0) : + Ideal.span {weightedSplitTraceLaurentPartialX alpha beta d e, + weightedSplitTraceLaurentPartialY alpha beta d e} = ⊤ := by + let L := WeightedSplitTraceLaurentCoordinateRing alpha beta d e + let J : Ideal L := Ideal.span {weightedSplitTraceLaurentPartialX alpha beta d e, + weightedSplitTraceLaurentPartialY alpha beta d e} + have hFactorTop := weightedSplitTraceLaurentJacobianFactors_span_top alpha beta hnondegenerate htwo d e + apply le_antisymm le_top + rw [← hFactorTop] + apply Ideal.span_le.mpr + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · have hPartial : weightedSplitTraceLaurentPartialX alpha beta d e ∈ J := + Ideal.subset_span (by simp) + rw [weightedSplitTraceLaurentPartialX_eq alpha beta d e hd] at hPartial + have hDegreeUnit : IsUnit (algebraMap K L (d : K)) := + (isUnit_iff_ne_zero.mpr hdChar).map (algebraMap K L) + have hXPowerUnit : + IsUnit (weightedSplitTraceLaurentX alpha beta d e ^ (d - 1)) := + (weightedSplitTraceLaurentX_isUnit alpha beta d e).pow (d - 1) + exact (J.unit_mul_mem_iff_mem (hDegreeUnit.mul hXPowerUnit)).mp hPartial + · have hPartial : weightedSplitTraceLaurentPartialY alpha beta d e ∈ J := + Ideal.subset_span (by simp) + rw [weightedSplitTraceLaurentPartialY_eq alpha beta d e he] at hPartial + have hDegreeUnit : IsUnit (algebraMap K L (e : K)) := + (isUnit_iff_ne_zero.mpr heChar).map (algebraMap K L) + have hYPowerUnit : + IsUnit (weightedSplitTraceLaurentY alpha beta d e ^ (e - 1)) := + (weightedSplitTraceLaurentY_isUnit alpha beta d e).pow (e - 1) + exact (J.unit_mul_mem_iff_mem (hDegreeUnit.mul hYPowerUnit)).mp hPartial + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean new file mode 100644 index 0000000000..0e9218efa1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean @@ -0,0 +1,488 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +import Mathlib.RingTheory.Localization.Integral + +/-! +# Normalized Laurent overlap transitions + +This module lifts the explicit Laurent chart transitions to integral closures in the corresponding +fraction fields. The lift is constructed directly: integrality is transported simultaneously +along the coordinate-ring equivalence and its induced fraction-field equivalence. In particular, +no unproved `smooth implies normal` bridge is used. + +The final cocycle is proved first in the fraction fields and then in the integral closures. Its +domain hypotheses are precisely the domain instances obtained from the already-proved +irreducibility of the two affine chart equations. +-/ + +namespace BGS.Markoff + +open AlgebraicGeometry + +noncomputable section + +section IntegralClosureTransport + +variable {K A B C : Type*} [Field K] +variable [CommRing A] [CommRing B] [CommRing C] +variable [Algebra K A] [Algebra K B] [Algebra K C] +variable [IsDomain A] [IsDomain B] [IsDomain C] + +omit [IsDomain A] [IsDomain B] in +private theorem fractionRingEquiv_maps_integral + (e : A ≃ₐ[K] B) (x : integralClosure A (FractionRing A)) : + IsIntegral B + ((IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e) (x : FractionRing A)) := by + apply IsIntegral.map_of_comp_eq (R := A) (S := FractionRing A) + (T := B) (U := FractionRing B) e.toRingEquiv.toRingHom + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e).toRingEquiv.toRingHom + · ext a + exact (IsFractionRing.algEquivOfAlgEquiv_algebraMap + (K := FractionRing A) (L := FractionRing B) e a).symm + · exact x.property + +/-- An equivalence of domain algebras transports their integral closures in their fraction fields. -/ +def integralClosureFractionRingEquiv (e : A ≃ₐ[K] B) : + integralClosure A (FractionRing A) ≃+* + integralClosure B (FractionRing B) where + toFun x := ⟨(IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e) (x : FractionRing A), + fractionRingEquiv_maps_integral e x⟩ + invFun y := ⟨(IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing B) (L := FractionRing A) e.symm) (y : FractionRing B), + fractionRingEquiv_maps_integral e.symm y⟩ + left_inv x := by + ext + exact (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e).symm_apply_apply x + right_inv y := by + ext + exact (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e).apply_symm_apply y + map_add' x y := by + ext + exact map_add _ _ _ + map_mul' x y := by + ext + exact map_mul _ _ _ + +omit [IsDomain A] [IsDomain B] in +@[simp] +theorem integralClosureFractionRingEquiv_coe (e : A ≃ₐ[K] B) + (x : integralClosure A (FractionRing A)) : + ((integralClosureFractionRingEquiv e x : + integralClosure B (FractionRing B)) : FractionRing B) = + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e) (x : FractionRing A) := rfl + +omit [IsDomain A] [IsDomain B] in +/-- The lifted integral-closure equivalence extends the original coordinate-ring equivalence. -/ +theorem integralClosureFractionRingEquiv_comp_algebraMap (e : A ≃ₐ[K] B) : + (integralClosureFractionRingEquiv e).toRingHom.comp + (algebraMap A (integralClosure A (FractionRing A))) = + (algebraMap B (integralClosure B (FractionRing B))).comp e.toRingHom := by + apply DFunLike.ext _ _ + intro a + apply Subtype.ext + exact IsFractionRing.algEquivOfAlgEquiv_algebraMap + (K := FractionRing A) (L := FractionRing B) e a + +omit [IsDomain A] [IsDomain B] in +@[simp] +theorem integralClosureFractionRingEquiv_symm (e : A ≃ₐ[K] B) : + (integralClosureFractionRingEquiv e).symm = + integralClosureFractionRingEquiv e.symm := rfl + +omit [IsDomain B] in +/-- Passing to fraction fields respects composition of algebra equivalences. -/ +theorem fractionRingEquiv_trans (e : A ≃ₐ[K] B) (f : B ≃ₐ[K] C) : + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e).trans + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing B) (L := FractionRing C) f) = + IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing C) (e.trans f) := by + apply AlgEquiv.ext + intro x + have h : + ((IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e).trans + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing B) (L := FractionRing C) f)).toRingEquiv.toRingHom = + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing C) (e.trans f)).toRingEquiv.toRingHom := by + apply IsFractionRing.ringHom_ext (A := A) + intro a + simp + exact RingHom.congr_fun h x + +omit [IsDomain B] in +/-- Transport of integral closures respects composition. -/ +theorem integralClosureFractionRingEquiv_trans + (e : A ≃ₐ[K] B) (f : B ≃ₐ[K] C) : + (integralClosureFractionRingEquiv e).trans + (integralClosureFractionRingEquiv f) = + integralClosureFractionRingEquiv (e.trans f) := by + ext x + change + ((IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing A) (L := FractionRing B) e).trans + (IsFractionRing.algEquivOfAlgEquiv + (K := FractionRing B) (L := FractionRing C) f)) x = _ + rw [fractionRingEquiv_trans] + rfl + +end IntegralClosureTransport + +section IntegralClosureLocalization + +variable {R : Type*} [CommRing R] [IsDomain R] + +/-- The canonical map from a principal open of an integral domain to the corresponding principal +open of its normalization. -/ +def integralClosureAwayMap (f : R) : + Localization.Away f →+* + Localization.Away (algebraMap R (integralClosure R (FractionRing R)) f) := by + letI : IsLocalization.Away + ((Algebra.ofId R (integralClosure R (FractionRing R))) f) + (Localization.Away (algebraMap R (integralClosure R (FractionRing R)) f)) := by + simpa using (inferInstance : IsLocalization.Away + (algebraMap R (integralClosure R (FractionRing R)) f) + (Localization.Away (algebraMap R (integralClosure R (FractionRing R)) f))) + exact (IsLocalization.Away.mapₐ + (Localization.Away f) + (Localization.Away (algebraMap R (integralClosure R (FractionRing R)) f)) + (Algebra.ofId R (integralClosure R (FractionRing R))) f).toRingHom + +/-- The localization comparison for normalization, bundled with the square that identifies its +restriction on the original principal open. Keeping the square in the data prevents the +normalization chart transition from being used without its compatibility with the raw chart. -/ +structure IntegralClosureAwayComparison (f : R) where + equiv : + Localization.Away (algebraMap R (integralClosure R (FractionRing R)) f) ≃+* + integralClosure (Localization.Away f) (FractionRing (Localization.Away f)) + equiv_comp_map : equiv.toRingHom.comp (integralClosureAwayMap f) = + algebraMap (Localization.Away f) + (integralClosure (Localization.Away f) (FractionRing (Localization.Away f))) + +/-- Normalizing an integral domain and then restricting to a nonempty principal open agrees with +normalizing that principal open in its own fraction field, compatibly with the raw principal open. + +The construction makes all comparison maps explicit. The fraction field of `R` is first given +its compatible `Localization.Away f`-algebra structure. Mathlib's +`IsLocalization.Away.integralClosure` then identifies the intermediate integral closure as a +localization of `integralClosure R (FractionRing R)`, and `FractionRing.algEquiv` compares the +intermediate ambient field with the canonical fraction field of `Localization.Away f`. -/ +def integralClosureAwayComparison (f : R) (hf : f ≠ 0) : + IntegralClosureAwayComparison f := by + let Rf := Localization.Away f + let F := FractionRing R + let N := integralClosure R F + have hfF : algebraMap R F f ≠ 0 := + (map_ne_zero_iff (algebraMap R F) (FaithfulSMul.algebraMap_injective R F)).mpr hf + have hfUnit : IsUnit (algebraMap R F f) := isUnit_iff_ne_zero.mpr hfF + let phi : Rf →ₐ[R] F := + IsLocalization.Away.liftAlgHom f (f := Algebra.ofId R F) hfUnit + letI : Algebra Rf F := phi.toRingHom.toAlgebra + letI : IsScalarTower R Rf F := IsScalarTower.of_algebraMap_eq' (by + ext r + exact (phi.commutes r).symm) + letI : IsFractionRing Rf F := + IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + (Submonoid.powers f) Rf F + let T := integralClosure Rf F + let Nf := integralClosure Rf (FractionRing Rf) + let fracEquiv : FractionRing Rf ≃ₐ[Rf] F := FractionRing.algEquiv Rf F + let psi : N →+* T := + { toFun := fun x ↦ ⟨(x : F), x.property.tower_top⟩ + map_one' := rfl + map_mul' := fun _ _ ↦ rfl + map_zero' := rfl + map_add' := fun _ _ ↦ rfl } + letI : Algebra N T := psi.toAlgebra + letI : IsScalarTower N T F := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower R N T := IsScalarTower.of_algebraMap_eq' (by + ext r + rfl) + letI : IsLocalization.Away (algebraMap R F f) F := + IsLocalization.away_of_isUnit_of_bijective F hfUnit Function.bijective_id + letI : IsLocalization.Away (algebraMap R N f) T := + IsLocalization.Away.integralClosure (S := F) (Rf := Rf) (Sf := F) f + let localizationEquiv : Localization.Away (algebraMap R N f) ≃ₐ[N] T := + IsLocalization.algEquiv (Submonoid.powers (algebraMap R N f)) + (Localization.Away (algebraMap R N f)) T + let ambientFieldEquiv : T ≃+* Nf := + (fracEquiv.mapIntegralClosure).symm.toRingEquiv + let e := localizationEquiv.toRingEquiv.trans ambientFieldEquiv + refine ⟨e, ?_⟩ + apply IsLocalization.ringHom_ext (M := Submonoid.powers f) + ext r + simp [e, localizationEquiv, ambientFieldEquiv, integralClosureAwayMap] + apply_fun fracEquiv + have hmap (x : T) : + fracEquiv ↑(fracEquiv.mapIntegralClosure.symm x) = (x : F) := by + exact congrArg Subtype.val (fracEquiv.mapIntegralClosure.apply_symm_apply x) + rw [hmap] + rw [show + (algebraMap R (Localization.Away (algebraMap R N f))) r = + (algebraMap N (Localization.Away (algebraMap R N f))) ((algebraMap R N) r) by + simpa using + (IsScalarTower.algebraMap_apply R N + (Localization.Away (algebraMap R N f)) r)] + rw [localizationEquiv.commutes] + rw [fracEquiv.commutes] + change + algebraMap T F (algebraMap N T (algebraMap R N r)) = + algebraMap Rf F (algebraMap R Rf r) + rw [← IsScalarTower.algebraMap_apply N T F] + rw [← IsScalarTower.algebraMap_apply R N F] + rw [← IsScalarTower.algebraMap_apply R Rf F] + +/-- The ring equivalence underlying `integralClosureAwayComparison`. -/ +def integralClosureAwayEquiv (f : R) (hf : f ≠ 0) : + Localization.Away (algebraMap R (integralClosure R (FractionRing R)) f) ≃+* + integralClosure (Localization.Away f) (FractionRing (Localization.Away f)) := + (integralClosureAwayComparison f hf).equiv + +/-- The localization equivalence carries the canonical raw-to-normalized principal-open map to +the canonical normalization map of the raw principal open. -/ +theorem integralClosureAwayEquiv_comp_map (f : R) (hf : f ≠ 0) : + (integralClosureAwayEquiv f hf).toRingHom.comp (integralClosureAwayMap f) = + algebraMap (Localization.Away f) + (integralClosure (Localization.Away f) (FractionRing (Localization.Away f))) := + (integralClosureAwayComparison f hf).equiv_comp_map + +end IntegralClosureLocalization + +section TraceCoverCharts + +variable {K : Type*} [Field K] + +/-- Coordinate ring of the affine normalization, before passing to `Spec`. -/ +abbrev WeightedSplitTraceAffineNormalizationRing + (alpha beta : K) (d e : ℕ) := + integralClosure (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (FractionRing (WeightedSplitTraceAffineCoordinateRing alpha beta d e)) + +/-- Normalization ring of the common Laurent overlap of a trace-cover affine chart. -/ +abbrev WeightedSplitTraceLaurentNormalizationRing + (alpha beta : K) (d e : ℕ) := + integralClosure (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (FractionRing (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)) + +/-- Irreducibility and positivity ensure that localizing away from the coordinate product is a +genuine nonzero open. The proof exposes the two possible coordinate-axis divisors and rules them +out by evaluation at `(0, 1)` and `(1, 0)`. -/ +theorem weightedSplitTraceAffineCoordinateProduct_ne_zero_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + weightedSplitTraceAffineCoordinateProduct alpha beta d e ≠ 0 := by + intro hzero + have hmul : MvPolynomial.X (0 : Fin 2) * MvPolynomial.X (1 : Fin 2) ∈ + Ideal.span {splitTraceCoverPolynomial alpha beta d e} := by + exact Ideal.Quotient.eq_zero_iff_mem.mp hzero + rw [Ideal.mem_span_singleton] at hmul + rcases h.prime.dvd_mul.mp hmul with hx | hy + · have ha := h.prime.associated_of_dvd (MvPolynomial.X_prime (i := (0 : Fin 2))) hx + have hamap := ha.map (MvPolynomial.eval ![0, 1]) + simp [eval_splitTraceCoverPolynomial, hd.ne'] at hamap + · have ha := h.prime.associated_of_dvd (MvPolynomial.X_prime (i := (1 : Fin 2))) hy + have hamap := ha.map (MvPolynomial.eval ![1, 0]) + simp [eval_splitTraceCoverPolynomial, he.ne', hbeta] at hamap + +/-- The Laurent coordinate ring is a domain once irreducibility proves that its affine source is +a domain and the preceding theorem proves that the inverted coordinate product is nonzero. -/ +theorem weightedSplitTraceLaurentCoordinateRing_isDomain + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + exact IsLocalization.Away.isDomain + (S := WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct_ne_zero_of_irreducible + alpha beta d e hd he hbeta h) + +/-- The normalized Laurent overlap is the principal open of the affine normalization obtained by +inverting the original coordinate product. Both the affine-domain and nonempty-open hypotheses +are discharged from irreducibility and positivity. -/ +def weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + Localization.Away + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceAffineNormalizationRing alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) ≃+* + WeightedSplitTraceLaurentNormalizationRing alpha beta d e := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + exact integralClosureAwayEquiv + (weightedSplitTraceAffineCoordinateProduct alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct_ne_zero_of_irreducible + alpha beta d e hd he hbeta h) + +/-- Scheme-level form of the normalized principal-open comparison. -/ +def weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e)) ≅ + Spec (CommRingCat.of (Localization.Away + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceAffineNormalizationRing alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct alpha beta d e)))) := + BGS.specIsoOfRingEquiv + (weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + alpha beta d e hd he hbeta h) + +variable (alpha beta : K) (d e : ℕ) +variable [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] +variable [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] + +/-- The first-coordinate inversion lifted to the normalized Laurent overlap. -/ +def weightedSplitTraceLeftInversionLaurentNormalizationEquiv : + WeightedSplitTraceLaurentNormalizationRing alpha beta d e ≃+* + WeightedSplitTraceLaurentNormalizationRing alpha beta d e := + integralClosureFractionRingEquiv + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e) + +/-- The second-coordinate inversion lifted to the normalized Laurent overlap. -/ +def weightedSplitTraceRightInversionLaurentNormalizationEquiv : + WeightedSplitTraceLaurentNormalizationRing beta alpha d e ≃+* + WeightedSplitTraceLaurentNormalizationRing alpha beta d e := + integralClosureFractionRingEquiv + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e) + +omit [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] in +/-- The coordinate-ring transition equivalences satisfy the same square cocycle as their maps. -/ +theorem weightedSplitTraceLaurentInversionEquivs_commute : + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e).trans + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e) = + (weightedSplitTraceLeftInversionLaurentEquiv beta alpha d e).trans + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e) := by + apply AlgEquiv.ext + intro x + exact DFunLike.congr_fun + (weightedSplitTraceLaurentInversions_commute alpha beta d e) x + +/-- The lifted normalization transitions satisfy the required square cocycle. -/ +theorem weightedSplitTraceLaurentNormalizationInversions_commute : + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e).trans + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e) = + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv beta alpha d e).trans + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e) := by + simp only [weightedSplitTraceRightInversionLaurentNormalizationEquiv, + weightedSplitTraceLeftInversionLaurentNormalizationEquiv] + rw [integralClosureFractionRingEquiv_trans, + integralClosureFractionRingEquiv_trans, + weightedSplitTraceLaurentInversionEquivs_commute] + +omit [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] in +/-- The normalization cocycle with its domain instances explicitly discharged by the two affine +irreducibility theorems. This is the upstream-to-downstream wiring used by the geometric charts. -/ +theorem weightedSplitTraceLaurentNormalizationInversions_commute_of_irreducible + (hd : 0 < d) (he : 0 < e) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e).trans + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e) = + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv beta alpha d e).trans + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e) := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + exact weightedSplitTraceLaurentNormalizationInversions_commute alpha beta d e + +/-- Scheme isomorphism on the normalized overlap induced by first-coordinate inversion. -/ +def weightedSplitTraceLeftInversionLaurentNormalizationSchemeIso : + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e)) ≅ + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e)) := + BGS.specIsoOfRingEquiv + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e) + +/-- Contravariant scheme isomorphism on normalized overlaps induced by second-coordinate inversion. -/ +def weightedSplitTraceRightInversionLaurentNormalizationSchemeIso : + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e)) ≅ + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing beta alpha d e)) := + BGS.specIsoOfRingEquiv + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e) + +section ConjugatedPrincipalOpenTransitions + +universe u + +variable {OA OB : Type u} [CommRing OA] [CommRing OB] + +/-- Transport first-coordinate inversion from the normalized Laurent ring to any explicitly +identified principal-open ring model. -/ +def conjugatedLeftNormalizationOpenEquiv + (openEquiv : OA ≃+* WeightedSplitTraceLaurentNormalizationRing alpha beta d e) : + OA ≃+* OA := + openEquiv.trans + ((weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e).trans + openEquiv.symm) + +/-- Transport second-coordinate inversion between two explicitly identified principal-open ring +models. -/ +def conjugatedRightNormalizationOpenEquiv + (openEquiv : OA ≃+* WeightedSplitTraceLaurentNormalizationRing alpha beta d e) + (swappedOpenEquiv : OB ≃+* WeightedSplitTraceLaurentNormalizationRing beta alpha d e) : + OB ≃+* OA := + swappedOpenEquiv.trans + ((weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e).trans + openEquiv.symm) + +/-- Conjugating by arbitrary principal-open identifications preserves the normalization cocycle. -/ +theorem conjugatedNormalizationOpenInversions_commute + (openEquiv : OA ≃+* WeightedSplitTraceLaurentNormalizationRing alpha beta d e) + (swappedOpenEquiv : OB ≃+* WeightedSplitTraceLaurentNormalizationRing beta alpha d e) : + (conjugatedRightNormalizationOpenEquiv alpha beta d e openEquiv swappedOpenEquiv).trans + (conjugatedLeftNormalizationOpenEquiv alpha beta d e openEquiv) = + (conjugatedLeftNormalizationOpenEquiv beta alpha d e swappedOpenEquiv).trans + (conjugatedRightNormalizationOpenEquiv alpha beta d e openEquiv swappedOpenEquiv) := by + ext x + simp only [conjugatedRightNormalizationOpenEquiv, conjugatedLeftNormalizationOpenEquiv, + RingEquiv.trans_apply, RingEquiv.apply_symm_apply] + exact congrArg openEquiv.symm + (DFunLike.congr_fun + (weightedSplitTraceLaurentNormalizationInversions_commute alpha beta d e) + (swappedOpenEquiv x)) + +/-- Scheme automorphism of a principal-open model induced by first-coordinate inversion. -/ +def conjugatedLeftNormalizationOpenSchemeIso + (openEquiv : OA ≃+* WeightedSplitTraceLaurentNormalizationRing alpha beta d e) : + Spec (CommRingCat.of OA) ≅ Spec (CommRingCat.of OA) := + BGS.specIsoOfRingEquiv + (conjugatedLeftNormalizationOpenEquiv alpha beta d e openEquiv) + +/-- Contravariant scheme isomorphism of principal-open models induced by second-coordinate +inversion. -/ +def conjugatedRightNormalizationOpenSchemeIso + (openEquiv : OA ≃+* WeightedSplitTraceLaurentNormalizationRing alpha beta d e) + (swappedOpenEquiv : OB ≃+* WeightedSplitTraceLaurentNormalizationRing beta alpha d e) : + Spec (CommRingCat.of OA) ≅ Spec (CommRingCat.of OB) := + BGS.specIsoOfRingEquiv + (conjugatedRightNormalizationOpenEquiv alpha beta d e + openEquiv swappedOpenEquiv) + +end ConjugatedPrincipalOpenTransitions + +end TraceCoverCharts + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean new file mode 100644 index 0000000000..fb008e19c7 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean @@ -0,0 +1,426 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +import Mathlib.RingTheory.Smooth.Locus +import Mathlib.RingTheory.Smooth.StandardSmooth +import Mathlib.RingTheory.Smooth.StandardSmoothCotangent + +/-! +# Smoothness of the Laurent trace cover + +This module converts the Jacobian unit-ideal calculation into an actual `Algebra.Smooth` theorem. +It constructs submersive presentations on the two principal opens where the formal partial +derivatives are inverted, proves those localizations standard smooth, and covers the prime +spectrum using `weightedSplitTraceLaurentPartials_span_top`. + +The construction is explicit: no smoothness or normality assumption is stored in a structure or +passed as an opaque typeclass premise. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable {K : Type*} [Field K] + +/-! ### Finite presentations and the first-partial smooth chart -/ + +/-- The singleton family of equations presenting the affine trace cover. -/ +def weightedSplitTraceRelationFamily (alpha beta : K) (d e : ℕ) (_ : Unit) : + MvPolynomial (Fin 2) K := splitTraceCoverPolynomial alpha beta d e + +def weightedSplitTraceAffinePresentationEquiv (alpha beta : K) (d e : ℕ) : + (MvPolynomial (Fin 2) K ⧸ Ideal.span (Set.range + (weightedSplitTraceRelationFamily alpha beta d e))) ≃ₐ[K] + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + Ideal.quotientEquivAlgOfEq K (by + congr 1 + ext p + simp [weightedSplitTraceRelationFamily, eq_comm]) + +def weightedSplitTraceAffineXPreSubmersivePresentation (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation K + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) (Fin 2) Unit := + (Algebra.PreSubmersivePresentation.naive + (v := weightedSplitTraceRelationFamily alpha beta d e) + (fun _ => 0) (fun _ _ _ => Subsingleton.elim _ _)).ofAlgEquiv + (weightedSplitTraceAffinePresentationEquiv alpha beta d e) + +noncomputable instance weightedSplitTraceAffineFinitePresentation (alpha beta : K) (d e : ℕ) : + Algebra.FinitePresentation K + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + Algebra.Presentation.finitePresentation_of_isFinite + (weightedSplitTraceAffineXPreSubmersivePresentation alpha beta d e).toPresentation + +noncomputable instance weightedSplitTraceLaurentFinitePresentation (alpha beta : K) (d e : ℕ) : + Algebra.FinitePresentation K + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + Algebra.FinitePresentation.trans K + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + +def weightedSplitTraceAffinePartialX (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + Ideal.Quotient.mk _ + (MvPolynomial.pderiv 0 (splitTraceCoverPolynomial alpha beta d e)) + +theorem weightedSplitTraceAffineXPreSubmersivePresentation_jacobian + (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceAffineXPreSubmersivePresentation alpha beta d e).jacobian = + weightedSplitTraceAffinePartialX alpha beta d e := by + let P := Algebra.PreSubmersivePresentation.naive + (v := weightedSplitTraceRelationFamily alpha beta d e) + (fun _ => 0) (fun _ _ _ => Subsingleton.elim _ _) + let E := weightedSplitTraceAffinePresentationEquiv alpha beta d e + change (P.ofAlgEquiv E).jacobian = weightedSplitTraceAffinePartialX alpha beta d e + rw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, + Algebra.PreSubmersivePresentation.jacobian_eq_jacobiMatrix_det, + Matrix.det_unique, Algebra.PreSubmersivePresentation.jacobiMatrix_naive] + change E (Ideal.Quotient.mk _ + (MvPolynomial.pderiv 0 (splitTraceCoverPolynomial alpha beta d e))) = + Ideal.Quotient.mk _ + (MvPolynomial.pderiv 0 (splitTraceCoverPolynomial alpha beta d e)) + exact Ideal.quotientEquivAlgOfEq_mk K _ _ + +theorem weightedSplitTraceLaurentEval_eq_algebraMap_mk + (alpha beta : K) (d e : ℕ) (p : MvPolynomial (Fin 2) K) : + MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentY alpha beta d e] p = + algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (Ideal.Quotient.mk _ p) := by + let ev : MvPolynomial (Fin 2) K →ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentY alpha beta d e] + let q : MvPolynomial (Fin 2) K →ₐ[K] + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + Ideal.Quotient.mkₐ K _ + let inclusion : WeightedSplitTraceAffineCoordinateRing alpha beta d e →ₐ[K] + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + { toRingHom := algebraMap _ _ + commutes' := fun k => IsScalarTower.algebraMap_apply K + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) k } + have h : ev = + inclusion.comp q := by + apply MvPolynomial.algHom_ext + intro i + fin_cases i <;> + simp [ev, q, inclusion, AlgHom.comp_apply, weightedSplitTraceLaurentX, + weightedSplitTraceLaurentY, weightedSplitTraceAffineX, + weightedSplitTraceAffineY] + change ev p = _ + rw [h] + rfl + +theorem weightedSplitTraceAffinePartialX_mapsToLaurent + (alpha beta : K) (d e : ℕ) : + algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (weightedSplitTraceAffinePartialX alpha beta d e) = + weightedSplitTraceLaurentPartialX alpha beta d e := by + symm + exact weightedSplitTraceLaurentEval_eq_algebraMap_mk alpha beta d e _ + +abbrev WeightedSplitTracePartialXLocalization (alpha beta : K) (d e : ℕ) := + Localization.Away (weightedSplitTraceLaurentPartialX alpha beta d e) + +def weightedSplitTraceCoordinateProductPreSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) Unit Unit := + Algebra.PreSubmersivePresentation.localizationAway + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct alpha beta d e) + +def weightedSplitTraceLaurentXPreSubmersivePresentation (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation K + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (Unit ⊕ Fin 2) (Unit ⊕ Unit) := + (weightedSplitTraceCoordinateProductPreSubmersivePresentation alpha beta d e).comp + (weightedSplitTraceAffineXPreSubmersivePresentation alpha beta d e) + +def weightedSplitTracePartialXLocalizationPreSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (WeightedSplitTracePartialXLocalization alpha beta d e) Unit Unit := + Algebra.PreSubmersivePresentation.localizationAway + (WeightedSplitTracePartialXLocalization alpha beta d e) + (weightedSplitTraceLaurentPartialX alpha beta d e) + +def weightedSplitTracePartialXCompositePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation K + (WeightedSplitTracePartialXLocalization alpha beta d e) + (Unit ⊕ (Unit ⊕ Fin 2)) (Unit ⊕ (Unit ⊕ Unit)) := + (weightedSplitTracePartialXLocalizationPreSubmersivePresentation alpha beta d e).comp + (weightedSplitTraceLaurentXPreSubmersivePresentation alpha beta d e) + +theorem weightedSplitTracePartialXCompositePresentation_jacobian_isUnit + (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTracePartialXCompositePresentation alpha beta d e).jacobian := by + let A := WeightedSplitTraceAffineCoordinateRing alpha beta d e + let L := WeightedSplitTraceLaurentCoordinateRing alpha beta d e + let Lx := WeightedSplitTracePartialXLocalization alpha beta d e + let P₀ := weightedSplitTraceAffineXPreSubmersivePresentation alpha beta d e + let Qxy := weightedSplitTraceCoordinateProductPreSubmersivePresentation alpha beta d e + let P₁ := weightedSplitTraceLaurentXPreSubmersivePresentation alpha beta d e + let Qx := weightedSplitTracePartialXLocalizationPreSubmersivePresentation alpha beta d e + have hP₀ : IsUnit (algebraMap L Lx (algebraMap A L P₀.jacobian)) := by + rw [show P₀.jacobian = weightedSplitTraceAffinePartialX alpha beta d e by + exact weightedSplitTraceAffineXPreSubmersivePresentation_jacobian alpha beta d e] + rw [weightedSplitTraceAffinePartialX_mapsToLaurent] + exact IsLocalization.Away.algebraMap_isUnit + (S := Lx) (weightedSplitTraceLaurentPartialX alpha beta d e) + have hQxy : IsUnit (algebraMap L Lx Qxy.jacobian) := by + rw [show Qxy.jacobian = algebraMap A L + (weightedSplitTraceAffineCoordinateProduct alpha beta d e) by + exact Algebra.PreSubmersivePresentation.localizationAway_jacobian _] + exact (IsLocalization.Away.algebraMap_isUnit + (S := L) (weightedSplitTraceAffineCoordinateProduct alpha beta d e)).map + (algebraMap L Lx) + have hQx : IsUnit Qx.jacobian := by + rw [show Qx.jacobian = algebraMap L Lx + (weightedSplitTraceLaurentPartialX alpha beta d e) by + exact Algebra.PreSubmersivePresentation.localizationAway_jacobian _] + exact IsLocalization.Away.algebraMap_isUnit + (S := Lx) (weightedSplitTraceLaurentPartialX alpha beta d e) + change IsUnit (Qx.comp P₁).jacobian + rw [Algebra.PreSubmersivePresentation.comp_jacobian_eq_jacobian_smul_jacobian, + Algebra.smul_def] + have hP₁ : IsUnit (algebraMap L Lx P₁.jacobian) := by + change IsUnit (algebraMap L Lx (Qxy.comp P₀).jacobian) + rw [Algebra.PreSubmersivePresentation.comp_jacobian_eq_jacobian_smul_jacobian, + Algebra.smul_def, map_mul] + exact hP₀.mul hQxy + exact hP₁.mul hQx + +def weightedSplitTracePartialXSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.SubmersivePresentation K + (WeightedSplitTracePartialXLocalization alpha beta d e) + (Unit ⊕ (Unit ⊕ Fin 2)) (Unit ⊕ (Unit ⊕ Unit)) where + toPreSubmersivePresentation := + weightedSplitTracePartialXCompositePresentation alpha beta d e + jacobian_isUnit := + weightedSplitTracePartialXCompositePresentation_jacobian_isUnit alpha beta d e + +theorem weightedSplitTracePartialXLocalization_isStandardSmooth + (alpha beta : K) (d e : ℕ) : + Algebra.IsStandardSmooth K + (WeightedSplitTracePartialXLocalization alpha beta d e) := + (weightedSplitTracePartialXSubmersivePresentation alpha beta d e).isStandardSmooth + +theorem weightedSplitTracePartialXLocalization_smooth + (alpha beta : K) (d e : ℕ) : + Algebra.Smooth K (WeightedSplitTracePartialXLocalization alpha beta d e) := by + letI : Algebra.IsStandardSmooth K + (WeightedSplitTracePartialXLocalization alpha beta d e) := + weightedSplitTracePartialXLocalization_isStandardSmooth alpha beta d e + infer_instance + +/-! ### The second-partial smooth chart -/ + +/-- The affine second partial derivative, before localization at the coordinate product. -/ +def weightedSplitTraceAffinePartialY (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e := + Ideal.Quotient.mk _ + (MvPolynomial.pderiv 1 (splitTraceCoverPolynomial alpha beta d e)) + +/-- The hypersurface presentation selecting the `y` column of its Jacobian matrix. -/ +def weightedSplitTraceAffineYPreSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation K + (WeightedSplitTraceAffineCoordinateRing alpha beta d e) (Fin 2) Unit := + (Algebra.PreSubmersivePresentation.naive + (v := weightedSplitTraceRelationFamily alpha beta d e) + (fun _ => 1) (fun _ _ _ => Subsingleton.elim _ _)).ofAlgEquiv + (weightedSplitTraceAffinePresentationEquiv alpha beta d e) + +theorem weightedSplitTraceAffineYPreSubmersivePresentation_jacobian + (alpha beta : K) (d e : ℕ) : + (weightedSplitTraceAffineYPreSubmersivePresentation alpha beta d e).jacobian = + weightedSplitTraceAffinePartialY alpha beta d e := by + let P := Algebra.PreSubmersivePresentation.naive + (v := weightedSplitTraceRelationFamily alpha beta d e) + (fun _ => 1) (fun _ _ _ => Subsingleton.elim _ _) + let E := weightedSplitTraceAffinePresentationEquiv alpha beta d e + change (P.ofAlgEquiv E).jacobian = weightedSplitTraceAffinePartialY alpha beta d e + rw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, + Algebra.PreSubmersivePresentation.jacobian_eq_jacobiMatrix_det, + Matrix.det_unique, Algebra.PreSubmersivePresentation.jacobiMatrix_naive] + change E (Ideal.Quotient.mk _ + (MvPolynomial.pderiv 1 (splitTraceCoverPolynomial alpha beta d e))) = + Ideal.Quotient.mk _ + (MvPolynomial.pderiv 1 (splitTraceCoverPolynomial alpha beta d e)) + exact Ideal.quotientEquivAlgOfEq_mk K _ _ + +theorem weightedSplitTraceAffinePartialY_mapsToLaurent + (alpha beta : K) (d e : ℕ) : + algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (weightedSplitTraceAffinePartialY alpha beta d e) = + weightedSplitTraceLaurentPartialY alpha beta d e := by + symm + exact weightedSplitTraceLaurentEval_eq_algebraMap_mk alpha beta d e _ + +/-- The principal open on which the second partial derivative is invertible. -/ +abbrev WeightedSplitTracePartialYLocalization (alpha beta : K) (d e : ℕ) := + Localization.Away (weightedSplitTraceLaurentPartialY alpha beta d e) + +/-- Laurent presentation whose hypersurface Jacobian is the second partial derivative. -/ +def weightedSplitTraceLaurentYPreSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation K + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (Unit ⊕ Fin 2) (Unit ⊕ Unit) := + (weightedSplitTraceCoordinateProductPreSubmersivePresentation alpha beta d e).comp + (weightedSplitTraceAffineYPreSubmersivePresentation alpha beta d e) + +def weightedSplitTracePartialYLocalizationPreSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) + (WeightedSplitTracePartialYLocalization alpha beta d e) Unit Unit := + Algebra.PreSubmersivePresentation.localizationAway + (WeightedSplitTracePartialYLocalization alpha beta d e) + (weightedSplitTraceLaurentPartialY alpha beta d e) + +def weightedSplitTracePartialYCompositePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.PreSubmersivePresentation K + (WeightedSplitTracePartialYLocalization alpha beta d e) + (Unit ⊕ (Unit ⊕ Fin 2)) (Unit ⊕ (Unit ⊕ Unit)) := + (weightedSplitTracePartialYLocalizationPreSubmersivePresentation alpha beta d e).comp + (weightedSplitTraceLaurentYPreSubmersivePresentation alpha beta d e) + +theorem weightedSplitTracePartialYCompositePresentation_jacobian_isUnit + (alpha beta : K) (d e : ℕ) : + IsUnit (weightedSplitTracePartialYCompositePresentation alpha beta d e).jacobian := by + let A := WeightedSplitTraceAffineCoordinateRing alpha beta d e + let L := WeightedSplitTraceLaurentCoordinateRing alpha beta d e + let Ly := WeightedSplitTracePartialYLocalization alpha beta d e + let P₀ := weightedSplitTraceAffineYPreSubmersivePresentation alpha beta d e + let Qxy := weightedSplitTraceCoordinateProductPreSubmersivePresentation alpha beta d e + let P₁ := weightedSplitTraceLaurentYPreSubmersivePresentation alpha beta d e + let Qy := weightedSplitTracePartialYLocalizationPreSubmersivePresentation alpha beta d e + have hP₀ : IsUnit (algebraMap L Ly (algebraMap A L P₀.jacobian)) := by + rw [show P₀.jacobian = weightedSplitTraceAffinePartialY alpha beta d e by + exact weightedSplitTraceAffineYPreSubmersivePresentation_jacobian alpha beta d e] + rw [weightedSplitTraceAffinePartialY_mapsToLaurent] + exact IsLocalization.Away.algebraMap_isUnit + (S := Ly) (weightedSplitTraceLaurentPartialY alpha beta d e) + have hQxy : IsUnit (algebraMap L Ly Qxy.jacobian) := by + rw [show Qxy.jacobian = algebraMap A L + (weightedSplitTraceAffineCoordinateProduct alpha beta d e) by + exact Algebra.PreSubmersivePresentation.localizationAway_jacobian _] + exact (IsLocalization.Away.algebraMap_isUnit + (S := L) (weightedSplitTraceAffineCoordinateProduct alpha beta d e)).map + (algebraMap L Ly) + have hQy : IsUnit Qy.jacobian := by + rw [show Qy.jacobian = algebraMap L Ly + (weightedSplitTraceLaurentPartialY alpha beta d e) by + exact Algebra.PreSubmersivePresentation.localizationAway_jacobian _] + exact IsLocalization.Away.algebraMap_isUnit + (S := Ly) (weightedSplitTraceLaurentPartialY alpha beta d e) + change IsUnit (Qy.comp P₁).jacobian + rw [Algebra.PreSubmersivePresentation.comp_jacobian_eq_jacobian_smul_jacobian, + Algebra.smul_def] + have hP₁ : IsUnit (algebraMap L Ly P₁.jacobian) := by + change IsUnit (algebraMap L Ly (Qxy.comp P₀).jacobian) + rw [Algebra.PreSubmersivePresentation.comp_jacobian_eq_jacobian_smul_jacobian, + Algebra.smul_def, map_mul] + exact hP₀.mul hQxy + exact hP₁.mul hQy + +def weightedSplitTracePartialYSubmersivePresentation + (alpha beta : K) (d e : ℕ) : + Algebra.SubmersivePresentation K + (WeightedSplitTracePartialYLocalization alpha beta d e) + (Unit ⊕ (Unit ⊕ Fin 2)) (Unit ⊕ (Unit ⊕ Unit)) where + toPreSubmersivePresentation := + weightedSplitTracePartialYCompositePresentation alpha beta d e + jacobian_isUnit := + weightedSplitTracePartialYCompositePresentation_jacobian_isUnit alpha beta d e + +theorem weightedSplitTracePartialYLocalization_isStandardSmooth + (alpha beta : K) (d e : ℕ) : + Algebra.IsStandardSmooth K + (WeightedSplitTracePartialYLocalization alpha beta d e) := + (weightedSplitTracePartialYSubmersivePresentation alpha beta d e).isStandardSmooth + +theorem weightedSplitTracePartialYLocalization_smooth + (alpha beta : K) (d e : ℕ) : + Algebra.Smooth K (WeightedSplitTracePartialYLocalization alpha beta d e) := by + letI : Algebra.IsStandardSmooth K + (WeightedSplitTracePartialYLocalization alpha beta d e) := + weightedSplitTracePartialYLocalization_isStandardSmooth alpha beta d e + infer_instance + +theorem weightedSplitTraceLaurent_smooth_of_partialLocalizations + (alpha beta : K) (d e : ℕ) + (hspan : Ideal.span {weightedSplitTraceLaurentPartialX alpha beta d e, + weightedSplitTraceLaurentPartialY alpha beta d e} = ⊤) + (hX : Algebra.Smooth K + (Localization.Away (weightedSplitTraceLaurentPartialX alpha beta d e))) + (hY : Algebra.Smooth K + (Localization.Away (weightedSplitTraceLaurentPartialY alpha beta d e))) : + Algebra.Smooth K (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by + let L := WeightedSplitTraceLaurentCoordinateRing alpha beta d e + let fx : L := weightedSplitTraceLaurentPartialX alpha beta d e + let fy : L := weightedSplitTraceLaurentPartialY alpha beta d e + have hXOpen : (PrimeSpectrum.basicOpen fx : Set (PrimeSpectrum L)) ⊆ + Algebra.smoothLocus K L := + Algebra.basicOpen_subset_smoothLocus_iff_smooth.mpr hX + have hYOpen : (PrimeSpectrum.basicOpen fy : Set (PrimeSpectrum L)) ⊆ + Algebra.smoothLocus K L := + Algebra.basicOpen_subset_smoothLocus_iff_smooth.mpr hY + have hLocus : Algebra.smoothLocus K L = Set.univ := by + apply Set.eq_univ_of_forall + intro p + by_cases hpx : p ∈ PrimeSpectrum.basicOpen fx + · exact hXOpen hpx + by_cases hpy : p ∈ PrimeSpectrum.basicOpen fy + · exact hYOpen hpy + have hfx : fx ∈ p.asIdeal := by + simpa [PrimeSpectrum.mem_basicOpen] using hpx + have hfy : fy ∈ p.asIdeal := by + simpa [PrimeSpectrum.mem_basicOpen] using hpy + exfalso + have hle : Ideal.span {fx, fy} ≤ p.asIdeal := by + rw [Ideal.span_le] + intro z hz + simp only [Set.mem_insert_iff, Set.mem_singleton_iff] at hz + rcases hz with rfl | rfl + · exact hfx + · exact hfy + have hpTop : p.asIdeal = ⊤ := top_unique (hspan ▸ hle) + exact p.isPrime.ne_top hpTop + exact ⟨(Algebra.smoothLocus_eq_univ_iff.mp hLocus), inferInstance⟩ + +/-- The Laurent trace-cover algebra is smooth over the ground field in the paper's +nondegenerate, characteristic-compatible range. -/ +theorem weightedSplitTraceLaurent_smooth + (alpha beta : K) (hnondegenerate : alpha * beta ≠ 1) + (htwo : (2 : K) ≠ 0) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hdChar : (d : K) ≠ 0) (heChar : (e : K) ≠ 0) : + Algebra.Smooth K + (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurent_smooth_of_partialLocalizations alpha beta d e + (weightedSplitTraceLaurentPartials_span_top alpha beta hnondegenerate + htwo d e hd he hdChar heChar) + (weightedSplitTracePartialXLocalization_smooth alpha beta d e) + (weightedSplitTracePartialYLocalization_smooth alpha beta d e) + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean new file mode 100644 index 0000000000..5153c4de13 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean @@ -0,0 +1,396 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +import Mathlib.RingTheory.Localization.Away.Basic + +/-! +# The Laurent split trace cover inside its Kummer function field + +This file constructs the comparison map that was missing between the denominator-cleared affine +trace-cover coordinate ring, localized away from the two coordinate axes, and the explicit +odd-coprime Kummer tower. Injectivity is kept as the visible remaining wall; it is not encoded as +an axiom or typeclass field. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The affine coordinate ring of the normalized split trace cover. -/ +abbrev SplitTraceAffineCoordinateRing (K : Type*) [Field K] + (sigma : K) (d e : ℕ) := + MvPolynomial (Fin 2) K ⧸ + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + +/-- The product of the two coordinate functions in the affine trace-cover ring. -/ +def splitTraceAffineCoordinateProduct (sigma : K) (d e : ℕ) : + SplitTraceAffineCoordinateRing K sigma d e := + Ideal.Quotient.mk _ (MvPolynomial.X 0 * MvPolynomial.X 1) + +/-- The coordinate ring of the open trace cover in the two-dimensional torus. -/ +abbrev SplitTraceLaurentCoordinateRing (K : Type*) [Field K] + (sigma : K) (d e : ℕ) := + Localization.Away (splitTraceAffineCoordinateProduct sigma d e) + +section OddCoprimeTower + +variable (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + +/-- Evaluation of the two affine coordinates at the canonical roots of the Kummer tower. -/ +def splitTracePolynomialToKummerTop : + MvPolynomial (Fin 2) K →ₐ[K] SplitTraceXiFunctionField K sigma e d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + exact MvPolynomial.aeval ![splitTraceXiRoot sigma e d, + splitTraceEtaRootInXiField sigma e d] + +/-- The defining affine trace-cover relation vanishes under evaluation in the Kummer tower. -/ +lemma splitTracePolynomialToKummerTop_relation : + splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde + (splitTraceCoverPolynomial 1 sigma d e) = 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + have hCover := splitTraceKummerTower_roots_on_cover + sigma hsigma e d heOdd hdOdd hde + have hsigmaMap : + splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma)) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) sigma := by + rw [show RatFunc.C sigma = algebraMap K (RatFunc K) sigma by + rw [RatFunc.algebraMap_eq_C]] + change algebraMap (RatFunc K) (SplitTraceXiFunctionField K sigma e d) + (algebraMap K (RatFunc K) sigma) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) sigma + exact (IsScalarTower.algebraMap_apply K (RatFunc K) + (SplitTraceXiFunctionField K sigma e d) sigma).symm + rw [hsigmaMap] at hCover + simpa [splitTracePolynomialToKummerTop, MvPolynomial.aeval_def, + splitTraceCoverPolynomial] using hCover + +/-- The affine trace-cover coordinate ring maps canonically to the Kummer top field. -/ +def splitTraceAffineToKummerTop : + SplitTraceAffineCoordinateRing K sigma d e →ₐ[K] + SplitTraceXiFunctionField K sigma e d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + refine Ideal.Quotient.liftₐ + (Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e}) + (splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde) ?_ + intro p hp + have hle : Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} ≤ + RingHom.ker + (splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom := by + rw [Ideal.span_le] + intro q hq + simp only [Set.mem_singleton_iff] at hq + subst q + exact splitTracePolynomialToKummerTop_relation sigma hsigma e d heOdd hdOdd hde + exact hle hp + +@[simp] +lemma splitTraceAffineToKummerTop_coordinate (i : Fin 2) : + splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde + (Ideal.Quotient.mk _ (MvPolynomial.X i)) = + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] i := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + simp [splitTraceAffineToKummerTop, splitTracePolynomialToKummerTop] + +lemma splitTraceBaseV_sq : + splitTraceBaseV sigma ^ 2 = + algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) + (splitTraceRadicand sigma) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceBaseKummerPolynomial sigma) + rw [splitTraceBaseKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + +lemma splitTraceEtaRoot_pow : + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ e = + algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) (splitTraceBaseV sigma) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceEtaKummerPolynomial sigma e) + rw [splitTraceEtaKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + +lemma splitTraceXiRoot_pow : + splitTraceXiRoot sigma e d ^ d = + algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d) (splitTraceXiRadicand sigma e) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceXiKummerPolynomial sigma e d) + rw [splitTraceXiKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + +lemma splitTraceBaseV_ne_zero (hsigma : sigma ≠ 0) : splitTraceBaseV sigma ≠ 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr + (splitTraceRadicand_ne_zero sigma hsigma) + +lemma splitTraceBaseU_ne_zero (hsigma : sigma ≠ 0) : splitTraceBaseU sigma ≠ 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + exact (map_ne_zero_iff _ + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)).injective).mpr + RatFunc.X_ne_zero + +lemma splitTraceEtaRootInXiField_ne_zero + (hsigma : sigma ≠ 0) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + splitTraceEtaRootInXiField sigma e d ≠ 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + apply (map_ne_zero_iff _ + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)).injective).mpr + change AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e) ≠ 0 + change AdjoinRoot.root (X ^ e - C (splitTraceBaseV sigma)) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hEtaIrred).mpr + (splitTraceBaseV_ne_zero (sigma := sigma) hsigma) + +lemma splitTraceXiRoot_ne_zero + (hsigma : sigma ≠ 0) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + splitTraceXiRoot sigma e d ≠ 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + have hRadicand : splitTraceXiRadicand sigma e ≠ 0 := by + apply (map_ne_zero_iff _ + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)).injective).mpr + exact mul_ne_zero + (splitTraceBaseU_ne_zero (sigma := sigma) hsigma) + (splitTraceBaseV_ne_zero (sigma := sigma) hsigma) + change AdjoinRoot.root (X ^ d - C (splitTraceXiRadicand sigma e)) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hXiIrred).mpr hRadicand + +lemma splitTraceAffineCoordinateProduct_maps_to_nonzero : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde + (splitTraceAffineCoordinateProduct sigma d e) ≠ 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + change splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde + (Ideal.Quotient.mk _ (MvPolynomial.X 0 * MvPolynomial.X 1)) ≠ 0 + simp only [map_mul] + rw [splitTraceAffineToKummerTop_coordinate, splitTraceAffineToKummerTop_coordinate] + exact mul_ne_zero + (splitTraceXiRoot_ne_zero (sigma := sigma) (e := e) (d := d) + hsigma heOdd hdOdd hde) + (splitTraceEtaRootInXiField_ne_zero (sigma := sigma) (e := e) (d := d) + hsigma heOdd hdOdd hde) + +/-- The image of the coordinate product is a unit for algebraic reasons internal to the Kummer +tower. This proof uses the three root-power equations, rather than treating the top quotient as a +field through a late typeclass instance. -/ +lemma splitTraceAffineCoordinateProduct_maps_to_isUnit : + IsUnit (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde + (splitTraceAffineCoordinateProduct sigma d e)) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + have hBaseUUnit : IsUnit (splitTraceBaseU sigma) := + (isUnit_iff_ne_zero.mpr RatFunc.X_ne_zero).map + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)) + have hBaseVUnit : IsUnit (splitTraceBaseV sigma) := by + apply (isUnit_pow_iff (by norm_num : (2 : ℕ) ≠ 0)).mp + rw [splitTraceBaseV_sq] + exact (isUnit_iff_ne_zero.mpr (splitTraceRadicand_ne_zero sigma hsigma)).map + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)) + have hEtaUnit : + IsUnit (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) := by + have he : e ≠ 0 := by + rintro rfl + simp at heOdd + apply (isUnit_pow_iff he).mp + rw [splitTraceEtaRoot_pow] + exact hBaseVUnit.map + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)) + have hEtaTopUnit : IsUnit (splitTraceEtaRootInXiField sigma e d) := + hEtaUnit.map (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)) + have hXiRadicandUnit : IsUnit (splitTraceXiRadicand sigma e) := + (hBaseUUnit.mul hBaseVUnit).map + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)) + have hXiUnit : IsUnit (splitTraceXiRoot sigma e d) := by + have hd : d ≠ 0 := by + rintro rfl + simp at hdOdd + apply (isUnit_pow_iff hd).mp + rw [splitTraceXiRoot_pow] + exact hXiRadicandUnit.map + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)) + have himage : + splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde + (splitTraceAffineCoordinateProduct sigma d e) = + splitTraceXiRoot sigma e d * splitTraceEtaRootInXiField sigma e d := by + change splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde + (Ideal.Quotient.mk _ (MvPolynomial.X 0 * MvPolynomial.X 1)) = _ + simp only [map_mul] + rw [splitTraceAffineToKummerTop_coordinate, splitTraceAffineToKummerTop_coordinate] + simp + rw [himage] + exact hXiUnit.mul hEtaTopUnit + +/-- The affine comparison map extends uniquely across the localization inverting both trace-cover +coordinates. -/ +def splitTraceLaurentToKummerTop : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + SplitTraceLaurentCoordinateRing K sigma d e →ₐ[K] + SplitTraceXiFunctionField K sigma e d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + apply IsLocalization.Away.liftAlgHom (splitTraceAffineCoordinateProduct sigma d e) + exact splitTraceAffineCoordinateProduct_maps_to_isUnit + sigma hsigma e d heOdd hdOdd hde + +theorem splitTraceLaurentToKummerTop_algebraMap_apply + (a : SplitTraceAffineCoordinateRing K sigma d e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde + (algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e) a) = + splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + simp only [splitTraceLaurentToKummerTop, IsLocalization.Away.liftAlgHom_apply] + apply IsLocalization.Away.lift_eq + +/-- Injectivity of the Laurent comparison map is reduced exactly to injectivity of the affine +quotient map. No domain hypothesis is manufactured here: proving the affine map injective is the +remaining kernel-equality/irreducibility wall. -/ +theorem splitTraceLaurentToKummerTop_injective_of_affine_injective + (hAffine : Function.Injective + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde)) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + apply (IsLocalization.injective_iff_map_algebraMap_eq + (Submonoid.powers (splitTraceAffineCoordinateProduct sigma d e)) + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom).2 + intro x y + change algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e) x = + algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e) y ↔ + splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde + (algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e) x) = + splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde + (algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e) y) + rw [splitTraceLaurentToKummerTop_algebraMap_apply, + splitTraceLaurentToKummerTop_algebraMap_apply] + constructor + · intro hxy + have hMapped := congrArg + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) hxy + simpa only [splitTraceLaurentToKummerTop_algebraMap_apply] using hMapped + · intro hxy + exact congrArg + (algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e)) (hAffine hxy) + +end OddCoprimeTower + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean new file mode 100644 index 0000000000..9a075cab39 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean @@ -0,0 +1,156 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization + +/-! +# Normal forms in the split trace-cover Kummer tower + +The full kernel calculation for the Laurent trace-cover map requires reducing arbitrary Laurent +polynomials to a bounded monomial normal form. This file proves the risky uniqueness half of that +calculation: the bounded `eta`--`xi` monomials are linearly independent over the quadratic base +function ring, so no nontrivial reduced normal form can vanish in the iterated Kummer algebra. + +This basis statement only uses that the two defining binomials are monic. Irreducibility, proved +in `TraceCurveKummer`, is needed later to regard the same rings as fields, but is not smuggled into +the normal-form interface. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +/-- Iterating two monic `AdjoinRoot` constructions gives a linearly independent rectangular +family of powers. This generic lemma keeps the typeclass structures fixed before the concrete +Kummer polynomials are substituted. -/ +theorem adjoinRootTower_normalMonomials_linearIndependent + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) : + @LinearIndependent (Fin f.natDegree × Fin g.natDegree) R (AdjoinRoot g) + (fun ji : Fin f.natDegree × Fin g.natDegree ↦ + algebraMap (AdjoinRoot f) (AdjoinRoot g) + (AdjoinRoot.root f ^ (ji.1 : ℕ)) * + AdjoinRoot.root g ^ (ji.2 : ℕ)) + _ (AdjoinRoot.instCommRing g).toAddCommMonoid _ := by + have hFirst := (AdjoinRoot.powerBasis' hf).basis.linearIndependent + have hSecond := (AdjoinRoot.powerBasis' hg).basis.linearIndependent + have hProduct := linearIndependent_smul hFirst hSecond + change LinearIndependent R + (fun p : Fin f.natDegree × Fin g.natDegree ↦ + (AdjoinRoot.powerBasis' hf).basis p.1 • + (AdjoinRoot.powerBasis' hg).basis p.2) at hProduct + simpa [PowerBasis.basis_eq_pow, Algebra.smul_def] using hProduct + +variable {K : Type*} [Field K] + +lemma splitTraceEtaKummerPolynomial_monic + (sigma : K) (e : ℕ) (he : e ≠ 0) : + (splitTraceEtaKummerPolynomial sigma e).Monic := by + rw [splitTraceEtaKummerPolynomial] + exact monic_X_pow_sub_C _ he + +lemma splitTraceXiKummerPolynomial_monic + (sigma : K) (e d : ℕ) (hd : d ≠ 0) : + (splitTraceXiKummerPolynomial sigma e d).Monic := by + rw [splitTraceXiKummerPolynomial] + exact monic_X_pow_sub_C _ hd + +/-- A bounded `eta`--`xi` normal form has unique coefficients over the base function ring. +Equivalently, its linear-combination evaluation map into the Kummer top algebra is injective. -/ +theorem splitTraceEtaXiNormalMonomials_linearIndependent + (sigma : K) (e d : ℕ) (he : e ≠ 0) (hd : d ≠ 0) : + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + LinearIndependent (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji : Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree ↦ + splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + simpa [splitTraceEtaRootInXiField, splitTraceXiRoot] using + adjoinRootTower_normalMonomials_linearIndependent + (splitTraceEtaKummerPolynomial sigma e) + (splitTraceEtaKummerPolynomial_monic sigma e he) + (splitTraceXiKummerPolynomial sigma e d) + (splitTraceXiKummerPolynomial_monic sigma e d hd) + +/-- In the odd-coprime situation used by the endgame, oddness supplies the required positive +exponents for the bounded normal-form theorem. -/ +theorem splitTraceEtaXiNormalMonomials_linearIndependent_of_oddCoprime + (sigma : K) (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (_hde : d.Coprime e) : + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + LinearIndependent (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji : Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree ↦ + splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + have he : e ≠ 0 := by + rintro rfl + simp at heOdd + have hd : d ≠ 0 := by + rintro rfl + simp at hdOdd + exact splitTraceEtaXiNormalMonomials_linearIndependent sigma e d he hd + +/-- In the odd-coprime endgame range, a reduced rectangular normal form evaluates to zero in the +Kummer top algebra exactly when every coefficient is zero. This is the concrete kernel statement +available before the separate existence-of-normal-form reduction for Laurent polynomials. -/ +theorem splitTraceEtaXiNormalForm_evaluation_eq_zero_iff + (sigma : K) (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + (c : (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) : + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + Finsupp.linearCombination (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji : Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree ↦ + splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) c = 0 ↔ + c = 0 := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + constructor + · intro hc + apply splitTraceEtaXiNormalMonomials_linearIndependent_of_oddCoprime + sigma e d heOdd hdOdd hde + simpa using hc + · rintro rfl + simp + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean new file mode 100644 index 0000000000..d4c3221b60 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean @@ -0,0 +1,335 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence + +/-! +# Odd common-prime Kummer classes on the split trace curve + +This module proves the rational-function and quadratic-base obstructions needed when an odd prime +divides both covering exponents. Exact height-one-prime divisibility rules out nontrivial powers +of the residual ratio `(1 - sigma * X) / (1 - X)`, and a norm calculation upgrades this to +independence of the two degree-one trace-coordinate classes modulo an odd prime. + +Turning this base-field class calculation into irreducibility for noncoprime covers still requires +the roots-of-unity eigencharacter descent in the first Kummer extension. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- No nontrivial power below a prime exponent of the residual trace ratio +can itself be a prime power in the rational-function field. This is the +height-one-prime obstruction at `sigma * X - 1`; the denominator prime +`1 - X` is distinct precisely when `sigma != 1`. -/ +theorem splitTraceResidualRatio_pow_ne_primePower + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (q a : ℕ) (_hq : q.Prime) (ha : 0 < a) (haq : a < q) + (z : RatFunc K) : + z ^ q ≠ + ((1 - RatFunc.C sigma * RatFunc.X) / (1 - RatFunc.X)) ^ a := by + intro hpow + let numeratorPrime : K[X] := normalizedSplitTraceEisensteinPrime sigma + let numerator : K[X] := 1 - C sigma * X + let denominator : K[X] := 1 - X + have hdenominator : denominator ≠ 0 := by + intro h + have hval := congrArg (Polynomial.eval (0 : K)) h + simp [denominator] at hval + have hdenominatorRat : + algebraMap K[X] (RatFunc K) denominator ≠ 0 := + (map_ne_zero_iff (algebraMap K[X] (RatFunc K)) + (RatFunc.algebraMap_injective K)).mpr hdenominator + have hzdenominatorRat : + algebraMap K[X] (RatFunc K) z.denom ≠ 0 := + (map_ne_zero_iff (algebraMap K[X] (RatFunc K)) + (RatFunc.algebraMap_injective K)).mpr z.denom_ne_zero + have hcrossRat : + algebraMap K[X] (RatFunc K) + (z.num ^ q * denominator ^ a) = + algebraMap K[X] (RatFunc K) + (numerator ^ a * z.denom ^ q) := by + have hpow' : + (algebraMap K[X] (RatFunc K) z.num / + algebraMap K[X] (RatFunc K) z.denom) ^ q = + (algebraMap K[X] (RatFunc K) numerator / + algebraMap K[X] (RatFunc K) denominator) ^ a := by + rw [RatFunc.num_div_denom] + simpa [numerator, denominator, RatFunc.algebraMap_C, + RatFunc.algebraMap_X] using hpow + rw [div_pow, div_pow] at hpow' + field_simp [hzdenominatorRat, hdenominatorRat] at hpow' + simpa only [map_mul, map_pow, mul_assoc, mul_left_comm, mul_comm] using hpow' + have hcross : + z.num ^ q * denominator ^ a = numerator ^ a * z.denom ^ q := + (RatFunc.algebraMap_injective K) hcrossRat + have hprimeIrreducible : Irreducible numeratorPrime := + normalizedSplitTraceEisensteinPrime_irreducible sigma hsigma + have hprime : Prime numeratorPrime := hprimeIrreducible.prime + have hprimeNotDvdDenominator : ¬ numeratorPrime ∣ denominator := by + intro h + apply normalizedSplitTraceEisensteinPrime_not_dvd_leading + sigma hsigma hnondegenerate + simpa [numeratorPrime, denominator, normalizedSplitTraceLeadingCoefficient] using + (dvd_mul_of_dvd_right h X) + have hnumeratorEq : numerator = -numeratorPrime := by + simp [numerator, numeratorPrime, normalizedSplitTraceEisensteinPrime] + have hprimeDvdNumeratorPow : numeratorPrime ∣ numerator ^ a := by + rw [hnumeratorEq, neg_pow] + exact dvd_mul_of_dvd_right (dvd_pow_self numeratorPrime ha.ne') ((-1 : K[X]) ^ a) + have hprimeDvdLeft : numeratorPrime ∣ z.num ^ q * denominator ^ a := by + rw [hcross] + exact dvd_mul_of_dvd_left hprimeDvdNumeratorPow _ + have hprimeNotDvdDenominatorPow : ¬ numeratorPrime ∣ denominator ^ a := by + exact fun h => hprimeNotDvdDenominator (hprime.dvd_of_dvd_pow h) + have hprimeDvdNumPow : numeratorPrime ∣ z.num ^ q := + (hprime.dvd_mul.mp hprimeDvdLeft).resolve_right hprimeNotDvdDenominatorPow + have hprimeDvdNum : numeratorPrime ∣ z.num := + hprime.dvd_of_dvd_pow hprimeDvdNumPow + have hprimeNotDvdDenom : ¬ numeratorPrime ∣ z.denom := by + intro hprimeDvdDenom + exact hprimeIrreducible.not_isUnit + (z.isCoprime_num_denom.isUnit_of_dvd' hprimeDvdNum hprimeDvdDenom) + obtain ⟨num', hnum⟩ := hprimeDvdNum + have haqLe : a ≤ q := Nat.le_of_lt haq + have hcancel : + numeratorPrime ^ (q - a) * (num' ^ q * denominator ^ a) = + (-1 : K[X]) ^ a * z.denom ^ q := by + apply mul_left_cancel₀ (pow_ne_zero a hprime.ne_zero) + calc + numeratorPrime ^ a * + (numeratorPrime ^ (q - a) * (num' ^ q * denominator ^ a)) = + (numeratorPrime * num') ^ q * denominator ^ a := by + calc + numeratorPrime ^ a * + (numeratorPrime ^ (q - a) * + (num' ^ q * denominator ^ a)) = + (numeratorPrime ^ a * numeratorPrime ^ (q - a)) * + (num' ^ q * denominator ^ a) := by ring + _ = numeratorPrime ^ (a + (q - a)) * + (num' ^ q * denominator ^ a) := by rw [pow_add] + _ = numeratorPrime ^ q * + (num' ^ q * denominator ^ a) := by rw [Nat.add_sub_of_le haqLe] + _ = (numeratorPrime * num') ^ q * denominator ^ a := by + rw [mul_pow] + ring + _ = z.num ^ q * denominator ^ a := by rw [← hnum] + _ = numerator ^ a * z.denom ^ q := hcross + _ = numeratorPrime ^ a * + ((-1 : K[X]) ^ a * z.denom ^ q) := by + rw [hnumeratorEq, neg_pow] + ring + have hsubPositive : 0 < q - a := Nat.sub_pos_of_lt haq + have hprimeDvdLeftAfterCancel : + numeratorPrime ∣ + numeratorPrime ^ (q - a) * (num' ^ q * denominator ^ a) := + dvd_mul_of_dvd_left (dvd_pow_self numeratorPrime hsubPositive.ne') _ + have hprimeDvdSignedDenomPow : + numeratorPrime ∣ (-1 : K[X]) ^ a * z.denom ^ q := by + rw [← hcancel] + exact hprimeDvdLeftAfterCancel + have hprimeNotDvdSign : ¬ numeratorPrime ∣ (-1 : K[X]) ^ a := by + intro h + exact hprimeIrreducible.not_isUnit + (isUnit_of_dvd_unit h (isUnit_neg_one.pow a)) + have hprimeDvdDenomPow : numeratorPrime ∣ z.denom ^ q := + (hprime.dvd_mul.mp hprimeDvdSignedDenomPow).resolve_left hprimeNotDvdSign + exact hprimeNotDvdDenom (hprime.dvd_of_dvd_pow hprimeDvdDenomPow) + +/-- The residual ratio is exactly `X * splitTraceRadicand sigma` in the +rational base of the trace curve. -/ +theorem RatFunc.X_mul_splitTraceRadicand_eq_residualRatio + (sigma : K) : + RatFunc.X * splitTraceRadicand sigma = + (1 - RatFunc.C sigma * RatFunc.X) / (1 - RatFunc.X) := by + have hX : (RatFunc.X : RatFunc K) ≠ 0 := RatFunc.X_ne_zero + have hOneSubX : (1 - RatFunc.X : RatFunc K) ≠ 0 := by + intro h + have honeX : (1 : RatFunc K) = RatFunc.X := sub_eq_zero.mp h + have hdegree := congrArg RatFunc.intDegree honeX + norm_num at hdegree + simp only [splitTraceRadicand, splitTraceRadicandNumerator, + splitTraceRadicandDenominator, map_sub, map_one, map_mul, + RatFunc.algebraMap_C, RatFunc.algebraMap_X] + field_simp [hX, hOneSubX] + +/-- Trace-radicand form of the odd-common-prime residual obstruction. -/ +theorem splitTrace_X_mul_radicand_pow_ne_primePower + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (q a : ℕ) (hq : q.Prime) (ha : 0 < a) (haq : a < q) + (z : RatFunc K) : + z ^ q ≠ (RatFunc.X * splitTraceRadicand sigma) ^ a := by + rw [RatFunc.X_mul_splitTraceRadicand_eq_residualRatio] + exact splitTraceResidualRatio_pow_ne_primePower + sigma hsigma hnondegenerate q a hq ha haq z + +/-- Divisibility form used after taking norms: the exponent of the residual +ratio need only be nonzero modulo `q`. -/ +theorem splitTrace_X_mul_radicand_pow_ne_primePower_of_not_dvd + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (q a : ℕ) (hq : q.Prime) (hqa : ¬ q ∣ a) + (z : RatFunc K) : + z ^ q ≠ (RatFunc.X * splitTraceRadicand sigma) ^ a := by + intro hpow + let residual : RatFunc K := RatFunc.X * splitTraceRadicand sigma + have hresidual : residual ≠ 0 := + mul_ne_zero RatFunc.X_ne_zero (splitTraceRadicand_ne_zero sigma hsigma) + have hremainderNe : a % q ≠ 0 := by + intro hzero + apply hqa + rw [Nat.dvd_iff_mod_eq_zero] + exact hzero + have hremainderPositive : 0 < a % q := Nat.pos_of_ne_zero hremainderNe + have hremainderLt : a % q < q := Nat.mod_lt _ hq.pos + let reducedRoot : RatFunc K := z / residual ^ (a / q) + apply splitTrace_X_mul_radicand_pow_ne_primePower + sigma hsigma hnondegenerate q (a % q) hq + hremainderPositive hremainderLt reducedRoot + have hdecomposition : a % q + q * (a / q) = a := Nat.mod_add_div a q + have hpowerDecomposition : + residual ^ a = + residual ^ (a % q) * (residual ^ (a / q)) ^ q := by + calc + residual ^ a = residual ^ (a % q + q * (a / q)) := by rw [hdecomposition] + _ = residual ^ (a % q) * residual ^ (q * (a / q)) := by rw [pow_add] + _ = residual ^ (a % q) * (residual ^ (a / q)) ^ q := by + rw [← pow_mul, Nat.mul_comm] + calc + reducedRoot ^ q = z ^ q / (residual ^ (a / q)) ^ q := by + simp [reducedRoot, div_pow] + _ = residual ^ a / (residual ^ (a / q)) ^ q := by + rw [hpow] + _ = residual ^ (a % q) := by + rw [hpowerDecomposition] + field_simp [hresidual] + _ = (RatFunc.X * splitTraceRadicand sigma) ^ (a % q) := by rfl + +/-- Odd-prime Kummer-class independence of the two degree-one trace +coordinates. The norm first forces the two character exponents to agree; +the remaining diagonal character is exactly the residual rational function +handled above. -/ +theorem splitTraceBaseCoordinates_mixedPower_ne_oddPrimePower + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (q a b : ℕ) (hq : q.Prime) (hqTwo : q ≠ 2) + (haq : a < q) (hbq : b < q) (hab : a ≠ 0 ∨ b ≠ 0) + (z : SplitTraceBaseFunctionField K sigma) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + z ^ q ≠ + (splitTraceBaseU sigma * splitTraceBaseV sigma) ^ a * + splitTraceBaseV sigma ^ b := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let baseField := SplitTraceBaseFunctionField K sigma + let U : baseField := splitTraceBaseU sigma + let V : baseField := splitTraceBaseV sigma + have hr : splitTraceRadicand sigma ≠ 0 := + splitTraceRadicand_ne_zero sigma hsigma + have hV : V ≠ 0 := by + change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr hr + have hU : U ≠ 0 := by + exact (map_ne_zero_iff _ + (algebraMap (RatFunc K) baseField).injective).mpr RatFunc.X_ne_zero + have hUV : U * V ≠ 0 := mul_ne_zero hU hV + have hrightNonzero : (U * V) ^ a * V ^ b ≠ 0 := + mul_ne_zero (pow_ne_zero a hUV) (pow_ne_zero b hV) + intro hpow + have hz : z ≠ 0 := by + intro hz + apply hrightNonzero + simpa [hz, hq.ne_zero] using hpow.symm + letI : Module.Finite (RatFunc K) baseField := + (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot + have hnorm := congrArg (Algebra.norm (RatFunc K)) hpow + rw [map_pow, map_mul, map_pow, map_pow] at hnorm + have hnormZNe : Algebra.norm (RatFunc K) z ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hz + have hnormUVNe : Algebra.norm (RatFunc K) (U * V) ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hUV + have hnormVNe : Algebra.norm (RatFunc K) V ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hV + have hdegree := congrArg RatFunc.intDegree hnorm + rw [RatFunc.intDegree_pow _ hnormZNe, + RatFunc.intDegree_mul (pow_ne_zero a hnormUVNe) (pow_ne_zero b hnormVNe), + RatFunc.intDegree_pow _ hnormUVNe, + RatFunc.intDegree_pow _ hnormVNe, + norm_splitTraceBaseU_mul_V_intDegree sigma hsigma] at hdegree + have hnormV : Algebra.norm (RatFunc K) V = -splitTraceRadicand sigma := by + simpa [V, splitTraceBaseV] using norm_splitTraceBaseRoot sigma hsigma + have hnormVIntDegree : + (Algebra.norm (RatFunc K) V).intDegree = -1 := by + rw [hnormV, RatFunc.intDegree_neg, splitTraceRadicand_intDegree sigma hsigma] + rw [hnormVIntDegree] at hdegree + have hdiv : (q : ℤ) ∣ (a : ℤ) - (b : ℤ) := by + refine ⟨(Algebra.norm (RatFunc K) z).intDegree, ?_⟩ + simpa [sub_eq_add_neg, mul_add] using hdegree.symm + have habEq : a = b := by + rcases le_total b a with hba | hab + · have hdivNat : q ∣ a - b := by + rw [← Int.natCast_dvd_natCast] + simpa [Nat.cast_sub hba] using hdiv + have hzero : a - b = 0 := + Nat.eq_zero_of_dvd_of_lt hdivNat (lt_of_le_of_lt (Nat.sub_le a b) haq) + exact Nat.le_antisymm (Nat.sub_eq_zero_iff_le.mp hzero) hba + · have hdivNeg : (q : ℤ) ∣ (b : ℤ) - (a : ℤ) := by + simpa only [neg_sub] using (dvd_neg.mpr hdiv) + have hdivNat : q ∣ b - a := by + rw [← Int.natCast_dvd_natCast] + simpa [Nat.cast_sub hab] using hdivNeg + have hzero : b - a = 0 := + Nat.eq_zero_of_dvd_of_lt hdivNat (lt_of_le_of_lt (Nat.sub_le b a) hbq) + exact Nat.le_antisymm hab (Nat.sub_eq_zero_iff_le.mp hzero) + subst b + have haPositive : 0 < a := by + rcases hab with ha | ha <;> exact Nat.pos_of_ne_zero ha + have hqNotDvdA : ¬ q ∣ a := Nat.not_dvd_of_pos_of_lt haPositive haq + have hqNotDvdTwoA : ¬ q ∣ 2 * a := by + intro h + rcases hq.dvd_mul.mp h with hqDvdTwo | hqDvdA + · exact hqTwo ((Nat.dvd_prime Nat.prime_two).mp hqDvdTwo |>.resolve_left hq.ne_one) + · exact hqNotDvdA hqDvdA + let residual : RatFunc K := RatFunc.X * splitTraceRadicand sigma + have hrootSquare : V ^ 2 = algebraMap (RatFunc K) baseField + (splitTraceRadicand sigma) := by + change splitTraceBaseV sigma ^ 2 = + algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) + (splitTraceRadicand sigma) + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceBaseKummerPolynomial sigma) + rw [splitTraceBaseKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hcoordinateProduct : + (U * V) * V = algebraMap (RatFunc K) baseField residual := by + rw [mul_assoc, ← pow_two, hrootSquare] + simp [U, residual, baseField, splitTraceBaseU] + have hpowResidual : + z ^ q = algebraMap (RatFunc K) baseField (residual ^ a) := by + calc + z ^ q = (U * V) ^ a * V ^ a := hpow + _ = ((U * V) * V) ^ a := by + simpa [mul_assoc] using (mul_pow (U * V) V a).symm + _ = (algebraMap (RatFunc K) baseField residual) ^ a := by rw [hcoordinateProduct] + _ = algebraMap (RatFunc K) baseField (residual ^ a) := by rw [map_pow] + have hnormResidual := congrArg (Algebra.norm (RatFunc K)) hpowResidual + rw [map_pow, Algebra.norm_algebraMap, + splitTraceBaseFunctionField_finrank sigma hsigma] at hnormResidual + apply splitTrace_X_mul_radicand_pow_ne_primePower_of_not_dvd + sigma hsigma hnondegenerate q (2 * a) hq hqNotDvdTwoA + (Algebra.norm (RatFunc K) z) + simpa [residual, pow_mul, Nat.mul_comm] using hnormResidual + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean new file mode 100644 index 0000000000..7dc409509d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean @@ -0,0 +1,439 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity + +/-! +# Irreducibility of the odd coprime split trace cover + +The key source-side argument is a residue decomposition. Every polynomial in `x,y` is written +uniquely as a sum of terms + +`x^r * y^s * q_{r,s}(x^d, y^e)`, with `r < d` and `s < e`. + +Evaluation in the Kummer tower sends the coefficient polynomial `q_{r,s}` to the degree-one +base trace curve at `(u*v,v)`. Irreducibility of that already-proved degree-one curve therefore +forces each `q_{r,s}` to be divisible by the base cover equation. Power substitution then shows +that the original polynomial is divisible by the `(d,e)` cover equation. This proves the +source-division theorem without assuming the target irreducibility or either comparison-map +injectivity statement. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +section ResidueBlocks + +variable (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) + +/-- A two-variable exponent with the displayed exponents in coordinates `0,1`. -/ +def finTwoExponent (i j : ℕ) : Fin 2 →₀ ℕ := + Finsupp.single 0 i + Finsupp.single 1 j + +theorem monomial_finTwoExponent (i j : ℕ) (c : K) : + MvPolynomial.monomial (finTwoExponent i j) c = + MvPolynomial.C c * MvPolynomial.X 0 ^ i * MvPolynomial.X 1 ^ j := by + rw [finTwoExponent, MvPolynomial.monomial_add_single, + ← MvPolynomial.C_mul_X_pow_eq_monomial] + +theorem finTwoExponent_of_finsupp (ex : Fin 2 →₀ ℕ) : + finTwoExponent (ex 0) (ex 1) = ex := by + ext k + fin_cases k <;> simp [finTwoExponent] + +/-- Substitute `x^d,y^e` for the two variables. -/ +def splitTracePowerSubstitution : + MvPolynomial (Fin 2) K →ₐ[K] MvPolynomial (Fin 2) K := + MvPolynomial.aeval ![MvPolynomial.X 0 ^ d, MvPolynomial.X 1 ^ e] + +@[simp] +theorem splitTracePowerSubstitution_X_zero : + splitTracePowerSubstitution (K := K) e d (MvPolynomial.X 0) = + MvPolynomial.X 0 ^ d := by + simp [splitTracePowerSubstitution] + +@[simp] +theorem splitTracePowerSubstitution_X_one : + splitTracePowerSubstitution (K := K) e d (MvPolynomial.X 1) = + MvPolynomial.X 1 ^ e := by + simp [splitTracePowerSubstitution] + +@[simp] +theorem splitTracePowerSubstitution_C (c : K) : + splitTracePowerSubstitution (K := K) e d (MvPolynomial.C c) = + MvPolynomial.C c := by + simp [splitTracePowerSubstitution] + +/-- The polynomial coefficient in one residue block. A monomial `x^i y^j` contributes +`X^(i/d) Y^(j/e)` to block `(j mod e, i mod d)`. -/ +def splitTracePolynomialResidueBlocks (p : MvPolynomial (Fin 2) K) : + (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + MvPolynomial (Fin 2) K := + (AddMonoidAlgebra.coeff p).sum fun ex c ↦ + Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd (ex 0) (ex 1)) + (MvPolynomial.monomial (finTwoExponent (ex 0 / d) (ex 1 / e)) c) + +@[simp] +theorem splitTracePolynomialResidueBlocks_zero : + splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd 0 = 0 := by + simp [splitTracePolynomialResidueBlocks] + +theorem splitTracePolynomialResidueBlocks_add + (p q : MvPolynomial (Fin 2) K) : + splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd (p + q) = + splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd p + + splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd q := by + classical + simp only [splitTracePolynomialResidueBlocks] + apply Finsupp.sum_add_index + · intro ex + simp + · intro ex _ a b + simp only [map_add, Finsupp.single_add] + +@[simp] +theorem splitTracePolynomialResidueBlocks_monomial + (ex : Fin 2 →₀ ℕ) (c : K) : + splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd + (MvPolynomial.monomial ex c) = + Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd (ex 0) (ex 1)) + (MvPolynomial.monomial (finTwoExponent (ex 0 / d) (ex 1 / e)) c) := by + rw [splitTracePolynomialResidueBlocks] + apply MvPolynomial.sum_monomial_eq + simp + +/-- Reassemble residue blocks after power substitution. -/ +def splitTraceRecomposeResidueBlocks + (q : (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + MvPolynomial (Fin 2) K) : MvPolynomial (Fin 2) K := + q.sum fun ji a ↦ + MvPolynomial.X 0 ^ (ji.2 : ℕ) * MvPolynomial.X 1 ^ (ji.1 : ℕ) * + splitTracePowerSubstitution (K := K) e d a + +theorem splitTracePowerSubstitution_monomial + (i j : ℕ) (c : K) : + splitTracePowerSubstitution (K := K) e d + (MvPolynomial.monomial (finTwoExponent i j) c) = + MvPolynomial.C c * MvPolynomial.X 0 ^ (d * i) * + MvPolynomial.X 1 ^ (e * j) := by + rw [monomial_finTwoExponent] + simp only [map_mul, map_pow, splitTracePowerSubstitution_C, + splitTracePowerSubstitution_X_zero, splitTracePowerSubstitution_X_one] + rw [pow_mul, pow_mul] + +theorem splitTraceRecomposeResidueBlocks_single_monomial + (i j : ℕ) (c : K) : + splitTraceRecomposeResidueBlocks sigma e d + (Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd i j) + (MvPolynomial.monomial (finTwoExponent (i / d) (j / e)) c)) = + MvPolynomial.monomial (finTwoExponent i j) c := by + rw [splitTraceRecomposeResidueBlocks, Finsupp.sum_single_index] + · rw [splitTracePowerSubstitution_monomial] + simp only [splitTraceMonomialNormalIndex_fst_val, + splitTraceMonomialNormalIndex_snd_val] + rw [monomial_finTwoExponent] + have hi : i % d + d * (i / d) = i := Nat.mod_add_div i d + have hj : j % e + e * (j / e) = j := Nat.mod_add_div j e + calc + MvPolynomial.X (0 : Fin 2) ^ (i % d) * MvPolynomial.X 1 ^ (j % e) * + (MvPolynomial.C c * MvPolynomial.X (0 : Fin 2) ^ (d * (i / d)) * + MvPolynomial.X (1 : Fin 2) ^ (e * (j / e))) = + MvPolynomial.C c * + (MvPolynomial.X (0 : Fin 2) ^ (i % d) * + MvPolynomial.X (0 : Fin 2) ^ (d * (i / d))) * + (MvPolynomial.X (1 : Fin 2) ^ (j % e) * + MvPolynomial.X (1 : Fin 2) ^ (e * (j / e))) := by + ring + _ = MvPolynomial.C c * MvPolynomial.X (0 : Fin 2) ^ i * + MvPolynomial.X (1 : Fin 2) ^ j := by + rw [← pow_add, ← pow_add, hi, hj] + · simp + +theorem splitTraceRecomposeResidueBlocks_add + (q r : (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + MvPolynomial (Fin 2) K) : + splitTraceRecomposeResidueBlocks sigma e d (q + r) = + splitTraceRecomposeResidueBlocks sigma e d q + + splitTraceRecomposeResidueBlocks sigma e d r := by + classical + simp only [splitTraceRecomposeResidueBlocks] + apply Finsupp.sum_add_index + · intro ji + simp + · intro ji _ a b + simp [map_add, mul_add] + +/-- Exact reconstruction from the residue blocks. -/ +theorem splitTraceRecomposeResidueBlocks_polynomial + (p : MvPolynomial (Fin 2) K) : + splitTraceRecomposeResidueBlocks sigma e d + (splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd p) = p := by + induction p using MvPolynomial.induction_on' with + | monomial ex c => + rw [splitTracePolynomialResidueBlocks_monomial, + splitTraceRecomposeResidueBlocks_single_monomial] + rw [finTwoExponent_of_finsupp] + | add p q hp hq => + rw [splitTracePolynomialResidueBlocks_add, + splitTraceRecomposeResidueBlocks_add, hp, hq] + +/-- Evaluate a residue-block polynomial on the degree-one base cover coordinates `(u*v,v)`. -/ +def splitTraceBaseResidueEvaluation : + MvPolynomial (Fin 2) K →ₐ[K] SplitTraceBaseFunctionField K sigma := + MvPolynomial.aeval + ![splitTraceBaseU sigma * splitTraceBaseV sigma, splitTraceBaseV sigma] + +theorem splitTraceBaseResidueEvaluation_monomial + (a b : ℕ) (c : K) : + splitTraceBaseResidueEvaluation sigma + (MvPolynomial.monomial (finTwoExponent a b) c) = + algebraMap K (SplitTraceBaseFunctionField K sigma) c * + splitTraceBaseU sigma ^ a * splitTraceBaseV sigma ^ (a + b) := by + rw [monomial_finTwoExponent] + simp only [map_mul, map_pow] + simp only [splitTraceBaseResidueEvaluation, MvPolynomial.aeval_C, + MvPolynomial.aeval_X, Matrix.cons_val_zero, Matrix.cons_val_one] + rw [mul_pow, pow_add] + ring + +/-- Each syntactic Kummer coefficient is exactly the degree-one base-curve evaluation of the +corresponding residue-block polynomial. -/ +theorem splitTraceBaseResidueEvaluation_residueBlock + (p : MvPolynomial (Fin 2) K) + (ji : Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) : + splitTraceBaseResidueEvaluation sigma + (splitTracePolynomialResidueBlocks sigma hsigma e d heOdd hdOdd p ji) = + splitTracePolynomialSyntacticNormalForm + sigma hsigma e d heOdd hdOdd p ji := by + induction p using MvPolynomial.induction_on' with + | monomial ex c => + rw [splitTracePolynomialResidueBlocks_monomial, + splitTracePolynomialSyntacticNormalForm_monomial] + by_cases hindex : + splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd (ex 0) (ex 1) = ji + · subst ji + simp only [Finsupp.single_eq_same] + rw [splitTraceBaseResidueEvaluation_monomial] + simp only [splitTraceMonomialNormalCoefficient, mul_assoc] + · simp [hindex] + | add p q hp hq => + rw [splitTracePolynomialResidueBlocks_add, + splitTracePolynomialSyntacticNormalForm_add] + simp only [Finsupp.add_apply, map_add, hp, hq] + +end ResidueBlocks + +section DegreeOneKernel + +variable (sigma : K) (hsigma : sigma ≠ 0) + +private lemma splitTraceEtaRootInXiField_one_one : + splitTraceEtaRootInXiField sigma 1 1 = + splitTraceBaseElementInXiField sigma 1 1 (splitTraceBaseV sigma) := by + simpa using (splitTraceEtaRootInXiField_pow (K := K) sigma 1 1) + +private lemma splitTraceXiRoot_one_one : + splitTraceXiRoot sigma 1 1 = + splitTraceBaseElementInXiField sigma 1 1 + (splitTraceBaseU sigma * splitTraceBaseV sigma) := by + have h := splitTraceXiRoot_pow (K := K) (sigma := sigma) (e := 1) (d := 1) + simpa [splitTraceXiRadicand, splitTraceBaseElementInXiField] using h + +/-- For the degree-one tower, evaluation at the two Kummer roots is just base-curve evaluation +at `(u*v,v)`, followed by the canonical inclusion of the base function field. -/ +theorem splitTracePolynomialToKummerTop_one_one_eq_baseResidueEvaluation + (q : MvPolynomial (Fin 2) K) : + splitTracePolynomialToKummerTop sigma hsigma 1 1 + (by decide) (by decide) (by decide) q = + IsScalarTower.toAlgHom K (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma 1 1) + (splitTraceBaseResidueEvaluation sigma q) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma 1 (by decide) + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma 1)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma 1 1 + (by decide) (by decide) (by decide) + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma 1 1)) := ⟨hXiIrred⟩ + let lhs : MvPolynomial (Fin 2) K →ₐ[K] + SplitTraceXiFunctionField K sigma 1 1 := + splitTracePolynomialToKummerTop sigma hsigma 1 1 + (by decide) (by decide) (by decide) + let rhs : MvPolynomial (Fin 2) K →ₐ[K] + SplitTraceXiFunctionField K sigma 1 1 := + (IsScalarTower.toAlgHom K (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma 1 1)).comp + (splitTraceBaseResidueEvaluation sigma) + have heq : lhs = rhs := by + apply MvPolynomial.algHom_ext + intro i + fin_cases i + · dsimp [lhs, rhs, splitTracePolynomialToKummerTop, + splitTraceBaseResidueEvaluation] + simp only [MvPolynomial.aeval_X, Matrix.cons_val_zero] + change splitTraceXiRoot sigma 1 1 = + algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma 1 1) + (splitTraceBaseU sigma * splitTraceBaseV sigma) + simpa [lhs, rhs, splitTracePolynomialToKummerTop, + splitTraceBaseResidueEvaluation, splitTraceBaseElementInXiField, + IsScalarTower.algebraMap_apply + (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma 1) + (SplitTraceXiFunctionField K sigma 1 1)] using + (splitTraceXiRoot_one_one (K := K) sigma) + · dsimp [lhs, rhs, splitTracePolynomialToKummerTop, + splitTraceBaseResidueEvaluation] + simp only [MvPolynomial.aeval_X, Matrix.cons_val_one] + change splitTraceEtaRootInXiField sigma 1 1 = + algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma 1 1) (splitTraceBaseV sigma) + simpa [lhs, rhs, splitTracePolynomialToKummerTop, + splitTraceBaseResidueEvaluation, splitTraceBaseElementInXiField, + IsScalarTower.algebraMap_apply + (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma 1) + (SplitTraceXiFunctionField K sigma 1 1)] using + (splitTraceEtaRootInXiField_one_one (K := K) sigma) + exact DFunLike.congr_fun heq q + +/-- The independently proved irreducibility of the degree-one trace curve gives the exact kernel +of base residue evaluation. -/ +theorem splitTraceBaseResiduePolynomial_mem_baseCover + (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (q : MvPolynomial (Fin 2) K) + (hq : splitTraceBaseResidueEvaluation sigma q = 0) : + q ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma 1 1} := by + have hcover : Irreducible (splitTraceCoverPolynomial (1 : K) sigma 1 1) := by + have hirred := weightedTraceTorusClosurePolynomial_irreducible + (1 : K) sigma one_ne_zero hsigma (by simpa using hnondegenerate) + simpa [weightedTraceTorusClosurePolynomial, hsigma] using hirred + apply splitTracePolynomial_mem_span_of_cover_irreducible_and_maps_to_zero + sigma hsigma 1 1 (by decide) (by decide) (by decide) hcover q + rw [splitTracePolynomialToKummerTop_one_one_eq_baseResidueEvaluation] + simp [hq] + +end DegreeOneKernel + +section SourceDivision + +variable (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + +/-- Power substitution carries the degree-one base equation to the exact `(d,e)` cover +equation. -/ +theorem splitTracePowerSubstitution_baseCover : + splitTracePowerSubstitution (K := K) e d + (splitTraceCoverPolynomial (1 : K) sigma 1 1) = + splitTraceCoverPolynomial (1 : K) sigma d e := by + simp only [splitTraceCoverPolynomial, map_add, map_sub, map_mul, map_pow, + splitTracePowerSubstitution_C, splitTracePowerSubstitution_X_zero, + splitTracePowerSubstitution_X_one] + simp only [pow_one, ← pow_mul] + rw [Nat.mul_comm e 2, Nat.mul_comm d 2] + +/-- Every residue-block term whose coefficient vanishes on the degree-one base curve is already +in the principal ideal of the full power-cover equation. -/ +theorem splitTraceResidueBlockTerm_mem_coverIdeal + (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (ji : Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) + (q : MvPolynomial (Fin 2) K) + (hq : splitTraceBaseResidueEvaluation sigma q = 0) : + MvPolynomial.X 0 ^ (ji.2 : ℕ) * MvPolynomial.X 1 ^ (ji.1 : ℕ) * + splitTracePowerSubstitution (K := K) e d q ∈ + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} := by + rw [Ideal.mem_span_singleton] + have hbase : splitTraceCoverPolynomial (1 : K) sigma 1 1 ∣ q := by + rw [← Ideal.mem_span_singleton] + exact splitTraceBaseResiduePolynomial_mem_baseCover + sigma hsigma hnondegenerate q hq + have hmapped := map_dvd (splitTracePowerSubstitution (K := K) e d) hbase + rw [splitTracePowerSubstitution_baseCover] at hmapped + exact dvd_mul_of_dvd_right hmapped + (MvPolynomial.X 0 ^ (ji.2 : ℕ) * MvPolynomial.X 1 ^ (ji.1 : ℕ)) + +/-- The missing source-division theorem for the nondegenerate odd-coprime cover. Its proof is +entirely bottom-up: residue decomposition, the independently proved degree-one kernel, and exact +power substitution. -/ +theorem splitTracePolynomialSyntacticNormalForm_division_of_oddCoprime + (hnondegenerate : sigma ≠ 1) (p : MvPolynomial (Fin 2) K) + (hnormal : splitTracePolynomialSyntacticNormalForm + sigma hsigma e d heOdd hdOdd p = 0) : + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} := by + rw [← splitTraceRecomposeResidueBlocks_polynomial + sigma hsigma e d heOdd hdOdd p] + rw [splitTraceRecomposeResidueBlocks, Finsupp.sum] + apply Ideal.sum_mem + intro ji hji + apply splitTraceResidueBlockTerm_mem_coverIdeal + sigma e d hsigma hnondegenerate ji + rw [splitTraceBaseResidueEvaluation_residueBlock] + rw [hnormal] + rfl + +end SourceDivision + +section Irreducibility + +/-- The explicit Laurent comparison is injective in the nondegenerate +odd-coprime range; no irreducibility premise remains. -/ +theorem splitTraceLaurentToKummerTop_injective_of_oddCoprime + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + apply (splitTracePolynomialSyntacticNormalForm_division_iff_laurentInjective + sigma hsigma e d heOdd hdOdd hde hnondegenerate).1 + intro p hp + exact splitTracePolynomialSyntacticNormalForm_division_of_oddCoprime + sigma hsigma e d heOdd hdOdd hnondegenerate p hp + +/-- The affine comparison is injective in the same range because the +coordinate-product localization has already been proved faithful. -/ +theorem splitTraceAffineToKummerTop_injective_of_oddCoprime + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Function.Injective + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde) := + splitTraceAffineToKummerTop_injective_of_laurentInjective + sigma hsigma e d heOdd hdOdd hde + (splitTraceLaurentToKummerTop_injective_of_oddCoprime + sigma hsigma hnondegenerate e d heOdd hdOdd hde) + +/-- The normalized split trace-cover polynomial is irreducible for nondegenerate odd coprime +exponents. No characteristic restriction is needed. -/ +theorem splitTraceCoverPolynomial_irreducible_of_oddCoprime + (sigma : K) (hsigma : sigma ≠ 0) (hnondegenerate : sigma ≠ 1) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by + have hLaurent : Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := + splitTraceLaurentToKummerTop_injective_of_oddCoprime + sigma hsigma hnondegenerate e d heOdd hdOdd hde + exact splitTraceCoverPolynomial_irreducible_of_laurentInjective + sigma hsigma e d heOdd hdOdd hde hLaurent + +end Irreducibility + +end + + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean new file mode 100644 index 0000000000..2f8767760e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean @@ -0,0 +1,689 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility + +/-! +# Irreducibility of positive coprime split trace covers + +This module removes the oddness restriction from the split-cover proof. A Capelli-style +binomial criterion constructs the Kummer tower for arbitrary positive coprime exponents over a +field containing a square root of `-1`. A parity-free residue decomposition then reconnects the +tower to the actual affine cover polynomial and proves its principal ideal prime. + +The coprimality restriction is still real in this proof: common prime divisors require a separate +Kummer-class independence argument and are not hidden here. +-/ + +namespace BGS.Markoff + +open Polynomial AdjoinRoot IntermediateField + +noncomputable section + +variable {K : Type*} [Field K] + +lemma exists_primePowerRootOfNegOne + (i : K) (hi : i ^ 2 = -1) (q : ℕ) (hq : q.Prime) : + ∃ c : K, c ^ q = -1 := by + by_cases hqTwo : q = 2 + · exact ⟨i, by simpa [hqTwo] using hi⟩ + · refine ⟨-1, ?_⟩ + simpa using (hq.odd_of_ne_two hqTwo).neg_one_pow (α := K) + +/-- Over a field in which `-1` is a square, the usual prime-radicand criterion for +`X^n-a` is valid also for even `n`. -/ +theorem X_pow_sub_C_irreducible_of_sqrt_neg_one + (i : K) (hi : i ^ 2 = -1) {n : ℕ} (hn : n ≠ 0) {a : K} + (ha : ∀ q : ℕ, q.Prime → q ∣ n → ∀ b : K, b ^ q ≠ a) : + Irreducible (X ^ n - C a) := by + induction n using induction_on_primes generalizing K a with + | zero => exact (hn rfl).elim + | one => simpa using irreducible_X_sub_C a + | prime_mul p n hp IH => + have hn' : n ≠ 0 := by + intro hnZero + apply hn + simp [hnZero] + rw [mul_comm] + apply X_pow_mul_sub_C_irreducible + (X_pow_sub_C_irreducible_of_prime hp (ha p hp (dvd_mul_right _ _))) + intro E _ _ x hx + have hxIntegral : IsIntegral K x := not_not.mp fun h => by + simpa only [degree_zero, degree_X_pow_sub_C hp.pos, + WithBot.natCast_ne_bot] using congr_arg degree (hx.symm.trans (dif_neg h)) + let iE : ↥(IntermediateField.adjoin K {x}) := + algebraMap K (↥(IntermediateField.adjoin K {x})) i + have hiE : iE ^ 2 = -1 := by + dsimp [iE] + rw [← map_pow, hi, map_neg, map_one] + apply IH iE hiE hn' + intro q hq hqn b hb + by_cases hpTwo : p = 2 + · have hnormNeg : (Algebra.norm K b) ^ q = -a := by + rw [← map_pow, hb, ← adjoin.powerBasis_gen hxIntegral, + Algebra.PowerBasis.norm_gen_eq_coeff_zero_minpoly] + simp [minpoly_gen, hx, hpTwo] + obtain ⟨c, hc⟩ := exists_primePowerRootOfNegOne i hi q hq + apply ha q hq (dvd_mul_of_dvd_right hqn p) (c * Algebra.norm K b) + rw [mul_pow, hc, hnormNeg] + simp + · apply ha q hq (dvd_mul_of_dvd_right hqn p) (Algebra.norm K b) + rw [← map_pow, hb, ← adjoin.powerBasis_gen hxIntegral, + Algebra.PowerBasis.norm_gen_eq_coeff_zero_minpoly] + simp [minpoly_gen, hx, hp.ne_zero.symm, (hp.odd_of_ne_two hpTwo).neg_pow] + +/-- The first trace-curve Kummer polynomial is irreducible for every positive exponent once +the constant field contains a square root of `-1`. -/ +theorem splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e : ℕ) (he : 0 < e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + Irreducible (splitTraceEtaKummerPolynomial sigma e) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + apply X_pow_sub_C_irreducible_of_sqrt_neg_one + (algebraMap K (SplitTraceBaseFunctionField K sigma) i) + · rw [← map_pow, hi, map_neg, map_one] + · exact he.ne' + · intro q hq _ z + exact splitTraceBaseRoot_not_primePower sigma hsigma q hq z + +lemma splitTraceEtaFunctionField_finrank_of_sqrt_neg_one + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e : ℕ) (he : 0 < e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + Module.finrank (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) = e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + rw [PowerBasis.finrank (AdjoinRoot.powerBasis hEtaIrred.ne_zero)] + simp [splitTraceEtaKummerPolynomial] + +/-- The norm-degree obstruction for the second radicand does not depend on parity. It applies +to every prime not dividing the first exponent. -/ +theorem splitTraceXiRadicand_not_primePower_of_sqrt_neg_one + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e : ℕ) (he : 0 < e) (q : ℕ) (hq : q.Prime) (hqe : ¬ q ∣ e) + (z : letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + SplitTraceEtaFunctionField K sigma e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + z ^ q ≠ splitTraceXiRadicand sigma e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + letI : Module.Finite (RatFunc K) (SplitTraceBaseFunctionField K sigma) := + (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot + letI : Module.Finite (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) := + (monic_X_pow_sub_C _ he.ne').finite_adjoinRoot + have hBaseV : splitTraceBaseV sigma ≠ 0 := by + change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 + exact (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr + (splitTraceRadicand_ne_zero sigma hsigma) + have hBaseU : splitTraceBaseU sigma ≠ 0 := by + exact (map_ne_zero_iff _ + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)).injective).mpr + RatFunc.X_ne_zero + have hBaseUV : splitTraceBaseU sigma * splitTraceBaseV sigma ≠ 0 := + mul_ne_zero hBaseU hBaseV + have hXiRadicand : splitTraceXiRadicand sigma e ≠ 0 := by + exact (map_ne_zero_iff _ + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)).injective).mpr hBaseUV + intro hpow + have hz : z ≠ 0 := by + intro hz + apply hXiRadicand + simpa [hz, hq.ne_zero] using hpow.symm + have hFirstNorm := congrArg + (Algebra.norm (SplitTraceBaseFunctionField K sigma)) hpow + rw [map_pow, splitTraceXiRadicand, Algebra.norm_algebraMap, + splitTraceEtaFunctionField_finrank_of_sqrt_neg_one sigma hsigma i hi e he] at hFirstNorm + have hSecondNorm := congrArg (Algebra.norm (RatFunc K)) hFirstNorm + rw [map_pow, map_pow] at hSecondNorm + have hNormZNe : + Algebra.norm (SplitTraceBaseFunctionField K sigma) z ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hz + have hDoubleNormZNe : + Algebra.norm (RatFunc K) + (Algebra.norm (SplitTraceBaseFunctionField K sigma) z) ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hNormZNe + have hNormBaseUVNe : + Algebra.norm (RatFunc K) (splitTraceBaseU sigma * splitTraceBaseV sigma) ≠ 0 := + Algebra.norm_ne_zero_iff.mpr hBaseUV + have hDegree := congrArg RatFunc.intDegree hSecondNorm + rw [RatFunc.intDegree_pow _ hDoubleNormZNe, + RatFunc.intDegree_pow _ hNormBaseUVNe, + norm_splitTraceBaseU_mul_V_intDegree sigma hsigma] at hDegree + apply hqe + rw [← Int.natCast_dvd_natCast] + exact ⟨_, by simpa using hDegree.symm⟩ + +/-- For arbitrary positive coprime exponents, including even exponents, the second Kummer +polynomial is irreducible once the constant field contains a square root of `-1`. -/ +theorem splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) (hde : d.Coprime e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + Irreducible (splitTraceXiKummerPolynomial sigma e d) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + rw [splitTraceXiKummerPolynomial] + apply X_pow_sub_C_irreducible_of_sqrt_neg_one + (algebraMap K (SplitTraceEtaFunctionField K sigma e) i) + · rw [← map_pow, hi, map_neg, map_one] + · exact hd.ne' + · intro q hq hqd z + exact splitTraceXiRadicand_not_primePower_of_sqrt_neg_one + sigma hsigma i hi e he q hq + (hq.coprime_iff_not_dvd.mp (Nat.Coprime.of_dvd_left hqd hde)) z + +section PositiveCoprimeCover + +variable (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) (hde : d.Coprime e) + +private theorem generalSplitTraceEtaKummerPolynomial_natDegree + (sigma : K) (hsigma : sigma ≠ 0) (e : ℕ) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + (splitTraceEtaKummerPolynomial sigma e).natDegree = e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + change (X ^ e - C (splitTraceBaseV sigma)).natDegree = e + exact natDegree_X_pow_sub_C + +private theorem generalSplitTraceXiKummerPolynomial_natDegree + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e : ℕ) (he : 0 < e) (d : ℕ) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + (splitTraceXiKummerPolynomial sigma e d).natDegree = d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + change (X ^ d - C (splitTraceXiRadicand sigma e)).natDegree = d + exact natDegree_X_pow_sub_C + +/-- Rectangular residue index for arbitrary positive coprime exponents. -/ +def generalSplitTraceMonomialNormalIndex + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) (a b : ℕ) : + Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree := by + exact (⟨b % e, by + rw [generalSplitTraceEtaKummerPolynomial_natDegree sigma hsigma e] + exact Nat.mod_lt _ he⟩, + ⟨a % d, by + rw [generalSplitTraceXiKummerPolynomial_natDegree sigma hsigma i hi e he d] + exact Nat.mod_lt _ hd⟩) + +@[simp] theorem generalSplitTraceMonomialNormalIndex_fst_val (a b : ℕ) : + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd a b).1.val = b % e := rfl + +@[simp] theorem generalSplitTraceMonomialNormalIndex_snd_val (a b : ℕ) : + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd a b).2.val = a % d := rfl + +/-- Syntactic rectangular coefficients without parity assumptions. -/ +def generalSplitTracePolynomialSyntacticNormalForm + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) + (p : MvPolynomial (Fin 2) K) : + (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + SplitTraceBaseFunctionField K sigma := + (AddMonoidAlgebra.coeff p).sum fun ex c ↦ + Finsupp.single + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd (ex 0) (ex 1)) + (algebraMap K (SplitTraceBaseFunctionField K sigma) c * + splitTraceMonomialNormalCoefficient sigma e d (ex 0) (ex 1)) + +@[simp] theorem generalSplitTracePolynomialSyntacticNormalForm_zero : + generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd 0 = 0 := by + simp [generalSplitTracePolynomialSyntacticNormalForm] + +theorem generalSplitTracePolynomialSyntacticNormalForm_add + (p q : MvPolynomial (Fin 2) K) : + generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd (p + q) = + generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd p + + generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd q := by + classical + simp only [generalSplitTracePolynomialSyntacticNormalForm] + apply Finsupp.sum_add_index + · intro ex + simp + · intro ex _ a b + simp only [map_add, add_mul, Finsupp.single_add] + +@[simp] theorem generalSplitTracePolynomialSyntacticNormalForm_monomial + (ex : Fin 2 →₀ ℕ) (c : K) : + generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd + (MvPolynomial.monomial ex c) = + Finsupp.single + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd (ex 0) (ex 1)) + (algebraMap K (SplitTraceBaseFunctionField K sigma) c * + splitTraceMonomialNormalCoefficient sigma e d (ex 0) (ex 1)) := by + rw [generalSplitTracePolynomialSyntacticNormalForm] + apply MvPolynomial.sum_monomial_eq + simp + +/-- Evaluation at the two roots in the general positive-coprime Kummer tower. -/ +def generalSplitTracePolynomialToKummerTop : + MvPolynomial (Fin 2) K →ₐ[K] SplitTraceXiFunctionField K sigma e d := + MvPolynomial.aeval + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] + +@[simp] theorem generalSplitTracePolynomialToKummerTop_monomial + (ex : Fin 2 →₀ ℕ) (c : K) : + generalSplitTracePolynomialToKummerTop sigma e d (MvPolynomial.monomial ex c) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) c * + (splitTraceXiRoot sigma e d ^ (ex 0) * + splitTraceEtaRootInXiField sigma e d ^ (ex 1)) := by + simp [generalSplitTracePolynomialToKummerTop, MvPolynomial.aeval_def, + MvPolynomial.eval₂_monomial, Fin.prod_univ_two] + +theorem generalSplitTracePolynomialSyntacticNormalForm_evaluation + (p : MvPolynomial (Fin 2) K) : + splitTraceExplicitNormalFormEvaluation sigma e d + (generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd p) = + generalSplitTracePolynomialToKummerTop sigma e d p := by + induction p using MvPolynomial.induction_on' with + | monomial ex c => + rw [generalSplitTracePolynomialSyntacticNormalForm_monomial, + splitTraceExplicitNormalFormEvaluation] + letI : CommRing (SplitTraceBaseFunctionField K sigma) := AdjoinRoot.instCommRing _ + letI : CommRing (SplitTraceEtaFunctionField K sigma e) := AdjoinRoot.instCommRing _ + letI : CommRing (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.instCommRing _ + rw [Finsupp.linearCombination_single] + simp only [Algebra.smul_def, generalSplitTraceMonomialNormalIndex_fst_val, + generalSplitTraceMonomialNormalIndex_snd_val, map_mul] + have hred := (splitTraceKummer_monomial_reduction + (K := K) sigma e d (ex 0) (ex 1)).symm + rw [generalSplitTracePolynomialToKummerTop_monomial] + calc + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma e d)) + ((algebraMap K (SplitTraceBaseFunctionField K sigma)) c) * + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma e d)) + (splitTraceMonomialNormalCoefficient sigma e d (ex 0) (ex 1)) * + (splitTraceEtaRootInXiField sigma e d ^ (ex 1 % e) * + splitTraceXiRoot sigma e d ^ (ex 0 % d)) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) c * + (splitTraceBaseElementInXiField sigma e d + (splitTraceMonomialNormalCoefficient sigma e d (ex 0) (ex 1)) * + (splitTraceEtaRootInXiField sigma e d ^ (ex 1 % e) * + splitTraceXiRoot sigma e d ^ (ex 0 % d))) := by + simp only [splitTraceBaseElementInXiField] + simp_rw [IsScalarTower.algebraMap_apply K + (SplitTraceBaseFunctionField K sigma) + (SplitTraceXiFunctionField K sigma e d)] + simp_rw [IsScalarTower.algebraMap_apply + (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)] + ring + _ = algebraMap K (SplitTraceXiFunctionField K sigma e d) c * + (splitTraceXiRoot sigma e d ^ ex 0 * + splitTraceEtaRootInXiField sigma e d ^ ex 1) := by rw [hred] + | add p q hp hq => + rw [generalSplitTracePolynomialSyntacticNormalForm_add] + change Finsupp.linearCombination (SplitTraceBaseFunctionField K sigma) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd p + + generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd q) = _ + change Finsupp.linearCombination (SplitTraceBaseFunctionField K sigma) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd p) = _ at hp + change Finsupp.linearCombination (SplitTraceBaseFunctionField K sigma) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd q) = _ at hq + rw [map_add, hp, hq, map_add] + +theorem generalSplitTracePolynomialSyntacticNormalForm_eq_zero_iff + (p : MvPolynomial (Fin 2) K) : + generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd p = 0 ↔ + generalSplitTracePolynomialToKummerTop sigma e d p = 0 := by + rw [← generalSplitTracePolynomialSyntacticNormalForm_evaluation + sigma hsigma i hi e d he hd p] + letI : CommRing (SplitTraceBaseFunctionField K sigma) := AdjoinRoot.instCommRing _ + letI : CommRing (SplitTraceEtaFunctionField K sigma e) := AdjoinRoot.instCommRing _ + letI : CommRing (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.instCommRing _ + change generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd p = 0 ↔ + Finsupp.linearCombination (SplitTraceBaseFunctionField K sigma) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd p) = 0 + constructor + · intro h + rw [h] + simp + · intro h + apply splitTraceEtaXiNormalMonomials_linearIndependent sigma e d he.ne' hd.ne' + simpa using h + +/-- Residue-block coefficient polynomials for arbitrary positive exponents. -/ +def generalSplitTracePolynomialResidueBlocks + (p : MvPolynomial (Fin 2) K) : + (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + MvPolynomial (Fin 2) K := + (AddMonoidAlgebra.coeff p).sum fun ex c ↦ + Finsupp.single + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd (ex 0) (ex 1)) + (MvPolynomial.monomial (finTwoExponent (ex 0 / d) (ex 1 / e)) c) + +@[simp] theorem generalSplitTracePolynomialResidueBlocks_zero : + generalSplitTracePolynomialResidueBlocks + sigma hsigma i hi e d he hd 0 = 0 := by + simp [generalSplitTracePolynomialResidueBlocks] + +theorem generalSplitTracePolynomialResidueBlocks_add + (p q : MvPolynomial (Fin 2) K) : + generalSplitTracePolynomialResidueBlocks sigma hsigma i hi e d he hd (p + q) = + generalSplitTracePolynomialResidueBlocks sigma hsigma i hi e d he hd p + + generalSplitTracePolynomialResidueBlocks sigma hsigma i hi e d he hd q := by + classical + simp only [generalSplitTracePolynomialResidueBlocks] + apply Finsupp.sum_add_index + · intro ex + simp + · intro ex _ a b + simp only [map_add, Finsupp.single_add] + +@[simp] theorem generalSplitTracePolynomialResidueBlocks_monomial + (ex : Fin 2 →₀ ℕ) (c : K) : + generalSplitTracePolynomialResidueBlocks sigma hsigma i hi e d he hd + (MvPolynomial.monomial ex c) = + Finsupp.single + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd (ex 0) (ex 1)) + (MvPolynomial.monomial (finTwoExponent (ex 0 / d) (ex 1 / e)) c) := by + rw [generalSplitTracePolynomialResidueBlocks] + apply MvPolynomial.sum_monomial_eq + simp + +theorem splitTraceRecomposeGeneralResidueBlocks_single_monomial + (a b : ℕ) (c : K) : + splitTraceRecomposeResidueBlocks sigma e d + (Finsupp.single + (generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd a b) + (MvPolynomial.monomial (finTwoExponent (a / d) (b / e)) c)) = + MvPolynomial.monomial (finTwoExponent a b) c := by + rw [splitTraceRecomposeResidueBlocks, Finsupp.sum_single_index] + · rw [splitTracePowerSubstitution_monomial] + simp only [generalSplitTraceMonomialNormalIndex_fst_val, + generalSplitTraceMonomialNormalIndex_snd_val] + rw [monomial_finTwoExponent] + have ha : a % d + d * (a / d) = a := Nat.mod_add_div a d + have hb : b % e + e * (b / e) = b := Nat.mod_add_div b e + calc + MvPolynomial.X (0 : Fin 2) ^ (a % d) * MvPolynomial.X 1 ^ (b % e) * + (MvPolynomial.C c * MvPolynomial.X (0 : Fin 2) ^ (d * (a / d)) * + MvPolynomial.X (1 : Fin 2) ^ (e * (b / e))) = + MvPolynomial.C c * + (MvPolynomial.X (0 : Fin 2) ^ (a % d) * + MvPolynomial.X (0 : Fin 2) ^ (d * (a / d))) * + (MvPolynomial.X (1 : Fin 2) ^ (b % e) * + MvPolynomial.X (1 : Fin 2) ^ (e * (b / e))) := by ring + _ = MvPolynomial.C c * MvPolynomial.X (0 : Fin 2) ^ a * + MvPolynomial.X (1 : Fin 2) ^ b := by + rw [← pow_add, ← pow_add, ha, hb] + · simp + +/-- Exact reconstruction from the general residue blocks. -/ +theorem splitTraceRecomposeGeneralResidueBlocks_polynomial + (p : MvPolynomial (Fin 2) K) : + splitTraceRecomposeResidueBlocks sigma e d + (generalSplitTracePolynomialResidueBlocks + sigma hsigma i hi e d he hd p) = p := by + induction p using MvPolynomial.induction_on' with + | monomial ex c => + rw [generalSplitTracePolynomialResidueBlocks_monomial, + splitTraceRecomposeGeneralResidueBlocks_single_monomial] + rw [finTwoExponent_of_finsupp] + | add p q hp hq => + rw [generalSplitTracePolynomialResidueBlocks_add, + splitTraceRecomposeResidueBlocks_add, hp, hq] + +/-- Each general syntactic coefficient is the base-curve evaluation of its residue block. -/ +theorem splitTraceBaseResidueEvaluation_generalResidueBlock + (p : MvPolynomial (Fin 2) K) + (ji : Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) : + splitTraceBaseResidueEvaluation sigma + (generalSplitTracePolynomialResidueBlocks + sigma hsigma i hi e d he hd p ji) = + generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd p ji := by + induction p using MvPolynomial.induction_on' with + | monomial ex c => + rw [generalSplitTracePolynomialResidueBlocks_monomial, + generalSplitTracePolynomialSyntacticNormalForm_monomial] + by_cases hindex : + generalSplitTraceMonomialNormalIndex sigma hsigma i hi e d he hd + (ex 0) (ex 1) = ji + · subst ji + simp only [Finsupp.single_eq_same] + rw [splitTraceBaseResidueEvaluation_monomial] + simp only [splitTraceMonomialNormalCoefficient, mul_assoc] + · simp [hindex] + | add p q hp hq => + rw [generalSplitTracePolynomialResidueBlocks_add, + generalSplitTracePolynomialSyntacticNormalForm_add] + simp only [Finsupp.add_apply, map_add, hp, hq] + +/-- Source division for every positive coprime cover once the even Kummer criterion applies. -/ +theorem generalSplitTracePolynomialSyntacticNormalForm_division + (hnondegenerate : sigma ≠ 1) (p : MvPolynomial (Fin 2) K) + (hnormal : generalSplitTracePolynomialSyntacticNormalForm + sigma hsigma i hi e d he hd p = 0) : + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} := by + rw [← splitTraceRecomposeGeneralResidueBlocks_polynomial + sigma hsigma i hi e d he hd p] + rw [splitTraceRecomposeResidueBlocks, Finsupp.sum] + apply Ideal.sum_mem + intro ji hji + apply splitTraceResidueBlockTerm_mem_coverIdeal + sigma e d hsigma hnondegenerate ji + rw [splitTraceBaseResidueEvaluation_generalResidueBlock] + rw [hnormal] + rfl + +/-- The roots of the positive-coprime tower satisfy the cleared affine cover equation. -/ +theorem generalSplitTraceKummerTower_cover_maps_to_zero : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime + sigma hsigma i hi e d he hd hde⟩ + generalSplitTracePolynomialToKummerTop sigma e d + (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime + sigma hsigma i hi e d he hd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let baseToXi : SplitTraceBaseFunctionField K sigma →+* + SplitTraceXiFunctionField K sigma e d := + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)).comp + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e)) + have hBase := splitTraceBaseU_V_equation sigma hsigma + have hBaseTop := congrArg baseToXi hBase + simp only [map_add, map_sub, map_mul, map_pow, map_one, map_zero] at hBaseTop + have hEtaRoot : + (AdjoinRoot.root (splitTraceEtaKummerPolynomial sigma e)) ^ e = + algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) (splitTraceBaseV sigma) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceEtaKummerPolynomial sigma e) + rw [splitTraceEtaKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hEtaTop := congrArg + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)) hEtaRoot + simp only [map_pow] at hEtaTop + have hXiRoot : + splitTraceXiRoot sigma e d ^ d = + algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d) (splitTraceXiRadicand sigma e) := by + apply sub_eq_zero.mp + have h := AdjoinRoot.eval₂_root (splitTraceXiKummerPolynomial sigma e d) + rw [splitTraceXiKummerPolynomial] at h + simp only [Polynomial.eval₂_sub, Polynomial.eval₂_pow, Polynomial.eval₂_X, + Polynomial.eval₂_C] at h + rw [← AdjoinRoot.algebraMap_eq] at h + exact h + have hCover := eval_splitTraceCoverPolynomial_of_powerRootRelations + (splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma))) + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseU sigma)) + (splitTraceBaseElementInXiField sigma e d (splitTraceBaseV sigma)) + (splitTraceXiRoot sigma e d) (splitTraceEtaRootInXiField sigma e d) d e + (by simpa [baseToXi, splitTraceBaseElementInXiField] using hBaseTop) + (by simpa [splitTraceEtaRootInXiField, splitTraceBaseElementInXiField, baseToXi] + using hEtaTop) + (by simpa [splitTraceXiRadicand, splitTraceBaseElementInXiField, baseToXi, + splitTraceXiRoot] using hXiRoot) + have hsigmaTop : + splitTraceBaseElementInXiField sigma e d + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma)) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) sigma := by + change algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d) + (algebraMap (SplitTraceBaseFunctionField K sigma) + (SplitTraceEtaFunctionField K sigma e) + (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) + (algebraMap K (RatFunc K) sigma))) = _ + rw [← IsScalarTower.algebraMap_apply K (RatFunc K) + (SplitTraceBaseFunctionField K sigma)] + rw [← IsScalarTower.algebraMap_apply K + (SplitTraceBaseFunctionField K sigma) (SplitTraceEtaFunctionField K sigma e)] + rw [← IsScalarTower.algebraMap_apply K + (SplitTraceEtaFunctionField K sigma e) (SplitTraceXiFunctionField K sigma e d)] + rw [hsigmaTop] at hCover + simpa [generalSplitTracePolynomialToKummerTop, MvPolynomial.aeval_def, + splitTraceCoverPolynomial] using hCover + +private lemma generalSplitTraceCoverPolynomial_ne_zero + (sigma : K) (d : ℕ) (hd : 0 < d) : + splitTraceCoverPolynomial (1 : K) sigma d e ≠ 0 := by + intro hzero + have heval := congrArg + (MvPolynomial.eval ![(0 : K), (1 : K)]) hzero + rw [eval_splitTraceCoverPolynomial] at heval + norm_num [hd.ne'] at heval + +/-- The normalized split trace-cover polynomial is irreducible for all positive coprime +exponents, including even exponents, over a field containing a square root of `-1`. -/ +theorem splitTraceCoverPolynomial_irreducible_of_sqrt_neg_one_coprime + (sigma : K) (hsigma : sigma ≠ 0) (i : K) (hi : i ^ 2 = -1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) (hde : d.Coprime e) + (hnondegenerate : sigma ≠ 1) : + Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one + sigma hsigma i hi e he + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime + sigma hsigma i hi e d he hd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + AdjoinRoot.isDomain_of_prime hXiIrred.prime + let f : MvPolynomial (Fin 2) K →+* SplitTraceXiFunctionField K sigma e d := + (generalSplitTracePolynomialToKummerTop sigma e d).toRingHom + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + have hCoverZero : + generalSplitTracePolynomialToKummerTop sigma e d + (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := + generalSplitTraceKummerTower_cover_maps_to_zero + sigma hsigma i hi e d he hd hde + have hI_le : I ≤ RingHom.ker f := by + change Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} ≤ RingHom.ker f + rw [Ideal.span_le] + intro p hp + simp only [Set.mem_singleton_iff] at hp + subst p + exact hCoverZero + have hker_le : RingHom.ker f ≤ I := by + intro p hp + apply generalSplitTracePolynomialSyntacticNormalForm_division + sigma hsigma i hi e d he hd hnondegenerate p + apply (generalSplitTracePolynomialSyntacticNormalForm_eq_zero_iff + sigma hsigma i hi e d he hd p).2 + exact hp + let quotientToTop : MvPolynomial (Fin 2) K ⧸ I →+* + SplitTraceXiFunctionField K sigma e d := + Ideal.Quotient.lift I f hI_le + have hInjective : Function.Injective quotientToTop := + RingHom.lift_injective_of_ker_le_ideal I hI_le hker_le + letI : IsDomain (MvPolynomial (Fin 2) K ⧸ I) := + hInjective.isDomain quotientToTop + have hprimeIdeal : I.IsPrime := + (Ideal.Quotient.isDomain_iff_prime I).mp inferInstance + have hprimeElement : Prime (splitTraceCoverPolynomial (1 : K) sigma d e) := + (Ideal.span_singleton_prime + (generalSplitTraceCoverPolynomial_ne_zero e sigma d hd)).1 (by + simpa [I] using hprimeIdeal) + exact irreducible_iff_prime.mpr hprimeElement + +end PositiveCoprimeCover + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean new file mode 100644 index 0000000000..9b68c7902d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean @@ -0,0 +1,34 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +/-! +# Standard charts of the biprojective trace curve +-/ + +namespace BGS.Markoff + +/-- The four standard affine charts of the biprojective trace curve. -/ +inductive WeightedSplitTraceProjectiveChart where + /-- The original affine chart. -/ + | affine + /-- The chart obtained by inverting the first projective coordinate. -/ + | invertFirst + /-- The chart obtained by inverting the second projective coordinate. -/ + | invertSecond + /-- The chart obtained by inverting both projective coordinates. -/ + | invertBoth + deriving DecidableEq + +/-- Backwards-compatible name used by earlier Blueprint snapshots. -/ +abbrev WeightedSplitTraceNormalizationChart := WeightedSplitTraceProjectiveChart + +universe u + +/-- Universe-lifted chart index used by Mathlib's gluing category. -/ +abbrev WeightedSplitTraceProjectiveChartIndex := + ULift.{u} WeightedSplitTraceProjectiveChart + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean new file mode 100644 index 0000000000..9db14b9e41 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean @@ -0,0 +1,263 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +import Mathlib.AlgebraicGeometry.OpenImmersion + +/-! +# Affine normalization charts and their overlap immersions + +This module packages the integral-closure rings from the trace-cover endgame as explicit affine +schemes. Their common torus overlaps are literal principal-open localizations, with open immersion +maps into the affine normalization charts. The previously proved normalization transitions are +then conjugated onto these concrete overlap schemes. + +The four-chart `Scheme.GlueData` is deliberately not asserted here: Mathlib requires explicit maps +on pullbacks of triple overlaps. The objects, open immersions, transition isomorphisms, and their +ring-level cocycle constructed below are the inputs for that remaining categorical assembly. +-/ + +namespace BGS.Markoff + +open AlgebraicGeometry + +noncomputable section + +universe u + +variable {K : Type u} [Field K] + +/-- Explicit affine `Spec` model of the normalization of one trace-cover chart. -/ +def weightedSplitTraceAffineNormalizationSpec (alpha beta : K) (d e : ℕ) : Scheme := + Spec (CommRingCat.of (WeightedSplitTraceAffineNormalizationRing alpha beta d e)) + +/-- Principal-open ring in the affine normalization obtained by inverting the original coordinate +product. -/ +abbrev WeightedSplitTraceAffineNormalizationLaurentOpenRing + (alpha beta : K) (d e : ℕ) := + Localization.Away + (algebraMap (WeightedSplitTraceAffineCoordinateRing alpha beta d e) + (WeightedSplitTraceAffineNormalizationRing alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) + +/-- The common torus overlap as an explicit affine scheme. -/ +def weightedSplitTraceAffineNormalizationLaurentOpenSpec + (alpha beta : K) (d e : ℕ) : Scheme := + Spec (CommRingCat.of + (WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e)) + +/-- The principal-open immersion of the normalized torus overlap into an affine normalization +chart. -/ +def weightedSplitTraceAffineNormalizationLaurentOpenImmersion + (alpha beta : K) (d e : ℕ) : + weightedSplitTraceAffineNormalizationLaurentOpenSpec alpha beta d e ⟶ + weightedSplitTraceAffineNormalizationSpec alpha beta d e := + Spec.map (CommRingCat.ofHom + (algebraMap (WeightedSplitTraceAffineNormalizationRing alpha beta d e) + (WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e))) + +instance weightedSplitTraceAffineNormalizationLaurentOpenImmersion_isOpen + (alpha beta : K) (d e : ℕ) : + IsOpenImmersion + (weightedSplitTraceAffineNormalizationLaurentOpenImmersion alpha beta d e) := by + dsimp only [weightedSplitTraceAffineNormalizationLaurentOpenImmersion, + weightedSplitTraceAffineNormalizationLaurentOpenSpec, + weightedSplitTraceAffineNormalizationSpec, + WeightedSplitTraceAffineNormalizationLaurentOpenRing] + infer_instance + +/-- First-coordinate inversion on the concrete principal-open normalization chart. -/ +def weightedSplitTraceLeftAffineNormalizationOpenEquiv_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e ≃+* + WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + exact conjugatedLeftNormalizationOpenEquiv alpha beta d e + (weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + alpha beta d e hd he hbeta h) + +/-- Second-coordinate inversion between the two concrete principal-open normalization charts. -/ +def weightedSplitTraceRightAffineNormalizationOpenEquiv_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + WeightedSplitTraceAffineNormalizationLaurentOpenRing beta alpha d e ≃+* + WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + exact conjugatedRightNormalizationOpenEquiv alpha beta d e + (weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + alpha beta d e hd he hbeta h) + (weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + beta alpha d e hd he halpha hswap) + +/-- Scheme automorphism of the concrete overlap induced by first-coordinate inversion. -/ +def weightedSplitTraceLeftAffineNormalizationOpenSchemeIso_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + weightedSplitTraceAffineNormalizationLaurentOpenSpec alpha beta d e ≅ + weightedSplitTraceAffineNormalizationLaurentOpenSpec alpha beta d e := + BGS.specIsoOfRingEquiv + (weightedSplitTraceLeftAffineNormalizationOpenEquiv_of_irreducible + alpha beta d e hd he hbeta h) + +/-- Contravariant scheme isomorphism of concrete overlaps induced by second-coordinate inversion. -/ +def weightedSplitTraceRightAffineNormalizationOpenSchemeIso_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + weightedSplitTraceAffineNormalizationLaurentOpenSpec alpha beta d e ≅ + weightedSplitTraceAffineNormalizationLaurentOpenSpec beta alpha d e := + BGS.specIsoOfRingEquiv + (weightedSplitTraceRightAffineNormalizationOpenEquiv_of_irreducible + alpha beta d e hd he halpha hbeta h hswap) + +/-- The affine normalization scheme used by each of the four standard charts. Inverting the +second coordinate swaps the two weights. -/ +def weightedSplitTraceNormalizationChartScheme + (alpha beta : K) (d e : ℕ) : WeightedSplitTraceProjectiveChart → Scheme + | .affine | .invertFirst => weightedSplitTraceAffineNormalizationSpec alpha beta d e + | .invertSecond | .invertBoth => weightedSplitTraceAffineNormalizationSpec beta alpha d e + +/-- The common torus open inside each standard normalization chart. -/ +def weightedSplitTraceNormalizationChartOpen + (alpha beta : K) (d e : ℕ) : WeightedSplitTraceProjectiveChart → Scheme + | .affine | .invertFirst => weightedSplitTraceAffineNormalizationLaurentOpenSpec alpha beta d e + | .invertSecond | .invertBoth => + weightedSplitTraceAffineNormalizationLaurentOpenSpec beta alpha d e + +/-- Principal-open immersion from each chart's torus overlap into that affine normalization +chart. -/ +def weightedSplitTraceNormalizationChartOpenImmersion + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChart) : + weightedSplitTraceNormalizationChartOpen alpha beta d e i ⟶ + weightedSplitTraceNormalizationChartScheme alpha beta d e i := by + cases i with + | affine | invertFirst => + exact weightedSplitTraceAffineNormalizationLaurentOpenImmersion alpha beta d e + | invertSecond | invertBoth => + exact weightedSplitTraceAffineNormalizationLaurentOpenImmersion beta alpha d e + +instance weightedSplitTraceNormalizationChartOpenImmersion_isOpen + (alpha beta : K) (d e : ℕ) (i : WeightedSplitTraceProjectiveChart) : + IsOpenImmersion + (weightedSplitTraceNormalizationChartOpenImmersion alpha beta d e i) := by + cases i with + | affine | invertFirst => + exact weightedSplitTraceAffineNormalizationLaurentOpenImmersion_isOpen alpha beta d e + | invertSecond | invertBoth => + exact weightedSplitTraceAffineNormalizationLaurentOpenImmersion_isOpen beta alpha d e + +/-- Every chart overlap, expressed in its own coordinates, identified with the normalized Laurent +scheme in the original `(alpha, beta)` coordinates. The four cases encode no inversion, first +inversion, second inversion, and both inversions respectively. -/ +def weightedSplitTraceNormalizationChartOpenIsoCommon + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) + (i : WeightedSplitTraceProjectiveChart) : + weightedSplitTraceNormalizationChartOpen alpha beta d e i ≅ + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e)) := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + let openA := weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + alpha beta d e hd he hbeta h + let openB := weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + beta alpha d e hd he halpha hswap + let left := weightedSplitTraceLeftInversionLaurentNormalizationSchemeIso alpha beta d e + let right := weightedSplitTraceRightInversionLaurentNormalizationSchemeIso alpha beta d e + cases i with + | affine => exact openA.symm + | invertFirst => exact openA.symm.trans left + | invertSecond => exact openB.symm.trans right.symm + | invertBoth => exact (openB.symm.trans right.symm).trans left + +/-- The actual four-chart gluing datum for the normalized trace-cover charts. The pullback-level +triple-overlap maps are supplied by `constantOpenGlueDataOfCommonTarget`; they are not assumed. -/ +def weightedSplitTraceProjectiveNormalizationGlueData + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + Scheme.GlueData := + BGS.constantOpenGlueDataOfCommonTarget + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartScheme alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpen alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpenImmersion alpha beta d e i.down) + (Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e))) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpenIsoCommon + alpha beta d e hd he halpha hbeta h hswap i.down) + +/-- The four affine normalization charts glued along their normalized torus opens. -/ +def weightedSplitTraceProjectiveNormalization + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : Scheme := + (weightedSplitTraceProjectiveNormalizationGlueData + alpha beta d e hd he halpha hbeta h hswap).glued + +/-- Open immersion of a standard affine normalization chart into the glued normalization. -/ +def weightedSplitTraceNormalizationChartMap + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) + (i : WeightedSplitTraceProjectiveChartIndex) : + weightedSplitTraceNormalizationChartScheme alpha beta d e i.down ⟶ + weightedSplitTraceProjectiveNormalization + alpha beta d e hd he halpha hbeta h hswap := + (weightedSplitTraceProjectiveNormalizationGlueData + alpha beta d e hd he halpha hbeta h hswap).ι i + +instance weightedSplitTraceNormalizationChartMap_isOpen + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) + (i : WeightedSplitTraceProjectiveChartIndex) : + IsOpenImmersion (weightedSplitTraceNormalizationChartMap + alpha beta d e hd he halpha hbeta h hswap i) := by + dsimp only [weightedSplitTraceNormalizationChartMap] + exact Scheme.GlueData.ι_isOpenImmersion + (weightedSplitTraceProjectiveNormalizationGlueData + alpha beta d e hd he halpha hbeta h hswap) i + +/-- The four standard affine normalization charts cover the glued normalization. -/ +theorem weightedSplitTraceNormalizationChartMap_jointly_surjective + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) + (x : (weightedSplitTraceProjectiveNormalization + alpha beta d e hd he halpha hbeta h hswap).carrier) : + ∃ (i : WeightedSplitTraceProjectiveChartIndex) + (y : (weightedSplitTraceNormalizationChartScheme alpha beta d e i.down).carrier), + weightedSplitTraceNormalizationChartMap + alpha beta d e hd he halpha hbeta h hswap i y = x := + (weightedSplitTraceProjectiveNormalizationGlueData + alpha beta d e hd he halpha hbeta h hswap).ι_jointly_surjective x + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean new file mode 100644 index 0000000000..4316a74e90 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean @@ -0,0 +1,469 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts + +/-! +# The normalization morphism on trace-curve charts + +This module connects the integral-closure charts to the raw biprojective trace curve. The key +point is the explicit principal-open square: localization of the affine normalization map agrees +with normalization of the Laurent chart. The coordinate inversions are then checked to commute +with the raw-to-normalized Laurent map. +-/ + +namespace BGS.Markoff + +open CategoryTheory +open AlgebraicGeometry + +noncomputable section + +universe u + +variable {K : Type u} [Field K] + +/-- Canonical ring map from an affine trace chart to its integral closure. -/ +def weightedSplitTraceAffineNormalizationRingHom (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e →+* + WeightedSplitTraceAffineNormalizationRing alpha beta d e := + algebraMap _ _ + +/-- Canonical localization map from an affine normalization to its Laurent principal open. -/ +def weightedSplitTraceAffineNormalizationAwayRingHom (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineNormalizationRing alpha beta d e →+* + WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e := + algebraMap _ _ + +/-- Canonical ring map from an affine trace chart to its Laurent principal open. -/ +def weightedSplitTraceAffineLaurentRingHom (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceAffineCoordinateRing alpha beta d e →+* + WeightedSplitTraceLaurentCoordinateRing alpha beta d e := + algebraMap _ _ + +/-- Canonical ring map from the raw Laurent chart to its normalization. -/ +def weightedSplitTraceLaurentNormalizationRingHom (alpha beta : K) (d e : ℕ) : + WeightedSplitTraceLaurentCoordinateRing alpha beta d e →+* + WeightedSplitTraceLaurentNormalizationRing alpha beta d e := + algebraMap _ _ + +/-- Inverse of the comparison between the localized affine normalization and normalized Laurent +ring. -/ +def weightedSplitTraceAffineOpenInverseRingHom_of_irreducible + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + WeightedSplitTraceLaurentNormalizationRing alpha beta d e →+* + WeightedSplitTraceAffineNormalizationLaurentOpenRing alpha beta d e := + (weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + alpha beta d e hd he hbeta h).symm.toRingHom + +/-- Before applying the integral-closure comparison, the two routes from the affine chart to the +localized affine normalization are equal by the scalar-tower law. -/ +theorem weightedSplitTraceRawPrincipalOpenSquare + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e)] : + (integralClosureAwayMap + (weightedSplitTraceAffineCoordinateProduct alpha beta d e)).comp + (weightedSplitTraceAffineLaurentRingHom alpha beta d e) = + (weightedSplitTraceAffineNormalizationAwayRingHom alpha beta d e).comp + (weightedSplitTraceAffineNormalizationRingHom alpha beta d e) := by + apply DFunLike.ext _ _ + intro r + simp [integralClosureAwayMap, weightedSplitTraceAffineLaurentRingHom, + weightedSplitTraceAffineNormalizationAwayRingHom, + weightedSplitTraceAffineNormalizationRingHom] + exact IsScalarTower.algebraMap_apply _ _ _ r + +/-- Ring-level affine-chart square for the normalization map. -/ +theorem weightedSplitTraceAffineNormalizationRingSquare + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + (weightedSplitTraceAffineNormalizationAwayRingHom alpha beta d e).comp + (weightedSplitTraceAffineNormalizationRingHom alpha beta d e) = + (weightedSplitTraceAffineOpenInverseRingHom_of_irreducible + alpha beta d e hd he hbeta h).comp + ((weightedSplitTraceLaurentNormalizationRingHom alpha beta d e).comp + (weightedSplitTraceAffineLaurentRingHom alpha beta d e)) := by + letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h + let E := weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible + alpha beta d e hd he hbeta h + apply DFunLike.ext _ _ + intro r + apply E.injective + dsimp only [weightedSplitTraceAffineOpenInverseRingHom_of_irreducible] + change E (((weightedSplitTraceAffineNormalizationAwayRingHom alpha beta d e).comp + (weightedSplitTraceAffineNormalizationRingHom alpha beta d e)) r) = + E (E.symm (((weightedSplitTraceLaurentNormalizationRingHom alpha beta d e).comp + (weightedSplitTraceAffineLaurentRingHom alpha beta d e)) r)) + rw [E.apply_symm_apply] + have hc := integralClosureAwayEquiv_comp_map + (weightedSplitTraceAffineCoordinateProduct alpha beta d e) + (weightedSplitTraceAffineCoordinateProduct_ne_zero_of_irreducible + alpha beta d e hd he hbeta h) + have hr := weightedSplitTraceRawPrincipalOpenSquare alpha beta d e + rw [← DFunLike.congr_fun hr r] + exact DFunLike.congr_fun hc ((weightedSplitTraceAffineLaurentRingHom alpha beta d e) r) + +/-- The affine normalization chart maps to the corresponding raw affine curve chart. -/ +def weightedSplitTraceAffineIntegralClosureToCurve (alpha beta : K) (d e : ℕ) : + weightedSplitTraceAffineNormalizationSpec alpha beta d e ⟶ + weightedSplitTraceAffineCurveSpec alpha beta d e := + Spec.map (CommRingCat.ofHom + (weightedSplitTraceAffineNormalizationRingHom alpha beta d e)) + +/-- The normalized common Laurent chart maps to the raw Laurent chart. -/ +def weightedSplitTraceLaurentNormalizationToCurve (alpha beta : K) (d e : ℕ) : + Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e)) ⟶ + weightedSplitTraceLaurentCurveSpec alpha beta d e := + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e)) + +/-- Scheme-level affine-chart square for the normalization map. -/ +theorem weightedSplitTraceAffineNormalizationSquare + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : + weightedSplitTraceAffineNormalizationLaurentOpenImmersion alpha beta d e ≫ + weightedSplitTraceAffineIntegralClosureToCurve alpha beta d e = + (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + alpha beta d e hd he hbeta h).inv ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + weightedSplitTraceLaurentCurveOpenImmersion alpha beta d e := by + change + Spec.map (CommRingCat.ofHom + (weightedSplitTraceAffineNormalizationAwayRingHom alpha beta d e)) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceAffineNormalizationRingHom alpha beta d e)) = + Spec.map (CommRingCat.ofHom + (weightedSplitTraceAffineOpenInverseRingHom_of_irreducible + alpha beta d e hd he hbeta h)) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e)) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceAffineLaurentRingHom alpha beta d e)) + exact BGS.specMap_two_eq_three_of_comp_eq + (weightedSplitTraceAffineNormalizationRingHom alpha beta d e) + (weightedSplitTraceAffineNormalizationAwayRingHom alpha beta d e) + (weightedSplitTraceAffineLaurentRingHom alpha beta d e) + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e) + (weightedSplitTraceAffineOpenInverseRingHom_of_irreducible + alpha beta d e hd he hbeta h) + (weightedSplitTraceAffineNormalizationRingSquare alpha beta d e hd he hbeta h) + +/-- First-coordinate inversion commutes with the raw-to-normalized Laurent ring map. -/ +theorem weightedSplitTraceLeftLaurentNormalizationRingSquare + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] : + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e).toRingHom.comp + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e) = + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e).comp + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e).toRingHom := + integralClosureFractionRingEquiv_comp_algebraMap + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e) + +/-- Second-coordinate inversion commutes with the raw-to-normalized Laurent ring maps. -/ +theorem weightedSplitTraceRightLaurentNormalizationRingSquare + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] : + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e).toRingHom.comp + (weightedSplitTraceLaurentNormalizationRingHom beta alpha d e) = + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e).comp + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e).toRingHom := + integralClosureFractionRingEquiv_comp_algebraMap + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e) + +/-- Scheme-level naturality of first-coordinate inversion. -/ +@[reassoc] +theorem weightedSplitTraceLeftLaurentNormalizationSquare + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] : + (weightedSplitTraceLeftInversionLaurentNormalizationSchemeIso alpha beta d e).hom ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e = + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + (weightedSplitTraceLeftInversionLaurentCurveSchemeIso alpha beta d e).hom := by + change + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e).toRingHom) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e)) = + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e)) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e).toRingHom) + exact BGS.specMap_two_eq_two_of_comp_eq + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e) + (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e).toRingHom + (weightedSplitTraceLeftInversionLaurentEquiv alpha beta d e).toRingHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e) + (weightedSplitTraceLeftLaurentNormalizationRingSquare alpha beta d e) + +/-- Scheme-level naturality of second-coordinate inversion. -/ +@[reassoc] +theorem weightedSplitTraceRightLaurentNormalizationSquare + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] : + (weightedSplitTraceRightInversionLaurentNormalizationSchemeIso alpha beta d e).hom ≫ + weightedSplitTraceLaurentNormalizationToCurve beta alpha d e = + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + (weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e).hom := by + change + Spec.map (CommRingCat.ofHom + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e).toRingHom) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLaurentNormalizationRingHom beta alpha d e)) = + Spec.map (CommRingCat.ofHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e)) ≫ + Spec.map (CommRingCat.ofHom + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e).toRingHom) + exact BGS.specMap_two_eq_two_of_comp_eq + (weightedSplitTraceLaurentNormalizationRingHom beta alpha d e) + (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e).toRingHom + (weightedSplitTraceRightInversionLaurentEquiv alpha beta d e).toRingHom + (weightedSplitTraceLaurentNormalizationRingHom alpha beta d e) + (weightedSplitTraceRightLaurentNormalizationRingSquare alpha beta d e) + +/-- Inverse form of second-coordinate naturality, oriented for the swapped affine charts. -/ +@[reassoc] +theorem weightedSplitTraceRightLaurentNormalizationInverseSquare + (alpha beta : K) (d e : ℕ) + [IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e)] + [IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e)] : + (weightedSplitTraceRightInversionLaurentNormalizationSchemeIso alpha beta d e).inv ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + (weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e).hom = + weightedSplitTraceLaurentNormalizationToCurve beta alpha d e := by + rw [← weightedSplitTraceRightLaurentNormalizationSquare alpha beta d e] + simp + +/-- Compatibility square for the chart obtained by inverting the first coordinate. -/ +theorem weightedSplitTraceFirstInvertedNormalizationSquare + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + weightedSplitTraceAffineNormalizationLaurentOpenImmersion alpha beta d e ≫ + weightedSplitTraceAffineIntegralClosureToCurve alpha beta d e = + ((weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + alpha beta d e hd he hbeta h).symm.trans + (weightedSplitTraceLeftInversionLaurentNormalizationSchemeIso alpha beta d e)).hom ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + (weightedSplitTraceLeftInversionLaurentCurveSchemeIso alpha beta d e).inv ≫ + weightedSplitTraceLaurentCurveOpenImmersion alpha beta d e := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + calc + _ = (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + alpha beta d e hd he hbeta h).inv ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + weightedSplitTraceLaurentCurveOpenImmersion alpha beta d e := + weightedSplitTraceAffineNormalizationSquare alpha beta d e hd he hbeta h + _ = _ := by + simp only [Iso.trans_hom, Iso.symm_hom, Category.assoc] + rw [weightedSplitTraceLeftLaurentNormalizationSquare_assoc alpha beta d e] + simp + +/-- Compatibility square for the chart obtained by inverting the second coordinate. -/ +theorem weightedSplitTraceSecondInvertedNormalizationSquare + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + weightedSplitTraceAffineNormalizationLaurentOpenImmersion beta alpha d e ≫ + weightedSplitTraceAffineIntegralClosureToCurve beta alpha d e = + ((weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + beta alpha d e hd he halpha hswap).symm.trans + (weightedSplitTraceRightInversionLaurentNormalizationSchemeIso alpha beta d e).symm).hom ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + (weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e).hom ≫ + weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + calc + _ = (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + beta alpha d e hd he halpha hswap).inv ≫ + weightedSplitTraceLaurentNormalizationToCurve beta alpha d e ≫ + weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e := + weightedSplitTraceAffineNormalizationSquare beta alpha d e hd he halpha hswap + _ = _ := by + simp only [Iso.trans_hom, Iso.symm_hom, Category.assoc] + rw [weightedSplitTraceRightLaurentNormalizationInverseSquare_assoc alpha beta d e] + +/-- Compatibility square for the chart obtained by inverting both coordinates. -/ +theorem weightedSplitTraceBothInvertedNormalizationSquare + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + weightedSplitTraceAffineNormalizationLaurentOpenImmersion beta alpha d e ≫ + weightedSplitTraceAffineIntegralClosureToCurve beta alpha d e = + (((weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + beta alpha d e hd he halpha hswap).symm.trans + (weightedSplitTraceRightInversionLaurentNormalizationSchemeIso alpha beta d e).symm).trans + (weightedSplitTraceLeftInversionLaurentNormalizationSchemeIso alpha beta d e)).hom ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + ((weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e).symm.trans + (weightedSplitTraceLeftInversionLaurentCurveSchemeIso alpha beta d e)).inv ≫ + weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e := by + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h + letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap + calc + _ = (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible + beta alpha d e hd he halpha hswap).inv ≫ + weightedSplitTraceLaurentNormalizationToCurve beta alpha d e ≫ + weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e := + weightedSplitTraceAffineNormalizationSquare beta alpha d e hd he halpha hswap + _ = _ := by + simp only [Iso.trans_hom, Iso.symm_hom, Iso.trans_inv, Iso.symm_inv, Category.assoc] + rw [weightedSplitTraceLeftLaurentNormalizationSquare_assoc alpha beta d e] + simp only [Iso.hom_inv_id_assoc] + rw [weightedSplitTraceRightLaurentNormalizationInverseSquare_assoc alpha beta d e] + +/-- Raw target map for each of the four affine normalization charts. -/ +def weightedSplitTraceNormalizationChartToProjectiveChart + (alpha beta : K) (d e : ℕ) : + (i : WeightedSplitTraceProjectiveChart) → + weightedSplitTraceNormalizationChartScheme alpha beta d e i ⟶ + weightedSplitTraceProjectiveChartScheme alpha beta d e i + | .affine | .invertFirst => weightedSplitTraceAffineIntegralClosureToCurve alpha beta d e + | .invertSecond | .invertBoth => weightedSplitTraceAffineIntegralClosureToCurve beta alpha d e + +/-- All four affine normalization maps restrict to the same raw Laurent normalization map under +the chosen common-overlap identifications. -/ +theorem weightedSplitTraceNormalizationChartCompatibility + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) + (i : WeightedSplitTraceProjectiveChart) : + weightedSplitTraceNormalizationChartOpenImmersion alpha beta d e i ≫ + weightedSplitTraceNormalizationChartToProjectiveChart alpha beta d e i = + (weightedSplitTraceNormalizationChartOpenIsoCommon + alpha beta d e hd he halpha hbeta h hswap i).hom ≫ + weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ + (weightedSplitTraceProjectiveChartOpenIsoCommon alpha beta d e i).inv ≫ + weightedSplitTraceProjectiveChartOpenImmersion alpha beta d e i := by + cases i with + | affine => + exact weightedSplitTraceAffineNormalizationSquare alpha beta d e hd he hbeta h + | invertFirst => + dsimp [weightedSplitTraceNormalizationChartOpenImmersion, + weightedSplitTraceNormalizationChartToProjectiveChart, + weightedSplitTraceNormalizationChartOpenIsoCommon, + weightedSplitTraceProjectiveChartOpenIsoCommon, + weightedSplitTraceProjectiveChartOpenImmersion] + exact weightedSplitTraceFirstInvertedNormalizationSquare + alpha beta d e hd he halpha hbeta h hswap + | invertSecond => + dsimp [weightedSplitTraceNormalizationChartOpenImmersion, + weightedSplitTraceNormalizationChartToProjectiveChart, + weightedSplitTraceNormalizationChartOpenIsoCommon, + weightedSplitTraceProjectiveChartOpenIsoCommon, + weightedSplitTraceProjectiveChartOpenImmersion] + exact weightedSplitTraceSecondInvertedNormalizationSquare + alpha beta d e hd he halpha hbeta h hswap + | invertBoth => + dsimp [weightedSplitTraceNormalizationChartOpenImmersion, + weightedSplitTraceNormalizationChartToProjectiveChart, + weightedSplitTraceNormalizationChartOpenIsoCommon, + weightedSplitTraceProjectiveChartOpenIsoCommon, + weightedSplitTraceProjectiveChartOpenImmersion] + exact weightedSplitTraceBothInvertedNormalizationSquare + alpha beta d e hd he halpha hbeta h hswap + +/-- The global morphism from the glued integral-closure charts to the raw biprojective trace +curve, descended from the four compatible affine normalization maps. -/ +def weightedSplitTraceProjectiveNormalizationToBiprojectiveCurve + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) : + weightedSplitTraceProjectiveNormalization + alpha beta d e hd he halpha hbeta h hswap ⟶ + weightedSplitTraceBiprojectiveCurve alpha beta d e := + BGS.constantOpenGlueDataOfCommonTargetMap + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartScheme alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpen alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartScheme alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpen alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpenImmersion alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpenImmersion alpha beta d e i.down) + (Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e))) + (weightedSplitTraceLaurentCurveSpec alpha beta d e) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpenIsoCommon + alpha beta d e hd he halpha hbeta h hswap i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpenIsoCommon alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartToProjectiveChart alpha beta d e i.down) + (weightedSplitTraceLaurentNormalizationToCurve alpha beta d e) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartCompatibility + alpha beta d e hd he halpha hbeta h hswap i.down) + +/-- On every standard affine chart, the global normalization morphism is the canonical affine +integral-closure map followed by the corresponding raw chart inclusion. -/ +@[reassoc] +theorem weightedSplitTraceNormalizationChartMap_toBiprojectiveCurve + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) + (hswap : Irreducible (splitTraceCoverPolynomial beta alpha d e)) + (i : WeightedSplitTraceProjectiveChartIndex) : + weightedSplitTraceNormalizationChartMap + alpha beta d e hd he halpha hbeta h hswap i ≫ + weightedSplitTraceProjectiveNormalizationToBiprojectiveCurve + alpha beta d e hd he halpha hbeta h hswap = + weightedSplitTraceNormalizationChartToProjectiveChart alpha beta d e i.down ≫ + weightedSplitTraceProjectiveChartMap alpha beta d e i := by + exact BGS.constantOpenGlueDataOfCommonTargetMap_chart + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartScheme alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpen alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartScheme alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpen alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpenImmersion alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpenImmersion alpha beta d e i.down) + (Spec (CommRingCat.of (WeightedSplitTraceLaurentNormalizationRing alpha beta d e))) + (weightedSplitTraceLaurentCurveSpec alpha beta d e) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartOpenIsoCommon + alpha beta d e hd he halpha hbeta h hswap i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceProjectiveChartOpenIsoCommon alpha beta d e i.down) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartToProjectiveChart alpha beta d e i.down) + (weightedSplitTraceLaurentNormalizationToCurve alpha beta d e) + (fun i : WeightedSplitTraceProjectiveChartIndex ↦ + weightedSplitTraceNormalizationChartCompatibility + alpha beta d e hd he halpha hbeta h hswap i.down) + i + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean new file mode 100644 index 0000000000..6cc3970431 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean @@ -0,0 +1,267 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +import Mathlib.Analysis.SpecialFunctions.Pow.Real + +/-! +# The exact projective-to-torus point-count bridge + +Mathlib currently has no general smooth-projective curve, genus, normalization, +and Hasse--Weil package from which the endgame estimate can be derived. This +module therefore starts at the first honest arithmetic interface: + +* an explicit equivalence between affine cover zeros and projective rational + points away from an explicit boundary finset; +* the Hasse inequality for that projective model, passed as a proposition; +* independent numerical genus and boundary bounds. + +The conclusion is the desired `O(sqrt (#K) * d * e)` estimate for the actual +Laurent trace-solution finset. No target estimate is hidden in a typeclass. +-/ + +namespace BGS.Markoff + +noncomputable section + +variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] + +/-- An explicit projective comparison, Hasse inequality, genus bound, and +boundary bound imply the split trace-cover estimate on the original torus. + +`projectivePoints` is intended to be the rational-point finset of the smooth +projective normalization, and `projectiveBoundary` its complement of the +affine chart. Requiring an actual equivalence of finite types prevents the +model comparison from being replaced by a cardinality assertion about the +desired torus count. -/ +theorem splitTraceCurveSolutions_count_error_le_of_projectiveComparison_and_hasse + {P : Type*} [DecidableEq P] + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (projectivePoints projectiveBoundary : Finset P) + (hboundarySubset : projectiveBoundary ⊆ projectivePoints) + (modelComparison : + ↥(affineSplitTraceCoverZeros K alpha beta d e) ≃ + ↥(projectivePoints \ projectiveBoundary)) + (genus genusCoefficient boundaryCoefficient : ℕ) + (hprojectiveHasse : + |(projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)| ≤ + 2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ)) + (hgenus : genus ≤ genusCoefficient * d * e) + (hboundary : projectiveBoundary.card ≤ boundaryCoefficient * d * e) : + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + ((2 * (genusCoefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ)) + + (boundaryCoefficient : ℝ)) * (d : ℝ) * (e : ℝ) := by + have hmodelCard : + (affineSplitTraceCoverZeros K alpha beta d e).card = + (projectivePoints \ projectiveBoundary).card := by + calc + (affineSplitTraceCoverZeros K alpha beta d e).card = + Fintype.card ↥(affineSplitTraceCoverZeros K alpha beta d e) := + (Fintype.card_coe _).symm + _ = Fintype.card ↥(projectivePoints \ projectiveBoundary) := + Fintype.card_congr modelComparison + _ = (projectivePoints \ projectiveBoundary).card := Fintype.card_coe _ + have hprojectivePartition : + (projectivePoints \ projectiveBoundary).card + projectiveBoundary.card = + projectivePoints.card := + Finset.card_sdiff_add_card_eq_card hboundarySubset + have haffineBoundary := + affineSplitTraceCoverZeros_card_eq_torus_card_add_one + K alpha beta d e hd he hbeta + have htorusSolutions := + torusSplitTraceCoverZeros_card_eq_splitTraceCurveSolutions_card + K alpha beta d e + have hcardIdentity : + projectivePoints.card = + (splitTraceCurveSolutions K alpha beta d e).card + 1 + + projectiveBoundary.card := by + omega + have herrorIdentity : + ((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ) = + ((projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)) - + (projectiveBoundary.card : ℝ) := by + have hcardReal : + (projectivePoints.card : ℝ) = + (splitTraceCurveSolutions K alpha beta d e).card + 1 + + projectiveBoundary.card := by + exact_mod_cast hcardIdentity + rw [hcardReal] + ring + have hboundaryReal : + (projectiveBoundary.card : ℝ) ≤ + (boundaryCoefficient : ℝ) * d * e := by + exact_mod_cast hboundary + have hgenusReal : + (genus : ℝ) ≤ (genusCoefficient : ℝ) * d * e := by + exact_mod_cast hgenus + have hsqrtNonnegative : + 0 ≤ Real.sqrt (Fintype.card K : ℝ) := Real.sqrt_nonneg _ + rw [herrorIdentity] + calc + |((projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)) - + (projectiveBoundary.card : ℝ)| ≤ + |(projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)| + + |(projectiveBoundary.card : ℝ)| := abs_sub _ _ + _ = |(projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)| + + (projectiveBoundary.card : ℝ) := by simp + _ ≤ 2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ) + + (projectiveBoundary.card : ℝ) := + add_le_add hprojectiveHasse le_rfl + _ ≤ 2 * ((genusCoefficient : ℝ) * d * e) * + Real.sqrt (Fintype.card K : ℝ) + + ((boundaryCoefficient : ℝ) * d * e) := by + gcongr + _ = ((2 * (genusCoefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ)) + + (boundaryCoefficient : ℝ)) * (d : ℝ) * (e : ℝ) := by ring + +/-- Since a finite field is nonempty, its square-root cardinality is at least +one. Thus the separate projective-boundary contribution can be absorbed into +the same `sqrt (#K) * d * e` error term used in the paper. -/ +theorem splitTraceCurveSolutions_count_error_le_sqrt_mul_de_of_projectiveComparison_and_hasse + {P : Type*} [DecidableEq P] + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (projectivePoints projectiveBoundary : Finset P) + (hboundarySubset : projectiveBoundary ⊆ projectivePoints) + (modelComparison : + ↥(affineSplitTraceCoverZeros K alpha beta d e) ≃ + ↥(projectivePoints \ projectiveBoundary)) + (genus genusCoefficient boundaryCoefficient : ℕ) + (hprojectiveHasse : + |(projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)| ≤ + 2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ)) + (hgenus : genus ≤ genusCoefficient * d * e) + (hboundary : projectiveBoundary.card ≤ boundaryCoefficient * d * e) : + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (2 * (genusCoefficient : ℝ) + (boundaryCoefficient : ℝ)) * + Real.sqrt (Fintype.card K : ℝ) * (d : ℝ) * (e : ℝ) := by + have hbridge := + splitTraceCurveSolutions_count_error_le_of_projectiveComparison_and_hasse + K alpha beta d e hd he hbeta projectivePoints projectiveBoundary + hboundarySubset modelComparison genus genusCoefficient boundaryCoefficient + hprojectiveHasse hgenus hboundary + have hcardOneNat : 1 ≤ Fintype.card K := Fintype.card_pos + have hcardOneReal : (1 : ℝ) ≤ Fintype.card K := by exact_mod_cast hcardOneNat + have hsqrtOne : (1 : ℝ) ≤ Real.sqrt (Fintype.card K : ℝ) := + Real.one_le_sqrt.mpr hcardOneReal + have hboundaryAbsorb : + (boundaryCoefficient : ℝ) ≤ + (boundaryCoefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) := by + simpa using mul_le_mul_of_nonneg_left hsqrtOne + (Nat.cast_nonneg boundaryCoefficient) + calc + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + ((2 * (genusCoefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ)) + + (boundaryCoefficient : ℝ)) * (d : ℝ) * (e : ℝ) := hbridge + _ ≤ (2 * (genusCoefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ) + + (boundaryCoefficient : ℝ) * Real.sqrt (Fintype.card K : ℝ)) * + (d : ℝ) * (e : ℝ) := by gcongr + _ = (2 * (genusCoefficient : ℝ) + (boundaryCoefficient : ℝ)) * + Real.sqrt (Fintype.card K : ℝ) * (d : ℝ) * (e : ℝ) := by ring + +/-- Square-form Hasse interface, matching the form used by the explicit +Legendre development and the standard Hasse--Weil statement. -/ +theorem splitTraceCurveSolutions_count_error_le_sqrt_mul_de_of_projectiveComparison_and_hasseSquare + {P : Type*} [DecidableEq P] + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (projectivePoints projectiveBoundary : Finset P) + (hboundarySubset : projectiveBoundary ⊆ projectivePoints) + (modelComparison : + ↥(affineSplitTraceCoverZeros K alpha beta d e) ≃ + ↥(projectivePoints \ projectiveBoundary)) + (genus genusCoefficient boundaryCoefficient : ℕ) + (hprojectiveHasseSquare : + ((projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)) ^ 2 ≤ + 4 * (genus : ℝ) ^ 2 * (Fintype.card K : ℝ)) + (hgenus : genus ≤ genusCoefficient * d * e) + (hboundary : projectiveBoundary.card ≤ boundaryCoefficient * d * e) : + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (2 * (genusCoefficient : ℝ) + (boundaryCoefficient : ℝ)) * + Real.sqrt (Fintype.card K : ℝ) * (d : ℝ) * (e : ℝ) := by + let projectiveError : ℝ := + (projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1) + have hcardNonnegative : (0 : ℝ) ≤ Fintype.card K := Nat.cast_nonneg _ + have htargetNonnegative : + 0 ≤ 2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ) := by positivity + have hprojectiveHasse : + |projectiveError| ≤ + 2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ) := by + apply (sq_le_sq₀ (abs_nonneg _) htargetNonnegative).mp + calc + |projectiveError| ^ 2 = projectiveError ^ 2 := sq_abs projectiveError + _ ≤ 4 * (genus : ℝ) ^ 2 * (Fintype.card K : ℝ) := by + simpa [projectiveError] using hprojectiveHasseSquare + _ = (2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ)) ^ 2 := by + rw [mul_pow, mul_pow, Real.sq_sqrt hcardNonnegative] + ring + exact splitTraceCurveSolutions_count_error_le_sqrt_mul_de_of_projectiveComparison_and_hasse + K alpha beta d e hd he hbeta projectivePoints projectiveBoundary + hboundarySubset modelComparison genus genusCoefficient boundaryCoefficient + (by simpa [projectiveError] using hprojectiveHasse) hgenus hboundary + +/-! ### Boundary labels supplied by the corner initial forms -/ + +/-- Four raw projective corners, with one label for each factor of the corresponding weighted +initial form. A normalization proof should inject its boundary points into this finite type. -/ +abbrev splitTraceNormalizationBoundaryLabels (d e : ℕ) := + Fin 4 × Fin (Nat.gcd d e) + +/-- An injective labeling of normalization-boundary points by a corner and an initial factor gives +the explicit `4de` boundary bound required by the point-count bridge. This premise is structural: +it does not assume the desired cardinal inequality. -/ +theorem projectiveBoundary_card_le_four_mul_de_of_injective_normalizationLabels + {P : Type*} [DecidableEq P] (boundary : Finset P) + (d e : ℕ) (hd : 0 < d) (he : 0 < e) + (labels : ↥boundary → splitTraceNormalizationBoundaryLabels d e) + (hlabels : Function.Injective labels) : + boundary.card ≤ 4 * d * e := by + have hgcd : Nat.gcd d e ≤ d := Nat.gcd_le_left e hd + have hdde : d ≤ d * e := Nat.le_mul_of_pos_right d he + calc + boundary.card = Fintype.card ↥boundary := (Fintype.card_coe boundary).symm + _ ≤ Fintype.card (splitTraceNormalizationBoundaryLabels d e) := + Fintype.card_le_of_injective labels hlabels + _ = 4 * Nat.gcd d e := by simp + _ ≤ 4 * d := Nat.mul_le_mul_left 4 hgcd + _ ≤ 4 * d * e := by simpa [Nat.mul_assoc] using Nat.mul_le_mul_left 4 hdde + +/-- The projective point estimate with boundary control supplied by actual normalization labels. +The remaining inputs are the affine-chart comparison, the genus bound, and Hasse--Weil for the +smooth projective normalization. -/ +theorem splitTraceCurveSolutions_count_error_le_of_normalizationLabels_and_hasse + {P : Type*} [DecidableEq P] + (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) + (projectivePoints projectiveBoundary : Finset P) + (hboundarySubset : projectiveBoundary ⊆ projectivePoints) + (modelComparison : + ↥(affineSplitTraceCoverZeros K alpha beta d e) ≃ + ↥(projectivePoints \ projectiveBoundary)) + (boundaryLabels : + ↥projectiveBoundary → splitTraceNormalizationBoundaryLabels d e) + (hboundaryLabels : Function.Injective boundaryLabels) + (genus genusCoefficient : ℕ) + (hprojectiveHasse : + |(projectivePoints.card : ℝ) - ((Fintype.card K : ℝ) + 1)| ≤ + 2 * (genus : ℝ) * Real.sqrt (Fintype.card K : ℝ)) + (hgenus : genus ≤ genusCoefficient * d * e) : + |((splitTraceCurveSolutions K alpha beta d e).card : ℝ) - + (Fintype.card K : ℝ)| ≤ + (2 * (genusCoefficient : ℝ) + 4) * + Real.sqrt (Fintype.card K : ℝ) * (d : ℝ) * (e : ℝ) := by + exact splitTraceCurveSolutions_count_error_le_sqrt_mul_de_of_projectiveComparison_and_hasse + K alpha beta d e hd he hbeta projectivePoints projectiveBoundary + hboundarySubset modelComparison genus genusCoefficient 4 hprojectiveHasse hgenus + (projectiveBoundary_card_le_four_mul_de_of_injective_normalizationLabels + projectiveBoundary d e hd he boundaryLabels hboundaryLabels) + +end + + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean new file mode 100644 index 0000000000..00bc412fa3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean @@ -0,0 +1,255 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm + +/-! +# Semantic normal forms for the split trace cover + +The iterated monic `AdjoinRoot` presentation gives every element of the Kummer top algebra a +unique rectangular coefficient vector. Composing this representation with the affine and +Laurent comparison maps gives semantic normal forms for trace-cover classes, and evaluation of +those coefficients recovers the comparison-map image exactly. + +This does not identify two source classes with the same semantic normal form. That remaining +injectivity statement is the syntactic quotient-division wall and is kept explicit below. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +/-- Rectangular coefficients of an element in a two-stage monic `AdjoinRoot` tower. -/ +def adjoinRootTowerSemanticNormalForm + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) (z : AdjoinRoot g) : + Fin f.natDegree × Fin g.natDegree →₀ R := + (((AdjoinRoot.powerBasis' hf).basis.smulTower + (AdjoinRoot.powerBasis' hg).basis).repr z) + +/-- Evaluate a rectangular coefficient vector in the two-stage `AdjoinRoot` tower. -/ +def adjoinRootTowerSemanticNormalFormEvaluation + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) + (c : Fin f.natDegree × Fin g.natDegree →₀ R) : AdjoinRoot g := + (((AdjoinRoot.powerBasis' hf).basis.smulTower + (AdjoinRoot.powerBasis' hg).basis).repr.symm c) + +@[simp] +theorem adjoinRootTowerSemanticNormalForm_evaluation + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) (z : AdjoinRoot g) : + adjoinRootTowerSemanticNormalFormEvaluation f hf g hg + (adjoinRootTowerSemanticNormalForm f hf g hg z) = z := by + exact LinearEquiv.symm_apply_apply _ z + +@[simp] +theorem adjoinRootTowerSemanticNormalForm_evaluation_inverse + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) + (c : Fin f.natDegree × Fin g.natDegree →₀ R) : + adjoinRootTowerSemanticNormalForm f hf g hg + (adjoinRootTowerSemanticNormalFormEvaluation f hf g hg c) = c := by + exact LinearEquiv.apply_symm_apply _ c + +@[simp] +theorem adjoinRootTowerSemanticNormalForm_zero + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) : + adjoinRootTowerSemanticNormalForm f hf g hg 0 = 0 := by + exact map_zero _ + +@[simp] +theorem adjoinRootTowerSemanticNormalFormEvaluation_zero + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) : + adjoinRootTowerSemanticNormalFormEvaluation f hf g hg 0 = 0 := by + exact map_zero _ + +theorem adjoinRootTowerSemanticNormalForm_injective + {R : Type*} [CommRing R] (f : R[X]) (hf : f.Monic) + (g : Polynomial (AdjoinRoot f)) (hg : g.Monic) : + Function.Injective (adjoinRootTowerSemanticNormalForm f hf g hg) := + ((AdjoinRoot.powerBasis' hf).basis.smulTower + (AdjoinRoot.powerBasis' hg).basis).repr.injective + +variable {K : Type*} [Field K] + +section TraceCover + +variable (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + +private lemma etaExponent_ne_zero (e : ℕ) (heOdd : Odd e) : e ≠ 0 := by + rintro rfl + simp at heOdd + +private lemma xiExponent_ne_zero (d : ℕ) (hdOdd : Odd d) : d ≠ 0 := by + rintro rfl + simp at hdOdd + +/-- Semantic rectangular coefficients of an affine trace-cover class. -/ +def splitTraceAffineSemanticNormalForm + (a : SplitTraceAffineCoordinateRing K sigma d e) : + Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree →₀ + AdjoinRoot (splitTraceBaseKummerPolynomial sigma) := + adjoinRootTowerSemanticNormalForm + (splitTraceEtaKummerPolynomial sigma e) + (splitTraceEtaKummerPolynomial_monic sigma e + (etaExponent_ne_zero e heOdd)) + (splitTraceXiKummerPolynomial sigma e d) + (splitTraceXiKummerPolynomial_monic sigma e d + (xiExponent_ne_zero d hdOdd)) + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a) + +/-- Evaluating the affine semantic normal form recovers the affine comparison-map image. -/ +theorem splitTraceAffineSemanticNormalForm_evaluation + (a : SplitTraceAffineCoordinateRing K sigma d e) : + adjoinRootTowerSemanticNormalFormEvaluation + (splitTraceEtaKummerPolynomial sigma e) + (splitTraceEtaKummerPolynomial_monic sigma e + (etaExponent_ne_zero e heOdd)) + (splitTraceXiKummerPolynomial sigma e d) + (splitTraceXiKummerPolynomial_monic sigma e d + (xiExponent_ne_zero d hdOdd)) + (splitTraceAffineSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a) = + splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a := by + exact adjoinRootTowerSemanticNormalForm_evaluation _ _ _ _ _ + +/-- The affine semantic normal form has zero coefficients exactly when its Kummer image is zero. -/ +theorem splitTraceAffineSemanticNormalForm_eq_zero_iff + (a : SplitTraceAffineCoordinateRing K sigma d e) : + splitTraceAffineSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a = 0 ↔ + splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a = 0 := by + let f := splitTraceEtaKummerPolynomial sigma e + let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) + let g := splitTraceXiKummerPolynomial sigma e d + let hg := splitTraceXiKummerPolynomial_monic sigma e d (xiExponent_ne_zero d hdOdd) + change adjoinRootTowerSemanticNormalForm f hf g hg + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a) = 0 ↔ _ + constructor + · intro h + have hEval := congrArg (adjoinRootTowerSemanticNormalFormEvaluation f hf g hg) h + simpa only [adjoinRootTowerSemanticNormalForm_evaluation, + adjoinRootTowerSemanticNormalFormEvaluation_zero] using hEval + · intro h + rw [h] + exact map_zero _ + +/-- Affine comparison-map injectivity is now exactly injectivity of the semantic coefficient map. +The forward implication is useful once a syntactic quotient reduction proves coefficient-map +injectivity; the converse prevents semantic coordinates from concealing the original wall. -/ +theorem splitTraceAffineSemanticNormalForm_injective_iff : + Function.Injective + (splitTraceAffineSemanticNormalForm sigma hsigma e d heOdd hdOdd hde) ↔ + Function.Injective + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + let f := splitTraceEtaKummerPolynomial sigma e + let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) + let g := splitTraceXiKummerPolynomial sigma e d + let hg := splitTraceXiKummerPolynomial_monic sigma e d (xiExponent_ne_zero d hdOdd) + change Function.Injective + (fun a ↦ adjoinRootTowerSemanticNormalForm f hf g hg + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a)) ↔ _ + constructor + · intro hSemantic a b hab + apply hSemantic + exact congrArg (adjoinRootTowerSemanticNormalForm f hf g hg) hab + · intro hAffine + exact (adjoinRootTowerSemanticNormalForm_injective f hf g hg).comp hAffine + +/-- Semantic rectangular coefficients of a Laurent trace-cover class. -/ +def splitTraceLaurentSemanticNormalForm + (a : SplitTraceLaurentCoordinateRing K sigma d e) : + Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree →₀ + AdjoinRoot (splitTraceBaseKummerPolynomial sigma) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + exact adjoinRootTowerSemanticNormalForm + (splitTraceEtaKummerPolynomial sigma e) + (splitTraceEtaKummerPolynomial_monic sigma e + (etaExponent_ne_zero e heOdd)) + (splitTraceXiKummerPolynomial sigma e d) + (splitTraceXiKummerPolynomial_monic sigma e d + (xiExponent_ne_zero d hdOdd)) + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a) + +/-- Evaluating the Laurent semantic normal form recovers the Laurent comparison-map image. -/ +theorem splitTraceLaurentSemanticNormalForm_evaluation + (a : SplitTraceLaurentCoordinateRing K sigma d e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + adjoinRootTowerSemanticNormalFormEvaluation + (splitTraceEtaKummerPolynomial sigma e) + (splitTraceEtaKummerPolynomial_monic sigma e + (etaExponent_ne_zero e heOdd)) + (splitTraceXiKummerPolynomial sigma e d) + (splitTraceXiKummerPolynomial_monic sigma e d + (xiExponent_ne_zero d hdOdd)) + (splitTraceLaurentSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a) = + splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + exact adjoinRootTowerSemanticNormalForm_evaluation _ _ _ _ _ + +/-- Laurent comparison-map injectivity is equivalent to injectivity of its semantic coefficient +map. Thus localization introduces no new target-side ambiguity; the unsolved source-side task is +still the syntactic quotient normal-form theorem. -/ +theorem splitTraceLaurentSemanticNormalForm_injective_iff : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := + ⟨splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde⟩ + Function.Injective + (splitTraceLaurentSemanticNormalForm sigma hsigma e d heOdd hdOdd hde) ↔ + Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let f := splitTraceEtaKummerPolynomial sigma e + let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) + let g := splitTraceXiKummerPolynomial sigma e d + let hg := splitTraceXiKummerPolynomial_monic sigma e d (xiExponent_ne_zero d hdOdd) + change Function.Injective + (fun a ↦ adjoinRootTowerSemanticNormalForm f hf g hg + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a)) ↔ _ + constructor + · intro hSemantic a b hab + apply hSemantic + exact congrArg (adjoinRootTowerSemanticNormalForm f hf g hg) hab + · intro hLaurent + exact (adjoinRootTowerSemanticNormalForm_injective f hf g hg).comp hLaurent + +end TraceCover + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean new file mode 100644 index 0000000000..fb5fe67f20 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean @@ -0,0 +1,232 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +/-! +# An exact criterion for the remaining split trace-cover division theorem + +For `sigma != 0, 1` and odd coprime cover degrees, the source-side syntactic division theorem is +equivalent to two concrete algebraic facts: irreducibility of the cleared affine cover polynomial +and injectivity of the comparison map after inverting the two coordinates. The reverse direction +uses primeness to prove that localization has not killed an affine class. Thus the `sigma = 1` +counterexample cannot be hidden by moving to the Laurent model. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +section OddCoprime + +variable (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + +private lemma splitTraceCoverPolynomial_ne_zero (hdOdd : Odd d) : + splitTraceCoverPolynomial (1 : K) sigma d e ≠ 0 := by + have hd : d ≠ 0 := by + rintro rfl + simp at hdOdd + intro hzero + have heval := congrArg (MvPolynomial.eval ![0, 1]) hzero + rw [eval_splitTraceCoverPolynomial] at heval + simp [hd] at heval + +private lemma coordinateZero_not_dvd_splitTraceCoverPolynomial + (hdOdd : Odd d) : + ¬ MvPolynomial.X 0 ∣ splitTraceCoverPolynomial (1 : K) sigma d e := by + have hd : d ≠ 0 := by + rintro rfl + simp at hdOdd + intro hdiv + have hmap := map_dvd (MvPolynomial.eval ![0, 1]) hdiv + simp [eval_splitTraceCoverPolynomial, hd] at hmap + +private lemma coordinateOne_not_dvd_splitTraceCoverPolynomial + (hsigma : sigma ≠ 0) (heOdd : Odd e) : + ¬ MvPolynomial.X 1 ∣ splitTraceCoverPolynomial (1 : K) sigma d e := by + have he : e ≠ 0 := by + rintro rfl + simp at heOdd + intro hdiv + have hmap := map_dvd (MvPolynomial.eval ![1, 0]) hdiv + simp [eval_splitTraceCoverPolynomial, he, hsigma] at hmap + +/-- The cleared affine cover polynomial has no coordinate-axis factor. This is the exact +saturation fact needed to pass faithfully from the affine quotient to the Laurent open; it uses +only `sigma ≠ 0` and positivity of the odd cover degrees, not irreducibility. -/ +theorem splitTraceCoverPolynomial_isRelPrime_coordinateProduct : + sigma ≠ 0 → Odd e → Odd d → + IsRelPrime (splitTraceCoverPolynomial (1 : K) sigma d e) + (MvPolynomial.X 0 * MvPolynomial.X 1) := by + intro hsigma heOdd hdOdd + apply (UniqueFactorizationMonoid.isRelPrime_iff_no_prime_factors + (splitTraceCoverPolynomial_ne_zero sigma e d hdOdd)).2 + intro q hqCover hqProduct hqPrime + rcases hqPrime.dvd_mul.mp hqProduct with hqZero | hqOne + · have hassociated := hqPrime.associated_of_dvd + (MvPolynomial.X_prime (i := (0 : Fin 2))) hqZero + exact coordinateZero_not_dvd_splitTraceCoverPolynomial sigma e d hdOdd + (hassociated.dvd_iff_dvd_left.mp hqCover) + · have hassociated := hqPrime.associated_of_dvd + (MvPolynomial.X_prime (i := (1 : Fin 2))) hqOne + exact coordinateOne_not_dvd_splitTraceCoverPolynomial sigma e d hsigma heOdd + (hassociated.dvd_iff_dvd_left.mp hqCover) + +/-- Inverting the coordinate product does not kill any affine trace-cover class. This affine +saturation theorem is independent of the unresolved irreducibility statement. -/ +theorem splitTraceAffineToLaurent_injective : + sigma ≠ 0 → Odd e → Odd d → + Function.Injective + (algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e)) := by + intro hsigma heOdd hdOdd + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + have hregular : splitTraceAffineCoordinateProduct sigma d e ∈ + nonZeroDivisors (SplitTraceAffineCoordinateRing K sigma d e) := by + rw [mem_nonZeroDivisors_iff] + constructor + · intro x hx + obtain ⟨p, rfl⟩ := Ideal.Quotient.mk_surjective x + have hmultiple : splitTraceCoverPolynomial (1 : K) sigma d e ∣ + (MvPolynomial.X 0 * MvPolynomial.X 1) * p := by + rw [← Ideal.mem_span_singleton] + apply Ideal.Quotient.eq_zero_iff_mem.mp + simpa [I, splitTraceAffineCoordinateProduct] using hx + have hp : splitTraceCoverPolynomial (1 : K) sigma d e ∣ p := + (splitTraceCoverPolynomial_isRelPrime_coordinateProduct + sigma e d hsigma heOdd hdOdd).dvd_of_dvd_mul_left hmultiple + apply Ideal.Quotient.eq_zero_iff_mem.mpr + rwa [Ideal.mem_span_singleton] + · intro x hx + obtain ⟨p, rfl⟩ := Ideal.Quotient.mk_surjective x + have hmultiple : splitTraceCoverPolynomial (1 : K) sigma d e ∣ + (MvPolynomial.X 0 * MvPolynomial.X 1) * p := by + rw [← Ideal.mem_span_singleton] + apply Ideal.Quotient.eq_zero_iff_mem.mp + simpa [I, splitTraceAffineCoordinateProduct, mul_comm] using hx + have hp : splitTraceCoverPolynomial (1 : K) sigma d e ∣ p := + (splitTraceCoverPolynomial_isRelPrime_coordinateProduct + sigma e d hsigma heOdd hdOdd).dvd_of_dvd_mul_left hmultiple + apply Ideal.Quotient.eq_zero_iff_mem.mpr + rwa [Ideal.mem_span_singleton] + exact IsLocalization.injective (SplitTraceLaurentCoordinateRing K sigma d e) (by + rw [Submonoid.powers_le] + exact hregular) + +/-- Injectivity of the Laurent comparison already forces injectivity of the affine comparison: +the coordinate-product localization is faithful by the explicit saturation theorem above. -/ +theorem splitTraceAffineToKummerTop_injective_of_laurentInjective + (hLaurent : Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde)) : + Function.Injective + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + have hlocalization : Function.Injective + (algebraMap (SplitTraceAffineCoordinateRing K sigma d e) + (SplitTraceLaurentCoordinateRing K sigma d e)) := + splitTraceAffineToLaurent_injective sigma e d hsigma heOdd hdOdd + intro x y hxy + apply hlocalization + apply hLaurent + rw [splitTraceLaurentToKummerTop_algebraMap_apply, + splitTraceLaurentToKummerTop_algebraMap_apply] + exact hxy + +/-- Injectivity on the Laurent open implies the exact source-side syntactic division theorem. -/ +theorem splitTracePolynomialSyntacticNormalForm_division_of_laurentInjective + (hLaurent : Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde)) + (p : MvPolynomial (Fin 2) K) + (hnormal : splitTracePolynomialSyntacticNormalForm + sigma hsigma e d heOdd hdOdd p = 0) : + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} := by + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + have hAffine := + splitTraceAffineToKummerTop_injective_of_laurentInjective + sigma hsigma e d heOdd hdOdd hde hLaurent + have heval : splitTracePolynomialToKummerTop + sigma hsigma e d heOdd hdOdd hde p = 0 := + (splitTracePolynomialSyntacticNormalForm_eq_zero_iff + sigma hsigma e d heOdd hdOdd hde p).1 hnormal + have hclass : Ideal.Quotient.mk I p = 0 := by + apply hAffine + change splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde p = 0 + exact heval + exact Ideal.Quotient.eq_zero_iff_mem.mp hclass + +/-- Laurent-to-Kummer injectivity also forces irreducibility of the cleared affine cover. +Indeed the affine quotient injects into the Kummer function field, hence is a domain. -/ +theorem splitTraceCoverPolynomial_irreducible_of_laurentInjective + (hLaurent : Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde)) : + Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + AdjoinRoot.isDomain_of_prime hXiIrred.prime + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + have hAffine := splitTraceAffineToKummerTop_injective_of_laurentInjective + sigma hsigma e d heOdd hdOdd hde hLaurent + letI : IsDomain (SplitTraceAffineCoordinateRing K sigma d e) := + hAffine.isDomain + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom + have hprimeIdeal : I.IsPrime := by + exact (Ideal.Quotient.isDomain_iff_prime I).mp inferInstance + have hprimeElement : Prime (splitTraceCoverPolynomial (1 : K) sigma d e) := + (Ideal.span_singleton_prime + (splitTraceCoverPolynomial_ne_zero sigma e d hdOdd)).1 (by + simpa [I] using hprimeIdeal) + exact irreducible_iff_prime.mpr hprimeElement + +/-- Exact characterization of the remaining source-division wall. In the nondegenerate case, +division by the cleared cover polynomial is equivalent to injectivity of the explicit +Laurent-to-Kummer comparison; the affine-to-Laurent map has already been proved faithful. -/ +theorem splitTracePolynomialSyntacticNormalForm_division_iff_laurentInjective + (hnondegenerate : sigma ≠ 1) : + (∀ p : MvPolynomial (Fin 2) K, + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p = 0 → + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e}) ↔ + Function.Injective + (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + AdjoinRoot.isDomain_of_prime hXiIrred.prime + constructor + · intro hdivision + have hAffine := + splitTraceAffineToKummerTop_injective_of_syntacticNormalForm_division + sigma hsigma e d heOdd hdOdd hde hnondegenerate hdivision + have hLaurent := splitTraceLaurentToKummerTop_injective_of_affine_injective + sigma hsigma e d heOdd hdOdd hde hAffine + exact hLaurent + · intro hLaurent p hnormal + exact splitTracePolynomialSyntacticNormalForm_division_of_laurentInjective + sigma hsigma e d heOdd hdOdd hde hLaurent p hnormal + +end OddCoprime + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean new file mode 100644 index 0000000000..b591ce615a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean @@ -0,0 +1,140 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm + +/-! +# The degenerate split trace cover has no principal syntactic division theorem + +At `sigma = 1` and `d = e = 1`, the cleared cover polynomial is the product +`(y - x) * (x * y - 1)`. The Kummer tower selects the component `x * y = 1`. +Consequently its evaluation kernel strictly contains the ideal generated by the whole cleared +polynomial. This file records that obstruction explicitly: the source-side division statement +must assume the nondegeneracy condition `sigma != 1`. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- The component selected by the Kummer parametrization when `sigma = d = e = 1`. -/ +def splitTraceDegenerateKummerComponent : MvPolynomial (Fin 2) K := + MvPolynomial.X 0 * MvPolynomial.X 1 - 1 + +private lemma ratFunc_X_mul_splitTraceRadicand_one : + RatFunc.X * splitTraceRadicand (1 : K) = 1 := by + have h := splitTraceRadicand_equation (K := K) (1 : K) + norm_num at h + have hne : (1 : RatFunc K) - RatFunc.X ≠ 0 := by + intro hzero + have hx : (1 : RatFunc K) = RatFunc.X := sub_eq_zero.mp hzero + have hdegree := congrArg RatFunc.intDegree hx + norm_num at hdegree + have hfactor : + ((1 : RatFunc K) - RatFunc.X) * + (RatFunc.X * splitTraceRadicand (1 : K) - 1) = 0 := by + linear_combination h + exact sub_eq_zero.mp ((mul_eq_zero.mp hfactor).resolve_left hne) + +private lemma splitTraceBaseU_mul_V_sq_one : + splitTraceBaseU (1 : K) * splitTraceBaseV (1 : K) ^ 2 = 1 := by + rw [splitTraceBaseV_sq] + rw [splitTraceBaseU, ← map_mul, ratFunc_X_mul_splitTraceRadicand_one] + simp + +private lemma splitTraceKummer_roots_mul_one : + splitTraceXiRoot (1 : K) 1 1 * splitTraceEtaRootInXiField (1 : K) 1 1 = 1 := by + have hxi := splitTraceXiRoot_pow (K := K) (1 : K) 1 1 + have heta := splitTraceEtaRootInXiField_pow (K := K) (1 : K) 1 1 + simp only [pow_one] at hxi heta + rw [hxi, heta] + simp only [splitTraceXiRadicand, splitTraceBaseElementInXiField, map_mul] + rw [← map_mul] + rw [← map_mul] + rw [← map_mul] + rw [← map_mul] + rw [show splitTraceBaseU (1 : K) * splitTraceBaseV (1 : K) * + splitTraceBaseV (1 : K) = + splitTraceBaseU (1 : K) * splitTraceBaseV (1 : K) ^ 2 by ring] + rw [splitTraceBaseU_mul_V_sq_one] + simp + +/-- The Kummer-selected component has zero syntactic normal form. -/ +theorem splitTraceDegenerateKummerComponent_syntacticNormalForm_eq_zero : + splitTracePolynomialSyntacticNormalForm (1 : K) one_ne_zero 1 1 + (by decide) (by decide) (splitTraceDegenerateKummerComponent (K := K)) = 0 := by + apply (splitTracePolynomialSyntacticNormalForm_eq_zero_iff + (1 : K) one_ne_zero 1 1 (by decide) (by decide) (by decide) + (splitTraceDegenerateKummerComponent (K := K))).2 + simp [splitTraceDegenerateKummerComponent, splitTracePolynomialToKummerTop, + splitTraceKummer_roots_mul_one] + +/-- The Kummer-selected component is not a multiple of the full degenerate cover polynomial. +Evaluation at the affine origin separates them. -/ +theorem splitTraceDegenerateKummerComponent_not_mem_coverIdeal : + splitTraceDegenerateKummerComponent (K := K) ∉ + Ideal.span {splitTraceCoverPolynomial (1 : K) 1 1 1} := by + intro hmem + let ev : MvPolynomial (Fin 2) K →+* K := MvPolynomial.eval ![0, 0] + have hle : Ideal.span {splitTraceCoverPolynomial (1 : K) 1 1 1} ≤ RingHom.ker ev := by + rw [Ideal.span_le] + intro p hp + simp only [Set.mem_singleton_iff] at hp + subst p + simp [ev, splitTraceCoverPolynomial] + have hzero := hle hmem + have hone : ev (splitTraceDegenerateKummerComponent (K := K)) = -1 := by + simp [ev, splitTraceDegenerateKummerComponent] + rw [RingHom.mem_ker, hone] at hzero + exact one_ne_zero (neg_eq_zero.mp hzero) + +/-- Therefore the source-side division assertion used by the affine injectivity endpoint is false +without the paper's nondegeneracy hypothesis `sigma != 1`. -/ +theorem not_splitTraceSyntacticNormalForm_division_at_degenerateParameter : + ¬ (∀ p : MvPolynomial (Fin 2) K, + splitTracePolynomialSyntacticNormalForm (1 : K) one_ne_zero 1 1 + (by decide) (by decide) p = 0 → + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) 1 1 1}) := by + intro hdivision + exact splitTraceDegenerateKummerComponent_not_mem_coverIdeal (K := K) + (hdivision (splitTraceDegenerateKummerComponent (K := K)) + splitTraceDegenerateKummerComponent_syntacticNormalForm_eq_zero) + +/-- At the degenerate parameter, the affine comparison map itself is not injective: the nonzero +class of `x * y - 1` maps to zero. -/ +theorem not_splitTraceAffineToKummerTop_injective_at_degenerateParameter : + ¬ Function.Injective + (splitTraceAffineToKummerTop (1 : K) one_ne_zero 1 1 + (by decide) (by decide) (by decide)) := by + intro hinjective + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) 1 1 1} + let q : MvPolynomial (Fin 2) K := splitTraceDegenerateKummerComponent + have hqeval : + splitTracePolynomialToKummerTop (1 : K) one_ne_zero 1 1 + (by decide) (by decide) (by decide) q = 0 := + (splitTracePolynomialSyntacticNormalForm_eq_zero_iff + (1 : K) one_ne_zero 1 1 (by decide) (by decide) (by decide) q).1 + splitTraceDegenerateKummerComponent_syntacticNormalForm_eq_zero + have hqmap : + splitTraceAffineToKummerTop (1 : K) one_ne_zero 1 1 + (by decide) (by decide) (by decide) (Ideal.Quotient.mk I q) = 0 := by + change splitTracePolynomialToKummerTop (1 : K) one_ne_zero 1 1 + (by decide) (by decide) (by decide) q = 0 + exact hqeval + have hqclass : Ideal.Quotient.mk I q = 0 := by + apply hinjective + simpa using hqmap + have hqmem : q ∈ I := Ideal.Quotient.eq_zero_iff_mem.mp hqclass + exact splitTraceDegenerateKummerComponent_not_mem_coverIdeal hqmem + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean new file mode 100644 index 0000000000..eb641877cc --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean @@ -0,0 +1,392 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +import Mathlib.RingTheory.Ideal.Quotient.Operations + +/-! +# Syntactic monomial reduction for the split trace cover + +This file starts the source-side quotient reduction. A monomial `xi^i * eta^j` is reduced by +Euclidean division of `i` by `d` and `j` by `e`. Its rectangular basis index is +`(j % e, i % d)`, and its coefficient in the quadratic base function field is +`u^(i / d) * v^(i / d + j / e)`. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +theorem pow_eq_pow_div_mul_pow_mod + {M : Type*} [Monoid M] (x : M) (n q : ℕ) : + x ^ n = (x ^ q) ^ (n / q) * x ^ (n % q) := by + calc + x ^ n = x ^ (q * (n / q) + n % q) := by rw [Nat.div_add_mod n q] + _ = x ^ (q * (n / q)) * x ^ (n % q) := by rw [pow_add] + _ = (x ^ q) ^ (n / q) * x ^ (n % q) := by + rw [pow_mul] + +variable {K : Type*} [Field K] + +section OddCoprime + +variable (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + +private lemma etaExponent_pos (e : ℕ) (heOdd : Odd e) : 0 < e := by + rcases heOdd with ⟨k, rfl⟩ + omega + +private lemma xiExponent_pos (d : ℕ) (hdOdd : Odd d) : 0 < d := by + rcases hdOdd with ⟨k, rfl⟩ + omega + +private lemma etaExponent_ne_zero (e : ℕ) (heOdd : Odd e) : e ≠ 0 := + (etaExponent_pos e heOdd).ne' + +private lemma xiExponent_ne_zero (d : ℕ) (hdOdd : Odd d) : d ≠ 0 := + (xiExponent_pos d hdOdd).ne' + +theorem splitTraceEtaKummerPolynomial_natDegree + (sigma : K) (hsigma : sigma ≠ 0) (e : ℕ) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + (splitTraceEtaKummerPolynomial sigma e).natDegree = e := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + change (X ^ e - C (splitTraceBaseV sigma)).natDegree = e + exact natDegree_X_pow_sub_C + +theorem splitTraceXiKummerPolynomial_natDegree + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) (heOdd : Odd e) : + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := + ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := + ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ + (splitTraceXiKummerPolynomial sigma e d).natDegree = d := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + change (X ^ d - C (splitTraceXiRadicand sigma e)).natDegree = d + exact natDegree_X_pow_sub_C + +/-- Residual rectangular index of the monomial `xi^i * eta^j`. -/ +def splitTraceMonomialNormalIndex (i j : ℕ) : + Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + exact (⟨j % e, by + rw [splitTraceEtaKummerPolynomial_natDegree sigma hsigma e] + exact Nat.mod_lt _ (etaExponent_pos e heOdd)⟩, + ⟨i % d, by + rw [splitTraceXiKummerPolynomial_natDegree sigma hsigma e d heOdd] + exact Nat.mod_lt _ (xiExponent_pos d hdOdd)⟩) + +@[simp] +theorem splitTraceMonomialNormalIndex_fst_val (i j : ℕ) : + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd i j).1.val = j % e := by + rfl + +@[simp] +theorem splitTraceMonomialNormalIndex_snd_val (i j : ℕ) : + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd i j).2.val = i % d := by + rfl + +/-- Base-function-field coefficient extracted from `xi^i * eta^j`. -/ +def splitTraceMonomialNormalCoefficient (i j : ℕ) : + SplitTraceBaseFunctionField K sigma := + splitTraceBaseU sigma ^ (i / d) * + splitTraceBaseV sigma ^ (i / d + j / e) + +/-- Evaluate a rectangular coefficient vector by the explicit normal monomial family. -/ +def splitTraceExplicitNormalFormEvaluation + (c : (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) : + SplitTraceXiFunctionField K sigma e d := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + exact Finsupp.linearCombination (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) c + +/-- Explicit source-side rectangular coefficients of a polynomial in the two affine coordinates. +Each source monomial is reduced independently by quotient and remainder of its two exponents. -/ +def splitTracePolynomialSyntacticNormalForm + (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) + (heOdd : Odd e) (hdOdd : Odd d) + (p : MvPolynomial (Fin 2) K) : + (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + AdjoinRoot (splitTraceBaseKummerPolynomial sigma) := + (AddMonoidAlgebra.coeff p).sum fun ex c ↦ + Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd (ex 0) (ex 1)) + (algebraMap K (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) c * + splitTraceMonomialNormalCoefficient sigma e d (ex 0) (ex 1)) + +@[simp] +theorem splitTracePolynomialSyntacticNormalForm_zero : + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd 0 = 0 := by + simp [splitTracePolynomialSyntacticNormalForm] + +theorem splitTracePolynomialSyntacticNormalForm_add + (p q : MvPolynomial (Fin 2) K) : + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd (p + q) = + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p + + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd q := by + classical + simp only [splitTracePolynomialSyntacticNormalForm] + apply Finsupp.sum_add_index + · intro ex + simp + · intro ex _ a b + simp only [map_add, add_mul, Finsupp.single_add] + +@[simp] +theorem splitTracePolynomialSyntacticNormalForm_monomial + (ex : Fin 2 →₀ ℕ) (c : K) : + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd + (MvPolynomial.monomial ex c) = + Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd (ex 0) (ex 1)) + (algebraMap K (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) c * + splitTraceMonomialNormalCoefficient sigma e d (ex 0) (ex 1)) := by + rw [splitTracePolynomialSyntacticNormalForm] + apply MvPolynomial.sum_monomial_eq + simp + +lemma splitTraceEtaRootInXiField_pow : + splitTraceEtaRootInXiField sigma e d ^ e = + splitTraceBaseElementInXiField sigma e d (splitTraceBaseV sigma) := by + have h := congrArg + (algebraMap (SplitTraceEtaFunctionField K sigma e) + (SplitTraceXiFunctionField K sigma e d)) + (splitTraceEtaRoot_pow (K := K) sigma e) + simpa [splitTraceEtaRootInXiField, splitTraceBaseElementInXiField] using h + +/-- Explicit source-side monomial reduction in the Kummer top algebra. -/ +theorem splitTraceKummer_monomial_reduction + (sigma : K) (e d i j : ℕ) : + splitTraceXiRoot sigma e d ^ i * splitTraceEtaRootInXiField sigma e d ^ j = + splitTraceBaseElementInXiField sigma e d + (splitTraceMonomialNormalCoefficient sigma e d i j) * + (splitTraceEtaRootInXiField sigma e d ^ (j % e) * + splitTraceXiRoot sigma e d ^ (i % d)) := by + rw [pow_eq_pow_div_mul_pow_mod _ i d, + pow_eq_pow_div_mul_pow_mod _ j e, + splitTraceXiRoot_pow, splitTraceEtaRootInXiField_pow] + simp only [splitTraceXiRadicand, splitTraceMonomialNormalCoefficient, + splitTraceBaseElementInXiField, map_mul, map_pow] + ring + +/-- The explicit normal-form evaluation of the singleton produced from a source monomial is the +original monomial in the Kummer top algebra. -/ +theorem splitTraceExplicitNormalFormEvaluation_single_monomial (i j : ℕ) : + splitTraceExplicitNormalFormEvaluation sigma e d + (Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd i j) + (splitTraceMonomialNormalCoefficient sigma e d i j)) = + splitTraceXiRoot sigma e d ^ i * splitTraceEtaRootInXiField sigma e d ^ j := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + rw [splitTraceExplicitNormalFormEvaluation, Finsupp.linearCombination_single] + simp only [Algebra.smul_def, splitTraceMonomialNormalIndex_fst_val, + splitTraceMonomialNormalIndex_snd_val] + rw [IsScalarTower.algebraMap_apply + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) + (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d))] + simpa [splitTraceBaseElementInXiField] using + (splitTraceKummer_monomial_reduction (K := K) sigma e d i j).symm + +/-- Including the source coefficient, explicit evaluation of the syntactic singleton agrees with +evaluation of the original source monomial. -/ +theorem splitTraceExplicitNormalFormEvaluation_single_scaled_monomial + (c : K) (i j : ℕ) : + splitTraceExplicitNormalFormEvaluation sigma e d + (Finsupp.single + (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd i j) + (algebraMap K (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) c * + splitTraceMonomialNormalCoefficient sigma e d i j)) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) c * + (splitTraceXiRoot sigma e d ^ i * splitTraceEtaRootInXiField sigma e d ^ j) := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + rw [splitTraceExplicitNormalFormEvaluation, Finsupp.linearCombination_single] + simp only [Algebra.smul_def, splitTraceMonomialNormalIndex_fst_val, + splitTraceMonomialNormalIndex_snd_val, map_mul] + have hred := (splitTraceKummer_monomial_reduction + (K := K) sigma e d i j).symm + rw [← hred] + simp only [splitTraceBaseElementInXiField] + simp_rw [IsScalarTower.algebraMap_apply K + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d))] + simp_rw [IsScalarTower.algebraMap_apply + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) + (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d))] + ring + +theorem splitTracePolynomialToKummerTop_monomial + (ex : Fin 2 →₀ ℕ) (c : K) : + splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde + (MvPolynomial.monomial ex c) = + algebraMap K (SplitTraceXiFunctionField K sigma e d) c * + (splitTraceXiRoot sigma e d ^ (ex 0) * + splitTraceEtaRootInXiField sigma e d ^ (ex 1)) := by + simp [splitTracePolynomialToKummerTop, MvPolynomial.aeval_def, + MvPolynomial.eval₂_monomial, Fin.prod_univ_two] + +/-- Evaluation of the explicit syntactic coefficient vector agrees with direct polynomial +evaluation at the two Kummer roots. -/ +theorem splitTracePolynomialSyntacticNormalForm_evaluation + (p : MvPolynomial (Fin 2) K) : + splitTraceExplicitNormalFormEvaluation sigma e d + (splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p) = + splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde p := by + induction p using MvPolynomial.induction_on' with + | monomial ex c => + rw [splitTracePolynomialSyntacticNormalForm_monomial, + splitTraceExplicitNormalFormEvaluation_single_scaled_monomial, + splitTracePolynomialToKummerTop_monomial] + | add p q hp hq => + rw [splitTracePolynomialSyntacticNormalForm_add] + change Finsupp.linearCombination + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p + + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd q) = _ + change Finsupp.linearCombination + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p) = _ at hp + change Finsupp.linearCombination + (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) + (splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd q) = _ at hq + rw [map_add, hp, hq, map_add] + +/-- The committed normal-monomial independence theorem makes explicit normal-form evaluation +injective. -/ +theorem splitTraceExplicitNormalFormEvaluation_eq_zero_iff + (sigma : K) (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) + (c : (Fin (splitTraceEtaKummerPolynomial sigma e).natDegree × + Fin (splitTraceXiKummerPolynomial sigma e d).natDegree) →₀ + AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) : + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + splitTraceExplicitNormalFormEvaluation sigma e d c = 0 ↔ c = 0 := by + letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + AdjoinRoot.instCommRing _ + letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + AdjoinRoot.instCommRing _ + change Finsupp.linearCombination (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * + splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) c = 0 ↔ c = 0 + exact splitTraceEtaXiNormalForm_evaluation_eq_zero_iff + sigma e d heOdd hdOdd hde c + +/-- A source polynomial has zero syntactic normal form exactly when its evaluation at the Kummer +roots vanishes. The remaining injectivity wall is to identify this explicit zero condition with +membership in the principal ideal generated by the trace-cover polynomial. -/ +theorem splitTracePolynomialSyntacticNormalForm_eq_zero_iff + (p : MvPolynomial (Fin 2) K) : + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p = 0 ↔ + splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde p = 0 := by + rw [← splitTracePolynomialSyntacticNormalForm_evaluation + sigma hsigma e d heOdd hdOdd hde p] + exact (splitTraceExplicitNormalFormEvaluation_eq_zero_iff + sigma e d heOdd hdOdd hde + (splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p)).symm + +/-- For a nondegenerate trace parameter, the remaining source-side division theorem is sufficient +for injectivity of the affine comparison map. The division hypothesis is deliberately an ordinary +explicit proposition: it is not an assumed declaration, typeclass, or structure field. The +condition `sigma ≠ 1` is essential: at `sigma = 1` the cleared cover factors and the Kummer tower +selects only one component; see `TraceCurveSyntacticDivisionObstruction`. -/ +theorem splitTraceAffineToKummerTop_injective_of_syntacticNormalForm_division + (_hnondegenerate : sigma ≠ 1) + (hdivision : ∀ p : MvPolynomial (Fin 2) K, + splitTracePolynomialSyntacticNormalForm sigma hsigma e d heOdd hdOdd p = 0 → + p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e}) : + Function.Injective + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde) := by + let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma + letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd + letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let hXiIrred := + splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde + letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let I : Ideal (MvPolynomial (Fin 2) K) := + Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} + let f : MvPolynomial (Fin 2) K →+* + SplitTraceXiFunctionField K sigma e d := + (splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom + have hIdeal : ∀ p : MvPolynomial (Fin 2) K, p ∈ I → f p = 0 := by + have hle : I ≤ RingHom.ker f := by + dsimp [I] + rw [Ideal.span_le] + intro q hq + simp only [Set.mem_singleton_iff] at hq + subst q + exact splitTracePolynomialToKummerTop_relation sigma hsigma e d heOdd hdOdd hde + intro p hp + exact hle hp + have hKernel : RingHom.ker f ≤ I := by + intro p hp + apply hdivision p + apply (splitTracePolynomialSyntacticNormalForm_eq_zero_iff + sigma hsigma e d heOdd hdOdd hde p).2 + exact hp + have hinjective := RingHom.lift_injective_of_ker_le_ideal I hIdeal hKernel + have hsame : + (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom = + Ideal.Quotient.lift I f hIdeal := by + apply Ideal.Quotient.ringHom_ext + apply DFunLike.ext _ _ + intro p + change f p = Ideal.Quotient.lift I f hIdeal (Ideal.Quotient.mk I p) + rw [Ideal.Quotient.lift_mk] + intro x y hxy + apply hinjective + rw [← hsame] + exact hxy + +end OddCoprime + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean new file mode 100644 index 0000000000..a779a89caf --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean @@ -0,0 +1,79 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility + +/-! +# Exact bidegree of the weighted middle-game trace curve + +Corvaja--Zannier Corollary 2 uses the two coordinate degrees of the affine +torus curve. This module computes those degrees for the actual reduced +weighted trace closure. The two-variable polynomial is transported through +the explicit `Fin 2` multivariate-to-iterated-polynomial equivalence already +used in the irreducibility proof; swapping the two polynomial variables +computes the second coordinate degree. +-/ + +namespace BGS.Markoff + +open Polynomial + +variable {K : Type*} [Field K] + +/-- The weighted trace closure has degree two in the right trace coordinate. -/ +theorem weightedTraceIteratedPolynomial_right_natDegree (alpha beta : K) : + (weightedTraceIteratedPolynomial alpha beta).natDegree = 2 := by + apply Nat.le_antisymm + · rw [natDegree_le_iff_coeff_eq_zero] + intro N hN + have hn0 : N ≠ 0 := by omega + have h1 : 1 ≠ N := by omega + have h2 : 2 ≠ N := by omega + simp [weightedTraceIteratedPolynomial, coeff_monomial, h1, h2, + coeff_C_of_ne_zero hn0] + · apply le_natDegree_of_ne_zero + simp [weightedTraceIteratedPolynomial, coeff_monomial] + +/-- The weighted trace closure has degree two in the left weighted coordinate +when its leading weight is nonzero. -/ +theorem weightedTraceIteratedPolynomial_left_natDegree + (alpha beta : K) (halpha : alpha ≠ 0) : + (Polynomial.Bivariate.swap + (weightedTraceIteratedPolynomial alpha beta)).natDegree = 2 := by + have hswap : + Polynomial.Bivariate.swap (weightedTraceIteratedPolynomial alpha beta) = + monomial 2 (C alpha * X) + + monomial 1 (-(X ^ 2 + 1)) + C (C beta * X) := by + simp [weightedTraceIteratedPolynomial, Polynomial.Bivariate.swap_apply, + ← Polynomial.C_mul_X_pow_eq_monomial] + ring + rw [hswap] + apply Nat.le_antisymm + · rw [natDegree_le_iff_coeff_eq_zero] + intro N hN + have hn0 : N ≠ 0 := by omega + have h1 : 1 ≠ N := by omega + have h2 : 2 ≠ N := by omega + simp [coeff_monomial, h1, h2, coeff_C_of_ne_zero hn0] + · apply le_natDegree_of_ne_zero + simp [coeff_monomial, halpha] + +/-- In the nonzero-weight branch used by the Markoff middle game, the reduced +torus closure has exact bidegree `(2, 2)`. The pair is expressed through the +explicit iterated-polynomial presentation, so no informal support convention +is hidden in the statement. -/ +theorem weightedTraceTorusClosurePolynomial_iteratedBidegree + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) : + let p := finTwoToIteratedPolynomial (K := K) + (weightedTraceTorusClosurePolynomial alpha beta) + (p.natDegree, (Polynomial.Bivariate.swap p).natDegree) = (2, 2) := by + rw [finTwoToIteratedPolynomial_weightedTraceTorusClosurePolynomial + alpha beta hbeta] + exact Prod.ext + (weightedTraceIteratedPolynomial_right_natDegree alpha beta) + (weightedTraceIteratedPolynomial_left_natDegree alpha beta halpha) + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean new file mode 100644 index 0000000000..966a88609d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean @@ -0,0 +1,101 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +import Mathlib.AlgebraicGeometry.EllipticCurve.Weierstrass + +/-! +# An explicit elliptic model for the weighted trace curve + +For the normalized trace equation, the birational coordinate `u = x / y` +gives + +`u * (1 - u) * y^2 + sigma * u - 1 = 0`. + +On the open set where `sigma * u * (1 - u)` is nonzero, the change + +`X = sigma * u`, `Y = sigma * u * (1 - u) * y` + +identifies this equation with + +`Y^2 = X^3 - (sigma + 1) * X^2 + sigma * X + = X * (X - 1) * (X - sigma)`. + +This module proves the coordinate identity and the exact Weierstrass +discriminant. It does not disguise the remaining algebraic-geometry wall: +the project still needs an in-repository bridge from this nonsingular +Weierstrass model to the genus and Euler-characteristic data used by +Corvaja--Zannier. +-/ + +namespace BGS.Markoff + +variable {K : Type*} [Field K] + +/-- The Weierstrass model birational to the normalized weighted trace curve. -/ +noncomputable def weightedTraceWeierstrassCurve (sigma : K) : + WeierstrassCurve K := + WeierstrassCurve.mk 0 (-(sigma + 1)) 0 sigma 0 + +/-- The exact discriminant of the weighted trace Weierstrass model. -/ +theorem weightedTraceWeierstrassCurve_discriminant (sigma : K) : + (weightedTraceWeierstrassCurve sigma).Δ = + 16 * sigma ^ 2 * (sigma - 1) ^ 2 := by + simp [weightedTraceWeierstrassCurve, WeierstrassCurve.Δ, + WeierstrassCurve.b₂, WeierstrassCurve.b₄, WeierstrassCurve.b₆, + WeierstrassCurve.b₈] + ring + +/-- Away from characteristic two and the degenerate parameters `0, 1`, the +explicit Weierstrass model is elliptic. -/ +theorem weightedTraceWeierstrassCurve_isElliptic + (sigma : K) (htwo : (2 : K) ≠ 0) (hsigma : sigma ≠ 0) + (hnondegenerate : sigma ≠ 1) : + (weightedTraceWeierstrassCurve sigma).IsElliptic := by + constructor + rw [weightedTraceWeierstrassCurve_discriminant] + apply isUnit_iff_ne_zero.mpr + have h16 : (16 : K) ≠ 0 := by + simpa only [show (16 : K) = (2 : K) ^ 4 by norm_num] using + pow_ne_zero 4 htwo + exact mul_ne_zero (mul_ne_zero h16 (pow_ne_zero 2 hsigma)) + (pow_ne_zero 2 (sub_ne_zero.mpr hnondegenerate)) + +/-- The normalized birational trace equation maps to the explicit +Weierstrass equation. -/ +theorem normalizedSplitTraceBirational_to_weightedTraceWeierstrass + (sigma u y : K) + (htrace : u * (1 - u) * y ^ 2 + sigma * u - 1 = 0) : + (sigma * u * (1 - u) * y) ^ 2 = + (sigma * u) ^ 3 - (sigma + 1) * (sigma * u) ^ 2 + + sigma * (sigma * u) := by + linear_combination sigma ^ 2 * u * (1 - u) * htrace + +/-- On the natural birational open, the normalized trace equation and the +explicit Weierstrass equation are equivalent. -/ +theorem normalizedSplitTraceBirational_iff_weightedTraceWeierstrass + (sigma u y : K) (hsigma : sigma ≠ 0) (hu : u ≠ 0) + (huOne : 1 - u ≠ 0) : + u * (1 - u) * y ^ 2 + sigma * u - 1 = 0 ↔ + (sigma * u * (1 - u) * y) ^ 2 = + (sigma * u) ^ 3 - (sigma + 1) * (sigma * u) ^ 2 + + sigma * (sigma * u) := by + constructor + · exact normalizedSplitTraceBirational_to_weightedTraceWeierstrass sigma u y + · intro hWeierstrass + have hidentity : + (sigma * u * (1 - u) * y) ^ 2 - + ((sigma * u) ^ 3 - (sigma + 1) * (sigma * u) ^ 2 + + sigma * (sigma * u)) = + sigma ^ 2 * u * (1 - u) * + (u * (1 - u) * y ^ 2 + sigma * u - 1) := by + ring + rw [hWeierstrass, sub_self] at hidentity + have hcoefficient : sigma ^ 2 * u * (1 - u) ≠ 0 := + mul_ne_zero (mul_ne_zero (pow_ne_zero 2 hsigma) hu) huOne + exact (mul_eq_zero.mp hidentity.symm).resolve_left hcoefficient + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean new file mode 100644 index 0000000000..845814e226 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean @@ -0,0 +1,332 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +import Mathlib.Algebra.MvPolynomial.Equiv +import Mathlib.Algebra.Polynomial.Bivariate +import Mathlib.RingTheory.Polynomial.GaussLemma + +/-! +# Absolute irreducibility of the weighted middle-game trace curve + +This module proves the absolute-irreducibility hypothesis exposed by +`MiddleGameCorvajaZannierGeometry`. The proof uses the published torus change of variables +honestly: the weighted left parameter is first scaled by `alpha`, and then the invertible +birational coordinate `u = x / y` is used after passage to the coefficient fraction field. +The resulting polynomial is the Eisenstein polynomial already proved irreducible in +`TraceCurveGeometry`. +-/ + +namespace BGS.Markoff + +open Polynomial + +section Scaling + +variable {R : Type*} [CommRing R] + +/-- Scaling the variable of a polynomial by a unit is an algebra automorphism. -/ +noncomputable def polynomialVariableScaleEquiv (c : Rˣ) : R[X] ≃ₐ[R] R[X] := by + let forward : R[X] →ₐ[R] R[X] := Polynomial.aeval (C (c : R) * X) + let backward : R[X] →ₐ[R] R[X] := Polynomial.aeval (C ((c⁻¹ : Rˣ) : R) * X) + refine AlgEquiv.ofAlgHom forward backward ?_ ?_ + · apply Polynomial.algHom_ext + simp only [AlgHom.comp_apply, forward, backward, Polynomial.aeval_X, + map_mul, Polynomial.aeval_C] + change C (((c⁻¹ : Rˣ) : R)) * (C (c : R) * X) = X + rw [← mul_assoc, ← C_mul] + simp + · apply Polynomial.algHom_ext + simp only [AlgHom.comp_apply, forward, backward, Polynomial.aeval_X, + map_mul, Polynomial.aeval_C] + change C (c : R) * (C (((c⁻¹ : Rˣ) : R)) * X) = X + rw [← mul_assoc, ← C_mul] + simp + +@[simp] +theorem polynomialVariableScaleEquiv_X (c : Rˣ) : + polynomialVariableScaleEquiv c X = C (c : R) * X := by + simp [polynomialVariableScaleEquiv] + +@[simp] +theorem polynomialVariableScaleEquiv_C (c : Rˣ) (r : R) : + polynomialVariableScaleEquiv c (C r) = C r := by + simp [polynomialVariableScaleEquiv] + +end Scaling + +section IteratedPolynomial + +variable {K : Type*} [Field K] + +/-- View a two-variable polynomial as a polynomial in variable `0`, whose coefficients are +ordinary polynomials in variable `1`. -/ +noncomputable def finTwoToIteratedPolynomial : + MvPolynomial (Fin 2) K ≃ₐ[K] Polynomial K[X] := + (MvPolynomial.finSuccEquiv K 1).trans + (Polynomial.mapAlgEquiv (MvPolynomial.uniqueAlgEquiv K (Fin 1))) + +@[simp] +theorem finTwoToIteratedPolynomial_X_zero : + finTwoToIteratedPolynomial (K := K) (MvPolynomial.X 0) = X := by + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 0) = + (Polynomial.X : Polynomial (MvPolynomial (Fin 1) K)) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp + rw [finTwoToIteratedPolynomial] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 0)) = X + rw [hinner] + simp + +@[simp] +theorem finTwoToIteratedPolynomial_X_one : + finTwoToIteratedPolynomial (K := K) (MvPolynomial.X 1) = C X := by + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 1) = + Polynomial.C (MvPolynomial.X (0 : Fin 1)) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp only [MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_X] + rw [show (1 : Fin 2) = Fin.succ (0 : Fin 1) by decide] + rfl + rw [finTwoToIteratedPolynomial] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 (MvPolynomial.X 1)) = C X + rw [hinner] + simp [MvPolynomial.uniqueAlgEquiv] + +@[simp] +theorem finTwoToIteratedPolynomial_C (r : K) : + finTwoToIteratedPolynomial (K := K) (MvPolynomial.C r) = C (C r) := by + have hinner : + MvPolynomial.finSuccEquiv K 1 (MvPolynomial.C r) = + Polynomial.C (MvPolynomial.C r) := by + rw [MvPolynomial.finSuccEquiv_apply] + simp + rw [finTwoToIteratedPolynomial] + change Polynomial.map (MvPolynomial.uniqueAlgEquiv K (Fin 1)).toRingHom + (MvPolynomial.finSuccEquiv K 1 (MvPolynomial.C r)) = C (C r) + rw [hinner] + simp [MvPolynomial.uniqueAlgEquiv] + +/-- The weighted trace curve in the iterated-polynomial presentation. -/ +noncomputable def weightedTraceIteratedPolynomial (alpha beta : K) : Polynomial K[X] := + monomial 2 (-X) + monomial 1 (C alpha * X ^ 2 + C beta) + C (-X) + +theorem finTwoToIteratedPolynomial_weightedTraceTorusClosurePolynomial + (alpha beta : K) (hbeta : beta ≠ 0) : + finTwoToIteratedPolynomial (K := K) + (weightedTraceTorusClosurePolynomial alpha beta) = + weightedTraceIteratedPolynomial alpha beta := by + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + simp [splitTraceCoverPolynomial, weightedTraceIteratedPolynomial, + ← Polynomial.C_mul_X_pow_eq_monomial] + ring + +private theorem weightedTraceIteratedPolynomial_isPrimitive + (alpha beta : K) (hbeta : beta ≠ 0) : + (weightedTraceIteratedPolynomial alpha beta).IsPrimitive := by + rw [Polynomial.isPrimitive_iff_isUnit_of_C_dvd] + intro r hr + have hcoeff := (Polynomial.C_dvd_iff_dvd_coeff r + (weightedTraceIteratedPolynomial alpha beta)).mp hr + have hrY : r ∣ X := by + have := hcoeff 0 + have hrNegY : r ∣ -X := by + simpa [weightedTraceIteratedPolynomial] using this + exact dvd_neg.mp hrNegY + have hrMiddle : r ∣ C alpha * X ^ 2 + C beta := by + have hpcoeff : + (weightedTraceIteratedPolynomial alpha beta).coeff 1 = + C alpha * X ^ 2 + C beta := by + norm_num [weightedTraceIteratedPolynomial, Polynomial.coeff_monomial] + rw [← hpcoeff] + exact hcoeff 1 + rcases hrY with ⟨q, hq⟩ + rcases hrMiddle with ⟨s, hs⟩ + have hrBeta : r ∣ C beta := by + refine ⟨s - C alpha * q * X, ?_⟩ + calc + C beta = (C alpha * X ^ 2 + C beta) - C alpha * X * X := by ring + _ = r * s - C alpha * (r * q) * X := by rw [hs, hq] + _ = r * (s - C alpha * q * X) := by ring + exact isUnit_of_dvd_unit hrBeta + (Polynomial.isUnit_C.mpr (isUnit_iff_ne_zero.mpr hbeta)) + +/-- The swapped Eisenstein polynomial after the invertible scaling `y ↦ alpha * y`. +It is a polynomial in the birational coordinate `u`, with coefficients in `K[y]`. -/ +noncomputable def weightedTraceScaledBirationalPolynomial + (alpha : Kˣ) (beta : K) : Polynomial K[X] := + let ay : K[X] := C (alpha : K) * X + monomial 2 (-(ay ^ 2)) + + monomial 1 (ay ^ 2 + C ((alpha : K) * beta)) + + C (-1) + +theorem weightedTraceScaledBirationalPolynomial_eq_map_swap + (alpha : Kˣ) (beta : K) : + weightedTraceScaledBirationalPolynomial alpha beta = + Polynomial.mapAlgEquiv (polynomialVariableScaleEquiv alpha) + (Polynomial.Bivariate.swap + (normalizedSplitTraceBirationalPolynomial ((alpha : K) * beta))) := by + simp [weightedTraceScaledBirationalPolynomial, + normalizedSplitTraceBirationalPolynomial, normalizedSplitTraceLeadingCoefficient, + normalizedSplitTraceEisensteinPrime, polynomialVariableScaleEquiv, + Polynomial.Bivariate.swap_apply, ← Polynomial.C_mul_X_pow_eq_monomial] + ring + +/-- The scaled-and-swapped birational polynomial remains irreducible. -/ +theorem weightedTraceScaledBirationalPolynomial_irreducible + (alpha : Kˣ) (beta : K) (hbeta : beta ≠ 0) + (hnondegenerate : (alpha : K) * beta ≠ 1) : + Irreducible (weightedTraceScaledBirationalPolynomial alpha beta) := by + rw [weightedTraceScaledBirationalPolynomial_eq_map_swap] + exact ((normalizedSplitTraceBirationalPolynomial_irreducible + ((alpha : K) * beta) (mul_ne_zero alpha.ne_zero hbeta) hnondegenerate).map + (Polynomial.Bivariate.swap)).map + (Polynomial.mapAlgEquiv (polynomialVariableScaleEquiv alpha)) + +private theorem weightedTraceScaledBirationalPolynomial_natDegree_ne_zero + (alpha : Kˣ) (beta : K) : + (weightedTraceScaledBirationalPolynomial alpha beta).natDegree ≠ 0 := by + let ay : K[X] := C (alpha : K) * X + have hay : ay ≠ 0 := mul_ne_zero (C_ne_zero.mpr alpha.ne_zero) X_ne_zero + have hcoeff : + (weightedTraceScaledBirationalPolynomial alpha beta).coeff 2 = -(ay ^ 2) := by + simp [weightedTraceScaledBirationalPolynomial, ay, Polynomial.coeff_monomial, + Polynomial.coeff_one] + have hcoeffNe : + (weightedTraceScaledBirationalPolynomial alpha beta).coeff 2 ≠ 0 := by + rw [hcoeff] + exact neg_ne_zero.mpr (pow_ne_zero 2 hay) + have hle : 2 ≤ (weightedTraceScaledBirationalPolynomial alpha beta).natDegree := + Polynomial.le_natDegree_of_ne_zero hcoeffNe + omega + +/-- The scaled birational polynomial stays irreducible over the coefficient fraction field. -/ +theorem weightedTraceScaledBirationalPolynomial_irreducible_fractionMap + (alpha : Kˣ) (beta : K) (hbeta : beta ≠ 0) + (hnondegenerate : (alpha : K) * beta ≠ 1) : + Irreducible + ((weightedTraceScaledBirationalPolynomial alpha beta).map + (algebraMap K[X] (FractionRing K[X]))) := by + have hirr := weightedTraceScaledBirationalPolynomial_irreducible + alpha beta hbeta hnondegenerate + have hprimitive := hirr.isPrimitive + (weightedTraceScaledBirationalPolynomial_natDegree_ne_zero alpha beta) + exact hprimitive.irreducible_iff_irreducible_map_fraction_map.mp hirr + +/-- The unit `alpha * y` in the rational function field `K(y)`. -/ +noncomputable def weightedTraceFractionScaleUnit (alpha : Kˣ) : + (FractionRing K[X])ˣ := + Units.mk0 + (algebraMap K[X] (FractionRing K[X]) (C (alpha : K) * X)) + ((map_ne_zero_iff (algebraMap K[X] (FractionRing K[X])) + (IsFractionRing.injective K[X] (FractionRing K[X]))).mpr + (mul_ne_zero (C_ne_zero.mpr alpha.ne_zero) X_ne_zero)) + +@[simp] +theorem weightedTraceFractionScaleUnit_val (alpha : Kˣ) : + (weightedTraceFractionScaleUnit alpha : FractionRing K[X]) = + algebraMap K[X] (FractionRing K[X]) (C (alpha : K) * X) := by + rfl + +/-- After passing to `K(y)` and scaling `x` by the invertible element `alpha * y`, the +weighted trace polynomial is `y` times the scaled Eisenstein polynomial. -/ +theorem polynomialVariableScaleEquiv_map_weightedTraceIteratedPolynomial + (alpha : Kˣ) (beta : K) : + polynomialVariableScaleEquiv (weightedTraceFractionScaleUnit alpha) + ((weightedTraceIteratedPolynomial (alpha : K) beta).map + (algebraMap K[X] (FractionRing K[X]))) = + C (algebraMap K[X] (FractionRing K[X]) X) * + (weightedTraceScaledBirationalPolynomial alpha beta).map + (algebraMap K[X] (FractionRing K[X])) := by + simp [polynomialVariableScaleEquiv, weightedTraceFractionScaleUnit_val, + weightedTraceIteratedPolynomial, weightedTraceScaledBirationalPolynomial, + ← Polynomial.C_mul_X_pow_eq_monomial] + ring + +/-- The actual weighted trace polynomial is irreducible in the iterated presentation. -/ +theorem weightedTraceIteratedPolynomial_irreducible + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) : + Irreducible (weightedTraceIteratedPolynomial alpha beta) := by + let alphaUnit : Kˣ := Units.mk0 alpha halpha + have hBirationalFraction : + Irreducible + ((weightedTraceScaledBirationalPolynomial alphaUnit beta).map + (algebraMap K[X] (FractionRing K[X]))) := + weightedTraceScaledBirationalPolynomial_irreducible_fractionMap + alphaUnit beta hbeta (by simpa [alphaUnit] using hnondegenerate) + have hyNe : algebraMap K[X] (FractionRing K[X]) X ≠ 0 := + (map_ne_zero_iff (algebraMap K[X] (FractionRing K[X])) + (IsFractionRing.injective K[X] (FractionRing K[X]))).mpr X_ne_zero + have hyUnit : IsUnit + (C (algebraMap K[X] (FractionRing K[X]) X) : + Polynomial (FractionRing K[X])) := + Polynomial.isUnit_C.mpr (isUnit_iff_ne_zero.mpr hyNe) + have hScaled : Irreducible + (polynomialVariableScaleEquiv (weightedTraceFractionScaleUnit alphaUnit) + ((weightedTraceIteratedPolynomial alpha beta).map + (algebraMap K[X] (FractionRing K[X])))) := by + rw [show alpha = (alphaUnit : K) by rfl, + polynomialVariableScaleEquiv_map_weightedTraceIteratedPolynomial] + exact (irreducible_isUnit_mul hyUnit).2 hBirationalFraction + have hFraction : Irreducible + ((weightedTraceIteratedPolynomial alpha beta).map + (algebraMap K[X] (FractionRing K[X]))) := by + have hback := hScaled.map + (polynomialVariableScaleEquiv (weightedTraceFractionScaleUnit alphaUnit)).symm + simpa using hback + have hprimitive := weightedTraceIteratedPolynomial_isPrimitive alpha beta hbeta + exact hprimitive.irreducible_iff_irreducible_map_fraction_map.mpr hFraction + +/-- The reduced torus closure commutes with injective scalar extension in the nonzero +`beta` branch used by the `(2,2)` middle-game curve. -/ +theorem map_weightedTraceTorusClosurePolynomial_of_beta_ne_zero + {L : Type*} [Field L] (phi : K →+* L) (alpha beta : K) (hbeta : beta ≠ 0) : + MvPolynomial.map phi (weightedTraceTorusClosurePolynomial alpha beta) = + weightedTraceTorusClosurePolynomial (phi alpha) (phi beta) := by + have hMapBeta : phi beta ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hbeta + rw [weightedTraceTorusClosurePolynomial, if_neg hbeta, + weightedTraceTorusClosurePolynomial, if_neg hMapBeta] + simp [splitTraceCoverPolynomial] + +/-- Irreducibility over the ground field, obtained from the iterated-polynomial proof by +the explicit two-variable polynomial equivalence. -/ +theorem weightedTraceTorusClosurePolynomial_irreducible + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) : + Irreducible (weightedTraceTorusClosurePolynomial alpha beta) := by + have hImage := + finTwoToIteratedPolynomial_weightedTraceTorusClosurePolynomial alpha beta hbeta + have hIterated := weightedTraceIteratedPolynomial_irreducible + alpha beta halpha hbeta hnondegenerate + rw [← hImage] at hIterated + have hback := hIterated.map (finTwoToIteratedPolynomial (K := K)).symm + simpa using hback + +/-- The actual weighted trace curve is absolutely irreducible when both weights are nonzero +and their product is not one. Every coordinate change used in the proof is an explicit +algebra equivalence or a Gauss-lemma passage to a fraction field. -/ +theorem weightedTraceCurve_absolutelyIrreducible + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) : + WeightedTraceCurveAbsolutelyIrreducible alpha beta := by + unfold WeightedTraceCurveAbsolutelyIrreducible + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + rw [map_weightedTraceTorusClosurePolynomial_of_beta_ne_zero phi alpha beta hbeta] + apply weightedTraceTorusClosurePolynomial_irreducible + · exact (map_ne_zero_iff phi phi.injective).mpr halpha + · exact (map_ne_zero_iff phi phi.injective).mpr hbeta + · intro h + apply hnondegenerate + apply phi.injective + simpa [phi] using h + +end IteratedPolynomial + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean new file mode 100644 index 0000000000..c0ca8c664c --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean @@ -0,0 +1,254 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry + +/-! +# The weighted trace curve is not a subtorus translate + +This module proves the non-specialness condition needed by the +Corvaja--Zannier torsion-point bound. The proof uses the two deck involutions +of the weighted trace curve and keeps all degenerate parameters explicit. +-/ + +namespace BGS.Markoff + +section CharacterPowers + +variable {F : Type*} [Field F] [Infinite F] + +/-- No fixed nonzero integer power is identically one on the units of an +infinite field. -/ +private theorem exists_unit_zpow_ne_one (n : ℤ) (hn : n ≠ 0) : + ∃ u : Fˣ, u ^ n ≠ 1 := by + by_contra h + push Not at h + let m := n.natAbs + let q : Polynomial F := Polynomial.X ^ m - 1 + have hm : m ≠ 0 := Int.natAbs_ne_zero.mpr hn + have hqDegree : q.natDegree = m := by + simpa [q] using (Polynomial.natDegree_X_pow_sub_C (R := F) (n := m) (r := 1)) + have hq : q ≠ 0 := by + intro hzero + have : q.natDegree = 0 := by simp [hzero] + omega + have hXq : Polynomial.X * q ≠ 0 := mul_ne_zero Polynomial.X_ne_zero hq + apply hXq + apply Polynomial.zero_of_eval_zero + intro x + by_cases hx : x = 0 + · simp [hx] + · let u : Fˣ := Units.mk0 x hx + have hu : u ^ m = 1 := pow_natAbs_eq_one.mpr (h u) + have hxpow : x ^ m = 1 := by + have := congrArg (fun v : Fˣ ↦ (v : F)) hu + simpa [u] using this + simp [q, hxpow] + +end CharacterPowers + +section CurveProjections + +variable {F : Type*} [Field F] [IsAlgClosed F] + +/-- Every right torus coordinate occurs on a nondegenerate weighted trace +curve. The other coordinate is obtained from its quadratic equation. -/ +private theorem exists_weightedTraceCurve_point_over_right + (alpha beta : F) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (k : Fˣ) : + ∃ h : Fˣ, + weightedSplitTorusTrace alpha beta h = splitTorusTrace k := by + let trace := splitTorusTrace k + let q : Polynomial F := + Polynomial.C alpha * Polynomial.X ^ 2 - + Polynomial.C trace * Polynomial.X + Polynomial.C beta + have hqDegree : q.natDegree = 2 := by + rw [show q = Polynomial.C alpha * Polynomial.X ^ 2 + + Polynomial.C (-trace) * Polynomial.X + Polynomial.C beta by + simp only [q, Polynomial.C_neg] + ring] + exact Polynomial.natDegree_quadratic halpha + have hq : q ≠ 0 := by + intro hzero + have : q.natDegree = 0 := by simp [hzero] + omega + have hqDegreeBot : q.degree ≠ 0 := by + rw [Polynomial.degree_eq_natDegree hq, hqDegree] + norm_num + obtain ⟨x, hx⟩ := IsAlgClosed.exists_root q hqDegreeBot + have hxzero : x ≠ 0 := by + intro hzero + subst x + simp [Polynomial.IsRoot.def, q, hbeta] at hx + refine ⟨Units.mk0 x hxzero, ?_⟩ + change alpha * x + beta * x⁻¹ = trace + have hxeq : alpha * x ^ 2 - trace * x + beta = 0 := by + simpa [Polynomial.IsRoot.def, q] using hx + field_simp [hxzero] + linear_combination hxeq + +/-- Every left torus coordinate occurs on the weighted trace curve. -/ +private theorem exists_weightedTraceCurve_point_over_left + (alpha beta : F) (h : Fˣ) : + ∃ k : Fˣ, + weightedSplitTorusTrace alpha beta h = splitTorusTrace k := by + let trace := weightedSplitTorusTrace alpha beta h + let q : Polynomial F := + Polynomial.X ^ 2 - Polynomial.C trace * Polynomial.X + 1 + have hqDegree : q.natDegree = 2 := by + rw [show q = Polynomial.C (1 : F) * Polynomial.X ^ 2 + + Polynomial.C (-trace) * Polynomial.X + Polynomial.C 1 by + simp only [q, Polynomial.C_neg, Polynomial.C_1] + ring] + exact Polynomial.natDegree_quadratic one_ne_zero + have hq : q ≠ 0 := by + intro hzero + have : q.natDegree = 0 := by simp [hzero] + omega + have hqDegreeBot : q.degree ≠ 0 := by + rw [Polynomial.degree_eq_natDegree hq, hqDegree] + norm_num + obtain ⟨x, hx⟩ := IsAlgClosed.exists_root q hqDegreeBot + have hxzero : x ≠ 0 := by + intro hzero + subst x + simp [Polynomial.IsRoot.def, q] at hx + refine ⟨Units.mk0 x hxzero, ?_⟩ + change trace = x + x⁻¹ + have hxeq : x ^ 2 - trace * x + 1 = 0 := by + simpa [Polynomial.IsRoot.def, q] using hx + field_simp [hxzero] + linear_combination -hxeq + +end CurveProjections + +section DeckInvolutions + +variable {F : Type*} [Field F] + +private theorem splitTorusTrace_inv (k : Fˣ) : + splitTorusTrace k⁻¹ = splitTorusTrace k := by + simp only [splitTorusTrace, Units.val_inv_eq_inv_val, inv_inv] + exact add_comm _ _ + +/-- The second deck involution exchanges the two roots of the quadratic in +the weighted coordinate. -/ +private theorem weightedSplitTorusTrace_deck_involution + (alpha beta : F) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) (h : Fˣ) : + let q : Fˣ := Units.mk0 (beta / alpha) (div_ne_zero hbeta halpha) + weightedSplitTorusTrace alpha beta (q * h⁻¹) = + weightedSplitTorusTrace alpha beta h := by + dsimp + simp only [weightedSplitTorusTrace, Units.val_mul, Units.val_inv_eq_inv_val, + Units.val_mk0, div_eq_mul_inv] + field_simp [halpha, hbeta, Units.ne_zero h] + ring + +end DeckInvolutions + +section NonSubtorus + +variable {K : Type*} [Field K] + +/-- If both weights are nonzero, the complete weighted trace curve is not a +character fiber in the two-dimensional torus. No characteristic restriction +is needed. + +This deliberately does not assume `alpha * beta ≠ 1`. When the product is +one the curve is reducible into two subtorus translates, but no single +character is constant on their union. Thus this proposition is the correct +non-specialness condition only when paired with the separate absolute +irreducibility hypothesis, exactly as it is in +`WeightedTraceCurveIsCorvajaZannierAdmissible`. -/ +theorem weightedTraceCurve_notSubtorusTranslate_of_weights_ne_zero + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) : + WeightedTraceCurveNotSubtorusTranslate alpha beta := by + let alphaL : AlgebraicClosure K := algebraMap K (AlgebraicClosure K) alpha + let betaL : AlgebraicClosure K := algebraMap K (AlgebraicClosure K) beta + have halphaL : alphaL ≠ 0 := by + exact (map_ne_zero_iff (algebraMap K (AlgebraicClosure K)) + (algebraMap K (AlgebraicClosure K)).injective).mpr halpha + have hbetaL : betaL ≠ 0 := by + exact (map_ne_zero_iff (algebraMap K (AlgebraicClosure K)) + (algebraMap K (AlgebraicClosure K)).injective).mpr hbeta + intro a b hab c + by_contra hvaries + push Not at hvaries + have haUniversal : ∀ k : (AlgebraicClosure K)ˣ, k ^ (2 * a) = 1 := by + intro k + obtain ⟨h, hcurve⟩ := + exists_weightedTraceCurve_point_over_right alphaL betaL halphaL hbetaL k + have hcurveInv : + weightedSplitTorusTrace alphaL betaL h = splitTorusTrace k⁻¹ := by + rw [splitTorusTrace_inv] + exact hcurve + have hvalue := hvaries k h hcurve + have hvalueInv := hvaries k⁻¹ h hcurveInv + have hpower : k ^ a = (k⁻¹) ^ a := by + exact mul_right_cancel (hvalue.trans hvalueInv.symm) + have hpowerInv : k ^ a = (k ^ a)⁻¹ := by + simpa only [inv_zpow] using hpower + have hsquare : k ^ a * k ^ a = 1 := eq_inv_iff_mul_eq_one.mp hpowerInv + calc + k ^ (2 * a) = k ^ (a + a) := by (congr 1; ring) + _ = k ^ a * k ^ a := zpow_add k a a + _ = 1 := hsquare + have ha : a = 0 := by + by_contra ha + have htwoa : 2 * a ≠ 0 := mul_ne_zero (by norm_num) ha + obtain ⟨k, hk⟩ := exists_unit_zpow_ne_one (F := AlgebraicClosure K) (2 * a) htwoa + exact hk (haUniversal k) + have hbUniversal : ∀ h : (AlgebraicClosure K)ˣ, h ^ (2 * b) = 1 := by + let q : (AlgebraicClosure K)ˣ := + Units.mk0 (betaL / alphaL) (div_ne_zero hbetaL halphaL) + have hconstant : ∀ h : (AlgebraicClosure K)ˣ, h ^ (2 * b) = q ^ b := by + intro h + obtain ⟨k, hcurve⟩ := exists_weightedTraceCurve_point_over_left alphaL betaL h + have hcurveDeck : + weightedSplitTorusTrace alphaL betaL (q * h⁻¹) = splitTorusTrace k := by + rw [weightedSplitTorusTrace_deck_involution alphaL betaL halphaL hbetaL] + exact hcurve + have hvalue := hvaries k h hcurve + have hvalueDeck := hvaries k (q * h⁻¹) hcurveDeck + have hpower : h ^ b = (q * h⁻¹) ^ b := by + exact mul_left_cancel (hvalue.trans hvalueDeck.symm) + have hpowerExpanded : h ^ b = q ^ b * (h ^ b)⁻¹ := by + simpa only [mul_zpow, inv_zpow] using hpower + have hsquare : h ^ b * h ^ b = q ^ b := by + calc + h ^ b * h ^ b = (q ^ b * (h ^ b)⁻¹) * h ^ b := by + exact congrArg (fun z ↦ z * h ^ b) hpowerExpanded + _ = q ^ b := by simp + calc + h ^ (2 * b) = h ^ (b + b) := by (congr 1; ring) + _ = h ^ b * h ^ b := zpow_add h b b + _ = q ^ b := hsquare + have hq : q ^ b = 1 := by + have hone := hconstant (1 : (AlgebraicClosure K)ˣ) + simpa using hone.symm + intro h + exact (hconstant h).trans hq + have hb : b = 0 := by + by_contra hb + have htwob : 2 * b ≠ 0 := mul_ne_zero (by norm_num) hb + obtain ⟨h, hh⟩ := exists_unit_zpow_ne_one + (F := AlgebraicClosure K) (2 * b) htwob + exact hh (hbUniversal h) + exact hab.elim (fun hne ↦ hne ha) (fun hne ↦ hne hb) + +/-- Once absolute irreducibility is supplied, all remaining geometric +admissibility conditions are discharged by the explicit parameter +hypotheses. -/ +theorem weightedTraceCurve_isCorvajaZannierAdmissible_of_absoluteIrreducible + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (hirreducible : WeightedTraceCurveAbsolutelyIrreducible alpha beta) : + WeightedTraceCurveIsCorvajaZannierAdmissible alpha beta := by + exact ⟨halpha, hbeta, hnondegenerate, hirreducible, + weightedTraceCurve_notSubtorusTranslate_of_weights_ne_zero alpha beta halpha hbeta⟩ + +end NonSubtorus + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean new file mode 100644 index 0000000000..d7e0fa6696 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +import Mathlib.FieldTheory.IsAlgClosed.Basic +import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed + +/-! +# Absolute irreducibility of weighted odd-coprime split trace covers + +The residue-block proof gives irreducibility first for the normalized coefficients `(1, sigma)`. +This file connects that result to the paper's actual weights `(alpha, beta)`. Over the algebraic +closure choose `c` with `c ^ e = alpha`; the reversible coordinate scaling `y ↦ c * y` carries the +normalized cover with `sigma = alpha * beta` to `alpha` times the weighted cover. Thus no new +irreducibility assumption is introduced at the normalization step. +-/ + +namespace BGS.Markoff + +open Polynomial + +noncomputable section + +variable {K : Type*} [Field K] + +/-- Scaling the second variable of a two-variable polynomial by a unit. -/ +noncomputable def finTwoSecondVariableScaleEquiv (c : Kˣ) : + MvPolynomial (Fin 2) K ≃ₐ[K] MvPolynomial (Fin 2) K := by + let forward : MvPolynomial (Fin 2) K →ₐ[K] MvPolynomial (Fin 2) K := + MvPolynomial.aeval ![MvPolynomial.X 0, MvPolynomial.C (c : K) * MvPolynomial.X 1] + let backward : MvPolynomial (Fin 2) K →ₐ[K] MvPolynomial (Fin 2) K := + MvPolynomial.aeval + ![MvPolynomial.X 0, MvPolynomial.C ((c⁻¹ : Kˣ) : K) * MvPolynomial.X 1] + refine AlgEquiv.ofAlgHom forward backward ?_ ?_ + · apply MvPolynomial.algHom_ext + intro i + fin_cases i + · simp [forward, backward] + · simp [forward, backward, ← mul_assoc] + rw [← map_mul] + simp + · apply MvPolynomial.algHom_ext + intro i + fin_cases i + · simp [forward, backward] + · simp [forward, backward, ← mul_assoc] + rw [← map_mul] + simp + +@[simp] +theorem finTwoSecondVariableScaleEquiv_X_zero (c : Kˣ) : + finTwoSecondVariableScaleEquiv c (MvPolynomial.X 0) = MvPolynomial.X 0 := by + simp [finTwoSecondVariableScaleEquiv] + +@[simp] +theorem finTwoSecondVariableScaleEquiv_X_one (c : Kˣ) : + finTwoSecondVariableScaleEquiv c (MvPolynomial.X 1) = + MvPolynomial.C (c : K) * MvPolynomial.X 1 := by + simp [finTwoSecondVariableScaleEquiv] + +@[simp] +theorem finTwoSecondVariableScaleEquiv_C (c : Kˣ) (a : K) : + finTwoSecondVariableScaleEquiv c (MvPolynomial.C a) = MvPolynomial.C a := by + simp [finTwoSecondVariableScaleEquiv] + +/-- Exact scaling identity between the normalized and weighted covers. -/ +theorem finTwoSecondVariableScaleEquiv_normalizedCover + (alpha beta : K) (e d : ℕ) (c : Kˣ) (hc : (c : K) ^ e = alpha) : + finTwoSecondVariableScaleEquiv c + (splitTraceCoverPolynomial (1 : K) (alpha * beta) d e) = + MvPolynomial.C alpha * splitTraceCoverPolynomial alpha beta d e := by + simp only [splitTraceCoverPolynomial, map_add, map_sub, map_mul, map_pow, + finTwoSecondVariableScaleEquiv_C, finTwoSecondVariableScaleEquiv_X_zero, + finTwoSecondVariableScaleEquiv_X_one, map_one] + simp only [mul_pow, ← map_pow] + rw [Nat.mul_comm 2 e, pow_mul, hc] + rw [map_pow] + ring + +/-- The cleared split trace-cover polynomial commutes with scalar extension. -/ +theorem map_splitTraceCoverPolynomial + {L : Type*} [Field L] (phi : K →+* L) (alpha beta : K) (d e : ℕ) : + MvPolynomial.map phi (splitTraceCoverPolynomial alpha beta d e) = + splitTraceCoverPolynomial (phi alpha) (phi beta) d e := by + simp [splitTraceCoverPolynomial] + +/-- The paper's weighted split trace cover is absolutely irreducible for arbitrary positive +covering exponents when the first-stage exponent is nonzero in the ground field. This is the +characteristic condition satisfied by the endgame exponents dividing `p - 1` or `p + 1`. -/ +theorem splitTraceCoverPolynomial_absolutelyIrreducible_of_positiveExponents + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) (heChar : (e : K) ≠ 0) : + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (splitTraceCoverPolynomial alpha beta d e)) := by + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + rw [map_splitTraceCoverPolynomial phi alpha beta d e] + have halphaL : phi alpha ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr halpha + have hbetaL : phi beta ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hbeta + have hproductL : phi alpha * phi beta ≠ 1 := by + intro h + apply hnondegenerate + apply phi.injective + simpa [phi] using h + have heCharL : (e : AlgebraicClosure K) ≠ 0 := by + change phi (e : K) ≠ 0 + exact (map_ne_zero_iff phi phi.injective).mpr heChar + letI : NeZero e := ⟨he.ne'⟩ + letI : NeZero (e : AlgebraicClosure K) := ⟨heCharL⟩ + obtain ⟨zeta, hzeta⟩ := + HasEnoughRootsOfUnity.exists_primitiveRoot (AlgebraicClosure K) e + obtain ⟨sqrtNegOne, hsqrtNegOne⟩ := + IsAlgClosed.exists_pow_nat_eq (-1 : AlgebraicClosure K) zero_lt_two + obtain ⟨c, hc⟩ := IsAlgClosed.exists_pow_nat_eq (phi alpha) he + have hcne : c ≠ 0 := by + intro hc0 + apply halphaL + rw [← hc] + simp [hc0, Nat.ne_of_gt he] + let cUnit : (AlgebraicClosure K)ˣ := Units.mk0 c hcne + have hnormalized : Irreducible + (splitTraceCoverPolynomial (1 : AlgebraicClosure K) (phi alpha * phi beta) d e) := + splitTraceCoverPolynomial_irreducible_of_primitiveRoot + (phi alpha * phi beta) (mul_ne_zero halphaL hbetaL) hproductL + sqrtNegOne hsqrtNegOne e d he hd zeta hzeta + have hscaled := hnormalized.map (finTwoSecondVariableScaleEquiv cUnit) + have hscaleIdentity : + finTwoSecondVariableScaleEquiv cUnit + (splitTraceCoverPolynomial (1 : AlgebraicClosure K) (phi alpha * phi beta) d e) = + MvPolynomial.C (phi alpha) * + splitTraceCoverPolynomial (phi alpha) (phi beta) d e := by + apply finTwoSecondVariableScaleEquiv_normalizedCover + simpa [cUnit] using hc + rw [hscaleIdentity] at hscaled + exact (irreducible_isUnit_mul + (halphaL.isUnit.map (MvPolynomial.C : AlgebraicClosure K →+* + MvPolynomial (Fin 2) (AlgebraicClosure K)))).mp hscaled + +/-- The paper's weighted split trace cover is absolutely irreducible for nonzero weights with +nondegenerate product and arbitrary positive coprime covering exponents. Passing to the +algebraic closure supplies both the required square root of `-1` and the root used to normalize +the first weight. -/ +theorem splitTraceCoverPolynomial_absolutelyIrreducible_of_coprime + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (e d : ℕ) (he : 0 < e) (hd : 0 < d) (hde : d.Coprime e) : + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (splitTraceCoverPolynomial alpha beta d e)) := by + let phi : K →+* AlgebraicClosure K := algebraMap K (AlgebraicClosure K) + rw [map_splitTraceCoverPolynomial phi alpha beta d e] + have halphaL : phi alpha ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr halpha + have hbetaL : phi beta ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hbeta + have hproductL : phi alpha * phi beta ≠ 1 := by + intro h + apply hnondegenerate + apply phi.injective + simpa [phi] using h + obtain ⟨sqrtNegOne, hsqrtNegOne⟩ := + IsAlgClosed.exists_pow_nat_eq (-1 : AlgebraicClosure K) zero_lt_two + obtain ⟨c, hc⟩ := IsAlgClosed.exists_pow_nat_eq (phi alpha) he + have hcne : c ≠ 0 := by + intro hc0 + apply halphaL + rw [← hc] + simp [hc0, Nat.ne_of_gt he] + let cUnit : (AlgebraicClosure K)ˣ := Units.mk0 c hcne + have hnormalized : Irreducible + (splitTraceCoverPolynomial (1 : AlgebraicClosure K) (phi alpha * phi beta) d e) := + splitTraceCoverPolynomial_irreducible_of_sqrt_neg_one_coprime + (phi alpha * phi beta) (mul_ne_zero halphaL hbetaL) + sqrtNegOne hsqrtNegOne e d he hd hde hproductL + have hscaled := hnormalized.map (finTwoSecondVariableScaleEquiv cUnit) + have hscaleIdentity : + finTwoSecondVariableScaleEquiv cUnit + (splitTraceCoverPolynomial (1 : AlgebraicClosure K) (phi alpha * phi beta) d e) = + MvPolynomial.C (phi alpha) * + splitTraceCoverPolynomial (phi alpha) (phi beta) d e := by + apply finTwoSecondVariableScaleEquiv_normalizedCover + simpa [cUnit] using hc + rw [hscaleIdentity] at hscaled + exact (irreducible_isUnit_mul + (halphaL.isUnit.map (MvPolynomial.C : AlgebraicClosure K →+* + MvPolynomial (Fin 2) (AlgebraicClosure K)))).mp hscaled + +/-- Backwards-compatible odd-coprime specialization of the positive-coprime theorem. -/ +theorem splitTraceCoverPolynomial_absolutelyIrreducible_of_oddCoprime + (alpha beta : K) (halpha : alpha ≠ 0) (hbeta : beta ≠ 0) + (hnondegenerate : alpha * beta ≠ 1) + (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : + Irreducible + (MvPolynomial.map (algebraMap K (AlgebraicClosure K)) + (splitTraceCoverPolynomial alpha beta d e)) := + splitTraceCoverPolynomial_absolutelyIrreducible_of_coprime + alpha beta halpha hbeta hnondegenerate e d heOdd.pos hdOdd.pos hde + +end + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean new file mode 100644 index 0000000000..324eff029e --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean @@ -0,0 +1,139 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.Analysis.SpecificLimits.Normed +import Mathlib.Analysis.SpecialFunctions.Pow.Asymptotics +import Mathlib.NumberTheory.ArithmeticFunction.Misc + +/-! +# Subpolynomial growth of the divisor-counting function + +This module develops the analytic-number-theory input used by the BGS +middle- and end-game union bounds. The public target is an eventual real +power bound for `Nat.divisors.card`. +-/ + +namespace BGS.NumberTheory + +open Filter +open scoped BigOperators Topology + +/-- A fixed power of `a + 1` is bounded by a constant times `2 ^ a`. +The constant is allowed to depend on the power. -/ +private lemma exists_pow_succ_le_constant_mul_two_pow (k : ℕ) : + ∃ D : ℕ, 0 < D ∧ ∀ a : ℕ, (a + 1) ^ k ≤ D * 2 ^ a := by + have h := + (isLittleO_pow_const_const_pow_of_one_lt (R := ℝ) k + (by norm_num : (1 : ℝ) < 2)).bound zero_lt_one + rw [eventually_atTop] at h + obtain ⟨N, hN⟩ := h + refine ⟨2 * (N + 1) ^ k, by positivity, fun a ↦ ?_⟩ + by_cases ha : N ≤ a + 1 + · have hreal := hN (a + 1) ha + simp only [Real.norm_eq_abs, one_mul, abs_pow] at hreal + simp at hreal + have hnat : (a + 1) ^ k ≤ 2 ^ (a + 1) := by exact_mod_cast hreal + calc + (a + 1) ^ k ≤ 2 ^ (a + 1) := hnat + _ = 2 * 2 ^ a := by simp [pow_succ, Nat.mul_comm] + _ ≤ (2 * (N + 1) ^ k) * 2 ^ a := by + gcongr + simpa using Nat.mul_le_mul_left 2 (Nat.one_le_pow' k N) + · have haN : a + 1 ≤ N + 1 := by omega + calc + (a + 1) ^ k ≤ (N + 1) ^ k := Nat.pow_le_pow_left haN k + _ ≤ (2 * (N + 1) ^ k) * 2 ^ a := by + have hpow : 1 ≤ 2 ^ a := by simpa using Nat.one_le_pow' a 1 + nlinarith [Nat.zero_le ((N + 1) ^ k)] + +/-- Raising the divisor count to a fixed natural power costs only a constant +times `n`. This is the arithmetic core of the subpolynomial estimate. -/ +private lemma exists_card_divisors_pow_le_constant_mul (k : ℕ) : + ∃ C : ℕ, 0 < C ∧ ∀ n : ℕ, n ≠ 0 → n.divisors.card ^ k ≤ C * n := by + obtain ⟨D, hD, hDpow⟩ := exists_pow_succ_le_constant_mul_two_pow k + refine ⟨D ^ (2 ^ k), pow_pos hD _, fun n hn ↦ ?_⟩ + have hfactor : ∀ p ∈ n.primeFactors, + (n.factorization p + 1) ^ k ≤ + (if p < 2 ^ k then D else 1) * p ^ n.factorization p := by + intro p hp + have hpPrime := Nat.prime_of_mem_primeFactors hp + have hpTwo : 2 ≤ p := hpPrime.two_le + have haPos : 0 < n.factorization p := + hpPrime.factorization_pos_of_dvd hn (Nat.dvd_of_mem_primeFactors hp) + by_cases hpSmall : p < 2 ^ k + · rw [if_pos hpSmall] + exact (hDpow (n.factorization p)).trans <| + Nat.mul_le_mul_left D (Nat.pow_le_pow_left hpTwo _) + · rw [if_neg hpSmall, one_mul] + have hsucc : n.factorization p + 1 ≤ 2 ^ n.factorization p := + Nat.succ_le_of_lt (n.factorization p).lt_two_pow_self + calc + (n.factorization p + 1) ^ k ≤ (2 ^ n.factorization p) ^ k := + Nat.pow_le_pow_left hsucc k + _ = (2 ^ k) ^ n.factorization p := by + rw [← pow_mul, ← pow_mul, Nat.mul_comm] + _ ≤ p ^ n.factorization p := + Nat.pow_le_pow_left (le_of_not_gt hpSmall) _ + have hsmallCard : + (n.primeFactors.filter fun p ↦ p < 2 ^ k).card ≤ 2 ^ k := by + calc + (n.primeFactors.filter fun p ↦ p < 2 ^ k).card ≤ (Finset.range (2 ^ k)).card := + Finset.card_le_card (by + intro p hp + exact Finset.mem_range.mpr (Finset.mem_filter.mp hp).2) + _ = 2 ^ k := Finset.card_range _ + rw [Nat.card_divisors hn, ← Finset.prod_pow] + calc + (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ k) ≤ + ∏ p ∈ n.primeFactors, + ((if p < 2 ^ k then D else 1) * p ^ n.factorization p) := + Finset.prod_le_prod (fun _ _ ↦ Nat.zero_le _) hfactor + _ = D ^ (n.primeFactors.filter fun p ↦ p < 2 ^ k).card * n := by + rw [Finset.prod_mul_distrib, ← Nat.prod_primeFactors_pow_factorization hn] + simp [Finset.prod_ite] + _ ≤ D ^ (2 ^ k) * n := by + exact Nat.mul_le_mul_right n (Nat.pow_le_pow_right hD hsmallCard) + +/-- The divisor-counting function is eventually bounded by every positive +real power. The cast and `Real.rpow` formulation is designed for direct use +in the real-valued union bounds for divisors of `p - 1` and `p + 1`. -/ +theorem eventually_card_divisors_le_rpow {ε : ℝ} (hε : 0 < ε) : + ∀ᶠ n : ℕ in atTop, (n.divisors.card : ℝ) ≤ (n : ℝ) ^ ε := by + obtain ⟨k, hk⟩ := exists_nat_gt (1 / ε) + have hkRealPos : (0 : ℝ) < k := (one_div_pos.mpr hε).trans hk + have hkPos : 0 < k := by exact_mod_cast hkRealPos + have hExponent : 0 < ε * (k : ℝ) - 1 := by + have := (div_lt_iff₀ hε).mp hk + nlinarith + obtain ⟨C, hC, hbound⟩ := exists_card_divisors_pow_le_constant_mul k + have hEventuallyConstant : + ∀ᶠ n : ℕ in atTop, (C : ℝ) ≤ (n : ℝ) ^ (ε * (k : ℝ) - 1) := + ((tendsto_rpow_atTop hExponent).comp tendsto_natCast_atTop_atTop).eventually + (eventually_ge_atTop (C : ℝ)) + filter_upwards [hEventuallyConstant, eventually_gt_atTop 0] with n hConstant hn + have hNatural := hbound n (Nat.ne_of_gt hn) + have hCast : (n.divisors.card : ℝ) ^ k ≤ (C : ℝ) * n := by + exact_mod_cast hNatural + have hnRealPos : (0 : ℝ) < n := by exact_mod_cast hn + have hPowers : (n.divisors.card : ℝ) ^ k ≤ ((n : ℝ) ^ ε) ^ k := by + calc + (n.divisors.card : ℝ) ^ k ≤ (C : ℝ) * n := hCast + _ ≤ (n : ℝ) ^ (ε * (k : ℝ) - 1) * n := + mul_le_mul_of_nonneg_right hConstant (Nat.cast_nonneg n) + _ = (n : ℝ) ^ (ε * (k : ℝ) - 1 + 1) := by + simpa using (Real.rpow_add hnRealPos (ε * (k : ℝ) - 1) 1).symm + _ = (n : ℝ) ^ (ε * (k : ℝ)) := by ring_nf + _ = ((n : ℝ) ^ ε) ^ k := Real.rpow_mul_natCast hnRealPos.le ε k + exact le_of_pow_le_pow_left₀ hkPos.ne' (Real.rpow_nonneg hnRealPos.le ε) hPowers + +/-- Threshold form of `eventually_card_divisors_le_rpow`, convenient when a +downstream argument already carries explicit lower bounds for `p - 1` and +`p + 1`. -/ +theorem exists_threshold_card_divisors_le_rpow {ε : ℝ} (hε : 0 < ε) : + ∃ N : ℕ, ∀ n : ℕ, N ≤ n → (n.divisors.card : ℝ) ≤ (n : ℝ) ^ ε := + eventually_atTop.mp (eventually_card_divisors_le_rpow hε) + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean new file mode 100644 index 0000000000..3debf26980 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean @@ -0,0 +1,143 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound + +/-! +# An explicit divisor-counting bound + +The asymptotic divisor bound used by the original assembly hides a threshold in a +little-oh argument. This file keeps the same elementary factorization proof but +uses a concrete polynomial-versus-exponential estimate. Its specialization at +`k = 32` is the numerical input for explicit strong approximation. +-/ + +namespace BGS.NumberTheory + +open scoped BigOperators + +/-- A completely explicit replacement for the polynomial-versus-exponential +constant in `DivisorBound.lean`. -/ +theorem pow_succ_le_self_pow_mul_two_pow + (k : ℕ) (hk : 0 < k) (a : ℕ) : + (a + 1) ^ k ≤ k ^ k * 2 ^ a := by + let q := a / k + have haq : a + 1 ≤ k * (q + 1) := by + exact Nat.succ_le_of_lt (by + simpa [q, Nat.mul_comm] using Nat.lt_mul_div_succ a hk) + have hq : q + 1 ≤ 2 ^ q := Nat.succ_le_of_lt q.lt_two_pow_self + calc + (a + 1) ^ k ≤ (k * (q + 1)) ^ k := Nat.pow_le_pow_left haq _ + _ = k ^ k * (q + 1) ^ k := by rw [mul_pow] + _ ≤ k ^ k * (2 ^ q) ^ k := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hq _) + _ = k ^ k * 2 ^ (q * k) := by rw [pow_mul] + _ ≤ k ^ k * 2 ^ a := Nat.mul_le_mul_left _ <| + Nat.pow_le_pow_right (by norm_num) (Nat.div_mul_le_self a k) + +/-- Explicit factorization bound for the divisor-counting function. -/ +theorem card_divisors_pow_le_explicit_constant_mul + (k : ℕ) (hk : 0 < k) (n : ℕ) (hn : n ≠ 0) : + n.divisors.card ^ k ≤ (k ^ k) ^ (2 ^ k) * n := by + let D := k ^ k + have hD : 0 < D := pow_pos hk _ + have hfactor : ∀ p ∈ n.primeFactors, + (n.factorization p + 1) ^ k ≤ + (if p < 2 ^ k then D else 1) * p ^ n.factorization p := by + intro p hp + have hpPrime := Nat.prime_of_mem_primeFactors hp + have hpTwo : 2 ≤ p := hpPrime.two_le + have haPos : 0 < n.factorization p := + hpPrime.factorization_pos_of_dvd hn (Nat.dvd_of_mem_primeFactors hp) + by_cases hpSmall : p < 2 ^ k + · rw [if_pos hpSmall] + exact (pow_succ_le_self_pow_mul_two_pow k hk (n.factorization p)).trans <| + Nat.mul_le_mul_left D (Nat.pow_le_pow_left hpTwo _) + · rw [if_neg hpSmall, one_mul] + have hsucc : n.factorization p + 1 ≤ 2 ^ n.factorization p := + Nat.succ_le_of_lt (n.factorization p).lt_two_pow_self + calc + (n.factorization p + 1) ^ k ≤ (2 ^ n.factorization p) ^ k := + Nat.pow_le_pow_left hsucc k + _ = (2 ^ k) ^ n.factorization p := by + rw [← pow_mul, ← pow_mul, Nat.mul_comm] + _ ≤ p ^ n.factorization p := + Nat.pow_le_pow_left (le_of_not_gt hpSmall) _ + have hsmallCard : + (n.primeFactors.filter fun p => p < 2 ^ k).card ≤ 2 ^ k := by + calc + (n.primeFactors.filter fun p => p < 2 ^ k).card ≤ + (Finset.range (2 ^ k)).card := + Finset.card_le_card (by + intro p hp + exact Finset.mem_range.mpr (Finset.mem_filter.mp hp).2) + _ = 2 ^ k := Finset.card_range _ + rw [Nat.card_divisors hn, ← Finset.prod_pow] + calc + (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ k) ≤ + ∏ p ∈ n.primeFactors, + ((if p < 2 ^ k then D else 1) * p ^ n.factorization p) := + Finset.prod_le_prod (fun _ _ => Nat.zero_le _) hfactor + _ = D ^ (n.primeFactors.filter fun p => p < 2 ^ k).card * n := by + rw [Finset.prod_mul_distrib, ← Nat.prod_primeFactors_pow_factorization hn] + simp [Finset.prod_ite] + _ ≤ D ^ (2 ^ k) * n := by + exact Nat.mul_le_mul_right n (Nat.pow_le_pow_right hD hsmallCard) + _ = (k ^ k) ^ (2 ^ k) * n := by rfl + +/-- Sealed data for the closed factorization constant. The subtype equation +lets downstream proofs rewrite the value without asking the kernel to +repeatedly normalize its enormous exponentiation. -/ +opaque explicitDivisorConstantData : + {n : ℕ // n = (32 ^ 32) ^ (2 ^ 32)} := + ⟨(32 ^ 32) ^ (2 ^ 32), rfl⟩ + +/-- The closed factorization constant used by the explicit Markoff proof. -/ +def explicitDivisorConstant : ℕ := explicitDivisorConstantData.1 + +theorem explicitDivisorConstant_eq : + explicitDivisorConstant = (32 ^ 32) ^ (2 ^ 32) := + explicitDivisorConstantData.2 + +theorem explicitDivisorConstant_pos : 0 < explicitDivisorConstant := by + rw [explicitDivisorConstant_eq] + exact pow_pos (pow_pos (by norm_num) _) _ + +theorem explicitDivisorConstant_le_pow_thirtyTwo : + explicitDivisorConstant ≤ explicitDivisorConstant ^ 32 := by + have hOne : 1 ≤ explicitDivisorConstant := explicitDivisorConstant_pos + simpa only [pow_one] using + (pow_le_pow_right₀ hOne (show (1 : ℕ) ≤ 32 by norm_num)) + +/-- Above the concrete constant, the divisor count is bounded by the +sixteenth root. -/ +theorem card_divisors_le_rpow_one_div_sixteen + (n : ℕ) (hn : explicitDivisorConstant ≤ n) : + (n.divisors.card : ℝ) ≤ (n : ℝ) ^ (1 / 16 : ℝ) := by + have hnPos : 0 < n := explicitDivisorConstant_pos.trans_le hn + have hNatural := card_divisors_pow_le_explicit_constant_mul + 32 (by norm_num) n hnPos.ne' + have hNatural' : n.divisors.card ^ 32 ≤ n ^ 2 := by + calc + n.divisors.card ^ 32 ≤ explicitDivisorConstant * n := by + rw [explicitDivisorConstant_eq] + exact hNatural + _ ≤ n * n := Nat.mul_le_mul_right n hn + _ = n ^ 2 := by ring + have hCast : (n.divisors.card : ℝ) ^ 32 ≤ (n : ℝ) ^ 2 := by + exact_mod_cast hNatural' + have hnNonnegative : (0 : ℝ) ≤ n := by positivity + have hPowers : (n.divisors.card : ℝ) ^ 32 ≤ + ((n : ℝ) ^ (1 / 16 : ℝ)) ^ 32 := by + calc + (n.divisors.card : ℝ) ^ 32 ≤ (n : ℝ) ^ 2 := hCast + _ = (n : ℝ) ^ ((1 / 16 : ℝ) * 32) := by norm_num + _ = ((n : ℝ) ^ (1 / 16 : ℝ)) ^ 32 := + Real.rpow_mul_natCast hnNonnegative (1 / 16 : ℝ) 32 + exact le_of_pow_le_pow_left₀ (by norm_num : (32 : ℕ) ≠ 0) + (Real.rpow_nonneg hnNonnegative _) hPowers + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean new file mode 100644 index 0000000000..b0c698beeb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean @@ -0,0 +1,66 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds + +/-! +# Exact certificate at the paper's terminal obstruction + +The published maximal-divisor computation stops at the reduced integer + +`(863#)(53#)(13#)(7#)(5#) 3^3 2^5`. + +Its central divisor-lattice coefficient is the paper's exact value +`C₉₃(n)`. The paper treats the two neighboring maximal-divisor counts +independently and therefore uses the square envelope `4 C^2`. The joint +`p - 1`, `p + 1` moment instead supplies `C^2 + 3J`, where the displayed +integer `J` is an exact tenth-root upper certificate. + +All comparisons below are closed integer computations checked by Lean. +-/ + +namespace BGS.NumberTheory + +/-- The reduced integer responsible for the published cutoff. -/ +def publishedTerminalReducedInteger : ℕ := + 344804838267768169319048795913558858218204726396462226085672206158143793783042367351629064411158183411576729661579236952954769470091851501268371488892117339245604283407662126578103043374612406105548170775523572783919769072224460076452087116657499868482554599063664473247688943813839202042578341146702180498643671937922409423337669168695270728922856540751624236363557097567988640618308214400000 + +/-- The exact value `C₉₃(n)` reported in the paper. -/ +def publishedTerminalCentralCoefficient : ℕ := + 3013671869689423302959704266406116383317724743440 + +/-- A tenth-root upper certificate for the joint neighboring divisor count. -/ +def publishedTerminalJointProductEnvelope : ℕ := + 183901584895411967004110876962572064564281061869576148842985488012286272296193902480021778244 + +/-- The new squared-sum envelope `C^2 + 3J`. -/ +def publishedTerminalJointSquareEnvelope : ℕ := + publishedTerminalCentralCoefficient ^ 2 + + 3 * publishedTerminalJointProductEnvelope + +/-- The displayed `J` really dominates the joint tenth-moment radicand. +The slightly looser `(n + 1)^2` form avoids any hidden square-root rounding. -/ +theorem publishedTerminalJointProductEnvelope_certificate : + 2 ^ 457 * (publishedTerminalReducedInteger + 1) ^ 2 ≤ + publishedTerminalJointProductEnvelope ^ 10 := by + native_decide + +/-- The new envelope makes the paper's first-interval obstruction empty at +the exact reduced integer that caused the published algorithm to stop. -/ +theorem publishedTerminalJointSquareEnvelope_succeeds : + 3 ^ 8 * publishedTerminalJointSquareEnvelope ^ 4 ≤ + 32 * (publishedTerminalReducedInteger + 2) := by + native_decide + +/-- In contrast, the paper's independent envelope `4C^2` fails at this same +integer. This records that the improvement is structural, not a re-rounding +of the published computation. -/ +theorem publishedTerminalIndependentSquareEnvelope_fails : + 32 * (publishedTerminalReducedInteger + 2) < + 3 ^ 8 * (4 * publishedTerminalCentralCoefficient ^ 2) ^ 4 := by + native_decide + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean new file mode 100644 index 0000000000..5316f153f5 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean @@ -0,0 +1,71 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate + +/-! +# Arithmetic core of the joint maximal-divisor algorithm + +The paper's independent `2C` estimate is replaced by a certified square +envelope `M^2 ≤ S`. This removes square roots and division from both the +connectivity test and the rank-refinement bound. +-/ + +namespace BGS.NumberTheory + +/-- A paper-style first-interval witness forces failure of the joint square +test. -/ +theorem jointSquareEnvelope_failure_of_firstInterval + {p n M S : ℕ} + (hn : n + 2 ≤ 4 * p) + (hfirst : 128 * p < (3 * M) ^ 8) + (hSquare : M ^ 2 ≤ S) : + 32 * (n + 2) < 3 ^ 8 * S ^ 4 := by + calc + 32 * (n + 2) ≤ 32 * (4 * p) := Nat.mul_le_mul_left 32 hn + _ = 128 * p := by ring + _ < (3 * M) ^ 8 := hfirst + _ = 3 ^ 8 * (M ^ 2) ^ 4 := by ring + _ ≤ 3 ^ 8 * S ^ 4 := by + gcongr + +/-- The joint envelope shrinks the divisor range in the rank-refinement +step from the paper's `162 C^3` to the root-free bound `81 C S / 2`. -/ +theorem jointRankRefinement_of_firstInterval + {d M C S : ℕ} + (hfirst : 4 * d < 81 * M ^ 3) + (hLinear : M ≤ 2 * C) + (hSquare : M ^ 2 ≤ S) : + 2 * d < 81 * C * S := by + have hCube : M ^ 3 ≤ 2 * C * S := by + calc + M ^ 3 = M * M ^ 2 := by ring + _ ≤ (2 * C) * S := Nat.mul_le_mul hLinear hSquare + _ = 2 * C * S := rfl + have hscaled : 4 * d < 81 * (2 * C * S) := + hfirst.trans_le (Nat.mul_le_mul_left 81 hCube) + by_contra hnot + have hreverse : 81 * C * S ≤ 2 * d := Nat.le_of_not_gt hnot + have hdouble : 81 * (2 * C * S) ≤ 4 * d := by + calc + 81 * (2 * C * S) = 2 * (81 * C * S) := by ring + _ ≤ 2 * (2 * d) := Nat.mul_le_mul_left 2 hreverse + _ = 4 * d := by ring + exact (Nat.not_le_of_lt hscaled) hdouble + +/-- If the joint square test succeeds, no first-interval witness can +exist. -/ +theorem no_firstInterval_of_jointSquareEnvelope + {p n M S : ℕ} + (hn : n + 2 ≤ 4 * p) + (hSquare : M ^ 2 ≤ S) + (hpasses : 3 ^ 8 * S ^ 4 ≤ 32 * (n + 2)) : + ¬ 128 * p < (3 * M) ^ 8 := by + intro hfirst + exact (not_lt_of_ge hpasses) + (jointSquareEnvelope_failure_of_firstInterval hn hfirst hSquare) + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean new file mode 100644 index 0000000000..a1a52bf1fb --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +import Mathlib.NumberTheory.ArithmeticFunction.Misc + +/-! +# Joint divisor bounds for neighboring even integers + +For an odd natural number `p`, the two torus orders `p - 1` and `p + 1` +have gcd exactly two. Consequently their divisor counts are not independent: + +`τ(p - 1) τ(p + 1) = 2 τ((p^2 - 1) / 2)`. + +Combining this identity with the elementary tenth-moment divisor bound gives +a joint estimate with one copy, rather than two copies, of the prime-factor +penalty. This is the arithmetic input for improving the maximal-divisor +cutoff. +-/ + +namespace BGS.NumberTheory + +private theorem card_divisors_two_mul_of_odd {n : ℕ} (hn : Odd n) : + (2 * n).divisors.card = 2 * n.divisors.card := by + have htwo : (2 : ℕ).divisors.card = 2 := by decide + rw [hn.coprime_two_left.card_divisors_mul] + rw [htwo] + +/-- Exact joint divisor-count identity for the neighboring torus orders. -/ +theorem card_divisors_pred_mul_card_divisors_succ_of_odd + {p : ℕ} (hp : Odd p) : + (p - 1).divisors.card * (p + 1).divisors.card = + 2 * (((p ^ 2 - 1) / 2).divisors.card) := by + rcases hp with ⟨k, rfl⟩ + have hcore : + (((2 * k + 1) ^ 2 - 1) / 2) = 2 * k * (k + 1) := by + have hsquare : + (2 * k + 1) ^ 2 = 2 * (2 * k * (k + 1)) + 1 := by ring + rw [hsquare] + omega + have hconsecutive : k.Coprime (k + 1) := by + rw [Nat.coprime_self_add_right] + exact Nat.coprime_one_right k + have hpred : 2 * k + 1 - 1 = 2 * k := by omega + have hsucc : 2 * k + 1 + 1 = 2 * (k + 1) := by omega + rcases k.even_or_odd with hkEven | hkOdd + · have hkSuccOdd : Odd (k + 1) := hkEven.add_one + have hcoprime : (2 * k).Coprime (k + 1) := + hkSuccOdd.coprime_two_left.mul_left hconsecutive + have hmul := hcoprime.card_divisors_mul + have htwo := card_divisors_two_mul_of_odd hkSuccOdd + rw [hcore, hpred, hsucc] + rw [htwo, hmul] + ring + · have hcoprime : k.Coprime (2 * (k + 1)) := + hkOdd.coprime_two_right.mul_right hconsecutive + have hmul := hcoprime.card_divisors_mul + have htwo := card_divisors_two_mul_of_odd hkOdd + have hfactor : 2 * k * (k + 1) = k * (2 * (k + 1)) := by ring + rw [hcore, hpred, hsucc, hfactor] + rw [htwo, hmul] + ring + +/-- The product of the two neighboring divisor counts has a single +prime-penalty factor in its tenth moment. -/ +theorem card_divisors_pred_mul_card_divisors_succ_pow_ten_le + {p : ℕ} (hp : Odd p) (hpTwo : 2 < p) : + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 10 ≤ + 2 ^ 456 * (p ^ 2 - 1) := by + let core := (p ^ 2 - 1) / 2 + have hpSq : 9 ≤ p ^ 2 := by nlinarith + have hcorePos : 0 < core := by + apply Nat.div_pos + · omega + · norm_num + have hmoment := + card_divisors_pow_ten_le_preliminary_constant_mul core hcorePos.ne' + have htwiceCore : 2 * core = p ^ 2 - 1 := by + rcases hp with ⟨k, rfl⟩ + dsimp [core] + have hsquare : (2 * k + 1) ^ 2 = 2 * (2 * k * (k + 1)) + 1 := by ring + rw [hsquare] + omega + have hexponent : 10 + 447 = 456 + 1 := by norm_num + calc + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 10 = + (2 * core.divisors.card) ^ 10 := by + rw [card_divisors_pred_mul_card_divisors_succ_of_odd hp] + _ = 2 ^ 10 * core.divisors.card ^ 10 := by rw [mul_pow] + _ ≤ 2 ^ 10 * (2 ^ 447 * core) := Nat.mul_le_mul_left _ hmoment + _ = (2 ^ 10 * 2 ^ 447) * core := (Nat.mul_assoc _ _ _).symm + _ = 2 ^ (10 + 447) * core := by rw [pow_add] + _ = 2 ^ (456 + 1) * core := by rw [hexponent] + _ = (2 ^ 456 * 2) * core := by rw [pow_succ] + _ = 2 ^ 456 * (2 * core) := Nat.mul_assoc _ _ _ + _ = 2 ^ 456 * (p ^ 2 - 1) := by rw [htwiceCore] + +/-- Joint tenth-moment constant for the sum of the neighboring divisor counts. +The leading term is the one-number prime penalty; the smaller correction pays +for the transition between the balanced and dominant cases. -/ +def neighboringDivisorSumMomentConstant : Nat := + 2 ^ 447 + 2 ^ 429 + +/-- Split point used to combine the product moment with the two individual +moments. It is chosen so that both resulting integer inequalities hold. -/ +theorem neighboringDivisorSumMomentConstant_eq : + neighboringDivisorSumMomentConstant = 2 ^ 429 * 262145 := by + rw [neighboringDivisorSumMomentConstant, + show (447 : Nat) = 429 + 18 by norm_num, pow_add] + norm_num + ring + +private def neighboringDivisorSumSplit : Nat := + 3913424 + +private theorem neighboringDivisorSum_balanced_constant : + (neighboringDivisorSumSplit + 1) ^ 10 * 2 ^ 228 ≤ + neighboringDivisorSumMomentConstant := by + norm_num [neighboringDivisorSumSplit, neighboringDivisorSumMomentConstant] + +private theorem neighboringDivisorSum_dominant_constant + {p : Nat} (hp : 794039 ≤ p) : + (neighboringDivisorSumSplit + 1) ^ 10 * 2 ^ 447 * (p + 1) ≤ + neighboringDivisorSumSplit ^ 10 * + neighboringDivisorSumMomentConstant * p := by + norm_num [neighboringDivisorSumSplit, neighboringDivisorSumMomentConstant] at * + omega + +/-- Square-root form of the joint product moment. -/ +theorem card_divisors_pred_mul_card_divisors_succ_pow_five_le + {p : Nat} (hp : Odd p) (hpTwo : 2 < p) : + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 5 ≤ + 2 ^ 228 * p := by + apply (Nat.pow_le_pow_iff_left (by norm_num : 2 ≠ 0)).mp + calc + (((p - 1).divisors.card * (p + 1).divisors.card) ^ 5) ^ 2 = + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 10 := by ring + _ ≤ 2 ^ 456 * (p ^ 2 - 1) := + card_divisors_pred_mul_card_divisors_succ_pow_ten_le hp hpTwo + _ ≤ 2 ^ 456 * p ^ 2 := by + gcongr + omega + _ = (2 ^ 228 * p) ^ 2 := by + rw [show (456 : Nat) = 228 * 2 by norm_num, pow_mul] + ring + +private theorem nat_le_of_pos_mul_le_mul_left + {c x y : Nat} (hc : 0 < c) (h : c * x ≤ c * y) : + x ≤ y := + Nat.le_of_mul_le_mul_left h hc + +/-- A joint tenth moment for the sum of the neighboring divisor counts. + +The usual power-of-a-sum inequality loses a factor of (2^9). Here comparable +counts are controlled by the product moment, while in the dominant case the +larger individual count controls the sum. -/ +theorem card_divisors_pred_add_card_divisors_succ_pow_ten_le + {p : Nat} (hp : Odd p) (hpLarge : 794039 ≤ p) : + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 10 ≤ + neighboringDivisorSumMomentConstant * p := by + let a := (p - 1).divisors.card + let b := (p + 1).divisors.card + let R := neighboringDivisorSumSplit + let K := 2 ^ 447 + let D := neighboringDivisorSumMomentConstant + have hpTwo : 2 < p := by omega + have hminus : a ^ 10 ≤ K * (p - 1) := by + simpa [a, K] using + card_divisors_pow_ten_le_preliminary_constant_mul (p - 1) (by omega) + have hplus : b ^ 10 ≤ K * (p + 1) := by + simpa [b, K] using + card_divisors_pow_ten_le_preliminary_constant_mul (p + 1) (by omega) + have hminusCommon : a ^ 10 ≤ K * (p + 1) := + hminus.trans (Nat.mul_le_mul_left K (by omega)) + have hproductFive : (a * b) ^ 5 ≤ 2 ^ 228 * p := by + simpa [a, b] using + card_divisors_pred_mul_card_divisors_succ_pow_five_le hp hpTwo + have hbalanced : (R + 1) ^ 10 * 2 ^ 228 ≤ D := by + simpa [R, D] using neighboringDivisorSum_balanced_constant + have hRPos : 0 < R := by norm_num [R, neighboringDivisorSumSplit] + have hRpowPos : 0 < R ^ 10 := pow_pos hRPos 10 + have hdominant : + (R + 1) ^ 10 * K * (p + 1) ≤ R ^ 10 * D * p := by + simpa [R, K, D] using neighboringDivisorSum_dominant_constant hpLarge + rcases le_total a b with hab | hba + · by_cases hfar : R * a ≤ b + · have hlinear : R * (a + b) ≤ (R + 1) * b := by + calc + R * (a + b) = R * a + R * b := by ring + _ ≤ b + R * b := Nat.add_le_add_right hfar _ + _ = (R + 1) * b := by ring + have hpow := Nat.pow_le_pow_left hlinear 10 + have hscaled : R ^ 10 * (a + b) ^ 10 ≤ R ^ 10 * (D * p) := by + calc + R ^ 10 * (a + b) ^ 10 = (R * (a + b)) ^ 10 := by ring + _ ≤ ((R + 1) * b) ^ 10 := hpow + _ = (R + 1) ^ 10 * b ^ 10 := by ring + _ ≤ (R + 1) ^ 10 * (K * (p + 1)) := + Nat.mul_le_mul_left _ hplus + _ = (R + 1) ^ 10 * K * (p + 1) := by ring + _ ≤ R ^ 10 * (D * p) := by + simpa only [Nat.mul_assoc] using hdominant + exact nat_le_of_pos_mul_le_mul_left + (c := R ^ 10) (x := (a + b) ^ 10) (y := D * p) + hRpowPos hscaled + · have hnear : b ≤ R * a := by omega + have hlinear : a + b ≤ (R + 1) * a := by + calc + a + b ≤ a + R * a := Nat.add_le_add_left hnear _ + _ = (R + 1) * a := by ring + have haa : a * a ≤ a * b := Nat.mul_le_mul_left a hab + calc + (a + b) ^ 10 ≤ ((R + 1) * a) ^ 10 := + Nat.pow_le_pow_left hlinear 10 + _ = (R + 1) ^ 10 * (a * a) ^ 5 := by ring + _ ≤ (R + 1) ^ 10 * (a * b) ^ 5 := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left haa 5) + _ ≤ (R + 1) ^ 10 * (2 ^ 228 * p) := + Nat.mul_le_mul_left _ hproductFive + _ = ((R + 1) ^ 10 * 2 ^ 228) * p := by ring + _ ≤ D * p := Nat.mul_le_mul_right p hbalanced + · by_cases hfar : R * b ≤ a + · have hlinear : R * (a + b) ≤ (R + 1) * a := by + calc + R * (a + b) = R * a + R * b := by ring + _ = R * b + R * a := by ring + _ ≤ a + R * a := Nat.add_le_add_right hfar _ + _ = (R + 1) * a := by ring + have hpow := Nat.pow_le_pow_left hlinear 10 + have hscaled : R ^ 10 * (a + b) ^ 10 ≤ R ^ 10 * (D * p) := by + calc + R ^ 10 * (a + b) ^ 10 = (R * (a + b)) ^ 10 := by ring + _ ≤ ((R + 1) * a) ^ 10 := hpow + _ = (R + 1) ^ 10 * a ^ 10 := by ring + _ ≤ (R + 1) ^ 10 * (K * (p + 1)) := + Nat.mul_le_mul_left _ hminusCommon + _ = (R + 1) ^ 10 * K * (p + 1) := by ring + _ ≤ R ^ 10 * (D * p) := by + simpa only [Nat.mul_assoc] using hdominant + exact nat_le_of_pos_mul_le_mul_left + (c := R ^ 10) (x := (a + b) ^ 10) (y := D * p) + hRpowPos hscaled + · have hnear : a ≤ R * b := by omega + have hlinear : a + b ≤ (R + 1) * b := by + calc + a + b ≤ R * b + b := Nat.add_le_add_right hnear _ + _ = (R + 1) * b := by ring + have hbb : b * b ≤ a * b := by + simpa [Nat.mul_comm] using Nat.mul_le_mul_left b hba + calc + (a + b) ^ 10 ≤ ((R + 1) * b) ^ 10 := + Nat.pow_le_pow_left hlinear 10 + _ = (R + 1) ^ 10 * (b * b) ^ 5 := by ring + _ ≤ (R + 1) ^ 10 * (a * b) ^ 5 := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hbb 5) + _ ≤ (R + 1) ^ 10 * (2 ^ 228 * p) := + Nat.mul_le_mul_left _ hproductFive + _ = ((R + 1) ^ 10 * 2 ^ 228) * p := by ring + _ ≤ D * p := Nat.mul_le_mul_right p hbalanced + +/-- If two nonnegative counts are individually at most `C` and their product +is at most `J`, their squared sum is bounded by `C^2 + 3J`. This is the +elementary inequality that replaces the paper's independent `4C^2` bound. -/ +theorem add_sq_le_sq_add_three_mul_of_le_of_mul_le + {a b C J : ℕ} (ha : a ≤ C) (hb : b ≤ C) (hab : a * b ≤ J) : + (a + b) ^ 2 ≤ C ^ 2 + 3 * J := by + rcases le_total a b with habOrder | hbaOrder + · have haSq : a * a ≤ a * b := Nat.mul_le_mul_left a habOrder + have hbSq : b * b ≤ C * C := Nat.mul_le_mul hb hb + nlinarith [hab] + · have hbSq : b * b ≤ a * b := by + simpa [Nat.mul_comm] using Nat.mul_le_mul_left b hbaOrder + have haSq : a * a ≤ C * C := Nat.mul_le_mul ha ha + nlinarith [hab] + +/-- Convert a certified tenth-moment envelope into the joint squared-sum +bound used by the improved maximal-divisor algorithm. -/ +theorem add_sq_le_sq_add_three_mul_of_pow_ten_envelope + {a b C J K : ℕ} + (ha : a ≤ C) (hb : b ≤ C) + (hmoment : (a * b) ^ 10 ≤ K) (henvelope : K ≤ J ^ 10) : + (a + b) ^ 2 ≤ C ^ 2 + 3 * J := by + apply add_sq_le_sq_add_three_mul_of_le_of_mul_le ha hb + apply (Nat.pow_le_pow_iff_left (by norm_num : 10 ≠ 0)).mp + exact hmoment.trans henvelope + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean new file mode 100644 index 0000000000..fa60caf031 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean @@ -0,0 +1,168 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +import Mathlib.GroupTheory.SpecificGroups.Cyclic.Basic + +/-! +# Maximal-divisor bounds + +This file proves the finite-poset cover behind the paper's maximal-divisor +improvement and combines it with the new joint `p - 1`, `p + 1` estimate. +-/ + +namespace BGS.NumberTheory + +/-- Divisors of `n` maximal under divisibility among those strictly below +`bound`. -/ +def maximalDivisorsBelow (n bound : ℕ) : Finset ℕ := + n.divisors.filter fun d => + d < bound ∧ + ∀ e ∈ n.divisors, e < bound → d ∣ e → e = d + +@[simp] +theorem mem_maximalDivisorsBelow_iff + {n bound d : ℕ} : + d ∈ maximalDivisorsBelow n bound ↔ + d ∈ n.divisors ∧ d < bound ∧ + ∀ e ∈ n.divisors, e < bound → d ∣ e → e = d := by + simp [maximalDivisorsBelow] + +theorem maximalDivisorsBelow_subset_divisors (n bound : ℕ) : + maximalDivisorsBelow n bound ⊆ n.divisors := by + intro d hd + exact (mem_maximalDivisorsBelow_iff.mp hd).1 + +theorem maximalDivisorsBelow_card_le_card_divisors (n bound : ℕ) : + (maximalDivisorsBelow n bound).card ≤ n.divisors.card := + Finset.card_le_card (maximalDivisorsBelow_subset_divisors n bound) + +/-- Every divisor below the cutoff divides a maximal divisor below it. -/ +theorem exists_dvd_maximalDivisorBelow + {n bound d : ℕ} (hn : n ≠ 0) (hdn : d ∣ n) (hdbound : d < bound) : + ∃ m ∈ maximalDivisorsBelow n bound, d ∣ m := by + let candidates := n.divisors.filter fun m => m < bound ∧ d ∣ m + have hdmem : d ∈ n.divisors := Nat.mem_divisors.mpr ⟨hdn, hn⟩ + have hnonempty : candidates.Nonempty := by + refine ⟨d, ?_⟩ + simp [candidates, hdmem, hdbound] + let m := candidates.max' hnonempty + have hmmem : m ∈ candidates := Finset.max'_mem candidates hnonempty + have hmdata : m ∈ n.divisors ∧ m < bound ∧ d ∣ m := by + simpa [candidates] using hmmem + refine ⟨m, ?_, hmdata.2.2⟩ + rw [mem_maximalDivisorsBelow_iff] + refine ⟨hmdata.1, hmdata.2.1, ?_⟩ + intro e hediv hebound hme + have hde : d ∣ e := hmdata.2.2.trans hme + have hemem : e ∈ candidates := by + simp only [candidates, Finset.mem_filter] + exact ⟨hediv, hebound, hde⟩ + have hem : e ≤ m := Finset.le_max' candidates e hemem + have hepos : 0 < e := + Nat.pos_of_dvd_of_pos (Nat.mem_divisors.mp hediv).1 (Nat.pos_of_ne_zero hn) + have hme' : m ≤ e := Nat.le_of_dvd hepos hme + exact Nat.le_antisymm hem hme' + +section CyclicCover + +variable (G : Type*) [Group G] [Fintype G] [DecidableEq G] + +/-- Elements killed by the `m`-th power map. -/ +def elementsWithPowOne (m : ℕ) : Finset G := + Finset.univ.filter fun g => g ^ m = 1 + +@[simp] +theorem mem_elementsWithPowOne_iff {m : ℕ} {g : G} : + g ∈ elementsWithPowOne G m ↔ g ^ m = 1 := by + simp [elementsWithPowOne] + +/-- Low-order elements in a cyclic group are covered by roots-of-unity sets +indexed by maximal divisors. -/ +theorem elementsOfOrderLessThan_subset_maximalDivisorCover + [IsCyclic G] (bound : ℕ) : + (Finset.univ.filter fun g : G => orderOf g < bound) ⊆ + (maximalDivisorsBelow (Fintype.card G) bound).biUnion + (elementsWithPowOne G) := by + intro g hg + have hgorder : orderOf g < bound := (Finset.mem_filter.mp hg).2 + obtain ⟨m, hmmax, horderDvd⟩ := + exists_dvd_maximalDivisorBelow Fintype.card_ne_zero orderOf_dvd_card hgorder + rw [Finset.mem_biUnion] + refine ⟨m, hmmax, ?_⟩ + rw [mem_elementsWithPowOne_iff] + exact orderOf_dvd_iff_pow_eq_one.mp horderDvd + +/-- The cyclic low-order count using only maximal divisors. -/ +theorem elementsOfOrderLessThan_card_le_maximalDivisors + [IsCyclic G] (bound : ℕ) : + (Finset.univ.filter fun g : G => orderOf g < bound).card ≤ + (bound - 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := by + calc + (Finset.univ.filter fun g : G => orderOf g < bound).card ≤ + ((maximalDivisorsBelow (Fintype.card G) bound).biUnion + (elementsWithPowOne G)).card := + Finset.card_le_card + (elementsOfOrderLessThan_subset_maximalDivisorCover G bound) + _ ≤ (maximalDivisorsBelow (Fintype.card G) bound).card * + (bound - 1) := by + apply Finset.card_biUnion_le_card_mul + intro m hm + have hmLt : m < bound := + (mem_maximalDivisorsBelow_iff.mp hm).2.1 + have hmPos : 0 < m := by + have hmDvd : m ∣ Fintype.card G := + (Nat.mem_divisors.mp + (mem_maximalDivisorsBelow_iff.mp hm).1).1 + exact Nat.pos_of_dvd_of_pos hmDvd Fintype.card_pos + calc + (elementsWithPowOne G m).card ≤ m := + IsCyclic.card_pow_eq_one_le hmPos + _ ≤ bound - 1 := Nat.le_sub_one_of_lt hmLt + _ = (bound - 1) * + (maximalDivisorsBelow (Fintype.card G) bound).card := + Nat.mul_comm _ _ + +end CyclicCover + +/-- The two maximal-divisor counts inherit the exact joint tenth moment. -/ +theorem maximalDivisorCounts_product_pow_ten_le + {p bound : ℕ} (hp : Odd p) (hpTwo : 2 < p) : + ((maximalDivisorsBelow (p - 1) bound).card * + (maximalDivisorsBelow (p + 1) bound).card) ^ 10 ≤ + 2 ^ 457 * (p ^ 2 - 1) := by + have hminus : + (maximalDivisorsBelow (p - 1) bound).card ≤ + (p - 1).divisors.card := + maximalDivisorsBelow_card_le_card_divisors _ _ + have hplus : + (maximalDivisorsBelow (p + 1) bound).card ≤ + (p + 1).divisors.card := + maximalDivisorsBelow_card_le_card_divisors _ _ + calc + ((maximalDivisorsBelow (p - 1) bound).card * + (maximalDivisorsBelow (p + 1) bound).card) ^ 10 ≤ + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 10 := + Nat.pow_le_pow_left (Nat.mul_le_mul hminus hplus) 10 + _ ≤ 2 ^ 456 * (p ^ 2 - 1) := + card_divisors_pred_mul_card_divisors_succ_pow_ten_le hp hpTwo + _ ≤ 2 ^ 457 * (p ^ 2 - 1) := by gcongr <;> norm_num + +/-- The new square envelope for the sum of the two maximal-divisor counts. -/ +theorem maximalDivisorCounts_add_sq_le + {p bound C J : ℕ} + (hminus : (maximalDivisorsBelow (p - 1) bound).card ≤ C) + (hplus : (maximalDivisorsBelow (p + 1) bound).card ≤ C) + (hproduct : + (maximalDivisorsBelow (p - 1) bound).card * + (maximalDivisorsBelow (p + 1) bound).card ≤ J) : + ((maximalDivisorsBelow (p - 1) bound).card + + (maximalDivisorsBelow (p + 1) bound).card) ^ 2 ≤ + C ^ 2 + 3 * J := + add_sq_le_sq_add_three_mul_of_le_of_mul_le hminus hplus hproduct + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean new file mode 100644 index 0000000000..21d9abc6e1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean @@ -0,0 +1,60 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion + +/-! +# Arithmetic criterion for the nonparabolic complement route + +The complement count supplies `8 * p ≤ (d * M) ^ 2`. The exact +Euler-characteristic coefficient anticipated by the strengthened +Corvaja--Zannier step gives `d ≤ 189 * M ^ 3`. Eliminating `d` yields the +integer obstruction `8 * p ≤ 189 ^ 2 * M ^ 8`. + +A root-free square envelope `M ^ 2 ≤ S` then gives +`8 * p ≤ 35721 * S ^ 4`. +-/ + +namespace BGS.NumberTheory + +/-- Eliminate the maximal order `d` from the nonparabolic complement count +using the exact coefficient `189`. -/ +theorem eight_mul_le_189_sq_mul_eighth_of_le_square_of_le_189_mul_cube + {p d M : ℕ} + (hcount : 8 * p ≤ (d * M) ^ 2) + (hdegree : d ≤ 189 * M ^ 3) : + 8 * p ≤ 189 ^ 2 * M ^ 8 := by + calc + 8 * p ≤ (d * M) ^ 2 := hcount + _ ≤ ((189 * M ^ 3) * M) ^ 2 := by + gcongr + _ = 189 ^ 2 * M ^ 8 := by ring + +/-- Replace `M` by any certified square envelope `S`; `189^2 = 35721`. -/ +theorem eight_mul_le_35721_mul_fourth_of_le_189_sq_mul_eighth + {p M S : ℕ} + (hbad : 8 * p ≤ 189 ^ 2 * M ^ 8) + (hSquare : M ^ 2 ≤ S) : + 8 * p ≤ 35721 * S ^ 4 := by + calc + 8 * p ≤ 189 ^ 2 * M ^ 8 := hbad + _ = 35721 * (M ^ 2) ^ 4 := by ring + _ ≤ 35721 * S ^ 4 := by + gcongr + +/-- Combined root-free obstruction for the nonparabolic complement route. -/ +theorem eight_mul_le_35721_mul_fourth_of_count_degree_squareEnvelope + {p d M S : ℕ} + (hcount : 8 * p ≤ (d * M) ^ 2) + (hdegree : d ≤ 189 * M ^ 3) + (hSquare : M ^ 2 ≤ S) : + 8 * p ≤ 35721 * S ^ 4 := + eight_mul_le_35721_mul_fourth_of_le_189_sq_mul_eighth + (eight_mul_le_189_sq_mul_eighth_of_le_square_of_le_189_mul_cube + hcount hdegree) + hSquare + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean new file mode 100644 index 0000000000..2c48bb5d72 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean @@ -0,0 +1,321 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting + +/-! +# One-sided primitive extraction with witness multiplicities + +The cage fiber-product count has an arbitrary finite witness type on the left +and a cyclic multiplicative group on the right. This file performs Möbius +inversion without erasing the left witness. +-/ + +namespace BGS + +open scoped ArithmeticFunction.Moebius BigOperators + +noncomputable section + +variable {A H T : Type*} [CommGroup H] + +/-- Witness/parameter pairs satisfying a relation. -/ +noncomputable def rightTraceRelationPairs + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) : + Finset (A × H) := by + classical + letI := Fintype.ofFinite A + letI := Fintype.ofFinite H + exact Finset.univ.filter fun z => leftTrace z.1 = rightTrace z.2 + +/-- Relation pairs whose right parameter has exact multiplicative order. -/ +noncomputable def rightTraceExactOrderSolutions + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) + (order : ℕ) : Finset (A × H) := by + classical + exact (rightTraceRelationPairs leftTrace rightTrace).filter fun z => + orderOf z.2 = order + +/-- Relation pairs whose right parameter is killed by a specified power. -/ +noncomputable def rightTracePowerKernelSolutions + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) + (exponent : ℕ) : Finset (A × H) := by + classical + exact (rightTraceRelationPairs leftTrace rightTrace).filter fun z => + z.2 ^ exponent = 1 + +/-- Relation pairs with the right parameter restricted to a power-map image. -/ +def rightPowerTraceRangeSolutions + (leftTrace : A → T) (rightTrace : H → T) (exponent : ℕ) := + {z : A × (powMonoidHom exponent : H →* H).range // + leftTrace z.1 = rightTrace z.2} + +/-- The one-sided power cover before quotienting by the power-map fibers. -/ +def rightPowerTraceCoverSolutions + (leftTrace : A → T) (rightTrace : H → T) (exponent : ℕ) := + {z : A × H // leftTrace z.1 = rightTrace (z.2 ^ exponent)} + +/-- A one-sided cover point is a range solution together with a point in the +corresponding power-map fiber. -/ +def rightPowerTraceCoverEquivSigmaFiber + (leftTrace : A → T) (rightTrace : H → T) (exponent : ℕ) : + rightPowerTraceCoverSolutions leftTrace rightTrace exponent ≃ + Σ s : rightPowerTraceRangeSolutions leftTrace rightTrace exponent, + ((powMonoidHom exponent : H →* H) ⁻¹' {(s.1.2 : H)} : Set H) where + toFun z := + ⟨⟨(z.1.1, ⟨z.1.2 ^ exponent, ⟨z.1.2, by simp⟩⟩), z.2⟩, + ⟨z.1.2, by simp⟩⟩ + invFun z := ⟨(z.1.1.1, z.2.1), by + have hz : (powMonoidHom exponent : H →* H) z.2.1 = (z.1.1.2 : H) := z.2.2 + change leftTrace z.1.1.1 = rightTrace (z.2.1 ^ exponent) + rw [show z.2.1 ^ exponent = z.1.1.2 by exact hz] + exact z.1.2⟩ + left_inv z := by rfl + right_inv z := by + rcases z with ⟨⟨⟨a, ⟨u, huRange⟩⟩, htrace⟩, ⟨root, hroot⟩⟩ + simp only [Set.mem_preimage, Set.mem_singleton_iff] at hroot + dsimp at hroot ⊢ + subst u + rfl + +/-- Exact one-sided power-cover multiplicity. -/ +theorem natCard_rightPowerTraceCoverSolutions + [Finite A] [Finite H] + (leftTrace : A → T) (rightTrace : H → T) (exponent : ℕ) : + Nat.card (rightPowerTraceCoverSolutions leftTrace rightTrace exponent) = + Nat.card (powMonoidHom exponent : H →* H).ker * + Nat.card (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) := by + letI : Finite (powMonoidHom exponent : H →* H).range := + Finite.of_injective Subtype.val Subtype.val_injective + letI : Finite (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) := + Finite.of_injective Subtype.val Subtype.val_injective + letI := Fintype.ofFinite + (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) + rw [Nat.card_congr + (rightPowerTraceCoverEquivSigmaFiber leftTrace rightTrace exponent), + Nat.card_sigma] + simp_rw [BGS.Markoff.natCard_powerMapFiber_eq_ker] + simp [Nat.mul_comm] + +/-- For a divisor exponent in a finite cyclic group, the one-sided cover has +exactly `d` points above every power-range solution. -/ +theorem natCard_rightPowerTraceCoverSolutions_of_dvd + [Finite A] [Finite H] [IsCyclic H] + (leftTrace : A → T) (rightTrace : H → T) (d : ℕ) + (hd : d ∣ Nat.card H) : + Nat.card (rightPowerTraceCoverSolutions leftTrace rightTrace d) = + d * Nat.card (rightPowerTraceRangeSolutions leftTrace rightTrace d) := by + rw [natCard_rightPowerTraceCoverSolutions, + IsCyclic.card_powMonoidHom_ker, + Nat.gcd_eq_right_iff_dvd.mpr hd] + +@[simp] +theorem mem_rightTraceExactOrderSolutions_iff + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) + (order : ℕ) (z : A × H) : + z ∈ rightTraceExactOrderSolutions leftTrace rightTrace order ↔ + leftTrace z.1 = rightTrace z.2 ∧ orderOf z.2 = order := by + classical + simp [rightTraceExactOrderSolutions, rightTraceRelationPairs] + +@[simp] +theorem mem_rightTracePowerKernelSolutions_iff + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) + (exponent : ℕ) (z : A × H) : + z ∈ rightTracePowerKernelSolutions leftTrace rightTrace exponent ↔ + leftTrace z.1 = rightTrace z.2 ∧ z.2 ^ exponent = 1 := by + classical + simp [rightTracePowerKernelSolutions, rightTraceRelationPairs] + +/-- Exact-order classes partition the relation pairs killed by one power. -/ +theorem sum_rightTraceExactOrderSolutions_card_eq_powerKernel_card + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) + (m : ℕ) (hm : 0 < m) : + ∑ order ∈ m.divisors, + (rightTraceExactOrderSolutions leftTrace rightTrace order).card = + (rightTracePowerKernelSolutions leftTrace rightTrace m).card := by + classical + simp only [rightTraceExactOrderSolutions] + rw [Finset.sum_card_fiberwise_eq_card_filter] + apply congrArg Finset.card + ext z + simp [rightTracePowerKernelSolutions, Nat.mem_divisors, hm.ne', + orderOf_dvd_iff_pow_eq_one] + +/-- Möbius inversion recovers the witness-bearing exact-order count. -/ +theorem moebius_sum_rightTracePowerKernel_card_eq_exactOrder_card + [Finite A] [Finite H] (leftTrace : A → T) (rightTrace : H → T) + (n : ℕ) (hn : 0 < n) : + ∑ x ∈ n.divisorsAntidiagonal, + (μ x.fst : ℤ) * + (rightTracePowerKernelSolutions leftTrace rightTrace x.snd).card = + (rightTraceExactOrderSolutions leftTrace rightTrace n).card := by + have hinversion := + (ArithmeticFunction.sum_eq_iff_sum_mul_moebius_eq + (R := ℤ) + (f := fun order => + ((rightTraceExactOrderSolutions leftTrace rightTrace order).card : ℤ)) + (g := fun exponent => + ((rightTracePowerKernelSolutions leftTrace rightTrace exponent).card : ℤ))).mp + (fun m hm => by + exact_mod_cast + sum_rightTraceExactOrderSolutions_card_eq_powerKernel_card + leftTrace rightTrace m hm) + exact hinversion n hn + +/-- A right power-range witness is a right power-kernel witness when the +corresponding subgroups agree. -/ +def rightPowerTraceRangeSolutionsEquivPowerKernelSolutions + [Finite A] [Finite H] + (leftTrace : A → T) (rightTrace : H → T) + (rangeExponent kernelExponent : ℕ) + (hsubgroup : + (powMonoidHom rangeExponent : H →* H).range = + (powMonoidHom kernelExponent : H →* H).ker) : + rightPowerTraceRangeSolutions leftTrace rightTrace rangeExponent ≃ + ↥(rightTracePowerKernelSolutions leftTrace rightTrace kernelExponent) where + toFun z := ⟨(z.1.1, z.1.2.1), by + rw [mem_rightTracePowerKernelSolutions_iff] + refine ⟨z.2, ?_⟩ + have hzker : z.1.2.1 ∈ (powMonoidHom kernelExponent : H →* H).ker := by + rw [← hsubgroup] + exact z.1.2.2 + exact hzker⟩ + invFun z := ⟨(z.1.1, ⟨z.1.2, by + rw [hsubgroup] + exact (mem_rightTracePowerKernelSolutions_iff + leftTrace rightTrace kernelExponent z.1).mp z.2 |>.2⟩), + (mem_rightTracePowerKernelSolutions_iff + leftTrace rightTrace kernelExponent z.1).mp z.2 |>.1⟩ + left_inv z := by rfl + right_inv z := by rfl + +theorem natCard_rightPowerTraceRangeSolutions_eq_powerKernel_card + [Finite A] [Finite H] + (leftTrace : A → T) (rightTrace : H → T) + (rangeExponent kernelExponent : ℕ) + (hsubgroup : + (powMonoidHom rangeExponent : H →* H).range = + (powMonoidHom kernelExponent : H →* H).ker) : + Nat.card (rightPowerTraceRangeSolutions leftTrace rightTrace rangeExponent) = + (rightTracePowerKernelSolutions leftTrace rightTrace kernelExponent).card := by + calc + Nat.card (rightPowerTraceRangeSolutions leftTrace rightTrace rangeExponent) = + Nat.card ↥(rightTracePowerKernelSolutions + leftTrace rightTrace kernelExponent) := + Nat.card_congr + (rightPowerTraceRangeSolutionsEquivPowerKernelSolutions + leftTrace rightTrace rangeExponent kernelExponent hsubgroup) + _ = (rightTracePowerKernelSolutions + leftTrace rightTrace kernelExponent).card := by + rw [Nat.card_eq_fintype_card, Fintype.card_coe] + +/-- Published one-sided inclusion--exclusion, retaining every left witness. -/ +theorem moebius_sum_rightPowerTraceRange_card_eq_exactOrder_card + [Finite A] [Finite H] [IsCyclic H] + (leftTrace : A → T) (rightTrace : H → T) : + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℤ) * + Nat.card (rightPowerTraceRangeSolutions + leftTrace rightTrace x.fst) = + (rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card := by + rw [← moebius_sum_rightTracePowerKernel_card_eq_exactOrder_card + leftTrace rightTrace (Nat.card H) Nat.card_pos] + apply Finset.sum_congr rfl + intro x hx + congr 1 + have hproduct := (Nat.mem_divisorsAntidiagonal.mp hx).1 + have hleftNe : x.fst ≠ 0 := Nat.left_ne_zero_of_mem_divisorsAntidiagonal hx + have hdvd : x.fst ∣ Nat.card H := ⟨x.snd, hproduct.symm⟩ + have hquotient : Nat.card H / x.fst = x.snd := by + rw [← hproduct, Nat.mul_comm x.fst x.snd, + Nat.mul_div_left x.snd (Nat.pos_of_ne_zero hleftNe)] + rw [natCard_rightPowerTraceRangeSolutions_eq_powerKernel_card + leftTrace rightTrace x.fst x.snd] + simpa [hquotient] using + BGS.Markoff.powMonoidHom_range_eq_ker_complementaryExponent + (H := H) x.fst hdvd + +/-- Pointwise range-count estimates give the divisor-count error envelope for +the witness-bearing primitive count. -/ +theorem rightTraceExactOrderSolutions_card_error_le_moebiusMain + [Finite A] [Finite H] [IsCyclic H] + (leftTrace : A → T) (rightTrace : H → T) + (mainTerm : ℕ → ℝ) (error : ℝ) + (hRange : ∀ d : ℕ, d ∣ Nat.card H → 0 < d → + |(Nat.card (rightPowerTraceRangeSolutions + leftTrace rightTrace d) : ℝ) - mainTerm d| ≤ error) : + |((rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card : ℝ) - + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst| ≤ + ((Nat.card H).divisors.card : ℝ) * error := by + have hExact := + moebius_sum_rightPowerTraceRange_card_eq_exactOrder_card + leftTrace rightTrace + have hExactReal : + ((rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card : ℝ) = + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * + (Nat.card (rightPowerTraceRangeSolutions + leftTrace rightTrace x.fst) : ℝ) := by + exact_mod_cast hExact.symm + rw [hExactReal] + apply BGS.Markoff.abs_moebius_weighted_sum_sub_le_divisors_card_mul + (Nat.card H) + (fun x => (Nat.card (rightPowerTraceRangeSolutions + leftTrace rightTrace x.fst) : ℝ)) + (fun x => mainTerm x.fst) error + intro x hx + have hproduct := (Nat.mem_divisorsAntidiagonal.mp hx).1 + have hdvd : x.fst ∣ Nat.card H := ⟨x.snd, hproduct.symm⟩ + exact hRange x.fst hdvd + (Nat.pos_of_ne_zero (Nat.left_ne_zero_of_mem_divisorsAntidiagonal hx)) + +/-- If the Möbius main term dominates the divisor error, a primitive right +parameter exists together with a genuine left witness. -/ +theorem rightTraceExactOrderSolutions_nonempty_of_divisorsError_lt_moebiusMain + [Finite A] [Finite H] [IsCyclic H] + (leftTrace : A → T) (rightTrace : H → T) + (mainTerm : ℕ → ℝ) (error : ℝ) + (hRange : ∀ d : ℕ, d ∣ Nat.card H → 0 < d → + |(Nat.card (rightPowerTraceRangeSolutions + leftTrace rightTrace d) : ℝ) - mainTerm d| ≤ error) + (hpositive : + ((Nat.card H).divisors.card : ℝ) * error < + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst) : + (rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).Nonempty := by + have henvelope := rightTraceExactOrderSolutions_card_error_le_moebiusMain + leftTrace rightTrace mainTerm error hRange + have hcardReal : + 0 < ((rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card : ℝ) := by + have hlower : + (∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst) - + ((rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card : ℝ) ≤ + |((rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card : ℝ) - + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst| := by + simpa only [neg_sub] using + neg_le_abs + (((rightTraceExactOrderSolutions + leftTrace rightTrace (Nat.card H)).card : ℝ) - + ∑ x ∈ (Nat.card H).divisorsAntidiagonal, + (μ x.fst : ℝ) * mainTerm x.fst) + linarith + exact Finset.card_pos.mp (by exact_mod_cast hcardReal) + +end + +end BGS diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean new file mode 100644 index 0000000000..87d51a38a2 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean @@ -0,0 +1,384 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +import Mathlib.Tactic.IntervalCases + +/-! +# An elementary tenth-moment divisor bound + +For the paper's preliminary all-divisors route, the generic factorization +constant in `ExplicitDivisorBound.lean` is much too large. Here each prime +factor is charged a small power-of-two penalty. The penalties over primes below +`1024` sum exactly to `447`; primes at least `1024` need no penalty. +-/ + +namespace BGS.NumberTheory + +open scoped BigOperators + +/-- If the tenth-power ratio is controlled at one exponent, it remains +controlled at every later exponent. -/ +private theorem pow_ten_succ_ratio_le + (base A a : ℕ) (ha : A ≤ a) + (hbase : (A + 2) ^ 10 ≤ base * (A + 1) ^ 10) : + (a + 2) ^ 10 ≤ base * (a + 1) ^ 10 := by + have hlinear : (A + 1) * (a + 2) ≤ (A + 2) * (a + 1) := by + nlinarith + have hpow := Nat.pow_le_pow_left hlinear 10 + have hscaled : + (A + 1) ^ 10 * (a + 2) ^ 10 ≤ + (A + 1) ^ 10 * (base * (a + 1) ^ 10) := by + calc + (A + 1) ^ 10 * (a + 2) ^ 10 = + ((A + 1) * (a + 2)) ^ 10 := by rw [mul_pow] + _ ≤ ((A + 2) * (a + 1)) ^ 10 := hpow + _ = (A + 2) ^ 10 * (a + 1) ^ 10 := by rw [mul_pow] + _ ≤ (base * (A + 1) ^ 10) * (a + 1) ^ 10 := + Nat.mul_le_mul_right _ hbase + _ = (A + 1) ^ 10 * (base * (a + 1) ^ 10) := by ring + exact Nat.le_of_mul_le_mul_left hscaled (by positivity) + +/-- Induction from a finite threshold for a fixed prime-size band. -/ +private theorem pow_ten_le_band_of_threshold + (base c A : ℕ) + (hbase : (A + 1) ^ 10 ≤ 2 ^ c * base ^ A) + (hratio : (A + 2) ^ 10 ≤ base * (A + 1) ^ 10) + (a : ℕ) (ha : A ≤ a) : + (a + 1) ^ 10 ≤ 2 ^ c * base ^ a := by + induction a, ha using Nat.le_induction with + | base => exact hbase + | succ a ha ih => + calc + (a + 1 + 1) ^ 10 ≤ base * (a + 1) ^ 10 := + pow_ten_succ_ratio_le base A a ha hratio + _ ≤ base * (2 ^ c * base ^ a) := + Nat.mul_le_mul_left _ ih + _ = 2 ^ c * base ^ (a + 1) := by ring + +private theorem pow_ten_le_base_two (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 26 * 2 ^ a := by + by_cases ha : 13 ≤ a + · simpa using pow_ten_le_band_of_threshold 2 26 13 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 12 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_three (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 20 * 3 ^ a := by + by_cases ha : 8 ≤ a + · simpa using pow_ten_le_band_of_threshold 3 20 8 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 7 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_five (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 15 * 5 ^ a := by + by_cases ha : 5 ≤ a + · simpa using pow_ten_le_band_of_threshold 5 15 5 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 4 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_seven (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 12 * 7 ^ a := by + by_cases ha : 4 ≤ a + · simpa using pow_ten_le_band_of_threshold 7 12 4 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 3 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_eleven (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 10 * 11 ^ a := by + by_cases ha : 3 ≤ a + · simpa using pow_ten_le_band_of_threshold 11 10 3 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 2 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_thirteen (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 9 * 13 ^ a := by + by_cases ha : 3 ≤ a + · simpa using pow_ten_le_band_of_threshold 13 9 3 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 2 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_seventeen (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 8 * 17 ^ a := by + by_cases ha : 3 ≤ a + · simpa using pow_ten_le_band_of_threshold 17 8 3 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 2 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_twentyThree (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 7 * 23 ^ a := by + by_cases ha : 2 ≤ a + · simpa using pow_ten_le_band_of_threshold 23 7 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_thirtyOne (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 6 * 31 ^ a := by + by_cases ha : 2 ≤ a + · simpa using pow_ten_le_band_of_threshold 31 6 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_fortyThree (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 5 * 43 ^ a := by + by_cases ha : 2 ≤ a + · simpa using pow_ten_le_band_of_threshold 43 5 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_sixtySeven (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 4 * 67 ^ a := by + by_cases ha : 1 ≤ a + · simpa using pow_ten_le_band_of_threshold 67 4 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_oneHundredThirtyOne (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 3 * 131 ^ a := by + by_cases ha : 1 ≤ a + · simpa using pow_ten_le_band_of_threshold 131 3 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_twoHundredFiftySeven (a : ℕ) : + (a + 1) ^ 10 ≤ 2 ^ 2 * 257 ^ a := by + by_cases ha : 1 ≤ a + · simpa using pow_ten_le_band_of_threshold 257 2 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_fiveHundredTwentyOne (a : ℕ) : + (a + 1) ^ 10 ≤ 2 * 521 ^ a := by + by_cases ha : 1 ≤ a + · simpa using pow_ten_le_band_of_threshold 521 1 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_ten_le_base_oneThousandTwentyFour (a : ℕ) : + (a + 1) ^ 10 ≤ 1024 ^ a := by + simpa using pow_ten_le_band_of_threshold 1024 0 0 + (by norm_num) (by norm_num) a (Nat.zero_le a) +/-- Power-of-two penalty assigned to a prime factor. The thresholds are the +first primes at which the optimal integer penalty decreases. -/ +def preliminaryPrimePenalty (p : ℕ) : ℕ := + if p < 3 then 26 + else if p < 5 then 20 + else if p < 7 then 15 + else if p < 11 then 12 + else if p < 13 then 10 + else if p < 17 then 9 + else if p < 23 then 8 + else if p < 31 then 7 + else if p < 43 then 6 + else if p < 67 then 5 + else if p < 131 then 4 + else if p < 257 then 3 + else if p < 521 then 2 + else if p < 1024 then 1 + else 0 + +private theorem preliminaryPrimePenalty_eq_zero_of_le + {p : ℕ} (hp : 1024 ≤ p) : + preliminaryPrimePenalty p = 0 := by + simp [preliminaryPrimePenalty, + show ¬p < 3 by omega, + show ¬p < 5 by omega, + show ¬p < 7 by omega, + show ¬p < 11 by omega, + show ¬p < 13 by omega, + show ¬p < 17 by omega, + show ¬p < 23 by omega, + show ¬p < 31 by omega, + show ¬p < 43 by omega, + show ¬p < 67 by omega, + show ¬p < 131 by omega, + show ¬p < 257 by omega, + show ¬p < 521 by omega, + show ¬p < 1024 by omega] + +/-- Factorwise tenth-moment estimate, using the penalty band containing the +prime. -/ +private theorem factorization_succ_pow_ten_le + {p a : ℕ} (hpPrime : p.Prime) : + (a + 1) ^ 10 ≤ + 2 ^ preliminaryPrimePenalty p * p ^ a := by + have hpTwo : 2 ≤ p := hpPrime.two_le + by_cases hp3 : p < 3 + · simp only [preliminaryPrimePenalty, if_pos hp3] + exact (pow_ten_le_base_two a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpTwo a) + · by_cases hp5 : p < 5 + · have hpLower : 3 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_pos hp5] + exact (pow_ten_le_base_three a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp7 : p < 7 + · have hpLower : 5 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, if_pos hp7] + exact (pow_ten_le_base_five a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp11 : p < 11 + · have hpLower : 7 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_pos hp11] + exact (pow_ten_le_base_seven a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp13 : p < 13 + · have hpLower : 11 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_pos hp13] + exact (pow_ten_le_base_eleven a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp17 : p < 17 + · have hpLower : 13 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_pos hp17] + exact (pow_ten_le_base_thirteen a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp23 : p < 23 + · have hpLower : 17 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_pos hp23] + exact (pow_ten_le_base_seventeen a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp31 : p < 31 + · have hpLower : 23 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp23, if_pos hp31] + exact (pow_ten_le_base_twentyThree a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp43 : p < 43 + · have hpLower : 31 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp23, if_neg hp31, if_pos hp43] + exact (pow_ten_le_base_thirtyOne a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp67 : p < 67 + · have hpLower : 43 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp23, if_neg hp31, if_neg hp43, if_pos hp67] + exact (pow_ten_le_base_fortyThree a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp131 : p < 131 + · have hpLower : 67 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, + if_neg hp67, if_pos hp131] + exact (pow_ten_le_base_sixtySeven a).trans <| + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) + · by_cases hp257 : p < 257 + · have hpLower : 131 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, + if_neg hp67, if_neg hp131, if_pos hp257] + exact (pow_ten_le_base_oneHundredThirtyOne a).trans <| + Nat.mul_le_mul_left _ + (Nat.pow_le_pow_left hpLower a) + · by_cases hp521 : p < 521 + · have hpLower : 257 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, + if_neg hp67, if_neg hp131, if_neg hp257, + if_pos hp521] + exact (pow_ten_le_base_twoHundredFiftySeven a).trans <| + Nat.mul_le_mul_left _ + (Nat.pow_le_pow_left hpLower a) + · by_cases hp1024 : p < 1024 + · have hpLower : 521 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, + if_neg hp67, if_neg hp131, if_neg hp257, + if_neg hp521, if_pos hp1024] + exact (pow_ten_le_base_fiveHundredTwentyOne a).trans <| + Nat.mul_le_mul_left _ + (Nat.pow_le_pow_left hpLower a) + · have hpLower : 1024 ≤ p := by omega + simp only [preliminaryPrimePenalty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, + if_neg hp67, if_neg hp131, if_neg hp257, + if_neg hp521, if_neg hp1024, pow_zero, one_mul] + exact + (pow_ten_le_base_oneThousandTwentyFour a).trans <| + Nat.pow_le_pow_left hpLower a +private theorem sum_preliminaryPrimePenalty_le (n : ℕ) : + ∑ p ∈ n.primeFactors, preliminaryPrimePenalty p ≤ 447 := by + let smallFactors := + n.primeFactors.filter fun p ↦ p < 1024 + let allSmallPrimes := + (Finset.range 1024).filter Nat.Prime + have hsumEq : + (∑ p ∈ smallFactors, preliminaryPrimePenalty p) = + ∑ p ∈ n.primeFactors, preliminaryPrimePenalty p := by + apply Finset.sum_subset (Finset.filter_subset _ _) + intro p hpFactors hpNotSmall + have hpLarge : 1024 ≤ p := by + by_contra hpNotLarge + have hpSmall : p < 1024 := by omega + exact hpNotSmall (Finset.mem_filter.mpr ⟨hpFactors, hpSmall⟩) + exact preliminaryPrimePenalty_eq_zero_of_le hpLarge + have hsubset : smallFactors ⊆ allSmallPrimes := by + intro p hp + have hp' := Finset.mem_filter.mp hp + exact Finset.mem_filter.mpr + ⟨Finset.mem_range.mpr hp'.2, + Nat.prime_of_mem_primeFactors hp'.1⟩ + have hle : + (∑ p ∈ smallFactors, preliminaryPrimePenalty p) ≤ + ∑ p ∈ allSmallPrimes, preliminaryPrimePenalty p := + Finset.sum_le_sum_of_subset_of_nonneg hsubset + (fun _ _ _ ↦ Nat.zero_le _) + have htotal : + (∑ p ∈ allSmallPrimes, preliminaryPrimePenalty p) ≤ 447 := by + decide + rw [← hsumEq] + exact hle.trans htotal + +/-- The divisor function satisfies the uniform elementary estimate +`τ(n)^10 ≤ 2^447 n`. -/ +theorem card_divisors_pow_ten_le_preliminary_constant_mul + (n : ℕ) (hn : n ≠ 0) : + n.divisors.card ^ 10 ≤ 2 ^ 447 * n := by + rw [Nat.card_divisors hn, ← Finset.prod_pow] + calc + (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ 10) ≤ + ∏ p ∈ n.primeFactors, + (2 ^ preliminaryPrimePenalty p * p ^ n.factorization p) := + Finset.prod_le_prod (fun _ _ ↦ Nat.zero_le _) + (fun p hp ↦ factorization_succ_pow_ten_le + (Nat.prime_of_mem_primeFactors hp)) + _ = 2 ^ (∑ p ∈ n.primeFactors, preliminaryPrimePenalty p) * n := by + rw [Finset.prod_mul_distrib, + Finset.prod_pow_eq_pow_sum, + ← Nat.prod_primeFactors_pow_factorization hn] + _ ≤ 2 ^ 447 * n := + Nat.mul_le_mul_right n <| + Nat.pow_le_pow_right (by norm_num) + (sum_preliminaryPrimePenalty_le n) + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean new file mode 100644 index 0000000000..2191d9cf6a --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean @@ -0,0 +1,130 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib + +/-! +# Prime-power factorization data + +This module contains the certificate-independent data and executable +recurrences used to describe a finite prime-power factorization and the ranks +of its divisor lattice. +-/ + +namespace BGS.NumberTheory + +/-- One claimed prime power `prime ^ exponent`. -/ +structure PrimePowerFactor where + prime : ℕ + exponent : ℕ + deriving DecidableEq, Repr + +namespace PrimePowerFactor + +/-- A factor is meaningful when its base is prime and its exponent is +positive. -/ +def Valid (factor : PrimePowerFactor) : Prop := + factor.prime.Prime ∧ 0 < factor.exponent + +/-- Executable checker for one prime-power factor. -/ +def check (factor : PrimePowerFactor) : Bool := + decide factor.prime.Prime && decide (0 < factor.exponent) + +@[simp] +theorem check_eq_true_iff (factor : PrimePowerFactor) : + factor.check = true ↔ factor.Valid := by + simp [check, Valid] + +end PrimePowerFactor + +/-- Every supplied prime-power entry is individually valid. -/ +def allPrimePowerFactorsValid : List PrimePowerFactor → Prop + | [] => True + | factor :: factors => + factor.Valid ∧ allPrimePowerFactorsValid factors + +/-- Executable counterpart of `allPrimePowerFactorsValid`. -/ +def allPrimePowerFactorsCheck : List PrimePowerFactor → Bool + | [] => true + | factor :: factors => + factor.check && allPrimePowerFactorsCheck factors + +@[simp] +theorem allPrimePowerFactorsCheck_eq_true_iff + (factors : List PrimePowerFactor) : + allPrimePowerFactorsCheck factors = true ↔ + allPrimePowerFactorsValid factors := by + induction factors with + | nil => simp [allPrimePowerFactorsCheck, allPrimePowerFactorsValid] + | cons factor factors ih => + simp [allPrimePowerFactorsCheck, allPrimePowerFactorsValid, ih] + +/-- The prime bases occur in strict increasing order. `List.Pairwise` rejects +duplicates and checks all later bases, not only adjacent entries. -/ +def primePowerBasesStrictlyIncreasing + (factors : List PrimePowerFactor) : Prop := + factors.Pairwise fun left right => left.prime < right.prime + +/-- Executable strict-order checker. -/ +def primePowerBasesStrictlyIncreasingCheck + (factors : List PrimePowerFactor) : Bool := + decide (factors.Pairwise fun left right => left.prime < right.prime) + +@[simp] +theorem primePowerBasesStrictlyIncreasingCheck_eq_true_iff + (factors : List PrimePowerFactor) : + primePowerBasesStrictlyIncreasingCheck factors = true ↔ + primePowerBasesStrictlyIncreasing factors := by + simp [primePowerBasesStrictlyIncreasingCheck, + primePowerBasesStrictlyIncreasing] + +/-- Canonical prime-power input: valid entries with distinct, increasing +prime bases. -/ +def canonicalPrimePowerFactors (factors : List PrimePowerFactor) : Prop := + allPrimePowerFactorsValid factors ∧ + primePowerBasesStrictlyIncreasing factors + +/-- Executable counterpart of `canonicalPrimePowerFactors`. -/ +def canonicalPrimePowerFactorsCheck + (factors : List PrimePowerFactor) : Bool := + allPrimePowerFactorsCheck factors && + primePowerBasesStrictlyIncreasingCheck factors + +@[simp] +theorem canonicalPrimePowerFactorsCheck_eq_true_iff + (factors : List PrimePowerFactor) : + canonicalPrimePowerFactorsCheck factors = true ↔ + canonicalPrimePowerFactors factors := by + simp [canonicalPrimePowerFactorsCheck, canonicalPrimePowerFactors] + +/-- The integer represented by a supplied prime-power list. -/ +def primePowerFactorizationValue : List PrimePowerFactor → ℕ + | [] => 1 + | factor :: factors => + factor.prime ^ factor.exponent * + primePowerFactorizationValue factors + +/-- The total exponent, i.e. the top rank of the divisor lattice. -/ +def primePowerTotalExponent : List PrimePowerFactor → ℕ + | [] => 0 + | factor :: factors => + factor.exponent + primePowerTotalExponent factors + +/-- Coefficient recurrence for `∏ (1 + X + ... + X^e)`. -/ +def divisorRankCoefficient : + List PrimePowerFactor → ℕ → ℕ + | [], 0 => 1 + | [], _ + 1 => 0 + | factor :: factors, rank => + ∑ exponent ∈ Finset.range (min factor.exponent rank + 1), + divisorRankCoefficient factors (rank - exponent) + +/-- The central rank coefficient recomputed from the supplied exponents. -/ +def centralDivisorRankCoefficient + (factors : List PrimePowerFactor) : ℕ := + divisorRankCoefficient factors (primePowerTotalExponent factors / 2) + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean new file mode 100644 index 0000000000..6fab3b2843 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean @@ -0,0 +1,297 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate + +/-! +# Canonical Rankin profile attached to a neighboring factorization + +The numerical certificate will choose rational caps. This file fixes the +mathematical coverage map independently of those choices: every odd prime in +the globally sorted support is sent to its actual side and exponent, while the +cap assignment and the twelfth-root cap remain explicit parameters. +-/ + +namespace BGS.NumberTheory + +private theorem factorization_two_mul_of_odd + {n : ℕ} (hn : Odd n) : + (2 * n).factorization 2 = 1 := by + have hnNe : n ≠ 0 := hn.pos.ne' + have hfactorization := Nat.factorization_mul (by norm_num : 2 ≠ 0) hnNe + have happly := congrArg (fun factorization : ℕ →₀ ℕ => + factorization 2) hfactorization + simpa [Nat.Prime.factorization_self Nat.prime_two, + Nat.factorization_eq_zero_of_not_dvd hn.not_two_dvd_nat] using happly + +/-- For an odd prime, exactly one neighboring two-adic exponent is one and +the other is at least two. -/ +theorem neighboring_twoFactorization_shape + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) : + (((p - 1).factorization 2 = 1 ∧ + 2 ≤ (p + 1).factorization 2) ∨ + ((p + 1).factorization 2 = 1 ∧ + 2 ≤ (p - 1).factorization 2)) := by + have hpOdd : Odd p := hpPrime.odd_iff.mpr (by omega) + rcases hpOdd with ⟨k, rfl⟩ + rcases k.even_or_odd with hkEven | hkOdd + · right + have hkPlusOdd : Odd (k + 1) := hkEven.add_one + constructor + · have hplusEq : 2 * k + 1 + 1 = 2 * (k + 1) := by omega + rw [hplusEq] + exact factorization_two_mul_of_odd hkPlusOdd + · have hminusEq : 2 * k + 1 - 1 = 2 * k := by omega + rw [hminusEq] + have hne : 2 * k ≠ 0 := by + rcases hkEven with ⟨j, hj⟩ + omega + apply (Nat.prime_two.pow_dvd_iff_le_factorization hne).mp + rcases hkEven with ⟨j, hj⟩ + refine ⟨j, ?_⟩ + norm_num + omega + · left + have hkPlusEven : Even (k + 1) := hkOdd.add_one + constructor + · have hminusEq : 2 * k + 1 - 1 = 2 * k := by omega + rw [hminusEq] + exact factorization_two_mul_of_odd hkOdd + · have hplusEq : 2 * k + 1 + 1 = 2 * (k + 1) := by omega + rw [hplusEq] + have hne : 2 * (k + 1) ≠ 0 := by omega + apply (Nat.prime_two.pow_dvd_iff_le_factorization hne).mp + rcases hkPlusEven with ⟨j, hj⟩ + refine ⟨j, ?_⟩ + norm_num + omega + +theorem actualNeighborExponent_pos + {p prime : ℕ} (hp : 1 < p) + (hprime : prime ∈ jointOddPrimeList p) : + 0 < actualNeighborExponent p prime := by + have hdata := mem_jointOddPrimeList.mp hprime + have hprimePrime : prime.Prime := by + rcases hdata.2 with hminus | hplus + · exact Nat.prime_of_mem_primeFactors hminus + · exact Nat.prime_of_mem_primeFactors hplus + by_cases hminus : prime ∈ (p - 1).primeFactors + · simp only [actualNeighborExponent, if_pos hminus] + exact hprimePrime.factorization_pos_of_dvd (by omega) + (Nat.dvd_of_mem_primeFactors hminus) + · have hplus : prime ∈ (p + 1).primeFactors := + hdata.2.resolve_left hminus + simp only [actualNeighborExponent, if_neg hminus] + exact hprimePrime.factorization_pos_of_dvd (by omega) + (Nat.dvd_of_mem_primeFactors hplus) + +/-- The exact odd factor produced from one actual support prime and one chosen +rational cap. -/ +def canonicalRankinOddFactor + (p : ℕ) (oddCap : ℕ → RationalPrimeWeightCap) + (prime : ℕ) : RankinOddFactor where + side := actualNeighborSide p prime + exponent := actualNeighborExponent p prime + weightCap := oddCap prime + +/-- The complete canonical profile for `p`, parameterized by cap choices. -/ +def canonicalRankinNeighborProfile + (p : ℕ) (twoCap : RationalPrimeWeightCap) + (oddCap : ℕ → RationalPrimeWeightCap) + (rootCap : ℕ) : RankinNeighborProfile where + minusTwoExponent := (p - 1).factorization 2 + plusTwoExponent := (p + 1).factorization 2 + twoWeightCap := twoCap + oddFactors := (jointOddPrimeList p).map + (canonicalRankinOddFactor p oddCap) + rootCap := rootCap + +theorem canonicalRankinNeighborProfile_matches + {p : ℕ} {twoCap : RationalPrimeWeightCap} + {oddCap : ℕ → RationalPrimeWeightCap} {rootCap : ℕ} + (hfloor : + ∀ prime ∈ jointOddPrimeList p, + (oddCap prime).lowerPrime ≤ prime) : + (canonicalRankinNeighborProfile p twoCap oddCap rootCap).Matches p := by + refine ⟨rfl, rfl, canonicalRankinOddFactor p oddCap, rfl, ?_⟩ + intro prime hprime + exact ⟨rfl, rfl, hfloor prime hprime⟩ + +private theorem allRankinOddFactorsValid_map_canonical + {p : ℕ} (hp : 1 < p) + {oddCap : ℕ → RationalPrimeWeightCap} + (hcap : + ∀ prime ∈ jointOddPrimeList p, + (oddCap prime).Valid ∧ + (oddCap prime).lowerPrime.Prime ∧ + 3 ≤ (oddCap prime).lowerPrime) : + allRankinOddFactorsValid + ((jointOddPrimeList p).map + (canonicalRankinOddFactor p oddCap)) := by + have hpos : + ∀ prime ∈ jointOddPrimeList p, + 0 < actualNeighborExponent p prime := + fun prime hprime => actualNeighborExponent_pos hp hprime + generalize jointOddPrimeList p = primes at hcap hpos ⊢ + induction primes with + | nil => simp [allRankinOddFactorsValid] + | cons prime primes ih => + simp only [List.map_cons, allRankinOddFactorsValid] + constructor + · exact ⟨hpos prime (by simp), + (hcap prime (by simp)).1, + (hcap prime (by simp)).2.1, + (hcap prime (by simp)).2.2⟩ + · apply ih + · intro q hq + exact hcap q (by simp [hq]) + · intro q hq + exact hpos q (by simp [hq]) + +/-- The exact assumptions on generated caps under which the canonical profile +is structurally and arithmetically valid. -/ +theorem canonicalRankinNeighborProfile_valid + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {twoCap : RationalPrimeWeightCap} + {oddCap : ℕ → RationalPrimeWeightCap} {rootCap : ℕ} + (htwoValid : twoCap.Valid) + (htwoFloor : twoCap.lowerPrime = 2) + (hoddValid : + ∀ prime ∈ jointOddPrimeList p, + (oddCap prime).Valid ∧ + (oddCap prime).lowerPrime.Prime ∧ + 3 ≤ (oddCap prime).lowerPrime) + (hfloorStrict : + (jointOddPrimeList p).Pairwise fun left right => + (oddCap left).lowerPrime < (oddCap right).lowerPrime) + (hrootPos : 0 < rootCap) + (hroot : + (canonicalRankinNeighborProfile p twoCap oddCap rootCap).witnessCap ≤ + rootCap ^ 12) : + (canonicalRankinNeighborProfile p twoCap oddCap rootCap).Valid := by + refine ⟨neighboring_twoFactorization_shape hpPrime hpTwo, + htwoValid, htwoFloor, ?_, ?_, hrootPos, hroot⟩ + · exact allRankinOddFactorsValid_map_canonical (by omega) hoddValid + · rw [rankinOddFloorsStrictlyIncreasing, + canonicalRankinNeighborProfile, List.pairwise_map] + simpa [canonicalRankinOddFactor] using hfloorStrict + +/-- The side-erased joint root condition is sufficient for validity of the +actual side assignment. This lets a finite certificate choose its root cap +without branching over which neighboring factor receives each odd prime. -/ +theorem canonicalRankinNeighborProfile_valid_of_jointEnvelope + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {twoCap : RationalPrimeWeightCap} + {oddCap : ℕ → RationalPrimeWeightCap} {rootCap : ℕ} + (htwoValid : twoCap.Valid) + (htwoFloor : twoCap.lowerPrime = 2) + (hoddValid : + ∀ prime ∈ jointOddPrimeList p, + (oddCap prime).Valid ∧ + (oddCap prime).lowerPrime.Prime ∧ + 3 ≤ (oddCap prime).lowerPrime) + (hfloorStrict : + (jointOddPrimeList p).Pairwise fun left right => + (oddCap left).lowerPrime < (oddCap right).lowerPrime) + (hrootPos : 0 < rootCap) + (hjointRoot : + RankinNeighborProfile.JointEnvelopeValid + (canonicalRankinNeighborProfile p twoCap oddCap rootCap)) : + (canonicalRankinNeighborProfile p twoCap oddCap rootCap).Valid := by + apply canonicalRankinNeighborProfile_valid hpPrime hpTwo + htwoValid htwoFloor hoddValid hfloorStrict hrootPos + exact + (RankinNeighborProfile.witnessCap_le_jointEnvelopeWitnessCap_of_shape + (canonicalRankinNeighborProfile p twoCap oddCap rootCap) + (neighboring_twoFactorization_shape hpPrime hpTwo)).trans + hjointRoot + +/-- A deliberately loose but universally available cap: weight one at the +actual prime. It is used only to prove that the profile representation is +total; optimized certificates replace it by smaller rational caps. -/ +def unitRationalPrimeWeightCap (prime : ℕ) : RationalPrimeWeightCap where + lowerPrime := prime + numerator := 1 + denominator := 1 + +theorem unitRationalPrimeWeightCap_valid + {prime : ℕ} (hprime : 0 < prime) : + (unitRationalPrimeWeightCap prime).Valid := by + simp [unitRationalPrimeWeightCap, RationalPrimeWeightCap.Valid] + omega + +private theorem pairwise_lt_of_pairwise_le_of_nodup + {values : List ℕ} + (hle : values.Pairwise (· ≤ ·)) (hnodup : values.Nodup) : + values.Pairwise (· < ·) := by + induction values with + | nil => simp + | cons value values ih => + rw [List.pairwise_cons] at hle ⊢ + rw [List.nodup_cons] at hnodup + constructor + · intro later hlater + exact lt_of_le_of_ne (hle.1 later hlater) (by + intro heq + exact hnodup.1 (heq ▸ hlater)) + · exact ih hle.2 hnodup.2 + +theorem jointOddPrimeList_pairwise_lt (p : ℕ) : + (jointOddPrimeList p).Pairwise (· < ·) := by + apply pairwise_lt_of_pairwise_le_of_nodup + · exact Finset.pairwise_sort (jointOddPrimeSupport p) (· ≤ ·) + · exact Finset.sort_nodup (jointOddPrimeSupport p) (· ≤ ·) + +/-- A concrete canonical profile exists for every `p`: exact-prime unit +weights and a deliberately oversized root cap make validity unconditional. +This theorem is a coverage sanity check, not the optimized numerical +certificate. -/ +def unitCanonicalRankinNeighborProfile (p : ℕ) : RankinNeighborProfile := + let seed := canonicalRankinNeighborProfile p + (unitRationalPrimeWeightCap 2) + unitRationalPrimeWeightCap 1 + canonicalRankinNeighborProfile p + (unitRationalPrimeWeightCap 2) + unitRationalPrimeWeightCap (seed.witnessCap + 1) + +theorem unitCanonicalRankinNeighborProfile_matches (p : ℕ) : + (unitCanonicalRankinNeighborProfile p).Matches p := by + apply canonicalRankinNeighborProfile_matches + intro prime hprime + simp [unitRationalPrimeWeightCap] + +theorem unitCanonicalRankinNeighborProfile_valid + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) : + (unitCanonicalRankinNeighborProfile p).Valid := by + let seed := canonicalRankinNeighborProfile p + (unitRationalPrimeWeightCap 2) + unitRationalPrimeWeightCap 1 + change (canonicalRankinNeighborProfile p + (unitRationalPrimeWeightCap 2) + unitRationalPrimeWeightCap (seed.witnessCap + 1)).Valid + apply canonicalRankinNeighborProfile_valid hpPrime hpTwo + · exact unitRationalPrimeWeightCap_valid (by norm_num) + · rfl + · intro prime hprime + have hprimePrime : prime.Prime := by + rcases (mem_jointOddPrimeList.mp hprime).2 with hminus | hplus + · exact Nat.prime_of_mem_primeFactors hminus + · exact Nat.prime_of_mem_primeFactors hplus + have hthree : 3 ≤ prime := by + have hneTwo := (mem_jointOddPrimeList.mp hprime).1 + have htwo := hprimePrime.two_le + omega + exact ⟨unitRationalPrimeWeightCap_valid hprimePrime.pos, + hprimePrime, hthree⟩ + · simpa [unitRationalPrimeWeightCap] using + jointOddPrimeList_pairwise_lt p + · omega + · change seed.witnessCap ≤ (seed.witnessCap + 1) ^ 12 + exact (Nat.le_succ seed.witnessCap).trans + (Nat.le_pow (by norm_num : 0 < 12)) + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean new file mode 100644 index 0000000000..0cef23b712 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean @@ -0,0 +1,83 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound + +/-! +# Concrete positional data below `2^1248` + +The table contains the first 275 odd primes, ending at 1783. Its product is +strictly larger than `2^2496`. Hence the joint odd support of every +`p < 2^1248` has fewer than 275 entries. The precision is intentionally only +a coarse starting choice; later certificate generation may increase it +without changing the support argument. +-/ + +namespace BGS.NumberTheory + +def rankinCutoff1248CapTable : RankinPositionalCapTable where + precision := 1000000 + oddPrimeFloors := [ + 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, + 67, 71, 73, 79, 83, 89, 97, 101, 103, 107, 109, 113, 127, 131, 137, + 139, 149, 151, 157, 163, 167, 173, 179, 181, 191, 193, 197, 199, 211, + 223, 227, 229, 233, 239, 241, 251, 257, 263, 269, 271, 277, 281, 283, + 293, 307, 311, 313, 317, 331, 337, 347, 349, 353, 359, 367, 373, 379, + 383, 389, 397, 401, 409, 419, 421, 431, 433, 439, 443, 449, 457, 461, + 463, 467, 479, 487, 491, 499, 503, 509, 521, 523, 541, 547, 557, 563, + 569, 571, 577, 587, 593, 599, 601, 607, 613, 617, 619, 631, 641, 643, + 647, 653, 659, 661, 673, 677, 683, 691, 701, 709, 719, 727, 733, 739, + 743, 751, 757, 761, 769, 773, 787, 797, 809, 811, 821, 823, 827, 829, + 839, 853, 857, 859, 863, 877, 881, 883, 887, 907, 911, 919, 929, 937, + 941, 947, 953, 967, 971, 977, 983, 991, 997, 1009, 1013, 1019, 1021, + 1031, 1033, 1039, 1049, 1051, 1061, 1063, 1069, 1087, 1091, 1093, + 1097, 1103, 1109, 1117, 1123, 1129, 1151, 1153, 1163, 1171, 1181, + 1187, 1193, 1201, 1213, 1217, 1223, 1229, 1231, 1237, 1249, 1259, + 1277, 1279, 1283, 1289, 1291, 1297, 1301, 1303, 1307, 1319, 1321, + 1327, 1361, 1367, 1373, 1381, 1399, 1409, 1423, 1427, 1429, 1433, + 1439, 1447, 1451, 1453, 1459, 1471, 1481, 1483, 1487, 1489, 1493, + 1499, 1511, 1523, 1531, 1543, 1549, 1553, 1559, 1567, 1571, 1579, + 1583, 1597, 1601, 1607, 1609, 1613, 1619, 1621, 1627, 1637, 1657, + 1663, 1667, 1669, 1693, 1697, 1699, 1709, 1721, 1723, 1733, 1741, + 1747, 1753, 1759, 1777, 1783] + +theorem rankinCutoff1248CapTable_check : + rankinCutoff1248CapTable.check = true := by + native_decide + +theorem rankinCutoff1248CapTable_valid : + rankinCutoff1248CapTable.Valid := + (RankinPositionalCapTable.check_eq_true_iff + rankinCutoff1248CapTable).mp + rankinCutoff1248CapTable_check + +theorem rankinCutoff1248CapTable_product : + 2 ^ (2 * 1248) < rankinCutoff1248CapTable.oddPrimeFloors.prod := by + native_decide + +theorem rankinCutoff1248CapTable_length : + rankinCutoff1248CapTable.oddPrimeFloors.length = 275 := by + native_decide + +/-- Uniform support-size coverage for the proposed new cutoff. -/ +theorem jointOddPrimeList_length_lt_275_of_lt_two_pow_1248 + {p : ℕ} (hpOne : 1 < p) (hp : p < 2 ^ 1248) : + (jointOddPrimeList p).length < 275 := by + have hlength := jointOddPrimeList_length_lt_of_lt_pow_of_capTable + hpOne hp rankinCutoff1248CapTable_valid + rankinCutoff1248CapTable_product + rw [rankinCutoff1248CapTable_length] at hlength + exact hlength + +theorem jointOddPrimeList_length_le_rankinCutoff1248CapTable + {p : ℕ} (hpOne : 1 < p) (hp : p < 2 ^ 1248) : + (jointOddPrimeList p).length ≤ + rankinCutoff1248CapTable.oddPrimeFloors.length := by + exact (jointOddPrimeList_length_lt_of_lt_pow_of_capTable + hpOne hp rankinCutoff1248CapTable_valid + rankinCutoff1248CapTable_product).le + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean new file mode 100644 index 0000000000..371d95328d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean @@ -0,0 +1,116 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage + +/-! +# Certified actual Rankin profiles below `2^1248` + +The finite exponent skeleton by itself does not choose the auxiliary twelfth +root used by the Rankin inequality. This module chooses one canonically from +the side-erased witness cap. It then proves that the actual positional +profile is structurally valid, matches `p`, and is dominated by the exact +scalar summary of its skeleton representative. +-/ + +namespace BGS.NumberTheory + +namespace RankinExponentSkeleton + +/-- One more than the integral twelfth root of the joint witness cap. -/ +def jointEnvelopeRootCap (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) : Nat := + Nat.nthRoot 12 + ((skeleton.toProfile table 1).jointEnvelopeWitnessCap) + 1 + +/-- The side-erased profile with its canonical twelfth-root cap installed. -/ +def certifiedProfile (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) : RankinNeighborProfile := + skeleton.toProfile table (skeleton.jointEnvelopeRootCap table) + +@[simp] theorem certifiedProfile_jointEnvelopeWitnessCap + (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) : + (skeleton.certifiedProfile table).jointEnvelopeWitnessCap = + (skeleton.toProfile table 1).jointEnvelopeWitnessCap := by + rfl + +theorem jointEnvelopeRootCap_pos + (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) : + 0 < skeleton.jointEnvelopeRootCap table := by + exact Nat.zero_lt_succ _ + +theorem certifiedProfile_jointEnvelopeValid + (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) : + (skeleton.certifiedProfile table).JointEnvelopeValid := by + rw [RankinNeighborProfile.JointEnvelopeValid, + certifiedProfile_jointEnvelopeWitnessCap] + exact (Nat.lt_pow_nthRoot_add_one (by norm_num : Ne 12 0) + ((skeleton.toProfile table 1).jointEnvelopeWitnessCap)).le + +end RankinExponentSkeleton + +/-- The canonical matched profile of `p`, using the cap determined by its +side-erased exponent skeleton. -/ +def actualRankinProfile1248 (p : Nat) : RankinNeighborProfile := + positionalCanonicalRankinNeighborProfile p + rankinCutoff1248CapTable.twoCap + rankinCutoff1248CapTable.oddCapAt + ((actualRankinExponentSkeleton p).jointEnvelopeRootCap + rankinCutoff1248CapTable) + +/-- The corresponding exact scalar summary, computed without side labels. -/ +def actualRankinSkeletonSummary1248 (p : Nat) : + RankinJointEnvelopeSummary := + RankinJointEnvelopeSummary.ofProfile + ((actualRankinExponentSkeleton p).certifiedProfile + rankinCutoff1248CapTable) + +theorem actualRankinProfile1248_matches + {p : Nat} (hp : p < 2 ^ 1248) (hpOne : 1 < p) : + (actualRankinProfile1248 p).Matches p := by + apply positionalCanonicalRankinNeighborProfile_matches_of_capTable + rankinCutoff1248CapTable_valid + · exact jointOddPrimeList_length_le_rankinCutoff1248CapTable hpOne hp + +theorem eraseSides_actualRankinProfile1248 + (p : Nat) : + (actualRankinProfile1248 p).eraseSides = + (actualRankinExponentSkeleton p).certifiedProfile + rankinCutoff1248CapTable := by + exact eraseSides_positionalCanonicalRankinNeighborProfile p + rankinCutoff1248CapTable.twoCap + rankinCutoff1248CapTable.oddCapAt + ((actualRankinExponentSkeleton p).jointEnvelopeRootCap + rankinCutoff1248CapTable) + +theorem actualRankinProfile1248_valid + {p : Nat} (hpPrime : p.Prime) (hpTwo : 2 < p) + (hp : p < 2 ^ 1248) : + (actualRankinProfile1248 p).Valid := by + apply positionalCanonicalRankinNeighborProfile_valid_of_capTable + hpPrime hpTwo rankinCutoff1248CapTable_valid + (jointOddPrimeList_length_le_rankinCutoff1248CapTable (by omega) hp) + · exact (actualRankinExponentSkeleton p).jointEnvelopeRootCap_pos + rankinCutoff1248CapTable + · exact (actualRankinExponentSkeleton p).certifiedProfile_jointEnvelopeValid + rankinCutoff1248CapTable + +/-- The exact skeleton summary dominates the actual side-assigned profile. +This is the semantic handoff from actual primes to scalar search rows. -/ +theorem actualRankinSkeletonSummary1248_dominates + (p : Nat) : + (actualRankinSkeletonSummary1248 p).Dominates + (actualRankinProfile1248 p) := by + rw [actualRankinSkeletonSummary1248, + RankinJointEnvelopeSummary.Dominates] + rw [← eraseSides_actualRankinProfile1248 p] + simp [RankinJointEnvelopeSummary.ofProfile] + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean new file mode 100644 index 0000000000..a1723a21ba --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean @@ -0,0 +1,169 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data + +/-! +# Finite exponent skeletons below `2^1248` + +After side erasure and positional prime caps, the only varying arithmetic data +are two two-adic exponents and a list of positive odd exponents. This module +records an executable admissibility predicate. Every actual prime below the +target cutoff satisfies it, including the strong global product budget +`jointLowerNeighborProduct < 2^2496`. +-/ + +namespace BGS.NumberTheory + +structure RankinExponentSkeleton where + minusTwoExponent : ℕ + plusTwoExponent : ℕ + oddExponents : List ℕ + deriving DecidableEq, Repr + +namespace RankinExponentSkeleton + +def toProfile (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) (rootCap : ℕ) : + RankinNeighborProfile := + positionalRankinSkeletonProfile table.twoCap table.oddCapAt + skeleton.minusTwoExponent skeleton.plusTwoExponent + skeleton.oddExponents rootCap + +def TwoFactorizationShape (skeleton : RankinExponentSkeleton) : Prop := + (skeleton.minusTwoExponent = 1 ∧ + 2 ≤ skeleton.plusTwoExponent) ∨ + (skeleton.plusTwoExponent = 1 ∧ + 2 ≤ skeleton.minusTwoExponent) + +def twoFactorizationShapeCheck + (skeleton : RankinExponentSkeleton) : Bool := + (decide (skeleton.minusTwoExponent = 1) && + decide (2 ≤ skeleton.plusTwoExponent)) || + (decide (skeleton.plusTwoExponent = 1) && + decide (2 ≤ skeleton.minusTwoExponent)) + +@[simp] theorem twoFactorizationShapeCheck_eq_true_iff + (skeleton : RankinExponentSkeleton) : + skeleton.twoFactorizationShapeCheck = true ↔ + skeleton.TwoFactorizationShape := by + simp [twoFactorizationShapeCheck, TwoFactorizationShape] + +def OddExponentsPositive (skeleton : RankinExponentSkeleton) : Prop := + ∀ exponent ∈ skeleton.oddExponents, 0 < exponent + +def oddExponentsPositiveCheck (skeleton : RankinExponentSkeleton) : Bool := + skeleton.oddExponents.all fun exponent => decide (0 < exponent) + +@[simp] theorem oddExponentsPositiveCheck_eq_true_iff + (skeleton : RankinExponentSkeleton) : + skeleton.oddExponentsPositiveCheck = true ↔ + skeleton.OddExponentsPositive := by + simp [oddExponentsPositiveCheck, OddExponentsPositive] + +def Admissible (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) + (slotBound productBound : ℕ) : Prop := + skeleton.TwoFactorizationShape ∧ + skeleton.OddExponentsPositive ∧ + skeleton.oddExponents.length < slotBound ∧ + (skeleton.toProfile table 1).jointLowerNeighborProduct < productBound + +def admissibleCheck (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) + (slotBound productBound : ℕ) : Bool := + skeleton.twoFactorizationShapeCheck && + skeleton.oddExponentsPositiveCheck && + decide (skeleton.oddExponents.length < slotBound) && + decide + ((skeleton.toProfile table 1).jointLowerNeighborProduct < productBound) + +@[simp] theorem admissibleCheck_eq_true_iff + (skeleton : RankinExponentSkeleton) + (table : RankinPositionalCapTable) + (slotBound productBound : ℕ) : + skeleton.admissibleCheck table slotBound productBound = true ↔ + skeleton.Admissible table slotBound productBound := by + simp [admissibleCheck, Admissible, and_assoc] + +end RankinExponentSkeleton + +def actualRankinExponentSkeleton (p : ℕ) : RankinExponentSkeleton where + minusTwoExponent := (p - 1).factorization 2 + plusTwoExponent := (p + 1).factorization 2 + oddExponents := actualOddExponentSkeleton p + +@[simp] theorem actualRankinExponentSkeleton_toProfile + (p : ℕ) (table : RankinPositionalCapTable) (rootCap : ℕ) : + (actualRankinExponentSkeleton p).toProfile table rootCap = + positionalRankinSkeletonProfile table.twoCap table.oddCapAt + ((p - 1).factorization 2) ((p + 1).factorization 2) + (actualOddExponentSkeleton p) rootCap := by + rfl + +theorem actualRankinExponentSkeleton_oddExponentsPositive + {p : ℕ} (hpOne : 1 < p) : + (actualRankinExponentSkeleton p).OddExponentsPositive := by + intro exponent hexponent + simp only [actualRankinExponentSkeleton] at hexponent ⊢ + rw [actualOddExponentSkeleton] at hexponent + obtain ⟨prime, hprime, rfl⟩ := List.mem_map.mp hexponent + exact actualNeighborExponent_pos hpOne hprime + +theorem actualRankinExponentSkeleton_productBudget_1248 + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + (hp : p < 2 ^ 1248) : + ((actualRankinExponentSkeleton p).toProfile + rankinCutoff1248CapTable 1).jointLowerNeighborProduct < + 2 ^ (2 * 1248) := by + have hlength : (jointOddPrimeList p).length ≤ + rankinCutoff1248CapTable.oddPrimeFloors.length := by + apply jointOddPrimeList_length_le_rankinCutoff1248CapTable + · omega + · exact hp + let actualProfile := positionalCanonicalRankinNeighborProfile p + rankinCutoff1248CapTable.twoCap + rankinCutoff1248CapTable.oddCapAt 1 + have hmatch : actualProfile.Matches p := by + exact positionalCanonicalRankinNeighborProfile_matches_of_capTable + rankinCutoff1248CapTable_valid hlength 1 + have hlower := actualProfile.lowerNeighborProducts_le + hpPrime hpTwo hmatch + have hjointLower : actualProfile.jointLowerNeighborProduct ≤ + (p - 1) * (p + 1) := by + rw [RankinNeighborProfile.jointLowerNeighborProduct_eq_mul] + exact Nat.mul_le_mul hlower.1 hlower.2 + have hneighbors := neighbors_mul_lt_two_pow_two_mul (by omega) hp + have herase := eraseSides_positionalCanonicalRankinNeighborProfile p + rankinCutoff1248CapTable.twoCap + rankinCutoff1248CapTable.oddCapAt 1 + calc + ((actualRankinExponentSkeleton p).toProfile + rankinCutoff1248CapTable 1).jointLowerNeighborProduct = + actualProfile.eraseSides.jointLowerNeighborProduct := by + rw [herase] + rfl + _ = actualProfile.jointLowerNeighborProduct := by + exact RankinNeighborProfile.eraseSides_jointLowerNeighborProduct + actualProfile + _ ≤ (p - 1) * (p + 1) := hjointLower + _ < 2 ^ (2 * 1248) := hneighbors + +/-- Every actual prime below the target lies in the executable finite search +domain. This theorem is coverage, not yet the terminal leaf check. -/ +theorem actualRankinExponentSkeleton_admissible_1248 + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + (hp : p < 2 ^ 1248) : + (actualRankinExponentSkeleton p).Admissible + rankinCutoff1248CapTable 275 (2 ^ (2 * 1248)) := by + refine ⟨neighboring_twoFactorization_shape hpPrime hpTwo, + actualRankinExponentSkeleton_oddExponentsPositive (by omega), ?_, ?_⟩ + · simpa [actualRankinExponentSkeleton, actualOddExponentSkeleton] using + jointOddPrimeList_length_lt_275_of_lt_two_pow_1248 + (by omega) hp + · exact actualRankinExponentSkeleton_productBudget_1248 hpPrime hpTwo hp + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean new file mode 100644 index 0000000000..840fd02d8d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean @@ -0,0 +1,585 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate + +/-! +# Side-erased joint Rankin envelopes + +The complete profile remembers whether every odd prime power belongs to +`p - 1` or `p + 1`. Exhaustive certification should not branch over that +binary word. Multiplying the two side divisor counts, Euler products, and +factorization lower bounds erases the word. Since both side divisor counts +are at least two and both coarse Euler products are at least one, the sums +appearing in the exact-order obstruction are controlled by these products. + +This is the proof-facing arithmetic layer for a substantially smaller finite +profile search. It contains no generated data and no coverage assumption. +-/ + +namespace BGS.NumberTheory + +namespace RankinNeighborProfile + +/-- Side-free product of all odd divisor-lattice lengths. -/ +def oddJointDivisorProduct : List RankinOddFactor → ℕ + | [] => 1 + | factor :: factors => + (factor.exponent + 1) * oddJointDivisorProduct factors + +/-- Product of the divisor counts of the two neighboring factorizations, +written in a form that does not inspect any side labels. -/ +def jointDivisorProduct (profile : RankinNeighborProfile) : ℕ := + (profile.minusTwoExponent + 1) * + (profile.plusTwoExponent + 1) * + oddJointDivisorProduct profile.oddFactors + +/-- Side-free product of all odd coarse Euler factors. -/ +def oddJointCoarseEulerProductProduct : List RankinOddFactor → ℚ + | [] => 1 + | factor :: factors => + coarseRankinPrimePowerFactor factor.exponent factor.weightCap.weight * + oddJointCoarseEulerProductProduct factors + +/-- Product of the two coarse Rankin Euler products, again computed without +examining the side labels. -/ +def jointCoarseEulerProductProduct + (profile : RankinNeighborProfile) : ℚ := + coarseRankinPrimePowerFactor profile.minusTwoExponent + profile.twoWeightCap.weight * + coarseRankinPrimePowerFactor profile.plusTwoExponent + profile.twoWeightCap.weight * + oddJointCoarseEulerProductProduct profile.oddFactors + +/-- Side-free product of all odd factorization floors. -/ +def oddJointLowerNeighborProduct : List RankinOddFactor → ℕ + | [] => 1 + | factor :: factors => + factor.weightCap.lowerPrime ^ factor.exponent * + oddJointLowerNeighborProduct factors + +/-- Product of the two factorization lower bounds. -/ +def jointLowerNeighborProduct (profile : RankinNeighborProfile) : ℕ := + 2 ^ (profile.minusTwoExponent + profile.plusTwoExponent) * + oddJointLowerNeighborProduct profile.oddFactors + +/-- Side-erased witness cap. The sum of the two divisor counts is at most +their product because each neighboring even integer has at least two +divisors. -/ +def jointEnvelopeWitnessCap (profile : RankinNeighborProfile) : ℕ := + 189 * profile.jointDivisorProduct ^ 3 + +/-- The extra validity condition for the side-erased envelope. -/ +def JointEnvelopeValid (profile : RankinNeighborProfile) : Prop := + profile.jointEnvelopeWitnessCap ≤ profile.rootCap ^ 12 + +/-- Failure square after replacing both side sums by side-erased products. -/ +def jointEnvelopeFailureSquare (profile : RankinNeighborProfile) : ℚ := + ((profile.jointEnvelopeWitnessCap : ℚ) * profile.rootCap * + (2 * profile.jointCoarseEulerProductProduct)) ^ 2 + +def JointEnvelopeClosesCutoff + (profile : RankinNeighborProfile) (cutoff : ℕ) : Prop := + profile.jointEnvelopeFailureSquare < (8 * (cutoff + 1) : ℕ) + +def JointEnvelopeExcludesFailure + (profile : RankinNeighborProfile) : Prop := + profile.jointEnvelopeFailureSquare ^ 2 < + (64 * profile.jointLowerNeighborProduct : ℕ) + +def jointEnvelopeValidCheck (profile : RankinNeighborProfile) : Bool := + decide (profile.jointEnvelopeWitnessCap ≤ profile.rootCap ^ 12) + +def jointEnvelopeClosesCutoffCheck + (profile : RankinNeighborProfile) (cutoff : ℕ) : Bool := + decide + (profile.jointEnvelopeFailureSquare < + ((8 * (cutoff + 1) : ℕ) : ℚ)) + +def jointEnvelopeExcludesFailureCheck + (profile : RankinNeighborProfile) : Bool := + decide + (profile.jointEnvelopeFailureSquare ^ 2 < + ((64 * profile.jointLowerNeighborProduct : ℕ) : ℚ)) + +/-- Complete executable leaf predicate for generated side-erased profiles. -/ +def JointEnvelopeLeafValid + (profile : RankinNeighborProfile) (cutoff : ℕ) : Prop := + profile.Valid ∧ profile.JointEnvelopeValid ∧ + (profile.JointEnvelopeClosesCutoff cutoff ∨ + profile.JointEnvelopeExcludesFailure) + +def jointEnvelopeLeafCheck + (profile : RankinNeighborProfile) (cutoff : ℕ) : Bool := + profile.check && profile.jointEnvelopeValidCheck && + (profile.jointEnvelopeClosesCutoffCheck cutoff || + profile.jointEnvelopeExcludesFailureCheck) + +@[simp] theorem jointEnvelopeValidCheck_eq_true_iff + (profile : RankinNeighborProfile) : + profile.jointEnvelopeValidCheck = true ↔ + profile.JointEnvelopeValid := by + simp [jointEnvelopeValidCheck, JointEnvelopeValid] + +@[simp] theorem jointEnvelopeClosesCutoffCheck_eq_true_iff + (profile : RankinNeighborProfile) (cutoff : ℕ) : + profile.jointEnvelopeClosesCutoffCheck cutoff = true ↔ + profile.JointEnvelopeClosesCutoff cutoff := by + simp [jointEnvelopeClosesCutoffCheck, JointEnvelopeClosesCutoff] + +@[simp] theorem jointEnvelopeExcludesFailureCheck_eq_true_iff + (profile : RankinNeighborProfile) : + profile.jointEnvelopeExcludesFailureCheck = true ↔ + profile.JointEnvelopeExcludesFailure := by + simp [jointEnvelopeExcludesFailureCheck, JointEnvelopeExcludesFailure] + +@[simp] theorem jointEnvelopeLeafCheck_eq_true_iff + (profile : RankinNeighborProfile) (cutoff : ℕ) : + profile.jointEnvelopeLeafCheck cutoff = true ↔ + profile.JointEnvelopeLeafValid cutoff := by + simp [jointEnvelopeLeafCheck, JointEnvelopeLeafValid, and_assoc] + +/-- Canonical representative of an odd slot after forgetting its side. -/ +def eraseOddFactorSide (factor : RankinOddFactor) : RankinOddFactor where + side := .minus + exponent := factor.exponent + weightCap := factor.weightCap + +/-- Canonical all-minus representative of a profile. The joint envelope +checker is invariant under this operation. -/ +def eraseSides (profile : RankinNeighborProfile) : RankinNeighborProfile where + minusTwoExponent := profile.minusTwoExponent + plusTwoExponent := profile.plusTwoExponent + twoWeightCap := profile.twoWeightCap + oddFactors := profile.oddFactors.map eraseOddFactorSide + rootCap := profile.rootCap + +private theorem oddJointDivisorProduct_map_eraseOddFactorSide + (factors : List RankinOddFactor) : + oddJointDivisorProduct (factors.map eraseOddFactorSide) = + oddJointDivisorProduct factors := by + induction factors with + | nil => simp [oddJointDivisorProduct] + | cons factor factors ih => + simp [oddJointDivisorProduct, eraseOddFactorSide, ih] + +private theorem oddJointCoarseProduct_map_eraseOddFactorSide + (factors : List RankinOddFactor) : + oddJointCoarseEulerProductProduct + (factors.map eraseOddFactorSide) = + oddJointCoarseEulerProductProduct factors := by + induction factors with + | nil => simp [oddJointCoarseEulerProductProduct] + | cons factor factors ih => + simp [oddJointCoarseEulerProductProduct, eraseOddFactorSide, ih] + +private theorem oddJointLowerProduct_map_eraseOddFactorSide + (factors : List RankinOddFactor) : + oddJointLowerNeighborProduct (factors.map eraseOddFactorSide) = + oddJointLowerNeighborProduct factors := by + induction factors with + | nil => simp [oddJointLowerNeighborProduct] + | cons factor factors ih => + simp [oddJointLowerNeighborProduct, eraseOddFactorSide, ih] + +@[simp] theorem eraseSides_jointDivisorProduct + (profile : RankinNeighborProfile) : + profile.eraseSides.jointDivisorProduct = + profile.jointDivisorProduct := by + simp [eraseSides, jointDivisorProduct, + oddJointDivisorProduct_map_eraseOddFactorSide] + +@[simp] theorem eraseSides_jointCoarseEulerProductProduct + (profile : RankinNeighborProfile) : + profile.eraseSides.jointCoarseEulerProductProduct = + profile.jointCoarseEulerProductProduct := by + simp [eraseSides, jointCoarseEulerProductProduct, + oddJointCoarseProduct_map_eraseOddFactorSide] + +@[simp] theorem eraseSides_jointLowerNeighborProduct + (profile : RankinNeighborProfile) : + profile.eraseSides.jointLowerNeighborProduct = + profile.jointLowerNeighborProduct := by + simp [eraseSides, jointLowerNeighborProduct, + oddJointLowerProduct_map_eraseOddFactorSide] + +@[simp] theorem eraseSides_jointEnvelopeWitnessCap + (profile : RankinNeighborProfile) : + profile.eraseSides.jointEnvelopeWitnessCap = + profile.jointEnvelopeWitnessCap := by + simp [jointEnvelopeWitnessCap] + +@[simp] theorem eraseSides_jointEnvelopeFailureSquare + (profile : RankinNeighborProfile) : + profile.eraseSides.jointEnvelopeFailureSquare = + profile.jointEnvelopeFailureSquare := by + change + (((profile.eraseSides.jointEnvelopeWitnessCap : ℚ) * + profile.eraseSides.rootCap * + (2 * profile.eraseSides.jointCoarseEulerProductProduct)) ^ 2) = + (((profile.jointEnvelopeWitnessCap : ℚ) * profile.rootCap * + (2 * profile.jointCoarseEulerProductProduct)) ^ 2) + rw [eraseSides_jointEnvelopeWitnessCap, + eraseSides_jointCoarseEulerProductProduct] + rfl + +@[simp] theorem eraseSides_jointEnvelopeValid_iff + (profile : RankinNeighborProfile) : + profile.eraseSides.JointEnvelopeValid ↔ + profile.JointEnvelopeValid := by + change + profile.eraseSides.jointEnvelopeWitnessCap ≤ + profile.eraseSides.rootCap ^ 12 ↔ + profile.jointEnvelopeWitnessCap ≤ profile.rootCap ^ 12 + rw [eraseSides_jointEnvelopeWitnessCap] + rfl + +@[simp] theorem eraseSides_jointEnvelopeClosesCutoff_iff + (profile : RankinNeighborProfile) (cutoff : ℕ) : + profile.eraseSides.JointEnvelopeClosesCutoff cutoff ↔ + profile.JointEnvelopeClosesCutoff cutoff := by + simp [JointEnvelopeClosesCutoff] + +@[simp] theorem eraseSides_jointEnvelopeExcludesFailure_iff + (profile : RankinNeighborProfile) : + profile.eraseSides.JointEnvelopeExcludesFailure ↔ + profile.JointEnvelopeExcludesFailure := by + simp [JointEnvelopeExcludesFailure] + +private theorem allRankinOddFactorsValid_map_eraseOddFactorSide + {factors : List RankinOddFactor} + (hvalid : allRankinOddFactorsValid factors) : + allRankinOddFactorsValid (factors.map eraseOddFactorSide) := by + induction factors with + | nil => simp [allRankinOddFactorsValid] + | cons factor factors ih => + simp only [allRankinOddFactorsValid] at hvalid + simp only [List.map_cons, allRankinOddFactorsValid] + exact ⟨by simpa [RankinOddFactor.Valid, eraseOddFactorSide] using hvalid.1, + ih hvalid.2⟩ + +private theorem rankinOddFloorsStrictlyIncreasing_map_eraseOddFactorSide + {factors : List RankinOddFactor} + (hstrict : rankinOddFloorsStrictlyIncreasing factors) : + rankinOddFloorsStrictlyIncreasing + (factors.map eraseOddFactorSide) := by + rw [rankinOddFloorsStrictlyIncreasing] at hstrict ⊢ + rw [List.pairwise_map] + simpa [eraseOddFactorSide] using hstrict + +/-- Checking the canonical all-minus representative is exactly equivalent to +checking the joint arithmetic leaf of the actual side assignment. -/ +theorem jointEnvelope_leaf_of_eraseSides_leaf + (profile : RankinNeighborProfile) {cutoff : ℕ} + (hleaf : profile.eraseSides.JointEnvelopeClosesCutoff cutoff ∨ + profile.eraseSides.JointEnvelopeExcludesFailure) : + profile.JointEnvelopeClosesCutoff cutoff ∨ + profile.JointEnvelopeExcludesFailure := by + simpa using hleaf + +private theorem oddDivisorCount_pos + (side : NeighborSide) (factors : List RankinOddFactor) : + 0 < oddDivisorCount side factors := by + induction factors with + | nil => simp [oddDivisorCount] + | cons factor factors ih => + simp only [oddDivisorCount] + split_ifs <;> positivity + +private theorem oddDivisorCount_mul_eq_oddJointDivisorProduct + (factors : List RankinOddFactor) : + oddDivisorCount .minus factors * oddDivisorCount .plus factors = + oddJointDivisorProduct factors := by + induction factors with + | nil => simp [oddDivisorCount, oddJointDivisorProduct] + | cons factor factors ih => + rcases factor with ⟨side, exponent, weightCap⟩ + cases side <;> + simp only [oddDivisorCount, oddJointDivisorProduct, + reduceCtorEq, ↓reduceIte] <;> + simpa [mul_assoc, mul_left_comm, mul_comm] using + congrArg (fun value : ℕ => (exponent + 1) * value) ih + +theorem jointDivisorProduct_eq_mul + (profile : RankinNeighborProfile) : + profile.jointDivisorProduct = + profile.divisorCount .minus * profile.divisorCount .plus := by + simp only [jointDivisorProduct, divisorCount, twoExponent] + rw [← oddDivisorCount_mul_eq_oddJointDivisorProduct] + ring + +theorem two_le_divisorCount_of_shape + (profile : RankinNeighborProfile) + (hshape : + (profile.minusTwoExponent = 1 ∧ + 2 ≤ profile.plusTwoExponent) ∨ + (profile.plusTwoExponent = 1 ∧ + 2 ≤ profile.minusTwoExponent)) + (side : NeighborSide) : + 2 ≤ profile.divisorCount side := by + have htwo : 1 ≤ profile.twoExponent side := by + rcases hshape with hshape | hshape + · cases side with + | minus => simp [twoExponent, hshape.1] + | plus => simp [twoExponent]; omega + · cases side with + | minus => simp [twoExponent]; omega + | plus => simp [twoExponent, hshape.1] + simp only [divisorCount] + have hodd : 0 < oddDivisorCount side profile.oddFactors := + oddDivisorCount_pos side profile.oddFactors + nlinarith + +theorem two_le_divisorCount_of_valid + (profile : RankinNeighborProfile) (hprofile : profile.Valid) + (side : NeighborSide) : + 2 ≤ profile.divisorCount side := + profile.two_le_divisorCount_of_shape hprofile.1 side + +/-- The side divisor-count sum is bounded by the side-erased product. -/ +theorem jointDivisorCount_le_jointDivisorProduct + (profile : RankinNeighborProfile) (hprofile : profile.Valid) : + profile.jointDivisorCount ≤ profile.jointDivisorProduct := by + rw [profile.jointDivisorProduct_eq_mul] + exact Nat.add_le_mul + (profile.two_le_divisorCount_of_valid hprofile .minus) + (profile.two_le_divisorCount_of_valid hprofile .plus) + +theorem jointDivisorCount_le_jointDivisorProduct_of_shape + (profile : RankinNeighborProfile) + (hshape : + (profile.minusTwoExponent = 1 ∧ + 2 ≤ profile.plusTwoExponent) ∨ + (profile.plusTwoExponent = 1 ∧ + 2 ≤ profile.minusTwoExponent)) : + profile.jointDivisorCount ≤ profile.jointDivisorProduct := by + rw [profile.jointDivisorProduct_eq_mul] + exact Nat.add_le_mul + (profile.two_le_divisorCount_of_shape hshape .minus) + (profile.two_le_divisorCount_of_shape hshape .plus) + +theorem witnessCap_le_jointEnvelopeWitnessCap_of_shape + (profile : RankinNeighborProfile) + (hshape : + (profile.minusTwoExponent = 1 ∧ + 2 ≤ profile.plusTwoExponent) ∨ + (profile.plusTwoExponent = 1 ∧ + 2 ≤ profile.minusTwoExponent)) : + profile.witnessCap ≤ profile.jointEnvelopeWitnessCap := by + simp only [witnessCap, jointEnvelopeWitnessCap] + exact Nat.mul_le_mul_left 189 + (Nat.pow_le_pow_left + (profile.jointDivisorCount_le_jointDivisorProduct_of_shape hshape) 3) + +private theorem one_le_oddCoarseEulerProduct + (side : NeighborSide) (factors : List RankinOddFactor) : + 1 ≤ oddCoarseEulerProduct side factors := by + induction factors with + | nil => simp [oddCoarseEulerProduct] + | cons factor factors ih => + simp only [oddCoarseEulerProduct] + split_ifs with hside + · have hlocal : + (1 : ℚ) ≤ coarseRankinPrimePowerFactor factor.exponent + factor.weightCap.weight := by + simp only [coarseRankinPrimePowerFactor] + exact le_add_of_nonneg_right + (Finset.sum_nonneg fun index _ => + pow_nonneg factor.weightCap.weight_nonneg (index + 1)) + exact one_le_mul_of_one_le_of_one_le hlocal ih + · simpa using ih + +theorem one_le_coarseEulerProduct + (profile : RankinNeighborProfile) (side : NeighborSide) : + 1 ≤ profile.coarseEulerProduct side := by + simp only [coarseEulerProduct] + have htwo : + (1 : ℚ) ≤ coarseRankinPrimePowerFactor + (profile.twoExponent side) profile.twoWeightCap.weight := by + simp only [coarseRankinPrimePowerFactor] + exact le_add_of_nonneg_right + (Finset.sum_nonneg fun index _ => + pow_nonneg profile.twoWeightCap.weight_nonneg (index + 1)) + exact one_le_mul_of_one_le_of_one_le htwo + (one_le_oddCoarseEulerProduct side profile.oddFactors) + +private theorem oddCoarseEulerProduct_mul_eq_oddJointProduct + (factors : List RankinOddFactor) : + oddCoarseEulerProduct .minus factors * + oddCoarseEulerProduct .plus factors = + oddJointCoarseEulerProductProduct factors := by + induction factors with + | nil => + simp [oddCoarseEulerProduct, oddJointCoarseEulerProductProduct] + | cons factor factors ih => + rcases factor with ⟨side, exponent, weightCap⟩ + cases side <;> + simp only [oddCoarseEulerProduct, + oddJointCoarseEulerProductProduct, reduceCtorEq, ↓reduceIte] <;> + simpa [mul_assoc, mul_left_comm, mul_comm] using + congrArg (fun value : ℚ => + coarseRankinPrimePowerFactor exponent weightCap.weight * value) ih + +theorem jointCoarseEulerProductProduct_eq_mul + (profile : RankinNeighborProfile) : + profile.jointCoarseEulerProductProduct = + profile.coarseEulerProduct .minus * + profile.coarseEulerProduct .plus := by + simp only [jointCoarseEulerProductProduct, coarseEulerProduct, twoExponent] + rw [← oddCoarseEulerProduct_mul_eq_oddJointProduct] + ring + +private theorem oddLowerNeighborProduct_mul_eq_oddJointProduct + (factors : List RankinOddFactor) : + oddLowerNeighborProduct .minus factors * + oddLowerNeighborProduct .plus factors = + oddJointLowerNeighborProduct factors := by + induction factors with + | nil => + simp [oddLowerNeighborProduct, oddJointLowerNeighborProduct] + | cons factor factors ih => + rcases factor with ⟨side, exponent, weightCap⟩ + cases side <;> + simp only [oddLowerNeighborProduct, + oddJointLowerNeighborProduct, reduceCtorEq, ↓reduceIte] <;> + simpa [mul_assoc, mul_left_comm, mul_comm] using + congrArg (fun value : ℕ => + weightCap.lowerPrime ^ exponent * value) ih + +theorem jointLowerNeighborProduct_eq_mul + (profile : RankinNeighborProfile) : + profile.jointLowerNeighborProduct = + profile.lowerNeighborProduct .minus * + profile.lowerNeighborProduct .plus := by + simp only [jointLowerNeighborProduct, lowerNeighborProduct, twoExponent] + rw [← oddLowerNeighborProduct_mul_eq_oddJointProduct] + rw [pow_add] + ring + +/-- The sum of the two Euler products is at most twice their product. -/ +theorem jointCoarseEulerProduct_le_two_mul_product + (profile : RankinNeighborProfile) : + profile.jointCoarseEulerProduct ≤ + 2 * profile.jointCoarseEulerProductProduct := by + have hminus := profile.one_le_coarseEulerProduct .minus + have hplus := profile.one_le_coarseEulerProduct .plus + rw [profile.jointCoarseEulerProductProduct_eq_mul] + simp only [jointCoarseEulerProduct] + calc + profile.coarseEulerProduct .minus + + profile.coarseEulerProduct .plus ≤ + profile.coarseEulerProduct .minus * + profile.coarseEulerProduct .plus + + profile.coarseEulerProduct .minus * + profile.coarseEulerProduct .plus := by + exact add_le_add + (calc + profile.coarseEulerProduct .minus = + profile.coarseEulerProduct .minus * 1 := by ring + _ ≤ profile.coarseEulerProduct .minus * + profile.coarseEulerProduct .plus := + mul_le_mul_of_nonneg_left hplus (by linarith)) + (calc + profile.coarseEulerProduct .plus = + 1 * profile.coarseEulerProduct .plus := by ring + _ ≤ profile.coarseEulerProduct .minus * + profile.coarseEulerProduct .plus := + mul_le_mul_of_nonneg_right hminus (by linarith)) + _ = 2 * (profile.coarseEulerProduct .minus * + profile.coarseEulerProduct .plus) := by ring + +/-- The ordinary profile failure square is dominated by the side-erased +joint envelope. -/ +theorem failureSquare_le_jointEnvelopeFailureSquare + (profile : RankinNeighborProfile) (hprofile : profile.Valid) : + profile.failureSquare ≤ profile.jointEnvelopeFailureSquare := by + have hwitnessNat : + profile.witnessCap ≤ profile.jointEnvelopeWitnessCap := by + exact profile.witnessCap_le_jointEnvelopeWitnessCap_of_shape hprofile.1 + have hwitness : + (profile.witnessCap : ℚ) ≤ profile.jointEnvelopeWitnessCap := by + exact_mod_cast hwitnessNat + have hroot : (0 : ℚ) ≤ profile.rootCap := by positivity + have hEulerNonneg : + (0 : ℚ) ≤ profile.jointCoarseEulerProduct := by + have hminus := profile.one_le_coarseEulerProduct .minus + have hplus := profile.one_le_coarseEulerProduct .plus + simp only [jointCoarseEulerProduct] + linarith + have hproductEulerNonneg : + (0 : ℚ) ≤ 2 * profile.jointCoarseEulerProductProduct := by + have hminus := profile.one_le_coarseEulerProduct .minus + have hplus := profile.one_le_coarseEulerProduct .plus + rw [profile.jointCoarseEulerProductProduct_eq_mul] + exact mul_nonneg (by norm_num) + (mul_nonneg (by linarith) (by linarith)) + have hbase : + (profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct ≤ + (profile.jointEnvelopeWitnessCap : ℚ) * profile.rootCap * + (2 * profile.jointCoarseEulerProductProduct) := by + exact mul_le_mul + (mul_le_mul_of_nonneg_right hwitness hroot) + profile.jointCoarseEulerProduct_le_two_mul_product + hEulerNonneg + (mul_nonneg (by positivity) hroot) + have hleftNonneg : + (0 : ℚ) ≤ (profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct := + mul_nonneg (mul_nonneg (by positivity) hroot) hEulerNonneg + have hrightNonneg : + (0 : ℚ) ≤ (profile.jointEnvelopeWitnessCap : ℚ) * + profile.rootCap * + (2 * profile.jointCoarseEulerProductProduct) := + mul_nonneg (mul_nonneg (by positivity) hroot) hproductEulerNonneg + simpa [failureSquare, jointEnvelopeFailureSquare] using + (sq_le_sq₀ hleftNonneg hrightNonneg).2 hbase + +theorem jointEnvelopeClosesCutoff_implies_closesCutoff + (profile : RankinNeighborProfile) (hprofile : profile.Valid) + {cutoff : ℕ} (hcloses : profile.JointEnvelopeClosesCutoff cutoff) : + profile.ClosesCutoff cutoff := by + exact (profile.failureSquare_le_jointEnvelopeFailureSquare hprofile).trans_lt + hcloses + +theorem jointEnvelopeExcludesFailure_implies_excludesFailure + (profile : RankinNeighborProfile) (hprofile : profile.Valid) + (hexcludes : profile.JointEnvelopeExcludesFailure) : + profile.ExcludesFailure := by + right + right + have hsquare : + profile.failureSquare ^ 2 ≤ + profile.jointEnvelopeFailureSquare ^ 2 := + pow_le_pow_left₀ (by + rw [failureSquare] + exact sq_nonneg _) + (profile.failureSquare_le_jointEnvelopeFailureSquare hprofile) 2 + have hexcludes' := hexcludes + rw [JointEnvelopeExcludesFailure, + profile.jointLowerNeighborProduct_eq_mul] at hexcludes' + exact hsquare.trans_lt hexcludes' + +/-- A valid actual profile with a side-erased root certificate yields a valid +canonical all-minus profile. -/ +theorem eraseSides_valid_of_valid_of_jointEnvelopeValid + (profile : RankinNeighborProfile) (hprofile : profile.Valid) + (hjoint : profile.JointEnvelopeValid) : + profile.eraseSides.Valid := by + refine ⟨hprofile.1, hprofile.2.1, hprofile.2.2.1, + allRankinOddFactorsValid_map_eraseOddFactorSide hprofile.2.2.2.1, + rankinOddFloorsStrictlyIncreasing_map_eraseOddFactorSide + hprofile.2.2.2.2.1, + ?_, ?_⟩ + · simpa [eraseSides] using hprofile.2.2.2.2.2.1 + · exact + (profile.eraseSides.witnessCap_le_jointEnvelopeWitnessCap_of_shape + hprofile.1).trans + ((eraseSides_jointEnvelopeValid_iff profile).mpr hjoint) + +end RankinNeighborProfile + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean new file mode 100644 index 0000000000..4d7b7a3cee --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean @@ -0,0 +1,214 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope + +/-! +# Finite coverage for side-erased Rankin envelopes + +A generated profile need not equal the canonical profile of `p`. It is +enough that it has a larger failure square and a smaller factorization floor. +Those two inequalities transport both kinds of terminal leaf. This replaces +exact enumeration by domination: one checked profile can close an entire +family of exponent/floor skeletons. + +The certificate below contains only data. Lean checks every leaf, while a +separate coverage theorem must exhibit a dominating row for the actual +profile. Thus generated arithmetic and mathematical exhaustiveness remain +distinct proof obligations. +-/ + +namespace BGS.NumberTheory + +namespace RankinNeighborProfile + +/-- `major` is a safe arithmetic representative for `actual`: its obstruction +upper bound is no smaller, and its factorization lower bound is no larger. -/ +def JointEnvelopeDominates + (major actual : RankinNeighborProfile) : Prop := + actual.jointEnvelopeFailureSquare ≤ + major.jointEnvelopeFailureSquare ∧ + major.jointLowerNeighborProduct ≤ + actual.jointLowerNeighborProduct + +def jointEnvelopeDominatesCheck + (major actual : RankinNeighborProfile) : Bool := + decide + (actual.jointEnvelopeFailureSquare ≤ + major.jointEnvelopeFailureSquare ∧ + major.jointLowerNeighborProduct ≤ + actual.jointLowerNeighborProduct) + +@[simp] theorem jointEnvelopeDominatesCheck_eq_true_iff + (major actual : RankinNeighborProfile) : + major.jointEnvelopeDominatesCheck actual = true ↔ + major.JointEnvelopeDominates actual := by + simp [jointEnvelopeDominatesCheck, JointEnvelopeDominates] + +theorem jointEnvelopeDominates_refl + (profile : RankinNeighborProfile) : + profile.JointEnvelopeDominates profile := by + exact ⟨le_rfl, le_rfl⟩ + +theorem JointEnvelopeDominates.trans + {first middle last : RankinNeighborProfile} + (hfirst : first.JointEnvelopeDominates middle) + (hmiddle : middle.JointEnvelopeDominates last) : + first.JointEnvelopeDominates last := by + exact ⟨hmiddle.1.trans hfirst.1, hfirst.2.trans hmiddle.2⟩ + +theorem eraseSides_jointEnvelopeDominates + (profile : RankinNeighborProfile) : + profile.eraseSides.JointEnvelopeDominates profile := by + constructor + · rw [eraseSides_jointEnvelopeFailureSquare] + · rw [eraseSides_jointLowerNeighborProduct] + +theorem jointEnvelopeClosesCutoff_of_dominates + {major actual : RankinNeighborProfile} {cutoff : ℕ} + (hdom : major.JointEnvelopeDominates actual) + (hcloses : major.JointEnvelopeClosesCutoff cutoff) : + actual.JointEnvelopeClosesCutoff cutoff := by + exact hdom.1.trans_lt hcloses + +theorem jointEnvelopeExcludesFailure_of_dominates + {major actual : RankinNeighborProfile} + (hdom : major.JointEnvelopeDominates actual) + (hexcludes : major.JointEnvelopeExcludesFailure) : + actual.JointEnvelopeExcludesFailure := by + have hactualNonneg : + (0 : ℚ) ≤ actual.jointEnvelopeFailureSquare := by + rw [jointEnvelopeFailureSquare] + positivity + have hsquare : + actual.jointEnvelopeFailureSquare ^ 2 ≤ + major.jointEnvelopeFailureSquare ^ 2 := + pow_le_pow_left₀ hactualNonneg hdom.1 2 + have hlower : + ((64 * major.jointLowerNeighborProduct : ℕ) : ℚ) ≤ + ((64 * actual.jointLowerNeighborProduct : ℕ) : ℚ) := by + exact_mod_cast Nat.mul_le_mul_left 64 hdom.2 + exact hsquare.trans_lt (hexcludes.trans_le hlower) + +theorem jointEnvelope_leaf_of_dominates + {major actual : RankinNeighborProfile} {cutoff : ℕ} + (hdom : major.JointEnvelopeDominates actual) + (hleaf : major.JointEnvelopeClosesCutoff cutoff ∨ + major.JointEnvelopeExcludesFailure) : + actual.JointEnvelopeClosesCutoff cutoff ∨ + actual.JointEnvelopeExcludesFailure := by + rcases hleaf with hcloses | hexcludes + · exact Or.inl (jointEnvelopeClosesCutoff_of_dominates hdom hcloses) + · exact Or.inr (jointEnvelopeExcludesFailure_of_dominates hdom hexcludes) + +end RankinNeighborProfile + +def allRankinJointEnvelopeLeavesValid + (cutoff : ℕ) : List RankinNeighborProfile → Prop + | [] => True + | profile :: profiles => + profile.JointEnvelopeLeafValid cutoff ∧ + allRankinJointEnvelopeLeavesValid cutoff profiles + +def allRankinJointEnvelopeLeavesCheck + (cutoff : ℕ) : List RankinNeighborProfile → Bool + | [] => true + | profile :: profiles => + profile.jointEnvelopeLeafCheck cutoff && + allRankinJointEnvelopeLeavesCheck cutoff profiles + +@[simp] theorem allRankinJointEnvelopeLeavesCheck_eq_true_iff + (cutoff : ℕ) (profiles : List RankinNeighborProfile) : + allRankinJointEnvelopeLeavesCheck cutoff profiles = true ↔ + allRankinJointEnvelopeLeavesValid cutoff profiles := by + induction profiles with + | nil => + simp [allRankinJointEnvelopeLeavesCheck, + allRankinJointEnvelopeLeavesValid] + | cons profile profiles ih => + simp [allRankinJointEnvelopeLeavesCheck, + allRankinJointEnvelopeLeavesValid, ih] + +private theorem jointEnvelopeLeafValid_of_all_of_mem + {cutoff : ℕ} {profiles : List RankinNeighborProfile} + (hall : allRankinJointEnvelopeLeavesValid cutoff profiles) + {profile : RankinNeighborProfile} (hmem : profile ∈ profiles) : + profile.JointEnvelopeLeafValid cutoff := by + induction profiles with + | nil => simp at hmem + | cons head tail ih => + simp only [allRankinJointEnvelopeLeavesValid] at hall + simp only [List.mem_cons] at hmem + rcases hmem with rfl | hmem + · exact hall.1 + · exact ih hall.2 hmem + +/-- Pure generated data for a domination cover. There are deliberately no +proof fields: the list is checked by reduction, and exhaustiveness is proved +separately through `Covers`. -/ +structure RankinJointEnvelopeFiniteCertificate where + cutoff : ℕ + profiles : List RankinNeighborProfile + deriving DecidableEq, Repr + +namespace RankinJointEnvelopeFiniteCertificate + +def LeavesValid (cert : RankinJointEnvelopeFiniteCertificate) : Prop := + allRankinJointEnvelopeLeavesValid cert.cutoff cert.profiles + +def check (cert : RankinJointEnvelopeFiniteCertificate) : Bool := + allRankinJointEnvelopeLeavesCheck cert.cutoff cert.profiles + +/-- Mathematical coverage of one actual profile by the generated rows. -/ +def Covers + (cert : RankinJointEnvelopeFiniteCertificate) + (actual : RankinNeighborProfile) : Prop := + ∃ major ∈ cert.profiles, major.JointEnvelopeDominates actual + +@[simp] theorem check_eq_true_iff + (cert : RankinJointEnvelopeFiniteCertificate) : + cert.check = true ↔ cert.LeavesValid := by + simp [check, LeavesValid] + +theorem jointEnvelope_leaf_of_check_of_covers + {cert : RankinJointEnvelopeFiniteCertificate} + {actual : RankinNeighborProfile} + (hcheck : cert.check = true) (hcover : cert.Covers actual) : + actual.JointEnvelopeClosesCutoff cert.cutoff ∨ + actual.JointEnvelopeExcludesFailure := by + obtain ⟨major, hmem, hdom⟩ := hcover + have hall : cert.LeavesValid := cert.check_eq_true_iff.mp hcheck + have hmajor := jointEnvelopeLeafValid_of_all_of_mem hall hmem + exact RankinNeighborProfile.jointEnvelope_leaf_of_dominates + hdom hmajor.2.2 + +end RankinJointEnvelopeFiniteCertificate + +end BGS.NumberTheory + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- A checked finite domination cover discharges the arithmetic leaf in the +exact-order Rankin endpoint. -/ +theorem prime_le_of_rankinJointEnvelopeFiniteCertificate + {p bound : ℕ} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p ≤ (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound ≤ 189 * (middleGameMaximalOrders p bound).card ^ 3) + (actual : RankinNeighborProfile) + (hactual : actual.Valid) (hmatch : actual.Matches p) + (cert : RankinJointEnvelopeFiniteCertificate) + (hcheck : cert.check = true) (hcover : cert.Covers actual) : + p ≤ cert.cutoff := by + apply prime_le_of_matching_rankinNeighborProfile_jointEnvelope_leaf + hpPrime hpTwo hroot hboundWitness actual hactual hmatch + exact cert.jointEnvelope_leaf_of_check_of_covers hcheck hcover + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean new file mode 100644 index 0000000000..eafccdb72d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean @@ -0,0 +1,235 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage + +/-! +# Scalar summaries for Rankin-envelope coverage + +A domination leaf does not need to be a structurally valid neighbor profile. +The exact-order endpoint only uses an upper bound for the joint failure square +and a lower bound for the joint factorization product. Recording just those +two monotone quantities lets one generated row summarize a whole box of +exponent skeletons. + +The generated list remains pure data. Lean checks every terminal inequality, +while a separate coverage theorem must prove that an actual profile is +dominated by one of the summaries. +-/ + +namespace BGS.NumberTheory + +/-- The two scalar quantities needed to transport a joint-envelope leaf. -/ +structure RankinJointEnvelopeSummary where + /-- A rational upper bound for every represented failure square. -/ + failureSquareUpper : Rat + /-- A natural lower bound for every represented joint neighbor product. -/ + lowerNeighborProductFloor : Nat + deriving DecidableEq, Repr + +namespace RankinJointEnvelopeSummary + +/-- A summary safely contains an actual profile when its failure-square bound +is larger and its factorization floor is smaller. -/ +def Dominates (summary : RankinJointEnvelopeSummary) + (actual : RankinNeighborProfile) : Prop := + actual.jointEnvelopeFailureSquare <= summary.failureSquareUpper /\ + summary.lowerNeighborProductFloor <= actual.jointLowerNeighborProduct + +def dominatesCheck (summary : RankinJointEnvelopeSummary) + (actual : RankinNeighborProfile) : Bool := + decide + (actual.jointEnvelopeFailureSquare <= summary.failureSquareUpper /\ + summary.lowerNeighborProductFloor <= actual.jointLowerNeighborProduct) + +/-- Direct cutoff closure for a scalar summary. -/ +def ClosesCutoff + (summary : RankinJointEnvelopeSummary) (cutoff : Nat) : Prop := + summary.failureSquareUpper < (8 * (cutoff + 1) : Nat) + +/-- Product-budget exclusion for a scalar summary. -/ +def ExcludesFailure (summary : RankinJointEnvelopeSummary) : Prop := + summary.failureSquareUpper ^ 2 < + (64 * summary.lowerNeighborProductFloor : Nat) + +def LeafValid + (summary : RankinJointEnvelopeSummary) (cutoff : Nat) : Prop := + summary.ClosesCutoff cutoff \/ summary.ExcludesFailure + +def leafCheck + (summary : RankinJointEnvelopeSummary) (cutoff : Nat) : Bool := + decide + (summary.failureSquareUpper < (8 * (cutoff + 1) : Nat) \/ + summary.failureSquareUpper ^ 2 < + (64 * summary.lowerNeighborProductFloor : Nat)) + +@[simp] theorem dominatesCheck_eq_true_iff + (summary : RankinJointEnvelopeSummary) + (actual : RankinNeighborProfile) : + summary.dominatesCheck actual = true <-> summary.Dominates actual := by + simp [dominatesCheck, Dominates] + +@[simp] theorem leafCheck_eq_true_iff + (summary : RankinJointEnvelopeSummary) (cutoff : Nat) : + summary.leafCheck cutoff = true <-> summary.LeafValid cutoff := by + simp [leafCheck, LeafValid, ClosesCutoff, ExcludesFailure] + +/-- Every profile gives an exact scalar summary. -/ +def ofProfile (profile : RankinNeighborProfile) : + RankinJointEnvelopeSummary where + failureSquareUpper := profile.jointEnvelopeFailureSquare + lowerNeighborProductFloor := profile.jointLowerNeighborProduct + +theorem ofProfile_dominates (profile : RankinNeighborProfile) : + (ofProfile profile).Dominates profile := by + exact And.intro le_rfl le_rfl + +theorem jointEnvelopeClosesCutoff_of_dominates + {summary : RankinJointEnvelopeSummary} + {actual : RankinNeighborProfile} {cutoff : Nat} + (hdom : summary.Dominates actual) + (hcloses : summary.ClosesCutoff cutoff) : + actual.JointEnvelopeClosesCutoff cutoff := by + exact hdom.1.trans_lt hcloses + +theorem jointEnvelopeExcludesFailure_of_dominates + {summary : RankinJointEnvelopeSummary} + {actual : RankinNeighborProfile} + (hdom : summary.Dominates actual) + (hexcludes : summary.ExcludesFailure) : + actual.JointEnvelopeExcludesFailure := by + have hactualNonneg : + (0 : Rat) <= actual.jointEnvelopeFailureSquare := by + rw [RankinNeighborProfile.jointEnvelopeFailureSquare] + positivity + have hsummaryNonneg : (0 : Rat) <= summary.failureSquareUpper := + hactualNonneg.trans hdom.1 + have hsquare : + actual.jointEnvelopeFailureSquare ^ 2 <= + summary.failureSquareUpper ^ 2 := by + exact pow_le_pow_left₀ hactualNonneg hdom.1 2 + have hlower : + ((64 * summary.lowerNeighborProductFloor : Nat) : Rat) <= + ((64 * actual.jointLowerNeighborProduct : Nat) : Rat) := by + exact_mod_cast Nat.mul_le_mul_left 64 hdom.2 + exact hsquare.trans_lt (hexcludes.trans_le hlower) + +theorem jointEnvelope_leaf_of_dominates + {summary : RankinJointEnvelopeSummary} + {actual : RankinNeighborProfile} {cutoff : Nat} + (hdom : summary.Dominates actual) + (hleaf : summary.LeafValid cutoff) : + actual.JointEnvelopeClosesCutoff cutoff \/ + actual.JointEnvelopeExcludesFailure := by + rcases hleaf with hcloses | hexcludes + · exact Or.inl (jointEnvelopeClosesCutoff_of_dominates hdom hcloses) + · exact Or.inr (jointEnvelopeExcludesFailure_of_dominates hdom hexcludes) + +end RankinJointEnvelopeSummary + +def allRankinJointEnvelopeSummariesValid + (cutoff : Nat) : List RankinJointEnvelopeSummary -> Prop + | [] => True + | summary :: summaries => + summary.LeafValid cutoff /\ + allRankinJointEnvelopeSummariesValid cutoff summaries + +def allRankinJointEnvelopeSummariesCheck + (cutoff : Nat) : List RankinJointEnvelopeSummary -> Bool + | [] => true + | summary :: summaries => + summary.leafCheck cutoff && + allRankinJointEnvelopeSummariesCheck cutoff summaries + +@[simp] theorem allRankinJointEnvelopeSummariesCheck_eq_true_iff + (cutoff : Nat) (summaries : List RankinJointEnvelopeSummary) : + allRankinJointEnvelopeSummariesCheck cutoff summaries = true <-> + allRankinJointEnvelopeSummariesValid cutoff summaries := by + induction summaries with + | nil => + simp [allRankinJointEnvelopeSummariesCheck, + allRankinJointEnvelopeSummariesValid] + | cons summary summaries ih => + simp [allRankinJointEnvelopeSummariesCheck, + allRankinJointEnvelopeSummariesValid, ih] + +private theorem summaryLeafValid_of_all_of_mem + {cutoff : Nat} {summaries : List RankinJointEnvelopeSummary} + (hall : allRankinJointEnvelopeSummariesValid cutoff summaries) + {summary : RankinJointEnvelopeSummary} (hmem : summary ∈ summaries) : + summary.LeafValid cutoff := by + induction summaries with + | nil => simp at hmem + | cons head tail ih => + simp only [allRankinJointEnvelopeSummariesValid] at hall + simp only [List.mem_cons] at hmem + rcases hmem with rfl | hmem + · exact hall.1 + · exact ih hall.2 hmem + +/-- Pure scalar data for a compressed domination cover. -/ +structure RankinJointEnvelopeSummaryCertificate where + cutoff : Nat + summaries : List RankinJointEnvelopeSummary + deriving DecidableEq, Repr + +namespace RankinJointEnvelopeSummaryCertificate + +def LeavesValid (cert : RankinJointEnvelopeSummaryCertificate) : Prop := + allRankinJointEnvelopeSummariesValid cert.cutoff cert.summaries + +def check (cert : RankinJointEnvelopeSummaryCertificate) : Bool := + allRankinJointEnvelopeSummariesCheck cert.cutoff cert.summaries + +/-- Mathematical coverage of one actual profile by the generated summaries. -/ +def Covers (cert : RankinJointEnvelopeSummaryCertificate) + (actual : RankinNeighborProfile) : Prop := + Exists fun summary => + summary ∈ cert.summaries /\ summary.Dominates actual + +@[simp] theorem check_eq_true_iff + (cert : RankinJointEnvelopeSummaryCertificate) : + cert.check = true <-> cert.LeavesValid := by + simp [check, LeavesValid] + +theorem jointEnvelope_leaf_of_check_of_covers + {cert : RankinJointEnvelopeSummaryCertificate} + {actual : RankinNeighborProfile} + (hcheck : cert.check = true) (hcover : cert.Covers actual) : + actual.JointEnvelopeClosesCutoff cert.cutoff \/ + actual.JointEnvelopeExcludesFailure := by + obtain ⟨summary, hmem, hdom⟩ := hcover + have hall : cert.LeavesValid := cert.check_eq_true_iff.mp hcheck + have hsummary := summaryLeafValid_of_all_of_mem hall hmem + exact summary.jointEnvelope_leaf_of_dominates hdom hsummary + +end RankinJointEnvelopeSummaryCertificate + +end BGS.NumberTheory + +namespace BGS.Markoff + +open BGS.NumberTheory + +/-- A checked scalar summary cover discharges the arithmetic leaf without +requiring generated rows to be valid neighbor profiles. -/ +theorem prime_le_of_rankinJointEnvelopeSummaryCertificate + {p bound : Nat} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hroot : + 8 * p <= (combinedTruncatedOrderTotientSum p bound) ^ 2) + (hboundWitness : + bound <= 189 * (middleGameMaximalOrders p bound).card ^ 3) + (actual : RankinNeighborProfile) + (hactual : actual.Valid) (hmatch : actual.Matches p) + (cert : RankinJointEnvelopeSummaryCertificate) + (hcheck : cert.check = true) (hcover : cert.Covers actual) : + p <= cert.cutoff := by + apply prime_le_of_matching_rankinNeighborProfile_jointEnvelope_leaf + hpPrime hpTwo hroot hboundWitness actual hactual hmatch + exact cert.jointEnvelope_leaf_of_check_of_covers hcheck hcover + +end BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean new file mode 100644 index 0000000000..e773582923 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean @@ -0,0 +1,313 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile +import Mathlib.Data.List.GetD +import Mathlib.Data.Nat.PrimeFin + +/-! +# Finite positional cap ladders + +A finite certificate can store the first `k` odd primes as literal data. The +checker verifies each entry by primality and `primeCounting'`, so no +noncomputable prime enumeration occurs in the payload. Every increasing list +of odd primes of length at most `k` is then pointwise bounded below by this +ladder. Consequently the positional canonical profile really matches the +actual neighboring factorization. + +The remaining global coverage obligation is deliberately visible: one must +prove that the actual joint odd support has length at most the stored ladder. +-/ + +namespace BGS.NumberTheory + +open scoped Nat.Prime + +/-- A strictly increasing list of odd primes has its entry in position `i` at +least the `(i + 1)`-st prime. The initial prime `2` supplies the shift. -/ +theorem nthPrime_succ_idxOf_le_of_pairwise + (values : List ℕ) (hnodup : values.Nodup) + (hpair : values.Pairwise (· < ·)) + (hprime : ∀ q ∈ values, q.Prime) + (htwo : 2 ∉ values) {q : ℕ} (hq : q ∈ values) : + Nat.nth Nat.Prime (values.idxOf q + 1) ≤ q := by + have hqPrime : q.Prime := hprime q hq + have hqThree : 3 ≤ q := by + have hqTwo := hqPrime.two_le + have hqNeTwo : q ≠ 2 := by + intro heq + subst q + exact htwo hq + omega + let earlier := values.take (values.idxOf q) + have hearlierNodup : earlier.Nodup := hnodup.take + have htwoEarlier : 2 ∉ earlier := by + intro hmem + exact htwo (List.mem_of_mem_take hmem) + have hsubset : insert 2 earlier.toFinset ⊆ q.primesBelow := by + intro r hr + rw [Finset.mem_insert] at hr + rcases hr with rfl | hr + · exact Nat.mem_primesBelow.mpr ⟨by omega, Nat.prime_two⟩ + · have hrEarlier : r ∈ earlier := by simpa using hr + have hrValues : r ∈ values := List.mem_of_mem_take hrEarlier + have hrIndex : values.idxOf r < values.idxOf q := by + exact (List.mem_take_iff_idxOf_lt hrValues).mp hrEarlier + have hrlt : r < q := by + have hrel := hpair.rel_get_of_lt + (a := ⟨values.idxOf r, List.idxOf_lt_length_of_mem hrValues⟩) + (b := ⟨values.idxOf q, List.idxOf_lt_length_of_mem hq⟩) + hrIndex + simpa [List.getElem_idxOf + (List.idxOf_lt_length_of_mem hrValues), + List.getElem_idxOf (List.idxOf_lt_length_of_mem hq)] using hrel + exact Nat.mem_primesBelow.mpr ⟨hrlt, hprime r hrValues⟩ + have hcard := Finset.card_le_card hsubset + have hindexCard : values.idxOf q + 1 ≤ q.primeCounting' := by + simpa [earlier, Finset.card_insert_of_notMem, + htwoEarlier, List.toFinset_card_of_nodup hearlierNodup, + List.length_take, Nat.min_eq_left + (List.idxOf_lt_length_of_mem hq).le, + Nat.primesBelow_card_eq_primeCounting'] using hcard + calc + Nat.nth Nat.Prime (values.idxOf q + 1) ≤ + Nat.nth Nat.Prime q.primeCounting' := + Nat.nth_monotone Nat.infinite_setOf_prime hindexCard + _ = q := by + simpa [Nat.primeCounting'] using Nat.nth_count hqPrime + +/-- The universal positional prime bound specialized to the canonical joint +odd support of `p`. -/ +theorem nthPrime_succ_idxOf_le_jointOddPrimeList + (p : ℕ) {q : ℕ} (hq : q ∈ jointOddPrimeList p) : + Nat.nth Nat.Prime ((jointOddPrimeList p).idxOf q + 1) ≤ q := by + apply nthPrime_succ_idxOf_le_of_pairwise + (jointOddPrimeList p) + (Finset.sort_nodup (jointOddPrimeSupport p) (· ≤ ·)) + (jointOddPrimeList_pairwise_lt p) + · intro prime hprime + rcases (mem_jointOddPrimeList.mp hprime).2 with hminus | hplus + · exact Nat.prime_of_mem_primeFactors hminus + · exact Nat.prime_of_mem_primeFactors hplus + · intro htwo + exact (mem_jointOddPrimeList.mp htwo).1 rfl + · exact hq + +/-- Proof predicate for a literal prime-floor ladder, starting at prime index +`start`. -/ +def primeFloorLadderValidFrom : ℕ → List ℕ → Prop + | _, [] => True + | start, floor :: floors => + floor.Prime ∧ floor.primeCounting' = start + 1 ∧ + primeFloorLadderValidFrom (start + 1) floors + +/-- Executable checker corresponding to `primeFloorLadderValidFrom`. -/ +def primeFloorLadderCheckFrom : ℕ → List ℕ → Bool + | _, [] => true + | start, floor :: floors => + decide floor.Prime && decide (floor.primeCounting' = start + 1) && + primeFloorLadderCheckFrom (start + 1) floors + +@[simp] theorem primeFloorLadderCheckFrom_eq_true_iff + (start : ℕ) (floors : List ℕ) : + primeFloorLadderCheckFrom start floors = true ↔ + primeFloorLadderValidFrom start floors := by + induction floors generalizing start with + | nil => simp [primeFloorLadderCheckFrom, primeFloorLadderValidFrom] + | cons floor floors ih => + simp [primeFloorLadderCheckFrom, primeFloorLadderValidFrom, ih, + and_assoc] + +private theorem primeFloorLadderValidFrom_getD + {start : ℕ} {floors : List ℕ} + (hvalid : primeFloorLadderValidFrom start floors) + {index : ℕ} (hindex : index < floors.length) : + (floors.getD index 0).Prime ∧ + (floors.getD index 0).primeCounting' = start + index + 1 := by + induction floors generalizing start index with + | nil => simp at hindex + | cons floor floors ih => + cases index with + | zero => + simpa [primeFloorLadderValidFrom] using + And.intro hvalid.1 hvalid.2.1 + | succ index => + have htail : primeFloorLadderValidFrom (start + 1) floors := by + simpa [primeFloorLadderValidFrom] using hvalid.2.2 + have hindexTail : index < floors.length := by + simpa using hindex + have hdata := ih htail hindexTail + simpa [Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using hdata + +/-- Literal data used to generate all rational prime-weight caps in a +positional search. -/ +structure RankinPositionalCapTable where + precision : ℕ + oddPrimeFloors : List ℕ + deriving DecidableEq, Repr + +namespace RankinPositionalCapTable + +def Valid (table : RankinPositionalCapTable) : Prop := + 0 < table.precision ∧ + primeFloorLadderValidFrom 0 table.oddPrimeFloors + +def check (table : RankinPositionalCapTable) : Bool := + decide (0 < table.precision) && + primeFloorLadderCheckFrom 0 table.oddPrimeFloors + +@[simp] theorem check_eq_true_iff (table : RankinPositionalCapTable) : + table.check = true ↔ table.Valid := by + simp [check, Valid] + +def twoCap (table : RankinPositionalCapTable) : RationalPrimeWeightCap := + rationalPrimeWeightCapForFloor table.precision 2 + +def oddCapAt (table : RankinPositionalCapTable) + (index : ℕ) : RationalPrimeWeightCap := + rationalPrimeWeightCapForFloor table.precision + (table.oddPrimeFloors.getD index 0) + +theorem oddFloor_data_of_valid + {table : RankinPositionalCapTable} (hvalid : table.Valid) + {index : ℕ} (hindex : index < table.oddPrimeFloors.length) : + (table.oddPrimeFloors.getD index 0).Prime ∧ + (table.oddPrimeFloors.getD index 0).primeCounting' = index + 1 := by + simpa [Nat.add_assoc, Nat.add_left_comm, Nat.add_comm] using + primeFloorLadderValidFrom_getD hvalid.2 hindex + +theorem oddCapAt_lowerPrime_eq_nthPrime + {table : RankinPositionalCapTable} (hvalid : table.Valid) + {index : ℕ} (hindex : index < table.oddPrimeFloors.length) : + (table.oddCapAt index).lowerPrime = + Nat.nth Nat.Prime (index + 1) := by + have hdata := table.oddFloor_data_of_valid hvalid hindex + change table.oddPrimeFloors.getD index 0 = + Nat.nth Nat.Prime (index + 1) + calc + table.oddPrimeFloors.getD index 0 = + Nat.nth Nat.Prime + (table.oddPrimeFloors.getD index 0).primeCounting' := by + simpa [Nat.primeCounting'] using (Nat.nth_count hdata.1).symm + _ = Nat.nth Nat.Prime (index + 1) := by rw [hdata.2] + +end RankinPositionalCapTable + +/-- A checked literal prime prefix covers every actual odd support whose +length fits in the table. -/ +theorem positionalCanonicalRankinNeighborProfile_matches_of_capTable + {p : ℕ} {table : RankinPositionalCapTable} + (hvalid : table.Valid) + (hlength : (jointOddPrimeList p).length ≤ + table.oddPrimeFloors.length) + (rootCap : ℕ) : + (positionalCanonicalRankinNeighborProfile p table.twoCap + table.oddCapAt rootCap).Matches p := by + apply canonicalRankinNeighborProfile_matches + intro prime hprime + have hindexActual : (jointOddPrimeList p).idxOf prime < + (jointOddPrimeList p).length := + List.idxOf_lt_length_of_mem hprime + have hindexTable : (jointOddPrimeList p).idxOf prime < + table.oddPrimeFloors.length := hindexActual.trans_le hlength + change (table.oddCapAt ((jointOddPrimeList p).idxOf prime)).lowerPrime ≤ prime + rw [table.oddCapAt_lowerPrime_eq_nthPrime hvalid hindexTable] + exact nthPrime_succ_idxOf_le_jointOddPrimeList p hprime + +private theorem idxOf_lt_idxOf_of_pairwise_lt + (values : List ℕ) (hpair : values.Pairwise (· < ·)) + {left right : ℕ} (hleft : left ∈ values) (hright : right ∈ values) + (hlr : left < right) : + values.idxOf left < values.idxOf right := by + have hindexNe : values.idxOf left ≠ values.idxOf right := by + intro heq + have hvalueEq : left = right := (List.idxOf_inj hleft).mp heq + exact hvalueEq.not_lt hlr + have hnotReverse : ¬values.idxOf right < values.idxOf left := by + intro hreverse + have hrel := hpair.rel_get_of_lt + (a := ⟨values.idxOf right, List.idxOf_lt_length_of_mem hright⟩) + (b := ⟨values.idxOf left, List.idxOf_lt_length_of_mem hleft⟩) + hreverse + have hrightLeft : right < left := by + simpa [List.getElem_idxOf + (List.idxOf_lt_length_of_mem hright), + List.getElem_idxOf (List.idxOf_lt_length_of_mem hleft)] using hrel + exact hlr.asymm hrightLeft + omega + +theorem jointOddPrimeList_pairwise_positionalCapFloor_lt + {p : ℕ} {table : RankinPositionalCapTable} + (hvalid : table.Valid) + (hlength : (jointOddPrimeList p).length ≤ + table.oddPrimeFloors.length) : + (jointOddPrimeList p).Pairwise fun left right => + (table.oddCapAt ((jointOddPrimeList p).idxOf left)).lowerPrime < + (table.oddCapAt ((jointOddPrimeList p).idxOf right)).lowerPrime := by + apply (jointOddPrimeList_pairwise_lt p).imp_of_mem + intro left right hleft hright hlr + have hleftIndex : (jointOddPrimeList p).idxOf left < + table.oddPrimeFloors.length := + (List.idxOf_lt_length_of_mem hleft).trans_le hlength + have hrightIndex : (jointOddPrimeList p).idxOf right < + table.oddPrimeFloors.length := + (List.idxOf_lt_length_of_mem hright).trans_le hlength + rw [table.oddCapAt_lowerPrime_eq_nthPrime hvalid hleftIndex, + table.oddCapAt_lowerPrime_eq_nthPrime hvalid hrightIndex] + apply Nat.nth_strictMono Nat.infinite_setOf_prime + exact Nat.add_lt_add_right + (idxOf_lt_idxOf_of_pairwise_lt (jointOddPrimeList p) + (jointOddPrimeList_pairwise_lt p) hleft hright hlr) 1 + +/-- The table also supplies every structural validity condition for the +actual positional profile. The only profile-dependent root obligation is +stated on the side-erased exponent skeleton that the finite search checks. -/ +theorem positionalCanonicalRankinNeighborProfile_valid_of_capTable + {p rootCap : ℕ} {table : RankinPositionalCapTable} + (hpPrime : p.Prime) (hpTwo : 2 < p) + (hvalid : table.Valid) + (hlength : (jointOddPrimeList p).length ≤ + table.oddPrimeFloors.length) + (hrootPos : 0 < rootCap) + (hjointRoot : + RankinNeighborProfile.JointEnvelopeValid + (positionalRankinSkeletonProfile table.twoCap table.oddCapAt + ((p - 1).factorization 2) ((p + 1).factorization 2) + (actualOddExponentSkeleton p) rootCap)) : + (positionalCanonicalRankinNeighborProfile p table.twoCap + table.oddCapAt rootCap).Valid := by + apply canonicalRankinNeighborProfile_valid_of_jointEnvelope + hpPrime hpTwo + · exact rationalPrimeWeightCapForFloor_valid hvalid.1 (by norm_num) + · rfl + · intro prime hprime + have hindexActual : (jointOddPrimeList p).idxOf prime < + (jointOddPrimeList p).length := + List.idxOf_lt_length_of_mem hprime + have hindexTable : (jointOddPrimeList p).idxOf prime < + table.oddPrimeFloors.length := hindexActual.trans_le hlength + have hdata := table.oddFloor_data_of_valid hvalid hindexTable + change (table.oddCapAt ((jointOddPrimeList p).idxOf prime)).Valid ∧ + (table.oddCapAt + ((jointOddPrimeList p).idxOf prime)).lowerPrime.Prime ∧ + 3 ≤ (table.oddCapAt + ((jointOddPrimeList p).idxOf prime)).lowerPrime + refine ⟨?_, ?_, ?_⟩ + · exact rationalPrimeWeightCapForFloor_valid hvalid.1 hdata.1.pos + · exact hdata.1 + · rw [table.oddCapAt_lowerPrime_eq_nthPrime hvalid hindexTable] + have hbound := Nat.add_two_le_nth_prime + ((jointOddPrimeList p).idxOf prime + 1) + omega + · exact jointOddPrimeList_pairwise_positionalCapFloor_lt hvalid hlength + · exact hrootPos + · apply (RankinNeighborProfile.eraseSides_jointEnvelopeValid_iff _).mp + change (positionalCanonicalRankinNeighborProfile p table.twoCap + table.oddCapAt rootCap).eraseSides.JointEnvelopeValid + rw [eraseSides_positionalCanonicalRankinNeighborProfile] + exact hjointRoot + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean new file mode 100644 index 0000000000..1099863994 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean @@ -0,0 +1,150 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage +import Mathlib.Analysis.SpecialFunctions.Pow.NthRootLemmas +import Mathlib.Algebra.Order.Floor.Div +import Mathlib.NumberTheory.PrimeCounting +import Mathlib.Data.List.Indexes + +/-! +# Positional Rankin profiles + +The globally sorted odd support has a canonical position. We attach the +`i`-th generated cap to the `i`-th support prime, rather than selecting a cap +from the prime value. After side erasure the resulting profile is determined +only by the two-adic exponents and the list of odd exponents. + +Caps are generated by integer arithmetic. For a denominator `D` and prime +floor `q`, the numerator is one more than the integral twelfth root of +`ceil(D^12 / q)`. The extra one makes the required twelfth-power inequality +immediate and keeps the checker independent of floating-point arithmetic. +-/ + +namespace BGS.NumberTheory + +/-- Executable numerator for a rational upper approximation to +`floor ^ (-1/12)`. -/ +def rankinCapNumerator (precision floor : ℕ) : ℕ := + Nat.nthRoot 12 + (precision ^ 12 ⌈/⌉ floor) + 1 + +def rationalPrimeWeightCapForFloor + (precision floor : ℕ) : RationalPrimeWeightCap where + lowerPrime := floor + numerator := rankinCapNumerator precision floor + denominator := precision + +theorem rationalPrimeWeightCapForFloor_valid + {precision floor : ℕ} (hprecision : 0 < precision) + (hfloor : 0 < floor) : + (rationalPrimeWeightCapForFloor precision floor).Valid := by + refine ⟨hfloor, ?_, hprecision, ?_⟩ + · simp [rationalPrimeWeightCapForFloor, rankinCapNumerator] + · have hceil : + precision ^ 12 ≤ floor * (precision ^ 12 ⌈/⌉ floor) := by + simpa [nsmul_eq_mul] using + (le_smul_ceilDiv (α := ℕ) (β := ℕ) + hfloor : + precision ^ 12 ≤ floor • (precision ^ 12 ⌈/⌉ floor)) + have hroot : + (precision ^ 12 ⌈/⌉ floor) ≤ + rankinCapNumerator precision floor ^ 12 := by + exact (Nat.lt_pow_nthRoot_add_one (by norm_num : 12 ≠ 0) + (precision ^ 12 ⌈/⌉ floor)).le + exact hceil.trans (Nat.mul_le_mul_left _ hroot) + +/-- The odd factor in position `index`, with side already erased. -/ +def positionalRankinOddFactor + (oddCapAt : ℕ → RationalPrimeWeightCap) + (index exponent : ℕ) : RankinOddFactor where + side := .minus + exponent := exponent + weightCap := oddCapAt index + +/-- The finite-search representative determined by an exponent skeleton. -/ +def positionalRankinSkeletonProfile + (twoCap : RationalPrimeWeightCap) + (oddCapAt : ℕ → RationalPrimeWeightCap) + (minusTwoExponent plusTwoExponent : ℕ) + (oddExponents : List ℕ) (rootCap : ℕ) : RankinNeighborProfile where + minusTwoExponent := minusTwoExponent + plusTwoExponent := plusTwoExponent + twoWeightCap := twoCap + oddFactors := oddExponents.mapIdx + (fun index exponent => + positionalRankinOddFactor oddCapAt index exponent) + rootCap := rootCap + +/-- Position-dependent cap assignment on the actual sorted support. -/ +def positionalOddCap + (p : ℕ) (oddCapAt : ℕ → RationalPrimeWeightCap) + (prime : ℕ) : RationalPrimeWeightCap := + oddCapAt ((jointOddPrimeList p).idxOf prime) + +/-- Canonical actual profile using the same cap ladder as the skeleton +representatives. -/ +def positionalCanonicalRankinNeighborProfile + (p : ℕ) (twoCap : RationalPrimeWeightCap) + (oddCapAt : ℕ → RationalPrimeWeightCap) + (rootCap : ℕ) : RankinNeighborProfile := + canonicalRankinNeighborProfile p + twoCap (positionalOddCap p oddCapAt) rootCap + +/-- The odd exponent skeleton of the actual neighboring factorization. -/ +def actualOddExponentSkeleton (p : ℕ) : List ℕ := + (jointOddPrimeList p).map (actualNeighborExponent p) + +private theorem mapIdx_eq_map_idxOf + {α β : Type*} [BEq α] [LawfulBEq α] + (values : List α) (hnodup : values.Nodup) + (f : ℕ → α → β) : + values.mapIdx f = + values.map (fun value => f (values.idxOf value) value) := by + rw [List.mapIdx_eq_ofFn] + apply List.ext_getElem + · simp + · intro index hleft hright + simp only [List.getElem_ofFn, List.getElem_map] + congr 1 + simpa using + (List.get_idxOf hnodup ⟨index, by simpa using hleft⟩).symm + +private theorem mapIdx_map + {α β γ : Type*} (values : List α) (g : α → β) + (f : ℕ → β → γ) : + (values.map g).mapIdx f = + values.mapIdx (fun index value => f index (g value)) := by + rw [List.mapIdx_eq_ofFn, List.mapIdx_eq_ofFn] + apply List.ext_getElem + · simp + · intro index hleft hright + simp only [List.getElem_ofFn] + rw [List.get_eq_getElem, List.getElem_map, List.get_eq_getElem] + +/-- Side erasure turns the positional canonical profile into exactly the +finite-search exponent skeleton. -/ +theorem eraseSides_positionalCanonicalRankinNeighborProfile + (p : ℕ) (twoCap : RationalPrimeWeightCap) + (oddCapAt : ℕ → RationalPrimeWeightCap) (rootCap : ℕ) : + (positionalCanonicalRankinNeighborProfile + p twoCap oddCapAt rootCap).eraseSides = + positionalRankinSkeletonProfile twoCap oddCapAt + ((p - 1).factorization 2) ((p + 1).factorization 2) + (actualOddExponentSkeleton p) rootCap := by + simp only [positionalCanonicalRankinNeighborProfile, + canonicalRankinNeighborProfile, RankinNeighborProfile.eraseSides, + positionalRankinSkeletonProfile] + congr 1 + rw [actualOddExponentSkeleton, List.map_map] + rw [mapIdx_map] + rw [mapIdx_eq_map_idxOf (jointOddPrimeList p) + (Finset.sort_nodup (jointOddPrimeSupport p) (· ≤ ·))] + simp [positionalRankinOddFactor, canonicalRankinOddFactor, + RankinNeighborProfile.eraseOddFactorSide, positionalOddCap] + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean new file mode 100644 index 0000000000..6b2606a14f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean @@ -0,0 +1,155 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage +import Mathlib.Algebra.Order.BigOperators.Group.List + +/-! +# Product bounds for finite positional prime ladders + +The product of the globally sorted odd support divides, up to harmless +overlap, `(p - 1) * (p + 1)`. A checked literal prefix of the odd primes is +pointwise no larger than any support of the same length. Combining these two +facts turns one exact primorial comparison into a uniform bound on the number +of exponent slots below a power cutoff. +-/ + +open scoped BigOperators + +namespace BGS.NumberTheory + +theorem jointOddPrimeList_prod_le_neighbors_mul + {p : ℕ} (hp : 1 < p) : + (jointOddPrimeList p).prod ≤ (p - 1) * (p + 1) := by + let minusSupport := (p - 1).primeFactors + let plusSupport := (p + 1).primeFactors + have hminusProd : (∏ q ∈ minusSupport, q) ∣ p - 1 := by + simpa [minusSupport] using Nat.prod_primeFactors_dvd (p - 1) + have hplusProd : (∏ q ∈ plusSupport, q) ∣ p + 1 := by + simpa [plusSupport] using Nat.prod_primeFactors_dvd (p + 1) + have hunionProd : + (∏ q ∈ minusSupport ∪ plusSupport, q) ∣ + (∏ q ∈ minusSupport, q) * (∏ q ∈ plusSupport, q) := by + refine ⟨∏ q ∈ minusSupport ∩ plusSupport, q, ?_⟩ + simpa [mul_comm] using + (Finset.prod_union_inter (s₁ := minusSupport) (s₂ := plusSupport) + (f := fun q : ℕ => q)).symm + have heraseProd : + (∏ q ∈ (minusSupport ∪ plusSupport).erase 2, q) ∣ + ∏ q ∈ minusSupport ∪ plusSupport, q := by + apply Finset.prod_dvd_prod_of_subset + exact Finset.erase_subset 2 (minusSupport ∪ plusSupport) + have hdiv : + (∏ q ∈ (minusSupport ∪ plusSupport).erase 2, q) ∣ + (p - 1) * (p + 1) := + heraseProd.trans (hunionProd.trans (Nat.mul_dvd_mul hminusProd hplusProd)) + have hminusPositive : 0 < p - 1 := by omega + have hplusPositive : 0 < p + 1 := by omega + have hpositive : 0 < (p - 1) * (p + 1) := + Nat.mul_pos hminusPositive hplusPositive + have hle := Nat.le_of_dvd hpositive hdiv + change ((jointOddPrimeSupport p).sort (· ≤ ·)).prod ≤ + (p - 1) * (p + 1) + rw [show ((jointOddPrimeSupport p).sort (· ≤ ·)).prod = + ∏ q ∈ jointOddPrimeSupport p, q by + calc + ((jointOddPrimeSupport p).sort (· ≤ ·)).prod = + (jointOddPrimeSupport p).toList.prod := + (Finset.sort_perm_toList (jointOddPrimeSupport p) (· ≤ ·)).prod_eq + _ = ∏ q ∈ jointOddPrimeSupport p, q := + Finset.prod_toList (jointOddPrimeSupport p)] + simpa [jointOddPrimeSupport, minusSupport, plusSupport] using hle + +theorem capTable_oddPrimeFloors_prod_le_jointOddPrimeList_prod + {p : ℕ} {table : RankinPositionalCapTable} + (hvalid : table.Valid) + (hlength : table.oddPrimeFloors.length ≤ + (jointOddPrimeList p).length) : + table.oddPrimeFloors.prod ≤ (jointOddPrimeList p).prod := by + let actual := jointOddPrimeList p + have hactualNodup : actual.Nodup := + Finset.sort_nodup (jointOddPrimeSupport p) (· ≤ ·) + have hpointwise : List.Forall₂ (· ≤ ·) table.oddPrimeFloors + (actual.take table.oddPrimeFloors.length) := by + rw [List.forall₂_iff_get] + constructor + · simp [actual, List.length_take, Nat.min_eq_left hlength] + · intro index hfloorIndex htakeIndex + have hactualIndex : index < actual.length := + hfloorIndex.trans_le hlength + have hcapEq := table.oddCapAt_lowerPrime_eq_nthPrime + hvalid hfloorIndex + change table.oddPrimeFloors.getD index 0 = + Nat.nth Nat.Prime (index + 1) at hcapEq + rw [List.getD_eq_getElem table.oddPrimeFloors 0 hfloorIndex] at hcapEq + have hmember : actual.get ⟨index, hactualIndex⟩ ∈ actual := + List.get_mem actual ⟨index, hactualIndex⟩ + have hbound := nthPrime_succ_idxOf_le_jointOddPrimeList p hmember + have hindexEq : + actual.idxOf (actual.get ⟨index, hactualIndex⟩) = index := by + simpa using List.get_idxOf hactualNodup ⟨index, hactualIndex⟩ + rw [hindexEq] at hbound + have htakeEq : + (actual.take table.oddPrimeFloors.length).get + ⟨index, htakeIndex⟩ = + actual.get ⟨index, hactualIndex⟩ := by + rw [List.get_eq_getElem, List.get_eq_getElem] + exact (List.getElem_take' hactualIndex hfloorIndex).symm + rw [htakeEq] + exact hcapEq.le.trans hbound + have hprefix := hpointwise.prod_le_prod' + have htakeSublist : List.Sublist + (actual.take table.oddPrimeFloors.length) actual := + List.take_sublist _ _ + have hactualOne : ∀ prime ∈ actual, 1 ≤ prime := by + intro prime hprime + rcases (mem_jointOddPrimeList.mp hprime).2 with hminus | hplus + · exact (Nat.prime_of_mem_primeFactors hminus).one_le + · exact (Nat.prime_of_mem_primeFactors hplus).one_le + exact hprefix.trans (htakeSublist.prod_le_prod' hactualOne) + +theorem jointOddPrimeList_length_lt_of_capTable_prod_gt + {p : ℕ} {table : RankinPositionalCapTable} + (hp : 1 < p) (hvalid : table.Valid) + (hproduct : (p - 1) * (p + 1) < table.oddPrimeFloors.prod) : + (jointOddPrimeList p).length < table.oddPrimeFloors.length := by + by_contra hnot + have hlength : table.oddPrimeFloors.length ≤ + (jointOddPrimeList p).length := by omega + have htableSupport := + capTable_oddPrimeFloors_prod_le_jointOddPrimeList_prod hvalid hlength + have hsupportNeighbors := jointOddPrimeList_prod_le_neighbors_mul hp + exact (not_lt_of_ge (htableSupport.trans hsupportNeighbors)) hproduct + +theorem neighbors_mul_lt_two_pow_two_mul + {p exponent : ℕ} (hpOne : 1 < p) (hp : p < 2 ^ exponent) : + (p - 1) * (p + 1) < 2 ^ (2 * exponent) := by + have hminus : p - 1 < 2 ^ exponent := + (Nat.sub_le p 1).trans_lt hp + have hplus : p + 1 ≤ 2 ^ exponent := by omega + have hplusPos : 0 < p + 1 := by omega + have hneighbors : (p - 1) * (p + 1) < + (2 ^ exponent) * (2 ^ exponent) := + (Nat.mul_lt_mul_of_pos_right hminus hplusPos).trans_le + (Nat.mul_le_mul_left (2 ^ exponent) hplus) + have hpower : (2 ^ exponent) * (2 ^ exponent) = + 2 ^ (2 * exponent) := by + rw [← pow_add] + congr 1 + omega + rwa [hpower] at hneighbors + +theorem jointOddPrimeList_length_lt_of_lt_pow_of_capTable + {p exponent : ℕ} {table : RankinPositionalCapTable} + (hpOne : 1 < p) (hp : p < 2 ^ exponent) + (hvalid : table.Valid) + (hproduct : 2 ^ (2 * exponent) < table.oddPrimeFloors.prod) : + (jointOddPrimeList p).length < table.oddPrimeFloors.length := by + have hneighbors := neighbors_mul_lt_two_pow_two_mul hpOne hp + apply jointOddPrimeList_length_lt_of_capTable_prod_gt hpOne hvalid + exact hneighbors.trans hproduct + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean new file mode 100644 index 0000000000..06b7153660 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean @@ -0,0 +1,295 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization + +namespace BGS.NumberTheory + +structure RationalPrimeWeightCap where + lowerPrime : ℕ + numerator : ℕ + denominator : ℕ + deriving DecidableEq, Repr + +namespace RationalPrimeWeightCap + +def weight (cap : RationalPrimeWeightCap) : ℚ := + cap.numerator / cap.denominator + +def Valid (cap : RationalPrimeWeightCap) : Prop := + 0 < cap.lowerPrime ∧ + 0 < cap.numerator ∧ + 0 < cap.denominator ∧ + cap.denominator ^ 12 ≤ cap.lowerPrime * cap.numerator ^ 12 + +def check (cap : RationalPrimeWeightCap) : Bool := + decide (0 < cap.lowerPrime) && + decide (0 < cap.numerator) && + decide (0 < cap.denominator) && + decide (cap.denominator ^ 12 ≤ + cap.lowerPrime * cap.numerator ^ 12) + +@[simp] theorem check_eq_true_iff (cap : RationalPrimeWeightCap) : + cap.check = true ↔ cap.Valid := by + simp [check, Valid, and_assoc] + +theorem weight_nonneg (cap : RationalPrimeWeightCap) : + 0 ≤ cap.weight := by + exact div_nonneg (by positivity) (by positivity) + +theorem one_le_prime_mul_weight_pow_twelve + (cap : RationalPrimeWeightCap) (hcap : cap.Valid) + {prime : ℕ} (hfloor : cap.lowerPrime ≤ prime) : + 1 ≤ (prime : ℚ) * cap.weight ^ 12 := by + have hnat : + cap.denominator ^ 12 ≤ prime * cap.numerator ^ 12 := by + exact hcap.2.2.2.trans (Nat.mul_le_mul_right _ hfloor) + have hdenPos : (0 : ℚ) < cap.denominator ^ 12 := by + have : (0 : ℚ) < cap.denominator := by + exact_mod_cast hcap.2.2.1 + positivity + rw [weight, div_pow] + rw [← mul_div_assoc] + apply (le_div_iff₀ hdenPos).2 + rw [one_mul] + exact_mod_cast hnat + +end RationalPrimeWeightCap + +/-- Which neighboring group order, `p - 1` or `p + 1`, contains an odd +prime-power factor. -/ +inductive NeighborSide where + | minus + | plus + deriving DecidableEq, Repr + +/-- One globally ordered odd-prime slot in a joint factorization profile. -/ +structure RankinOddFactor where + side : NeighborSide + exponent : ℕ + weightCap : RationalPrimeWeightCap + deriving DecidableEq, Repr + +namespace RankinOddFactor + +def Valid (factor : RankinOddFactor) : Prop := + 0 < factor.exponent ∧ + factor.weightCap.Valid ∧ + factor.weightCap.lowerPrime.Prime ∧ + 3 ≤ factor.weightCap.lowerPrime + +def check (factor : RankinOddFactor) : Bool := + decide (0 < factor.exponent) && + factor.weightCap.check && + decide factor.weightCap.lowerPrime.Prime && + decide (3 ≤ factor.weightCap.lowerPrime) + +@[simp] theorem check_eq_true_iff (factor : RankinOddFactor) : + factor.check = true ↔ factor.Valid := by + simp [check, Valid, and_assoc] + +end RankinOddFactor + +def allRankinOddFactorsValid : List RankinOddFactor → Prop + | [] => True + | factor :: factors => + factor.Valid ∧ allRankinOddFactorsValid factors + +def allRankinOddFactorsCheck : List RankinOddFactor → Bool + | [] => true + | factor :: factors => + factor.check && allRankinOddFactorsCheck factors + +@[simp] theorem allRankinOddFactorsCheck_eq_true_iff + (factors : List RankinOddFactor) : + allRankinOddFactorsCheck factors = true ↔ + allRankinOddFactorsValid factors := by + induction factors with + | nil => simp [allRankinOddFactorsCheck, allRankinOddFactorsValid] + | cons factor factors ih => + simp [allRankinOddFactorsCheck, allRankinOddFactorsValid, ih] + +def rankinOddFloorsStrictlyIncreasing + (factors : List RankinOddFactor) : Prop := + factors.Pairwise fun left right => + left.weightCap.lowerPrime < right.weightCap.lowerPrime + +def rankinOddFloorsStrictlyIncreasingCheck : + List RankinOddFactor → Bool + | [] => true + | factor :: factors => + factors.all (fun later => + decide (factor.weightCap.lowerPrime < + later.weightCap.lowerPrime)) && + rankinOddFloorsStrictlyIncreasingCheck factors + +@[simp] theorem rankinOddFloorsStrictlyIncreasingCheck_eq_true_iff + (factors : List RankinOddFactor) : + rankinOddFloorsStrictlyIncreasingCheck factors = true ↔ + rankinOddFloorsStrictlyIncreasing factors := by + induction factors with + | nil => + simp [rankinOddFloorsStrictlyIncreasingCheck, + rankinOddFloorsStrictlyIncreasing] + | cons factor factors ih => + simp [rankinOddFloorsStrictlyIncreasingCheck, + rankinOddFloorsStrictlyIncreasing, ih] + +/-- The two-adic data and globally sorted odd support of a possible pair +`p - 1`, `p + 1`. -/ +structure RankinNeighborProfile where + minusTwoExponent : ℕ + plusTwoExponent : ℕ + twoWeightCap : RationalPrimeWeightCap + oddFactors : List RankinOddFactor + rootCap : ℕ + deriving DecidableEq, Repr + +namespace RankinNeighborProfile + +def twoExponent + (profile : RankinNeighborProfile) : NeighborSide → ℕ + | .minus => profile.minusTwoExponent + | .plus => profile.plusTwoExponent + +def oddDivisorCount : NeighborSide → List RankinOddFactor → ℕ + | _, [] => 1 + | side, factor :: factors => + (if factor.side = side then factor.exponent + 1 else 1) * + oddDivisorCount side factors + +def divisorCount + (profile : RankinNeighborProfile) (side : NeighborSide) : ℕ := + (profile.twoExponent side + 1) * + oddDivisorCount side profile.oddFactors + +def jointDivisorCount (profile : RankinNeighborProfile) : ℕ := + profile.divisorCount .minus + profile.divisorCount .plus + +def oddCoarseEulerProduct : + NeighborSide → List RankinOddFactor → ℚ + | _, [] => 1 + | side, factor :: factors => + (if factor.side = side then + coarseRankinPrimePowerFactor factor.exponent + factor.weightCap.weight + else 1) * + oddCoarseEulerProduct side factors + +def coarseEulerProduct + (profile : RankinNeighborProfile) (side : NeighborSide) : ℚ := + coarseRankinPrimePowerFactor (profile.twoExponent side) + profile.twoWeightCap.weight * + oddCoarseEulerProduct side profile.oddFactors + +def jointCoarseEulerProduct (profile : RankinNeighborProfile) : ℚ := + profile.coarseEulerProduct .minus + + profile.coarseEulerProduct .plus + +/-- Product lower bound contributed by the odd factors assigned to one side. -/ +def oddLowerNeighborProduct : + NeighborSide → List RankinOddFactor → ℕ + | _, [] => 1 + | side, factor :: factors => + (if factor.side = side then + factor.weightCap.lowerPrime ^ factor.exponent + else 1) * + oddLowerNeighborProduct side factors + +/-- Factorization lower bound for `p - 1` or `p + 1` represented by a +profile. Unlike the failure square, this grows exponentially in large exact +exponents and will support sound branch exclusion. -/ +def lowerNeighborProduct + (profile : RankinNeighborProfile) (side : NeighborSide) : ℕ := + 2 ^ profile.twoExponent side * + oddLowerNeighborProduct side profile.oddFactors + +def witnessCap (profile : RankinNeighborProfile) : ℕ := + 189 * profile.jointDivisorCount ^ 3 + +/-- Structural and arithmetic validity of one complete profile payload. -/ +def Valid (profile : RankinNeighborProfile) : Prop := + ((profile.minusTwoExponent = 1 ∧ + 2 ≤ profile.plusTwoExponent) ∨ + (profile.plusTwoExponent = 1 ∧ + 2 ≤ profile.minusTwoExponent)) ∧ + profile.twoWeightCap.Valid ∧ + profile.twoWeightCap.lowerPrime = 2 ∧ + allRankinOddFactorsValid profile.oddFactors ∧ + rankinOddFloorsStrictlyIncreasing profile.oddFactors ∧ + 0 < profile.rootCap ∧ + profile.witnessCap ≤ profile.rootCap ^ 12 + +/-- A profile closes a proposed cutoff when its rational failure square lies +strictly below `8 * (cutoff + 1)`. -/ +def failureSquare (profile : RankinNeighborProfile) : ℚ := + ((profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct) ^ 2 + +def ClosesCutoff + (profile : RankinNeighborProfile) (cutoff : ℕ) : Prop := + profile.failureSquare < (8 * (cutoff + 1) : ℕ) + +/-- A profile excludes the failure obstruction when one represented +neighboring product already forces `p` above the profile failure square. -/ +def ExcludesFailure (profile : RankinNeighborProfile) : Prop := + profile.failureSquare < + (8 * (profile.lowerNeighborProduct .minus + 1) : ℕ) ∨ + profile.failureSquare < + (8 * (profile.lowerNeighborProduct .plus - 1) : ℕ) ∨ + profile.failureSquare ^ 2 < + (64 * (profile.lowerNeighborProduct .minus * + profile.lowerNeighborProduct .plus) : ℕ) + +def check (profile : RankinNeighborProfile) : Bool := + (decide + ((profile.minusTwoExponent = 1 ∧ + 2 ≤ profile.plusTwoExponent) ∨ + (profile.plusTwoExponent = 1 ∧ + 2 ≤ profile.minusTwoExponent))) && + profile.twoWeightCap.check && + decide (profile.twoWeightCap.lowerPrime = 2) && + allRankinOddFactorsCheck profile.oddFactors && + rankinOddFloorsStrictlyIncreasingCheck profile.oddFactors && + decide (0 < profile.rootCap) && + decide (profile.witnessCap ≤ profile.rootCap ^ 12) + +def closesCutoffCheck + (profile : RankinNeighborProfile) (cutoff : ℕ) : Bool := + decide + ((((profile.witnessCap : ℚ) * profile.rootCap * + profile.jointCoarseEulerProduct) ^ 2) < + ((8 * (cutoff + 1) : ℕ) : ℚ)) + +def excludesFailureCheck (profile : RankinNeighborProfile) : Bool := + decide + (profile.failureSquare < + ((8 * (profile.lowerNeighborProduct .minus + 1) : ℕ) : ℚ) ∨ + profile.failureSquare < + ((8 * (profile.lowerNeighborProduct .plus - 1) : ℕ) : ℚ) ∨ + profile.failureSquare ^ 2 < + ((64 * (profile.lowerNeighborProduct .minus * + profile.lowerNeighborProduct .plus) : ℕ) : ℚ)) + +@[simp] theorem check_eq_true_iff (profile : RankinNeighborProfile) : + profile.check = true ↔ profile.Valid := by + simp [check, Valid, and_assoc] + +@[simp] theorem closesCutoffCheck_eq_true_iff + (profile : RankinNeighborProfile) (cutoff : ℕ) : + profile.closesCutoffCheck cutoff = true ↔ + profile.ClosesCutoff cutoff := by + simp [closesCutoffCheck, ClosesCutoff, failureSquare] + +@[simp] theorem excludesFailureCheck_eq_true_iff + (profile : RankinNeighborProfile) : + profile.excludesFailureCheck = true ↔ + profile.ExcludesFailure := by + simp [excludesFailureCheck, ExcludesFailure] + +end RankinNeighborProfile + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean new file mode 100644 index 0000000000..8841e04a1d --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean @@ -0,0 +1,773 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +import Mathlib.NumberTheory.ArithmeticFunction.Misc + +/-! +# Matching an actual neighboring factorization to a Rankin profile + +This file is the semantic layer between an executable profile payload and the +actual prime factorizations of `p - 1` and `p + 1`. Odd primes are placed in +one globally increasing support list. A matching assignment records, at each +actual prime, its side, exact exponent, and a rational weight cap whose lower +prime is no larger than the actual prime. +-/ + +namespace BGS.NumberTheory + +open scoped BigOperators + +/-- The odd prime support appearing in either neighboring integer. -/ +def jointOddPrimeSupport (p : ℕ) : Finset ℕ := + ((p - 1).primeFactors ∪ (p + 1).primeFactors).erase 2 + +/-- The canonical globally increasing list of odd neighboring prime factors. -/ +def jointOddPrimeList (p : ℕ) : List ℕ := + (jointOddPrimeSupport p).sort (· ≤ ·) + +@[simp] theorem mem_jointOddPrimeList {p prime : ℕ} : + prime ∈ jointOddPrimeList p ↔ + prime ≠ 2 ∧ + (prime ∈ (p - 1).primeFactors ∨ + prime ∈ (p + 1).primeFactors) := by + simp [jointOddPrimeList, jointOddPrimeSupport, and_or_left] + +/-- The neighboring side selected by an actual odd prime. -/ +def actualNeighborSide (p prime : ℕ) : NeighborSide := + if prime ∈ (p - 1).primeFactors then .minus else .plus + +/-- The exact exponent on the side selected by `actualNeighborSide`. -/ +def actualNeighborExponent (p prime : ℕ) : ℕ := + if prime ∈ (p - 1).primeFactors then + (p - 1).factorization prime + else + (p + 1).factorization prime + +namespace RankinOddFactor + +/-- One profile factor matches one actual odd neighboring prime. -/ +def Matches (factor : RankinOddFactor) (p prime : ℕ) : Prop := + factor.side = actualNeighborSide p prime ∧ + factor.exponent = actualNeighborExponent p prime ∧ + factor.weightCap.lowerPrime ≤ prime + +end RankinOddFactor + +namespace RankinNeighborProfile + +/-- A profile matches the complete actual factorization pair. The total +assignment function is harmless away from the canonical support; its map on +that support is exactly the supplied odd-factor list. -/ +def Matches (profile : RankinNeighborProfile) (p : ℕ) : Prop := + profile.minusTwoExponent = (p - 1).factorization 2 ∧ + profile.plusTwoExponent = (p + 1).factorization 2 ∧ + ∃ assignment : ℕ → RankinOddFactor, + profile.oddFactors = (jointOddPrimeList p).map assignment ∧ + ∀ prime ∈ jointOddPrimeList p, + (assignment prime).Matches p prime + +end RankinNeighborProfile + +private theorem rankinOddFactor_valid_of_allValid_of_mem + {factor : RankinOddFactor} {factors : List RankinOddFactor} + (hall : allRankinOddFactorsValid factors) + (hmem : factor ∈ factors) : + factor.Valid := by + induction factors with + | nil => simp at hmem + | cons head tail ih => + simp only [allRankinOddFactorsValid] at hall + simp only [List.mem_cons] at hmem + rcases hmem with rfl | hmem + · exact hall.1 + · exact ih hall.2 hmem + +/-- A matching assignment turns profile weight caps into a total rational +prime-weight function. Primes outside the neighboring supports get weight +one. -/ +def assignedPrimeWeight + (p : ℕ) (profile : RankinNeighborProfile) + (assignment : ℕ → RankinOddFactor) (prime : ℕ) : ℚ := + if prime = 2 then profile.twoWeightCap.weight + else if prime ∈ jointOddPrimeSupport p then + (assignment prime).weightCap.weight + else 1 + +theorem assignedPrimeWeight_nonneg + {p : ℕ} {profile : RankinNeighborProfile} + (hprofile : profile.Valid) + {assignment : ℕ → RankinOddFactor} + (hlist : + profile.oddFactors = (jointOddPrimeList p).map assignment) + (prime : ℕ) : + 0 ≤ assignedPrimeWeight p profile assignment prime := by + by_cases htwo : prime = 2 + · simp [assignedPrimeWeight, htwo, + RationalPrimeWeightCap.weight_nonneg] + by_cases hsupport : prime ∈ jointOddPrimeSupport p + · have hprimeList : prime ∈ jointOddPrimeList p := by + simpa [jointOddPrimeList] using hsupport + have hfactorMem : assignment prime ∈ profile.oddFactors := by + rw [hlist] + exact List.mem_map_of_mem hprimeList + have hfactorValid : (assignment prime).Valid := + rankinOddFactor_valid_of_allValid_of_mem hprofile.2.2.2.1 hfactorMem + simp [assignedPrimeWeight, htwo, hsupport, + RationalPrimeWeightCap.weight_nonneg] + · simp [assignedPrimeWeight, htwo, hsupport] + +theorem assignedPrimeWeight_power + {p : ℕ} {profile : RankinNeighborProfile} + (hprofile : profile.Valid) + {assignment : ℕ → RankinOddFactor} + (hlist : + profile.oddFactors = (jointOddPrimeList p).map assignment) + (hmatch : + ∀ prime ∈ jointOddPrimeList p, + (assignment prime).Matches p prime) + (prime : ℕ) (hprime : prime.Prime) : + 1 ≤ (prime : ℚ) * + (assignedPrimeWeight p profile assignment prime) ^ 12 := by + by_cases htwo : prime = 2 + · subst prime + simp only [assignedPrimeWeight, if_pos] + apply profile.twoWeightCap.one_le_prime_mul_weight_pow_twelve + hprofile.2.1 + rw [hprofile.2.2.1] + by_cases hsupport : prime ∈ jointOddPrimeSupport p + · have hprimeList : prime ∈ jointOddPrimeList p := by + simpa [jointOddPrimeList] using hsupport + have hfactorMem : assignment prime ∈ profile.oddFactors := by + rw [hlist] + exact List.mem_map_of_mem hprimeList + have hfactorValid : (assignment prime).Valid := + rankinOddFactor_valid_of_allValid_of_mem hprofile.2.2.2.1 hfactorMem + have hfloor : + (assignment prime).weightCap.lowerPrime ≤ prime := + (hmatch prime hprimeList).2.2 + simpa [assignedPrimeWeight, htwo, hsupport] using + (assignment prime).weightCap.one_le_prime_mul_weight_pow_twelve + hfactorValid.2.1 hfloor + · simp [assignedPrimeWeight, htwo, hsupport] + exact_mod_cast hprime.one_le + +private theorem jointOddPrimeList_map_prod + {M : Type*} [CommMonoid M] + (p : ℕ) (f : ℕ → M) : + ((jointOddPrimeList p).map f).prod = + ∏ prime ∈ jointOddPrimeSupport p, f prime := by + exact + (((jointOddPrimeSupport p).sort_perm_toList (· ≤ ·)).map f).prod_eq.trans + ((jointOddPrimeSupport p).prod_map_toList f) + +private theorem oddDivisorCount_map_assignment + (p : ℕ) (side : NeighborSide) + (primes : List ℕ) (assignment : ℕ → RankinOddFactor) + (hmatch : + ∀ prime ∈ primes, (assignment prime).Matches p prime) : + RankinNeighborProfile.oddDivisorCount side + (primes.map assignment) = + (primes.map fun prime => + if actualNeighborSide p prime = side then + actualNeighborExponent p prime + 1 + else 1).prod := by + induction primes with + | nil => simp [RankinNeighborProfile.oddDivisorCount] + | cons prime primes ih => + have hhead := hmatch prime (by simp) + have htail : + ∀ q ∈ primes, (assignment q).Matches p q := by + intro q hq + exact hmatch q (by simp [hq]) + simp only [List.map_cons, RankinNeighborProfile.oddDivisorCount, + List.prod_cons] + rw [ih htail] + simp [RankinOddFactor.Matches] at hhead + rw [hhead.1, hhead.2.1] + +private theorem odd_prime_not_mem_both_neighbors + {p prime : ℕ} (hp : 1 < p) (hodd : prime ≠ 2) + (hminus : prime ∈ (p - 1).primeFactors) + (hplus : prime ∈ (p + 1).primeFactors) : False := by + have hdivMinus : prime ∣ p - 1 := + Nat.dvd_of_mem_primeFactors hminus + have hdivPlus : prime ∣ p + 1 := + Nat.dvd_of_mem_primeFactors hplus + have hdivTwo : prime ∣ 2 := by + have hdiv := Nat.dvd_sub hdivPlus hdivMinus + have hsub : p + 1 - (p - 1) = 2 := by omega + simpa [hsub] using hdiv + rcases (Nat.dvd_prime Nat.prime_two).mp hdivTwo with hone | htwo + · exact (Nat.prime_of_mem_primeFactors hminus).ne_one hone + · exact hodd htwo + +private theorem jointOddPrimeList_factor_product_minus + (p : ℕ) : + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .minus then + actualNeighborExponent p prime + 1 + else 1).prod = + ∏ prime ∈ (p - 1).primeFactors.erase 2, + ((p - 1).factorization prime + 1) := by + rw [jointOddPrimeList_map_prod] + symm + calc + (∏ prime ∈ (p - 1).primeFactors.erase 2, + ((p - 1).factorization prime + 1)) = + ∏ prime ∈ (p - 1).primeFactors.erase 2, + (if actualNeighborSide p prime = .minus then + actualNeighborExponent p prime + 1 + else 1) := by + apply Finset.prod_congr rfl + intro prime hprime + have hminus : prime ∈ (p - 1).primeFactors := + Finset.mem_of_mem_erase hprime + simp [actualNeighborSide, actualNeighborExponent, hminus] + _ = ∏ prime ∈ jointOddPrimeSupport p, + (if actualNeighborSide p prime = .minus then + actualNeighborExponent p prime + 1 + else 1) := by + apply Finset.prod_subset + · intro prime hprime + simp only [jointOddPrimeSupport, Finset.mem_erase, + Finset.mem_union] + exact ⟨(Finset.mem_erase.mp hprime).1, + Or.inl (Finset.mem_of_mem_erase hprime)⟩ + · intro prime hsupport hnot + have hodd : prime ≠ 2 := by + exact (Finset.mem_erase.mp hsupport).1 + have hnotMinus : prime ∉ (p - 1).primeFactors := by + intro hminus + exact hnot (Finset.mem_erase.mpr ⟨hodd, hminus⟩) + simp [actualNeighborSide, hnotMinus] + +private theorem jointOddPrimeList_factor_product_plus + (p : ℕ) (hp : 1 < p) : + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .plus then + actualNeighborExponent p prime + 1 + else 1).prod = + ∏ prime ∈ (p + 1).primeFactors.erase 2, + ((p + 1).factorization prime + 1) := by + rw [jointOddPrimeList_map_prod] + symm + calc + (∏ prime ∈ (p + 1).primeFactors.erase 2, + ((p + 1).factorization prime + 1)) = + ∏ prime ∈ (p + 1).primeFactors.erase 2, + (if actualNeighborSide p prime = .plus then + actualNeighborExponent p prime + 1 + else 1) := by + apply Finset.prod_congr rfl + intro prime hprime + have hplus : prime ∈ (p + 1).primeFactors := + Finset.mem_of_mem_erase hprime + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hprime).1 + have hnotMinus : prime ∉ (p - 1).primeFactors := by + intro hminus + exact odd_prime_not_mem_both_neighbors hp hodd hminus hplus + simp [actualNeighborSide, actualNeighborExponent, hnotMinus] + _ = ∏ prime ∈ jointOddPrimeSupport p, + (if actualNeighborSide p prime = .plus then + actualNeighborExponent p prime + 1 + else 1) := by + apply Finset.prod_subset + · intro prime hprime + simp only [jointOddPrimeSupport, Finset.mem_erase, + Finset.mem_union] + exact ⟨(Finset.mem_erase.mp hprime).1, + Or.inr (Finset.mem_of_mem_erase hprime)⟩ + · intro prime hsupport hnot + have hodd : prime ≠ 2 := + (Finset.mem_erase.mp hsupport).1 + have hnotPlus : prime ∉ (p + 1).primeFactors := by + intro hplus + exact hnot (Finset.mem_erase.mpr ⟨hodd, hplus⟩) + have hminus : prime ∈ (p - 1).primeFactors := by + rcases (Finset.mem_union.mp + (Finset.mem_of_mem_erase hsupport)) with hminus | hplus + · exact hminus + · exact False.elim (hnotPlus hplus) + simp [actualNeighborSide, hminus] + +theorem RankinNeighborProfile.divisorCount_eq_neighborCards + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {profile : RankinNeighborProfile} + (hmatch : profile.Matches p) : + profile.divisorCount .minus = (p - 1).divisors.card ∧ + profile.divisorCount .plus = (p + 1).divisors.card := by + rcases hmatch with + ⟨hminusTwo, hplusTwo, assignment, hlist, hoddMatch⟩ + have hp : 1 < p := by omega + have hpOdd : p % 2 = 1 := + hpPrime.eq_two_or_odd.resolve_left (by omega) + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + have htwoMinus : 2 ∈ (p - 1).primeFactors := by + apply Nat.prime_two.mem_primeFactors _ hminusNe + omega + have htwoPlus : 2 ∈ (p + 1).primeFactors := by + apply Nat.prime_two.mem_primeFactors _ hplusNe + omega + constructor + · rw [Nat.card_divisors hminusNe] + rw [← Finset.mul_prod_erase + (p - 1).primeFactors (fun prime => + (p - 1).factorization prime + 1) htwoMinus] + simp only [RankinNeighborProfile.divisorCount, + RankinNeighborProfile.twoExponent, hminusTwo, hlist] + rw [oddDivisorCount_map_assignment p .minus + (jointOddPrimeList p) assignment hoddMatch] + rw [jointOddPrimeList_factor_product_minus p] + · rw [Nat.card_divisors hplusNe] + rw [← Finset.mul_prod_erase + (p + 1).primeFactors (fun prime => + (p + 1).factorization prime + 1) htwoPlus] + simp only [RankinNeighborProfile.divisorCount, + RankinNeighborProfile.twoExponent, hplusTwo, hlist] + rw [oddDivisorCount_map_assignment p .plus + (jointOddPrimeList p) assignment hoddMatch] + rw [jointOddPrimeList_factor_product_plus p hp] + +theorem RankinNeighborProfile.jointDivisorCount_eq_neighborCards + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {profile : RankinNeighborProfile} + (hmatch : profile.Matches p) : + profile.jointDivisorCount = + (p - 1).divisors.card + (p + 1).divisors.card := by + rcases profile.divisorCount_eq_neighborCards hpPrime hpTwo hmatch with + ⟨hminus, hplus⟩ + simp [RankinNeighborProfile.jointDivisorCount, hminus, hplus] + +private theorem oddLowerNeighborProduct_map_assignment_le + (p : ℕ) (side : NeighborSide) + (primes : List ℕ) (assignment : ℕ → RankinOddFactor) + (hmatch : + ∀ prime ∈ primes, (assignment prime).Matches p prime) : + RankinNeighborProfile.oddLowerNeighborProduct side + (primes.map assignment) ≤ + (primes.map fun prime => + if actualNeighborSide p prime = side then + prime ^ actualNeighborExponent p prime + else 1).prod := by + induction primes with + | nil => simp [RankinNeighborProfile.oddLowerNeighborProduct] + | cons prime primes ih => + have hhead := hmatch prime (by simp) + have htail : + ∀ q ∈ primes, (assignment q).Matches p q := by + intro q hq + exact hmatch q (by simp [hq]) + simp only [List.map_cons, + RankinNeighborProfile.oddLowerNeighborProduct, + List.prod_cons] + rw [hhead.1, hhead.2.1] + by_cases hside : actualNeighborSide p prime = side + · simp only [hside, if_pos] + exact Nat.mul_le_mul + (Nat.pow_le_pow_left hhead.2.2 _) + (ih htail) + · simpa [hside] using ih htail + +private theorem jointOddPrimeList_power_product_minus + (p : ℕ) : + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .minus then + prime ^ actualNeighborExponent p prime + else 1).prod = + ∏ prime ∈ (p - 1).primeFactors.erase 2, + prime ^ (p - 1).factorization prime := by + rw [jointOddPrimeList_map_prod] + symm + calc + (∏ prime ∈ (p - 1).primeFactors.erase 2, + prime ^ (p - 1).factorization prime) = + ∏ prime ∈ (p - 1).primeFactors.erase 2, + (if actualNeighborSide p prime = .minus then + prime ^ actualNeighborExponent p prime + else 1) := by + apply Finset.prod_congr rfl + intro prime hprime + have hminus : prime ∈ (p - 1).primeFactors := + Finset.mem_of_mem_erase hprime + simp [actualNeighborSide, actualNeighborExponent, hminus] + _ = ∏ prime ∈ jointOddPrimeSupport p, + (if actualNeighborSide p prime = .minus then + prime ^ actualNeighborExponent p prime + else 1) := by + apply Finset.prod_subset + · intro prime hprime + exact Finset.mem_erase.mpr + ⟨(Finset.mem_erase.mp hprime).1, + Finset.mem_union_left _ (Finset.mem_of_mem_erase hprime)⟩ + · intro prime hsupport hnot + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hsupport).1 + have hnotMinus : prime ∉ (p - 1).primeFactors := by + intro hminus + exact hnot (Finset.mem_erase.mpr ⟨hodd, hminus⟩) + simp [actualNeighborSide, hnotMinus] + +private theorem jointOddPrimeList_power_product_plus + (p : ℕ) (hp : 1 < p) : + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .plus then + prime ^ actualNeighborExponent p prime + else 1).prod = + ∏ prime ∈ (p + 1).primeFactors.erase 2, + prime ^ (p + 1).factorization prime := by + rw [jointOddPrimeList_map_prod] + symm + calc + (∏ prime ∈ (p + 1).primeFactors.erase 2, + prime ^ (p + 1).factorization prime) = + ∏ prime ∈ (p + 1).primeFactors.erase 2, + (if actualNeighborSide p prime = .plus then + prime ^ actualNeighborExponent p prime + else 1) := by + apply Finset.prod_congr rfl + intro prime hprime + have hplus : prime ∈ (p + 1).primeFactors := + Finset.mem_of_mem_erase hprime + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hprime).1 + have hnotMinus : prime ∉ (p - 1).primeFactors := by + intro hminus + exact odd_prime_not_mem_both_neighbors hp hodd hminus hplus + simp [actualNeighborSide, actualNeighborExponent, hnotMinus] + _ = ∏ prime ∈ jointOddPrimeSupport p, + (if actualNeighborSide p prime = .plus then + prime ^ actualNeighborExponent p prime + else 1) := by + apply Finset.prod_subset + · intro prime hprime + exact Finset.mem_erase.mpr + ⟨(Finset.mem_erase.mp hprime).1, + Finset.mem_union_right _ (Finset.mem_of_mem_erase hprime)⟩ + · intro prime hsupport hnot + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hsupport).1 + have hnotPlus : prime ∉ (p + 1).primeFactors := by + intro hplus + exact hnot (Finset.mem_erase.mpr ⟨hodd, hplus⟩) + have hminus : prime ∈ (p - 1).primeFactors := by + rcases Finset.mem_union.mp + (Finset.mem_of_mem_erase hsupport) with hminus | hplus + · exact hminus + · exact False.elim (hnotPlus hplus) + simp [actualNeighborSide, hminus] + +/-- Matching profiles give genuine lower bounds for both neighboring +integers. -/ +theorem RankinNeighborProfile.lowerNeighborProducts_le + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {profile : RankinNeighborProfile} + (hmatch : profile.Matches p) : + profile.lowerNeighborProduct .minus ≤ p - 1 ∧ + profile.lowerNeighborProduct .plus ≤ p + 1 := by + rcases hmatch with + ⟨hminusTwo, hplusTwo, assignment, hlist, hoddMatch⟩ + have hp : 1 < p := by omega + have hpOdd : p % 2 = 1 := + hpPrime.eq_two_or_odd.resolve_left (by omega) + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + have htwoMinus : 2 ∈ (p - 1).primeFactors := by + apply Nat.prime_two.mem_primeFactors _ hminusNe + omega + have htwoPlus : 2 ∈ (p + 1).primeFactors := by + apply Nat.prime_two.mem_primeFactors _ hplusNe + omega + constructor + · simp only [RankinNeighborProfile.lowerNeighborProduct, + RankinNeighborProfile.twoExponent, hminusTwo, hlist] + calc + 2 ^ (p - 1).factorization 2 * + RankinNeighborProfile.oddLowerNeighborProduct .minus + ((jointOddPrimeList p).map assignment) ≤ + 2 ^ (p - 1).factorization 2 * + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .minus then + prime ^ actualNeighborExponent p prime + else 1).prod := + Nat.mul_le_mul_left _ + (oddLowerNeighborProduct_map_assignment_le + p .minus (jointOddPrimeList p) assignment hoddMatch) + _ = 2 ^ (p - 1).factorization 2 * + ∏ prime ∈ (p - 1).primeFactors.erase 2, + prime ^ (p - 1).factorization prime := by + rw [jointOddPrimeList_power_product_minus p] + _ = ∏ prime ∈ (p - 1).primeFactors, + prime ^ (p - 1).factorization prime := + Finset.mul_prod_erase (p - 1).primeFactors + (fun prime => prime ^ (p - 1).factorization prime) htwoMinus + _ = p - 1 := (Nat.prod_primeFactors_pow_factorization hminusNe).symm + · simp only [RankinNeighborProfile.lowerNeighborProduct, + RankinNeighborProfile.twoExponent, hplusTwo, hlist] + calc + 2 ^ (p + 1).factorization 2 * + RankinNeighborProfile.oddLowerNeighborProduct .plus + ((jointOddPrimeList p).map assignment) ≤ + 2 ^ (p + 1).factorization 2 * + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .plus then + prime ^ actualNeighborExponent p prime + else 1).prod := + Nat.mul_le_mul_left _ + (oddLowerNeighborProduct_map_assignment_le + p .plus (jointOddPrimeList p) assignment hoddMatch) + _ = 2 ^ (p + 1).factorization 2 * + ∏ prime ∈ (p + 1).primeFactors.erase 2, + prime ^ (p + 1).factorization prime := by + rw [jointOddPrimeList_power_product_plus p hp] + _ = ∏ prime ∈ (p + 1).primeFactors, + prime ^ (p + 1).factorization prime := + Finset.mul_prod_erase (p + 1).primeFactors + (fun prime => prime ^ (p + 1).factorization prime) htwoPlus + _ = p + 1 := (Nat.prod_primeFactors_pow_factorization hplusNe).symm + +private theorem oddCoarseEulerProduct_map_assignment + (p : ℕ) (side : NeighborSide) + (primes : List ℕ) (assignment : ℕ → RankinOddFactor) + (hmatch : + ∀ prime ∈ primes, (assignment prime).Matches p prime) : + RankinNeighborProfile.oddCoarseEulerProduct side + (primes.map assignment) = + (primes.map fun prime => + if actualNeighborSide p prime = side then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1).prod := by + induction primes with + | nil => simp [RankinNeighborProfile.oddCoarseEulerProduct] + | cons prime primes ih => + have hhead := hmatch prime (by simp) + have htail : + ∀ q ∈ primes, (assignment q).Matches p q := by + intro q hq + exact hmatch q (by simp [hq]) + simp only [List.map_cons, + RankinNeighborProfile.oddCoarseEulerProduct, + List.prod_cons] + rw [ih htail] + simp [RankinOddFactor.Matches] at hhead + rw [hhead.1, hhead.2.1] + +private theorem jointOddPrimeList_coarse_product_minus + (p : ℕ) + (profile : RankinNeighborProfile) + (assignment : ℕ → RankinOddFactor) : + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .minus then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1).prod = + ∏ prime ∈ (p - 1).primeFactors.erase 2, + coarseRankinPrimePowerFactor ((p - 1).factorization prime) + (assignedPrimeWeight p profile assignment prime) := by + rw [jointOddPrimeList_map_prod] + symm + calc + (∏ prime ∈ (p - 1).primeFactors.erase 2, + coarseRankinPrimePowerFactor ((p - 1).factorization prime) + (assignedPrimeWeight p profile assignment prime)) = + ∏ prime ∈ (p - 1).primeFactors.erase 2, + (if actualNeighborSide p prime = .minus then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1) := by + apply Finset.prod_congr rfl + intro prime hprime + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hprime).1 + have hminus : prime ∈ (p - 1).primeFactors := + Finset.mem_of_mem_erase hprime + have hsupport : prime ∈ jointOddPrimeSupport p := by + exact Finset.mem_erase.mpr ⟨hodd, + Finset.mem_union_left _ hminus⟩ + simp [actualNeighborSide, actualNeighborExponent, + assignedPrimeWeight, hodd, hminus, hsupport] + _ = ∏ prime ∈ jointOddPrimeSupport p, + (if actualNeighborSide p prime = .minus then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1) := by + apply Finset.prod_subset + · intro prime hprime + exact Finset.mem_erase.mpr + ⟨(Finset.mem_erase.mp hprime).1, + Finset.mem_union_left _ (Finset.mem_of_mem_erase hprime)⟩ + · intro prime hsupport hnot + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hsupport).1 + have hnotMinus : prime ∉ (p - 1).primeFactors := by + intro hminus + exact hnot (Finset.mem_erase.mpr ⟨hodd, hminus⟩) + simp [actualNeighborSide, hnotMinus] + +private theorem jointOddPrimeList_coarse_product_plus + (p : ℕ) (hp : 1 < p) + (profile : RankinNeighborProfile) + (assignment : ℕ → RankinOddFactor) : + ((jointOddPrimeList p).map fun prime => + if actualNeighborSide p prime = .plus then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1).prod = + ∏ prime ∈ (p + 1).primeFactors.erase 2, + coarseRankinPrimePowerFactor ((p + 1).factorization prime) + (assignedPrimeWeight p profile assignment prime) := by + rw [jointOddPrimeList_map_prod] + symm + calc + (∏ prime ∈ (p + 1).primeFactors.erase 2, + coarseRankinPrimePowerFactor ((p + 1).factorization prime) + (assignedPrimeWeight p profile assignment prime)) = + ∏ prime ∈ (p + 1).primeFactors.erase 2, + (if actualNeighborSide p prime = .plus then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1) := by + apply Finset.prod_congr rfl + intro prime hprime + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hprime).1 + have hplus : prime ∈ (p + 1).primeFactors := + Finset.mem_of_mem_erase hprime + have hnotMinus : prime ∉ (p - 1).primeFactors := by + intro hminus + exact odd_prime_not_mem_both_neighbors hp hodd hminus hplus + have hsupport : prime ∈ jointOddPrimeSupport p := by + exact Finset.mem_erase.mpr ⟨hodd, + Finset.mem_union_right _ hplus⟩ + simp [actualNeighborSide, actualNeighborExponent, + assignedPrimeWeight, hodd, hnotMinus, hsupport] + _ = ∏ prime ∈ jointOddPrimeSupport p, + (if actualNeighborSide p prime = .plus then + coarseRankinPrimePowerFactor + (actualNeighborExponent p prime) + (assignment prime).weightCap.weight + else 1) := by + apply Finset.prod_subset + · intro prime hprime + exact Finset.mem_erase.mpr + ⟨(Finset.mem_erase.mp hprime).1, + Finset.mem_union_right _ (Finset.mem_of_mem_erase hprime)⟩ + · intro prime hsupport hnot + have hodd : prime ≠ 2 := (Finset.mem_erase.mp hsupport).1 + have hnotPlus : prime ∉ (p + 1).primeFactors := by + intro hplus + exact hnot (Finset.mem_erase.mpr ⟨hodd, hplus⟩) + have hminus : prime ∈ (p - 1).primeFactors := by + rcases Finset.mem_union.mp + (Finset.mem_of_mem_erase hsupport) with hminus | hplus + · exact hminus + · exact False.elim (hnotPlus hplus) + simp [actualNeighborSide, hminus] + +theorem RankinNeighborProfile.factorizationCoarse_eq_coarseEulerProduct + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {profile : RankinNeighborProfile} + (hmatch : profile.Matches p) : + ∃ assignment : ℕ → RankinOddFactor, + profile.oddFactors = (jointOddPrimeList p).map assignment ∧ + (∀ prime ∈ jointOddPrimeList p, + (assignment prime).Matches p prime) ∧ + (p - 1).factorization.prod (fun prime exponent => + coarseRankinPrimePowerFactor exponent + (assignedPrimeWeight p profile assignment prime)) = + profile.coarseEulerProduct .minus ∧ + (p + 1).factorization.prod (fun prime exponent => + coarseRankinPrimePowerFactor exponent + (assignedPrimeWeight p profile assignment prime)) = + profile.coarseEulerProduct .plus := by + rcases hmatch with + ⟨hminusTwo, hplusTwo, assignment, hlist, hoddMatch⟩ + have hp : 1 < p := by omega + have hpOdd : p % 2 = 1 := + hpPrime.eq_two_or_odd.resolve_left (by omega) + have hminusNe : p - 1 ≠ 0 := by omega + have hplusNe : p + 1 ≠ 0 := by omega + have htwoMinus : 2 ∈ (p - 1).primeFactors := by + apply Nat.prime_two.mem_primeFactors _ hminusNe + omega + have htwoPlus : 2 ∈ (p + 1).primeFactors := by + apply Nat.prime_two.mem_primeFactors _ hplusNe + omega + refine ⟨assignment, hlist, hoddMatch, ?_, ?_⟩ + · simp only [Finsupp.prod] + rw [Nat.support_factorization] + rw [← Finset.mul_prod_erase + (p - 1).primeFactors + (fun prime => coarseRankinPrimePowerFactor + ((p - 1).factorization prime) + (assignedPrimeWeight p profile assignment prime)) htwoMinus] + simp only [assignedPrimeWeight, if_pos, + RankinNeighborProfile.coarseEulerProduct, + RankinNeighborProfile.twoExponent, hminusTwo, hlist] + rw [oddCoarseEulerProduct_map_assignment p .minus + (jointOddPrimeList p) assignment hoddMatch] + rw [jointOddPrimeList_coarse_product_minus + p profile assignment] + rfl + · simp only [Finsupp.prod] + rw [Nat.support_factorization] + rw [← Finset.mul_prod_erase + (p + 1).primeFactors + (fun prime => coarseRankinPrimePowerFactor + ((p + 1).factorization prime) + (assignedPrimeWeight p profile assignment prime)) htwoPlus] + simp only [assignedPrimeWeight, if_pos, + RankinNeighborProfile.coarseEulerProduct, + RankinNeighborProfile.twoExponent, hplusTwo, hlist] + rw [oddCoarseEulerProduct_map_assignment p .plus + (jointOddPrimeList p) assignment hoddMatch] + rw [jointOddPrimeList_coarse_product_plus + p hp profile assignment] + rfl + +/-- A valid matching profile supplies one total rational weight assignment +whose two exact Euler products are bounded by the profile's two coarse +products. -/ +theorem RankinNeighborProfile.exists_assignedPrimeWeight_bounds + {p : ℕ} (hpPrime : p.Prime) (hpTwo : 2 < p) + {profile : RankinNeighborProfile} + (hprofile : profile.Valid) (hmatch : profile.Matches p) : + ∃ assignment : ℕ → RankinOddFactor, + (∀ prime, + 0 ≤ assignedPrimeWeight p profile assignment prime) ∧ + (∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * + (assignedPrimeWeight p profile assignment prime) ^ 12) ∧ + (p - 1).factorization.prod (fun prime exponent => + rankinPrimePowerFactor prime exponent + (assignedPrimeWeight p profile assignment prime)) ≤ + profile.coarseEulerProduct .minus ∧ + (p + 1).factorization.prod (fun prime exponent => + rankinPrimePowerFactor prime exponent + (assignedPrimeWeight p profile assignment prime)) ≤ + profile.coarseEulerProduct .plus := by + obtain ⟨assignment, hlist, hoddMatch, hminusEq, hplusEq⟩ := + profile.factorizationCoarse_eq_coarseEulerProduct + hpPrime hpTwo hmatch + have hnonneg : + ∀ prime, 0 ≤ assignedPrimeWeight p profile assignment prime := + assignedPrimeWeight_nonneg hprofile hlist + have hpower : + ∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * + (assignedPrimeWeight p profile assignment prime) ^ 12 := + assignedPrimeWeight_power hprofile hlist hoddMatch + refine ⟨assignment, hnonneg, hpower, ?_, ?_⟩ + · exact (factorizationEulerProduct_le_coarse + (p - 1) (assignedPrimeWeight p profile assignment) hnonneg).trans_eq + hminusEq + · exact (factorizationEulerProduct_le_coarse + (p + 1) (assignedPrimeWeight p profile assignment) hnonneg).trans_eq + hplusEq + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean new file mode 100644 index 0000000000..e94520ec7f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean @@ -0,0 +1,82 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import Mathlib.GroupTheory.SpecificGroups.Cyclic +import Mathlib.Tactic + +/-! +# Exact truncated order budgets in finite cyclic groups + +For a cyclic group of order `N`, the number of elements of exact order `e` +is `φ(e)` when `e ∣ N`. Summing only the non-two-torsion orders at most a +cutoff gives the exact root budget used by the improved Markoff count. +-/ + +namespace BGS.NumberTheory + +/-- Root count contributed by divisor orders strictly above two and at most +`bound`. -/ +def truncatedOrderTotientSum (N bound : ℕ) : ℕ := + ∑ order ∈ N.divisors.filter + (fun order ↦ 2 < order ∧ order ≤ bound), + order.totient + +/-- Elements whose exact order is in the non-two-torsion truncated range. -/ +noncomputable def elementsOfOrderBetweenThreeAnd + (G : Type*) [Group G] [Fintype G] (bound : ℕ) : Finset G := + Finset.univ.filter fun g ↦ 2 < orderOf g ∧ orderOf g ≤ bound + +@[simp] +theorem mem_elementsOfOrderBetweenThreeAnd_iff + {G : Type*} [Group G] [Fintype G] {bound : ℕ} {g : G} : + g ∈ elementsOfOrderBetweenThreeAnd G bound ↔ + 2 < orderOf g ∧ orderOf g ≤ bound := by + classical + simp [elementsOfOrderBetweenThreeAnd] + +/-- Exact cyclic root count for the truncated non-two-torsion order range. -/ +theorem elementsOfOrderBetweenThreeAnd_card_eq_truncatedOrderTotientSum + (G : Type*) [Group G] [Fintype G] [IsCyclic G] (bound : ℕ) : + (elementsOfOrderBetweenThreeAnd G bound).card = + truncatedOrderTotientSum (Fintype.card G) bound := by + classical + let orders := + (Fintype.card G).divisors.filter + (fun order ↦ 2 < order ∧ order ≤ bound) + have hcard : Fintype.card G ≠ 0 := Fintype.card_ne_zero + rw [elementsOfOrderBetweenThreeAnd] + rw [Finset.card_eq_sum_card_fiberwise + (t := orders) (f := orderOf) (by + intro g hg + have hgRange := (Finset.mem_filter.mp hg).2 + apply Finset.mem_filter.mpr + refine ⟨Nat.mem_divisors.mpr ⟨orderOf_dvd_card, hcard⟩, hgRange⟩)] + rw [truncatedOrderTotientSum] + change + (∑ order ∈ orders, + ((Finset.univ.filter fun g : G ↦ + 2 < orderOf g ∧ orderOf g ≤ bound).filter + fun g ↦ orderOf g = order).card) = + ∑ order ∈ orders, order.totient + apply Finset.sum_congr rfl + intro order horder + have horderData := (Finset.mem_filter.mp horder) + have horderDvd : order ∣ Fintype.card G := + (Nat.mem_divisors.mp horderData.1).1 + have hfiber : + ((Finset.univ.filter fun g : G ↦ + 2 < orderOf g ∧ orderOf g ≤ bound).filter + fun g ↦ orderOf g = order) = + Finset.univ.filter (fun g : G ↦ orderOf g = order) := by + ext g + simp only [Finset.mem_filter, Finset.mem_univ, true_and] + constructor + · exact fun hg ↦ hg.2 + · intro hg + exact ⟨by simpa [hg] using horderData.2, hg⟩ + rw [hfiber, IsCyclic.card_orderOf_eq_totient horderDvd] + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean new file mode 100644 index 0000000000..3cc7b81710 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean @@ -0,0 +1,170 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient +import Mathlib.Tactic + +/-! +# Rational Rankin bounds for truncated exact-order sums + +This isolates the analytic inequality from any particular factorization +certificate. Rational weights make every later finite certificate exactly +checkable. +-/ + +namespace BGS.NumberTheory + +/-- The weighted divisor sum used by the rational Rankin estimate. -/ +def weightedTotientDivisorSum + (N : ℕ) (weight : ℕ → ℚ) : ℚ := + ∑ order ∈ N.divisors, + (order.totient : ℚ) / order * weight order + +private theorem one_le_cap_mul_weight_of_twelfthPower + {order bound : ℕ} {weight cap : ℚ} + (horderPos : 0 < order) + (horderBound : order ≤ bound) + (hweightNonneg : 0 ≤ weight) + (hweightPower : 1 ≤ (order : ℚ) * weight ^ 12) + (hcapNonneg : 0 ≤ cap) + (hboundCap : (bound : ℚ) ≤ cap ^ 12) : + 1 ≤ cap * weight := by + have hboundNonneg : (0 : ℚ) ≤ bound := by positivity + have hproduct : + (bound : ℚ) ≤ + (order : ℚ) * (cap * weight) ^ 12 := by + calc + (bound : ℚ) = (bound : ℚ) * 1 := by ring + _ ≤ cap ^ 12 * ((order : ℚ) * weight ^ 12) := by + gcongr + _ = (order : ℚ) * (cap * weight) ^ 12 := by ring + have horderCast : (order : ℚ) ≤ bound := by + exact_mod_cast horderBound + have horderProduct : + (order : ℚ) ≤ + (order : ℚ) * (cap * weight) ^ 12 := + horderCast.trans hproduct + have hpower : (1 : ℚ) ≤ (cap * weight) ^ 12 := by + apply + (mul_le_mul_iff_right₀ + (show (0 : ℚ) < order by exact_mod_cast horderPos)).mp + simpa using horderProduct + have hcapWeightNonneg : 0 ≤ cap * weight := + mul_nonneg hcapNonneg hweightNonneg + apply + (pow_le_pow_iff_left₀ + (show (0 : ℚ) ≤ 1 by norm_num) + hcapWeightNonneg + (show (12 : ℕ) ≠ 0 by norm_num)).mp + simpa using hpower + +/-- Abstract rational-weight Rankin bound. + +For every divisor order in the truncated range, the hypotheses say that +`weight(order)` is at least its inverse twelfth root, while `cap` is at +least the twelfth root of `bound`. The conclusion bounds the exact +truncated root count by a weighted sum over all divisors of `N`. -/ +theorem truncatedOrderTotientSum_cast_le_weightedRankin + (N bound : ℕ) (weight : ℕ → ℚ) (cap : ℚ) + (hweightNonneg : + ∀ order ∈ N.divisors, 0 ≤ weight order) + (hweightPower : + ∀ order ∈ N.divisors, + 1 ≤ (order : ℚ) * (weight order) ^ 12) + (hcapNonneg : 0 ≤ cap) + (hboundCap : (bound : ℚ) ≤ cap ^ 12) : + (truncatedOrderTotientSum N bound : ℚ) ≤ + (bound : ℚ) * cap * + weightedTotientDivisorSum N weight := by + let selected := + N.divisors.filter + (fun order ↦ 2 < order ∧ order ≤ bound) + let summand : ℕ → ℚ := fun order ↦ + (order.totient : ℚ) / order * weight order + have hsummandNonneg : + ∀ order ∈ N.divisors, 0 ≤ summand order := by + intro order horder + exact mul_nonneg + (div_nonneg (by positivity) (by positivity)) + (hweightNonneg order horder) + have hselectedWeighted : + (∑ order ∈ selected, summand order) ≤ + ∑ order ∈ N.divisors, summand order := by + apply Finset.sum_le_sum_of_subset_of_nonneg + (Finset.filter_subset _ _) + intro order horder _hnotSelected + exact hsummandNonneg order horder + have hterm : + ∀ order ∈ selected, + (order.totient : ℚ) ≤ + (bound : ℚ) * cap * summand order := by + intro order horder + have horderData := (Finset.mem_filter.mp horder) + have horderDvd := (Nat.mem_divisors.mp horderData.1).1 + have hNNe := (Nat.mem_divisors.mp horderData.1).2 + have horderNe : order ≠ 0 := by + intro hzero + subst order + simp only [zero_dvd_iff] at horderDvd + exact hNNe horderDvd + have horderPos : 0 < order := Nat.pos_of_ne_zero horderNe + have hone : + (1 : ℚ) ≤ cap * weight order := + one_le_cap_mul_weight_of_twelfthPower + horderPos horderData.2.2 + (hweightNonneg order horderData.1) + (hweightPower order horderData.1) + hcapNonneg hboundCap + have horderLe : + (order : ℚ) ≤ (bound : ℚ) * cap * weight order := by + calc + (order : ℚ) ≤ bound := by exact_mod_cast horderData.2.2 + _ = (bound : ℚ) * 1 := by ring + _ ≤ (bound : ℚ) * (cap * weight order) := + mul_le_mul_of_nonneg_left hone (by positivity) + _ = (bound : ℚ) * cap * weight order := by ring + have hratioNonneg : + 0 ≤ (order.totient : ℚ) / order := + div_nonneg (by positivity) (by positivity) + calc + (order.totient : ℚ) = + ((order.totient : ℚ) / order) * order := by + rw [div_mul_cancel₀] + exact_mod_cast horderNe + _ ≤ ((order.totient : ℚ) / order) * + ((bound : ℚ) * cap * weight order) := + mul_le_mul_of_nonneg_left horderLe hratioNonneg + _ = (bound : ℚ) * cap * summand order := by + simp only [summand] + ring + have hselected : + (∑ order ∈ selected, (order.totient : ℚ)) ≤ + (bound : ℚ) * cap * + (∑ order ∈ selected, summand order) := by + calc + (∑ order ∈ selected, (order.totient : ℚ)) ≤ + ∑ order ∈ selected, + ((bound : ℚ) * cap * summand order) := + Finset.sum_le_sum hterm + _ = (bound : ℚ) * cap * + (∑ order ∈ selected, summand order) := by + rw [Finset.mul_sum] + calc + (truncatedOrderTotientSum N bound : ℚ) = + ∑ order ∈ selected, (order.totient : ℚ) := by + simp only [truncatedOrderTotientSum, selected, Nat.cast_sum] + _ ≤ (bound : ℚ) * cap * + (∑ order ∈ selected, summand order) := + hselected + _ ≤ (bound : ℚ) * cap * + (∑ order ∈ N.divisors, summand order) := + mul_le_mul_of_nonneg_left hselectedWeighted + (mul_nonneg (by positivity) hcapNonneg) + _ = (bound : ℚ) * cap * + weightedTotientDivisorSum N weight := by + simp only [weightedTotientDivisorSum, summand] + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean new file mode 100644 index 0000000000..5f6c24a3e1 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean @@ -0,0 +1,287 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin +import Mathlib.NumberTheory.ArithmeticFunction.Zeta +import Mathlib.NumberTheory.ArithmeticFunction.Misc +import Mathlib.Data.Nat.Factorization.Basic +import Mathlib.Tactic + +namespace BGS.NumberTheory + +open ArithmeticFunction +open scoped ArithmeticFunction.zeta + +/-- Completely multiplicative rational weight determined by its prime values. -/ +def factorizationWeight (primeWeight : ℕ → ℚ) (n : ℕ) : ℚ := + if n = 0 then 0 else + n.factorization.prod fun prime exponent => + (primeWeight prime) ^ exponent + +@[simp] +theorem factorizationWeight_zero (primeWeight : ℕ → ℚ) : + factorizationWeight primeWeight 0 = 0 := by + simp [factorizationWeight] + +@[simp] +theorem factorizationWeight_one (primeWeight : ℕ → ℚ) : + factorizationWeight primeWeight 1 = 1 := by + simp [factorizationWeight] + +theorem factorizationWeight_mul + (primeWeight : ℕ → ℚ) {m n : ℕ} + (hm : m ≠ 0) (hn : n ≠ 0) : + factorizationWeight primeWeight (m * n) = + factorizationWeight primeWeight m * + factorizationWeight primeWeight n := by + simp only [factorizationWeight, mul_eq_zero, hm, hn, or_false, ↓reduceIte] + rw [Nat.factorization_mul hm hn] + exact Finsupp.prod_add_index' (fun _ => pow_zero _) (fun _ => pow_add _) + +/-- The weighted totient ratio as an arithmetic function. -/ +def weightedTotientRatio + (primeWeight : ℕ → ℚ) : ArithmeticFunction ℚ := + ⟨fun n => + if n = 0 then 0 else + (n.totient : ℚ) / n * factorizationWeight primeWeight n, + by simp⟩ + +@[simp] +theorem weightedTotientRatio_apply_ne_zero + (primeWeight : ℕ → ℚ) {n : ℕ} (hn : n ≠ 0) : + weightedTotientRatio primeWeight n = + (n.totient : ℚ) / n * factorizationWeight primeWeight n := by + simp [weightedTotientRatio, hn] + +theorem weightedTotientRatio_isMultiplicative + (primeWeight : ℕ → ℚ) : + (weightedTotientRatio primeWeight).IsMultiplicative := by + refine ⟨by simp [weightedTotientRatio], ?_⟩ + intro m n hcoprime + by_cases hm : m = 0 + · subst m + simp + by_cases hn : n = 0 + · subst n + simp + simp only [weightedTotientRatio_apply_ne_zero _ hm, + weightedTotientRatio_apply_ne_zero _ hn, + weightedTotientRatio_apply_ne_zero _ (mul_ne_zero hm hn), + Nat.totient_mul hcoprime, + factorizationWeight_mul primeWeight hm hn, + Nat.cast_mul] + field_simp + +/-- Exact local Euler factor for one prime power. -/ +def rankinPrimePowerFactor + (prime exponent : ℕ) (weight : ℚ) : ℚ := + 1 + ((prime - 1 : ℕ) : ℚ) / prime * + ∑ index ∈ Finset.range exponent, weight ^ (index + 1) + +/-- Prime-independent upper local factor. Dropping `1 - 1 / prime` is +important for profile certificates: a lower bound on the prime controls the +weight, while this coarser factor is monotone-free. -/ +def coarseRankinPrimePowerFactor + (exponent : ℕ) (weight : ℚ) : ℚ := + 1 + ∑ index ∈ Finset.range exponent, weight ^ (index + 1) + +theorem rankinPrimePowerFactor_nonneg + {prime exponent : ℕ} (hprime : prime.Prime) + {weight : ℚ} (hweight : 0 ≤ weight) : + 0 ≤ rankinPrimePowerFactor prime exponent weight := by + simp only [rankinPrimePowerFactor] + positivity + +theorem rankinPrimePowerFactor_le_coarse + {prime exponent : ℕ} (hprime : prime.Prime) + {weight : ℚ} (hweight : 0 ≤ weight) : + rankinPrimePowerFactor prime exponent weight ≤ + coarseRankinPrimePowerFactor exponent weight := by + have hsumNonneg : + (0 : ℚ) ≤ + ∑ index ∈ Finset.range exponent, weight ^ (index + 1) := by + positivity + have hratio : (((prime - 1 : ℕ) : ℚ) / prime) ≤ 1 := by + apply (div_le_one (by exact_mod_cast hprime.pos)).2 + exact_mod_cast Nat.sub_le prime 1 + simp only [rankinPrimePowerFactor, coarseRankinPrimePowerFactor] + gcongr + simpa using mul_le_mul_of_nonneg_right hratio hsumNonneg + +private theorem weightedTotientRatio_primePowerSum + (prime exponent : ℕ) (hprime : prime.Prime) + (primeWeight : ℕ → ℚ) : + ∑ order ∈ (prime ^ exponent).divisors, + weightedTotientRatio primeWeight order = + rankinPrimePowerFactor prime exponent (primeWeight prime) := by + rw [Nat.sum_divisors_prime_pow hprime] + rw [Finset.sum_range_succ'] + simp only [rankinPrimePowerFactor] + rw [show weightedTotientRatio primeWeight (prime ^ 0) = 1 by + simp [weightedTotientRatio, factorizationWeight]] + rw [add_comm _ 1] + rw [add_left_cancel_iff] + rw [Finset.mul_sum] + apply Finset.sum_congr rfl + intro index hindex + simp only [weightedTotientRatio_apply_ne_zero _ + (pow_ne_zero _ hprime.ne_zero), factorizationWeight, + pow_ne_zero _ hprime.ne_zero, if_false, hprime.factorization_pow] + rw [Finsupp.prod_single_index] + rw [Nat.totient_prime_pow_succ hprime] + push_cast + field_simp [hprime.ne_zero] + ring + all_goals simp + +theorem weightedTotientDivisorSum_eq_factorizationEulerProduct + (N : ℕ) (hN : N ≠ 0) (primeWeight : ℕ → ℚ) : + weightedTotientDivisorSum N (factorizationWeight primeWeight) = + N.factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime) := by + have hmult := weightedTotientRatio_isMultiplicative primeWeight + have hzetaMult : + ((ζ : ArithmeticFunction ℕ) : ArithmeticFunction ℚ).IsMultiplicative := + ArithmeticFunction.isMultiplicative_zeta.natCast + calc + weightedTotientDivisorSum N (factorizationWeight primeWeight) = + ∑ order ∈ N.divisors, + weightedTotientRatio primeWeight order := by + apply Finset.sum_congr rfl + intro order horder + have horderNe : order ≠ 0 := + ne_zero_of_dvd_ne_zero hN (Nat.mem_divisors.mp horder).1 + simp [weightedTotientRatio_apply_ne_zero _ horderNe] + _ = (((ζ : ArithmeticFunction ℕ) : ArithmeticFunction ℚ) * + weightedTotientRatio primeWeight) N := by + rw [ArithmeticFunction.coe_zeta_mul_apply] + _ = N.factorization.prod fun prime exponent => + ((((ζ : ArithmeticFunction ℕ) : ArithmeticFunction ℚ) * + weightedTotientRatio primeWeight) (prime ^ exponent)) := by + exact (hzetaMult.mul hmult).multiplicative_factorization _ hN + _ = N.factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime) := by + apply Finsupp.prod_congr + intro prime hprime + rw [ArithmeticFunction.coe_zeta_mul_apply] + exact weightedTotientRatio_primePowerSum prime _ + (Nat.prime_of_mem_primeFactors hprime) primeWeight + +/-- Nonnegative prime weights give a nonnegative multiplicative weight on +every positive integer. -/ +theorem factorizationWeight_nonneg + (primeWeight : ℕ → ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) + (n : ℕ) : + 0 ≤ factorizationWeight primeWeight n := by + by_cases hn : n = 0 + · simp [hn] + simp only [factorizationWeight, hn, ↓reduceIte, Finsupp.prod] + apply Finset.prod_nonneg + intro prime hprime + exact pow_nonneg (hprimeWeightNonneg prime) _ + +/-- The exact Euler product is nonnegative when all supplied prime weights +are nonnegative. -/ +theorem factorizationEulerProduct_nonneg + (N : ℕ) (hN : N ≠ 0) (primeWeight : ℕ → ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) : + 0 ≤ N.factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime) := by + rw [← weightedTotientDivisorSum_eq_factorizationEulerProduct + N hN primeWeight] + apply Finset.sum_nonneg + intro order horder + exact mul_nonneg + (div_nonneg (by positivity) (by positivity)) + (factorizationWeight_nonneg primeWeight hprimeWeightNonneg order) + +/-- The exact Euler product is bounded by the product of the +prime-independent coarse local factors. -/ +theorem factorizationEulerProduct_le_coarse + (N : ℕ) (primeWeight : ℕ → ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) : + (N.factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime)) ≤ + (N.factorization.prod fun prime exponent => + coarseRankinPrimePowerFactor exponent (primeWeight prime)) := by + simp only [Finsupp.prod] + apply Finset.prod_le_prod + · intro prime hprime + exact rankinPrimePowerFactor_nonneg + (Nat.prime_of_mem_primeFactors hprime) + (hprimeWeightNonneg prime) + · intro prime hprime + exact rankinPrimePowerFactor_le_coarse + (Nat.prime_of_mem_primeFactors hprime) + (hprimeWeightNonneg prime) + +/-- A primewise twelfth-power lower bound multiplies to the exact Rankin +weight hypothesis for every positive integer. -/ +theorem factorizationWeight_twelfthPower + (primeWeight : ℕ → ℚ) + (hprimeWeightPower : + ∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * (primeWeight prime) ^ 12) + {n : ℕ} (hn : n ≠ 0) : + 1 ≤ (n : ℚ) * (factorizationWeight primeWeight n) ^ 12 := by + have hnCast : + (n : ℚ) = n.factorization.prod fun prime exponent => + (prime : ℚ) ^ exponent := by + calc + (n : ℚ) = + ((n.factorization.prod fun prime exponent => + prime ^ exponent : ℕ) : ℚ) := by + exact congrArg (fun value : ℕ => (value : ℚ)) + (Nat.prod_factorization_pow_eq_self hn).symm + _ = n.factorization.prod fun prime exponent => + (prime : ℚ) ^ exponent := by + push_cast + rfl + rw [hnCast] + simp only [factorizationWeight, hn, ↓reduceIte, Finsupp.prod] + rw [← Finset.prod_pow, ← Finset.prod_mul_distrib] + apply Finset.one_le_prod + intro prime hprime + rw [show (prime : ℚ) ^ n.factorization prime * + (primeWeight prime ^ n.factorization prime) ^ 12 = + ((prime : ℚ) * primeWeight prime ^ 12) ^ + n.factorization prime by + rw [mul_pow] + congr 1 + rw [← pow_mul, ← pow_mul, Nat.mul_comm]] + exact one_le_pow₀ + (hprimeWeightPower prime (Nat.prime_of_mem_primeFactors hprime)) + +/-- Primewise rational weights specialize the abstract Rankin inequality to +an exact Euler product over the factorization of `N`. -/ +theorem truncatedOrderTotientSum_cast_le_factorizationRankin + (N bound : ℕ) (primeWeight : ℕ → ℚ) (cap : ℚ) + (hprimeWeightNonneg : ∀ prime, 0 ≤ primeWeight prime) + (hprimeWeightPower : + ∀ prime : ℕ, prime.Prime → + 1 ≤ (prime : ℚ) * (primeWeight prime) ^ 12) + (hcapNonneg : 0 ≤ cap) + (hboundCap : (bound : ℚ) ≤ cap ^ 12) + (hN : N ≠ 0) : + (truncatedOrderTotientSum N bound : ℚ) ≤ + (bound : ℚ) * cap * + (N.factorization.prod fun prime exponent => + rankinPrimePowerFactor prime exponent (primeWeight prime)) := by + rw [← weightedTotientDivisorSum_eq_factorizationEulerProduct + N hN primeWeight] + apply truncatedOrderTotientSum_cast_le_weightedRankin + · intro order horder + exact factorizationWeight_nonneg primeWeight hprimeWeightNonneg order + · intro order horder + have horderNe : order ≠ 0 := + ne_zero_of_dvd_ne_zero hN (Nat.mem_divisors.mp horder).1 + exact factorizationWeight_twelfthPower primeWeight + hprimeWeightPower horderNe + · exact hcapNonneg + · exact hboundCap + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean new file mode 100644 index 0000000000..747918302f --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean @@ -0,0 +1,609 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +import Mathlib.Tactic.IntervalCases + +/-! +# A weighted twentieth-moment divisor bound + +Squaring the elementary tenth-moment estimate would give +`τ(n)^20 ≤ 2^894 n^2`. That loses the fractional part of every +prime-factor penalty before the square is taken. Charging the doubled +weight directly preserves those fractional parts and gives the stronger +uniform estimate + +`τ(n)^20 ≤ 2^796 n^2`. + +The proof uses the same finite-band induction as the tenth-moment bound. +It does not enumerate integers, factorizations, or neighboring divisor +profiles. +-/ + +namespace BGS.NumberTheory + +open scoped BigOperators + +/-- Tenth-power ratio monotonicity used before squaring the weighted estimate. -/ +private theorem weighted_pow_ten_succ_ratio_le + (base A a : ℕ) (ha : A ≤ a) + (hbase : (A + 2) ^ 10 ≤ base * (A + 1) ^ 10) : + (a + 2) ^ 10 ≤ base * (a + 1) ^ 10 := by + have hlinear : (A + 1) * (a + 2) ≤ (A + 2) * (a + 1) := by + nlinarith + have hpow := Nat.pow_le_pow_left hlinear 10 + have hscaled : + (A + 1) ^ 10 * (a + 2) ^ 10 ≤ + (A + 1) ^ 10 * (base * (a + 1) ^ 10) := by + calc + (A + 1) ^ 10 * (a + 2) ^ 10 = + ((A + 1) * (a + 2)) ^ 10 := by rw [mul_pow] + _ ≤ ((A + 2) * (a + 1)) ^ 10 := hpow + _ = (A + 2) ^ 10 * (a + 1) ^ 10 := by rw [mul_pow] + _ ≤ (base * (A + 1) ^ 10) * (a + 1) ^ 10 := + Nat.mul_le_mul_right _ hbase + _ = (A + 1) ^ 10 * (base * (a + 1) ^ 10) := by ring + exact Nat.le_of_mul_le_mul_left hscaled (by positivity) + +/-- Once the twentieth-power ratio is controlled, it remains controlled +at every later exponent. -/ +private theorem pow_twenty_succ_ratio_le + (base A a : ℕ) (ha : A ≤ a) + (hbase : (A + 2) ^ 20 ≤ base ^ 2 * (A + 1) ^ 20) : + (a + 2) ^ 20 ≤ base ^ 2 * (a + 1) ^ 20 := by + have hbaseTenSq : ((A + 2) ^ 10) ^ 2 ≤ + (base * (A + 1) ^ 10) ^ 2 := by + calc + ((A + 2) ^ 10) ^ 2 = (A + 2) ^ 20 := by + rw [← pow_mul] + _ ≤ base ^ 2 * (A + 1) ^ 20 := hbase + _ = base ^ 2 * ((A + 1) ^ 10) ^ 2 := by + rw [← pow_mul] + _ = (base * (A + 1) ^ 10) ^ 2 := by rw [mul_pow] + have hbaseTen : (A + 2) ^ 10 ≤ base * (A + 1) ^ 10 := + (Nat.pow_le_pow_iff_left (by norm_num : 2 ≠ 0)).mp hbaseTenSq + have hten := weighted_pow_ten_succ_ratio_le base A a ha hbaseTen + have hsq := Nat.pow_le_pow_left hten 2 + calc + (a + 2) ^ 20 = ((a + 2) ^ 10) ^ 2 := by + rw [← pow_mul] + _ ≤ (base * (a + 1) ^ 10) ^ 2 := hsq + _ = base ^ 2 * ((a + 1) ^ 10) ^ 2 := by rw [mul_pow] + _ = base ^ 2 * (a + 1) ^ 20 := by + rw [← pow_mul] + +/-- Induction from a finite threshold for a fixed prime-size band. -/ +private theorem pow_twenty_le_band_of_threshold + (base c A : ℕ) + (hbase : (A + 1) ^ 20 ≤ 2 ^ c * base ^ (2 * A)) + (hratio : (A + 2) ^ 20 ≤ base ^ 2 * (A + 1) ^ 20) + (a : ℕ) (ha : A ≤ a) : + (a + 1) ^ 20 ≤ 2 ^ c * base ^ (2 * a) := by + induction a, ha using Nat.le_induction with + | base => exact hbase + | succ a ha ih => + calc + (a + 1 + 1) ^ 20 ≤ base ^ 2 * (a + 1) ^ 20 := + pow_twenty_succ_ratio_le base A a ha hratio + _ ≤ base ^ 2 * (2 ^ c * base ^ (2 * a)) := + Nat.mul_le_mul_left _ ih + _ = 2 ^ c * base ^ (2 * (a + 1)) := by + rw [show 2 * (a + 1) = 2 * a + 2 by omega, pow_add] + ring + +private theorem pow_twenty_le_base_two (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 51 * 2 ^ (2 * a) := by + by_cases ha : 13 ≤ a + · simpa using pow_twenty_le_band_of_threshold 2 51 13 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 12 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_three (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 39 * 3 ^ (2 * a) := by + by_cases ha : 8 ≤ a + · simpa using pow_twenty_le_band_of_threshold 3 39 8 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 7 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_five (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 29 * 5 ^ (2 * a) := by + by_cases ha : 5 ≤ a + · simpa using pow_twenty_le_band_of_threshold 5 29 5 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 4 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_seven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 24 * 7 ^ (2 * a) := by + by_cases ha : 4 ≤ a + · simpa using pow_twenty_le_band_of_threshold 7 24 4 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 3 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_eleven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 20 * 11 ^ (2 * a) := by + by_cases ha : 3 ≤ a + · simpa using pow_twenty_le_band_of_threshold 11 20 3 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 2 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_thirteen (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 18 * 13 ^ (2 * a) := by + by_cases ha : 3 ≤ a + · simpa using pow_twenty_le_band_of_threshold 13 18 3 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 2 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_seventeen (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 16 * 17 ^ (2 * a) := by + by_cases ha : 3 ≤ a + · simpa using pow_twenty_le_band_of_threshold 17 16 3 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 2 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_nineteen (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 15 * 19 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 19 15 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_twentyThree (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 14 * 23 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 23 14 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_twentyNine (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 13 * 29 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 29 13 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_thirtyOne (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 12 * 31 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 31 12 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_thirtySeven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 11 * 37 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 37 11 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_fortyThree (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 10 * 43 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 43 10 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_fiftyThree (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 9 * 53 ^ (2 * a) := by + by_cases ha : 2 ≤ a + · simpa using pow_twenty_le_band_of_threshold 53 9 2 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 1 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_sixtySeven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 8 * 67 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 67 8 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_ninetySeven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 7 * 97 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 97 7 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_oneHundredThirtyOne (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 6 * 131 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 131 6 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_oneHundredNinetyOne (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 5 * 191 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 191 5 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_twoHundredFiftySeven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 4 * 257 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 257 4 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_threeHundredSixtySeven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 3 * 367 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 367 3 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_fiveHundredTwentyOne (a : ℕ) : + (a + 1) ^ 20 ≤ 2 ^ 2 * 521 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 521 2 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_sevenHundredTwentySeven (a : ℕ) : + (a + 1) ^ 20 ≤ 2 * 727 ^ (2 * a) := by + by_cases ha : 1 ≤ a + · simpa using pow_twenty_le_band_of_threshold 727 1 1 + (by norm_num) (by norm_num) a ha + · have ha' : a ≤ 0 := by omega + interval_cases a <;> norm_num + +private theorem pow_twenty_le_base_oneThousandTwentyFour (a : ℕ) : + (a + 1) ^ 20 ≤ 1024 ^ (2 * a) := by + simpa using pow_twenty_le_band_of_threshold 1024 0 0 + (by norm_num) (by norm_num) a (Nat.zero_le a) + +/-- The exact integer penalty bands for the weight pair `(20, 2)`. -/ +def weightedPrimePenaltyTwenty (p : ℕ) : ℕ := + if p < 3 then 51 + else if p < 5 then 39 + else if p < 7 then 29 + else if p < 11 then 24 + else if p < 13 then 20 + else if p < 17 then 18 + else if p < 19 then 16 + else if p < 23 then 15 + else if p < 29 then 14 + else if p < 31 then 13 + else if p < 37 then 12 + else if p < 43 then 11 + else if p < 53 then 10 + else if p < 67 then 9 + else if p < 97 then 8 + else if p < 131 then 7 + else if p < 191 then 6 + else if p < 257 then 5 + else if p < 367 then 4 + else if p < 521 then 3 + else if p < 727 then 2 + else if p < 1024 then 1 + else 0 + +private theorem weightedPrimePenaltyTwenty_eq_zero_of_le + {p : ℕ} (hp : 1024 ≤ p) : + weightedPrimePenaltyTwenty p = 0 := by + simp [weightedPrimePenaltyTwenty, + show ¬p < 3 by omega, show ¬p < 5 by omega, + show ¬p < 7 by omega, show ¬p < 11 by omega, + show ¬p < 13 by omega, show ¬p < 17 by omega, + show ¬p < 19 by omega, show ¬p < 23 by omega, + show ¬p < 29 by omega, show ¬p < 31 by omega, + show ¬p < 37 by omega, show ¬p < 43 by omega, + show ¬p < 53 by omega, show ¬p < 67 by omega, + show ¬p < 97 by omega, show ¬p < 131 by omega, + show ¬p < 191 by omega, show ¬p < 257 by omega, + show ¬p < 367 by omega, show ¬p < 521 by omega, + show ¬p < 727 by omega, show ¬p < 1024 by omega] + +private theorem pow_twenty_le_of_base_le + {base p c a : ℕ} + (h : (a + 1) ^ 20 ≤ 2 ^ c * base ^ (2 * a)) + (hbase : base ≤ p) : + (a + 1) ^ 20 ≤ 2 ^ c * p ^ (2 * a) := + h.trans (Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hbase _)) + +/-- Factorwise twentieth-moment estimate for the doubled number weight. -/ +private theorem factorization_succ_pow_twenty_le + {p a : ℕ} (hpPrime : p.Prime) : + (a + 1) ^ 20 ≤ + 2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * a) := by + have hpTwo : 2 ≤ p := hpPrime.two_le + by_cases hp3 : p < 3 + · simp only [weightedPrimePenaltyTwenty, if_pos hp3] + exact pow_twenty_le_of_base_le (pow_twenty_le_base_two a) hpTwo + · by_cases hp5 : p < 5 + · have hpLower : 3 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_pos hp5] + exact pow_twenty_le_of_base_le (pow_twenty_le_base_three a) hpLower + · by_cases hp7 : p < 7 + · have hpLower : 5 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, if_pos hp7] + exact pow_twenty_le_of_base_le (pow_twenty_le_base_five a) hpLower + · by_cases hp11 : p < 11 + · have hpLower : 7 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_pos hp11] + exact pow_twenty_le_of_base_le (pow_twenty_le_base_seven a) hpLower + · by_cases hp13 : p < 13 + · have hpLower : 11 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_pos hp13] + exact pow_twenty_le_of_base_le (pow_twenty_le_base_eleven a) hpLower + · by_cases hp17 : p < 17 + · have hpLower : 13 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_pos hp17] + exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirteen a) hpLower + · by_cases hp19 : p < 19 + · have hpLower : 17 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, if_pos hp19] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_seventeen a) hpLower + · by_cases hp23 : p < 23 + · have hpLower : 19 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_pos hp23] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_nineteen a) hpLower + · by_cases hp29 : p < 29 + · have hpLower : 23 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_pos hp29] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_twentyThree a) hpLower + · by_cases hp31 : p < 31 + · have hpLower : 29 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_neg hp29, if_pos hp31] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_twentyNine a) hpLower + · by_cases hp37 : p < 37 + · have hpLower : 31 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_pos hp37] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_thirtyOne a) hpLower + · by_cases hp43 : p < 43 + · have hpLower : 37 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_pos hp43] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_thirtySeven a) hpLower + · by_cases hp53 : p < 53 + · have hpLower : 43 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, if_pos hp53] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_fortyThree a) hpLower + · by_cases hp67 : p < 67 + · have hpLower : 53 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, if_neg hp53, + if_pos hp67] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_fiftyThree a) hpLower + · by_cases hp97 : p < 97 + · have hpLower : 67 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, if_neg hp3, + if_neg hp5, if_neg hp7, if_neg hp11, + if_neg hp13, if_neg hp17, if_neg hp19, + if_neg hp23, if_neg hp29, if_neg hp31, + if_neg hp37, if_neg hp43, if_neg hp53, + if_neg hp67, if_pos hp97] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_sixtySeven a) hpLower + · by_cases hp131 : p < 131 + · have hpLower : 97 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, if_neg hp7, + if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, if_neg hp97, + if_pos hp131] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_ninetySeven a) hpLower + · by_cases hp191 : p < 191 + · have hpLower : 131 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, if_neg hp7, + if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, if_neg hp97, + if_neg hp131, if_pos hp191] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_oneHundredThirtyOne a) + hpLower + · by_cases hp257 : p < 257 + · have hpLower : 191 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, if_neg hp7, + if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, if_neg hp97, + if_neg hp131, if_neg hp191, if_pos hp257] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_oneHundredNinetyOne a) + hpLower + · by_cases hp367 : p < 367 + · have hpLower : 257 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, if_neg hp7, + if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, if_neg hp97, + if_neg hp131, if_neg hp191, + if_neg hp257, if_pos hp367] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_twoHundredFiftySeven a) + hpLower + · by_cases hp521 : p < 521 + · have hpLower : 367 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, if_neg hp7, + if_neg hp11, if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, if_neg hp97, + if_neg hp131, if_neg hp191, + if_neg hp257, if_neg hp367, + if_pos hp521] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_threeHundredSixtySeven a) + hpLower + · by_cases hp727 : p < 727 + · have hpLower : 521 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, if_neg hp7, + if_neg hp11, if_neg hp13, + if_neg hp17, if_neg hp19, + if_neg hp23, if_neg hp29, + if_neg hp31, if_neg hp37, + if_neg hp43, if_neg hp53, + if_neg hp67, if_neg hp97, + if_neg hp131, if_neg hp191, + if_neg hp257, if_neg hp367, + if_neg hp521, if_pos hp727] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_fiveHundredTwentyOne a) + hpLower + · by_cases hp1024 : p < 1024 + · have hpLower : 727 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, + if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, + if_neg hp29, if_neg hp31, + if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, + if_neg hp97, if_neg hp131, + if_neg hp191, if_neg hp257, + if_neg hp367, if_neg hp521, + if_neg hp727, if_pos hp1024] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_sevenHundredTwentySeven a) + hpLower + · have hpLower : 1024 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + if_neg hp3, if_neg hp5, + if_neg hp7, if_neg hp11, + if_neg hp13, if_neg hp17, + if_neg hp19, if_neg hp23, + if_neg hp29, if_neg hp31, + if_neg hp37, if_neg hp43, + if_neg hp53, if_neg hp67, + if_neg hp97, if_neg hp131, + if_neg hp191, if_neg hp257, + if_neg hp367, if_neg hp521, + if_neg hp727, if_neg hp1024, + pow_zero, one_mul] + simpa only [pow_zero, one_mul] using + (pow_twenty_le_of_base_le (c := 0) + (by simpa only [pow_zero, one_mul] using + pow_twenty_le_base_oneThousandTwentyFour a) + hpLower) + +private theorem sum_weightedPrimePenaltyTwenty_le (n : ℕ) : + ∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p ≤ 796 := by + let smallFactors := + n.primeFactors.filter fun p ↦ p < 1024 + let allSmallPrimes := + (Finset.range 1024).filter Nat.Prime + have hsumEq : + (∑ p ∈ smallFactors, weightedPrimePenaltyTwenty p) = + ∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p := by + apply Finset.sum_subset (Finset.filter_subset _ _) + intro p hpFactors hpNotSmall + have hpLarge : 1024 ≤ p := by + by_contra hpNotLarge + have hpSmall : p < 1024 := by omega + exact hpNotSmall (Finset.mem_filter.mpr ⟨hpFactors, hpSmall⟩) + exact weightedPrimePenaltyTwenty_eq_zero_of_le hpLarge + have hsubset : smallFactors ⊆ allSmallPrimes := by + intro p hp + have hp' := Finset.mem_filter.mp hp + exact Finset.mem_filter.mpr + ⟨Finset.mem_range.mpr hp'.2, + Nat.prime_of_mem_primeFactors hp'.1⟩ + have hle : + (∑ p ∈ smallFactors, weightedPrimePenaltyTwenty p) ≤ + ∑ p ∈ allSmallPrimes, weightedPrimePenaltyTwenty p := + Finset.sum_le_sum_of_subset_of_nonneg hsubset + (fun _ _ _ ↦ Nat.zero_le _) + have htotal : + (∑ p ∈ allSmallPrimes, weightedPrimePenaltyTwenty p) ≤ 796 := by + decide + rw [← hsumEq] + exact hle.trans htotal + +/-- Weighted elementary divisor estimate: +`τ(n)^20 ≤ 2^796 n^2`. -/ +theorem card_divisors_pow_twenty_le_weighted_constant_mul_sq + (n : ℕ) (hn : n ≠ 0) : + n.divisors.card ^ 20 ≤ 2 ^ 796 * n ^ 2 := by + rw [Nat.card_divisors hn, ← Finset.prod_pow] + calc + (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ 20) ≤ + ∏ p ∈ n.primeFactors, + (2 ^ weightedPrimePenaltyTwenty p * + p ^ (2 * n.factorization p)) := + Finset.prod_le_prod (fun _ _ ↦ Nat.zero_le _) + (fun p hp ↦ factorization_succ_pow_twenty_le + (Nat.prime_of_mem_primeFactors hp)) + _ = 2 ^ (∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) * n ^ 2 := by + rw [Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum] + congr 1 + calc + (∏ p ∈ n.primeFactors, p ^ (2 * n.factorization p)) = + ∏ p ∈ n.primeFactors, (p ^ n.factorization p) ^ 2 := by + apply Finset.prod_congr rfl + intro p hp + rw [show 2 * n.factorization p = n.factorization p * 2 by omega, pow_mul] + _ = (∏ p ∈ n.primeFactors, p ^ n.factorization p) ^ 2 := by + exact Finset.prod_pow n.primeFactors 2 + (fun p => p ^ n.factorization p) + _ = n ^ 2 := by rw [← Nat.prod_primeFactors_pow_factorization hn] + _ ≤ 2 ^ 796 * n ^ 2 := + Nat.mul_le_mul_right (n ^ 2) <| + Nat.pow_le_pow_right (by norm_num) + (sum_weightedPrimePenaltyTwenty_le n) + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean new file mode 100644 index 0000000000..d237648ce3 --- /dev/null +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean @@ -0,0 +1,256 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment + +/-! +# A weighted joint divisor bound for neighboring integers + +The weighted divisor estimate `τ(n)^20 ≤ 2^796 n^2` retains substantially +more information than the square of the tenth-moment bound. For the +neighboring even integers `p - 1` and `p + 1`, their exact gcd-two identity +also controls the product of their divisor counts. Splitting into balanced +and dominant cases then gives a twentieth moment for their sum whose leading +constant is still `2^796`. +-/ + +namespace BGS.NumberTheory + +/-- The product of the two neighboring divisor counts has only one weighted +prime-penalty factor in its twentieth moment. -/ +theorem card_divisors_pred_mul_card_divisors_succ_pow_twenty_le + {p : ℕ} (hp : Odd p) (hpTwo : 2 < p) : + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 20 ≤ + 2 ^ 814 * (p ^ 2 - 1) ^ 2 := by + let core := (p ^ 2 - 1) / 2 + have hpSq : 9 ≤ p ^ 2 := by nlinarith + have hcorePos : 0 < core := by + apply Nat.div_pos + · omega + · norm_num + have hmoment := + card_divisors_pow_twenty_le_weighted_constant_mul_sq + core hcorePos.ne' + have htwiceCore : 2 * core = p ^ 2 - 1 := by + rcases hp with ⟨k, rfl⟩ + dsimp [core] + have hsquare : + (2 * k + 1) ^ 2 = 2 * (2 * k * (k + 1)) + 1 := by ring + rw [hsquare] + omega + calc + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 20 = + (2 * core.divisors.card) ^ 20 := by + rw [card_divisors_pred_mul_card_divisors_succ_of_odd hp] + _ = 2 ^ 20 * core.divisors.card ^ 20 := by rw [mul_pow] + _ ≤ 2 ^ 20 * (2 ^ 796 * core ^ 2) := + Nat.mul_le_mul_left _ hmoment + _ = 2 ^ 816 * core ^ 2 := by + rw [show (816 : ℕ) = 20 + 796 by norm_num, pow_add] + ring + _ = 2 ^ 814 * (2 * core) ^ 2 := by + rw [show (816 : ℕ) = 814 + 2 by norm_num, pow_add] + norm_num + ring + _ = 2 ^ 814 * (p ^ 2 - 1) ^ 2 := by rw [htwiceCore] + +/-- Square-root form of the weighted joint product moment. -/ +theorem card_divisors_pred_mul_card_divisors_succ_pow_ten_weighted_le + {p : ℕ} (hp : Odd p) (hpTwo : 2 < p) : + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 10 ≤ + 2 ^ 407 * p ^ 2 := by + apply (Nat.pow_le_pow_iff_left (by norm_num : 2 ≠ 0)).mp + have htwo : (2 ^ 407) ^ 2 = 2 ^ 814 := by + rw [← pow_mul] + calc + (((p - 1).divisors.card * (p + 1).divisors.card) ^ 10) ^ 2 = + ((p - 1).divisors.card * (p + 1).divisors.card) ^ 20 := by + rw [← pow_mul] + _ ≤ 2 ^ 814 * (p ^ 2 - 1) ^ 2 := + card_divisors_pred_mul_card_divisors_succ_pow_twenty_le hp hpTwo + _ ≤ 2 ^ 814 * (p ^ 2) ^ 2 := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left (by omega) 2) + _ = (2 ^ 407 * p ^ 2) ^ 2 := by rw [mul_pow, htwo] + +/-- Joint weighted twentieth-moment constant for the sum of the neighboring +divisor counts. -/ +def neighboringDivisorSumWeightedMomentConstant : ℕ := + 2 ^ 796 + 2 ^ 781 + +theorem neighboringDivisorSumWeightedMomentConstant_eq : + neighboringDivisorSumWeightedMomentConstant = 2 ^ 781 * 32769 := by + rw [neighboringDivisorSumWeightedMomentConstant, + show (796 : ℕ) = 781 + 15 by norm_num, pow_add] + norm_num + ring + +private def neighboringDivisorSumWeightedSplit : ℕ := + 716198 + +private theorem neighboringDivisorSumWeighted_balanced_constant : + (neighboringDivisorSumWeightedSplit + 1) ^ 20 * 2 ^ 407 ≤ + neighboringDivisorSumWeightedMomentConstant := by + norm_num [neighboringDivisorSumWeightedSplit, + neighboringDivisorSumWeightedMomentConstant] + +private theorem neighboringDivisorSumWeighted_dominant_constant + {p : ℕ} (hp : 794039 ≤ p) : + (neighboringDivisorSumWeightedSplit + 1) ^ 20 * 2 ^ 796 * + (p + 1) ^ 2 ≤ + neighboringDivisorSumWeightedSplit ^ 20 * + neighboringDivisorSumWeightedMomentConstant * p ^ 2 := by + let R := neighboringDivisorSumWeightedSplit + let K := 2 ^ 796 + let D := neighboringDivisorSumWeightedMomentConstant + let P := 794039 + have hground : + (R + 1) ^ 20 * K * (P + 1) ^ 2 ≤ + R ^ 20 * D * P ^ 2 := by + norm_num [R, K, D, P, neighboringDivisorSumWeightedSplit, + neighboringDivisorSumWeightedMomentConstant] + have hlinear : P * (p + 1) ≤ (P + 1) * p := by + dsimp [P] + omega + have hratioPow := + Nat.pow_le_pow_left hlinear 2 + have hratio : + P ^ 2 * (p + 1) ^ 2 ≤ (P + 1) ^ 2 * p ^ 2 := by + simpa only [mul_pow] using hratioPow + have hcombined : + P ^ 2 * ((R + 1) ^ 20 * K * (p + 1) ^ 2) ≤ + P ^ 2 * (R ^ 20 * D * p ^ 2) := by + calc + P ^ 2 * ((R + 1) ^ 20 * K * (p + 1) ^ 2) = + ((R + 1) ^ 20 * K) * (P ^ 2 * (p + 1) ^ 2) := by ring + _ ≤ ((R + 1) ^ 20 * K) * ((P + 1) ^ 2 * p ^ 2) := + Nat.mul_le_mul_left _ hratio + _ = ((R + 1) ^ 20 * K * (P + 1) ^ 2) * p ^ 2 := by ring + _ ≤ (R ^ 20 * D * P ^ 2) * p ^ 2 := + Nat.mul_le_mul_right _ hground + _ = P ^ 2 * (R ^ 20 * D * p ^ 2) := by ring + exact Nat.le_of_mul_le_mul_left hcombined (pow_pos (by norm_num : 0 < P) 2) + +private theorem nat_le_of_pos_mul_le_mul_left_weighted + {c x y : ℕ} (hc : 0 < c) (h : c * x ≤ c * y) : + x ≤ y := + Nat.le_of_mul_le_mul_left h hc + +/-- Weighted joint twentieth moment for the sum of the neighboring divisor +counts. Comparable counts are controlled by their product; a dominant count +is controlled by its individual weighted moment. -/ +theorem card_divisors_pred_add_card_divisors_succ_pow_twenty_le + {p : ℕ} (hp : Odd p) (hpLarge : 794039 ≤ p) : + ((p - 1).divisors.card + (p + 1).divisors.card) ^ 20 ≤ + neighboringDivisorSumWeightedMomentConstant * p ^ 2 := by + let a := (p - 1).divisors.card + let b := (p + 1).divisors.card + let R := neighboringDivisorSumWeightedSplit + let K := 2 ^ 796 + let D := neighboringDivisorSumWeightedMomentConstant + have hpTwo : 2 < p := by omega + have hminus : a ^ 20 ≤ K * (p - 1) ^ 2 := by + simpa [a, K] using + card_divisors_pow_twenty_le_weighted_constant_mul_sq + (p - 1) (by omega) + have hplus : b ^ 20 ≤ K * (p + 1) ^ 2 := by + simpa [b, K] using + card_divisors_pow_twenty_le_weighted_constant_mul_sq + (p + 1) (by omega) + have hminusCommon : a ^ 20 ≤ K * (p + 1) ^ 2 := + hminus.trans (Nat.mul_le_mul_left K + (Nat.pow_le_pow_left (by omega) 2)) + have hproductTen : (a * b) ^ 10 ≤ 2 ^ 407 * p ^ 2 := by + simpa [a, b] using + card_divisors_pred_mul_card_divisors_succ_pow_ten_weighted_le hp hpTwo + have hbalanced : (R + 1) ^ 20 * 2 ^ 407 ≤ D := by + simpa [R, D] using neighboringDivisorSumWeighted_balanced_constant + have hRPos : 0 < R := by + norm_num [R, neighboringDivisorSumWeightedSplit] + have hRpowPos : 0 < R ^ 20 := pow_pos hRPos 20 + have hdominant : + (R + 1) ^ 20 * K * (p + 1) ^ 2 ≤ R ^ 20 * D * p ^ 2 := by + simpa [R, K, D] using + neighboringDivisorSumWeighted_dominant_constant hpLarge + rcases le_total a b with hab | hba + · by_cases hfar : R * a ≤ b + · have hlinear : R * (a + b) ≤ (R + 1) * b := by + calc + R * (a + b) = R * a + R * b := by ring + _ ≤ b + R * b := Nat.add_le_add_right hfar _ + _ = (R + 1) * b := by ring + have hpow := Nat.pow_le_pow_left hlinear 20 + have hscaled : + R ^ 20 * (a + b) ^ 20 ≤ R ^ 20 * (D * p ^ 2) := by + calc + R ^ 20 * (a + b) ^ 20 = (R * (a + b)) ^ 20 := by ring + _ ≤ ((R + 1) * b) ^ 20 := hpow + _ = (R + 1) ^ 20 * b ^ 20 := by ring + _ ≤ (R + 1) ^ 20 * (K * (p + 1) ^ 2) := + Nat.mul_le_mul_left _ hplus + _ = (R + 1) ^ 20 * K * (p + 1) ^ 2 := by ring + _ ≤ R ^ 20 * (D * p ^ 2) := by + simpa only [Nat.mul_assoc] using hdominant + exact nat_le_of_pos_mul_le_mul_left_weighted + (c := R ^ 20) (x := (a + b) ^ 20) (y := D * p ^ 2) + hRpowPos hscaled + · have hnear : b ≤ R * a := by omega + have hlinear : a + b ≤ (R + 1) * a := by + calc + a + b ≤ a + R * a := Nat.add_le_add_left hnear _ + _ = (R + 1) * a := by ring + have haa : a * a ≤ a * b := Nat.mul_le_mul_left a hab + calc + (a + b) ^ 20 ≤ ((R + 1) * a) ^ 20 := + Nat.pow_le_pow_left hlinear 20 + _ = (R + 1) ^ 20 * (a * a) ^ 10 := by ring + _ ≤ (R + 1) ^ 20 * (a * b) ^ 10 := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left haa 10) + _ ≤ (R + 1) ^ 20 * (2 ^ 407 * p ^ 2) := + Nat.mul_le_mul_left _ hproductTen + _ = ((R + 1) ^ 20 * 2 ^ 407) * p ^ 2 := by ring + _ ≤ D * p ^ 2 := Nat.mul_le_mul_right (p ^ 2) hbalanced + · by_cases hfar : R * b ≤ a + · have hlinear : R * (a + b) ≤ (R + 1) * a := by + calc + R * (a + b) = R * a + R * b := by ring + _ = R * b + R * a := by ring + _ ≤ a + R * a := Nat.add_le_add_right hfar _ + _ = (R + 1) * a := by ring + have hpow := Nat.pow_le_pow_left hlinear 20 + have hscaled : + R ^ 20 * (a + b) ^ 20 ≤ R ^ 20 * (D * p ^ 2) := by + calc + R ^ 20 * (a + b) ^ 20 = (R * (a + b)) ^ 20 := by ring + _ ≤ ((R + 1) * a) ^ 20 := hpow + _ = (R + 1) ^ 20 * a ^ 20 := by ring + _ ≤ (R + 1) ^ 20 * (K * (p + 1) ^ 2) := + Nat.mul_le_mul_left _ hminusCommon + _ = (R + 1) ^ 20 * K * (p + 1) ^ 2 := by ring + _ ≤ R ^ 20 * (D * p ^ 2) := by + simpa only [Nat.mul_assoc] using hdominant + exact nat_le_of_pos_mul_le_mul_left_weighted + (c := R ^ 20) (x := (a + b) ^ 20) (y := D * p ^ 2) + hRpowPos hscaled + · have hnear : a ≤ R * b := by omega + have hlinear : a + b ≤ (R + 1) * b := by + calc + a + b ≤ R * b + b := Nat.add_le_add_right hnear _ + _ = (R + 1) * b := by ring + have hbb : b * b ≤ a * b := by + simpa [Nat.mul_comm] using Nat.mul_le_mul_left b hba + calc + (a + b) ^ 20 ≤ ((R + 1) * b) ^ 20 := + Nat.pow_le_pow_left hlinear 20 + _ = (R + 1) ^ 20 * (b * b) ^ 10 := by ring + _ ≤ (R + 1) ^ 20 * (a * b) ^ 10 := + Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hbb 10) + _ ≤ (R + 1) ^ 20 * (2 ^ 407 * p ^ 2) := + Nat.mul_le_mul_left _ hproductTen + _ = ((R + 1) ^ 20 * 2 ^ 407) * p ^ 2 := by ring + _ ≤ D * p ^ 2 := Nat.mul_le_mul_right (p ^ 2) hbalanced + +end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/Comparator/Solution.lean b/LeanPool/MarkoffModP/Comparator/Solution.lean new file mode 100644 index 0000000000..f18b825479 --- /dev/null +++ b/LeanPool/MarkoffModP/Comparator/Solution.lean @@ -0,0 +1,31 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity + +namespace Challenge + +abbrev MarkoffNat := + {⟨x, y, z⟩ : ℕ × ℕ × ℕ | x ^ 2 + y ^ 2 + z ^ 2 = 3 * x * y * z} + +abbrev MarkoffModp (p : ℕ) := + {⟨x, y, z⟩ : ZMod p × ZMod p × ZMod p | x ^ 2 + y ^ 2 + z ^ 2 = 3 * x * y * z} + +abbrev markoffNatToModp (p : ℕ) : MarkoffNat → MarkoffModp p := + fun ⟨⟨x, y, z⟩, h⟩ ↦ ⟨⟨x, y, z⟩, by simpa using congrArg (fun n : ℕ ↦ (n : ZMod p)) h⟩ + +theorem markoff_reduction_surjective_of_large_prime : + let p₀ := 35721 ^ 5 * 2 ^ 1547 * 32769 ^ 2 + 1 + ∀ (p : ℕ), p.Prime → p₀ ≤ p → Function.Surjective (markoffNatToModp p) := by + dsimp only + intro p hpPrime hp y + obtain ⟨x, hx⟩ := + BGS.Markoff.reduction_surjective_of_explicitBound p hpPrime hp y + refine ⟨x, ?_⟩ + apply Subtype.ext + exact congrArg Subtype.val hx + +end Challenge diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean new file mode 100644 index 0000000000..cd035f1b1a --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean @@ -0,0 +1,249 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic +public import Mathlib.Algebra.Module.MinimalAxioms +public import Mathlib.LinearAlgebra.Quotient.Basic +public import Mathlib.RingTheory.DedekindDomain.FiniteAdeleRing + +/-! +# K-valued adele space of a function field +Definitions and basic structure for Stichtenoth's adele space. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero +open Filter + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncAdele : DecidableEq k⟮X⟯ := Classical.decEq _ +/-- The classical decidable equality on coordinate places used for adele surgery. -/ +local instance instDecidableEqPlaceAAdele : DecidableEq (PlaceA k K) := Classical.decEq _ + +/-- The `k`-submodule of the full product consisting of tuples integral at all but finitely many +places. -/ +def adeleSubmodule : Submodule k (PlaceA k K → K) where + carrier := {α | ∀ᶠ v in cofinite, α v ∈ placeValuationSubring k K v} + zero_mem' := by simp + add_mem' {a b} ha hb := by + change ∀ᶠ v in cofinite, a v ∈ placeValuationSubring k K v at ha + change ∀ᶠ v in cofinite, b v ∈ placeValuationSubring k K v at hb + change ∀ᶠ v in cofinite, (a + b) v ∈ placeValuationSubring k K v + exact (ha.and hb).mono fun _ h => add_mem h.1 h.2 + smul_mem' c a ha := by + change ∀ᶠ v in cofinite, a v ∈ placeValuationSubring k K v at ha + change ∀ᶠ v in cofinite, (c • a) v ∈ placeValuationSubring k K v + filter_upwards [ha] with v hv + rw [Pi.smul_apply, Algebra.smul_def] + exact mul_mem (by + change placeValuation k K v (algebraMap k K c) ≤ 1 + exact placeValuation_algebraMap_le_one k K v c) hv + +omit [Algebra k K] [IsScalarTower k k[X] K] in +/-- Every element of `K` is integral at all but finitely many coordinate places. -/ +theorem eventually_mem_placeValuationSubring (f : K) : + ∀ᶠ v : PlaceA k K in cofinite, f ∈ placeValuationSubring k K v := by + rw [Filter.eventually_cofinite] + refine ((IsDedekindDomain.HeightOneSpectrum.Support.finite + (R := ringOfIntegers k K) f).image Sum.inl).union + ((IsDedekindDomain.HeightOneSpectrum.Support.finite + (R := infiniteIntegers k K) f).image Sum.inr) |>.subset ?_ + intro v hv + rcases v with v | v + · left + refine ⟨v, ?_, rfl⟩ + simpa [IsDedekindDomain.HeightOneSpectrum.Support, placeValuationSubring, + placeValuation, not_le] using hv + · right + refine ⟨v, ?_, rfl⟩ + simpa [IsDedekindDomain.HeightOneSpectrum.Support, placeValuationSubring, + placeValuation, not_le] using hv + +/-- The K-valued adele space `A_K = Πʳ_{v} [K, O_v]`. -/ +abbrev AdeleSpace := adeleSubmodule k K + +/-- Pointwise multiplication of an adele by an element of `K`. -/ +def smulAdele (x : K) (a : AdeleSpace k K) : AdeleSpace k K := ⟨fun v => x * a.val v, by + have hx := eventually_mem_placeValuationSubring k K x + have ha := a.property + change ∀ᶠ v : PlaceA k K in cofinite, a.val v ∈ placeValuationSubring k K v at ha + change ∀ᶠ v : PlaceA k K in cofinite, x * a.val v ∈ placeValuationSubring k K v + exact (hx.and ha).mono fun _ h => mul_mem h.1 h.2⟩ + +instance : SMul K (AdeleSpace k K) := ⟨smulAdele k K⟩ + +instance : Module K (AdeleSpace k K) := + Module.ofMinimalAxioms + (fun _ _ _ => Subtype.ext <| funext fun _ => mul_add _ _ _) + (fun _ _ _ => Subtype.ext <| funext fun _ => add_mul _ _ _) + (fun _ _ _ => Subtype.ext <| funext fun _ => mul_assoc _ _ _) + (fun _ => Subtype.ext <| funext fun _ => one_mul _) + +/-- Multiplication by `x ∈ K` as a `k`-linear endomorphism of the adele space. -/ +def mulAdeleLinear (x : K) : AdeleSpace k K →ₗ[k] AdeleSpace k K where + toFun a := x • a + map_add' _ _ := smul_add x _ _ + map_smul' c a := by + ext v + change x * (c • a.val v) = c • (x * a.val v) + simp only [Algebra.smul_def] + ring + +/-- An adele lies in the filtration piece `A(D)` when its component at every place `v` has +valuation at most `WithZero.exp (D v)`. -/ +def memAdeleFilt (D : DivisorA k K) (α : AdeleSpace k K) : Prop := + ∀ v, placeValuation k K v (α.val v) ≤ WithZero.exp (D v) + +/-- The filtration piece `A(D)` of the adele space. -/ +def adeleFilt (D : DivisorA k K) : Submodule k (AdeleSpace k K) where + carrier := {a | memAdeleFilt k K D a} + zero_mem' := fun v => by simp + add_mem' {a b} ha hb := by + change memAdeleFilt k K D a at ha + change memAdeleFilt k K D b at hb + change memAdeleFilt k K D (a + b) + exact fun v => (Valuation.map_add _ (a.val v) (b.val v)).trans (max_le (ha v) (hb v)) + smul_mem' c a ha := by + change memAdeleFilt k K D a at ha + change memAdeleFilt k K D (c • a) + intro v + change placeValuation k K v (c • a.val v) ≤ _ + rw [Algebra.smul_def, map_mul] + exact (mul_le_mul' (placeValuation_algebraMap_le_one k K v c) (ha v)).trans_eq + (one_mul _) + +/-- The diagonal embedding `K → A_K` of principal adeles. -/ +def diagonal : K →ₗ[k] AdeleSpace k K where + toFun f := ⟨fun _ => f, by + simpa [adeleSubmodule] using + eventually_mem_placeValuationSubring k K f⟩ + map_add' _ _ := rfl + map_smul' _ _ := rfl + +/-- The image `K̃` of the diagonal embedding. -/ +def diagonalSubmodule : Submodule k (AdeleSpace k K) := LinearMap.range (diagonal k K) + +theorem adeleFilt_inf_diagonal (D : DivisorA k K) : + adeleFilt k K D ⊓ diagonalSubmodule k K = + Submodule.map (diagonal k K : K →ₗ[k] AdeleSpace k K) (RRspace k K D) := by + ext a + constructor + · rintro ⟨ha, f, rfl⟩ + refine ⟨f, ?_, rfl⟩ + simpa [adeleFilt, memAdeleFilt, RRspace, memRRspace, diagonal] using ha + · rintro ⟨f, hf, rfl⟩ + refine ⟨?_, ⟨f, rfl⟩⟩ + simpa [adeleFilt, memAdeleFilt, RRspace, memRRspace, diagonal] using hf + +/-- The adele filtration is monotone in the divisor. -/ +theorem adeleFilt_mono {D D' : DivisorA k K} (h : D ≤ D') : + adeleFilt k K D ≤ adeleFilt k K D' := by + intro a ha v + exact (ha v).trans (WithZero.exp_le_exp.mpr (h v)) + +/-- `A(D)` as a submodule of `A(D')`, for `D ≤ D'`. -/ +@[nolint unusedArguments] +def adeleFiltWithin {D D' : DivisorA k K} (_h : D ≤ D') : + Submodule k (adeleFilt k K D') := + Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D) + +/-- Finite-rank increment `finrank k (A(D') ⧸ A(D))`. -/ +noncomputable def finrankAdeleFiltDiff (D D' : DivisorA k K) : ℕ := by + letI : AddCommGroup (adeleFilt k K D') := Submodule.addCommGroup _ + letI : Module k (adeleFilt k K D') := Submodule.module _ + exact Module.finrank k <| + (adeleFilt k K D') ⧸ + Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D) + +/-- Rank of `(A(D') + K̃) ⧸ (A(D) + K̃)` from the sandwich bookkeeping. -/ +@[nolint unusedArguments] +noncomputable def sandwichRank (D D' : DivisorA k K) (_h : D ≤ D') : ℤ := + by + letI : AddCommGroup (adeleFilt k K D' + diagonalSubmodule k K) := + Submodule.addCommGroup _ + letI : Module k (adeleFilt k K D' + diagonalSubmodule k K) := Submodule.module _ + exact Int.ofNat (Module.finrank k <| + (adeleFilt k K D' + diagonalSubmodule k K) ⧸ + Submodule.comap (adeleFilt k K D' + diagonalSubmodule k K).subtype + (adeleFilt k K D + diagonalSubmodule k K)) + +/-- Component update for adele surgery (`A(D₁ ⊔ D₂) = A(D₁) + A(D₂)`). -/ +def adeleUpdate (α : AdeleSpace k K) (v : PlaceA k K) (a : K) : AdeleSpace k K := + ⟨Function.update α.val v a, by + change ∀ᶠ w : PlaceA k K in cofinite, + Function.update α.val v a w ∈ placeValuationSubring k K w + filter_upwards [α.property, Filter.eventually_cofinite_ne v] with w hw hwv + simpa [Function.update_of_ne hwv] using hw⟩ + +theorem adeleFilt_sup_eq_add {D₁ D₂ : DivisorA k K} : + adeleFilt k K (D₁ ⊔ D₂) = adeleFilt k K D₁ + adeleFilt k K D₂ := by + classical + rw [Submodule.add_eq_sup] + apply le_antisymm + · intro a ha + have haevent := a.property + change ∀ᶠ v : PlaceA k K in cofinite, + a.val v ∈ placeValuationSubring k K v at haevent + let a₁ : AdeleSpace k K := ⟨fun v => if D₂ v ≤ D₁ v then a.val v else 0, by + simpa [adeleSubmodule] using haevent.mono fun v hv => by + by_cases h : D₂ v ≤ D₁ v + · rw [if_pos h] + exact hv + · rw [if_neg h] + exact zero_mem _⟩ + let a₂ : AdeleSpace k K := ⟨fun v => if D₂ v ≤ D₁ v then 0 else a.val v, by + simpa [adeleSubmodule] using haevent.mono fun v hv => by + by_cases h : D₂ v ≤ D₁ v + · rw [if_pos h] + exact zero_mem _ + · rw [if_neg h] + exact hv⟩ + have ha₁ : a₁ ∈ adeleFilt k K D₁ := by + change memAdeleFilt k K D₁ a₁ + intro v + by_cases h : D₂ v ≤ D₁ v + · change placeValuation k K v (if D₂ v ≤ D₁ v then a.val v else 0) ≤ _ + rw [if_pos h] + simpa [Finsupp.sup_apply, sup_eq_left.mpr h] using ha v + · simp [a₁, h] + have ha₂ : a₂ ∈ adeleFilt k K D₂ := by + change memAdeleFilt k K D₂ a₂ + intro v + by_cases h : D₂ v ≤ D₁ v + · simp [a₂, h] + · have hv : D₁ v ≤ D₂ v := le_of_not_ge h + change placeValuation k K v (if D₂ v ≤ D₁ v then 0 else a.val v) ≤ _ + rw [if_neg h] + simpa [Finsupp.sup_apply, sup_eq_right.mpr hv] using ha v + refine Submodule.mem_sup.mpr ⟨a₁, ha₁, a₂, ha₂, ?_⟩ + ext v + by_cases h : D₂ v ≤ D₁ v <;> simp [a₁, a₂, h] + · apply sup_le + · intro a ha + change memAdeleFilt k K (D₁ ⊔ D₂) a + intro v + exact (ha v).trans (WithZero.exp_le_exp.mpr le_sup_left) + · intro a ha + change memAdeleFilt k K (D₁ ⊔ D₂) a + intro v + exact (ha v).trans (WithZero.exp_le_exp.mpr le_sup_right) + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean new file mode 100644 index 0000000000..4f77a8f8b7 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean @@ -0,0 +1,1113 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +public import Mathlib.Algebra.Order.GroupWithZero.Canonical +public import Mathlib.LinearAlgebra.Isomorphisms +public import Mathlib.LinearAlgebra.Dimension.Finite +public import Mathlib.LinearAlgebra.Dimension.RankNullity +public import Mathlib.LinearAlgebra.Quotient.Basic +public import Mathlib.RingTheory.LocalRing.ResidueField.Basic +public import Mathlib.RingTheory.Finiteness.Finsupp + +/-! +# Exact dimensions of adele divisor quotients + +This file proves the exact rank formula for the adele filtration and the sandwich identity. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero +open IsDedekindDomain Cardinal + + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- Decidable equality on `k(X)` for adele filter proofs. -/ +local instance instDecidableEqRatFuncAdeleFilter : DecidableEq k⟮X⟯ := Classical.decEq _ +/-- Decidable equality on coordinate places for adele filter proofs. -/ +local instance instDecidableEqPlaceAAdeleFilter : DecidableEq (PlaceA k K) := Classical.decEq _ +/-- Additive group structure on adele filtration pieces. -/ +local instance adeleFiltAddCommGroup (D' : DivisorA k K) : AddCommGroup (adeleFilt k K D') := + Submodule.addCommGroup _ +/-- Module structure on adele filtration pieces. -/ +local instance adeleFiltModule (D' : DivisorA k K) : Module k (adeleFilt k K D') := + Submodule.module _ + +/-- The zero adele. -/ +def zeroAdele : AdeleSpace k K := ⟨0, by simp⟩ + +/-- Lift an adele to the valuation subring at a finite place, scaled by a uniformizer power. -/ +noncomputable def finiteAdeleLocalResidueToSubring (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) + (a : adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v := by + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inl v) + 1 + refine ⟨π ^ n * (a.val : AdeleSpace k K).val (Sum.inl v), ?_⟩ + have hmem : v.valuation K (π ^ n * (a.val : AdeleSpace k K).val (Sum.inl v)) ≤ 1 := by + have hπpow : v.valuation K (π ^ n) = WithZero.exp (-1) ^ n := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + rw [map_mul, hπpow] + have hf : v.valuation K ((a.val : AdeleSpace k K).val (Sum.inl v)) ≤ WithZero.exp n := by + have := a.property (Sum.inl v) + simpa [memAdeleFilt, placeValuation, n, Finsupp.add_apply, Finsupp.single_apply, + add_comm] using this + calc + WithZero.exp (-1) ^ n * v.valuation K ((a.val : AdeleSpace k K).val (Sum.inl v)) + ≤ WithZero.exp (-1) ^ n * WithZero.exp n := mul_le_mul_right hf _ + _ = 1 := by + rw [← WithZero.exp_zsmul, ← WithZero.exp_add] + convert WithZero.exp_zero + simp + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + Valuation.mem_valuationSubring_iff] + exact hmem + +/-- One-step local residue map on adeles at a finite coordinate place. -/ +noncomputable def finiteAdeleLocalResidueMap (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + adeleFilt k K (D + Finsupp.single (Sum.inl v) 1) →ₗ[k] v.asIdeal.ResidueField := + let A := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v + letI : Algebra k A := + ((algebraMap (ringOfIntegers k K) A).comp + (algebraMap k (ringOfIntegers k K))).toAlgebra + letI : IsScalarTower k (ringOfIntegers k K) A := + IsScalarTower.of_algebraMap_eq fun _ => rfl + { + toFun := fun a => + IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v + (finiteAdeleLocalResidueToSubring k K D v a) + map_add' := fun a b => by + rw [← map_add] + congr 1 + simp [finiteAdeleLocalResidueToSubring, mul_add] + map_smul' := fun c a => by + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inl v) + 1 + have hz : + finiteAdeleLocalResidueToSubring k K D v (c • a) = + algebraMap k A c * finiteAdeleLocalResidueToSubring k K D v a := by + apply Subtype.ext + simp only [finiteAdeleLocalResidueToSubring, Submodule.coe_smul_of_tower, Algebra.smul_def, + Pi.smul_apply] + let α : PlaceA k K → K := (a.val : AdeleSpace k K).val + change π ^ n * (algebraMap k K c * α (Sum.inl v)) = + (↑(algebraMap k A c) : K) * (π ^ n * α (Sum.inl v)) + have hcA : (↑(algebraMap k A c) : K) = algebraMap k K c := by + calc + (↑(algebraMap k A c) : K) = + ↑(algebraMap (ringOfIntegers k K) A + (algebraMap k (ringOfIntegers k K) c)) := by + rw [IsScalarTower.algebraMap_apply k (ringOfIntegers k K) A] + _ = algebraMap (ringOfIntegers k K) K + (algebraMap k (ringOfIntegers k K) c) := rfl + _ = algebraMap k K c := + (IsScalarTower.algebraMap_apply k (ringOfIntegers k K) K c).symm + rw [hcA] + ring + rw [hz, map_mul, Algebra.smul_def] + congr 1 + rw [IsScalarTower.algebraMap_apply k (ringOfIntegers k K) A] + rw [IsDedekindDomain.HeightOneSpectrum.residueHom, IsLocalization.lift_eq] + exact (IsScalarTower.algebraMap_apply k (ringOfIntegers k K) + v.asIdeal.ResidueField c).symm } + +theorem finiteAdeleLocalResidueMap_ker (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + (finiteAdeleLocalResidueMap k K D v).ker = + Submodule.comap (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)).subtype + (adeleFilt k K D) := by + ext a + simp only [LinearMap.mem_ker, Submodule.mem_comap, Submodule.coe_subtype, + finiteAdeleLocalResidueMap, finiteAdeleLocalResidueToSubring] + change IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v + ⟨(Classical.choose (v.valuation_exists_uniformizer K)) ^ + (D (Sum.inl v) + 1) * ((a.val : AdeleSpace k K).val (Sum.inl v)), _⟩ = 0 ↔ + ∀ w, placeValuation k K w ((a.val : AdeleSpace k K).val w) ≤ WithZero.exp (D w) + rw [IsDedekindDomain.HeightOneSpectrum.residueHom_eq_zero_iff] + have hπ := Classical.choose_spec (v.valuation_exists_uniformizer K) + rw [map_mul, map_zpow₀, hπ] + rw [← WithZero.exp_zsmul] + have hnsmul : (D (Sum.inl v) + 1) • (-1 : ℤ) = -(D (Sum.inl v) + 1) := by simp + rw [hnsmul] + have hlocal : WithZero.exp (-(D (Sum.inl v) + 1)) * + v.valuation K ((a.val : AdeleSpace k K).val (Sum.inl v)) < 1 ↔ + v.valuation K ((a.val : AdeleSpace k K).val (Sum.inl v)) ≤ + WithZero.exp (D (Sum.inl v)) := by + simpa using exp_neg_mul_lt_one_iff_le + (v.valuation K ((a.val : AdeleSpace k K).val (Sum.inl v))) (D (Sum.inl v) + 1) + rw [hlocal] + constructor + · intro hv w + by_cases hw : w = Sum.inl v + · subst hw + exact hv + · simpa [placeValuation, hw] using a.property w + · intro hf + simpa [placeValuation] using hf (Sum.inl v) + +theorem finiteAdeleLocalResidueMap_surjective (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + Function.Surjective (finiteAdeleLocalResidueMap k K D v) := by + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inl v) + 1 + intro y + obtain ⟨x, hx⟩ := IsLocalRing.residue_surjective y + let z : IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v := + IsDedekindDomain.HeightOneSpectrum.localizationAlgEquiv (K := K) v x + have hz : IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v z = y := by + rwa [IsDedekindDomain.HeightOneSpectrum.residueHom_apply_localizationAlgEquiv] + let xK : K := π ^ (-n) * (z : K) + let a₀ : AdeleSpace k K := adeleUpdate k K (zeroAdele k K) (Sum.inl v) xK + have ha₀ : a₀ ∈ adeleFilt k K (D + Finsupp.single (Sum.inl v) 1) := by + intro w + by_cases hw : w = Sum.inl v + · subst hw + simp only [placeValuation, Finsupp.add_apply, Finsupp.single_apply] + have hπpow : v.valuation K (π ^ (-n)) = WithZero.exp (-1) ^ (-n) := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + have hzle : v.valuation K (z : K) ≤ 1 := by + simpa [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + Valuation.mem_valuationSubring_iff] using z.property + have hval : + (v.valuation K) (a₀.val (Sum.inl v)) ≤ WithZero.exp (D (Sum.inl v) + 1) := by + have hmul' : (v.valuation K) (a₀.val (Sum.inl v)) = + (v.valuation K) (π ^ (-n)) * (v.valuation K) (z : K) := by + show (v.valuation K) + (Function.update (0 : PlaceA k K → K) (Sum.inl v) xK (Sum.inl v)) = _ + simp only [Function.update_self, xK] + exact Valuation.map_mul (v.valuation K) _ _ + have hbound : + (v.valuation K) (π ^ (-n)) * (v.valuation K) (z : K) ≤ WithZero.exp n := by + have hπpow : v.valuation K (π ^ (-n)) = WithZero.exp (-1) ^ (-n) := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + rw [hπpow] + have hzle0 : (v.valuation K) (z : K) ≤ WithZero.exp (0 : ℤ) := by + simpa [WithZero.exp_zero] using hzle + calc + WithZero.exp (-1) ^ (-n) * (v.valuation K) (z : K) + ≤ WithZero.exp (-1) ^ (-n) * WithZero.exp 0 := mul_le_mul_right hzle0 _ + _ = WithZero.exp n := by + rw [← WithZero.exp_zsmul, ← WithZero.exp_add] + simp + simpa [n] using (le_of_eq hmul').trans hbound + exact hval + · simp only [placeValuation, zeroAdele, adeleUpdate, a₀, + Function.update_of_ne hw, Pi.zero_apply, Valuation.map_zero, + Finsupp.add_apply, Finsupp.single_apply] + exact zero_le + refine ⟨⟨a₀, ha₀⟩, ?_⟩ + have hmul : (finiteAdeleLocalResidueToSubring k K D v ⟨a₀, ha₀⟩ : K) = (z : K) := by + dsimp [finiteAdeleLocalResidueToSubring, a₀, adeleUpdate, xK, zeroAdele, n, π] + simp only [Function.update_self] + have hπne : π ≠ 0 := by + intro h0 + have huniform := Classical.choose_spec (v.valuation_exists_uniformizer K) + have hπdef : v.valuation K π = WithZero.exp (-1) := by dsimp [π]; exact huniform + rw [h0, Valuation.map_zero] at hπdef + exact absurd hπdef.symm WithZero.exp_ne_zero + have h1 : π ^ (D (Sum.inl v) + 1) * π ^ (-(D (Sum.inl v) + 1)) = (1 : K) := by + rw [← zpow_add₀ hπne, add_neg_cancel, zpow_zero] + calc + π ^ (D (Sum.inl v) + 1) * (π ^ (-(D (Sum.inl v) + 1)) * (z : K)) + = (π ^ (D (Sum.inl v) + 1) * π ^ (-(D (Sum.inl v) + 1))) * (z : K) := by ring + _ = (z : K) := by rw [h1, one_mul] + simp only [finiteAdeleLocalResidueMap, finiteAdeleLocalResidueToSubring] + exact congr_arg (IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v) + (Subtype.ext_iff.mpr hmul) ▸ hz + +theorem finrankAdeleFiltDiff_single_finite (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + finrankAdeleFiltDiff k K D (D + Finsupp.single (Sum.inl v) 1) = + placeDegree k K (Sum.inl v) := by + let f := finiteAdeleLocalResidueMap k K D v + let e : (ringOfIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + have hker := finiteAdeleLocalResidueMap_ker k K D v + have hsurj := finiteAdeleLocalResidueMap_surjective k K D v + rw [finrankAdeleFiltDiff, ← hker, f.quotKerEquivRange.finrank_eq] + rw [LinearMap.range_eq_top.mpr hsurj, finrank_top] + calc + Module.finrank k v.asIdeal.ResidueField = Module.finrank k (ringOfIntegers k K ⧸ v.asIdeal) := + e.finrank_eq.symm + _ = placeDegree k K (Sum.inl v) := rfl + +/-- Lift an adele to the valuation subring at an infinite place, scaled by a uniformizer power. -/ +noncomputable def infiniteAdeleLocalResidueToSubring (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) + (a : adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v := by + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inr v) + 1 + refine ⟨π ^ n * (a.val : AdeleSpace k K).val (Sum.inr v), ?_⟩ + have hmem : v.valuation K (π ^ n * (a.val : AdeleSpace k K).val (Sum.inr v)) ≤ 1 := by + have hπpow : v.valuation K (π ^ n) = WithZero.exp (-1) ^ n := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + rw [map_mul, hπpow] + have hf : v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) ≤ WithZero.exp n := by + have := a.property (Sum.inr v) + simpa [memAdeleFilt, placeValuation, n, Finsupp.add_apply, Finsupp.single_apply, + add_comm] using this + calc + WithZero.exp (-1) ^ n * v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) + ≤ WithZero.exp (-1) ^ n * WithZero.exp n := mul_le_mul_right hf _ + _ = 1 := by + rw [← WithZero.exp_zsmul, ← WithZero.exp_add] + convert WithZero.exp_zero + simp + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + Valuation.mem_valuationSubring_iff] + exact hmem + +/-- One-step local residue map on adeles at an infinite coordinate place. -/ +noncomputable def infiniteAdeleLocalResidueMap (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + adeleFilt k K (D + Finsupp.single (Sum.inr v) 1) →ₗ[k] v.asIdeal.ResidueField := + let A := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v + letI : Algebra k A := + ((algebraMap (infiniteIntegers k K) A).comp + (algebraMap k (infiniteIntegers k K))).toAlgebra + letI : IsScalarTower k (infiniteIntegers k K) A := + IsScalarTower.of_algebraMap_eq fun _ => rfl + { + toFun := fun a => + IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v + (infiniteAdeleLocalResidueToSubring k K D v a) + map_add' := fun a b => by + rw [← map_add] + congr 1 + simp [infiniteAdeleLocalResidueToSubring, mul_add] + map_smul' := fun c a => by + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inr v) + 1 + have hz : + infiniteAdeleLocalResidueToSubring k K D v (c • a) = + algebraMap k A c * infiniteAdeleLocalResidueToSubring k K D v a := by + apply Subtype.ext + simp only [infiniteAdeleLocalResidueToSubring, Submodule.coe_smul_of_tower, + Algebra.smul_def, + Pi.smul_apply] + let α : PlaceA k K → K := (a.val : AdeleSpace k K).val + change π ^ n * (algebraMap k K c * α (Sum.inr v)) = + (↑(algebraMap k A c) : K) * (π ^ n * α (Sum.inr v)) + have hcA : (↑(algebraMap k A c) : K) = algebraMap k K c := by + calc + (↑(algebraMap k A c) : K) = + ↑(algebraMap (infiniteIntegers k K) A + (algebraMap k (infiniteIntegers k K) c)) := by + rw [IsScalarTower.algebraMap_apply k (infiniteIntegers k K) A] + _ = algebraMap (infiniteIntegers k K) K + (algebraMap k (infiniteIntegers k K) c) := rfl + _ = algebraMap k K c := + (IsScalarTower.algebraMap_apply k (infiniteIntegers k K) K c).symm + rw [hcA] + ring + rw [hz, map_mul, Algebra.smul_def] + congr 1 + rw [IsScalarTower.algebraMap_apply k (infiniteIntegers k K) A] + rw [IsDedekindDomain.HeightOneSpectrum.residueHom, IsLocalization.lift_eq] + exact (IsScalarTower.algebraMap_apply k (infiniteIntegers k K) + v.asIdeal.ResidueField c).symm } + +theorem infiniteAdeleLocalResidueMap_ker (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + (infiniteAdeleLocalResidueMap k K D v).ker = + Submodule.comap (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)).subtype + (adeleFilt k K D) := by + ext a + simp only [LinearMap.mem_ker, Submodule.mem_comap, Submodule.coe_subtype, + infiniteAdeleLocalResidueMap, infiniteAdeleLocalResidueToSubring] + change IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v + ⟨(Classical.choose (v.valuation_exists_uniformizer K)) ^ + (D (Sum.inr v) + 1) * ((a.val : AdeleSpace k K).val (Sum.inr v)), _⟩ = 0 ↔ + ∀ w, placeValuation k K w ((a.val : AdeleSpace k K).val w) ≤ WithZero.exp (D w) + rw [IsDedekindDomain.HeightOneSpectrum.residueHom_eq_zero_iff] + have hπ := Classical.choose_spec (v.valuation_exists_uniformizer K) + rw [map_mul, map_zpow₀, hπ] + rw [← WithZero.exp_zsmul] + have hnsmul : (D (Sum.inr v) + 1) • (-1 : ℤ) = -(D (Sum.inr v) + 1) := by simp + rw [hnsmul] + have hlocal : WithZero.exp (-(D (Sum.inr v) + 1)) * + v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) < 1 ↔ + v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) ≤ + WithZero.exp (D (Sum.inr v)) := by + simpa using exp_neg_mul_lt_one_iff_le + (v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v))) (D (Sum.inr v) + 1) + rw [hlocal] + constructor + · intro hv w + by_cases hw : w = Sum.inr v + · subst hw + exact hv + · simpa [placeValuation, hw] using a.property w + · intro hf + simpa [placeValuation] using hf (Sum.inr v) + +theorem infiniteAdeleLocalResidueMap_surjective (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + Function.Surjective (infiniteAdeleLocalResidueMap k K D v) := by + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inr v) + 1 + intro y + obtain ⟨x, hx⟩ := IsLocalRing.residue_surjective y + let z : IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v := + IsDedekindDomain.HeightOneSpectrum.localizationAlgEquiv (K := K) v x + have hz : IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v z = y := by + rwa [IsDedekindDomain.HeightOneSpectrum.residueHom_apply_localizationAlgEquiv] + let xK : K := π ^ (-n) * (z : K) + let a₀ : AdeleSpace k K := adeleUpdate k K (zeroAdele k K) (Sum.inr v) xK + have ha₀ : a₀ ∈ adeleFilt k K (D + Finsupp.single (Sum.inr v) 1) := by + intro w + by_cases hw : w = Sum.inr v + · subst hw + simp only [placeValuation, Finsupp.add_apply, Finsupp.single_apply] + have hπpow : v.valuation K (π ^ (-n)) = WithZero.exp (-1) ^ (-n) := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + have hzle : v.valuation K (z : K) ≤ 1 := by + simpa [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + Valuation.mem_valuationSubring_iff] using z.property + have hval : + (v.valuation K) (a₀.val (Sum.inr v)) ≤ WithZero.exp (D (Sum.inr v) + 1) := by + have hmul' : (v.valuation K) (a₀.val (Sum.inr v)) = + (v.valuation K) (π ^ (-n)) * (v.valuation K) (z : K) := by + show (v.valuation K) + (Function.update (0 : PlaceA k K → K) (Sum.inr v) xK (Sum.inr v)) = _ + simp only [Function.update_self, xK] + exact Valuation.map_mul (v.valuation K) _ _ + have hbound : + (v.valuation K) (π ^ (-n)) * (v.valuation K) (z : K) ≤ WithZero.exp n := by + have hπpow : v.valuation K (π ^ (-n)) = WithZero.exp (-1) ^ (-n) := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + rw [hπpow] + have hzle0 : (v.valuation K) (z : K) ≤ WithZero.exp (0 : ℤ) := by + simpa [WithZero.exp_zero] using hzle + calc + WithZero.exp (-1) ^ (-n) * (v.valuation K) (z : K) + ≤ WithZero.exp (-1) ^ (-n) * WithZero.exp 0 := mul_le_mul_right hzle0 _ + _ = WithZero.exp n := by + rw [← WithZero.exp_zsmul, ← WithZero.exp_add] + simp + simpa [n] using (le_of_eq hmul').trans hbound + exact hval + · simp only [placeValuation, zeroAdele, adeleUpdate, a₀, + Function.update_of_ne hw, Pi.zero_apply, Valuation.map_zero, + Finsupp.add_apply, Finsupp.single_apply] + exact zero_le + refine ⟨⟨a₀, ha₀⟩, ?_⟩ + have hmul : (infiniteAdeleLocalResidueToSubring k K D v ⟨a₀, ha₀⟩ : K) = (z : K) := by + dsimp [infiniteAdeleLocalResidueToSubring, a₀, adeleUpdate, xK, zeroAdele, n, π] + simp only [Function.update_self] + have hπne : π ≠ 0 := by + intro h0 + have huniform := Classical.choose_spec (v.valuation_exists_uniformizer K) + have hπdef : v.valuation K π = WithZero.exp (-1) := by dsimp [π]; exact huniform + rw [h0, Valuation.map_zero] at hπdef + exact absurd hπdef.symm WithZero.exp_ne_zero + have h1 : π ^ (D (Sum.inr v) + 1) * π ^ (-(D (Sum.inr v) + 1)) = (1 : K) := by + rw [← zpow_add₀ hπne, add_neg_cancel, zpow_zero] + calc + π ^ (D (Sum.inr v) + 1) * (π ^ (-(D (Sum.inr v) + 1)) * (z : K)) + = (π ^ (D (Sum.inr v) + 1) * π ^ (-(D (Sum.inr v) + 1))) * (z : K) := by ring + _ = (z : K) := by rw [h1, one_mul] + simp only [infiniteAdeleLocalResidueMap, infiniteAdeleLocalResidueToSubring] + exact congr_arg (IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v) + (Subtype.ext_iff.mpr hmul) ▸ hz + +theorem finrankAdeleFiltDiff_single_infinite (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + finrankAdeleFiltDiff k K D (D + Finsupp.single (Sum.inr v) 1) = + placeDegree k K (Sum.inr v) := by + let f := infiniteAdeleLocalResidueMap k K D v + let e : (infiniteIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + have hker := infiniteAdeleLocalResidueMap_ker k K D v + have hsurj := infiniteAdeleLocalResidueMap_surjective k K D v + rw [finrankAdeleFiltDiff, ← hker, f.quotKerEquivRange.finrank_eq] + rw [LinearMap.range_eq_top.mpr hsurj, finrank_top] + calc + Module.finrank k v.asIdeal.ResidueField = + Module.finrank k (infiniteIntegers k K ⧸ v.asIdeal) := + e.finrank_eq.symm + _ = placeDegree k K (Sum.inr v) := rfl + +theorem finrankAdeleFiltDiff_single_one (D : DivisorA k K) (v : PlaceA k K) : + finrankAdeleFiltDiff k K D (D + Finsupp.single v 1) = placeDegree k K v := by + rcases v with v | v + · exact finrankAdeleFiltDiff_single_finite k K D v + · exact finrankAdeleFiltDiff_single_infinite k K D v + +theorem finiteAdeleFiltDiff_quotient_single (D : DivisorA k K) (v : PlaceA k K) : + Module.Finite k ((adeleFilt k K (D + Finsupp.single v 1)) ⧸ + Submodule.comap (adeleFilt k K (D + Finsupp.single v 1)).subtype (adeleFilt k K D)) := by + classical + rcases v with v | v + · letI : AddCommGroup (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) := + Submodule.addCommGroup _ + letI : Module k (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) := Submodule.module _ + let f := finiteAdeleLocalResidueMap k K D v + let e : (ringOfIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let p := Submodule.comap (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)).subtype + (adeleFilt k K D) + haveI : Module.Finite k f.range := inferInstance + haveI : Module.Finite k + (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1) ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p + (finiteAdeleLocalResidueMap_ker k K D v)) + · letI : AddCommGroup (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) := + Submodule.addCommGroup _ + letI : Module k (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) := Submodule.module _ + let f := infiniteAdeleLocalResidueMap k K D v + let e : (infiniteIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let p := Submodule.comap (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)).subtype + (adeleFilt k K D) + haveI : Module.Finite k f.range := inferInstance + haveI : Module.Finite k + (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1) ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p + (infiniteAdeleLocalResidueMap_ker k K D v)) + +theorem finiteAdeleFiltDiff_quotient_self (D : DivisorA k K) : + Module.Finite k ((adeleFilt k K D) ⧸ + Submodule.comap (adeleFilt k K D).subtype (adeleFilt k K D)) := by + rw [show Submodule.comap (adeleFilt k K D).subtype (adeleFilt k K D) = ⊤ from + Submodule.comap_subtype_self (adeleFilt k K D)] + exact inferInstanceAs + (Module.Finite k ((adeleFilt k K D) ⧸ (⊤ : Submodule k (adeleFilt k K D)))) + +theorem finiteAdeleFiltDiff_quotient_mono_add {D M N : DivisorA k K} + (hDM : D ≤ M) (hMN : M ≤ N) + [Module.Finite k ((adeleFilt k K N) ⧸ + Submodule.comap (adeleFilt k K N).subtype (adeleFilt k K M))] + [Module.Finite k ((adeleFilt k K M) ⧸ + Submodule.comap (adeleFilt k K M).subtype (adeleFilt k K D))] : + Module.Finite k ((adeleFilt k K N) ⧸ + Submodule.comap (adeleFilt k K N).subtype (adeleFilt k K D)) := by + let p := adeleFilt k K N + let q := Submodule.comap p.subtype (adeleFilt k K D) + let r := Submodule.comap p.subtype (adeleFilt k K M) + let pM := adeleFilt k K M + let qM := Submodule.comap pM.subtype (adeleFilt k K D) + have hqr : q ≤ r := Submodule.comap_mono (adeleFilt_mono k K hDM) + let eR := Submodule.comapSubtypeEquivOfLe (adeleFilt_mono k K hMN) + let qInR : Submodule k ↥r := Submodule.comap r.subtype q + have hqmap : qM.map (eR.symm : pM →ₗ[k] r) = qInR := by + rw [Submodule.map_equiv_eq_comap_symm eR.symm qM] + rfl + have eMq : (pM ⧸ qM) ≃ₗ[k] (r ⧸ qInR) := Submodule.Quotient.equiv qM qInR eR.symm hqmap + haveI : Module.Finite k (r ⧸ qInR) := Module.Finite.equiv eMq + have hker : (q.mkQ.comp (r.subtype : r →ₗ[k] p)).ker = qInR := by + rw [LinearMap.ker_comp, Submodule.ker_mkQ] + have hrange : (q.mkQ.comp (r.subtype : r →ₗ[k] p)).range = r.map q.mkQ := by + rw [LinearMap.range_comp, Submodule.range_subtype] + have eQuot : (r ⧸ qInR) ≃ₗ[k] r.map q.mkQ := by + rw [← hker, ← hrange] + exact LinearMap.quotKerEquivRange (q.mkQ.comp (r.subtype : r →ₗ[k] p)) + haveI : Module.Finite k (r.map q.mkQ) := Module.Finite.equiv eQuot + have eThird := Submodule.quotientQuotientEquivQuotient q r hqr + haveI : Module.Finite k (p ⧸ r) := by dsimp only [p, r]; infer_instance + haveI : Module.Finite k ((p ⧸ q) ⧸ Submodule.map q.mkQ r) := Module.Finite.equiv eThird.symm + exact Module.Finite.of_submodule_quotient (Submodule.map q.mkQ r) + +theorem finiteAdeleFiltDiff_quotient_single_nat (D : DivisorA k K) (v : PlaceA k K) (n : ℕ) : + Module.Finite k ((adeleFilt k K (D + Finsupp.single v (n : ℤ))) ⧸ + Submodule.comap (adeleFilt k K (D + Finsupp.single v (n : ℤ))).subtype + (adeleFilt k K D)) := by + induction n with + | zero => + have heq : D + Finsupp.single v ((0 : ℕ) : ℤ) = D := by simp + rw [heq] + exact finiteAdeleFiltDiff_quotient_self k K D + | succ n ih => + have heq : D + Finsupp.single v ((n + 1 : ℕ) : ℤ) = + D + Finsupp.single v (n : ℤ) + Finsupp.single v 1 := by + ext w + simp only [Finsupp.add_apply, Finsupp.single_apply] + split <;> omega + have hDM : D ≤ D + Finsupp.single v (n : ℤ) := by + intro w + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + have hMN : D + Finsupp.single v (n : ℤ) ≤ + D + Finsupp.single v (n : ℤ) + Finsupp.single v 1 := by + intro w + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + letI := ih + haveI := finiteAdeleFiltDiff_quotient_single k K (D + Finsupp.single v (n : ℤ)) v + rw [heq] + exact finiteAdeleFiltDiff_quotient_mono_add k K hDM hMN + +theorem finiteAdeleFiltDiff_quotient_add_effective (D E : DivisorA k K) + (hE : IsEffective k K E) : + Module.Finite k ((adeleFilt k K (D + E)) ⧸ + Submodule.comap (adeleFilt k K (D + E)).subtype (adeleFilt k K D)) := by + classical + induction E using Finsupp.induction generalizing D with + | zero => + rw [add_zero] + exact finiteAdeleFiltDiff_quotient_self k K D + | single_add a b f ha hb ih => + have hfa : f a = 0 := Finsupp.notMem_support_iff.mp ha + have hff : IsEffective k K f := by + intro w + by_cases hw : w = a + · subst w + rw [hfa] + · simpa [Finsupp.single_apply, hw] using hE w + have hb0 : 0 ≤ b := by + simpa [Finsupp.single_apply, hfa] using hE a + letI := ih D hff + haveI := finiteAdeleFiltDiff_quotient_single_nat k K (D + f) a b.toNat + have hbcast : (b.toNat : ℤ) = b := Int.toNat_of_nonneg hb0 + have heq : D + (Finsupp.single a b + f) = + (D + f) + Finsupp.single a (b.toNat : ℤ) := by + rw [hbcast] + abel + have hDM : D ≤ D + f := by + intro w + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (hff w) + have hMN : D + f ≤ (D + f) + Finsupp.single a (b.toNat : ℤ) := by + intro w + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + rw [heq] + exact finiteAdeleFiltDiff_quotient_mono_add k K hDM hMN + +theorem finiteAdeleFiltDiff_quotient_add_eq {M N : DivisorA k K} + (hN : N = M + (N - M)) (hE : IsEffective k K (N - M)) : + Module.Finite k ((adeleFilt k K N) ⧸ + Submodule.comap (adeleFilt k K N).subtype (adeleFilt k K M)) := + hN ▸ finiteAdeleFiltDiff_quotient_add_effective k K M (N - M) hE + +theorem finrankAdeleFiltDiff_mono_add {D M N : DivisorA k K} + (hDM : D ≤ M) (hMN : M ≤ N) : + finrankAdeleFiltDiff k K D N = + finrankAdeleFiltDiff k K D M + finrankAdeleFiltDiff k K M N := by + let p := adeleFilt k K N + let q := Submodule.comap p.subtype (adeleFilt k K D) + let r := Submodule.comap p.subtype (adeleFilt k K M) + have hqr : q ≤ r := Submodule.comap_mono (adeleFilt_mono k K hDM) + have hDN : D ≤ N := hDM.trans hMN + have hE := (le_iff_sub_effective k K).mp hDN + have hEN := (le_iff_sub_effective k K).mp hMN + have hND : D + (N - D) = N := by ext w; simp [sub_eq_add_neg] + have hNM : M + (N - M) = N := by ext w; simp [sub_eq_add_neg] + haveI : Module.Finite k (p ⧸ q) := + finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hND.symm hE + haveI : Module.Finite k (p ⧸ r) := + finiteAdeleFiltDiff_quotient_add_eq k K (M := M) hNM.symm hEN + dsimp only [finrankAdeleFiltDiff] + have e := Submodule.quotientQuotientEquivQuotient q r hqr + have hadd := Submodule.finrank_quotient_add_finrank (r.map q.mkQ) + have hrmap : Module.finrank k (r.map q.mkQ) = finrankAdeleFiltDiff k K D M := by + let pM := adeleFilt k K M + let qM := Submodule.comap pM.subtype (adeleFilt k K D) + let qInR : Submodule k ↥r := Submodule.comap r.subtype q + let eR := Submodule.comapSubtypeEquivOfLe (adeleFilt_mono k K hMN) + have hqmap : qM.map (eR.symm : pM →ₗ[k] r) = qInR := by + rw [Submodule.map_equiv_eq_comap_symm eR.symm qM] + rfl + have eM : (pM ⧸ qM) ≃ₗ[k] (r ⧸ qInR) := Submodule.Quotient.equiv qM qInR eR.symm hqmap + have hker : (q.mkQ.comp (r.subtype : r →ₗ[k] p)).ker = qInR := by + rw [LinearMap.ker_comp, Submodule.ker_mkQ] + have hrange : (q.mkQ.comp (r.subtype : r →ₗ[k] p)).range = r.map q.mkQ := by + rw [LinearMap.range_comp, Submodule.range_subtype] + have eQuot : (r ⧸ qInR) ≃ₗ[k] r.map q.mkQ := by + rw [← hker, ← hrange] + exact LinearMap.quotKerEquivRange (q.mkQ.comp (r.subtype : r →ₗ[k] p)) + dsimp [finrankAdeleFiltDiff] + rw [← eQuot.finrank_eq, eM.finrank_eq] + calc + Module.finrank k (↥p ⧸ q) + = Module.finrank k ((↥p ⧸ q) ⧸ Submodule.map q.mkQ r) + + Module.finrank k ↥(Submodule.map q.mkQ r) := hadd.symm + _ = Module.finrank k (↥p ⧸ r) + finrankAdeleFiltDiff k K D M := by + rw [e.finrank_eq, hrmap] + _ = finrankAdeleFiltDiff k K D M + finrankAdeleFiltDiff k K M N := by + dsimp only [finrankAdeleFiltDiff] + rw [add_comm] + +theorem finrankAdeleFiltDiff_add_one {D M : DivisorA k K} (v : PlaceA k K) (hDM : D ≤ M) : + finrankAdeleFiltDiff k K D (M + Finsupp.single v 1) = + finrankAdeleFiltDiff k K D M + placeDegree k K v := by + have hMN : M ≤ M + Finsupp.single v 1 := by + intro w + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + rw [finrankAdeleFiltDiff_mono_add k K hDM hMN, finrankAdeleFiltDiff_single_one] + +theorem finrankAdeleFiltDiff_add_effective (D E : DivisorA k K) + (hE : IsEffective k K E) : + finrankAdeleFiltDiff k K D (D + E) = (deg k K E).toNat := by + classical + induction E using Finsupp.induction generalizing D with + | zero => + rw [add_zero, finrankAdeleFiltDiff, deg_zero] + have hp : Submodule.comap (adeleFilt k K D).subtype (adeleFilt k K D) = ⊤ := by + ext a + simp + rw [hp] + exact Module.finrank_eq_zero_of_subsingleton k _ + | single_add a b f ha hb ih => + have hfa : f a = 0 := Finsupp.notMem_support_iff.mp ha + have hff : IsEffective k K f := by + intro w + by_cases hw : w = a + · subst w + rw [hfa] + · have hwE := hE w + simpa [Finsupp.single_apply, hw] using hwE + have hb0 : 0 ≤ b := by + have haE := hE a + simpa [Finsupp.single_apply, hfa] using haE + let M := D + f + let N := M + Finsupp.single a (b.toNat : ℤ) + have hDM : D ≤ M := by + intro w + dsimp only [M] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (hff w) + have hMN : M ≤ N := by + intro w + dsimp only [N] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + have hfirst := ih D hff + have hsecond : finrankAdeleFiltDiff k K M N = b.toNat * placeDegree k K a := by + have hbcast : (b.toNat : ℤ) = b := Int.toNat_of_nonneg hb0 + have heq : N = M + Finsupp.single a (b.toNat : ℤ) := rfl + rw [heq] + induction b.toNat with + | zero => + simp only [Nat.cast_zero, Finsupp.single_zero, add_zero, zero_mul] + rw [finrankAdeleFiltDiff] + have hp : Submodule.comap (adeleFilt k K M).subtype (adeleFilt k K M) = ⊤ := by + ext a + simp + rw [hp] + exact Module.finrank_eq_zero_of_subsingleton k _ + | succ n ihN => + let P := M + Finsupp.single a (n : ℤ) + have hMP : M ≤ P := by + intro w + dsimp only [P] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + have heqP : M + Finsupp.single a ((n + 1 : ℕ) : ℤ) = P + Finsupp.single a 1 := by + dsimp [P] + ext w + simp only [Finsupp.add_apply, Finsupp.single_apply] + split <;> omega + have hadd := finrankAdeleFiltDiff_add_one k K (M := P) a hMP + have hcast : M + Finsupp.single a (Int.ofNat (n + 1)) = + M + Finsupp.single a ((n + 1 : ℕ) : ℤ) := by simp [Int.ofNat_eq_natCast] + calc + finrankAdeleFiltDiff k K M (M + Finsupp.single a ↑(n + 1)) + = finrankAdeleFiltDiff k K M (M + Finsupp.single a (Int.ofNat (n + 1))) := by + simp [Int.ofNat_eq_natCast] + _ = finrankAdeleFiltDiff k K M (M + Finsupp.single a ((n + 1 : ℕ) : ℤ)) := by + rw [hcast] + _ = finrankAdeleFiltDiff k K M (P + Finsupp.single a 1) := by rw [heqP] + _ = finrankAdeleFiltDiff k K M P + placeDegree k K a := hadd + _ = n * placeDegree k K a + placeDegree k K a := by + rw [← ihN] + _ = (n + 1) * placeDegree k K a := by ring + have hdegf : 0 ≤ deg k K f := deg_nonneg k K hff + have hdegE : deg k K (Finsupp.single a b + f) = + b * (placeDegree k K a : ℤ) + deg k K f := by + rw [deg_add] + simp [deg] + have hdegE0 : 0 ≤ deg k K (Finsupp.single a b + f) := deg_nonneg k K hE + have hdegNat : (deg k K (Finsupp.single a b + f)).toNat = + b.toNat * placeDegree k K a + (deg k K f).toNat := by + have hfcast : ((deg k K f).toNat : ℤ) = deg k K f := Int.toNat_of_nonneg hdegf + have hEcast : ((deg k K (Finsupp.single a b + f)).toNat : ℤ) = + deg k K (Finsupp.single a b + f) := Int.toNat_of_nonneg hdegE0 + apply Int.ofNat_injective + change ((deg k K (Finsupp.single a b + f)).toNat : ℤ) = + ((b.toNat * placeDegree k K a + (deg k K f).toNat : ℕ) : ℤ) + rw [hEcast, Nat.cast_add, Nat.cast_mul, Int.toNat_of_nonneg hb0, hfcast] + exact hdegE + have htotal : finrankAdeleFiltDiff k K D N = + (deg k K (Finsupp.single a b + f)).toNat := by + have hadd := finrankAdeleFiltDiff_mono_add k K hDM hMN + rw [hadd, hfirst, hsecond, hdegNat, Nat.add_comm] + have heq : D + (Finsupp.single a b + f) = N := by + dsimp only [N, M] + rw [Int.toNat_of_nonneg hb0] + abel + rw [heq] + exact htotal + +theorem finrank_adeleFilt_quotient {D D' : DivisorA k K} (h : D ≤ D') : + finrankAdeleFiltDiff k K D D' = (deg k K (D' - D)).toNat := by + have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp h + have hrank := finrankAdeleFiltDiff_add_effective k K D (D' - D) hE + have heq : D + (D' - D) = D' := by abel + rw [heq] at hrank + exact hrank + +theorem finrank_map_comap_mkQ_eq_quotient {D' : DivisorA k K} + {s t : Submodule k (AdeleSpace k K)} (_hs : s ≤ adeleFilt k K D') + (ht : t ≤ adeleFilt k K D') (_hst : s ≤ t) : + Module.finrank k (Submodule.map (Submodule.comap (adeleFilt k K D').subtype s).mkQ + (Submodule.comap (adeleFilt k K D').subtype t)) = + Module.finrank k + (↥(Submodule.comap (adeleFilt k K D').subtype t) ⧸ + Submodule.comap (Submodule.comap (adeleFilt k K D').subtype t).subtype + (Submodule.comap (adeleFilt k K D').subtype s)) := by + classical + let p := adeleFilt k K D' + let qp := Submodule.comap p.subtype s + let qt := Submodule.comap p.subtype t + let st := Submodule.comap t.subtype s + let qpInQt := Submodule.comap qt.subtype qp + letI : AddCommGroup ↥t := Submodule.addCommGroup _ + letI : Module k ↥t := Submodule.module _ + letI : AddCommGroup ↥qt := Submodule.addCommGroup _ + letI : Module k ↥qt := Submodule.module _ + let eT := Submodule.comapSubtypeEquivOfLe ht + have hmap : st.map (eT.symm : ↥t →ₗ[k] ↥qt) = qpInQt := by + ext x + simp [Submodule.mem_comap, st, qpInQt, qp, qt, eT] + have hker : (qp.mkQ.comp (qt.subtype : qt →ₗ[k] p)).ker = qpInQt := by + rw [LinearMap.ker_comp, Submodule.ker_mkQ] + have hrange : (qp.mkQ.comp (qt.subtype : qt →ₗ[k] p)).range = Submodule.map qp.mkQ qt := by + rw [LinearMap.range_comp, Submodule.range_subtype] + have eQuot : (↥qt ⧸ qpInQt) ≃ₗ[k] Submodule.map qp.mkQ qt := by + rw [← hker, ← hrange] + exact LinearMap.quotKerEquivRange (qp.mkQ.comp (qt.subtype : qt →ₗ[k] p)) + have eTS : ((↥t) ⧸ st) ≃ₗ[k] ((↥qt) ⧸ qpInQt) := + Submodule.Quotient.equiv st qpInQt eT.symm hmap + rw [← eQuot.finrank_eq, ← eTS.finrank_eq] + +theorem sandwich {D D' : DivisorA k K} (h : D ≤ D') : + sandwichRank k K D D' h = deg k K D' - ell k K D' - (deg k K D - ell k K D) := by + let p := adeleFilt k K D' + let s := adeleFilt k K D + let r := diagonalSubmodule k K + let l := Submodule.map (diagonal k K) (RRspace k K D') + let t := l ⊔ s + have hs_le_p : s ≤ p := adeleFilt_mono k K h + have hst : s ≤ t := le_sup_right + have htp : t ≤ p := by + rintro x hx + rcases Submodule.mem_sup.mp hx with ⟨y, hy, z, hz, rfl⟩ + rcases hy with ⟨f, hf, rfl⟩ + exact Submodule.add_mem p + (by simpa [adeleFilt, memAdeleFilt, memRRspace, RRspace, diagonal, p] using hf) (hs_le_p hz) + have hmod : p ⊓ (s + r) = s + p ⊓ r := by + apply le_antisymm + · rintro x ⟨hxp, hxsr⟩ + rcases Submodule.mem_sup.mp hxsr with ⟨a, has, y, hy, rfl⟩ + obtain ⟨f, rfl⟩ := LinearMap.mem_range.mp hy + refine Submodule.mem_sup.mpr ⟨a, has, (diagonal k K f), ?_, rfl⟩ + exact Submodule.mem_inf.mpr + ⟨(by simpa [sub_add_cancel] using Submodule.sub_mem p hxp (hs_le_p has)), hy⟩ + · rintro x hx + rcases Submodule.mem_sup.mp hx with ⟨a, has, y, hy, rfl⟩ + rcases Submodule.mem_inf.mp hy with ⟨hyp, hyr⟩ + refine ⟨Submodule.add_mem p (hs_le_p has) hyp, + Submodule.add_mem (s + r) (Submodule.mem_sup_left has) (Submodule.mem_sup_right hyr)⟩ + have hinter : p ⊓ (s + r) = t := by + have hpr : p ⊓ r = l := adeleFilt_inf_diagonal k K D' + calc p ⊓ (s + r) = s + (p ⊓ r) := hmod + _ = s + l := by rw [hpr] + _ = t := by simp [t, Submodule.add_eq_sup, sup_comm] + letI : AddCommGroup ↥p := Submodule.addCommGroup _ + letI : Module k ↥p := Submodule.module _ + letI : AddCommGroup ↥(p + r) := Submodule.addCommGroup _ + letI : Module k ↥(p + r) := Submodule.module _ + let qp := Submodule.comap p.subtype s + let qt := Submodule.comap p.subtype t + have hqp : qp ≤ qt := Submodule.comap_mono hst + have hpsum : p ⊔ (s + r) = p + r := by + rw [← Submodule.add_eq_sup] + apply le_antisymm + · refine sup_le le_sup_left (add_le_add hs_le_p le_rfl) + · intro x hx + rcases Submodule.mem_sup.mp hx with ⟨a, ha, b, hb, rfl⟩ + have hb' : b ∈ s + r := Submodule.mem_sup_right hb + exact Submodule.add_mem _ (Submodule.mem_sup_left ha) (Submodule.mem_sup_right hb') + haveI : AddCommGroup ↥(p ⊔ (s + r)) := Submodule.addCommGroup _ + haveI : Module k ↥(p ⊔ (s + r)) := Submodule.module _ + have e1 := LinearMap.quotientInfEquivSupQuotient p (s + r) + have hsand : + Module.finrank k (↥(p + r) ⧸ Submodule.comap (p + r).subtype (s + r)) = + Module.finrank k (↥p ⧸ qt) := by + have hinfl : + Submodule.comap p.subtype p ⊓ Submodule.comap p.subtype (s + r) = qt := by + rw [← Submodule.comap_inf, hinter] + have hfin := e1.symm.finrank_eq + rw [← hpsum.symm, hinfl] at hfin + exact hfin + have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp h + have e2 := Submodule.quotientQuotientEquivQuotient qp qt hqp + have hdiv : D + (D' - D) = D' := by ext w; simp [sub_eq_add_neg] + haveI : Module.Finite k (↥p ⧸ qp) := + finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hdiv.symm hE + have hsecond : Module.finrank k (Submodule.map qp.mkQ qt) = finrankRRspaceDiff k K D D' := by + have hld : l ⊓ s = Submodule.map (diagonal k K) (RRspace k K D) := by + refine Submodule.ext fun a => ⟨?_, ?_⟩ + · rintro ⟨hxl, hxs⟩ + rcases hxl with ⟨f, hf, rfl⟩ + refine ⟨f, fun v => ?_, rfl⟩ + have hxv := hxs v + simpa [memRRspace, memAdeleFilt, placeValuation, diagonal, adeleFilt, s] using hxv + · rintro ⟨f, hf, rfl⟩ + refine ⟨⟨f, RRspace_mono k K h hf, rfl⟩, fun v => ?_⟩ + simpa [memRRspace, memAdeleFilt, placeValuation, diagonal, adeleFilt, s] using hf v + have hfin_map := finrank_map_comap_mkQ_eq_quotient k K hs_le_p htp hst + let st := Submodule.comap t.subtype s + let qpInQt := Submodule.comap qt.subtype qp + letI : AddCommGroup ↥t := Submodule.addCommGroup _ + letI : Module k ↥t := Submodule.module _ + let eT := Submodule.comapSubtypeEquivOfLe htp + have hmap : st.map (eT.symm : ↥t →ₗ[k] ↥qt) = qpInQt := by + ext x + simp [Submodule.mem_comap, st, qpInQt, qp, qt, eT] + have eTS : ((↥t) ⧸ st) ≃ₗ[k] ((↥qt) ⧸ qpInQt) := + Submodule.Quotient.equiv st qpInQt eT.symm hmap + have e3 := LinearMap.quotientInfEquivSupQuotient l s + letI : AddCommGroup ↥(l ⊔ s) := Submodule.addCommGroup _ + letI : Module k ↥(l ⊔ s) := Submodule.module _ + letI : AddCommGroup ↥l := Submodule.addCommGroup _ + letI : Module k ↥l := Submodule.module _ + dsimp [finrankRRspaceDiff] + calc + Module.finrank k (Submodule.map qp.mkQ qt) + = Module.finrank k (↥qt ⧸ Submodule.comap qt.subtype qp) := hfin_map + _ = Module.finrank k (↥t ⧸ st) := eTS.finrank_eq.symm + _ = Module.finrank k (↥(l ⊔ s) ⧸ Submodule.comap (l ⊔ s).subtype s) := rfl + _ = Module.finrank k + (↥l ⧸ (Submodule.comap l.subtype l ⊓ Submodule.comap l.subtype s)) := + e3.symm.finrank_eq + _ = Module.finrank k + ((RRspace k K D') ⧸ Submodule.comap (RRspace k K D').subtype (RRspace k K D)) := by + let pR := RRspace k K D' + let qR := Submodule.comap pR.subtype (RRspace k K D) + let qInL : Submodule k ↥l := + Submodule.comap l.subtype (Submodule.map (diagonal k K) (RRspace k K D)) + let f' := (diagonal k K).comp pR.subtype + have hf' : ∀ g, f' g ∈ l := fun g => Submodule.mem_map.mpr ⟨g, g.property, rfl⟩ + let f : pR →ₗ[k] l := f'.codRestrict l hf' + have hf_ker : f.ker = ⊥ := by + rw [eq_bot_iff] + intro g hg + apply Subtype.ext + let w : PlaceA k K := Classical.choice (nonempty_placeA k K) + have hfg := LinearMap.mem_ker.mp hg + have hzero : (f g : AdeleSpace k K) = 0 := congrArg Subtype.val hfg + have hz : ((f g : AdeleSpace k K).val : PlaceA k K → K) w = 0 := by + rw [hzero] + simp + simpa [f, f', diagonal, LinearMap.comp_apply, Submodule.coe_subtype] using hz + have hf_inj : Function.Injective f := by + intro g₁ g₂ hfg + have hmem : g₁ - g₂ ∈ f.ker := by + rw [LinearMap.mem_ker, map_sub, hfg, sub_self] + rw [hf_ker] at hmem + exact sub_eq_zero.mp hmem + have hf_surj : Function.Surjective f := by + rintro ⟨a, g, hg, rfl⟩ + exact ⟨⟨g, hg⟩, rfl⟩ + let eL : pR ≃ₗ[k] l := LinearEquiv.ofBijective f ⟨hf_inj, hf_surj⟩ + have hmap : qR.map f = qInL := by + ext x + simp only [Submodule.mem_map, Submodule.mem_comap, qR, qInL, l] + constructor + · rintro ⟨g, hg, heq⟩ + refine ⟨g.val, ?_, ?_⟩ + · simpa [mem_RRspace_iff] using hg + · rw [← heq] + rfl + · rintro ⟨y, hy, hxy⟩ + refine ⟨⟨y, RRspace_mono k K h hy⟩, ?_, ?_⟩ + · simpa [mem_RRspace_iff] using hy + · apply Subtype.ext + exact hxy + have eQuot : (pR ⧸ qR) ≃ₗ[k] (l ⧸ qInL) := Submodule.Quotient.equiv qR qInL eL hmap + rw [← Submodule.comap_inf, hld, eQuot.finrank_eq] + have hsplit : + Module.finrank k (↥p ⧸ qt) = + finrankAdeleFiltDiff k K D D' - finrankRRspaceDiff k K D D' := by + unfold finrankAdeleFiltDiff + have hfin := finrank_adeleFilt_quotient k K h + have hle' : finrankRRspaceDiff k K D D' ≤ finrankAdeleFiltDiff k K D D' := by + rw [hfin] + exact finrank_RRspace_quotient_le k K h + have hadd := Submodule.finrank_quotient_add_finrank (Submodule.map qp.mkQ qt) + rw [e2.finrank_eq, hsecond] at hadd + exact (Nat.sub_eq_of_eq_add hadd.symm).symm + have hfin := finrank_adeleFilt_quotient k K h + have hdeg : 0 ≤ deg k K (D' - D) := deg_nonneg k K hE + have htoNat : ((deg k K (D' - D)).toNat : ℤ) = deg k K (D' - D) := + Int.toNat_of_nonneg hdeg + have hrr := finrankRRspaceDiff_add_ell k K h + have hle : finrankRRspaceDiff k K D D' ≤ finrankAdeleFiltDiff k K D D' := by + rw [hfin] + exact finrank_RRspace_quotient_le k K h + dsimp only [sandwichRank] + have hmain : + (Int.ofNat (Module.finrank k (↥(p + r) ⧸ Submodule.comap (p + r).subtype (s + r)))) = + (finrankAdeleFiltDiff k K D D' - finrankRRspaceDiff k K D D') := by + rw [hsand, hsplit] + simp only [Int.ofNat_eq_natCast, Nat.cast_sub hle] + rw [hmain, hfin, htoNat] + have hrrZ : (finrankRRspaceDiff k K D D' : ℤ) = ell k K D' - ell k K D := by + rw [finrankRRspaceDiff, ell, ell, + ← (Submodule.comapSubtypeEquivOfLe (RRspace_mono k K h)).finrank_eq] at hrr ⊢ + omega + rw [hrrZ, deg_sub k K D' D] + omega + +theorem sandwichDiagonal_inter {D D' : DivisorA k K} (h : D ≤ D') : + adeleFilt k K D' ⊓ (adeleFilt k K D + diagonalSubmodule k K) = + Submodule.map (diagonal k K) (RRspace k K D') ⊔ adeleFilt k K D := by + let p := adeleFilt k K D' + let s := adeleFilt k K D + let r := diagonalSubmodule k K + let l := Submodule.map (diagonal k K) (RRspace k K D') + let t := l ⊔ s + have hs_le_p : s ≤ p := adeleFilt_mono k K h + have hmod : p ⊓ (s + r) = s + p ⊓ r := by + apply le_antisymm + · rintro x ⟨hxp, hxsr⟩ + rcases Submodule.mem_sup.mp hxsr with ⟨a, has, y, hy, rfl⟩ + obtain ⟨f, rfl⟩ := LinearMap.mem_range.mp hy + refine Submodule.mem_sup.mpr ⟨a, has, (diagonal k K f), ?_, rfl⟩ + exact Submodule.mem_inf.mpr + ⟨(by simpa [sub_add_cancel] using Submodule.sub_mem p hxp (hs_le_p has)), hy⟩ + · rintro x hx + rcases Submodule.mem_sup.mp hx with ⟨a, has, y, hy, rfl⟩ + rcases Submodule.mem_inf.mp hy with ⟨hyp, hyr⟩ + refine ⟨Submodule.add_mem p (hs_le_p has) hyp, + Submodule.add_mem (s + r) (Submodule.mem_sup_left has) (Submodule.mem_sup_right hyr)⟩ + have hpr : p ⊓ r = l := adeleFilt_inf_diagonal k K D' + calc + p ⊓ (s + r) = s + p ⊓ r := hmod + _ = s + l := by rw [hpr] + _ = t := by simp [t, Submodule.add_eq_sup, sup_comm] + +theorem sandwichDiagonalSubmodule_eq_of_rank_zero {D D' : DivisorA k K} (hle : D ≤ D') + (h0 : sandwichRank k K D D' hle = 0) : + adeleFilt k K D' + diagonalSubmodule k K = adeleFilt k K D + diagonalSubmodule k K := by + let p := adeleFilt k K D' + let s := adeleFilt k K D + let r := diagonalSubmodule k K + let t := Submodule.map (diagonal k K) (RRspace k K D') ⊔ s + let qp := Submodule.comap p.subtype s + let qt := Submodule.comap p.subtype t + have hqp_le : qp ≤ qt := Submodule.comap_mono le_sup_right + have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp hle + have hdiv : D + (D' - D) = D' := by abel + haveI : Module.Finite k (↥p ⧸ qp) := + finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hdiv.symm hE + have htp : t ≤ p := by + rintro x hx + rcases Submodule.mem_sup.mp hx with ⟨y, hy, z, hz, rfl⟩ + rcases hy with ⟨f, hf, rfl⟩ + exact Submodule.add_mem p + (by simpa [adeleFilt, memAdeleFilt, memRRspace, RRspace, diagonal, p] using hf) + (adeleFilt_mono k K hle hz) + letI : AddCommGroup ↥p := Submodule.addCommGroup _ + letI : Module k ↥p := Submodule.module _ + letI : AddCommGroup ↥(p + r) := Submodule.addCommGroup _ + letI : Module k ↥(p + r) := Submodule.module _ + letI : AddCommGroup ↥(adeleFilt k K D' + diagonalSubmodule k K) := Submodule.addCommGroup _ + letI : Module k ↥(adeleFilt k K D' + diagonalSubmodule k K) := Submodule.module _ + have hfin_qt : Module.finrank k (↥p ⧸ qt) = 0 := by + have hfin_sandwich : + Module.finrank k + (↥(adeleFilt k K D' + diagonalSubmodule k K) ⧸ + Submodule.comap (adeleFilt k K D' + diagonalSubmodule k K).subtype + (adeleFilt k K D + diagonalSubmodule k K)) = 0 := + Int.ofNat_eq_zero.mp (by simpa [sandwichRank] using h0) + have hinter := sandwichDiagonal_inter k K hle + have hinfl : Submodule.comap p.subtype p ⊓ Submodule.comap p.subtype (s + r) = qt := by + rw [← Submodule.comap_inf, hinter] + have hpsum : p ⊔ (s + r) = p + r := by + rw [← Submodule.add_eq_sup] + apply le_antisymm + · refine sup_le le_sup_left (add_le_add (adeleFilt_mono k K hle) le_rfl) + · intro x hx + rcases Submodule.mem_sup.mp hx with ⟨a, ha, b, hb, rfl⟩ + have hb' : b ∈ s + r := Submodule.mem_sup_right hb + exact Submodule.add_mem _ (Submodule.mem_sup_left ha) (Submodule.mem_sup_right hb') + have hsand := + (LinearMap.quotientInfEquivSupQuotient p (s + r)).symm.finrank_eq + rw [hpsum, hinfl] at hsand + exact hsand.symm.trans hfin_sandwich + haveI : Module.Finite k (↥p ⧸ qt) := + Module.Finite.equiv (Submodule.quotientQuotientEquivQuotient qp qt hqp_le) + have hrk : Module.rank k (↥p ⧸ qt) = 0 := by + rw [← Module.finrank_eq_rank, hfin_qt, Nat.cast_zero] + have hsub : Subsingleton (↥p ⧸ qt) := rank_zero_iff.mp hrk + have htopqt : qt = ⊤ := Submodule.Quotient.subsingleton_iff.mp hsub + have hp_le_t : p ≤ t := Submodule.comap_subtype_eq_top.mp htopqt + have hp_eq_t : p = t := le_antisymm hp_le_t htp + have hinter := sandwichDiagonal_inter k K hle + have hp_le_sr : p ≤ s + r := by + have h := inf_le_right (a := p) (b := s + r) + rw [hinter] at h + exact hp_eq_t.symm ▸ h + have hsr_le_pr : s + r ≤ p + r := add_le_add (adeleFilt_mono k K hle) le_rfl + have hpr_le_sr : p + r ≤ s + r := by + intro x hx + rcases Submodule.mem_sup.mp hx with ⟨a, hap, y, hyr, rfl⟩ + rcases Submodule.mem_sup.mp (hp_le_sr hap) with ⟨b, hbs, w, hwr, hbc⟩ + refine Submodule.mem_sup.mpr + ⟨b, hbs, w + y, Submodule.add_mem r hwr hyr, by rw [← hbc, add_assoc]⟩ + exact le_antisymm hpr_le_sr hsr_le_pr + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean b/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean new file mode 100644 index 0000000000..b9b52f5624 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean @@ -0,0 +1,11 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +/- +Kernel-level axiom audit for the vendored coordinate-free Riemann--Roch core. +-/ + +import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch diff --git a/LeanPool/MarkoffModP/RiemannRoch/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/Basic.lean new file mode 100644 index 0000000000..89c37c0b02 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Basic.lean @@ -0,0 +1,86 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.FunctionField.Divisor +public import Mathlib.FieldTheory.AlgebraicClosure +public import Mathlib.FieldTheory.RatFunc.Basic + +/-! +# Basic divisor API aliases + +This file re-exports the coordinate divisor API from `FunctionField.Divisor` under the names +used in downstream modules (`degA`, `placeDegA`), and hosts the standing +`IsFullConstantField` hypothesis. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc + +noncomputable section + +namespace FunctionField + +open Chart + +variable (k K : Type*) [Field k] [Field K] + [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- Backward-compatible alias for `placeDegree`. -/ +abbrev placeDegA (v : PlaceA k K) : ℕ := placeDegree k K v + +/-- Backward-compatible alias for `deg`. -/ +noncomputable abbrev degA (D : DivisorA k K) : ℤ := deg k K D + +/-- Every element of `K` that is algebraic over the base field `k` is already in `k`. + +This is the standing hypothesis for the Stichtenoth/Serre adelic proof track. It is equivalent +to `k` being relatively algebraically closed in `K`, i.e. Mathlib's `algebraicClosure k K = ⊥`; +see `FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot`. -/ +class IsFullConstantField (k K : Type*) [Field k] [Field K] [Algebra k K] : Prop where + /-- Every element of `K` that is algebraic over `k` already lies in the image of `k`. -/ + algebraic_mem : ∀ x : K, IsAlgebraic k x → ∃ c : k, x = algebraMap k K c + +namespace IsFullConstantField + +variable (k K : Type*) [Field k] [Field K] [Algebra k K] [IsFullConstantField k K] + +theorem mem_range {x : K} (hx : IsAlgebraic k x) : + x ∈ Set.range (algebraMap k K) := by + obtain ⟨c, hc⟩ := IsFullConstantField.algebraic_mem (k := k) (K := K) x hx + exact ⟨c, hc.symm⟩ + +end IsFullConstantField + +/-- `IsFullConstantField k K` is exactly the statement that `k` is relatively algebraically +closed in `K`, i.e. it coincides with Mathlib's `algebraicClosure k K = ⊥`. This identifies the +standing hypothesis with the standard field-theoretic notion. -/ +theorem isFullConstantField_iff_algebraicClosure_eq_bot (k K : Type*) [Field k] [Field K] + [Algebra k K] : IsFullConstantField k K ↔ algebraicClosure k K = ⊥ := by + constructor + · intro h + rw [eq_bot_iff] + intro x hx + obtain ⟨c, rfl⟩ := h.algebraic_mem x (mem_algebraicClosure_iff.mp hx) + exact (⊥ : IntermediateField k K).algebraMap_mem c + · intro h + refine ⟨fun x hx => ?_⟩ + have hxb : x ∈ (⊥ : IntermediateField k K) := h ▸ mem_algebraicClosure_iff.mpr hx + obtain ⟨c, hc⟩ := IntermediateField.mem_bot.mp hxb + exact ⟨c, hc.symm⟩ + +instance ratFuncIsFullConstantField : IsFullConstantField k (RatFunc k) where + algebraic_mem x hx := by + by_contra h + exact RatFunc.transcendental_of_ne_C x h hx + +end FunctionField + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean new file mode 100644 index 0000000000..a664640cab --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean @@ -0,0 +1,246 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.Divisor + +/-! +# Adeles indexed by intrinsic places + +This file defines the function-field adele space directly as a restricted product over +coordinate-free places. The equivalence `adeleEquivChart` identifies it with the two-chart +construction and transports the filtration and diagonal embedding. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero +open Filter + +noncomputable section + +namespace FunctionField + +open Chart + +variable (k K : Type*) [Field k] [Field K] +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- The `k`-submodule of tuples over intrinsic places that are integral almost everywhere. -/ +def adeleSubmodule : Submodule k (Place k K → K) where + carrier := {a | ∀ᶠ v in cofinite, a v ∈ v.toValuationSubring} + zero_mem' := by + change ∀ᶠ v : Place k K in cofinite, (0 : K) ∈ v.toValuationSubring + exact Filter.Eventually.of_forall fun v => v.toValuationSubring.zero_mem + add_mem' {a b} ha hb := by + change ∀ᶠ v in cofinite, a v ∈ v.toValuationSubring at ha + change ∀ᶠ v in cofinite, b v ∈ v.toValuationSubring at hb + change ∀ᶠ v in cofinite, (a + b) v ∈ v.toValuationSubring + exact (ha.and hb).mono fun _ h => add_mem h.1 h.2 + smul_mem' c a ha := by + change ∀ᶠ v in cofinite, a v ∈ v.toValuationSubring at ha + change ∀ᶠ v in cofinite, (c • a) v ∈ v.toValuationSubring + filter_upwards [ha] with v hv + rw [Pi.smul_apply, Algebra.smul_def] + exact mul_mem (v.triv_on_k c) hv + +/-- The intrinsic, `K`-valued adele space. -/ +abbrev AdeleSpace := adeleSubmodule k K + +/-- Every element of the function field is integral at all but finitely many intrinsic places. -/ +theorem eventually_mem_place (f : K) : + ∀ᶠ v : Place k K in cofinite, f ∈ v.toValuationSubring := by + have h := Chart.eventually_mem_placeValuationSubring k K f + have h' := (chartToPlace k K).symm.injective.tendsto_cofinite.eventually h + filter_upwards [h'] with v hv + rw [← (chartToPlace k K).apply_symm_apply v, chartToPlace_apply, + Place.ofChart_toValuationSubring] + exact hv + +/-- Reindex an intrinsic adele along the equivalence between chart and intrinsic places. -/ +noncomputable def adeleEquivChart : AdeleSpace k K ≃ₗ[k] Chart.AdeleSpace k K where + toFun a := ⟨fun w => a.1 (chartToPlace k K w), by + have ha := (chartToPlace k K).injective.tendsto_cofinite.eventually a.property + filter_upwards [ha] with w hw + rw [placeValuationSubring, ← Place.ofChart_toValuationSubring] + exact hw⟩ + invFun a := ⟨fun v => a.1 ((chartToPlace k K).symm v), by + have ha := (chartToPlace k K).symm.injective.tendsto_cofinite.eventually a.property + filter_upwards [ha] with v hv + have hs : v.toValuationSubring = + placeValuationSubring k K ((chartToPlace k K).symm v) := by + rw [placeValuationSubring, ← Place.ofChart_toValuationSubring] + exact congrArg Place.toValuationSubring + ((chartToPlace k K).apply_symm_apply v).symm + rw [hs] + exact hv⟩ + left_inv a := by + apply Subtype.ext + funext v + exact congrArg a.1 ((chartToPlace k K).apply_symm_apply v) + right_inv a := by + apply Subtype.ext + funext w + exact congrArg a.1 ((chartToPlace k K).symm_apply_apply w) + map_add' _ _ := rfl + map_smul' _ _ := rfl + +@[simp] +theorem adeleEquivChart_apply (a : AdeleSpace k K) (w : PlaceA k K) : + (adeleEquivChart k K a).1 w = a.1 (chartToPlace k K w) := + rfl + +@[simp] +theorem adeleEquivChart_symm_apply (a : Chart.AdeleSpace k K) (v : Place k K) : + ((adeleEquivChart k K).symm a).1 v = a.1 ((chartToPlace k K).symm v) := + rfl + +/-- Pointwise multiplication of an intrinsic adele by an element of `K`. -/ +def smulAdele (x : K) (a : AdeleSpace k K) : AdeleSpace k K := + ⟨fun v => x * a.1 v, (eventually_mem_place k K x).and a.property |>.mono + fun _ h => mul_mem h.1 h.2⟩ + +instance : SMul K (AdeleSpace k K) := ⟨smulAdele k K⟩ + +instance : Module K (AdeleSpace k K) := + Module.ofMinimalAxioms + (fun _ _ _ => Subtype.ext <| funext fun _ => mul_add _ _ _) + (fun _ _ _ => Subtype.ext <| funext fun _ => add_mul _ _ _) + (fun _ _ _ => Subtype.ext <| funext fun _ => mul_assoc _ _ _) + (fun _ => Subtype.ext <| funext fun _ => one_mul _) + +/-- The intrinsic-to-chart adele equivalence commutes with multiplication by `K`. -/ +@[simp] +theorem adeleEquivChart_smul (x : K) (a : AdeleSpace k K) : + adeleEquivChart k K (x • a) = x • adeleEquivChart k K a := by + ext w + change x * a.1 (chartToPlace k K w) = x * a.1 (chartToPlace k K w) + rfl + +/-- Multiplication by an element of `K` as a `k`-linear endomorphism of intrinsic adeles. -/ +def mulAdeleLinear (x : K) : AdeleSpace k K →ₗ[k] AdeleSpace k K where + toFun a := x • a + map_add' _ _ := smul_add x _ _ + map_smul' c a := by + ext v + change x * (c • a.1 v) = c • (x * a.1 v) + simp only [Algebra.smul_def] + ring + +/-- An intrinsic adele satisfies the bound prescribed by a divisor. -/ +def memAdeleFilt (D : Divisor k K) (a : AdeleSpace k K) : Prop := + ∀ v, v.valuation (a.1 v) ≤ WithZero.exp (D v) + +/-- The intrinsic adele filtration piece `A(D)`. -/ +def adeleFilt (D : Divisor k K) : Submodule k (AdeleSpace k K) where + carrier := {a | memAdeleFilt k K D a} + zero_mem' := fun _ => by simp + add_mem' {a b} ha hb := fun v => + (v.valuation.map_add (a.1 v) (b.1 v)).trans (max_le (ha v) (hb v)) + smul_mem' c a ha := by + intro v + change v.valuation (c • a.1 v) ≤ _ + rw [Algebra.smul_def, map_mul] + have hc : v.valuation (algebraMap k K c) ≤ 1 := by + rw [← Valuation.mem_valuationSubring_iff, Place.valuationSubring_valuation] + exact v.triv_on_k c + exact (mul_le_mul' hc (ha v)).trans_eq (one_mul _) + +/-- Membership in the intrinsic filtration agrees with chart filtration membership. -/ +theorem mem_adeleFilt_equivChart (D : Divisor k K) (a : AdeleSpace k K) : + adeleEquivChart k K a ∈ + Chart.adeleFilt k K ((divisorEquivChart k K).symm D) ↔ + a ∈ adeleFilt k K D := by + constructor + · intro ha v + let w := (chartToPlace k K).symm v + have hw := ha w + rw [← placeValuation_eq] at hw + simpa [w, divisorEquivChart, Finsupp.domCongr_apply] using hw + · intro ha w + have hv := ha (chartToPlace k K w) + rw [placeValuation_eq] at hv + simpa [divisorEquivChart, Finsupp.domCongr_apply] using hv + +omit [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] in +/-- The intrinsic adele filtration is monotone in the divisor. -/ +theorem adeleFilt_mono {D E : Divisor k K} (h : D ≤ E) : + adeleFilt k K D ≤ adeleFilt k K E := by + intro a ha v + exact (ha v).trans (WithZero.exp_le_exp.mpr (h v)) + +/-- The diagonal embedding of the function field into intrinsic adeles. -/ +def diagonal : K →ₗ[k] AdeleSpace k K where + toFun f := ⟨fun _ => f, eventually_mem_place k K f⟩ + map_add' _ _ := rfl + map_smul' _ _ := rfl + +/-- The image of the intrinsic diagonal embedding. -/ +def diagonalSubmodule : Submodule k (AdeleSpace k K) := + LinearMap.range (diagonal k K) + +@[simp] +theorem adeleEquivChart_diagonal (f : K) : + adeleEquivChart k K (diagonal k K f) = Chart.diagonal k K f := by + ext w + change f = f + rfl + +/-- The chart equivalence maps the intrinsic filtration onto the chart filtration. -/ +theorem map_adeleFilt_equivChart (D : Divisor k K) : + Submodule.map (adeleEquivChart k K).toLinearMap (adeleFilt k K D) = + Chart.adeleFilt k K ((divisorEquivChart k K).symm D) := by + ext a + constructor + · rintro ⟨b, hb, rfl⟩ + exact (mem_adeleFilt_equivChart k K D b).2 hb + · intro ha + refine ⟨(adeleEquivChart k K).symm a, ?_, by simp⟩ + exact (mem_adeleFilt_equivChart k K D _).1 (by simpa using ha) + +/-- The chart equivalence maps the intrinsic diagonal submodule onto the chart diagonal. -/ +theorem map_diagonalSubmodule_equivChart : + Submodule.map (adeleEquivChart k K).toLinearMap (diagonalSubmodule k K) = + Chart.diagonalSubmodule k K := by + ext a + constructor + · rintro ⟨b, ⟨f, rfl⟩, rfl⟩ + exact ⟨f, (adeleEquivChart_diagonal k K f).symm⟩ + · rintro ⟨f, rfl⟩ + exact ⟨diagonal k K f, ⟨f, rfl⟩, adeleEquivChart_diagonal k K f⟩ + +/-- The chart equivalence maps `A(D)` plus the diagonal onto the corresponding chart submodule. -/ +theorem map_adeleFilt_add_diagonal_equivChart (D : Divisor k K) : + Submodule.map (adeleEquivChart k K).toLinearMap + (adeleFilt k K D + diagonalSubmodule k K) = + Chart.adeleFilt k K ((divisorEquivChart k K).symm D) + + Chart.diagonalSubmodule k K := by + rw [Submodule.add_eq_sup, + Submodule.map_sup (adeleFilt k K D) (diagonalSubmodule k K) + (adeleEquivChart k K).toLinearMap, + map_adeleFilt_equivChart, + map_diagonalSubmodule_equivChart, ← Submodule.add_eq_sup] + +/-- Membership in `A(D)` plus the diagonal is preserved by the chart equivalence. -/ +theorem mem_adeleFilt_add_diagonal_equivChart (D : Divisor k K) (a : AdeleSpace k K) : + adeleEquivChart k K a ∈ + Chart.adeleFilt k K ((divisorEquivChart k K).symm D) + + Chart.diagonalSubmodule k K ↔ + a ∈ adeleFilt k K D + diagonalSubmodule k K := by + rw [← map_adeleFilt_add_diagonal_equivChart k K D] + constructor + · rintro ⟨b, hb, hba⟩ + exact (adeleEquivChart k K).injective hba |>.symm ▸ hb + · intro ha + exact ⟨a, ha, rfl⟩ + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean new file mode 100644 index 0000000000..ae20fd7316 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean @@ -0,0 +1,290 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch + +/-! +# Coordinate-free transport along algebra equivalences + +This file proves that intrinsic places, divisors, Riemann--Roch spaces, and genus are invariant +under an equivalence of function fields over the constant field. No rational-function chart or +function-field hypotheses are needed: the intrinsic definitions only use the two field structures +and their algebras over the common constant field. +-/ + +@[expose] public section + +open scoped WithZero + +noncomputable section + +namespace FunctionField + +open MonoidWithZeroHom + +namespace Place + +variable {k K L : Type*} [Field k] [Field K] [Field L] + [Algebra k K] [Algebra k L] + +/-- The normalized valuation associated to an intrinsic place is surjective. -/ +theorem valuation_surjective (v : Place k K) : + Function.Surjective v.valuation := by + intro z + obtain ⟨y, rfl⟩ := v.normalization.surjective z + obtain ⟨x, hx⟩ := + (ValueGroup₀.restrict₀_surjective + v.toValuationSubring.valuation.toMonoidWithZeroHom) y + refine ⟨x, ?_⟩ + change v.normalization + (v.toValuationSubring.valuation.restrict x) = v.normalization y + exact congrArg v.normalization hx + +/-- Transport an intrinsic place through an algebra equivalence. -/ +noncomputable def mapAlgEquiv (e : K ≃ₐ[k] L) (v : Place k K) : Place k L := by + let q : Valuation L (WithZero (Multiplicative ℤ)) := + v.valuation.comap e.symm.toRingHom + have hqnontrivial : q.IsNontrivial := by + obtain ⟨x, hx0, hx1⟩ := + (inferInstance : v.valuation.IsNontrivial).exists_val_nontrivial + refine ⟨e x, ?_, ?_⟩ + · simpa [q] using hx0 + · simpa [q] using hx1 + letI : q.IsNontrivial := hqnontrivial + letI : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q + refine + { toValuationSubring := q.valuationSubring + ne_top := by + intro htop + exact (Valuation.valuationSubring_eq_top_iff q).mp htop hqnontrivial + triv_on_k := fun c => by + rw [Valuation.mem_valuationSubring_iff] + have hc : v.valuation (algebraMap k K c) ≤ 1 := by + rw [← Valuation.mem_valuationSubring_iff, + Place.valuationSubring_valuation] + exact v.triv_on_k c + change v.valuation (e.symm (algebraMap k L c)) ≤ 1 + rw [e.symm.commutes] + exact hc + isDiscrete := by + let h := Valuation.isEquiv_valuation_valuationSubring q + exact ⟨h.orderMonoidIso.symm.trans + (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q)⟩ } + +/-- The valuation subring of a transported place is the corresponding pullback. -/ +@[simp] +theorem mapAlgEquiv_toValuationSubring (e : K ≃ₐ[k] L) (v : Place k K) : + (mapAlgEquiv e v).toValuationSubring = + v.toValuationSubring.comap e.symm.toRingHom := by + ext x + change v.valuation (e.symm x) ≤ 1 ↔ e.symm x ∈ v.toValuationSubring + rw [← Place.valuationSubring_valuation v] + rw [Valuation.mem_valuationSubring_iff] + +/-- Intrinsic places are equivalent under an equivalence of their ambient fields. -/ +noncomputable def algEquiv (e : K ≃ₐ[k] L) : Place k K ≃ Place k L where + toFun := mapAlgEquiv e + invFun := mapAlgEquiv e.symm + left_inv v := by + apply Place.ext + rw [mapAlgEquiv_toValuationSubring, mapAlgEquiv_toValuationSubring] + ext x + simp + right_inv v := by + apply Place.ext + rw [mapAlgEquiv_toValuationSubring, mapAlgEquiv_toValuationSubring] + ext x + simp + +/-- Transporting a place preserves its normalized valuation exactly. -/ +theorem mapAlgEquiv_valuation_eq_comap (e : K ≃ₐ[k] L) (v : Place k K) : + (mapAlgEquiv e v).valuation = + v.valuation.comap e.symm.toRingHom := by + let q : Valuation L (WithZero (Multiplicative ℤ)) := + v.valuation.comap e.symm.toRingHom + have hqsurj : Function.Surjective q := by + intro z + obtain ⟨x, hx⟩ := valuation_surjective v z + refine ⟨e x, ?_⟩ + simpa [q] using hx + have hqnontrivial : q.IsNontrivial := by + obtain ⟨x, hx0, hx1⟩ := + (inferInstance : v.valuation.IsNontrivial).exists_val_nontrivial + refine ⟨e x, ?_, ?_⟩ + · simpa [q] using hx0 + · simpa [q] using hx1 + letI : q.IsNontrivial := hqnontrivial + letI : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q + let V := q.valuationSubring + let h := Valuation.isEquiv_valuation_valuationSubring q + let ε : ValueGroup₀ (.ofClass V.valuation) ≃*o + WithZero (Multiplicative ℤ) := + h.orderMonoidIso.symm.trans + (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q) + have hnorm : (mapAlgEquiv e v).normalization = ε := + orderMonoidIso_withZeroMulInt_unique _ _ + ext x + change (mapAlgEquiv e v).normalization + (V.valuation.restrict x) = q x + rw [hnorm] + change (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q) + (h.orderMonoidIso.symm (V.valuation.restrict x)) = q x + rw [show h.orderMonoidIso.symm (V.valuation.restrict x) = q.restrict x by + change h.orderMonoidIso.symm + (q.valuationSubring.valuation.restrict x) = q.restrict x + exact h.orderMonoidIso.symm_apply_eq.mpr + (h.orderMonoidIso_spec x).symm] + exact + Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt_restrict_apply_of_surjective + hqsurj x + +/-- Evaluation of normalized valuations is preserved by transport. -/ +@[simp] +theorem algEquiv_valuation_apply (e : K ≃ₐ[k] L) (v : Place k K) (x : K) : + ((algEquiv e) v).valuation (e x) = v.valuation x := by + change (mapAlgEquiv e v).valuation (e x) = v.valuation x + rw [mapAlgEquiv_valuation_eq_comap] + simp + +/-- The valuation subrings at corresponding places are equivalent as constant-field algebras. -/ +noncomputable def valuationSubringAlgEquiv (e : K ≃ₐ[k] L) (v : Place k K) : + v.toValuationSubring ≃ₐ[k] ((algEquiv e) v).toValuationSubring := by + let f : v.toValuationSubring →ₐ[k] + ((algEquiv e) v).toValuationSubring := + { toFun := fun x => ⟨e x, by + change e x ∈ (mapAlgEquiv e v).toValuationSubring + rw [mapAlgEquiv_toValuationSubring] + change e.symm (e x) ∈ v.toValuationSubring + rw [e.symm_apply_apply] + exact x.property⟩ + map_one' := by ext; simp + map_mul' := by intro x y; ext; simp + map_zero' := by ext; simp + map_add' := by intro x y; ext; simp + commutes' := fun c => by + apply Subtype.ext + change e (algebraMap k K c) = algebraMap k L c + exact e.commutes c } + apply AlgEquiv.ofBijective f + constructor + · intro x y hxy + apply Subtype.ext + exact e.injective (congrArg Subtype.val hxy) + · intro y + refine ⟨⟨e.symm y, ?_⟩, ?_⟩ + · have hy := y.property + change y.1 ∈ (mapAlgEquiv e v).toValuationSubring at hy + rw [mapAlgEquiv_toValuationSubring] at hy + exact hy + · apply Subtype.ext + simp [f] + +/-- Residue fields at corresponding places are equivalent over the constant field. -/ +noncomputable def residueFieldAlgEquiv (e : K ≃ₐ[k] L) (v : Place k K) : + v.residueField ≃ₐ[k] ((algEquiv e) v).residueField := + IsLocalRing.ResidueField.mapAlgEquiv (valuationSubringAlgEquiv e v) + +/-- Place degree is preserved under an equivalence of ambient fields. -/ +@[simp] +theorem degree_algEquiv (e : K ≃ₐ[k] L) (v : Place k K) : + ((algEquiv e) v).degree = v.degree := + (residueFieldAlgEquiv e v).toLinearEquiv.finrank_eq.symm + +end Place + +variable {k K L : Type*} [Field k] [Field K] [Field L] + [Algebra k K] [Algebra k L] + +/-- Reindex intrinsic divisors through an equivalence of their ambient fields. -/ +noncomputable def divisorAlgEquiv (e : K ≃ₐ[k] L) : + Divisor k K ≃+ Divisor k L := + Finsupp.domCongr (Place.algEquiv e) + +/-- Intrinsic divisor degree is preserved by ambient-field equivalence. -/ +@[simp] +theorem Divisor.deg_algEquiv (e : K ≃ₐ[k] L) (D : Divisor k K) : + Divisor.deg k L (divisorAlgEquiv e D) = Divisor.deg k K D := by + classical + induction D using Finsupp.induction with + | zero => simp [Divisor.deg, divisorAlgEquiv] + | single_add a b f ha hb ih => + rw [map_add, Divisor.deg_add, Divisor.deg_add, ih] + congr 1 + simp [Divisor.deg, divisorAlgEquiv, Finsupp.domCongr_apply, + Finsupp.equivMapDomain_single] + +/-- Riemann--Roch membership is preserved by ambient-field equivalence. -/ +theorem memRRspace_algEquiv_iff (e : K ≃ₐ[k] L) (D : Divisor k K) (x : K) : + memRRspace k L (divisorAlgEquiv e D) (e x) ↔ memRRspace k K D x := by + constructor + · intro hx v + have hv := hx ((Place.algEquiv e) v) + simpa [divisorAlgEquiv, Finsupp.domCongr_apply] using hv + · intro hx w + let v := (Place.algEquiv e).symm w + have hv := hx v + have hw : (Place.algEquiv e) v = w := + (Place.algEquiv e).apply_symm_apply w + rw [← hw] + simpa [divisorAlgEquiv, Finsupp.domCongr_apply] using hv + +/-- The image of an intrinsic Riemann--Roch space is the transported space. -/ +theorem RRspace_map_algEquiv (e : K ≃ₐ[k] L) (D : Divisor k K) : + Submodule.map e.toLinearEquiv.toLinearMap (RRspace k K D) = + RRspace k L (divisorAlgEquiv e D) := by + ext y + constructor + · rintro ⟨x, hx, rfl⟩ + change memRRspace k K D x at hx + change memRRspace k L (divisorAlgEquiv e D) (e x) + exact (memRRspace_algEquiv_iff e D x).2 hx + · intro hy + change memRRspace k L (divisorAlgEquiv e D) y at hy + refine ⟨e.symm y, ?_, e.apply_symm_apply y⟩ + change memRRspace k K D (e.symm y) + apply (memRRspace_algEquiv_iff e D (e.symm y)).1 + simpa using hy + +/-- Corresponding intrinsic Riemann--Roch spaces are linearly equivalent. -/ +noncomputable def RRspaceAlgEquiv (e : K ≃ₐ[k] L) (D : Divisor k K) : + RRspace k K D ≃ₗ[k] RRspace k L (divisorAlgEquiv e D) := + e.toLinearEquiv.ofSubmodules _ _ (RRspace_map_algEquiv e D) + +/-- Riemann--Roch dimension is invariant under ambient-field equivalence. -/ +@[simp] +theorem ell_algEquiv (e : K ≃ₐ[k] L) (D : Divisor k K) : + ell k L (divisorAlgEquiv e D) = ell k K D := by + exact (RRspaceAlgEquiv e D).finrank_eq.symm + +/-- Divisor defect is invariant under ambient-field equivalence. -/ +@[simp] +theorem defect_algEquiv (e : K ≃ₐ[k] L) (D : Divisor k K) : + defect k L (divisorAlgEquiv e D) = defect k K D := by + rw [defect, defect, Divisor.deg_algEquiv, ell_algEquiv] + +/-- Intrinsic function-field genus is invariant under an equivalence over the constant field. -/ +theorem genus_eq_of_algEquiv (e : K ≃ₐ[k] L) : + genus k K = genus k L := by + let E := divisorAlgEquiv e + have hsets : + {d : ℤ | ∃ D : Divisor k K, defect k K D = d} = + {d : ℤ | ∃ D : Divisor k L, defect k L D = d} := by + ext d + constructor + · rintro ⟨D, hD⟩ + refine ⟨E D, ?_⟩ + rw [defect_algEquiv] + exact hD + · rintro ⟨D, hD⟩ + refine ⟨E.symm D, ?_⟩ + rw [← defect_algEquiv e (E.symm D), E.apply_symm_apply] + exact hD + unfold genus + rw [hsets] + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean new file mode 100644 index 0000000000..d7eee6e9fe --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean @@ -0,0 +1,221 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.LocalResidue +public import LeanPool.MarkoffModP.RiemannRoch.PlaceEquiv + +/-! +# Coordinate-free divisors and degree + +This file transports the two-chart divisor group to intrinsic places and identifies the transported +degree with the residue-field weighted sum. + +## Main definitions + +* `FunctionField.Divisor`: divisors indexed by intrinsic places. +* `FunctionField.divisorEquivChart`: equivalence with the two-chart divisor group. +* `FunctionField.Divisor.deg`: intrinsic divisor degree. +* `FunctionField.principalDivisor`: coordinate-free principal divisors. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField + +open Chart + +variable (k K : Type*) [Field k] [Field K] + [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- Classical decidable equality for the coordinate rational function field. -/ +local instance instDecidableEqRatFuncCoordinateFreeDivisor : DecidableEq k⟮X⟯ := + Classical.decEq _ + +namespace Place + +/-- Constant-field algebra structure on a finite-place valuation subring. -/ +noncomputable local instance finiteVspAlgebra + (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + Algebra k (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) := + ((algebraMap (ringOfIntegers k K) + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w)).comp + (algebraMap k (ringOfIntegers k K))).toAlgebra + +/-- Scalar-tower compatibility for a finite-place valuation subring. -/ +local instance finiteVspTower + (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + IsScalarTower k (ringOfIntegers k K) + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) := + IsScalarTower.of_algebraMap_eq fun _ => rfl + +/-- The finite-chart valuation subring is the valuation subring of the intrinsic place. -/ +noncomputable def finiteValuationSubringAlgEquiv + (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w ≃ₐ[k] + (Place.ofChart k K (Sum.inl w)).toValuationSubring := by + let e : (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w).toSubring ≃+* + (Place.ofChart k K (Sum.inl w)).toValuationSubring.toSubring := + RingEquiv.subringCongr <| congrArg ValuationSubring.toSubring <| + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring + (K := K) (v := w)).trans (Place.ofChart_toValuationSubring k K (Sum.inl w)).symm + exact + { __ := e + commutes' := fun c => by + apply Subtype.ext + change algebraMap (ringOfIntegers k K) K + (algebraMap k (ringOfIntegers k K) c) = algebraMap k K c + exact (IsScalarTower.algebraMap_apply k (ringOfIntegers k K) K c).symm } + +/-- The finite-chart residue field is the intrinsic residue field. -/ +noncomputable def finiteResidueAlgEquiv + (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + (ringOfIntegers k K ⧸ w.asIdeal) ≃ₐ[k] + (Place.ofChart k K (Sum.inl w)).residueField := by + let e₀ : (ringOfIntegers k K ⧸ w.asIdeal) ≃ₐ[k] w.asIdeal.ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom k (ringOfIntegers k K ⧸ w.asIdeal) w.asIdeal.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField w.asIdeal) + let e₁ : w.asIdeal.ResidueField ≃ₐ[k] + IsLocalRing.ResidueField + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) := + IsLocalRing.ResidueField.mapAlgEquiv + ((IsDedekindDomain.HeightOneSpectrum.localizationAlgEquiv (K := K) w).restrictScalars k) + let e₂ : IsLocalRing.ResidueField + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) ≃ₐ[k] + (Place.ofChart k K (Sum.inl w)).residueField := + IsLocalRing.ResidueField.mapAlgEquiv (finiteValuationSubringAlgEquiv k K w) + exact e₀.trans (e₁.trans e₂) + +theorem finite_degree_eq (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + (Place.ofChart k K (Sum.inl w)).degree = placeDegree k K (Sum.inl w) := by + exact (finiteResidueAlgEquiv k K w).toLinearEquiv.finrank_eq.symm + +/-- Constant-field algebra structure on an infinite-place valuation subring. -/ +noncomputable local instance infiniteVspAlgebra + (w : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + Algebra k (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) := + ((algebraMap (infiniteIntegers k K) + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w)).comp + (algebraMap k (infiniteIntegers k K))).toAlgebra + +/-- Scalar-tower compatibility for an infinite-place valuation subring. -/ +local instance infiniteVspTower + (w : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + IsScalarTower k (infiniteIntegers k K) + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) := + IsScalarTower.of_algebraMap_eq fun _ => rfl + +/-- The infinite-chart valuation subring is the valuation subring of the intrinsic place. -/ +noncomputable def infiniteValuationSubringAlgEquiv + (w : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w ≃ₐ[k] + (Place.ofChart k K (Sum.inr w)).toValuationSubring := by + let e : (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w).toSubring ≃+* + (Place.ofChart k K (Sum.inr w)).toValuationSubring.toSubring := + RingEquiv.subringCongr <| congrArg ValuationSubring.toSubring <| + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring + (K := K) (v := w)).trans (Place.ofChart_toValuationSubring k K (Sum.inr w)).symm + exact + { __ := e + commutes' := fun c => by + apply Subtype.ext + change algebraMap (infiniteIntegers k K) K + (algebraMap k (infiniteIntegers k K) c) = algebraMap k K c + exact (IsScalarTower.algebraMap_apply k (infiniteIntegers k K) K c).symm } + +/-- The infinite-chart residue field is the intrinsic residue field. -/ +noncomputable def infiniteResidueAlgEquiv + (w : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + (infiniteIntegers k K ⧸ w.asIdeal) ≃ₐ[k] + (Place.ofChart k K (Sum.inr w)).residueField := by + let e₀ : (infiniteIntegers k K ⧸ w.asIdeal) ≃ₐ[k] w.asIdeal.ResidueField := + AlgEquiv.ofBijective + (IsScalarTower.toAlgHom k (infiniteIntegers k K ⧸ w.asIdeal) w.asIdeal.ResidueField) + (Ideal.bijective_algebraMap_quotient_residueField w.asIdeal) + let e₁ : w.asIdeal.ResidueField ≃ₐ[k] + IsLocalRing.ResidueField + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) := + IsLocalRing.ResidueField.mapAlgEquiv + ((IsDedekindDomain.HeightOneSpectrum.localizationAlgEquiv (K := K) w).restrictScalars k) + let e₂ : IsLocalRing.ResidueField + (IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K w) ≃ₐ[k] + (Place.ofChart k K (Sum.inr w)).residueField := + IsLocalRing.ResidueField.mapAlgEquiv (infiniteValuationSubringAlgEquiv k K w) + exact e₀.trans (e₁.trans e₂) + +theorem infinite_degree_eq (w : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + (Place.ofChart k K (Sum.inr w)).degree = placeDegree k K (Sum.inr w) := by + exact (infiniteResidueAlgEquiv k K w).toLinearEquiv.finrank_eq.symm + +end Place + +/-- The chart degree agrees with the intrinsic residue-field degree. -/ +theorem placeDegree_eq (w : PlaceA k K) : + placeDegree k K w = (chartToPlace k K w).degree := by + rcases w with w | w + · exact (Place.finite_degree_eq k K w).symm + · exact (Place.infinite_degree_eq k K w).symm + +/-- Divisors indexed by coordinate-free places. -/ +abbrev Divisor := Place k K →₀ ℤ + +/-- Reindex a chart divisor by the chart/intrinsic place equivalence. -/ +noncomputable def divisorEquivChart : DivisorA k K ≃+ Divisor k K := + Finsupp.domCongr (chartToPlace k K) + +/-- The coordinate-free principal-divisor homomorphism. -/ +noncomputable def principalDivisor : Additive Kˣ →+ Divisor k K := + (divisorEquivChart k K).toAddMonoidHom.comp (principalDivisorA k K) + +namespace Divisor + +/-- The intrinsic weighted degree of a divisor. -/ +noncomputable def deg (D : Divisor k K) : ℤ := + D.sum fun v n => n * (v.degree : ℤ) + +omit [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] in +/-- The degree is the intrinsic residue-degree weighted sum. -/ +theorem deg_formula (D : Divisor k K) : + deg k K D = D.sum fun v n => n * (v.degree : ℤ) := rfl + +omit [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_add (D E : Divisor k K) : deg k K (D + E) = deg k K D + deg k K E := by + classical + simp [deg, Finsupp.sum_add_index, add_mul] + +theorem deg_equivChart (D : DivisorA k K) : + deg k K (divisorEquivChart k K D) = Chart.deg k K D := by + classical + induction D using Finsupp.induction with + | zero => simp [deg, Chart.deg, divisorEquivChart] + | single_add a b f ha hb ih => + rw [map_add, deg_add, Chart.deg_add, ih] + congr 1 + simp [deg, Chart.deg, divisorEquivChart, Finsupp.domCongr_apply, + Finsupp.equivMapDomain_single, placeDegree_eq] + +/-- Principal divisors have degree zero. -/ +theorem deg_principal_eq_zero (x : Kˣ) : + deg k K (principalDivisor k K (Additive.ofMul x)) = 0 := by + rw [principalDivisor] + exact (deg_equivChart k K (principalDivisorA k K (Additive.ofMul x))).trans + (deg_principalDivisorA_eq_zero k K x) + +end Divisor + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean new file mode 100644 index 0000000000..38bd58a029 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean @@ -0,0 +1,350 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.WeilDifferential +public import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Corollaries + +/-! +# Coordinate-free Riemann–Roch + +This file exposes the Riemann–Roch stack over divisors indexed by intrinsic valuation-subring +places. The kernel-checked chart proofs are transported across `chartToPlace`. + +## Main definitions and results + +* `FunctionField.RRspace`, `FunctionField.ell`, and `FunctionField.genus`. +* `FunctionField.AdeleSpace` and `FunctionField.adeleFilt`. +* `FunctionField.IsCanonical` and `FunctionField.duality`. +* `FunctionField.riemann_roch` and coordinate-free corollaries C1–C6. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField + +open Chart + +variable (k K : Type*) [Field k] [Field K] [Algebra k K] + +/-- A function belongs to the intrinsic Riemann–Roch space of `D` when its normalized valuation +at every place is bounded by the coefficient of `D` there. -/ +def memRRspace (D : Divisor k K) (f : K) : Prop := + ∀ v, v.valuation f ≤ WithZero.exp (D v) + +namespace memRRspace + +variable {k K} {D : Divisor k K} + +theorem zero_mem (D : Divisor k K) : memRRspace k K D 0 := fun v => by simp + +theorem add_mem {f g : K} (hf : memRRspace k K D f) (hg : memRRspace k K D g) : + memRRspace k K D (f + g) := fun v => + (v.valuation.map_add f g).trans (max_le (hf v) (hg v)) + +theorem smul_mem (c : k) {f : K} (hf : memRRspace k K D f) : + memRRspace k K D (c • f) := fun v => by + by_cases hc : c = 0 + · simp [hc] + rw [Algebra.smul_def, map_mul, Valuation.IsTrivialOn.eq_one c hc, one_mul] + exact hf v + +end memRRspace + +/-- The Riemann–Roch space of an intrinsic divisor. -/ +def RRspace (D : Divisor k K) : Submodule k K := + { carrier := {f | memRRspace k K D f} + zero_mem' := memRRspace.zero_mem D + add_mem' := memRRspace.add_mem + smul_mem' := memRRspace.smul_mem } + +/-- The Riemann–Roch dimension of an intrinsic divisor. -/ +noncomputable def ell (D : Divisor k K) : ℕ := + Module.finrank k (RRspace k K D) + +/-- The defect of an intrinsic divisor. -/ +noncomputable def defect (D : Divisor k K) : ℤ := + D.deg + 1 - ell k K D + +/-- The intrinsic genus is the supremum of the defects of all intrinsic divisors. The +Riemann–Roch argument below proves that this supremum is attained and agrees with every chart +calculation. -/ +noncomputable def genus : ℕ := + (sSup {d : ℤ | ∃ D : Divisor k K, defect k K D = d}).toNat + +variable [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] + +omit [IsFullConstantField k K] in +/-- The intrinsic membership condition agrees with the coordinate construction. -/ +theorem memRRspace_equivChart (D : Divisor k K) (f : K) : + memRRspace k K D f ↔ + Chart.memRRspace k K ((divisorEquivChart k K).symm D) f := by + constructor + · intro hf w + have hv := hf (chartToPlace k K w) + rw [placeValuation_eq] at hv + simpa [divisorEquivChart, Finsupp.domCongr_apply] using hv + · intro hf v + let w := (chartToPlace k K).symm v + have hw := hf w + rw [← placeValuation_eq] at hw + simpa [w, divisorEquivChart, Finsupp.domCongr_apply] using hw + +omit [IsFullConstantField k K] in +/-- The intrinsic Riemann–Roch space is the chart space after reindexing divisors. -/ +theorem RRspace_eq_chart (D : Divisor k K) : + RRspace k K D = Chart.RRspace k K ((divisorEquivChart k K).symm D) := by + ext f + exact memRRspace_equivChart k K D f + +omit [IsFullConstantField k K] in +/-- Riemann–Roch dimension is preserved by the chart equivalence. -/ +theorem ell_eq_chart (D : Divisor k K) : + ell k K D = Chart.ell k K ((divisorEquivChart k K).symm D) := by + rw [ell, Chart.ell, RRspace_eq_chart k K D] + +/-- The index of specialty of an intrinsic divisor. -/ +noncomputable def indexOfSpecialty (D : Divisor k K) : ℕ := + (ell k K D - (D.deg + 1 - (genus k K : ℤ))).toNat + +/-- The dimension of the intrinsic adele quotient by `A(D)` plus the diagonal. -/ +noncomputable def finrankAdeleQuotient (D : Divisor k K) : ℕ := + Module.finrank k <| + AdeleSpace k K ⧸ (adeleFilt k K D + diagonalSubmodule k K) + +omit [IsFullConstantField k K] in +/-- Pulling an intrinsic divisor back to the chart preserves degree. -/ +@[simp] +theorem Divisor.chart_deg (D : Divisor k K) : + Chart.deg k K ((divisorEquivChart k K).symm D) = D.deg := by + have h := Divisor.deg_equivChart k K ((divisorEquivChart k K).symm D) + simpa using h.symm + +omit [IsFullConstantField k K] in +/-- Intrinsic defect is preserved by the chart equivalence. -/ +theorem defect_eq_chart (D : Divisor k K) : + defect k K D = Chart.defect k K ((divisorEquivChart k K).symm D) := by + rw [defect, Chart.defect, ell_eq_chart, Divisor.chart_deg] + +/-- The intrinsic supremum definition of genus agrees with the chart construction. -/ +theorem genus_eq_genusChart : genus k K = Chart.genus k K := by + let S : Set ℤ := {d | ∃ D : Divisor k K, defect k K D = d} + have hS : S.Nonempty := ⟨defect k K 0, ⟨0, rfl⟩⟩ + have hub : ∀ d ∈ S, d ≤ (Chart.genus k K : ℤ) := by + rintro d ⟨D, rfl⟩ + rw [defect_eq_chart] + exact Chart.defect_le k K _ + obtain ⟨E, hE⟩ := Chart.exists_defect_eq (k := k) (K := K) + have happ : ∀ z < (Chart.genus k K : ℤ), ∃ d ∈ S, z < d := by + intro z hz + refine ⟨defect k K (divisorEquivChart k K E), ⟨_, rfl⟩, ?_⟩ + rw [defect_eq_chart] + simpa [hE] using hz + have hsup : sSup S = (Chart.genus k K : ℤ) := + csSup_eq_of_forall_le_of_forall_lt_exists_gt hS hub happ + rw [genus] + change (sSup S).toNat = _ + rw [hsup] + simp + +/-- The numerical characterization of a canonical coordinate divisor. -/ +theorem chart_isCanonical_iff_degree_ell (E : DivisorA k K) : + Chart.IsCanonical k K E ↔ + Chart.deg k K E = 2 * (Chart.genus k K : ℤ) - 2 ∧ + Chart.ell k K E = Chart.genus k K := by + constructor + · intro hE + exact ⟨Chart.deg_canonical k K hE, Chart.ell_canonical k K hE⟩ + · rintro ⟨hdegE, hellE⟩ + obtain ⟨C, hC⟩ := Chart.exists_isCanonical k K + have hRR := Chart.riemann_roch k K hC E + have hpos : 0 < Chart.ell k K (C - E) := by + rw [hellE, hdegE] at hRR + omega + obtain ⟨x, hxeff⟩ := + Chart.exists_effective_add_principal_of_ell_pos k K (C - E) hpos + let P := principalDivisorA k K (Additive.ofMul x) + have hdegzero : Chart.deg k K ((C - E) + P) = 0 := by + rw [Chart.deg_add, Chart.deg_sub, + deg_principalDivisorA_eq_zero, Chart.deg_canonical k K hC, hdegE] + omega + have hzero : (C - E) + P = 0 := + eq_zero_of_effective_deg_zero k K hxeff hdegzero + have hCE : C + P = E := by + calc + C + P = E + ((C - E) + P) := by abel + _ = E := by rw [hzero, add_zero] + rcases hC with ⟨ω, hω, hdiv⟩ + have hxω : Chart.WeilDifferential.IsNonzero ((x : K) • ω) := by + intro hx + have hx0 : (x : K) • ω = 0 := by + apply Chart.WeilDifferential.ext + exact hx + have hω0 := (Chart.WeilDifferential.smulWeil_eq_zero_iff + (k := k) (K := K) (x : K) (Units.ne_zero x) ω).mp hx0 + apply hω + rw [hω0] + rfl + refine ⟨(x : K) • ω, hxω, ?_⟩ + rw [Chart.WeilDifferential.divOmega_smul (k := k) (K := K) x ω hω hxω, hdiv] + exact hCE + +/-- A divisor is canonical exactly when it has degree `2g - 2` and Riemann–Roch dimension `g`. -/ +theorem isCanonical_iff_deg_ell (W : Divisor k K) : + IsCanonical k K W ↔ + W.deg = 2 * (genus k K : ℤ) - 2 ∧ ell k K W = genus k K := by + rw [isCanonical_iff_chart, chart_isCanonical_iff_degree_ell] + simp only [Divisor.chart_deg, ell_eq_chart, genus_eq_genusChart] + +/-- The intrinsic specialty index agrees with the coordinate construction. -/ +theorem indexOfSpecialty_eq_chart (D : Divisor k K) : + indexOfSpecialty k K D = + Chart.indexOfSpecialty k K ((divisorEquivChart k K).symm D) := by + rw [indexOfSpecialty, Chart.indexOfSpecialty, ell_eq_chart, Divisor.chart_deg, + genus_eq_genusChart] + +/-- The intrinsic adele quotient is linearly equivalent to its chart presentation. -/ +noncomputable def adeleQuotientEquivChart (D : Divisor k K) : + (AdeleSpace k K ⧸ (adeleFilt k K D + diagonalSubmodule k K)) ≃ₗ[k] + (Chart.AdeleSpace k K ⧸ + (Chart.adeleFilt k K ((divisorEquivChart k K).symm D) + + Chart.diagonalSubmodule k K)) := + Submodule.Quotient.equiv _ _ (adeleEquivChart k K) + (map_adeleFilt_add_diagonal_equivChart k K D) + +omit [IsFullConstantField k K] in +/-- The intrinsic and chart adele quotients have the same dimension. -/ +theorem finrankAdeleQuotient_eq_chart (D : Divisor k K) : + finrankAdeleQuotient k K D = + Chart.finrankAdeleQuotient k K ((divisorEquivChart k K).symm D) := + (adeleQuotientEquivChart k K D).finrank_eq + +/-- The intrinsic adele quotient dimension is the index of specialty. -/ +theorem finrank_adele_quotient (D : Divisor k K) : + finrankAdeleQuotient k K D = indexOfSpecialty k K D := by + rw [finrankAdeleQuotient_eq_chart, Chart.finrank_adele_quotient, + indexOfSpecialty_eq_chart] + +/-- The rank change in the intrinsic filtration-and-diagonal sandwich. -/ +noncomputable def sandwichRank (D E : Divisor k K) (h : D ≤ E) : ℤ := by + have hchart : (divisorEquivChart k K).symm D ≤ + (divisorEquivChart k K).symm E := by + intro w + have hw := h (chartToPlace k K w) + simpa [divisorEquivChart, Finsupp.domCongr_apply] using hw + exact Chart.sandwichRank k K ((divisorEquivChart k K).symm D) + ((divisorEquivChart k K).symm E) hchart + +omit [IsFullConstantField k K] in +/-- The intrinsic sandwich rank is the change in `deg D - ell(D)`. -/ +theorem sandwich {D E : Divisor k K} (h : D ≤ E) : + sandwichRank k K D E h = E.deg - ell k K E - (D.deg - ell k K D) := by + simp only [sandwichRank] + rw [Chart.sandwich] + simp only [Divisor.chart_deg, ell_eq_chart] + +/-- The dimension of intrinsic `Omega(D)` is the index of specialty of `D`. -/ +theorem WeilDifferential.finrank_differentialSpace (D : Divisor k K) : + Module.finrank k (WeilDifferential.differentialSpace (k := k) (K := K) D) = + indexOfSpecialty k K D := by + rw [WeilDifferential.finrank_differentialSpace_eq_chart, + Chart.WeilDifferential.finrank_differentialSpace, indexOfSpecialty_eq_chart] + +/-- Every function field admits an intrinsic canonical divisor. -/ +theorem exists_isCanonical : ∃ W : Divisor k K, IsCanonical k K W := by + obtain ⟨W, hW⟩ := Chart.exists_isCanonical k K + refine ⟨divisorEquivChart k K W, ?_⟩ + apply (isCanonical_iff_chart k K _).mpr + simpa using hW + +/-- Coordinate-free duality. -/ +theorem duality {W : Divisor k K} (hW : IsCanonical k K W) (D : Divisor k K) : + ell k K (W - D) = indexOfSpecialty k K D := by + have hW' := (isCanonical_iff_chart k K W).mp hW + rw [ell_eq_chart, indexOfSpecialty_eq_chart] + simpa using Chart.duality k K hW' ((divisorEquivChart k K).symm D) + +/-- Riemann's inequality for intrinsic divisors. -/ +theorem riemann_ineq (D : Divisor k K) : + (ell k K D : ℤ) ≥ D.deg + 1 - (genus k K : ℤ) := by + rw [ell_eq_chart] + simpa [genus_eq_genusChart] using + Chart.riemann_ineq k K ((divisorEquivChart k K).symm D) + +/-- The coordinate-free Riemann–Roch theorem. -/ +theorem riemann_roch {W : Divisor k K} (hW : IsCanonical k K W) (D : Divisor k K) : + (ell k K D : ℤ) = D.deg + 1 - (genus k K : ℤ) + ell k K (W - D) := by + have hW' := (isCanonical_iff_chart k K W).mp hW + rw [ell_eq_chart, ell_eq_chart] + simpa [genus_eq_genusChart] using + Chart.riemann_roch k K hW' ((divisorEquivChart k K).symm D) + +section Canonical + +variable {W : Divisor k K} (hW : IsCanonical k K W) + +include hW + +/-- **C1**: a canonical divisor has Riemann–Roch dimension equal to the genus. -/ +theorem ell_canonical : ell k K W = genus k K := by + exact (isCanonical_iff_deg_ell k K W).mp hW |>.2 + +/-- **C2**: a canonical divisor has degree `2g - 2`. -/ +theorem deg_canonical : W.deg = 2 * (genus k K : ℤ) - 2 := by + exact (isCanonical_iff_deg_ell k K W).mp hW |>.1 + +/-- **C3**: divisors of degree at least `2g - 1` are nonspecial. -/ +theorem ell_eq_of_deg_ge (D : Divisor k K) + (hdeg : D.deg ≥ 2 * (genus k K : ℤ) - 1) : + (ell k K D : ℤ) = D.deg + 1 - (genus k K : ℤ) := by + have hW' := (isCanonical_iff_chart k K W).mp hW + have hdeg' : Chart.deg k K ((divisorEquivChart k K).symm D) ≥ + 2 * (Chart.genus k K : ℤ) - 1 := by simpa [genus_eq_genusChart] using hdeg + rw [ell_eq_chart] + simpa [genus_eq_genusChart] using + Chart.ell_eq_of_deg_ge k K hW' ((divisorEquivChart k K).symm D) hdeg' + +/-- **C4**: the specialty index is `ℓ(W-D)`. -/ +theorem indexOfSpecialty_eq_ell (D : Divisor k K) : + (indexOfSpecialty k K D : ℤ) = ell k K (W - D) := by + have hW' := (isCanonical_iff_chart k K W).mp hW + rw [indexOfSpecialty_eq_chart, ell_eq_chart] + simpa using Chart.indexOfSpecialty_eq_ell k K hW' + ((divisorEquivChart k K).symm D) + +end Canonical + +/-- **C5**: Clifford's inequality for intrinsic divisors. -/ +theorem clifford {W : Divisor k K} (hW : IsCanonical k K W) (D : Divisor k K) + (hdeg₀ : 0 ≤ D.deg) (hdeg₁ : D.deg ≤ 2 * (genus k K : ℤ) - 2) + (hℓD : 0 < ell k K D) (hℓW : 0 < ell k K (W - D)) : + 2 * ((ell k K D : ℤ) - 1) ≤ D.deg := by + have hW' := (isCanonical_iff_chart k K W).mp hW + have hdeg₀' : 0 ≤ Chart.deg k K ((divisorEquivChart k K).symm D) := by + simpa using hdeg₀ + have hdeg₁' : Chart.deg k K ((divisorEquivChart k K).symm D) ≤ + 2 * (Chart.genus k K : ℤ) - 2 := by simpa [genus_eq_genusChart] using hdeg₁ + rw [ell_eq_chart k K D] at hℓD ⊢ + rw [ell_eq_chart k K (W - D)] at hℓW + simpa [genus_eq_genusChart] using + Chart.clifford k K hW' ((divisorEquivChart k K).symm D) hdeg₀' hdeg₁' hℓD hℓW + +/-- **C6**: there exists an intrinsic nonspecial divisor. -/ +theorem exists_nonspecial_divisor : + ∃ D : Divisor k K, indexOfSpecialty k K D = 0 := by + obtain ⟨D, hD⟩ := Chart.exists_nonspecial_divisor k K + refine ⟨divisorEquivChart k K D, ?_⟩ + rw [indexOfSpecialty_eq_chart] + simpa using hD + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean new file mode 100644 index 0000000000..2cb9ce769e --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean @@ -0,0 +1,285 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AdeleSpace +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic + +/-! +# Weil differentials over intrinsic places + +Weil differentials are defined here as linear functionals on the intrinsic adele space that +vanish on `A(D)` plus the diagonal for some intrinsic divisor. The equivalence +`weilDifferentialEquivChart` transports the existing chart proofs without exposing chart-indexed +carriers in the public statements. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField + +open Chart + +variable (k K : Type*) [Field k] [Field K] +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] + +/-- A Weil differential is a functional on intrinsic adeles that vanishes on `A(D)` plus the +diagonal for some intrinsic divisor `D`. -/ +structure WeilDifferential where + /-- The underlying linear functional on intrinsic adeles. -/ + toFun : AdeleSpace k K →ₗ[k] k + /-- A filtration piece plus the diagonal on which the functional vanishes. -/ + vanishes_on : ∃ D : Divisor k K, + ∀ a ∈ adeleFilt k K D + diagonalSubmodule k K, toFun a = 0 + +namespace WeilDifferential + +variable {k K} + +/-- A Weil differential is nonzero when its underlying functional is nonzero. -/ +def IsNonzero (omega : WeilDifferential k K) : Prop := omega.toFun ≠ 0 + +/-- The space of functionals vanishing on `A(D)` plus the diagonal. -/ +def differentialSpace (D : Divisor k K) : + Submodule k (AdeleSpace k K →ₗ[k] k) where + carrier := {phi | ∀ a ∈ adeleFilt k K D + diagonalSubmodule k K, phi a = 0} + zero_mem' := by simp + add_mem' {phi psi} hphi hpsi := by + intro a ha + simp [hphi a ha, hpsi a ha] + smul_mem' c phi hphi := by + intro a ha + simp [hphi a ha] + +/-- The dual-space equivalence induced by reindexing intrinsic adeles to chart adeles. -/ +noncomputable def adeleDualEquivChart : + (AdeleSpace k K →ₗ[k] k) ≃ₗ[k] (Chart.AdeleSpace k K →ₗ[k] k) := + (adeleEquivChart k K).symm.dualMap + +omit [IsFullConstantField k K] in +@[simp] +theorem adeleDualEquivChart_apply (phi : AdeleSpace k K →ₗ[k] k) + (a : Chart.AdeleSpace k K) : + adeleDualEquivChart (k := k) (K := K) phi a = + phi ((adeleEquivChart k K).symm a) := + rfl + +omit [IsFullConstantField k K] in +@[simp] +theorem adeleDualEquivChart_symm_apply (phi : Chart.AdeleSpace k K →ₗ[k] k) + (a : AdeleSpace k K) : + (adeleDualEquivChart (k := k) (K := K)).symm phi a = + phi (adeleEquivChart k K a) := + rfl + +/-- Reindex an intrinsic Weil differential as a chart Weil differential. -/ +noncomputable def toChart (omega : WeilDifferential k K) : + Chart.WeilDifferential k K where + toFun := adeleDualEquivChart (k := k) (K := K) omega.toFun + vanishes_on := by + obtain ⟨D, hD⟩ := omega.vanishes_on + refine ⟨(divisorEquivChart k K).symm D, fun a ha => ?_⟩ + apply hD ((adeleEquivChart k K).symm a) + exact (mem_adeleFilt_add_diagonal_equivChart k K D _).mp (by simpa using ha) + +/-- Reindex a chart Weil differential as an intrinsic Weil differential. -/ +noncomputable def ofChart (omega : Chart.WeilDifferential k K) : + WeilDifferential k K where + toFun := (adeleDualEquivChart (k := k) (K := K)).symm omega.toFun + vanishes_on := by + obtain ⟨D, hD⟩ := omega.vanishes_on + refine ⟨divisorEquivChart k K D, fun a ha => ?_⟩ + apply hD (adeleEquivChart k K a) + have hmap := (mem_adeleFilt_add_diagonal_equivChart k K + (divisorEquivChart k K D) a).mpr ha + simpa using hmap + +omit [IsFullConstantField k K] in +@[ext] +theorem ext {omega eta : WeilDifferential k K} (h : omega.toFun = eta.toFun) : + omega = eta := by + cases omega + cases eta + cases h + rfl + +instance : Zero (WeilDifferential k K) := ⟨⟨0, ⟨0, by simp⟩⟩⟩ + +instance : Add (WeilDifferential k K) where + add omega eta := ⟨omega.toFun + eta.toFun, by + obtain ⟨Domega, homega⟩ := omega.vanishes_on + obtain ⟨Deta, heta⟩ := eta.vanishes_on + refine ⟨Domega ⊓ Deta, fun a ha => ?_⟩ + have hleft : adeleFilt k K (Domega ⊓ Deta) + diagonalSubmodule k K ≤ + adeleFilt k K Domega + diagonalSubmodule k K := by + simpa only [Submodule.add_eq_sup] using + sup_le_sup (adeleFilt_mono k K inf_le_left) le_rfl + have hright : adeleFilt k K (Domega ⊓ Deta) + diagonalSubmodule k K ≤ + adeleFilt k K Deta + diagonalSubmodule k K := by + simpa only [Submodule.add_eq_sup] using + sup_le_sup (adeleFilt_mono k K inf_le_right) le_rfl + simp [homega a (hleft ha), heta a (hright ha)]⟩ + +instance : Neg (WeilDifferential k K) where + neg omega := ⟨-omega.toFun, by + obtain ⟨D, hD⟩ := omega.vanishes_on + exact ⟨D, fun a ha => by simp [hD a ha]⟩⟩ + +instance : AddCommGroup (WeilDifferential k K) where + add_assoc _ _ _ := ext (add_assoc _ _ _) + zero_add _ := ext (zero_add _) + add_zero _ := ext (add_zero _) + add_comm _ _ := ext (add_comm _ _) + nsmul := nsmulRec + nsmul_zero _ := ext rfl + nsmul_succ _ _ := ext rfl + neg := Neg.neg + neg_add_cancel omega := ext (neg_add_cancel omega.toFun) + sub := fun omega eta => omega + -eta + sub_eq_add_neg _ _ := rfl + zsmul := zsmulRec + +/-- Intrinsic and chart Weil differentials are equivalent as additive groups. -/ +noncomputable def weilDifferentialAddEquivChart : + WeilDifferential k K ≃+ Chart.WeilDifferential k K where + toFun := toChart + invFun := ofChart + left_inv omega := by + apply ext + exact (adeleDualEquivChart (k := k) (K := K)).symm_apply_apply omega.toFun + right_inv omega := by + apply Chart.WeilDifferential.ext + exact (adeleDualEquivChart (k := k) (K := K)).apply_symm_apply omega.toFun + map_add' omega eta := by + apply Chart.WeilDifferential.ext + exact (adeleDualEquivChart (k := k) (K := K)).map_add omega.toFun eta.toFun + +noncomputable instance : SMul K (WeilDifferential k K) := + ⟨fun x omega => + (weilDifferentialAddEquivChart (k := k) (K := K)).symm + (x • weilDifferentialAddEquivChart (k := k) (K := K) omega)⟩ + +omit [IsFullConstantField k K] in +@[simp] +theorem weilDifferentialAddEquivChart_smul (x : K) (omega : WeilDifferential k K) : + weilDifferentialAddEquivChart (k := k) (K := K) (x • omega) = + x • weilDifferentialAddEquivChart (k := k) (K := K) omega := + (weilDifferentialAddEquivChart (k := k) (K := K)).apply_symm_apply _ + +noncomputable instance : Module K (WeilDifferential k K) := + Function.Injective.module K + (weilDifferentialAddEquivChart (k := k) (K := K)).toAddMonoidHom + (weilDifferentialAddEquivChart (k := k) (K := K)).injective + (weilDifferentialAddEquivChart_smul (k := k) (K := K)) + +/-- Intrinsic and chart Weil differentials are linearly equivalent over the function field. -/ +noncomputable def weilDifferentialEquivChart : + WeilDifferential k K ≃ₗ[K] Chart.WeilDifferential k K where + __ := weilDifferentialAddEquivChart (k := k) (K := K) + map_smul' := weilDifferentialAddEquivChart_smul (k := k) (K := K) + +/-- The intrinsic space `Omega(D)` is linearly equivalent to its chart presentation. -/ +noncomputable def differentialSpaceEquivChart (D : Divisor k K) : + differentialSpace (k := k) (K := K) D ≃ₗ[k] + Chart.WeilDifferential.differentialSpace + ((divisorEquivChart k K).symm D) where + toFun phi := ⟨adeleDualEquivChart (k := k) (K := K) phi.1, by + intro a ha + apply phi.2 ((adeleEquivChart k K).symm a) + exact (mem_adeleFilt_add_diagonal_equivChart k K D _).mp (by simpa using ha)⟩ + invFun phi := ⟨(adeleDualEquivChart (k := k) (K := K)).symm phi.1, by + intro a ha + apply phi.2 (adeleEquivChart k K a) + exact (mem_adeleFilt_add_diagonal_equivChart k K D a).mpr ha⟩ + left_inv phi := Subtype.ext + ((adeleDualEquivChart (k := k) (K := K)).symm_apply_apply phi.1) + right_inv phi := Subtype.ext + ((adeleDualEquivChart (k := k) (K := K)).apply_symm_apply phi.1) + map_add' _ _ := rfl + map_smul' _ _ := rfl + +omit [IsFullConstantField k K] in +/-- The intrinsic and chart differential spaces have the same dimension. -/ +theorem finrank_differentialSpace_eq_chart (D : Divisor k K) : + Module.finrank k (differentialSpace (k := k) (K := K) D) = + Module.finrank k (Chart.WeilDifferential.differentialSpace + ((divisorEquivChart k K).symm D)) := + (differentialSpaceEquivChart (k := k) (K := K) D).finrank_eq + +/-- The intrinsic space of Weil differentials is one-dimensional over `K`. -/ +theorem finrank_weilDifferential_eq_one : + Module.finrank K (WeilDifferential k K) = 1 := by + rw [(weilDifferentialEquivChart (k := k) (K := K)).finrank_eq] + exact Chart.WeilDifferential.finrank_weilDifferential_eq_one (k := k) (K := K) + +omit [IsFullConstantField k K] in +/-- Non-vanishing is preserved by the intrinsic-to-chart equivalence. -/ +theorem isNonzero_toChart (omega : WeilDifferential k K) : + IsNonzero omega ↔ Chart.WeilDifferential.IsNonzero (toChart omega) := by + change omega.toFun ≠ 0 ↔ + adeleDualEquivChart (k := k) (K := K) omega.toFun ≠ 0 + exact (adeleDualEquivChart (k := k) (K := K)).map_ne_zero_iff.symm + +/-- The divisor of a nonzero intrinsic Weil differential. -/ +noncomputable def divOmega (omega : WeilDifferential k K) (homega : IsNonzero omega) : + Divisor k K := + divisorEquivChart k K <| + Chart.WeilDifferential.divOmega (toChart omega) ((isNonzero_toChart omega).mp homega) + +/-- Multiplying a differential adds the corresponding intrinsic principal divisor. -/ +theorem divOmega_smul (x : Kˣ) (omega : WeilDifferential k K) (homega : IsNonzero omega) + (hxomega : IsNonzero ((x : K) • omega)) : + divOmega ((x : K) • omega) hxomega = + divOmega omega homega + principalDivisor k K (Additive.ofMul x) := by + apply (divisorEquivChart k K).symm.injective + simp only [divOmega, principalDivisor, map_add, AddEquiv.symm_apply_apply] + have hsmul : toChart ((x : K) • omega) = (x : K) • toChart omega := + weilDifferentialAddEquivChart_smul (k := k) (K := K) x omega + have hxchart : Chart.WeilDifferential.IsNonzero ((x : K) • toChart omega) := by + simpa only [hsmul] using + ((isNonzero_toChart ((x : K) • omega)).mp hxomega) + have hchart := Chart.WeilDifferential.divOmega_smul (k := k) (K := K) x + (toChart omega) ((isNonzero_toChart omega).mp homega) hxchart + simpa [hsmul, principalDivisor] using hchart + +end WeilDifferential + +/-- A divisor is canonical when it is the divisor of a nonzero intrinsic Weil differential. -/ +def IsCanonical (W : Divisor k K) : Prop := + ∃ (omega : WeilDifferential k K) (homega : WeilDifferential.IsNonzero omega), + WeilDifferential.divOmega omega homega = W + +/-- Intrinsic and chart definitions of canonical divisors agree. -/ +theorem isCanonical_iff_chart (W : Divisor k K) : + IsCanonical k K W ↔ + Chart.IsCanonical k K ((divisorEquivChart k K).symm W) := by + constructor + · rintro ⟨omega, homega, rfl⟩ + refine ⟨WeilDifferential.toChart omega, + (WeilDifferential.isNonzero_toChart omega).mp homega, ?_⟩ + simp [WeilDifferential.divOmega] + · rintro ⟨omega, homega, hdiv⟩ + let eta := WeilDifferential.ofChart omega + have hetaChart : WeilDifferential.toChart eta = omega := + (WeilDifferential.weilDifferentialAddEquivChart + (k := k) (K := K)).apply_symm_apply omega + have heta : WeilDifferential.IsNonzero eta := by + apply (WeilDifferential.isNonzero_toChart eta).mpr + rw [hetaChart] + exact homega + refine ⟨eta, heta, ?_⟩ + apply (divisorEquivChart k K).symm.injective + simp only [WeilDifferential.divOmega, AddEquiv.symm_apply_apply] + simpa only [hetaChart] using hdiv + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean new file mode 100644 index 0000000000..c1c669cd36 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean @@ -0,0 +1,236 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import Mathlib.Data.Finsupp.Multiset +public import Mathlib.RingTheory.DedekindDomain.Factorization + +/-! +# Divisors of a Dedekind domain + +This file identifies the group of nonzero fractional ideals of a Dedekind domain with the free +abelian group on its height-one prime ideals. The coefficient of a prime `v` is the existing +function `FractionalIdeal.count K v`. + +## Main definitions + +* `IsDedekindDomain.Divisor`: the free abelian group on height-one prime ideals. +* `FractionalIdeal.divisor`: the divisor associated to a nonzero fractional ideal. +* `FractionalIdeal.divisorEquiv`: the additive equivalence between nonzero fractional ideals and + divisors. +* `FractionalIdeal.principalDivisor`: the divisor of a nonzero element of the fraction field. +-/ + +@[expose] public section + +open IsDedekindDomain +open scoped nonZeroDivisors + +namespace IsDedekindDomain + +/-- The group of divisors supported on height-one prime ideals of a ring. -/ +abbrev Divisor (R : Type*) [CommRing R] := HeightOneSpectrum R →₀ ℤ + +end IsDedekindDomain + +namespace FractionalIdeal + +variable {R K : Type*} [CommRing R] [IsDedekindDomain R] [Field K] + [Algebra R K] [IsFractionRing R K] + +/-- The divisor of a nonzero fractional ideal. -/ +noncomputable def divisor (I : (FractionalIdeal R⁰ K)ˣ) : Divisor R := + Finsupp.mk (finite_factors (I : FractionalIdeal R⁰ K)).toFinset + (fun v ↦ count K v I) fun _ ↦ (finite_factors (I : FractionalIdeal R⁰ K)).mem_toFinset + +@[simp] +theorem divisor_apply (I : (FractionalIdeal R⁰ K)ˣ) (v : HeightOneSpectrum R) : + divisor I v = count K v I := by + classical + simp [divisor] + +/-- Reconstruct a nonzero fractional ideal from a divisor. -/ +noncomputable def ofDivisor (K : Type*) [Field K] [Algebra R K] [IsFractionRing R K] + (D : Divisor R) : (FractionalIdeal R⁰ K)ˣ := + Units.mk0 (D.prod fun v n ↦ (v.asIdeal : FractionalIdeal R⁰ K) ^ n) <| by + classical + rw [Finsupp.prod] + exact Finset.prod_ne_zero_iff.mpr fun v _ ↦ + zpow_ne_zero _ (coeIdeal_ne_zero.mpr v.ne_bot) + +@[simp] +theorem count_ofDivisor (D : Divisor R) (v : HeightOneSpectrum R) : + count K v (ofDivisor K D : FractionalIdeal R⁰ K) = D v := by + classical + simpa [ofDivisor] using count_finsuppProd K v D + +private theorem eq_of_count_eq {I J : FractionalIdeal R⁰ K} (hI : I ≠ 0) (hJ : J ≠ 0) + (h : ∀ v, count K v I = count K v J) : I = J := by + rw [← finprod_heightOneSpectrum_factorization' K hI, + ← finprod_heightOneSpectrum_factorization' K hJ] + exact finprod_congr fun v ↦ congr_arg ((v.asIdeal : FractionalIdeal R⁰ K) ^ ·) (h v) + +/-- Nonzero fractional ideals of a Dedekind domain are additively equivalent to its divisors. + +Multiplication of fractional ideals corresponds to addition of divisors. +-/ +noncomputable def divisorEquiv : Additive (FractionalIdeal R⁰ K)ˣ ≃+ Divisor R where + toFun I := divisor I.toMul + invFun D := Additive.ofMul (ofDivisor K D) + left_inv I := by + apply Additive.toMul.injective + apply Units.ext + change (ofDivisor K (divisor I.toMul) : FractionalIdeal R⁰ K) = I.toMul + apply eq_of_count_eq (ofDivisor K (divisor I.toMul)).ne_zero I.toMul.ne_zero + intro v + rw [count_ofDivisor, divisor_apply] + right_inv D := by + ext v + change count K v (ofDivisor K D : FractionalIdeal R⁰ K) = D v + rw [count_ofDivisor] + map_add' I J := by + change divisor (I.toMul * J.toMul) = divisor I.toMul + divisor J.toMul + ext v + simp only [divisor_apply, Units.val_mul] + exact count_mul K v I.toMul.ne_zero J.toMul.ne_zero + +/-- The nonzero principal fractional ideal generated by an element of the fraction field. -/ +noncomputable def principalFractionalIdeal : Kˣ →* (FractionalIdeal R⁰ K)ˣ where + toFun x := Units.mk0 (spanSingleton R⁰ (x : K)) (spanSingleton_ne_zero_iff.mpr x.ne_zero) + map_one' := Units.ext spanSingleton_one + map_mul' x y := Units.ext (spanSingleton_mul_spanSingleton (R := R) (x : K) y).symm + +@[simp] +theorem principalFractionalIdeal_apply_coe (x : Kˣ) : + (principalFractionalIdeal (R := R) (K := K) x : FractionalIdeal R⁰ K) = + spanSingleton R⁰ (x : K) := rfl + +/-- The principal divisor of a nonzero element of the fraction field. -/ +noncomputable def principalDivisor : Additive Kˣ →+ Divisor R := + divisorEquiv.toAddMonoidHom.comp principalFractionalIdeal.toAdditive + +@[simp] +theorem principalDivisor_apply (x : Additive Kˣ) (v : HeightOneSpectrum R) : + principalDivisor (R := R) (K := K) x v = + count K v (spanSingleton R⁰ (x.toMul : K)) := by + change divisor (principalFractionalIdeal x.toMul) v = _ + rw [divisor_apply, principalFractionalIdeal_apply_coe] + +/-- A weighted degree on divisors of a Dedekind domain. -/ +noncomputable def weightedDegree (w : Ideal R → ℕ) : Divisor R →+ ℤ where + toFun D := D.sum fun v n => n * (w v.asIdeal : ℤ) + map_zero' := by simp + map_add' D E := by + classical + simp [Finsupp.sum_add_index, add_mul] + +omit [IsDedekindDomain R] in +@[simp] +theorem weightedDegree_apply (w : Ideal R → ℕ) (D : Divisor R) : + weightedDegree (R := R) w D = + D.sum fun v n => n * (w v.asIdeal : ℤ) := rfl + +/-- The weighted degree of the divisor of a nonzero integral ideal is the weighted sum of its +normalized prime factors. The weight is stated on ideals, so that it can later be chosen as a +residue-field degree or an inertia-weighted residue-field degree. -/ +theorem divisor_ideal_sum_eq_normalizedFactors_sum (J : Ideal R) (hJ : J ≠ ⊥) + (w : Ideal R → ℕ) : + let JU : (FractionalIdeal R⁰ K)ˣ := + Units.mk0 (J : FractionalIdeal R⁰ K) (coeIdeal_ne_zero.mpr hJ) + (divisor JU).sum (fun v n => n * (w v.asIdeal : ℤ)) = + (((UniqueFactorizationMonoid.normalizedFactors J).map w).sum : ℤ) := by + classical + dsimp only + rw [Finsupp.sum] + let s := UniqueFactorizationMonoid.normalizedFactors J + have hcoeff (v : HeightOneSpectrum R) : + divisor (Units.mk0 (J : FractionalIdeal R⁰ K) (coeIdeal_ne_zero.mpr hJ)) v = + (s.count v.asIdeal : ℤ) := by + rw [divisor_apply, Units.val_mk0, count_coe K v hJ, + Ideal.count_associates_factors_eq hJ v.isPrime v.ne_bot] + have hsum : + ∑ v ∈ (divisor + (Units.mk0 (J : FractionalIdeal R⁰ K) (coeIdeal_ne_zero.mpr hJ))).support, + divisor (Units.mk0 (J : FractionalIdeal R⁰ K) (coeIdeal_ne_zero.mpr hJ)) v * + (w v.asIdeal : ℤ) = + ∑ P ∈ s.toFinset, (s.count P : ℤ) * (w P : ℤ) := by + apply Finset.sum_bij (fun v _ => v.asIdeal) + · intro v hv + rw [Multiset.mem_toFinset, ← Multiset.count_ne_zero] + intro hz + have : divisor + (Units.mk0 (J : FractionalIdeal R⁰ K) (coeIdeal_ne_zero.mpr hJ)) v = 0 := by + rw [hcoeff, hz, Nat.cast_zero] + exact (Finsupp.mem_support_iff.mp hv) this + · intro v₁ _ v₂ _ hv + exact HeightOneSpectrum.ext hv + · intro P hP + rw [Multiset.mem_toFinset] at hP + have hprime : Prime P := + UniqueFactorizationMonoid.prime_of_normalized_factor P hP + let v : HeightOneSpectrum R := + ⟨P, Ideal.isPrime_of_prime hprime, hprime.ne_zero⟩ + refine ⟨v, ?_, rfl⟩ + rw [Finsupp.mem_support_iff, hcoeff] + exact_mod_cast (Multiset.count_pos.mpr hP).ne' + · intro v _ + rw [hcoeff] + rw [hsum, Finset.sum_multiset_map_count] + simp only [s, nsmul_eq_mul, Nat.cast_sum, Nat.cast_mul] + push_cast + rfl + +/-- Weighted degree of the divisor of a nonzero integral ideal. -/ +theorem weightedDegree_divisor_ideal (J : Ideal R) (hJ : J ≠ ⊥) + (w : Ideal R → ℕ) : + weightedDegree (R := R) w + (divisor (Units.mk0 (J : FractionalIdeal R⁰ K) (coeIdeal_ne_zero.mpr hJ))) = + (((UniqueFactorizationMonoid.normalizedFactors J).map w).sum : ℤ) := + divisor_ideal_sum_eq_normalizedFactors_sum J hJ w + +/-- If a nonzero fraction is represented by `n / d`, its weighted principal-divisor degree is +the weighted factor degree of `n` minus that of `d`. -/ +theorem weightedDegree_principal_mk' (w : Ideal R → ℕ) (x : Kˣ) (n : R) + (d : nonZeroDivisors R) (hnd : IsLocalization.mk' K n d = (x : K)) : + weightedDegree (R := R) w (principalDivisor (Additive.ofMul x)) = + (((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {n})).map w).sum : ℤ) - + (((UniqueFactorizationMonoid.normalizedFactors + (Ideal.span {(d : R)})).map w).sum : ℤ) := by + classical + have hn : n ≠ 0 := by + intro hn + exact x.ne_zero (by simpa [hn] using hnd.symm) + have hd : (d : R) ≠ 0 := by + simpa only [mem_nonZeroDivisors_iff_ne_zero] using d.property + have hspan : spanSingleton R⁰ (x : K) = + spanSingleton R⁰ ((algebraMap R K) (d : R))⁻¹ * + (Ideal.span {n} : FractionalIdeal R⁰ K) := by + rw [← hnd, IsFractionRing.mk'_eq_div, coeIdeal_span_singleton, + spanSingleton_mul_spanSingleton] + congr 1 + simp only [div_eq_mul_inv] + ac_rfl + have hdiv : principalDivisor (R := R) (K := K) (Additive.ofMul x) = + divisor (Units.mk0 (Ideal.span {n} : FractionalIdeal R⁰ K) + (coeIdeal_ne_zero.mpr (Ideal.span_singleton_eq_bot.not.mpr hn))) - + divisor (Units.mk0 (Ideal.span {(d : R)} : FractionalIdeal R⁰ K) + (coeIdeal_ne_zero.mpr (Ideal.span_singleton_eq_bot.not.mpr hd))) := by + ext v + rw [principalDivisor_apply, Finsupp.sub_apply, divisor_apply, divisor_apply] + change count K v (spanSingleton R⁰ (x : K)) = + count K v (Ideal.span {n} : FractionalIdeal R⁰ K) - + count K v (Ideal.span {(d : R)} : FractionalIdeal R⁰ K) + rw [count_well_defined K v (spanSingleton_ne_zero_iff.mpr x.ne_zero) hspan, + count_coe K v (Ideal.span_singleton_eq_bot.not.mpr hn), + count_coe K v (Ideal.span_singleton_eq_bot.not.mpr hd)] + rw [hdiv, map_sub, + weightedDegree_divisor_ideal (K := K) (Ideal.span {n}) + (Ideal.span_singleton_eq_bot.not.mpr hn) w, + weightedDegree_divisor_ideal (K := K) (Ideal.span {(d : R)}) + (Ideal.span_singleton_eq_bot.not.mpr hd) w] + +end FractionalIdeal diff --git a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean new file mode 100644 index 0000000000..8c69c4fffa --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean @@ -0,0 +1,646 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Place +public import Mathlib.Data.Finsupp.Order +public import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing + +/-! +# Divisor degree and order on a function field + +This file completes the coordinate divisor API needed for Riemann–Roch spaces and adeles: +place degrees, global degree, and the partial order on `DivisorA`. + +## Main definitions + +* `FunctionField.placeDegree`: residue field dimension of a coordinate place. +* `FunctionField.deg`: global degree of a divisor. + +The partial order on `DivisorA` is the pointwise order on `Finsupp` from Mathlib +(`Finsupp.le_def`); no new order instance is introduced here. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncDivisorFile : DecidableEq k⟮X⟯ := Classical.decEq _ + +/-- The degree of a coordinate place: the residue field dimension over `k`. -/ +noncomputable def placeDegree (v : PlaceA k K) : ℕ := + match v with + | Sum.inl w => + letI : Field (ringOfIntegers k K ⧸ w.asIdeal) := Ideal.Quotient.field w.asIdeal + Module.finrank k (ringOfIntegers k K ⧸ w.asIdeal) + | Sum.inr w => + letI : Field (infiniteIntegers k K ⧸ w.asIdeal) := Ideal.Quotient.field w.asIdeal + Module.finrank k (infiniteIntegers k K ⧸ w.asIdeal) + +/-- Every coordinate place has strictly positive degree. -/ +theorem placeDegree_pos (v : PlaceA k K) : 0 < placeDegree k K v := by + rcases v with v | v + · change 0 < Module.finrank k (ringOfIntegers k K ⧸ v.asIdeal) + exact Module.finrank_pos + · change 0 < Module.finrank k (infiniteIntegers k K ⧸ v.asIdeal) + exact Module.finrank_pos + +omit [IsScalarTower k[X] k⟮X⟯ K] in +/-- At an infinite coordinate place, the place degree is its inertia degree over the unique +place at infinity of `k(X)`. -/ +theorem placeDegree_infinite_eq_inertiaDeg + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + placeDegree k K (Sum.inr v) = + v.asIdeal.inertiaDeg (inftyValuationSubring k) := by + let A := inftyValuationSubring k + let S := infiniteIntegers k K + let p : Ideal A := v.asIdeal.under A + letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + letI : p.IsMaximal := Ideal.IsMaximal.under A v.asIdeal + letI : v.asIdeal.LiesOver p := ⟨rfl⟩ + letI : Field (A ⧸ p) := Ideal.Quotient.field p + letI : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + letI : Algebra (A ⧸ p) (S ⧸ v.asIdeal) := + Ideal.Quotient.algebraQuotientOfLEComap (Ideal.over_def v.asIdeal p).ge + have hp : p = IsLocalRing.maximalIdeal A := IsLocalRing.eq_maximalIdeal inferInstance + letI : FiniteDimensional k (A ⧸ p) := by + rw [hp] + exact inftyValuationSubring.finiteDimensionalResidueField k + letI : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := by + have hfin := Ideal.inertiaDeg_pos v.asIdeal A + rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] at hfin + exact FiniteDimensional.of_finrank_pos hfin + letI : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := + IsScalarTower.of_algebraMap_eq fun _ => rfl + change Module.finrank k (S ⧸ v.asIdeal) = v.asIdeal.inertiaDeg A + rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] + have htower := Module.finrank_mul_finrank k (A ⧸ p) (S ⧸ v.asIdeal) + have hbase : Module.finrank k (A ⧸ p) = 1 := by + rw [hp] + exact inftyValuationSubring.finrank_residueField k + rw [hbase, one_mul] at htower + exact htower.symm + +/-- At a finite coordinate place, the place degree is the degree of the prime below times its +inertia degree. -/ +theorem placeDegree_finite_eq_base_mul_inertiaDeg + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + placeDegree k K (Sum.inl v) = + Module.finrank k (k[X] ⧸ v.asIdeal.under k[X]) * + v.asIdeal.inertiaDeg k[X] := by + let S := ringOfIntegers k K + let p : Ideal k[X] := v.asIdeal.under k[X] + letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + letI : p.IsMaximal := Ideal.IsMaximal.under k[X] v.asIdeal + letI : v.asIdeal.LiesOver p := ⟨rfl⟩ + letI : Field (k[X] ⧸ p) := Ideal.Quotient.field p + letI : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + letI : Algebra (k[X] ⧸ p) (S ⧸ v.asIdeal) := + Ideal.Quotient.algebraQuotientOfLEComap (Ideal.over_def v.asIdeal p).ge + letI : FiniteDimensional k (k[X] ⧸ p) := + finite_of_finite_type_of_isJacobsonRing k _ + letI : FiniteDimensional (k[X] ⧸ p) (S ⧸ v.asIdeal) := by + have hfin := Ideal.inertiaDeg_pos v.asIdeal k[X] + rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] at hfin + exact FiniteDimensional.of_finrank_pos hfin + letI : IsScalarTower k (k[X] ⧸ p) (S ⧸ v.asIdeal) := + IsScalarTower.of_algebraMap_eq fun _ => rfl + change Module.finrank k (S ⧸ v.asIdeal) = + Module.finrank k (k[X] ⧸ p) * v.asIdeal.inertiaDeg k[X] + rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] + exact (Module.finrank_mul_finrank k (k[X] ⧸ p) (S ⧸ v.asIdeal)).symm + +/-- The relative ideal norm of a finite coordinate prime has exponent equal to its inertia +degree; unlike Mathlib's perfect-field version, this uses only the standing separability +hypothesis. -/ +theorem relNorm_asIdeal_finite + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + Ideal.relNorm k[X] v.asIdeal = + (v.asIdeal.under k[X]) ^ v.asIdeal.inertiaDeg k[X] := by + let S := ringOfIntegers k K + letI : Algebra k[X] (FractionRing S) := inferInstance + letI : FaithfulSMul k[X] (FractionRing S) := inferInstance + letI : Algebra (FractionRing k[X]) (FractionRing S) := + FractionRing.liftAlgebra k[X] (FractionRing S) + letI : IsScalarTower k[X] (FractionRing k[X]) (FractionRing S) := + FractionRing.isScalarTower_liftAlgebra k[X] (FractionRing S) + letI : Algebra.IsSeparable (FractionRing k[X]) (FractionRing S) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv k[X] k⟮X⟯).symm.toRingEquiv + (FractionRing.algEquiv S K).symm.toRingEquiv ?_ + ext x + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv k[X] k⟮X⟯).symm + (FractionRing.algEquiv S K).symm x + letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + letI : (v.asIdeal.under k[X]).IsMaximal := Ideal.IsMaximal.under k[X] v.asIdeal + exact Ideal.relNorm_eq_pow_of_isMaximal_of_isSeparable + v.asIdeal (v.asIdeal.under k[X]) + +omit [Algebra k[X] K] [IsScalarTower k[X] k⟮X⟯ K] in +/-- The corresponding relative-norm formula on the infinity chart. -/ +theorem relNorm_asIdeal_infinite + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + Ideal.relNorm (inftyValuationSubring k) v.asIdeal = + (v.asIdeal.under (inftyValuationSubring k)) ^ + v.asIdeal.inertiaDeg (inftyValuationSubring k) := by + let A := inftyValuationSubring k + let S := infiniteIntegers k K + letI : Algebra A (FractionRing S) := inferInstance + letI : FaithfulSMul A (FractionRing S) := inferInstance + letI : Algebra (FractionRing A) (FractionRing S) := + FractionRing.liftAlgebra A (FractionRing S) + letI : IsScalarTower A (FractionRing A) (FractionRing S) := + FractionRing.isScalarTower_liftAlgebra A (FractionRing S) + letI : Algebra.IsSeparable (FractionRing A) (FractionRing S) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv A k⟮X⟯).symm.toRingEquiv + (FractionRing.algEquiv S K).symm.toRingEquiv ?_ + ext x + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv A k⟮X⟯).symm + (FractionRing.algEquiv S K).symm x + letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + letI : (v.asIdeal.under A).IsMaximal := Ideal.IsMaximal.under A v.asIdeal + exact Ideal.relNorm_eq_pow_of_isMaximal_of_isSeparable + v.asIdeal (v.asIdeal.under A) + +/-- Weighted factor degree on the finite chart is preserved by relative ideal norm. -/ +theorem finite_factorDegree_eq_relNorm (I : Ideal (ringOfIntegers k K)) (hI : I ≠ ⊥) : + ((UniqueFactorizationMonoid.normalizedFactors I).map fun P => + Module.finrank k (k[X] ⧸ P.under k[X]) * P.inertiaDeg k[X]).sum = + ((UniqueFactorizationMonoid.normalizedFactors (Ideal.relNorm k[X] I)).map fun p => + Module.finrank k (k[X] ⧸ p)).sum := by + let S := ringOfIntegers k K + letI : Algebra k[X] (FractionRing S) := inferInstance + letI : FaithfulSMul k[X] (FractionRing S) := inferInstance + letI : Algebra (FractionRing k[X]) (FractionRing S) := + FractionRing.liftAlgebra k[X] (FractionRing S) + letI : IsScalarTower k[X] (FractionRing k[X]) (FractionRing S) := + FractionRing.isScalarTower_liftAlgebra k[X] (FractionRing S) + letI : Algebra.IsSeparable (FractionRing k[X]) (FractionRing S) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv k[X] k⟮X⟯).symm.toRingEquiv + (FractionRing.algEquiv S K).symm.toRingEquiv ?_ + ext x + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv k[X] k⟮X⟯).symm + (FractionRing.algEquiv S K).symm x + symm + simpa only [Nat.mul_comm] using + Ideal.sum_normalizedFactors_relNorm_of_isSeparable I hI + (fun p : Ideal k[X] => Module.finrank k (k[X] ⧸ p)) + +omit [Algebra k[X] K] [IsScalarTower k[X] k⟮X⟯ K] in +/-- The analogous relative-norm identity on the infinity chart. -/ +theorem infinite_factorDegree_eq_relNorm + (I : Ideal (infiniteIntegers k K)) (hI : I ≠ ⊥) : + ((UniqueFactorizationMonoid.normalizedFactors I).map fun P => + P.inertiaDeg (inftyValuationSubring k)).sum = + ((UniqueFactorizationMonoid.normalizedFactors + (Ideal.relNorm (inftyValuationSubring k) I)).map fun _ => 1).sum := by + let A := inftyValuationSubring k + let S := infiniteIntegers k K + letI : Algebra A (FractionRing S) := inferInstance + letI : FaithfulSMul A (FractionRing S) := inferInstance + letI : Algebra (FractionRing A) (FractionRing S) := + FractionRing.liftAlgebra A (FractionRing S) + letI : IsScalarTower A (FractionRing A) (FractionRing S) := + FractionRing.isScalarTower_liftAlgebra A (FractionRing S) + letI : Algebra.IsSeparable (FractionRing A) (FractionRing S) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv A k⟮X⟯).symm.toRingEquiv + (FractionRing.algEquiv S K).symm.toRingEquiv ?_ + ext x + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv A k⟮X⟯).symm + (FractionRing.algEquiv S K).symm x + symm + simpa using Ideal.sum_normalizedFactors_relNorm_of_isSeparable I hI + (fun _ : Ideal A => 1) + +/-- Over the finite chart of `k(X)`, the weighted prime-factor degree of a principal polynomial +ideal is the polynomial degree. -/ +theorem polynomial_factorDegree_span (p : k[X]) (hp : p ≠ 0) : + ((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {p})).map + (fun P : Ideal k[X] => Module.finrank k (k[X] ⧸ P))).sum = p.natDegree := by + classical + rw [← UniqueFactorizationMonoid.factors_eq_normalizedFactors, + Ideal.factors_span_eq, Multiset.map_map] + simp_rw [Function.comp_apply, finrank_quotient_span_eq_natDegree] + have hassoc := UniqueFactorizationMonoid.factors_prod hp + have hprod : (UniqueFactorizationMonoid.factors p).prod ≠ 0 := + hassoc.ne_zero_iff.mpr hp + have hzero : (0 : k[X]) ∉ UniqueFactorizationMonoid.factors p := by + intro h + exact hprod (Multiset.prod_eq_zero_iff.mpr h) + rw [← Polynomial.natDegree_multiset_prod _ hzero] + exact Polynomial.natDegree_eq_of_degree_eq + (Polynomial.degree_eq_degree_of_associated hassoc) + +/-- Over the infinity chart of `k(X)`, the number of prime factors of a nonzero principal ideal +is the negative rational-function degree of its generator. -/ +theorem infinity_factorDegree_span (a : inftyValuationSubring k) (ha : a ≠ 0) : + ((((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {a})).map + (fun _ : Ideal (inftyValuationSubring k) => (1 : ℕ))).sum : ℕ) : ℤ) = + -RatFunc.intDegree (a : k⟮X⟯) := by + classical + let v := RatFunc.inftyValuation k + let A := inftyValuationSubring k + have hmem : (1 / RatFunc.X : k⟮X⟯) ∈ v.valuationSubring := by + change v (1 / RatFunc.X) ≤ 1 + rw [RatFunc.inftyValuation.X_inv] + simpa only [← WithZero.exp_zero, WithZero.exp_le_exp] using (show (-1 : ℤ) ≤ 0 by omega) + let π : v.valuationSubring := ⟨1 / RatFunc.X, hmem⟩ + have hgen : (↑(Valuation.IsRankOneDiscrete.generator v) : WithZero (Multiplicative ℤ)) = + WithZero.exp (-1 : ℤ) := by + have h := Valuation.IsRankOneDiscrete.generator_eq_exp_neg_one_of_mem_range + (v := v) (show WithZero.exp (-1 : ℤ) ∈ Set.range v from + ⟨1 / RatFunc.X, RatFunc.inftyValuation.X_inv k⟩) + exact congrArg Units.val h + have hπval : v (π : k⟮X⟯) = WithZero.exp (-1 : ℤ) := by + exact RatFunc.inftyValuation.X_inv k + have hπ : v.IsUniformizer (π : k⟮X⟯) := by + rw [Valuation.IsUniformizer.iff, hgen] + exact hπval + let πu : v.Uniformizer := ⟨π, hπ⟩ + obtain ⟨n, u, hau⟩ := Valuation.exists_pow_Uniformizer ha πu + have hassocA : Associated a (π ^ n) := by + have hauA : a = π ^ n * (u : v.valuationSubring) := by + apply Subtype.ext + exact hau + rw [hauA] + exact associated_mul_unit_left _ _ u.isUnit + have hmaxpow : IsLocalRing.maximalIdeal A ^ n = Ideal.span {π ^ n} := by + exact Valuation.pow_Uniformizer_is_pow_generator πu n + have hideal : Ideal.span {a} = IsLocalRing.maximalIdeal A ^ n := by + rw [hmaxpow] + exact Ideal.span_singleton_eq_span_singleton.mpr hassocA + have hmaxIrred : Irreducible (IsLocalRing.maximalIdeal A) := by + exact (Ideal.prime_of_isPrime + (IsDiscreteValuationRing.maximalIdeal A).ne_bot + (IsLocalRing.maximalIdeal.isMaximal A).isPrime).irreducible + have hfactor : + UniqueFactorizationMonoid.normalizedFactors (Ideal.span {a}) = + Multiset.replicate n (IsLocalRing.maximalIdeal A) := by + rw [hideal, UniqueFactorizationMonoid.normalizedFactors_pow, + UniqueFactorizationMonoid.normalizedFactors_irreducible hmaxIrred, + normalize_eq, Multiset.nsmul_singleton] + have hleft : + ((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {a})).map + (fun _ : Ideal A => 1)).sum = n := by + rw [hfactor] + simp + have huval : v ((u : v.valuationSubring) : k⟮X⟯) = 1 := by + exact (Valuation.Integers.isUnit_iff_valuation_eq_one + (Valuation.valuationSubring.integers v)).mp u.isUnit + have haval : v (a : k⟮X⟯) = WithZero.exp (RatFunc.intDegree (a : k⟮X⟯)) := by + rw [RatFunc.inftyValuation_apply, RatFunc.inftyValuation_of_nonzero] + simpa using ha + have hvrepr := congrArg v hau + have hexp : WithZero.exp (RatFunc.intDegree (a : k⟮X⟯)) = + WithZero.exp (-(n : ℤ)) := by + rw [← haval, hvrepr, map_mul] + change v ((π : k⟮X⟯) ^ n) * v ((u : v.valuationSubring) : k⟮X⟯) = _ + rw [map_pow, hπval, huval, mul_one] + calc + WithZero.exp (-1 : ℤ) ^ n = WithZero.exp (n • (-1 : ℤ)) := + (WithZero.exp_nsmul n (-1 : ℤ)).symm + _ = WithZero.exp (-(n : ℤ)) := by congr 1; simp + have hint : RatFunc.intDegree (a : k⟮X⟯) = -(n : ℤ) := + WithZero.exp_injective hexp + have hleftZ : + ((((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {a})).map + (fun _ : Ideal A => (1 : ℕ))).sum : ℕ) : ℤ) = (n : ℤ) := by + exact congrArg (fun m : ℕ => (m : ℤ)) hleft + rw [hleftZ, hint] + omega + +/-- Compatibility of integral norm on the finite chart with the field norm after passing to +fraction fields. -/ +theorem finite_intNorm_div_eq_norm (x : Kˣ) (n : ringOfIntegers k K) + (d : nonZeroDivisors (ringOfIntegers k K)) + (hnd : IsLocalization.mk' K n d = (x : K)) : + algebraMap k[X] k⟮X⟯ (Algebra.intNorm k[X] (ringOfIntegers k K) n) / + algebraMap k[X] k⟮X⟯ + (Algebra.intNorm k[X] (ringOfIntegers k K) (d : ringOfIntegers k K)) = + Algebra.norm k⟮X⟯ (x : K) := by + have hn : algebraMap k[X] k⟮X⟯ (Algebra.intNorm k[X] (ringOfIntegers k K) n) = + Algebra.intNorm k⟮X⟯ K (algebraMap (ringOfIntegers k K) K n) := + Algebra.intNorm_eq_of_isLocalization k[X]⁰ (Bₘ := K) n + have hd : algebraMap k[X] k⟮X⟯ + (Algebra.intNorm k[X] (ringOfIntegers k K) (d : ringOfIntegers k K)) = + Algebra.intNorm k⟮X⟯ K + (algebraMap (ringOfIntegers k K) K (d : ringOfIntegers k K)) := + Algebra.intNorm_eq_of_isLocalization k[X]⁰ (Bₘ := K) (d : ringOfIntegers k K) + rw [Algebra.intNorm_eq_norm k[X] (ringOfIntegers k K), + Algebra.intNorm_eq_norm k⟮X⟯ K] at hn hd + let N : K →*₀ k⟮X⟯ := + { Algebra.norm k⟮X⟯ with + map_zero' := (Algebra.norm_eq_zero_iff (R := k⟮X⟯) (S := K)).mpr rfl } + have hx := congrArg N hnd + rw [IsFractionRing.mk'_eq_div, map_div₀] at hx + change Algebra.norm k⟮X⟯ (algebraMap (ringOfIntegers k K) K n) / + Algebra.norm k⟮X⟯ + (algebraMap (ringOfIntegers k K) K (d : ringOfIntegers k K)) = + Algebra.norm k⟮X⟯ (x : K) at hx + rw [← hn, ← hd] at hx + simpa [Algebra.intNorm_eq_norm k[X] (ringOfIntegers k K)] using hx + +omit [Algebra k[X] K] [IsScalarTower k[X] k⟮X⟯ K] in +/-- Compatibility of integral norm with field norm on the infinity chart. -/ +theorem infinite_intNorm_div_eq_norm (x : Kˣ) (n : infiniteIntegers k K) + (d : nonZeroDivisors (infiniteIntegers k K)) + (hnd : IsLocalization.mk' K n d = (x : K)) : + algebraMap (inftyValuationSubring k) k⟮X⟯ + (Algebra.intNorm (inftyValuationSubring k) (infiniteIntegers k K) n) / + algebraMap (inftyValuationSubring k) k⟮X⟯ + (Algebra.intNorm (inftyValuationSubring k) (infiniteIntegers k K) + (d : infiniteIntegers k K)) = + Algebra.norm k⟮X⟯ (x : K) := by + let A := inftyValuationSubring k + let S := infiniteIntegers k K + have hn : algebraMap A k⟮X⟯ (Algebra.intNorm A S n) = + Algebra.intNorm k⟮X⟯ K (algebraMap S K n) := + Algebra.intNorm_eq_of_isLocalization A⁰ (Bₘ := K) n + have hd : algebraMap A k⟮X⟯ (Algebra.intNorm A S (d : S)) = + Algebra.intNorm k⟮X⟯ K (algebraMap S K (d : S)) := + Algebra.intNorm_eq_of_isLocalization A⁰ (Bₘ := K) (d : S) + rw [Algebra.intNorm_eq_norm A S, Algebra.intNorm_eq_norm k⟮X⟯ K] at hn hd + let N : K →*₀ k⟮X⟯ := + { Algebra.norm k⟮X⟯ with + map_zero' := (Algebra.norm_eq_zero_iff (R := k⟮X⟯) (S := K)).mpr rfl } + have hx := congrArg N hnd + rw [IsFractionRing.mk'_eq_div, map_div₀] at hx + change Algebra.norm k⟮X⟯ (algebraMap S K n) / + Algebra.norm k⟮X⟯ (algebraMap S K (d : S)) = Algebra.norm k⟮X⟯ (x : K) at hx + rw [← hn, ← hd] at hx + simpa [A, S, Algebra.intNorm_eq_norm A S] using hx + +/-- The ideal-valued weight whose restriction to finite height-one primes is `placeDegree`. -/ +noncomputable def finiteIdealWeight (P : Ideal (ringOfIntegers k K)) : ℕ := + Module.finrank k (k[X] ⧸ P.under k[X]) * P.inertiaDeg k[X] + +/-- The ideal-valued weight whose restriction to infinite height-one primes is `placeDegree`. -/ +noncomputable def infiniteIdealWeight (P : Ideal (infiniteIntegers k K)) : ℕ := + P.inertiaDeg (inftyValuationSubring k) + +/-- The finite-chart contribution of a principal divisor is the degree at infinity of the field +norm. -/ +theorem finitePrincipalDegree_eq_intDegree_norm (x : Kˣ) : + (FractionalIdeal.principalDivisor + (R := ringOfIntegers k K) (K := K) (Additive.ofMul x)).sum + (fun v n => n * (placeDegree k K (Sum.inl v) : ℤ)) = + RatFunc.intDegree (Algebra.norm k⟮X⟯ (x : K)) := by + classical + let S := ringOfIntegers k K + obtain ⟨n, d, hnd⟩ := IsLocalization.exists_mk'_eq S⁰ (x : K) + have hn : n ≠ 0 := by + intro hn + exact x.ne_zero (by simpa [hn] using hnd.symm) + have hd : (d : S) ≠ 0 := by + simpa only [mem_nonZeroDivisors_iff_ne_zero] using d.property + have hdeg := FractionalIdeal.weightedDegree_principal_mk' + (R := S) (K := K) (finiteIdealWeight k K) x n d hnd + have hnormn := finite_factorDegree_eq_relNorm k K (Ideal.span {n}) + (Ideal.span_singleton_eq_bot.not.mpr hn) + have hnormd := finite_factorDegree_eq_relNorm k K (Ideal.span {(d : S)}) + (Ideal.span_singleton_eq_bot.not.mpr hd) + let pn : k[X] := Algebra.intNorm k[X] S n + let pd : k[X] := Algebra.intNorm k[X] S (d : S) + have hpn : pn ≠ 0 := by + dsimp only [pn] + rw [Algebra.intNorm_eq_norm] + simpa only [ne_eq, Algebra.norm_eq_zero_iff] using hn + have hpd : pd ≠ 0 := by + dsimp only [pd] + rw [Algebra.intNorm_eq_norm] + simpa only [ne_eq, Algebra.norm_eq_zero_iff] using hd + rw [Ideal.relNorm_singleton, polynomial_factorDegree_span k pn hpn] at hnormn + rw [Ideal.relNorm_singleton, polynomial_factorDegree_span k pd hpd] at hnormd + change + (FractionalIdeal.principalDivisor + (R := S) (K := K) (Additive.ofMul x)).sum + (fun v m => m * (placeDegree k K (Sum.inl v) : ℤ)) = _ + have hchart : + (FractionalIdeal.principalDivisor + (R := S) (K := K) (Additive.ofMul x)).sum + (fun v m => m * (placeDegree k K (Sum.inl v) : ℤ)) = + (pn.natDegree : ℤ) - (pd.natDegree : ℤ) := by + rw [← hnormn, ← hnormd] + simpa only [FractionalIdeal.weightedDegree_apply, finiteIdealWeight, + placeDegree_finite_eq_base_mul_inertiaDeg] using hdeg + have hratio := finite_intNorm_div_eq_norm k K x n d hnd + change algebraMap k[X] k⟮X⟯ pn / algebraMap k[X] k⟮X⟯ pd = + Algebra.norm k⟮X⟯ (x : K) at hratio + have hpn' : algebraMap k[X] k⟮X⟯ pn ≠ 0 := + by simpa using (IsFractionRing.injective k[X] k⟮X⟯).ne hpn + have hpd' : algebraMap k[X] k⟮X⟯ pd ≠ 0 := + by simpa using (IsFractionRing.injective k[X] k⟮X⟯).ne hpd + have hint := congrArg RatFunc.intDegree hratio + rw [RatFunc.intDegree_div hpn' hpd', RatFunc.intDegree_polynomial, + RatFunc.intDegree_polynomial] at hint + exact hchart.trans hint + +omit [IsScalarTower k[X] k⟮X⟯ K] in +/-- The infinite-chart contribution of a principal divisor is the negative degree at infinity of +the field norm. -/ +theorem infinitePrincipalDegree_eq_neg_intDegree_norm (x : Kˣ) : + (FractionalIdeal.principalDivisor + (R := infiniteIntegers k K) (K := K) (Additive.ofMul x)).sum + (fun v n => n * (placeDegree k K (Sum.inr v) : ℤ)) = + -RatFunc.intDegree (Algebra.norm k⟮X⟯ (x : K)) := by + classical + let A := inftyValuationSubring k + let S := infiniteIntegers k K + obtain ⟨n, d, hnd⟩ := IsLocalization.exists_mk'_eq S⁰ (x : K) + have hn : n ≠ 0 := by + intro hn + exact x.ne_zero (by simpa [hn] using hnd.symm) + have hd : (d : S) ≠ 0 := by + simpa only [mem_nonZeroDivisors_iff_ne_zero] using d.property + have hdeg := FractionalIdeal.weightedDegree_principal_mk' + (R := S) (K := K) (infiniteIdealWeight k K) x n d hnd + have hnormn := infinite_factorDegree_eq_relNorm k K (Ideal.span {n}) + (Ideal.span_singleton_eq_bot.not.mpr hn) + have hnormd := infinite_factorDegree_eq_relNorm k K (Ideal.span {(d : S)}) + (Ideal.span_singleton_eq_bot.not.mpr hd) + let qn : A := Algebra.intNorm A S n + let qd : A := Algebra.intNorm A S (d : S) + have hqn : qn ≠ 0 := by + dsimp only [qn] + rw [Algebra.intNorm_eq_norm] + simpa only [ne_eq, Algebra.norm_eq_zero_iff] using hn + have hqd : qd ≠ 0 := by + dsimp only [qd] + rw [Algebra.intNorm_eq_norm] + simpa only [ne_eq, Algebra.norm_eq_zero_iff] using hd + rw [Ideal.relNorm_singleton] at hnormn hnormd + have hbaseqn := infinity_factorDegree_span k qn hqn + have hbaseqd := infinity_factorDegree_span k qd hqd + have hnormnZ := congrArg (fun m : ℕ => (m : ℤ)) hnormn + have hnormdZ := congrArg (fun m : ℕ => (m : ℤ)) hnormd + have hupn : + ((((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {n})).map + (fun P => P.inertiaDeg (inftyValuationSubring k))).sum : ℕ) : ℤ) = + -RatFunc.intDegree (qn : k⟮X⟯) := + hnormnZ.trans hbaseqn + have hupd : + ((((UniqueFactorizationMonoid.normalizedFactors (Ideal.span {(d : S)})).map + (fun P => P.inertiaDeg (inftyValuationSubring k))).sum : ℕ) : ℤ) = + -RatFunc.intDegree (qd : k⟮X⟯) := + hnormdZ.trans hbaseqd + change + (FractionalIdeal.principalDivisor + (R := S) (K := K) (Additive.ofMul x)).sum + (fun v m => m * (placeDegree k K (Sum.inr v) : ℤ)) = _ + have hchart : + (FractionalIdeal.principalDivisor + (R := S) (K := K) (Additive.ofMul x)).sum + (fun v m => m * (placeDegree k K (Sum.inr v) : ℤ)) = + -RatFunc.intDegree (qn : k⟮X⟯) - + (-RatFunc.intDegree (qd : k⟮X⟯)) := by + have hdeg' := hdeg + simp only [FractionalIdeal.weightedDegree_apply, infiniteIdealWeight] at hdeg' + rw [hupn, hupd] at hdeg' + simpa only [placeDegree_infinite_eq_inertiaDeg] using hdeg' + have hratio := infinite_intNorm_div_eq_norm k K x n d hnd + change (qn : k⟮X⟯) / (qd : k⟮X⟯) = Algebra.norm k⟮X⟯ (x : K) at hratio + have hqn' : (qn : k⟮X⟯) ≠ 0 := by simpa using hqn + have hqd' : (qd : k⟮X⟯) ≠ 0 := by simpa using hqd + have hint := congrArg RatFunc.intDegree hratio + rw [RatFunc.intDegree_div hqn' hqd'] at hint + rw [hchart, ← hint] + ring + +/-- The valuation subring at a coordinate place. -/ +noncomputable def placeValuationSubring (v : PlaceA k K) : ValuationSubring K := + (placeValuation k K v).valuationSubring + +/-- The global degree of a divisor. -/ +noncomputable def deg (D : DivisorA k K) : ℤ := + D.sum fun v n => (n : ℤ) * (placeDegree k K v : ℤ) + +/-- Product formula: the global degree of a principal divisor is zero. -/ +theorem deg_principalDivisorA_eq_zero (x : Kˣ) : + deg k K (principalDivisorA k K (Additive.ofMul x)) = 0 := by + let Dfin := FractionalIdeal.principalDivisor + (R := ringOfIntegers k K) (K := K) (Additive.ofMul x) + let Dinf := FractionalIdeal.principalDivisor + (R := infiniteIntegers k K) (K := K) (Additive.ofMul x) + have hdiv : principalDivisorA k K (Additive.ofMul x) = Dfin.sumElim Dinf := by + rw [Finsupp.sumElim_eq_add] + rfl + rw [deg, hdiv, Finsupp.sum_sumElim] + change + Dfin.sum (fun v n => n * (placeDegree k K (Sum.inl v) : ℤ)) + + Dinf.sum (fun v n => n * (placeDegree k K (Sum.inr v) : ℤ)) = 0 + rw [finitePrincipalDegree_eq_intDegree_norm k K x, + infinitePrincipalDegree_eq_neg_intDegree_norm k K x] + exact add_neg_cancel _ + +/-- The support of a divisor. -/ +def support (D : DivisorA k K) : Finset (PlaceA k K) := D.support + +/-- A divisor is effective when all coefficients are nonnegative. -/ +def IsEffective (D : DivisorA k K) : Prop := + ∀ v, 0 ≤ D v + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_zero : deg k K (0 : DivisorA k K) = 0 := by + simp [deg, placeDegree] + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_add (D₁ D₂ : DivisorA k K) : + deg k K (D₁ + D₂) = deg k K D₁ + deg k K D₂ := by + classical + simp [deg, Finsupp.sum_add_index, add_mul] + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_neg (D : DivisorA k K) : deg k K (-D) = -deg k K D := by + classical + simp [deg, Finsupp.sum_neg_index, neg_mul] + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_sub (D D' : DivisorA k K) : + deg k K (D - D') = deg k K D - deg k K D' := by + simp [deg_add, deg_neg, sub_eq_add_neg] + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_nsmul {D : DivisorA k K} (n : ℕ) : + deg k K (n • D) = (n : ℤ) * deg k K D := by + induction n with + | zero => simp [deg_zero] + | succ n ih => + rw [succ_nsmul, deg_add, ih] + simp only [Nat.cast_add, Nat.cast_one, one_mul, add_mul, add_comm] + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_nsmul_effective {D : DivisorA k K} (n : ℕ) (_hD : IsEffective k K D) : + deg k K (n • D) = (n : ℤ) * deg k K D := + deg_nsmul (k := k) (K := K) (D := D) n + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +/-- Effective divisors have nonnegative degree. -/ +theorem deg_nonneg {D : DivisorA k K} (hD : IsEffective k K D) : + 0 ≤ deg k K D := by + classical + exact Finsupp.sum_nonneg fun v _ => + mul_nonneg (hD v) (Int.natCast_nonneg (placeDegree k K v)) + +/-- An effective divisor of degree zero is the zero divisor. -/ +theorem eq_zero_of_effective_deg_zero {D : DivisorA k K} (hD : IsEffective k K D) + (hdeg : deg k K D = 0) : D = 0 := by + classical + rw [deg, Finsupp.sum] at hdeg + have hall := (Finset.sum_eq_zero_iff_of_nonneg (fun v _ => + mul_nonneg (hD v) (Int.natCast_nonneg (placeDegree k K v)))).1 hdeg + apply Finsupp.ext + intro v + simp only [Finsupp.zero_apply] + by_cases hv : v ∈ D.support + · have hmul := hall v hv + have hplace : (placeDegree k K v : ℤ) ≠ 0 := by + exact_mod_cast (placeDegree_pos k K v).ne' + exact (mul_eq_zero.mp hmul).resolve_right hplace + · simpa only [Finsupp.mem_support_iff, not_not] using hv + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem deg_single (v : PlaceA k K) (n : ℤ) : + deg k K (Finsupp.single v n) = n * placeDegree k K v := by + simp [deg, Finsupp.sum_single_index] + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +/-- The degree map is monotone for the pointwise order on divisors. -/ +theorem deg_mono {D D' : DivisorA k K} (h : D ≤ D') : + deg k K D ≤ deg k K D' := by + rw [← sub_nonneg, ← deg_sub] + apply deg_nonneg k K + intro v + exact sub_nonneg.mpr (h v) + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +/-- A nonpositive divisor has nonpositive degree. -/ +theorem deg_nonpos {D : DivisorA k K} (hD : D ≤ 0) : deg k K D ≤ 0 := by + simpa only [deg_zero] using deg_mono k K hD + +omit [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem le_iff_sub_effective {D D' : DivisorA k K} : + D ≤ D' ↔ IsEffective k K (D' - D) := by + simp only [Finsupp.le_def, IsEffective, Finsupp.sub_apply, sub_nonneg] + +end FunctionField.Chart diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean new file mode 100644 index 0000000000..b81f1b4312 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean @@ -0,0 +1,203 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.FilterChain +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic +public import Mathlib.Algebra.Order.GroupWithZero.Canonical +public import Mathlib.LinearAlgebra.FiniteDimensional.Basic +public import Mathlib.Algebra.Module.Submodule.Lattice +public import Mathlib.LinearAlgebra.Quotient.Basic +public import Mathlib.RingTheory.Valuation.ValuationSubring + +/-! +# Adele quotient rank and the index of specialty +This file proves Stichtenoth 1.5.4: the rank of `𝒜_K/(A(D)+K̃)` equals the specialty +index `i(D)`. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero +open Filter + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +variable [IsFullConstantField k K] + +/-- The classical decidable equality on coordinate places used for adele surgery. -/ +local instance instDecidableEqPlaceAAdeleQuotient : DecidableEq (PlaceA k K) := Classical.decEq _ + +/-- The top submodule of the adele space (avoids `↥⊤` notation pitfalls). -/ +def topAdeleSubmodule : Submodule k (AdeleSpace k K) := ⊤ + +omit [IsFullConstantField k K] in +/-- Finite set of finite places where an adele component is not integral. -/ +theorem exceptionalFinite (α : AdeleSpace k K) : + {v : PlaceA k K | ¬placeValuation k K v (α.val v) ≤ 1}.Finite := + (Filter.eventually_cofinite.mp α.property).subset (by + intro v hv + change α.val v ∉ placeValuationSubring k K v + simpa [placeValuationSubring, Valuation.mem_valuationSubring_iff] using hv) + +/-- Finset of finite places where an adele component is not integral. -/ +def exceptionalPlaces (α : AdeleSpace k K) : Finset (PlaceA k K) := + (exceptionalFinite k K α).toFinset + +/-- Every adele lies in some filtration piece `A(D)`. -/ +noncomputable def divisorOfAdele (α : AdeleSpace k K) : DivisorA k K := + Finsupp.onFinset (exceptionalPlaces k K α) + (fun v => + if 1 < placeValuation k K v (α.val v) then + WithZero.log (placeValuation k K v (α.val v)) + else 0) + (by + intro v hvne + by_cases hlt : 1 < placeValuation k K v (α.val v) + · dsimp [exceptionalPlaces] + exact (exceptionalFinite k K α).mem_toFinset.mpr (not_le.mpr hlt) + · simp [hlt] at hvne) + +omit [IsFullConstantField k K] in +theorem mem_adeleFilt_divisorOfAdele (α : AdeleSpace k K) : + α ∈ adeleFilt k K (divisorOfAdele k K α) := by + intro v + show placeValuation k K v (α.val v) ≤ WithZero.exp ((divisorOfAdele k K α) v) + dsimp [divisorOfAdele, exceptionalPlaces, Finsupp.onFinset_apply] + by_cases hv : placeValuation k K v (α.val v) ≤ 1 + · have hnotlt : ¬1 < placeValuation k K v (α.val v) := not_lt.mpr hv + have hnotmem : v ∉ exceptionalPlaces k K α := by + intro hmem + have hgt := (exceptionalFinite k K α).mem_toFinset.mp (by + dsimp [exceptionalPlaces] at hmem ⊢ + exact hmem) + have hnotle : ¬placeValuation k K v (α.val v) ≤ 1 := by simpa using hgt + exact absurd hv hnotle + split_ifs with hlt + · exfalso + exact hnotlt hlt + · simpa [WithZero.exp_zero] using hv + · have hlt : 1 < placeValuation k K v (α.val v) := not_le.mp hv + have hmem : v ∈ exceptionalPlaces k K α := by + dsimp [exceptionalPlaces] + exact (exceptionalFinite k K α).mem_toFinset.mpr (not_le.mpr hlt) + have hval : placeValuation k K v (α.val v) ≠ 0 := ne_of_gt (zero_lt_one.trans hlt) + split_ifs with hlt' + · simp [WithZero.exp_log hval] + · exfalso + exact hlt' hlt + +omit [IsFullConstantField k K] in +theorem exists_adeleFilt_mem (α : AdeleSpace k K) : + ∃ D : DivisorA k K, α ∈ adeleFilt k K D := + ⟨divisorOfAdele k K α, mem_adeleFilt_divisorOfAdele k K α⟩ + +theorem defect_eq_genus_of_ge {D D' : DivisorA k K} (hle : D ≤ D') + (hD : defect k K D = genus k K) : defect k K D' = genus k K := by + have hle' : defect k K D ≤ defect k K D' := defect_mono' (k := k) (K := K) hle + have hgen : defect k K D' ≤ genus k K := defect_le k K D' + omega + +theorem sandwichRank_eq_zero_of_defect_eq {D D' : DivisorA k K} (hle : D ≤ D') + (hD : defect k K D = genus k K) : + sandwichRank k K D D' hle = 0 := by + have hD' : defect k K D' = genus k K := defect_eq_genus_of_ge (k := k) (K := K) hle hD + have hs := sandwich (k := k) (K := K) hle + dsimp only [defect] at hD hD' ⊢ + rw [hs] + omega + +omit [IsFullConstantField k K] in +theorem adeleFilt_add_diagonal_eq_of_sandwich_zero {D D' : DivisorA k K} (hle : D ≤ D') + (h0 : sandwichRank k K D D' hle = 0) : + adeleFilt k K D' + diagonalSubmodule k K = adeleFilt k K D + diagonalSubmodule k K := + sandwichDiagonalSubmodule_eq_of_rank_zero (k := k) (K := K) hle h0 + +theorem adeleSubmodule_top_eq_adeleFilt_add_diagonal {D : DivisorA k K} + (hD : defect k K D = genus k K) : + topAdeleSubmodule k K = adeleFilt k K D + diagonalSubmodule k K := by + apply le_antisymm + · intro α _ + obtain ⟨Dα, hDα⟩ := exists_adeleFilt_mem (k := k) (K := K) α + let D' := D ⊔ Dα + have hD' : defect k K D' = genus k K := + defect_eq_genus_of_ge (k := k) (K := K) (le_sup_left (a := D) (b := Dα)) hD + have h0 := sandwichRank_eq_zero_of_defect_eq (k := k) (K := K) (D := D) (D' := D') + (le_sup_left (a := D) (b := Dα)) hD + have heq := adeleFilt_add_diagonal_eq_of_sandwich_zero (k := k) (K := K) (D := D) (D' := D') + (le_sup_left (a := D) (b := Dα)) h0 + have hmem : α ∈ adeleFilt k K D' + diagonalSubmodule k K := + Submodule.mem_sup_left (adeleFilt_mono (k := k) (K := K) le_sup_right hDα) + rw [heq] at hmem + exact hmem + · exact le_top + +omit [IsFullConstantField k K] in +theorem finrankAdeleQuotient_eq_sandwichRank {D D' : DivisorA k K} (hle : D ≤ D') + (hfull : topAdeleSubmodule k K = adeleFilt k K D' + diagonalSubmodule k K) : + finrankAdeleQuotient k K D = (sandwichRank k K D D' hle).toNat := by + classical + let ssum := adeleFilt k K D + diagonalSubmodule k K + let topMod := topAdeleSubmodule k K + letI : AddCommGroup ↥topMod := Submodule.addCommGroup _ + letI : Module k ↥topMod := Submodule.module _ + let p := Submodule.comap topMod.subtype ssum + let e : ↥topMod ≃ₗ[k] AdeleSpace k K := + Submodule.topEquiv (R := k) (M := AdeleSpace k K) + have hmap := Submodule.map_comap_subtype (p := topMod) (p' := ssum) + have heq_lm : (e : ↥topMod →ₗ[k] AdeleSpace k K) = topMod.subtype := by + apply LinearMap.ext + rintro ⟨f, _⟩ + apply Subtype.ext + funext v + rfl + have hf : p.map (e : ↥topMod →ₗ[k] AdeleSpace k K) = ssum := by + rw [show p.map (e : ↥topMod →ₗ[k] AdeleSpace k K) = p.map topMod.subtype from by + rw [heq_lm], hmap, inf_eq_right] + exact le_top + dsimp only [finrankAdeleQuotient, sandwichRank, ssum] + rw [← (Submodule.Quotient.equiv p ssum e hf).finrank_eq, hfull.symm] + simp only [topMod, topAdeleSubmodule, ssum, p] + simp + +theorem finrank_adele_quotient (D : DivisorA k K) : + finrankAdeleQuotient k K D = indexOfSpecialty k K D := by + obtain ⟨D₁, hD₁⟩ := exists_defect_eq (k := k) (K := K) + let D' := D ⊔ D₁ + have hle : D ≤ D' := le_sup_left (a := D) (b := D₁) + have hD' : defect k K D' = genus k K := + defect_eq_genus_of_ge (k := k) (K := K) (le_sup_right (a := D) (b := D₁)) hD₁ + have hfull := adeleSubmodule_top_eq_adeleFilt_add_diagonal (k := k) (K := K) hD' + have hsand := sandwich (k := k) (K := K) hle + have hfin := finrankAdeleQuotient_eq_sandwichRank (k := k) (K := K) hle hfull + have hdef : sandwichRank k K D D' hle = defect k K D' - defect k K D := by + dsimp only [defect] + rw [hsand] + omega + have hidx : (indexOfSpecialty k K D : ℤ) = genus k K - defect k K D := by + have := indexOfSpecialty_eq (k := k) (K := K) D + dsimp only [defect] at this ⊢ + omega + have hD'gen : defect k K D' = genus k K := hD' + calc finrankAdeleQuotient k K D + _ = (sandwichRank k K D D' hle).toNat := hfin + _ = (genus k K - defect k K D).toNat := by rw [hdef, hD'gen] + _ = indexOfSpecialty k K D := by + rw [← hidx] + simp only [Int.toNat_natCast] + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean new file mode 100644 index 0000000000..0321d2033f --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean @@ -0,0 +1,353 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Ramification +public import Mathlib.Data.Int.LeastGreatest +public import Mathlib.FieldTheory.RatFunc.Basic +public import Mathlib.LinearAlgebra.Basis.Basic + +/-! +# Genus, Riemann inequality, and the index of specialty + +This file defines the genus of a function field and the specialty index `i(D)`. + +## Main definitions + +* `FunctionField.defect`: `deg D + 1 − ℓ(D)`. +* `FunctionField.genus`: the maximal defect. +* `FunctionField.indexOfSpecialty`: `ℓ(D) − (deg D + 1 − g)`. + +## Main results + +* `FunctionField.riemann_ineq` +* `FunctionField.finrank_adele_quotient` +* `FunctionField.genus_ratFunc` +* `FunctionField.deg_polarX_eq_finrank` +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +variable [IsFullConstantField k K] + +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncGenus : DecidableEq k⟮X⟯ := Classical.decEq _ + +/-- The defect `deg D + 1 − ℓ(D)`. -/ +noncomputable def defect (D : DivisorA k K) : ℤ := + deg k K D + 1 - ell k K D + +/-- Stichtenoth 1.4.11 for the chart variable `X_K` (equality; ≤ half proved in `Polar.lean`). -/ +theorem deg_polarX_eq_finrank : + deg k K (polarDivisor k K (XK k K)) = Module.finrank k⟮X⟯ K := by + exact le_antisymm (deg_polarX_le_finrank (k := k) (K := K)) + (finrank_le_deg_polarX (k := k) (K := K)) + +section RiemannFamily + +omit [IsFullConstantField k K] in +/-- Monotonicity of the defect along divisor domination. -/ +theorem defect_mono' {D D' : DivisorA k K} (h : D ≤ D') : + defect k K D ≤ defect k K D' := by + dsimp only [defect] + have := defect_mono (k := k) (K := K) h + omega + +omit [IsFullConstantField k K] in +/-- Defect is unchanged by adding a principal divisor. -/ +theorem defect_add_principal (D : DivisorA k K) (x : Kˣ) : + defect k K (D + principalDivisorA k K (Additive.ofMul x)) = defect k K D := by + dsimp only [defect] + rw [deg_add, deg_principalDivisor_eq_zero (k := k) (K := K) x, ell_add_principal, add_zero] + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +/-- From membership in `L(D₁ - D₀)`, the pole divisor of `f` moves `D₀` below `D₁ + (f)`. -/ +theorem le_add_principal_of_memRRspace {D₀ D₁ : DivisorA k K} {f : K} (hf : f ≠ 0) + (hmem : memRRspace k K (D₁ - D₀) f) : + D₀ ≤ D₁ + principalDivisorA k K (Additive.ofMul (Units.mk0 f hf)) := by + rw [le_iff_sub_effective] + intro v + dsimp only [Finsupp.add_apply, Finsupp.sub_apply] + have hv := hmem v + have hxval := placeValuation_eq_exp_neg_principalDivisor k K (Additive.ofMul (Units.mk0 f hf)) v + change placeValuation k K v f ≤ WithZero.exp ((D₁ - D₀) v) at hv + change placeValuation k K v f = + WithZero.exp (-(principalDivisorA k K (Additive.ofMul (Units.mk0 f hf)) v)) at hxval + rw [hxval] at hv + have hexp := WithZero.exp_le_exp.mp hv + have hsubv : (D₁ - D₀) v = D₁ v - D₀ v := rfl + have hexp' : + -(principalDivisorA k K (Additive.ofMul (Units.mk0 f hf)) v) ≤ D₁ v - D₀ v := by + simpa [hsubv] using hexp + linarith + +omit [IsFullConstantField k K] in +/-- `ℓ(D + E) − deg E ≤ ℓ(D)` for effective `E`. -/ +theorem ell_sub_effective_sub_ge {D E : DivisorA k K} (hE : IsEffective k K E) : + (ell k K (D + E) : ℤ) - deg k K E ≤ ell k K D := by + have hle : D ≤ D + E := by + intro v + simp only [Finsupp.add_apply] + linarith [hE v] + have hsum := finrankRRspaceDiff_add_ell (k := k) (K := K) hle + have hq := finrankRRspaceDiff_add_effective_le (k := k) (K := K) D E hE + have hdeg : 0 ≤ deg k K E := deg_nonneg (k := k) (K := K) hE + have htoNat : ((deg k K E).toNat : ℤ) = deg k K E := Int.toNat_of_nonneg hdeg + have hqZ : (finrankRRspaceDiff k K D (D + E) : ℤ) ≤ deg k K E := by + rw [← htoNat] + exact_mod_cast hq + have hsum' : (finrankRRspaceDiff k K D (D + E) : ℤ) + ell k K D = ell k K (D + E) := by + exact_mod_cast hsum + omega + +omit [IsFullConstantField k K] in +/-- Every defect is bounded by `c₀` once the pole family has defect `≤ c₀` and grows in +rank. -/ +theorem defect_le_of_family (B C : DivisorA k K) (c₀ : ℤ) + (hmono : ∀ r : ℕ, defect k K (C + r • B) ≤ c₀) + (hgrow : ∀ m : ℤ, ∃ r : ℕ, m ≤ ell k K (C + r • B)) : + ∀ D : DivisorA k K, defect k K D ≤ c₀ := by + intro D + let Dpos := D ⊔ (0 : DivisorA k K) + have hDle : D ≤ Dpos := le_sup_left (a := D) (b := 0) + have hDposeff : IsEffective k K Dpos := fun v => le_max_right (D v) 0 + obtain ⟨r, hr⟩ := hgrow (deg k K Dpos + 1) + let Dr := C + r • B + have hsub := ell_sub_effective_sub_ge (k := k) (K := K) (D := Dr - Dpos) (E := Dpos) hDposeff + rw [sub_add_cancel] at hsub + have hellpos : 0 < ell k K (Dr - Dpos) := by + linarith + obtain ⟨f, hfne⟩ := (Module.finrank_pos_iff_exists_ne_zero (R := k)).1 hellpos + let fK : K := f.val + have hfKne : fK ≠ 0 := fun h => hfne (Subtype.ext h) + have hmem : memRRspace k K (Dr - Dpos) fK := f.property + have hDposle : Dpos ≤ Dr + principalDivisorA k K (Additive.ofMul (Units.mk0 fK hfKne)) := + le_add_principal_of_memRRspace (k := k) (K := K) hfKne hmem + have hDle' : D ≤ Dr + principalDivisorA k K (Additive.ofMul (Units.mk0 fK hfKne)) := + le_trans hDle hDposle + calc + defect k K D ≤ + defect k K (Dr + principalDivisorA k K (Additive.ofMul (Units.mk0 fK hfKne))) := + defect_mono' (k := k) (K := K) hDle' + _ = defect k K Dr := defect_add_principal (k := k) (K := K) Dr _ + _ ≤ c₀ := hmono r + +end RiemannFamily + +/-- Along the chart pole family, every defect is at most `deg C + 1 − n`. -/ +theorem defect_le_chart_family (D : DivisorA k K) : + defect k K D ≤ + deg k K (basisPoleBound k K (Module.finBasis k⟮X⟯ K)) + 1 - + Module.finrank k⟮X⟯ K := by + let b := Module.finBasis k⟮X⟯ K + let n := Module.finrank k⟮X⟯ K + let C := basisPoleBound k K b + let B := polarDivisor k K (XK k K) + let c₀ := deg k K C + 1 - n + have hmono : ∀ r : ℕ, defect k K (C + r • B) ≤ c₀ := by + intro r + have hdeg : deg k K (C + r • B) = deg k K C + (r : ℤ) * deg k K B := by + rw [add_comm, ← nsmul_eq_mul, deg_add, deg_nsmul, nsmul_eq_mul, add_comm] + have hell := ell_family_ge (k := k) (K := K) (n := n) (r := r) b + have hBdeg : deg k K B = (n : ℤ) := deg_polarX_eq_finrank (k := k) (K := K) + have hcast : (n * (r + 1) : ℤ) ≤ ell k K (C + r • B) := Nat.cast_le.mpr hell + dsimp only [defect] + rw [hdeg, hBdeg] + linarith + have hn : 0 < n := Module.finrank_pos + have hgrow : ∀ m : ℤ, ∃ r : ℕ, m ≤ ell k K (C + r • B) := by + intro m + by_cases hm : m ≤ 0 + · refine ⟨0, ?_⟩ + have h0le : (0 : DivisorA k K) ≤ C + 0 • B := fun v => + show 0 ≤ (C + 0 • B) v by + simpa [Finsupp.add_apply, Finsupp.nsmul_apply] using + basisPoleBound_nonneg (k := k) (K := K) b v + have hmono0 : (ell k K (0 : DivisorA k K) : ℤ) ≤ ell k K (C + 0 • B) := by + exact_mod_cast Submodule.finrank_mono (RRspace_mono (k := k) (K := K) h0le) + rw [ell_zero (k := k) (K := K)] at hmono0 + linarith + · have hmpos : 0 < m := by omega + let mnat := Int.toNat m + have hmNat : (mnat : ℤ) = m := Int.toNat_of_nonneg (le_of_lt hmpos) + refine ⟨mnat, ?_⟩ + have hge := ell_family_ge (k := k) (K := K) (n := n) (r := mnat) b + have hcast : (n * (mnat + 1) : ℤ) ≤ ell k K (C + mnat • B) := Nat.cast_le.mpr hge + have hbound : m ≤ (n * (mnat + 1) : ℤ) := by + rw [← hmNat] + have hn1 : (1 : ℤ) ≤ n := by exact_mod_cast hn + nlinarith [show (0 : ℤ) < m from hmpos] + linarith + exact defect_le_of_family (k := k) (K := K) B C c₀ hmono hgrow D + +/-- Riemann's bounded-defect theorem: the integer defects have a nonnegative maximum. -/ +theorem exists_max_defect : + ∃ g : ℕ, (∀ D : DivisorA k K, defect k K D ≤ (g : ℤ)) ∧ + ∃ D : DivisorA k K, defect k K D = (g : ℤ) := by + let b := Module.finBasis k⟮X⟯ K + let n := Module.finrank k⟮X⟯ K + let C := basisPoleBound k K b + let c₀ := deg k K C + 1 - n + have hbound : ∀ D : DivisorA k K, defect k K D ≤ c₀ := + fun D => defect_le_chart_family (k := k) (K := K) D + have hzero : defect k K (0 : DivisorA k K) = 0 := by + dsimp only [defect] + rw [deg_zero (k := k) (K := K), ell_zero (k := k) (K := K)] + omega + have hInh : ∃ z : ℤ, ∃ D : DivisorA k K, defect k K D = z := ⟨0, 0, hzero⟩ + have hBdd : ∃ b : ℤ, ∀ z : ℤ, (∃ D : DivisorA k K, defect k K D = z) → z ≤ b := by + refine ⟨c₀, ?_⟩ + intro z ⟨D, hD⟩ + simpa [hD] using hbound D + obtain ⟨g', hg', hgmax⟩ := Int.exists_greatest_of_bdd hBdd hInh + have hg'nn : 0 ≤ g' := hgmax 0 ⟨0, hzero⟩ + refine ⟨g'.toNat, ?_, ?_⟩ + · intro D + have hle := hgmax (defect k K D) ⟨D, rfl⟩ + calc defect k K D ≤ g' := hle + _ = (g'.toNat : ℤ) := (Int.toNat_of_nonneg hg'nn).symm + · obtain ⟨D, hD⟩ := hg' + refine ⟨D, ?_⟩ + rw [Int.toNat_of_nonneg hg'nn] + exact hD + +/-- The genus of the function field `K/k`. -/ +noncomputable def genus : ℕ := + Classical.choose (exists_max_defect k K) + +theorem riemann_ineq (D : DivisorA k K) : + (ell k K D : ℤ) ≥ deg k K D + 1 - (genus k K : ℤ) := by + have h := (Classical.choose_spec (exists_max_defect k K)).1 D + simp only [defect, genus] at h ⊢ + omega + +theorem defect_le (D : DivisorA k K) : defect k K D ≤ genus k K := by + have h := riemann_ineq k K D + simp only [defect] + omega + +theorem exists_defect_eq : ∃ D : DivisorA k K, defect k K D = genus k K := by + simpa only [genus] using (Classical.choose_spec (exists_max_defect k K)).2 + +/-- Riemann's inequality along a growing pole family: the genus is at most `c₀`. -/ +theorem genus_le_of_family (B C : DivisorA k K) (c₀ : ℤ) + (hmono : ∀ r : ℕ, defect k K (C + r • B) ≤ c₀) + (hgrow : ∀ m : ℤ, ∃ r : ℕ, m ≤ ell k K (C + r • B)) : + (genus k K : ℤ) ≤ c₀ := by + have hbound := defect_le_of_family (k := k) (K := K) B C c₀ hmono hgrow + obtain ⟨D, hD⟩ := exists_defect_eq (k := k) (K := K) + simpa [hD] using hbound D + +/-- The index of specialty `i(D) = ℓ(D) − (deg D + 1 − g)`. -/ +noncomputable def indexOfSpecialty (D : DivisorA k K) : ℕ := + (ell k K D - (deg k K D + 1 - (genus k K : ℤ))).toNat + +theorem indexOfSpecialty_eq (D : DivisorA k K) : + (indexOfSpecialty k K D : ℤ) = ell k K D - (deg k K D + 1 - (genus k K : ℤ)) := by + have h := riemann_ineq k K D + rw [indexOfSpecialty, Int.toNat_of_nonneg] + omega + +/-- `finrank k (A_K ⧸ (A(D) + K̃))`. -/ +noncomputable def finrankAdeleQuotient (D : DivisorA k K) : ℕ := + Module.finrank k <| + (AdeleSpace k K) ⧸ (adeleFilt k K D + diagonalSubmodule k K) + +section PolarDivisor + +omit [IsFullConstantField k K] in +theorem polar_deg_pos {x : K} (hx : ¬IsAlgebraic k x) : + 0 < deg k K (polarDivisor k K x) := by + by_cases hx0 : x = 0 + · subst hx0 + exact absurd isAlgebraic_zero hx + · exact polarDivisor_pos k K hx0 hx + +end PolarDivisor + +section RatFunc + +/-- The genus of the rational function field `RatFunc k` is zero. -/ +theorem genus_ratFunc : genus k (RatFunc k) = 0 := by + let K := k⟮X⟯ + have hn : Module.finrank k⟮X⟯ K = 1 := Module.finrank_self k⟮X⟯ + let hb : Module.Basis (Fin 1) k⟮X⟯ K := Module.Basis.singleton (Fin 1) k⟮X⟯ + let B := polarDivisor k K (XK k K) + let C := (0 : DivisorA k K) + have hCeq : basisPoleBound k K hb = C := by + have hpol : polarDivisor k K (1 : K) = 0 := + polarDivisor_eq_zero_of_algebraic (k := k) (K := K) isAlgebraic_one + ext v + simp only [basisPoleBound, C, Finsupp.zero_apply] + rw [Finset.sum_fin_eq_sum_range, Finset.sum_range_one] + dsimp [hb] + simp only [Module.Basis.singleton_apply, hpol] + rfl + have hmono : ∀ r : ℕ, defect k K (C + r • B) ≤ 0 := by + intro r + dsimp only [defect] + have hdeg : deg k K (C + r • B) = (r : ℤ) * deg k K B := by + rw [zero_add, deg_nsmul] + have hell := ell_family_ge (k := k) (K := K) (n := 1) (r := r) hb + have hell' : ((r + 1 : ℕ) : ℤ) ≤ (ell k K (C + r • B) : ℤ) := by + have hellNat : r + 1 ≤ ell k K (C + r • B) := by + simpa [hCeq, one_mul, B] using hell + exact_mod_cast hellNat + norm_num [Nat.cast_add, Nat.cast_one] at hell' + have hBdeg : deg k K B = 1 := by + rw [deg_polarX_eq_finrank (k := k) (K := K)] + exact_mod_cast hn + rw [hdeg, hBdeg] + linarith + have hgrow : ∀ m : ℤ, ∃ r : ℕ, m ≤ ell k K (C + r • B) := by + intro m + by_cases hm : m ≤ 0 + · refine ⟨0, ?_⟩ + have h0le : (0 : DivisorA k K) ≤ C + 0 • B := fun v => by simp [C] + have hmono0 : (ell k K (0 : DivisorA k K) : ℤ) ≤ ell k K (C + 0 • B) := by + exact_mod_cast Submodule.finrank_mono (RRspace_mono (k := k) (K := K) h0le) + rw [ell_zero (k := k) (K := K)] at hmono0 + linarith + · have hmpos : 0 < m := by omega + let mnat := Int.toNat m + have hmNat : (mnat : ℤ) = m := Int.toNat_of_nonneg (le_of_lt hmpos) + refine ⟨mnat, ?_⟩ + have hge := ell_family_ge (k := k) (K := K) (n := 1) (r := mnat) hb + have hcast : ((mnat + 1 : ℕ) : ℤ) ≤ (ell k K (C + mnat • B) : ℤ) := by + have hgeNat : mnat + 1 ≤ ell k K (C + mnat • B) := by + simpa [hCeq, one_mul, B] using hge + exact_mod_cast hgeNat + norm_num [Nat.cast_add, Nat.cast_one] at hcast + linarith + have hle : (genus k K : ℤ) ≤ 0 := + genus_le_of_family (k := k) (K := K) B C 0 hmono hgrow + have hge : 0 ≤ (genus k K : ℤ) := by + have := defect_le (k := k) (K := K) (0 : DivisorA k K) + dsimp [defect] at this + rw [deg_zero (k := k) (K := K), ell_zero (k := k) (K := K)] at this + exact this + linarith + +end RatFunc + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean new file mode 100644 index 0000000000..5349aecb0b --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean @@ -0,0 +1,746 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic +public import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic +public import Mathlib.FieldTheory.RatFunc.Basic +public import Mathlib.RingTheory.Algebraic.Basic +public import Mathlib.LinearAlgebra.Basis.Basic +public import Mathlib.LinearAlgebra.Dimension.Constructions +public import Mathlib.Algebra.Polynomial.AlgebraMap +public import Mathlib.Algebra.Polynomial.Degree.Operations +public import Mathlib.Algebra.Polynomial.Degree.Support +public import Mathlib.FieldTheory.RatFunc.AsPolynomial +public import Mathlib.RingTheory.Adjoin.Polynomial.Bivariate +public import Mathlib.RingTheory.Localization.Integral + +/-! +# Pole divisors and Stichtenoth 1.4.11 +This file develops the pole divisor `(x)_∞` and the key degree identity: +`deg (polarDivisor x) = finrank k(X) K` for transcendental `x`. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +open Polynomial BigOperators Submodule IntermediateField + +noncomputable section + +namespace FunctionField.Chart + +section TranscendentalPowers + +variable (k L : Type*) [Field k] [Field L] [Algebra k L] + +/-- Powers `x^j` with `j ≤ r` are `k`-linearly independent when `x` is transcendental. -/ +theorem linearIndependent_fin_pow_of_transcendental {x : L} (hx : Transcendental k x) (r : ℕ) : + LinearIndependent k fun j : Fin (r + 1) => x ^ (j : ℕ) := by + rw [Fintype.linearIndependent_iff] + intro g hg j + let p : k[X] := ∑ i : Fin (r + 1), C (g i) * X ^ (i : ℕ) + have hzero : aeval x p = 0 := by + have hsum : aeval x p = ∑ i : Fin (r + 1), g i • x ^ (i : ℕ) := by + simp only [p, map_sum, map_mul, aeval_C] + congr 1 + ext i + rw [aeval_X_pow, Algebra.smul_def, mul_comm] + rw [hsum, hg] + have hp0 : p = 0 := (transcendental_iff.mp hx) p hzero + have hcoeffj : g j = 0 := by + have hpgj : g j = p.coeff (j : ℕ) := by + classical + dsimp only [p] + rw [finsetSum_coeff, Finset.sum_eq_single j] + · rw [coeff_C_mul_X_pow, if_pos rfl] + · intro b _ ne + rw [coeff_C_mul_X_pow] + split_ifs with h + · exact absurd h (Fin.val_ne_of_ne ne.symm) + · rfl + · simp + rw [hpgj, hp0, coeff_zero] + exact hcoeffj + +end TranscendentalPowers + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +variable [IsFullConstantField k K] + +/-- Decidable equality on coordinate places for polar divisor proofs. -/ +local instance instDecidableEqPlaceAPolar : DecidableEq (PlaceA k K) := Classical.decEq _ +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncPolar : DecidableEq k⟮X⟯ := Classical.decEq _ + +section PolarDivisor + +/-- The pole divisor `(x)_∞` of a nonzero function. -/ +noncomputable def polarDivisor (x : K) : DivisorA k K := + by + classical + exact if hx : x = 0 then 0 + else (-principalDivisorA k K (Additive.ofMul (Units.mk0 x hx))) ⊔ 0 + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem polarDivisor_zero : polarDivisor k K (0 : K) = 0 := by + simp [polarDivisor] + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem polarDivisor_nonneg (x : K) : 0 ≤ polarDivisor k K x := by + unfold polarDivisor + split_ifs with hx + · simp + · exact le_sup_right + +theorem polarDivisor_eq_zero_of_algebraic {x : K} (hx : IsAlgebraic k x) : + polarDivisor k K x = 0 := by + by_cases hx0 : x = 0 + · simp [polarDivisor, hx0] + · obtain ⟨c, hc⟩ := IsFullConstantField.algebraic_mem (k := k) (K := K) x hx + have hc0 : c ≠ 0 := fun hc0 => hx0 (hc.trans (by rw [hc0, map_zero])) + have hdiv : + principalDivisorA k K (Additive.ofMul (Units.mk0 x hx0)) = 0 := by + have hmap : Units.mk0 x hx0 = Units.map (algebraMap k K) (Units.mk0 c hc0) := by + ext + exact hc + rw [hmap, principalDivisorA_algebraMap k K (Units.mk0 c hc0)] + ext v + unfold polarDivisor + simp only [dif_neg hx0, hdiv, neg_zero, Finsupp.sup_apply, max_self] + +omit [IsFullConstantField k K] in +theorem exists_placeValuation_gt_one_of_not_algebraic {x : K} (_hx : x ≠ 0) + (hnt : ¬IsAlgebraic k x) : + ∃ v : PlaceA k K, 1 < placeValuation k K v x := by + by_cases h : ∃ v : PlaceA k K, 1 < placeValuation k K v x + · exact h + · push Not at h + exact absurd (isAlgebraic_of_placeValuation_le_one k K x h) hnt + +omit [IsFullConstantField k K] in +theorem polarDivisor_pos {x : K} (hx : x ≠ 0) (hnt : ¬IsAlgebraic k x) : + 0 < deg k K (polarDivisor k K x) := by + obtain ⟨v, hvgt⟩ := exists_placeValuation_gt_one_of_not_algebraic k K hx hnt + have hvpos : 0 < placeDegree k K v := placeDegree_pos k K v + have hord : 0 < (polarDivisor k K x) v := by + unfold polarDivisor + split_ifs with hx0 + · exact absurd hx0 hx + · have hvval := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul (Units.mk0 x hx)) v + change 1 < placeValuation k K v x at hvgt + change placeValuation k K v x = + WithZero.exp (-(principalDivisorA k K (Additive.ofMul (Units.mk0 x hx)) v)) at hvval + rw [hvval] at hvgt + let t := -(principalDivisorA k K (Additive.ofMul (Units.mk0 x hx)) v) + have hexp1 : 1 < WithZero.exp t := hvgt + have ht : 0 < t := by + have hexpne : WithZero.exp t ≠ 0 := WithZero.exp_pos.ne' + have hlog : WithZero.log 1 < WithZero.log (WithZero.exp t) := + (WithZero.log_lt_log one_ne_zero hexpne).2 hexp1 + rw [WithZero.log_one, WithZero.log_exp] at hlog + exact hlog + rw [Finsupp.sup_apply] + exact lt_sup_iff.2 (Or.inl ht) + have hsingle : Finsupp.single v (polarDivisor k K x v) ≤ polarDivisor k K x := by + intro w + by_cases hw : w = v + · subst hw + simp only [Finsupp.single_apply, if_pos] + exact le_rfl + · rw [Finsupp.single_apply, if_neg (Ne.symm hw)] + exact polarDivisor_nonneg k K x w + have hle : (placeDegree k K v : ℤ) * (polarDivisor k K x v) ≤ + deg k K (polarDivisor k K x) := by + rw [← mul_comm (polarDivisor k K x v : ℤ), ← deg_single k K v (polarDivisor k K x v)] + exact deg_mono k K hsingle + have hdeg : 0 < (placeDegree k K v : ℤ) * (polarDivisor k K x v) := by + exact mul_pos (mod_cast hvpos) (mod_cast hord) + exact lt_of_lt_of_le hdeg hle + +omit [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- `¬IsAlgebraic` is equivalent to `Transcendental` over a field. -/ +theorem not_isAlgebraic_iff_transcendental (x : K) : + ¬IsAlgebraic k x ↔ Transcendental k x := + Iff.rfl + +/-- If `n(r + 1) ≤ dr + c` for all natural `r` and `0 < d`, then `n ≤ d`. +Used in the `finrank ≤ deg B` half of Stichtenoth 1.4.11. -/ +theorem le_of_forall_nat_mul_le {n d c : ℕ} (_hd : 0 < d) + (h : ∀ r : ℕ, n * (r + 1) ≤ d * r + c) : n ≤ d := by + by_contra hn + have hn' : d < n := lt_of_not_ge hn + have hnd : 0 < n - d := tsub_pos_of_lt hn' + have step : ∀ r : ℕ, (n - d) * r + n ≤ c := by + intro r + have hr := h r + have hsuc : n * (r + 1) = n * r + n := Nat.mul_succ n r + have hn_eq : d + (n - d) = n := by rw [Nat.add_comm, Nat.sub_add_cancel (Nat.le_of_lt hn')] + have hsplit : n * r = d * r + (n - d) * r := by + conv_lhs => arg 1; rw [← hn_eq] + exact add_mul d (n - d) r + rw [hsuc, hsplit] at hr + have hr' : (n - d) * r + n ≤ c := by omega + exact hr' + have _hnc : n ≤ c := by simpa [Nat.mul_zero, Nat.zero_add] using step 0 + have bound : ∀ r : ℕ, (n - d) * r ≤ c - n := by + intro r + have := step r + omega + set q := (c - n) / (n - d) + have hq_lt : c - n < (q + 1) * (n - d) := by + have hmod := Nat.mod_lt (c - n) hnd + calc c - n + = (n - d) * q + (c - n) % (n - d) := (Nat.div_add_mod (c - n) (n - d)).symm + _ = q * (n - d) + (c - n) % (n - d) := by rw [Nat.mul_comm] + _ < q * (n - d) + (n - d) := by gcongr + _ = (q + 1) * (n - d) := by ring_nf + have hcontra := bound (q + 1) + rw [Nat.mul_comm] at hcontra + exact lt_irrefl _ (Nat.lt_of_le_of_lt hcontra hq_lt) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem memRRspace_polarDivisor_of_ne_zero {x : K} (hxne : x ≠ 0) : + memRRspace k K (polarDivisor k K x) x := by + intro v + unfold polarDivisor + split_ifs with hx0 + · exact absurd hx0 hxne + · have hvval := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul (Units.mk0 x hx0)) v + change placeValuation k K v x = + WithZero.exp (-(principalDivisorA k K (Additive.ofMul (Units.mk0 x hx0)) v)) at hvval + rw [hvval, Finsupp.sup_apply] + exact WithZero.exp_le_exp.mpr (le_max_left _ 0) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem memRRspace_smul_polar {x : K} (hxne : x ≠ 0) (n : ℕ) : + memRRspace k K (n • polarDivisor k K x) (x ^ n) := + memRRspace.pow_mem (k := k) (K := K) (D := polarDivisor k K x) (f := x) + (memRRspace_polarDivisor_of_ne_zero k K hxne) n + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem nsmul_le_nsmul_polar {D : DivisorA k K} (hD : 0 ≤ D) {j r : ℕ} (hjr : j ≤ r) : + j • D ≤ r • D := by + intro v + show (j : ℤ) * D v ≤ (r : ℤ) * D v + exact mul_le_mul_of_nonneg_right (Nat.cast_le.mpr hjr) (hD v) + +/-- A uniform pole bound for a finite family of functions. -/ +noncomputable def basisPoleBound {ι : Type*} [Fintype ι] (f : ι → K) : DivisorA k K := + (Finset.univ : Finset ι).sum fun i => polarDivisor k K (f i) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem polarDivisor_le_basisPoleBound {ι : Type*} [Fintype ι] [DecidableEq ι] + (f : ι → K) (i : ι) : + polarDivisor k K (f i) ≤ basisPoleBound k K f := by + classical + simp only [basisPoleBound] + rw [← Finset.add_sum_erase _ _ (Finset.mem_univ i)] + exact le_add_of_nonneg_right (Finset.sum_nonneg fun j _ => polarDivisor_nonneg k K (f j)) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem basisPoleBound_nonneg {ι : Type*} [Fintype ι] (f : ι → K) : + 0 ≤ basisPoleBound k K f := by + intro v + change 0 ≤ (basisPoleBound k K f) v + simp [basisPoleBound, Finset.sum_apply] + exact Finset.sum_nonneg fun i _ => polarDivisor_nonneg k K (f i) v + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem memRRspace_basisPoleBound {ι : Type*} [Fintype ι] [DecidableEq ι] + (f : ι → K) (i : ι) : + memRRspace k K (basisPoleBound k K f) (f i) := by + by_cases hi : f i = 0 + · rw [hi] + exact memRRspace.zero_mem (k := k) (K := K) (basisPoleBound k K f) + · exact (memRRspace.memRRspace_mono (k := k) (K := K) (polarDivisor_le_basisPoleBound k K f i)) + (memRRspace_polarDivisor_of_ne_zero k K hi) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem memRRspace_basis_smul_x_pow {ι : Type*} [Fintype ι] [DecidableEq ι] + (f : ι → K) (x : K) + (hxne : x ≠ 0) (r : ℕ) (i : ι) (j : ℕ) (hj : j ≤ r) : + memRRspace k K (basisPoleBound k K f + r • polarDivisor k K x) (f i * x ^ j) := + memRRspace.mul_mem (k := k) (K := K) + (memRRspace_basisPoleBound k K f i) + ((memRRspace.memRRspace_mono (k := k) (K := K) + (nsmul_le_nsmul_polar (D := polarDivisor k K x) (hD := polarDivisor_nonneg k K x) + (hjr := hj))) + (memRRspace_smul_polar k K hxne j)) + +section ChartVariable + +/-- Scalar tower `k → k⟮X⟯ → K` for chart-variable arguments. -/ +local instance instIsScalarTowerChart : IsScalarTower k k⟮X⟯ K := + IsScalarTower.of_algebraMap_eq fun c => by + rw [IsScalarTower.algebraMap_apply k k[X] K, + IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, + ← IsScalarTower.algebraMap_apply k k[X] k⟮X⟯] + +/-- The chart variable `X_K` in `K`. -/ +noncomputable def XK : K := algebraMap k⟮X⟯ K (RatFunc.X : k⟮X⟯) + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem transcendental_XK : Transcendental k (XK k K) := + (transcendental_algebraMap_iff (algebraMap k⟮X⟯ K).injective).2 RatFunc.transcendental_X + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem not_algebraic_XK : ¬IsAlgebraic k (XK k K) := + transcendental_XK k K + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem XK_ne_zero : XK k K ≠ 0 := fun hx0 => + (not_algebraic_XK k K) (hx0 ▸ isAlgebraic_zero) + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- Powers `X_K^j` with `j ≤ r` are `k`-linearly independent. -/ +theorem linearIndependent_fin_pow_XK (r : ℕ) : + LinearIndependent k fun j : Fin (r + 1) => (XK k K) ^ (j : ℕ) := + linearIndependent_fin_pow_of_transcendental (k := k) (L := K) (transcendental_XK k K) r + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- The family `{b i · X_K^j}` is `k`-linearly independent over a `k⟮X⟯`-basis `b`. -/ +theorem linearIndependent_basis_smul_XK_pow {n r : ℕ} + (b : Module.Basis (Fin n) k⟮X⟯ K) : + LinearIndependent k fun p : Fin n × Fin (r + 1) => + (b p.1 : K) * (XK k K) ^ (p.2 : ℕ) := by + rw [Fintype.linearIndependent_iff] + intro g hg + let s : Fin n → k⟮X⟯ := fun i => + ∑ j : Fin (r + 1), g (i, j) • RatFunc.X ^ (j : ℕ) + have hsingle : ∀ i, algebraMap k⟮X⟯ K (s i) * (b i : K) = + ∑ j : Fin (r + 1), g (i, j) • ((b i : K) * (XK k K) ^ (j : ℕ)) := by + intro i + dsimp only [s, XK] + rw [map_sum, Finset.sum_mul] + refine Finset.sum_congr rfl ?_ + intro j _ + simp only [Algebra.smul_def, map_mul, map_pow, mul_assoc, mul_comm (b i : K), + IsScalarTower.algebraMap_apply k k⟮X⟯ K (g (i, j))] + have hcombo : ∑ i : Fin n, algebraMap k⟮X⟯ K (s i) * (b i : K) = 0 := by + rw [Finset.sum_congr rfl fun i _ => hsingle i, ← Finset.sum_product'] + exact hg + have hcombo' : ∑ i : Fin n, s i • (b i : K) = 0 := by + simpa only [Algebra.smul_def] using hcombo + have hs : ∀ i, s i = 0 := + (Fintype.linearIndependent_iff.mp b.linearIndependent) s hcombo' + intro p + have hs' := hs p.1 + have hlin := linearIndependent_fin_pow_of_transcendental (k := k) (L := k⟮X⟯) + RatFunc.transcendental_X r + rw [Fintype.linearIndependent_iff] at hlin + exact hlin (fun j => g (p.1, j)) (by dsimp only [s] at hs'; exact hs') p.2 + +omit [IsFullConstantField k K] in +/-- Growth along the pole family: `n(r+1) ≤ ℓ(C + r•B)`. -/ +theorem ell_family_ge {n r : ℕ} (b : Module.Basis (Fin n) k⟮X⟯ K) : + n * (r + 1) ≤ ell k K (basisPoleBound k K b + r • polarDivisor k K (XK k K)) := by + let C := basisPoleBound k K b + let B := polarDivisor k K (XK k K) + let x := XK k K + have hx0 : x ≠ 0 := XK_ne_zero k K + have hDnn : 0 ≤ C + r • B := add_nonneg (basisPoleBound_nonneg k K b) fun v => + mul_nonneg (Nat.cast_nonneg r) (polarDivisor_nonneg k K x v) + let v : Fin n × Fin (r + 1) → K := fun p => (b p.1 : K) * x ^ (p.2 : ℕ) + have hmem : ∀ p, v p ∈ RRspace k K (C + r • B) := by + intro p + rw [mem_RRspace_iff] + exact memRRspace_basis_smul_x_pow (k := k) (K := K) (f := b) x hx0 r p.1 (p.2 : ℕ) + (Nat.le_of_lt_succ (Fin.is_lt p.2)) + have hlin : LinearIndependent k v := + linearIndependent_basis_smul_XK_pow (k := k) (K := K) b + have hsubset : span k (Set.range v) ≤ RRspace k K (C + r • B) := by + refine span_le.mpr ?_ + rintro _ ⟨p, rfl⟩ + exact hmem p + have hcard : n * (r + 1) ≤ Module.finrank k (span k (Set.range v)) := by + have heq_card := finrank_span_eq_card (R := k) (M := K) hlin + simp [heq_card, Fintype.card_prod, Fintype.card_fin] + have hle : Module.finrank k (span k (Set.range v)) ≤ ell k K (C + r • B) := + Submodule.finrank_mono hsubset + exact Nat.le_trans hcard hle + +/-- Stichtenoth 1.4.11 counting half for the chart variable: `[K : k⟮X⟯] ≤ deg (X_K)_∞`. -/ +theorem finrank_le_deg_polarX : + Module.finrank k⟮X⟯ K ≤ deg k K (polarDivisor k K (XK k K)) := by + let n := Module.finrank k⟮X⟯ K + let b := Module.finBasis k⟮X⟯ K + let C := basisPoleBound k K b + let B := polarDivisor k K (XK k K) + have hx : ¬IsAlgebraic k (XK k K) := not_algebraic_XK k K + have hx0 : XK k K ≠ 0 := XK_ne_zero k K + have hBpos : 0 < deg k K B := polarDivisor_pos k K hx0 hx + have hBnn : 0 ≤ B := polarDivisor_nonneg k K (XK k K) + have hBeff : IsEffective k K B := hBnn + have hdegB0 := deg_nonneg k K hBeff + have hdpos : 0 < (deg k K B).toNat := by + rw [← Int.toNat_of_nonneg hdegB0] at hBpos + exact Int.ofNat_lt.mp hBpos + have hmain : n ≤ (deg k K B).toNat := + le_of_forall_nat_mul_le (d := (deg k K B).toNat) (c := (deg k K C).toNat + 1) hdpos fun r => by + let D := C + r • B + have hDnn : 0 ≤ D := add_nonneg (basisPoleBound_nonneg k K b) fun v => + mul_nonneg (Nat.cast_nonneg r) (hBnn v) + have hDeff : IsEffective k K D := hDnn + have hCeff : IsEffective k K C := basisPoleBound_nonneg k K b + have hell : (ell k K D : ℤ) ≤ deg k K D + 1 := + ell_le_nonneg (k := k) (K := K) hDnn + have hdeg : deg k K D = deg k K C + (r : ℤ) * deg k K B := by + rw [add_comm, ← nsmul_eq_mul, deg_add, deg_nsmul, nsmul_eq_mul, add_comm] + have hell_nat : n * (r + 1) ≤ ell k K D := + ell_family_ge (k := k) (K := K) (n := n) (r := r) b + have hbound : (n * (r + 1) : ℤ) ≤ deg k K D + 1 := + (Nat.cast_le.mpr hell_nat).trans hell + have hC0 := deg_nonneg k K hCeff + have htoC : ((deg k K C).toNat : ℤ) = deg k K C := Int.toNat_of_nonneg hC0 + have htoB : ((deg k K B).toNat : ℤ) = deg k K B := Int.toNat_of_nonneg hdegB0 + have hsum : + deg k K D + 1 = (deg k K B).toNat * r + ((deg k K C).toNat + 1) := by + rw [hdeg, htoC, htoB] + ring + have hnat_z : + (n * (r + 1) : ℤ) ≤ (deg k K B).toNat * r + ((deg k K C).toNat + 1) := by + rw [← hsum] + exact hbound + exact_mod_cast hnat_z + have hdegB := deg_nonneg k K hBeff + rw [← Int.toNat_of_nonneg hdegB] + exact_mod_cast hmain + +end ChartVariable + +section Auxiliary + +/-- The rational function field `k(x) ⊆ K` generated by a transcendental element. -/ +noncomputable def rationalSubfield (x : K) : IntermediateField k K := + IntermediateField.adjoin k {x} + +omit [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- The family `{b i * x^j}` is `k`-linearly independent over a `k(x)`-basis `b`. -/ +theorem linearIndependent_basis_smul_x_pow {n r : ℕ} {x : K} (hx : Transcendental k x) + (b : Module.Basis (Fin n) (rationalSubfield k K x) K) : + LinearIndependent k fun p : Fin n × Fin (r + 1) => + (b p.1 : K) * x ^ (p.2 : ℕ) := by + rw [Fintype.linearIndependent_iff] + intro g hg + let F := rationalSubfield k K x + have hxF : x ∈ F := IntermediateField.mem_adjoin_of_mem k (Set.mem_singleton x) + let s : Fin n → F := fun i => + ∑ j : Fin (r + 1), g (i, j) • ⟨x ^ (j : ℕ), by + convert F.pow_mem hxF (Int.ofNat j) using 1 + exact (zpow_natCast x j).symm⟩ + have hsingle : ∀ i, s i • (b i : K) = + ∑ j : Fin (r + 1), g (i, j) • ((b i : K) * x ^ (j : ℕ)) := by + intro i + simp only [s, Algebra.smul_def, map_sum] + rw [Finset.sum_mul] + congr 1 + ext j + simp [mul_assoc, mul_comm, mul_left_comm] + have hcombo : ∑ i : Fin n, s i • (b i : K) = 0 := by + rw [Finset.sum_congr rfl fun i _ => hsingle i, ← Finset.sum_product'] + exact hg + have hs : ∀ i, s i = 0 := (Fintype.linearIndependent_iff.mp b.linearIndependent) s hcombo + intro p + have hs' := hs p.1 + have hz : ∑ j : Fin (r + 1), g (p.1, j) • x ^ (j : ℕ) = 0 := by + simpa [s] using congrArg Subtype.val hs' + have hlin := linearIndependent_fin_pow_of_transcendental (k := k) (L := K) hx r + rw [Fintype.linearIndependent_iff] at hlin + exact hlin (fun j => g (p.1, j)) hz p.2 + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- The structure map `k[X] → K` is evaluation of polynomials at the chart variable `X_K`. -/ +theorem algebraMap_polynomial_eq_aeval_XK (p : k[X]) : + algebraMap k[X] K p = aeval (XK k K) p := by + have h : IsScalarTower.toAlgHom k k[X] K = aeval (XK k K) := by + refine Polynomial.algHom_ext ?_ + rw [IsScalarTower.toAlgHom_apply, aeval_X, + IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, RatFunc.algebraMap_X] + rfl + calc algebraMap k[X] K p = IsScalarTower.toAlgHom k k[X] K p := rfl + _ = aeval (XK k K) p := by rw [h] + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- The structure map `k⟮X⟯ → K` sends a rational function to the quotient of the +evaluations of its numerator and denominator at `X_K`. -/ +theorem algebraMap_ratFunc_eq_div (c : k⟮X⟯) : + algebraMap k⟮X⟯ K c = aeval (XK k K) c.num / aeval (XK k K) c.denom := by + conv_lhs => rw [← RatFunc.num_div_denom c] + rw [map_div₀, ← IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, + ← IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, + algebraMap_polynomial_eq_aeval_XK, algebraMap_polynomial_eq_aeval_XK] + +omit [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- Coercion of `aeval` at the adjoined generator of `k(X_K)`. -/ +theorem coe_aeval_adjoinSimple_gen_XK (p : k[X]) : + ((aeval (AdjoinSimple.gen k (XK k K)) p : IntermediateField.adjoin k {XK k K}) : K) + = aeval (XK k K) p := by + have hgen : (IntermediateField.adjoin k {XK k K}).val (AdjoinSimple.gen k (XK k K)) = XK k K := + IntermediateField.AdjoinSimple.algebraMap_gen k (XK k K) + calc ((aeval (AdjoinSimple.gen k (XK k K)) p : IntermediateField.adjoin k {XK k K}) : K) + = (IntermediateField.adjoin k {XK k K}).val + (aeval (AdjoinSimple.gen k (XK k K)) p) := rfl + _ = aeval ((IntermediateField.adjoin k {XK k K}).val (AdjoinSimple.gen k (XK k K))) p := + (Polynomial.aeval_algHom_apply _ _ _).symm + _ = aeval (XK k K) p := by rw [hgen] + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +/-- The canonical `k`-embedding `k⟮X⟯ ≃ₐ k(X_K) ⊆ K` agrees with the structure map. -/ +theorem coe_ratFuncAlgEquiv_XK (c : k⟮X⟯) : + ((RatFunc.algEquivOfTranscendental (XK k K) (transcendental_XK k K) c : + IntermediateField.adjoin k {XK k K}) : K) + = algebraMap k⟮X⟯ K c := by + conv_lhs => rw [← RatFunc.num_div_denom c] + rw [map_div₀, RatFunc.algEquivOfTranscendental_algebraMap, + RatFunc.algEquivOfTranscendental_algebraMap, IntermediateField.coe_div, + coe_aeval_adjoinSimple_gen_XK, coe_aeval_adjoinSimple_gen_XK, + algebraMap_ratFunc_eq_div] + +/-! ### Target 2: finrank bridge -/ + +omit [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem finrank_eq_finrank_rationalSubfield_XK : + Module.finrank k⟮X⟯ K = + Module.finrank (rationalSubfield k K (algebraMap k⟮X⟯ K (RatFunc.X : k⟮X⟯))) K := by + refine Algebra.finrank_eq_of_equiv_equiv + (RatFunc.algEquivOfTranscendental (XK k K) (transcendental_XK k K)).toRingEquiv + (RingEquiv.refl K) ?_ + ext c + show algebraMap (IntermediateField.adjoin k {XK k K}) K + (RatFunc.algEquivOfTranscendental (XK k K) (transcendental_XK k K) c) + = algebraMap k⟮X⟯ K c + rw [IntermediateField.algebraMap_apply] + exact coe_ratFuncAlgEquiv_XK k K c + +/-! ### Target 1: finite dimensionality over `k(x)` -/ + +omit [_root_.FunctionField k K] [IsFullConstantField k K] in +/-- Every element of `K` is algebraic over the polynomial subalgebra `k[X_K]`. -/ +theorem isAlgebraic_adjoin_XK (z : K) : + IsAlgebraic (Algebra.adjoin k {XK k K}) z := by + have h1 : IsAlgebraic k⟮X⟯ z := Algebra.IsAlgebraic.isAlgebraic z + have h2 : IsAlgebraic k[X] z := (IsFractionRing.isAlgebraic_iff k[X] k⟮X⟯ K).mpr h1 + obtain ⟨p, hp0, hpz⟩ := h2 + set e := Polynomial.algEquivOfTranscendental k (XK k K) (transcendental_XK k K) with he + have hcomp : ((Algebra.adjoin k {XK k K}).val.comp e.toAlgHom : k[X] →ₐ[k] K) + = IsScalarTower.toAlgHom k k[X] K := by + refine Polynomial.algHom_ext ?_ + rw [AlgHom.comp_apply] + have hex : e.toAlgHom X = e X := rfl + rw [hex, he, Polynomial.algEquivOfTranscendental_apply_X, + IsScalarTower.toAlgHom_apply, IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, + RatFunc.algebraMap_X] + rfl + refine ⟨p.map (e : k[X] →+* Algebra.adjoin k {XK k K}), ?_, ?_⟩ + · exact (Polynomial.map_ne_zero_iff e.injective).mpr hp0 + · rw [aeval_def, Polynomial.eval₂_map] + have hring : ((algebraMap (Algebra.adjoin k {XK k K}) K).comp + (e : k[X] →+* Algebra.adjoin k {XK k K})) = algebraMap k[X] K := by + have := congrArg AlgHom.toRingHom hcomp + exact this + rw [hring, ← aeval_def] + exact hpz + +omit [_root_.FunctionField k K] [IsFullConstantField k K] in +/-- Exchange: if `x` is transcendental over `k`, then `X_K` is algebraic over `k[x]`. -/ +theorem isAlgebraic_adjoin_x_XK {x : K} (hx : Transcendental k x) : + IsAlgebraic (Algebra.adjoin k {x}) (XK k K) := by + have h := IsAlgebraic.adjoin_singleton (R := k) (A := K) (B := K) + (transcendental_XK k K) hx (isAlgebraic_adjoin_XK k K x) + simpa using h + +omit [_root_.FunctionField k K] [IsFullConstantField k K] in +/-- `X_K` is algebraic over the rational subfield `k(x)`. -/ +theorem isAlgebraic_rationalSubfield_XK {x : K} (hx : Transcendental k x) : + IsAlgebraic (rationalSubfield k K x) (XK k K) := by + have hle : Algebra.adjoin k {x} ≤ (rationalSubfield k K x).toSubalgebra := by + refine Algebra.adjoin_le ?_ + intro y hy + rw [Set.mem_singleton_iff] at hy + subst hy + exact IntermediateField.subset_adjoin k {y} rfl + exact (isAlgebraic_adjoin_x_XK k K hx).tower_top_of_subalgebra_le hle + +omit [IsFullConstantField k K] in +/-- A function field is finite over the rational subfield generated by a transcendental element. -/ +theorem finiteDimensional_rationalSubfield {x : K} (hx : Transcendental k x) : + FiniteDimensional (rationalSubfield k K x) K := by + set F := rationalSubfield k K x with hF + set t := XK k K with ht + have htF : IsIntegral F t := (isAlgebraic_rationalSubfield_XK k K hx).isIntegral + haveI hFN : FiniteDimensional F (IntermediateField.adjoin F {t}) := + IntermediateField.adjoin.finiteDimensional htF + set N := IntermediateField.adjoin F {t} with hN + -- every polynomial evaluation at t lies in N + have haev : ∀ p : k[X], aeval t p ∈ N := by + intro p + have h1 : aeval t (p.map (algebraMap k F)) = aeval t p := + Polynomial.aeval_map_algebraMap F t p + rw [← h1] + have h2 : aeval t (p.map (algebraMap k F)) ∈ Algebra.adjoin F ({t} : Set K) := by + rw [Algebra.adjoin_singleton_eq_range_aeval] + exact ⟨p.map (algebraMap k F), rfl⟩ + exact IntermediateField.algebra_adjoin_le_adjoin F {t} h2 + -- the image of k⟮X⟯ inside K lies in N + have hE : ∀ c : k⟮X⟯, algebraMap k⟮X⟯ K c ∈ N := by + intro c + rw [algebraMap_ratFunc_eq_div] + exact div_mem (haev c.num) (haev c.denom) + -- the subalgebra k[t] is contained in N + have hsub : ∀ z : K, z ∈ Algebra.adjoin k ({t} : Set K) → z ∈ N := by + intro z hz + rw [Algebra.adjoin_singleton_eq_range_aeval] at hz + obtain ⟨p, rfl⟩ := hz + exact haev p + -- the inclusion ring hom k[t] →+* N + let χ : Algebra.adjoin k ({t} : Set K) →+* N := + { toFun := fun a => ⟨a.1, hsub a.1 a.2⟩ + map_one' := rfl + map_mul' := fun _ _ => rfl + map_zero' := rfl + map_add' := fun _ _ => rfl } + have hχinj : Function.Injective χ := by + intro a b hab + have h : (a : K) = (b : K) := congrArg (fun z : N => (z : K)) hab + exact Subtype.ext h + -- basis of K over k⟮X⟯ + set b := Module.finBasis k⟮X⟯ K with hb + -- each basis vector is integral over N + have hbN : ∀ i, IsIntegral N (b i) := by + intro i + refine IsAlgebraic.isIntegral ?_ + obtain ⟨p, hp0, hpz⟩ := isAlgebraic_adjoin_XK k K (b i) + refine ⟨p.map χ, (Polynomial.map_ne_zero_iff hχinj).mpr hp0, ?_⟩ + rw [aeval_def, Polynomial.eval₂_map] + have hring : (algebraMap N K).comp χ + = algebraMap (Algebra.adjoin k ({t} : Set K)) K := RingHom.ext fun a => rfl + rw [hring, ← aeval_def] + exact hpz + -- K is generated over N by the basis vectors + have htop : IntermediateField.adjoin N (Set.range ⇑b) = ⊤ := by + rw [eq_top_iff] + rintro z - + have hz := b.sum_repr z + rw [← hz] + refine sum_mem fun i _ => ?_ + rw [Algebra.smul_def] + refine mul_mem ?_ (IntermediateField.subset_adjoin N _ ⟨i, rfl⟩) + have hmem := hE (b.repr z i) + have := IntermediateField.algebraMap_mem (IntermediateField.adjoin N (Set.range ⇑b)) + (⟨algebraMap k⟮X⟯ K (b.repr z i), hmem⟩ : N) + rwa [IntermediateField.algebraMap_apply] at this + haveI hfin : Finite (Set.range ⇑b) := (Set.finite_range ⇑b).to_subtype + haveI hNtop : FiniteDimensional N (IntermediateField.adjoin N (Set.range ⇑b)) := + IntermediateField.finiteDimensional_adjoin fun z hz => by + obtain ⟨i, rfl⟩ := hz + exact hbN i + haveI hNK : FiniteDimensional N K := by + rw [htop] at hNtop + exact (IntermediateField.topEquiv (F := N) (E := K)).toLinearEquiv.finiteDimensional + exact Module.Finite.trans N K + + +/-- Stichtenoth 1.4.11 (≤) for general transcendental `x`. -/ +theorem finrankAdjoin_le_deg_polar {x : K} (hx : ¬IsAlgebraic k x) : + Module.finrank (rationalSubfield k K x) K ≤ deg k K (polarDivisor k K x) := by + have hxT : Transcendental k x := hx + by_cases hx0 : x = 0 + · subst hx0 + exact absurd isAlgebraic_zero hx + haveI := finiteDimensional_rationalSubfield (k := k) (K := K) hxT + let F := rationalSubfield k K x + let n := Module.finrank F K + let b := Module.finBasis F K + let C := basisPoleBound k K b + let B := polarDivisor k K x + have hBpos : 0 < deg k K B := polarDivisor_pos k K hx0 hx + have hBnn : 0 ≤ B := polarDivisor_nonneg k K x + have hBeff : IsEffective k K B := polarDivisor_nonneg k K x + have hdegB0 := deg_nonneg k K hBeff + have hdpos : 0 < (deg k K B).toNat := by + rw [← Int.toNat_of_nonneg hdegB0] at hBpos + exact Int.ofNat_lt.mp hBpos + have hmain : n ≤ (deg k K B).toNat := + le_of_forall_nat_mul_le (d := (deg k K B).toNat) (c := (deg k K C).toNat + 1) hdpos fun r => by + let D := C + r • B + have hDnn : 0 ≤ D := add_nonneg (basisPoleBound_nonneg k K b) fun v => + mul_nonneg (Nat.cast_nonneg r) (hBnn v) + have hDeff : IsEffective k K D := hDnn + have hCeff : IsEffective k K C := basisPoleBound_nonneg k K b + let v : Fin n × Fin (r + 1) → K := fun p => (b p.1 : K) * x ^ (p.2 : ℕ) + have hmem : ∀ p, v p ∈ RRspace k K D := by + intro p + rw [mem_RRspace_iff] + exact memRRspace_basis_smul_x_pow (k := k) (K := K) (f := b) x hx0 r p.1 (p.2 : ℕ) + (Nat.le_of_lt_succ (Fin.is_lt p.2)) + have hlin : LinearIndependent k v := + linearIndependent_basis_smul_x_pow (k := k) (K := K) hxT b + have hsubset : span k (Set.range v) ≤ RRspace k K D := by + refine span_le.mpr ?_ + rintro _ ⟨p, rfl⟩ + exact hmem p + have hcard : + n * (r + 1) ≤ Module.finrank k (span k (Set.range v)) := by + have heq_card := finrank_span_eq_card (R := k) (M := K) hlin + simp [heq_card, Fintype.card_prod, Fintype.card_fin] + have hle : Module.finrank k (span k (Set.range v)) ≤ ell k K D := + Submodule.finrank_mono hsubset + have hell : (ell k K D : ℤ) ≤ deg k K D + 1 := + ell_le_nonneg (k := k) (K := K) hDnn + have hdeg : deg k K D = deg k K C + (r : ℤ) * deg k K B := by + rw [add_comm, ← nsmul_eq_mul, deg_add, deg_nsmul, nsmul_eq_mul, add_comm] + have hell_nat : n * (r + 1) ≤ ell k K D := Nat.le_trans hcard hle + have hbound : (n * (r + 1) : ℤ) ≤ deg k K D + 1 := + (Nat.cast_le.mpr hell_nat).trans hell + have hC0 := deg_nonneg k K hCeff + have htoC : ((deg k K C).toNat : ℤ) = deg k K C := Int.toNat_of_nonneg hC0 + have htoB : ((deg k K B).toNat : ℤ) = deg k K B := Int.toNat_of_nonneg hdegB0 + have hsum : + deg k K D + 1 = (deg k K B).toNat * r + ((deg k K C).toNat + 1) := by + rw [hdeg, htoC, htoB] + ring + have hnat_z : + (n * (r + 1) : ℤ) ≤ (deg k K B).toNat * r + ((deg k K C).toNat + 1) := by + rw [← hsum] + exact hbound + exact_mod_cast hnat_z + have hdegB := deg_nonneg k K hBeff + rw [← Int.toNat_of_nonneg hdegB] + exact_mod_cast hmain + +/-- Coordinate-base specialization via the adjoin bridge. -/ +theorem deg_polar_le_finrank {x : K} (hx : ¬IsAlgebraic k x) + (hxgen : x = algebraMap k⟮X⟯ K (RatFunc.X : k⟮X⟯)) : + Module.finrank k⟮X⟯ K ≤ deg k K (polarDivisor k K x) := by + rw [hxgen] at hx ⊢ + have h := finrankAdjoin_le_deg_polar (k := k) (K := K) hx + have hfin : + Module.finrank k⟮X⟯ K = + Module.finrank (rationalSubfield k K (algebraMap k⟮X⟯ K (RatFunc.X : k⟮X⟯))) K := + finrank_eq_finrank_rationalSubfield_XK k K + exact hfin ▸ h + +end Auxiliary + +end PolarDivisor + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean new file mode 100644 index 0000000000..32345e83fc --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean @@ -0,0 +1,390 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar +public import Mathlib.NumberTheory.RamificationInertia.Basic +public import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas +public import Mathlib.RingTheory.Valuation.Discrete.Basic +public import Mathlib.RingTheory.IntegralClosure.Algebra.Basic +public import Mathlib.Algebra.Group.TypeTags.Basic + +/-! +# Ramification half of Stichtenoth 1.4.11 +This file proves `deg (X_K)_∞ ≤ [K : k(X)]` via the fundamental identity of ramification +index and inertia degree. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero Additive + +open Polynomial BigOperators Submodule IntermediateField Ideal FunctionField + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +variable [IsFullConstantField k K] + +/-- Decidable equality on coordinate places for ramification proofs. -/ +local instance instDecidableEqPlaceARam : DecidableEq (PlaceA k K) := Classical.decEq _ +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncRam : DecidableEq k⟮X⟯ := Classical.decEq _ + +/-- The uniformizer `t = X⁻¹` in `k(X)`. -/ +noncomputable def tRatFunc : k⟮X⟯ := 1 / RatFunc.X + +/-- `t` as an element of the valuation subring at infinity. -/ +noncomputable def tA : inftyValuationSubring k := + ⟨tRatFunc k, by + rw [Valuation.mem_valuationSubring_iff] + dsimp [tRatFunc] + rw [RatFunc.inftyValuation.X_inv k] + exact WithZero.exp_le_exp.mpr (show (-1 : ℤ) ≤ 0 by omega)⟩ + +@[simp] +theorem tRatFunc_coe : (tA k : k⟮X⟯) = tRatFunc k := rfl + +omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem maximalIdeal_infty_eq_span_t : + IsLocalRing.maximalIdeal (inftyValuationSubring k) = + Ideal.span {(tA k : inftyValuationSubring k)} := by + let v := RatFunc.inftyValuation k + have hπval : v (tRatFunc k) = WithZero.exp (-1 : ℤ) := RatFunc.inftyValuation.X_inv k + have hgen : (↑(Valuation.IsRankOneDiscrete.generator v) : WithZero (Multiplicative ℤ)) = + WithZero.exp (-1 : ℤ) := by + have h := Valuation.IsRankOneDiscrete.generator_eq_exp_neg_one_of_mem_range + (v := v) (show WithZero.exp (-1 : ℤ) ∈ Set.range v from ⟨tRatFunc k, hπval⟩) + exact congrArg Units.val h + have hπ : v.IsUniformizer (tA k : k⟮X⟯) := by + rw [Valuation.IsUniformizer.iff, tRatFunc_coe k, hgen] + exact hπval + exact Valuation.IsUniformizer.is_generator hπ + +local notation "inftyRing" => inftyValuationSubring k +local notation "inftyInts" => infiniteIntegers k K +local notation "maxIdealInfty" => IsLocalRing.maximalIdeal (inftyValuationSubring k) + +/-- Ramification index of the infinite place above `k(X)`. -/ +noncomputable def ramIdxInfty (P : Ideal (infiniteIntegers k K)) : ℕ := + Ideal.ramificationIdx' + (IsLocalRing.maximalIdeal (inftyValuationSubring k)) P + +/-- Its image `t_K` in the function field. -/ +noncomputable def tK : K := algebraMap k⟮X⟯ K (tRatFunc k) + +omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem map_maximalIdeal_infty : + Ideal.map (algebraMap inftyRing inftyInts) maxIdealInfty = + Ideal.span {algebraMap inftyRing inftyInts (tA k)} := by + rw [maximalIdeal_infty_eq_span_t k, Ideal.map_span, Set.image_singleton] + +omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem XK_mul_tK : XK k K * tK k K = 1 := by + dsimp only [XK, tK, tRatFunc] + rw [← map_mul (algebraMap k⟮X⟯ K), div_eq_mul_inv, one_mul, + mul_inv_cancel₀ RatFunc.X_ne_zero, map_one] + +omit [Algebra k K] [IsScalarTower k k[X] K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem XK_mem_ringOfIntegers : + ∃ a : ringOfIntegers k K, (a : K) = XK k K := by + have hx : (algebraMap k[X] K (Polynomial.X : k[X])) ∈ ringOfIntegers k K := + (mem_integralClosure_iff (R := k[X]) (A := K)).2 + (isIntegral_algebraMap (x := (Polynomial.X : k[X]))) + refine ⟨⟨algebraMap k[X] K (Polynomial.X : k[X]), hx⟩, ?_⟩ + dsimp [XK] + rw [IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, RatFunc.algebraMap_X] + +omit [Algebra k K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem ringOfIntegers_coe_ne_zero {a : ringOfIntegers k K} (ha : a ≠ 0) : (a : K) ≠ 0 := + fun h => ha ((Subtype.ext_iff).mpr h) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem principalDivisorA_nonneg_at_finite_of_mem_ringOfIntegers {a : ringOfIntegers k K} + (ha : a ≠ 0) (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + 0 ≤ principalDivisorA k K + (Additive.ofMul (Units.mk0 (a : K) (ringOfIntegers_coe_ne_zero k K ha))) (Sum.inl w) := by + rw [principalDivisorA_apply_finite, FractionalIdeal.principalDivisor_apply] + have hle := w.valuation_le_one (K := K) a + have hval := FractionalIdeal.valuation_eq_exp_neg_count (R := ringOfIntegers k K) (K := K) w + (Units.mk0 (a : K) (ringOfIntegers_coe_ne_zero k K ha)) + have hcount : + FractionalIdeal.principalDivisor (R := ringOfIntegers k K) (K := K) + (Additive.ofMul (Units.mk0 (a : K) (ringOfIntegers_coe_ne_zero k K ha))) w = + FractionalIdeal.count K w + (FractionalIdeal.spanSingleton (ringOfIntegers k K)⁰ + (Units.mk0 (a : K) (ringOfIntegers_coe_ne_zero k K ha))) := by + rfl + have hnonneg : + 0 ≤ FractionalIdeal.count K w + (FractionalIdeal.spanSingleton (ringOfIntegers k K)⁰ + (Units.mk0 (a : K) (ringOfIntegers_coe_ne_zero k K ha))) := by + let count := + FractionalIdeal.count K w + (FractionalIdeal.spanSingleton (ringOfIntegers k K)⁰ + (Units.mk0 (a : K) (ringOfIntegers_coe_ne_zero k K ha))) + have hle' : -count ≤ 0 := + WithZero.exp_le_exp.mp (by rw [← hval, WithZero.exp_zero]; exact hle) + exact neg_nonpos.mp hle' + simpa [hcount] using hnonneg + +omit [IsFullConstantField k K] in +theorem polarDivisor_XK_zero_at_finite + (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + polarDivisor k K (XK k K) (Sum.inl w) = 0 := by + have hx0 : XK k K ≠ 0 := XK_ne_zero k K + obtain ⟨a, ha⟩ := XK_mem_ringOfIntegers k K + have ha0 : a ≠ 0 := fun ha0 => hx0 (by simpa [ha] using congrArg Subtype.val ha0) + have hprincipal : + 0 ≤ principalDivisorA k K (Additive.ofMul (Units.mk0 (XK k K) hx0)) (Sum.inl w) := by + simpa [ha] using + principalDivisorA_nonneg_at_finite_of_mem_ringOfIntegers (k := k) (K := K) ha0 w + unfold polarDivisor + simp only [dif_neg hx0, Finsupp.sup_apply] + exact max_eq_right (neg_nonpos.mpr hprincipal) + +omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [_root_.FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] in +theorem tK_ne_zero : tK k K ≠ 0 := by + dsimp [tK, tRatFunc] + intro h + rw [← map_zero (algebraMap k⟮X⟯ K)] at h + exact one_div_ne_zero RatFunc.X_ne_zero <| + (RingHom.injective (algebraMap k⟮X⟯ K)).eq_iff.mp h + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +theorem principalDivisorA_tK_at_infinite + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + principalDivisorA k K (Additive.ofMul (Units.mk0 (tK k K) (tK_ne_zero k K))) (Sum.inr v) = + (ramIdxInfty k K v.asIdeal : ℤ) := by + rw [principalDivisorA_apply_infinite] + let A := inftyValuationSubring k + let S := infiniteIntegers k K + let tS : S := algebraMap A S (tA k) + have htK : tK k K = algebraMap A K (tA k) := by + dsimp [tK, tA, tRatFunc] + rfl + have hspan : + FractionalIdeal.spanSingleton S⁰ (tK k K) = + (Ideal.span {tS} : FractionalIdeal S⁰ K) := by + rw [htK, IsScalarTower.algebraMap_apply A S K, ← FractionalIdeal.coeIdeal_span_singleton] + have htS : tS ≠ 0 := by + intro h + have hz : tK k K = 0 := by + dsimp [tS] at h + rw [htK, IsScalarTower.algebraMap_apply A S K, h, map_zero] + exact tK_ne_zero k K hz + let p := IsLocalRing.maximalIdeal A + have hinj := ValuationSubring.integralClosure_algebraMap_injective + (v := RatFunc.inftyValuation k) (L := K) + have hpne : p ≠ ⊥ := + Ring.ne_bot_of_isMaximal_of_not_isField (IsLocalRing.maximalIdeal.isMaximal A) + (IsDiscreteValuationRing.not_isField A) + have hmap : Ideal.map (algebraMap A S) p ≠ ⊥ := by + rintro hbot + exact hpne ((Ideal.map_eq_bot_iff_of_injective hinj).mp hbot) + have hcount : + FractionalIdeal.principalDivisor (R := S) (K := K) + (Additive.ofMul (Units.mk0 (tK k K) (tK_ne_zero k K))) v = + (UniqueFactorizationMonoid.normalizedFactors (Ideal.map (algebraMap A S) p)).count + v.asIdeal := by + rw [FractionalIdeal.principalDivisor_apply, toMul_ofMul, Units.val_mk0, hspan, + FractionalIdeal.count_coe (K := K) v (Ideal.span_singleton_eq_bot.not.mpr htS), + ← map_maximalIdeal_infty k] + rw [Ideal.count_associates_factors_eq hmap v.isPrime v.ne_bot] + rw [hcount, ← IsDedekindDomain.ramificationIdx'_eq_normalizedFactors_count hmap v.isPrime + v.ne_bot, ramIdxInfty] + +omit [IsFullConstantField k K] in +theorem principalDivisorA_XK_at_infinite + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + principalDivisorA k K (Additive.ofMul (Units.mk0 (XK k K) (XK_ne_zero k K))) (Sum.inr v) = + -(ramIdxInfty k K v.asIdeal : ℤ) := by + have hx0 : XK k K ≠ 0 := XK_ne_zero k K + have ht0 : tK k K ≠ 0 := tK_ne_zero k K + let hunit : Kˣ := Units.mk0 (XK k K * tK k K) (by rw [XK_mul_tK k K]; exact one_ne_zero) + have hmul : hunit = Units.mk0 (XK k K) hx0 * Units.mk0 (tK k K) ht0 := by + apply Units.ext + simp [hunit, Units.val_mul, Units.val_mk0, XK_mul_tK k K] + have hprod : + principalDivisorA k K (Additive.ofMul hunit) = + principalDivisorA k K (Additive.ofMul (Units.mk0 (XK k K) hx0)) + + principalDivisorA k K (Additive.ofMul (Units.mk0 (tK k K) ht0)) := by + rw [show Additive.ofMul hunit = + Additive.ofMul (Units.mk0 (XK k K) hx0 * Units.mk0 (tK k K) ht0) from congr_arg _ hmul, + ofMul_mul, (principalDivisorA k K).map_add] + have hone : principalDivisorA k K (Additive.ofMul hunit) = 0 := by + ext w + simp only [Finsupp.zero_apply] + have hv := placeValuation_eq_exp_neg_principalDivisor k K (Additive.ofMul hunit) w + have hval' : placeValuation k K w ↑(Additive.toMul (Additive.ofMul hunit)) = 1 := by + rw [toMul_ofMul, show (↑hunit : K) = 1 by simp [hunit, XK_mul_tK k K]] + rcases w with w | w <;> simp [placeValuation] + have hexp : + WithZero.exp (-((principalDivisorA k K) (Additive.ofMul hunit)) w) = WithZero.exp 0 := + (hv.symm.trans hval').trans WithZero.exp_zero.symm + exact neg_eq_zero.mp (WithZero.exp_injective hexp) + have hzero : + principalDivisorA k K (Additive.ofMul (Units.mk0 (XK k K) hx0)) (Sum.inr v) + + principalDivisorA k K (Additive.ofMul (Units.mk0 (tK k K) ht0)) (Sum.inr v) = 0 := by + have := congrArg (fun D => D (Sum.inr v)) hone + rwa [hprod] at this + rw [principalDivisorA_tK_at_infinite k K v] at hzero + linarith + +omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [IsFullConstantField k K] in +theorem ramificationIdx_pos_over_infty + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + 0 < ramIdxInfty k K v.asIdeal := by + let A := inftyValuationSubring k + let p := IsLocalRing.maximalIdeal A + have hpne : p ≠ ⊥ := + Ring.ne_bot_of_isMaximal_of_not_isField (IsLocalRing.maximalIdeal.isMaximal A) + (IsDiscreteValuationRing.not_isField A) + have hPp : v.asIdeal.LiesOver p := ⟨(IsLocalRing.eq_maximalIdeal inferInstance).symm⟩ + exact Nat.cast_pos.mpr <| + Nat.pos_iff_ne_zero.mpr <| + IsDedekindDomain.ramificationIdx'_ne_zero_of_liesOver (S := infiniteIntegers k K) + v.asIdeal hpne + +omit [IsFullConstantField k K] in +theorem polarDivisor_XK_at_infinite + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + polarDivisor k K (XK k K) (Sum.inr v) = ramIdxInfty k K v.asIdeal := by + have hx0 : XK k K ≠ 0 := XK_ne_zero k K + have hprincipal := principalDivisorA_XK_at_infinite (k := k) (K := K) v + have hpos : 0 < (ramIdxInfty k K v.asIdeal : ℤ) := + Nat.cast_pos.mpr (ramificationIdx_pos_over_infty (k := k) (K := K) v) + have hneg : + (-principalDivisorA k K (Additive.ofMul (Units.mk0 (XK k K) hx0))) (Sum.inr v) = + (ramIdxInfty k K v.asIdeal : ℤ) := by + simpa using congrArg Neg.neg hprincipal + unfold polarDivisor + simp only [dif_neg hx0, Finsupp.sup_apply, hneg] + exact max_eq_left (le_of_lt hpos) + +/-- The height-one ideal above `∞` corresponding to an infinite place. -/ +noncomputable def inftyIdealOfPlace (v : PlaceA k K) : Ideal (infiniteIntegers k K) := + match v with + | Sum.inr w => w.asIdeal + | Sum.inl _ => ⊥ + +omit [IsFullConstantField k K] in +theorem deg_polarDivisor_XK_eq_primesOverFinset_sum : + deg k K (polarDivisor k K (XK k K)) = + ∑ P ∈ IsDedekindDomain.primesOverFinset + (IsLocalRing.maximalIdeal (inftyValuationSubring k)) (infiniteIntegers k K), + (ramIdxInfty k K P : ℤ) * + (Ideal.inertiaDeg' + (IsLocalRing.maximalIdeal (inftyValuationSubring k)) P : ℤ) := by + classical + rw [deg, Finsupp.sum] + let A := inftyValuationSubring k + let S := infiniteIntegers k K + let p := IsLocalRing.maximalIdeal A + let D := polarDivisor k K (XK k K) + have hp : p ≠ ⊥ := + Ring.ne_bot_of_isMaximal_of_not_isField (IsLocalRing.maximalIdeal.isMaximal A) + (IsDiscreteValuationRing.not_isField A) + let pred : PlaceA k K → Prop := fun v => match v with | Sum.inr _ => true | _ => false + let g : PlaceA k K → ℤ := fun v => (D v : ℤ) * (placeDegree k K v : ℤ) + have hsum_filter : + D.support.sum g = + (D.support.filter pred).sum g := + Eq.symm <| + Finset.sum_subset (Finset.filter_subset pred D.support) fun v hv hv' => by + rcases v with v | v + · rw [polarDivisor_XK_zero_at_finite, zero_mul] + · exfalso + simp only [Finset.mem_filter, pred] at hv' + exact hv' ⟨hv, by simp⟩ + rw [hsum_filter] + apply Finset.sum_bij (fun v _ => inftyIdealOfPlace (k := k) (K := K) v) + · intro v hv + simp only [Finset.mem_filter, pred] at hv + obtain ⟨_, hright⟩ := hv + rcases v with v | w + · cases hright + · rw [IsDedekindDomain.mem_primesOverFinset_iff hp] + have hpw : p = w.asIdeal.under A := + (IsLocalRing.eq_maximalIdeal (Ideal.IsMaximal.under A w.asIdeal)).symm + exact ⟨w.isPrime, ⟨hpw⟩⟩ + · intro v₁ hv₁ v₂ hv₂ h + simp only [Finset.mem_filter, pred] at hv₁ hv₂ ⊢ + match v₁ with + | Sum.inl _ => simp at hv₁ + | Sum.inr w₁ => + match v₂ with + | Sum.inl _ => simp at hv₂ + | Sum.inr w₂ => + simp only [inftyIdealOfPlace] at h + exact congrArg Sum.inr (IsDedekindDomain.HeightOneSpectrum.ext h) + · intro P hP + have hmem := (IsDedekindDomain.mem_primesOverFinset_iff hp (P := P)).mp hP + have hprime : P.IsPrime := hmem.1 + have hbot : P ≠ ⊥ := Ideal.ne_bot_of_mem_primesOver hp hmem + let w : IsDedekindDomain.HeightOneSpectrum S := ⟨P, hprime, hbot⟩ + refine ⟨Sum.inr w, ?_, rfl⟩ + · simp only [Finset.mem_filter, pred, Finsupp.mem_support_iff] + refine And.intro ?_ (by simp) + rw [polarDivisor_XK_at_infinite] + norm_cast + exact (ramificationIdx_pos_over_infty k K w).ne' + · intro v hv + simp only [Finset.mem_filter, pred, inftyIdealOfPlace] at hv ⊢ + rcases v with v | v + · simp at hv + · have hpw : v.asIdeal.under A = p := + IsLocalRing.eq_maximalIdeal (Ideal.IsMaximal.under A v.asIdeal) + letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + letI : p.IsMaximal := by + rw [← hpw] + exact Ideal.IsMaximal.under A v.asIdeal + letI : v.asIdeal.LiesOver p := ⟨hpw.symm⟩ + have hinertia : + Ideal.inertiaDeg' p v.asIdeal = v.asIdeal.inertiaDeg A := + Ideal.inertiaDeg'_eq_inertiaDeg (p := p) (q := v.asIdeal) + rw [polarDivisor_XK_at_infinite k K v, ramIdxInfty, + placeDegree_infinite_eq_inertiaDeg, ← hinertia] + +omit [IsFullConstantField k K] in +/-- Stichtenoth 1.4.11 ramification half for the chart variable: `deg (X_K)_∞ ≤ [K : k(X)]`. -/ +theorem deg_polarX_le_finrank : + deg k K (polarDivisor k K (XK k K)) ≤ Module.finrank k⟮X⟯ K := by + rw [deg_polarDivisor_XK_eq_primesOverFinset_sum k K] + let A := inftyValuationSubring k + let S := infiniteIntegers k K + let p := IsLocalRing.maximalIdeal A + have hp : p ≠ ⊥ := + Ring.ne_bot_of_isMaximal_of_not_isField (IsLocalRing.maximalIdeal.isMaximal A) + (IsDiscreteValuationRing.not_isField A) + letI : p.IsMaximal := IsLocalRing.maximalIdeal.isMaximal A + have hsum := Ideal.sum_ramification_inertia (R := A) (S := S) (K := k⟮X⟯) (L := K) hp + have heq : + (∑ P ∈ IsDedekindDomain.primesOverFinset p S, + (ramIdxInfty k K P : ℤ) * (Ideal.inertiaDeg' p P : ℤ)) = + Module.finrank k⟮X⟯ K := by + dsimp [ramIdxInfty] + norm_cast + exact le_of_eq heq + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean b/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean new file mode 100644 index 0000000000..fd20b9430c --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean @@ -0,0 +1,229 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Basic +public import Mathlib.Algebra.Algebra.Operations +public import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas +public import Mathlib.RingTheory.Finiteness.Subalgebra +public import Mathlib.RingTheory.IntegralClosure.Algebra.Basic + +/-! +# A linear Cauchy–Davenport bound over a full constant field + +This file proves the specialization of the Hou–Leung–Xiang linear Kneser theorem needed for +Clifford's theorem. If every element of `K` algebraic over `k` is constant, then nonzero finite +dimensional `k`-subspaces `A, B ⊆ K` satisfy + +`finrank A + finrank B ≤ finrank (A * B) + 1`. + +The proof is the Dyson e-transform induction from Hou–Leung–Xiang. The full-constant-field +hypothesis makes the stabilizer-field step direct and avoids a separate finite/infinite base-field +split. +-/ + +@[expose] public section + +open scoped Pointwise + +namespace FunctionField + +variable (k K : Type*) [Field k] [Field K] [Algebra k K] + [IsFullConstantField k K] + +/-- If a finite-dimensional subspace `A` containing `1` has dimension bigger than one, some +nonzero `e ∈ B` makes the Dyson intersection `A ∩ B e⁻¹` proper. -/ +theorem exists_dyson_step (A B : Submodule k K) + [FiniteDimensional k A] [FiniteDimensional k B] + (hA1 : (1 : K) ∈ A) (hB1 : (1 : K) ∈ B) (hAdim : 1 < Module.finrank k A) : + ∃ e : K, e ∈ B ∧ e ≠ 0 ∧ + A ⊓ Submodule.comap (LinearMap.mulRight k e) B ≠ A := by + by_contra! h + have hstable : ∀ a ∈ A, ∀ b ∈ B, a * b ∈ B := by + intro a ha b hb + by_cases hb0 : b = 0 + · subst b + simp + · have heq := h b hb hb0 + have hamem : a ∈ A ⊓ Submodule.comap (LinearMap.mulRight k b) B := heq.symm ▸ ha + exact hamem.2 + have hBne : B ≠ ⊥ := by + rw [Submodule.ne_bot_iff] + exact ⟨1, hB1, one_ne_zero⟩ + have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top + have hAle : A ≤ (1 : Submodule k K) := by + intro a ha + have haint : IsIntegral k a := isIntegral_of_smul_mem_submodule B hBne hBfg a (by + intro b hb + simpa only [smul_eq_mul] using hstable a ha b hb) + obtain ⟨c, hc⟩ := IsFullConstantField.algebraic_mem (k := k) (K := K) a haint.isAlgebraic + rw [Submodule.one_eq_span, Submodule.mem_span_singleton] + refine ⟨c, ?_⟩ + simpa only [Algebra.smul_def, mul_one] using hc.symm + have hAeq : A = 1 := le_antisymm hAle (Submodule.one_le.mpr hA1) + have hdim : Module.finrank k A = 1 := by + rw [hAeq, Submodule.one_eq_span, finrank_span_singleton one_ne_zero] + omega + +/-- One Dyson e-transform preserves the sum of dimensions, strictly decreases the first +subspace, and does not enlarge the product space. -/ +theorem dyson_step (A B : Submodule k K) + [FiniteDimensional k A] [FiniteDimensional k B] + (hA1 : (1 : K) ∈ A) (hB1 : (1 : K) ∈ B) (hAdim : 1 < Module.finrank k A) : + ∃ A' B' : Submodule k K, + (1 : K) ∈ A' ∧ (1 : K) ∈ B' ∧ A' < A ∧ + A'.FG ∧ B'.FG ∧ + Module.finrank k A' + Module.finrank k B' = + Module.finrank k A + Module.finrank k B ∧ A' * B' ≤ A * B := by + obtain ⟨e, heB, he0, hproper⟩ := exists_dyson_step k K A B hA1 hB1 hAdim + let u : Kˣ := Units.mk0 e he0 + let ε : K ≃ₗ[k] K := u.mulRightLinearEquiv k + let A' := A ⊓ Submodule.comap (ε : K →ₗ[k] K) B + let B' := Submodule.map (ε : K →ₗ[k] K) A ⊔ B + refine ⟨A', B', ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · refine ⟨hA1, ?_⟩ + change ε 1 ∈ B + simpa [ε, u] using heB + · exact (show B ≤ Submodule.map (ε : K →ₗ[k] K) A ⊔ B from le_sup_right) hB1 + · exact lt_of_le_of_ne inf_le_left hproper + · exact (Submodule.fg_top A').mp Module.Finite.fg_top + · have hAfg : A.FG := (Submodule.fg_top A).mp Module.Finite.fg_top + have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top + exact (hAfg.map (ε : K →ₗ[k] K)).sup hBfg + · have hmapA' : Submodule.map (ε : K →ₗ[k] K) A' = + Submodule.map (ε : K →ₗ[k] K) A ⊓ B := by + ext x + simp only [A', Submodule.mem_map_equiv, Submodule.mem_inf, Submodule.mem_comap, + LinearEquiv.coe_coe] + rw [ε.apply_symm_apply] + have hfinA' : Module.finrank k A' = + Module.finrank k ↑(Submodule.map (ε : K →ₗ[k] K) A ⊓ B) := by + rw [← hmapA', LinearEquiv.finrank_map_eq] + have hdim := Submodule.finrank_sup_add_finrank_inf_eq + (Submodule.map (ε : K →ₗ[k] K) A) B + have hfinA := LinearEquiv.finrank_map_eq ε A + have hdim' : Module.finrank k B' + + Module.finrank k ↑(Submodule.map (ε : K →ₗ[k] K) A ⊓ B) = + Module.finrank k ↑(Submodule.map (ε : K →ₗ[k] K) A) + + Module.finrank k B := by + simpa only [B'] using hdim + omega + · dsimp only [B'] + rw [Submodule.mul_sup] + apply sup_le + · apply Submodule.mul_le.mpr + intro a ha b hb + rw [Submodule.mem_map] at hb + obtain ⟨b₀, hb₀, rfl⟩ := hb + have hae : a * e ∈ B := ha.2 + have hmem := Submodule.mul_mem_mul hb₀ hae + change a * ε b₀ ∈ A * B + rw [show a * ε b₀ = b₀ * (a * e) by simp [ε, u]; ring] + exact hmem + · apply Submodule.mul_le.mpr + intro a ha b hb + change a ∈ A ⊓ Submodule.comap (ε : K →ₗ[k] K) B at ha + exact Submodule.mul_mem_mul ha.1 hb + +/-- The normalized linear Cauchy–Davenport bound, for subspaces containing `1`. -/ +theorem normalized_mul_finrank (A B : Submodule k K) + [FiniteDimensional k A] [FiniteDimensional k B] + (hA1 : (1 : K) ∈ A) (hB1 : (1 : K) ∈ B) : + Module.finrank k A + Module.finrank k B ≤ Module.finrank k (A * B) + 1 := by + generalize hn : Module.finrank k A = n + induction n using Nat.strong_induction_on generalizing A B with + | h n ih => + have hnpos : 0 < n := by + rw [← hn, Module.finrank_pos_iff] + exact ⟨⟨1, hA1⟩, 0, by simp⟩ + by_cases hn1 : n = 1 + · have hAeq : A = 1 := by + have hle : (1 : Submodule k K) ≤ A := Submodule.one_le.mpr hA1 + exact (Submodule.eq_of_le_of_finrank_eq hle (by + rw [Submodule.one_eq_span, finrank_span_singleton one_ne_zero, hn, hn1])).symm + subst A + rw [hn1] + change 1 + Module.finrank k B ≤ + Module.finrank k ↑((1 : Submodule k K) • B) + 1 + rw [Submodule.one_smul] + omega + · have hngt : 1 < n := by omega + have hAdim : 1 < Module.finrank k A := hn.symm ▸ hngt + obtain ⟨A', B', hA'1, hB'1, hA'lt, hA'fg, hB'fg, hdim, hprod⟩ := + dyson_step k K A B hA1 hB1 hAdim + letI : FiniteDimensional k A' := Module.Finite.of_fg hA'fg + letI : FiniteDimensional k B' := Module.Finite.of_fg hB'fg + have hsmall : Module.finrank k A' < n := by + rw [← hn] + exact Submodule.finrank_lt_finrank_of_lt hA'lt + have hih := ih (Module.finrank k A') hsmall A' B' hA'1 hB'1 rfl + have hAfg : A.FG := (Submodule.fg_top A).mp Module.Finite.fg_top + have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top + letI : FiniteDimensional k (A * B) := Module.Finite.of_fg (hAfg.mul hBfg) + have hmono : Module.finrank k (A' * B') ≤ Module.finrank k (A * B) := + Submodule.finrank_mono hprod + omega + +/-- **Linear Cauchy–Davenport over a full constant field.** Nonzero finite-dimensional +subspaces of `K` have product dimension at least the sum of their dimensions minus one. -/ +theorem mul_finrank (A B : Submodule k K) + [FiniteDimensional k A] [FiniteDimensional k B] + (hA : A ≠ ⊥) (hB : B ≠ ⊥) : + Module.finrank k A + Module.finrank k B ≤ Module.finrank k (A * B) + 1 := by + rw [Submodule.ne_bot_iff] at hA hB + obtain ⟨a, haA, ha0⟩ := hA + obtain ⟨b, hbB, hb0⟩ := hB + let ua : Kˣ := Units.mk0 a ha0 + let ub : Kˣ := Units.mk0 b hb0 + let εa : K ≃ₗ[k] K := (ua⁻¹).mulLeftLinearEquiv k K + let εb : K ≃ₗ[k] K := (ub⁻¹).mulLeftLinearEquiv k K + let εab : K ≃ₗ[k] K := (ua * ub).mulLeftLinearEquiv k K + let A' := Submodule.map (εa : K →ₗ[k] K) A + let B' := Submodule.map (εb : K →ₗ[k] K) B + have hA'1 : (1 : K) ∈ A' := by + apply Submodule.mem_map.mpr + refine ⟨a, haA, ?_⟩ + change ((ua⁻¹ : Kˣ) : K) * a = 1 + exact inv_mul_cancel₀ ha0 + have hB'1 : (1 : K) ∈ B' := by + apply Submodule.mem_map.mpr + refine ⟨b, hbB, ?_⟩ + change ((ub⁻¹ : Kˣ) : K) * b = 1 + exact inv_mul_cancel₀ hb0 + have hAfin : A'.FG := by + have hAfg : A.FG := (Submodule.fg_top A).mp Module.Finite.fg_top + exact hAfg.map (εa : K →ₗ[k] K) + have hBfin : B'.FG := by + have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top + exact hBfg.map (εb : K →ₗ[k] K) + letI : FiniteDimensional k A' := Module.Finite.of_fg hAfin + letI : FiniteDimensional k B' := Module.Finite.of_fg hBfin + have hnorm := normalized_mul_finrank k K A' B' hA'1 hB'1 + have hprod : A' * B' ≤ Submodule.comap (εab : K →ₗ[k] K) (A * B) := by + apply Submodule.mul_le.mpr + intro x hx y hy + obtain ⟨x₀, hx₀, rfl⟩ := Submodule.mem_map.mp hx + obtain ⟨y₀, hy₀, rfl⟩ := Submodule.mem_map.mp hy + change ((ua * ub : Kˣ) : K) * + ((((ua⁻¹ : Kˣ) : K) * x₀) * (((ub⁻¹ : Kˣ) : K) * y₀)) ∈ A * B + have hm := Submodule.mul_mem_mul hx₀ hy₀ + simpa [mul_assoc, mul_left_comm, mul_comm] using hm + have hmap : Submodule.map (εab : K →ₗ[k] K) (A' * B') ≤ A * B := + (Submodule.map_le_iff_le_comap).mpr hprod + have hAfg : A.FG := (Submodule.fg_top A).mp Module.Finite.fg_top + have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top + letI : FiniteDimensional k (A * B) := Module.Finite.of_fg (hAfg.mul hBfg) + have hmono : Module.finrank k (A' * B') ≤ Module.finrank k (A * B) := by + rw [← LinearEquiv.finrank_map_eq εab (A' * B')] + exact Submodule.finrank_mono hmap + have hfinA : Module.finrank k A' = Module.finrank k A := by + exact LinearEquiv.finrank_map_eq εa A + have hfinB : Module.finrank k B' = Module.finrank k B := by + exact LinearEquiv.finrank_map_eq εb B + omega + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean b/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean new file mode 100644 index 0000000000..13628c2d49 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean @@ -0,0 +1,105 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Basic +public import Mathlib.RingTheory.DedekindDomain.AdicValuation +public import Mathlib.RingTheory.LocalRing.ResidueField.Ideal +public import Mathlib.RingTheory.Localization.Basic + +/-! Local residue maps for height-one primes of Dedekind domains. -/ + +@[expose] public section + +open scoped nonZeroDivisors WithZero + +noncomputable section + +open IsDedekindDomain + +namespace IsDedekindDomain.HeightOneSpectrum + +variable {R K : Type*} [CommRing R] [IsDedekindDomain R] [Field K] + [Algebra R K] [IsFractionRing R K] + +/-- The residue map from the valuation ring at a height-one prime. -/ +noncomputable def residueHom (v : HeightOneSpectrum R) : + valuationSubringAtPrime K v →+* v.asIdeal.ResidueField := + IsLocalization.lift (S := valuationSubringAtPrime K v) + (g := algebraMap R v.asIdeal.ResidueField) + fun y : v.asIdeal.primeCompl => isUnit_iff_ne_zero.mpr <| by + rw [ne_eq, Ideal.algebraMap_residueField_eq_zero] + exact Ideal.mem_primeCompl_iff.mp y.property + +/-- An element has zero residue exactly when its valuation is strictly less than one. -/ +theorem residueHom_eq_zero_iff (v : HeightOneSpectrum R) + (z : valuationSubringAtPrime K v) : + residueHom (K := K) v z = 0 ↔ v.valuation K (z : K) < 1 := by + obtain ⟨n, d, hnd⟩ := IsLocalization.exists_mk'_eq v.asIdeal.primeCompl z + rw [← hnd, residueHom, IsLocalization.lift_mk'] + simp only [mul_eq_zero, Units.ne_zero, or_false] + rw [Ideal.algebraMap_residueField_eq_zero] + rw [← valuation_lt_one_iff_mem (K := K) v] + rw [show (↑(IsLocalization.mk' (valuationSubringAtPrime K v) n d) : K) = + algebraMap R K n / algebraMap R K d by + have hd0 : (d : R) ≠ 0 := by + intro hd + exact (Ideal.mem_primeCompl_iff.mp d.property) (hd ▸ v.asIdeal.zero_mem) + have hdK : algebraMap R K (d : R) ≠ 0 := by + simpa using (FaithfulSMul.algebraMap_injective R K).ne hd0 + apply (eq_div_iff hdK).2 + have h := congrArg (fun y : valuationSubringAtPrime K v => (y : K)) + (IsLocalization.mk'_spec (valuationSubringAtPrime K v) n d) + change (↑(IsLocalization.mk' (valuationSubringAtPrime K v) n d) : K) * + algebraMap R K d = algebraMap R K n at h + exact h] + rw [(v.valuation K).map_div] + have hvd : v.valuation K (algebraMap R K d) = 1 := + (valuation_eq_one_iff_notMem (K := K) (v := v)).2 + (Ideal.mem_primeCompl_iff.mp d.property) + rw [hvd, div_one] + +/-- The localization at a height-one prime is algebra-equivalent to its valuation subring. -/ +noncomputable def localizationAlgEquiv (v : HeightOneSpectrum R) : + Localization.AtPrime v.asIdeal ≃ₐ[R] valuationSubringAtPrime K v := + IsLocalization.algEquiv v.asIdeal.primeCompl (Localization.AtPrime v.asIdeal) + (valuationSubringAtPrime K v) + +/-- `residueHom` on a localized fraction agrees with the quotient map. -/ +theorem residueHom_mk' (v : HeightOneSpectrum R) (n : R) (d : v.asIdeal.primeCompl) : + residueHom (K := K) v (IsLocalization.mk' (valuationSubringAtPrime K v) n d) = + algebraMap R v.asIdeal.ResidueField n * + (algebraMap R v.asIdeal.ResidueField (d : R))⁻¹ := by + dsimp [residueHom] + simp [IsLocalization.lift_mk', IsUnit.coe_liftRight] + +/-- `residueHom` on a localized fraction agrees with the residue map on `AtPrime`. -/ +theorem residueHom_mk'_residue (v : HeightOneSpectrum R) (n : R) (d : v.asIdeal.primeCompl) : + residueHom (K := K) v (IsLocalization.mk' (valuationSubringAtPrime K v) n d) = + IsLocalRing.residue (Localization.AtPrime v.asIdeal) + (IsLocalization.mk' (Localization.AtPrime v.asIdeal) n d) := by + have hd0 : algebraMap R v.asIdeal.ResidueField (d : R) ≠ 0 := + Ideal.algebraMap_residueField_eq_zero.not.mpr (Ideal.mem_primeCompl_iff.mp d.property) + have hdunit : IsUnit (algebraMap R v.asIdeal.ResidueField (d : R)) := + isUnit_iff_ne_zero.mpr hd0 + rw [residueHom_mk', IsLocalRing.residue_def] + have h := congrArg (IsLocalRing.residue (Localization.AtPrime v.asIdeal)) + (IsLocalization.mk'_spec (S := Localization.AtPrime v.asIdeal) n d) + simp only [map_mul, IsLocalRing.residue_def] at h + field_simp [hdunit] at h ⊢ + exact h.symm + +/-- `residueHom` agrees with the residue map on the localization model. -/ +theorem residueHom_apply_localizationAlgEquiv (v : HeightOneSpectrum R) + (x : Localization.AtPrime v.asIdeal) : + residueHom (K := K) v (localizationAlgEquiv (K := K) v x) = + IsLocalRing.residue (Localization.AtPrime v.asIdeal) x := by + obtain ⟨n, d, hx⟩ := IsLocalization.exists_mk'_eq v.asIdeal.primeCompl x + rw [← hx] + simp [localizationAlgEquiv, residueHom_mk'_residue] + +end IsDedekindDomain.HeightOneSpectrum diff --git a/LeanPool/MarkoffModP/RiemannRoch/Place.lean b/LeanPool/MarkoffModP/RiemannRoch/Place.lean new file mode 100644 index 0000000000..984a388e44 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/Place.lean @@ -0,0 +1,630 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm +public import Mathlib.NumberTheory.FunctionField +public import Mathlib.RingTheory.Jacobson.Ring +public import Mathlib.RingTheory.LocalRing.ResidueField.Basic +public import Mathlib.RingTheory.Valuation.AlgebraInstances +public import Mathlib.RingTheory.Valuation.Discrete.Basic +public import Mathlib.RingTheory.Valuation.Discrete.RankOne +public import Mathlib.RingTheory.Valuation.IsTrivialOn +public import Mathlib.GroupTheory.ArchimedeanDensely + +/-! +# Coordinate places of a function field + +This file gives the coordinate presentation of the places of a finite separable extension of +`k(X)`. Finite places are the height-one primes of the integral closure of `k[X]`; infinite +places are the height-one primes of the integral closure of the valuation subring at infinity. + +## Main definitions + +* `FunctionField.inftyValuationSubring`: the valuation subring at infinity of `k(X)`. +* `FunctionField.infiniteIntegers`: its integral closure in a function field `K`. +* `FunctionField.PlaceA`: the sum of the finite and infinite height-one spectra. +* `FunctionField.placeValuation`: the valuation of a coordinate place. +* `FunctionField.DivisorA`: divisors in the coordinate presentation. +* `FunctionField.principalDivisorA`: the principal divisor on both coordinate charts. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FractionalIdeal + +variable {R K : Type*} [CommRing R] [IsDedekindDomain R] [Field K] + [Algebra R K] [IsFractionRing R K] + +/-- The multiplicative adic valuation of a nonzero element is the exponential of the negative +coefficient of its principal fractional ideal. -/ +theorem valuation_eq_exp_neg_count (v : IsDedekindDomain.HeightOneSpectrum R) (x : Kˣ) : + v.valuation K (x : K) = + WithZero.exp (-count K v (spanSingleton R⁰ (x : K))) := by + let n : R := Classical.choose (IsLocalization.exists_mk'_eq R⁰ (x : K)) + let d : R⁰ := Classical.choose + (Classical.choose_spec (IsLocalization.exists_mk'_eq R⁰ (x : K))) + have hx : IsLocalization.mk' K n d = (x : K) := + Classical.choose_spec + (Classical.choose_spec (IsLocalization.exists_mk'_eq R⁰ (x : K))) + have hn : n ≠ 0 := by + intro hn + rw [hn, IsLocalization.mk'_zero] at hx + exact x.ne_zero hx.symm + have hI : spanSingleton R⁰ (x : K) = + spanSingleton R⁰ (algebraMap R K (d : R))⁻¹ * + (Ideal.span {n} : Ideal R) := by + rw [← hx, IsFractionRing.mk'_eq_div, div_eq_mul_inv, + coeIdeal_span_singleton, spanSingleton_mul_spanSingleton, mul_comm] + conv_lhs => + rw [← hx, v.valuation_of_mk', v.intValuation_if_neg hn, + v.intValuation_if_neg (nonZeroDivisors.ne_zero d.property)] + rw [count_well_defined K v (spanSingleton_ne_zero_iff.mpr x.ne_zero) hI, + ← WithZero.exp_sub] + congr 1 + ring + +end FractionalIdeal + +namespace RatFunc + +variable {k : Type*} [Field k] + +/-- A rational function regular at infinity has a unique constant residue: after subtracting +the ratio of the leading coefficients of its numerator and denominator, its degree at infinity +is strictly negative (unless the difference is zero). -/ +theorem exists_sub_C_intDegree_neg (z : k⟮X⟯) (hzdeg : z.intDegree ≤ 0) : + ∃ c : k, z - C c = 0 ∨ (z - C c).intDegree < 0 := by + by_cases hz : z = 0 + · exact ⟨0, by simp [hz]⟩ + by_cases hneg : z.intDegree < 0 + · exact ⟨0, Or.inr (by simpa using hneg)⟩ + have hzdeg0 : z.intDegree = 0 := by omega + let c : k := z.num.leadingCoeff / z.denom.leadingCoeff + let p : k[X] := z.num - Polynomial.C c * z.denom + have hrepr : z - C c = + algebraMap k[X] k⟮X⟯ p / algebraMap k[X] k⟮X⟯ z.denom := by + conv_lhs => lhs; rw [← z.num_div_denom] + rw [← RatFunc.algebraMap_C] + simp only [p, map_sub, map_mul] + apply (eq_div_iff (RatFunc.algebraMap_ne_zero z.denom_ne_zero)).2 + rw [sub_mul, div_mul_cancel₀ _ (RatFunc.algebraMap_ne_zero z.denom_ne_zero)] + by_cases hp : p = 0 + · exact ⟨c, Or.inl (by rw [hrepr, hp, map_zero, zero_div])⟩ + refine ⟨c, Or.inr ?_⟩ + have hnumdeg : z.num.natDegree = z.denom.natDegree := by + simp only [RatFunc.intDegree] at hzdeg0 + omega + have hnum0 : z.num ≠ 0 := RatFunc.num_ne_zero hz + have hden0 : z.denom ≠ 0 := z.denom_ne_zero + have hlcnum : z.num.leadingCoeff ≠ 0 := Polynomial.leadingCoeff_ne_zero.mpr hnum0 + have hlcden : z.denom.leadingCoeff ≠ 0 := Polynomial.leadingCoeff_ne_zero.mpr hden0 + have hc : c ≠ 0 := div_ne_zero hlcnum hlcden + have hCmul0 : Polynomial.C c * z.denom ≠ 0 := + mul_ne_zero (Polynomial.C_ne_zero.mpr hc) hden0 + have hdegree : z.num.degree = (Polynomial.C c * z.denom).degree := by + rw [Polynomial.degree_eq_natDegree hnum0, Polynomial.degree_mul, + Polynomial.degree_C hc, zero_add, Polynomial.degree_eq_natDegree hden0, hnumdeg] + have hlc : z.num.leadingCoeff = + (Polynomial.C c * z.denom).leadingCoeff := by + rw [Polynomial.leadingCoeff_mul, Polynomial.leadingCoeff_C] + dsimp only [c] + field_simp + have hpdeg : p.degree < z.num.degree := by + simpa only [p] using Polynomial.degree_sub_lt hdegree hnum0 hlc + have hpnat : p.natDegree < z.denom.natDegree := by + rw [Polynomial.natDegree_lt_iff_degree_lt hp] + rw [← hnumdeg] + simpa [Polynomial.degree_eq_natDegree hnum0] using hpdeg + rw [hrepr, RatFunc.intDegree_div] + · simp only [RatFunc.intDegree_polynomial] + omega + · exact RatFunc.algebraMap_ne_zero hp + · exact RatFunc.algebraMap_ne_zero hden0 + +end RatFunc + +namespace FunctionField + +variable (k K : Type*) [Field k] [Field K] + +open MonoidWithZeroHom + +/-- The ordered multiplicative group with zero `ℤᵐ⁰` has no nontrivial ordered monoid +automorphisms. -/ +private noncomputable def withZeroMulIntLogAddEquiv + (e : ℤᵐ⁰ ≃*o ℤᵐ⁰) : ℤ ≃+ ℤ := by + let f : ℤ →+ ℤ := + { toFun := fun z => WithZero.log (e (WithZero.exp z)) + map_zero' := by simp + map_add' := by + intro x y + rw [WithZero.exp_add, map_mul] + rw [WithZero.log_mul] + · simp + · simp } + refine AddEquiv.ofBijective f ?_ + constructor + · intro x y h + apply WithZero.exp_injective + apply e.injective + simpa [f] using congrArg WithZero.exp h + · intro y + refine ⟨WithZero.log (e.symm (WithZero.exp y)), ?_⟩ + dsimp [f] + rw [WithZero.exp_log] + · simp + · simp + +/-- A normalized discrete rank-one value group has a unique order-preserving normalization. -/ +theorem orderMonoidIso_withZeroMulInt_eq_refl (e : ℤᵐ⁰ ≃*o ℤᵐ⁰) : + e = OrderMonoidIso.refl ℤᵐ⁰ := by + have hmono : Monotone (withZeroMulIntLogAddEquiv e) := by + intro x y hxy + dsimp [withZeroMulIntLogAddEquiv] + change WithZero.log (e (WithZero.exp x)) ≤ + WithZero.log (e (WithZero.exp y)) + apply WithZero.exp_le_exp.mp + rw [WithZero.exp_log, WithZero.exp_log] + · exact e.toOrderIso.monotone (WithZero.exp_le_exp.mpr hxy) + · simp + · simp + rcases Int.addEquiv_eq_refl_or_neg (withZeroMulIntLogAddEquiv e) with h | h + · ext x + by_cases hx : x = 0 + · simp [hx] + · rw [← WithZero.exp_log hx] + apply WithZero.exp_injective + have ht := congrArg WithZero.exp + (DFunLike.congr_fun h (WithZero.log x)) + simpa [withZeroMulIntLogAddEquiv] using ht + · have hle := hmono (show (0 : ℤ) ≤ 1 by omega) + rw [h] at hle + norm_num at hle + +/-- Any two order-preserving normalizations of the same value group are equal. -/ +theorem orderMonoidIso_withZeroMulInt_unique {G : Type*} + [LinearOrderedCommGroupWithZero G] (e f : G ≃*o ℤᵐ⁰) : e = f := by + have h := orderMonoidIso_withZeroMulInt_eq_refl (e.symm.trans f) + ext x + have hx := DFunLike.congr_fun h (e x) + simpa using hx.symm + +/-- A coordinate-free place of `K/k`: a nontrivial valuation subring of `K` containing the +constant field, together with the proposition that its value group admits the discrete rank-one +normalization. The normalization is stored only through `Nonempty`, so a place is determined by +its valuation subring rather than by a choice of uniformizer. -/ +structure Place [Algebra k K] where + /-- The valuation subring underlying the place. -/ + toValuationSubring : ValuationSubring K + /-- A place is nontrivial. -/ + ne_top : toValuationSubring ≠ ⊤ + /-- Constants are integral at every place. -/ + triv_on_k : ∀ c : k, algebraMap k K c ∈ toValuationSubring + /-- The value group is discrete of rank one, expressed without choosing a normalization. -/ + isDiscrete : Nonempty + (ValueGroup₀ (.ofClass toValuationSubring.valuation) ≃*o ℤᵐ⁰) + +namespace Place + +variable {k K : Type*} [Field k] [Field K] [Algebra k K] + +/-- Two places are equal when their valuation subrings are equal. -/ +@[ext] +theorem ext {v w : Place k K} + (h : v.toValuationSubring = w.toValuationSubring) : v = w := by + cases v + cases w + cases h + rfl + +/-- Places inherit the membership coercion of their valuation subrings. -/ +instance : SetLike (Place k K) K where + coe v := v.toValuationSubring + coe_injective := by + intro v w h + exact ext (SetLike.coe_injective h) + +@[simp] +theorem mem_toValuationSubring (v : Place k K) (x : K) : + x ∈ v.toValuationSubring ↔ x ∈ v := Iff.rfl + +/-- A normalization of the value group of a coordinate-free place. -/ +noncomputable def normalization (v : Place k K) : + ValueGroup₀ (.ofClass v.toValuationSubring.valuation) ≃*o ℤᵐ⁰ := + Classical.choice v.isDiscrete + +/-- The normalized `ℤᵐ⁰`-valued valuation associated to a coordinate-free place. -/ +noncomputable def valuation (v : Place k K) : Valuation K ℤᵐ⁰ := + v.toValuationSubring.valuation.restrict.map + v.normalization.toMonoidWithZeroHom v.normalization.toOrderIso.monotone + +/-- The normalized valuation is equivalent to the canonical valuation of the valuation +subring. -/ +theorem valuation_isEquiv_canonical (v : Place k K) : + v.valuation.IsEquiv v.toValuationSubring.valuation := by + exact (Valuation.isEquiv_map_self_of_strictMono + v.normalization.toMonoidWithZeroHom v.normalization.strictMono).trans + v.toValuationSubring.valuation.isEquiv_restrict.symm + +/-- Recovering the valuation subring from the normalized valuation gives the original place. -/ +@[simp] +theorem valuationSubring_valuation (v : Place k K) : + v.valuation.valuationSubring = v.toValuationSubring := by + exact (Valuation.isEquiv_iff_valuationSubring _ _).mp + v.valuation_isEquiv_canonical |>.trans + v.toValuationSubring.valuationSubring_valuation + +/-- The normalized valuation of a place is trivial on the constant field. -/ +instance valuation_isTrivialOn (v : Place k K) : v.valuation.IsTrivialOn k where + eq_one c hc := by + let w := v.toValuationSubring.valuation + have hc_le : w (algebraMap k K c) ≤ 1 := by + rw [v.toValuationSubring.valuation_le_one_iff] + exact v.triv_on_k c + have hc_inv_le : w (algebraMap k K c⁻¹) ≤ 1 := by + rw [v.toValuationSubring.valuation_le_one_iff] + exact v.triv_on_k c⁻¹ + have hmap_ne : w (algebraMap k K c) ≠ 0 := by simp [hc] + have hmap_pos : 0 < w (algebraMap k K c) := zero_lt_iff.mpr hmap_ne + have hinv_le : (w (algebraMap k K c))⁻¹ ≤ 1 := by + simpa only [map_inv₀, map_inv] using hc_inv_le + have hw : w (algebraMap k K c) = 1 := + le_antisymm hc_le ((inv_le_one₀ hmap_pos).1 hinv_le) + exact v.valuation_isEquiv_canonical.eq_one_iff_eq_one.mpr hw + +/-- The normalized valuation of a place is nontrivial. -/ +instance valuation_isNontrivial (v : Place k K) : v.valuation.IsNontrivial := by + have hcanonical : v.toValuationSubring.valuation.IsNontrivial := by + by_contra h + exact v.ne_top (v.toValuationSubring.eq_top_iff.mpr h) + exact Valuation.isNontrivial_of_isEquiv + v.valuation_isEquiv_canonical.symm hcanonical + +/-- The valuation ring itself, viewed as a `k`-algebra. -/ +instance algebraValuationSubring (v : Place k K) : Algebra k v.toValuationSubring := + (algebraMap k K).codRestrict v.toValuationSubring (fun c ↦ v.triv_on_k c) |>.toAlgebra + +/-- The residue field of a coordinate-free place. -/ +abbrev residueField (v : Place k K) := + IsLocalRing.ResidueField v.toValuationSubring + +/-- The intrinsic degree of a place is the dimension of its residue field over `k`. -/ +noncomputable def degree (v : Place k K) : ℕ := + Module.finrank k v.residueField + +end Place + +-- Coordinate-chart infrastructure; the intrinsic API is `FunctionField.Place`. +namespace Chart + +/-- The classical decidable equality used to define the valuation at infinity. -/ +local instance instDecidableEqRatFuncRiemannRoch : DecidableEq k⟮X⟯ := Classical.decEq _ + +/-- The valuation subring at infinity of the rational function field `k(X)`. -/ +abbrev inftyValuationSubring := (RatFunc.inftyValuation k).valuationSubring + +namespace inftyValuationSubring + +instance : IsDedekindDomain (inftyValuationSubring k) := by infer_instance + +instance : Algebra k (inftyValuationSubring k) := + (RatFunc.C.codRestrict (inftyValuationSubring k) fun c => by + rw [Valuation.mem_valuationSubring_iff] + by_cases hc : c = 0 + · simp [hc] + · exact (RatFunc.inftyValuation.C k hc).le).toAlgebra + +local notation "ᵐ∞" => IsLocalRing.maximalIdeal (inftyValuationSubring k) + +/-- The residue field at infinity. -/ +local instance : Field (inftyValuationSubring k ⧸ ᵐ∞) := Ideal.Quotient.field ᵐ∞ + +/-- The residue map at infinity is onto the constant field. -/ +theorem residue_algebraMap_surjective : + Function.Surjective (algebraMap k (inftyValuationSubring k ⧸ ᵐ∞)) := by + intro q + obtain ⟨a, rfl⟩ := Ideal.Quotient.mk_surjective q + let z : k⟮X⟯ := (a : k⟮X⟯) + have hzdeg : z.intDegree ≤ 0 := by + by_cases hz : z = 0 + · simp [hz] + have ha := a.property + rw [Valuation.mem_valuationSubring_iff] at ha + change RatFunc.inftyValuation k z ≤ 1 at ha + have hv : RatFunc.inftyValuation k z = WithZero.exp z.intDegree := + RatFunc.inftyValuation_of_nonzero k hz + rw [hv] at ha + exact WithZero.exp_le_exp.mp (by simpa only [WithZero.exp_zero] using ha) + obtain ⟨c, hc | hc⟩ := RatFunc.exists_sub_C_intDegree_neg z hzdeg + · refine ⟨c, ?_⟩ + apply (Ideal.Quotient.mk_eq_mk_iff_sub_mem _ _).2 + have hzero : algebraMap k (inftyValuationSubring k) c - a = 0 := by + apply Subtype.ext + change RatFunc.C c - z = 0 + rw [show RatFunc.C c - z = -(z - RatFunc.C c) by ring, hc, neg_zero] + rw [hzero] + exact ᵐ∞.zero_mem + · refine ⟨c, ?_⟩ + apply (Ideal.Quotient.mk_eq_mk_iff_sub_mem _ _).2 + have hne : z - RatFunc.C c ≠ 0 := by + intro h + rw [h, RatFunc.intDegree_zero] at hc + omega + have hpos : a - algebraMap k (inftyValuationSubring k) c ∈ ᵐ∞ := by + rw [Valuation.mem_maximalIdeal_iff] + change RatFunc.inftyValuation k (z - RatFunc.C c) < 1 + have hv : RatFunc.inftyValuation k (z - RatFunc.C c) = + WithZero.exp (z - RatFunc.C c).intDegree := + RatFunc.inftyValuation_of_nonzero k hne + rw [hv] + exact WithZero.exp_lt_exp.mpr hc + simpa only [neg_sub] using ᵐ∞.neg_mem hpos + +/-- The residue field of the valuation ring at infinity is canonically the constant field. -/ +noncomputable def residueAlgEquiv : + k ≃ₐ[k] (inftyValuationSubring k ⧸ ᵐ∞) := + AlgEquiv.ofBijective (Algebra.ofId k (inftyValuationSubring k ⧸ ᵐ∞)) + ⟨(Algebra.ofId k (inftyValuationSubring k ⧸ ᵐ∞)).injective, + residue_algebraMap_surjective k⟩ + +instance finiteDimensionalResidueField : + FiniteDimensional k (inftyValuationSubring k ⧸ ᵐ∞) := + (residueAlgEquiv k).toLinearEquiv.finiteDimensional + +@[simp] +theorem finrank_residueField : + Module.finrank k (inftyValuationSubring k ⧸ ᵐ∞) = 1 := by + rw [← (residueAlgEquiv k).toLinearEquiv.finrank_eq] + exact Module.finrank_self k + +end inftyValuationSubring + +variable [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- The integral closure in `K` of the valuation subring at infinity of `k(X)`. -/ +abbrev infiniteIntegers := integralClosure (inftyValuationSubring k) K + +namespace infiniteIntegers + +instance isTorsionFreeOverInfinityRing : + Module.IsTorsionFree (inftyValuationSubring k) (infiniteIntegers k K) := + IsIntegralClosure.isTorsionFree (inftyValuationSubring k) K + +instance : IsFractionRing (infiniteIntegers k K) K := + IsIntegralClosure.isFractionRing_of_finite_extension + (inftyValuationSubring k) k⟮X⟯ K (infiniteIntegers k K) + +instance : IsDedekindDomain (infiniteIntegers k K) := + integralClosure.isDedekindDomain (inftyValuationSubring k) k⟮X⟯ K + +instance : Module.Finite (inftyValuationSubring k) (infiniteIntegers k K) := + IsIntegralClosure.finite (inftyValuationSubring k) k⟮X⟯ K (infiniteIntegers k K) + +instance : Algebra k (infiniteIntegers k K) := + ((algebraMap (inftyValuationSubring k) (infiniteIntegers k K)).comp + (algebraMap k (inftyValuationSubring k))).toAlgebra + +instance : IsScalarTower k (inftyValuationSubring k) (infiniteIntegers k K) := + IsScalarTower.of_algebraMap_eq (R := k) (S := inftyValuationSubring k) + (A := infiniteIntegers k K) fun _ => rfl + +end infiniteIntegers + +namespace ringOfIntegers + +instance isTorsionFreeOverPolynomial : + Module.IsTorsionFree k[X] (ringOfIntegers k K) := by + letI : FaithfulSMul k[X] K := + (faithfulSMul_iff_algebraMap_injective k[X] K).2 + (FunctionField.algebraMap_injective k K) + exact IsIntegralClosure.isTorsionFree k[X] K + +instance algebraOverConstants : Algebra k (ringOfIntegers k K) := + ((algebraMap k[X] (ringOfIntegers k K)).comp (algebraMap k k[X])).toAlgebra + +instance isScalarTowerConstants : IsScalarTower k k[X] (ringOfIntegers k K) := + IsScalarTower.of_algebraMap_eq fun _ => rfl + +instance finiteTypeOverConstants : Algebra.FiniteType k (ringOfIntegers k K) := + Algebra.FiniteType.trans (S := k[X]) inferInstance inferInstance + +instance moduleFiniteOverPolynomial : Module.Finite k[X] (ringOfIntegers k K) := + IsIntegralClosure.finite k[X] k⟮X⟯ K (ringOfIntegers k K) + +end ringOfIntegers + +/-- Coordinate places of `K`: finite places on the `k[X]` chart and places above infinity. -/ +abbrev PlaceA := + IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K) ⊕ + IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K) + +/-- The discrete valuation associated to a coordinate place. -/ +def placeValuation : PlaceA k K → Valuation K ℤᵐ⁰ + | Sum.inl v => v.valuation K + | Sum.inr v => v.valuation K + +/-- Divisors on `K` in the two-chart coordinate presentation. -/ +abbrev DivisorA := PlaceA k K →₀ ℤ + +namespace PlaceA + +/-- The residue field at a finite coordinate place is finite-dimensional over the constant +field. -/ +instance finiteDimensionalResidueFieldFinite + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + FiniteDimensional k (ringOfIntegers k K ⧸ v.asIdeal) := by + letI : Field (ringOfIntegers k K ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + exact finite_of_finite_type_of_isJacobsonRing k _ + +/-- The residue field at an infinite coordinate place is finite-dimensional over the constant +field. -/ +instance finiteDimensionalResidueFieldInfinite + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + FiniteDimensional k (infiniteIntegers k K ⧸ v.asIdeal) := by + let A := inftyValuationSubring k + let S := infiniteIntegers k K + let p : Ideal A := v.asIdeal.under A + letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + letI : p.IsMaximal := Ideal.IsMaximal.under A v.asIdeal + letI : v.asIdeal.LiesOver p := ⟨rfl⟩ + letI : Field (A ⧸ p) := Ideal.Quotient.field p + letI : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + letI : Algebra (A ⧸ p) (S ⧸ v.asIdeal) := + Ideal.Quotient.algebraQuotientOfLEComap (Ideal.over_def v.asIdeal p).ge + have hp : p = IsLocalRing.maximalIdeal A := IsLocalRing.eq_maximalIdeal inferInstance + letI : FiniteDimensional k (A ⧸ p) := by + rw [hp] + exact inftyValuationSubring.finiteDimensionalResidueField k + letI : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := by + have hfin := Ideal.inertiaDeg'_pos p v.asIdeal + rw [Ideal.inertiaDeg'_algebraMap] at hfin + exact FiniteDimensional.of_finrank_pos hfin + letI : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := + IsScalarTower.of_algebraMap_eq fun _ => rfl + exact FiniteDimensional.trans k (A ⧸ p) (S ⧸ v.asIdeal) + +/-- The degree of a finite coordinate place over the constant field. -/ +noncomputable def finiteDegree + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : ℕ := + Module.finrank k (ringOfIntegers k K ⧸ v.asIdeal) + +end PlaceA + +/-- The principal divisor of a nonzero function, combining its finite and infinite parts. -/ +noncomputable def principalDivisorA : Additive Kˣ →+ DivisorA k K := + (Finsupp.mapDomain.addMonoidHom Sum.inl).comp + (FractionalIdeal.principalDivisor (R := ringOfIntegers k K) (K := K)) + + (Finsupp.mapDomain.addMonoidHom Sum.inr).comp + (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K)) + +@[simp] +theorem principalDivisorA_apply_finite (x : Additive Kˣ) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + principalDivisorA k K x (Sum.inl v) = + FractionalIdeal.principalDivisor (R := ringOfIntegers k K) (K := K) x v := by + simp only [principalDivisorA, AddMonoidHom.add_apply, AddMonoidHom.coe_comp, + Function.comp_apply] + change Finsupp.mapDomain Sum.inl + (FractionalIdeal.principalDivisor (R := ringOfIntegers k K) (K := K) x) (Sum.inl v) + + Finsupp.mapDomain Sum.inr + (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x) + (Sum.inl v) = _ + rw [Finsupp.mapDomain_apply Sum.inl_injective] + rw [Finsupp.mapDomain_notin_range] + · simp + · rintro ⟨w, h⟩ + cases h + +@[simp] +theorem principalDivisorA_apply_infinite (x : Additive Kˣ) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + principalDivisorA k K x (Sum.inr v) = + FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x v := by + simp only [principalDivisorA, AddMonoidHom.add_apply, AddMonoidHom.coe_comp, + Function.comp_apply] + change Finsupp.mapDomain Sum.inl + (FractionalIdeal.principalDivisor (R := ringOfIntegers k K) (K := K) x) (Sum.inr v) + + Finsupp.mapDomain Sum.inr + (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x) + (Sum.inr v) = _ + rw [Finsupp.mapDomain_apply Sum.inr_injective] + rw [Finsupp.mapDomain_notin_range] + · simp + · rintro ⟨w, h⟩ + cases h + +/-- A principal-divisor coefficient is the negative logarithm of the corresponding valuation. -/ +theorem placeValuation_eq_exp_neg_principalDivisor (x : Additive Kˣ) (v : PlaceA k K) : + placeValuation k K v (x.toMul : K) = + WithZero.exp (-(principalDivisorA k K x v)) := by + rcases v with v | v + · rw [principalDivisorA_apply_finite, FractionalIdeal.principalDivisor_apply] + exact FractionalIdeal.valuation_eq_exp_neg_count v x.toMul + · rw [principalDivisorA_apply_infinite, FractionalIdeal.principalDivisor_apply] + exact FractionalIdeal.valuation_eq_exp_neg_count v x.toMul + +section ConstantField + +variable [Algebra k K] [IsScalarTower k k[X] K] + +instance ringOfIntegers.isScalarTowerConstantsFractions : + IsScalarTower k (ringOfIntegers k K) K := + IsScalarTower.of_algebraMap_eq fun c => by + rw [IsScalarTower.algebraMap_apply k k[X] K, + IsScalarTower.algebraMap_apply k[X] (ringOfIntegers k K) K, + ← IsScalarTower.algebraMap_apply k k[X] (ringOfIntegers k K)] + +instance infiniteIntegers.isScalarTowerConstantsFractions : + IsScalarTower k (infiniteIntegers k K) K := + IsScalarTower.of_algebraMap_eq fun c => by + have h₁ : algebraMap k (infiniteIntegers k K) c = + algebraMap (inftyValuationSubring k) (infiniteIntegers k K) + (algebraMap k (inftyValuationSubring k) c) := rfl + have h₂ : algebraMap (inftyValuationSubring k) k⟮X⟯ + (algebraMap k (inftyValuationSubring k) c) = RatFunc.C c := rfl + rw [h₁, ← IsScalarTower.algebraMap_apply (inftyValuationSubring k) (infiniteIntegers k K) K, + IsScalarTower.algebraMap_apply (inftyValuationSubring k) k⟮X⟯ K, h₂, + IsScalarTower.algebraMap_apply k k[X] K, + IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, Polynomial.algebraMap_eq, + RatFunc.algebraMap_C] + +/-- Constants have valuation at most one at every coordinate place. -/ +theorem placeValuation_algebraMap_le_one (v : PlaceA k K) (c : k) : + placeValuation k K v (algebraMap k K c) ≤ 1 := by + obtain w | w := v + · show w.valuation K (algebraMap k K c) ≤ 1 + rw [IsScalarTower.algebraMap_apply k (ringOfIntegers k K) K] + exact w.valuation_le_one _ + · show w.valuation K (algebraMap k K c) ≤ 1 + rw [IsScalarTower.algebraMap_apply k (infiniteIntegers k K) K] + exact w.valuation_le_one _ + +/-- A nonzero constant has trivial valuation at every coordinate place. -/ +theorem placeValuation_algebraMap_eq_one (v : PlaceA k K) (c : kˣ) : + placeValuation k K v (algebraMap k K (c : k)) = 1 := by + have hc_le := placeValuation_algebraMap_le_one k K v (c : k) + have hc_inv_le := placeValuation_algebraMap_le_one k K v ((c⁻¹ : kˣ) : k) + have hmap_ne : placeValuation k K v (algebraMap k K (c : k)) ≠ 0 := by + rw [map_ne_zero] + exact (map_ne_zero (algebraMap k K)).2 c.ne_zero + have hmap_pos : 0 < placeValuation k K v (algebraMap k K (c : k)) := + WithZero.pos_iff_ne_zero.2 hmap_ne + have hinv_le : (placeValuation k K v (algebraMap k K (c : k)))⁻¹ ≤ 1 := by + simpa using hc_inv_le + exact le_antisymm hc_le ((inv_le_one₀ hmap_pos).1 hinv_le) + +/-- Multiplying by a nonzero constant does not change a principal divisor. -/ +@[simp] +theorem principalDivisorA_algebraMap (c : kˣ) : + principalDivisorA k K + (Additive.ofMul (Units.map (algebraMap k K) c)) = 0 := by + ext v + simp only [Finsupp.zero_apply] + have hv := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul (Units.map (algebraMap k K) c)) v + change placeValuation k K v (algebraMap k K (c : k)) = _ at hv + rw [placeValuation_algebraMap_eq_one k K v c] at hv + have hexp : WithZero.exp (0 : ℤ) = + WithZero.exp + (-(principalDivisorA k K + (Additive.ofMul (Units.map (algebraMap k K) c)) v)) := by + simpa using hv + exact neg_eq_zero.mp (WithZero.exp_injective hexp.symm) + +end ConstantField + +end Chart + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean b/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean new file mode 100644 index 0000000000..23a052e2ce --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean @@ -0,0 +1,467 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Place +import Mathlib.NumberTheory.RatFunc.Ostrowski +import Mathlib.NumberTheory.RamificationInertia.Valuation +import Mathlib.RingTheory.Valuation.Discrete.RankOne +import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing +import Mathlib.RingTheory.Valuation.LocalSubring + +/-! +# Coordinate-free places and the two-chart presentation + +This file proves that the intrinsic valuation-subring places of a one-dimensional function field +are equivalent to the finite/infinite two-chart presentation. The proof restricts a place to +`k(X)`, applies Ostrowski's theorem, and recovers the unique height-one centre in the appropriate +integral closure. + +## Main definitions + +* `FunctionField.Place.ofChart`: regard a coordinate place as an intrinsic place. +* `FunctionField.Place.toChart`: recover a coordinate chart from an intrinsic place. +* `FunctionField.chartToPlace`: the equivalence between the two presentations. +* `FunctionField.placeValuation_isEquiv`: compatibility of normalized valuations. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField + +open MonoidWithZeroHom +open Chart + +variable (k K : Type*) [Field k] [Field K] + [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] + [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- Classical decidable equality for the rational function field used by Ostrowski. -/ +local instance instDecidableEqRatFuncPlaceEquiv : DecidableEq k⟮X⟯ := Classical.decEq _ + +/-- A coordinate place, regarded as an intrinsic valuation subring. -/ +noncomputable def Place.ofChart (w : PlaceA k K) : Place k K := by + let q := placeValuation k K w + let V := q.valuationSubring + have hqdisc : q.IsRankOneDiscrete := by + rcases w with w | w <;> dsimp [q, placeValuation] <;> infer_instance + have hqnontrivial : q.IsNontrivial := by + rcases w with w | w <;> dsimp [q, placeValuation] <;> infer_instance + refine + { toValuationSubring := V + ne_top := by + change q.valuationSubring ≠ ⊤ + intro htop + exact (Valuation.valuationSubring_eq_top_iff q).mp htop hqnontrivial + triv_on_k := fun c => by + rw [Valuation.mem_valuationSubring_iff] + exact placeValuation_algebraMap_le_one k K w c + isDiscrete := ?_ } + letI : q.IsRankOneDiscrete := hqdisc + let h := Valuation.isEquiv_valuation_valuationSubring q + exact ⟨h.orderMonoidIso.symm.trans + (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q)⟩ + +@[simp] +theorem Place.ofChart_toValuationSubring (w : PlaceA k K) : + (Place.ofChart k K w).toValuationSubring = + (placeValuation k K w).valuationSubring := rfl + +theorem Place.ofChart_valuation_isEquiv (w : PlaceA k K) : + (placeValuation k K w).IsEquiv (Place.ofChart k K w).valuation := by + rw [Valuation.isEquiv_iff_valuationSubring, + Place.valuationSubring_valuation, Place.ofChart_toValuationSubring] + +/-- The normalized intrinsic valuation attached to a coordinate place is exactly its coordinate +valuation. This strengthens equivalence by using uniqueness of the ordered `ℤᵐ⁰` +normalization. -/ +theorem Place.ofChart_valuation_eq (w : PlaceA k K) : + (Place.ofChart k K w).valuation = placeValuation k K w := by + let q := placeValuation k K w + let V := q.valuationSubring + have hqdisc : q.IsRankOneDiscrete := by + rcases w with w | w <;> dsimp [q, placeValuation] <;> infer_instance + letI : q.IsRankOneDiscrete := hqdisc + let h := Valuation.isEquiv_valuation_valuationSubring q + let e : ValueGroup₀ (.ofClass V.valuation) ≃*o ℤᵐ⁰ := + h.orderMonoidIso.symm.trans + (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q) + have hnorm : (Place.ofChart k K w).normalization = e := + orderMonoidIso_withZeroMulInt_unique _ _ + ext x + change (Place.ofChart k K w).normalization + (V.valuation.restrict x) = q x + rw [hnorm] + change (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q) + (h.orderMonoidIso.symm (V.valuation.restrict x)) = q x + rw [show h.orderMonoidIso.symm (V.valuation.restrict x) = q.restrict x by + change h.orderMonoidIso.symm + (q.valuationSubring.valuation.restrict x) = q.restrict x + exact h.orderMonoidIso.symm_apply_eq.mpr (h.orderMonoidIso_spec x).symm] + exact Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt_restrict_apply_of_surjective + (by + rcases w with w | w + · exact w.valuation_surjective K + · exact w.valuation_surjective K) x + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem Place.finite_X_le_one + (w : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + w.valuation K (algebraMap k⟮X⟯ K RatFunc.X) ≤ 1 := by + let r : ringOfIntegers k K := algebraMap k[X] (ringOfIntegers k K) Polynomial.X + have hr := w.valuation_le_one (K := K) r + have hr_eq : (r : K) = algebraMap k⟮X⟯ K RatFunc.X := by + calc + (r : K) = algebraMap (ringOfIntegers k K) K r := rfl + _ = algebraMap k[X] K Polynomial.X := by + simpa only [r] using + (IsScalarTower.algebraMap_apply k[X] (ringOfIntegers k K) K Polynomial.X).symm + _ = algebraMap k⟮X⟯ K RatFunc.X := by + rw [IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, RatFunc.algebraMap_X] + rw [← hr_eq] + exact hr + +namespace Place + +variable {R L : Type*} [CommRing R] [IsDedekindDomain R] [Field L] + [Algebra R L] [IsFractionRing R L] + +/-- The centre in a Dedekind model of a valuation subring containing that model. -/ +noncomputable def centerIdeal (V : ValuationSubring L) + (hR : ∀ r : R, algebraMap R L r ∈ V) : Ideal R := + (IsLocalRing.maximalIdeal V).comap + ((algebraMap R L).codRestrict V hR) + +instance centerIdeal_isPrime (V : ValuationSubring L) + (hR : ∀ r : R, algebraMap R L r ∈ V) : (centerIdeal V hR).IsPrime := + (IsLocalRing.maximalIdeal V).comap_isPrime _ + +/-- A nonzero centre is a height-one prime of a Dedekind model. -/ +noncomputable def center (V : ValuationSubring L) + (hR : ∀ r : R, algebraMap R L r ∈ V) (hne : centerIdeal V hR ≠ ⊥) : + IsDedekindDomain.HeightOneSpectrum R where + asIdeal := centerIdeal V hR + isPrime := inferInstance + ne_bot := hne + +theorem valuationSubringAtPrime_center (V : ValuationSubring L) (hV : V ≠ ⊤) + (hR : ∀ r : R, algebraMap R L r ∈ V) (hne : centerIdeal V hR ≠ ⊥) : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L (center V hR hne) = V := by + let w := center V hR hne + let A := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L w + have hle : A ≤ V := by + rintro x hx + have hvx : w.valuation L x ≤ 1 := by + rw [← Valuation.mem_valuationSubring_iff, + ← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + exact hx + obtain ⟨a, s, hxs⟩ := w.exists_primeCompl_mul_eq_of_integer x hvx + have hs_not_center : (s : R) ∉ centerIdeal V hR := by + change (s : R) ∉ w.asIdeal + exact s.property + have hs_inv_mem : (algebraMap R L s)⁻¹ ∈ V := by + have hs_not_max : + ((⟨algebraMap R L s, hR s⟩ : V) ∉ IsLocalRing.maximalIdeal V) := by + exact hs_not_center + have hs_unit : IsUnit (⟨algebraMap R L s, hR s⟩ : V) := by + simpa [IsLocalRing.mem_maximalIdeal] using hs_not_max + obtain ⟨u, hu⟩ := hs_unit + have hinv_mem : (algebraMap R L s)⁻¹ ∈ V := by + have huval : ((u : V) : L) = algebraMap R L s := by + exact congrArg Subtype.val hu + have huinv : (((u⁻¹ : Vˣ) : V) : L) = (algebraMap R L s)⁻¹ := by + have hmV : ((u⁻¹ : Vˣ) : V) * (u : V) = 1 := by simp + have hmL := congrArg (fun z : V => (z : L)) hmV + change (((u⁻¹ : Vˣ) : V) : L) * ((u : V) : L) = 1 at hmL + rw [huval] at hmL + exact eq_inv_of_mul_eq_one_left hmL + rw [← huinv] + exact (u⁻¹ : Vˣ).val.property + exact hinv_mem + have hs_ne : algebraMap R L s ≠ 0 := by + have hsR : (s : R) ≠ 0 := by + intro hs0 + exact s.property (hs0 ▸ w.asIdeal.zero_mem) + intro hs0 + apply hsR + apply FaithfulSMul.algebraMap_injective R L + simpa using hs0 + have hx_eq : x = algebraMap R L a * (algebraMap R L s)⁻¹ := by + apply (eq_mul_inv_iff_mul_eq₀ hs_ne).2 + exact hxs + rw [hx_eq] + exact V.mul_mem _ _ (hR a) hs_inv_mem + exact ValuationSubring.eq_of_le_of_ne_top A hle hV + +end Place + +namespace Place + +local instance instTowerConstantsRatFunc : IsScalarTower k k⟮X⟯ K := + IsScalarTower.of_algebraMap_eq fun c => by + exact (IsScalarTower.algebraMap_apply k k[X] K c).trans + (IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K (algebraMap k k[X] c)) + +/-- The restriction of an intrinsic place to the rational function subfield. -/ +noncomputable def restrict (v : Place k K) : Valuation k⟮X⟯ ℤᵐ⁰ := + v.valuation.comap (algebraMap k⟮X⟯ K) + +instance restrict_isTrivialOn (v : Place k K) : (restrict k K v).IsTrivialOn k where + eq_one c hc := by + change v.valuation + (algebraMap k⟮X⟯ K (algebraMap k k⟮X⟯ c)) = 1 + rw [← IsScalarTower.algebraMap_apply k k⟮X⟯ K] + exact Valuation.IsTrivialOn.eq_one c hc + +omit [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [FunctionField k K] in +theorem restrict_isNontrivial (v : Place k K) : + (restrict k K v).IsNontrivial := by + let q := restrict k K v + by_contra hq + letI : v.valuation.IsTrivialOn k⟮X⟯ := + { eq_one := fun a ha => by + change q a = 1 + by_contra hne + apply hq + refine ⟨a, ?_, hne⟩ + simp [restrict, ha] } + obtain ⟨y, hy0, hy1⟩ := + (inferInstance : v.valuation.IsNontrivial).exists_val_nontrivial + have hy : y ≠ 0 := v.valuation.ne_zero_iff.mp hy0 + exact (Valuation.transcendental_of_ne_one k⟮X⟯ y hy hy1) + (Algebra.IsAlgebraic.isAlgebraic y) + +omit [FunctionField k K] in +theorem restrict_classification (v : Place k K) : + Xor ((restrict k K v).IsEquiv (RatFunc.inftyValuation k)) + (∃! u : IsDedekindDomain.HeightOneSpectrum k[X], + (restrict k K v).IsEquiv (u.valuation k⟮X⟯)) := by + let q := restrict k K v + letI : q.IsNontrivial := restrict_isNontrivial k K v + letI : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q + exact RatFunc.valuation_isEquiv_infty_or_adic (v := q) + +omit [IsScalarTower k k[X] K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem finiteRing_le (v : Place k K) + (u : IsDedekindDomain.HeightOneSpectrum k[X]) + (h : (restrict k K v).IsEquiv (u.valuation k⟮X⟯)) : + ∀ r : ringOfIntegers k K, algebraMap (ringOfIntegers k K) K r ∈ + v.toValuationSubring := by + have hpoly : ∀ p : k[X], algebraMap k[X] K p ∈ v.toValuationSubring := by + intro p + rw [← v.valuationSubring_valuation, Valuation.mem_valuationSubring_iff] + rw [IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K] + exact h.le_one_iff_le_one.mpr (u.valuation_le_one p) + letI : IsIntegrallyClosedIn v.toValuationSubring.toSubring K := + Subring.isIntegrallyClosedIn_iff.mpr fun {_x} hx => + LocalSubring.mem_of_isMax_of_isIntegral + v.toValuationSubring.isMax_toLocalSubring hx + have hle : (ringOfIntegers k K).toSubring ≤ v.toValuationSubring.toSubring := + (Subring.integralClosure_le_iff).mpr hpoly + exact fun r => hle r.property + +omit [IsScalarTower k k[X] K] in +theorem finiteCenter_ne (v : Place k K) + (u : IsDedekindDomain.HeightOneSpectrum k[X]) + (h : (restrict k K v).IsEquiv (u.valuation k⟮X⟯)) : + centerIdeal v.toValuationSubring (finiteRing_le k K v u h) ≠ ⊥ := by + obtain ⟨a, ha_mem, ha_ne⟩ := Submodule.exists_mem_ne_zero_of_ne_bot u.ne_bot + let r : ringOfIntegers k K := algebraMap k[X] (ringOfIntegers k K) a + have hr_ne : r ≠ 0 := by + intro hr + apply ha_ne + apply FaithfulSMul.algebraMap_injective k[X] (ringOfIntegers k K) + simpa [r] using hr + intro hbot + have hr_center : r ∈ + centerIdeal v.toValuationSubring (finiteRing_le k K v u h) := by + change (⟨algebraMap (ringOfIntegers k K) K r, + finiteRing_le k K v u h r⟩ : v.toValuationSubring) ∈ + IsLocalRing.maximalIdeal v.toValuationSubring + rw [v.toValuationSubring.valuation_lt_one_iff] + have hnorm : v.valuation (algebraMap (ringOfIntegers k K) K r) < 1 := by + rw [show algebraMap (ringOfIntegers k K) K r = algebraMap k[X] K a by + simpa only [r] using + (IsScalarTower.algebraMap_apply k[X] (ringOfIntegers k K) K a).symm, + IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K] + exact h.lt_one_iff_lt_one.mpr + ((u.valuation_lt_one_iff_mem a).mpr ha_mem) + simpa only [map_one] using + v.valuation_isEquiv_canonical.lt_one_iff_lt_one.mp hnorm + rw [hbot] at hr_center + exact hr_ne (Ideal.mem_bot.mp hr_center) + +omit [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] + [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in +theorem infiniteRing_le (v : Place k K) + (h : (restrict k K v).IsEquiv (RatFunc.inftyValuation k)) : + ∀ r : infiniteIntegers k K, algebraMap (infiniteIntegers k K) K r ∈ + v.toValuationSubring := by + have hbase : ∀ a : inftyValuationSubring k, + algebraMap (inftyValuationSubring k) K a ∈ v.toValuationSubring := by + intro a + rw [← v.valuationSubring_valuation, Valuation.mem_valuationSubring_iff] + rw [IsScalarTower.algebraMap_apply (inftyValuationSubring k) k⟮X⟯ K] + exact h.le_one_iff_le_one.mpr a.property + letI : IsIntegrallyClosedIn v.toValuationSubring.toSubring K := + Subring.isIntegrallyClosedIn_iff.mpr fun {_x} hx => + LocalSubring.mem_of_isMax_of_isIntegral + v.toValuationSubring.isMax_toLocalSubring hx + have hle : (infiniteIntegers k K).toSubring ≤ v.toValuationSubring.toSubring := + (Subring.integralClosure_le_iff).mpr hbase + exact fun r => hle r.property + +omit [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] in +theorem infiniteCenter_ne (v : Place k K) + (h : (restrict k K v).IsEquiv (RatFunc.inftyValuation k)) : + centerIdeal v.toValuationSubring (infiniteRing_le k K v h) ≠ ⊥ := by + let A := inftyValuationSubring k + let u := IsDiscreteValuationRing.maximalIdeal A + obtain ⟨a, ha_mem, ha_ne⟩ := Submodule.exists_mem_ne_zero_of_ne_bot u.ne_bot + let r : infiniteIntegers k K := algebraMap A (infiniteIntegers k K) a + have hr_ne : r ≠ 0 := by + intro hr + apply ha_ne + apply FaithfulSMul.algebraMap_injective A (infiniteIntegers k K) + simpa [r] using hr + intro hbot + have hr_center : r ∈ + centerIdeal v.toValuationSubring (infiniteRing_le k K v h) := by + change (⟨algebraMap (infiniteIntegers k K) K r, + infiniteRing_le k K v h r⟩ : v.toValuationSubring) ∈ + IsLocalRing.maximalIdeal v.toValuationSubring + rw [v.toValuationSubring.valuation_lt_one_iff] + have hnorm : v.valuation (algebraMap (infiniteIntegers k K) K r) < 1 := by + rw [show algebraMap (infiniteIntegers k K) K r = algebraMap A K a by + simpa only [r] using + (IsScalarTower.algebraMap_apply A (infiniteIntegers k K) K a).symm, + IsScalarTower.algebraMap_apply A k⟮X⟯ K] + exact h.lt_one_iff_lt_one.mpr + ((Valuation.mem_maximalIdeal_iff (v := RatFunc.inftyValuation k)).mp ha_mem) + simpa only [map_one] using + v.valuation_isEquiv_canonical.lt_one_iff_lt_one.mp hnorm + rw [hbot] at hr_center + exact hr_ne (Ideal.mem_bot.mp hr_center) + +omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] in +theorem infinite_X_gt_one + (w : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + 1 < w.valuation K (algebraMap k⟮X⟯ K RatFunc.X) := by + let A := inftyValuationSubring k + let u := IsDiscreteValuationRing.maximalIdeal A + have hund : w.asIdeal.under A = u.asIdeal := by + exact IsLocalRing.eq_maximalIdeal inferInstance + letI : w.asIdeal.LiesOver u.asIdeal := ⟨hund.symm⟩ + have hbase : (u.valuation k⟮X⟯).IsEquiv (RatFunc.inftyValuation k) := by + rw [Valuation.isEquiv_iff_valuationSubring] + apply ValuationSubring.toSubring_injective + have hmap : Subring.map (algebraMap A k⟮X⟯) ⊤ = A.toSubring := by + ext x + constructor + · rintro ⟨a, _, rfl⟩ + exact a.property + · intro hx + exact ⟨⟨x, hx⟩, Set.mem_univ _, rfl⟩ + exact (IsDiscreteValuationRing.map_algebraMap_eq_valuationSubring + (A := A) (K := k⟮X⟯)).symm.trans hmap + have hbaseX : 1 < u.valuation k⟮X⟯ RatFunc.X := + hbase.one_lt_iff_one_lt.mpr (by simp [← WithZero.exp_zero]) + have he : Ideal.ramificationIdx' u.asIdeal w.asIdeal ≠ 0 := + Ideal.IsDedekindDomain.ramificationIdx'_ne_zero_of_liesOver + w.asIdeal u.ne_bot + have hpow : 1 < (u.valuation k⟮X⟯ RatFunc.X) ^ + Ideal.ramificationIdx' u.asIdeal w.asIdeal := by + exact one_lt_pow₀ hbaseX he + rw [u.valuation_liesOver K w RatFunc.X] at hpow + exact hpow + +theorem ofChart_injective : Function.Injective (Place.ofChart k K) := by + intro w₁ w₂ hw + have hsub := congrArg Place.toValuationSubring hw + simp only [Place.ofChart_toValuationSubring] at hsub + rcases w₁ with w₁ | w₁ <;> rcases w₂ with w₂ | w₂ + · congr 1 + exact IsDedekindDomain.HeightOneSpectrum.eq_of_valuation_isEquiv_valuation + ((Valuation.isEquiv_iff_valuationSubring _ _).mpr hsub) + · have hequiv : (w₁.valuation K).IsEquiv (w₂.valuation K) := + (Valuation.isEquiv_iff_valuationSubring _ _).mpr hsub + have hle := hequiv.le_one_iff_le_one.mp (finite_X_le_one k K w₁) + exact (not_le_of_gt (infinite_X_gt_one k K w₂) hle).elim + · have hequiv : (w₂.valuation K).IsEquiv (w₁.valuation K) := + (Valuation.isEquiv_iff_valuationSubring _ _).mpr hsub.symm + have hle := hequiv.le_one_iff_le_one.mp (finite_X_le_one k K w₂) + exact (not_le_of_gt (infinite_X_gt_one k K w₁) hle).elim + · congr 1 + exact IsDedekindDomain.HeightOneSpectrum.eq_of_valuation_isEquiv_valuation + ((Valuation.isEquiv_iff_valuationSubring _ _).mpr hsub) + +/-- Every intrinsic place occurs on one of the two coordinate charts. -/ +theorem exists_chart (v : Place k K) : + ∃ w : PlaceA k K, Place.ofChart k K w = v := by + rcases restrict_classification k K v with h | h + · let w := center v.toValuationSubring + (infiniteRing_le k K v h.1) (infiniteCenter_ne k K v h.1) + refine ⟨Sum.inr w, Place.ext ?_⟩ + rw [Place.ofChart_toValuationSubring] + change (w.valuation K).valuationSubring = _ + rw [← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + exact valuationSubringAtPrime_center v.toValuationSubring v.ne_top + (infiniteRing_le k K v h.1) (infiniteCenter_ne k K v h.1) + · let u := h.1.choose + have hu := h.1.choose_spec.1 + let w := center v.toValuationSubring + (finiteRing_le k K v u hu) (finiteCenter_ne k K v u hu) + refine ⟨Sum.inl w, Place.ext ?_⟩ + rw [Place.ofChart_toValuationSubring] + change (w.valuation K).valuationSubring = _ + rw [← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + exact valuationSubringAtPrime_center v.toValuationSubring v.ne_top + (finiteRing_le k K v u hu) (finiteCenter_ne k K v u hu) + +/-- Recover a coordinate chart containing an intrinsic place. -/ +noncomputable def toChart (v : Place k K) : PlaceA k K := + Classical.choose (exists_chart k K v) + +theorem ofChart_toChart (v : Place k K) : + Place.ofChart k K (toChart k K v) = v := + Classical.choose_spec (exists_chart k K v) + +/-- Coordinate places and intrinsic places are equivalent. -/ +noncomputable def chartToPlaceCore : PlaceA k K ≃ Place k K where + toFun := Place.ofChart k K + invFun := toChart k K + left_inv w := ofChart_injective k K (ofChart_toChart k K (Place.ofChart k K w)) + right_inv := ofChart_toChart k K + +end Place + +/-- The equivalence from the two-chart construction to coordinate-free places. -/ +noncomputable abbrev chartToPlace : PlaceA k K ≃ Place k K := + Place.chartToPlaceCore k K + +@[simp] +theorem chartToPlace_apply (w : PlaceA k K) : + chartToPlace k K w = Place.ofChart k K w := rfl + +/-- The coordinate valuation and the normalized intrinsic valuation define the same place. -/ +theorem placeValuation_isEquiv (w : PlaceA k K) : + (placeValuation k K w).IsEquiv (chartToPlace k K w).valuation := + Place.ofChart_valuation_isEquiv k K w + +/-- Compatibility of the chart and intrinsic normalized valuations. -/ +theorem placeValuation_eq (w : PlaceA k K) : + (chartToPlace k K w).valuation = placeValuation k K w := + Place.ofChart_valuation_eq k K w + +end FunctionField diff --git a/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean new file mode 100644 index 0000000000..ff803386ef --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean @@ -0,0 +1,942 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Basic +public import LeanPool.MarkoffModP.RiemannRoch.LocalResidue +public import Mathlib.Algebra.Order.GroupWithZero.Canonical +public import Mathlib.Algebra.Polynomial.Eval.Subring +public import Mathlib.FieldTheory.Minpoly.IsIntegrallyClosed +public import Mathlib.RingTheory.DedekindDomain.AdicValuation +public import Mathlib.RingTheory.LocalRing.ResidueField.Ideal +public import Mathlib.RingTheory.Polynomial.Tower + +/-! +# Riemann–Roch spaces `L(D)` + +This file defines the Riemann–Roch space of a divisor on a function field and its dimension +`ℓ(D)`. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField.Chart + +lemma exp_neg_mul_lt_one_iff_le (x : ℤᵐ⁰) (n : ℤ) : + WithZero.exp (-n) * x < 1 ↔ x ≤ WithZero.exp (n - 1) := by + by_cases hx : x = 0 + · simp [hx] + rw [← WithZero.log_lt_log (mul_ne_zero WithZero.exp_ne_zero hx) one_ne_zero] + rw [WithZero.log_mul WithZero.exp_ne_zero hx, WithZero.log_exp, WithZero.log_one] + rw [← WithZero.log_le_iff_le_exp hx] + omega + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncRRspace : DecidableEq k⟮X⟯ := Classical.decEq _ + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem nonempty_placeA : Nonempty (PlaceA k K) := by + let P : Ideal k[X] := Ideal.span {Polynomial.X} + letI : P.IsMaximal := + PrincipalIdealRing.isMaximal_of_irreducible Polynomial.irreducible_X + obtain ⟨Q, hQprime, hQunder⟩ := + P.exists_ideal_over_prime_of_isIntegral_of_isDomain + (S := ringOfIntegers k K) (by simp) + have hQ0 : Q ≠ ⊥ := by + intro hQ + have hP : P = ⊥ := by simpa [hQ] using hQunder.symm + have hX : Polynomial.X ∈ P := Ideal.subset_span (Set.mem_singleton _) + rw [hP, Ideal.mem_bot] at hX + exact Polynomial.X_ne_zero hX + exact ⟨Sum.inl ⟨Q, hQprime, hQ0⟩⟩ + +/-- A function belongs to the Riemann–Roch space of `D` when its valuation at every place `v` +is at most `WithZero.exp (D v)`, i.e. `ord_v f ≥ -D v` in additive notation. The zero function +belongs trivially since its valuation is `0`. -/ +def memRRspace (D : DivisorA k K) (f : K) : Prop := + ∀ v, placeValuation k K v f ≤ WithZero.exp (D v) + +namespace memRRspace + +variable {D : DivisorA k K} + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem zero_mem (D : DivisorA k K) : memRRspace k K D 0 := fun v => by + rw [map_zero] + exact zero_le + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem add_mem {f g : K} (hf : memRRspace k K D f) (hg : memRRspace k K D g) : + memRRspace k K D (f + g) := fun v => + le_trans (Valuation.map_add _ f g) (max_le (hf v) (hg v)) + +theorem smul_mem (c : k) {f : K} (hf : memRRspace k K D f) : + memRRspace k K D (c • f) := fun v => by + rw [Algebra.smul_def, map_mul] + calc placeValuation k K v (algebraMap k K c) * placeValuation k K v f + ≤ 1 * WithZero.exp (D v) := + mul_le_mul' (placeValuation_algebraMap_le_one k K v c) (hf v) + _ = WithZero.exp (D v) := one_mul _ + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem one_mem : memRRspace k K 0 1 := fun v => by + rw [Valuation.map_one (placeValuation k K v)] + show (1 : WithZero (Multiplicative ℤ)) ≤ WithZero.exp ((0 : DivisorA k K) v) + rw [Finsupp.zero_apply, ← WithZero.exp_zero] + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem mul_mem {D E : DivisorA k K} {f g : K} (hf : memRRspace k K D f) + (hg : memRRspace k K E g) : + memRRspace k K (D + E) (f * g) := fun v => by + rw [Valuation.map_mul (placeValuation k K v), Finsupp.add_apply] + calc placeValuation k K v f * placeValuation k K v g + ≤ WithZero.exp (D v) * WithZero.exp (E v) := mul_le_mul' (hf v) (hg v) + _ = WithZero.exp (D v + E v) := by rw [← WithZero.exp_add] + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem memRRspace_mono {D E : DivisorA k K} (h : D ≤ E) {f : K} (hf : memRRspace k K D f) : + memRRspace k K E f := fun v => + (hf v).trans (WithZero.exp_le_exp.mpr (h v)) + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem pow_mem {D : DivisorA k K} {f : K} (hf : memRRspace k K D f) : + ∀ n : ℕ, memRRspace k K (n • D) (f ^ n) := by + intro n + induction n with + | zero => + simpa using one_mem (k := k) (K := K) + | succ n ih => + rw [succ_nsmul, pow_succ] + exact mul_mem (k := k) (K := K) ih hf + +end memRRspace + +/-- The Riemann–Roch space `L(D)`. -/ +def RRspace (D : DivisorA k K) : Submodule k K where + carrier := {f | memRRspace k K D f} + zero_mem' := memRRspace.zero_mem (k := k) (K := K) D + add_mem' hf hg := memRRspace.add_mem (k := k) (K := K) hf hg + smul_mem' c _ hf := memRRspace.smul_mem (k := k) (K := K) c hf + +/-- The dimension `ℓ(D)`. -/ +noncomputable def ell (D : DivisorA k K) : ℕ := + Module.finrank k (RRspace k K D) + +@[simp] +theorem mem_RRspace_iff (D : DivisorA k K) (f : K) : + f ∈ RRspace k K D ↔ memRRspace k K D f := by + simp [RRspace] + +theorem RRspace_mono {D D' : DivisorA k K} (h : D ≤ D') : + RRspace k K D ≤ RRspace k K D' := by + intro f hf + rw [mem_RRspace_iff] at hf ⊢ + exact fun v => (hf v).trans (WithZero.exp_le_exp.mpr (h v)) + +/-- Multiplication by a nonzero function identifies `L(D + (x))` with `L(D)`. -/ +noncomputable def RRspaceAddPrincipalEquiv (D : DivisorA k K) (x : Kˣ) : + RRspace k K (D + principalDivisorA k K (Additive.ofMul x)) ≃ₗ[k] + RRspace k K D where + toFun f := ⟨(x : K) * f.val, by + intro v + change placeValuation k K v ((x : K) * f.val) ≤ WithZero.exp (D v) + rw [map_mul] + have hxval := placeValuation_eq_exp_neg_principalDivisor k K (Additive.ofMul x) v + change placeValuation k K v (x : K) = + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) at hxval + rw [hxval] + have hf := f.property v + rw [Finsupp.add_apply, WithZero.exp_add] at hf + calc + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) * + placeValuation k K v f.val ≤ + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) * + (WithZero.exp (D v) * + WithZero.exp (principalDivisorA k K (Additive.ofMul x) v)) := + mul_le_mul_right hf _ + _ = WithZero.exp (D v) := by + rw [← WithZero.exp_add, ← WithZero.exp_add] + congr 1 + ring⟩ + invFun f := ⟨((x⁻¹ : Kˣ) : K) * f.val, by + intro v + change placeValuation k K v (((x⁻¹ : Kˣ) : K) * f.val) ≤ + WithZero.exp ((D + principalDivisorA k K (Additive.ofMul x)) v) + rw [map_mul] + have hxinv := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul (x⁻¹ : Kˣ)) v + have hxinv' : placeValuation k K v ((x⁻¹ : Kˣ) : K) = + WithZero.exp (principalDivisorA k K (Additive.ofMul x) v) := by + change placeValuation k K v ((x⁻¹ : Kˣ) : K) = _ at hxinv ⊢ + simpa using hxinv + rw [hxinv', Finsupp.add_apply, WithZero.exp_add] + calc + WithZero.exp (principalDivisorA k K (Additive.ofMul x) v) * + placeValuation k K v f.val ≤ + WithZero.exp (principalDivisorA k K (Additive.ofMul x) v) * + WithZero.exp (D v) := mul_le_mul_right (f.property v) _ + _ = WithZero.exp (D v) * + WithZero.exp (principalDivisorA k K (Additive.ofMul x) v) := mul_comm _ _⟩ + left_inv f := Subtype.ext (by + change ((x⁻¹ : Kˣ) : K) * ((x : K) * f.val) = f.val + rw [← mul_assoc, Units.inv_mul, one_mul]) + right_inv f := Subtype.ext (by + change (x : K) * (((x⁻¹ : Kˣ) : K) * f.val) = f.val + rw [← mul_assoc, Units.mul_inv, one_mul]) + map_add' f g := by + apply Subtype.ext + exact mul_add (x : K) f.val g.val + map_smul' c f := by + apply Subtype.ext + change (x : K) * (c • f.val) = c • ((x : K) * f.val) + simp only [Algebra.smul_def] + ring + +/-- Riemann–Roch dimensions are invariant under adding a principal divisor. -/ +theorem ell_add_principal (D : DivisorA k K) (x : Kˣ) : + ell k K (D + principalDivisorA k K (Additive.ofMul x)) = ell k K D := by + exact (RRspaceAddPrincipalEquiv k K D x).finrank_eq + +/-- The rank of the quotient `L(D') / L(D)` (with intersection semantics when unordered). -/ +noncomputable def finrankRRspaceDiff (D D' : DivisorA k K) : ℕ := by + letI : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ + letI : Module k (RRspace k K D') := Submodule.module _ + exact Module.finrank k <| + (RRspace k K D') ⧸ + Submodule.comap (RRspace k K D').subtype (RRspace k K D) + +/-- One-step local residue map at a finite coordinate place. -/ +noncomputable def finiteLocalResidueMap (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + RRspace k K (D + Finsupp.single (Sum.inl v) 1) →ₗ[k] v.asIdeal.ResidueField := by + let A := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v + letI : Algebra k A := + ((algebraMap (ringOfIntegers k K) A).comp + (algebraMap k (ringOfIntegers k K))).toAlgebra + letI : IsScalarTower k (ringOfIntegers k K) A := + IsScalarTower.of_algebraMap_eq fun _ => rfl + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inl v) + 1 + let toA : RRspace k K (D + Finsupp.single (Sum.inl v) 1) → A := fun f => + ⟨π ^ n * (f : K), by + change π ^ n * (f : K) ∈ + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + Valuation.mem_valuationSubring_iff] + have hπpow : v.valuation K (π ^ n) = WithZero.exp (-1) ^ n := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + rw [map_mul, hπpow] + have hf : v.valuation K (f : K) ≤ WithZero.exp n := by + simpa [placeValuation, n] using f.property (Sum.inl v) + calc + WithZero.exp (-1) ^ n * v.valuation K (f : K) + ≤ WithZero.exp (-1) ^ n * WithZero.exp n := mul_le_mul_right hf _ + _ = 1 := by + rw [← WithZero.exp_zsmul, ← WithZero.exp_add] + convert WithZero.exp_zero + simp⟩ + exact + { toFun := fun f => + IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v (toA f) + map_add' := fun f g => by + rw [← map_add] + congr 1 + apply Subtype.ext + simp [toA, mul_add] + map_smul' := fun c f => by + have hz : toA (c • f) = algebraMap k A c * toA f := by + apply Subtype.ext + simp only [toA, Submodule.coe_smul_of_tower, Algebra.smul_def] + change π ^ n * (algebraMap k K c * (f : K)) = + (↑(algebraMap k A c) : K) * (π ^ n * (f : K)) + have hcA : (↑(algebraMap k A c) : K) = algebraMap k K c := by + calc + (↑(algebraMap k A c) : K) = + ↑(algebraMap (ringOfIntegers k K) A + (algebraMap k (ringOfIntegers k K) c)) := by + rw [IsScalarTower.algebraMap_apply k (ringOfIntegers k K) A] + _ = algebraMap (ringOfIntegers k K) K + (algebraMap k (ringOfIntegers k K) c) := rfl + _ = algebraMap k K c := + (IsScalarTower.algebraMap_apply k (ringOfIntegers k K) K c).symm + rw [hcA] + ring + rw [hz, map_mul] + rw [Algebra.smul_def] + congr 1 + rw [IsScalarTower.algebraMap_apply k (ringOfIntegers k K) A] + rw [IsDedekindDomain.HeightOneSpectrum.residueHom, IsLocalization.lift_eq] + exact (IsScalarTower.algebraMap_apply k (ringOfIntegers k K) + v.asIdeal.ResidueField c).symm } + +theorem finiteLocalResidueMap_ker (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + (finiteLocalResidueMap k K D v).ker = + Submodule.comap (RRspace k K (D + Finsupp.single (Sum.inl v) 1)).subtype + (RRspace k K D) := by + ext f + simp only [LinearMap.mem_ker, Submodule.mem_comap, Submodule.coe_subtype, + mem_RRspace_iff] + change IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v + ⟨(Classical.choose (v.valuation_exists_uniformizer K)) ^ + (D (Sum.inl v) + 1) * (f : K), _⟩ = 0 ↔ + ∀ w, placeValuation k K w (f : K) ≤ WithZero.exp (D w) + rw [IsDedekindDomain.HeightOneSpectrum.residueHom_eq_zero_iff] + have hπ := Classical.choose_spec (v.valuation_exists_uniformizer K) + rw [map_mul, map_zpow₀, hπ] + rw [← WithZero.exp_zsmul] + have hnsmul : (D (Sum.inl v) + 1) • (-1 : ℤ) = -(D (Sum.inl v) + 1) := by + simp + rw [hnsmul] + have hlocal : WithZero.exp (-(D (Sum.inl v) + 1)) * v.valuation K (f : K) < 1 ↔ + v.valuation K (f : K) ≤ WithZero.exp (D (Sum.inl v)) := by + simpa using exp_neg_mul_lt_one_iff_le + (v.valuation K (f : K)) (D (Sum.inl v) + 1) + rw [hlocal] + constructor + · intro hv w + by_cases hw : w = Sum.inl v + · subst w + exact hv + · have hf := f.property w + simpa [placeValuation, hw] using hf + · intro hf + simpa [placeValuation] using hf (Sum.inl v) + +theorem finrankRRspaceDiff_single_finite_le (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : + finrankRRspaceDiff k K D (D + Finsupp.single (Sum.inl v) 1) ≤ + placeDegree k K (Sum.inl v) := by + let f := finiteLocalResidueMap k K D v + let e : (ringOfIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + have hker := finiteLocalResidueMap_ker k K D v + rw [finrankRRspaceDiff, ← hker, f.quotKerEquivRange.finrank_eq] + calc + Module.finrank k f.range ≤ Module.finrank k v.asIdeal.ResidueField := + f.range.finrank_le + _ = Module.finrank k (ringOfIntegers k K ⧸ v.asIdeal) := by + exact e.finrank_eq.symm + _ = placeDegree k K (Sum.inl v) := rfl + +/-- One-step local residue map at an infinite coordinate place. -/ +noncomputable def infiniteLocalResidueMap (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + RRspace k K (D + Finsupp.single (Sum.inr v) 1) →ₗ[k] v.asIdeal.ResidueField := by + let A := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v + letI : Algebra k A := + ((algebraMap (infiniteIntegers k K) A).comp + (algebraMap k (infiniteIntegers k K))).toAlgebra + letI : IsScalarTower k (infiniteIntegers k K) A := + IsScalarTower.of_algebraMap_eq fun _ => rfl + let π : K := Classical.choose (v.valuation_exists_uniformizer K) + let n : ℤ := D (Sum.inr v) + 1 + let toA : RRspace k K (D + Finsupp.single (Sum.inr v) 1) → A := fun f => + ⟨π ^ n * (f : K), by + change π ^ n * (f : K) ∈ + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime K v + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + Valuation.mem_valuationSubring_iff] + have hπpow : v.valuation K (π ^ n) = WithZero.exp (-1) ^ n := by + rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] + rw [map_mul, hπpow] + have hf : v.valuation K (f : K) ≤ WithZero.exp n := by + simpa [placeValuation, n] using f.property (Sum.inr v) + calc + WithZero.exp (-1) ^ n * v.valuation K (f : K) + ≤ WithZero.exp (-1) ^ n * WithZero.exp n := mul_le_mul_right hf _ + _ = 1 := by + rw [← WithZero.exp_zsmul, ← WithZero.exp_add] + convert WithZero.exp_zero + simp⟩ + exact + { toFun := fun f => + IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v (toA f) + map_add' := fun f g => by + rw [← map_add] + congr 1 + apply Subtype.ext + simp [toA, mul_add] + map_smul' := fun c f => by + have hz : toA (c • f) = algebraMap k A c * toA f := by + apply Subtype.ext + simp only [toA, Submodule.coe_smul_of_tower, Algebra.smul_def] + change π ^ n * (algebraMap k K c * (f : K)) = + (↑(algebraMap k A c) : K) * (π ^ n * (f : K)) + have hcA : (↑(algebraMap k A c) : K) = algebraMap k K c := by + calc + (↑(algebraMap k A c) : K) = + ↑(algebraMap (infiniteIntegers k K) A + (algebraMap k (infiniteIntegers k K) c)) := by + rw [IsScalarTower.algebraMap_apply k (infiniteIntegers k K) A] + _ = algebraMap (infiniteIntegers k K) K + (algebraMap k (infiniteIntegers k K) c) := rfl + _ = algebraMap k K c := + (IsScalarTower.algebraMap_apply k (infiniteIntegers k K) K c).symm + rw [hcA] + ring + rw [hz, map_mul] + rw [Algebra.smul_def] + congr 1 + rw [IsScalarTower.algebraMap_apply k (infiniteIntegers k K) A] + rw [IsDedekindDomain.HeightOneSpectrum.residueHom, IsLocalization.lift_eq] + exact (IsScalarTower.algebraMap_apply k (infiniteIntegers k K) + v.asIdeal.ResidueField c).symm } + +theorem infiniteLocalResidueMap_ker (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + (infiniteLocalResidueMap k K D v).ker = + Submodule.comap (RRspace k K (D + Finsupp.single (Sum.inr v) 1)).subtype + (RRspace k K D) := by + ext f + simp only [LinearMap.mem_ker, Submodule.mem_comap, Submodule.coe_subtype, + mem_RRspace_iff] + change IsDedekindDomain.HeightOneSpectrum.residueHom (K := K) v + ⟨(Classical.choose (v.valuation_exists_uniformizer K)) ^ + (D (Sum.inr v) + 1) * (f : K), _⟩ = 0 ↔ + ∀ w, placeValuation k K w (f : K) ≤ WithZero.exp (D w) + rw [IsDedekindDomain.HeightOneSpectrum.residueHom_eq_zero_iff] + have hπ := Classical.choose_spec (v.valuation_exists_uniformizer K) + rw [map_mul, map_zpow₀, hπ] + rw [← WithZero.exp_zsmul] + have hnsmul : (D (Sum.inr v) + 1) • (-1 : ℤ) = -(D (Sum.inr v) + 1) := by + simp + rw [hnsmul] + have hlocal : WithZero.exp (-(D (Sum.inr v) + 1)) * v.valuation K (f : K) < 1 ↔ + v.valuation K (f : K) ≤ WithZero.exp (D (Sum.inr v)) := by + simpa using exp_neg_mul_lt_one_iff_le + (v.valuation K (f : K)) (D (Sum.inr v) + 1) + rw [hlocal] + constructor + · intro hv w + by_cases hw : w = Sum.inr v + · subst w + exact hv + · have hf := f.property w + simpa [placeValuation, hw] using hf + · intro hf + simpa [placeValuation] using hf (Sum.inr v) + +theorem finrankRRspaceDiff_single_infinite_le (D : DivisorA k K) + (v : IsDedekindDomain.HeightOneSpectrum (infiniteIntegers k K)) : + finrankRRspaceDiff k K D (D + Finsupp.single (Sum.inr v) 1) ≤ + placeDegree k K (Sum.inr v) := by + let f := infiniteLocalResidueMap k K D v + let e : (infiniteIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + have hker := infiniteLocalResidueMap_ker k K D v + rw [finrankRRspaceDiff, ← hker, f.quotKerEquivRange.finrank_eq] + calc + Module.finrank k f.range ≤ Module.finrank k v.asIdeal.ResidueField := + f.range.finrank_le + _ = Module.finrank k (infiniteIntegers k K ⧸ v.asIdeal) := by + exact e.finrank_eq.symm + _ = placeDegree k K (Sum.inr v) := rfl + +theorem finiteDimensional_add_single_one (D : DivisorA k K) (v : PlaceA k K) + [FiniteDimensional k (RRspace k K D)] : + FiniteDimensional k (RRspace k K (D + Finsupp.single v 1)) := by + classical + have hle : RRspace k K D ≤ RRspace k K (D + Finsupp.single v 1) := by + apply RRspace_mono k K + intro w + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + let p := Submodule.comap (RRspace k K (D + Finsupp.single v 1)).subtype + (RRspace k K D) + letI : Module.Finite k p := + Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hle).symm + rcases v with v | v + · let f := finiteLocalResidueMap k K D v + let e : (ringOfIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + letI : Module.Finite k f.range := inferInstance + haveI hqker : Module.Finite k + (RRspace k K (D + Finsupp.single (Sum.inl v) 1) ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + haveI hqp : Module.Finite k + (RRspace k K (D + Finsupp.single (Sum.inl v) 1) ⧸ p) := by + exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p + (finiteLocalResidueMap_ker k K D v)) + exact Module.Finite.of_submodule_quotient p + · let f := infiniteLocalResidueMap k K D v + let e : (infiniteIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := + LinearEquiv.ofBijective + ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) + v.asIdeal.ResidueField).restrictScalars k) + (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) + letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + letI : Module.Finite k f.range := inferInstance + haveI hqker : Module.Finite k + (RRspace k K (D + Finsupp.single (Sum.inr v) 1) ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + haveI hqp : Module.Finite k + (RRspace k K (D + Finsupp.single (Sum.inr v) 1) ⧸ p) := by + exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p + (infiniteLocalResidueMap_ker k K D v)) + exact Module.Finite.of_submodule_quotient p + +theorem finiteDimensional_add_single_nat (D : DivisorA k K) (v : PlaceA k K) + (n : ℕ) [FiniteDimensional k (RRspace k K D)] : + FiniteDimensional k (RRspace k K (D + Finsupp.single v (n : ℤ))) := by + induction n with + | zero => + have heq : D + Finsupp.single v ((0 : ℕ) : ℤ) = D := by simp + rw [heq] + infer_instance + | succ n ih => + letI : FiniteDimensional k + (RRspace k K (D + Finsupp.single v (n : ℤ))) := ih + have hfin := finiteDimensional_add_single_one k K + (D + Finsupp.single v (n : ℤ)) v + have heq : D + Finsupp.single v ((n + 1 : ℕ) : ℤ) = + (D + Finsupp.single v (n : ℤ)) + Finsupp.single v 1 := by + classical + ext w + simp only [Finsupp.add_apply, Finsupp.single_apply] + split <;> omega + rw [heq] + exact hfin + +theorem finrankRRspaceDiff_add_finrank_of_finite {D D' : DivisorA k K} + (h : D ≤ D') [FiniteDimensional k (RRspace k K D')] : + finrankRRspaceDiff k K D D' + Module.finrank k (RRspace k K D) = + Module.finrank k (RRspace k K D') := by + letI : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ + letI : Module k (RRspace k K D') := Submodule.module _ + rw [finrankRRspaceDiff, + ← (Submodule.comapSubtypeEquivOfLe (RRspace_mono k K h)).finrank_eq] + exact Submodule.finrank_quotient_add_finrank _ + +theorem finrankRRspaceDiff_single_one_le (D : DivisorA k K) (v : PlaceA k K) : + finrankRRspaceDiff k K D (D + Finsupp.single v 1) ≤ placeDegree k K v := by + rcases v with v | v + · exact finrankRRspaceDiff_single_finite_le k K D v + · exact finrankRRspaceDiff_single_infinite_le k K D v + +theorem finrankRRspaceDiff_single_nat_le (D : DivisorA k K) (v : PlaceA k K) + (n : ℕ) [FiniteDimensional k (RRspace k K D)] : + finrankRRspaceDiff k K D (D + Finsupp.single v (n : ℤ)) ≤ + n * placeDegree k K v := by + induction n with + | zero => + simp only [Nat.cast_zero, Finsupp.single_zero, add_zero, zero_mul] + rw [finrankRRspaceDiff] + have hp : Submodule.comap (RRspace k K D).subtype (RRspace k K D) = ⊤ := by + ext f + simp + rw [hp] + have h := Submodule.finrank_quotient_add_finrank + (⊤ : Submodule k (RRspace k K D)) + simp only [finrank_top] at h + omega + | succ n ih => + let M := D + Finsupp.single v (n : ℤ) + let N := M + Finsupp.single v 1 + letI : FiniteDimensional k (RRspace k K M) := + finiteDimensional_add_single_nat k K D v n + letI : FiniteDimensional k (RRspace k K N) := + finiteDimensional_add_single_one k K M v + have hDM : D ≤ M := by + intro w + dsimp only [M] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + classical + simp only [Finsupp.single_apply] + split <;> omega) + have hMN : M ≤ N := by + intro w + dsimp only [N] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + classical + simp only [Finsupp.single_apply] + split <;> omega) + have hDN : D ≤ N := hDM.trans hMN + have hsumDM := finrankRRspaceDiff_add_finrank_of_finite k K hDM + have hsumMN := finrankRRspaceDiff_add_finrank_of_finite k K hMN + have hsumDN := finrankRRspaceDiff_add_finrank_of_finite k K hDN + have hstep := finrankRRspaceDiff_single_one_le k K M v + change finrankRRspaceDiff k K D M ≤ n * placeDegree k K v at ih + change finrankRRspaceDiff k K M N ≤ placeDegree k K v at hstep + have htotal : finrankRRspaceDiff k K D N ≤ + n * placeDegree k K v + placeDegree k K v := by omega + have heq : D + Finsupp.single v ((n + 1 : ℕ) : ℤ) = N := by + classical + ext w + simp only [N, M, Finsupp.add_apply, Finsupp.single_apply] + split <;> omega + rw [heq] + simpa [Nat.succ_mul] using htotal + +theorem finiteDimensional_add_effective (D E : DivisorA k K) + (hE : IsEffective k K E) [FiniteDimensional k (RRspace k K D)] : + FiniteDimensional k (RRspace k K (D + E)) := by + classical + induction E using Finsupp.induction generalizing D with + | zero => + rw [add_zero] + infer_instance + | single_add a b f ha hb ih => + have hfa : f a = 0 := Finsupp.notMem_support_iff.mp ha + have hff : IsEffective k K f := by + intro w + by_cases hw : w = a + · subst w + rw [hfa] + · have hwE := hE w + simpa [Finsupp.single_apply, hw] using hwE + have hb0 : 0 ≤ b := by + have haE := hE a + simpa [Finsupp.single_apply, hfa] using haE + letI : FiniteDimensional k (RRspace k K (D + f)) := ih D hff + have hsingle := finiteDimensional_add_single_nat k K (D + f) a b.toNat + have hbcast : (b.toNat : ℤ) = b := Int.toNat_of_nonneg hb0 + have heq : D + (Finsupp.single a b + f) = + (D + f) + Finsupp.single a (b.toNat : ℤ) := by + rw [hbcast] + abel + rw [heq] + exact hsingle + +theorem finrankRRspaceDiff_add_effective_le (D E : DivisorA k K) + (hE : IsEffective k K E) [FiniteDimensional k (RRspace k K D)] : + finrankRRspaceDiff k K D (D + E) ≤ (deg k K E).toNat := by + classical + induction E using Finsupp.induction generalizing D with + | zero => + rw [add_zero, finrankRRspaceDiff] + have hp : Submodule.comap (RRspace k K D).subtype (RRspace k K D) = ⊤ := by + ext f + simp + rw [hp, deg_zero] + have h := Submodule.finrank_quotient_add_finrank + (⊤ : Submodule k (RRspace k K D)) + simp only [finrank_top] at h + omega + | single_add a b f ha hb ih => + have hfa : f a = 0 := Finsupp.notMem_support_iff.mp ha + have hff : IsEffective k K f := by + intro w + by_cases hw : w = a + · subst w + rw [hfa] + · have hwE := hE w + simpa [Finsupp.single_apply, hw] using hwE + have hb0 : 0 ≤ b := by + have haE := hE a + simpa [Finsupp.single_apply, hfa] using haE + let M := D + f + let N := M + Finsupp.single a (b.toNat : ℤ) + letI : FiniteDimensional k (RRspace k K M) := + finiteDimensional_add_effective k K D f hff + letI : FiniteDimensional k (RRspace k K N) := + finiteDimensional_add_single_nat k K M a b.toNat + have hDM : D ≤ M := by + intro w + dsimp only [M] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (hff w) + have hMN : M ≤ N := by + intro w + dsimp only [N] + simp only [Finsupp.add_apply] + exact le_add_of_nonneg_right (by + simp only [Finsupp.single_apply] + split <;> omega) + have hDN : D ≤ N := hDM.trans hMN + have hsumDM := finrankRRspaceDiff_add_finrank_of_finite k K hDM + have hsumMN := finrankRRspaceDiff_add_finrank_of_finite k K hMN + have hsumDN := finrankRRspaceDiff_add_finrank_of_finite k K hDN + have hfirst := ih D hff + change finrankRRspaceDiff k K D M ≤ (deg k K f).toNat at hfirst + have hsecond := finrankRRspaceDiff_single_nat_le k K M a b.toNat + change finrankRRspaceDiff k K M N ≤ b.toNat * placeDegree k K a at hsecond + have hbcast : (b.toNat : ℤ) = b := Int.toNat_of_nonneg hb0 + have hdegf : 0 ≤ deg k K f := deg_nonneg k K hff + have hdegE : deg k K (Finsupp.single a b + f) = + b * (placeDegree k K a : ℤ) + deg k K f := by + rw [deg_add] + simp [deg] + have hdegE0 : 0 ≤ deg k K (Finsupp.single a b + f) := deg_nonneg k K hE + have hdegNat : (deg k K (Finsupp.single a b + f)).toNat = + b.toNat * placeDegree k K a + (deg k K f).toNat := by + have hfcast : ((deg k K f).toNat : ℤ) = deg k K f := + Int.toNat_of_nonneg hdegf + have hEcast : ((deg k K (Finsupp.single a b + f)).toNat : ℤ) = + deg k K (Finsupp.single a b + f) := Int.toNat_of_nonneg hdegE0 + apply Int.ofNat_injective + change ((deg k K (Finsupp.single a b + f)).toNat : ℤ) = + ((b.toNat * placeDegree k K a + (deg k K f).toNat : ℕ) : ℤ) + rw [hEcast, Nat.cast_add, Nat.cast_mul, hbcast, hfcast] + exact hdegE + have htotal : finrankRRspaceDiff k K D N ≤ + (deg k K (Finsupp.single a b + f)).toNat := by omega + have heq : D + (Finsupp.single a b + f) = N := by + dsimp only [N, M] + rw [hbcast] + abel + rw [heq] + exact htotal + +omit [Algebra k K] [IsScalarTower k k[X] K] in +theorem deg_principalDivisor_eq_zero (x : Kˣ) : + deg k K (principalDivisorA k K (Additive.ofMul x)) = 0 := by + exact deg_principalDivisorA_eq_zero k K x + +theorem RRspace_neg_deg {D : DivisorA k K} (h : deg k K D < 0) : + RRspace k K D = ⊥ := by + apply le_antisymm + · intro f hf + rw [Submodule.mem_bot] + by_contra hf0 + let x : Kˣ := Units.mk0 f hf0 + have hdiv : -D ≤ principalDivisorA k K (Additive.ofMul x) := by + intro v + have hv := hf v + have hxval := placeValuation_eq_exp_neg_principalDivisor k K (Additive.ofMul x) v + change placeValuation k K v f ≤ WithZero.exp (D v) at hv + change placeValuation k K v f = + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) at hxval + rw [hxval] at hv + have hexp := WithZero.exp_le_exp.mp hv + simp only [Finsupp.neg_apply] + omega + have hdeg := deg_mono k K hdiv + rw [deg_neg, deg_principalDivisor_eq_zero k K x] at hdeg + omega + · exact bot_le + +theorem RRspace_neg_deg_ell {D : DivisorA k K} (h : deg k K D < 0) : ell k K D = 0 := by + show Module.finrank k (RRspace k K D) = 0 + rw [RRspace_neg_deg k K h] + exact finrank_bot k K + +theorem finiteDimensional_RRspace_aux (D : DivisorA k K) : + FiniteDimensional k (RRspace k K D) := by + classical + let v : PlaceA k K := Classical.choice (nonempty_placeA k K) + let n : ℕ := (deg k K D).toNat + 1 + let D₀ : DivisorA k K := D - Finsupp.single v (n : ℤ) + have hdegSingle : deg k K (Finsupp.single v (n : ℤ)) = + (n : ℤ) * placeDegree k K v := by + simp [deg] + have hnpos : 0 < (n : ℤ) := by + dsimp only [n] + omega + have hvpos : 0 < (placeDegree k K v : ℤ) := by + exact_mod_cast placeDegree_pos k K v + have hdegDle : deg k K D < (n : ℤ) * placeDegree k K v := by + by_cases hdeg0 : 0 ≤ deg k K D + · have hcast : ((deg k K D).toNat : ℤ) = deg k K D := + Int.toNat_of_nonneg hdeg0 + have hdlt : deg k K D < (n : ℤ) := by + dsimp only [n] + push_cast + omega + have hnle : (n : ℤ) ≤ (n : ℤ) * placeDegree k K v := by + have hvone : (1 : ℤ) ≤ placeDegree k K v := by omega + simpa only [mul_one] using mul_le_mul_of_nonneg_left hvone hnpos.le + exact hdlt.trans_le hnle + · have hprod : 0 < (n : ℤ) * placeDegree k K v := + mul_pos hnpos hvpos + omega + have hD₀neg : deg k K D₀ < 0 := by + dsimp only [D₀] + rw [deg_sub, hdegSingle] + omega + have hbot := RRspace_neg_deg k K hD₀neg + letI : FiniteDimensional k (RRspace k K D₀) := by + rw [hbot] + infer_instance + have hfin := finiteDimensional_add_single_nat k K D₀ v n + have heq : D₀ + Finsupp.single v (n : ℤ) = D := by + dsimp only [D₀] + abel + rw [heq] at hfin + exact hfin + +/-- The local residue-field estimate for an increment of Riemann–Roch spaces. -/ +theorem finrank_RRspace_quotient_le {D D' : DivisorA k K} (h : D ≤ D') : + finrankRRspaceDiff k K D D' ≤ (deg k K (D' - D)).toNat := by + letI : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D + have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp h + have hrank := finrankRRspaceDiff_add_effective_le k K D (D' - D) hE + have heq : D + (D' - D) = D' := by abel + rw [heq] at hrank + exact hrank + +/-- A function integral at every coordinate place is algebraic over the constant field. -/ +theorem isAlgebraic_of_placeValuation_le_one (f : K) + (hf : ∀ v : PlaceA k K, placeValuation k K v f ≤ 1) : IsAlgebraic k f := by + by_cases hf0 : f = 0 + · subst f + exact isAlgebraic_zero + have hfin := IsDedekindDomain.HeightOneSpectrum.mem_integers_of_valuation_le_one + (R := ringOfIntegers k K) K f (fun v => hf (Sum.inl v)) + have hinf := IsDedekindDomain.HeightOneSpectrum.mem_integers_of_valuation_le_one + (R := infiniteIntegers k K) K f (fun v => hf (Sum.inr v)) + obtain ⟨a, ha⟩ := hfin + obtain ⟨b, hb⟩ := hinf + let p : k[X][X] := minpoly k[X] a + let q : (inftyValuationSubring k)[X] := minpoly (inftyValuationSubring k) b + have hpmap : minpoly k⟮X⟯ f = p.map (algebraMap k[X] k⟮X⟯) := by + rw [← ha] + exact minpoly.isIntegrallyClosed_eq_field_fractions k⟮X⟯ K + (Algebra.IsIntegral.isIntegral a) + have hqmap : minpoly k⟮X⟯ f = + q.map (algebraMap (inftyValuationSubring k) k⟮X⟯) := by + rw [← hb] + exact minpoly.isIntegrallyClosed_eq_field_fractions k⟮X⟯ K + (Algebra.IsIntegral.isIntegral b) + have hpcoeff : ∀ i, p.coeff i ∈ Set.range (Polynomial.C : k →+* k[X]) := by + intro i + let c := p.coeff i + have hcval : RatFunc.inftyValuation k (algebraMap k[X] k⟮X⟯ c) ≤ 1 := by + have hc : algebraMap k[X] k⟮X⟯ c = + algebraMap (inftyValuationSubring k) k⟮X⟯ (q.coeff i) := by + have hc' := congrArg (fun r : k⟮X⟯[X] => r.coeff i) (hpmap.symm.trans hqmap) + simpa [p, q, c] using hc' + rw [hc] + exact (q.coeff i).property + by_cases hc0 : c = 0 + · refine ⟨0, ?_⟩ + change Polynomial.C 0 = c + simp [hc0] + have hdeg : c.natDegree = 0 := by + rw [RatFunc.inftyValuation_apply, RatFunc.inftyValuation.polynomial (F := k) hc0, + ← WithZero.exp_zero, WithZero.exp_le_exp] at hcval + omega + exact ⟨c.coeff 0, (Polynomial.eq_C_of_natDegree_eq_zero hdeg).symm⟩ + have hprange : p ∈ (Polynomial.mapRingHom (Polynomial.C : k →+* k[X])).range := by + rw [Polynomial.mem_map_range] + exact hpcoeff + obtain ⟨P, hP⟩ := hprange + have hP0 : P ≠ 0 := by + intro hP0 + rw [hP0, map_zero] at hP + have hpmonic : p.Monic := minpoly.monic (Algebra.IsIntegral.isIntegral a) + exact hpmonic.ne_zero hP.symm + refine ⟨P, hP0, ?_⟩ + have hroot : Polynomial.aeval a p = 0 := minpoly.aeval _ _ + rw [← hP] at hroot + change Polynomial.aeval a (P.map (Polynomial.C : k →+* k[X])) = 0 at hroot + calc + Polynomial.aeval f P = Polynomial.aeval f + (P.map (Polynomial.C : k →+* k[X])) := by + symm + exact Polynomial.aeval_map_algebraMap k[X] f P + _ = algebraMap (ringOfIntegers k K) K + (Polynomial.aeval a (P.map (Polynomial.C : k →+* k[X]))) := by + rw [← ha] + symm + simp + _ = 0 := by rw [hroot, map_zero] + +theorem ell_zero [IsFullConstantField k K] : ell k K (0 : DivisorA k K) = 1 := by + let φ : k →ₗ[k] RRspace k K (0 : DivisorA k K) := + { toFun := fun c => ⟨algebraMap k K c, by + intro v + simpa using placeValuation_algebraMap_le_one k K v c⟩ + map_add' := fun x y => Subtype.ext (map_add (algebraMap k K) x y) + map_smul' := fun c x => Subtype.ext (by simp [Algebra.smul_def]) } + have hφ : Function.Bijective φ := by + constructor + · intro c d hcd + apply (algebraMap k K).injective + exact congrArg Subtype.val hcd + · intro f + have hfalg : IsAlgebraic k (f : K) := by + apply isAlgebraic_of_placeValuation_le_one k K f + intro v + simpa [memRRspace] using f.property v + obtain ⟨c, hc⟩ := IsFullConstantField.algebraic_mem + (k := k) (K := K) (f : K) hfalg + refine ⟨c, Subtype.ext ?_⟩ + exact hc.symm + let e : k ≃ₗ[k] RRspace k K (0 : DivisorA k K) := LinearEquiv.ofBijective φ hφ + change Module.finrank k (RRspace k K (0 : DivisorA k K)) = 1 + rw [← e.finrank_eq] + exact Module.finrank_self k + +instance finiteDimensional_RRspace (D : DivisorA k K) : + FiniteDimensional k (RRspace k K D) := by + exact finiteDimensional_RRspace_aux k K D + +/-- Rank-nullity for an inclusion of Riemann–Roch spaces. -/ +theorem finrankRRspaceDiff_add_ell {D D' : DivisorA k K} (h : D ≤ D') : + finrankRRspaceDiff k K D D' + ell k K D = ell k K D' := by + letI : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ + letI : Module k (RRspace k K D') := Submodule.module _ + rw [finrankRRspaceDiff, ell, ell, + ← (Submodule.comapSubtypeEquivOfLe (RRspace_mono k K h)).finrank_eq] + exact Submodule.finrank_quotient_add_finrank _ + +theorem ell_le [IsFullConstantField k K] (D : DivisorA k K) : + (ell k K D : ℤ) ≤ deg k K (D ⊔ 0) + 1 := by + let E := D ⊔ 0 + have h0E : (0 : DivisorA k K) ≤ E := le_sup_right + have hDE : D ≤ E := le_sup_left + have hdegE : 0 ≤ deg k K E := deg_nonneg k K h0E + have hq := finrank_RRspace_quotient_le k K h0E + have hsum := finrankRRspaceDiff_add_ell k K h0E + have hmono : ell k K D ≤ ell k K E := by + exact Submodule.finrank_mono (RRspace_mono k K hDE) + rw [ell_zero k K] at hsum + have htoNat : ((deg k K E).toNat : ℤ) = deg k K E := Int.toNat_of_nonneg hdegE + have hqZ : (finrankRRspaceDiff k K 0 E : ℤ) ≤ + ((deg k K (E - 0)).toNat : ℤ) := by exact_mod_cast hq + simp only [sub_zero] at hqZ + rw [htoNat] at hqZ + change (ell k K D : ℤ) ≤ deg k K E + 1 + omega + +theorem ell_le_nonneg [IsFullConstantField k K] {D : DivisorA k K} (hD : 0 ≤ D) : + (ell k K D : ℤ) ≤ deg k K D + 1 := by + simpa [sup_eq_left.mpr hD] using ell_le k K D + +theorem defect_mono {D D' : DivisorA k K} (h : D ≤ D') : + deg k K D - ell k K D ≤ deg k K D' - ell k K D' := by + have hdeg : 0 ≤ deg k K (D' - D) := + deg_nonneg k K ((le_iff_sub_effective k K).mp h) + have hq := finrank_RRspace_quotient_le k K h + have hsum := finrankRRspaceDiff_add_ell k K h + have htoNat : ((deg k K (D' - D)).toNat : ℤ) = deg k K (D' - D) := + Int.toNat_of_nonneg hdeg + have hqZ : (finrankRRspaceDiff k K D D' : ℤ) ≤ + ((deg k K (D' - D)).toNat : ℤ) := by exact_mod_cast hq + rw [deg_sub] at htoNat + rw [deg_sub] at hqZ + rw [htoNat] at hqZ + omega + +end FunctionField.Chart diff --git a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean new file mode 100644 index 0000000000..a3ccaec1d8 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean @@ -0,0 +1,38 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential + +/-! +# The Riemann–Roch theorem +This is pure packaging of the duality theorem together with the definition of the index of +specialty. +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] + +/-- **Riemann–Roch** (Stichtenoth Thm. 1.5.15): for a canonical divisor `W`, + +`ℓ(D) = deg D + 1 − g + ℓ(W − D)`. -/ +theorem riemann_roch {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) : + (ell k K D : ℤ) = deg k K D + 1 - (genus k K : ℤ) + ell k K (W - D) := by + have hi := indexOfSpecialty_eq k K D + have hdual := indexOfSpecialty_eq_ell_sub k K hW D + omega + +end FunctionField.Chart diff --git a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean new file mode 100644 index 0000000000..e803aa11c8 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean @@ -0,0 +1,515 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Basic +public import LeanPool.MarkoffModP.RiemannRoch.LinearKneser + +import Mathlib.Algebra.Module.Submodule.Union + +/-! +# Corollaries of Riemann–Roch +Standard consequences of the main theorem, including C5 (Clifford) and C6 (existence of +non-special divisors). +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] [IsFullConstantField k K] + +section Canonical + +variable {W : DivisorA k K} (hW : IsCanonical k K W) + +include hW + +/-- **C1**: for a canonical divisor, `ℓ(W) = g`. -/ +theorem ell_canonical : ell k K W = genus k K := by + have hRR := riemann_roch k K hW (0 : DivisorA k K) + rw [ell_zero k K, deg_zero, zero_add, sub_zero] at hRR + omega + +/-- **C2**: `deg W = 2g − 2`. -/ +theorem deg_canonical : deg k K W = 2 * (genus k K : ℤ) - 2 := by + have hRR := riemann_roch k K hW W + rw [sub_self, ell_zero k K, ell_canonical k K hW] at hRR + omega + +/-- **C3**: if `deg D ≥ 2g − 1` then `ℓ(D) = deg D + 1 − g`. -/ +theorem ell_eq_of_deg_ge (D : DivisorA k K) (hdeg : deg k K D ≥ 2 * (genus k K : ℤ) - 1) : + (ell k K D : ℤ) = deg k K D + 1 - (genus k K : ℤ) := by + have hcanonical := deg_canonical k K hW + have hneg : deg k K (W - D) < 0 := by + rw [deg_sub, hcanonical] + omega + have hell := RRspace_neg_deg_ell k K hneg + rw [riemann_roch k K hW D, hell, Int.ofNat_zero, add_zero] + +/-- **C4**: index-of-specialty language matches `ℓ(W − D)`. -/ +theorem indexOfSpecialty_eq_ell (D : DivisorA k K) : + (indexOfSpecialty k K D : ℤ) = ell k K (W - D) := by + exact indexOfSpecialty_eq_ell_sub k K hW D + +end Canonical + +/-- The specialty index vanishes in degree at least `2g - 1`. -/ +theorem indexOfSpecialty_eq_zero_of_large_deg (D : DivisorA k K) + (hdeg : deg k K D ≥ 2 * (genus k K : ℤ) - 1) : + indexOfSpecialty k K D = 0 := by + obtain ⟨W, hW⟩ := exists_isCanonical k K + have hell := ell_eq_of_deg_ge k K hW D hdeg + have hi := indexOfSpecialty_eq k K D + omega + +/-- The specialty index vanishes above a uniform degree bound. -/ +theorem indexOfSpecialty_eq_zero_of_le_deg : + ∃ c : ℤ, ∀ D : DivisorA k K, c ≤ deg k K D → indexOfSpecialty k K D = 0 := by + exact ⟨2 * (genus k K : ℤ) - 1, fun D hD => + indexOfSpecialty_eq_zero_of_large_deg k K D hD⟩ + +omit [IsFullConstantField k K] in +/-- A positive-dimensional Riemann–Roch space supplies an effective representative of the +divisor's linear-equivalence class. -/ +theorem exists_effective_add_principal_of_ell_pos (D : DivisorA k K) + (hD : 0 < ell k K D) : + ∃ x : Kˣ, IsEffective k K + (D + principalDivisorA k K (Additive.ofMul x)) := by + letI : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D + obtain ⟨f, hf⟩ := (Module.finrank_pos_iff_exists_ne_zero (R := k) + (M := RRspace k K D)).mp hD + have hfval : (f : K) ≠ 0 := by + intro h + apply hf + exact Subtype.ext h + let x : Kˣ := Units.mk0 (f : K) hfval + refine ⟨x, ?_⟩ + have hle : (0 : DivisorA k K) ≤ + D + principalDivisorA k K (Additive.ofMul x) := + le_add_principal_of_memRRspace (k := k) (K := K) + (D₀ := (0 : DivisorA k K)) (D₁ := D) hfval + (by simpa only [sub_zero] using + ((mem_RRspace_iff k K D (f : K)).mp f.property)) + exact hle + +omit [IsFullConstantField k K] in +/-- Riemann–Roch spaces preserve infima of divisors. -/ +theorem RRspace_inf (D E : DivisorA k K) : + RRspace k K (D ⊓ E) = RRspace k K D ⊓ RRspace k K E := by + ext f + simp only [Submodule.mem_inf, mem_RRspace_iff] + constructor + · intro hf + exact ⟨memRRspace.memRRspace_mono (k := k) (K := K) inf_le_left hf, + memRRspace.memRRspace_mono (k := k) (K := K) inf_le_right hf⟩ + · rintro ⟨hD, hE⟩ v + change placeValuation k K v f ≤ WithZero.exp ((D ⊓ E) v) + rw [Finsupp.inf_apply] + by_cases h : D v ≤ E v + · rw [inf_eq_left.mpr h] + exact hD v + · rw [inf_eq_right.mpr (le_of_not_ge h)] + exact hE v + +omit [IsFullConstantField k K] in +/-- The sum of two Riemann–Roch spaces lies in the space of the supremum divisor. -/ +theorem RRspace_sup_le (D E : DivisorA k K) : + RRspace k K D ⊔ RRspace k K E ≤ RRspace k K (D ⊔ E) := by + rw [sup_le_iff] + exact ⟨RRspace_mono k K le_sup_left, RRspace_mono k K le_sup_right⟩ + +omit [IsFullConstantField k K] in +/-- Riemann–Roch dimension is submodular on the divisor lattice. -/ +theorem ell_submodular (D E : DivisorA k K) : + ell k K D + ell k K E ≤ ell k K (D ⊔ E) + ell k K (D ⊓ E) := by + letI : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D + letI : FiniteDimensional k (RRspace k K E) := finiteDimensional_RRspace_aux k K E + have hsup : Module.finrank k ↑(RRspace k K D ⊔ RRspace k K E) ≤ + Module.finrank k (RRspace k K (D ⊔ E)) := + Submodule.finrank_mono (RRspace_sup_le k K D E) + have hdim := Submodule.finrank_sup_add_finrank_inf_eq + (RRspace k K D) (RRspace k K E) + rw [← RRspace_inf k K D E] at hdim + dsimp only [ell] + omega + +omit [IsFullConstantField k K] in +/-- Every positive-dimensional complete linear system has a representative minimal under +removing one copy of any place. -/ +theorem exists_minimal_RRspace (A : DivisorA k K) (hA : 0 < ell k K A) : + ∃ D₀ : DivisorA k K, D₀ ≤ A ∧ RRspace k K D₀ = RRspace k K A ∧ + ∀ v : PlaceA k K, ell k K (D₀ - Finsupp.single v 1) < ell k K D₀ := by + let S : Set ℕ := {n | ∃ D : DivisorA k K, + D ≤ A ∧ RRspace k K D = RRspace k K A ∧ deg k K D = (n : ℤ)} + have hdegA : 0 ≤ deg k K A := by + obtain ⟨x, hx⟩ := exists_effective_add_principal_of_ell_pos k K A hA + have hdeg := deg_nonneg k K hx + rw [deg_add, deg_principalDivisor_eq_zero k K x, add_zero] at hdeg + exact hdeg + have hS : S.Nonempty := by + refine ⟨(deg k K A).toNat, A, le_rfl, rfl, ?_⟩ + exact (Int.toNat_of_nonneg hdegA).symm + obtain ⟨D₀, hD₀A, hspace, hdegD₀⟩ := Nat.sInf_mem hS + refine ⟨D₀, hD₀A, hspace, fun v => ?_⟩ + have hle : D₀ - Finsupp.single v 1 ≤ D₀ := by + intro w + simp only [Finsupp.sub_apply] + exact sub_le_self _ (Finsupp.single_nonneg.mpr (by omega) w) + have hell_le : ell k K (D₀ - Finsupp.single v 1) ≤ ell k K D₀ := + Submodule.finrank_mono (RRspace_mono k K hle) + rw [lt_iff_le_and_ne] + refine ⟨hell_le, ?_⟩ + intro hell_eq + haveI : FiniteDimensional k (RRspace k K D₀) := finiteDimensional_RRspace_aux k K D₀ + have hspace_sub : RRspace k K (D₀ - Finsupp.single v 1) = RRspace k K D₀ := + Submodule.eq_of_le_of_finrank_eq (RRspace_mono k K hle) hell_eq + have hdegsub_nonneg : 0 ≤ deg k K (D₀ - Finsupp.single v 1) := by + have hpos : 0 < ell k K (D₀ - Finsupp.single v 1) := by + rw [hell_eq] + dsimp only [ell] at hA ⊢ + rw [hspace] + exact hA + obtain ⟨x, hx⟩ := exists_effective_add_principal_of_ell_pos k K _ hpos + have hdeg := deg_nonneg k K hx + rw [deg_add, deg_principalDivisor_eq_zero k K x, add_zero] at hdeg + exact hdeg + let m := (deg k K (D₀ - Finsupp.single v 1)).toNat + have hmcast : (m : ℤ) = deg k K (D₀ - Finsupp.single v 1) := + Int.toNat_of_nonneg hdegsub_nonneg + have hmS : m ∈ S := by + refine ⟨D₀ - Finsupp.single v 1, hle.trans hD₀A, ?_, hmcast.symm⟩ + exact hspace_sub.trans hspace + have hmin := Nat.sInf_le hmS + have hdegdrop : deg k K (D₀ - Finsupp.single v 1) < deg k K D₀ := by + rw [deg_sub, deg_single] + have hv := placeDegree_pos k K v + omega + rw [hdegD₀, ← hmcast] at hdegdrop + exact (not_lt_of_ge hmin) (by exact_mod_cast hdegdrop) + +omit [IsFullConstantField k K] in +/-- Over an infinite constant field, finitely many one-place drops from a minimal complete +linear system can be avoided simultaneously. -/ +theorem exists_RRspace_avoiding [Infinite k] (D₀ : DivisorA k K) + (s : Finset (PlaceA k K)) + (hdrop : ∀ v ∈ s, ell k K (D₀ - Finsupp.single v 1) < ell k K D₀) : + ∃ z : RRspace k K D₀, ∀ v ∈ s, + (z : K) ∉ RRspace k K (D₀ - Finsupp.single v 1) := by + let p : {v // v ∈ s} → Submodule k (RRspace k K D₀) := fun v => + Submodule.comap (RRspace k K D₀).subtype + (RRspace k K (D₀ - Finsupp.single v.1 1)) + have hp : ∀ v, p v ≠ ⊤ := by + intro v hv + have hrev : RRspace k K D₀ ≤ RRspace k K (D₀ - Finsupp.single v.1 1) := + Submodule.comap_subtype_eq_top.mp hv + have hle : D₀ - Finsupp.single v.1 1 ≤ D₀ := by + intro w + simp only [Finsupp.sub_apply] + exact sub_le_self _ (Finsupp.single_nonneg.mpr (by omega) w) + have heq : RRspace k K (D₀ - Finsupp.single v.1 1) = RRspace k K D₀ := + le_antisymm (RRspace_mono k K hle) hrev + have hell : ell k K (D₀ - Finsupp.single v.1 1) = ell k K D₀ := by + dsimp only [ell] + rw [heq] + exact (ne_of_lt (hdrop v.1 v.2)) hell + obtain ⟨z, hz⟩ := Submodule.exists_forall_notMem_of_forall_ne_top p hp + refine ⟨z, fun v hv hmem => ?_⟩ + exact hz ⟨v, hv⟩ (by + simpa only [p, Submodule.mem_comap, Submodule.coe_subtype] using hmem) + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +/-- Membership of a nonzero function in `L(D)` expressed coefficientwise through its principal +divisor. -/ +theorem memRRspace_iff_neg_principalDivisor_le {D : DivisorA k K} {f : K} + (hf : f ≠ 0) : + memRRspace k K D f ↔ ∀ v, -(principalDivisorA k K + (Additive.ofMul (Units.mk0 f hf)) v) ≤ D v := by + constructor + · intro h v + have hv := h v + have hval := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul (Units.mk0 f hf)) v + change placeValuation k K v f ≤ WithZero.exp (D v) at hv + change placeValuation k K v f = WithZero.exp + (-(principalDivisorA k K (Additive.ofMul (Units.mk0 f hf)) v)) at hval + rw [hval] at hv + exact WithZero.exp_le_exp.mp hv + · intro h v + have hval := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul (Units.mk0 f hf)) v + change placeValuation k K v f ≤ WithZero.exp (D v) + change placeValuation k K v f = WithZero.exp + (-(principalDivisorA k K (Additive.ofMul (Units.mk0 f hf)) v)) at hval + rw [hval] + exact WithZero.exp_le_exp.mpr (h v) + +/-- If multiplication by a section that is exact at every place in `supp B` creates no new +poles, the other factor is constant. -/ +theorem eq_algebraMap_of_mul_mem {D₀ B : DivisorA k K} (hB0 : B ≠ 0) {z x : K} + (hz : memRRspace k K D₀ z) + (havoid : ∀ v ∈ B.support, z ∉ RRspace k K (D₀ - Finsupp.single v 1)) + (hx : memRRspace k K B x) (hmul : memRRspace k K D₀ (x * z)) : + ∃ c : k, x = algebraMap k K c := by + have hsupp : B.support.Nonempty := Finsupp.support_nonempty_iff.mpr hB0 + obtain ⟨v₀, hv₀⟩ := hsupp + have hz0 : z ≠ 0 := by + intro hz0 + subst z + exact havoid v₀ hv₀ (memRRspace.zero_mem (k := k) (K := K) _) + by_cases hx0 : x = 0 + · exact ⟨0, by simp [hx0]⟩ + have hxz0 : x * z ≠ 0 := mul_ne_zero hx0 hz0 + let ux : Kˣ := Units.mk0 x hx0 + let uz : Kˣ := Units.mk0 z hz0 + let uxz : Kˣ := Units.mk0 (x * z) hxz0 + have hxdiv := (memRRspace_iff_neg_principalDivisor_le k K hx0).mp hx + have hzdiv := (memRRspace_iff_neg_principalDivisor_le k K hz0).mp hz + have hmuldiv := (memRRspace_iff_neg_principalDivisor_le k K hxz0).mp hmul + change ∀ v, -(principalDivisorA k K (Additive.ofMul ux) v) ≤ B v at hxdiv + change ∀ v, -(principalDivisorA k K (Additive.ofMul uz) v) ≤ D₀ v at hzdiv + change ∀ v, -(principalDivisorA k K (Additive.ofMul uxz) v) ≤ D₀ v at hmuldiv + have hvalx : ∀ v : PlaceA k K, placeValuation k K v x ≤ 1 := by + intro v + have hdivx : 0 ≤ principalDivisorA k K (Additive.ofMul ux) v := by + by_cases hv : v ∈ B.support + · have hzexact : -(principalDivisorA k K (Additive.ofMul uz) v) = D₀ v := by + have hle := hzdiv v + have hnle : ¬ -(principalDivisorA k K (Additive.ofMul uz) v) ≤ D₀ v - 1 := by + intro hsmall + apply havoid v hv + rw [mem_RRspace_iff] + apply (memRRspace_iff_neg_principalDivisor_le k K hz0).mpr + intro w + by_cases hw : w = v + · subst w + simpa using hsmall + · simpa [Finsupp.single_apply, hw] using hzdiv w + omega + have hdivmul : principalDivisorA k K (Additive.ofMul uxz) v = + principalDivisorA k K (Additive.ofMul ux) v + + principalDivisorA k K (Additive.ofMul uz) v := by + have hu : uxz = ux * uz := by + apply Units.ext + rfl + rw [hu, ofMul_mul, (principalDivisorA k K).map_add, Finsupp.add_apply] + have hp := hmuldiv v + rw [hdivmul] at hp + omega + · have hBv : B v = 0 := Finsupp.notMem_support_iff.mp hv + have hp := hxdiv v + rw [hBv] at hp + omega + have hval := placeValuation_eq_exp_neg_principalDivisor k K + (Additive.ofMul ux) v + change placeValuation k K v x = WithZero.exp + (-(principalDivisorA k K (Additive.ofMul ux) v)) at hval + rw [hval, ← WithZero.exp_zero] + exact WithZero.exp_le_exp.mpr (by omega) + exact IsFullConstantField.algebraic_mem (k := k) (K := K) x + (isAlgebraic_of_placeValuation_le_one k K x hvalx) + +/-- Stichtenoth's key Clifford inequality for an effective nonzero second divisor and a first +divisor minimal under one-place drops. -/ +theorem ell_add_ell_le_of_effective_minimal [Infinite k] + (D₀ B : DivisorA k K) (hB : IsEffective k K B) (hB0 : B ≠ 0) + (hdrop : ∀ v ∈ B.support, + ell k K (D₀ - Finsupp.single v 1) < ell k K D₀) : + ell k K D₀ + ell k K B ≤ 1 + ell k K (D₀ + B) := by + obtain ⟨z, hzavoid⟩ := exists_RRspace_avoiding k K D₀ B.support hdrop + let T := RRspace k K (D₀ + B) + let P : Submodule k T := Submodule.comap T.subtype (RRspace k K D₀) + let mulZ : RRspace k K B →ₗ[k] T := { + toFun x := ⟨(x : K) * (z : K), by + rw [mem_RRspace_iff] + simpa only [add_comm] using memRRspace.mul_mem (k := k) (K := K) + ((mem_RRspace_iff k K B (x : K)).mp x.property) + ((mem_RRspace_iff k K D₀ (z : K)).mp z.property)⟩ + map_add' x y := Subtype.ext (add_mul (x : K) (y : K) (z : K)) + map_smul' c x := Subtype.ext (by + simp only [Submodule.coe_smul_of_tower, RingHom.id_apply, Algebra.smul_def] + ring) } + let φ : RRspace k K B →ₗ[k] T ⧸ P := P.mkQ.comp mulZ + have hone_mem : memRRspace k K B (1 : K) := + memRRspace.memRRspace_mono (k := k) (K := K) (show (0 : DivisorA k K) ≤ B from hB) + (memRRspace.one_mem (k := k) (K := K)) + let oneB : RRspace k K B := ⟨1, hone_mem⟩ + have hker_le : φ.ker ≤ k ∙ oneB := by + intro x hxker + have hq : P.mkQ (mulZ x) = 0 := by + exact hxker + have hp : mulZ x ∈ P := Submodule.Quotient.mk_eq_zero P |>.mp hq + have hmul : memRRspace k K D₀ ((x : K) * (z : K)) := by + exact hp + obtain ⟨c, hc⟩ := eq_algebraMap_of_mul_mem k K hB0 + ((mem_RRspace_iff k K D₀ (z : K)).mp z.property) hzavoid + ((mem_RRspace_iff k K B (x : K)).mp x.property) hmul + have hxeq : x = c • oneB := by + apply Subtype.ext + simp only [Submodule.coe_smul_of_tower, oneB, Algebra.smul_def] + rw [hc, mul_one] + rw [hxeq] + exact Submodule.smul_mem _ c (Submodule.mem_span_singleton_self oneB) + have hker_ge : k ∙ oneB ≤ φ.ker := by + rw [Submodule.span_singleton_le_iff_mem] + rw [LinearMap.mem_ker] + change P.mkQ (mulZ oneB) = 0 + apply (Submodule.Quotient.mk_eq_zero P).mpr + change (1 : K) * (z : K) ∈ RRspace k K D₀ + simpa only [one_mul] using z.property + have hker : φ.ker = k ∙ oneB := le_antisymm hker_le hker_ge + have honeB : oneB ≠ 0 := by + intro h + have hc := congr_arg (fun q : RRspace k K B => (q : K)) h + change (1 : K) = 0 at hc + exact one_ne_zero hc + have hfinKer : Module.finrank k φ.ker = 1 := by + rw [hker, finrank_span_singleton honeB] + have hDle : RRspace k K D₀ ≤ T := by + exact RRspace_mono k K (show D₀ ≤ D₀ + B by + intro v + simp only [Finsupp.add_apply] + linarith [hB v]) + have hmapP : P.map T.subtype = RRspace k K D₀ := by + dsimp only [P] + rw [Submodule.map_comap_subtype, inf_eq_right.mpr hDle] + have hfinP : Module.finrank k P = ell k K D₀ := by + rw [← Submodule.finrank_map_subtype_eq T P, hmapP] + rfl + letI : FiniteDimensional k (RRspace k K B) := finiteDimensional_RRspace_aux k K B + letI : FiniteDimensional k T := finiteDimensional_RRspace_aux k K (D₀ + B) + have hranknull := φ.finrank_range_add_finrank_ker + have hrange : Module.finrank k φ.range ≤ Module.finrank k (T ⧸ P) := by + simpa only [finrank_top] using + Submodule.finrank_mono (show φ.range ≤ (⊤ : Submodule k (T ⧸ P)) from le_top) + have hquot := P.finrank_quotient_add_finrank + dsimp only [ell] at hfinP + rw [hfinKer] at hranknull + rw [hfinP] at hquot + dsimp only [ell] at ⊢ + change Module.finrank k (RRspace k K D₀) + Module.finrank k (RRspace k K B) ≤ + 1 + Module.finrank k T + omega + +/-- Stichtenoth Lemma 1.6.14 over an infinite full constant field. -/ +theorem ell_add_ell_le_infinite [Infinite k] + (A B : DivisorA k K) (hA : 0 < ell k K A) (hB : 0 < ell k K B) : + ell k K A + ell k K B ≤ 1 + ell k K (A + B) := by + obtain ⟨x, hxeff⟩ := exists_effective_add_principal_of_ell_pos k K A hA + obtain ⟨y, hyeff⟩ := exists_effective_add_principal_of_ell_pos k K B hB + let A₀ := A + principalDivisorA k K (Additive.ofMul x) + let B₀ := B + principalDivisorA k K (Additive.ofMul y) + have hellA₀ : ell k K A₀ = ell k K A := ell_add_principal k K A x + have hellB₀ : ell k K B₀ = ell k K B := ell_add_principal k K B y + have hA₀pos : 0 < ell k K A₀ := hellA₀.symm ▸ hA + obtain ⟨D₀, hD₀le, hspace, hdrop⟩ := exists_minimal_RRspace k K A₀ hA₀pos + have hellD₀ : ell k K D₀ = ell k K A₀ := by + dsimp only [ell] + rw [hspace] + have hle : D₀ + B₀ ≤ A₀ + B₀ := by + intro v + simp only [Finsupp.add_apply] + linarith [hD₀le v] + have hell_mono : ell k K (D₀ + B₀) ≤ ell k K (A₀ + B₀) := + Submodule.finrank_mono (RRspace_mono k K hle) + have hsum : A₀ + B₀ = (A + B) + + principalDivisorA k K (Additive.ofMul (x * y)) := by + dsimp only [A₀, B₀] + rw [ofMul_mul, (principalDivisorA k K).map_add] + abel + have hellsum : ell k K (A₀ + B₀) = ell k K (A + B) := by + rw [hsum, ell_add_principal] + by_cases hB₀0 : B₀ = 0 + · have hellB₀one : ell k K B₀ = 1 := by + rw [hB₀0, ell_zero k K] + have hellsum0 : ell k K A₀ = ell k K (A + B) := by + simpa only [hB₀0, add_zero] using hellsum + rw [← hellA₀, ← hellB₀, hellB₀one, ← hellsum0] + omega + · have hkey := ell_add_ell_le_of_effective_minimal k K D₀ B₀ hyeff hB₀0 + (fun v _ => hdrop v) + rw [← hellA₀, ← hellB₀, ← hellsum] + omega + +/-- Stichtenoth Lemma 1.6.14 over an arbitrary full constant field. This is the +Riemann–Roch-space specialization of `mul_finrank`. -/ +theorem ell_add_ell_le (A B : DivisorA k K) (hA : 0 < ell k K A) + (hB : 0 < ell k K B) : + ell k K A + ell k K B ≤ 1 + ell k K (A + B) := by + letI : FiniteDimensional k (RRspace k K A) := finiteDimensional_RRspace_aux k K A + letI : FiniteDimensional k (RRspace k K B) := finiteDimensional_RRspace_aux k K B + have hAne : RRspace k K A ≠ ⊥ := by + intro hzero + dsimp only [ell] at hA + rw [hzero, finrank_bot] at hA + omega + have hBne : RRspace k K B ≠ ⊥ := by + intro hzero + dsimp only [ell] at hB + rw [hzero, finrank_bot] at hB + omega + have hAfg : (RRspace k K A).FG := + (Submodule.fg_top (RRspace k K A)).mp Module.Finite.fg_top + have hBfg : (RRspace k K B).FG := + (Submodule.fg_top (RRspace k K B)).mp Module.Finite.fg_top + letI : FiniteDimensional k (RRspace k K A * RRspace k K B) := + Module.Finite.of_fg (hAfg.mul hBfg) + have hproduct := mul_finrank k K (RRspace k K A) (RRspace k K B) hAne hBne + have hmul : RRspace k K A * RRspace k K B ≤ RRspace k K (A + B) := by + apply Submodule.mul_le.mpr + intro x hx y hy + rw [mem_RRspace_iff] at hx hy ⊢ + exact memRRspace.mul_mem (k := k) (K := K) hx hy + have hmono : Module.finrank k (RRspace k K A * RRspace k K B) ≤ + Module.finrank k (RRspace k K (A + B)) := + Submodule.finrank_mono hmul + dsimp only [ell] + omega + +/-- The core Clifford inequality: with `W` canonical, whenever both `ℓ(D)` and `ℓ(W − D)` are +positive, `2(ℓ(D) − 1) ≤ deg D`. The textbook degree bounds +`0 ≤ deg D ≤ 2g − 2` are **not** required — positivity of both dimensions, the linear +product bound, and Riemann–Roch suffice. -/ +theorem clifford_of_ell_pos {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) + (hℓD : 0 < ell k K D) (hℓW : 0 < ell k K (W - D)) : + 2 * ((ell k K D : ℤ) - 1) ≤ deg k K D := by + have hkey := ell_add_ell_le k K D (W - D) hℓD hℓW + have hsum : D + (W - D) = W := by abel + rw [hsum, ell_canonical k K hW] at hkey + have hRR := riemann_roch k K hW D + omega + +/-- **C5** (Clifford): if `0 ≤ deg D ≤ 2g − 2` and both `ℓ(D)` and `ℓ(W − D)` are +positive, then `2(ℓ(D) − 1) ≤ deg D`. This is the conventional textbook statement; the degree +hypotheses are kept for fidelity but are not needed for the inequality (see +`clifford_of_ell_pos`). -/ +theorem clifford {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) + (_hdeg₀ : 0 ≤ deg k K D) (_hdeg₁ : deg k K D ≤ 2 * (genus k K : ℤ) - 2) + (hℓD : 0 < ell k K D) (hℓW : 0 < ell k K (W - D)) : + 2 * ((ell k K D : ℤ) - 1) ≤ deg k K D := + clifford_of_ell_pos k K hW D hℓD hℓW + +/-- **C6** (field-independent form): a divisor attaining the maximal defect is nonspecial. +The stronger assertion that one can choose an effective divisor of degree `g` requires +additional hypotheses on the constant field and is not valid over every field. -/ +theorem exists_nonspecial_divisor : + ∃ D : DivisorA k K, indexOfSpecialty k K D = 0 := by + obtain ⟨D, hD⟩ := exists_defect_eq k K + refine ⟨D, ?_⟩ + have hi := indexOfSpecialty_eq k K D + simp only [defect] at hD + omega + +end FunctionField.Chart + +end diff --git a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean new file mode 100644 index 0000000000..6e732e6f79 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean @@ -0,0 +1,184 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import Mathlib.RingTheory.Ideal.Norm.RelNorm +public import Mathlib.FieldTheory.SeparableClosure + +/-! +# Relative norms in finite separable extensions + +Mathlib's theorem `Ideal.relNorm_eq_pow_of_isMaximal` assumes that the fraction field of the +base Dedekind domain is perfect. For function fields the needed hypothesis is instead already +available in its sharp form: the particular fraction-field extension is separable. This file +records that variant, using the same normal-closure argument as the Mathlib theorem. +-/ + +@[expose] public section + +open Module +open UniqueFactorizationMonoid +open scoped nonZeroDivisors + +namespace Ideal + + +variable {R S : Type*} [CommRing R] [CommRing S] + [IsDedekindDomain R] [IsDedekindDomain S] + [Algebra R S] [Module.Finite R S] [IsTorsionFree R S] + +/-- The relative norm of a maximal ideal in a finite separable extension is the corresponding +prime below, raised to the inertia degree. This is the separable-extension variant of +`Ideal.relNorm_eq_pow_of_isMaximal`. -/ +theorem relNorm_eq_pow_of_isMaximal_of_isSeparable + [@Algebra.IsSeparable (FractionRing R) (FractionRing S) _ _ + (FractionRing.liftAlgebra R (FractionRing S))] + (P : Ideal S) (p : Ideal R) [P.LiesOver p] [P.IsMaximal] [p.IsMaximal] : + relNorm R P = p ^ P.inertiaDeg R := by + let K := FractionRing R + let L := FractionRing S + letI : Algebra K L := FractionRing.liftAlgebra R L + let E := IntermediateField.normalClosure K L (AlgebraicClosure L) + letI : Algebra S E := ((algebraMap L E).comp (algebraMap S L)).toAlgebra + letI : IsScalarTower S L E := IsScalarTower.of_algebraMap_eq' rfl + let T : Type _ := integralClosure S E + letI : Algebra S T := inferInstance + letI : Algebra T E := inferInstance + letI : IsScalarTower S T E := inferInstance + letI : Algebra R T := ((algebraMap S T).comp (algebraMap R S)).toAlgebra + letI : IsScalarTower R S T := IsScalarTower.of_algebraMap_eq' rfl + letI : Algebra R E := ((algebraMap S E).comp (algebraMap R S)).toAlgebra + letI : IsScalarTower R S E := IsScalarTower.of_algebraMap_eq' rfl + letI : IsScalarTower R T E := IsScalarTower.to₁₃₄ R S T E + letI : FaithfulSMul R E := (faithfulSMul_iff_algebraMap_injective R E).2 <| by + rw [IsScalarTower.algebraMap_eq R S E] + exact (algebraMap L E).injective.comp (IsFractionRing.injective S L) |>.comp + (FaithfulSMul.algebraMap_injective R S) + letI : IsScalarTower R S L := inferInstance + letI : FaithfulSMul R L := inferInstance + letI : IsScalarTower R L E := IsScalarTower.to₁₃₄ R S L E + letI : IsScalarTower R K L := FractionRing.isScalarTower_liftAlgebra R L + letI : IsScalarTower R K E := IsScalarTower.to₁₂₄ R K L E + letI : IsIntegralClosure T S E := integralClosure.isIntegralClosure S E + letI : FaithfulSMul S T := (faithfulSMul_iff_algebraMap_injective S T).2 <| by + intro x y hxy + apply (algebraMap L E).injective.comp (IsFractionRing.injective S L) + exact congrArg (fun z : T => (algebraMap T E) z) hxy + letI : FaithfulSMul R T := (faithfulSMul_iff_algebraMap_injective R T).2 <| by + rw [IsScalarTower.algebraMap_eq R S T] + exact (FaithfulSMul.algebraMap_injective S T).comp + (FaithfulSMul.algebraMap_injective R S) + letI : FiniteDimensional K E := + normalClosure.is_finiteDimensional K L (AlgebraicClosure L) + letI : Algebra.IsSeparable K E := by + rw [← le_separableClosure_iff] + apply normalClosure_le_iff.mpr + intro i + haveI : Algebra.IsSeparable K i.fieldRange := + AlgEquiv.Algebra.isSeparable (AlgEquiv.ofInjectiveField i) + exact le_separableClosure K (AlgebraicClosure L) i.fieldRange + letI : Algebra.IsSeparable L E := + Algebra.isSeparable_tower_top_of_isSeparable K L E + letI : FiniteDimensional L E := Module.Finite.right K L E + letI : IsFractionRing T E := + IsIntegralClosure.isFractionRing_of_finite_extension S L E T + letI : Module.Finite S T := IsIntegralClosure.finite S L E T + letI : Module.Finite R T := Module.Finite.trans S T + letI : IsDedekindDomain T := integralClosure.isDedekindDomain S L E + letI : IsGalois K E := { + to_isSeparable := inferInstance + to_normal := normalClosure.normal K L (AlgebraicClosure L) } + let algT : Algebra T (FractionRing T) := inferInstance + letI : Algebra T (FractionRing T) := algT + letI : Algebra R (FractionRing T) := inferInstance + letI : Algebra S (FractionRing T) := inferInstance + letI : FaithfulSMul R (FractionRing T) := inferInstance + letI : FaithfulSMul S (FractionRing T) := inferInstance + letI : Algebra K (FractionRing T) := FractionRing.liftAlgebra R (FractionRing T) + letI : Algebra L (FractionRing T) := FractionRing.liftAlgebra S (FractionRing T) + letI : IsScalarTower R K (FractionRing T) := + FractionRing.isScalarTower_liftAlgebra R (FractionRing T) + letI : IsScalarTower S L (FractionRing T) := + FractionRing.isScalarTower_liftAlgebra S (FractionRing T) + letI : IsGalois K (FractionRing T) := by + refine IsGalois.of_equiv_equiv (F := K) (E := E) + (f := (FractionRing.algEquiv R K).symm.toRingEquiv) + (g := (FractionRing.algEquiv T E).symm.toRingEquiv) ?_ + ext + simpa using! IsFractionRing.algEquiv_commutes (FractionRing.algEquiv R K).symm + (FractionRing.algEquiv T E).symm _ + obtain ⟨Q, hQ₁, hQ₂⟩ : ∃ Q : Ideal T, Q.IsMaximal ∧ Q.LiesOver P := + exists_maximal_ideal_liesOver_of_isIntegral P + letI : Q.IsMaximal := hQ₁ + letI : Q.LiesOver P := hQ₂ + letI : Q.LiesOver p := LiesOver.trans Q P p + have h := relNorm_eq_pow_of_isPrime_isGalois Q p + letI : IsGalois (FractionRing S) (FractionRing T) := + IsGalois.tower_top_of_isGalois (FractionRing R) (FractionRing S) (FractionRing T) + rwa [← relNorm_relNorm R S, relNorm_eq_pow_of_isPrime_isGalois Q P, map_pow, + inertiaDeg_tower (R := R) P Q, pow_mul, + pow_left_inj (inertiaDeg_pos Q S).ne'] at h + +/-- Relative norm preserves the weighted sum of prime factors, with each prime upstairs weighted +by its inertia degree over the prime below. -/ +theorem sum_normalizedFactors_relNorm_of_isSeparable + [@Algebra.IsSeparable (FractionRing R) (FractionRing S) _ _ + (FractionRing.liftAlgebra R (FractionRing S))] + (I : Ideal S) (hI : I ≠ ⊥) (w : Ideal R → ℕ) : + ((normalizedFactors (relNorm R I)).map w).sum = + ((normalizedFactors I).map fun P => + P.inertiaDeg R * w (P.under R)).sum := by + classical + letI : Algebra (FractionRing R) (FractionRing S) := + FractionRing.liftAlgebra R (FractionRing S) + have aux : ∀ s : Multiset (Ideal S), (∀ P ∈ s, Prime P) → + ((normalizedFactors (relNorm R s.prod)).map w).sum = + (s.map fun P => P.inertiaDeg R * w (P.under R)).sum := by + intro s hs + induction s using Multiset.induction_on with + | empty => + rw [Multiset.prod_zero, map_one] + simp only [normalizedFactors_one, Multiset.map_zero, Multiset.sum_zero] + | @cons P s ih => + have hP : Prime P := hs P (Multiset.mem_cons_self P s) + have hs' : ∀ Q ∈ s, Prime Q := fun Q hQ => hs Q (Multiset.mem_cons_of_mem hQ) + have hP0 : P ≠ ⊥ := hP.ne_zero + have hs0 : s.prod ≠ ⊥ := Multiset.prod_ne_zero fun h => + (hs' ⊥ h).ne_zero rfl + let p : Ideal R := P.under R + letI : P.IsMaximal := (Ideal.isPrime_of_prime hP).isMaximal hP0 + letI : p.IsMaximal := Ideal.IsMaximal.under R P + letI : P.LiesOver p := ⟨rfl⟩ + have hp0 : p ≠ ⊥ := by + intro hp + haveI : P.LiesOver (⊥ : Ideal R) := hp ▸ (inferInstance : P.LiesOver p) + exact hP0 (Ideal.eq_bot_of_liesOver_bot R P) + have hnorm : relNorm R P = p ^ P.inertiaDeg R := + relNorm_eq_pow_of_isMaximal_of_isSeparable P p + have hnormP0 : relNorm R P ≠ ⊥ := (relNorm_eq_bot_iff.not.mpr hP0) + have hnorms0 : relNorm R s.prod ≠ ⊥ := + relNorm_eq_bot_iff.not.mpr hs0 + rw [Multiset.prod_cons, map_mul, normalizedFactors_mul hnormP0 hnorms0, + Multiset.map_add, Multiset.sum_add, hnorm, normalizedFactors_pow, + UniqueFactorizationMonoid.normalizedFactors_irreducible + (Ideal.prime_of_isPrime hp0 + (inferInstance : p.IsMaximal).isPrime).irreducible, + normalize_eq, Multiset.nsmul_singleton] + simp [ih hs', p] + let s := normalizedFactors I + have hsprod : s.prod = I := prod_normalizedFactors_eq_self hI + calc + ((normalizedFactors (relNorm R I)).map w).sum = + ((normalizedFactors (relNorm R s.prod)).map w).sum := by rw [hsprod] + _ = (s.map fun P => P.inertiaDeg R * w (P.under R)).sum := by + apply aux s + intro P hP + exact UniqueFactorizationMonoid.prime_of_normalized_factor P hP + _ = ((normalizedFactors I).map fun P => + P.inertiaDeg R * w (P.under R)).sum := rfl + +end Ideal diff --git a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean new file mode 100644 index 0000000000..b5f1f044e7 --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean @@ -0,0 +1,9 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic diff --git a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean new file mode 100644 index 0000000000..af9898284c --- /dev/null +++ b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean @@ -0,0 +1,847 @@ +/- +Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Released under Apache 2.0 license as described in the file LICENSE. +Authors: Yuma Mizuno +-/ + +module + +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic +public import LeanPool.MarkoffModP.RiemannRoch.Genus.AdeleQuotient +public import Mathlib.LinearAlgebra.Dual.Lemmas + +/-! +# Weil differentials and the duality theorem +This file defines Weil differentials, the canonical divisor class, and the duality theorem +that identifies `L(W − D)` with `Ω(D)`. + +## Main definitions + +* `FunctionField.WeilDifferential` +* `FunctionField.WeilDifferential.differentialSpace` +* `FunctionField.WeilDifferential.divOmega` +* `FunctionField.IsCanonical` + +## Main results + +* `FunctionField.WeilDifferential.finrank_weilDifferential_eq_one` +* `FunctionField.isCanonical_unique_up_to_principal` +* `FunctionField.duality` +-/ + +@[expose] public section + +open scoped nonZeroDivisors Polynomial RatFunc WithZero + +noncomputable section + +namespace FunctionField.Chart + +variable (k K : Type*) [Field k] [Field K] + +variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] + [IsScalarTower k[X] k⟮X⟯ K] [_root_.FunctionField k K] + [Algebra.IsSeparable k⟮X⟯ K] + +variable [IsFullConstantField k K] + +/-- The classical decidable equality on `k(X)` used by the coordinate places. -/ +local instance instDecidableEqRatFuncWeil : DecidableEq k⟮X⟯ := Classical.decEq _ + +attribute [local instance] adeleFiltAddCommGroup adeleFiltModule + +/-- The `k`- and `K`-scalar actions on the adele space are compatible. -/ +instance instIsScalarTowerAdeleSpace : IsScalarTower k K (AdeleSpace k K) := + ⟨fun c x a => Subtype.ext <| funext fun v => by + change (c • x) * a.val v = c • (x * a.val v) + rw [Algebra.smul_def, Algebra.smul_def, mul_assoc]⟩ + +omit [IsFullConstantField k K] in +/-- The sandwich quotient `A(D') ⧸ (A(D) + K̃) ⊓ A(D')` is finite-dimensional. -/ +theorem finite_adeleFilt_sub_quotient {D D' : DivisorA k K} (hle : D ≤ D') : + Module.Finite k ((adeleFilt k K D') ⧸ + Submodule.comap (adeleFilt k K D').subtype + (adeleFilt k K D + diagonalSubmodule k K)) := by + have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp hle + have hdiv : D + (D' - D) = D' := by abel + haveI : Module.Finite k ((adeleFilt k K D') ⧸ + Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D)) := + finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hdiv.symm hE + exact Module.Finite.equiv (Submodule.quotientQuotientEquivQuotient + (Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D)) + (Submodule.comap (adeleFilt k K D').subtype + (adeleFilt k K D + diagonalSubmodule k K)) + (Submodule.comap_mono (by + rw [Submodule.add_eq_sup] + exact le_sup_left))) + +/-- The adele class space `𝒜_K ⧸ (A(D) + K̃)` is finite-dimensional over `k`. -/ +instance finiteDimensional_adeleQuotient (D : DivisorA k K) : + FiniteDimensional k + ((AdeleSpace k K) ⧸ (adeleFilt k K D + diagonalSubmodule k K)) := by + obtain ⟨D₁, hD₁⟩ := exists_defect_eq (k := k) (K := K) + have hle : D ≤ D ⊔ D₁ := le_sup_left + have hfull : topAdeleSubmodule k K = + adeleFilt k K (D ⊔ D₁) + diagonalSubmodule k K := + adeleSubmodule_top_eq_adeleFilt_add_diagonal (k := k) (K := K) + (defect_eq_genus_of_ge (k := k) (K := K) le_sup_right hD₁) + haveI := finite_adeleFilt_sub_quotient (k := k) (K := K) hle + have hker : Submodule.comap (adeleFilt k K (D ⊔ D₁)).subtype + (adeleFilt k K D + diagonalSubmodule k K) ≤ + LinearMap.ker (((adeleFilt k K D + diagonalSubmodule k K).mkQ).comp + (adeleFilt k K (D ⊔ D₁)).subtype) := by + intro x hx + rw [LinearMap.mem_ker, LinearMap.comp_apply, Submodule.subtype_apply, + Submodule.mkQ_apply] + exact (Submodule.Quotient.mk_eq_zero _).mpr hx + refine Module.Finite.of_surjective (Submodule.liftQ _ _ hker) ?_ + intro y + obtain ⟨x, rfl⟩ := + Submodule.mkQ_surjective (adeleFilt k K D + diagonalSubmodule k K) y + have hx : x ∈ adeleFilt k K (D ⊔ D₁) + diagonalSubmodule k K := by + have hxtop : x ∈ topAdeleSubmodule k K := Submodule.mem_top + rwa [hfull] at hxtop + rcases Submodule.mem_sup.mp hx with ⟨a, ha, b, hb, rfl⟩ + refine ⟨Submodule.Quotient.mk ⟨a, ha⟩, ?_⟩ + rw [Submodule.liftQ_apply] + show (adeleFilt k K D + diagonalSubmodule k K).mkQ a = + (adeleFilt k K D + diagonalSubmodule k K).mkQ (a + b) + have hb0 : (adeleFilt k K D + diagonalSubmodule k K).mkQ b = 0 := by + rw [Submodule.mkQ_apply] + exact (Submodule.Quotient.mk_eq_zero _).mpr (Submodule.mem_sup_right hb) + rw [map_add, hb0, add_zero] + +omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in +/-- If `D ≤ D'` and `deg D' ≤ deg D`, the divisors are equal. -/ +theorem eq_of_le_of_deg_le {D D' : DivisorA k K} (h : D ≤ D') + (hdeg : deg k K D' ≤ deg k K D) : D = D' := by + have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp h + have hdeg0 : deg k K (D' - D) = 0 := by + have hge : 0 ≤ deg k K (D' - D) := deg_nonneg k K hE + rw [deg_sub] at hge ⊢ + omega + have hzero : D' - D = 0 := eq_zero_of_effective_deg_zero k K hE hdeg0 + exact (sub_eq_zero.mp hzero).symm + +/-- A Weil differential: a k-linear functional on adeles vanishing on some `A(D)+K̃`. -/ +structure WeilDifferential where + /-- The underlying `k`-linear functional on adeles. -/ + toFun : AdeleSpace k K →ₗ[k] k + /-- The functional vanishes on `A(D) + K̃` for some divisor `D`. -/ + vanishes_on : ∃ D : DivisorA k K, + ∀ α ∈ adeleFilt k K D + diagonalSubmodule k K, toFun α = 0 + +namespace WeilDifferential + +variable {k K} + +/-- A Weil differential is nonzero. -/ +def IsNonzero (ω : WeilDifferential k K) : Prop := ω.toFun ≠ 0 + +/-- The space `Ω(D)` of k-linear functionals vanishing on `A(D)+K̃`. -/ +def differentialSpace (D : DivisorA k K) : Submodule k (AdeleSpace k K →ₗ[k] k) where + carrier := {φ | ∀ a ∈ adeleFilt k K D + diagonalSubmodule k K, φ a = 0} + zero_mem' := by simp + add_mem' {f g} hf hg := by + intro a ha + simp [hf a ha, hg a ha] + smul_mem' c f hf := by + intro a ha + simp [hf a ha] + +theorem finrank_differentialSpace (D : DivisorA k K) : + Module.finrank k (differentialSpace D) = indexOfSpecialty k K D := by + let S := adeleFilt k K D + diagonalSubmodule k K + have homega : differentialSpace D = S.dualAnnihilator := by + ext φ + rw [Submodule.mem_dualAnnihilator] + change (∀ a ∈ adeleFilt k K D + diagonalSubmodule k K, φ a = 0) ↔ _ + rfl + rw [homega, ← S.dualQuotEquivDualAnnihilator.finrank_eq, Subspace.dual_finrank_eq] + exact finrank_adele_quotient k K D + +theorem exists_nontrivial_omega : + ∃ D : DivisorA k K, differentialSpace D ≠ ⊥ := by + letI : IsScalarTower k k⟮X⟯ K := + IsScalarTower.of_algebraMap_eq fun c => by + rw [IsScalarTower.algebraMap_apply k k[X] K, + IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, + ← IsScalarTower.algebraMap_apply k k[X] k⟮X⟯] + let x : K := algebraMap k⟮X⟯ K (RatFunc.X : k⟮X⟯) + have hx : ¬IsAlgebraic k x := by + exact (transcendental_algebraMap_iff (algebraMap k⟮X⟯ K).injective).2 + RatFunc.transcendental_X + let E : DivisorA k K := polarDivisor k K x + let D : DivisorA k K := -(E + E) + have hE : 0 < deg k K E := polar_deg_pos k K hx + have hD : deg k K D < 0 := by + simp only [D, deg_neg, deg_add] + omega + have hℓ : ell k K D = 0 := RRspace_neg_deg_ell k K hD + have hi := indexOfSpecialty_eq k K D + have hindex : 0 < indexOfSpecialty k K D := by + have hg : 0 ≤ (genus k K : ℤ) := Int.natCast_nonneg _ + have hdegD : deg k K D = -(deg k K E + deg k K E) := by + simp only [D, deg_neg, deg_add] + rw [hℓ, hdegD] at hi + exact_mod_cast (show (0 : ℤ) < (indexOfSpecialty k K D : ℤ) by omega) + refine ⟨D, fun hbot => ?_⟩ + have hfin : 0 < Module.finrank k (differentialSpace D) := by + rw [finrank_differentialSpace] + exact hindex + rw [hbot, finrank_bot] at hfin + omega + +omit [IsFullConstantField k K] in +/-- Multiplication by a unit sends `A(D + (x)) + K̃` into `A(D) + K̃`. -/ +theorem mul_mem_adeleFilt_add_diagonal (x : Kˣ) (D : DivisorA k K) + {a : AdeleSpace k K} + (ha : a ∈ adeleFilt k K (D + principalDivisorA k K (Additive.ofMul x)) + + diagonalSubmodule k K) : + (x : K) • a ∈ adeleFilt k K D + diagonalSubmodule k K := by + rw [Submodule.add_eq_sup] at ha ⊢ + rcases Submodule.mem_sup.mp ha with ⟨a₁, ha₁, a₂, ha₂, rfl⟩ + refine Submodule.mem_sup.mpr ⟨(x : K) • a₁, ?_, (x : K) • a₂, ?_, + (smul_add (x : K) a₁ a₂).symm⟩ + · intro v + change placeValuation k K v ((x : K) * a₁.val v) ≤ WithZero.exp (D v) + rw [map_mul] + have hxval := placeValuation_eq_exp_neg_principalDivisor k K (Additive.ofMul x) v + change placeValuation k K v (x : K) = + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) at hxval + rw [hxval] + have hv := ha₁ v + rw [Finsupp.add_apply, WithZero.exp_add] at hv + calc + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) * + placeValuation k K v (a₁.val v) ≤ + WithZero.exp (-(principalDivisorA k K (Additive.ofMul x) v)) * + (WithZero.exp (D v) * + WithZero.exp (principalDivisorA k K (Additive.ofMul x) v)) := + mul_le_mul_right hv _ + _ = WithZero.exp (D v) := by + rw [← WithZero.exp_add, ← WithZero.exp_add] + congr 1 + ring + · rcases ha₂ with ⟨f, rfl⟩ + exact ⟨(x : K) * f, by ext v; rfl⟩ + +/-- Scalar multiplication of a Weil differential by `x ∈ K`. -/ +noncomputable def smulWeil (x : K) (ω : WeilDifferential k K) : WeilDifferential k K := by + by_cases hx : x = 0 + · exact ⟨0, ⟨0, by simp⟩⟩ + let xu : Kˣ := Units.mk0 x hx + refine ⟨ω.toFun.comp (mulAdeleLinear k K x), ?_⟩ + obtain ⟨D, hD⟩ := ω.vanishes_on + refine ⟨D + principalDivisorA k K (Additive.ofMul xu), fun a ha => hD _ ?_⟩ + change x • a ∈ adeleFilt k K D + diagonalSubmodule k K + simpa only [xu, Units.val_mk0] using + mul_mem_adeleFilt_add_diagonal (k := k) (K := K) xu D ha + +omit [IsFullConstantField k K] in +@[simp] +theorem smulWeil_toFun_apply (x : K) (ω : WeilDifferential k K) (a : AdeleSpace k K) : + (smulWeil x ω).toFun a = ω.toFun (x • a) := by + by_cases hx : x = 0 + · simp [smulWeil, hx] + · simp only [smulWeil, hx, ↓reduceDIte, LinearMap.comp_apply] + congr 1 + +instance : Zero (WeilDifferential k K) := ⟨⟨0, ⟨0, by simp⟩⟩⟩ + +instance : Add (WeilDifferential k K) where + add ω η := ⟨ω.toFun + η.toFun, by + obtain ⟨Dω, hω⟩ := ω.vanishes_on + obtain ⟨Dη, hη⟩ := η.vanishes_on + refine ⟨Dω ⊓ Dη, fun a ha => ?_⟩ + have hleft : adeleFilt k K (Dω ⊓ Dη) + diagonalSubmodule k K ≤ + adeleFilt k K Dω + diagonalSubmodule k K := by + simpa only [Submodule.add_eq_sup] using + sup_le_sup (adeleFilt_mono k K inf_le_left) le_rfl + have hright : adeleFilt k K (Dω ⊓ Dη) + diagonalSubmodule k K ≤ + adeleFilt k K Dη + diagonalSubmodule k K := by + simpa only [Submodule.add_eq_sup] using + sup_le_sup (adeleFilt_mono k K inf_le_right) le_rfl + simp [hω a (hleft ha), hη a (hright ha)]⟩ + +omit [IsFullConstantField k K] in +@[ext] +theorem ext {ω η : WeilDifferential k K} (h : ω.toFun = η.toFun) : ω = η := by + cases ω + cases η + cases h + rfl + +instance : Neg (WeilDifferential k K) where + neg ω := ⟨-ω.toFun, by + obtain ⟨D, hD⟩ := ω.vanishes_on + exact ⟨D, fun a ha => by simp [hD a ha]⟩⟩ + +instance : AddCommGroup (WeilDifferential k K) where + add_assoc _ _ _ := ext (add_assoc _ _ _) + zero_add _ := ext (zero_add _) + add_zero _ := ext (add_zero _) + add_comm _ _ := ext (add_comm _ _) + nsmul := nsmulRec + nsmul_zero _ := ext rfl + nsmul_succ _ _ := ext rfl + neg := Neg.neg + neg_add_cancel ω := ext (neg_add_cancel ω.toFun) + sub := fun ω η => ω + -η + sub_eq_add_neg _ _ := rfl + zsmul := zsmulRec + +noncomputable instance : SMul K (WeilDifferential k K) := ⟨smulWeil⟩ + +noncomputable instance : Module K (WeilDifferential k K) := + Module.ofMinimalAxioms + (fun x ω η => by + apply ext + ext a + change (smulWeil x (ω + η)).toFun a = + ((smulWeil x ω).toFun + (smulWeil x η).toFun) a + rw [smulWeil_toFun_apply] + change (ω.toFun + η.toFun) (x • a) = + (smulWeil x ω).toFun a + (smulWeil x η).toFun a + rw [LinearMap.add_apply, smulWeil_toFun_apply, smulWeil_toFun_apply]) + (fun x y ω => by + apply ext + ext a + change (smulWeil (x + y) ω).toFun a = + ((smulWeil x ω).toFun + (smulWeil y ω).toFun) a + rw [smulWeil_toFun_apply] + change ω.toFun ((x + y) • a) = + (smulWeil x ω).toFun a + (smulWeil y ω).toFun a + rw [smulWeil_toFun_apply, smulWeil_toFun_apply, add_smul, map_add]) + (fun x y ω => by + apply ext + ext a + change (smulWeil (x * y) ω).toFun a = (smulWeil x (smulWeil y ω)).toFun a + rw [smulWeil_toFun_apply, smulWeil_toFun_apply, smulWeil_toFun_apply] + rw [← mul_smul, mul_comm x y]) + (fun ω => by + apply ext + ext a + change (smulWeil 1 ω).toFun a = ω.toFun a + rw [smulWeil_toFun_apply, one_smul]) + +omit [IsFullConstantField k K] in +theorem smulWeil_algebraMap (c : k) (ω : WeilDifferential k K) (a : AdeleSpace k K) : + (smulWeil (algebraMap k K c) ω).toFun a = c • ω.toFun a := by + rw [smulWeil_toFun_apply, algebraMap_smul, map_smul] + +omit [IsFullConstantField k K] in +theorem smulWeil_eq_zero_iff (x : K) (hx : x ≠ 0) (ω : WeilDifferential k K) : + smulWeil x ω = 0 ↔ ω = 0 := by + constructor + · intro hxω + calc ω = (1 : K) • ω := (one_smul K ω).symm + _ = (x⁻¹ * x) • ω := by rw [inv_mul_cancel₀ hx] + _ = x⁻¹ • (x • ω) := mul_smul x⁻¹ x ω + _ = x⁻¹ • (smulWeil x ω) := rfl + _ = x⁻¹ • (0 : WeilDifferential k K) := by rw [hxω] + _ = 0 := smul_zero x⁻¹ + · intro hω + subst hω + show x • (0 : WeilDifferential k K) = 0 + exact smul_zero x + +omit [IsFullConstantField k K] in +/-- `Ω(D)` is the dual annihilator of `A(D) + K̃`. -/ +theorem differentialSpace_eq_dualAnnihilator (D : DivisorA k K) : + differentialSpace (k := k) (K := K) D = + (adeleFilt k K D + diagonalSubmodule k K).dualAnnihilator := by + ext φ + rw [Submodule.mem_dualAnnihilator] + change (∀ a ∈ adeleFilt k K D + diagonalSubmodule k K, φ a = 0) ↔ _ + rfl + +instance instFiniteDimensionalDifferentialSpace (D : DivisorA k K) : + FiniteDimensional k (differentialSpace (k := k) (K := K) D) := by + rw [differentialSpace_eq_dualAnnihilator D] + exact Module.Finite.equiv + (Submodule.dualQuotEquivDualAnnihilator + (adeleFilt k K D + diagonalSubmodule k K)) + +/-- Divisors `D` for which `ω` vanishes on `A(D)+K̃`. -/ +def vanishingDivisors (ω : WeilDifferential k K) : Set (DivisorA k K) := + {D | ∀ α ∈ adeleFilt k K D + diagonalSubmodule k K, ω.toFun α = 0} + +omit [IsFullConstantField k K] in +/-- `vanishingDivisors` is downward closed. -/ +theorem mem_vanishingDivisors_of_le {ω : WeilDifferential k K} {D D' : DivisorA k K} + (hle : D' ≤ D) (hD : D ∈ vanishingDivisors ω) : D' ∈ vanishingDivisors ω := by + intro α hα + apply hD + have hsub : adeleFilt k K D' + diagonalSubmodule k K ≤ + adeleFilt k K D + diagonalSubmodule k K := by + simpa only [Submodule.add_eq_sup] using + sup_le_sup (adeleFilt_mono k K hle) (le_refl (diagonalSubmodule k K)) + exact hsub hα + +omit [IsFullConstantField k K] in +/-- Underlying functional of a sum of differentials. -/ +theorem add_toFun (ω η : WeilDifferential k K) : + (ω + η).toFun = ω.toFun + η.toFun := rfl + +omit [IsFullConstantField k K] in +/-- If `ω` vanishes on `A(D₀)+K̃` and `f ∈ L(E)`, then `f•ω` vanishes on +`A(D₀−E)+K̃`. -/ +theorem smulWeil_toFun_mem_differentialSpace (ω : WeilDifferential k K) {D₀ : DivisorA k K} + (h : D₀ ∈ vanishingDivisors ω) {E : DivisorA k K} (f : RRspace k K E) : + (smulWeil (f : K) ω).toFun ∈ differentialSpace (k := k) (K := K) (D₀ - E) := by + have hvan : ∀ α ∈ adeleFilt k K D₀ + diagonalSubmodule k K, ω.toFun α = 0 := h + show ∀ a ∈ adeleFilt k K (D₀ - E) + diagonalSubmodule k K, + (smulWeil (f : K) ω).toFun a = 0 + intro a ha + rw [smulWeil_toFun_apply] + by_cases hf : (f : K) = 0 + · rw [hf, zero_smul, map_zero] + · have hmemE : memRRspace k K (D₀ - (D₀ - E)) (f : K) := by + rw [sub_sub_cancel] + exact (mem_RRspace_iff k K E (f : K)).mp f.property + have hdivle : D₀ - E ≤ D₀ + + principalDivisorA k K (Additive.ofMul (Units.mk0 (f : K) hf)) := + le_add_principal_of_memRRspace (k := k) (K := K) (D₀ := D₀ - E) (D₁ := D₀) + hf hmemE + have hle : adeleFilt k K (D₀ - E) + diagonalSubmodule k K ≤ + adeleFilt k K (D₀ + principalDivisorA k K + (Additive.ofMul (Units.mk0 (f : K) hf))) + diagonalSubmodule k K := by + simpa only [Submodule.add_eq_sup] using + sup_le_sup (adeleFilt_mono k K hdivle) (le_refl (diagonalSubmodule k K)) + have hsm := mul_mem_adeleFilt_add_diagonal (k := k) (K := K) + (Units.mk0 (f : K) hf) D₀ (hle ha) + rw [Units.val_mk0] at hsm + exact hvan _ hsm + +/-- For `D₀ ∈ M_ω`, multiplication into `ω` maps `L(E)` into `Ω(D₀ − E)`. -/ +noncomputable def smulIntoOmega (ω : WeilDifferential k K) {D₀ : DivisorA k K} + (h : D₀ ∈ vanishingDivisors ω) (E : DivisorA k K) : + RRspace k K E →ₗ[k] differentialSpace (k := k) (K := K) (D₀ - E) where + toFun f := ⟨(smulWeil (f : K) ω).toFun, smulWeil_toFun_mem_differentialSpace ω h f⟩ + map_add' f g := by + apply Subtype.ext + apply LinearMap.ext + intro a + change (smulWeil ((f : K) + (g : K)) ω).toFun a = + (smulWeil (f : K) ω).toFun a + (smulWeil (g : K) ω).toFun a + rw [smulWeil_toFun_apply, smulWeil_toFun_apply, smulWeil_toFun_apply, add_smul, + map_add] + map_smul' c f := by + apply Subtype.ext + apply LinearMap.ext + intro a + change (smulWeil (c • (f : K)) ω).toFun a = c • (smulWeil (f : K) ω).toFun a + rw [smulWeil_toFun_apply, smulWeil_toFun_apply, Algebra.smul_def, mul_smul, + algebraMap_smul, map_smul] + +omit [IsFullConstantField k K] in +@[simp] +theorem smulIntoOmega_coe (ω : WeilDifferential k K) {D₀ : DivisorA k K} + (h : D₀ ∈ vanishingDivisors ω) (E : DivisorA k K) (f : RRspace k K E) : + (smulIntoOmega ω h E f : AdeleSpace k K →ₗ[k] k) = (smulWeil (f : K) ω).toFun := + rfl + +omit [IsFullConstantField k K] in +theorem smulIntoOmega_injective (ω : WeilDifferential k K) {D₀ : DivisorA k K} + (h : D₀ ∈ vanishingDivisors ω) (E : DivisorA k K) (hω : ω.toFun ≠ 0) : + Function.Injective (smulIntoOmega ω h E) := by + intro f g hfg + by_contra hne + have hd0 : smulIntoOmega ω h E (f - g) = 0 := by + rw [map_sub, hfg, sub_self] + have hval : ((f - g : RRspace k K E) : K) ≠ 0 := by + intro h0 + exact hne (sub_eq_zero.mp (Subtype.ext h0)) + have htoFun : (smulWeil ((f - g : RRspace k K E) : K) ω).toFun = 0 := + congrArg Subtype.val hd0 + have hzero : smulWeil ((f - g : RRspace k K E) : K) ω = 0 := ext htoFun + have hω0 : ω = 0 := (smulWeil_eq_zero_iff _ hval ω).mp hzero + apply hω + rw [hω0] + rfl + +/-- **S2**: the space of Weil differentials is one-dimensional over `K`. -/ +theorem finrank_weilDifferential_eq_one : + Module.finrank K (WeilDifferential k K) = 1 := by + obtain ⟨D₀', hD₀'⟩ := exists_nontrivial_omega (k := k) (K := K) + obtain ⟨φ, hφ, hφ0⟩ := Submodule.exists_mem_ne_zero_of_ne_bot hD₀' + set ω₀ : WeilDifferential k K := ⟨φ, ⟨D₀', hφ⟩⟩ with hω₀def + have hω₀ne : ω₀ ≠ 0 := by + intro h + apply hφ0 + have hval : ω₀.toFun = φ := rfl + rw [← hval, h]; rfl + refine (finrank_eq_one_iff_of_nonzero' ω₀ hω₀ne).mpr ?_ + intro ω + by_contra hspan + push Not at hspan + -- Independence: `f•ω₀ + g•ω = 0 → f = 0 ∧ g = 0`. + have hindep : ∀ f g : K, f • ω₀ + g • ω = 0 → f = 0 ∧ g = 0 := by + intro f g hfg + by_cases hg : g = 0 + · subst hg + rw [zero_smul, add_zero] at hfg + refine ⟨?_, rfl⟩ + by_contra hf + exact hω₀ne ((smulWeil_eq_zero_iff f hf ω₀).mp hfg) + · exfalso + apply hspan (g⁻¹ * (-f)) + have hgω : g • ω = (-f) • ω₀ := by + have hneg : g • ω = -(f • ω₀) := by + rw [eq_neg_iff_add_eq_zero, add_comm]; exact hfg + rw [hneg, neg_smul] + have hω : ω = (g⁻¹ * (-f)) • ω₀ := by + rw [mul_smul, ← hgω, ← mul_smul, inv_mul_cancel₀ hg, one_smul] + exact hω.symm + -- Common vanishing divisor `D₀`. + obtain ⟨D₁, hD₁⟩ := ω₀.vanishes_on + obtain ⟨D₂, hD₂⟩ := ω.vanishes_on + set D₀ : DivisorA k K := D₁ ⊓ D₂ with hD₀def + have h₀ : D₀ ∈ vanishingDivisors ω₀ := + mem_vanishingDivisors_of_le inf_le_left hD₁ + have h₂ : D₀ ∈ vanishingDivisors ω := + mem_vanishingDivisors_of_le inf_le_right hD₂ + -- Pole family. + set B : DivisorA k K := polarDivisor k K (XK k K) with hBdef + have hBpos : 0 < deg k K B := polar_deg_pos k K (not_algebraic_XK k K) + have hb1 : 1 ≤ deg k K B := hBpos + -- The counting bound at level `n`: `2 ℓ(nB) ≤ i(D₀ − nB)`. + have hcount : ∀ n : ℕ, + 2 * (ell k K (n • B) : ℤ) ≤ indexOfSpecialty k K (D₀ - n • B) := by + intro n + set E : DivisorA k K := n • B with hEdef + have hinj : Function.Injective + (LinearMap.coprod (smulIntoOmega ω₀ h₀ E) (smulIntoOmega ω h₂ E)) := by + intro x y hxy + have hd : (LinearMap.coprod (smulIntoOmega ω₀ h₀ E) + (smulIntoOmega ω h₂ E)) (x - y) = 0 := by + rw [map_sub, hxy, sub_self] + rw [LinearMap.coprod_apply] at hd + have hcoe : (smulWeil (((x - y).1 : RRspace k K E) : K) ω₀).toFun + + (smulWeil (((x - y).2 : RRspace k K E) : K) ω).toFun = 0 := by + have h1 := congrArg Subtype.val hd + simpa only [Submodule.coe_add, smulIntoOmega_coe, Submodule.coe_zero] using h1 + have hsum : ((((x - y).1 : RRspace k K E) : K) • ω₀ + + (((x - y).2 : RRspace k K E) : K) • ω).toFun = 0 := by + rw [add_toFun]; exact hcoe + have hzero : (((x - y).1 : RRspace k K E) : K) • ω₀ + + (((x - y).2 : RRspace k K E) : K) • ω = 0 := ext hsum + obtain ⟨hf0, hg0⟩ := hindep _ _ hzero + have hxy0 : x - y = 0 := Prod.ext (Subtype.ext hf0) (Subtype.ext hg0) + exact sub_eq_zero.mp hxy0 + have hfrle : Module.finrank k (RRspace k K E × RRspace k K E) ≤ + Module.finrank k (differentialSpace (k := k) (K := K) (D₀ - E)) := + LinearMap.finrank_le_finrank_of_injective hinj + rw [Module.finrank_prod, finrank_differentialSpace] at hfrle + have hLfr : Module.finrank k (RRspace k K E) = ell k K E := rfl + rw [hLfr] at hfrle + omega + -- Choose `n` large enough to contradict the bound. + set M : ℤ := max (deg k K D₀) (3 * (genus k K : ℤ) - 3 - deg k K D₀) with hMdef + set n : ℕ := M.toNat + 1 with hndef + have hn_ge : (n : ℤ) ≥ M + 1 := by + have hself := Int.self_le_toNat M + push_cast [hndef] + omega + have hn_d0 : (n : ℤ) > deg k K D₀ := by + have hle : deg k K D₀ ≤ M := le_max_left _ _ + omega + have hn_g : (n : ℤ) > 3 * (genus k K : ℤ) - 3 - deg k K D₀ := by + have hle : 3 * (genus k K : ℤ) - 3 - deg k K D₀ ≤ M := le_max_right _ _ + omega + have hnb_ge : (n : ℤ) * deg k K B ≥ (n : ℤ) := by + have hn0 : (0 : ℤ) ≤ (n : ℤ) := Int.natCast_nonneg n + nlinarith [hb1, hn0] + have hdegsub : deg k K (D₀ - n • B) = deg k K D₀ - (n : ℤ) * deg k K B := by + rw [deg_sub, deg_nsmul] + have hdeg_neg : deg k K (D₀ - n • B) < 0 := by + rw [hdegsub]; omega + have hℓ0 : ell k K (D₀ - n • B) = 0 := RRspace_neg_deg_ell k K hdeg_neg + have hi := indexOfSpecialty_eq (k := k) (K := K) (D₀ - n • B) + rw [hℓ0, hdegsub] at hi + have hrr := riemann_ineq (k := k) (K := K) (n • B) + rw [deg_nsmul] at hrr + have hc := hcount n + omega + +omit [IsFullConstantField k K] in +/-- Vanishing divisors translate by the principal divisor under scalar multiplication. -/ +theorem add_principal_mem_vanishingDivisors_smul_iff (x : Kˣ) + (ω : WeilDifferential k K) (D : DivisorA k K) : + D + principalDivisorA k K (Additive.ofMul x) ∈ + vanishingDivisors ((x : K) • ω) ↔ + D ∈ vanishingDivisors ω := by + constructor + · intro h a ha + let P := principalDivisorA k K (Additive.ofMul x) + have hsource : + (D + P) + principalDivisorA k K (Additive.ofMul (x⁻¹ : Kˣ)) = D := by + have hinv : Additive.ofMul (x⁻¹ : Kˣ) = -(Additive.ofMul x) := rfl + rw [hinv, map_neg] + abel + have haSource : a ∈ adeleFilt k K + ((D + P) + principalDivisorA k K (Additive.ofMul (x⁻¹ : Kˣ))) + + diagonalSubmodule k K := by + simpa only [hsource] using ha + have ha' := mul_mem_adeleFilt_add_diagonal (k := k) (K := K) + (x⁻¹ : Kˣ) (D + P) haSource + have hz := h (((x⁻¹ : Kˣ) : K) • a) ha' + change (smulWeil (x : K) ω).toFun (((x⁻¹ : Kˣ) : K) • a) = 0 at hz + rw [smulWeil_toFun_apply] at hz + simpa [mul_smul] using hz + · intro h a ha + change (smulWeil (x : K) ω).toFun a = 0 + rw [smulWeil_toFun_apply] + exact h _ (mul_mem_adeleFilt_add_diagonal (k := k) (K := K) x D ha) + +omit [IsFullConstantField k K] in +/-- Directedness of the vanishing set: it is closed under `⊔`. -/ +theorem sup_mem_vanishingDivisors {ω : WeilDifferential k K} {D₁ D₂ : DivisorA k K} + (hD₁ : D₁ ∈ vanishingDivisors ω) (hD₂ : D₂ ∈ vanishingDivisors ω) : + D₁ ⊔ D₂ ∈ vanishingDivisors ω := by + intro α hα + rw [Submodule.add_eq_sup, adeleFilt_sup_eq_add, ← Submodule.add_eq_sup] at hα + rw [Submodule.add_eq_sup] at hα + rcases Submodule.mem_sup.mp hα with ⟨a, ha, d, hd, rfl⟩ + rw [Submodule.add_eq_sup] at ha + rcases Submodule.mem_sup.mp ha with ⟨a₁, ha₁, a₂, ha₂, rfl⟩ + have hsplit : a₁ + a₂ + d = (a₁ + d) + a₂ := by abel + rw [hsplit, map_add] + have h1 : ω.toFun (a₁ + d) = 0 := by + apply hD₁ + rw [Submodule.add_eq_sup] + exact Submodule.add_mem_sup ha₁ hd + have h2 : ω.toFun a₂ = 0 := by + apply hD₂ + rw [Submodule.add_eq_sup] + exact Submodule.mem_sup_left ha₂ + rw [h1, h2, add_zero] + +/-- Degree bound (duality-free): a vanishing divisor of a nonzero `ω` has degree `≤ 2g − 1`. -/ +theorem deg_le_of_mem_vanishingDivisors {ω : WeilDifferential k K} (hω : ω.toFun ≠ 0) + {D : DivisorA k K} (hD : D ∈ vanishingDivisors ω) : + deg k K D ≤ 2 * (genus k K : ℤ) - 1 := by + have hinj : Function.Injective (smulIntoOmega ω hD D) := + smulIntoOmega_injective ω hD D hω + have hle : Module.finrank k (RRspace k K D) ≤ + Module.finrank k (differentialSpace (k := k) (K := K) (D - D)) := + LinearMap.finrank_le_finrank_of_injective hinj + have hDD : D - D = (0 : DivisorA k K) := sub_self D + have hΩ : Module.finrank k (differentialSpace (k := k) (K := K) (D - D)) = genus k K := by + rw [hDD, finrank_differentialSpace] + have hidx := indexOfSpecialty_eq (k := k) (K := K) (0 : DivisorA k K) + rw [ell_zero (k := k) (K := K), deg_zero (k := k) (K := K)] at hidx + omega + have hℓg : (ell k K D : ℤ) ≤ (genus k K : ℤ) := by + have hnat : ell k K D ≤ genus k K := by + rw [show ell k K D = Module.finrank k (RRspace k K D) from rfl, ← hΩ] + exact hle + exact_mod_cast hnat + have hRR := riemann_ineq (k := k) (K := K) D + omega + +theorem exists_max_vanishingDivisor {ω : WeilDifferential k K} (hω : IsNonzero ω) : + ∃! W : DivisorA k K, W ∈ vanishingDivisors ω ∧ + ∀ D ∈ vanishingDivisors ω, D ≤ W := by + have hω' : ω.toFun ≠ 0 := hω + set P : ℤ → Prop := fun z => ∃ D ∈ vanishingDivisors ω, deg k K D = z with hP + have hInh : ∃ z, P z := by + obtain ⟨D₀, hD₀⟩ := ω.vanishes_on + exact ⟨deg k K D₀, D₀, hD₀, rfl⟩ + have hBdd : ∃ b : ℤ, ∀ z, P z → z ≤ b := by + refine ⟨2 * (genus k K : ℤ) - 1, ?_⟩ + rintro z ⟨D, hD, rfl⟩ + exact deg_le_of_mem_vanishingDivisors hω' hD + obtain ⟨ub, ⟨W, hWmem, hWdeg⟩, hubmax⟩ := Int.exists_greatest_of_bdd hBdd hInh + have hmaxdiv : ∀ D ∈ vanishingDivisors ω, D ≤ W := by + intro D hD + have hsup : D ⊔ W ∈ vanishingDivisors ω := sup_mem_vanishingDivisors hD hWmem + have hdegle : deg k K (D ⊔ W) ≤ ub := hubmax _ ⟨D ⊔ W, hsup, rfl⟩ + have hWle : W ≤ D ⊔ W := le_sup_right + have hdegW : deg k K (D ⊔ W) ≤ deg k K W := by rw [hWdeg]; exact hdegle + have heq : W = D ⊔ W := eq_of_le_of_deg_le k K hWle hdegW + rw [heq]; exact le_sup_left + refine ⟨W, ⟨hWmem, hmaxdiv⟩, ?_⟩ + rintro W' ⟨hW'mem, hW'max⟩ + exact le_antisymm (hmaxdiv W' hW'mem) (hW'max W hWmem) + +/-- The divisor of a nonzero Weil differential. -/ +noncomputable def divOmega (ω : WeilDifferential k K) (hω : IsNonzero ω) : DivisorA k K := + Classical.choose (exists_max_vanishingDivisor (k := k) (K := K) hω) + +theorem divOmega_smul (x : Kˣ) (ω : WeilDifferential k K) (hω : IsNonzero ω) + (hxω : IsNonzero ((x : K) • ω)) : + WeilDifferential.divOmega ((x : K) • ω) hxω = + WeilDifferential.divOmega ω hω + principalDivisorA k K (Additive.ofMul x) := by + let W := WeilDifferential.divOmega ω hω + let P := principalDivisorA k K (Additive.ofMul x) + have hmax : W ∈ vanishingDivisors ω ∧ + ∀ D ∈ vanishingDivisors ω, D ≤ W := by + simpa only [W, divOmega] using + (Classical.choose_spec (exists_max_vanishingDivisor (k := k) (K := K) hω)).1 + have htarget : W + P ∈ vanishingDivisors ((x : K) • ω) ∧ + ∀ E ∈ vanishingDivisors ((x : K) • ω), E ≤ W + P := by + constructor + · exact (add_principal_mem_vanishingDivisors_smul_iff + (k := k) (K := K) x ω W).2 hmax.1 + · intro E hE + have htranslate : (E - P) + P = E := by abel + have hE' : E - P ∈ vanishingDivisors ω := by + apply (add_principal_mem_vanishingDivisors_smul_iff + (k := k) (K := K) x ω (E - P)).1 + simpa only [P, htranslate] using hE + have hle := hmax.2 (E - P) hE' + intro v + have hv := hle v + simp only [Finsupp.sub_apply, Finsupp.add_apply] at hv ⊢ + omega + let hex := exists_max_vanishingDivisor (k := k) (K := K) hxω + have hchosen : WeilDifferential.divOmega ((x : K) • ω) hxω ∈ + vanishingDivisors ((x : K) • ω) ∧ + ∀ D ∈ vanishingDivisors ((x : K) • ω), + D ≤ WeilDifferential.divOmega ((x : K) • ω) hxω := by + simpa only [divOmega, hex] using (Classical.choose_spec hex).1 + exact hex.unique hchosen htarget + +end WeilDifferential + +/-- A divisor is canonical when it is the divisor of a nonzero Weil differential. -/ +def IsCanonical (W : DivisorA k K) : Prop := + ∃ (ω : WeilDifferential k K) (hω : WeilDifferential.IsNonzero ω), + WeilDifferential.divOmega ω hω = W + +/-- A function field admits a canonical divisor. -/ +theorem exists_isCanonical : ∃ W : DivisorA k K, IsCanonical k K W := by + obtain ⟨D, hD⟩ := WeilDifferential.exists_nontrivial_omega (k := k) (K := K) + obtain ⟨φ, hφ, hφ0⟩ := Submodule.exists_mem_ne_zero_of_ne_bot hD + let ω : WeilDifferential k K := ⟨φ, ⟨D, hφ⟩⟩ + have hω : WeilDifferential.IsNonzero ω := hφ0 + exact ⟨WeilDifferential.divOmega ω hω, ω, hω, rfl⟩ + +theorem isCanonical_unique_up_to_principal {W₁ W₂ : DivisorA k K} + (h₁ : IsCanonical k K W₁) (h₂ : IsCanonical k K W₂) : + ∃ f : Kˣ, W₁ - W₂ = principalDivisorA k K (Additive.ofMul f) := by + rcases h₁ with ⟨ω₁, hω₁, rfl⟩ + rcases h₂ with ⟨ω₂, hω₂, rfl⟩ + have hω₁0 : ω₁ ≠ 0 := by + intro h + apply hω₁ + rw [h] + rfl + have hω₂0 : ω₂ ≠ 0 := by + intro h + apply hω₂ + rw [h] + rfl + obtain ⟨c, hc⟩ := exists_smul_eq_of_finrank_eq_one (K := K) + (WeilDifferential.finrank_weilDifferential_eq_one (k := k) (K := K)) hω₂0 ω₁ + have hc0 : c ≠ 0 := by + intro h + subst c + apply hω₁0 + simpa only [zero_smul] using hc.symm + let f : Kˣ := Units.mk0 c hc0 + have hcf : (f : K) • ω₂ = ω₁ := by + simpa only [f, Units.val_mk0] using hc + have hnontrivial : WeilDifferential.IsNonzero ((f : K) • ω₂) := by + exact hcf.symm ▸ hω₁ + refine ⟨f, ?_⟩ + have hdiv := WeilDifferential.divOmega_smul (k := k) (K := K) f ω₂ hω₂ hnontrivial + calc + WeilDifferential.divOmega ω₁ hω₁ - WeilDifferential.divOmega ω₂ hω₂ = + WeilDifferential.divOmega ((f : K) • ω₂) hnontrivial - + WeilDifferential.divOmega ω₂ hω₂ := by + congr 2 + exact hcf.symm + _ = principalDivisorA k K (Additive.ofMul f) := by rw [hdiv]; abel + +open WeilDifferential in +theorem duality {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) : + ell k K (W - D) = indexOfSpecialty k K D := by + obtain ⟨ω₀, hω₀, hdivW⟩ := hW + have hω₀' : ω₀.toFun ≠ 0 := hω₀ + have hω₀ne : ω₀ ≠ 0 := fun h => hω₀ (by rw [h]; rfl) + -- `W` is the maximum vanishing divisor of `ω₀`. + have hWspec : W ∈ vanishingDivisors ω₀ ∧ + ∀ D' ∈ vanishingDivisors ω₀, D' ≤ W := by + have h := (Classical.choose_spec + (WeilDifferential.exists_max_vanishingDivisor (k := k) (K := K) hω₀)).1 + have he : Classical.choose + (WeilDifferential.exists_max_vanishingDivisor (k := k) (K := K) hω₀) = W := hdivW + rw [he] at h + exact h + obtain ⟨hWmem, hWmax⟩ := hWspec + have hWD : W - (W - D) = D := sub_sub_cancel W D + -- The multiplication map `μ : L(W − D) → Ω(W − (W − D))`. + set μ := smulIntoOmega ω₀ hWmem (W - D) with hμdef + have hμinj : Function.Injective μ := smulIntoOmega_injective ω₀ hWmem (W - D) hω₀' + have hμsurj : Function.Surjective μ := by + intro ψ + set φ : AdeleSpace k K →ₗ[k] k := (ψ : AdeleSpace k K →ₗ[k] k) with hφdef + by_cases hψ0 : φ = 0 + · exact ⟨0, by rw [map_zero]; exact (Subtype.ext hψ0).symm⟩ + · -- Package `ψ` as a nonzero differential vanishing on `A(D)+K̃`. + have hψmem : ∀ α ∈ adeleFilt k K D + diagonalSubmodule k K, φ α = 0 := by + have hp : ∀ α ∈ adeleFilt k K (W - (W - D)) + diagonalSubmodule k K, φ α = 0 := + ψ.property + rw [hWD] at hp + exact hp + set η : WeilDifferential k K := ⟨φ, ⟨D, hψmem⟩⟩ with hηdef + have hηnt : η.toFun ≠ 0 := hψ0 + obtain ⟨c, hc⟩ := exists_smul_eq_of_finrank_eq_one (K := K) + (WeilDifferential.finrank_weilDifferential_eq_one (k := k) (K := K)) hω₀ne η + have hc0 : c ≠ 0 := by + intro h + subst h + apply hηnt + have hη0 : η = 0 := by rw [← hc, zero_smul] + rw [hη0]; rfl + set cu : Kˣ := Units.mk0 c hc0 with hcudef + set P : DivisorA k K := principalDivisorA k K (Additive.ofMul cu) with hPdef + -- `D ∈ M_{c•ω₀}` translates to `D − P ∈ M_ω₀`. + have hDmem : D ∈ vanishingDivisors ((cu : K) • ω₀) := by + have hcω : (cu : K) • ω₀ = η := by + rw [Units.val_mk0]; exact hc + rw [hcω] + intro α hα + exact hψmem α hα + have hDPmem : D - P ∈ vanishingDivisors ω₀ := by + apply (add_principal_mem_vanishingDivisors_smul_iff (k := k) (K := K) cu ω₀ (D - P)).1 + have hsub : (D - P) + P = D := by rw [hPdef]; abel + rw [hsub]; exact hDmem + have hDPle : D - P ≤ W := hWmax (D - P) hDPmem + -- Hence `c ∈ L(W − D)`. + have hcmem : memRRspace k K (W - D) c := by + intro v + have hval := placeValuation_eq_exp_neg_principalDivisor k K (Additive.ofMul cu) v + change placeValuation k K v c ≤ WithZero.exp ((W - D) v) + have hcv : placeValuation k K v c = + WithZero.exp (-(P v)) := by + rw [hPdef] + have hcuc : (cu : K) = c := by simp [hcudef] + rw [← hcuc]; exact hval + rw [hcv] + apply WithZero.exp_le_exp.mpr + have hlev := hDPle v + simp only [Finsupp.sub_apply] at hlev ⊢ + omega + refine ⟨⟨c, (mem_RRspace_iff k K (W - D) c).mpr hcmem⟩, ?_⟩ + apply Subtype.ext + rw [hμdef, smulIntoOmega_coe] + change ((c : K) • ω₀).toFun = φ + rw [hc] + -- Conclude via the induced equivalence. + have hfr : Module.finrank k (RRspace k K (W - D)) = + Module.finrank k (differentialSpace (k := k) (K := K) (W - (W - D))) := + (LinearEquiv.ofBijective μ ⟨hμinj, hμsurj⟩).finrank_eq + show Module.finrank k (RRspace k K (W - D)) = indexOfSpecialty k K D + rw [hfr, hWD, finrank_differentialSpace] + +theorem indexOfSpecialty_eq_ell_sub {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) : + (indexOfSpecialty k K D : ℤ) = ell k K (W - D) := by + exact_mod_cast (duality k K hW D).symm + +end FunctionField.Chart + +end diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index 95e0c8ad83..684d69cbe9 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -9966,3 +9966,31 @@ projects: msc: - '90C35' - '05C21' + + - slug: markoff-modp + title: Markoff mod p + summary: Lean 4 formalization of strong approximation for the Markoff surface modulo + sufficiently large primes. The primary source is Bourgain-Gamburd-Sarnak. + branch: number theory + entry_module: LeanPool.MarkoffModP + authors: + - Yuma Mizuno + source: + url: https://github.com/yuma-mizuno/markoff-modp + github_repo: yuma-mizuno/markoff-modp + commit: ac1099fc96b0f1cf6e6099c74a24b783691c21aa + license: Apache-2.0 + status: verified + provenance: AI + main_declarations: + - BGS.Markoff.reduction_surjective_of_explicitBound + main_results: + - declaration: BGS.Markoff.reduction_surjective_of_explicitBound + informal: For primes exceeding the explicit bound, reduction of integral Markoff + points to the Markoff surface modulo p is surjective as specified by the theorem. + tags: + - markoff-equation + - strong-approximation + - finite-fields + msc: + - 11D25 From 93d687f355341d46e8284559b32644ae523a8dc1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 18:24:29 +0000 Subject: [PATCH 02/37] Refine full import for Lean 4.34 compatibility and quality checks --- .../MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean | 4 ++-- LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean | 6 +++--- .../MarkoffModP/BGS/Markoff/Incidence/PointCount.lean | 8 ++++---- LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean | 2 +- .../BGS/NumberTheory/ExplicitDivisorBound.lean | 2 +- LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean | 6 ++---- .../MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Basic.lean | 4 ++-- .../RiemannRoch/CoordinateFree/AdeleSpace.lean | 4 ++-- .../MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean | 4 ++-- .../MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean | 4 ++-- .../RiemannRoch/CoordinateFree/RiemannRoch.lean | 4 ++-- .../RiemannRoch/CoordinateFree/WeilDifferential.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Divisor.lean | 4 ++-- .../MarkoffModP/RiemannRoch/FunctionField/Divisor.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/Place.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean | 4 ++-- .../MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean | 4 ++-- .../RiemannRoch/RiemannRochTheorem/Corollaries.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean | 4 ++-- LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean | 4 ++-- .../MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean | 4 ++-- 29 files changed, 59 insertions(+), 61 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean index e0bfc61091..915e9fea85 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 University of Washington Math AI Lab. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Bianca Viray, Bryan Boehnke, Grant Yang, George Peykanu, Tianshuo Wang -/ import Mathlib.RingTheory.LocalRing.Etale diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean index dba7a6d3d6..5fb41c9ff1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean @@ -23,7 +23,7 @@ open scoped Topology namespace Legacy /-- Sealed data for the deliberately conservative project cutoff. -/ -opaque explicitStrongApproximationCutoffData : +@[irreducible] def explicitStrongApproximationCutoffData : {n : ℕ // n = BGS.NumberTheory.explicitDivisorConstant + 1} := ⟨BGS.NumberTheory.explicitDivisorConstant + 1, rfl⟩ @@ -150,7 +150,7 @@ end Legacy /-- The coefficient in the simultaneous ninth-moment bound for the divisor counts of `p - 1` and `p + 1`. -/ -opaque explicitDivisorMomentConstantData : +@[irreducible] def explicitDivisorMomentConstantData : {n : ℕ // n = 2 ^ 9 * (9 ^ 9) ^ (2 ^ 9)} := ⟨2 ^ 9 * (9 ^ 9) ^ (2 ^ 9), rfl⟩ @@ -167,7 +167,7 @@ theorem explicitDivisorMomentConstant_pos : positivity /-- Sealed data for the improved project cutoff. -/ -opaque explicitStrongApproximationCutoffData : +@[irreducible] def explicitStrongApproximationCutoffData : {n : ℕ // n = 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1} := ⟨2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1, rfl⟩ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean index 17045b6d9c..51a7b88daa 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean @@ -86,24 +86,24 @@ theorem sum_quadraticChar_two_linear_factors -quadraticChar F (A * B) := by let L : F := A * B let center : F := (A * D + B * C) / (2 * L) - let constant : F := (A * D - B * C) ^ 2 / (4 * L) + let constantTerm : F := (A * D - B * C) ^ 2 / (4 * L) have h2 : (2 : F) ≠ 0 := Ring.two_ne_zero hF have h4 : (4 : F) ≠ 0 := by rw [show (4 : F) = 2 ^ 2 by norm_num] exact pow_ne_zero 2 h2 have hL : L ≠ 0 := mul_ne_zero hA hB - have hconstant : constant ≠ 0 := by + have hconstant : constantTerm ≠ 0 := by exact div_ne_zero (pow_ne_zero 2 (sub_ne_zero.mpr hcross)) (mul_ne_zero h4 hL) let e : F ≃ F := Equiv.addRight center calc ∑ x : F, quadraticChar F ((A * x - C) * (B * x - D)) = ∑ x : F, quadraticChar F ((A * (e x) - C) * (B * (e x) - D)) := by exact (e.sum_comp fun x ↦ quadraticChar F ((A * x - C) * (B * x - D))).symm - _ = ∑ x : F, quadraticChar F (L * x ^ 2 - constant) := by + _ = ∑ x : F, quadraticChar F (L * x ^ 2 - constantTerm) := by apply sum_congr rfl intro x _ congr 1 - dsimp [e, center, constant, L] + dsimp [e, center, constantTerm, L] field_simp [h2, hA, hB] ring _ = -quadraticChar F L := diff --git a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean index 8e427e996e..66e61ab3eb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean @@ -32,7 +32,7 @@ theorem preliminaryDivisorMomentConstant_pos : positivity /-- Sealed data for the elementary preliminary-route cutoff. -/ -opaque preliminaryStrongApproximationCutoffData : +@[irreducible] def preliminaryStrongApproximationCutoffData : {n : ℕ // n = 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1} := ⟨2 ^ 1833 * (48 ^ 3 + 1) ^ 10 + 1, rfl⟩ diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean index 3debf26980..1304d47cfb 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean @@ -91,7 +91,7 @@ theorem card_divisors_pow_le_explicit_constant_mul /-- Sealed data for the closed factorization constant. The subtype equation lets downstream proofs rewrite the value without asking the kernel to repeatedly normalize its enormous exponentiation. -/ -opaque explicitDivisorConstantData : +@[irreducible] def explicitDivisorConstantData : {n : ℕ // n = (32 ^ 32) ^ (2 ^ 32)} := ⟨(32 ^ 32) ^ (2 ^ 32), rfl⟩ diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean index cd035f1b1a..5e326e868b 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module @@ -158,7 +158,6 @@ theorem adeleFilt_mono {D D' : DivisorA k K} (h : D ≤ D') : exact (ha v).trans (WithZero.exp_le_exp.mpr (h v)) /-- `A(D)` as a submodule of `A(D')`, for `D ≤ D'`. -/ -@[nolint unusedArguments] def adeleFiltWithin {D D' : DivisorA k K} (_h : D ≤ D') : Submodule k (adeleFilt k K D') := Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D) @@ -172,7 +171,6 @@ noncomputable def finrankAdeleFiltDiff (D D' : DivisorA k K) : ℕ := by Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D) /-- Rank of `(A(D') + K̃) ⧸ (A(D) + K̃)` from the sandwich bookkeeping. -/ -@[nolint unusedArguments] noncomputable def sandwichRank (D D' : DivisorA k K) (_h : D ≤ D') : ℤ := by letI : AddCommGroup (adeleFilt k K D' + diagonalSubmodule k K) := diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean index 4f77a8f8b7..daf716e95c 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/Basic.lean index 89c37c0b02..de906ce43a 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean index a664640cab..b425880bd5 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AdeleSpace.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean index ae20fd7316..c53e4f4b18 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean index d7eee6e9fe..542e93d7c7 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/Divisor.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean index 38bd58a029..43d2a1b85a 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/RiemannRoch.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean index 2cb9ce769e..de51abed45 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/WeilDifferential.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean index c1c669cd36..21e38a8f65 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Divisor.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean index 8c69c4fffa..6edc4a8037 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean index b81f1b4312..e932652233 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean index 0321d2033f..8a2e3b9d22 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean index 5349aecb0b..79d59ff9a7 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean index 32345e83fc..33114dd32e 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean b/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean index fd20b9430c..39f44ec086 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean b/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean index 13628c2d49..6dba62d812 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/Place.lean b/LeanPool/MarkoffModP/RiemannRoch/Place.lean index 984a388e44..89c37d5745 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Place.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Place.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean b/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean index 23a052e2ce..0b07b82481 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean index ff803386ef..2e91ad4012 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean index a3ccaec1d8..83c24ec92a 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean index e803aa11c8..287b43e504 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean index 6e732e6f79..261da482a3 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean index b5f1f044e7..e79220f368 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module diff --git a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean index af9898284c..4245ccd5be 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean @@ -1,7 +1,7 @@ /- -Copyright (c) 2026 Yuma Mizuno. All rights reserved. +Copyright (c) 2026 Guanghao Li. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. -Authors: Yuma Mizuno +Authors: Guanghao Li -/ module From 29ee4a7e685831f22edb739c0b735f8ac8309ac0 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 21:39:20 +0000 Subject: [PATCH 03/37] Port algebraic frontiers and share the separable relative norm theorem --- .../FiniteExtensionProductFormula.lean | 70 +------------------ .../CorvajaZannier/FinitePlaceCompletion.lean | 3 +- .../PlaneCurveLogarithmicGauss.lean | 20 +++--- .../BGS/FiniteField/HasseFrobenius.lean | 7 +- .../BGS/Markoff/Core/EvenSignAction.lean | 6 +- .../BGS/Markoff/Core/ParabolicFibers.lean | 14 ++-- .../BGS/Markoff/Core/RotationTorus.lean | 2 +- .../BGS/Markoff/Incidence/CoordinateRing.lean | 36 +++++++--- .../BGS/Markoff/Opening/CyclotomicNorm.lean | 6 +- .../BGS/NumberTheory/DivisorBound.lean | 2 +- .../RiemannRoch/SeparableRelNorm.lean | 1 + 11 files changed, 61 insertions(+), 106 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean index 43ca13d7a7..ea54feab12 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean @@ -4,7 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib.RingTheory.Ideal.Norm.RelNorm +import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm import Mathlib.FieldTheory.IsSepClosed /-! @@ -75,73 +75,7 @@ private theorem relNorm_eq_pow_of_isMaximal_of_isSeparable (P : Ideal S) (p : Ideal R) [P.LiesOver p] [P.IsMaximal] [p.IsMaximal] : Ideal.relNorm R P = p ^ P.inertiaDeg R := by - let M := SeparableClosure K - let φ : L →ₐ[K] M := IsSepClosed.lift - let E : IntermediateField K M := IntermediateField.normalClosure K L M - let φE := φ.codRestrict E.toSubalgebra (fun x => - φ.fieldRange_le_normalClosure ⟨x, rfl⟩) - letI : Algebra L E := φE.toAlgebra - letI : IsScalarTower K L E := IsScalarTower.of_algHom φE - letI : Algebra S E := - ((algebraMap L E).comp (algebraMap S L)).toAlgebra - letI : IsScalarTower S L E := IsScalarTower.of_algebraMap_eq' rfl - let T := integralClosure S E - letI : CommRing T := inferInstanceAs (CommRing (integralClosure S E)) - letI : IsDomain T := inferInstanceAs (IsDomain (integralClosure S E)) - letI : Algebra S T := inferInstanceAs (Algebra S (integralClosure S E)) - letI : Algebra T E := inferInstanceAs (Algebra (integralClosure S E) E) - letI : IsScalarTower S T E := - inferInstanceAs (IsScalarTower S (integralClosure S E) E) - letI : IsIntegralClosure T S E := - integralClosure.isIntegralClosure S E - letI : Algebra R T := ((algebraMap S T).comp (algebraMap R S)).toAlgebra - letI : IsScalarTower R S T := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower R L E := IsScalarTower.to₁₃₄ R K L E - letI : IsScalarTower R S E := IsScalarTower.to₁₂₄ R S L E - letI : IsScalarTower R T E := IsScalarTower.to₁₃₄ R S T E - letI : FaithfulSMul S E := - (faithfulSMul_iff_algebraMap_injective S E).mpr - ((FaithfulSMul.algebraMap_injective L E).comp - (FaithfulSMul.algebraMap_injective S L)) - letI : IsGalois K E := IsGalois.normalClosure K L M - letI : FiniteDimensional K E := - normalClosure.is_finiteDimensional K L M - letI : FiniteDimensional L E := Module.Finite.right K L E - letI : Algebra.IsSeparable L E := - Algebra.isSeparable_tower_top_of_isSeparable K L E - letI : IsFractionRing T E := - integralClosure.isFractionRing_of_finite_extension L E - letI : Module.IsTorsionFree S T := - Subalgebra.instIsTorsionFree (integralClosure S E) - letI : FaithfulSMul R T := - (faithfulSMul_iff_algebraMap_injective R T).mpr - ((FaithfulSMul.algebraMap_injective S T).comp - (FaithfulSMul.algebraMap_injective R S)) - letI : Module.Finite S T := IsIntegralClosure.finite S L E T - letI : Module.Finite R T := Module.Finite.trans S T - letI : IsDedekindDomain T := - integralClosure.isDedekindDomain S L E - letI : IsGalois K (FractionRing T) := by - refine IsGalois.of_equiv_equiv (F := K) (E := E) - (f := (FractionRing.algEquiv R K).symm.toRingEquiv) - (g := (FractionRing.algEquiv T E).symm.toRingEquiv) ?_ - ext - simpa using! IsFractionRing.algEquiv_commutes - (FractionRing.algEquiv R K).symm - (FractionRing.algEquiv T E).symm _ - obtain ⟨Q, hQ⟩ : ∃ Q : Ideal T, Q.IsMaximal ∧ Q.LiesOver P := - Ideal.exists_maximal_ideal_liesOver_of_isIntegral P - letI : Q.IsMaximal := hQ.1 - letI : Q.LiesOver P := hQ.2 - letI : Q.LiesOver p := Ideal.LiesOver.trans Q P p - have h := Ideal.relNorm_eq_pow_of_isPrime_isGalois Q p - letI : IsGalois (FractionRing S) (FractionRing T) := - IsGalois.tower_top_of_isGalois - (FractionRing R) (FractionRing S) (FractionRing T) - rwa [← Ideal.relNorm_relNorm R S, - Ideal.relNorm_eq_pow_of_isPrime_isGalois Q P, map_pow, - Ideal.inertiaDeg_tower (R := R) P Q, pow_mul, - pow_left_inj (Ideal.inertiaDeg_pos Q S).ne'] at h + exact Ideal.relNorm_eq_pow_of_isMaximal_of_isSeparable P p private theorem count_relNorm_heightOne_of_liesOver (p : HeightOneSpectrum R) (Q : HeightOneSpectrum S) (hQp : Q.asIdeal.LiesOver p.asIdeal) : diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean index 897e51c44e..1b760b5755 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean @@ -110,8 +110,7 @@ def finitePrincipalDivisor (x : L) : HeightOneSpectrum R →₀ ℤ := @[simp] theorem finitePrincipalDivisor_apply (x : L) (v : HeightOneSpectrum R) : - finitePrincipalDivisor x v = finitePlaceOrder v x := by - simp [finitePrincipalDivisor] + finitePrincipalDivisor x v = finitePlaceOrder v x := rfl /-- The finite principal divisor of a nonzero product is the sum of the two finite principal divisors. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean index 7d6bb8a44e..637bc80b54 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean @@ -34,14 +34,14 @@ def planeCurveLogarithmicPDeriv {K : Type*} [Field K] theorem coeff_planeCurveLogarithmicPDeriv {K : Type*} [Field K] (i : Fin 2) (f : MvPolynomial (Fin 2) K) (m : Fin 2 →₀ ℕ) : - MvPolynomial.coeff m (planeCurveLogarithmicPDeriv i f) = - (m i : K) * MvPolynomial.coeff m f := by + (planeCurveLogarithmicPDeriv i f).coeff m = + (m i : K) * f.coeff m := by induction f using MvPolynomial.induction_on' with | add p q hp hq => simp only [planeCurveLogarithmicPDeriv, map_add, mul_add, MvPolynomial.coeff_add] - change MvPolynomial.coeff m (planeCurveLogarithmicPDeriv i p) + - MvPolynomial.coeff m (planeCurveLogarithmicPDeriv i q) = _ + change (planeCurveLogarithmicPDeriv i p).coeff m + + (planeCurveLogarithmicPDeriv i q).coeff m = _ rw [hp, hq] | monomial n a => rw [planeCurveLogarithmicPDeriv, @@ -61,8 +61,8 @@ def planeCurveLogarithmicDirection {K : Type*} [Field K] theorem coeff_planeCurveLogarithmicDirection {K : Type*} [Field K] (a b : K) (f : MvPolynomial (Fin 2) K) (m : Fin 2 →₀ ℕ) : - MvPolynomial.coeff m (planeCurveLogarithmicDirection a b f) = - (a * (m 0 : K) + b * (m 1 : K)) * MvPolynomial.coeff m f := by + (planeCurveLogarithmicDirection a b f).coeff m = + (a * (m 0 : K) + b * (m 1 : K)) * f.coeff m := by simp only [planeCurveLogarithmicDirection, MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, coeff_planeCurveLogarithmicPDeriv] ring @@ -90,7 +90,7 @@ private theorem eq_C_coeff_zero_of_degreeOf_zero {K : Type*} [Field K] (g : MvPolynomial (Fin 2) K) (h0 : MvPolynomial.degreeOf 0 g = 0) (h1 : MvPolynomial.degreeOf 1 g = 0) : - g = MvPolynomial.C (MvPolynomial.coeff 0 g) := by + g = MvPolynomial.C (g.coeff 0) := by ext m by_cases hm : m = 0 · subst m @@ -131,7 +131,7 @@ theorem planeCurveLogarithmicDirection_eq_C_mul_of_dvd rw [hg, MvPolynomial.degreeOf_mul_eq hf hg0] at hdegree0 hdegree1 have hgDegree0 : MvPolynomial.degreeOf 0 g = 0 := by omega have hgDegree1 : MvPolynomial.degreeOf 1 g = 0 := by omega - let d := MvPolynomial.coeff 0 g + let d := g.coeff 0 have hgC : g = MvPolynomial.C d := eq_C_coeff_zero_of_degreeOf_zero g hgDegree0 hgDegree1 refine ⟨d, ?_⟩ @@ -163,10 +163,10 @@ private theorem logWeights_eq_of_logarithmicPDeriv_eq ∀ m ∈ f.support, (m 0 : K) - c * (m 1 : K) = d := by intro m hm - have hcoeff := congrArg (MvPolynomial.coeff m) hrelation + have hcoeff := congrArg (fun p ↦ p.coeff m) hrelation simp only [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, coeff_planeCurveLogarithmicPDeriv] at hcoeff - have hm0 : MvPolynomial.coeff m f ≠ 0 := + have hm0 : f.coeff m ≠ 0 := MvPolynomial.mem_support_iff.mp hm apply (mul_right_cancel₀ hm0) linear_combination hcoeff diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean b/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean index 9b9b4dced8..0e30214956 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean @@ -126,9 +126,7 @@ theorem legendrePointFrobenius_baseChange (u v : F) | zero => rfl | some x y h => simp only [legendrePointFrobenius, legendrePointBaseChange, - mapLegendrePointCoordinates, WeierstrassCurve.Affine.Point.some.injEq] - exact ⟨(FiniteField.frobeniusAlgHom F (AlgebraicClosure F)).commutes x, - (FiniteField.frobeniusAlgHom F (AlgebraicClosure F)).commutes y⟩ + mapLegendrePointCoordinates, AlgHom.commutes] /-- Every Frobenius-fixed algebraic-closure point descends to an `F`-rational point. -/ theorem exists_baseChange_eq_of_legendrePointFrobenius_eq (u v : F) @@ -155,8 +153,7 @@ theorem exists_baseChange_eq_of_legendrePointFrobenius_eq (u v : F) ((legendreWeierstrassCurve u v).toAffine.baseChange_nonsingular (Algebra.ofId F (AlgebraicClosure F)).injective x₀ y₀).mp hmapped refine ⟨.some x₀ y₀ hbase, ?_⟩ - simpa only [legendrePointBaseChange, WeierstrassCurve.Affine.Point.some.injEq] - using And.intro hx₀ hy₀ + simp only [legendrePointBaseChange, hx₀, hy₀] /-- `F`-rational Legendre points are exactly the Frobenius-fixed algebraic-closure points. -/ def legendreRationalPointEquivFrobeniusFixed (u v : F) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean index 8e8ae693b5..e3c67fb38d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean @@ -25,7 +25,11 @@ inductive EvenSign | neg12 | neg13 | neg23 - deriving DecidableEq, Fintype, Repr + deriving DecidableEq, Repr + +instance : Fintype EvenSign where + elems := {.id, .neg12, .neg13, .neg23} + complete x := by cases x <;> simp namespace EvenSign diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean index 9485f4f86e..967e95b4a7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean @@ -368,14 +368,16 @@ theorem rhoSL_two_pow_eq_one_iff have hmatrix := congrArg (fun g : Matrix.SpecialLinearGroup (Fin 2) (ZMod p) => (g : Matrix (Fin 2) (Fin 2) (ZMod p))) hpower + change rho (2 : ZMod p) ^ n = 1 at hmatrix have hentry := congrArg (fun m : Matrix (Fin 2) (Fin 2) (ZMod p) => m 0 1) hmatrix - simp [rhoSL, rho_two_pow] at hentry + simp [rho_two_pow] at hentry exact (ZMod.natCast_eq_zero_iff n p).mp hentry · intro hn have hnzero : (n : ZMod p) = 0 := (ZMod.natCast_eq_zero_iff n p).2 hn apply Matrix.SpecialLinearGroup.ext intro a b - fin_cases a <;> fin_cases b <;> simp [rhoSL, rho_two_pow, hnzero] + change (rho (2 : ZMod p) ^ n) a b = (1 : Matrix (Fin 2) (Fin 2) (ZMod p)) a b + fin_cases a <;> fin_cases b <;> simp [rho_two_pow, hnzero] /-- The normalized trace-`2` rotation has exact group-theoretic order `p`. -/ theorem rotationOrder_two (p : ℕ) [Fact p.Prime] : @@ -419,15 +421,16 @@ theorem rhoSL_neg_two_pow_eq_one_iff have hmatrix := congrArg (fun g : Matrix.SpecialLinearGroup (Fin 2) (ZMod p) => (g : Matrix (Fin 2) (Fin 2) (ZMod p))) hpower + change rho (-2 : ZMod p) ^ n = 1 at hmatrix have hoffDiagonal := congrArg (fun m : Matrix (Fin 2) (Fin 2) (ZMod p) => m 0 1) hmatrix have hnzero : (n : ZMod p) = 0 := by - simpa [rhoSL, rho_neg_two_pow] using hoffDiagonal + simpa [rho_neg_two_pow] using hoffDiagonal have hpdvd : p ∣ n := (ZMod.natCast_eq_zero_iff n p).mp hnzero have hdiagonal := congrArg (fun m : Matrix (Fin 2) (Fin 2) (ZMod p) => m 0 0) hmatrix have hsign : (-1 : ZMod p) ^ n = 1 := by - simpa [rhoSL, rho_neg_two_pow, hnzero] using hdiagonal + simpa [rho_neg_two_pow, hnzero] using hdiagonal have heven : Even n := (neg_one_pow_eq_one_iff_even hnegOne).mp hsign exact (Fact.out : p.Prime).odd_of_ne_two hpTwo |>.coprime_two_left |>.mul_dvd_of_dvd_of_dvd heven.two_dvd hpdvd @@ -439,8 +442,9 @@ theorem rhoSL_neg_two_pow_eq_one_iff have hsign : (-1 : ZMod p) ^ n = 1 := heven.neg_one_pow apply Matrix.SpecialLinearGroup.ext intro a b + change (rho (-2 : ZMod p) ^ n) a b = (1 : Matrix (Fin 2) (Fin 2) (ZMod p)) a b fin_cases a <;> fin_cases b <;> - simp [rhoSL, rho_neg_two_pow, hnzero, hsign] + simp [rho_neg_two_pow, hnzero, hsign] /-- The normalized trace-`-2` rotation has exact group-theoretic order `2p` for odd `p`. -/ theorem rotationOrder_neg_two diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean index b32d69d5e2..0316388589 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean @@ -105,7 +105,7 @@ theorem splitDiagonalSLHom_injective : apply Units.ext have hentry := congrArg (fun A : Matrix.SpecialLinearGroup (Fin 2) F => (A : Matrix (Fin 2) (Fin 2) F) 0 0) h - simpa [splitDiagonalSLHom, splitDiagonalSL_coe] using hentry + exact hentry /-- The diagonal `SL₂` element has exactly the multiplicative order of its first eigenvalue. -/ theorem splitDiagonalSL_orderOf (w : Fˣ) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean index 49e4aca091..0bd5436b18 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean @@ -132,9 +132,13 @@ lemma not_isSquare_algebraMap_adjoinSquare_of_independent let x : F := b.repr z 0 let y : F := b.repr z 1 have hb0 : b 0 = 1 := by - simp [b, PowerBasis.coe_basis] + simp only [b, Module.Basis.reindex_apply, PowerBasis.coe_basis] + change AdjoinRoot.root q ^ 0 = 1 + exact pow_zero _ have hb1 : b 1 = AdjoinRoot.root q := by - simp [b, PowerBasis.coe_basis] + simp only [b, Module.Basis.reindex_apply, PowerBasis.coe_basis] + change AdjoinRoot.root q ^ 1 = AdjoinRoot.root q + exact pow_one _ have hz : z = algebraMap F (AdjoinRoot q) x + algebraMap F (AdjoinRoot q) y * AdjoinRoot.root q := by have hsum := b.sum_repr z @@ -206,10 +210,22 @@ lemma adjoinSquareMap_injective {R S : Type*} [CommRing R] [CommRing S] (AdjoinRoot.powerBasis' hqRMonic).basis.reindex (finCongr hqRNatDegree) let bS : Module.Basis (Fin 2) S (AdjoinRoot qS) := (AdjoinRoot.powerBasis' hqSMonic).basis.reindex (finCongr hqSNatDegree) - have hbR0 : bR 0 = 1 := by simp [bR, PowerBasis.coe_basis] - have hbR1 : bR 1 = AdjoinRoot.root qR := by simp [bR, PowerBasis.coe_basis] - have hbS0 : bS 0 = 1 := by simp [bS, PowerBasis.coe_basis] - have hbS1 : bS 1 = AdjoinRoot.root qS := by simp [bS, PowerBasis.coe_basis] + have hbR0 : bR 0 = 1 := by + simp only [bR, Module.Basis.reindex_apply, PowerBasis.coe_basis] + change AdjoinRoot.root qR ^ 0 = 1 + exact pow_zero _ + have hbR1 : bR 1 = AdjoinRoot.root qR := by + simp only [bR, Module.Basis.reindex_apply, PowerBasis.coe_basis] + change AdjoinRoot.root qR ^ 1 = AdjoinRoot.root qR + exact pow_one _ + have hbS0 : bS 0 = 1 := by + simp only [bS, Module.Basis.reindex_apply, PowerBasis.coe_basis] + change AdjoinRoot.root qS ^ 0 = 1 + exact pow_zero _ + have hbS1 : bS 1 = AdjoinRoot.root qS := by + simp only [bS, Module.Basis.reindex_apply, PowerBasis.coe_basis] + change AdjoinRoot.root qS ^ 1 = AdjoinRoot.root qS + exact pow_one _ rw [injective_iff_map_eq_zero] intro z hzMap let x : R := bR.repr z 0 @@ -223,7 +239,7 @@ lemma adjoinSquareMap_injective {R S : Type*} [CommRing R] [CommRing S] algebraMap S (AdjoinRoot qS) (φ x) + algebraMap S (AdjoinRoot qS) (φ y) * AdjoinRoot.root qS = 0 := by rw [hz] at hzMap - simpa [adjoinSquareMap, qR, qS] using hzMap + simpa [adjoinSquareMap, AdjoinRoot.map, qR, qS] using hzMap have hbasisTarget : φ x • bS 0 + φ y • bS 1 = 0 := by simpa [hbS0, hbS1, Algebra.smul_def] using htarget have hxMap := congrArg (bS.coord 0) hbasisTarget @@ -279,7 +295,7 @@ lemma incidenceFirstQuadraticToRatFunc_algebraMap (a : L) (r : Polynomial L) : (algebraMap (Polynomial L) (IncidenceFirstQuadraticRing L a) r) = algebraMap (RatFunc L) (IncidenceFirstQuadraticRatFuncRing L a) (algebraMap (Polynomial L) (RatFunc L) r) := by - simp [incidenceFirstQuadraticToRatFunc, adjoinSquareMap] + simp [incidenceFirstQuadraticToRatFunc, adjoinSquareMap, AdjoinRoot.map] /-- The second quadratic polynomial over the first rational-function-field extension. -/ def incidenceSecondQuadraticRatFuncPolynomial (a b : L) : @@ -672,8 +688,8 @@ lemma incidenceAuxCoordinateRingToBiquadratic_coordinateClass (a b : L) (i : Fin (incidenceAuxCoordinateClass L a b i) = ![incidenceBiquadraticY L a b, incidenceBiquadraticLambda L a b, incidenceBiquadraticMu L a b] i := by - simp [incidenceAuxCoordinateRingToBiquadratic, incidenceAuxCoordinateClass, - incidenceAuxAevalToBiquadratic] + change incidenceAuxAevalToBiquadratic L a b (X i) = _ + simp [incidenceAuxAevalToBiquadratic] @[simp] lemma incidenceBiquadraticToAuxCoordinateRing_y (a b : L) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean index de7fc09fdd..966232f90d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean @@ -42,7 +42,7 @@ theorem algebraNorm_norm_le_pow_of_embeddings _ = ‖∏ σ : K →ₐ[ℚ] ℂ, σ x‖ := by rw [Algebra.norm_eq_prod_embeddings] _ ≤ ∏ σ : K →ₐ[ℚ] ℂ, ‖σ x‖ := Finset.norm_prod_le _ _ _ ≤ ∏ _σ : K →ₐ[ℚ] ℂ, B := by - exact Finset.prod_le_prod (fun _ _ ↦ norm_nonneg _) (fun σ _ ↦ hB σ) + exact Finset.prod_le_prod₀ (fun _ _ ↦ norm_nonneg _) (fun σ _ ↦ hB σ) _ = B ^ Module.finrank ℚ K := by simp [AlgHom.card] /-- Integral version of `algebraNorm_norm_le_pow_of_embeddings`, with an integer-valued bound. -/ @@ -169,7 +169,7 @@ theorem cyclotomicDefect_integerNorm_natAbs_pos apply integerNorm_natAbs_pos intro hzero apply hη - simpa using congrArg (fun x : 𝓞 K ↦ (x : K)) hzero + exact congrArg (fun x : 𝓞 K ↦ (x : K)) hzero /-- The completed norm-and-reduction implication: if the nonzero cyclotomic defect reduces to zero at an ideal above `(p)`, then `p ≤ 20 ^ φ(n)`. Constructing the compatible reduction data is the @@ -193,7 +193,7 @@ theorem modulus_le_twenty_pow_totient_of_cyclotomicDefect_reduction have hηne : η ≠ 0 := by intro hzero apply hη - simpa [η] using congrArg (fun x : 𝓞 K ↦ (x : K)) hzero + exact congrArg (fun x : 𝓞 K ↦ (x : K)) hzero have hp_le : p ≤ (Algebra.norm ℤ η).natAbs := modulus_le_integerNorm_natAbs_of_quotient_eq_zero P p η hP (by simpa [η] using hred) hηne exact hp_le.trans <| by diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean index 324eff029e..01ac56542d 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean @@ -90,7 +90,7 @@ private lemma exists_card_divisors_pow_le_constant_mul (k : ℕ) : (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ k) ≤ ∏ p ∈ n.primeFactors, ((if p < 2 ^ k then D else 1) * p ^ n.factorization p) := - Finset.prod_le_prod (fun _ _ ↦ Nat.zero_le _) hfactor + Finset.prod_le_prod hfactor _ = D ^ (n.primeFactors.filter fun p ↦ p < 2 ^ k).card * n := by rw [Finset.prod_mul_distrib, ← Nat.prod_primeFactors_pow_factorization hn] simp [Finset.prod_ite] diff --git a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean index 261da482a3..beed2d243d 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean @@ -89,6 +89,7 @@ theorem relNorm_eq_pow_of_isMaximal_of_isSeparable letI : Module.Finite S T := IsIntegralClosure.finite S L E T letI : Module.Finite R T := Module.Finite.trans S T letI : IsDedekindDomain T := integralClosure.isDedekindDomain S L E + have : IsTorsionFree S T := FaithfulSMul.to_isTorsionFree S T letI : IsGalois K E := { to_isSeparable := inferInstance to_normal := normalClosure.normal K L (AlgebraicClosure L) } From 6a765b6c6433429549157a84f5ac4c1e458fb8f1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 21:54:32 +0000 Subject: [PATCH 04/37] Repair normalized coordinates and function-field dependency APIs --- .../DivisorExponentCoefficient.lean | 9 +++++---- .../AbsoluteIrreducibilityBaseChange.lean | 18 ++++++++++++----- .../DedekindDifferentDivisor.lean | 2 +- .../BGS/CorvajaZannier/InfinityPlace.lean | 2 +- .../PlaneCurveDiagonalStabilizer.lean | 16 +++++++-------- .../CorvajaZannier/PlaneCurveSupportRank.lean | 20 +++++++++---------- .../DedekindDifferentLocalTrace.lean | 1 - .../BGS/HasseWeil/ExactConstantExtension.lean | 3 ++- .../HasseWeil/FinitePlaceApproximation.lean | 2 +- .../MarkoffModP/BGS/HasseWeil/PowerSum.lean | 11 ++++------ .../Core/FiniteRotationEigenvalues.lean | 3 ++- .../BGS/Markoff/Core/Normalization.lean | 2 +- .../BGS/Markoff/Core/NormalizedOrbit.lean | 2 +- .../BGS/Markoff/Diophantine/LocalCounts.lean | 5 ++++- .../Markoff/Incidence/NormalizedGraph.lean | 6 +++++- .../NumberTheory/ExplicitDivisorBound.lean | 17 +++++++++------- ...ncatedOrderTotientRankinFactorization.lean | 4 ++-- 17 files changed, 70 insertions(+), 53 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean index 2d129ca2b8..51f33e0bb3 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean @@ -89,11 +89,12 @@ theorem divisorExponentLayer_card_eq_divisorRankCoefficient | nil => cases rank with | zero => - simp [DivisorExponentLayer, DivisorExponentBox, - divisorExponentRank, divisorRankCoefficient] + let : Unique (DivisorExponentLayer [] 0) := + ⟨⟨PUnit.unit, rfl⟩, fun x ↦ Subtype.ext (Subsingleton.elim (α := PUnit) _ _)⟩ + exact Fintype.card_unique | succ rank => - simp [DivisorExponentLayer, DivisorExponentBox, - divisorExponentRank, divisorRankCoefficient] + change Fintype.card {v : PUnit // 0 = rank + 1} = 0 + exact Fintype.card_eq_zero_iff.mpr ⟨fun x ↦ Nat.noConfusion x.property⟩ | cons factor factors ih => calc Fintype.card diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean index 0f73bef4ea..ce7ce8fa38 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean @@ -179,7 +179,7 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed have hDzero : MvPolynomial.map θ D = 0 := by ext m rw [MvPolynomial.coeff_map] - simp only [coeff_zero] + simp only [AddMonoidAlgebra.coeff_zero, Finsupp.coe_zero, Pi.zero_apply] exact hker_specialize (hcoeffD m) simp only [D, map_sub, map_mul] at hDzero have hmapfAE : MvPolynomial.map θ fA = @@ -202,12 +202,16 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed MvPolynomial.X (gVar mg) * MvPolynomial.X invG - 1 have hqG : qG ∈ RingHom.ker ψ := by change ψ qG = 0 - simp [qG, ψ, val, gVar, invG, hmg] + dsimp only [qG] + rw [map_sub, map_mul, map_one] + simp [ψ, val, gVar, invG, hmg] have hqGE := hker_specialize hqG have hxG : x (gVar mg) ≠ 0 := by have hprod : x (gVar mg) * x invG = 1 := by apply sub_eq_zero.mp - simpa [qG, θ] using hqGE + change θ (MvPolynomial.X (gVar mg) * MvPolynomial.X invG - 1) = 0 at hqGE + rw [map_sub, map_mul, map_one] at hqGE + simpa only [θ, MvPolynomial.eval₂Hom_X'] using hqGE exact left_ne_zero_of_mul_eq_one hprod have hcoeffFormula : gE.coeff mg = x (gVar mg) := by simp [gE, G, MvPolynomial.coeff_sum, @@ -221,12 +225,16 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed MvPolynomial.X (hVar mh) * MvPolynomial.X invH - 1 have hqH : qH ∈ RingHom.ker ψ := by change ψ qH = 0 - simp [qH, ψ, val, hVar, invH, hmh] + dsimp only [qH] + rw [map_sub, map_mul, map_one] + simp [ψ, val, hVar, invH, hmh] have hqHE := hker_specialize hqH have hxH : x (hVar mh) ≠ 0 := by have hprod : x (hVar mh) * x invH = 1 := by apply sub_eq_zero.mp - simpa [qH, θ] using hqHE + change θ (MvPolynomial.X (hVar mh) * MvPolynomial.X invH - 1) = 0 at hqHE + rw [map_sub, map_mul, map_one] at hqHE + simpa only [θ, MvPolynomial.eval₂Hom_X'] using hqHE exact left_ne_zero_of_mul_eq_one hprod have hcoeffFormula : hE'.coeff mh = x (hVar mh) := by simp [hE', H, MvPolynomial.coeff_sum, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean index 050281bb5e..956ae7add1 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean @@ -48,7 +48,7 @@ def idealMultiplicityDivisor (I : Ideal R) (hI : I ≠ ⊥) : Finsupp.mk h.toFinset (fun v => multiplicity v.asIdeal I) (fun v => by rw [h.mem_toFinset, Set.mem_setOf_eq] simpa [Nat.pos_iff_ne_zero] using - (dvd_iff_multiplicity_pos (a := v.asIdeal) (b := I)).symm) + (dvd_iff_multiplicity_pos (FiniteMultiplicity.of_prime_left v.prime hI)).symm) @[simp] theorem idealMultiplicityDivisor_apply (I : Ideal R) (hI : I ≠ ⊥) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean index 49919513b4..440bc3c17f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean @@ -48,7 +48,7 @@ instance : IsDiscreteValuationRing (RatFuncInfinityIntegers K) := instance : IsDedekindDomain (RatFuncInfinityIntegers K) := by let hnf : ¬ IsField (RatFuncInfinityIntegers K) := IsDiscreteValuationRing.not_isField (RatFuncInfinityIntegers K) - apply ((IsDiscreteValuationRing.TFAE (RatFuncInfinityIntegers K) hnf).out 0 2).mp + apply ((IsDiscreteValuationRing.TFAE (RatFuncInfinityIntegers K) hnf).out 1 3).mp infer_instance /-- The unique height-one prime of the infinity valuation ring. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean index 808a09ce94..63ae009ad7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean @@ -16,18 +16,18 @@ def diagonalScale {F : Type*} [Field F] (z : Fˣ × Fˣ) (f : MvPolynomial (Fin 2) F) := f.support.sum fun m => MvPolynomial.monomial m - (MvPolynomial.coeff m f * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1) + (f.coeff m * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1) theorem coeff_diagonalScale {F : Type*} [Field F] (z : Fˣ × Fˣ) (f : MvPolynomial (Fin 2) F) (m : Fin 2 →₀ ℕ) : - MvPolynomial.coeff m (diagonalScale z f) = - MvPolynomial.coeff m f * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 := by + (diagonalScale z f).coeff m = + f.coeff m * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 := by classical by_cases hm : m ∈ f.support · simp [diagonalScale, MvPolynomial.coeff_sum, MvPolynomial.coeff_monomial, hm] - · have hcoeff : MvPolynomial.coeff m f = 0 := + · have hcoeff : f.coeff m = 0 := MvPolynomial.notMem_support_iff.mp hm simp [diagonalScale, MvPolynomial.coeff_sum, MvPolynomial.coeff_monomial, hm, hcoeff] @@ -68,7 +68,7 @@ private theorem eq_C_coeff_zero_of_bidegree_zero {F : Type*} [Field F] (g : MvPolynomial (Fin 2) F) (h0 : MvPolynomial.degreeOf 0 g = 0) (h1 : MvPolynomial.degreeOf 1 g = 0) : - g = MvPolynomial.C (MvPolynomial.coeff 0 g) := by + g = MvPolynomial.C (g.coeff 0) := by ext m by_cases hm : m = 0 · subst m @@ -125,7 +125,7 @@ theorem diagonalScale_eq_C_mul_of_dvd have h := hdegree 1 rw [hg, MvPolynomial.degreeOf_mul_eq hf hg0] at h omega - let c := MvPolynomial.coeff 0 g + let c := g.coeff 0 have hgC : g = MvPolynomial.C c := eq_C_coeff_zero_of_bidegree_zero g hgDegree0 hgDegree1 refine ⟨c, ?_⟩ @@ -161,10 +161,10 @@ theorem planeCurveSupportCharacterStabilizer_of_diagonalScale_eval_zero intro r hr s hs have hweight (m : Fin 2 →₀ ℕ) (hm : m ∈ f.support) : (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 = c := by - have hcoeff := congrArg (MvPolynomial.coeff m) hc + have hcoeff := congrArg (fun p ↦ p.coeff m) hc rw [coeff_diagonalScale] at hcoeff simp only [MvPolynomial.coeff_C_mul] at hcoeff - have hm0 : MvPolynomial.coeff m f ≠ 0 := + have hm0 : f.coeff m ≠ 0 := MvPolynomial.mem_support_iff.mp hm exact mul_left_cancel₀ hm0 (by simpa [mul_comm, mul_left_comm, mul_assoc] using hcoeff) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean index f492fb3cf7..0598c88a17 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean @@ -476,7 +476,7 @@ private theorem exists_directionalPolynomial_representation · exact (parameter_bounds r hr).2.trans hhile |>.trans (parameter_bounds s hs).1 exact hsr (parameter_inj hs hr hparam_eq) let q : Polynomial A := - ∑ s ∈ F.support, Polynomial.monomial (index s) (MvPolynomial.coeff s F) + ∑ s ∈ F.support, Polynomial.monomial (index s) (F.coeff s) have coeff_finset_sum (n : ℕ) (S : Finset (Fin 2 →₀ ℕ)) (g : (Fin 2 →₀ ℕ) → Polynomial A) : (∑ s ∈ S, g s).coeff n = ∑ s ∈ S, (g s).coeff n := by @@ -484,13 +484,13 @@ private theorem exists_directionalPolynomial_representation | empty => simp | @insert a S ha ih => simp [ha, ih, Polynomial.coeff_add] have coeff_q_index : ∀ s ∈ F.support, - q.coeff (index s) = MvPolynomial.coeff s F := by + q.coeff (index s) = F.coeff s := by intro s hs rw [show q.coeff (index s) = ∑ t ∈ F.support, - (Polynomial.monomial (index t) (MvPolynomial.coeff t F)).coeff (index s) by + (Polynomial.monomial (index t) (F.coeff t)).coeff (index s) by simpa [q] using coeff_finset_sum (index s) F.support - (fun t => Polynomial.monomial (index t) (MvPolynomial.coeff t F))] + (fun t => Polynomial.monomial (index t) (F.coeff t))] rw [Finset.sum_eq_single s] · rw [Polynomial.coeff_monomial, if_pos rfl] · intro t ht hts @@ -515,9 +515,9 @@ private theorem exists_directionalPolynomial_representation intro n hn rw [show q.coeff n = ∑ s ∈ F.support, - (Polynomial.monomial (index s) (MvPolynomial.coeff s F)).coeff n by + (Polynomial.monomial (index s) (F.coeff s)).coeff n by simpa [q] using coeff_finset_sum n F.support - (fun s => Polynomial.monomial (index s) (MvPolynomial.coeff s F))] + (fun s => Polynomial.monomial (index s) (F.coeff s))] simp only [Polynomial.coeff_monomial] apply Finset.sum_eq_zero intro s hs @@ -599,7 +599,7 @@ private theorem exists_directionalPolynomial_representation have hhomog : directionalHomogenization v q N = ∑ s ∈ F.support, directionalHomogenization v - (Polynomial.monomial (index s) (MvPolynomial.coeff s F)) N := by + (Polynomial.monomial (index s) (F.coeff s)) N := by simp only [q, directionalHomogenization, Polynomial.homogenize_finsetSum, map_sum] rw [hhomog, Finset.mul_sum] @@ -608,7 +608,7 @@ private theorem exists_directionalPolynomial_representation rw [directionalHomogenization_monomial v (index_le s hs)] rw [MvPolynomial.monomial_mul] simp only [one_mul] - apply congrArg (fun e => MvPolynomial.monomial e (MvPolynomial.coeff s F)) + apply congrArg (fun e => MvPolynomial.monomial e (F.coeff s)) simpa [add_assoc] using exponent_eq s hs private theorem directionalPolynomial_degree_eq_one_of_irreducible @@ -812,10 +812,10 @@ theorem planeCurveSupportHasRankTwo_of_absoluteIrreducible_notSubtorusTranslate have hsupp_single : F.support = {r} := by apply Finset.eq_singleton_iff_unique_mem.mpr exact ⟨hr, fun s hs => hsingle s hs⟩ - have hFmono : F = MvPolynomial.monomial r (MvPolynomial.coeff r F) := by + have hFmono : F = MvPolynomial.monomial r (F.coeff r) := by rw [← F.support_sum_monomial_coeff, hsupp_single] simp - have hcoeff : MvPolynomial.coeff r F ≠ 0 := + have hcoeff : F.coeff r ≠ 0 := MvPolynomial.mem_support_iff.mp hr have hx₀ : (x₀ : A) ≠ 0 := Units.ne_zero x₀ have hy₀ : (y₀ : A) ≠ 0 := Units.ne_zero y₀ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 10ab08f68d..971b05d4cf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -38,7 +38,6 @@ theorem le_iff_count_ge {I J : FractionalIdeal R⁰ K} (hI : I ≠ 0) (hJ : J simpa [hzero] apply finprod_le_finprod · exact hfinite I - · exact fun _ ↦ zero_le _ · exact hfinite J · intro v exact zpow_le_zpow_right_of_le_one₀ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean index af4895b3e7..2df0c4ba11 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean @@ -198,7 +198,8 @@ noncomputable def exactConstantExtensionLinearEquiv : map_add' := map_add e map_smul' := by intro x z - refine TensorProduct.induction_on z (by simp) (fun y s => ?_) + refine TensorProduct.induction_on (motive := fun z ↦ e (x • z) = x • e z) z + (by rw [smul_zero, map_zero, smul_zero]) (fun y s => ?_) (fun z w hz hw => ?_) · change e ((x * y) ⊗ₜ[C] s) = e (x ⊗ₜ[C] (1 : S)) * e (y ⊗ₜ[C] s) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean index ed5679e7bd..2634cd5952 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean @@ -265,7 +265,7 @@ theorem exists_fraction_approximating_at_finitePlaces_regular_elsewhere · have hcount : (normalizedFactors (Ideal.span ({(denominator : R)} : Set R))).count v.asIdeal = 0 := by - exact Multiset.count_eq_zero.mpr (by simpa using hfactor) + exact Multiset.count_eq_zero.mpr (by simpa only [Multiset.mem_toFinset] using hfactor) simp [hcount] simpa [z] using valuation_div_algebraMap_le_one_of_mem_denominatorPower diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean index 1f0ee69aa3..4f154d9a41 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean @@ -126,13 +126,10 @@ theorem norm_le_of_mem_of_weightedPowerSum_isBigO (fun n : ℕ ↦ (isolatePolynomial s z).sum (fun k a ↦ a * weightedPowerSum s weight (n + k))) =O[atTop] fun n : ℕ ↦ ρ ^ n := by - simpa only [Polynomial.sum_def] using - (IsBigO.sum fun k hk ↦ - (hshift k).const_mul_left ((isolatePolynomial s z).coeff k) : - (fun n : ℕ ↦ ∑ k ∈ (isolatePolynomial s z).support, - (isolatePolynomial s z).coeff k * - weightedPowerSum s weight (n + k)) =O[atTop] - fun n : ℕ ↦ ρ ^ n) + convert! (IsBigO.sum (s := (isolatePolynomial s z).support) fun k hk ↦ + (hshift k).const_mul_left ((isolatePolynomial s z).coeff k)) using 1 + funext n + simp only [Polynomial.sum_def, Finset.sum_apply] have hisolated : (fun n : ℕ ↦ weight z * z ^ n * (isolatePolynomial s z).eval z) =O[atTop] fun n : ℕ ↦ ρ ^ n := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean index 80ca95a026..a6cb9a032a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean @@ -81,10 +81,11 @@ theorem rhoSL_two_not_finiteOrder : ¬ IsOfFinOrder (rhoSL (2 : R)) := by have hmatrix := congrArg (fun g : Matrix.SpecialLinearGroup (Fin 2) R ↦ (g : Matrix (Fin 2) (Fin 2) R)) hpower + change rho (2 : R) ^ n = 1 at hmatrix have hoffDiagonal := congrArg (fun m : Matrix (Fin 2) (Fin 2) R ↦ m 0 1) hmatrix have hnzero : (n : R) = 0 := by - simpa [rhoSL, rho_two_pow] using hoffDiagonal + simpa [rho_two_pow] using hoffDiagonal have : n = 0 := by exact_mod_cast hnzero exact hnpos.ne' this diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean index 79ac27cd65..1af6e646db 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean @@ -221,7 +221,7 @@ def normalizationEquiv (R : Type u) [CommRing R] [Invertible (3 : R)] : /-- Scaling by three restricts to an equivalence of the original and normalized Markoff surfaces. -/ def normalizationSurfaceEquiv (R : Type u) [CommRing R] [Invertible (3 : R)] : - ↑(surface R) ≃ ↑(normalizedSurface R) := + {x : Point R // IsMarkoff x} ≃ {x : NormalizedPoint R // IsNormalizedMarkoff x} := (normalizationEquiv R).subtypeEquiv fun x => by change IsMarkoff x ↔ IsNormalizedMarkoff (toNormalized x) exact (isNormalizedMarkoff_toNormalized_iff x).symm diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean index fb9f4c4532..0ac820202e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean @@ -22,7 +22,7 @@ universe u /-- The normalized Markoff surface as a subtype. -/ abbrev NormalizedMarkoffSurface (R : Type u) [CommRing R] := - ↑(normalizedSurface R) + {x : NormalizedPoint R // IsNormalizedMarkoff x} /-- The fundamental rotation, restricted to the original-coordinate Markoff surface. -/ def rotate1Surface {R : Type u} [CommRing R] (x : MarkoffSurface R) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean index 3f44d84c8f..a815d950c1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean @@ -182,7 +182,10 @@ private def normalizedSurfaceEquivDiscriminantRoots ext <;> simp right_inv u := by rcases u with ⟨x, y, d⟩ - simp + change (⟨x, y, (normalizedMarkoffThirdCoordinateEquivDiscriminantRoots hF x y) + ((normalizedMarkoffThirdCoordinateEquivDiscriminantRoots hF x y).symm d)⟩ : + Σ x : F, Σ y : F, {d : F // d ^ 2 = (y ^ 2 - 4) * x ^ 2 - 4 * y ^ 2}) = _ + rw [Equiv.apply_symm_apply] private lemma squareRootSubtypeCard_eq_quadraticChar_add_one (hF : ringChar F ≠ 2) (t : F) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean index 5280becefc..d8d5cc54d9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean @@ -27,7 +27,11 @@ inductive NormalizedCoordinateAxis | first | second | third - deriving DecidableEq, Fintype, Repr + deriving DecidableEq, Repr + +instance : Fintype NormalizedCoordinateAxis where + elems := {.first, .second, .third} + complete x := by cases x <;> simp /-- A normalized conic fiber, indexed without identifying normalized and original coordinates. -/ def normalizedFiberAt {R : Type u} [CommRing R] : diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean index 1304d47cfb..4c51e4e1ba 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean @@ -80,7 +80,7 @@ theorem card_divisors_pow_le_explicit_constant_mul (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ k) ≤ ∏ p ∈ n.primeFactors, ((if p < 2 ^ k then D else 1) * p ^ n.factorization p) := - Finset.prod_le_prod (fun _ _ => Nat.zero_le _) hfactor + Finset.prod_le_prod hfactor _ = D ^ (n.primeFactors.filter fun p => p < 2 ^ k).card * n := by rw [Finset.prod_mul_distrib, ← Nat.prod_primeFactors_pow_factorization hn] simp [Finset.prod_ite] @@ -91,20 +91,23 @@ theorem card_divisors_pow_le_explicit_constant_mul /-- Sealed data for the closed factorization constant. The subtype equation lets downstream proofs rewrite the value without asking the kernel to repeatedly normalize its enormous exponentiation. -/ -@[irreducible] def explicitDivisorConstantData : +noncomputable def explicitDivisorConstantData : {n : ℕ // n = (32 ^ 32) ^ (2 ^ 32)} := - ⟨(32 ^ 32) ^ (2 ^ 32), rfl⟩ + Classical.choice ⟨⟨(32 ^ 32) ^ (2 ^ 32), rfl⟩⟩ /-- The closed factorization constant used by the explicit Markoff proof. -/ -def explicitDivisorConstant : ℕ := explicitDivisorConstantData.1 +noncomputable def explicitDivisorConstant : ℕ := explicitDivisorConstantData.1 theorem explicitDivisorConstant_eq : explicitDivisorConstant = (32 ^ 32) ^ (2 ^ 32) := explicitDivisorConstantData.2 -theorem explicitDivisorConstant_pos : 0 < explicitDivisorConstant := by - rw [explicitDivisorConstant_eq] - exact pow_pos (pow_pos (by norm_num) _) _ +private theorem positive_of_eq_iterated_pow {n a b c : ℕ} + (ha : 0 < a) (h : n = (a ^ b) ^ c) : 0 < n := + h.symm ▸ pow_pos (pow_pos ha _) _ + +theorem explicitDivisorConstant_pos : 0 < explicitDivisorConstant := + positive_of_eq_iterated_pow (by decide : 0 < 32) explicitDivisorConstant_eq theorem explicitDivisorConstant_le_pow_thirtyTwo : explicitDivisorConstant ≤ explicitDivisorConstant ^ 32 := by diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean index 5f6c24a3e1..ecaa73c370 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean @@ -209,7 +209,7 @@ theorem factorizationEulerProduct_le_coarse (N.factorization.prod fun prime exponent => coarseRankinPrimePowerFactor exponent (primeWeight prime)) := by simp only [Finsupp.prod] - apply Finset.prod_le_prod + apply Finset.prod_le_prod₀ · intro prime hprime exact rankinPrimePowerFactor_nonneg (Nat.prime_of_mem_primeFactors hprime) @@ -244,7 +244,7 @@ theorem factorizationWeight_twelfthPower rw [hnCast] simp only [factorizationWeight, hn, ↓reduceIte, Finsupp.prod] rw [← Finset.prod_pow, ← Finset.prod_mul_distrib] - apply Finset.one_le_prod + apply Finset.one_le_prod₀ intro prime hprime rw [show (prime : ℚ) ^ n.factorization prime * (primeWeight prime ^ n.factorization prime) ^ 12 = From 6fbe2588a3a099e11ca16cd79be76ced2fb016da Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 22:20:13 +0000 Subject: [PATCH 05/37] Port divisor, curve and gluing proofs to current Mathlib --- .../ConstantOpenGlueData.lean | 19 +++-- .../DedekindCanonicalDifferentScaling.lean | 6 +- .../CorvajaZannier/InfinityInertiaDegree.lean | 5 +- .../BGS/CorvajaZannier/LocalMonogenicity.lean | 4 +- .../LocalReciprocalDiscriminant.lean | 6 +- .../CorvajaZannier/ParameterizedBound.lean | 5 +- .../BGS/CorvajaZannier/PoweredImageCurve.lean | 12 +-- .../BGS/HasseWeil/FormalZetaTrace.lean | 12 +-- .../BGS/HasseWeil/PlaneCoordinateShear.lean | 10 +-- .../Cage/BiquadraticPrimitiveQuartic.lean | 20 +++-- .../Markoff/Core/ConicParametrization.lean | 14 +-- .../Markoff/Opening/CyclotomicReduction.lean | 11 +-- .../IrreducibilityObstructions.lean | 2 +- .../BGS/Markoff/TraceCurve/Kummer.lean | 8 +- .../NumberTheory/PreliminaryDivisorBound.lean | 85 ++++++++++++++++++- LeanPool/MarkoffModP/RiemannRoch/Place.lean | 16 ++-- 16 files changed, 169 insertions(+), 66 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean index d806fe06ed..f11ac6fa63 100644 --- a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean @@ -71,11 +71,17 @@ def constantOpenGlueData toGlueData := CategoryTheory.GlueData.ofGlueData' (constantOpenGlueDataAux U V f t t_id t_comp) f_open i j := by - dsimp [CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f'] - split_ifs + change J at i j + have hf : AlgebraicGeometry.IsOpenImmersion (f i) := inferInstance + dsimp [CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', + constantOpenGlueDataAux] + split_ifs with hij · infer_instance · change AlgebraicGeometry.IsOpenImmersion (eqToHom _ ≫ f i) - infer_instance + refine @AlgebraicGeometry.IsOpenImmersion.comp _ (V i) (U i) + (eqToHom _) (f i) ?_ hf + refine @AlgebraicGeometry.IsOpenImmersion.of_isIso _ _ (eqToHom _) ?_ + exact (eqToIso (if_neg hij)).isIso_hom /-- Glue schemes whose overlap in each chart is identified with one common scheme. The transition from chart `i` to chart `j` is induced by passing through the common target, so identity and @@ -126,7 +132,7 @@ def constantOpenGlueDataOfCommonTargetMap change J at i j by_cases hij : i = j · subst j - rw [D.t_id] + erw [D.t_id] simp · dsimp only [D, constantOpenGlueDataOfCommonTarget, constantOpenGlueData, CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', @@ -157,8 +163,9 @@ theorem constantOpenGlueDataOfCommonTargetMap_chart constantOpenGlueDataOfCommonTargetMap U V U' V' f f' W W' s s' g q h = g i ≫ (constantOpenGlueDataOfCommonTarget U' V' f' W' s').ι i := by dsimp [constantOpenGlueDataOfCommonTargetMap] - unfold CategoryTheory.GlueData.ι - rw [Multicoequalizer.π_desc] + unfold AlgebraicGeometry.Scheme.GlueData.ι + exact Multicoequalizer.π_desc + (constantOpenGlueDataOfCommonTarget U V f W s).toGlueData.diagram _ _ _ i end diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean index e54ddae700..f378bbb2b7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean @@ -42,14 +42,14 @@ theorem exists_element_locally_generating_ideal multiplicity v.asIdeal I := by have hprod : v.asIdeal * I ≠ ⊥ := mul_ne_zero v.ne_bot hI obtain ⟨a, ha⟩ := IsDedekindDomain.exists_sup_span_eq - (I := v.asIdeal * I) (J := I) Ideal.mul_le_left hprod + (I := v.asIdeal * I) (J := I) Ideal.mul_le_right hprod have ha0 : a ≠ 0 := by intro ha_zero have hprod_eq : v.asIdeal * I = I := by simpa [ha_zero] using ha have hmult := congrArg (multiplicity v.asIdeal) hprod_eq rw [multiplicity_mul v.prime - (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self] at hmult + (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self (FiniteMultiplicity.of_prime_left v.prime v.ne_bot)] at hmult omega have hspan0 : Ideal.span {a} ≠ ⊥ := by simpa [Ideal.span_singleton_eq_bot] using ha0 @@ -59,7 +59,7 @@ theorem exists_element_locally_generating_ideal exact le_sup_right have hsup := v.multiplicity_sup hprod hspan0 rw [ha, multiplicity_mul v.prime - (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self] at hsup + (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self (FiniteMultiplicity.of_prime_left v.prime v.ne_bot)] at hsup have hmult : multiplicity v.asIdeal (Ideal.span {a}) = multiplicity v.asIdeal I := by by_cases hle : multiplicity v.asIdeal (Ideal.span {a}) ≤ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean index fe1cff2542..e8b7733250 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean @@ -209,8 +209,9 @@ theorem finiteExtensionInfinityPlace_inertiaDeg_eq_one letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver (ratFuncInfinityPlace K).asIdeal P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra - (ratFuncInfinityPlace K).asIdeal P.1 := ⟨rfl⟩ + let : IsScalarTower (RatFuncInfinityIntegers K) + (Localization.AtPrime (ratFuncInfinityPlace K).asIdeal) (Localization.AtPrime P.1) := + inferInstance letI : IsAlgClosed (ratFuncInfinityPlace K).asIdeal.ResidueField := IsAlgClosed.of_ringEquiv K (ratFuncInfinityPlace K).asIdeal.ResidueField diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean index 915e9fea85..b6e7b9bc78 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean @@ -160,8 +160,8 @@ lemma Ideal.pow_le_span_pow_sup {I J : Ideal S} {π : S} rw [pow_succ] refine (Ideal.mul_mono ih h.le).trans ?_ rw [Ideal.sup_mul, Ideal.mul_sup, Ideal.mul_sup] - refine sup_le (sup_le ?_ (Ideal.mul_le_left.trans le_sup_right)) - (sup_le (Ideal.mul_le_right.trans le_sup_right) + refine sup_le (sup_le ?_ (Ideal.mul_le_right.trans le_sup_right)) + (sup_le (Ideal.mul_le_left.trans le_sup_right) (Ideal.mul_le_left.trans le_sup_right)) rw [Ideal.span_singleton_mul_span_singleton, pow_succ] exact le_sup_left diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean index eec443a62c..640ca325a2 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean @@ -76,7 +76,8 @@ theorem sylvester_reflect (f g : R[X]) (m n : ℕ) : simp only [coeff_reflect] split_ifs <;> simp_all [revAt] <;> try omega congr 1 - rw [if_pos (by omega)] + change revAtFun n ((i : ℕ) - j) = _ + rw [revAtFun, if_pos (by omega)] exact (reflected_row_sub_reflected_shift m n i j i.isLt j.isLt (by omega) (by omega)).symm | right j => @@ -87,7 +88,8 @@ theorem sylvester_reflect (f g : R[X]) (m n : ℕ) : simp only [coeff_reflect] split_ifs <;> simp_all [revAt] <;> try omega congr 1 - rw [if_pos (by omega)] + change revAtFun m ((i : ℕ) - j) = _ + rw [revAtFun, if_pos (by omega)] simpa [Nat.add_comm] using (reflected_row_sub_reflected_shift n m i j (by omega) j.isLt (by omega) (by omega)).symm diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean index b5be513d97..87e447b2f9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean @@ -439,12 +439,13 @@ theorem theoremFour_parameterizedBound_of_propositionTwo ring have hNumerical' : G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := by - simpa [H, K, N, A, B, C, Nat.cast_add, Nat.cast_mul] using hNumerical + simpa only [H, K, N, A, B, C, Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hNumerical calc G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := hNumerical' _ ≤ (3 / t) * baseRoot + (1 / t) * baseRoot + - (t ^ 2 / 2) * baseRoot := by linarith + (t ^ 2 / 2) * baseRoot := + add_le_add (add_le_add hFirstTerm hSecondTerm) hThirdTerm _ = (4 / t + t ^ 2 / 2) * baseRoot := by ring _ = (4 / t + t ^ 2 / 2) * ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean index 7af7104178..48083fcec3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean @@ -122,6 +122,8 @@ theorem finrank_over_adjoin_pow_le_mul change Module.finrank AK L ≤ d rw [hA] exact hdegree + have : Module.Free A L := Module.Free.of_divisionRing A L + have : Module.Free E0 A := Module.Free.of_divisionRing E0 A calc Module.finrank E0 L = Module.finrank E0 A * Module.finrank A L := by rw [Module.finrank_mul_finrank] @@ -698,7 +700,7 @@ theorem poweredCoordinateImageRelation_irreducible (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) - ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + ((planeCurveFunction f 1) ^ n) := IsIntegral.of_finite _ _ change Irreducible (primitiveClearedMinpolyRelation ((planeCurveFunction f 0) ^ m) (firstPoweredCoordinate_transcendental hf hpartialSecond m hm) @@ -720,7 +722,7 @@ theorem evalBivariate_poweredCoordinateImageRelation_eq_zero (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) - ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + ((planeCurveFunction f 1) ^ n) := IsIntegral.of_finite _ _ change evalBivariate ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) (primitiveClearedMinpolyRelation @@ -745,7 +747,7 @@ theorem poweredCoordinateImageRelation_natDegree_eq_finrank (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) - ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + ((planeCurveFunction f 1) ^ n) := IsIntegral.of_finite _ _ calc (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree = (minpoly (FirstPoweredCoordinateSubfield f m) @@ -778,7 +780,7 @@ theorem poweredCoordinateImageRelation_transpose_natDegree_eq_finrank (PlaneCurveFunctionField f) := finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn have hu : IsIntegral (SecondPoweredCoordinateSubfield f n) - ((planeCurveFunction f 0) ^ m) := Algebra.IsIntegral.isIntegral _ + ((planeCurveFunction f 0) ^ m) := IsIntegral.of_finite _ _ have hdegree := transposeBivariate_natDegree_eq_minpoly ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) (secondPoweredCoordinate_transcendental hf hpartialFirst n hn) @@ -851,7 +853,7 @@ theorem poweredCoordinateImageRelation_natDegree_pos (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) - ((planeCurveFunction f 1) ^ n) := Algebra.IsIntegral.isIntegral _ + ((planeCurveFunction f 1) ^ n) := IsIntegral.of_finite _ _ rw [poweredCoordinateImageRelation_natDegree_eq_finrank hf hpartialSecond m hm n, IntermediateField.adjoin.finrank hv] exact minpoly.natDegree_pos hv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean index 97a33645d1..24d351d8c8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -19,7 +19,7 @@ open scoped BigOperators PowerSeries noncomputable section def negativeXLogDerivative (f : PowerSeries ℂ) : PowerSeries ℂ := - -PowerSeries.X * PowerSeries.derivative ℂ f * f⁻¹ + -PowerSeries.X * PowerSeries.derivative (R := ℂ) f * f⁻¹ def linearPowerSeriesFactor (a : ℂ) : PowerSeries ℂ := 1 - PowerSeries.C a * PowerSeries.X @@ -37,7 +37,7 @@ theorem linearPowerSeriesFactor_inv (a : ℂ) : simpa [linearPowerSeriesFactor, mul_comm] using h theorem derivative_linearPowerSeriesFactor (a : ℂ) : - PowerSeries.derivative ℂ (linearPowerSeriesFactor a) = -PowerSeries.C a := by + PowerSeries.derivative (R := ℂ) (linearPowerSeriesFactor a) = -PowerSeries.C a := by change PowerSeries.derivativeFun (linearPowerSeriesFactor a) = -PowerSeries.C a rw [linearPowerSeriesFactor, sub_eq_add_neg] rw [show -(PowerSeries.C a * PowerSeries.X) = @@ -47,7 +47,7 @@ theorem derivative_linearPowerSeriesFactor (a : ℂ) : have hX : PowerSeries.derivativeFun (PowerSeries.X : PowerSeries ℂ) = 1 := PowerSeries.derivative_X have hC : PowerSeries.derivativeFun (PowerSeries.C a) = 0 := - PowerSeries.derivative_C a + PowerSeries.derivative_C rw [hX, hC] simp @@ -128,7 +128,7 @@ def pointCountDerivativeSeries (pointCount : ℕ → ℕ) : PowerSeries ℂ := /-- Euler's logarithmic-derivative identity for a point-count zeta series. -/ def HasFormalZetaPointCountDerivative (Z : PowerSeries ℂ) (pointCount : ℕ → ℕ) : Prop := - PowerSeries.derivative ℂ Z = Z * pointCountDerivativeSeries pointCount + PowerSeries.derivative (R := ℂ) Z = Z * pointCountDerivativeSeries pointCount /-- The formal logarithm `∑ₙ Nₙ Tⁿ/n` attached to extension point counts. -/ def pointCountLogSeries (pointCount : ℕ → ℕ) : PowerSeries ℂ := @@ -150,7 +150,7 @@ def formalPointCountZeta (pointCount : ℕ → ℕ) : PowerSeries ℂ := (PowerSeries.exp ℂ).subst (pointCountLogSeries pointCount) theorem derivative_pointCountLogSeries (pointCount : ℕ → ℕ) : - PowerSeries.derivative ℂ (pointCountLogSeries pointCount) = + PowerSeries.derivative (R := ℂ) (pointCountLogSeries pointCount) = pointCountDerivativeSeries pointCount := by ext n rw [PowerSeries.coeff_derivative] @@ -163,7 +163,7 @@ theorem formalPointCountZeta_hasPointCountDerivative HasFormalZetaPointCountDerivative (formalPointCountZeta pointCount) pointCount := by rw [HasFormalZetaPointCountDerivative, formalPointCountZeta, - PowerSeries.derivative_subst ℂ (pointCountLogSeries_hasSubst pointCount), + PowerSeries.derivative_subst (pointCountLogSeries_hasSubst pointCount), PowerSeries.derivative_exp, derivative_pointCountLogSeries] /-- The denominator `(1 - T)(1 - qT)` of the zeta function of a curve over diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean index 1ffbcb8c88..19ed99a3c5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean @@ -58,13 +58,13 @@ theorem dvd_exponent_of_pderiv_eq_zero exact Finsupp.sub_add_single_one_cancel hi have hni : n i + 1 = m i := by simpa [n] using congrArg (fun v : σ →₀ ℕ => v i) hn - have hcoeff : coeff m f ≠ 0 := by + have hcoeff : f.coeff m ≠ 0 := by simpa [mem_support_iff] using hm have hcast : (m i : R) ≠ 0 := by exact (CharP.cast_eq_zero_iff R p (m i)).not.mpr hnot - have hz := congrArg (coeff n) hderiv + have hz := congrArg (fun g : MvPolynomial σ R ↦ g.coeff n) hderiv rw [coeff_pderiv] at hz - simp only [coeff_zero] at hz + simp only [AddMonoidAlgebra.coeff_zero] at hz rw [hn] at hz have hfactor : ((n i : R) + 1) = (m i : R) := by simpa only [Nat.cast_add, Nat.cast_one] using @@ -92,12 +92,12 @@ theorem exists_pow_eq_of_forall_pderiv_eq_zero let g : MvPolynomial σ R := ∑ m ∈ f.support, monomial (divideExponents p m) - ((frobeniusEquiv R p).symm (coeff m f)) + ((frobeniusEquiv R p).symm (f.coeff m)) refine ⟨g, ?_⟩ rw [← map_frobenius_expand p] calc map (frobenius R p) (expand p g) = - ∑ m ∈ f.support, monomial m (coeff m f) := by + ∑ m ∈ f.support, monomial m (f.coeff m) := by simp only [g, map_sum, map_monomial, expand_monomial] apply Finset.sum_congr rfl intro m hm diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean index 5937bc8ad9..268ea50dd5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean @@ -151,20 +151,24 @@ theorem biquadraticPrimitiveQuartic_irreducible norm_num [secondZero, secondOne] at this have hfirst0 : firstBasis firstZero = 1 := by change (AdjoinRoot.powerBasis' hqfMonic).basis firstZero = 1 - rw [(AdjoinRoot.powerBasis' hqfMonic).basis_eq_pow] - simp [firstZero] + simp only [PowerBasis.coe_basis] + change AdjoinRoot.root qf ^ 0 = 1 + exact pow_zero _ have hfirst1 : firstBasis firstOne = AdjoinRoot.root qf := by change (AdjoinRoot.powerBasis' hqfMonic).basis firstOne = AdjoinRoot.root qf - rw [(AdjoinRoot.powerBasis' hqfMonic).basis_eq_pow] - simp [firstOne] + simp only [PowerBasis.coe_basis] + change AdjoinRoot.root qf ^ 1 = AdjoinRoot.root qf + exact pow_one _ have hsecond0 : secondBasis secondZero = 1 := by change (AdjoinRoot.powerBasis' hqgMonic).basis secondZero = 1 - rw [(AdjoinRoot.powerBasis' hqgMonic).basis_eq_pow] - simp [secondZero] + simp only [PowerBasis.coe_basis] + change AdjoinRoot.root qg ^ 0 = 1 + exact pow_zero _ have hsecond1 : secondBasis secondOne = AdjoinRoot.root qg := by change (AdjoinRoot.powerBasis' hqgMonic).basis secondOne = AdjoinRoot.root qg - rw [(AdjoinRoot.powerBasis' hqgMonic).basis_eq_pow] - simp [secondOne] + simp only [PowerBasis.coe_basis] + change AdjoinRoot.root qg ^ 1 = AdjoinRoot.root qg + exact pow_one _ have hpowers : LinearIndependent F (fun i : Fin 4 ↦ z ^ (i : ℕ)) := by refine Fintype.linearIndependent_iff.mpr ?_ intro c hc i diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean index 7e793d31ca..d596fe878c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean @@ -750,7 +750,7 @@ theorem quadraticNormFiberPoint_parameter quadraticNormFiberPoint p t ht ht0 w (quadraticNormFiberParameter p t ht ht0 w htrace hw x) = x := by apply algebraMapNormalizedPoint_injective p - rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace] + erw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace] let extensionPoint := algebraMapNormalizedFiberPoint p t w htrace x have htraceExtension : splitTorusTrace (w : (quadraticFiniteField p)ˣ) ≠ 0 := by @@ -795,7 +795,7 @@ theorem normalizedRotate1_quadraticNormFiberPoint apply algebraMapNormalizedPoint_injective p rw [algebraMapNormalizedPoint_normalizedRotate1] rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace s] - rw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace] + erw [algebraMap_quadraticNormFiberPoint p t ht ht0 w htrace] rw [normalizedRotate1_splitFiberPoint] rfl @@ -846,12 +846,14 @@ theorem iterate_normalizedRotate1_quadraticNormFiberPoint (quadraticNormFiberMulNormOne p (quadraticFiberProductUnit p t ht ht0) s (w ^ n)) := by induction n with | zero => - simp [quadraticNormFiberMulNormOne_one] + simp only [Function.iterate_zero, id_eq, pow_zero] + congr 1 + exact (quadraticNormFiberMulNormOne_one p _ s).symm | succ n ih => - rw [Function.iterate_succ_apply', ih, + erw [Function.iterate_succ_apply', ih, normalizedRotate1_quadraticNormFiberPoint p t ht ht0 w htrace] congr 1 - rw [quadraticNormFiberMulNormOne_assoc, pow_succ] + erw [quadraticNormFiberMulNormOne_assoc, pow_succ] theorem iterate_normalizedRotate1_quadraticNormFiberPoint_eq_self_iff (t : ZMod p) (ht : t ^ 2 ≠ 4) (ht0 : t ≠ 0) @@ -870,7 +872,7 @@ theorem iterate_normalizedRotate1_quadraticNormFiberPoint_eq_self_iff apply Subtype.ext exact mul_left_cancel hunit · intro hpower - rw [hpower, quadraticNormFiberMulNormOne_one] + erw [hpower, quadraticNormFiberMulNormOne_one] /-- One full nonsplit rotation cycle, represented in the base-field conic. -/ noncomputable def quadraticNormFiberRotationCycle diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean index e422c745af..04e424c2d4 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean @@ -81,7 +81,7 @@ theorem openingCyclotomicRoot_isPrimitive (n : ℕ) [NeZero n] : letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ - simp [openingCyclotomicRoot] + exact IsCyclotomicExtension.zeta_spec n ℚ (OpeningCyclotomicField n) /-- The canonical cyclotomic root, regarded as an algebraic integer. -/ noncomputable def openingCyclotomicIntegerRoot (n : ℕ) [NeZero n] : @@ -116,10 +116,11 @@ private theorem primitiveRoot_isRoot_integralPowerBasis_minpoly letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ - simpa [openingCyclotomicIntegralPowerBasis, - ← NumberField.RingOfIntegers.minpoly_coe, - ← cyclotomic_eq_minpoly (openingCyclotomicRoot_isPrimitive n) (NeZero.pos n)] using - hrootCyclotomic + rw [openingCyclotomicIntegralPowerBasis_gen] + rw [← NumberField.RingOfIntegers.minpoly_coe] + change aeval ω (minpoly ℤ (openingCyclotomicRoot n)) = 0 + erw [← cyclotomic_eq_minpoly (openingCyclotomicRoot_isPrimitive n) (NeZero.pos n)] + exact hrootCyclotomic /-- The compatible reduction homomorphism determined by the prescribed primitive root `ω`. -/ noncomputable def openingCyclotomicReduction diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean index 2e286b9e11..261a4299d1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean @@ -102,7 +102,7 @@ theorem exists_splitTraceCoverPolynomial_normalized_frobenius_factorization (splitTraceCoverPolynomial (1 : K) tau d e) ^ p := by obtain ⟨tau, htau⟩ := surjective_frobenius K p sigma have htauPow : tau ^ p = sigma := by - simpa [frobenius] using htau + exact htau refine ⟨tau, ?_, ?_⟩ · exact htauPow · rw [← htauPow] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean index fa6f62199f..9c8a9e896e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean @@ -182,8 +182,11 @@ lemma norm_splitTraceBaseRoot let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ let pb := AdjoinRoot.powerBasis hIrred.ne_zero + have hdim : pb.dim = 2 := by + change (splitTraceBaseKummerPolynomial sigma).natDegree = 2 + simp [splitTraceBaseKummerPolynomial] change Algebra.norm (RatFunc K) pb.gen = -splitTraceRadicand sigma - rw [Algebra.PowerBasis.norm_gen_eq_coeff_zero_minpoly, + rw [Algebra.PowerBasis.norm_gen_eq_coeff_zero_minpoly, hdim, AdjoinRoot.minpoly_powerBasis_gen_of_monic] · simp [pb, splitTraceBaseKummerPolynomial] · exact monic_X_pow_sub_C _ (by norm_num) @@ -271,6 +274,7 @@ lemma splitTraceBaseFunctionField_finrank let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hIrred.ne_zero)] + change (splitTraceBaseKummerPolynomial sigma).natDegree = 2 simp [splitTraceBaseKummerPolynomial] /-- The norm of `u * v` has rational-function degree one. This is the second independent divisor @@ -322,6 +326,7 @@ lemma splitTraceEtaFunctionField_finrank let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hEtaIrred.ne_zero)] + change (splitTraceEtaKummerPolynomial sigma e).natDegree = e simp [splitTraceEtaKummerPolynomial] /-- The second Kummer radicand, corresponding to `xi^d = u * v`. -/ @@ -538,6 +543,7 @@ lemma splitTraceXiFunctionField_finrank splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hXiIrred.ne_zero)] + change (splitTraceXiKummerPolynomial sigma e d).natDegree = d simp [splitTraceXiKummerPolynomial] /-- The iterated Kummer function-field tower for the odd, coprime split trace power cover is a diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean index 87d51a38a2..164e050794 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean @@ -326,6 +326,68 @@ private theorem factorization_succ_pow_ten_le exact (pow_ten_le_base_oneThousandTwentyFour a).trans <| Nat.pow_le_pow_left hpLower a + +-- Separate closed computations keep each kernel check within the default limit. +private def preliminaryPrimePenaltyBlock (k : ℕ) : ℕ := + ∑ p ∈ Finset.range 64, if Nat.Prime (k * 64 + p) then preliminaryPrimePenalty (k * 64 + p) else 0 +private theorem preliminaryPrimePenaltyBlock_value_0 : preliminaryPrimePenaltyBlock 0 = 165 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_1 : preliminaryPrimePenaltyBlock 1 = 52 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_2 : preliminaryPrimePenaltyBlock 2 = 36 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_3 : preliminaryPrimePenaltyBlock 3 = 33 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_4 : preliminaryPrimePenaltyBlock 4 = 24 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_5 : preliminaryPrimePenaltyBlock 5 = 20 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_6 : preliminaryPrimePenaltyBlock 6 = 20 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_7 : preliminaryPrimePenaltyBlock 7 = 22 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_8 : preliminaryPrimePenaltyBlock 8 = 8 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_9 : preliminaryPrimePenaltyBlock 9 = 10 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_10 : preliminaryPrimePenaltyBlock 10 = 11 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_11 : preliminaryPrimePenaltyBlock 11 = 9 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_12 : preliminaryPrimePenaltyBlock 12 = 10 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_13 : preliminaryPrimePenaltyBlock 13 = 9 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_14 : preliminaryPrimePenaltyBlock 14 = 8 := by + decide +kernel + +private theorem preliminaryPrimePenaltyBlock_value_15 : preliminaryPrimePenaltyBlock 15 = 10 := by + decide +kernel + +private theorem sum_preliminaryPrimePenalty_blocks (k : ℕ) : + (∑ p ∈ Finset.range (k * 64), if Nat.Prime p then preliminaryPrimePenalty p else 0) = + ∑ i ∈ Finset.range k, preliminaryPrimePenaltyBlock i := by + induction k with + | zero => simp + | succ k ih => + rw [Nat.succ_mul, Finset.sum_range_add, ih] + rw [Finset.sum_range_succ (f := preliminaryPrimePenaltyBlock)] + rfl + private theorem sum_preliminaryPrimePenalty_le (n : ℕ) : ∑ p ∈ n.primeFactors, preliminaryPrimePenalty p ≤ 447 := by let smallFactors := @@ -355,7 +417,26 @@ private theorem sum_preliminaryPrimePenalty_le (n : ℕ) : (fun _ _ _ ↦ Nat.zero_le _) have htotal : (∑ p ∈ allSmallPrimes, preliminaryPrimePenalty p) ≤ 447 := by - decide + apply le_of_eq + rw [Finset.sum_filter] + change (∑ p ∈ Finset.range (16 * 64), if Nat.Prime p then preliminaryPrimePenalty p else 0) = _ + rw [sum_preliminaryPrimePenalty_blocks] + simp only [Finset.sum_range_succ, Finset.sum_range_zero] + rw [preliminaryPrimePenaltyBlock_value_0, preliminaryPrimePenaltyBlock_value_1, + preliminaryPrimePenaltyBlock_value_2, + preliminaryPrimePenaltyBlock_value_3, + preliminaryPrimePenaltyBlock_value_4, + preliminaryPrimePenaltyBlock_value_5, + preliminaryPrimePenaltyBlock_value_6, + preliminaryPrimePenaltyBlock_value_7, + preliminaryPrimePenaltyBlock_value_8, + preliminaryPrimePenaltyBlock_value_9, + preliminaryPrimePenaltyBlock_value_10, + preliminaryPrimePenaltyBlock_value_11, + preliminaryPrimePenaltyBlock_value_12, + preliminaryPrimePenaltyBlock_value_13, + preliminaryPrimePenaltyBlock_value_14, + preliminaryPrimePenaltyBlock_value_15] rw [← hsumEq] exact hle.trans htotal @@ -369,7 +450,7 @@ theorem card_divisors_pow_ten_le_preliminary_constant_mul (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ 10) ≤ ∏ p ∈ n.primeFactors, (2 ^ preliminaryPrimePenalty p * p ^ n.factorization p) := - Finset.prod_le_prod (fun _ _ ↦ Nat.zero_le _) + Finset.prod_le_prod (fun p hp ↦ factorization_succ_pow_ten_le (Nat.prime_of_mem_primeFactors hp)) _ = 2 ^ (∑ p ∈ n.primeFactors, preliminaryPrimePenalty p) * n := by diff --git a/LeanPool/MarkoffModP/RiemannRoch/Place.lean b/LeanPool/MarkoffModP/RiemannRoch/Place.lean index 89c37d5745..29c6608e2d 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Place.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Place.lean @@ -183,10 +183,9 @@ theorem orderMonoidIso_withZeroMulInt_eq_refl (e : ℤᵐ⁰ ≃*o ℤᵐ⁰) : by_cases hx : x = 0 · simp [hx] · rw [← WithZero.exp_log hx] - apply WithZero.exp_injective - have ht := congrArg WithZero.exp - (DFunLike.congr_fun h (WithZero.log x)) - simpa [withZeroMulIntLogAddEquiv] using ht + have ht := DFunLike.congr_fun h (WithZero.log x) + change WithZero.log (e (WithZero.exp (WithZero.log x))) = WithZero.log x at ht + simpa using congrArg WithZero.exp ht · have hle := hmono (show (0 : ℤ) ≤ 1 by omega) rw [h] at hle norm_num at hle @@ -487,10 +486,7 @@ instance finiteDimensionalResidueFieldInfinite letI : FiniteDimensional k (A ⧸ p) := by rw [hp] exact inftyValuationSubring.finiteDimensionalResidueField k - letI : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := by - have hfin := Ideal.inertiaDeg'_pos p v.asIdeal - rw [Ideal.inertiaDeg'_algebraMap] at hfin - exact FiniteDimensional.of_finrank_pos hfin + letI : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := inferInstance letI : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := IsScalarTower.of_algebraMap_eq fun _ => rfl exact FiniteDimensional.trans k (A ⧸ p) (S ⧸ v.asIdeal) @@ -521,7 +517,7 @@ theorem principalDivisorA_apply_finite (x : Additive Kˣ) Finsupp.mapDomain Sum.inr (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x) (Sum.inl v) = _ - rw [Finsupp.mapDomain_apply Sum.inl_injective] + rw [Finsupp.mapDomain_apply_of_injective Sum.inl_injective] rw [Finsupp.mapDomain_notin_range] · simp · rintro ⟨w, h⟩ @@ -539,7 +535,7 @@ theorem principalDivisorA_apply_infinite (x : Additive Kˣ) Finsupp.mapDomain Sum.inr (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x) (Sum.inr v) = _ - rw [Finsupp.mapDomain_apply Sum.inr_injective] + rw [Finsupp.mapDomain_apply_of_injective Sum.inr_injective] rw [Finsupp.mapDomain_notin_range] · simp · rintro ⟨w, h⟩ From 9f41cce80ea47c4b5ce305970632c32805f2d4e3 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 22:35:35 +0000 Subject: [PATCH 06/37] Port Markoff divisor, weighted counting, and formal zeta dependencies --- .../FiniteExtensionPrincipalDivisor.lean | 4 +- .../PlaneCurveAuxiliaryFinitePlaceCases.lean | 3 +- .../PlaneCurveInfinityDifferentDegree.lean | 2 +- .../PoweredImageFrobeniusRelation.lean | 4 +- .../PoweredImageHeightFactor.lean | 8 ++ .../TranscendentalPowerDegree.lean | 2 + .../FormalZetaConstantExtensionIdentity.lean | 24 +++--- .../BGS/HasseWeil/FormalZetaUniqueness.lean | 4 +- .../HasseWeil/PlaneFrobeniusDeflation.lean | 2 +- .../Markoff/MiddleGame/Diagonalization.lean | 1 + .../BGS/Markoff/Opening/CyclotomicBound.lean | 2 +- .../BGS/Markoff/TraceCurve/Localization.lean | 4 +- .../JointNeighborDivisorBound.lean | 7 +- .../NumberTheory/WeightedDivisorMoment.lean | 84 ++++++++++++++++++- .../RiemannRoch/FunctionField/Divisor.lean | 4 +- 15 files changed, 123 insertions(+), 32 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean index 41166521a7..b8cee9b66d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean @@ -850,8 +850,8 @@ theorem finiteExtensionFinitePlace_inertiaDeg_eq_one letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := - ⟨rfl⟩ + have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime q.asIdeal) := inferInstance letI : IsAlgClosed p.asIdeal.ResidueField := IsAlgClosed.of_ringEquiv K p.asIdeal.ResidueField (ratFuncFinitePlaceResidueEquiv K p).symm.toRingEquiv diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean index 3494f65502..c6574c08f5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean @@ -124,7 +124,8 @@ theorem finiteExtensionFinitePlace_residueField_finite [Fintype K] letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime q.asIdeal) := inferInstance letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := inferInstance diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean index ca0c2d2fcd..3decbcd80a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean @@ -272,7 +272,7 @@ theorem infinityDifferentDegree_le_discriminantOrder_of_primitiveElement by have hinj : Function.Injective (algebraMap B (FractionRing B)) := - FaithfulSMul.algebraMap_injective B (FractionRing B) + IsFractionRing.injective B (FractionRing B) intro hzero apply hd apply hinj diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean index 03c2e71fde..cdabbad3ec 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean @@ -185,7 +185,7 @@ theorem poweredCoordinateImageRelation_quotient_embeds_source letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) L := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) yL := - Algebra.IsIntegral.isIntegral _ + IsIntegral.of_finite _ _ let g := poweredCoordinateImageRelation hf hpartialSecond m hm n have hzeroL : φL g = 0 := by simpa [φL, xL, yL, g] using @@ -242,7 +242,7 @@ theorem bivariateEquiv_map_commutes theorem iteratedPolynomialBaseChangeEquiv_tmul_one (E : Type*) [Field E] [Algebra K E] (g : Polynomial (Polynomial K)) : - iteratedPolynomialBaseChangeEquiv E (1 ⊗ₜ[K] g) = + iteratedPolynomialBaseChangeEquiv (K := K) E (1 ⊗ₜ[K] g) = g.map (Polynomial.mapRingHom (algebraMap K E)) := by change (Polynomial.Bivariate.equivMvPolynomial E).symm ((MvPolynomial.algebraTensorAlgEquiv K E) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean index 37175fa742..ace15795a8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean @@ -39,6 +39,10 @@ theorem poweredCoordinateImageRelation_natDegree_mul_imageIndex finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm rw [poweredCoordinateImageRelation_natDegree_eq_finrank hf hpartialSecond m hm n] + have : Module.Free (FirstPoweredCoordinateSubfield f m) (PoweredImageOverFirst f m n) := + Module.Free.of_divisionRing _ _ + have : Module.Free (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) := + Module.Free.of_divisionRing _ _ exact Module.finrank_mul_finrank (FirstPoweredCoordinateSubfield f m) (PoweredImageOverFirst f m n) @@ -67,6 +71,10 @@ theorem poweredCoordinateImageRelation_transpose_natDegree_mul_imageIndex finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn rw [poweredCoordinateImageRelation_transpose_natDegree_eq_finrank hf hpartialFirst hpartialSecond m hm n hn] + have : Module.Free (SecondPoweredCoordinateSubfield f n) (PoweredImageOverSecond f m n) := + Module.Free.of_divisionRing _ _ + have : Module.Free (PoweredImageOverSecond f m n) (PlaneCurveFunctionField f) := + Module.Free.of_divisionRing _ _ exact Module.finrank_mul_finrank (SecondPoweredCoordinateSubfield f n) (PoweredImageOverSecond f m n) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean index d6ef12dbb4..6303180658 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean @@ -169,6 +169,8 @@ theorem finrank_over_adjoin_pow_eq_mul change FiniteDimensional AK L rw [hAK] infer_instance + have : Module.Free A L := Module.Free.of_divisionRing A L + have : Module.Free E0 A := Module.Free.of_divisionRing E0 A calc Module.finrank E0 L = Module.finrank E0 A * Module.finrank A L := by rw [Module.finrank_mul_finrank] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean index 7eea0a80c3..ae9ca14226 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean @@ -42,7 +42,7 @@ theorem subst_pointCountDerivativeSeries_mul_derivative_X_pow (hsupport : ∀ n, 0 < n → ¬ d ∣ n → pointCount n = 0) : PowerSeries.subst (PowerSeries.X ^ d) (pointCountDerivativeSeries extendedPointCount) * - PowerSeries.derivative ℂ (PowerSeries.X ^ d) = + PowerSeries.derivative (R := ℂ) (PowerSeries.X ^ d) = pointCountDerivativeSeries (fun n => d * pointCount n) := by ext n rw [PowerSeries.derivative_pow] @@ -127,31 +127,31 @@ theorem formalPointCountZeta_hasDegreeExtensionIdentity_of_positive (formalPointCountZeta extendedPointCount) by rfl] rw [PowerSeries.constantCoeff_subst_X_pow hd.ne'] simp [G] - have hF : PowerSeries.derivative ℂ F = F * A := by + have hF : PowerSeries.derivative (R := ℂ) F = F * A := by have htrace := formalPointCountZeta_hasPointCountDerivative extendedPointCount rw [HasFormalZetaPointCountDerivative] at htrace calc - PowerSeries.derivative ℂ F = + PowerSeries.derivative (R := ℂ) F = PowerSeries.subst (PowerSeries.X ^ d) - (PowerSeries.derivative ℂ + (PowerSeries.derivative (R := ℂ) (formalPointCountZeta extendedPointCount)) * - PowerSeries.derivative ℂ (PowerSeries.X ^ d) := by - exact PowerSeries.derivative_subst ℂ hs + PowerSeries.derivative (R := ℂ) (PowerSeries.X ^ d) := by + exact PowerSeries.derivative_subst hs _ = PowerSeries.subst (PowerSeries.X ^ d) (formalPointCountZeta extendedPointCount * pointCountDerivativeSeries extendedPointCount) * - PowerSeries.derivative ℂ (PowerSeries.X ^ d) := by rw [htrace] + PowerSeries.derivative (R := ℂ) (PowerSeries.X ^ d) := by rw [htrace] _ = F * (PowerSeries.subst (PowerSeries.X ^ d) (pointCountDerivativeSeries extendedPointCount) * - PowerSeries.derivative ℂ (PowerSeries.X ^ d)) := by + PowerSeries.derivative (R := ℂ) (PowerSeries.X ^ d)) := by rw [PowerSeries.subst_mul hs] simp only [F] rw [mul_assoc] _ = F * A := by rw [subst_pointCountDerivativeSeries_mul_derivative_X_pow pointCount extendedPointCount d hd hcount hsupport] - have hG : PowerSeries.derivative ℂ G = G * A := by + have hG : PowerSeries.derivative (R := ℂ) G = G * A := by have htrace := formalPointCountZeta_hasPointCountDerivative pointCount rw [HasFormalZetaPointCountDerivative] at htrace have hpred : d - 1 + 1 = d := @@ -161,12 +161,12 @@ theorem formalPointCountZeta_hasDegreeExtensionIdentity_of_positive formalPointCountZeta pointCount ^ d := by rw [← pow_succ, hpred] calc - PowerSeries.derivative ℂ G = + PowerSeries.derivative (R := ℂ) G = (d : PowerSeries ℂ) * formalPointCountZeta pointCount ^ (d - 1) * - PowerSeries.derivative ℂ + PowerSeries.derivative (R := ℂ) (formalPointCountZeta pointCount) := by - exact PowerSeries.derivative_pow ℂ + exact PowerSeries.derivative_pow (formalPointCountZeta pointCount) d _ = (d : PowerSeries ℂ) * formalPointCountZeta pointCount ^ (d - 1) * diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean index 116f1f408f..73f992d930 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean @@ -28,8 +28,8 @@ logarithmic-derivative equation are equal. -/ theorem powerSeries_eq_of_constantCoeff_eq_of_derivative_eq_mul (F G A : PowerSeries ℂ) (hconstant : PowerSeries.constantCoeff F = PowerSeries.constantCoeff G) - (hF : PowerSeries.derivative ℂ F = F * A) - (hG : PowerSeries.derivative ℂ G = G * A) : + (hF : PowerSeries.derivative (R := ℂ) F = F * A) + (hG : PowerSeries.derivative (R := ℂ) G = G * A) : F = G := by apply PowerSeries.ext intro n diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean index dcd68adb2c..0825f4995f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean @@ -108,7 +108,7 @@ theorem derivative_finSuccEquiv_eq_finSuccEquiv_pderiv_zero MvPolynomial.finSuccEquiv_coeff_coeff, coeff_pderiv, nsmul_eq_mul, mul_comm] congr 1 - · apply congrArg (coeff · f) + · apply congrArg f.coeff apply Finsupp.ext intro i refine Fin.cases ?_ (fun j => ?_) i <;> simp diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean index 928e051d30..a5fe553fe7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean @@ -29,6 +29,7 @@ theorem rotationOrder_zero_le_four apply orderOf_le_of_pow_eq_one (by norm_num) apply Matrix.SpecialLinearGroup.ext intro i j + change (rho (0 : ZMod p) ^ 4) i j = (1 : Matrix (Fin 2) (Fin 2) (ZMod p)) i j fin_cases i <;> fin_cases j <;> norm_num [rhoSL, rho, pow_succ, Matrix.mul_apply, Fin.sum_univ_two] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean index bb8ee4dbdf..407fa07247 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean @@ -254,7 +254,7 @@ theorem modulus_le_twenty_pow_totient_of_compatible_residue_traces isIntegral_cyclotomicDefect_of_primitiveRoots hz₁ hl₁ hz₂ hl₂ hz₃ hl₃⟩ Ideal.Quotient.mk P γ = 0 := by dsimp only - rw [Ideal.Quotient.eq_zero_iff_mem] + erw [Ideal.Quotient.eq_zero_iff_mem] have hmem := openingCyclotomicIntegerDefect_mem_prime_of_normalizedMarkoff p n a₁ a₂ a₃ hcoprime ω hω ha₁ ha₂ ha₃ x hx h₁ h₂ h₃ rw [show (⟨cyclotomicDefect z₁ z₂ z₃, diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean index 5153c4de13..dc1ad0fe45 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean @@ -123,7 +123,9 @@ lemma splitTraceAffineToKummerTop_coordinate (i : Fin 2) : let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ - simp [splitTraceAffineToKummerTop, splitTracePolynomialToKummerTop] + change MvPolynomial.aeval + ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] (MvPolynomial.X i) = _ + simp lemma splitTraceBaseV_sq : splitTraceBaseV sigma ^ 2 = diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean index a1a52bf1fb..480738372d 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean @@ -108,10 +108,7 @@ def neighboringDivisorSumMomentConstant : Nat := moments. It is chosen so that both resulting integer inequalities hold. -/ theorem neighboringDivisorSumMomentConstant_eq : neighboringDivisorSumMomentConstant = 2 ^ 429 * 262145 := by - rw [neighboringDivisorSumMomentConstant, - show (447 : Nat) = 429 + 18 by norm_num, pow_add] - norm_num - ring + decide +kernel private def neighboringDivisorSumSplit : Nat := 3913424 @@ -119,7 +116,7 @@ private def neighboringDivisorSumSplit : Nat := private theorem neighboringDivisorSum_balanced_constant : (neighboringDivisorSumSplit + 1) ^ 10 * 2 ^ 228 ≤ neighboringDivisorSumMomentConstant := by - norm_num [neighboringDivisorSumSplit, neighboringDivisorSumMomentConstant] + decide +kernel private theorem neighboringDivisorSum_dominant_constant {p : Nat} (hp : 794039 ≤ p) : diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean index 747918302f..d97db4f526 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean @@ -541,6 +541,67 @@ private theorem factorization_succ_pow_twenty_le pow_twenty_le_base_oneThousandTwentyFour a) hpLower) +-- Separate closed computations keep each kernel check within the default limit. +private def weightedPrimePenaltyTwentyBlock (k : ℕ) : ℕ := + ∑ p ∈ Finset.range 64, if Nat.Prime (k * 64 + p) then weightedPrimePenaltyTwenty (k * 64 + p) else 0 +private theorem weightedPrimePenaltyTwentyBlock_value_0 : weightedPrimePenaltyTwentyBlock 0 = 320 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_1 : weightedPrimePenaltyTwentyBlock 1 = 97 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_2 : weightedPrimePenaltyTwentyBlock 2 = 71 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_3 : weightedPrimePenaltyTwentyBlock 3 = 55 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_4 : weightedPrimePenaltyTwentyBlock 4 = 48 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_5 : weightedPrimePenaltyTwentyBlock 5 = 36 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_6 : weightedPrimePenaltyTwentyBlock 6 = 30 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_7 : weightedPrimePenaltyTwentyBlock 7 = 33 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_8 : weightedPrimePenaltyTwentyBlock 8 = 16 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_9 : weightedPrimePenaltyTwentyBlock 9 = 20 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_10 : weightedPrimePenaltyTwentyBlock 10 = 22 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_11 : weightedPrimePenaltyTwentyBlock 11 = 11 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_12 : weightedPrimePenaltyTwentyBlock 12 = 10 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_13 : weightedPrimePenaltyTwentyBlock 13 = 9 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_14 : weightedPrimePenaltyTwentyBlock 14 = 8 := by + decide +kernel + +private theorem weightedPrimePenaltyTwentyBlock_value_15 : weightedPrimePenaltyTwentyBlock 15 = 10 := by + decide +kernel + +private theorem sum_weightedPrimePenaltyTwenty_blocks (k : ℕ) : + (∑ p ∈ Finset.range (k * 64), if Nat.Prime p then weightedPrimePenaltyTwenty p else 0) = + ∑ i ∈ Finset.range k, weightedPrimePenaltyTwentyBlock i := by + induction k with + | zero => simp + | succ k ih => + rw [Nat.succ_mul, Finset.sum_range_add, ih] + rw [Finset.sum_range_succ (f := weightedPrimePenaltyTwentyBlock)] + rfl + private theorem sum_weightedPrimePenaltyTwenty_le (n : ℕ) : ∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p ≤ 796 := by let smallFactors := @@ -570,7 +631,26 @@ private theorem sum_weightedPrimePenaltyTwenty_le (n : ℕ) : (fun _ _ _ ↦ Nat.zero_le _) have htotal : (∑ p ∈ allSmallPrimes, weightedPrimePenaltyTwenty p) ≤ 796 := by - decide + apply le_of_eq + rw [Finset.sum_filter] + change (∑ p ∈ Finset.range (16 * 64), if Nat.Prime p then weightedPrimePenaltyTwenty p else 0) = _ + rw [sum_weightedPrimePenaltyTwenty_blocks] + simp only [Finset.sum_range_succ, Finset.sum_range_zero] + rw [weightedPrimePenaltyTwentyBlock_value_0, weightedPrimePenaltyTwentyBlock_value_1, + weightedPrimePenaltyTwentyBlock_value_2, + weightedPrimePenaltyTwentyBlock_value_3, + weightedPrimePenaltyTwentyBlock_value_4, + weightedPrimePenaltyTwentyBlock_value_5, + weightedPrimePenaltyTwentyBlock_value_6, + weightedPrimePenaltyTwentyBlock_value_7, + weightedPrimePenaltyTwentyBlock_value_8, + weightedPrimePenaltyTwentyBlock_value_9, + weightedPrimePenaltyTwentyBlock_value_10, + weightedPrimePenaltyTwentyBlock_value_11, + weightedPrimePenaltyTwentyBlock_value_12, + weightedPrimePenaltyTwentyBlock_value_13, + weightedPrimePenaltyTwentyBlock_value_14, + weightedPrimePenaltyTwentyBlock_value_15] rw [← hsumEq] exact hle.trans htotal @@ -585,7 +665,7 @@ theorem card_divisors_pow_twenty_le_weighted_constant_mul_sq ∏ p ∈ n.primeFactors, (2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * n.factorization p)) := - Finset.prod_le_prod (fun _ _ ↦ Nat.zero_le _) + Finset.prod_le_prod (fun p hp ↦ factorization_succ_pow_twenty_le (Nat.prime_of_mem_primeFactors hp)) _ = 2 ^ (∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) * n ^ 2 := by diff --git a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean index 6edc4a8037..780afae8a5 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean @@ -443,7 +443,7 @@ theorem finitePrincipalDegree_eq_intDegree_norm (x : Kˣ) : (pn.natDegree : ℤ) - (pd.natDegree : ℤ) := by rw [← hnormn, ← hnormd] simpa only [FractionalIdeal.weightedDegree_apply, finiteIdealWeight, - placeDegree_finite_eq_base_mul_inertiaDeg] using hdeg + placeDegree_finite_eq_base_mul_inertiaDeg] using! hdeg have hratio := finite_intNorm_div_eq_norm k K x n d hnd change algebraMap k[X] k⟮X⟯ pn / algebraMap k[X] k⟮X⟯ pd = Algebra.norm k⟮X⟯ (x : K) at hratio @@ -516,7 +516,7 @@ theorem infinitePrincipalDegree_eq_neg_intDegree_norm (x : Kˣ) : (-RatFunc.intDegree (qd : k⟮X⟯)) := by have hdeg' := hdeg simp only [FractionalIdeal.weightedDegree_apply, infiniteIdealWeight] at hdeg' - rw [hupn, hupd] at hdeg' + erw [hupn, hupd] at hdeg' simpa only [placeDegree_infinite_eq_inertiaDeg] using hdeg' have hratio := infinite_intNorm_div_eq_norm k K x n d hnd change (qn : k⟮X⟯) / (qd : k⟮X⟯) = Algebra.norm k⟮X⟯ (x : K) at hratio From 83187f7e6416790aaa5b6cb3e99d9e6c483f0e65 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 22:52:28 +0000 Subject: [PATCH 07/37] Port remaining finite-place dependencies and reduce torsion proof elaboration --- .../FiniteExtensionExceptionalSupport.lean | 2 +- .../FiniteExtensionResidueSurjectivity.lean | 6 +- .../PlaneCurveFiniteDifferentBound.lean | 3 +- .../BGS/CorvajaZannier/PoweredImageIndex.lean | 8 + .../TorsionExhaustiveGcdDivisorBound.lean | 150 +++++++----------- .../HasseWeil/FiniteExtensionPlaceTower.lean | 6 +- .../HasseWeil/PlaneFrobeniusDegenerate.lean | 2 +- .../PositiveCoprimeIrreducibility.lean | 1 + .../WeightedNeighborDivisorBound.lean | 11 +- .../MarkoffModP/RiemannRoch/LocalResidue.lean | 7 +- 10 files changed, 91 insertions(+), 105 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index f16c70701e..88a057ebcf 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -605,7 +605,7 @@ theorem sum_finiteExtensionFamilyMemberSupport_placeDegree finiteExtensionPlaceDegree K L w := by classical rw [finiteExtensionFamilyMemberSupport, Finset.sum_map] - simpa [finiteExtensionFamilyMemberSupportEmbedding] using + simpa [finiteExtensionFamilyMemberSupportEmbedding] using! (Finset.sum_attach (finiteExtensionPrincipalDivisor K L (f a)).support (fun w => finiteExtensionPlaceDegree K L w)) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean index 5b0bbdde87..edb78d7816 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean @@ -107,7 +107,8 @@ theorem finiteExtensionFinitePlace_constantResidue_surjective letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime q.asIdeal) := inferInstance letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := inferInstance @@ -136,7 +137,8 @@ theorem finiteExtensionInfinityPlace_constantResidue_surjective let p := (ratFuncInfinityPlace K).asIdeal letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean index d0c99fba2e..a6cf57f213 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean @@ -586,7 +586,8 @@ theorem finiteExtensionFiniteDifferentDivisorBelow_apply_le_minpolyDiscr_of_loca exact horder.symm have hmMultiplicity : multiplicity p.asIdeal (Ideal.span {(m : K[X])}) = 0 := by - rw [multiplicity_eq_zero, Ideal.dvd_span_singleton] + apply multiplicity_eq_zero_of_not_dvd + rw [Ideal.dvd_span_singleton] exact m.property have hrOrder : ratFuncFiniteOrder p r = 0 := by change finitePlaceOrder p (algebraMap K[X] (RatFunc K) (m : K[X])) = 0 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean index b8c29f6079..c7d8cacdf5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean @@ -107,6 +107,10 @@ theorem finrank_poweredImageOverFirst_le_firstProjectionPowerDegree letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm + have : Module.Free (FirstPoweredCoordinateSubfield f m) + (PoweredImageOverFirst f m n) := Module.Free.of_divisionRing _ _ + have : Module.Free (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) := + Module.Free.of_divisionRing _ _ have htower := Module.finrank_mul_finrank (FirstPoweredCoordinateSubfield f m) (PoweredImageOverFirst f m n) @@ -145,6 +149,10 @@ theorem finrank_poweredImageOverSecond_le_secondProjectionPowerDegree letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn + have : Module.Free (SecondPoweredCoordinateSubfield f n) + (PoweredImageOverSecond f m n) := Module.Free.of_divisionRing _ _ + have : Module.Free (PoweredImageOverSecond f m n) (PlaneCurveFunctionField f) := + Module.Free.of_divisionRing _ _ have htower := Module.finrank_mul_finrank (SecondPoweredCoordinateSubfield f n) (PoweredImageOverSecond f m n) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index c3c8896c92..6d8742b49a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -290,6 +290,43 @@ theorem finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem rw [horder, ← exp_zero, exp_lt_exp] at hqlt omega +private theorem exists_integralClosurePlace_orders_positive + (m : MaximalSpectrum A) + (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) + (r s : A) (hr : r ∈ m.asIdeal) (hs : s ∈ m.asIdeal) + (hr0 : algebraMap A L r ≠ 0) (hs0 : algebraMap A L s ≠ 0) + (b : integralClosure P L) (hb : algebraMap (integralClosure P L) L b = + algebraMap A L r) : + ∃ q : HeightOneSpectrum (integralClosure P L), + HeightOneSpectrum.valuationSubringAtPrime L q = + dominatingValuationSubring (A := A) (L := L) m ∧ + 0 < finitePlaceOrder q (algebraMap A L r) ∧ + 0 < finitePlaceOrder q (algebraMap A L s) := by + let V := dominatingValuationSubring (A := A) (L := L) m + have hnonunits : algebraMap A L r ∈ V.nonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem m r hr + have hV : V ≠ ⊤ := by + intro htop + exact ((ValuationSubring.eq_top_iff V).mp htop) + ((Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 ⟨_, hr0, hnonunits⟩) + have hb0 : b ≠ 0 := by + intro hzero + apply hr0 + rw [← hb, hzero, map_zero] + have hbMem : b ∈ dominatingIntegralClosurePrime m hbase := by + change integralClosureToDominatingValuationSubring m hbase b ∈ IsLocalRing.maximalIdeal V + apply ValuationSubring.coe_mem_nonunits_iff.mp + change algebraMap (integralClosure P L) L b ∈ V.nonunits + rwa [hb] + have hqne : dominatingIntegralClosurePrime m hbase ≠ ⊥ := by + intro hbot + apply hb0 + simpa only [hbot, Ideal.mem_bot] using hbMem + exact ⟨dominatingIntegralClosurePlace m hbase hqne, + valuationSubringAt_dominatingIntegralClosurePlace_eq m hbase hqne hV, + finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem m hbase hqne hV r hr hr0, + finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem m hbase hqne hV s hs hs0⟩ + end IntegralClosure end DominatingValuationSubring @@ -453,6 +490,11 @@ theorem polynomial_algebraMap_mem_planeCurveCoordinateRing_range (planeCurveFunction f 0) hx) exact hcomp.symm +private theorem map_power_sub_one {R S : Type*} [Ring R] [Ring S] + (φ : R →+* S) (x : R) (y : S) (h : φ x = y) (n : ℕ) : + φ (x ^ n - 1) = y ^ n - 1 := by + rw [map_sub, map_pow, map_one, h] + variable [Fintype K] [DecidableEq K] /-- Every rational torsion point produces an actual finite place of the @@ -466,26 +508,26 @@ theorem exists_torsionPoint_exhaustiveFinitePlace_orders_positive (hfirstNonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0) (hsecondNonzero : planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0) (z : TorusCurveTorsionPoint f firstOrder secondOrder) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsDedekindDomain + let : IsDedekindDomain (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) - letI : IsFractionRing + let : IsFractionRing (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) (PlaneCurveFunctionField f) := integralClosure.isFractionRing_of_finite_extension (RatFunc K) @@ -500,40 +542,15 @@ theorem exists_torsionPoint_exhaustiveFinitePlace_orders_positive (planeCurveFunction f 0 ^ firstOrder - 1) ∧ 0 < finitePlaceOrder q (planeCurveFunction f 1 ^ secondOrder - 1) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsDedekindDomain - (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := - integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) - letI : IsFractionRing - (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) - (PlaneCurveFunctionField f) := - integralClosure.isFractionRing_of_finite_extension (RatFunc K) - (PlaneCurveFunctionField f) + intro domain hx ratFuncAlgebra polynomialAlgebra scalarTower finiteDimension separable + dedekind fraction let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f let B := integralClosure (Polynomial K) E let m := torsionPointMaximalIdeal f firstOrder secondOrder z - let hbase : ∀ P : Polynomial K, + have hbase : ∀ P : Polynomial K, algebraMap (Polynomial K) E P ∈ (algebraMap A E).range := polynomial_algebraMap_mem_planeCurveCoordinateRing_range hf hpartialSecond - let V := dominatingValuationSubring (A := A) (L := E) m let rfirst : A := planeCurveCoordinate f 0 ^ firstOrder - 1 let rsecond : A := planeCurveCoordinate f 1 ^ secondOrder - 1 let Pfirst : Polynomial K := Polynomial.X ^ firstOrder - 1 @@ -554,71 +571,24 @@ theorem exists_torsionPoint_exhaustiveFinitePlace_orders_positive rfl have hPfirstMap : algebraMap (Polynomial K) E Pfirst = planeCurveFunction f 0 ^ firstOrder - 1 := by - simp only [Pfirst, map_sub, map_pow, map_one] - change algebraMap (RatFunc K) E - (algebraMap (Polynomial K) (RatFunc K) Polynomial.X) ^ firstOrder - 1 = _ - rw [show algebraMap (Polynomial K) (RatFunc K) Polynomial.X = - RatFunc.X by simp] - rw [planeCurveFirstCoordinateRatFuncAlgebra_X f hx] + exact map_power_sub_one (algebraMap (Polynomial K) E) Polynomial.X + (planeCurveFunction f 0) (planeCurveFirstCoordinateRatFuncAlgebra_X f hx) firstOrder have hbfirstMap : algebraMap B E bfirst = planeCurveFunction f 0 ^ firstOrder - 1 := by rw [show algebraMap B E bfirst = algebraMap (Polynomial K) E Pfirst by exact IsScalarTower.algebraMap_apply (Polynomial K) B E Pfirst] exact hPfirstMap - have hbfirst0 : bfirst ≠ 0 := by - intro hb - apply hfirstNonzero - rw [← hbfirstMap, hb, map_zero] - have hfirstNonunits : - planeCurveFunction f 0 ^ firstOrder - 1 ∈ V.nonunits := by - rw [← hrfirstMap] - exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) m rfirst hrfirst - have hsecondNonunits : - planeCurveFunction f 1 ^ secondOrder - 1 ∈ V.nonunits := by - rw [← hrsecondMap] - exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) m rsecond hrsecond - have hV : V ≠ ⊤ := by - intro htop - have hnontrivial : V.valuation.IsNontrivial := - (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 - ⟨planeCurveFunction f 0 ^ firstOrder - 1, - hfirstNonzero, hfirstNonunits⟩ - exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial - have hbfirstMem : - bfirst ∈ dominatingIntegralClosurePrime m hbase := by - change integralClosureToDominatingValuationSubring m hbase bfirst ∈ - IsLocalRing.maximalIdeal V - apply ValuationSubring.coe_mem_nonunits_iff.mp - have hcoe : - ((integralClosureToDominatingValuationSubring - m hbase bfirst : V) : E) = algebraMap B E bfirst := by - rfl - rw [hcoe, hbfirstMap] - exact hfirstNonunits - have hqne : dominatingIntegralClosurePrime m hbase ≠ ⊥ := by - intro hbot - have : bfirst = 0 := by simpa [hbot] using hbfirstMem - exact hbfirst0 this - let q : HeightOneSpectrum B := - dominatingIntegralClosurePlace m hbase hqne have hrfirstMap0 : algebraMap A E rfirst ≠ 0 := by rw [hrfirstMap] exact hfirstNonzero have hrsecondMap0 : algebraMap A E rsecond ≠ 0 := by rw [hrsecondMap] exact hsecondNonzero - refine ⟨q, ?_, ?_, ?_⟩ - · exact valuationSubringAt_dominatingIntegralClosurePlace_eq - m hbase hqne hV - · rw [← hrfirstMap] - exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem - m hbase hqne hV rfirst hrfirst hrfirstMap0 - · rw [← hrsecondMap] - exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem - m hbase hqne hV rsecond hrsecond hrsecondMap0 + obtain ⟨q, hq, hfirst, hsecond⟩ := exists_integralClosurePlace_orders_positive + m hbase rfirst rsecond hrfirst hrsecond hrfirstMap0 hrsecondMap0 bfirst + (hbfirstMap.trans hrfirstMap.symm) + exact ⟨q, hq, hrfirstMap ▸ hfirst, hrsecondMap ▸ hsecond⟩ /-- The finite place in the exhaustive `K[X]`-integral-closure model selected above a rational torsion point. -/ @@ -818,6 +788,8 @@ theorem torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + letI : DecidableEq (FiniteExtensionPlace K (PlaneCurveFunctionField f)) := + Classical.decEq _ let x : PlaneCurveFunctionField f := planeCurveFunction f 0 ^ firstOrder - 1 let y : PlaneCurveFunctionField f := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index 8cfe15ee00..554a700383 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -1146,7 +1146,8 @@ private theorem finitePlaceResidueField_finite ratFuncFinitePlaceResidueField_finite K p letI : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal P.asIdeal := ⟨rfl⟩ + have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime P.asIdeal) := inferInstance letI : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance letI : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := inferInstance @@ -1166,7 +1167,8 @@ private theorem infinityPlaceResidueField_finite simpa [p] using Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P letI := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance exact Module.finite_of_finite p.ResidueField diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean index e959e5a109..a4cbc9cf53 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean @@ -43,7 +43,7 @@ theorem natDegree_uniqueAlgEquiv_fin_one intro m hm apply Polynomial.le_natDegree_of_ne_zero rw [MvPolynomial.coeff_uniqueAlgEquiv] - change coeff (Finsupp.single (0 : Fin 1) (m 0)) q ≠ 0 + change q.coeff (Finsupp.single (0 : Fin 1) (m 0)) ≠ 0 have hmEq : Finsupp.single (0 : Fin 1) (m 0) = m := by simpa using (Finsupp.unique_single m).symm rw [hmEq] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean index 2f8767760e..2445ca4ef6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean @@ -109,6 +109,7 @@ lemma splitTraceEtaFunctionField_finrank_of_sqrt_neg_one sigma hsigma i hi e he letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hEtaIrred.ne_zero)] + change (splitTraceEtaKummerPolynomial sigma e).natDegree = e simp [splitTraceEtaKummerPolynomial] /-- The norm-degree obstruction for the second radicand does not depend on parity. It applies diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean index d237648ce3..9b98758331 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean @@ -83,10 +83,7 @@ def neighboringDivisorSumWeightedMomentConstant : ℕ := theorem neighboringDivisorSumWeightedMomentConstant_eq : neighboringDivisorSumWeightedMomentConstant = 2 ^ 781 * 32769 := by - rw [neighboringDivisorSumWeightedMomentConstant, - show (796 : ℕ) = 781 + 15 by norm_num, pow_add] - norm_num - ring + decide +kernel private def neighboringDivisorSumWeightedSplit : ℕ := 716198 @@ -94,8 +91,7 @@ private def neighboringDivisorSumWeightedSplit : ℕ := private theorem neighboringDivisorSumWeighted_balanced_constant : (neighboringDivisorSumWeightedSplit + 1) ^ 20 * 2 ^ 407 ≤ neighboringDivisorSumWeightedMomentConstant := by - norm_num [neighboringDivisorSumWeightedSplit, - neighboringDivisorSumWeightedMomentConstant] + decide +kernel private theorem neighboringDivisorSumWeighted_dominant_constant {p : ℕ} (hp : 794039 ≤ p) : @@ -110,8 +106,7 @@ private theorem neighboringDivisorSumWeighted_dominant_constant have hground : (R + 1) ^ 20 * K * (P + 1) ^ 2 ≤ R ^ 20 * D * P ^ 2 := by - norm_num [R, K, D, P, neighboringDivisorSumWeightedSplit, - neighboringDivisorSumWeightedMomentConstant] + decide +kernel have hlinear : P * (p + 1) ≤ (P + 1) * p := by dsimp [P] omega diff --git a/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean b/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean index 6dba62d812..30f148b4da 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/LocalResidue.lean @@ -90,7 +90,12 @@ theorem residueHom_mk'_residue (v : HeightOneSpectrum R) (n : R) (d : v.asIdeal. have h := congrArg (IsLocalRing.residue (Localization.AtPrime v.asIdeal)) (IsLocalization.mk'_spec (S := Localization.AtPrime v.asIdeal) n d) simp only [map_mul, IsLocalRing.residue_def] at h - field_simp [hdunit] at h ⊢ + field_simp [hdunit] + change IsLocalRing.residue (Localization.AtPrime v.asIdeal) + (IsLocalization.mk' (Localization.AtPrime v.asIdeal) n d) * + algebraMap R v.asIdeal.ResidueField (d : R) = + algebraMap R v.asIdeal.ResidueField n at h + rw [mul_comm] at h exact h.symm /-- `residueHom` agrees with the residue map on the localization model. -/ From eeed4041d5364bae733c2e17146d053591d89f27 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:24:33 +0000 Subject: [PATCH 08/37] Port affine places, infinity localizations, and canonical degree bounds --- ...ensionCanonicalAuxiliaryInfinityPlace.lean | 60 ++++++--- .../PlaneCurveCanonicalDegreeBound.lean | 26 ++-- .../PoweredImageBaseChange.lean | 9 +- .../PoweredImageGaloisBound.lean | 11 +- .../TorsionExhaustiveGcdDivisorBound.lean | 4 +- .../BGS/HasseWeil/AffinePointPlace.lean | 120 +++++------------- .../BGS/HasseWeil/FiniteBranchLocus.lean | 2 +- .../HasseWeil/OnePointLeadingCoefficient.lean | 6 +- .../Endgame/Nonsplit/DescendedTraceCurve.lean | 7 +- .../BGS/Markoff/ExplicitNumerics.lean | 8 +- .../Markoff/TraceCurve/ChartLocalization.lean | 22 +++- .../RiemannRoch/AdeleSpace/FilterChain.lean | 7 +- .../RiemannRoch/Genus/Ramification.lean | 2 +- 13 files changed, 130 insertions(+), 154 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean index 8340ebbb9c..0840c7a300 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean @@ -168,29 +168,35 @@ omit [DecidableEq K] in omit [DecidableEq K] in theorem finiteExtensionInfinityPlaceLocalIsFractionRing (P : FiniteExtensionInfinityPlace K L) : - letI := finiteExtensionInfinityPlaceLocalAlgebra + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P IsFractionRing (FiniteExtensionInfinityPlaceLocalRing K L P) L := by - letI hIntegralClosureLocalAlgebra : + let hIntegralClosureLocalAlgebra : Algebra (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) := inferInstance - letI := finiteExtensionInfinityPlaceLocalAlgebra + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let _ : SMul (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) := Algebra.toSMul + let _ : SMul (FiniteExtensionInfinityPlaceLocalRing K L P) L := Algebra.toSMul + let _ : SMul (RatFuncInfinityIntegralClosure K L) L := Algebra.toSMul letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) L := by - exact IsScalarTower.of_algebraMap_eq' + have htower := IsScalarTower.of_algebraMap_eq' (R := RatFuncInfinityIntegralClosure K L) (S := FiniteExtensionInfinityPlaceLocalRing K L P) (A := L) (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap (K := K) (L := L) P).symm - exact IsFractionRing.isFractionRing_of_isDomain_of_isLocalization + exact htower + have hFraction := IsFractionRing.isFractionRing_of_isDomain_of_isLocalization (R := RatFuncInfinityIntegralClosure K L) (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.primeCompl (FiniteExtensionInfinityPlaceLocalRing K L P) L + exact hFraction noncomputable def finiteExtensionInfinityPlaceLocalOrderTop (P : FiniteExtensionInfinityPlace K L) (x : L) : WithTop ℤ := by - letI := finiteExtensionInfinityPlaceLocalAlgebra + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P @@ -206,7 +212,7 @@ noncomputable def finiteExtensionInfinityPlaceLocalOrderTop noncomputable def finiteExtensionInfinityPlaceLocalOrder (P : FiniteExtensionInfinityPlace K L) (x : L) : ℤ := by - letI := finiteExtensionInfinityPlaceLocalAlgebra + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P @@ -225,7 +231,7 @@ theorem finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder (P : FiniteExtensionInfinityPlace K L) (x : L) : finiteExtensionInfinityPlaceLocalOrder (K := K) (L := L) P x = finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by - letI := finiteExtensionInfinityPlaceLocalAlgebra + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P @@ -235,18 +241,25 @@ theorem finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder (RatFuncInfinityIntegralClosure K L) (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot (FiniteExtensionInfinityPlaceLocalRing K L P) + let _ : SMul (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) := Algebra.toSMul + let _ : SMul (FiniteExtensionInfinityPlaceLocalRing K L P) L := Algebra.toSMul + let _ : SMul (RatFuncInfinityIntegralClosure K L) L := Algebra.toSMul letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) L := by - exact IsScalarTower.of_algebraMap_eq' + have htower := IsScalarTower.of_algebraMap_eq' (R := RatFuncInfinityIntegralClosure K L) (S := FiniteExtensionInfinityPlaceLocalRing K L P) (A := L) (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap (K := K) (L := L) P).symm + exact htower change finitePlaceOrder (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionInfinityPlaceLocalRing K L P)) x = _ - exact localizationAtPrime_finitePlaceOrder_eq + have hOrder := localizationAtPrime_finitePlaceOrder_eq + (S := FiniteExtensionInfinityPlaceLocalRing K L P) (primeOverHeightOne (ratFuncInfinityPlace K) P) x + exact hOrder omit [DecidableEq K] in theorem finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder @@ -254,7 +267,7 @@ theorem finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P x = (finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x : WithTop ℤ) := by - letI := finiteExtensionInfinityPlaceLocalAlgebra + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P @@ -309,19 +322,25 @@ theorem finiteExtensionInfinityPlace_local_preserves_of_global_preserves (K := K) (L := L) P r) = finiteExtensionInfinityPlaceLocalizationToField (K := K) (L := L) P s := by - letI hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra + let hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + let _ : SMul (RatFuncInfinityIntegralClosure K L) + (FiniteExtensionInfinityPlaceLocalRing K L P) := Algebra.toSMul + let _ : SMul (FiniteExtensionInfinityPlaceLocalRing K L P) L := Algebra.toSMul + let _ : SMul (RatFuncInfinityIntegralClosure K L) L := Algebra.toSMul letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) L := by - exact IsScalarTower.of_algebraMap_eq' + have htower := IsScalarTower.of_algebraMap_eq' (R := RatFuncInfinityIntegralClosure K L) (S := FiniteExtensionInfinityPlaceLocalRing K L P) (A := L) (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap (K := K) (L := L) P).symm - exact ambientDerivation_preserves_localizationAtPrime_of_preserves + exact htower + have hPreserves := ambientDerivation_preserves_localizationAtPrime_of_preserves (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal E hE + exact hPreserves /-- The infinity different supplies the exact canonical scaling coefficient. The reciprocal-parameter derivations are explicit inputs: `Es` preserves the @@ -439,7 +458,7 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseIII_of_scaled_preserves finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by - letI hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra + let hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P @@ -491,7 +510,7 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseIV_of_scaled_preserves finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by - letI hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra + let hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P @@ -736,7 +755,7 @@ theorem finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative ∃ x₀ : FiniteExtensionInfinityPlaceLocalRing K L P, x = finiteExtensionInfinityPlaceLocalizationToField (K := K) (L := L) P x₀ := by - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P letI : IsDiscreteValuationRing @@ -793,7 +812,7 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseII_of_scaled_preserves finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P letI : IsDiscreteValuationRing @@ -914,7 +933,8 @@ theorem finiteExtensionInfinityPlace_residueField_finite [Fintype K] simpa [p] using Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance exact Module.finite_of_finite p.ResidueField @@ -1033,7 +1053,7 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseI_of_scaled_preserves finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (indexedDedekindLocalWronskian D epsilonOrder (auxiliaryFamily u v h k)).det := by - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P letI : IsDiscreteValuationRing diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean index 4fba87a194..4064abcf20 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean @@ -93,13 +93,13 @@ theorem planeCurve_canonicalDifferentDivisor_degree_le {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI := separable_planeCurveFunctionField_over_ratFunc + let := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond finiteExtensionDivisorDegree K (PlaneCurveFunctionField f) (finiteExtensionCanonicalDifferentDivisor K @@ -110,17 +110,8 @@ theorem planeCurve_canonicalDifferentDivisor_degree_le (MvPolynomial.degreeOf 1 f : ℤ) - 2 * (MvPolynomial.degreeOf 0 f : ℤ) - 2 * (MvPolynomial.degreeOf 1 f : ℤ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + intro domain hx ratFuncAlgebra finiteDimension separable let L := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) L := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let F : K[X][X] := planeCurvePolynomialInSecondCoordinate f let firstDegree := MvPolynomial.degreeOf 0 f let secondDegree := MvPolynomial.degreeOf 1 f @@ -160,9 +151,14 @@ theorem planeCurve_canonicalDifferentDivisor_degree_le (infinityNormalizedPolynomial K localFirstDegree F) = 0 := by rw [infinityNormalizedPolynomial] simp only [map_mul, aeval_C, hrootF, mul_zero] + let _ : SMul (RatFunc K) L := Algebra.toSMul + let _ : MulAction (RatFunc K) L := + (Algebra.toModule : Module (RatFunc K) L).toMulAction have hrootIntegral : Polynomial.aeval v (infinityNormalizedIntegralPolynomial K localFirstDegree F hcoeff) = 0 := by - rw [← Polynomial.aeval_map_algebraMap (RatFunc K) v] + have hmap := Polynomial.aeval_map_algebraMap (RatFunc K) v + (infinityNormalizedIntegralPolynomial K localFirstDegree F hcoeff) + rw [← hmap] rw [infinityNormalizedIntegralPolynomial_map] exact hrootNormalized have hprimitive : Algebra.adjoin (RatFunc K) {v} = ⊤ := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean index f167dcc1f1..5746cba885 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean @@ -63,7 +63,9 @@ noncomputable def planeCurveCoordinateRingMap obtain ⟨r, rfl⟩ := Ideal.mem_span_singleton.mp hq apply Ideal.mem_span_singleton.mpr refine ⟨MvPolynomial.map (algebraMap K E) r, ?_⟩ - simp [ι] + change MvPolynomial.map (algebraMap K E) (f * r) = + MvPolynomial.map (algebraMap K E) f * MvPolynomial.map (algebraMap K E) r + exact map_mul _ _ _ /-- The coordinate-ring base-change map preserves the two coordinate classes. -/ @@ -74,6 +76,9 @@ classes. -/ planeCurveCoordinate (MvPolynomial.map (algebraMap K E) f) i := by simp [planeCurveCoordinateRingMap, planeCurveCoordinate, planeCurveQuotientMap] + change Ideal.Quotient.mk (Ideal.span {MvPolynomial.map (algebraMap K E) f}) + (MvPolynomial.map (algebraMap K E) (MvPolynomial.X i)) = _ + rw [MvPolynomial.map_X] /-- The coefficient base change of the canonical powered-image relation vanishes on the generic powered coordinates of the base-changed curve. -/ @@ -183,7 +188,7 @@ theorem poweredCoordinateImageRelation_map_associated_baseChange letI : FiniteDimensional (FirstPoweredCoordinateSubfield fE m) LE := finiteDimensional_over_firstPoweredCoordinate hfE hpartialSecondE m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield fE m) - ((planeCurveFunction fE 1) ^ n) := Algebra.IsIntegral.isIntegral _ + ((planeCurveFunction fE 1) ^ n) := IsIntegral.of_finite _ _ have hdvd : poweredCoordinateImageRelation hfE hpartialSecondE m hm n ∣ (poweredCoordinateImageRelation hf hpartialSecond m hm n).map diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean index 72e5360bee..4d0f3d9a1b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean @@ -102,15 +102,14 @@ theorem finiteDimensional_poweredCoordinateImageField (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m n : ℕ) (hm : 0 < m) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf FiniteDimensional (PoweredCoordinateImageField f m n) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf + intro domain let L := PlaneCurveFunctionField f let E0 := FirstPoweredCoordinateSubfield f m let B := PoweredCoordinateImageField f m n - letI : FiniteDimensional E0 L := + let : FiniteDimensional E0 L := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hE0B : E0 ≤ B := by apply IntermediateField.adjoin.mono F @@ -118,9 +117,9 @@ theorem finiteDimensional_poweredCoordinateImageField simp only [Set.mem_singleton_iff] at hz simp only [Set.mem_insert_iff, Set.mem_singleton_iff] exact Or.inl hz - letI : Algebra E0 B := + let : Algebra E0 B := (IntermediateField.inclusion hE0B).toRingHom.toAlgebra - letI : IsScalarTower E0 B L := by + let : IsScalarTower E0 B L := by apply IsScalarTower.of_algebraMap_eq' ext z rfl diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index 6d8742b49a..969ae1c724 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -290,7 +290,9 @@ theorem finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem rw [horder, ← exp_zero, exp_lt_exp] at hqlt omega -private theorem exists_integralClosurePlace_orders_positive +/-- A nonzero integral element at a maximal ideal gives a centered finite place +where both prescribed elements have positive order. -/ +theorem exists_integralClosurePlace_orders_positive (m : MaximalSpectrum A) (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) (r s : A) (hr : r ∈ m.asIdeal) (hs : s ∈ m.asIdeal) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean index 746367cd5d..6388bde155 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean @@ -93,6 +93,17 @@ theorem secondCoordinate_sub_affinePoint_ne_zero rw [sub_eq_zero.mp hzero] exact isAlgebraic_algebraMap z.1.2 +private theorem ratFuncSpecialization_X_sub_C + {K E : Type*} [Field K] [Field E] [Algebra K E] + (x : E) (hx : Transcendental K x) (c : K) : + ratFuncSpecialization x hx + (algebraMap (Polynomial K) (RatFunc K) (Polynomial.X - Polynomial.C c)) = + x - algebraMap K E c := by + have hcomp := congrArg + (fun h : Polynomial K →+* E => h (Polynomial.X - Polynomial.C c)) + (ratFuncSpecialization_comp_polynomial_algebraMap x hx) + simpa using hcomp + /-- Every affine rational point has an exhaustive finite place centered at that point where both coordinate differences have positive order. -/ theorem exists_affinePoint_exhaustiveFinitePlace_orders_positive @@ -100,26 +111,26 @@ theorem exists_affinePoint_exhaustiveFinitePlace_orders_positive (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (z : AffinePlaneCurvePoint f) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsDedekindDomain + let : IsDedekindDomain (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) - letI : IsFractionRing + let : IsFractionRing (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) (PlaneCurveFunctionField f) := integralClosure.isFractionRing_of_finite_extension (RatFunc K) @@ -136,32 +147,8 @@ theorem exists_affinePoint_exhaustiveFinitePlace_orders_positive 0 < finitePlaceOrder q (planeCurveFunction f 1 - algebraMap K (PlaneCurveFunctionField f) z.1.2) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsDedekindDomain - (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := - integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) - letI : IsFractionRing - (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) - (PlaneCurveFunctionField f) := - integralClosure.isFractionRing_of_finite_extension (RatFunc K) - (PlaneCurveFunctionField f) + intro domain hx ratFuncAlgebra polynomialAlgebra scalarTower finiteDimension separable + dedekind fraction let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f let B := integralClosure (Polynomial K) E @@ -169,7 +156,6 @@ theorem exists_affinePoint_exhaustiveFinitePlace_orders_positive let hbase : ∀ P : Polynomial K, algebraMap (Polynomial K) E P ∈ (algebraMap A E).range := polynomial_algebraMap_mem_planeCurveCoordinateRing_range hf hpartialSecond - let V := dominatingValuationSubring (A := A) (L := E) m let rfirst : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 let rsecond : A := planeCurveCoordinate f 1 - algebraMap K A z.1.2 let Pfirst : Polynomial K := Polynomial.X - Polynomial.C z.1.1 @@ -196,69 +182,22 @@ theorem exists_affinePoint_exhaustiveFinitePlace_orders_positive planeCurveFunction f 0 - algebraMap K E z.1.1 := by change ratFuncSpecialization (planeCurveFunction f 0) hx (algebraMap (Polynomial K) (RatFunc K) Pfirst) = _ - have hcomp := congrArg - (fun h : Polynomial K →+* E => h Pfirst) - (ratFuncSpecialization_comp_polynomial_algebraMap - (planeCurveFunction f 0) hx) - simpa [Pfirst] using hcomp + exact ratFuncSpecialization_X_sub_C (planeCurveFunction f 0) hx z.1.1 have hbfirstMap : algebraMap B E bfirst = planeCurveFunction f 0 - algebraMap K E z.1.1 := by rw [show algebraMap B E bfirst = algebraMap (Polynomial K) E Pfirst by exact IsScalarTower.algebraMap_apply (Polynomial K) B E Pfirst] exact hPfirstMap - have hbfirst0 : bfirst ≠ 0 := by - intro hb - apply hfirstNonzero - rw [← hbfirstMap, hb, map_zero] - have hfirstNonunits : - planeCurveFunction f 0 - algebraMap K E z.1.1 ∈ V.nonunits := by - rw [← hrfirstMap] - exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) m rfirst hrfirst - have hsecondNonunits : - planeCurveFunction f 1 - algebraMap K E z.1.2 ∈ V.nonunits := by - rw [← hrsecondMap] - exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) m rsecond hrsecond - have hV : V ≠ ⊤ := by - intro htop - have hnontrivial : V.valuation.IsNontrivial := - (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 - ⟨planeCurveFunction f 0 - algebraMap K E z.1.1, - hfirstNonzero, hfirstNonunits⟩ - exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial - have hbfirstMem : bfirst ∈ dominatingIntegralClosurePrime m hbase := by - change integralClosureToDominatingValuationSubring m hbase bfirst ∈ - IsLocalRing.maximalIdeal V - apply ValuationSubring.coe_mem_nonunits_iff.mp - have hcoe : - ((integralClosureToDominatingValuationSubring - m hbase bfirst : V) : E) = algebraMap B E bfirst := by - rfl - rw [hcoe, hbfirstMap] - exact hfirstNonunits - have hqne : dominatingIntegralClosurePrime m hbase ≠ ⊥ := by - intro hbot - have : bfirst = 0 := by simpa [hbot] using hbfirstMem - exact hbfirst0 this - let q : HeightOneSpectrum B := - dominatingIntegralClosurePlace m hbase hqne have hrfirstMap0 : algebraMap A E rfirst ≠ 0 := by - rw [hrfirstMap] - exact hfirstNonzero + rwa [hrfirstMap] have hrsecondMap0 : algebraMap A E rsecond ≠ 0 := by - rw [hrsecondMap] - exact hsecondNonzero - refine ⟨q, ?_, ?_, ?_⟩ - · exact valuationSubringAt_dominatingIntegralClosurePlace_eq - m hbase hqne hV - · rw [← hrfirstMap] - exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem - m hbase hqne hV rfirst hrfirst hrfirstMap0 - · rw [← hrsecondMap] - exact finitePlaceOrder_dominatingIntegralClosurePlace_pos_of_mem - m hbase hqne hV rsecond hrsecond hrsecondMap0 + rwa [hrsecondMap] + have hb : algebraMap B E bfirst = algebraMap A E rfirst := + hbfirstMap.trans hrfirstMap.symm + obtain ⟨q, hq, hfirst, hsecond⟩ := exists_integralClosurePlace_orders_positive + m hbase rfirst rsecond hrfirst hrsecond hrfirstMap0 hrsecondMap0 bfirst hb + exact ⟨q, hq, hrfirstMap ▸ hfirst, hrsecondMap ▸ hsecond⟩ variable [DecidableEq K] @@ -536,6 +475,7 @@ theorem affinePointFamily_card_le_finiteExtensionGcdWeightedDegree let finitePlace : ι → FiniteExtensionFinitePlace K E := fun i => affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond (point i) + let _ : DecidableEq (FiniteExtensionPlace K E) := Classical.decEq _ let place : ι → FiniteExtensionPlace K E := fun i => .inl (finitePlace i) have hFinitePlaceInjective : Function.Injective finitePlace := (affinePointExhaustiveFinitePlace_injective diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean index 0de6c4b078..2a2decd6ef 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean @@ -59,7 +59,7 @@ theorem dedekindRamificationLocus_finite : have hdiv : Q.asIdeal ∣ differentIdeal A B := dvd_differentIdeal_iff.mpr hQ simpa [D, BGS.CorvajaZannier.differentMultiplicityDivisor_apply] using - (multiplicity_pos_of_dvd hdiv).ne' + (multiplicity_pos_of_dvd hdiv (FiniteMultiplicity.of_prime_left Q.prime hDifferent)).ne' /-- The branch locus downstairs is the image of the ramification locus under contraction of height-one primes. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean index 76c509663c..78d03a09b1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean @@ -199,7 +199,8 @@ theorem finiteExtensionFinitePlace_degree_eq_finrank_residueField letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime q.asIdeal) := inferInstance rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p.asIdeal q.asIdeal] rw [ratFuncFinitePlaceDegree_eq_finrank_residueField K p] rw [mul_comm, Module.finrank_mul_finrank] @@ -214,7 +215,8 @@ theorem finiteExtensionInfinityPlace_degree_eq_finrank_residueField Module.finrank K P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance letI : Algebra p.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean index a9478f1644..13e1f475d4 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean @@ -707,8 +707,9 @@ theorem existingConicSeedNonsplitTraceCurveSolutions_eq_seeded seededNonsplitTraceCurveSolutions p (quadraticFiberProductUnit p t ht ht0) s d e := by ext z - simp [existingConicSeedNonsplitTraceCurveSolutions, - seededNonsplitTraceCurveSolutions, ExistingConicSeedNonsplitTraceCoverEquation] + rw [mem_existingConicSeedNonsplitTraceCurveSolutions_iff] + erw [mem_seededNonsplitTraceCurveSolutions_iff] + rfl /-- Exact existing-conic count comparison with both affine boundaries exposed: `u = 0` contributes nothing for positive exponents, while `w = 1` is the displayed boundary term. -/ @@ -722,7 +723,7 @@ theorem existingConicSeedNonsplitTraceCurveSolutions_card_eq_affine_add_identity (seededNonsplitIdentityBoundarySolutions p (quadraticFiberProductUnit p t ht ht0) s d e).card := by rw [existingConicSeedNonsplitTraceCurveSolutions_eq_seeded] - rw [seededNonsplitTraceCurveSolutions_card_eq_descended_add_identityBoundary] + erw [seededNonsplitTraceCurveSolutions_card_eq_descended_add_identityBoundary] rw [← affinePlaneCurveZeros_seededNonsplitDescendedPolynomial_card_eq p s.1 d e hd he] end diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean index 5fb41c9ff1..4fe869c496 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean @@ -23,13 +23,13 @@ open scoped Topology namespace Legacy /-- Sealed data for the deliberately conservative project cutoff. -/ -@[irreducible] def explicitStrongApproximationCutoffData : +@[irreducible] noncomputable def explicitStrongApproximationCutoffData : {n : ℕ // n = BGS.NumberTheory.explicitDivisorConstant + 1} := ⟨BGS.NumberTheory.explicitDivisorConstant + 1, rfl⟩ /-- The deliberately conservative project cutoff. It is not the primorial constant from arXiv:2308.07579. -/ -def explicitStrongApproximationCutoff : ℕ := +noncomputable def explicitStrongApproximationCutoff : ℕ := explicitStrongApproximationCutoffData.1 theorem explicitStrongApproximationCutoff_eq : @@ -167,14 +167,14 @@ theorem explicitDivisorMomentConstant_pos : positivity /-- Sealed data for the improved project cutoff. -/ -@[irreducible] def explicitStrongApproximationCutoffData : +@[irreducible] noncomputable def explicitStrongApproximationCutoffData : {n : ℕ // n = 2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1} := ⟨2 ^ 9 * (48 ^ 3 + 1) ^ 18 * explicitDivisorMomentConstant ^ 8 + 1, rfl⟩ /-- The explicit project cutoff. It is deliberately different from the primorial constant in arXiv:2308.07579. -/ -def explicitStrongApproximationCutoff : ℕ := +noncomputable def explicitStrongApproximationCutoff : ℕ := explicitStrongApproximationCutoffData.1 theorem explicitStrongApproximationCutoff_eq : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean index 1dccfb1d85..5e11a788bc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean @@ -206,13 +206,19 @@ def weightedSplitTraceLeftInversionAffineMap (alpha beta : K) (d e : ℕ) : theorem weightedSplitTraceLeftInversionAffineMap_x (alpha beta : K) (d e : ℕ) : weightedSplitTraceLeftInversionAffineMap alpha beta d e (weightedSplitTraceAffineX alpha beta d e) = weightedSplitTraceLaurentXInverse alpha beta d e := by - simp [weightedSplitTraceLeftInversionAffineMap, weightedSplitTraceLeftInversionPolynomialMap, weightedSplitTraceAffineX] + change MvPolynomial.aeval + ![weightedSplitTraceLaurentXInverse alpha beta d e, + weightedSplitTraceLaurentY alpha beta d e] (MvPolynomial.X 0) = _ + simp @[simp] theorem weightedSplitTraceLeftInversionAffineMap_y (alpha beta : K) (d e : ℕ) : weightedSplitTraceLeftInversionAffineMap alpha beta d e (weightedSplitTraceAffineY alpha beta d e) = weightedSplitTraceLaurentY alpha beta d e := by - simp [weightedSplitTraceLeftInversionAffineMap, weightedSplitTraceLeftInversionPolynomialMap, weightedSplitTraceAffineY] + change MvPolynomial.aeval + ![weightedSplitTraceLaurentXInverse alpha beta d e, + weightedSplitTraceLaurentY alpha beta d e] (MvPolynomial.X 1) = _ + simp theorem weightedSplitTraceLeftInversionAffineMap_coordinateProduct_isUnit (alpha beta : K) (d e : ℕ) : IsUnit (weightedSplitTraceLeftInversionAffineMap alpha beta d e (weightedSplitTraceAffineCoordinateProduct alpha beta d e)) := by @@ -399,8 +405,10 @@ theorem weightedSplitTraceRightInversionAffineMap_x weightedSplitTraceRightInversionAffineMap alpha beta d e (weightedSplitTraceAffineX beta alpha d e) = weightedSplitTraceLaurentX alpha beta d e := by - simp [weightedSplitTraceRightInversionAffineMap, - weightedSplitTraceRightInversionPolynomialMap, weightedSplitTraceAffineX] + change MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentYInverse alpha beta d e] (MvPolynomial.X 0) = _ + simp @[simp] theorem weightedSplitTraceRightInversionAffineMap_y @@ -408,8 +416,10 @@ theorem weightedSplitTraceRightInversionAffineMap_y weightedSplitTraceRightInversionAffineMap alpha beta d e (weightedSplitTraceAffineY beta alpha d e) = weightedSplitTraceLaurentYInverse alpha beta d e := by - simp [weightedSplitTraceRightInversionAffineMap, - weightedSplitTraceRightInversionPolynomialMap, weightedSplitTraceAffineY] + change MvPolynomial.aeval + ![weightedSplitTraceLaurentX alpha beta d e, + weightedSplitTraceLaurentYInverse alpha beta d e] (MvPolynomial.X 1) = _ + simp theorem weightedSplitTraceRightInversionAffineMap_coordinateProduct_isUnit (alpha beta : K) (d e : ℕ) : diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean index daf716e95c..4bddfc03eb 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean @@ -264,9 +264,10 @@ noncomputable def infiniteAdeleLocalResidueToSubring (D : DivisorA k K) rw [map_zpow₀, Classical.choose_spec (v.valuation_exists_uniformizer K)] rw [map_mul, hπpow] have hf : v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) ≤ WithZero.exp n := by - have := a.property (Sum.inr v) - simpa [memAdeleFilt, placeValuation, n, Finsupp.add_apply, Finsupp.single_apply, - add_comm] using this + have h := a.property (Sum.inr v) + change v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) ≤ + WithZero.exp ((D + Finsupp.single (Sum.inr v) 1 : DivisorA k K) (Sum.inr v)) at h + simpa only [Finsupp.add_apply, Finsupp.single_eq_same] using h calc WithZero.exp (-1) ^ n * v.valuation K ((a.val : AdeleSpace k K).val (Sum.inr v)) ≤ WithZero.exp (-1) ^ n * WithZero.exp n := mul_le_mul_right hf _ diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean index 33114dd32e..ac85c540d5 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean @@ -360,7 +360,7 @@ theorem deg_polarDivisor_XK_eq_primesOverFinset_sum : letI : v.asIdeal.LiesOver p := ⟨hpw.symm⟩ have hinertia : Ideal.inertiaDeg' p v.asIdeal = v.asIdeal.inertiaDeg A := - Ideal.inertiaDeg'_eq_inertiaDeg (p := p) (q := v.asIdeal) + Ideal.inertiaDeg'_eq_inertiaDeg (p := p) (P := v.asIdeal) rw [polarDivisor_XK_at_infinite k K v, ramIdxInfty, placeDegree_infinite_eq_inertiaDeg, ← hinertia] From 0b0a3ed8c8c364c0d415b57e5190c12af3c2b973 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:40:25 +0000 Subject: [PATCH 09/37] Port constant fields and trace-curve normalization proofs --- .../ConstantFieldRatFuncCompatibility.lean | 3 + .../HasseWeil/FunctionFieldConstantField.lean | 3 +- .../BGS/HasseWeil/OnePointBase.lean | 26 +++--- .../BGS/HasseWeil/PlaneConstantField.lean | 86 +++++++++++-------- .../BGS/Markoff/PreliminaryNumerics.lean | 9 +- .../BGS/Markoff/TraceCurve/LaurentSmooth.lean | 4 +- .../ProjectiveNormalizationMorphism.lean | 6 ++ .../RiemannRoch/Genus/AdeleQuotient.lean | 31 ++----- 8 files changed, 89 insertions(+), 79 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean index 93797f47d5..cd90ca4605 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean @@ -60,6 +60,9 @@ theorem planeCurveCoordinateRingBaseChangeAlgEquiv_includeRight intro i simp [Φ, planeCurveCoordinateRingBaseChangeAlgEquiv, planeCurveCoordinateRingMap] + erw [Ideal.quotientEquivAlg_mk] + simp only [MvPolynomial.algebraTensorAlgEquiv_tmul, one_smul] + rfl theorem planeCurveFunctionFieldBaseChangeAlgHom_function (hf : Irreducible f) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean index 0e21d29b2f..41743ec70f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean @@ -155,7 +155,8 @@ theorem finiteExtensionFinitePlaceResidueField_finite [Fintype K] ratFuncFinitePlaceResidueField_finite K p letI : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal P.asIdeal := ⟨rfl⟩ + let _ : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime P.asIdeal) := inferInstance letI : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance letI : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := inferInstance diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean index 6f0bcb3197..2c9e514d2c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean @@ -84,20 +84,24 @@ theorem finiteExtensionOnePointRiemannSpace_zero_moduleFinite Module.Finite K (finiteExtensionOnePointRiemannSpace K L P 0) := by let Q : FiniteExtensionInfinityPlace K L := Classical.choice (inferInstance : Nonempty (FiniteExtensionInfinityPlace K L)) - letI : Algebra (RatFuncInfinityIntegralClosure K L) + let : Algebra (RatFuncInfinityIntegralClosure K L) (RatFuncInfinityIntegralClosure K L) := Algebra.id (RatFuncInfinityIntegralClosure K L) - letI : Algebra (RatFuncInfinityIntegralClosure K L) + let _ : DistribMulAction (RatFuncInfinityIntegralClosure K L) + (RatFuncInfinityIntegralClosure K L) := + (Algebra.toModule : Module (RatFuncInfinityIntegralClosure K L) + (RatFuncInfinityIntegralClosure K L)).toDistribMulAction + let : Algebra (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L Q) := OreLocalization.instAlgebra let R := FiniteExtensionInfinityPlaceLocalRing K L Q - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) Q - letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) Q - letI : IsDiscreteValuationRing R := + let := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) Q + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) Q + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) (primeOverHeightOne (ratFuncInfinityPlace K) Q).ne_bot R - letI : Finite Q.1.ResidueField := + let : Finite Q.1.ResidueField := finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) Q let V := finiteExtensionOnePointRiemannSpace K L P 0 have hliftExists : ∀ x : V, ∃ r : R, @@ -107,7 +111,9 @@ theorem finiteExtensionOnePointRiemannSpace_zero_moduleFinite apply finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative (K := K) (L := L) Q x.1 by_cases hx0 : x.1 = 0 - · simp [finiteExtensionInfinityPlaceLocalOrderTop, hx0] + · simp only [finiteExtensionInfinityPlaceLocalOrderTop, hx0] + erw [finitePlaceOrderTop_zero] + exact le_top · rw [finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder Q x.1 hx0] have hxmem := (mem_finiteExtensionOnePointRiemannSpace_iff K L P 0 x.1).mp x.2 @@ -135,8 +141,8 @@ theorem finiteExtensionOnePointRiemannSpace_zero_moduleFinite by_contra hne let r : R := lift x - lift y have hrResidue : IsLocalRing.residue R r = 0 := by - change IsLocalRing.residue R (lift x) - - IsLocalRing.residue R (lift y) = 0 + dsimp only [r] + rw [map_sub] exact sub_eq_zero.mpr hxy have hrMem : r ∈ IsLocalRing.maximalIdeal R := (IsLocalRing.residue_eq_zero_iff r).mp hrResidue @@ -197,7 +203,7 @@ theorem finiteExtensionOnePointRiemannSpace_zero_moduleFinite have hDegreeZero := finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L (x.1 - y.1) hdNe omega - letI : Finite V := Finite.of_injective residue hresidueInjective + let : Finite V := Finite.of_injective residue hresidueInjective change Module.Finite K V infer_instance diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean index fb3449726d..6371619eec 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean @@ -158,6 +158,40 @@ theorem adjoin_transcendental_algebraicClosure_eq_bot rw [ratFunc_algebraicClosure_eq_bot] at hmap simpa only [IntermediateField.map_bot] using hmap.symm +private theorem finiteDimensional_finrank_of_adjoin_eq_top + {A L : Type*} [Field A] [Field L] [Algebra A L] + (y : L) (hy : IsIntegral A y) (htop : IntermediateField.adjoin A {y} = ⊤) : + FiniteDimensional A L ∧ Module.finrank A L = (minpoly A y).natDegree := by + let : FiniteDimensional A (IntermediateField.adjoin A {y}) := + IntermediateField.adjoin.finiteDimensional hy + let : FiniteDimensional A (⊤ : IntermediateField A L) := by + rw [← htop] + infer_instance + let : FiniteDimensional A L := + IntermediateField.topEquiv.toLinearEquiv.finiteDimensional + refine ⟨inferInstance, ?_⟩ + calc + Module.finrank A L = Module.finrank A (⊤ : IntermediateField A L) := by + rw [IntermediateField.finrank_top'] + _ = Module.finrank A (IntermediateField.adjoin A {y}) := by rw [htop] + _ = (minpoly A y).natDegree := IntermediateField.adjoin.finrank hy + +private theorem algebraMap_surjective_of_equal_finrank + {F A L : Type*} [Field F] [Field A] [Field L] + [Algebra F A] [Algebra A L] [Algebra F L] [IsScalarTower F A L] + [FiniteDimensional F L] [FiniteDimensional A L] + (degree : ℕ) (hdegree : 0 < degree) + (hA : Module.finrank A L = degree) (hF : Module.finrank F L = degree) : + Function.Surjective (algebraMap F A) := by + let : FiniteDimensional F A := + FiniteDimensional.of_injective (IsScalarTower.toAlgHom F A L).toLinearMap + (RingHom.injective _) + have hmul := Module.finrank_mul_finrank F A L + have hfinrank : Module.finrank F A = 1 := by + rw [hA, hF] at hmul + nlinarith + exact (Algebra.finrank_eq_one_iff_bijective_algebraMap.mp hfinrank).2 + /-- **Exact constant field of an absolutely irreducible plane curve.** If the defining equation remains irreducible over an algebraic closure and @@ -178,12 +212,9 @@ theorem planeCurveFunctionField_algebraicClosure_eq_bot (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI := planeCurveCoordinateRing_isDomain hf + let _ := planeCurveCoordinateRing_isDomain hf algebraicClosure K (PlaneCurveFunctionField f) = ⊥ := by - let hf : Irreducible f := - irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf + intro hf domain let L := PlaneCurveFunctionField f let E : IntermediateField K L := algebraicClosure K L let x : L := planeCurveFunction f 0 @@ -225,8 +256,14 @@ theorem planeCurveFunctionField_algebraicClosure_eq_bot rw [Set.mem_singleton_iff] at hz subst z exact IntermediateField.subset_adjoin E {x} (Set.mem_singleton x) - letI : Algebra F A := (IntermediateField.inclusion hFA).toAlgebra - letI : IsScalarTower F A L := + let : Algebra F A := (IntermediateField.inclusion hFA).toAlgebra + let _ : SMul F A := Algebra.toSMul + let _ : Module F A := Algebra.toModule + let _ : SMul A L := Algebra.toSMul + let _ : Module A L := Algebra.toModule + let _ : SMul F L := Algebra.toSMul + let _ : Module F L := Algebra.toModule + let : IsScalarTower F A L := IsScalarTower.of_algebraMap_eq' (R := F) (S := A) (A := L) rfl have hpoly : polynomialOverFirstCoordinate f ≠ 0 := polynomialOverFirstCoordinate_ne_zero_of_irreducible hf hdegree @@ -263,40 +300,19 @@ theorem planeCurveFunctionField_algebraicClosure_eq_bot (IntermediateField.adjoin E {x}) {y}).restrictScalars E = ⊤ rw [IntermediateField.adjoin_adjoin_left] simpa only [Set.singleton_union] using hpairE - letI : FiniteDimensional A (IntermediateField.adjoin A {y}) := - IntermediateField.adjoin.finiteDimensional hyA - letI : FiniteDimensional A (⊤ : IntermediateField A L) := by - rw [← htopA] - infer_instance - letI : FiniteDimensional A L := - IntermediateField.topEquiv.toLinearEquiv.finiteDimensional - have hfinA : Module.finrank A L = MvPolynomial.degreeOf 1 f := by - calc - Module.finrank A L = Module.finrank A - (⊤ : IntermediateField A L) := by - rw [IntermediateField.finrank_top'] - _ = Module.finrank A (IntermediateField.adjoin A {y}) := by - rw [htopA] - _ = (minpoly A y).natDegree := - IntermediateField.adjoin.finrank hyA - _ = MvPolynomial.degreeOf 1 f := hminA - letI : FiniteDimensional F L := + obtain ⟨finiteDimensionalA, hfinrankA⟩ := + finiteDimensional_finrank_of_adjoin_eq_top y hyA htopA + let : FiniteDimensional A L := finiteDimensionalA + have hfinA : Module.finrank A L = MvPolynomial.degreeOf 1 f := + hfinrankA.trans hminA + let : FiniteDimensional F L := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).1 have hfinF : Module.finrank F L = MvPolynomial.degreeOf 1 f := finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible hf hpartialSecond - letI : FiniteDimensional F A := - FiniteDimensional.of_injective - (IsScalarTower.toAlgHom F A L).toLinearMap - (RingHom.injective _) - have hmul : Module.finrank F A * Module.finrank A L = - Module.finrank F L := Module.finrank_mul_finrank F A L - have hfinFA : Module.finrank F A = 1 := by - rw [hfinA, hfinF] at hmul - nlinarith have hsurj : Function.Surjective (algebraMap F A) := - (Algebra.finrank_eq_one_iff_bijective_algebraMap.mp hfinFA).2 + algebraMap_surjective_of_equal_finrank (L := L) _ hdegree hfinA hfinF have hArestrict : A.restrictScalars K = F := by apply le_antisymm · intro z hz diff --git a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean index 66e61ab3eb..fe8b8fed77 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean @@ -158,13 +158,8 @@ private theorem preliminary_endgame_coefficient_le_cutoff_pow_four : private theorem preliminary_fixed_pow_eight_le_cutoff : 100522 ^ 8 ≤ 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 := by - calc - 100522 ^ 8 ≤ (2 ^ 17) ^ 8 := Nat.pow_le_pow_left (by norm_num) _ - _ = 2 ^ 136 := by - rw [show (136 : ℕ) = 17 * 8 by norm_num, pow_mul] - _ ≤ 2 ^ 1833 := Nat.pow_le_pow_right (by norm_num) (by norm_num) - _ ≤ 2 ^ 1833 * (48 ^ 3 + 1) ^ 10 := - Nat.le_mul_of_pos_right _ (pow_pos (by norm_num) _) + decide +kernel + private theorem preliminary_lowOrder_coefficient_eq_cutoff_sq : 2 ^ 10 * (48 ^ 3 + 1) ^ 20 * preliminaryDivisorMomentConstant ^ 8 = (2 ^ 1833 * (48 ^ 3 + 1) ^ 10) ^ 2 := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean index fb008e19c7..e07df6b67b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean @@ -77,7 +77,7 @@ theorem weightedSplitTraceAffineXPreSubmersivePresentation_jacobian (fun _ => 0) (fun _ _ _ => Subsingleton.elim _ _) let E := weightedSplitTraceAffinePresentationEquiv alpha beta d e change (P.ofAlgEquiv E).jacobian = weightedSplitTraceAffinePartialX alpha beta d e - rw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, + erw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, Algebra.PreSubmersivePresentation.jacobian_eq_jacobiMatrix_det, Matrix.det_unique, Algebra.PreSubmersivePresentation.jacobiMatrix_naive] change E (Ideal.Quotient.mk _ @@ -255,7 +255,7 @@ theorem weightedSplitTraceAffineYPreSubmersivePresentation_jacobian (fun _ => 1) (fun _ _ _ => Subsingleton.elim _ _) let E := weightedSplitTraceAffinePresentationEquiv alpha beta d e change (P.ofAlgEquiv E).jacobian = weightedSplitTraceAffinePartialY alpha beta d e - rw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, + erw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, Algebra.PreSubmersivePresentation.jacobian_eq_jacobiMatrix_det, Matrix.det_unique, Algebra.PreSubmersivePresentation.jacobiMatrix_naive] change E (Ideal.Quotient.mk _ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean index 4316a74e90..cc8ce60fdb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean @@ -27,6 +27,12 @@ universe u variable {K : Type u} [Field K] +local instance affineNormalizationSelfAction (alpha beta : K) (d e : ℕ) : + DistribMulAction (WeightedSplitTraceAffineNormalizationRing alpha beta d e) + (WeightedSplitTraceAffineNormalizationRing alpha beta d e) := + (Algebra.toModule : Module (WeightedSplitTraceAffineNormalizationRing alpha beta d e) + (WeightedSplitTraceAffineNormalizationRing alpha beta d e)).toDistribMulAction + /-- Canonical ring map from an affine trace chart to its integral closure. -/ def weightedSplitTraceAffineNormalizationRingHom (alpha beta : K) (d e : ℕ) : WeightedSplitTraceAffineCoordinateRing alpha beta d e →+* diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean index e932652233..6ca4fe544a 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean @@ -74,30 +74,13 @@ omit [IsFullConstantField k K] in theorem mem_adeleFilt_divisorOfAdele (α : AdeleSpace k K) : α ∈ adeleFilt k K (divisorOfAdele k K α) := by intro v - show placeValuation k K v (α.val v) ≤ WithZero.exp ((divisorOfAdele k K α) v) - dsimp [divisorOfAdele, exceptionalPlaces, Finsupp.onFinset_apply] - by_cases hv : placeValuation k K v (α.val v) ≤ 1 - · have hnotlt : ¬1 < placeValuation k K v (α.val v) := not_lt.mpr hv - have hnotmem : v ∉ exceptionalPlaces k K α := by - intro hmem - have hgt := (exceptionalFinite k K α).mem_toFinset.mp (by - dsimp [exceptionalPlaces] at hmem ⊢ - exact hmem) - have hnotle : ¬placeValuation k K v (α.val v) ≤ 1 := by simpa using hgt - exact absurd hv hnotle - split_ifs with hlt - · exfalso - exact hnotlt hlt - · simpa [WithZero.exp_zero] using hv - · have hlt : 1 < placeValuation k K v (α.val v) := not_le.mp hv - have hmem : v ∈ exceptionalPlaces k K α := by - dsimp [exceptionalPlaces] - exact (exceptionalFinite k K α).mem_toFinset.mpr (not_le.mpr hlt) - have hval : placeValuation k K v (α.val v) ≠ 0 := ne_of_gt (zero_lt_one.trans hlt) - split_ifs with hlt' - · simp [WithZero.exp_log hval] - · exfalso - exact hlt' hlt + change placeValuation k K v (α.val v) ≤ WithZero.exp ((divisorOfAdele k K α) v) + change placeValuation k K v (α.val v) ≤ + WithZero.exp (if 1 < placeValuation k K v (α.val v) then + WithZero.log (placeValuation k K v (α.val v)) else 0) + by_cases hlt : 1 < placeValuation k K v (α.val v) + · rw [if_pos hlt, WithZero.exp_log (ne_of_gt (zero_lt_one.trans hlt))] + · simpa only [if_neg hlt, WithZero.exp_zero] using le_of_not_gt hlt omit [IsFullConstantField k K] in theorem exists_adeleFilt_mem (α : AdeleSpace k K) : From 0faff572db0d01d72c20d1debfc8ed5bfe498730 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:50:40 +0000 Subject: [PATCH 10/37] Factor boundary degree transport through generic valuation models --- .../PlaneCurveBoundarySupport.lean | 702 +++++++++--------- 1 file changed, 331 insertions(+), 371 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean index 10d0def05a..aeedb26b59 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -32,13 +32,15 @@ open IsDedekindDomain Multiplicative WithZero namespace BGS.CorvajaZannier +universe u v + noncomputable section attribute [local instance high] Module.Free.of_divisionRing -variable (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] -variable (L : Type*) [Field L] [Algebra (RatFunc K) L] +variable (K : Type u) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] +variable (L : Type v) [Field L] [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] @@ -326,6 +328,28 @@ private theorem finrank_eq_of_ringEquiv_of_finite_base ← Module.natCard_eq_pow_finrank] exact Nat.card_congr e.toEquiv +/-- Equal normalized valuations have residue fields of the same degree over a finite base. -/ +private theorem residueFinrank_eq_of_valuation_eq + {k R S F : Type*} [Field k] [Fintype k] + [CommRing R] [IsDedekindDomain R] [CommRing S] [IsDedekindDomain S] + [Field F] [Algebra R F] [IsFractionRing R F] + [Algebra S F] [IsFractionRing S F] + (q : HeightOneSpectrum R) (r : HeightOneSpectrum S) + [Algebra k q.asIdeal.ResidueField] [Algebra k r.asIdeal.ResidueField] + [Finite r.asIdeal.ResidueField] + (h : r.valuation F = q.valuation F) : + Module.finrank k r.asIdeal.ResidueField = Module.finrank k q.asIdeal.ResidueField := by + let e := heightOneSpectrumResidueFieldRingEquivOfComapEq q r (RingEquiv.refl F) (by + rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + ext z + change r.valuation F z ≤ 1 ↔ q.valuation F z ≤ 1 + rw [h]) + let : Finite q.asIdeal.ResidueField := Finite.of_injective e e.injective + let : FiniteDimensional k r.asIdeal.ResidueField := inferInstance + let : FiniteDimensional k q.asIdeal.ResidueField := inferInstance + exact (finrank_eq_of_ringEquiv_of_finite_base e).symm + section ValuationCenter variable {R S F : Type*} [CommRing R] [IsDomain R] @@ -482,7 +506,8 @@ private theorem probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra p.asIdeal q.asIdeal := ⟨rfl⟩ + have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) + (Localization.AtPrime q.asIdeal) := inferInstance rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p.asIdeal q.asIdeal] rw [← probe_ratFuncFinitePlaceDegree_eq_finrank_residue K L p] rw [mul_comm, Module.finrank_mul_finrank] @@ -493,7 +518,8 @@ private theorem probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue Module.finrank K P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance letI : Algebra p.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance @@ -509,6 +535,278 @@ private theorem probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue _ = Module.finrank K P.1.ResidueField := Module.finrank_mul_finrank K p.ResidueField P.1.ResidueField +/-- The place degree is determined by any finite residue field with the same valuation. -/ +private theorem probe_placeDegree_eq_of_valuation_eq [Fintype K] + {S : Type*} [CommRing S] [IsDedekindDomain S] + [Algebra S L] [IsFractionRing S L] + (w : FiniteExtensionPlace K L) (q : HeightOneSpectrum S) + [Algebra K q.asIdeal.ResidueField] [Finite q.asIdeal.ResidueField] + (hq : q.valuation L = probeFiniteExtensionPlaceValuation K L w) : + finiteExtensionPlaceDegree K L w = Module.finrank K q.asIdeal.ResidueField := by + cases w with + | inl r => + rw [probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue K L r] + exact (residueFinrank_eq_of_valuation_eq (k := K) r q hq).symm + | inr P => + rw [probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue K L P] + exact (residueFinrank_eq_of_valuation_eq (k := K) + (primeOverHeightOne (ratFuncInfinityPlace K) P) q hq).symm + +private theorem weightedSum_le_of_injective + {α β : Type*} [DecidableEq α] [DecidableEq β] + (source : Finset α) (target : Finset β) (map : ↥source → β) + (sourceWeight : α → ℕ) (targetWeight : β → ℕ) + (injective : Function.Injective map) + (weight : ∀ x, targetWeight (map x) = sourceWeight x) + (membership : ∀ x, map x ∈ target) : + ∑ x ∈ source, sourceWeight x ≤ ∑ y ∈ target, targetWeight y := by + have imageSubset : source.attach.image map ⊆ target := by + intro y hy + obtain ⟨x, _, rfl⟩ := Finset.mem_image.mp hy + exact membership x + have imageSum : ∑ y ∈ source.attach.image map, targetWeight y = + ∑ x ∈ source, sourceWeight x := by + rw [Finset.sum_image] + · simp only [weight, Finset.sum_attach] + · intro x hx y hy hxy + exact injective hxy + rw [← imageSum] + exact Finset.sum_le_sum_of_subset imageSubset + +private theorem finitePlace_of_valuation_positive + [Algebra K L] [IsScalarTower K (RatFunc K) L] + (y : L) (hy0 : y ≠ 0) (hpolyX : algebraMap K[X] L Polynomial.X = y) + (v : Valuation L (WithZero (Multiplicative ℤ))) + (hvsurj : Function.Surjective v) + (hvconst : ∀ c : K, v (algebraMap K L c) ≤ 1) + (hvylt : v y < 1) : + ∃ q : FiniteExtensionFinitePlace K L, q.valuation L = v := by + let V := v.valuationSubring + have hyV : y ∈ V := by + change v y ≤ 1 + exact le_of_lt hvylt + have hconstV : ∀ c : K, algebraMap K L c ∈ V := by + intro c + change v (algebraMap K L c) ≤ 1 + exact hvconst c + have hbase : ∀ P : K[X], algebraMap K[X] L P ∈ V := by + intro P + induction P using Polynomial.induction_on' with + | add P Q hP hQ => + rw [map_add] + exact add_mem hP hQ + | monomial n c => + rw [← Polynomial.C_mul_X_pow_eq_monomial, map_mul, map_pow, + hpolyX] + have hC : algebraMap K[X] L (Polynomial.C c) = + algebraMap K L c := by + change algebraMap (RatFunc K) L + (algebraMap K[X] (RatFunc K) (Polynomial.C c)) = + algebraMap K L c + rw [show algebraMap K[X] (RatFunc K) (Polynomial.C c) = + algebraMap K (RatFunc K) c by simp, + IsScalarTower.algebraMap_apply K (RatFunc K) L] + rw [hC] + exact mul_mem (hconstV c) (pow_mem hyV n) + have hyNonunit : algebraMap K[X] L Polynomial.X ∈ V.nonunits := by + rw [hpolyX, ValuationSubring.mem_nonunits_iff_exists_mem_maximalIdeal] + exact ⟨hyV, (Valuation.mem_maximalIdeal_iff (v := v)).mpr hvylt⟩ + have hcenterNe : valuationCenterIdeal + (S := RatFuncFiniteIntegralClosure K L) V hbase ≠ ⊥ := + valuationCenterIdeal_ne_bot_of_mem_nonunits + (S := RatFuncFiniteIntegralClosure K L) V hbase + Polynomial.X (by + rw [hpolyX] + exact hy0) hyNonunit + let q : FiniteExtensionFinitePlace K L := + valuationCenterPlace (S := RatFuncFiniteIntegralClosure K L) + V hbase hcenterNe + have hvNontrivial : v.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one v).mpr + ⟨y, hy0, hvylt⟩ + have hVne : V ≠ ⊤ := by + rw [ne_eq, Valuation.valuationSubring_eq_top_iff] + exact not_not_intro hvNontrivial + have hsubring : + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L q = V := + valuationSubringAt_valuationCenterPlace_eq + (S := RatFuncFiniteIntegralClosure K L) + V hbase hcenterNe hVne + have hequiv : (q.valuation L).IsEquiv v := by + rw [Valuation.isEquiv_iff_valuationSubring, + ← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + exact hsubring + have hqval : q.valuation L = v := + valuation_eq_of_isEquiv_of_surjective hequiv + (q.valuation_surjective L) hvsurj + exact ⟨q, hqval⟩ + + +/-- An injective, degree-preserving transport of positive places bounds the positive degree. -/ +private theorem positiveDegree_le_of_valuation_transport + [Algebra K L] [IsScalarTower K (RatFunc K) L] + {W : Type*} (divisor : W →₀ ℤ) (degree₁ : W → ℕ) + (v₁ : W → Valuation L (WithZero (Multiplicative ℤ))) + (y : L) (hy0 : y ≠ 0) (hpolyX : algebraMap K[X] L Polynomial.X = y) + (hv₁surj : ∀ w, Function.Surjective (v₁ w)) + (hv₁y : ∀ w, v₁ w y = exp (-divisor w)) + (hv₁const : ∀ w c, v₁ w (algebraMap K L c) ≤ 1) + (hv₁inj : Function.Injective v₁) + (hdegree : ∀ w (q : FiniteExtensionFinitePlace K L), q.valuation L = v₁ w → + finiteExtensionPlaceDegree K L (.inl q) = degree₁ w) : + ∑ w ∈ divisor.support.filter (fun w => 0 < divisor w), + (divisor w).toNat * degree₁ w ≤ finiteExtensionPositiveDegree K L y := by + classical + let D₁ : W → ℤ := divisor + let S₁ := divisor.support.filter (fun w => 0 < D₁ w) + have hcenter : ∀ (w : W), 0 < D₁ w → + ∃ q : FiniteExtensionFinitePlace K L, + q.valuation L = v₁ w ∧ + finiteExtensionPlaceDegree K L (.inl q) = degree₁ w ∧ + finiteExtensionPrincipalDivisor K L y (.inl q) = D₁ w := by + intro w hw + change 0 < divisor w at hw + let v := v₁ w + have hvylt : v y < 1 := by + rw [hv₁y w, ← exp_zero, exp_lt_exp] + omega + obtain ⟨q, hqval⟩ := finitePlace_of_valuation_positive K L y hy0 hpolyX + v (hv₁surj w) (hv₁const w) hvylt + have hqOrderVal := probeFiniteExtensionPlaceValuation_eq_exp_neg_order + K L (.inl q) y hy0 + have horder : finiteExtensionPrincipalDivisor K L y (.inl q) = + D₁ w := by + change q.valuation L y = + exp (-finiteExtensionPrincipalDivisor K L y (.inl q)) at hqOrderVal + rw [hqval, hv₁y w] at hqOrderVal + have hneg := exp_injective hqOrderVal + change -D₁ w = _ at hneg + omega + refine ⟨q, hqval, ?_, horder⟩ + exact hdegree w q hqval + let T₁ := {w : W // w ∈ S₁} + let centerFinite : T₁ → FiniteExtensionFinitePlace K L := + fun w => Classical.choose + (hcenter w.1 (Finset.mem_filter.mp w.2).2) + have hcenterFiniteVal (w : T₁) : + (centerFinite w).valuation L = v₁ w.1 := by + exact (Classical.choose_spec + (hcenter w.1 (Finset.mem_filter.mp w.2).2)).1 + have hcenterFiniteDegree (w : T₁) : + finiteExtensionPlaceDegree K L (.inl (centerFinite w)) = + degree₁ w.1 := by + exact (Classical.choose_spec + (hcenter w.1 (Finset.mem_filter.mp w.2).2)).2.1 + have hcenterFiniteOrder (w : T₁) : + finiteExtensionPrincipalDivisor K L y + (.inl (centerFinite w)) = D₁ w.1 := by + exact (Classical.choose_spec + (hcenter w.1 (Finset.mem_filter.mp w.2).2)).2.2 + let W₂ := FiniteExtensionPlace K L + let D₂ : W₂ → ℤ := fun w => + finiteExtensionPrincipalDivisor K L y w + let degree₂ : W₂ → ℕ := fun w => + finiteExtensionPlaceDegree K L w + let center : T₁ → W₂ := fun w => .inl (centerFinite w) + have hcenterOrder (w : T₁) : D₂ (center w) = D₁ w.1 := by + exact hcenterFiniteOrder w + have hcenterDegree (w : T₁) : + degree₂ (center w) = degree₁ w.1 := by + exact hcenterFiniteDegree w + have hcenterInj : Function.Injective center := by + intro a b hab + have hcf : centerFinite a = centerFinite b := by + change Sum.inl (centerFinite a) = Sum.inl (centerFinite b) at hab + exact Sum.inl.inj hab + apply Subtype.ext + apply hv₁inj + rw [← hcenterFiniteVal a, ← hcenterFiniteVal b, hcf] + let S₂ := (finiteExtensionPrincipalDivisor K L y).support.filter + (fun w => 0 < D₂ w) + have hsource_le : + (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ + finiteExtensionPositiveDegree K L y := by + change _ ≤ ∑ z ∈ S₂, (D₂ z).toNat * degree₂ z + apply weightedSum_le_of_injective S₁ S₂ center + (fun w => (D₁ w).toNat * degree₁ w) + (fun z => (D₂ z).toNat * degree₂ z) hcenterInj + · intro w + rw [hcenterOrder, hcenterDegree] + · intro w + apply Finset.mem_filter.mpr + have hpos : 0 < D₁ w.1 := (Finset.mem_filter.mp w.2).2 + constructor + · apply Finsupp.mem_support_iff.mpr + change D₂ (center w) ≠ 0 + rw [hcenterOrder] + exact ne_of_gt hpos + · rw [hcenterOrder] + exact hpos + exact hsource_le + + + +/-- Passing to a second rational-function model cannot decrease the positive degree. -/ +private theorem positiveDegree_le_in_secondModel [Fintype K] + [Algebra K L] [IsScalarTower K (RatFunc K) L] + (second : RatFunc K →+* L) (y : L) (hy0 : y ≠ 0) : + let source := finiteExtensionPositiveDegree K L y + let : Algebra (RatFunc K) L := second.toAlgebra + ∀ (_ : FiniteDimensional (RatFunc K) L) (_ : Algebra.IsSeparable (RatFunc K) L) + (_ : IsScalarTower K (RatFunc K) L), + algebraMap K[X] L Polynomial.X = y → source ≤ finiteExtensionPositiveDegree K L y := by + classical + let W₁ := FiniteExtensionPlace K L + let divisor₁ : W₁ →₀ ℤ := + finiteExtensionPrincipalDivisor K L y + let D₁ : W₁ → ℤ := fun w => + divisor₁ w + let S₁ : Finset W₁ := divisor₁.support.filter + (fun w => 0 < D₁ w) + let degree₁ : W₁ → ℕ := fun w => + finiteExtensionPlaceDegree K L w + let v₁ : W₁ → Valuation L (WithZero (Multiplicative ℤ)) := + probeFiniteExtensionPlaceValuation K L + have hdegree₁ {S : Type v} [CommRing S] [IsDedekindDomain S] + [Algebra S L] [IsFractionRing S L] + (w : W₁) (q : HeightOneSpectrum S) + [Algebra K q.asIdeal.ResidueField] [Finite q.asIdeal.ResidueField] + (hq : q.valuation L = v₁ w) : + degree₁ w = Module.finrank K q.asIdeal.ResidueField := + probe_placeDegree_eq_of_valuation_eq K L w q hq + have hv₁surj : ∀ w : W₁, Function.Surjective (v₁ w) := by + intro w + exact probeFiniteExtensionPlaceValuation_surjective K L w + have hv₁y : ∀ w : W₁, + v₁ w y = exp (-D₁ w) := by + intro w + exact probeFiniteExtensionPlaceValuation_eq_exp_neg_order + K L w y hy0 + have hv₁const : ∀ (w : W₁) (c : K), + v₁ w (algebraMap K L c) ≤ 1 := by + intro w c + exact probeFiniteExtensionPlaceValuation_constant_le_one K L w c + have hv₁inj : Function.Injective v₁ := by + change Function.Injective + (probeFiniteExtensionPlaceValuation K L) + exact probeFiniteExtensionPlaceValuation_injective K L + intro source secondAlgebra finiteDimension separable tower hpolyX + have hdegreeCompare (w : W₁) (q : FiniteExtensionFinitePlace K L) + (hqval : q.valuation L = v₁ w) : + finiteExtensionPlaceDegree K L (.inl q) = degree₁ w := by + let : Finite q.asIdeal.ResidueField := + finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q + rw [probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue K L q] + exact (hdegree₁ w q hqval).symm + have hsource_le : + (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ finiteExtensionPositiveDegree K L y := + positiveDegree_le_of_valuation_transport K L divisor₁ degree₁ v₁ y hy0 hpolyX + hv₁surj hv₁y hv₁const hv₁inj hdegreeCompare + change (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ _ + exact hsource_le + + + end noncomputable section @@ -523,24 +821,21 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_fir {f : MvPolynomial (Fin 2) K₀} (hf : Irreducible f) (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := finiteDimensional_planeCurveFunctionField_over_ratFunc - hf hpartialSecond - letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : FiniteDimensional (RatFunc K₀) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let : Algebra.IsSeparable (RatFunc K₀) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond finiteExtensionPositiveDegree K₀ (PlaneCurveFunctionField f) (planeCurveFunction f 1) ≤ MvPolynomial.degreeOf 0 f := by + intro domain hxTrans firstAlg finiteDimension separable classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf let L₀ := PlaneCurveFunctionField f let x : L₀ := planeCurveFunction f 0 let y : L₀ := planeCurveFunction f 1 - have hxTrans : Transcendental K₀ x := - firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) have hyTrans : Transcendental K₀ y := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) @@ -549,14 +844,7 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_fir apply hyTrans rw [h] exact isAlgebraic_zero - let firstAlg : Algebra (RatFunc K₀) L₀ := - planeCurveFirstCoordinateRatFuncAlgebra f hxTrans - letI : Algebra (RatFunc K₀) L₀ := firstAlg - letI : FiniteDimensional (RatFunc K₀) L₀ := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K₀) L₀ := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsScalarTower K₀ (RatFunc K₀) L₀ := by + let : IsScalarTower K₀ (RatFunc K₀) L₀ := by apply IsScalarTower.of_algebraMap_eq' ext c change algebraMap K₀ L₀ c = @@ -565,112 +853,16 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_fir (ratFuncSpecialization_comp_polynomial_algebraMap x hxTrans) (Polynomial.C c) simpa using h.symm - letI : Algebra K₀[X] L₀ := - RingHom.toAlgebra ((algebraMap (RatFunc K₀) L₀).comp - (algebraMap K₀[X] (RatFunc K₀))) - letI : IsScalarTower K₀[X] (RatFunc K₀) L₀ := - .of_algebraMap_eq' rfl - letI : Algebra K₀ (RatFuncFiniteIntegralClosure K₀ L₀) := - RingHom.toAlgebra - ((algebraMap K₀[X] (RatFuncFiniteIntegralClosure K₀ L₀)).comp - (algebraMap K₀ K₀[X])) - letI : IsScalarTower K₀ K₀[X] - (RatFuncFiniteIntegralClosure K₀ L₀) := - .of_algebraMap_eq' rfl - letI : Algebra K₀ (RatFuncInfinityIntegers K₀) := - (ratFuncInfinityConstantRingHom K₀).toAlgebra - letI : IsScalarTower K₀ (RatFuncInfinityIntegers K₀) (RatFunc K₀) := - .of_algebraMap_eq' rfl - letI : Algebra K₀ (RatFuncInfinityIntegralClosure K₀ L₀) := - RingHom.toAlgebra - ((algebraMap (RatFuncInfinityIntegers K₀) - (RatFuncInfinityIntegralClosure K₀ L₀)).comp - (algebraMap K₀ (RatFuncInfinityIntegers K₀))) - letI : IsScalarTower K₀ (RatFuncInfinityIntegers K₀) - (RatFuncInfinityIntegralClosure K₀ L₀) := - .of_algebraMap_eq' rfl - letI : IsDedekindDomain (RatFuncFiniteIntegralClosure K₀ L₀) := - integralClosure.isDedekindDomain K₀[X] (RatFunc K₀) L₀ - letI : IsFractionRing (RatFuncFiniteIntegralClosure K₀ L₀) L₀ := - integralClosure.isFractionRing_of_finite_extension (RatFunc K₀) L₀ - letI : IsDedekindDomain (RatFuncInfinityIntegralClosure K₀ L₀) := - IsIntegralClosure.isDedekindDomain - (RatFuncInfinityIntegers K₀) (RatFunc K₀) L₀ - (RatFuncInfinityIntegralClosure K₀ L₀) - letI : IsFractionRing (RatFuncInfinityIntegralClosure K₀ L₀) L₀ := - integralClosure.isFractionRing_of_finite_extension (RatFunc K₀) L₀ - let W₁ := FiniteExtensionPlace K₀ L₀ - let divisor₁ : W₁ →₀ ℤ := - finiteExtensionPrincipalDivisor K₀ L₀ y - let D₁ : W₁ → ℤ := fun w => - divisor₁ w - let S₁ : Finset W₁ := divisor₁.support.filter - (fun w => 0 < D₁ w) - let degree₁ : W₁ → ℕ := fun w => - finiteExtensionPlaceDegree K₀ L₀ w - let infinityPrime₁ := fun P : FiniteExtensionInfinityPlace K₀ L₀ => - primeOverHeightOne (ratFuncInfinityPlace K₀) P - have hdegree₁ : ∀ w : W₁, degree₁ w = - match w with - | .inl q => Module.finrank K₀ q.asIdeal.ResidueField - | .inr P => Module.finrank K₀ P.1.ResidueField := by - intro w - cases w with - | inl q => - exact probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue - K₀ L₀ q - | inr P => - exact probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue - K₀ L₀ P - let v₁ : W₁ → Valuation L₀ (WithZero (Multiplicative ℤ)) := - probeFiniteExtensionPlaceValuation K₀ L₀ - have hv₁surj : ∀ w : W₁, Function.Surjective (v₁ w) := by - intro w - exact probeFiniteExtensionPlaceValuation_surjective K₀ L₀ w - have hv₁y : ∀ w : W₁, - v₁ w y = exp (-D₁ w) := by - intro w - exact probeFiniteExtensionPlaceValuation_eq_exp_neg_order - K₀ L₀ w y hy0 - have hv₁const : ∀ (w : W₁) (c : K₀), - v₁ w (algebraMap K₀ L₀ c) ≤ 1 := by - intro w c - exact (by - change probeFiniteExtensionPlaceValuation K₀ L₀ w - (algebraMap K₀ L₀ c) ≤ 1 - cases w with - | inl q => - have hrepr : algebraMap K₀ L₀ c = - algebraMap (RatFuncFiniteIntegralClosure K₀ L₀) L₀ - (algebraMap K₀ - (RatFuncFiniteIntegralClosure K₀ L₀) c) := by - rw [IsScalarTower.algebraMap_apply K₀ (RatFunc K₀) L₀] - rfl - rw [hrepr] - exact q.valuation_le_one _ - | inr P => - have hrepr : algebraMap K₀ L₀ c = - algebraMap (RatFuncInfinityIntegralClosure K₀ L₀) L₀ - (algebraMap K₀ - (RatFuncInfinityIntegralClosure K₀ L₀) c) := by - rw [IsScalarTower.algebraMap_apply K₀ (RatFunc K₀) L₀] - rfl - rw [hrepr] - exact (primeOverHeightOne - (ratFuncInfinityPlace K₀) P).valuation_le_one _) - have hv₁inj : Function.Injective v₁ := by - change Function.Injective - (probeFiniteExtensionPlaceValuation K₀ L₀) - exact probeFiniteExtensionPlaceValuation_injective K₀ L₀ - let secondAlg : Algebra (RatFunc K₀) L₀ := - planeCurveSecondCoordinateRatFuncAlgebra f hyTrans - letI : Algebra (RatFunc K₀) L₀ := secondAlg - letI : FiniteDimensional (RatFunc K₀) L₀ := + let secondHom : RatFunc K₀ →+* L₀ := ratFuncSpecialization y hyTrans + let sourceDegree := finiteExtensionPositiveDegree K₀ L₀ y + have hcompare := positiveDegree_le_in_secondModel K₀ L₀ secondHom y hy0 + let : Algebra (RatFunc K₀) L₀ := secondHom.toAlgebra + let : FiniteDimensional (RatFunc K₀) L₀ := finiteDimensional_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst - letI : Algebra.IsSeparable (RatFunc K₀) L₀ := + let : Algebra.IsSeparable (RatFunc K₀) L₀ := separable_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst - letI : IsScalarTower K₀ (RatFunc K₀) L₀ := by + let : IsScalarTower K₀ (RatFunc K₀) L₀ := by apply IsScalarTower.of_algebraMap_eq' ext c change algebraMap K₀ L₀ c = @@ -679,233 +871,14 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_fir (ratFuncSpecialization_comp_polynomial_algebraMap y hyTrans) (Polynomial.C c) simpa using h.symm - letI : Algebra K₀[X] L₀ := + let : Algebra K₀[X] L₀ := RingHom.toAlgebra ((algebraMap (RatFunc K₀) L₀).comp (algebraMap K₀[X] (RatFunc K₀))) - letI : IsScalarTower K₀[X] (RatFunc K₀) L₀ := - .of_algebraMap_eq' rfl - letI : Algebra K₀ (RatFuncFiniteIntegralClosure K₀ L₀) := - RingHom.toAlgebra - ((algebraMap K₀[X] (RatFuncFiniteIntegralClosure K₀ L₀)).comp - (algebraMap K₀ K₀[X])) - letI : IsScalarTower K₀ K₀[X] - (RatFuncFiniteIntegralClosure K₀ L₀) := - .of_algebraMap_eq' rfl - letI : IsDedekindDomain (RatFuncFiniteIntegralClosure K₀ L₀) := - integralClosure.isDedekindDomain K₀[X] (RatFunc K₀) L₀ - letI : IsFractionRing (RatFuncFiniteIntegralClosure K₀ L₀) L₀ := - integralClosure.isFractionRing_of_finite_extension (RatFunc K₀) L₀ have hpolyX : algebraMap K₀[X] L₀ Polynomial.X = y := by change ratFuncSpecialization y hyTrans RatFunc.X = y simp [ratFuncSpecialization, RatFunc.algEquivOfTranscendental_X] - have hcenter : ∀ (w : W₁), 0 < D₁ w → - ∃ q : FiniteExtensionFinitePlace K₀ L₀, - q.valuation L₀ = v₁ w ∧ - finiteExtensionPlaceDegree K₀ L₀ (.inl q) = degree₁ w ∧ - finiteExtensionPrincipalDivisor K₀ L₀ y (.inl q) = D₁ w := by - intro w hw - let v := v₁ w - let V := v.valuationSubring - have hvylt : v y < 1 := by - rw [hv₁y w, ← exp_zero, exp_lt_exp] - omega - have hyV : y ∈ V := by - change v y ≤ 1 - exact le_of_lt hvylt - have hconstV : ∀ c : K₀, algebraMap K₀ L₀ c ∈ V := by - intro c - change v (algebraMap K₀ L₀ c) ≤ 1 - exact hv₁const w c - have hbase : ∀ P : K₀[X], algebraMap K₀[X] L₀ P ∈ V := by - intro P - induction P using Polynomial.induction_on' with - | add P Q hP hQ => - rw [map_add] - exact add_mem hP hQ - | monomial n c => - rw [← Polynomial.C_mul_X_pow_eq_monomial, map_mul, map_pow, - hpolyX] - have hC : algebraMap K₀[X] L₀ (Polynomial.C c) = - algebraMap K₀ L₀ c := by - change algebraMap (RatFunc K₀) L₀ - (algebraMap K₀[X] (RatFunc K₀) (Polynomial.C c)) = - algebraMap K₀ L₀ c - rw [show algebraMap K₀[X] (RatFunc K₀) (Polynomial.C c) = - algebraMap K₀ (RatFunc K₀) c by simp, - IsScalarTower.algebraMap_apply K₀ (RatFunc K₀) L₀] - rw [hC] - exact mul_mem (hconstV c) (pow_mem hyV n) - have hyNonunit : algebraMap K₀[X] L₀ Polynomial.X ∈ V.nonunits := by - rw [hpolyX, ValuationSubring.mem_nonunits_iff_exists_mem_maximalIdeal] - exact ⟨hyV, (Valuation.mem_maximalIdeal_iff (v := v)).mpr hvylt⟩ - have hcenterNe : valuationCenterIdeal - (S := RatFuncFiniteIntegralClosure K₀ L₀) V hbase ≠ ⊥ := - valuationCenterIdeal_ne_bot_of_mem_nonunits - (S := RatFuncFiniteIntegralClosure K₀ L₀) V hbase - Polynomial.X (by - rw [hpolyX] - intro hy0 - apply hyTrans - rw [hy0] - exact isAlgebraic_zero) hyNonunit - let q : FiniteExtensionFinitePlace K₀ L₀ := - valuationCenterPlace (S := RatFuncFiniteIntegralClosure K₀ L₀) - V hbase hcenterNe - have hvNontrivial : v.IsNontrivial := - (Valuation.isNontrivial_iff_exists_lt_one v).mpr - ⟨y, (by - intro hy0 - apply hyTrans - rw [hy0] - exact isAlgebraic_zero), hvylt⟩ - have hVne : V ≠ ⊤ := by - rw [ne_eq, Valuation.valuationSubring_eq_top_iff] - exact not_not_intro hvNontrivial - have hsubring : - IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L₀ q = V := - valuationSubringAt_valuationCenterPlace_eq - (S := RatFuncFiniteIntegralClosure K₀ L₀) - V hbase hcenterNe hVne - have hequiv : (q.valuation L₀).IsEquiv v := by - rw [Valuation.isEquiv_iff_valuationSubring, - ← IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] - exact hsubring - have hqval : q.valuation L₀ = v₁ w := - valuation_eq_of_isEquiv_of_surjective hequiv - (q.valuation_surjective L₀) (hv₁surj w) - have hqOrderVal := probeFiniteExtensionPlaceValuation_eq_exp_neg_order - K₀ L₀ (.inl q) y hy0 - have horder : finiteExtensionPrincipalDivisor K₀ L₀ y (.inl q) = - D₁ w := by - change q.valuation L₀ y = - exp (-finiteExtensionPrincipalDivisor K₀ L₀ y (.inl q)) at hqOrderVal - rw [hqval, hv₁y w] at hqOrderVal - have hneg := exp_injective hqOrderVal - omega - refine ⟨q, hqval, ?_, horder⟩ - letI : Finite q.asIdeal.ResidueField := - finiteExtensionFinitePlace_residueField_finite - (K := K₀) (L := L₀) q - cases w with - | inl q₁ => - let e := heightOneSpectrumResidueFieldRingEquivOfComapEq - q₁ q (RingEquiv.refl L₀) (by - have hqval' : q.valuation L₀ = q₁.valuation L₀ := by - simpa [v₁, probeFiniteExtensionPlaceValuation] using hqval - rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, - IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] - ext z - change q.valuation L₀ z ≤ 1 ↔ q₁.valuation L₀ z ≤ 1 - rw [hqval']) - letI : Finite q₁.asIdeal.ResidueField := - Finite.of_injective e e.injective - letI : FiniteDimensional K₀ q.asIdeal.ResidueField := inferInstance - letI : FiniteDimensional K₀ q₁.asIdeal.ResidueField := inferInstance - rw [probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue - K₀ L₀ q, hdegree₁] - exact (finrank_eq_of_ringEquiv_of_finite_base e).symm - | inr P₁ => - let q₁ := infinityPrime₁ P₁ - let e := heightOneSpectrumResidueFieldRingEquivOfComapEq - q₁ q (RingEquiv.refl L₀) (by - have hqval' : q.valuation L₀ = q₁.valuation L₀ := by - simpa [v₁, probeFiniteExtensionPlaceValuation, - q₁, infinityPrime₁] using hqval - rw [IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring, - IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] - ext z - change q.valuation L₀ z ≤ 1 ↔ q₁.valuation L₀ z ≤ 1 - rw [hqval']) - letI : Finite q₁.asIdeal.ResidueField := - Finite.of_injective e e.injective - letI : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ - letI : Fintype q₁.asIdeal.ResidueField := Fintype.ofFinite _ - letI : Module.Finite K₀ q.asIdeal.ResidueField := by - rw [Module.finite_def] - exact ⟨Finset.univ, by simp⟩ - letI : Module.Finite K₀ q₁.asIdeal.ResidueField := by - rw [Module.finite_def] - exact ⟨Finset.univ, by simp⟩ - rw [probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue - K₀ L₀ q, hdegree₁] - exact (finrank_eq_of_ringEquiv_of_finite_base e).symm - let T₁ := {w : W₁ // w ∈ S₁} - let centerFinite : T₁ → FiniteExtensionFinitePlace K₀ L₀ := - fun w => Classical.choose - (hcenter w.1 (Finset.mem_filter.mp w.2).2) - have hcenterFiniteVal (w : T₁) : - (centerFinite w).valuation L₀ = v₁ w.1 := by - exact (Classical.choose_spec - (hcenter w.1 (Finset.mem_filter.mp w.2).2)).1 - have hcenterFiniteDegree (w : T₁) : - finiteExtensionPlaceDegree K₀ L₀ (.inl (centerFinite w)) = - degree₁ w.1 := by - exact (Classical.choose_spec - (hcenter w.1 (Finset.mem_filter.mp w.2).2)).2.1 - have hcenterFiniteOrder (w : T₁) : - finiteExtensionPrincipalDivisor K₀ L₀ y - (.inl (centerFinite w)) = D₁ w.1 := by - exact (Classical.choose_spec - (hcenter w.1 (Finset.mem_filter.mp w.2).2)).2.2 - let W₂ := FiniteExtensionPlace K₀ L₀ - let D₂ : W₂ → ℤ := fun w => - finiteExtensionPrincipalDivisor K₀ L₀ y w - let degree₂ : W₂ → ℕ := fun w => - finiteExtensionPlaceDegree K₀ L₀ w - let center : T₁ → W₂ := fun w => .inl (centerFinite w) - have hcenterOrder (w : T₁) : D₂ (center w) = D₁ w.1 := by - exact hcenterFiniteOrder w - have hcenterDegree (w : T₁) : - degree₂ (center w) = degree₁ w.1 := by - exact hcenterFiniteDegree w - have hcenterInj : Function.Injective center := by - intro a b hab - have hcf : centerFinite a = centerFinite b := by - change Sum.inl (centerFinite a) = Sum.inl (centerFinite b) at hab - exact Sum.inl.inj hab - apply Subtype.ext - apply hv₁inj - rw [← hcenterFiniteVal a, ← hcenterFiniteVal b, hcf] - let S₂ := (finiteExtensionPrincipalDivisor K₀ L₀ y).support.filter - (fun w => 0 < D₂ w) - have hcenterImageSubset : S₁.attach.image center ⊆ S₂ := by - intro z hz - rcases Finset.mem_image.mp hz with ⟨w, hw, rfl⟩ - apply Finset.mem_filter.mpr - have hpos : 0 < D₁ w.1 := (Finset.mem_filter.mp w.2).2 - constructor - · apply Finsupp.mem_support_iff.mpr - change D₂ (center w) ≠ 0 - rw [hcenterOrder] - exact ne_of_gt hpos - · rw [hcenterOrder] - exact hpos - have hsumImage : - (∑ z ∈ S₁.attach.image center, - (D₂ z).toNat * degree₂ z) = - ∑ w ∈ S₁.attach, - (D₁ w.1).toNat * degree₁ w.1 := by - rw [Finset.sum_image] - · apply Finset.sum_congr rfl - intro w hw - rw [hcenterOrder, hcenterDegree] - · intro a ha b hb hab - exact hcenterInj hab - have hsource_le : - (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ - finiteExtensionPositiveDegree K₀ L₀ y := by - calc - _ = ∑ w ∈ S₁.attach, - (D₁ w.1).toNat * degree₁ w.1 := by - symm - exact Finset.sum_attach S₁ - (fun w => (D₁ w).toNat * degree₁ w) - _ = ∑ z ∈ S₁.attach.image center, - (D₂ z).toNat * degree₂ z := hsumImage.symm - _ ≤ ∑ z ∈ S₂, (D₂ z).toNat * degree₂ z := - Finset.sum_le_sum_of_subset hcenterImageSubset - _ = finiteExtensionPositiveDegree K₀ L₀ y := by - rfl + have hsource_le : sourceDegree ≤ finiteExtensionPositiveDegree K₀ L₀ y := + hcompare inferInstance inferInstance inferInstance hpolyX have hySecondDegree : finiteExtensionPositiveDegree K₀ L₀ y = MvPolynomial.degreeOf 0 f := by @@ -919,13 +892,7 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_fir finrank_planeCurveFunctionField_over_secondRatFunc_eq_degreeOf_first hf hpartialFirst] at hheight simpa using hheight - have hySourceBound : - (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ - MvPolynomial.degreeOf 0 f := by - exact hsource_le.trans_eq hySecondDegree - change (∑ w ∈ S₁, (D₁ w).toNat * degree₁ w) ≤ - MvPolynomial.degreeOf 0 f - exact hySourceBound + exact hsource_le.trans_eq hySecondDegree /-- The zero/pole boundary of positive powers of the two plane-curve coordinates has degree at most twice the sum of the two coordinate degrees. -/ @@ -934,32 +901,29 @@ theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_le (hpartialFirst : MvPolynomial.pderiv 0 f ≠ 0) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m n : ℕ) (hm : 0 < m) (hn : 0 < n) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := finiteDimensional_planeCurveFunctionField_over_ratFunc + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond ∑ w ∈ propositionTwoExceptionalPlaces K₀ (PlaneCurveFunctionField f) ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), finiteExtensionPlaceDegree K₀ (PlaneCurveFunctionField f) w ≤ 2 * (MvPolynomial.degreeOf 0 f + MvPolynomial.degreeOf 1 f) := by + intro domain hxTrans ratFuncAlgebra finiteDimension separable classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf let L₀ := PlaneCurveFunctionField f let x : L₀ := planeCurveFunction f 0 let y : L₀ := planeCurveFunction f 1 - have hxTrans : Transcendental K₀ x := - firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) have hyTrans : Transcendental K₀ y := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) have hx0 : x ≠ 0 := by intro h apply hxTrans + change IsAlgebraic K₀ x rw [h] exact isAlgebraic_zero have hy0 : y ≠ 0 := by @@ -967,13 +931,6 @@ theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_le apply hyTrans rw [h] exact isAlgebraic_zero - letI : Algebra (RatFunc K₀) L₀ := - planeCurveFirstCoordinateRatFuncAlgebra f hxTrans - letI : FiniteDimensional (RatFunc K₀) L₀ := - finiteDimensional_planeCurveFunctionField_over_ratFunc - hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K₀) L₀ := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hxDegree : finiteExtensionPositiveDegree K₀ L₀ x = MvPolynomial.degreeOf 1 f := by have hheight := finiteExtensionPositiveDegree_polynomial @@ -990,6 +947,7 @@ theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_le MvPolynomial.degreeOf 0 f := by exact finiteExtensionPositiveDegree_planeCurveSecondCoordinate_le_degreeOf_first hf hpartialFirst hpartialSecond + let _ : DecidableEq (FiniteExtensionPlace K₀ L₀) := fun a b => instDecidableEqSum a b have hsupportX : (finiteExtensionPrincipalDivisor K₀ L₀ (x ^ m)).support = (finiteExtensionPrincipalDivisor K₀ L₀ x).support := by @@ -1002,10 +960,12 @@ theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_le rw [finiteExtensionPrincipalDivisor_pow K₀ L₀ y hy0 n] ext w simp [Finsupp.mem_support_iff, hn.ne'] + dsimp only [propositionTwoExceptionalPlaces] change (∑ w ∈ (finiteExtensionPrincipalDivisor K₀ L₀ (x ^ m)).support ∪ (finiteExtensionPrincipalDivisor K₀ L₀ (y ^ n)).support, - finiteExtensionPlaceDegree K₀ L₀ w) ≤ _ + finiteExtensionPlaceDegree K₀ L₀ w) ≤ + 2 * (MvPolynomial.degreeOf 0 f + MvPolynomial.degreeOf 1 f) rw [hsupportX, hsupportY] calc _ ≤ From 7c183e4729506299b4bda568c8c2b24ae180a233 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Mon, 21 Sep 2026 23:59:50 +0000 Subject: [PATCH 11/37] Port function field place and constant field instances --- .../ConstantExtensionInfinityPlaceBridge.lean | 7 ++++- ...tantExtensionFinitePlaceCompatibility.lean | 2 -- .../FiniteExtensionPlaceAlgEquiv.lean | 11 +++++-- .../FunctionFieldNormalClosureConstants.lean | 3 ++ .../BGS/HasseWeil/RiemannSpaceConstants.lean | 15 ++++++++++ .../RiemannSpaceFinitePlaceIncrement.lean | 30 ++++++++++--------- 6 files changed, 48 insertions(+), 20 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean index 4e7b14db8b..5072ef6dc6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean @@ -267,7 +267,8 @@ private theorem actualInfinityPlaceResidueField_finite simpa [p] using Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P letI := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + let _ : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance @@ -970,6 +971,10 @@ theorem exactConstantExtensionInfinityPlace_degree_eq_one_of_dvd C S N q hqOrigin letI : Finite P.1.ResidueField := actualInfinityPlaceResidueField_finite C N P + let _ : DistribMulAction (RatFuncInfinityIntegralClosure C N) + (RatFuncInfinityIntegralClosure C N) := + (Algebra.toModule : Module (RatFuncInfinityIntegralClosure C N) + (RatFuncInfinityIntegralClosure C N)).toDistribMulAction apply Nat.div_self rw [finiteExtensionInfinityPlace_degree_eq_finrank_residueField C N P] exact Module.finrank_pos diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index ab473f051a..11f41e0c9b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -325,7 +325,6 @@ theorem exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTran normalizationAlgEquivRatFuncFiniteOfAlgebraMap, integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] rw [integralClosureAlgEquivRatFuncFiniteOfEq_coe] - rfl apply IsDedekindDomain.HeightOneSpectrum.ext have hActualIdeal : (exactConstantExtensionUpstairsFinitePlace @@ -637,7 +636,6 @@ theorem exactConstantExtensionCompatibleBaseFinitePlace_under_original normalizationAlgEquivRatFuncFiniteOfAlgebraMap, integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] rw [integralClosureAlgEquivRatFuncFiniteOfEq_coe] - rfl have hNormalizationMapsAgree (z : S ⊗[C] integralClosure C[X] N) : ((eTensor z : integralClosure S[X] (ExactConstantExtension C N S)) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean index 7cd24dcaed..d982c90b7c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean @@ -281,8 +281,10 @@ theorem finiteExtensionFinitePlace_degree_eq_residue_finrank letI : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver P.asIdeal Q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra P.asIdeal Q.asIdeal := - ⟨rfl⟩ + let _ : IsScalarTower K[X] (Localization.AtPrime P.asIdeal) + (Localization.AtPrime Q.asIdeal) := inferInstance + let _ : Module.Free P.asIdeal.ResidueField Q.asIdeal.ResidueField := + Module.Free.of_divisionRing P.asIdeal.ResidueField Q.asIdeal.ResidueField rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq P.asIdeal Q.asIdeal] rw [ratFuncFinitePlaceDegree_eq_finrank_residueField K P] rw [mul_comm, Module.finrank_mul_finrank] @@ -295,7 +297,10 @@ theorem finiteExtensionInfinityPlace_degree_eq_residue_finrank Module.finrank K P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 - letI : Localization.AtPrime.IsLiesOverAlgebra p P.1 := ⟨rfl⟩ + let _ : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) + (Localization.AtPrime P.1) := inferInstance + let _ : Module.Free p.ResidueField P.1.ResidueField := + Module.Free.of_divisionRing p.ResidueField P.1.ResidueField letI : Algebra p.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean index 993752ace4..94c05eb90d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean @@ -147,6 +147,9 @@ theorem functionFieldNormalClosureConstantField_isExact : (FunctionFieldNormalClosure K L)) := algebraicClosure.algebraicClosure_eq_bot K (FunctionFieldNormalClosure K L) +local instance normalClosureConstantModule : + Module K (FunctionFieldNormalClosureConstantField K L) := Algebra.toModule + omit [DecidableEq (RatFunc K)] in /-- Frobenius on the finite algebraic constant field has order equal to its degree over `K`. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean index f13e67416c..2ff02d9c97 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean @@ -38,6 +38,21 @@ local instance regularConstantAlgebra : Algebra K L := local instance regularConstantTower : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl +local instance regularInfinityNonempty : Nonempty (FiniteExtensionInfinityPlace K L) := by + let _ : Algebra.IsIntegral (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L + let _ : Module.IsTorsionFree (RatFuncInfinityIntegers K) L := + Module.IsTorsionFree.trans_faithfulSMul + (RatFuncInfinityIntegers K) (RatFunc K) L + let _ : Module.IsTorsionFree (RatFuncInfinityIntegers K) + (RatFuncInfinityIntegralClosure K L) := + IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L + exact Ideal.nonempty_primesOver (ratFuncInfinityPlace K).asIdeal + +local instance regularPlaceNonempty : Nonempty (FiniteExtensionPlace K L) := + Nonempty.map Sum.inr (regularInfinityNonempty K L) + /-- The subalgebra of functions regular at every exhaustive place. -/ def finiteExtensionRegularSubalgebra : Subalgebra K L where carrier := finiteExtensionRiemannSpace K L 0 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean index a2e570d95d..50d6274eba 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean @@ -168,22 +168,24 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment let Q : FiniteExtensionPlace K L := .inl q let S := finiteExtensionRiemannSpace K L D let T := finiteExtensionRiemannSpace K L (D + Finsupp.single Q 1) - letI : Algebra (RatFuncFiniteIntegralClosure K L) + let : Algebra (RatFuncFiniteIntegralClosure K L) (RatFuncFiniteIntegralClosure K L) := Algebra.id (RatFuncFiniteIntegralClosure K L) let upperFiniteClosureLocalAlgebra : Algebra (RatFuncFiniteIntegralClosure K L) (FiniteExtensionFinitePlaceLocalRing K L q) := OreLocalization.instAlgebra - letI := upperFiniteClosureLocalAlgebra - letI : SMul (RatFuncFiniteIntegralClosure K L) + let := upperFiniteClosureLocalAlgebra + let : SMul (RatFuncFiniteIntegralClosure K L) (FiniteExtensionFinitePlaceLocalRing K L q) := upperFiniteClosureLocalAlgebra.toSMul - letI : Algebra K (FiniteExtensionFinitePlaceLocalRing K L q) := + let : Algebra K (FiniteExtensionFinitePlaceLocalRing K L q) := OreLocalization.instAlgebra - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsScalarTower K R L := by + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let _ : FaithfulSMul R L := + (faithfulSMul_iff_algebraMap_injective R L).mpr (IsFractionRing.injective R L) + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext c symm @@ -198,7 +200,7 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap (K := K) (L := L) q) (algebraMap K A c)] rfl - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A q.ne_bot R obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R @@ -371,18 +373,18 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment ext x rw [LinearMap.mem_ker, Submodule.mem_comap] exact hkerPoint x - letI : Finite (IsLocalRing.ResidueField R) := by + let : Finite (IsLocalRing.ResidueField R) := by simpa [R] using finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q - letI : Module.Finite K (IsLocalRing.ResidueField R) := + let : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite - letI : Module.Finite K f.range := inferInstance - letI : Module.Finite K f.ker := by + let : Module.Finite K f.range := inferInstance + let : Module.Finite K f.ker := by rw [hker] exact Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hST).symm - letI : Module.Finite K (T ⧸ f.ker) := + let : Module.Finite K (T ⧸ f.ker) := Module.Finite.equiv f.quotKerEquivRange.symm - letI hTFinite : Module.Finite K T := + let hTFinite : Module.Finite K T := Module.Finite.of_submodule_quotient f.ker have hkerRank : Module.finrank K f.ker = Module.finrank K S := by rw [hker] From 1b28927f39019a10e83b48ddad415743a67d98e1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:10:58 +0000 Subject: [PATCH 12/37] Factor Riemann dimension and exceptional-place arguments --- .../PlaneCurvePropositionTwoGeometric.lean | 31 +++++--- ...unctionFieldNormalClosureConstantBase.lean | 17 ++-- .../RiemannSpaceInfinityPlaceIncrement.lean | 79 +++++++++++-------- 3 files changed, 76 insertions(+), 51 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean index 849619f818..0252ee1924 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean @@ -26,6 +26,15 @@ namespace BGS.CorvajaZannier noncomputable section +private theorem exceptionalPlaces_comm + (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (u v : L) : propositionTwoExceptionalPlaces K L u v = + propositionTwoExceptionalPlaces K L v u := by + classical + exact Finset.union_comm _ _ + /-- The natural orientation `(u,v)=(x^m,y^n)` of the geometric Proposition 2 argument. -/ theorem planeCurvePropositionTwo_natural_of_poweredImageIndexBound @@ -40,7 +49,7 @@ theorem planeCurvePropositionTwo_natural_of_poweredImageIndexBound (hnPrime : ¬ p ∣ n) (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) (hindex : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : @@ -50,15 +59,15 @@ theorem planeCurvePropositionTwo_natural_of_poweredImageIndexBound (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) (planeCurveExhaustiveTorsionGcdWeightedDegree hf hpartialSecond m n : ℝ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let Chi := 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f apply planeCurvePropositionTwo_natural_of_auxiliaryBounds hf hpartialFirst hpartialSecond m n p Chi hm hn hindex intro h k hh hk hadmissible hexcluded let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n let g := poweredCoordinateFrobeniusImageRelation @@ -110,7 +119,7 @@ theorem planeCurvePropositionTwo_swapped_of_poweredImageIndexBound (hmPrime : ¬ p ∣ m) (hcardK : MvPolynomial.degreeOf 1 f < Fintype.card K) (hindex : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : @@ -120,15 +129,15 @@ theorem planeCurvePropositionTwo_swapped_of_poweredImageIndexBound (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) (planeCurveExhaustiveTorsionGcdWeightedDegree hf hpartialSecond m n : ℝ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let Chi := 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f apply planeCurvePropositionTwo_swapped_of_auxiliaryBounds hf hpartialFirst hpartialSecond m n p Chi hm hn hindex intro h k hh hk hadmissible hexcluded let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := @@ -170,8 +179,8 @@ theorem planeCurvePropositionTwo_swapped_of_poweredImageIndexBound exact finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_linearIndependent (p := p) hf hpartialFirst hpartialSecond m n hm hn h k hadmissible.1 Chi hLI (by - simpa only [propositionTwoExceptionalPlaces, Finset.union_comm] using - hEulerNatural) + erw [exceptionalPlaces_comm] + exact hEulerNatural) /-- The two orientations combine to the actual minimum/maximum degree form needed by the plane-curve endpoint. -/ @@ -188,7 +197,7 @@ theorem planeCurvePropositionTwo_of_poweredImageIndexBound (hlarge : 12 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f < p) (hindex : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean index 346f2e0290..9344b60846 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean @@ -63,6 +63,14 @@ constant field. -/ (FunctionFieldNormalClosureConstantBase K L) := (functionFieldNormalClosureConstantToBase K L).toAlgebra +local instance normalClosureConstantBaseSMul : + SMul (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) := Algebra.toSMul + +local instance normalClosureConstantBaseModule : + Module (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) := Algebra.toModule + /-- The embeddings of the constants into the fixed field and into the normal closure form a scalar tower. -/ noncomputable instance functionFieldNormalClosureConstantBase_isScalarTower : @@ -108,7 +116,7 @@ function-field normal closure. -/ /-- The Galois group of the specialized constant extension is the product of the new constant Galois group and the kernel-fixed-field Galois group. -/ noncomputable def functionFieldNormalClosureConstantExtensionAutMulEquiv : - letI := exactConstantExtensionBaseAlgebra + let := exactConstantExtensionBaseAlgebra (FunctionFieldNormalClosureConstantField K L) (FunctionFieldNormalClosureConstantBase K L) (FunctionFieldNormalClosure K L) S @@ -123,7 +131,7 @@ noncomputable def functionFieldNormalClosureConstantExtensionAutMulEquiv : ExactConstantExtension (FunctionFieldNormalClosureConstantField K L) (FunctionFieldNormalClosure K L) S) := by - letI := exactConstantExtensionBaseAlgebra + let := exactConstantExtensionBaseAlgebra (FunctionFieldNormalClosureConstantField K L) (FunctionFieldNormalClosureConstantBase K L) (FunctionFieldNormalClosure K L) S @@ -133,10 +141,9 @@ noncomputable def functionFieldNormalClosureConstantExtensionAutMulEquiv : (FunctionFieldNormalClosure K L) S (functionFieldNormalClosureConstantField_isExact K L) -omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The specialized constant quotient is onto. -/ theorem functionFieldNormalClosureConstantExtensionQuotient_surjective : - letI := exactConstantExtensionBaseAlgebra + let := exactConstantExtensionBaseAlgebra (FunctionFieldNormalClosureConstantField K L) (FunctionFieldNormalClosureConstantBase K L) (FunctionFieldNormalClosure K L) S @@ -145,7 +152,7 @@ theorem functionFieldNormalClosureConstantExtensionQuotient_surjective : (FunctionFieldNormalClosureConstantBase K L) (FunctionFieldNormalClosure K L) S (functionFieldNormalClosureConstantField_isExact K L)) := by - letI := exactConstantExtensionBaseAlgebra + let := exactConstantExtensionBaseAlgebra (FunctionFieldNormalClosureConstantField K L) (FunctionFieldNormalClosureConstantBase K L) (FunctionFieldNormalClosure K L) S diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean index 55a4cda57c..a247ef8825 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean @@ -15,6 +15,30 @@ open IsDedekindDomain noncomputable section +private theorem finite_and_finrank_le_of_residue_map + {k E F : Type*} [Field k] [AddCommGroup E] [Module k E] + [AddCommGroup F] [Module k F] [Module.Finite k F] + (S T : Submodule k E) [Module.Finite k S] (hST : S ≤ T) + (f : T →ₗ[k] F) (hker : f.ker = Submodule.comap T.subtype S) : + Module.Finite k T ∧ Module.finrank k T ≤ Module.finrank k S + Module.finrank k F := by + let : Module.Finite k f.range := inferInstance + let : Module.Finite k f.ker := by + rw [hker] + exact Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hST).symm + let : Module.Finite k (T ⧸ f.ker) := + Module.Finite.equiv f.quotKerEquivRange.symm + let hTFinite : Module.Finite k T := Module.Finite.of_submodule_quotient f.ker + have hkerRank : Module.finrank k f.ker = Module.finrank k S := by + rw [hker] + exact (Submodule.comapSubtypeEquivOfLe hST).finrank_eq + refine ⟨hTFinite, ?_⟩ + calc + Module.finrank k T = Module.finrank k f.range + Module.finrank k f.ker := + f.finrank_range_add_finrank_ker.symm + _ ≤ Module.finrank k F + Module.finrank k S := + Nat.add_le_add f.range.finrank_le (le_of_eq hkerRank) + _ = Module.finrank k S + Module.finrank k F := Nat.add_comm _ _ + section InfinityPlace variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] @@ -119,22 +143,24 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment let Q : FiniteExtensionPlace K L := .inr P let S := finiteExtensionRiemannSpace K L D let T := finiteExtensionRiemannSpace K L (D + Finsupp.single Q 1) - letI : Algebra (RatFuncInfinityIntegralClosure K L) + let : Algebra (RatFuncInfinityIntegralClosure K L) (RatFuncInfinityIntegralClosure K L) := Algebra.id (RatFuncInfinityIntegralClosure K L) let upperInfinityClosureLocalAlgebra : Algebra (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) := OreLocalization.instAlgebra - letI := upperInfinityClosureLocalAlgebra - letI : SMul (RatFuncInfinityIntegralClosure K L) + let := upperInfinityClosureLocalAlgebra + let : SMul (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) := upperInfinityClosureLocalAlgebra.toSMul - letI : Algebra K (FiniteExtensionInfinityPlaceLocalRing K L P) := + let : Algebra K (FiniteExtensionInfinityPlaceLocalRing K L P) := OreLocalization.instAlgebra - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsScalarTower K R L := by + let := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + let : FaithfulSMul R L := + (faithfulSMul_iff_algebraMap_injective R L).mpr (IsFractionRing.injective R L) + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext c symm @@ -149,7 +175,7 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap (K := K) (L := L) P) (algebraMap K A c)] exact (IsScalarTower.algebraMap_apply K A L c).symm - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot R obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R @@ -178,7 +204,9 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment apply finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative (K := K) (L := L) P (a * x.1) by_cases hx0 : x.1 = 0 - · simp [a, hx0, finiteExtensionInfinityPlaceLocalOrderTop] + · simp only [hx0, mul_zero, finiteExtensionInfinityPlaceLocalOrderTop] + erw [finitePlaceOrderTop_zero] + exact le_top · have hxmem := (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp x.2 rcases hxmem with hxmem | ⟨_, hxorders⟩ · exact (hx0 hxmem).elim @@ -329,39 +357,20 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment ext x rw [LinearMap.mem_ker, Submodule.mem_comap] exact hkerPoint x - letI : Finite (IsLocalRing.ResidueField R) := by - letI : Finite P.1.ResidueField := + let : Finite (IsLocalRing.ResidueField R) := by + let : Finite P.1.ResidueField := finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P change Finite (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField exact Finite.of_injective (infinityIncrementResidueFieldAlgEquiv K L P) (infinityIncrementResidueFieldAlgEquiv K L P).injective - letI : Module.Finite K (IsLocalRing.ResidueField R) := + let : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite - letI : Module.Finite K f.range := inferInstance - letI : Module.Finite K f.ker := by - rw [hker] - exact Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hST).symm - letI : Module.Finite K (T ⧸ f.ker) := - Module.Finite.equiv f.quotKerEquivRange.symm - letI hTFinite : Module.Finite K T := - Module.Finite.of_submodule_quotient f.ker - have hkerRank : Module.finrank K f.ker = Module.finrank K S := by - rw [hker] - exact (Submodule.comapSubtypeEquivOfLe hST).finrank_eq - constructor - · exact hTFinite - · calc - Module.finrank K T = - Module.finrank K f.range + Module.finrank K f.ker := - f.finrank_range_add_finrank_ker.symm - _ ≤ Module.finrank K (IsLocalRing.ResidueField R) + - Module.finrank K S := - Nat.add_le_add f.range.finrank_le (le_of_eq hkerRank) - _ = Module.finrank K S + - finiteExtensionPlaceDegree K L (.inr P) := by - rw [hResidueRank, Nat.add_comm] + have hbound := finite_and_finrank_le_of_residue_map S T hST f hker + refine ⟨hbound.1, ?_⟩ + rw [← hResidueRank] + exact hbound.2 end InfinityPlace From 5a071bf418c9d95faa0b1b955c1b2234d8629cf4 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:24:03 +0000 Subject: [PATCH 13/37] Factor exact constant extension different comparison --- ...ExactConstantExtensionFiniteDifferent.lean | 436 ++++++++++-------- 1 file changed, 238 insertions(+), 198 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean index 0c34f62239..0b17ca3431 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean @@ -49,6 +49,67 @@ private theorem finiteDifferentCanonicalFractionRing letI := finiteDifferentCanonicalFractionRingAlgebra R infer_instance +private theorem different_eq_map_of_disjoint_fields + (A B R₁ R₂ K L : Type*) + [CommRing A] [IsDomain A] [IsIntegrallyClosed A] + [CommRing B] [IsDedekindDomain B] + [CommRing R₁] [IsDedekindDomain R₁] + [CommRing R₂] [IsDedekindDomain R₂] [Field K] [Field L] + [Algebra A K] [IsFractionRing A K] [Algebra B L] [IsFractionRing B L] + [Algebra A L] [Algebra K L] [FiniteDimensional K L] [Algebra.IsSeparable K L] + [IsScalarTower A K L] [Algebra A B] [IsScalarTower A B L] + [FaithfulSMul A B] [Module.Finite A B] [Module.IsTorsionFree A B] + [Algebra A R₁] [Algebra A R₂] [Algebra R₁ B] [Algebra R₂ B] + [Algebra R₁ L] [Algebra R₂ L] + [IsScalarTower A R₁ L] [IsScalarTower R₁ B L] [IsScalarTower R₂ B L] + [Module.Finite A R₁] [Module.Finite A R₂] [Module.Free A R₂] + [Module.Finite R₁ B] [Module.Finite R₂ B] + [IsScalarTower A R₁ B] [IsScalarTower A R₂ B] + [Module.IsTorsionFree A R₁] [Module.IsTorsionFree A R₂] + [Module.IsTorsionFree R₁ B] [Module.IsTorsionFree R₂ B] + [IsIntegralClosure B R₁ L] + (F₁ F₂ : IntermediateField K L) + [Algebra R₁ F₁] [Algebra R₂ F₂] [Module.IsTorsionFree R₁ F₁] + [IsFractionRing R₁ F₁] [IsFractionRing R₂ F₂] + [IsScalarTower A F₂ L] [IsScalarTower A R₂ F₂] + [IsScalarTower R₁ F₁ L] [IsScalarTower R₂ F₂ L] + [Algebra.IsSeparable K F₂] [Algebra.IsSeparable F₁ L] + [IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂] + (hdisjoint : F₁.LinearDisjoint F₂) (hsup : F₁ ⊔ F₂ = ⊤) + (hcoprime : IsCoprime + ((differentIdeal A R₁).map (algebraMap R₁ B)) + ((differentIdeal A R₂).map (algebraMap R₂ B))) : + differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by + let : Algebra A (FractionRing A) := finiteDifferentCanonicalFractionRingAlgebra A + let : SMul A (FractionRing A) := Algebra.toSMul + let : IsFractionRing A (FractionRing A) := finiteDifferentCanonicalFractionRing A + let : Algebra B (FractionRing B) := finiteDifferentCanonicalFractionRingAlgebra B + let : SMul B (FractionRing B) := Algebra.toSMul + let : IsFractionRing B (FractionRing B) := finiteDifferentCanonicalFractionRing B + let : Algebra A (FractionRing B) := + RingHom.toAlgebra ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + let : SMul A (FractionRing B) := Algebra.toSMul + let : IsScalarTower A B (FractionRing B) := IsScalarTower.of_algebraMap_eq' rfl + let : FaithfulSMul A (FractionRing B) := by + rw [faithfulSMul_iff_algebraMap_injective] + change Function.Injective + ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + exact (IsFractionRing.injective B (FractionRing B)).comp + (FaithfulSMul.algebraMap_injective A B) + let : Algebra (FractionRing A) (FractionRing B) := FractionRing.liftAlgebra A (FractionRing B) + let : SMul (FractionRing A) (FractionRing B) := Algebra.toSMul + let : IsScalarTower A (FractionRing A) (FractionRing B) := + FractionRing.isScalarTower_liftAlgebra A (FractionRing B) + let : Algebra.IsSeparable (FractionRing A) (FractionRing B) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv A K).symm.toRingEquiv + (FractionRing.algEquiv B L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv A K).symm (FractionRing.algEquiv B L).symm z + exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal + (K := K) (L := L) (F₁ := F₁) (F₂ := F₂) A B R₁ R₂ hdisjoint hsup hcoprime + variable (C S N : Type*) [Field C] [Field S] [Field N] [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] @@ -213,6 +274,64 @@ theorem exactConstantExtension_rationalFunctionRanges_linearDisjoint : exact hfinL exact ⟨hdisjoint, hsup⟩ +private theorem normalization_finite_and_torsionFree + [Fintype C] [Finite S] : + let L := ExactConstantExtension C N S + let R₂ := integralClosure C[X] N + let B := integralClosure S[X] L + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra S[X] L := constantExtensionTensorPolynomialAlgebra C S N + let : Algebra R₂ B := exactConstantExtensionFiniteNormalizationAlgebra C S N + let : SMul R₂ B := Algebra.toSMul + let : Module R₂ B := Algebra.toModule + Module.Finite R₂ B ∧ Module.IsTorsionFree R₂ B := by + intro L R₂ B field polynomial normalization scalar module + let : IsDomain R₂ := inferInstance + let : IsDomain B := inferInstance + let : Algebra R₂ (S ⊗[C] R₂) := + Algebra.TensorProduct.rightAlgebra + let : SMul R₂ (S ⊗[C] R₂) := Algebra.toSMul + let : Module R₂ (S ⊗[C] R₂) := Algebra.toModule + let : Algebra R₂ (R₂ ⊗[C] S) := + Algebra.TensorProduct.leftAlgebra + let : SMul R₂ (R₂ ⊗[C] S) := Algebra.toSMul + let : Module R₂ (R₂ ⊗[C] S) := Algebra.toModule + let eSwap : R₂ ⊗[C] S ≃ₐ[R₂] S ⊗[C] R₂ := + { (Algebra.TensorProduct.comm C R₂ S).toRingEquiv with + commutes' := fun r => by + change (Algebra.TensorProduct.comm C R₂ S) + (r ⊗ₜ[C] (1 : S)) = (1 : S) ⊗ₜ[C] r + rfl } + let : Module.Finite R₂ (R₂ ⊗[C] S) := + Module.Finite.base_change C R₂ S + let : Module.Finite R₂ (S ⊗[C] R₂) := + Module.Finite.equiv eSwap.toLinearEquiv + let eNorm : S ⊗[C] R₂ ≃+* B := + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + let : Algebra R₂ B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + let : SMul R₂ B := Algebra.toSMul + let : Module R₂ B := Algebra.toModule + let eNormR₂ : S ⊗[C] R₂ ≃ₐ[R₂] B := + { eNorm with + commutes' := fun r => by + change eNorm (1 ⊗ₜ[C] r) = + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + (1 ⊗ₜ[C] r) + rfl } + let : Module.Finite R₂ B := + Module.Finite.equiv eNormR₂.toLinearEquiv + let : Module.IsTorsionFree R₂ B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + (eNorm.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R₂)).toRingHom) + exact eNorm.injective.comp + (Algebra.TensorProduct.includeRight_injective + (R := C) (A := S) (B := R₂) (algebraMap C S).injective) + exact ⟨inferInstance, inferInstance⟩ + /-- In an exact finite constant extension, the different of the extended finite normalization is the extension of the original finite different. The map on ideals is the right-factor map supplied by @@ -222,20 +341,20 @@ theorem exactConstantExtension_finiteDifferent_eq_map let L := ExactConstantExtension C N S let R₂ := integralClosure C[X] N let B := integralClosure S[X] L - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra S[X] L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra S[X] L := constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] L := Algebra.toSMul - letI : Module S[X] L := Algebra.toModule - letI : Algebra (RatFunc S) L := + let : SMul S[X] L := Algebra.toSMul + let : Module S[X] L := Algebra.toModule + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : Algebra S[X] (RatFunc S) := + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc S) L := Algebra.toModule + let : Algebra S[X] (RatFunc S) := finiteDifferentCanonicalRatFuncPolynomialAlgebra S - letI : IsFractionRing S[X] (RatFunc S) := + let : IsFractionRing S[X] (RatFunc S) := finiteDifferentCanonicalRatFuncPolynomialFractionRing S - letI : IsScalarTower S[X] (RatFunc S) L := + let : IsScalarTower S[X] (RatFunc S) L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -244,101 +363,94 @@ theorem exactConstantExtension_finiteDifferent_eq_map (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : Module.IsTorsionFree S[X] L := by + let : Module.IsTorsionFree S[X] L := by rw [Module.isTorsionFree_iff_algebraMap_injective] intro p q hpq apply RatFunc.algebraMap_injective S apply (algebraMap (RatFunc S) L).injective simpa only [IsScalarTower.algebraMap_apply S[X] (RatFunc S) L] using hpq - letI : FiniteDimensional (RatFunc S) L := + let : FiniteDimensional (RatFunc S) L := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) L := + let : Algebra.IsSeparable (RatFunc S) L := isSeparable_over_extendedRatFunc C S N hExact - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) L B - letI : Module.IsTorsionFree S[X] B := + let : Module.IsTorsionFree S[X] B := IsIntegralClosure.isTorsionFree S[X] L - letI : Algebra C[X] (RatFunc C) := + let : Algebra C[X] (RatFunc C) := finiteDifferentCanonicalRatFuncPolynomialAlgebra C - letI : IsFractionRing C[X] (RatFunc C) := + let : IsFractionRing C[X] (RatFunc C) := finiteDifferentCanonicalRatFuncPolynomialFractionRing C - letI : IsScalarTower C[X] (RatFunc C) N := + let : IsScalarTower C[X] (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : IsDedekindDomain R₂ := + let : IsDedekindDomain R₂ := IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R₂ - letI : Module.IsTorsionFree C[X] N := by + let : Module.IsTorsionFree C[X] N := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective ((algebraMap (RatFunc C) N).comp (algebraMap C[X] (RatFunc C))) exact (algebraMap (RatFunc C) N).injective.comp (RatFunc.algebraMap_injective C) - letI : Module.IsTorsionFree C[X] R₂ := + let : Module.IsTorsionFree C[X] R₂ := IsIntegralClosure.isTorsionFree C[X] N - letI : Algebra R₂ B := + let : Algebra R₂ B := exactConstantExtensionFiniteNormalizationAlgebra C S N differentIdeal S[X] B = Ideal.map (algebraMap R₂ B) (differentIdeal C[X] R₂) := by - let L := ExactConstantExtension C N S - let R₂ := integralClosure C[X] N - let B := integralClosure S[X] L - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra S[X] L := - constantExtensionTensorPolynomialAlgebra C S N - letI : IsDomain R₂ := inferInstance - letI : IsDomain B := inferInstance - letI : SMul S[X] L := Algebra.toSMul - letI : Module S[X] L := Algebra.toModule - letI : Algebra (RatFunc C) L := + intro L R₂ B model0 model1 model2 model3 model4 model5 model6 model7 model8 model9 model10 model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 model21 + let : IsDomain R₂ := inferInstance + let : IsDomain B := inferInstance + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) L := Algebra.toSMul - letI : Module (RatFunc C) L := Algebra.toModule - letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction - letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : SMul N L := Algebra.toSMul - letI : Module N L := Algebra.toModule - letI : IsScalarTower (RatFunc C) N L := + let : SMul (RatFunc C) L := Algebra.toSMul + let : Module (RatFunc C) L := Algebra.toModule + let : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + let : MulAction (RatFunc C) L := DistribMulAction.toMulAction + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : SMul N L := Algebra.toSMul + let : Module N L := Algebra.toModule + let : IsScalarTower (RatFunc C) N L := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule - letI : Algebra (RatFunc S) L := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : Module (RatFunc C) (RatFunc S) := Algebra.toModule + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : IsScalarTower (RatFunc C) (RatFunc S) L := + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc S) L := Algebra.toModule + let : IsScalarTower (RatFunc C) (RatFunc S) L := rationalBase_scalarTower C S N hExact - letI : Algebra C[X] (RatFunc C) := + let : Algebra C[X] (RatFunc C) := finiteDifferentCanonicalRatFuncPolynomialAlgebra C - letI : IsFractionRing C[X] (RatFunc C) := + let : IsFractionRing C[X] (RatFunc C) := finiteDifferentCanonicalRatFuncPolynomialFractionRing C - letI : IsScalarTower C[X] (RatFunc C) N := + let : IsScalarTower C[X] (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra C[X] L := + let : Algebra C[X] L := RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp (algebraMap C[X] (RatFunc C))) - letI : SMul C[X] L := Algebra.toSMul - letI : Module C[X] L := Algebra.toModule - letI : IsScalarTower C[X] (RatFunc C) L := + let : SMul C[X] L := Algebra.toSMul + let : Module C[X] L := Algebra.toModule + let : IsScalarTower C[X] (RatFunc C) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra C[X] B := + let : Algebra C[X] B := RingHom.toAlgebra ((algebraMap S[X] B).comp (algebraMap C[X] S[X])) - letI : SMul C[X] B := Algebra.toSMul - letI : Module C[X] B := Algebra.toModule - letI : IsScalarTower C[X] S[X] B := + let : SMul C[X] B := Algebra.toSMul + let : Module C[X] B := Algebra.toModule + let : IsScalarTower C[X] S[X] B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower S[X] B L := + let : IsScalarTower S[X] B L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra S[X] (RatFunc S) := + let : Algebra S[X] (RatFunc S) := finiteDifferentCanonicalRatFuncPolynomialAlgebra S - letI : IsFractionRing S[X] (RatFunc S) := + let : IsFractionRing S[X] (RatFunc S) := finiteDifferentCanonicalRatFuncPolynomialFractionRing S - letI : IsScalarTower S[X] (RatFunc S) L := + let : IsScalarTower S[X] (RatFunc S) L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -346,7 +458,7 @@ theorem exactConstantExtension_finiteDifferent_eq_map ratFuncToExactConstantExtension C S N hExact (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : IsScalarTower C[X] S[X] L := + let : IsScalarTower C[X] S[X] L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -357,44 +469,44 @@ theorem exactConstantExtension_finiteDifferent_eq_map rw [rationalBase_algebraMap_eq C S N hExact] apply congrArg (algebraMap (RatFunc S) L) exact ratFuncCoefficientAlgHom_algebraMap C S p) - letI : IsScalarTower C[X] B L := + let : IsScalarTower C[X] B L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p change algebraMap C[X] L p = algebraMap S[X] L (algebraMap C[X] S[X] p) exact IsScalarTower.algebraMap_apply C[X] S[X] L p) - letI : SMul C[X] S[X] := Algebra.toSMul - letI : Module C[X] S[X] := Algebra.toModule - letI : Module.Finite C[X] (C[X] ⊗[C] S) := + let : SMul C[X] S[X] := Algebra.toSMul + let : Module C[X] S[X] := Algebra.toModule + let : Module.Finite C[X] (C[X] ⊗[C] S) := Module.Finite.base_change C C[X] S - letI : Module.Finite C[X] S[X] := + let : Module.Finite C[X] S[X] := Module.Finite.equiv (Algebra.IsPushout.equiv C C[X] S S[X]).toLinearEquiv - letI : Module.IsTorsionFree C[X] S[X] := by + let : Module.IsTorsionFree C[X] S[X] := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective (Polynomial.map (algebraMap C S)) exact Polynomial.map_injective (algebraMap C S) (algebraMap C S).injective - letI : Module.Free C[X] S[X] := + let : Module.Free C[X] S[X] := Module.free_of_finite_type_torsion_free' - letI : Module.IsTorsionFree S[X] L := by + let : Module.IsTorsionFree S[X] L := by rw [Module.isTorsionFree_iff_algebraMap_injective] intro p q hpq apply RatFunc.algebraMap_injective S apply (algebraMap (RatFunc S) L).injective simpa only [IsScalarTower.algebraMap_apply S[X] (RatFunc S) L] using hpq - letI : FiniteDimensional (RatFunc S) L := + let : FiniteDimensional (RatFunc S) L := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) L := + let : Algebra.IsSeparable (RatFunc S) L := isSeparable_over_extendedRatFunc C S N hExact let eNL := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N L := Module.Finite.equiv eNL - letI : FiniteDimensional (RatFunc C) L := + let : Module.Finite N L := Module.Finite.equiv eNL + let : FiniteDimensional (RatFunc C) L := Module.Finite.trans N L - letI : Algebra.IsSeparable (RatFunc C) L := + let : Algebra.IsSeparable (RatFunc C) L := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let f₁ : RatFunc S →ₐ[RatFunc C] L := IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L @@ -404,40 +516,40 @@ theorem exactConstantExtension_finiteDifferent_eq_map let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange - letI : Algebra S[X] F₁ := + let : Algebra S[X] F₁ := RingHom.toAlgebra (e₁.toRingEquiv.toRingHom.comp (algebraMap S[X] (RatFunc S))) - letI : SMul S[X] F₁ := Algebra.toSMul - letI : Module S[X] F₁ := Algebra.toModule + let : SMul S[X] F₁ := Algebra.toSMul + let : Module S[X] F₁ := Algebra.toModule let e₁poly : RatFunc S ≃ₐ[S[X]] F₁ := { e₁.toRingEquiv with commutes' := fun _ => rfl } - letI : IsFractionRing S[X] F₁ := + let : IsFractionRing S[X] F₁ := IsFractionRing.of_algEquiv e₁poly - letI : Module.IsTorsionFree S[X] F₁ := by + let : Module.IsTorsionFree S[X] F₁ := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact IsFractionRing.injective S[X] F₁ - letI : Algebra R₂ F₂ := + let : Algebra R₂ F₂ := RingHom.toAlgebra (e₂.toRingEquiv.toRingHom.comp (algebraMap R₂ N)) - letI : SMul R₂ F₂ := Algebra.toSMul - letI : Module R₂ F₂ := Algebra.toModule + let : SMul R₂ F₂ := Algebra.toSMul + let : Module R₂ F₂ := Algebra.toModule let e₂norm : N ≃ₐ[R₂] F₂ := { e₂.toRingEquiv with commutes' := fun _ => rfl } - letI : Algebra R₂ L := + let : Algebra R₂ L := RingHom.toAlgebra ((algebraMap F₂ L).comp (algebraMap R₂ F₂)) - letI : SMul R₂ L := Algebra.toSMul - letI : Module R₂ L := Algebra.toModule - letI : IsScalarTower R₂ F₂ L := + let : SMul R₂ L := Algebra.toSMul + let : Module R₂ L := Algebra.toModule + let : IsScalarTower R₂ F₂ L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing R₂ N := + let : IsFractionRing R₂ N := IsIntegralClosure.isFractionRing_of_finite_extension C[X] (RatFunc C) N R₂ - letI : IsFractionRing R₂ F₂ := + let : IsFractionRing R₂ F₂ := IsFractionRing.of_algEquiv e₂norm - letI : Algebra C[X] F₂ := IntermediateField.algebra' F₂ - letI : SMul C[X] F₂ := Algebra.toSMul - letI : IsScalarTower C[X] R₂ F₂ := + let : Algebra C[X] F₂ := IntermediateField.algebra' F₂ + let : SMul C[X] F₂ := Algebra.toSMul + let : IsScalarTower C[X] R₂ F₂ := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -447,9 +559,9 @@ theorem exactConstantExtension_finiteDifferent_eq_map algebraMap N L (algebraMap C[X] N p) rw [IsScalarTower.algebraMap_apply C[X] (RatFunc C) N] exact IsScalarTower.algebraMap_apply (RatFunc C) N L _) - letI : IsScalarTower C[X] F₂ L := + let : IsScalarTower C[X] F₂ L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower C[X] R₂ L := + let : IsScalarTower C[X] R₂ L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -458,54 +570,18 @@ theorem exactConstantExtension_finiteDifferent_eq_map (algebraMap R₂ F₂ (algebraMap C[X] R₂ p)) rw [← IsScalarTower.algebraMap_apply C[X] R₂ F₂] exact IsScalarTower.algebraMap_apply C[X] F₂ L p) - letI : IsLocalization + let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors C[X])) N := IsIntegralClosure.isLocalization C[X] (RatFunc C) N R₂ - letI : IsLocalization + let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors C[X])) F₂ := IsLocalization.isLocalization_of_algEquiv _ e₂norm - letI : Algebra R₂ (S ⊗[C] R₂) := - Algebra.TensorProduct.rightAlgebra - letI : SMul R₂ (S ⊗[C] R₂) := Algebra.toSMul - letI : Module R₂ (S ⊗[C] R₂) := Algebra.toModule - letI : Algebra R₂ (R₂ ⊗[C] S) := - Algebra.TensorProduct.leftAlgebra - letI : SMul R₂ (R₂ ⊗[C] S) := Algebra.toSMul - letI : Module R₂ (R₂ ⊗[C] S) := Algebra.toModule - let eSwap : R₂ ⊗[C] S ≃ₐ[R₂] S ⊗[C] R₂ := - { (Algebra.TensorProduct.comm C R₂ S).toRingEquiv with - commutes' := fun r => by - change (Algebra.TensorProduct.comm C R₂ S) - (r ⊗ₜ[C] (1 : S)) = (1 : S) ⊗ₜ[C] r - rfl } - letI : Module.Finite R₂ (R₂ ⊗[C] S) := - Module.Finite.base_change C R₂ S - letI : Module.Finite R₂ (S ⊗[C] R₂) := - Module.Finite.equiv eSwap.toLinearEquiv - let eNorm : S ⊗[C] R₂ ≃+* B := - finiteFieldConstantExtensionIntegralClosureRingEquiv C S N - letI : Algebra R₂ B := - exactConstantExtensionFiniteNormalizationAlgebra C S N - letI : SMul R₂ B := Algebra.toSMul - letI : Module R₂ B := Algebra.toModule - let eNormR₂ : S ⊗[C] R₂ ≃ₐ[R₂] B := - { eNorm with - commutes' := fun r => by - change eNorm (1 ⊗ₜ[C] r) = - finiteFieldConstantExtensionIntegralClosureRingEquiv C S N - (1 ⊗ₜ[C] r) - rfl } - letI : Module.Finite R₂ B := - Module.Finite.equiv eNormR₂.toLinearEquiv - letI : Module.IsTorsionFree R₂ B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - change Function.Injective - (eNorm.toRingHom.comp - (Algebra.TensorProduct.includeRight - (R := C) (A := S) (B := R₂)).toRingHom) - exact eNorm.injective.comp - (Algebra.TensorProduct.includeRight_injective - (R := C) (A := S) (B := R₂) (algebraMap C S).injective) + let : Algebra R₂ B := exactConstantExtensionFiniteNormalizationAlgebra C S N + let : SMul R₂ B := Algebra.toSMul + let : Module R₂ B := Algebra.toModule + have hnormalization := normalization_finite_and_torsionFree C S N hExact + let : Module.Finite R₂ B := hnormalization.1 + let : Module.IsTorsionFree R₂ B := hnormalization.2 have hR₂BL : (algebraMap R₂ L) = (algebraMap B L).comp (algebraMap R₂ B) := by @@ -516,9 +592,9 @@ theorem exactConstantExtension_finiteDifferent_eq_map exact (finiteFieldConstantExtensionIntegralClosureRingEquiv_tmul C S N 1 r).symm - letI : IsScalarTower R₂ B L := + let : IsScalarTower R₂ B L := IsScalarTower.of_algebraMap_eq' hR₂BL - letI : IsScalarTower C[X] R₂ B := + let : IsScalarTower C[X] R₂ B := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -536,21 +612,21 @@ theorem exactConstantExtension_finiteDifferent_eq_map _ = algebraMap B L (algebraMap R₂ B (algebraMap C[X] R₂ p)) := IsScalarTower.algebraMap_apply R₂ B L _) - letI : Module.Finite C[X] R₂ := + let : Module.Finite C[X] R₂ := IsIntegralClosure.finite C[X] (RatFunc C) N R₂ - letI : Module.IsTorsionFree C[X] N := by + let : Module.IsTorsionFree C[X] N := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective ((algebraMap (RatFunc C) N).comp (algebraMap C[X] (RatFunc C))) exact (algebraMap (RatFunc C) N).injective.comp (RatFunc.algebraMap_injective C) - letI : Module.IsTorsionFree C[X] R₂ := + let : Module.IsTorsionFree C[X] R₂ := IsIntegralClosure.isTorsionFree C[X] N - letI : Module.Free C[X] R₂ := + let : Module.Free C[X] R₂ := Module.free_of_finite_type_torsion_free' - letI : Module.Finite C[X] B := Module.Finite.trans R₂ B - letI : Module.IsTorsionFree C[X] B := by + let : Module.Finite C[X] B := Module.Finite.trans R₂ B + let : Module.IsTorsionFree C[X] B := by rw [Module.isTorsionFree_iff_algebraMap_injective] intro p q hpq have hinj : Function.Injective (algebraMap C[X] L) := by @@ -562,63 +638,28 @@ theorem exactConstantExtension_finiteDifferent_eq_map apply hinj simpa only [IsScalarTower.algebraMap_apply C[X] B L] using congrArg (algebraMap B L) hpq - letI : FaithfulSMul C[X] B := by + let : FaithfulSMul C[X] B := by rw [faithfulSMul_iff_algebraMap_injective] exact Module.isTorsionFree_iff_algebraMap_injective.mp (show Module.IsTorsionFree C[X] B from inferInstance) - letI : IsScalarTower S[X] F₁ L := + let : IsScalarTower S[X] F₁ L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p change algebraMap S[X] L p = f₁ (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : Algebra.IsSeparable (RatFunc C) F₂ := inferInstance - letI : Algebra.IsSeparable F₁ L := inferInstance - letI : IsIntegralClosure B S[X] L := inferInstance - letI : IsFractionRing B L := + let : Algebra.IsSeparable (RatFunc C) F₂ := inferInstance + let : Algebra.IsSeparable F₁ L := inferInstance + let : IsIntegralClosure B S[X] L := inferInstance + let : IsFractionRing B L := IsIntegralClosure.isFractionRing_of_finite_extension S[X] F₁ L B - letI : Algebra C[X] (FractionRing C[X]) := - finiteDifferentCanonicalFractionRingAlgebra C[X] - letI : SMul C[X] (FractionRing C[X]) := Algebra.toSMul - letI : IsFractionRing C[X] (FractionRing C[X]) := - finiteDifferentCanonicalFractionRing C[X] - letI : Algebra B (FractionRing B) := - finiteDifferentCanonicalFractionRingAlgebra B - letI : SMul B (FractionRing B) := Algebra.toSMul - letI : IsFractionRing B (FractionRing B) := - finiteDifferentCanonicalFractionRing B - letI : Algebra C[X] (FractionRing B) := - RingHom.toAlgebra - ((algebraMap B (FractionRing B)).comp (algebraMap C[X] B)) - letI : SMul C[X] (FractionRing B) := Algebra.toSMul - letI : IsScalarTower C[X] B (FractionRing B) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FaithfulSMul C[X] (FractionRing B) := by - rw [faithfulSMul_iff_algebraMap_injective] - change Function.Injective - ((algebraMap B (FractionRing B)).comp (algebraMap C[X] B)) - exact (IsFractionRing.injective B (FractionRing B)).comp - (FaithfulSMul.algebraMap_injective C[X] B) - letI : Algebra (FractionRing C[X]) (FractionRing B) := - FractionRing.liftAlgebra C[X] (FractionRing B) - letI : SMul (FractionRing C[X]) (FractionRing B) := Algebra.toSMul - letI : IsScalarTower C[X] (FractionRing C[X]) (FractionRing B) := - FractionRing.isScalarTower_liftAlgebra C[X] (FractionRing B) - letI : Algebra.IsSeparable (FractionRing C[X]) (FractionRing B) := by - refine Algebra.IsSeparable.of_equiv_equiv - (FractionRing.algEquiv C[X] (RatFunc C)).symm.toRingEquiv - (FractionRing.algEquiv B L).symm.toRingEquiv ?_ - ext z - exact IsFractionRing.algEquiv_commutes - (FractionRing.algEquiv C[X] (RatFunc C)).symm - (FractionRing.algEquiv B L).symm z - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain S[X] F₁ L B - letI : IsDedekindDomain R₂ := + let : IsDedekindDomain R₂ := IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R₂ - letI : Module.Finite S[X] B := + let : Module.Finite S[X] B := IsIntegralClosure.finite S[X] F₁ L B - letI : Module.IsTorsionFree S[X] B := + let : Module.IsTorsionFree S[X] B := IsIntegralClosure.isTorsionFree S[X] L have hranges := exactConstantExtension_rationalFunctionRanges_linearDisjoint C S N hExact @@ -635,11 +676,10 @@ theorem exactConstantExtension_finiteDifferent_eq_map apply Ideal.isCoprime_iff_sup_eq.mpr exact top_sup_eq (Ideal.map (algebraMap R₂ B) (differentIdeal C[X] R₂)) - letI : IsScalarTower C[X] F₂ L := + let : IsScalarTower C[X] F₂ L := IsScalarTower.of_algebraMap_eq' rfl - exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal - (K := RatFunc C) (L := L) (F₁ := F₁) (F₂ := F₂) - C[X] B S[X] R₂ hdisjoint hsup hcoprime + exact different_eq_map_of_disjoint_fields C[X] B S[X] R₂ (RatFunc C) L + F₁ F₂ hdisjoint hsup hcoprime end From 882977b698ce791c0bad0d25729cb2f5751ba6fe Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:28:56 +0000 Subject: [PATCH 14/37] Factor valuation-center and residue-degree comparisons --- .../SquareExtensionAffinePlaces.lean | 531 +++++++++--------- 1 file changed, 266 insertions(+), 265 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean index c7e650d237..b9e9e4887b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean @@ -35,6 +35,127 @@ open scoped BigOperators nonZeroDivisors Polynomial noncomputable section +private theorem exists_dominatingPlace_of_nonzero_nonunit + {A P E : Type*} [CommRing A] [IsDomain A] [CommRing P] [Field E] + [Algebra A E] [IsFractionRing A E] [Algebra P E] + [IsDedekindDomain (integralClosure P E)] [IsFractionRing (integralClosure P E) E] + (m : MaximalSpectrum A) + (hbase : ∀ x : P, algebraMap P E x ∈ (algebraMap A E).range) + (b : integralClosure P E) (hb : b ≠ 0) + (hunit : (b : E) ∈ (dominatingValuationSubring (L := E) m).nonunits) : + ∃ q : HeightOneSpectrum (integralClosure P E), + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q = + dominatingValuationSubring (L := E) m := by + let V := dominatingValuationSubring (L := E) m + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨(b : E), Subtype.coe_ne_coe.mpr hb, hunit⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hbMem : b ∈ dominatingIntegralClosurePrime m hbase := by + change integralClosureToDominatingValuationSubring m hbase b ∈ + IsLocalRing.maximalIdeal V + exact ValuationSubring.coe_mem_nonunits_iff.mp hunit + have hne : dominatingIntegralClosurePrime m hbase ≠ ⊥ := by + intro hbot + apply hb + simpa only [hbot, Ideal.mem_bot] using hbMem + exact ⟨dominatingIntegralClosurePlace m hbase hne, + valuationSubringAt_dominatingIntegralClosurePlace_eq m hbase hne hV⟩ + +private theorem exists_dominatingPlace_of_base_element + {A P E : Type*} [CommRing A] [IsDomain A] [CommRing P] [Field E] + [Algebra A E] [IsFractionRing A E] [Algebra P E] + [IsDedekindDomain (integralClosure P E)] [IsFractionRing (integralClosure P E) E] + (m : MaximalSpectrum A) + (hbase : ∀ x : P, algebraMap P E x ∈ (algebraMap A E).range) + (hinj : Function.Injective (algebraMap P E)) + (p : P) (hp : p ≠ 0) (r : A) (hr : r ∈ m.asIdeal) + (hmap : algebraMap P E p = algebraMap A E r) : + ∃ q : HeightOneSpectrum (integralClosure P E), + IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q = + dominatingValuationSubring (L := E) m := by + let b := algebraMap P (integralClosure P E) p + have hb : b ≠ 0 := by + intro h + apply hp + apply hinj + have h' := congrArg (algebraMap (integralClosure P E) E) h + simpa only [b, map_zero, ← IsScalarTower.algebraMap_apply] using h' + apply exists_dominatingPlace_of_nonzero_nonunit m hbase b hb + change algebraMap P E p ∈ (dominatingValuationSubring (L := E) m).nonunits + rw [hmap] + exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem m r hr + +private theorem residue_finrank_le_of_dominating_valuation + {K A E : Type*} [Field K] [CommRing A] [IsDomain A] [Field E] + [Algebra K A] [Algebra K E] [Algebra A E] [IsScalarTower K A E] + [IsFractionRing A E] (m : MaximalSpectrum A) (R : ValuationSubring E) + [Algebra K R] + [Module.Finite K (IsLocalRing.ResidueField R)] + (hscalar : ∀ c : K, (algebraMap K R c : E) = algebraMap K E c) + (hspec : R = dominatingValuationSubring (L := E) m) : + Module.finrank K m.asIdeal.ResidueField ≤ + Module.finrank K (IsLocalRing.ResidueField R) := by + let V := dominatingValuationSubring (A := A) (L := E) m + let eVR : V ≃+* R := + { toFun := fun x => ⟨x.1, by rw [hspec]; exact x.2⟩ + invFun := fun x => ⟨x.1, by + change x.1 ∈ dominatingValuationSubring m + rw [← hspec] + exact x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + let ψ : A →+* R := + eVR.toRingHom.comp + (coordinateRingToDominatingValuationSubring + (A := A) (L := E) m) + have hcenter : m.asIdeal = + Ideal.comap ψ (IsLocalRing.maximalIdeal R) := by + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := E)] + ext a + change coordinateRingToDominatingValuationSubring m a ∈ + IsLocalRing.maximalIdeal V ↔ + eVR (coordinateRingToDominatingValuationSubring m a) ∈ + IsLocalRing.maximalIdeal R + simp only [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact (not_congr (MulEquiv.isUnit_map (f := eVR.toMulEquiv))).symm + have hψcoe (a : A) : ((ψ a : R) : E) = algebraMap A E a := by + rfl + let θ : A →ₐ[K] IsLocalRing.ResidueField R := + { toRingHom := (IsLocalRing.residue R).comp ψ + commutes' := by + intro c + rw [IsScalarTower.algebraMap_apply K R + (IsLocalRing.ResidueField R)] + apply congrArg (IsLocalRing.residue R) + apply Subtype.ext + rw [hψcoe] + change algebraMap A E (algebraMap K A c) = (algebraMap K R c : E) + rw [← IsScalarTower.algebraMap_apply K A E] + exact (hscalar c).symm } + have hker : m.asIdeal = RingHom.ker θ := by + ext a + rw [RingHom.mem_ker] + change a ∈ m.asIdeal ↔ IsLocalRing.residue R (ψ a) = 0 + rw [IsLocalRing.residue_eq_zero_iff, hcenter] + rfl + let ι : m.asIdeal.ResidueField →ₐ[K] + IsLocalRing.ResidueField R := by + apply Ideal.ResidueField.liftₐ m.asIdeal θ hker.le + intro a ha + change IsUnit (θ a) + rw [isUnit_iff_ne_zero] + intro hzero + apply ha + rw [hker] + exact hzero + exact LinearMap.finrank_le_finrank_of_injective (f := ι.toLinearMap) ι.injective + variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] variable (p : ℕ) [Fact p.Prime] [CharP K p] @@ -92,9 +213,9 @@ def squareExtensionPointMaximalIdeal MaximalSpectrum (PlaneCurveCoordinateRing f) := by let φ := squareExtensionPointEval K p f z let R := φ.range - letI : Finite R := inferInstance - letI : IsDomain R := inferInstance - letI : Field R := IsField.toField (Finite.isField_of_domain R) + let : Finite R := inferInstance + let : IsDomain R := inferInstance + let : Field R := IsField.toField (Finite.isField_of_domain R) refine ⟨RingHom.ker φ, ?_⟩ rw [← AlgHom.ker_rangeRestrict φ] exact RingHom.ker_isMaximal_of_surjective φ.rangeRestrict.toRingHom @@ -204,10 +325,10 @@ theorem squareExtensionClosedPointFiber_card_le_residueDegree let zf : SquareExtensionClosedPointFiber K p f m := ⟨z, Subtype.ext hz⟩ let ι := squareExtensionFiberResidueAlgHom K p f m zf - letI : Finite m.1.asIdeal.ResidueField := + let : Finite m.1.asIdeal.ResidueField := Finite.of_injective ι ι.injective - letI : Fintype m.1.asIdeal.ResidueField := Fintype.ofFinite _ - letI : Module.Finite K m.1.asIdeal.ResidueField := + let : Fintype m.1.asIdeal.ResidueField := Fintype.ofFinite _ + let : Module.Finite K m.1.asIdeal.ResidueField := Module.Finite.of_fg_top (by rw [Submodule.fg_def] exact ⟨Set.univ, Set.finite_univ, by simp⟩) @@ -278,7 +399,7 @@ theorem squareExtensionFrobeniusElement_mem_pointMaximalIdeal planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - planeCurveCoordinate f 0 ∈ (squareExtensionPointMaximalIdeal K p f z).asIdeal := by - letI : Fintype (SquareExtension K p) := Fintype.ofFinite _ + let : Fintype (SquareExtension K p) := Fintype.ofFinite _ rw [squareExtensionPointMaximalIdeal_asIdeal] change squareExtensionPointEval K p f z (planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - @@ -289,6 +410,64 @@ theorem squareExtensionFrobeniusElement_mem_pointMaximalIdeal exact FiniteField.natCard_extension K p 2 rw [← hcard, FiniteField.pow_card, sub_self] +private theorem residue_finrank_le_finitePlace_degree + (K E A : Type*) [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] + [Field E] [Algebra (RatFunc K) E] [FiniteDimensional (RatFunc K) E] + [Algebra.IsSeparable (RatFunc K) E] [Algebra K E] + [IsScalarTower K (RatFunc K) E] + [CommRing A] [IsDomain A] [Algebra K A] [Algebra A E] + [IsScalarTower K A E] [IsFractionRing A E] + [IsDedekindDomain (RatFuncFiniteIntegralClosure K E)] + [IsFractionRing (RatFuncFiniteIntegralClosure K E) E] + (m : MaximalSpectrum A) (q : FiniteExtensionFinitePlace K E) + (hspec : IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q = + dominatingValuationSubring (L := E) m) : + Module.finrank K m.asIdeal.ResidueField ≤ finiteExtensionPlaceDegree K E (.inl q) := by + let : Algebra (Polynomial K) E := + RingHom.toAlgebra ((algebraMap (RatFunc K) E).comp + (algebraMap (Polynomial K) (RatFunc K))) + let : IsScalarTower (Polynomial K) (RatFunc K) E := IsScalarTower.of_algebraMap_eq' rfl + let B := RatFuncFiniteIntegralClosure K E + let : Algebra K B := + RingHom.toAlgebra + ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) + let : IsScalarTower K (Polynomial K) B := + IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K (Polynomial K) E := + IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, + IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] + rfl) + let : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + ext c + rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] + rfl) + let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q + let : Algebra K R := + RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) + let : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl + let e := atPrimeResidueAlgEquiv K B R q.asIdeal + have hplace : finiteExtensionPlaceDegree K E (.inl q) = + Module.finrank K q.asIdeal.ResidueField := + finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q + let : Module.Finite K q.asIdeal.ResidueField := + Module.finite_of_finrank_pos (by + rw [← hplace] + exact finiteExtensionPlaceDegree_pos K E (.inl q)) + let : Module.Finite K (IsLocalRing.ResidueField R) := + Module.Finite.equiv e.toLinearEquiv + have hle : Module.finrank K m.asIdeal.ResidueField ≤ + Module.finrank K (IsLocalRing.ResidueField R) := + residue_finrank_le_of_dominating_valuation m R (fun c => by + change algebraMap B E (algebraMap K B c) = algebraMap K E c + exact (IsScalarTower.algebraMap_apply K B E c).symm) hspec + have heq : Module.finrank K (IsLocalRing.ResidueField R) = + Module.finrank K q.asIdeal.ResidueField := + e.symm.toLinearEquiv.finrank_eq + rw [hplace, ← heq] + exact hle + omit [DecidableEq K] in /-- Every base closed affine centre arising from a quadratic-extension point has an exhaustive finite place above it. -/ @@ -297,26 +476,26 @@ theorem exists_squareExtensionClosedPoint_exhaustiveFinitePlace (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : SquareExtensionClosedPoint K p f) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsDedekindDomain + let : IsDedekindDomain (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) - letI : IsFractionRing + let : IsFractionRing (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) (PlaneCurveFunctionField f) := integralClosure.isFractionRing_of_finite_extension (RatFunc K) @@ -326,32 +505,7 @@ theorem exists_squareExtensionClosedPoint_exhaustiveFinitePlace IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime (PlaneCurveFunctionField f) q = dominatingValuationSubring m.1 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : IsDedekindDomain - (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) := - integralClosure.isDedekindDomain (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) - letI : IsFractionRing - (integralClosure (Polynomial K) (PlaneCurveFunctionField f)) - (PlaneCurveFunctionField f) := - integralClosure.isFractionRing_of_finite_extension (RatFunc K) - (PlaneCurveFunctionField f) + intro inst hx alg poly tower finite separable dedekind fraction let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f let B := integralClosure (Polynomial K) E @@ -362,7 +516,6 @@ theorem exists_squareExtensionClosedPoint_exhaustiveFinitePlace let r : A := planeCurveCoordinate f 0 ^ (Nat.card K) ^ 2 - planeCurveCoordinate f 0 let P : Polynomial K := Polynomial.X ^ (Nat.card K) ^ 2 - Polynomial.X - let b : B := algebraMap (Polynomial K) B P obtain ⟨z, hz⟩ := m.2 have hm : squareExtensionPointMaximalIdeal K p f z = m.1 := hz have hr : r ∈ m.1.asIdeal := by @@ -380,58 +533,17 @@ theorem exists_squareExtensionClosedPoint_exhaustiveFinitePlace (fun h : Polynomial K →+* E => h P) (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) - simpa [P] using hcomp - have hfun0 : planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - - planeCurveFunction f 0 ≠ 0 := by - intro hzero - apply hP0 - apply (transcendental_iff.mp hx) P - simpa [P] using hzero + simpa only [P, RingHom.comp_apply, map_sub, map_pow, + Polynomial.coe_eval₂RingHom, Polynomial.eval₂_X] using hcomp have hrMap : algebraMap A E r = planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - planeCurveFunction f 0 := by simp only [r, map_sub, map_pow] rfl - have hbMap : algebraMap B E b = - planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - - planeCurveFunction f 0 := by - rw [show algebraMap B E b = algebraMap (Polynomial K) E P by - exact IsScalarTower.algebraMap_apply (Polynomial K) B E P] - exact hPMap - have hb0 : b ≠ 0 := by - intro hb - apply hfun0 - rw [← hbMap, hb, map_zero] - have hnonunits : - planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - - planeCurveFunction f 0 ∈ V.nonunits := by - rw [← hrMap] - exact algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) m.1 r hr - have hV : V ≠ ⊤ := by - intro htop - have hnontrivial : V.valuation.IsNontrivial := - (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 - ⟨planeCurveFunction f 0 ^ (Nat.card K) ^ 2 - - planeCurveFunction f 0, hfun0, hnonunits⟩ - exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial - have hbMem : b ∈ dominatingIntegralClosurePrime m.1 hbase := by - change integralClosureToDominatingValuationSubring m.1 hbase b ∈ - IsLocalRing.maximalIdeal V - apply ValuationSubring.coe_mem_nonunits_iff.mp - have hcoe : - ((integralClosureToDominatingValuationSubring - m.1 hbase b : V) : E) = algebraMap B E b := by - rfl - rw [hcoe, hbMap] - exact hnonunits - have hqne : dominatingIntegralClosurePrime m.1 hbase ≠ ⊥ := by - intro hbot - have : b = 0 := by simpa [hbot] using hbMem - exact hb0 this - exact ⟨dominatingIntegralClosurePlace m.1 hbase hqne, - valuationSubringAt_dominatingIntegralClosurePlace_eq - m.1 hbase hqne hV⟩ + have hinj : Function.Injective (algebraMap (Polynomial K) E) := + (algebraMap (RatFunc K) E).injective.comp (RatFunc.algebraMap_injective K) + exact exists_dominatingPlace_of_base_element m.1 hbase hinj P hP0 r hr + (hPMap.trans hrMap.symm) /-- The selected exhaustive finite place above a quadratic-extension closed affine centre. -/ @@ -440,20 +552,20 @@ def squareExtensionClosedPointExhaustiveFinitePlace (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : SquareExtensionClosedPoint K p f) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond FiniteExtensionFinitePlace K (PlaneCurveFunctionField f) := by exact Classical.choose @@ -467,20 +579,20 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_spec (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : SquareExtensionClosedPoint K p f) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime (PlaneCurveFunctionField f) @@ -497,40 +609,40 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_injective {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond Function.Injective (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change Function.Injective (squareExtensionClosedPointExhaustiveFinitePlace @@ -565,54 +677,32 @@ theorem squareExtensionClosedPoint_residueDegree_le_placeDegree (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : SquareExtensionClosedPoint K p f) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ Module.finrank K m.1.asIdeal.ResidueField ≤ finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inl (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m)) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + intro inst hx alg poly tower finite separable decEq let E := PlaneCurveFunctionField f let q : FiniteExtensionFinitePlace K E := squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m - let B := RatFuncFiniteIntegralClosure K E - letI : Algebra K B := - RingHom.toAlgebra - ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) - letI : IsScalarTower K (Polynomial K) B := - IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K (RatFunc K) E := + let : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by ext c have h := congrArg @@ -620,99 +710,8 @@ theorem squareExtensionClosedPoint_residueDegree_le_placeDegree (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) - letI : IsScalarTower K (Polynomial K) E := - IsScalarTower.of_algebraMap_eq' (by - ext c - rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, - IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] - rfl) - letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by - ext c - rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] - rfl) - let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q - letI : Algebra K R := - RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) - letI : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl - let V := dominatingValuationSubring - (A := PlaneCurveCoordinateRing f) (L := E) m.1 - have hspec : R = V := - squareExtensionClosedPointExhaustiveFinitePlace_spec - K p hf hpartialSecond m - let eVR : V ≃+* R := - { toFun := fun x => ⟨x.1, by rw [hspec]; exact x.2⟩ - invFun := fun x => ⟨x.1, by rw [← hspec]; exact x.2⟩ - left_inv := fun x => Subtype.ext rfl - right_inv := fun x => Subtype.ext rfl - map_add' := fun _ _ => rfl - map_mul' := fun _ _ => rfl } - let A := PlaneCurveCoordinateRing f - let ψ : A →+* R := - eVR.toRingHom.comp - (coordinateRingToDominatingValuationSubring - (A := A) (L := E) m.1) - have hcenter : m.1.asIdeal = - Ideal.comap ψ (IsLocalRing.maximalIdeal R) := by - rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal - (A := A) (L := E)] - ext a - change coordinateRingToDominatingValuationSubring m.1 a ∈ - IsLocalRing.maximalIdeal V ↔ - eVR (coordinateRingToDominatingValuationSubring m.1 a) ∈ - IsLocalRing.maximalIdeal R - simp only [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] - exact (not_congr (MulEquiv.isUnit_map (f := eVR.toMulEquiv))).symm - have hψcoe (a : A) : ((ψ a : R) : E) = algebraMap A E a := by - rfl - let θ : A →ₐ[K] IsLocalRing.ResidueField R := - { toRingHom := (IsLocalRing.residue R).comp ψ - commutes' := by - intro c - rw [IsScalarTower.algebraMap_apply K R - (IsLocalRing.ResidueField R)] - apply congrArg (IsLocalRing.residue R) - apply Subtype.ext - rw [hψcoe] - change algebraMap A E (algebraMap K A c) = - algebraMap B E (algebraMap K B c) - rw [← IsScalarTower.algebraMap_apply K A E, - ← IsScalarTower.algebraMap_apply K B E] } - have hker : m.1.asIdeal = RingHom.ker θ := by - ext a - rw [RingHom.mem_ker] - change a ∈ m.1.asIdeal ↔ IsLocalRing.residue R (ψ a) = 0 - rw [IsLocalRing.residue_eq_zero_iff, hcenter] - rfl - let ι : m.1.asIdeal.ResidueField →ₐ[K] - IsLocalRing.ResidueField R := by - apply Ideal.ResidueField.liftₐ m.1.asIdeal θ hker.le - intro a ha - change IsUnit (θ a) - rw [isUnit_iff_ne_zero] - intro hzero - apply ha - rw [hker] - exact hzero - let e := atPrimeResidueAlgEquiv K B R q.asIdeal - letI : DecidableEq (RatFunc K) := Classical.decEq _ - have hplace : finiteExtensionPlaceDegree K E (.inl q) = - Module.finrank K q.asIdeal.ResidueField := - finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q - letI : Module.Finite K q.asIdeal.ResidueField := - Module.finite_of_finrank_pos (by - rw [← hplace] - exact finiteExtensionPlaceDegree_pos K E (.inl q)) - letI : Module.Finite K (IsLocalRing.ResidueField R) := - Module.Finite.equiv e.toLinearEquiv - have hle : Module.finrank K m.1.asIdeal.ResidueField ≤ - Module.finrank K (IsLocalRing.ResidueField R) := - LinearMap.finrank_le_finrank_of_injective - (f := ι.toLinearMap) ι.injective - have heq : Module.finrank K (IsLocalRing.ResidueField R) = - Module.finrank K q.asIdeal.ResidueField := - e.symm.toLinearEquiv.finrank_eq - rw [hplace, ← heq] - exact hle + exact residue_finrank_le_finitePlace_degree K E (PlaneCurveCoordinateRing f) m.1 q + (squareExtensionClosedPointExhaustiveFinitePlace_spec K p hf hpartialSecond m) /-- Quadratic-extension affine points are bounded by the sum of the degrees of one selected normalization place above each closed affine centre. The @@ -721,45 +720,45 @@ theorem squareExtensionAffinePoint_card_le_selectedPlaceDegreeSum {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ Fintype.card (SquareExtensionAffinePoint K p f) ≤ ∑ m : SquareExtensionClosedPoint K p f, finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inl (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m)) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ have hcard : Fintype.card (SquareExtensionAffinePoint K p f) = ∑ m : SquareExtensionClosedPoint K p f, @@ -782,46 +781,46 @@ theorem squareExtensionAffinePoint_card_le_finiteExtensionHeight_of_selectedPlac (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (u : PlaneCurveFunctionField f) (hu : u ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ (∀ m : SquareExtensionClosedPoint K p f, 0 < finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) u (.inl (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m))) → Fintype.card (SquareExtensionAffinePoint K p f) ≤ finiteExtensionHeight K (PlaneCurveFunctionField f) u := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ change (∀ m : SquareExtensionClosedPoint K p f, 0 < finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) u @@ -840,6 +839,8 @@ theorem squareExtensionAffinePoint_card_le_finiteExtensionHeight_of_selectedPlac apply squareExtensionClosedPointExhaustiveFinitePlace_injective K p hf hpartialSecond exact Sum.inl_injective hmn + let : DecidableEq (FiniteExtensionPlace K (PlaneCurveFunctionField f)) := + @instDecidableEqSum _ _ (Classical.decEq _) (Classical.decEq _) let S : Finset (FiniteExtensionPlace K (PlaneCurveFunctionField f)) := Finset.univ.image place have hsum : From 928d77a1eee3f39ff793893f6ad1229145f37bab Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:40:14 +0000 Subject: [PATCH 15/37] Repair constant extension regularity and weighted trace bounds --- ...onFrobeniusTwistFinitePlaceUnramified.lean | 486 +++++++++--------- .../ExactConstantExtensionRegularity.lean | 44 +- ...WeightedTraceEulerSevenPropositionTwo.lean | 25 +- 3 files changed, 282 insertions(+), 273 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean index 66fc552134..bea2df13d3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean @@ -55,9 +55,9 @@ private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) (k : ℤ) (s : S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S ((exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) ^ k) @@ -66,9 +66,9 @@ private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft Algebra.TensorProduct.includeLeft (R := C) (S := C) (A := S) (B := N) (((FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k) s) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S change ((exactConstantExtensionCombinedAutHom C (RatFunc C) N S @@ -90,20 +90,20 @@ theorem exactConstantExtensionFrobeniusTwistOverFixedField_zpowers_eq_top (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S Subgroup.zpowers (exactConstantExtensionFrobeniusTwistOverFixedField C N S hExact g) = ⊤ := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact let sigma := exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g @@ -148,7 +148,7 @@ theorem finitePlaceUnder_degree_eq_one_of_generator_fixed (.inl (finitePlaceUnder K M T Q)) = 1 := by let P := finitePlaceUnder K M T Q let Q₀ : FinitePlaceUnderFiber K M T P := ⟨Q, rfl⟩ - letI := finitePlaceGalAction K M T + let := finitePlaceGalAction K M T have hsigma : sigma ∈ MulAction.stabilizer (T ≃ₐ[M] T) Q := by rw [MulAction.mem_stabilizer_iff] @@ -165,8 +165,8 @@ theorem finitePlaceUnder_degree_eq_one_of_generator_fixed have hfix := MulAction.mem_stabilizer_iff.mp htau change finitePlaceGalSmul K M T tau Q = Q at hfix exact hfix - letI := finitePlaceUnderFiberGalAction K M T P - letI : MulAction.IsPretransitive (T ≃ₐ[M] T) + let := finitePlaceUnderFiberGalAction K M T P + let : MulAction.IsPretransitive (T ≃ₐ[M] T) (FinitePlaceUnderFiber K M T P) := finitePlaceUnderFiberGalAction_isPretransitive K M T P have hcard : Fintype.card (FinitePlaceUnderFiber K M T P) = 1 := by @@ -326,28 +326,28 @@ theorem finitePlaceGalSmul_eq_of_apply_eq let A := RatFuncFiniteIntegralClosure K T let A₁ := RatFuncFiniteIntegralClosure K M₁ let A₂ := RatFuncFiniteIntegralClosure K M₂ - letI : Algebra K[X] M₁ := + let : Algebra K[X] M₁ := RingHom.toAlgebra ((algebraMap (RatFunc K) M₁).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) M₁ := + let : IsScalarTower K[X] (RatFunc K) M₁ := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K[X] M₂ := + let : Algebra K[X] M₂ := RingHom.toAlgebra ((algebraMap (RatFunc K) M₂).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) M₂ := + let : IsScalarTower K[X] (RatFunc K) M₂ := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K[X] T := + let : Algebra K[X] T := RingHom.toAlgebra ((algebraMap (RatFunc K) T).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) T := + let : IsScalarTower K[X] (RatFunc K) T := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra A₁ A := (finiteIntegralClosureMap K M₁ T).toAlgebra - letI : SMul A₁ A := Algebra.toSMul - letI : Module A₁ A := Algebra.toModule - letI : IsScalarTower A₁ M₁ T := inferInstance - letI : Algebra.IsIntegral K[X] A₁ := + let : Algebra A₁ A := (finiteIntegralClosureMap K M₁ T).toAlgebra + let : SMul A₁ A := Algebra.toSMul + let : Module A₁ A := Algebra.toModule + let : IsScalarTower A₁ M₁ T := inferInstance + let : Algebra.IsIntegral K[X] A₁ := IsIntegralClosure.isIntegral_algebra K[X] M₁ - letI : IsScalarTower K[X] A₁ T := by + let : IsScalarTower K[X] A₁ T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc K) T @@ -356,21 +356,21 @@ theorem finitePlaceGalSmul_eq_of_apply_eq (algebraMap (RatFunc K) M₁ (algebraMap K[X] (RatFunc K) x)) exact IsScalarTower.algebraMap_apply (RatFunc K) M₁ T _ - letI : IsScalarTower A₁ A T := + let : IsScalarTower A₁ A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap A₁ A r) = algebraMap A₁ T r by rfl] ring⟩ - letI : IsIntegralClosure A A₁ T := + let : IsIntegralClosure A A₁ T := IsIntegralClosure.tower_top (R := K[X]) - letI : Algebra A₂ A := (finiteIntegralClosureMap K M₂ T).toAlgebra - letI : SMul A₂ A := Algebra.toSMul - letI : Module A₂ A := Algebra.toModule - letI : IsScalarTower A₂ M₂ T := inferInstance - letI : Algebra.IsIntegral K[X] A₂ := + let : Algebra A₂ A := (finiteIntegralClosureMap K M₂ T).toAlgebra + let : SMul A₂ A := Algebra.toSMul + let : Module A₂ A := Algebra.toModule + let : IsScalarTower A₂ M₂ T := inferInstance + let : Algebra.IsIntegral K[X] A₂ := IsIntegralClosure.isIntegral_algebra K[X] M₂ - letI : IsScalarTower K[X] A₂ T := by + let : IsScalarTower K[X] A₂ T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc K) T @@ -379,17 +379,17 @@ theorem finitePlaceGalSmul_eq_of_apply_eq (algebraMap (RatFunc K) M₂ (algebraMap K[X] (RatFunc K) x)) exact IsScalarTower.algebraMap_apply (RatFunc K) M₂ T _ - letI : IsScalarTower A₂ A T := + let : IsScalarTower A₂ A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap A₂ A r) = algebraMap A₂ T r by rfl] ring⟩ - letI : IsIntegralClosure A A₂ T := + let : IsIntegralClosure A A₂ T := IsIntegralClosure.tower_top (R := K[X]) - letI : MulSemiringAction (T ≃ₐ[M₁] T) A := + let : MulSemiringAction (T ≃ₐ[M₁] T) A := finiteIntegralClosureGalAction K M₁ T - letI : MulSemiringAction (T ≃ₐ[M₂] T) A := + let : MulSemiringAction (T ≃ₐ[M₂] T) A := finiteIntegralClosureGalAction K M₂ T have hsmul (a₁ : T ≃ₐ[M₁] T) (a₂ : T ≃ₐ[M₂] T) (ha : ∀ x : T, a₁ x = a₂ x) (x : A) : a₁ • x = a₂ • x := by @@ -425,91 +425,91 @@ theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), finitePlaceRelativeRamificationIdx C F (ExactConstantExtension C N S) Q = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra C[X] T := + let : Algebra C[X] T := RingHom.toAlgebra ((algebraMap (RatFunc C) T).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C[X] (RatFunc C) T := + let : IsScalarTower C[X] (RatFunc C) T := IsScalarTower.of_algebraMap_eq' rfl let A := RatFuncFiniteIntegralClosure C T let AF := RatFuncFiniteIntegralClosure C F - letI : Algebra AF A := (finiteIntegralClosureMap C F T).toAlgebra - letI : SMul AF A := Algebra.toSMul - letI : Module AF A := Algebra.toModule - letI : Algebra S A := + let : Algebra AF A := (finiteIntegralClosureMap C F T).toAlgebra + let : SMul AF A := Algebra.toSMul + let : Module AF A := Algebra.toModule + let : Algebra S A := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : IsScalarTower AF F T := inferInstance - letI : Algebra.IsIntegral C[X] AF := + let : IsScalarTower AF F T := inferInstance + let : Algebra.IsIntegral C[X] AF := IsIntegralClosure.isIntegral_algebra C[X] F - letI : IsScalarTower C[X] AF T := by + let : IsScalarTower C[X] AF T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc C) T @@ -518,20 +518,20 @@ theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one (algebraMap (RatFunc C) F (algebraMap C[X] (RatFunc C) x)) exact IsScalarTower.algebraMap_apply (RatFunc C) F T _ - letI : IsScalarTower AF A T := + let : IsScalarTower AF A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap AF A r) = algebraMap AF T r by rfl] ring⟩ - letI : IsIntegralClosure A AF T := + let : IsIntegralClosure A AF T := IsIntegralClosure.tower_top (R := C[X]) - letI : IsDedekindDomain A := inferInstance - letI : MulSemiringAction (T ≃ₐ[F] T) A := + let : IsDedekindDomain A := inferInstance + let : MulSemiringAction (T ≃ₐ[F] T) A := finiteIntegralClosureGalAction C F T dsimp only intro Q - letI : Q.asIdeal.IsMaximal := Q.isMaximal + let : Q.asIdeal.IsMaximal := Q.isMaximal rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C F T Q] have hInertia : finitePlaceInertiaGroup C F T Q = ⊥ := by ext tau @@ -621,10 +621,8 @@ theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one (h.1 : T ≃ₐ[RatFunc C] T) = sigma ^ k := hk.symm _ = 1 := hsigma have hh : h = 1 := Subtype.ext hambient - calc - tau = e h := (e.apply_symm_apply tau).symm - _ = e 1 := congrArg e hh - _ = 1 := map_one e + exact (e.apply_symm_apply tau).symm.trans + ((congrArg e hh).trans (map_one e)) · intro htau rw [Subgroup.mem_bot] at htau simp [htau] @@ -638,40 +636,40 @@ theorem frobeniusTwistField_fixed_finitePlace_under_degree_eq_one (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), @@ -684,33 +682,33 @@ theorem frobeniusTwistField_fixed_finitePlace_under_degree_eq_one (.inl (finitePlaceUnder C F (ExactConstantExtension C N S) Q)) = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only @@ -736,46 +734,46 @@ theorem exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedFiel (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction (RatFunc C) + let : DistribMulAction (RatFunc C) (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + let : MulAction (RatFunc C) (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + let : IsGalois (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), @@ -786,37 +784,37 @@ theorem exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedFiel (exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) Q := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only @@ -834,46 +832,46 @@ theorem frobeniusTwistField_ambientFixed_finitePlace_under_degree_eq_one (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction (RatFunc C) + let : DistribMulAction (RatFunc C) (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + let : MulAction (RatFunc C) (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + let : IsGalois (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtension_isGalois C (RatFunc C) N S hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), @@ -886,37 +884,37 @@ theorem frobeniusTwistField_ambientFixed_finitePlace_under_degree_eq_one (.inl (finitePlaceUnder C F (ExactConstantExtension C N S) Q)) = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only @@ -936,46 +934,46 @@ noncomputable def (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction (RatFunc C) + let : DistribMulAction (RatFunc C) (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + let : MulAction (RatFunc C) (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + let : IsGalois (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g FiniteExtensionRationalFinitePlace C F ≃ @@ -986,37 +984,37 @@ noncomputable def (exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) Q = Q} := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean index 68bc7c396a..4876b6ff0f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean @@ -38,12 +38,11 @@ automorphism of the constant extension that acts trivially on the enlarged constants. -/ noncomputable def exactConstantExtensionFunctionAutHomToConstantKernel (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S (N ≃ₐ[L] N) →* (exactConstantExtensionConstantQuotient C L N S hExact).ker := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + intro fieldModel algebraModel let f := exactConstantExtensionFunctionAutHom C L N S exact { toFun := fun g => ⟨f g, by @@ -59,12 +58,11 @@ noncomputable def exactConstantExtensionFunctionAutHomToConstantKernel theorem exactConstantExtensionFunctionAutHomToConstantKernel_injective (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S Function.Injective (exactConstantExtensionFunctionAutHomToConstantKernel C L N S hExact) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + intro fieldModel algebraModel intro g h hgh have hfun : exactConstantExtensionFunctionAutHom C L N S g = exactConstantExtensionFunctionAutHom C L N S h := @@ -77,12 +75,11 @@ theorem exactConstantExtensionFunctionAutHomToConstantKernel_injective theorem exactConstantExtensionFunctionAutHomToConstantKernel_surjective (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S Function.Surjective (exactConstantExtensionFunctionAutHomToConstantKernel C L N S hExact) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + intro fieldModel algebraModel intro x have hx : x.1 ∈ (exactConstantExtensionFunctionAutHom C L N S).range := by rw [← exactConstantExtensionConstantQuotient_ker C L N S hExact] @@ -97,12 +94,11 @@ it is canonically the kernel of restriction from the full extended Galois group to the Galois group of the enlarged constants. -/ noncomputable def exactConstantExtensionFunctionAutMulEquiv (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S (N ≃ₐ[L] N) ≃* (exactConstantExtensionConstantQuotient C L N S hExact).ker := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + intro fieldModel algebraModel exact MulEquiv.ofBijective (exactConstantExtensionFunctionAutHomToConstantKernel C L N S hExact) ⟨exactConstantExtensionFunctionAutHomToConstantKernel_injective @@ -134,9 +130,15 @@ theorem functionFieldNormalClosureConstantExtensionTensor_isField : /-- The constant extension has the expected degree over the original normal closure. -/ theorem functionFieldNormalClosureConstantExtension_finrank_over_normalClosure : - letI := exactConstantExtensionAlgebra + let := exactConstantExtensionAlgebra (FunctionFieldNormalClosureConstantField K F) (FunctionFieldNormalClosure K F) S + let : SMul (FunctionFieldNormalClosure K F) + (ExactConstantExtension (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S) := Algebra.toSMul + let : Module (FunctionFieldNormalClosure K F) + (ExactConstantExtension (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosure K F) S) := Algebra.toModule Module.finrank (FunctionFieldNormalClosure K F) (ExactConstantExtension (FunctionFieldNormalClosureConstantField K F) @@ -153,8 +155,8 @@ theorem functionFieldNormalClosureConstantExtension_isGalois_over_constantBase : let B := FunctionFieldNormalClosureConstantBase K F let N := FunctionFieldNormalClosure K F let hExact := functionFieldNormalClosureConstantField_isExact K F - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C B N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C B N S IsGalois B (ExactConstantExtension C N S) := by exact exactConstantExtension_isGalois (FunctionFieldNormalClosureConstantField K F) @@ -170,8 +172,8 @@ noncomputable def let B := FunctionFieldNormalClosureConstantBase K F let N := FunctionFieldNormalClosure K F let hExact := functionFieldNormalClosureConstantField_isExact K F - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C B N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C B N S (N ≃ₐ[B] N) ≃* (exactConstantExtensionConstantQuotient C B N S hExact).ker := by exact exactConstantExtensionFunctionAutMulEquiv diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean index e06bf93298..27ffdd8e60 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean @@ -55,9 +55,9 @@ theorem weightedTracePropositionTwo_natural_eulerSeven let hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0 := weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero alpha beta hadmissible.2.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ have hindexTwo : Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ 2 := by @@ -72,7 +72,7 @@ theorem weightedTracePropositionTwo_natural_eulerSeven hf hpartialFirst hpartialSecond m n p 7 hm hn hindexSeven intro h k hh hk hparameters hexcluded let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let gK := poweredCoordinateImageRelation hf hpartialSecond m hm n let g := poweredCoordinateFrobeniusImageRelation @@ -113,6 +113,15 @@ theorem weightedTracePropositionTwo_natural_eulerSeven h k hparameters.1 7 hLI (by simpa only [f, hf, Nat.cast_ofNat] using hEuler) +private theorem exceptionalPlaces_comm + (K : Type*) [Field K] [DecidableEq K] [DecidableEq (RatFunc K)] + (L : Type*) [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] + (u v : L) : propositionTwoExceptionalPlaces K L u v = + propositionTwoExceptionalPlaces K L v u := by + classical + exact Finset.union_comm _ _ + theorem weightedTracePropositionTwo_swapped_eulerSeven {K : Type*} [Field K] [Fintype K] [DecidableEq K] {p : ℕ} [Fact p.Prime] [CharP K p] @@ -143,9 +152,9 @@ theorem weightedTracePropositionTwo_swapped_eulerSeven let hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0 := weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero alpha beta hadmissible.2.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ have hindexTwo : Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ 2 := by @@ -160,7 +169,7 @@ theorem weightedTracePropositionTwo_swapped_eulerSeven hf hpartialFirst hpartialSecond m n p 7 hm hn hindexSeven intro h k hh hk hparameters hexcluded let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := @@ -205,8 +214,8 @@ theorem weightedTracePropositionTwo_swapped_eulerSeven finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_linearIndependent (p := p) hf hpartialFirst hpartialSecond m n hm hn h k hparameters.1 7 hLI (by - simpa only [f, hf, propositionTwoExceptionalPlaces, - Finset.union_comm, Nat.cast_ofNat] using hEuler) + erw [exceptionalPlaces_comm] + exact hEuler) /-- The natural and swapped orientations give the minimum/maximum form with Euler budget exactly seven. -/ From 1331ed5bd272d4a88ab1bc2bd56ac79c366b3a50 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 00:44:48 +0000 Subject: [PATCH 16/37] Factor smooth residue normalization and constant-base algebra arguments --- ...FunctionFieldNormalClosureRatFuncBase.lean | 16 + .../PlaneSmoothPointNormalization.lean | 422 +++++++----------- 2 files changed, 175 insertions(+), 263 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean index b2855fe673..a1637daa60 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean @@ -29,6 +29,18 @@ variable (K L : Type*) [Field K] [Field L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] +local instance ratFuncBaseConstantSMul : + SMul (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) := Algebra.toSMul + +local instance ratFuncBaseConstantModule : + Module (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantBase K L) := Algebra.toModule + +local instance normalClosureConstantBaseRatFuncTower : + IsScalarTower K (RatFunc K) (FunctionFieldNormalClosureConstantBase K L) := + IsScalarTower.of_algebraMap_eq' rfl + /-- The compositum of the original rational function field and the algebraic constant field, formed inside the chosen normal closure. -/ def functionFieldNormalClosureConstantCompositum : @@ -94,6 +106,10 @@ algebraic constants of the normal closure. -/ theorem functionFieldNormalClosureConstantBaseX_transcendental : Transcendental (FunctionFieldNormalClosureConstantField K L) (functionFieldNormalClosureConstantBaseX K L) := by + let : Algebra.IsAlgebraic K (FunctionFieldNormalClosureConstantField K L) := + algebraicClosure.isAlgebraic K (FunctionFieldNormalClosure K L) + let : Algebra.IsIntegral K (FunctionFieldNormalClosureConstantField K L) := + Algebra.IsAlgebraic.isIntegral intro hx have hxIntegralK : IsIntegral K (functionFieldNormalClosureConstantBaseX K L) := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean index 0c985e47c1..1398dbfb2d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean @@ -92,7 +92,8 @@ theorem planeCurveYPreSubmersivePresentation_jacobian change (P.ofAlgEquiv E).jacobian = planeCurvePartialY f rw [Algebra.PreSubmersivePresentation.jacobian_ofAlgEquiv, Algebra.PreSubmersivePresentation.jacobian_eq_jacobiMatrix_det, - Matrix.det_unique, Algebra.PreSubmersivePresentation.jacobiMatrix_naive] + Matrix.det_unique] + erw [Algebra.PreSubmersivePresentation.jacobiMatrix_naive] change E (Ideal.Quotient.mk _ (MvPolynomial.pderiv 1 f)) = Ideal.Quotient.mk _ (MvPolynomial.pderiv 1 f) exact Ideal.quotientEquivAlgOfEq_mk K _ _ @@ -276,7 +277,7 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing rw [hunder] exact m.isMaximal letI hqMax : q.IsMaximal := by - exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) + exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) Ad q let S := Localization.AtPrime q letI : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q letI : IsDomain S := IsLocalization.isDomain_of_atPrime S q @@ -354,7 +355,7 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing have hprincipal : (IsLocalRing.maximalIdeal S).IsPrincipal := IsLocalRing.finrank_cotangentSpace_le_one_iff.mp hcotangent have hSDvr : IsDiscreteValuationRing S := - ((IsDiscreteValuationRing.TFAE S hnotField).out 4 0).mp hprincipal + ((IsDiscreteValuationRing.TFAE S hnotField).out 5 1).mp hprincipal letI : IsDiscreteValuationRing S := hSDvr exact IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing (IsLocalization.algEquiv m.asIdeal.primeCompl S @@ -398,7 +399,7 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing rw [hunder] exact m.1.isMaximal letI hqMax : q.IsMaximal := by - exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) + exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) Ad q let S := Localization.AtPrime q letI : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q letI : IsDomain S := IsLocalization.isDomain_of_atPrime S q @@ -484,7 +485,7 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing have hprincipal : (IsLocalRing.maximalIdeal S).IsPrincipal := IsLocalRing.finrank_cotangentSpace_le_one_iff.mp hcotangent have hSDvr : IsDiscreteValuationRing S := - ((IsDiscreteValuationRing.TFAE S hnotField).out 4 0).mp hprincipal + ((IsDiscreteValuationRing.TFAE S hnotField).out 5 1).mp hprincipal letI : IsDiscreteValuationRing S := hSDvr exact IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing (IsLocalization.algEquiv m.1.asIdeal.primeCompl S @@ -515,6 +516,106 @@ theorem finrank_residueField_eq_of_commonLocalization : end CommonLocalization +private theorem residue_finrank_eq_of_regular_dominating_valuation + (C A B E : Type*) [Field C] [CommRing A] [IsDomain A] [CommRing B] [Field E] + [Algebra C A] [Algebra C B] [Algebra A E] [IsFractionRing A E] + [Algebra C E] [IsScalarTower C A E] + (m : MaximalSpectrum A) (q : Ideal B) [q.IsMaximal] + (R : ValuationSubring E) [Algebra B R] [Algebra C R] + [IsScalarTower C B R] [IsLocalization.AtPrime R q] + [IsDiscreteValuationRing (Localization.AtPrime m.asIdeal)] + (hm0 : m.asIdeal ≠ ⊥) + (hspec : R = dominatingValuationSubring (A := A) (L := E) m) + (hscalar : ∀ c : C, ((algebraMap C R c : R) : E) = algebraMap C E c) : + Module.finrank C m.asIdeal.ResidueField = Module.finrank C q.ResidueField := by + let Wsub : Subalgebra A E := + Localization.subalgebra.ofField E m.asIdeal.primeCompl + m.asIdeal.primeCompl_le_nonZeroDivisors + let : IsDiscreteValuationRing Wsub := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing + (IsLocalization.algEquiv m.asIdeal.primeCompl + (Localization.AtPrime m.asIdeal) Wsub).toRingEquiv + let W : ValuationSubring E := + ValuationSubring.ofSubring Wsub.toSubring fun x => by + simpa [IsLocalization.IsInteger] using + ValuationRing.isInteger_or_isInteger Wsub x + let : Algebra A W := Wsub.algebra' + let : IsLocalization m.asIdeal.primeCompl W := + Localization.subalgebra.isLocalization_ofField E + m.asIdeal.primeCompl m.asIdeal.primeCompl_le_nonZeroDivisors + let eW : Wsub ≃+* W := + { toFun := fun x => ⟨x.1, x.2⟩ + invFun := fun x => ⟨x.1, x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + let : IsDiscreteValuationRing W := + IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW + let V := dominatingValuationSubring (A := A) (L := E) m + have hWV : W ≤ V := by + intro x hx + change x ∈ Wsub at hx + rcases hx with ⟨a, s, hs, rfl⟩ + have haV : algebraMap A E a ∈ V := + range_le_dominatingValuationSubring m ⟨a, rfl⟩ + have hsV : algebraMap A E s ∈ V := + range_le_dominatingValuationSubring m ⟨s, rfl⟩ + let sv : V := ⟨algebraMap A E s, hsV⟩ + have hsvNot : sv ∉ IsLocalRing.maximalIdeal V := by + intro hsv + apply hs + rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal + (A := A) (L := E)] + exact hsv + have hsvUnit : IsUnit sv := by + by_contra hunit + apply hsvNot + rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] + exact hunit + have hinvV : (algebraMap A E s)⁻¹ ∈ V := + Submonoid.inv_mem_of_isUnit (S := V) hsvUnit + exact V.toSubring.mul_mem haV hinvV + rw [Submodule.ne_bot_iff] at hm0 + obtain ⟨r, hr, hr0⟩ := hm0 + have hrMap0 : algebraMap A E r ≠ 0 := by + intro hzero + apply hr0 + apply IsFractionRing.injective A E + simpa using hzero + have hrNonunits : algebraMap A E r ∈ V.nonunits := + algebraMap_mem_dominatingValuationSubring_nonunits_of_mem + (A := A) (L := E) m r hr + have hV : V ≠ ⊤ := by + intro htop + have hnontrivial : V.valuation.IsNontrivial := + (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 + ⟨algebraMap A E r, hrMap0, hrNonunits⟩ + exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial + have hWVeq : W = V := + ValuationSubring.eq_of_le_of_ne_top W hWV hV + have hWR : W = R := hWVeq.trans hspec.symm + let eWR : W ≃+* R := + { toFun := fun x => ⟨x.1, by rw [← hWR]; exact x.2⟩ + invFun := fun x => ⟨x.1, by rw [hWR]; exact x.2⟩ + left_inv := fun x => Subtype.ext rfl + right_inv := fun x => Subtype.ext rfl + map_add' := fun _ _ => rfl + map_mul' := fun _ _ => rfl } + let : Algebra A R := + RingHom.toAlgebra (eWR.toRingHom.comp (algebraMap A W)) + let eWRAlg : W ≃ₐ[A] R := + { eWR with commutes' := fun _ => rfl } + let : IsLocalization m.asIdeal.primeCompl R := + IsLocalization.isLocalization_of_algEquiv + m.asIdeal.primeCompl eWRAlg + let : IsScalarTower C A R := + IsScalarTower.of_algebraMap_eq (R := C) (S := A) (A := R) (fun c => by + apply Subtype.ext + change ((algebraMap C R c : R) : E) = algebraMap A E (algebraMap C A c) + rw [hscalar, ← IsScalarTower.algebraMap_apply C A E]) + exact finrank_residueField_eq_of_commonLocalization (C := C) (R := R) m.asIdeal q + section SquareExtensionCommonLocalization variable {f : MvPolynomial (Fin 2) K} @@ -567,56 +668,40 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_eq_residueDe (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : SquareExtensionClosedPoint K p f) (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inl (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m)) = Module.finrank K m.1.asIdeal.ResidueField := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + intro domainModel hx ratFuncModel polynomialModel towerModel finiteModel separableModel + decidableModel let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f let q : FiniteExtensionFinitePlace K E := squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m let B := RatFuncFiniteIntegralClosure K E - letI : Algebra K B := + let : Algebra K B := RingHom.toAlgebra ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) - letI : IsScalarTower K (Polynomial K) B := + let : IsScalarTower K (Polynomial K) B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K (RatFunc K) E := + let : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by ext c have h := congrArg @@ -624,121 +709,32 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_eq_residueDe (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) - letI : IsScalarTower K (Polynomial K) E := + let : IsScalarTower K (Polynomial K) E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] rfl) - letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + let : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] rfl) let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q - letI : Algebra K R := + let : Algebra K R := RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) - letI : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl - - let Wsub : Subalgebra A E := - Localization.subalgebra.ofField E m.1.asIdeal.primeCompl - m.1.asIdeal.primeCompl_le_nonZeroDivisors - letI : IsDiscreteValuationRing (Localization.AtPrime m.1.asIdeal) := - squareExtensionClosedPoint_localization_isDiscreteValuationRing - K p hf m hsmooth - letI : IsDiscreteValuationRing Wsub := - IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing - (IsLocalization.algEquiv m.1.asIdeal.primeCompl - (Localization.AtPrime m.1.asIdeal) Wsub).toRingEquiv - let W : ValuationSubring E := - ValuationSubring.ofSubring Wsub.toSubring fun x => by - simpa [IsLocalization.IsInteger] using - ValuationRing.isInteger_or_isInteger Wsub x - letI : Algebra A W := Wsub.algebra' - letI : IsLocalization m.1.asIdeal.primeCompl W := - Localization.subalgebra.isLocalization_ofField E - m.1.asIdeal.primeCompl m.1.asIdeal.primeCompl_le_nonZeroDivisors - let eW : Wsub ≃+* W := - { toFun := fun x => ⟨x.1, x.2⟩ - invFun := fun x => ⟨x.1, x.2⟩ - left_inv := fun x => Subtype.ext rfl - right_inv := fun x => Subtype.ext rfl - map_add' := fun _ _ => rfl - map_mul' := fun _ _ => rfl } - letI : IsDiscreteValuationRing W := - IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW - let V := dominatingValuationSubring (A := A) (L := E) m.1 - have hWV : W ≤ V := by - intro x hx - change x ∈ Wsub at hx - rcases hx with ⟨a, s, hs, rfl⟩ - have haV : algebraMap A E a ∈ V := - range_le_dominatingValuationSubring m.1 ⟨a, rfl⟩ - have hsV : algebraMap A E s ∈ V := - range_le_dominatingValuationSubring m.1 ⟨s, rfl⟩ - let sv : V := ⟨algebraMap A E s, hsV⟩ - have hsvNot : sv ∉ IsLocalRing.maximalIdeal V := by - intro hsv - apply hs - rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal - (A := A) (L := E)] - exact hsv - have hsvUnit : IsUnit sv := by - by_contra hunit - apply hsvNot - rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] - exact hunit - have hinvV : (algebraMap A E s)⁻¹ ∈ V := - Submonoid.inv_mem_of_isUnit (S := V) hsvUnit - exact V.toSubring.mul_mem haV hinvV - have hm0 : m.1.asIdeal ≠ ⊥ := - squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY - K p hf m hsmooth - rw [Submodule.ne_bot_iff] at hm0 - obtain ⟨r, hr, hr0⟩ := hm0 - have hrMap0 : algebraMap A E r ≠ 0 := by - intro hzero - apply hr0 - apply IsFractionRing.injective A E - simpa using hzero - have hrNonunits : algebraMap A E r ∈ V.nonunits := - algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) (L := E) m.1 r hr - have hV : V ≠ ⊤ := by - intro htop - have hnontrivial : V.valuation.IsNontrivial := - (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 - ⟨algebraMap A E r, hrMap0, hrNonunits⟩ - exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial - have hWVeq : W = V := - ValuationSubring.eq_of_le_of_ne_top W hWV hV - have hspec : R = V := - squareExtensionClosedPointExhaustiveFinitePlace_spec - K p hf hpartialSecond m - have hWR : W = R := hWVeq.trans hspec.symm - let eWR : W ≃+* R := - { toFun := fun x => ⟨x.1, by rw [← hWR]; exact x.2⟩ - invFun := fun x => ⟨x.1, by rw [hWR]; exact x.2⟩ - left_inv := fun x => Subtype.ext rfl - right_inv := fun x => Subtype.ext rfl - map_add' := fun _ _ => rfl - map_mul' := fun _ _ => rfl } - letI : Algebra A R := - RingHom.toAlgebra (eWR.toRingHom.comp (algebraMap A W)) - let eWRAlg : W ≃ₐ[A] R := - { eWR with commutes' := fun _ => rfl } - letI : IsLocalization m.1.asIdeal.primeCompl R := - IsLocalization.isLocalization_of_algEquiv - m.1.asIdeal.primeCompl eWRAlg - letI : IsScalarTower K A R := - IsScalarTower.of_algebraMap_eq (R := K) (S := A) (A := R) (fun c => by - apply Subtype.ext - change algebraMap B E (algebraMap K B c) = - algebraMap A E (algebraMap K A c) - rw [← IsScalarTower.algebraMap_apply K B E, - ← IsScalarTower.algebraMap_apply K A E]) + let : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl + + let : IsDiscreteValuationRing (Localization.AtPrime m.1.asIdeal) := + squareExtensionClosedPoint_localization_isDiscreteValuationRing K p hf m hsmooth + have hresidue := residue_finrank_eq_of_regular_dominating_valuation K A B E + m.1 q.asIdeal R + (squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY K p hf m hsmooth) + (squareExtensionClosedPointExhaustiveFinitePlace_spec K p hf hpartialSecond m) + (fun c => by + change algebraMap B E (algebraMap K B c) = algebraMap K E c + exact (IsScalarTower.algebraMap_apply K B E c).symm) rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q] - exact (finrank_residueField_eq_of_commonLocalization - (C := K) (A := A) (B := B) (R := R) m.1.asIdeal q.asIdeal).symm + exact hresidue.symm section FinitePlaceDegree @@ -927,55 +923,39 @@ theorem affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY (z : AffinePlaneCurvePoint f) (hregular : MvPolynomial.eval ![z.1.1, z.1.2] (MvPolynomial.pderiv 1 f) ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inl (affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond z)) = 1 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + intro domainModel hx ratFuncModel polynomialModel towerModel finiteModel separableModel + decidableModel let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f let m := affinePlaneCurvePointMaximalIdeal f z let q : FiniteExtensionFinitePlace K E := affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond z let B := RatFuncFiniteIntegralClosure K E - letI : Algebra K B := + let : Algebra K B := RingHom.toAlgebra ((algebraMap (Polynomial K) B).comp (algebraMap K (Polynomial K))) - letI : IsScalarTower K (Polynomial K) B := + let : IsScalarTower K (Polynomial K) B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K (RatFunc K) E := + let : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by ext c have h := congrArg @@ -983,23 +963,23 @@ theorem affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) - letI : IsScalarTower K (Polynomial K) E := + let : IsScalarTower K (Polynomial K) E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, IsScalarTower.algebraMap_apply K (Polynomial K) (RatFunc K)] rfl) - letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + let : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (Polynomial K) E] rfl) let R := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E q - letI : Algebra K R := + let : Algebra K R := RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) - letI : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z - letI : Finite m.asIdeal.ResidueField := + let : Finite m.asIdeal.ResidueField := Finite.of_injective eCenter eCenter.injective let r0 : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 have hr0mem : r0 ∈ m.asIdeal := @@ -1024,102 +1004,18 @@ theorem affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY change MvPolynomial.eval ![z.1.1, z.1.2] (MvPolynomial.pderiv 1 f) ≠ 0 exact hregular - letI : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := + let : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := planeCurveClosedPoint_localization_isDiscreteValuationRing K hf m hm0 hsmooth - let Wsub : Subalgebra A E := - Localization.subalgebra.ofField E m.asIdeal.primeCompl - m.asIdeal.primeCompl_le_nonZeroDivisors - letI : IsDiscreteValuationRing Wsub := - IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing - (IsLocalization.algEquiv m.asIdeal.primeCompl - (Localization.AtPrime m.asIdeal) Wsub).toRingEquiv - let W : ValuationSubring E := - ValuationSubring.ofSubring Wsub.toSubring fun x => by - simpa [IsLocalization.IsInteger] using - ValuationRing.isInteger_or_isInteger Wsub x - letI : Algebra A W := Wsub.algebra' - letI : IsLocalization m.asIdeal.primeCompl W := - Localization.subalgebra.isLocalization_ofField E - m.asIdeal.primeCompl m.asIdeal.primeCompl_le_nonZeroDivisors - let eW : Wsub ≃+* W := - { toFun := fun x => ⟨x.1, x.2⟩ - invFun := fun x => ⟨x.1, x.2⟩ - left_inv := fun x => Subtype.ext rfl - right_inv := fun x => Subtype.ext rfl - map_add' := fun _ _ => rfl - map_mul' := fun _ _ => rfl } - letI : IsDiscreteValuationRing W := - IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW - let V := dominatingValuationSubring (A := A) (L := E) m - have hWV : W ≤ V := by - intro x hx - change x ∈ Wsub at hx - rcases hx with ⟨a, s, hs, rfl⟩ - have haV : algebraMap A E a ∈ V := - range_le_dominatingValuationSubring m ⟨a, rfl⟩ - have hsV : algebraMap A E s ∈ V := - range_le_dominatingValuationSubring m ⟨s, rfl⟩ - let sv : V := ⟨algebraMap A E s, hsV⟩ - have hsvNot : sv ∉ IsLocalRing.maximalIdeal V := by - intro hsv - apply hs - rw [pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal - (A := A) (L := E)] - exact hsv - have hsvUnit : IsUnit sv := by - by_contra hunit - apply hsvNot - rw [IsLocalRing.mem_maximalIdeal, mem_nonunits_iff] - exact hunit - have hinvV : (algebraMap A E s)⁻¹ ∈ V := - Submonoid.inv_mem_of_isUnit (S := V) hsvUnit - exact V.toSubring.mul_mem haV hinvV - have hrNonunits : algebraMap A E r0 ∈ V.nonunits := - algebraMap_mem_dominatingValuationSubring_nonunits_of_mem - (A := A) (L := E) m r0 hr0mem - have hV : V ≠ ⊤ := by - intro htop - have hnontrivial : V.valuation.IsNontrivial := - (Valuation.isNontrivial_iff_exists_lt_one V.valuation).2 - ⟨algebraMap A E r0, hr0map, hrNonunits⟩ - exact ((ValuationSubring.eq_top_iff V).mp htop) hnontrivial - have hWVeq : W = V := - ValuationSubring.eq_of_le_of_ne_top W hWV hV - have hspec : R = V := - (affinePointExhaustiveFinitePlace_spec - hf hpartialFirst hpartialSecond z).1 - have hWR : W = R := hWVeq.trans hspec.symm - let eWR : W ≃+* R := - { toFun := fun x => ⟨x.1, by rw [← hWR]; exact x.2⟩ - invFun := fun x => ⟨x.1, by rw [hWR]; exact x.2⟩ - left_inv := fun x => Subtype.ext rfl - right_inv := fun x => Subtype.ext rfl - map_add' := fun _ _ => rfl - map_mul' := fun _ _ => rfl } - letI : Algebra A R := - RingHom.toAlgebra (eWR.toRingHom.comp (algebraMap A W)) - let eWRAlg : W ≃ₐ[A] R := - { eWR with commutes' := fun _ => rfl } - letI : IsLocalization m.asIdeal.primeCompl R := - IsLocalization.isLocalization_of_algEquiv - m.asIdeal.primeCompl eWRAlg - letI : IsScalarTower K A R := - IsScalarTower.of_algebraMap_eq (R := K) (S := A) (A := R) (fun c => by - apply Subtype.ext - change algebraMap B E (algebraMap K B c) = - algebraMap A E (algebraMap K A c) - rw [← IsScalarTower.algebraMap_apply K B E, - ← IsScalarTower.algebraMap_apply K A E]) - rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q] - calc - Module.finrank K q.asIdeal.ResidueField = - Module.finrank K m.asIdeal.ResidueField := - (finrank_residueField_eq_of_commonLocalization - (C := K) (A := A) (B := B) (R := R) m.asIdeal q.asIdeal).symm - _ = 1 := by - simpa using eCenter.toLinearEquiv.finrank_eq + have hresidue := residue_finrank_eq_of_regular_dominating_valuation K A B E + m q.asIdeal R hm0 + (affinePointExhaustiveFinitePlace_spec hf hpartialFirst hpartialSecond z).1 + (fun c => by + change algebraMap B E (algebraMap K B c) = algebraMap K E c + exact (IsScalarTower.algebraMap_apply K B E c).symm) + rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K E q, ← hresidue] + simpa using eCenter.toLinearEquiv.finrank_eq end end BGS.HasseWeil From fe64c1478544cc6f83230e171823b0fa6994b1d1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:00:21 +0000 Subject: [PATCH 17/37] Factor infinity different through generic field-range base change --- ...actConstantExtensionInfinityDifferent.lean | 791 +++++++++--------- 1 file changed, 397 insertions(+), 394 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean index 53eb2b2385..ac1585b810 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean @@ -48,11 +48,184 @@ local instance exactConstantExtensionInfinityDifferentDecidableEqExtendedRatFunc private theorem exactConstantExtensionInfinityDifferentCanonicalFractionRing (R : Type*) [CommRing R] [IsDomain R] : - letI := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R + let := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R IsFractionRing R (FractionRing R) := by - letI := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R + let := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R infer_instance +private theorem different_eq_map_of_disjoint_fields + (A B R₁ R₂ K L : Type*) + [CommRing A] [IsDomain A] [IsIntegrallyClosed A] + [CommRing B] [IsDedekindDomain B] + [CommRing R₁] [IsDedekindDomain R₁] + [CommRing R₂] [IsDedekindDomain R₂] [Field K] [Field L] + [Algebra A K] [IsFractionRing A K] [Algebra B L] [IsFractionRing B L] + [Algebra A L] [Algebra K L] [FiniteDimensional K L] [Algebra.IsSeparable K L] + [IsScalarTower A K L] [Algebra A B] [IsScalarTower A B L] + [FaithfulSMul A B] [Module.Finite A B] [Module.IsTorsionFree A B] + [Algebra A R₁] [Algebra A R₂] [Algebra R₁ B] [Algebra R₂ B] + [Algebra R₁ L] [Algebra R₂ L] + [IsScalarTower A R₁ L] [IsScalarTower R₁ B L] [IsScalarTower R₂ B L] + [Module.Finite A R₁] [Module.Finite A R₂] [Module.Free A R₂] + [Module.Finite R₁ B] [Module.Finite R₂ B] + [IsScalarTower A R₁ B] [IsScalarTower A R₂ B] + [Module.IsTorsionFree A R₁] [Module.IsTorsionFree A R₂] + [Module.IsTorsionFree R₁ B] [Module.IsTorsionFree R₂ B] + [IsIntegralClosure B R₁ L] + (F₁ F₂ : IntermediateField K L) + [Algebra R₁ F₁] [Algebra R₂ F₂] [Module.IsTorsionFree R₁ F₁] + [IsFractionRing R₁ F₁] [IsFractionRing R₂ F₂] + [IsScalarTower A F₂ L] [IsScalarTower A R₂ F₂] + [IsScalarTower R₁ F₁ L] [IsScalarTower R₂ F₂ L] + [Algebra.IsSeparable K F₂] [Algebra.IsSeparable F₁ L] + [IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂] + (hdisjoint : F₁.LinearDisjoint F₂) (hsup : F₁ ⊔ F₂ = ⊤) + (hcoprime : IsCoprime + ((differentIdeal A R₁).map (algebraMap R₁ B)) + ((differentIdeal A R₂).map (algebraMap R₂ B))) : + differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by + let : Algebra A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra A + let : SMul A (FractionRing A) := Algebra.toSMul + let : IsFractionRing A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRing A + let : Algebra B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra B + let : SMul B (FractionRing B) := Algebra.toSMul + let : IsFractionRing B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRing B + let : Algebra A (FractionRing B) := + RingHom.toAlgebra ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + let : SMul A (FractionRing B) := Algebra.toSMul + let : IsScalarTower A B (FractionRing B) := IsScalarTower.of_algebraMap_eq' rfl + let : FaithfulSMul A (FractionRing B) := by + rw [faithfulSMul_iff_algebraMap_injective] + change Function.Injective + ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + exact (IsFractionRing.injective B (FractionRing B)).comp + (FaithfulSMul.algebraMap_injective A B) + let : Algebra (FractionRing A) (FractionRing B) := FractionRing.liftAlgebra A (FractionRing B) + let : SMul (FractionRing A) (FractionRing B) := Algebra.toSMul + let : IsScalarTower A (FractionRing A) (FractionRing B) := + FractionRing.isScalarTower_liftAlgebra A (FractionRing B) + let : Algebra.IsSeparable (FractionRing A) (FractionRing B) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv A K).symm.toRingEquiv + (FractionRing.algEquiv B L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv A K).symm (FractionRing.algEquiv B L).symm z + exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal + (K := K) (L := L) (F₁ := F₁) (F₂ := F₂) A B R₁ R₂ hdisjoint hsup hcoprime + +private theorem finite_torsionFree_of_integral_base_change + (A R₁ R₂ B K L : Type*) + [CommRing A] [CommRing R₁] [CommRing R₂] [CommRing B] [Field K] [Field L] + [IsDedekindDomain R₂] + [Algebra A R₁] [Algebra A R₂] [Algebra A L] + [Algebra R₁ L] [Algebra R₂ L] [Algebra B L] [Algebra R₂ B] + [Algebra R₂ K] [IsFractionRing R₂ K] [Algebra K L] + [IsScalarTower R₂ K L] [IsScalarTower R₂ B L] [Module.IsTorsionFree R₂ L] + [IsScalarTower A R₁ L] [IsScalarTower A R₂ L] + [Algebra.IsIntegral A R₁] [Algebra.IsIntegral A R₂] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + [IsIntegralClosure B R₁ L] : + Module.Finite R₂ B ∧ Module.IsTorsionFree R₂ B := by + let : IsIntegralClosure B R₂ L := by + refine ⟨IsIntegralClosure.algebraMap_injective B R₁ L, ?_⟩ + intro x + constructor + · intro hx + have hxA : IsIntegral A x := isIntegral_trans (R := A) x hx + exact (IsIntegralClosure.isIntegral_iff (A := B) (R := R₁)).mp hxA.tower_top + · intro hx + have hxR₁ : IsIntegral R₁ x := + (IsIntegralClosure.isIntegral_iff (A := B) (R := R₁)).mpr hx + exact (isIntegral_trans (R := A) x hxR₁).tower_top + exact ⟨IsIntegralClosure.finite R₂ K L B, IsIntegralClosure.isTorsionFree R₂ L⟩ + +private theorem different_eq_map_of_disjoint_ranges + (A R₁ R₂ B K K₁ K₂ L : Type*) + [CommRing A] [IsDomain A] [IsPrincipalIdealRing A] + [CommRing R₁] [IsDedekindDomain R₁] + [CommRing R₂] [IsDedekindDomain R₂] [CommRing B] [IsDedekindDomain B] + [Field K] [Field K₁] [Field K₂] [Field L] + [Algebra A K] [IsFractionRing A K] + [Algebra K K₁] [Algebra K K₂] [Algebra K L] + [Algebra K₁ L] [Algebra K₂ L] [Algebra A K₂] + [IsScalarTower K K₁ L] [IsScalarTower K K₂ L] [IsScalarTower A K K₂] + [Algebra A R₁] [Algebra A R₂] [Algebra A B] [Algebra A L] + [Algebra R₁ K₁] [IsFractionRing R₁ K₁] + [Algebra R₂ K₂] [IsFractionRing R₂ K₂] + [Algebra R₁ B] [Algebra R₂ B] [Algebra R₁ L] [Algebra R₂ L] [Algebra B L] + [IsScalarTower A K L] [IsScalarTower A K₂ L] + [IsScalarTower R₁ K₁ L] [IsScalarTower R₂ K₂ L] + [IsScalarTower A R₂ K₂] [IsScalarTower A R₁ L] [IsScalarTower A R₂ L] + [IsScalarTower A R₁ B] [IsScalarTower A R₂ B] + [IsScalarTower R₁ B L] [IsScalarTower R₂ B L] [IsScalarTower A B L] + [FiniteDimensional K K₂] [FiniteDimensional K L] [Algebra.IsSeparable K L] + [Module.Finite A R₁] [Module.Finite A R₂] [Module.Free A R₂] + [Module.IsTorsionFree A R₁] [Module.IsTorsionFree A R₂] + [Module.IsTorsionFree R₁ L] [Module.IsTorsionFree R₂ L] + [Module.IsTorsionFree R₁ B] + [IsIntegralClosure R₂ A K₂] [IsIntegralClosure B R₁ L] + (hdisjoint : (IsScalarTower.toAlgHom K K₁ L).fieldRange.LinearDisjoint + (IsScalarTower.toAlgHom K K₂ L).fieldRange) + (hsup : (IsScalarTower.toAlgHom K K₁ L).fieldRange ⊔ + (IsScalarTower.toAlgHom K K₂ L).fieldRange = ⊤) + (hcoprime : IsCoprime ((differentIdeal A R₁).map (algebraMap R₁ B)) + ((differentIdeal A R₂).map (algebraMap R₂ B))) : + differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by + let f₁ := IsScalarTower.toAlgHom K K₁ L + let f₂ := IsScalarTower.toAlgHom K K₂ L + let F₁ := f₁.fieldRange + let F₂ := f₂.fieldRange + let e₁ := f₁.equivFieldRange + let e₂ := f₂.equivFieldRange + let : Algebra R₁ F₁ := + RingHom.toAlgebra (e₁.toRingHom.comp (algebraMap R₁ K₁)) + let e₁inf : K₁ ≃ₐ[R₁] F₁ := { e₁.toRingEquiv with commutes' := fun _ => rfl } + let : IsFractionRing R₁ F₁ := IsFractionRing.of_algEquiv e₁inf + let : Module.IsTorsionFree R₁ F₁ := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact IsFractionRing.injective R₁ F₁ + let : IsScalarTower R₁ F₁ L := IsScalarTower.of_algebraMap_eq (fun z => by + change algebraMap R₁ L z = algebraMap K₁ L (algebraMap R₁ K₁ z) + exact IsScalarTower.algebraMap_apply R₁ K₁ L z) + let : Algebra R₂ F₂ := + RingHom.toAlgebra (e₂.toRingHom.comp (algebraMap R₂ K₂)) + let e₂norm : K₂ ≃ₐ[R₂] F₂ := { e₂.toRingEquiv with commutes' := fun _ => rfl } + let : IsFractionRing R₂ F₂ := IsFractionRing.of_algEquiv e₂norm + let : IsScalarTower R₂ F₂ L := IsScalarTower.of_algebraMap_eq (fun z => by + change algebraMap R₂ L z = algebraMap K₂ L (algebraMap R₂ K₂ z) + exact IsScalarTower.algebraMap_apply R₂ K₂ L z) + let : Algebra A F₂ := IntermediateField.algebra' F₂ + let : IsScalarTower A R₂ F₂ := IsScalarTower.of_algebraMap_eq (fun z => by + apply Subtype.ext + change algebraMap A L z = algebraMap K₂ L (algebraMap R₂ K₂ (algebraMap A R₂ z)) + rw [← IsScalarTower.algebraMap_apply A R₂ K₂, + ← IsScalarTower.algebraMap_apply A K₂ L]) + let : IsScalarTower A F₂ L := IsScalarTower.of_algebraMap_eq' rfl + let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) K₂ := + IsIntegralClosure.isLocalization A K K₂ R₂ + let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂ := + IsLocalization.isLocalization_of_algEquiv _ e₂norm + have hnormalization := finite_torsionFree_of_integral_base_change A R₁ R₂ B F₂ L + let : Module.Finite R₂ B := hnormalization.1 + let : Module.IsTorsionFree R₂ B := hnormalization.2 + let : Module.Finite R₁ B := IsIntegralClosure.finite R₁ F₁ L B + let : Module.Finite A B := Module.Finite.trans R₂ B + let : Module.IsTorsionFree A B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + have hR₂B := Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree R₂ B from inferInstance) + have hAR₂ := Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree A R₂ from inferInstance) + intro x y hxy + apply hAR₂ + apply hR₂B + exact (IsScalarTower.algebraMap_apply A R₂ B x).symm.trans + (hxy.trans (IsScalarTower.algebraMap_apply A R₂ B y)) + let : IsFractionRing B L := + IsIntegralClosure.isFractionRing_of_finite_extension R₁ F₁ L B + exact different_eq_map_of_disjoint_fields A B R₁ R₂ K L F₁ F₂ hdisjoint hsup hcoprime + variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) @@ -60,75 +233,75 @@ private noncomputable def exactConstantExtensionInfinityDifferentNormalizationRingHom [Fintype C] [Finite S] : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : Algebra (RatFunc S) L := + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + let : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + let : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : Algebra (RatFuncInfinityIntegers C) N := + let : Algebra (RatFuncInfinityIntegers C) N := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers C) L := + let : Algebra (RatFuncInfinityIntegers C) L := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers S) L := + let : Algebra (RatFuncInfinityIntegers S) L := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : Algebra (RatFuncInfinityIntegers C) + let : Algebra (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) RatFuncInfinityIntegralClosure C N →+* RatFuncInfinityIntegralClosure S L := by let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) L := Algebra.toSMul - letI : Module (RatFunc C) L := Algebra.toModule - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : SMul N L := Algebra.toSMul - letI : Module N L := Algebra.toModule - letI : IsScalarTower (RatFunc C) N L := + let : SMul (RatFunc C) L := Algebra.toSMul + let : Module (RatFunc C) L := Algebra.toModule + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : SMul N L := Algebra.toSMul + let : Module N L := Algebra.toModule + let : IsScalarTower (RatFunc C) N L := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule - letI : Algebra (RatFunc S) L := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : Module (RatFunc C) (RatFunc S) := Algebra.toModule + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc S) L := Algebra.toModule + let : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : SMul (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toModule - letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + let : SMul (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toSMul + let : Module (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.toModule + let : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : SMul (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.toModule - letI : Algebra (RatFuncInfinityIntegers C) N := + let : SMul (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.toSMul + let : Module (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.toModule + let : Algebra (RatFuncInfinityIntegers C) N := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : SMul (RatFuncInfinityIntegers C) N := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers C) N := Algebra.toModule - letI : Algebra (RatFuncInfinityIntegers C) L := + let : SMul (RatFuncInfinityIntegers C) N := Algebra.toSMul + let : Module (RatFuncInfinityIntegers C) N := Algebra.toModule + let : Algebra (RatFuncInfinityIntegers C) L := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : SMul (RatFuncInfinityIntegers C) L := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers C) L := Algebra.toModule - letI : Algebra (RatFuncInfinityIntegers S) L := + let : SMul (RatFuncInfinityIntegers C) L := Algebra.toSMul + let : Module (RatFuncInfinityIntegers C) L := Algebra.toModule + let : Algebra (RatFuncInfinityIntegers S) L := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : SMul (RatFuncInfinityIntegers S) L := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers S) L := Algebra.toModule - letI : Algebra (RatFuncInfinityIntegers C) + let : SMul (RatFuncInfinityIntegers S) L := Algebra.toSMul + let : Module (RatFuncInfinityIntegers S) L := Algebra.toModule + let : Algebra (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : SMul (RatFuncInfinityIntegers C) + let : SMul (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers C) + let : Module (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := Algebra.toModule - letI : Module.Finite (RatFuncInfinityIntegers C) + let : Module.Finite (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := ratFuncInfinityIntegers_coefficient_moduleFinite C S - letI : IsScalarTower (RatFuncInfinityIntegers C) + let : IsScalarTower (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) L := IsScalarTower.of_algebraMap_eq' (by ext z @@ -137,7 +310,7 @@ private noncomputable def (ratFuncCoefficientAlgHom C S z.1) exact DFunLike.congr_fun (rationalBase_algebraMap_eq C S N hExact) z.1) - letI : IsScalarTower (RatFuncInfinityIntegers C) N L := + let : IsScalarTower (RatFuncInfinityIntegers C) N L := IsScalarTower.of_algebraMap_eq' (by ext z change algebraMap (RatFunc C) L z.1 = @@ -158,19 +331,19 @@ original function field. -/ exactConstantExtensionInfinityNormalizationAlgebra [Fintype C] [Finite S] : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : Algebra (RatFunc S) L := + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + let : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + let : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : Algebra (RatFuncInfinityIntegers C) N := + let : Algebra (RatFuncInfinityIntegers C) N := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers C) + let : Algebra (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) Algebra (RatFuncInfinityIntegralClosure C N) (RatFuncInfinityIntegralClosure S L) := @@ -185,35 +358,35 @@ theorem exactConstantExtensionInfinityNormalizationAlgebra_coe [Fintype C] [Finite S] (x : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : Algebra (RatFunc S) L := + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + let : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + let : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : Algebra (RatFuncInfinityIntegers C) N := + let : Algebra (RatFuncInfinityIntegers C) N := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) RatFuncInfinityIntegralClosure C N) : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : Algebra (RatFunc S) L := + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := + let : Algebra (RatFuncInfinityIntegers C) (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := + let : Algebra (RatFuncInfinityIntegers S) (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : Algebra (RatFuncInfinityIntegers C) N := + let : Algebra (RatFuncInfinityIntegers C) N := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : Algebra (RatFuncInfinityIntegers C) + let : Algebra (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : Algebra (RatFuncInfinityIntegralClosure C N) + let : Algebra (RatFuncInfinityIntegralClosure C N) (RatFuncInfinityIntegralClosure S L) := exactConstantExtensionInfinityNormalizationAlgebra C S N hExact ((algebraMap (RatFuncInfinityIntegralClosure C N) @@ -228,45 +401,45 @@ underlying ring equivalence is the identity on the ambient function field. -/ noncomputable def exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv [Fintype C] [Finite S] : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) L := + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact RatFuncInfinityIntegralClosure C L ≃+* RatFuncInfinityIntegralClosure S L := by let L := ExactConstantExtension C N S let A := RatFuncInfinityIntegers C let R₁ := RatFuncInfinityIntegers S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) L := Algebra.toSMul - letI : Module (RatFunc C) L := Algebra.toModule - letI : Algebra (RatFunc S) L := + let : SMul (RatFunc C) L := Algebra.toSMul + let : Module (RatFunc C) L := Algebra.toModule + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring A - letI : SMul A (RatFunc C) := Algebra.toSMul - letI : Module A (RatFunc C) := Algebra.toModule - letI : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring R₁ - letI : SMul R₁ (RatFunc S) := Algebra.toSMul - letI : Module R₁ (RatFunc S) := Algebra.toModule - letI : Algebra A L := Algebra.ofSubsemiring A - letI : SMul A L := Algebra.toSMul - letI : Module A L := Algebra.toModule - letI : Algebra R₁ L := Algebra.ofSubsemiring R₁ - letI : SMul R₁ L := Algebra.toSMul - letI : Module R₁ L := Algebra.toModule - letI : Algebra A R₁ := + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc S) L := Algebra.toModule + let : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + let : SMul A (RatFunc C) := Algebra.toSMul + let : Module A (RatFunc C) := Algebra.toModule + let : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring R₁ + let : SMul R₁ (RatFunc S) := Algebra.toSMul + let : Module R₁ (RatFunc S) := Algebra.toModule + let : Algebra A L := Algebra.ofSubsemiring A + let : SMul A L := Algebra.toSMul + let : Module A L := Algebra.toModule + let : Algebra R₁ L := Algebra.ofSubsemiring R₁ + let : SMul R₁ L := Algebra.toSMul + let : Module R₁ L := Algebra.toModule + let : Algebra A R₁ := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : SMul A R₁ := Algebra.toSMul - letI : Module A R₁ := Algebra.toModule - letI : Module.Finite A R₁ := + let : SMul A R₁ := Algebra.toSMul + let : Module A R₁ := Algebra.toModule + let : Module.Finite A R₁ := ratFuncInfinityIntegers_coefficient_moduleFinite C S - letI : Algebra.IsIntegral A R₁ := by infer_instance - letI : IsScalarTower A R₁ L := + let : Algebra.IsIntegral A R₁ := by infer_instance + let : IsScalarTower A R₁ L := IsScalarTower.of_algebraMap_eq' (by ext z change algebraMap (RatFunc C) L z.1 = @@ -281,17 +454,17 @@ theorem exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv_coe [Fintype C] [Finite S] (x : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) L := + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact RatFuncInfinityIntegralClosure C L) : let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) L := + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact (((exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv C S N hExact) x : RatFuncInfinityIntegralClosure S L) : L) = x := by @@ -304,339 +477,169 @@ theorem exactConstantExtension_infinityDifferent_eq_map let L := ExactConstantExtension C N S let A := RatFuncInfinityIntegers C let R₁ := RatFuncInfinityIntegers S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : Algebra (RatFunc S) L := + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : SMul A (RatFunc C) := Algebra.toSMul - letI : Module A (RatFunc C) := Algebra.toModule - letI : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : SMul R₁ (RatFunc S) := Algebra.toSMul - letI : Module R₁ (RatFunc S) := Algebra.toModule - letI : IsFractionRing A (RatFunc C) := + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc S) L := Algebra.toModule + let : Algebra A (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) + let : SMul A (RatFunc C) := Algebra.toSMul + let : Module A (RatFunc C) := Algebra.toModule + let : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) + let : SMul R₁ (RatFunc S) := Algebra.toSMul + let : Module R₁ (RatFunc S) := Algebra.toModule + let : IsFractionRing A (RatFunc C) := IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) - letI : IsFractionRing R₁ (RatFunc S) := + let : IsFractionRing R₁ (RatFunc S) := IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) - letI : Algebra A N := + let : Algebra A N := Algebra.ofSubsemiring A - letI : SMul A N := Algebra.toSMul - letI : Module A N := Algebra.toModule - letI : IsScalarTower A (RatFunc C) N := + let : SMul A N := Algebra.toSMul + let : Module A N := Algebra.toModule + let : IsScalarTower A (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra A R₁ := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : Algebra R₁ L := + let : Algebra A R₁ := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + let : Algebra R₁ L := Algebra.ofSubsemiring R₁ - letI : SMul R₁ L := Algebra.toSMul - letI : Module R₁ L := Algebra.toModule - letI : IsScalarTower R₁ (RatFunc S) L := + let : SMul R₁ L := Algebra.toSMul + let : Module R₁ L := Algebra.toModule + let : IsScalarTower R₁ (RatFunc S) L := IsScalarTower.of_algebraMap_eq' rfl let R₂ := RatFuncInfinityIntegralClosure C N let B := RatFuncInfinityIntegralClosure S L - letI : IsIntegralClosure R₂ A N := + let : Algebra A R₂ := Subalgebra.algebra R₂ + let : SMul A R₂ := Algebra.toSMul + let : Module A R₂ := Algebra.toModule + let : Algebra R₁ B := Subalgebra.algebra B + let : SMul R₁ B := Algebra.toSMul + let : Module R₁ B := Algebra.toModule + let : IsIntegralClosure R₂ A N := integralClosure.isIntegralClosure A N - letI : IsIntegralClosure B R₁ L := + let : IsIntegralClosure B R₁ L := integralClosure.isIntegralClosure R₁ L - letI : FiniteDimensional (RatFunc S) L := + let : FiniteDimensional (RatFunc S) L := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) L := + let : Algebra.IsSeparable (RatFunc S) L := isSeparable_over_extendedRatFunc C S N hExact - letI : IsDedekindDomain R₂ := + let : IsDedekindDomain R₂ := integralClosure.isDedekindDomain A (RatFunc C) N - letI : IsDedekindDomain B := + let : IsDedekindDomain B := integralClosure.isDedekindDomain R₁ (RatFunc S) L - letI : Algebra R₂ B := + let : Module.IsTorsionFree A R₂ := IsIntegralClosure.isTorsionFree A N + let : Module.IsTorsionFree R₁ B := IsIntegralClosure.isTorsionFree R₁ L + let : Algebra R₂ B := exactConstantExtensionInfinityNormalizationAlgebra C S N hExact differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by - let L := ExactConstantExtension C N S - let A := RatFuncInfinityIntegers C - let R₁ := RatFuncInfinityIntegers S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) L := Algebra.toSMul - letI : Module (RatFunc C) L := Algebra.toModule - letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction - letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : SMul N L := Algebra.toSMul - letI : Module N L := Algebra.toModule - letI : IsScalarTower (RatFunc C) N L := + intro L A R₁ model3 model4 model5 model6 model7 model8 model9 + model10 model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 model21 + model22 model23 model24 model25 R₂ B model28 model29 model30 model31 model32 model33 + model34 model35 model36 model37 model38 model39 model40 model41 model42 + let : SMul (RatFunc C) L := Algebra.toSMul + let : Module (RatFunc C) L := Algebra.toModule + let : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + let : MulAction (RatFunc C) L := DistribMulAction.toMulAction + let : SMul N L := Algebra.toSMul + let : Module N L := Algebra.toModule + let : IsScalarTower (RatFunc C) N L := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule - letI : Algebra (RatFunc S) L := - ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : IsScalarTower (RatFunc C) (RatFunc S) L := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : Module (RatFunc C) (RatFunc S) := Algebra.toModule + let : IsScalarTower (RatFunc C) (RatFunc S) L := rationalBase_scalarTower C S N hExact - letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring (RatFuncInfinityIntegers C) - letI : SMul A (RatFunc C) := Algebra.toSMul - letI : Module A (RatFunc C) := Algebra.toModule - letI : IsFractionRing A (RatFunc C) := - IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) - letI : Algebra R₁ (RatFunc S) := Algebra.ofSubsemiring (RatFuncInfinityIntegers S) - letI : SMul R₁ (RatFunc S) := Algebra.toSMul - letI : Module R₁ (RatFunc S) := Algebra.toModule - letI : IsFractionRing R₁ (RatFunc S) := - IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) - letI : Algebra A R₁ := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : SMul A R₁ := Algebra.toSMul - letI : Module A R₁ := Algebra.toModule - letI : Module.Finite A R₁ := + let : SMul A R₁ := Algebra.toSMul + let : Module A R₁ := Algebra.toModule + let : Module.Finite A R₁ := ratFuncInfinityIntegers_coefficient_moduleFinite C S - letI : Module.IsTorsionFree A R₁ := by + let : Module.IsTorsionFree A R₁ := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective (ratFuncInfinityIntegersRingHom C S) exact ratFuncInfinityIntegersRingHom_injective C S - letI : Algebra.IsIntegral A R₁ := by infer_instance - letI : Algebra A N := - Algebra.ofSubsemiring A - letI : SMul A N := Algebra.toSMul - letI : Module A N := Algebra.toModule - letI : IsScalarTower A (RatFunc C) N := - IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra A L := + let : Algebra.IsIntegral A R₁ := by infer_instance + let : Algebra A L := Algebra.ofSubsemiring A - letI : SMul A L := Algebra.toSMul - letI : Module A L := Algebra.toModule - letI : IsScalarTower A (RatFunc C) L := - IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra R₁ L := - Algebra.ofSubsemiring R₁ - letI : SMul R₁ L := Algebra.toSMul - letI : Module R₁ L := Algebra.toModule - letI : DistribMulAction R₁ L := Module.toDistribMulAction - letI : MulAction R₁ L := DistribMulAction.toMulAction - letI : IsScalarTower R₁ (RatFunc S) L := + let : SMul A L := Algebra.toSMul + let : Module A L := Algebra.toModule + let : IsScalarTower A (RatFunc C) L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower A R₁ L := + let : DistribMulAction R₁ L := Module.toDistribMulAction + let : MulAction R₁ L := DistribMulAction.toMulAction + let : IsScalarTower A R₁ L := IsScalarTower.of_algebraMap_eq' (by ext z change algebraMap (RatFunc C) L z.1 = algebraMap (RatFunc S) L (ratFuncCoefficientAlgHom C S z.1) exact DFunLike.congr_fun (rationalBase_algebraMap_eq C S N hExact) z.1) - let R₂ := RatFuncInfinityIntegralClosure C N - let B := RatFuncInfinityIntegralClosure S L - letI := Subalgebra.algebra R₂ - letI : SMul A R₂ := Algebra.toSMul - letI : Module A R₂ := Algebra.toModule - letI : Algebra R₂ N := Algebra.ofSubsemiring R₂ - letI : SMul R₂ N := Algebra.toSMul - letI : Module R₂ N := Algebra.toModule - letI : IsScalarTower A R₂ N := + let : Algebra R₂ N := Algebra.ofSubsemiring R₂ + let : SMul R₂ N := Algebra.toSMul + let : Module R₂ N := Algebra.toModule + let : IsScalarTower A R₂ N := IsScalarTower.of_algebraMap_eq' (by ext z; rfl) - letI := Subalgebra.algebra B - letI : SMul R₁ B := Algebra.toSMul - letI : Module R₁ B := Algebra.toModule - letI : Algebra B L := Algebra.ofSubsemiring B - letI : SMul B L := Algebra.toSMul - letI : Module B L := Algebra.toModule - letI : IsScalarTower R₁ B L := + let : Algebra B L := Algebra.ofSubsemiring B + let : SMul B L := Algebra.toSMul + let : Module B L := Algebra.toModule + let : IsScalarTower R₁ B L := IsScalarTower.of_algebraMap_eq' (by ext z; rfl) - letI : IsIntegralClosure R₂ A N := - integralClosure.isIntegralClosure A N - letI : IsIntegralClosure B R₁ L := - integralClosure.isIntegralClosure R₁ L - letI : IsDomain R₂ := inferInstance - letI : IsDomain B := inferInstance - letI : Module.IsTorsionFree R₁ L := by + let : IsIntegralClosure R₂ A N := integralClosure.isIntegralClosure A N + let : IsIntegralClosure B R₁ L := integralClosure.isIntegralClosure R₁ L + let : IsDomain R₂ := inferInstance + let : IsDomain B := inferInstance + let : Module.IsTorsionFree R₁ L := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact (algebraMap (RatFunc S) L).injective.comp (IsFractionRing.injective R₁ (RatFunc S)) - letI : FiniteDimensional (RatFunc S) L := - finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) L := - isSeparable_over_extendedRatFunc C S N hExact let eNL := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N L := Module.Finite.equiv eNL - letI : FiniteDimensional (RatFunc C) L := Module.Finite.trans N L - letI : Algebra.IsSeparable (RatFunc C) L := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N L := Module.Finite.equiv eNL + let : FiniteDimensional (RatFunc C) L := Module.Finite.trans N L + let : Algebra.IsSeparable (RatFunc C) L := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let f₁ : RatFunc S →ₐ[RatFunc C] L := - IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L - let f₂ : N →ₐ[RatFunc C] L := - IsScalarTower.toAlgHom (RatFunc C) N L - let F₁ : IntermediateField (RatFunc C) L := f₁.fieldRange - let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange - let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange - let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange - letI : Algebra R₁ F₁ := - RingHom.toAlgebra - (e₁.toRingEquiv.toRingHom.comp (algebraMap R₁ (RatFunc S))) - letI : SMul R₁ F₁ := Algebra.toSMul - letI : Module R₁ F₁ := Algebra.toModule - let e₁inf : RatFunc S ≃ₐ[R₁] F₁ := - { e₁.toRingEquiv with commutes' := fun _ => rfl } - letI : IsFractionRing R₁ F₁ := IsFractionRing.of_algEquiv e₁inf - letI : Module.IsTorsionFree R₁ F₁ := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - exact IsFractionRing.injective R₁ F₁ - letI : IsScalarTower R₁ F₁ L := - IsScalarTower.of_algebraMap_eq' (by - ext z - change algebraMap R₁ L z = f₁ (algebraMap R₁ (RatFunc S) z) - rfl) - letI : Algebra R₂ F₂ := - RingHom.toAlgebra - (e₂.toRingEquiv.toRingHom.comp (algebraMap R₂ N)) - letI : SMul R₂ F₂ := Algebra.toSMul - letI : Module R₂ F₂ := Algebra.toModule - let e₂norm : N ≃ₐ[R₂] F₂ := - { e₂.toRingEquiv with commutes' := fun _ => rfl } - letI : Algebra R₂ L := - RingHom.toAlgebra ((algebraMap F₂ L).comp (algebraMap R₂ F₂)) - letI : SMul R₂ L := Algebra.toSMul - letI : Module R₂ L := Algebra.toModule - letI : IsScalarTower R₂ F₂ L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing R₂ N := + let : Algebra R₂ L := + RingHom.toAlgebra ((algebraMap N L).comp (algebraMap R₂ N)) + let : SMul R₂ L := Algebra.toSMul + let : Module R₂ L := Algebra.toModule + let : IsScalarTower R₂ N L := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower A N L := IsScalarTower.of_algebraMap_eq (fun z => by + change algebraMap (RatFunc C) L z.1 = + algebraMap N L (algebraMap (RatFunc C) N z.1) + exact IsScalarTower.algebraMap_apply (RatFunc C) N L z.1) + let : IsScalarTower A R₂ L := IsScalarTower.of_algebraMap_eq (fun z => by + change algebraMap A L z = algebraMap N L (algebraMap R₂ N (algebraMap A R₂ z)) + rw [← IsScalarTower.algebraMap_apply A R₂ N, + ← IsScalarTower.algebraMap_apply A N L]) + let : IsFractionRing R₂ N := IsIntegralClosure.isFractionRing_of_finite_extension A (RatFunc C) N R₂ - letI : IsFractionRing R₂ F₂ := IsFractionRing.of_algEquiv e₂norm - letI : Module.IsTorsionFree R₂ L := by + let : Module.IsTorsionFree R₂ L := by rw [Module.isTorsionFree_iff_algebraMap_injective] - exact (algebraMap F₂ L).injective.comp - (IsFractionRing.injective R₂ F₂) - letI : Algebra A F₂ := IntermediateField.algebra' F₂ - letI : SMul A F₂ := Algebra.toSMul - letI : IsScalarTower A R₂ F₂ := - IsScalarTower.of_algebraMap_eq' (by - ext z - change algebraMap (RatFunc C) L z.1 = - algebraMap N L (algebraMap (RatFunc C) N z.1) - exact IsScalarTower.algebraMap_apply (RatFunc C) N L z.1) - letI : IsScalarTower A F₂ L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower A R₂ L := - IsScalarTower.of_algebraMap_eq' (by - ext z - change algebraMap A L z = - algebraMap F₂ L (algebraMap R₂ F₂ (algebraMap A R₂ z)) - rw [← IsScalarTower.algebraMap_apply A R₂ F₂] - exact IsScalarTower.algebraMap_apply A F₂ L z) - letI : IsLocalization - (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) N := - IsIntegralClosure.isLocalization A (RatFunc C) N R₂ - letI : IsLocalization - (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂ := - IsLocalization.isLocalization_of_algEquiv _ e₂norm - letI : Algebra R₂ B := - exactConstantExtensionInfinityNormalizationAlgebra C S N hExact - letI : SMul R₂ B := Algebra.toSMul - letI : Module R₂ B := Algebra.toModule - letI : IsScalarTower R₂ B L := - IsScalarTower.of_algebraMap_eq' (by - ext x - exact exactConstantExtensionInfinityNormalizationAlgebra_coe - C S N hExact x) - letI : IsScalarTower A R₂ B := - IsScalarTower.of_algebraMap_eq' (by - ext z - calc - ((algebraMap A B z : B) : L) = algebraMap A L z := rfl - _ = algebraMap R₂ L (algebraMap A R₂ z) := - IsScalarTower.algebraMap_apply A R₂ L z - _ = algebraMap B L (algebraMap R₂ B (algebraMap A R₂ z)) := - IsScalarTower.algebraMap_apply R₂ B L _) - letI : Module.Finite A R₂ := - IsIntegralClosure.finite A (RatFunc C) N R₂ - letI : Module.IsTorsionFree A R₂ := - IsIntegralClosure.isTorsionFree A N - letI : Module.Free A R₂ := Module.free_of_finite_type_torsion_free' - letI : IsDedekindDomain R₂ := - integralClosure.isDedekindDomain A (RatFunc C) N - letI : IsDedekindDomain B := - integralClosure.isDedekindDomain R₁ (RatFunc S) L - letI : IsIntegralClosure B R₂ L := by - refine ⟨?_, ?_⟩ - · exact fun x y h => Subtype.ext h - · intro x - constructor - · intro hx - have hxA : IsIntegral A x := isIntegral_trans (R := A) x hx - have hxR₁ : IsIntegral R₁ x := hxA.tower_top - exact ⟨⟨x, hxR₁⟩, rfl⟩ - · rintro ⟨y, rfl⟩ - have hyA : IsIntegral A (y : L) := - isIntegral_trans (R := A) (y : L) y.2 - exact hyA.tower_top - letI : Module.Finite R₂ B := - IsIntegralClosure.finite R₂ F₂ L B - letI : Module.IsTorsionFree R₂ B := - IsIntegralClosure.isTorsionFree R₂ L - letI : Module.Finite R₁ B := - IsIntegralClosure.finite R₁ F₁ L B - letI : Module.IsTorsionFree R₁ B := - IsIntegralClosure.isTorsionFree R₁ L - letI : Module.Finite A B := Module.Finite.trans R₂ B - letI : Module.IsTorsionFree A B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - have hR₂B : Function.Injective (algebraMap R₂ B) := - Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree R₂ B from inferInstance) - have hAR₂ : Function.Injective (algebraMap A R₂) := - Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree A R₂ from inferInstance) - exact hR₂B.comp hAR₂ - letI : IsIntegralClosure B R₁ L := inferInstance - letI : IsFractionRing B L := - IsIntegralClosure.isFractionRing_of_finite_extension R₁ F₁ L B - letI : Algebra.IsSeparable (RatFunc C) F₂ := inferInstance - letI : Algebra.IsSeparable F₁ L := inferInstance - letI : Algebra A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra A - letI : SMul A (FractionRing A) := Algebra.toSMul - letI : IsFractionRing A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRing A - letI : Algebra B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra B - letI : SMul B (FractionRing B) := Algebra.toSMul - letI : IsFractionRing B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRing B - letI : Algebra A (FractionRing B) := - RingHom.toAlgebra - ((algebraMap B (FractionRing B)).comp (algebraMap A B)) - letI : SMul A (FractionRing B) := Algebra.toSMul - letI : IsScalarTower A B (FractionRing B) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FaithfulSMul A (FractionRing B) := by - rw [faithfulSMul_iff_algebraMap_injective] - exact (IsFractionRing.injective B (FractionRing B)).comp - (Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree A B from inferInstance)) - letI : Algebra (FractionRing A) (FractionRing B) := - FractionRing.liftAlgebra A (FractionRing B) - letI : SMul (FractionRing A) (FractionRing B) := Algebra.toSMul - letI : IsScalarTower A (FractionRing A) (FractionRing B) := - FractionRing.isScalarTower_liftAlgebra A (FractionRing B) - letI : Algebra.IsSeparable (FractionRing A) (FractionRing B) := by - refine Algebra.IsSeparable.of_equiv_equiv - (ratFuncInfinityFractionRingEquiv C).symm.toRingEquiv - (FractionRing.algEquiv B L).symm.toRingEquiv ?_ + exact (algebraMap N L).injective.comp (IsFractionRing.injective R₂ N) + let : SMul R₂ B := Algebra.toSMul + let : Module R₂ B := Algebra.toModule + let : IsScalarTower R₂ B L := IsScalarTower.of_algebraMap_eq' (by + ext x + exact exactConstantExtensionInfinityNormalizationAlgebra_coe C S N hExact x) + let : IsScalarTower A R₂ B := IsScalarTower.of_algebraMap_eq' (by ext z - exact IsFractionRing.algEquiv_commutes - (ratFuncInfinityFractionRingEquiv C).symm - (FractionRing.algEquiv B L).symm z - have hranges := - exactConstantExtension_rationalFunctionRanges_linearDisjoint C S N hExact - have hdisjoint : F₁.LinearDisjoint F₂ := hranges.1 - have hsup : F₁ ⊔ F₂ = ⊤ := hranges.2 - have hcoprime : - IsCoprime - ((differentIdeal A R₁).map (algebraMap R₁ B)) - ((differentIdeal A R₂).map (algebraMap R₂ B)) := by - rw [ratFuncInfinityIntegers_coefficient_differentIdeal_eq_top C S] - rw [Ideal.map_top] - apply Ideal.isCoprime_iff_sup_eq.mpr - exact top_sup_eq - (Ideal.map (algebraMap R₂ B) (differentIdeal A R₂)) - exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal - (K := RatFunc C) (L := L) (F₁ := F₁) (F₂ := F₂) - A B R₁ R₂ hdisjoint hsup hcoprime + calc + ((algebraMap A B z : B) : L) = algebraMap A L z := rfl + _ = algebraMap R₂ L (algebraMap A R₂ z) := + IsScalarTower.algebraMap_apply A R₂ L z + _ = algebraMap B L (algebraMap R₂ B (algebraMap A R₂ z)) := + IsScalarTower.algebraMap_apply R₂ B L _) + let : Module.Finite A R₂ := IsIntegralClosure.finite A (RatFunc C) N R₂ + let : Module.Free A R₂ := Module.free_of_finite_type_torsion_free' + have hranges := exactConstantExtension_rationalFunctionRanges_linearDisjoint C S N hExact + have hcoprime : IsCoprime ((differentIdeal A R₁).map (algebraMap R₁ B)) + ((differentIdeal A R₂).map (algebraMap R₂ B)) := by + rw [ratFuncInfinityIntegers_coefficient_differentIdeal_eq_top C S, Ideal.map_top] + exact Ideal.isCoprime_iff_sup_eq.mpr (top_sup_eq _) + exact different_eq_map_of_disjoint_ranges A R₁ R₂ B (RatFunc C) (RatFunc S) N L + hranges.1 hranges.2 hcoprime end From c093bb72d37d8a2294ad422c4b7fedc37429d3f1 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:06:32 +0000 Subject: [PATCH 18/37] Repair Frobenius-twist descent and intermediate field finiteness --- ...stantExtensionFrobeniusTwistInfinityPlaceDescent.lean | 6 ++---- ...sionIntermediateFrobeniusTwistFinitePlaceAverage.lean | 9 +++++---- 2 files changed, 7 insertions(+), 8 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean index 686609f6ce..fad02d49d2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean @@ -782,10 +782,8 @@ theorem frobeniusTwistField_infinityPlace_ramificationIdx_eq_one (h.1 : T ≃ₐ[RatFunc C] T) = sigma ^ k := hk.symm _ = 1 := hsigma have hh : h = 1 := Subtype.ext hambient - calc - tau = e h := (e.apply_symm_apply tau).symm - _ = e 1 := congrArg e hh - _ = 1 := map_one e + exact (e.apply_symm_apply tau).symm.trans + ((congrArg e hh).trans (map_one e)) · intro htau rw [Subgroup.mem_bot] at htau simp [htau] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 9f502dc058..1bcf716c93 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -247,6 +247,9 @@ theorem finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g letI : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact + let : Module.IsTorsionFree F T := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap F T).injective exact Module.Finite.left (RatFunc C) F T /-- Separability of the exact constant extension descends to every @@ -608,10 +611,8 @@ theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one (h.1 : T ≃ₐ[L] T) = sigma ^ k := hk.symm _ = 1 := hsigma have hh : h = 1 := Subtype.ext hambient - calc - tau = e h := (e.apply_symm_apply tau).symm - _ = e 1 := congrArg e hh - _ = 1 := map_one e + exact (e.apply_symm_apply tau).symm.trans + ((congrArg e hh).trans (map_one e)) · intro htau rw [Subgroup.mem_bot] at htau simp [htau] From e1ffee84172613869bf57f1e45e7f83fdb5c7022 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:18:18 +0000 Subject: [PATCH 19/37] Factor local different nonvanishing and normalization injectivity --- ...ConstantExtensionDifferentCoefficient.lean | 163 ++++++++---------- 1 file changed, 72 insertions(+), 91 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean index 4e7299aed2..6fe0e3570a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean @@ -620,6 +620,53 @@ theorem exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one exact exactConstantExtensionInfinityPlace_ramificationIdx_eq_one C S N hExact Q +private theorem different_ne_bot_of_fraction_fields + (A B K L : Type*) [CommRing A] [IsDomain A] [IsIntegrallyClosed A] + [CommRing B] [IsDedekindDomain B] [Field K] [Field L] + [Algebra A K] [IsFractionRing A K] [Algebra B L] [IsFractionRing B L] + [Algebra A L] [Algebra K L] [Algebra.IsSeparable K L] + [IsScalarTower A K L] [Algebra A B] [IsScalarTower A B L] + [Module.Finite A B] [Module.IsTorsionFree A B] : differentIdeal A B ≠ ⊥ := by + let : Algebra A (FractionRing A) := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra A + let : SMul A (FractionRing A) := Algebra.toSMul + let : IsFractionRing A (FractionRing A) := exactConstantDifferentCoefficientCanonicalFractionRing A + let : Algebra B (FractionRing B) := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra B + let : SMul B (FractionRing B) := Algebra.toSMul + let : IsFractionRing B (FractionRing B) := exactConstantDifferentCoefficientCanonicalFractionRing B + let : Algebra A (FractionRing B) := + RingHom.toAlgebra ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + let : SMul A (FractionRing B) := Algebra.toSMul + let : IsScalarTower A B (FractionRing B) := IsScalarTower.of_algebraMap_eq' rfl + let : FaithfulSMul A (FractionRing B) := by + rw [faithfulSMul_iff_algebraMap_injective] + change Function.Injective + ((algebraMap B (FractionRing B)).comp (algebraMap A B)) + exact (IsFractionRing.injective B (FractionRing B)).comp + (FaithfulSMul.algebraMap_injective A B) + let : Algebra (FractionRing A) (FractionRing B) := FractionRing.liftAlgebra A (FractionRing B) + let : SMul (FractionRing A) (FractionRing B) := Algebra.toSMul + let : IsScalarTower A (FractionRing A) (FractionRing B) := + FractionRing.isScalarTower_liftAlgebra A (FractionRing B) + let : Algebra.IsSeparable (FractionRing A) (FractionRing B) := by + refine Algebra.IsSeparable.of_equiv_equiv + (FractionRing.algEquiv A K).symm.toRingEquiv + (FractionRing.algEquiv B L).symm.toRingEquiv ?_ + ext z + exact IsFractionRing.algEquiv_commutes + (FractionRing.algEquiv A K).symm (FractionRing.algEquiv B L).symm z + exact differentIdeal_ne_bot + +private theorem normalization_map_injective + {R B N E : Type*} [CommRing R] [CommRing B] [Field N] [Field E] + [Algebra R B] [Algebra N E] + (i : R → N) (j : B → E) (hi : Function.Injective i) + (hcompat : ∀ x, j (algebraMap R B x) = algebraMap N E (i x)) : + Function.Injective (algebraMap R B) := by + intro x y hxy + apply hi + apply (algebraMap N E).injective + exact (hcompat x).symm.trans ((congrArg j hxy).trans (hcompat y)) + /-- Exact constant extension preserves the total-different coefficient at every presented finite or infinity place. -/ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq @@ -627,25 +674,25 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq (⊥ : IntermediateField C N)) (q : ExactConstantExtensionPresentedPlace C S N) : let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : Algebra S[X] E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : Algebra S[X] E := constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] E := Algebra.toSMul - letI : Module S[X] E := Algebra.toModule - letI : IsScalarTower S[X] (RatFunc S) E := + let : SMul S[X] E := Algebra.toSMul + let : Module S[X] E := Algebra.toModule + let : IsScalarTower S[X] (RatFunc S) E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -654,9 +701,9 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact finiteExtensionTotalDifferentEffectiveDivisor S E (exactConstantExtensionPresentedUpstairsPlaceEquiv @@ -664,39 +711,8 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq finiteExtensionTotalDifferentEffectiveDivisor C N (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) := by - dsimp only - let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := - finiteDimensional_exactConstantExtension_over_baseRatFunc - C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := - ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : Algebra S[X] E := - constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] E := Algebra.toSMul - letI : Module S[X] E := Algebra.toModule - letI : IsScalarTower S[X] (RatFunc S) E := - IsScalarTower.of_algebraMap_eq' (by - apply DFunLike.ext _ _ - intro p - change algebraMap S[X] E p = - ratFuncToExactConstantExtension C S N hExact - (algebraMap S[X] (RatFunc S) p) - exact - (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : FiniteDimensional (RatFunc S) E := - finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := - isSeparable_over_extendedRatFunc C S N hExact + intro E model1 model2 model3 model4 model5 model6 model7 model8 model9 + model10 model11 model12 model13 model14 model15 cases q with | inl q => letI : Algebra S[X] (RatFunc S) := @@ -731,6 +747,10 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq exactConstantExtensionFiniteNormalizationAlgebra C S N letI : SMul R2 B := Algebra.toSMul letI : Module R2 B := Algebra.toModule + letI : SMul C R2 := Algebra.toSMul + letI : Module C R2 := Algebra.toModule + letI : Module.Free C R2 := Module.Free.of_divisionRing C R2 + letI : Module.Flat C R2 := Module.Flat.of_free let eNorm : S ⊗[C] R2 ≃+* B := finiteFieldConstantExtensionIntegralClosureRingEquiv C S N letI : Module.IsTorsionFree R2 B := by @@ -861,51 +881,12 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq letI : Module R2 B := Algebra.toModule letI : Module.IsTorsionFree R2 B := by rw [Module.isTorsionFree_iff_algebraMap_injective] - intro x y hxy - apply Subtype.ext - apply (algebraMap N E).injective - have hxy' := congrArg Subtype.val hxy - calc - algebraMap N E x.1 = - ((algebraMap R2 B x : B) : E) := - (exactConstantExtensionInfinityNormalizationAlgebra_coe - C S N hExact x).symm - _ = ((algebraMap R2 B y : B) : E) := hxy' - _ = algebraMap N E y.1 := - exactConstantExtensionInfinityNormalizationAlgebra_coe - C S N hExact y + exact normalization_map_injective Subtype.val Subtype.val + Subtype.val_injective + (exactConstantExtensionInfinityNormalizationAlgebra_coe C S N hExact) letI : IsFractionRing R2 N := IsIntegralClosure.isFractionRing_of_finite_extension A (RatFunc C) N R2 - letI : Algebra R2 (FractionRing R2) := - exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R2 - letI : SMul R2 (FractionRing R2) := Algebra.toSMul - letI : IsFractionRing R2 (FractionRing R2) := - exactConstantDifferentCoefficientCanonicalFractionRing R2 - letI : Algebra A (FractionRing R2) := - RingHom.toAlgebra - ((algebraMap R2 (FractionRing R2)).comp (algebraMap A R2)) - letI : SMul A (FractionRing R2) := Algebra.toSMul - letI : IsScalarTower A R2 (FractionRing R2) := - IsScalarTower.of_algebraMap_eq' rfl - letI : FaithfulSMul A (FractionRing R2) := by - rw [faithfulSMul_iff_algebraMap_injective] - exact (IsFractionRing.injective R2 (FractionRing R2)).comp - (Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree A R2 from inferInstance)) - letI : Algebra (FractionRing A) (FractionRing R2) := - FractionRing.liftAlgebra A (FractionRing R2) - letI : Algebra.IsSeparable (FractionRing A) (FractionRing R2) := by - refine Algebra.IsSeparable.of_equiv_equiv - (ratFuncInfinityFractionRingEquiv C).symm.toRingEquiv - (FractionRing.algEquiv R2 N).symm.toRingEquiv ?_ - ext z - exact IsFractionRing.algEquiv_commutes - (A := A) (B := R2) - (K₁ := RatFunc C) (K₂ := FractionRing A) - (L₁ := N) (L₂ := FractionRing R2) - (ratFuncInfinityFractionRingEquiv C).symm - (FractionRing.algEquiv R2 N).symm z rw [exactConstantExtension_infinityDifferent_eq_map C S N hExact] let w := exactConstantExtensionUpstairsInfinityPlace C S N hExact q.1 q.2 @@ -918,7 +899,7 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq C S N hExact q).symm⟩ have hDifferentBase : differentIdeal (RatFuncInfinityIntegers C) R2 ≠ ⊥ := - differentIdeal_ne_bot + different_ne_bot_of_fraction_fields A R2 (RatFunc C) N calc multiplicity w.1 (Ideal.map (algebraMap R2 B) From aaa1157a0ddcd72e31cdff45107e8d225334479c Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:27:08 +0000 Subject: [PATCH 20/37] Separate canonical constant-compositum comparisons --- ...nFieldNormalClosureOriginalCompositum.lean | 171 ++++++++++-------- 1 file changed, 98 insertions(+), 73 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index 9127fa2f45..9cef36b979 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -37,6 +37,30 @@ variable (K F : Type*) [Field K] [Field F] [FiniteDimensional (RatFunc K) F] [Algebra.IsSeparable (RatFunc K) F] +local instance originalCompositumNormalClosureSMul : + SMul K (FunctionFieldNormalClosure K F) := Algebra.toSMul + +local instance originalCompositumNormalClosureModule : + Module K (FunctionFieldNormalClosure K F) := Algebra.toModule + +local instance originalCompositumNormalClosureSelfTower : + IsScalarTower K K (FunctionFieldNormalClosure K F) := + ⟨fun x y z => (smul_smul x y z).symm⟩ + +local instance originalCompositumBaseConstantSMul : + SMul K (FunctionFieldNormalClosureConstantField K F) := Algebra.toSMul + +local instance originalCompositumBaseConstantModule : + Module K (FunctionFieldNormalClosureConstantField K F) := Algebra.toModule + +local instance originalCompositumConstantBaseSMul : + SMul (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureConstantBase K F) := Algebra.toSMul + +local instance originalCompositumConstantBaseModule : + Module (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureConstantBase K F) := Algebra.toModule + /-- Multiplication of the two embedded factors `C` and `F` inside the normal closure. Before exactness is imposed this is merely an algebra homomorphism from the tensor product; exactness will make its source a field and hence the @@ -123,14 +147,24 @@ noncomputable def functionFieldNormalClosureConstantToOriginalCompositum (FunctionFieldNormalClosureOriginalCompositum K F hExact) := (functionFieldNormalClosureConstantToOriginalCompositum K F hExact).toAlgebra +local instance originalCompositumConstantSMul + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + SMul (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := Algebra.toSMul + +local instance originalCompositumConstantModule + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + Module (FunctionFieldNormalClosureConstantField K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := Algebra.toModule + /-- The tensor/compositum equivalence respects the enlarged constants. -/ noncomputable def exactConstantExtensionOriginalCompositumConstantAlgEquiv (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : - letI : Field (ExactConstantExtension K F + let : Field (ExactConstantExtension K F (FunctionFieldNormalClosureConstantField K F)) := exactConstantExtensionField K F (FunctionFieldNormalClosureConstantField K F) hExact - letI : Algebra (FunctionFieldNormalClosureConstantField K F) + let : Algebra (FunctionFieldNormalClosureConstantField K F) (ExactConstantExtension K F (FunctionFieldNormalClosureConstantField K F)) := Algebra.TensorProduct.leftAlgebra @@ -138,14 +172,7 @@ noncomputable def exactConstantExtensionOriginalCompositumConstantAlgEquiv (FunctionFieldNormalClosureConstantField K F) ≃ₐ[ FunctionFieldNormalClosureConstantField K F] FunctionFieldNormalClosureOriginalCompositum K F hExact := by - letI : Field (ExactConstantExtension K F - (FunctionFieldNormalClosureConstantField K F)) := - exactConstantExtensionField K F - (FunctionFieldNormalClosureConstantField K F) hExact - letI : Algebra (FunctionFieldNormalClosureConstantField K F) - (ExactConstantExtension K F - (FunctionFieldNormalClosureConstantField K F)) := - Algebra.TensorProduct.leftAlgebra + intro model1 model2 refine { exactConstantExtensionOriginalCompositumAlgEquiv K F hExact with commutes' := ?_ } @@ -235,15 +262,39 @@ noncomputable def functionFieldNormalClosureConstantBaseToOriginalCompositum map_add' _ _ := rfl commutes' _ := rfl +@[reducible] private noncomputable def originalCompositumRatFuncSelfAlgebra + (C : Type*) [Field C] : Algebra C (RatFunc C) := + RatFunc.instAlgebraOfPolynomial C C + +private theorem originalCompositum_ratFunc_algHom_ext + {C M : Type*} [Field C] [Field M] [Algebra C M] + (f g : RatFunc C →ₐ[C] M) (hX : f RatFunc.X = g RatFunc.X) : f = g := by + have hRing : f.toRingHom = g.toRingHom := by + apply IsFractionRing.ringHom_ext (A := C[X]) + intro p + induction p using Polynomial.induction_on' with + | add p q hp hq => + simpa only [map_add] using congrArg₂ (fun x y => x + y) hp hq + | monomial n c => + rw [← Polynomial.C_mul_X_pow_eq_monomial] + simp only [map_mul, map_pow, RatFunc.algebraMap_C, + RatFunc.algebraMap_X] + rw [← RatFunc.algebraMap_eq_C] + have hfc : f.toRingHom (algebraMap C (RatFunc C) c) = + algebraMap C M c := f.commutes c + have hgc : g.toRingHom (algebraMap C (RatFunc C) c) = + algebraMap C M c := g.commutes c + have hX' : f.toRingHom RatFunc.X = g.toRingHom RatFunc.X := hX + rw [hfc, hgc, hX'] + exact DFunLike.ext _ _ (fun r => DFunLike.congr_fun hRing r) + /-- The standard coefficient algebra structure on `C(t)` used by the rational-function equivalence. -/ @[reducible] noncomputable instance (priority := 2000) functionFieldNormalClosureConstantFieldRatFuncAlgebraForOriginalCompositum : Algebra (FunctionFieldNormalClosureConstantField K F) (RatFunc (FunctionFieldNormalClosureConstantField K F)) := - RatFunc.instAlgebraOfPolynomial - (FunctionFieldNormalClosureConstantField K F) - (FunctionFieldNormalClosureConstantField K F) + originalCompositumRatFuncSelfAlgebra (FunctionFieldNormalClosureConstantField K F) /-- The `C(t)`-algebra structure on `CF`, transported through the canonical equivalence `C(t) ≃ C K(t)` inside the normal closure. -/ @@ -350,34 +401,48 @@ whose constant algebra is definitionally this restriction. -/ RingHom.toAlgebra ((algebraMap (RatFunc K) F).comp (algebraMap K (RatFunc K))) +private theorem originalMultiplicationCanonicalRatFunc_X : + let : Algebra K F := functionFieldCanonicalConstantAlgebra K F + let : IsScalarTower K (RatFunc K) F := IsScalarTower.of_algebraMap_eq' rfl + ∀ (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)), + functionFieldNormalClosureOriginalMultiplication K F + (ratFuncToExactConstantExtension K + (FunctionFieldNormalClosureConstantField K F) F hExact RatFunc.X) = + algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) RatFunc.X := by + intro model1 model2 hExact + let C := FunctionFieldNormalClosureConstantField K F + letI : Algebra K[X] F := + RingHom.toAlgebra + ((algebraMap (RatFunc K) F).comp (algebraMap K[X] (RatFunc K))) + rw [ratFuncToExactConstantExtension_X] + simp only [polynomialTensorCancelEvaluationPoint, Algebra.TensorProduct.includeRight_apply] + rw [functionFieldNormalClosureOriginalMultiplication_tmul] + change (1 : FunctionFieldNormalClosure K F) * + functionFieldToNormalClosure K F (algebraMap K[X] F Polynomial.X) = _ + rw [one_mul] + change functionFieldToNormalClosure K F + (algebraMap (RatFunc K) F (algebraMap K[X] (RatFunc K) Polynomial.X)) = _ + rw [RatFunc.algebraMap_X] + exact (functionFieldToNormalClosure K F).commutes RatFunc.X + /-- For the canonical restricted constant algebra, the tensor/compositum equivalence is linear over `C(t)`, not merely over `K`. -/ noncomputable def exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv : - letI : Algebra K F := functionFieldCanonicalConstantAlgebra K F - letI : IsScalarTower K (RatFunc K) F := + let : Algebra K F := functionFieldCanonicalConstantAlgebra K F + let : IsScalarTower K (RatFunc K) F := IsScalarTower.of_algebraMap_eq' rfl ∀ (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)), let C := FunctionFieldNormalClosureConstantField K F let E := ExactConstantExtension K F C let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Field E := exactConstantExtensionField K F C hExact - letI : Algebra C E := Algebra.TensorProduct.leftAlgebra - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField K F C hExact + let : Algebra C E := Algebra.TensorProduct.leftAlgebra + let : Algebra (RatFunc C) E := ratFuncExactConstantExtensionAlgebra K C F hExact E ≃ₐ[RatFunc C] M := by - letI : Algebra K F := functionFieldCanonicalConstantAlgebra K F - letI : IsScalarTower K (RatFunc K) F := - IsScalarTower.of_algebraMap_eq' rfl - intro hExact - let C := FunctionFieldNormalClosureConstantField K F - letI : Algebra C (RatFunc C) := RatFunc.instAlgebraOfPolynomial C C - let E := ExactConstantExtension K F C - let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Field E := exactConstantExtensionField K F C hExact - letI : Algebra C E := Algebra.TensorProduct.leftAlgebra - letI : Algebra (RatFunc C) E := - ratFuncExactConstantExtensionAlgebra K C F hExact + intro model1 model2 hExact C E M model3 model4 model5 + letI : Algebra C (RatFunc C) := originalCompositumRatFuncSelfAlgebra C letI : Algebra K[X] F := RingHom.toAlgebra ((algebraMap (RatFunc K) F).comp @@ -390,51 +455,11 @@ noncomputable def functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgHom K F hExact have hX : f RatFunc.X = g RatFunc.X := by - have hfX : ((f RatFunc.X : M) : FunctionFieldNormalClosure K F) = - algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) RatFunc.X := by - change functionFieldNormalClosureOriginalMultiplication K F - (ratFuncToExactConstantExtension K C F hExact RatFunc.X) = _ - rw [ratFuncToExactConstantExtension_X] - simp only [polynomialTensorCancelEvaluationPoint, - Algebra.TensorProduct.includeRight_apply] - rw [functionFieldNormalClosureOriginalMultiplication_tmul] - change (1 : FunctionFieldNormalClosure K F) * - functionFieldToNormalClosure K F - (algebraMap K[X] F Polynomial.X) = _ - rw [one_mul] - change functionFieldToNormalClosure K F - (algebraMap (RatFunc K) F - (algebraMap K[X] (RatFunc K) Polynomial.X)) = _ - rw [RatFunc.algebraMap_X] - exact (functionFieldToNormalClosure K F).commutes RatFunc.X - have hgX : ((g RatFunc.X : M) : FunctionFieldNormalClosure K F) = - algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) RatFunc.X := by - change ((functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F - RatFunc.X : FunctionFieldNormalClosureConstantBase K F) : - FunctionFieldNormalClosure K F) = _ - rw [functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X] - rfl apply Subtype.ext + have hfX := originalMultiplicationCanonicalRatFunc_X K F hExact + have hgX := congrArg Subtype.val (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X K F) exact hfX.trans hgX.symm - have hRing : f.toRingHom = g.toRingHom := by - apply IsFractionRing.ringHom_ext (A := C[X]) - intro p - induction p using Polynomial.induction_on' with - | add p q hp hq => - simpa only [map_add] using congrArg₂ (fun x y => x + y) hp hq - | monomial n c => - rw [← Polynomial.C_mul_X_pow_eq_monomial] - simp only [map_mul, map_pow, RatFunc.algebraMap_C, - RatFunc.algebraMap_X] - rw [← RatFunc.algebraMap_eq_C] - have hfc : f.toRingHom (algebraMap C (RatFunc C) c) = - algebraMap C M c := f.commutes c - have hgc : g.toRingHom (algebraMap C (RatFunc C) c) = - algebraMap C M c := g.commutes c - have hX' : f.toRingHom RatFunc.X = g.toRingHom RatFunc.X := hX - rw [hfc, hgc, hX'] - have hfg : f = g := - DFunLike.ext _ _ (fun r => DFunLike.congr_fun hRing r) + have hfg : f = g := originalCompositum_ratFunc_algHom_ext (C := C) (M := M) f g hX refine { eC with commutes' := ?_ } intro r exact DFunLike.congr_fun hfg r From 6244dd94a9424e12ced2c095fc0685a8d91cf502 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:47:51 +0000 Subject: [PATCH 21/37] Factor affine residue centers through general valuation lemmas --- .../PlaneRationalPlaceAffineComparison.lean | 813 ++++++++++-------- 1 file changed, 438 insertions(+), 375 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean index e35cb0947d..bab5a1bdad 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean @@ -262,7 +262,7 @@ theorem rationalBasePlace_primesOver_card_le_finrank let e : P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) ≃ ↥(IsDedekindDomain.primesOverFinset P.1.asIdeal (RatFuncFiniteIntegralClosure K L)) := - Equiv.setCongr + Set.equivOfEq (IsDedekindDomain.coe_primesOverFinset P.1.ne_bot (RatFuncFiniteIntegralClosure K L)).symm calc @@ -504,6 +504,34 @@ open BGS.CorvajaZannier IsDedekindDomain Polynomial variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] variable {f : MvPolynomial (Fin 2) K} +private theorem mem_valuationSubring_of_polynomial_root + {A E : Type*} [CommRing A] [Field E] (V : ValuationSubring E) + [Algebra A V] [Algebra A E] [IsScalarTower A V E] + (F : A[X]) (x : E) + (hinjective : Function.Injective (algebraMap A E)) + (hlcUnit : IsUnit (algebraMap A V F.leadingCoeff)) + (hroot : Polynomial.aeval x F = 0) : x ∈ V := by + let G : V[X] := F.map (algebraMap A V) + have hmap : Function.Injective (algebraMap A V) := by + intro p q hpq + apply hinjective + have h := congrArg (algebraMap V E) hpq + simpa only [IsScalarTower.algebraMap_apply A V E] using h + have hGUnit : IsUnit G.leadingCoeff := by + rw [Polynomial.leadingCoeff_map_of_injective hmap F] + exact hlcUnit + have hGRoot : Polynomial.aeval x G = 0 := by + rw [Polynomial.aeval_def, Polynomial.eval₂_map, ← IsScalarTower.algebraMap_eq A V E] + exact hroot + let H : V[X] := hGUnit.unit⁻¹ • G + have hHMonic : H.Monic := Polynomial.monic_of_isUnit_leadingCoeff_inv_smul hGUnit + have hHRoot : Polynomial.aeval x H = 0 := by + change Polynomial.aeval x (hGUnit.unit⁻¹ • G) = 0 + rw [Units.smul_def, map_smul, hGRoot, smul_zero] + have hintegral : IsIntegral V x := ⟨H, hHMonic, hHRoot⟩ + obtain ⟨y, hy⟩ := IsIntegrallyClosed.isIntegral_iff.mp hintegral + exact hy ▸ y.2 + omit [Fintype K] in /-- Away from the leading-coefficient zero locus, the second plane coordinate is regular in the valuation subring of a rational finite place. @@ -512,70 +540,63 @@ equation over the valuation ring, and uses its integral closedness. -/ theorem planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ ∀ Q : FiniteExtensionRationalFinitePlace K (PlaneCurveFunctionField f), (secondCoordinateAffineExceptionalPolynomial f).eval (rationalFinitePlaceBaseCoordinate K (PlaneCurveFunctionField f) Q) ≠ 0 → planeCurveFunction f 1 ∈ IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime (PlaneCurveFunctionField f) Q.1 := by + intro model1 hx model3 model4 model5 model6 model7 model8 classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) E := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra K[X] E := - RingHom.toAlgebra - ((algebraMap (RatFunc K) E).comp - (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) E := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) E := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) E := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : Field E := inferInstance + let : SMul (RatFunc K) E := Algebra.toSMul + let : Module (RatFunc K) E := Algebra.toModule + let : SMul K[X] E := Algebra.toSMul + let : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E - letI : Module.Finite K[X] B := + let : CommRing B := inferInstance + let : SMul K[X] B := Algebra.toSMul + let : Module K[X] B := Algebra.toModule + let : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B - letI : Module.IsTorsionFree K[X] E := + let : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E - letI : Module.IsTorsionFree K[X] B := + let : Module.IsTorsionFree K[X] B := IsIntegralClosure.isTorsionFree K[X] E - letI : NoZeroSMulDivisors K[X] B := + let : NoZeroSMulDivisors K[X] B := { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B - letI : IsFractionRing B E := + let : IsFractionRing B E := IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B - dsimp only intro Q hgood let V := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime E Q.1 - letI : Algebra K[X] V := RingHom.toAlgebra + let : Algebra V E := Algebra.ofSubsemiring V + let : SMul V E := Algebra.toSMul + let : Module V E := Algebra.toModule + let : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) - letI : IsScalarTower K[X] V E := + let : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl let F : K[X][X] := planeCurvePolynomialInSecondCoordinate f - let G : V[X] := F.map (algebraMap K[X] V) have hlcEval : F.leadingCoeff.eval (rationalFinitePlaceBaseCoordinate K E Q) ≠ 0 := by change ((planeCurvePolynomialInSecondCoordinate f).leadingCoeff * @@ -586,40 +607,54 @@ theorem planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptio have hlcUnit : IsUnit (algebraMap K[X] V F.leadingCoeff) := rationalFinitePlacePolynomial_isUnit_of_eval_baseCoordinate_ne_zero K E Q F.leadingCoeff hlcEval - have hGLeading : G.leadingCoeff = algebraMap K[X] V F.leadingCoeff := by - have hinjective : Function.Injective (algebraMap K[X] V) := by - intro p q hpq - apply FaithfulSMul.algebraMap_injective K[X] E - have hmap := congrArg (algebraMap V E) hpq - simpa only [IsScalarTower.algebraMap_apply K[X] V E] using hmap - exact Polynomial.leadingCoeff_map_of_injective hinjective F - have hGUnit : IsUnit G.leadingCoeff := by - rw [hGLeading] - exact hlcUnit - have hroot : Polynomial.aeval (planeCurveFunction f 1) G = 0 := by - have hroot0 := - aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero - hf hpartialSecond - dsimp only at hroot0 - rw [Polynomial.aeval_def] - change Polynomial.eval₂ (algebraMap V E) (planeCurveFunction f 1) - (F.map (algebraMap K[X] V)) = 0 - rw [Polynomial.eval₂_map, - ← IsScalarTower.algebraMap_eq K[X] V E] - rw [Polynomial.aeval_def, Polynomial.eval₂_map, - ← IsScalarTower.algebraMap_eq K[X] (RatFunc K) E] at hroot0 - exact hroot0 - let H : V[X] := hGUnit.unit⁻¹ • G - have hHMonic : H.Monic := - Polynomial.monic_of_isUnit_leadingCoeff_inv_smul hGUnit - have hHRoot : Polynomial.aeval (planeCurveFunction f 1) H = 0 := by - change Polynomial.aeval (planeCurveFunction f 1) - (hGUnit.unit⁻¹ • G) = 0 - rw [Units.smul_def, map_smul, hroot, smul_zero] - have hintegral : IsIntegral V (planeCurveFunction f 1) := - ⟨H, hHMonic, hHRoot⟩ - obtain ⟨y, hy⟩ := IsIntegrallyClosed.isIntegral_iff.mp hintegral - exact hy ▸ y.2 + apply mem_valuationSubring_of_polynomial_root V F (planeCurveFunction f 1) + (Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree K[X] E from inferInstance)) hlcUnit + have hroot := aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero hf hpartialSecond + dsimp only at hroot + rw [Polynomial.aeval_def, Polynomial.eval₂_map, + ← IsScalarTower.algebraMap_eq K[X] (RatFunc K) E] at hroot + exact hroot + +private theorem eval_pair_eq_zero_of_residue + {K E : Type*} [Field K] [Field E] [Algebra K E] + (V : ValuationSubring E) [Algebra K V] [IsScalarTower K V E] + (m : Ideal V) [m.IsMaximal] (f : MvPolynomial (Fin 2) K) + (xv yv : V) (a b : K) + (ha : algebraMap K m.ResidueField a = algebraMap V m.ResidueField xv) + (hb : algebraMap K m.ResidueField b = algebraMap V m.ResidueField yv) + (hroot : MvPolynomial.eval₂ (algebraMap K E) ![(xv : E), (yv : E)] f = 0) : + MvPolynomial.eval ![a, b] f = 0 := by + let evalV : MvPolynomial (Fin 2) K →+* V := + MvPolynomial.eval₂Hom (algebraMap K V) ![xv, yv] + have hfV : evalV f = 0 := by + apply Subtype.ext + change algebraMap V E (MvPolynomial.eval₂ (algebraMap K V) ![xv, yv] f) = 0 + rw [MvPolynomial.eval₂_comp_left, ← IsScalarTower.algebraMap_eq K V E] + have hcoordinates : (algebraMap V E) ∘ ![xv, yv] = ![(xv : E), (yv : E)] := by + funext i + fin_cases i <;> rfl + rw [hcoordinates] + exact hroot + let evalK : MvPolynomial (Fin 2) K →+* K := + MvPolynomial.eval₂Hom (RingHom.id K) ![a, b] + have hcomp : (algebraMap K m.ResidueField).comp evalK = + (algebraMap V m.ResidueField).comp evalV := by + apply MvPolynomial.ringHom_ext + · intro c + simp only [RingHom.comp_apply, evalK, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C] + exact (IsScalarTower.algebraMap_apply K V m.ResidueField c).symm + · intro i + fin_cases i + · simpa [evalK, evalV] using ha + · simpa [evalK, evalV] using hb + change evalK f = 0 + apply (algebraMap K m.ResidueField).injective + calc + algebraMap K m.ResidueField (evalK f) = algebraMap V m.ResidueField (evalV f) := + DFunLike.congr_fun hcomp f + _ = algebraMap K m.ResidueField 0 := by rw [hfV, map_zero, map_zero] /-- The affine residue center of a rational finite normalization place away from the leading-coefficient/discriminant locus. Both plane coordinates are @@ -628,62 +663,60 @@ classes with unique constants in `K`. -/ noncomputable def planeCurveGoodRationalFinitePlaceCenter (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ RationalFinitePlaceAwayFromPolynomialZeros K (PlaneCurveFunctionField f) (secondCoordinateAffineExceptionalPolynomial f) → AffinePlaneCurvePoint f := by + intro model1 hx model3 model4 model5 model6 model7 model8 classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) E := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra K[X] E := - RingHom.toAlgebra - ((algebraMap (RatFunc K) E).comp - (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) E := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) E := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) E := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI : Field E := inferInstance + letI : AddCommMonoid E := inferInstance + let : SMul (RatFunc K) E := Algebra.toSMul + let : Module (RatFunc K) E := Algebra.toModule + let : SMul K[X] E := Algebra.toSMul + let : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E - letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B - letI : Module.IsTorsionFree K[X] E := + letI : CommRing B := inferInstance + letI : AddCommMonoid B := inferInstance + let : SMul K[X] B := Algebra.toSMul + let : Module K[X] B := Algebra.toModule + let : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + let : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E - letI : Module.IsTorsionFree K[X] B := + let : Module.IsTorsionFree K[X] B := IsIntegralClosure.isTorsionFree K[X] E - letI : NoZeroSMulDivisors K[X] B := + let : NoZeroSMulDivisors K[X] B := { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B - letI : IsFractionRing B E := + let : IsFractionRing B E := IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B - letI : Algebra K B := RingHom.toAlgebra + let : Algebra K B := RingHom.toAlgebra ((algebraMap K[X] B).comp (algebraMap K K[X])) - letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K (RatFunc K) E := + letI : SMul K B := Algebra.toSMul + letI : Module K B := Algebra.toModule + letI : SMul K E := Algebra.toSMul + letI : Module K E := Algebra.toModule + let : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by ext c have h := congrArg @@ -691,26 +724,33 @@ noncomputable def planeCurveGoodRationalFinitePlaceCenter (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) - letI : IsScalarTower K K[X] E := + let : IsScalarTower K K[X] E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, IsScalarTower.algebraMap_apply K K[X] (RatFunc K)] rfl) - letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + let : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K K[X] E] rfl) - dsimp only intro Q let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 - letI : Algebra K[X] V := RingHom.toAlgebra + letI : Algebra B V := inferInstance + letI : SMul B V := Algebra.toSMul + letI : Module B V := Algebra.toModule + let : Algebra V E := Algebra.ofSubsemiring V + let : SMul V E := Algebra.toSMul + let : Module V E := Algebra.toModule + let : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) - letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K V := RingHom.toAlgebra + let : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra K V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K B)) - letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by + letI : SMul K V := Algebra.toSMul + letI : Module K V := Algebra.toModule + let : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K B E] rfl) @@ -747,51 +787,17 @@ noncomputable def planeCurveGoodRationalFinitePlaceCenter have hb : algebraMap K m.ResidueField b = algebraMap V m.ResidueField yv := Classical.choose_spec (hresidue (algebraMap V m.ResidueField yv)) - let evalV : MvPolynomial (Fin 2) K →+* V := - MvPolynomial.eval₂Hom (algebraMap K V) ![xv, yv] - have hfV : evalV f = 0 := by - apply Subtype.ext - simp only [evalV, MvPolynomial.coe_eval₂Hom] - change algebraMap V E - (MvPolynomial.eval₂ (algebraMap K V) ![xv, yv] f) = 0 - rw [MvPolynomial.eval₂_comp_left, - ← IsScalarTower.algebraMap_eq K V E] - have hcoordinatesE : (algebraMap V E) ∘ ![xv, yv] = - ![(xv : E), (yv : E)] := by - funext i - fin_cases i <;> rfl - rw [hcoordinatesE, hxv] - change MvPolynomial.eval₂ (algebraMap K E) - ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 - have hcoordinates : planeCurveFunction f = - ![planeCurveFunction f 0, planeCurveFunction f 1] := by - funext i - fin_cases i <;> rfl - rw [← hcoordinates] - exact eval₂_planeCurveFunction_eq_zero f - let evalK : MvPolynomial (Fin 2) K →+* K := - MvPolynomial.eval₂Hom (RingHom.id K) ![a, b] - have hcomp : (algebraMap K m.ResidueField).comp evalK = - (algebraMap V m.ResidueField).comp evalV := by - apply MvPolynomial.ringHom_ext - · intro c - simp only [RingHom.comp_apply, evalK, evalV, - MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C] - exact (IsScalarTower.algebraMap_apply K V m.ResidueField c).symm - · intro i - fin_cases i - · simpa [evalK, evalV] using ha - · simpa [evalK, evalV] using hb refine ⟨(a, b), ?_⟩ - change evalK f = 0 - apply (algebraMap K m.ResidueField).injective - rw [map_zero] - calc - algebraMap K m.ResidueField (evalK f) = - ((algebraMap K m.ResidueField).comp evalK) f := rfl - _ = ((algebraMap V m.ResidueField).comp evalV) f := by rw [hcomp] - _ = algebraMap V m.ResidueField (evalV f) := rfl - _ = 0 := by rw [hfV, map_zero] + apply eval_pair_eq_zero_of_residue V m f xv yv a b ha hb + rw [hxv] + change MvPolynomial.eval₂ (algebraMap K E) + ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [← hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f omit [Fintype K] in /-- The first coordinate of the affine residue center is the base coordinate @@ -831,21 +837,21 @@ of the second plane coordinate in the local residue field. -/ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K (PlaneCurveFunctionField f) (secondCoordinateAffineExceptionalPolynomial f), @@ -865,24 +871,20 @@ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue (⟨planeCurveFunction f 1, planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero hf hpartialSecond Q.1 Q.2⟩ : V) := by + intro model1 hx model3 model4 model5 model6 model7 model8 classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) E := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra K[X] E := RingHom.toAlgebra - ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) E := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) E := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) E := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI : Field E := inferInstance + letI : AddCommMonoid E := inferInstance + letI : SMul (RatFunc K) E := Algebra.toSMul + letI : Module (RatFunc K) E := Algebra.toModule + letI : SMul K[X] E := Algebra.toSMul + letI : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E + letI : CommRing B := inferInstance + letI : AddCommMonoid B := inferInstance + letI : SMul K[X] B := Algebra.toSMul + letI : Module K[X] B := Algebra.toModule letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B letI : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E @@ -896,6 +898,10 @@ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B letI : Algebra K B := RingHom.toAlgebra ((algebraMap K[X] B).comp (algebraMap K K[X])) + letI : SMul K B := Algebra.toSMul + letI : Module K B := Algebra.toModule + letI : SMul K E := Algebra.toSMul + letI : Module K E := Algebra.toModule letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl letI : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by @@ -918,11 +924,19 @@ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue dsimp only intro Q let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra B V := inferInstance + letI : SMul B V := Algebra.toSMul + letI : Module B V := Algebra.toModule + letI : Algebra V E := Algebra.ofSubsemiring V + letI : SMul V E := Algebra.toSMul + letI : Module V E := Algebra.toModule letI : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl letI : Algebra K V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K B)) + letI : SMul K V := Algebra.toSMul + letI : Module K V := Algebra.toModule letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by ext c @@ -946,6 +960,88 @@ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue (hresidue (algebraMap V m.ResidueField yv)) omit [Fintype K] in +private theorem exists_centered_coordinate_hom + {K E : Type*} [Field K] [Field E] [Algebra K E] + (f : MvPolynomial (Fin 2) K) (V : ValuationSubring E) + [Algebra K V] [IsScalarTower K V E] + (ι : PlaneCurveCoordinateRing f →ₐ[K] E) (xv yv : V) + (hι : ∀ j, ι (planeCurveCoordinate f j) = algebraMap V E (![xv, yv] j)) + (hroot : MvPolynomial.eval₂ (algebraMap K E) ![(xv : E), (yv : E)] f = 0) + (z : AffinePlaneCurvePoint f) + (hfirst : algebraMap K (IsLocalRing.maximalIdeal V).ResidueField z.1.1 = + algebraMap V (IsLocalRing.maximalIdeal V).ResidueField xv) + (hsecond : algebraMap K (IsLocalRing.maximalIdeal V).ResidueField z.1.2 = + algebraMap V (IsLocalRing.maximalIdeal V).ResidueField yv) : + ∃ φ : PlaneCurveCoordinateRing f →+* V, + (∀ r, ((φ r : V) : E) = ι r) ∧ + Ideal.comap φ (IsLocalRing.maximalIdeal V) = + (affinePlaneCurvePointMaximalIdeal f z).asIdeal := by + let A := PlaneCurveCoordinateRing f + let m := IsLocalRing.maximalIdeal V + let evalV : MvPolynomial (Fin 2) K →+* V := + MvPolynomial.eval₂Hom (algebraMap K V) ![xv, yv] + have hfV : evalV f = 0 := by + apply Subtype.ext + simp only [evalV, MvPolynomial.coe_eval₂Hom] + change algebraMap V E + (MvPolynomial.eval₂ (algebraMap K V) ![xv, yv] f) = 0 + rw [MvPolynomial.eval₂_comp_left, + ← IsScalarTower.algebraMap_eq K V E] + have hcoordinatesE : (algebraMap V E) ∘ ![xv, yv] = + ![(xv : E), (yv : E)] := by + funext i + fin_cases i <;> rfl + rw [hcoordinatesE] + exact hroot + let φ : A →+* V := Ideal.Quotient.lift (Ideal.span {f}) evalV (by + intro g hg + obtain ⟨c, rfl⟩ := Ideal.mem_span_singleton.mp hg + rw [map_mul, hfV, zero_mul]) + have hφE : ∀ r : A, ((φ r : V) : E) = ι r := by + intro r + suffices (algebraMap V E).comp φ = ι.toRingHom by + exact DFunLike.congr_fun this r + apply Ideal.Quotient.ringHom_ext + apply MvPolynomial.ringHom_ext + · intro c + simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C] + change algebraMap V E (algebraMap K V c) = ι (algebraMap K A c) + rw [ι.commutes, IsScalarTower.algebraMap_apply K V E] + · intro i + simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_X] + change algebraMap V E (![xv, yv] i) = ι (planeCurveCoordinate f i) + exact (hι i).symm + have hrescomp : (algebraMap V m.ResidueField).comp φ = + (algebraMap K m.ResidueField).comp (planeCurvePointEval f z) := by + apply Ideal.Quotient.ringHom_ext + apply MvPolynomial.ringHom_ext + · intro c + simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, + MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C, + planeCurvePointEval, Ideal.Quotient.lift_mk] + exact (IsScalarTower.algebraMap_apply K V m.ResidueField c).symm + · intro i + fin_cases i + · simpa [φ, evalV, planeCurvePointEval] using hfirst.symm + · simpa [φ, evalV, planeCurvePointEval] using hsecond.symm + refine ⟨φ, hφE, ?_⟩ + apply Ideal.ext + intro r + change φ r ∈ m ↔ planeCurvePointEval f z r = 0 + rw [← Ideal.algebraMap_residueField_eq_zero] + have hr := DFunLike.congr_fun hrescomp r + simp only [RingHom.comp_apply] at hr + rw [hr] + constructor + · intro h + apply (algebraMap K m.ResidueField).injective + simpa using h + · intro h + simp [h] + + /-- A good rational finite place admits a coordinate-ring map into its valuation ring. The map is the canonical inclusion in the function field, and the inverse image of the local maximal ideal is exactly the maximal ideal @@ -953,21 +1049,21 @@ of its affine residue center. -/ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf + let := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K (PlaneCurveFunctionField f) (secondCoordinateAffineExceptionalPolynomial f), @@ -980,25 +1076,21 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom (affinePlaneCurvePointMaximalIdeal f (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q)).asIdeal := by + intro model1 hx model3 model4 model5 model6 model7 model8 classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) E := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra K[X] E := RingHom.toAlgebra - ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) E := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) E := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) E := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + letI : Field E := inferInstance + letI : AddCommMonoid E := inferInstance + letI : SMul (RatFunc K) E := Algebra.toSMul + letI : Module (RatFunc K) E := Algebra.toModule + letI : SMul K[X] E := Algebra.toSMul + letI : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E + letI : CommRing B := inferInstance + letI : AddCommMonoid B := inferInstance + letI : SMul K[X] B := Algebra.toSMul + letI : Module K[X] B := Algebra.toModule letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B letI : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E @@ -1012,6 +1104,10 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B letI : Algebra K B := RingHom.toAlgebra ((algebraMap K[X] B).comp (algebraMap K K[X])) + letI : SMul K B := Algebra.toSMul + letI : Module K B := Algebra.toModule + letI : SMul K E := Algebra.toSMul + letI : Module K E := Algebra.toModule letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl letI : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by @@ -1034,11 +1130,19 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom dsimp only intro Q let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra B V := inferInstance + letI : SMul B V := Algebra.toSMul + letI : Module B V := Algebra.toModule + letI : Algebra V E := Algebra.ofSubsemiring V + letI : SMul V E := Algebra.toSMul + letI : Module V E := Algebra.toModule letI : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl letI : Algebra K V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K B)) + letI : SMul K V := Algebra.toSMul + letI : Module K V := Algebra.toModule letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by ext c @@ -1060,51 +1164,6 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom planeCurveSecondCoordinate_mem_valuationSubringAtPrime_of_affineExceptional_ne_zero hf hpartialSecond Q.1 Q.2 let yv : V := ⟨planeCurveFunction f 1, hymem⟩ - let evalV : MvPolynomial (Fin 2) K →+* V := - MvPolynomial.eval₂Hom (algebraMap K V) ![xv, yv] - have hfV : evalV f = 0 := by - apply Subtype.ext - simp only [evalV, MvPolynomial.coe_eval₂Hom] - change algebraMap V E - (MvPolynomial.eval₂ (algebraMap K V) ![xv, yv] f) = 0 - rw [MvPolynomial.eval₂_comp_left, - ← IsScalarTower.algebraMap_eq K V E] - have hcoordinatesE : (algebraMap V E) ∘ ![xv, yv] = - ![(xv : E), (yv : E)] := by - funext i - fin_cases i <;> rfl - rw [hcoordinatesE, hxv] - change MvPolynomial.eval₂ (algebraMap K E) - ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 - have hcoordinates : planeCurveFunction f = - ![planeCurveFunction f 0, planeCurveFunction f 1] := by - funext i - fin_cases i <;> rfl - rw [← hcoordinates] - exact eval₂_planeCurveFunction_eq_zero f - let φ : A →+* V := Ideal.Quotient.lift (Ideal.span {f}) evalV (by - intro g hg - obtain ⟨c, rfl⟩ := Ideal.mem_span_singleton.mp hg - rw [map_mul, hfV, zero_mul]) - have hφE : ∀ r : A, ((φ r : V) : E) = algebraMap A E r := by - intro r - suffices (algebraMap V E).comp φ = algebraMap A E by - exact DFunLike.congr_fun this r - apply Ideal.Quotient.ringHom_ext - apply MvPolynomial.ringHom_ext - · intro c - simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, - MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C] - change algebraMap V E (algebraMap K V c) = algebraMap K E c - exact (IsScalarTower.algebraMap_apply K V E c).symm - · intro i - simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, - MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_X] - fin_cases i - · change (xv : E) = planeCurveFunction f 0 - exact hxv - · change (yv : E) = planeCurveFunction f 1 - rfl let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q have hfirst : algebraMap K m.ResidueField z.1.1 = algebraMap V m.ResidueField xv := by @@ -1115,33 +1174,21 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom algebraMap V m.ResidueField yv := by exact planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue hf hpartialSecond Q - have hrescomp : (algebraMap V m.ResidueField).comp φ = - (algebraMap K m.ResidueField).comp (planeCurvePointEval f z) := by - apply Ideal.Quotient.ringHom_ext - apply MvPolynomial.ringHom_ext - · intro c - simp only [RingHom.comp_apply, φ, Ideal.Quotient.lift_mk, evalV, - MvPolynomial.coe_eval₂Hom, MvPolynomial.eval₂_C, - planeCurvePointEval, Ideal.Quotient.lift_mk] - exact (IsScalarTower.algebraMap_apply K V m.ResidueField c).symm - · intro i - fin_cases i - · simpa [φ, evalV, planeCurvePointEval, z] using hfirst.symm - · simpa [φ, evalV, planeCurvePointEval, z] using hsecond.symm - refine ⟨φ, hφE, ?_⟩ - apply Ideal.ext - intro r - change φ r ∈ m ↔ planeCurvePointEval f z r = 0 - rw [← Ideal.algebraMap_residueField_eq_zero] - have hr := DFunLike.congr_fun hrescomp r - simp only [RingHom.comp_apply] at hr - rw [hr] - constructor - · intro h - apply (algebraMap K m.ResidueField).injective - simpa using h - · intro h - simp [h] + apply exists_centered_coordinate_hom f V (IsScalarTower.toAlgHom K A E) xv yv _ _ z + hfirst hsecond + · intro i + fin_cases i + · exact hxv.symm + · rfl + · rw [hxv] + change MvPolynomial.eval₂ (algebraMap K E) + ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [← hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f omit [Fintype K] in @@ -1212,107 +1259,22 @@ theorem planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero hf hpartialSecond Q] exact hresultant -/-- At a good rational finite place, the normalization valuation ring is -the unique valuation ring dominating its smooth affine residue center. -/ -theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating - (hf : Irreducible f) - (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : - letI := planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := - RingHom.toAlgebra - ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp - (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) - (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ - ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K - (PlaneCurveFunctionField f) - (secondCoordinateAffineExceptionalPolynomial f), - HeightOneSpectrum.valuationSubringAtPrime - (PlaneCurveFunctionField f) Q.1.1 = - dominatingValuationSubring - (affinePlaneCurvePointMaximalIdeal f - (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q)) := by - classical - letI : IsDomain (PlaneCurveCoordinateRing f) := - planeCurveCoordinateRing_isDomain hf - let hx := firstCoordinate_transcendental hf - (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - let A := PlaneCurveCoordinateRing f - let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) E := - planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra K[X] E := RingHom.toAlgebra - ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) E := - IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) E := - finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) E := - separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ - let B := RatFuncFiniteIntegralClosure K E - letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B - letI : Module.IsTorsionFree K[X] E := - Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E - letI : Module.IsTorsionFree K[X] B := - IsIntegralClosure.isTorsionFree K[X] E - letI : NoZeroSMulDivisors K[X] B := - { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } - letI : IsDedekindDomain B := - IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B - letI : IsFractionRing B E := - IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B - dsimp only - intro Q - let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q - let m := affinePlaneCurvePointMaximalIdeal f z - let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 +omit [Fintype K] in +private theorem valuationSubring_eq_dominating_of_centered_hom + {A E : Type*} [CommRing A] [IsDomain A] [Field E] + [Algebra A E] [IsFractionRing A E] (m : MaximalSpectrum A) + [IsDiscreteValuationRing (Localization.AtPrime m.asIdeal)] + (V : ValuationSubring E) (φ : A →+* V) + (hφE : ∀ r, ((φ r : V) : E) = algebraMap A E r) + (hcenter : Ideal.comap φ (IsLocalRing.maximalIdeal V) = m.asIdeal) + (hV : V ≠ ⊤) (r0 : A) (hr0mem : r0 ∈ m.asIdeal) + (hr0map : algebraMap A E r0 ≠ 0) : + V = dominatingValuationSubring (A := A) (L := E) m := by let D := dominatingValuationSubring (A := A) (L := E) m - obtain ⟨φ, hφE, hcenter⟩ := - exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom - hf hpartialSecond Q - let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z - letI : Finite m.asIdeal.ResidueField := - Finite.of_injective eCenter eCenter.injective - let r0 : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 - have hr0mem : r0 ∈ m.asIdeal := - firstCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal z - have hr0mapEq : algebraMap A E r0 = - planeCurveFunction f 0 - algebraMap K E z.1.1 := by - simp only [r0, map_sub] - rfl - have hr0map : algebraMap A E r0 ≠ 0 := by - rw [hr0mapEq] - exact firstCoordinate_sub_affinePoint_ne_zero hf hpartialSecond z - have hr0 : r0 ≠ 0 := by - intro hzero - apply hr0map - rw [hzero, map_zero] - have hm0 : m.asIdeal ≠ ⊥ := by - intro hm - apply hr0 - simpa [hm] using hr0mem - have hsmooth : planeCurvePartialY f ∉ m.asIdeal := by - change planeCurvePointEval f z (planeCurvePartialY f) ≠ 0 - change MvPolynomial.eval ![z.1.1, z.1.2] - (MvPolynomial.pderiv 1 f) ≠ 0 - exact planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero - hf hpartialSecond Q - letI : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := - planeCurveClosedPoint_localization_isDiscreteValuationRing - K hf m hm0 hsmooth let Wsub : Subalgebra A E := Localization.subalgebra.ofField E m.asIdeal.primeCompl m.asIdeal.primeCompl_le_nonZeroDivisors - letI : IsDiscreteValuationRing Wsub := + let : IsDiscreteValuationRing Wsub := IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing (IsLocalization.algEquiv m.asIdeal.primeCompl (Localization.AtPrime m.asIdeal) Wsub).toRingEquiv @@ -1320,8 +1282,8 @@ theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating ValuationSubring.ofSubring Wsub.toSubring fun x => by simpa [IsLocalization.IsInteger] using ValuationRing.isInteger_or_isInteger Wsub x - letI : Algebra A W := Wsub.algebra' - letI : IsLocalization m.asIdeal.primeCompl W := + let : Algebra A W := Wsub.algebra' + let : IsLocalization m.asIdeal.primeCompl W := Localization.subalgebra.isLocalization_ofField E m.asIdeal.primeCompl m.asIdeal.primeCompl_le_nonZeroDivisors let eW : Wsub ≃+* W := @@ -1331,7 +1293,7 @@ theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating right_inv := fun x => Subtype.ext rfl map_add' := fun _ _ => rfl map_mul' := fun _ _ => rfl } - letI : IsDiscreteValuationRing W := + let : IsDiscreteValuationRing W := IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing eW have hWV : W ≤ V := by intro x hx @@ -1358,11 +1320,6 @@ theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating have h := Submonoid.inv_mem_of_isUnit (S := V) hsvUnit rwa [hφE s] at h exact V.toSubring.mul_mem haV hinvV - have hV : V ≠ ⊤ := by - change HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 ≠ ⊤ - rw [HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] - simp only [ne_eq, Valuation.valuationSubring_eq_top_iff, not_not] - infer_instance have hWVeq : W = V := ValuationSubring.eq_of_le_of_ne_top W hWV hV have hWD : W ≤ D := by @@ -1401,6 +1358,112 @@ theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating ValuationSubring.eq_of_le_of_ne_top W hWD hD exact hWVeq.symm.trans hWDeq +/-- At a good rational finite place, the normalization valuation ring is +the unique valuation ring dominating its smooth affine residue center. -/ +theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating + (hf : Irreducible f) + (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : + let := planeCurveCoordinateRing_isDomain hf + let hx := firstCoordinate_transcendental hf + (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + RingHom.toAlgebra + ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp + (algebraMap (Polynomial K) (RatFunc K))) + let : IsScalarTower (Polynomial K) (RatFunc K) + (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond + let : DecidableEq (RatFunc K) := Classical.decEq _ + ∀ Q : RationalFinitePlaceAwayFromPolynomialZeros K + (PlaneCurveFunctionField f) + (secondCoordinateAffineExceptionalPolynomial f), + HeightOneSpectrum.valuationSubringAtPrime + (PlaneCurveFunctionField f) Q.1.1 = + dominatingValuationSubring + (affinePlaneCurvePointMaximalIdeal f + (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q)) := by + intro model1 hx model3 model4 model5 model6 model7 model8 + classical + let A := PlaneCurveCoordinateRing f + let E := PlaneCurveFunctionField f + letI : Field E := inferInstance + letI : AddCommMonoid E := inferInstance + letI : SMul (RatFunc K) E := Algebra.toSMul + letI : Module (RatFunc K) E := Algebra.toModule + letI : SMul K[X] E := Algebra.toSMul + letI : Module K[X] E := Algebra.toModule + let B := RatFuncFiniteIntegralClosure K E + letI : CommRing B := inferInstance + letI : AddCommMonoid B := inferInstance + letI : SMul K[X] B := Algebra.toSMul + letI : Module K[X] B := Algebra.toModule + letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + letI : Module.IsTorsionFree K[X] E := + Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E + letI : Module.IsTorsionFree K[X] B := + IsIntegralClosure.isTorsionFree K[X] E + letI : NoZeroSMulDivisors K[X] B := + { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } + letI : IsDedekindDomain B := + IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B + letI : IsFractionRing B E := + IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B + intro Q + let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q + let m := affinePlaneCurvePointMaximalIdeal f z + let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 + letI : Algebra B V := inferInstance + letI : SMul B V := Algebra.toSMul + letI : Module B V := Algebra.toModule + letI : Algebra V E := Algebra.ofSubsemiring V + letI : SMul V E := Algebra.toSMul + letI : Module V E := Algebra.toModule + let D := dominatingValuationSubring (A := A) (L := E) m + obtain ⟨φ, hφE, hcenter⟩ := + exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom + hf hpartialSecond Q + let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z + letI : Finite m.asIdeal.ResidueField := + Finite.of_injective eCenter eCenter.injective + let r0 : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 + have hr0mem : r0 ∈ m.asIdeal := + firstCoordinate_sub_mem_affinePlaneCurvePointMaximalIdeal z + have hr0mapEq : algebraMap A E r0 = + planeCurveFunction f 0 - algebraMap K E z.1.1 := by + simp only [r0, map_sub] + rfl + have hr0map : algebraMap A E r0 ≠ 0 := by + rw [hr0mapEq] + exact firstCoordinate_sub_affinePoint_ne_zero hf hpartialSecond z + have hr0 : r0 ≠ 0 := by + intro hzero + apply hr0map + rw [hzero, map_zero] + have hm0 : m.asIdeal ≠ ⊥ := by + intro hm + apply hr0 + simpa [hm] using hr0mem + have hsmooth : planeCurvePartialY f ∉ m.asIdeal := by + change planeCurvePointEval f z (planeCurvePartialY f) ≠ 0 + change MvPolynomial.eval ![z.1.1, z.1.2] + (MvPolynomial.pderiv 1 f) ≠ 0 + exact planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero + hf hpartialSecond Q + letI : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := + planeCurveClosedPoint_localization_isDiscreteValuationRing + K hf m hm0 hsmooth + have hV : V ≠ ⊤ := by + change HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 ≠ ⊤ + rw [HeightOneSpectrum.valuationSubringAtPrime_eq_valuationSubring] + simp only [ne_eq, Valuation.valuationSubring_eq_top_iff, not_not] + infer_instance + exact valuationSubring_eq_dominating_of_centered_hom m V φ hφE hcenter hV + r0 hr0mem hr0map + /-- The residue-center map is injective on the good rational finite places: smoothness makes the local DVR, hence the dominating valuation ring, unique. -/ From cd7fd10dc2b464f5d8aaa436943a9b1c0e9e974d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:51:44 +0000 Subject: [PATCH 22/37] Update finite-place averages to scalar towers and field dimensions --- ...antExtensionFrobeniusTwistFinitePlaceAverage.lean | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean index dd4d93dc4d..7521835fb4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -138,6 +138,12 @@ noncomputable def ratFuncFinitePlaceEquivFiniteExtension : heightOneSpectrumEquivOfAlgEquiv (ratFuncFiniteBasePolynomialAlgEquivChart C) +private theorem finrank_mul_finrank_of_fields + (K F E : Type*) [Field K] [Field F] [Field E] + [Algebra K F] [Algebra K E] [Algebra F E] [IsScalarTower K F E] : + Module.finrank K F * Module.finrank F E = Module.finrank K E := + Module.finrank_mul_finrank K F E + /-- A finite-place degree is the dimension of its residue field over the constant field. -/ private theorem finiteExtensionPlaceDegree_inl_eq_finrank_residueField_ratFunc @@ -148,11 +154,11 @@ private theorem finiteExtensionPlaceDegree_inl_eq_finrank_residueField_ratFunc letI : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver P.asIdeal Q.asIdeal - letI : Localization.AtPrime.IsLiesOverAlgebra P.asIdeal Q.asIdeal := - ⟨rfl⟩ + let : IsScalarTower C[X] (Localization.AtPrime P.asIdeal) + (Localization.AtPrime Q.asIdeal) := inferInstance rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq P.asIdeal Q.asIdeal] rw [ratFuncFinitePlaceDegree_eq_finrank_residueField C P] - rw [mul_comm, Module.finrank_mul_finrank] + rw [mul_comm, finrank_mul_finrank_of_fields] /-- The chart-normalization equivalence preserves finite-place degree. -/ @[simp] From c0d2c124cbe800b83e1ad79b08f359adbdf752e7 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 01:59:17 +0000 Subject: [PATCH 23/37] Port Markoff warning spellings, explicit imports and kernel certificates --- .../ClearedLinearFractionalSubstitution.lean | 4 +- .../Algebra/KummerEigencharacterDescent.lean | 6 +- .../ConstantOpenGlueData.lean | 6 +- .../DivisorExponentSpernerBridge.lean | 4 +- .../Combinatorics/ProductOfChainsGrid.lean | 4 +- .../AbsoluteIrreducibilityBaseChange.lean | 2 +- .../CorvajaZannier/BivariateResultant.lean | 2 +- .../DedekindAuxiliaryCaseI.lean | 6 +- .../DedekindDifferentDivisor.lean | 2 +- .../DedekindDifferentKaehler.lean | 16 +- .../DedekindLocalDerivationExtension.lean | 10 +- .../DedekindPerfectResidueCaseI.lean | 6 +- .../ElementaryFiniteFieldBound.lean | 8 +- .../CorvajaZannier/EndpointComposition.lean | 4 +- ...ensionCanonicalAuxiliaryInfinityPlace.lean | 62 +- ...iteExtensionCanonicalDifferentDivisor.lean | 2 +- ...ionCanonicalGlobalNormalizedAutomatic.lean | 10 +- .../FiniteExtensionCanonicalPlaceSum.lean | 76 +-- ...iteExtensionCanonicalPlacewiseScaling.lean | 14 +- .../FiniteExtensionGcdOutsideHeight.lean | 4 +- .../FiniteExtensionPolynomialHeight.lean | 4 +- .../FiniteExtensionPrincipalDivisor.lean | 14 +- .../FiniteExtensionProductFormula.lean | 4 +- .../FiniteExtensionResidueSurjectivity.lean | 26 +- .../FiniteFunctionFieldDegree.lean | 2 +- .../BGS/CorvajaZannier/FrobeniusSubfield.lean | 12 +- .../GlobalWronskianPlaceSum.lean | 6 +- .../CorvajaZannier/InfinityInertiaDegree.lean | 16 +- .../BGS/CorvajaZannier/InfinityPlace.lean | 2 +- .../CorvajaZannier/LaurentFrobeniusBasis.lean | 2 +- .../LaurentFrobeniusPowerBasis.lean | 2 +- .../CorvajaZannier/LocalAuxiliaryCaseI.lean | 4 +- .../BGS/CorvajaZannier/LocalMonogenicity.lean | 38 +- .../LocalReciprocalDiscriminant.lean | 6 +- .../PlaneCurveAuxiliaryFinitePlace.lean | 38 +- .../PlaneCurveAuxiliaryFinitePlaceCases.lean | 46 +- .../PlaneCurveAuxiliaryIndependence.lean | 32 +- .../PlaneCurveBidegreeBridge.lean | 4 +- .../PlaneCurveBoundarySupport.lean | 14 +- .../PlaneCurveCanonicalDegreeBound.lean | 8 +- .../PlaneCurveCanonicalEulerBound.lean | 8 +- .../PlaneCurveCanonicalGcdBound.lean | 32 +- .../PlaneCurveCoordinatePowerHeight.lean | 16 +- .../PlaneCurveDiagonalStabilizer.lean | 2 +- .../PlaneCurveDiscriminantBound.lean | 2 +- .../PlaneCurveFiniteDifferentBound.lean | 58 +- .../PlaneCurveFunctionField.lean | 20 +- .../PlaneCurveInfinityDifferentBound.lean | 2 +- .../PlaneCurveInfinityDifferentDegree.lean | 2 +- ...PlaneCurveLocalReciprocalDiscriminant.lean | 44 +- .../PlaneCurveLogarithmicGauss.lean | 8 +- .../PlaneCurvePoweredHeightBounds.lean | 42 +- .../PlaneCurvePoweredImageDegreeBudget.lean | 4 +- .../PlaneCurvePropositionTwoAssembly.lean | 20 +- .../PlaneCurvePropositionTwoDegreeBridge.lean | 2 +- .../PlaneCurveRatFuncModel.lean | 40 +- .../PlaneCurveSeparability.lean | 48 +- .../PlaneCurveSharedOriginBoundary.lean | 20 +- .../CorvajaZannier/PlaneCurveSupportRank.lean | 12 +- .../PoweredCoordinateRelation.lean | 44 +- .../CorvajaZannier/PoweredCoordinates.lean | 54 +- .../PoweredImageBaseChange.lean | 14 +- .../BGS/CorvajaZannier/PoweredImageCurve.lean | 72 +-- .../PoweredImageExactSupportIndexBound.lean | 16 +- .../PoweredImageFrobeniusRelation.lean | 50 +- .../PoweredImageFrobeniusRelationSwapped.lean | 8 +- .../PoweredImageGaloisBound.lean | 56 +- .../PoweredImageHeightFactor.lean | 8 +- .../BGS/CorvajaZannier/PoweredImageIndex.lean | 8 +- .../PoweredImageIndexBound.lean | 4 +- .../SeparatingCoordinateNotFrobenius.lean | 24 +- .../CorvajaZannier/TorsionBidegreeCount.lean | 4 +- .../TorsionExhaustiveGcdDivisorBound.lean | 36 +- .../TorsionGcdDivisorBound.lean | 4 +- .../TorsionPointNormalization.lean | 12 +- .../TorusCharacterKernelBound.lean | 16 +- .../TranscendentalPowerDegree.lean | 14 +- .../WronskianChangeParameter.lean | 2 +- .../BGS/FiniteField/EllipticCharacterSum.lean | 2 +- .../BGS/FiniteField/QuadraticCharacter.lean | 4 +- .../BGS/HasseWeil/AffinePointPlace.lean | 42 +- .../HasseWeil/ClosedPlaceEulerRecurrence.lean | 24 +- .../ConstantExtensionClosedPlaceCount.lean | 14 +- ...tExtensionClosedPlaceSplittingFormula.lean | 116 ++-- .../ConstantExtensionFinitePlaceBridge.lean | 56 +- .../ConstantExtensionInfinityPlaceBridge.lean | 100 ++-- ...tantExtensionInfinityPlaceDegreeTower.lean | 150 ++--- ...ionInfinityPlaceSplittingMultiplicity.lean | 162 +++--- ...ntExtensionPlaceSplittingMultiplicity.lean | 86 +-- .../ConstantExtensionRationalPlace.lean | 4 +- .../HasseWeil/ConstantFieldAutomorphism.lean | 20 +- .../ConstantFieldRatFuncCompatibility.lean | 80 +-- .../DedekindDifferentLocalTrace.lean | 4 +- .../BGS/HasseWeil/ExactConstantExtension.lean | 22 +- .../ExactConstantExtensionAutomorphism.lean | 28 +- .../ExactConstantExtensionConstants.lean | 34 +- ...ConstantExtensionDifferentCoefficient.lean | 402 ++++++------- ...ExactConstantExtensionFiniteDifferent.lean | 50 +- .../ExactConstantExtensionFinitePlace.lean | 110 ++-- ...tantExtensionFinitePlaceCompatibility.lean | 174 +++--- ...tExtensionFinitePlaceFrobeniusAverage.lean | 88 +-- .../ExactConstantExtensionFrobeniusTwist.lean | 70 +-- ...stantExtensionFrobeniusTwistConstants.lean | 20 +- ...ConstantExtensionFrobeniusTwistDegree.lean | 8 +- ...nsionFrobeniusTwistFinitePlaceAverage.lean | 180 +++--- ...ensionFrobeniusTwistFinitePlaceBridge.lean | 98 ++-- ...tConstantExtensionFrobeniusTwistGenus.lean | 28 +- ...ionFrobeniusTwistInfinityPlaceDescent.lean | 214 +++---- ...robeniusTwistInfinityPlaceEquivalence.lean | 166 +++--- ...ntExtensionFrobeniusTwistRiemannLower.lean | 50 +- .../ExactConstantExtensionGenusDegree.lean | 32 +- ...ExactConstantExtensionGenusInvariance.lean | 40 +- ...onstantExtensionInfinityNormalization.lean | 16 +- ...ntExtensionInfinityPlaceCompatibility.lean | 98 ++-- ...diateFrobeniusTwistFinitePlaceAverage.lean | 546 +++++++++--------- ...ctConstantExtensionNormalClosureTower.lean | 216 +++---- .../ExactConstantExtensionQuotient.lean | 28 +- ...ctConstantExtensionRationalPlaceCount.lean | 12 +- ...ConstantExtensionTotalDifferentDegree.lean | 30 +- .../ExactConstantExtensionTower.lean | 100 ++-- .../ExtensionEvenDegreeStepanovBound.lean | 20 +- .../BGS/HasseWeil/FilteredDimension.lean | 4 +- .../BGS/HasseWeil/FiniteBranchLocus.lean | 2 +- .../FiniteExtensionAffineIdealDegree.lean | 24 +- .../FiniteExtensionAffineIdealDivisor.lean | 6 +- ...iteExtensionCanonicalDifferentCotrace.lean | 8 +- ...ExtensionCanonicalDifferentGenusBound.lean | 8 +- ...sionCanonicalDifferentLocalMaximality.lean | 2 +- .../FiniteExtensionClosedPlaceAlgEquiv.lean | 4 +- ...FiniteExtensionDivisorClassRecurrence.lean | 14 +- .../HasseWeil/FiniteExtensionGenusBound.lean | 2 +- ...nHasseBoundFromEvenConstantExtensions.lean | 4 +- ...FiniteExtensionIndexedZetaRationality.lean | 2 +- ...ensionIndexedZetaRationalityAutomatic.lean | 2 +- .../FiniteExtensionLocalPoleQuotient.lean | 80 +-- .../FiniteExtensionLocalPoleSpace.lean | 4 +- .../FiniteExtensionPlaceAlgEquiv.lean | 10 +- .../FiniteExtensionPlaceDegreeFiniteness.lean | 30 +- .../HasseWeil/FiniteExtensionPlaceTower.lean | 182 +++--- .../FiniteExtensionPrincipalParts.lean | 26 +- .../FiniteExtensionRiemannEventualGrowth.lean | 2 +- .../HasseWeil/FiniteExtensionRiemannRoch.lean | 4 +- ...ExtensionRiemannShiftedEventualGrowth.lean | 6 +- .../FiniteExtensionRiemannSpace.lean | 4 +- ...ExtensionRiemannSpaceProjectivization.lean | 12 +- ...initeExtensionStandardZetaRationality.lean | 2 +- .../FiniteExtensionZetaDegreeIndexOne.lean | 20 +- ...ensionZetaDegreeIndexOneFromAllCounts.lean | 6 +- .../FiniteExtensionZetaSimplePole.lean | 4 +- .../BGS/HasseWeil/FiniteFieldCompositum.lean | 8 +- .../FiniteFieldConstantExtensionResidue.lean | 8 +- .../FiniteFieldDivisibleExtension.lean | 8 +- .../FiniteFieldInfinityDifferent.lean | 34 +- .../FiniteFieldPolynomialDifferent.lean | 10 +- .../BGS/HasseWeil/FiniteFieldSubfield.lean | 8 +- .../FiniteLinearIndependenceBound.lean | 8 +- .../HasseWeil/FinitePlaceFrobeniusFiber.lean | 8 +- .../BGS/HasseWeil/FinitePrincipalParts.lean | 28 +- .../BGS/HasseWeil/FinsuppWeightedFiber.lean | 2 +- .../BGS/HasseWeil/FixedPointAverage.lean | 16 +- .../BGS/HasseWeil/FormalZetaRationality.lean | 4 +- .../BGS/HasseWeil/FormalZetaTrace.lean | 24 +- .../HasseWeil/FrobeniusPlaceCardinality.lean | 12 +- .../BGS/HasseWeil/FrobeniusRestriction.lean | 4 +- .../FunctionFieldConstantExtension.lean | 10 +- .../HasseWeil/FunctionFieldConstantField.lean | 20 +- .../HasseWeil/FunctionFieldNormalClosure.lean | 2 +- ...nFieldNormalClosureOriginalCompositum.lean | 8 +- .../BGS/HasseWeil/GaloisAverage.lean | 5 +- .../GeneralFiniteExtensionRiemannLower.lean | 4 +- .../GeneralSquareFieldStepanovCount.lean | 8 +- .../BGS/HasseWeil/IdealMultiplicityMap.lean | 2 +- .../LocalPoleCumulativeQuotient.lean | 6 +- .../BGS/HasseWeil/OnePointIncrement.lean | 8 +- .../HasseWeil/OnePointLeadingCoefficient.lean | 32 +- .../BGS/HasseWeil/OnePointPoleSemigroup.lean | 10 +- .../OnePointStepanovDegreeTwoAuxiliary.lean | 2 +- .../BGS/HasseWeil/OnePointStrictLevels.lean | 4 +- .../HasseWeil/PlaneAffineCountTransfer.lean | 3 +- .../PlaneAffineHasseWeilFromEvenError.lean | 32 +- .../PlaneAffineHasseWeilFromZeta.lean | 16 +- .../PlaneAffineRationalPlaceComparison.lean | 56 +- .../BGS/HasseWeil/PlaneCoordinatePole.lean | 32 +- .../PlaneCoordinatePoleAtInfinity.lean | 36 +- .../BGS/HasseWeil/PlaneCoordinateShear.lean | 2 +- .../PlaneCurveGenusBoundAutomatic.lean | 26 +- .../PlaneCurveGenusBoundFromCotrace.lean | 32 +- ...PlaneCurveGenusBoundFromCotraceDegree.lean | 32 +- .../PlaneFinitePlaceRiemannLower.lean | 30 +- .../HasseWeil/PlaneFrobeniusDeflation.lean | 2 +- .../HasseWeil/PlaneFrobeniusDegenerate.lean | 4 +- .../HasseWeil/PlaneInfinityRiemannLower.lean | 18 +- .../BGS/HasseWeil/PlaneMonomialSpace.lean | 14 +- .../HasseWeil/PlaneOnePointRiemannLower.lean | 76 +-- .../PlaneRationalPlaceAffineComparison.lean | 286 ++++----- .../PlaneSmoothPointNormalization.lean | 128 ++-- .../PlaneSquareFieldStepanovCount.lean | 32 +- ...laneSquareFieldStepanovCountAutomatic.lean | 32 +- .../BGS/HasseWeil/PlaneStepanovAuxiliary.lean | 24 +- .../BGS/HasseWeil/PoleDivisor.lean | 2 +- .../BGS/HasseWeil/PolynomialSpectral.lean | 2 +- .../MarkoffModP/BGS/HasseWeil/PowerSum.lean | 6 +- .../RatFuncCanonicalInfinityDivisor.lean | 8 +- .../HasseWeil/RatFuncConstantExtension.lean | 2 +- .../RatFuncExactConstantExtension.lean | 130 ++--- .../RatFuncInfinityLocalization.lean | 4 +- .../BGS/HasseWeil/RatFuncParameterPole.lean | 6 +- .../BGS/HasseWeil/RationalPlace.lean | 10 +- .../BGS/HasseWeil/RiemannSpaceConstants.lean | 4 +- .../RiemannSpaceEffectiveIncrement.lean | 8 +- .../BGS/HasseWeil/SquareFieldResidue.lean | 6 +- .../SquareFieldStepanovRestriction.lean | 42 +- .../BGS/HasseWeil/StepanovParameters.lean | 8 +- .../HasseWeil/StepanovRestrictionMaps.lean | 2 +- .../HasseWeil/StepanovSquareVanishing.lean | 40 +- .../BGS/HasseWeil/TensorRestriction.lean | 8 +- .../MarkoffModP/BGS/HasseWeil/ZetaTrace.lean | 3 +- .../Assembly/DivisibleOrbitTransitivity.lean | 6 +- .../Markoff/Assembly/ElementaryCounts.lean | 5 +- ...erSevenNonparabolicComplementFrontier.lean | 2 +- .../Assembly/EvenSignOrbitDivisibility.lean | 2 +- .../ExactOrderComplementObstruction.lean | 2 +- ...tOrderEulerSevenComplementObstruction.lean | 2 +- .../BGS/Markoff/Assembly/GiantOrbit.lean | 6 +- .../Assembly/MiddleGameThenEndgame.lean | 6 +- .../NonparabolicComplementFrontier.lean | 2 +- .../PairedMaximalDivisorLowOrderCount.lean | 4 +- .../Assembly/SplitCageEvenSignBase.lean | 2 +- .../Assembly/TransitivitySurjectivity.lean | 4 +- .../Cage/BiquadraticPrimitiveQuartic.lean | 5 +- .../BGS/Markoff/Cage/Connectivity.lean | 4 +- .../BGS/Markoff/Cage/HasseWeilAssumption.lean | 2 +- .../Markoff/Cage/PlaneCountComparison.lean | 16 +- .../BGS/Markoff/Cage/PowerCover.lean | 2 +- .../BGS/Markoff/Cage/PulledRadicand.lean | 4 +- .../Cage/ShiftedTraceCurveIrreducibility.lean | 4 +- .../MarkoffModP/BGS/Markoff/Core/Basic.lean | 4 +- .../BGS/Markoff/Core/SemiringFunctor.lean | 2 +- .../BGS/Markoff/Core/Statements.lean | 2 +- .../BGS/Markoff/Core/TraceClassification.lean | 4 +- .../CoordinateZeroPatternCounts.lean | 4 +- .../BGS/Markoff/Diophantine/LocalCounts.lean | 22 +- .../BGS/Markoff/Diophantine/PrimewiseCRT.lean | 4 +- .../Markoff/Endgame/LargeOrderToMaximal.lean | 4 +- .../Nonsplit/DescendedIrreducibility.lean | 8 +- .../Endgame/Nonsplit/DescendedTraceCurve.lean | 4 +- .../Markoff/Endgame/PowerCoverCounting.lean | 8 +- .../Endgame/PrimitiveInclusionExclusion.lean | 2 +- .../BGS/Markoff/Incidence/CoordinateRing.lean | 16 +- .../BGS/Markoff/Incidence/Fibers.lean | 8 +- .../Markoff/Incidence/NormalizedGraph.lean | 10 +- .../BGS/Markoff/Incidence/PointCount.lean | 2 +- .../MiddleGame/CorvajaZannierFromGeneral.lean | 6 +- .../MiddleGame/CorvajaZannierGeometry.lean | 8 +- .../Markoff/MiddleGame/RightSubgroups.lean | 4 +- .../MiddleGame/WeightedTraceEulerSeven.lean | 12 +- .../WeightedTraceEulerSevenLargeBound.lean | 2 +- .../WeightedTracePoweredImageIndexTwo.lean | 8 +- .../BGS/Markoff/Opening/CompatibleRoots.lean | 2 +- .../BGS/Markoff/Opening/CyclotomicBound.lean | 4 +- .../Markoff/Opening/CyclotomicReduction.lean | 16 +- .../BGS/Markoff/Opening/EveryOrbitLarge.lean | 2 +- .../BGS/Markoff/Opening/OrbitCardBound.lean | 4 +- .../BGS/Markoff/Opening/TraceOrderBound.lean | 2 +- .../TraceCurve/AffineNormalization.lean | 4 +- .../TraceCurve/BiprojectiveClosure.lean | 4 +- .../TraceCurve/CommonPrimeKummerTower.lean | 28 +- .../BGS/Markoff/TraceCurve/Kummer.lean | 46 +- .../LaurentComparisonInjectivity.lean | 30 +- .../TraceCurve/LaurentNormalization.lean | 6 +- .../BGS/Markoff/TraceCurve/LaurentSmooth.lean | 4 +- .../BGS/Markoff/TraceCurve/Localization.lean | 52 +- .../BGS/Markoff/TraceCurve/NormalForm.lean | 18 +- .../OddCommonPrimeIndependence.lean | 4 +- .../TraceCurve/OddCoprimeIrreducibility.lean | 6 +- .../PositiveCoprimeIrreducibility.lean | 54 +- .../ProjectiveNormalizationMorphism.lean | 14 +- .../TraceCurve/SemanticNormalForm.lean | 12 +- .../SyntacticDivisionCriterion.lean | 18 +- .../TraceCurve/SyntacticNormalForm.lean | 30 +- .../TraceCurve/WeightedIrreducibility.lean | 6 +- .../WeightedOddCoprimeIrreducibility.lean | 4 +- .../BGS/NumberTheory/DivisorBound.lean | 4 +- .../NumberTheory/ExplicitDivisorBound.lean | 4 +- .../JointMaximalDivisorCertificate.lean | 6 +- .../OneSidedPrimitiveWitness.lean | 6 +- .../NumberTheory/PreliminaryDivisorBound.lean | 88 +-- .../NumberTheory/PrimePowerFactorization.lean | 4 +- .../NumberTheory/RankinCanonicalProfile.lean | 4 +- .../NumberTheory/RankinCutoff1248Data.lean | 6 +- .../RankinPositionalCoverage.lean | 4 +- .../RankinPositionalSupportBound.lean | 4 +- .../NumberTheory/RankinProfileMatching.lean | 8 +- ...ncatedOrderTotientRankinFactorization.lean | 2 +- .../NumberTheory/WeightedDivisorMoment.lean | 303 +++++----- .../RiemannRoch/AdeleSpace/Basic.lean | 12 +- .../RiemannRoch/AdeleSpace/FilterChain.lean | 98 ++-- .../RiemannRoch/CoordinateFree/AlgEquiv.lean | 4 +- .../RiemannRoch/FunctionField/Divisor.lean | 84 +-- .../RiemannRoch/Genus/AdeleQuotient.lean | 8 +- .../MarkoffModP/RiemannRoch/Genus/Polar.lean | 22 +- .../RiemannRoch/Genus/Ramification.lean | 12 +- .../MarkoffModP/RiemannRoch/LinearKneser.lean | 12 +- LeanPool/MarkoffModP/RiemannRoch/Place.lean | 32 +- .../MarkoffModP/RiemannRoch/PlaceEquiv.lean | 16 +- .../RiemannRoch/RRspace/Basic.lean | 52 +- .../RiemannRochTheorem/Corollaries.lean | 18 +- .../RiemannRoch/SeparableRelNorm.lean | 98 ++-- .../RiemannRoch/WeilDifferential/Basic.lean | 14 +- 309 files changed, 4315 insertions(+), 4285 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean b/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean index 9ce2f4d210..4779464aa0 100644 --- a/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean +++ b/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean @@ -113,9 +113,9 @@ theorem irreducible_clearedLinearFractionalSubstitution {f : K[X]} (hf : Irreducible f) (hfDegree : 2 ≤ f.natDegree) {a b c d : K} (hdet : a * d - b * c ≠ 0) : Irreducible (clearedLinearFractionalSubstitution f a b c d) := by - letI : Fact (Irreducible f) := ⟨hf⟩ + let : Fact (Irreducible f) := ⟨hf⟩ let E := AdjoinRoot f - letI : FiniteDimensional K E := by + let : FiniteDimensional K E := by change FiniteDimensional K (AdjoinRoot f) exact (AdjoinRoot.powerBasis hf.ne_zero).finite let α : E := AdjoinRoot.root f diff --git a/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean b/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean index 55550ee2b9..066c61b40c 100644 --- a/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean +++ b/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean @@ -106,8 +106,8 @@ theorem exists_rootMonomial_of_primePower_mem_base ∃ k < e, e ∣ q * k ∧ ∃ c : F, z = algebraMap F (AdjoinRoot (X ^ e - C v)) c * AdjoinRoot.root (X ^ e - C v) ^ k := by - letI : Fact (Irreducible (X ^ e - C v)) := ⟨hirr⟩ - letI : NeZero e := ⟨he.ne'⟩ + let : Fact (Irreducible (X ^ e - C v)) := ⟨hirr⟩ + let : NeZero e := ⟨he.ne'⟩ let ζe : rootsOfUnity e F := rootsOfUnity.mkOfPowEq ζ hζ.pow_eq_one let T : AdjoinRoot (X ^ e - C v) →ₐ[F] AdjoinRoot (X ^ e - C v) := autAdjoinRootXPowSubCHom e v ζe @@ -136,7 +136,7 @@ theorem exists_rootMonomial_of_primePower_mem_base _ = z ^ q := hzq.symm have hratioPow : (T z / z) ^ q = 1 := by rw [div_pow, hTpow, div_self (pow_ne_zero q hz)] - letI : NeZero q := ⟨hq.ne_zero⟩ + let : NeZero q := ⟨hq.ne_zero⟩ obtain ⟨m, hm, hmratio⟩ := hζqL.eq_pow_of_pow_eq_one hratioPow have hTz : T z = algebraMap F (AdjoinRoot (X ^ e - C v)) (ζ ^ (s * m)) * z := by diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean index f11ac6fa63..bcab7dc4e5 100644 --- a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean @@ -81,7 +81,7 @@ def constantOpenGlueData refine @AlgebraicGeometry.IsOpenImmersion.comp _ (V i) (U i) (eqToHom _) (f i) ?_ hf refine @AlgebraicGeometry.IsOpenImmersion.of_isIso _ _ (eqToHom _) ?_ - exact (eqToIso (if_neg hij)).isIso_hom + exact (eqToIso (ite_eq_right hij)).isIso_hom /-- Glue schemes whose overlap in each chart is identified with one common scheme. The transition from chart `i` to chart `j` is induced by passing through the common target, so identity and @@ -120,7 +120,7 @@ def constantOpenGlueDataOfCommonTargetMap dsimp only [E, constantOpenGlueDataOfCommonTarget, constantOpenGlueData, CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', constantOpenGlueDataAux] at hc - simp only [dif_neg hij, dif_neg (Ne.symm hij)] at hc + simp only [dite_eq_right hij, dite_eq_right (Ne.symm hij)] at hc simp at hc exact (cancel_epi _).mp hc fapply Multicoequalizer.desc @@ -137,7 +137,7 @@ def constantOpenGlueDataOfCommonTargetMap · dsimp only [D, constantOpenGlueDataOfCommonTarget, constantOpenGlueData, CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', constantOpenGlueDataAux] - simp only [dif_neg hij, dif_neg (Ne.symm hij)] + simp only [dite_eq_right hij, dite_eq_right (Ne.symm hij)] simp congr 1 simp only [← Category.assoc] diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean index b9f4301019..b1b1cdac40 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean @@ -24,8 +24,8 @@ theorem divisorExponentAntichain_card_le_centralDivisorRankCoefficient (hantichain : IsAntichain (· ≤ ·) (antichain : Set (DivisorExponentBox factors))) : antichain.card ≤ centralDivisorRankCoefficient factors := by - letI := divisorExponentBoxFintype factors - letI := divisorExponentBoxPartialOrder factors + let := divisorExponentBoxFintype factors + let := divisorExponentBoxPartialOrder factors have hcentral := (divisorExponentBoxDecomposition factors).antichain_card_le_central_rank antichain hantichain diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean index be331a0c3d..6228f118f1 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean @@ -44,11 +44,11 @@ theorem gridKey_le_min {m n x y : ℕ} (hx : x ≤ m) (hy : y ≤ n) : gridKey m n x y ≤ min m n := by by_cases hmn : m ≤ n - · rw [gridKey, if_pos hmn] + · rw [gridKey, ite_eq_left hmn] apply le_min · exact (min_le_right _ _).trans (Nat.sub_le _ _) · exact (min_le_left _ _).trans hy - · rw [gridKey, if_neg hmn] + · rw [gridKey, ite_eq_right hmn] apply le_min · exact (min_le_left _ _).trans hx · exact (min_le_right _ _).trans (Nat.sub_le _ _) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean index ce7ce8fa38..2ebac88148 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean @@ -163,7 +163,7 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed let P : Ideal (MvPolynomial V K) := RingHom.ker ψ have hPprime : P.IsPrime := RingHom.ker_isPrime ψ obtain ⟨M, hMmax, hPM⟩ := Ideal.exists_le_maximal P hPprime.ne_top - letI : Finite V := by infer_instance + let : Finite V := by infer_instance obtain ⟨x, hx⟩ := MvPolynomial.eq_vanishingIdeal_singleton_of_isMaximal E hMmax let θ : MvPolynomial V K →+* E := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean index 8c4d2db82d..b5d5cba813 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean @@ -229,7 +229,7 @@ theorem auxiliaryRelationPolynomial_coeff_natDegree_le exact Polynomial.natDegree_add_le_of_degree_le hA (hG 0) | succ s => simp only [Polynomial.coeff_sub, Polynomial.coeff_add, - Polynomial.coeff_C, if_neg (Nat.succ_ne_zero s), zero_add, + Polynomial.coeff_C, ite_eq_right (Nat.succ_ne_zero s), zero_add, Polynomial.coeff_mul_X] simpa using Polynomial.natDegree_sub_le_of_le (hG (s + 1)) (hG s) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean index e51da05fb1..335feadcda 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean @@ -124,7 +124,7 @@ theorem exists_constant_dedekindPoleDepth_sub_mul_lt rw [hz, finitePlaceOrderTop_eq_coe v x hx] simp · refine ⟨c, ?_, ?_⟩ - simp only [dedekindPoleDepth, hx, hz, if_false] + simp only [dedekindPoleDepth, hx, hz, ite_false] have hxorderneg : finitePlaceOrder v x < 0 := by rw [finitePlaceOrderTop_eq_coe v x hx] at hxneg exact_mod_cast hxneg @@ -390,7 +390,7 @@ theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_pol (((D : L → L)^[epsilonOrder (σ i)]) (g i)) := by gcongr with i by_cases hi : i ∈ poles - · simp only [hi, if_true] + · simp only [hi, ite_true] have hgi : g i ≠ 0 := by intro hz have hneg := hpole i hi @@ -401,7 +401,7 @@ theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_pol v π hπ hπIdeal D hDIntegral (epsilonOrder (σ i)) (g i) rw [finitePlaceOrderTop_eq_coe v (g i) hgi] at hbound simpa only [← WithTop.coe_add, sub_eq_add_neg] using hbound - · simp only [hi, if_false] + · simp only [hi, ite_false] exact finitePlaceOrderTop_derivation_iterate_nonnegative_of_nonnegative v D hDIntegral (epsilonOrder (σ i)) (g i) (hregular i hi) _ = finitePlaceOrderTop v diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean index 956ae7add1..9ad114da64 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean @@ -46,7 +46,7 @@ def idealMultiplicityDivisor (I : Ideal R) (hI : I ≠ ⊥) : HeightOneSpectrum R →₀ Nat := let h := Ideal.finite_factors hI Finsupp.mk h.toFinset (fun v => multiplicity v.asIdeal I) (fun v => by - rw [h.mem_toFinset, Set.mem_setOf_eq] + rw [h.mem_toFinset, Set.mem_ofPred_eq] simpa [Nat.pos_iff_ne_zero] using (dvd_iff_multiplicity_pos (FiniteMultiplicity.of_prime_left v.prime hI)).symm) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean index 0166c71f6b..a381938a4f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean @@ -75,7 +75,7 @@ theorem traceSeparabilityElement_central (b : Basis ι K L) (x : L) : simp only [Finset.sum_apply'] simp_rw [TensorProduct.equivFinsuppOfBasisLeft_apply_tmul_apply] simp only [Basis.repr_self, Finsupp.single_apply, ite_smul, one_smul, zero_smul, - Finset.sum_ite_eq', Finset.mem_univ, if_true] + Finset.sum_ite_eq', Finset.mem_univ, ite_true] rw [← traceDual_mul_eq_sum_repr b x j] /-- Multiplication sends the trace-dual separability element to one. -/ @@ -184,7 +184,7 @@ private lemma exists_integral_traceDual_mul rw [← Submodule.restrictScalars_mem A, Submodule.traceDual_span_of_basis A (1 : Submodule B L) bK hbspan] exact Submodule.subset_span (Set.mem_range_self i) - letI : IsFractionRing B L := + let : IsFractionRing B L := IsIntegralClosure.isFractionRing_of_finite_extension A K L B have hd' : algebraMap B L d ∈ (FractionalIdeal.dual A K (1 : FractionalIdeal B⁰ L))⁻¹ := by @@ -222,14 +222,14 @@ variable {A B κ : Type*} private theorem mem_kaehlerAnnihilator_of_mem_differentIdeal_of_basis (bA : Basis κ A B) (d : B) (hd : d ∈ differentIdeal A B) : d ∈ Module.annihilator B Ω[B⁄A] := by - letI : IsIntegralClosure B A (FractionRing B) := + let : IsIntegralClosure B A (FractionRing B) := IsIntegralClosure.of_isIntegrallyClosed B A (FractionRing B) - letI : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := + let : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := isAlgebraic_of_isFractionRing A B .. - letI : IsLocalization + let : IsLocalization (Algebra.algebraMapSubmonoid B A⁰) (FractionRing B) := IsIntegralClosure.isLocalization A (FractionRing A) (FractionRing B) B - letI : FiniteDimensional (FractionRing A) (FractionRing B) := + let : FiniteDimensional (FractionRing A) (FractionRing B) := .of_isLocalization A B A⁰ let bK := bA.localizationLocalization (FractionRing A) A⁰ (FractionRing B) let c : κ → B := fun i ↦ @@ -248,7 +248,7 @@ private theorem mem_kaehlerAnnihilator_of_mem_differentIdeal_of_basis one_mul, map_sum, Finset.sum_apply'] simp_rw [TensorProduct.equivFinsuppOfBasisLeft_apply_tmul_apply] simp only [Basis.repr_self, Finsupp.single_apply, ite_smul, one_smul, - zero_smul, Finset.sum_ite_eq', Finset.mem_univ, if_true] + zero_smul, Finset.sum_ite_eq', Finset.mem_univ, ite_true] apply FaithfulSMul.algebraMap_injective B (FractionRing B) rw [map_sum] have htrace := traceDual_mul_eq_sum_repr bK @@ -308,7 +308,7 @@ theorem differentIdeal_le_kaehlerDifferentialAnnihilator differentIdeal A B ≤ Module.annihilator B Ω[B⁄A] := by intro d hd let bA := Module.Free.chooseBasis A B - letI := Classical.decEq (Module.Free.ChooseBasisIndex A B) + let := Classical.decEq (Module.Free.ChooseBasisIndex A B) exact mem_kaehlerAnnihilator_of_mem_differentIdeal_of_basis bA d hd /-- In a principal target, a generator of the trace different is also a diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean index 16979806ef..49faba865a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean @@ -159,9 +159,9 @@ theorem dedekindLocal_formallyEtale_of_isUnramifiedAt [Algebra.IsUnramifiedAt A Q] : Algebra.FormallyEtale (Localization.AtPrime p) (Localization.AtPrime Q) := by - letI : Algebra.FinitePresentation A B := + let : Algebra.FinitePresentation A B := Algebra.FinitePresentation.of_finiteType.mp inferInstance - letI : Algebra.FormallyEtale A (Localization.AtPrime Q) := + let : Algebra.FormallyEtale A (Localization.AtPrime Q) := Algebra.IsEtaleAt.of_isUnramifiedAt_of_flat Q exact Algebra.FormallyEtale.of_restrictScalars (R := A) (A := Localization.AtPrime p) (B := Localization.AtPrime Q) @@ -179,7 +179,7 @@ theorem dedekindLocal_formallyEtale_of_not_dvd_different (hQ : ¬ Q ∣ differentIdeal A B) : Algebra.FormallyEtale (Localization.AtPrime p) (Localization.AtPrime Q) := by - letI : Algebra.IsUnramifiedAt A Q := + let : Algebra.IsUnramifiedAt A Q := not_dvd_differentIdeal_iff.mp hQ exact dedekindLocal_formallyEtale_of_isUnramifiedAt p Q @@ -215,7 +215,7 @@ theorem dedekindLocal_derivation_preserves_of_isUnramifiedAt ∀ t : Localization.AtPrime Q, E (algebraMap (Localization.AtPrime Q) U t) = algebraMap (Localization.AtPrime Q) U (D' t) := by - letI : Algebra.FormallyEtale (Localization.AtPrime p) + let : Algebra.FormallyEtale (Localization.AtPrime p) (Localization.AtPrime Q) := dedekindLocal_formallyEtale_of_isUnramifiedAt p Q exact formallyEtale_derivation_preserves D E hE @@ -254,7 +254,7 @@ theorem dedekindLocal_derivation_preserves_of_not_dvd_different ∀ t : Localization.AtPrime Q, E (algebraMap (Localization.AtPrime Q) U t) = algebraMap (Localization.AtPrime Q) U (D' t) := by - letI : Algebra.FormallyEtale (Localization.AtPrime p) + let : Algebra.FormallyEtale (Localization.AtPrime p) (Localization.AtPrime Q) := dedekindLocal_formallyEtale_of_not_dvd_different p Q hQ exact formallyEtale_derivation_preserves D E hE diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean index 3c0276db61..2a3e70f27c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean @@ -51,10 +51,10 @@ theorem exists_frobeniusSubfield_regular_unit_sub_mul_mem_of_perfect_residue algebraMap (frobeniusSubfield L p) L c = algebraMap R L b ∧ (u : R) - b * (w : R) ∈ v.asIdeal := by let κ := v.asIdeal.ResidueField - letI : CharP κ p := + let : CharP κ p := CharP.of_ringHom_of_ne_zero (algebraMap R κ) p (Fact.out : p.Prime).ne_zero - letI : ExpChar κ p := inferInstance + let : ExpChar κ p := inferInstance let ratio : κ := algebraMap R κ (((u * w⁻¹ : Rˣ) : R)) obtain ⟨z, hz⟩ := surjective_frobenius κ p ratio obtain ⟨a, ha⟩ := v.asIdeal.algebraMap_residueField_surjective z @@ -199,7 +199,7 @@ theorem exists_frobeniusSubfield_dedekindPoleDepth_sub_mul_lt_of_perfect_residue · rw [hz, finitePlaceOrderTop_eq_coe v x hx] simp · refine ⟨c, ?_, ?_⟩ - · simp only [dedekindPoleDepth, hx, hz, if_false] + · simp only [dedekindPoleDepth, hx, hz, ite_false] have hxorderneg : finitePlaceOrder v x < 0 := by rw [finitePlaceOrderTop_eq_coe v x hx] at hxneg exact_mod_cast hxneg diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean index d17914e4a6..5cbc3eec32 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean @@ -30,10 +30,10 @@ theorem torusCurveTorsionIntersection_card_le_orders (torusCurveTorsionIntersection K f firstOrder secondOrder).card ≤ firstOrder * secondOrder := by let S := torusCurveTorsionIntersection K f firstOrder secondOrder - letI : NeZero firstOrder := ⟨hfirst.ne'⟩ - letI : NeZero secondOrder := ⟨hsecond.ne'⟩ - letI : Fintype (rootsOfUnity firstOrder K) := Fintype.ofFinite _ - letI : Fintype (rootsOfUnity secondOrder K) := Fintype.ofFinite _ + let : NeZero firstOrder := ⟨hfirst.ne'⟩ + let : NeZero secondOrder := ⟨hsecond.ne'⟩ + let : Fintype (rootsOfUnity firstOrder K) := Fintype.ofFinite _ + let : Fintype (rootsOfUnity secondOrder K) := Fintype.ofFinite _ let toRoots : {z // z ∈ S} → rootsOfUnity firstOrder K × rootsOfUnity secondOrder K := fun z ↦ (⟨z.1.1, (mem_rootsOfUnity firstOrder z.1.1).2 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean index e1341dbd35..461f685977 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean @@ -70,7 +70,7 @@ theorem poweredTorsionFunctions_ne_zero_of_isCorvajaZannierPlaneCurve planeCurveFunction f 1 ^ secondOrder - 1 ≠ 0 := by let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure hcurve.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hxTrans : Transcendental K (planeCurveFunction f 0) := firstCoordinate_transcendental hf @@ -107,7 +107,7 @@ theorem poweredCoordinateImageRelation_spec_of_isCorvajaZannierPlaneCurve ∀ i, (g.coeff i).natDegree ≤ secondOrder * firstDegree := by let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure hcurve.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let g := poweredCoordinateImageRelation hf hcurve.2.2.2 firstOrder hfirstOrder secondOrder diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean index 0840c7a300..0b40089045 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean @@ -180,7 +180,7 @@ theorem finiteExtensionInfinityPlaceLocalIsFractionRing (FiniteExtensionInfinityPlaceLocalRing K L P) := Algebra.toSMul let _ : SMul (FiniteExtensionInfinityPlaceLocalRing K L P) L := Algebra.toSMul let _ : SMul (RatFuncInfinityIntegralClosure K L) L := Algebra.toSMul - letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) + let : IsScalarTower (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) L := by have htower := IsScalarTower.of_algebraMap_eq' (R := RatFuncInfinityIntegralClosure K L) @@ -233,9 +233,9 @@ theorem finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -245,7 +245,7 @@ theorem finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder (FiniteExtensionInfinityPlaceLocalRing K L P) := Algebra.toSMul let _ : SMul (FiniteExtensionInfinityPlaceLocalRing K L P) L := Algebra.toSMul let _ : SMul (RatFuncInfinityIntegralClosure K L) L := Algebra.toSMul - letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) + let : IsScalarTower (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) L := by have htower := IsScalarTower.of_algebraMap_eq' (R := RatFuncInfinityIntegralClosure K L) @@ -269,9 +269,9 @@ theorem finiteExtensionInfinityPlaceLocalOrderTop_eq_globalOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x : WithTop ℤ) := by let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -324,13 +324,13 @@ theorem finiteExtensionInfinityPlace_local_preserves_of_global_preserves (K := K) (L := L) P s := by let hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing + let hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P let _ : SMul (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) := Algebra.toSMul let _ : SMul (FiniteExtensionInfinityPlaceLocalRing K L P) L := Algebra.toSMul let _ : SMul (RatFuncInfinityIntegralClosure K L) L := Algebra.toSMul - letI : IsScalarTower (RatFuncInfinityIntegralClosure K L) + let : IsScalarTower (RatFuncInfinityIntegralClosure K L) (FiniteExtensionInfinityPlaceLocalRing K L P) L := by have htower := IsScalarTower.of_algebraMap_eq' (R := RatFuncInfinityIntegralClosure K L) @@ -374,7 +374,7 @@ theorem exists_finiteExtensionInfinityPlace_canonicalDifferent_scaling_certifica finiteExtensionInfinityPlaceLocalizationToField (K := K) (L := L) P s := by let q := primeOverHeightOne (ratFuncInfinityPlace K) P - letI : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by + let : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by simpa [q] using (Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P) have hs : ratFuncInfinityUniformizer K ≠ 0 := by @@ -460,9 +460,9 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseIII_of_scaled_preserves (auxiliaryFamily u v h k)).det := by let hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing + let hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -512,9 +512,9 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseIV_of_scaled_preserves (auxiliaryFamily u v h k)).det := by let hLocalAlgebra := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing + let hLocalFraction := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -756,9 +756,9 @@ theorem finiteExtensionInfinityPlace_exists_local_lift_of_orderTop_nonnegative x = finiteExtensionInfinityPlaceLocalizationToField (K := K) (L := L) P x₀ := by let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -813,9 +813,9 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseII_of_scaled_preserves (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -927,16 +927,16 @@ theorem ratFuncInfinityPlace_residueField_finite [Fintype K] : theorem finiteExtensionInfinityPlace_residueField_finite [Fintype K] (P : FiniteExtensionInfinityPlace K L) : Finite P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal - letI : Finite p.ResidueField := + let : Finite p.ResidueField := ratFuncInfinityPlace_residueField_finite (K := K) - letI : P.1.LiesOver p := by + let : P.1.LiesOver p := by simpa [p] using Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P - letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance - letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance - letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + let : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance + let : Module.Finite p.ResidueField P.1.ResidueField := inferInstance exact Module.finite_of_finite p.ResidueField theorem finiteExtensionInfinityPlaceLocal_residueField_perfect [Fintype K] @@ -951,16 +951,16 @@ theorem finiteExtensionInfinityPlaceLocal_residueField_perfect [Fintype K] (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal.ResidueField := by let q := (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal - letI : Finite q.ResidueField := by + let : Finite q.ResidueField := by simpa [q, primeOverHeightOne_asIdeal] using finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P - letI : Finite (HasQuotient.Quotient + let : Finite (HasQuotient.Quotient (RatFuncInfinityIntegralClosure K L) q) := Finite.of_injective (algebraMap (HasQuotient.Quotient (RatFuncInfinityIntegralClosure K L) q) q.ResidueField) q.injective_algebraMap_quotient_residueField - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) @@ -968,7 +968,7 @@ theorem finiteExtensionInfinityPlaceLocal_residueField_perfect [Fintype K] (FiniteExtensionInfinityPlaceLocalRing K L P) let e := IsLocalization.AtPrime.equivQuotMaximalIdeal q (FiniteExtensionInfinityPlaceLocalRing K L P) - letI : Finite (HasQuotient.Quotient + let : Finite (HasQuotient.Quotient (FiniteExtensionInfinityPlaceLocalRing K L P) (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal) := @@ -977,7 +977,7 @@ theorem finiteExtensionInfinityPlaceLocal_residueField_perfect [Fintype K] (FiniteExtensionInfinityPlaceLocalRing K L P) (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal - letI : Finite + let : Finite (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal.ResidueField := IsLocalization.finite Rq (nonZeroDivisors Rq) @@ -1054,15 +1054,15 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseI_of_scaled_preserves (indexedDedekindLocalWronskian D epsilonOrder (auxiliaryFamily u v h k)).det := by let _ := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionInfinityPlaceLocalRing K L P) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (RatFuncInfinityIntegralClosure K L) (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot (FiniteExtensionInfinityPlaceLocalRing K L P) - letI : CharP (FiniteExtensionInfinityPlaceLocalRing K L P) p := ⟨by + let : CharP (FiniteExtensionInfinityPlaceLocalRing K L P) p := ⟨by intro m rw [← map_eq_zero_iff (finiteExtensionInfinityPlaceLocalizationToField @@ -1073,7 +1073,7 @@ theorem finiteExtensionInfinityPlace_auxiliaryFamily_caseI_of_scaled_preserves exact IsFractionRing.injective (FiniteExtensionInfinityPlaceLocalRing K L P) L), map_natCast, CharP.cast_eq_zero_iff L p]⟩ - letI : PerfectField + let : PerfectField (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionInfinityPlaceLocalRing K L P)).asIdeal.ResidueField := finiteExtensionInfinityPlaceLocal_residueField_perfect diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean index 3f4028b1e0..bd29ff3060 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean @@ -221,7 +221,7 @@ theorem finiteExtensionInfinity_sum_ramification_inertia_eq_finrank : (ratFuncInfinityPlace K).asIdeal (RatFuncInfinityIntegralClosure K L) _ = Module.finrank (RatFunc K) L := - (Algebra.IsAlgebraic.finrank_of_isFractionRing + (IsFractionRing.finrank_eq (RatFuncInfinityIntegers K) (RatFunc K) (RatFuncInfinityIntegralClosure K L) L).symm diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean index d3a7b71cd6..fb8e9461aa 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean @@ -40,9 +40,9 @@ noncomputable def probeRatFuncDerivation : @[simp] theorem probeRatFuncDerivation_algebraMap (f : K[X]) : probeRatFuncDerivation K (algebraMap K[X] (RatFunc K) f) = algebraMap K[X] (RatFunc K) f.derivative := by - letI : IsScalarTower K K[X] (RatFunc K) := + let : IsScalarTower K K[X] (RatFunc K) := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra.FormallyEtale K[X] (RatFunc K) := + let : Algebra.FormallyEtale K[X] (RatFunc K) := Algebra.FormallyEtale.of_isLocalization K[X]⁰ simpa only [probeRatFuncDerivation, Polynomial.mkDerivation_apply, smul_eq_mul, mul_one] using @@ -376,10 +376,10 @@ theorem probe_normalizedDerivation_comp_ratFunc (D.restrictScalars K).compAlgebraMap (RatFunc K) = (Algebra.linearMap (RatFunc K) L).compDer (probeRatFuncDerivation K) := by - letI : IsScalarTower K K[X] (RatFunc K) := + let : IsScalarTower K K[X] (RatFunc K) := IsScalarTower.of_algebraMap_eq' (R := K) (S := K[X]) (A := RatFunc K) rfl - letI : Algebra.FormallyEtale K[X] (RatFunc K) := + let : Algebra.FormallyEtale K[X] (RatFunc K) := Algebra.FormallyEtale.of_isLocalization K[X]⁰ apply derivation_ext_of_formallyUnramified (S := K[X]) intro f @@ -494,7 +494,7 @@ theorem probe_exists_normalizedInfinityScaling (K := K) (L := L) P r) = finiteExtensionInfinityPlaceLocalizationToField (K := K) (L := L) P s := by - letI : IsScalarTower K (RatFuncInfinityIntegers K) L := + let : IsScalarTower K (RatFuncInfinityIntegers K) L := probeInfinityConstantLTower K L exact exists_finiteExtensionInfinityPlace_canonicalDifferent_scaling_certificate (K := K) (L := L) D (probeInfinityRingDerivation K) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean index 621904f3cc..c119c0b5fd 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean @@ -60,6 +60,28 @@ theorem finiteExtensionOutsideHeight_negativeSum rw [Nat.cast_mul, Int.natCast_natAbs, abs_of_nonpos (le_of_lt hneg)] ring +private theorem sum_negative_outside_subtype + {X : Type*} [DecidableEq X] (D : X →₀ ℤ) (S T : Finset X) + (hDT : D.support ⊆ T) (weight : X → ℤ) + (S' : Finset {x // x ∈ T}) + (hS' : ∀ x : {x // x ∈ T}, x ∈ S' ↔ x.1 ∈ S) : + ∑ x ∈ Finset.univ.filter (fun x : {x // x ∈ T} => x ∉ S' ∧ D x.1 < 0), + D x.1 * weight x.1 = + ∑ x ∈ D.support.filter (fun x => x ∉ S ∧ D x < 0), D x * weight x := by + classical + rw [Finset.sum_filter] + simp_rw [hS'] + calc + _ = ∑ x ∈ T, if x ∉ S ∧ D x < 0 then D x * weight x else 0 := + (Finset.sum_subtype T (fun x => by simp) + (fun x => if x ∉ S ∧ D x < 0 then D x * weight x else 0)).symm + _ = ∑ x ∈ D.support, if x ∉ S ∧ D x < 0 then D x * weight x else 0 := by + symm + apply Finset.sum_subset hDT + intro x hx hnot + simp [Finsupp.notMem_support_iff.mp hnot] + _ = _ := by rw [Finset.sum_filter] + /-- Exhaustive residue-degree-weighted summation with a genuine canonical divisor and a nonzero global Wronskian. -/ theorem globalWronskianInequality_of_finiteExtensionCanonicalPlacewiseBounds @@ -209,53 +231,17 @@ theorem globalWronskianInequality_of_finiteExtensionCanonicalPlacewiseBounds ∑ P ∈ Finset.univ.filter (fun P : I => P ∉ S' ∧ ord rho P < 0), ord rho P * (finiteExtensionPlaceDegree K L P.1 : ℤ) = -(finiteExtensionOutsideHeight K L rho S : ℤ) := by - let R := (finiteExtensionPrincipalDivisor K L rho).support.filter - (fun P => P ∉ S ∧ finiteExtensionPrincipalDivisor K L rho P < 0) - have hRT : R ⊆ T := by + have hsupport : (finiteExtensionPrincipalDivisor K L rho).support ⊆ T := by intro P hP - have hsupport : P ∈ (finiteExtensionPrincipalDivisor K L rho).support := - (Finset.mem_filter.mp hP).1 - simp [T, finiteExtensionCanonicalSummationSupport, hsupport] - let eR : {P // P ∈ R} ↪ I := - ⟨fun P => ⟨P.1, hRT P.2⟩, - fun P Q hPQ => Subtype.ext - (congrArg (fun R : I => R.1) hPQ)⟩ - have hfilter : Finset.univ.filter (fun P : I => P ∉ S' ∧ ord rho P < 0) = - R.attach.map eR := by - ext P - simp only [Finset.mem_filter, Finset.mem_univ, true_and, Finset.mem_map, - ] - constructor - · intro hP - have hne : finiteExtensionPrincipalDivisor K L rho P.1 ≠ 0 := - ne_of_lt hP.2 - have hmemR : P.1 ∈ R := by - apply Finset.mem_filter.mpr - refine ⟨Finsupp.mem_support_iff.mpr hne, ?_, hP.2⟩ - intro hPS - exact hP.1 ((hS'_iff P).mpr hPS) - let Q : {P // P ∈ R} := ⟨P.1, hmemR⟩ - refine ⟨Q, by simp, ?_⟩ - apply Subtype.ext - rfl - · rintro ⟨Q, hQattach, hQP⟩ - have hval : Q.1 = P.1 := congrArg (fun R : I => R.1) hQP - have hQR := (Finset.mem_filter.mp Q.2).2 - constructor - · rw [hS'_iff] - simpa [hval] using hQR.1 - · simpa [ord, hval] using hQR.2 - rw [hfilter, Finset.sum_map] - change ∑ Q ∈ R.attach, - finiteExtensionPrincipalDivisor K L rho Q.1 * - (finiteExtensionPlaceDegree K L Q.1 : ℤ) = _ + simp [T, finiteExtensionCanonicalSummationSupport, hP] calc - _ = ∑ P ∈ R, finiteExtensionPrincipalDivisor K L rho P * - (finiteExtensionPlaceDegree K L P : ℤ) := - Finset.sum_attach R (fun P => finiteExtensionPrincipalDivisor K L rho P * - (finiteExtensionPlaceDegree K L P : ℤ)) - _ = _ := by - simpa [R] using finiteExtensionOutsideHeight_negativeSum K L rho S + _ = ∑ P ∈ (finiteExtensionPrincipalDivisor K L rho).support.filter + (fun P => P ∉ S ∧ finiteExtensionPrincipalDivisor K L rho P < 0), + finiteExtensionPrincipalDivisor K L rho P * + (finiteExtensionPlaceDegree K L P : ℤ) := + sum_negative_outside_subtype (finiteExtensionPrincipalDivisor K L rho) S T + hsupport (fun P => (finiteExtensionPlaceDegree K L P : ℤ)) S' hS'_iff + _ = _ := finiteExtensionOutsideHeight_negativeSum K L rho S apply globalWronskianInequality_of_weightedPlacewiseBounds (fun P : I => finiteExtensionPlaceDegree K L P.1) S' (ord u) (ord v) (ord rho) (ord grid) ordW diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean index 03e832e248..8c7c80dc9e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean @@ -104,17 +104,17 @@ theorem exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate (K := K) (L := L) q r) = finiteExtensionFinitePlaceLocalizationToField (K := K) (L := L) q s := by - letI : Algebra K L := + let : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : IsScalarTower K (RatFunc K) L := + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K K[X] L := + let : IsScalarTower K K[X] L := IsScalarTower.of_algebraMap_eq' rfl let F := frobeniusSubfield L p - letI : Algebra K F := + let : Algebra K F := (perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p)).toAlgebra - letI : IsScalarTower K F L := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K F L := IsScalarTower.of_algebraMap_eq' rfl let Ds : Derivation K K[X] K[X] := Polynomial.mkDerivation K 1 let E : Derivation K L L := D.restrictScalars K have hE : ∀ s : K[X], @@ -143,8 +143,8 @@ theorem exists_finiteExtensionFinitePlace_canonicalDifferent_scaling_certificate exact (IsFractionRing.injective (RatFuncFiniteIntegralClosure K L) L).ne hδ refine ⟨c, hc, ?_, ?_⟩ · simpa only [c, finiteExtensionCanonicalDifferentDivisor_inl] using hδorder - · letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI : IsScalarTower (RatFuncFiniteIntegralClosure K L) + · let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let : IsScalarTower (RatFuncFiniteIntegralClosure K L) (FiniteExtensionFinitePlaceLocalRing K L q) L := by apply IsScalarTower.of_algebraMap_eq' exact (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean index 21bfc8343c..f115dc5db6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean @@ -43,7 +43,7 @@ theorem gcdMultiplicity_add_outsidePole_le_secondPositivePart · obtain ⟨hDu, hDv⟩ := hOutside hPS rw [hRho] by_cases hneg : Du P - Dv P < 0 - · simp only [hPS, not_false_eq_true, hneg, and_self, if_pos] + · simp only [hPS, not_false_eq_true, hneg, and_self, ite_eq_left] have hmin : min (Du P) (Dv P) = Du P := min_eq_left (sub_nonpos.mp (le_of_lt hneg)) have hcast : @@ -56,7 +56,7 @@ theorem gcdMultiplicity_add_outsidePole_le_secondPositivePart omega exact_mod_cast hcast · have hnonneg : 0 ≤ Du P - Dv P := le_of_not_gt hneg - simp only [hPS, not_false_eq_true, hneg, and_false, if_false, add_zero] + simp only [hPS, not_false_eq_true, hneg, and_false, ite_false, add_zero] exact Int.toNat_le_toNat (min_le_right _ _) /-- If the local order of `rho` is the difference of the two one-minus diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean index d9746f68a4..137bb11791 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean @@ -232,7 +232,7 @@ theorem finiteExtensionPositiveDegree_polynomial_cast rw [finiteExtensionFinitePrincipalDivisor_apply] change 0 < finiteExtensionPrincipalDivisor K L x (.inl q) exact lt_of_le_of_ne hnonneg (Ne.symm hne) - rw [if_pos hpos] + rw [ite_eq_left hpos] simp only [finiteExtensionPlaceDegree, Nat.cast_mul] ring have hinfinity : @@ -247,7 +247,7 @@ theorem finiteExtensionPositiveDegree_polynomial_cast rw [finiteExtensionInfinityPrincipalDivisor_apply] change ¬ 0 < finiteExtensionPrincipalDivisor K L x (.inr q) exact not_lt_of_ge hnonpos - rw [if_neg hnotpos] + rw [ite_eq_right hnotpos] change (finiteExtensionFinitePrincipalDivisor K L x).sum (fun q n => if 0 < n then diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean index b8cee9b66d..492999244b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean @@ -213,7 +213,7 @@ theorem finiteExtensionFiniteDivisorBelow_apply ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by classical let e := finitePlaceFiberEquivPrimesOver K L p - letI : Fintype {q : FiniteExtensionFinitePlace K L // + let : Fintype {q : FiniteExtensionFinitePlace K L // HeightOneSpectrum.under K[X] q = p} := Fintype.ofEquiv (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) e.symm let P₀ : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := @@ -847,18 +847,18 @@ theorem finiteExtensionFinitePlace_inertiaDeg_eq_one (q : FiniteExtensionFinitePlace K L) : q.asIdeal.inertiaDeg K[X] = 1 := by let p := HeightOneSpectrum.under K[X] q - letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime q.asIdeal) := inferInstance - letI : IsAlgClosed p.asIdeal.ResidueField := + let : IsAlgClosed p.asIdeal.ResidueField := IsAlgClosed.of_ringEquiv K p.asIdeal.ResidueField (ratFuncFinitePlaceResidueEquiv K p).symm.toRingEquiv - letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance - letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := + let : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance + let : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := inferInstance - letI : Algebra.IsIntegral p.asIdeal.ResidueField q.asIdeal.ResidueField := + let : Algebra.IsIntegral p.asIdeal.ResidueField q.asIdeal.ResidueField := Algebra.IsIntegral.of_finite _ _ rw [Ideal.inertiaDeg_eq p.asIdeal q.asIdeal, Algebra.finrank_eq_one_iff_bijective_algebraMap] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean index ea54feab12..191c1544fb 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean @@ -88,7 +88,7 @@ private theorem count_relNorm_heightOne_of_liesOver (p : HeightOneSpectrum R) Ring.DimensionLEOne.maximalOfPrime p.ne_bot p.isPrime have hQmax : Q.asIdeal.IsMaximal := Ring.DimensionLEOne.maximalOfPrime Q.ne_bot Q.isPrime - letI : Q.asIdeal.LiesOver p.asIdeal := hQp + let : Q.asIdeal.LiesOver p.asIdeal := hQp rw [relNorm_eq_pow_of_isMaximal_of_isSeparable Q.asIdeal p.asIdeal] rw [FractionalIdeal.coeIdeal_pow] simp [FractionalIdeal.count_pow, FractionalIdeal.count_self] @@ -113,7 +113,7 @@ private theorem count_relNorm_heightOne_of_not_liesOver apply hQp rw [← heq] exact hQq - letI : Q.asIdeal.LiesOver q.asIdeal := hQq + let : Q.asIdeal.LiesOver q.asIdeal := hQq rw [relNorm_eq_pow_of_isMaximal_of_isSeparable Q.asIdeal q.asIdeal] rw [FractionalIdeal.coeIdeal_pow] rw [FractionalIdeal.count_pow, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean index edb78d7816..82c7e77086 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean @@ -104,20 +104,20 @@ theorem finiteExtensionFinitePlace_constantResidue_surjective (q : FiniteExtensionFinitePlace K L) : Function.Surjective (algebraMap K q.asIdeal.ResidueField) := by let p := HeightOneSpectrum.under K[X] q - letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime q.asIdeal) := inferInstance - letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance - letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := + let : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance + let : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := inferInstance - letI : Algebra.IsIntegral p.asIdeal.ResidueField q.asIdeal.ResidueField := + let : Algebra.IsIntegral p.asIdeal.ResidueField q.asIdeal.ResidueField := Algebra.IsIntegral.of_finite _ _ let e := ratFuncFinitePlaceResidueEquiv K p - letI : IsAlgClosed p.asIdeal.ResidueField := + let : IsAlgClosed p.asIdeal.ResidueField := IsAlgClosed.of_ringEquiv K p.asIdeal.ResidueField e.symm.toRingEquiv - letI : IsScalarTower K p.asIdeal.ResidueField q.asIdeal.ResidueField := + let : IsScalarTower K p.asIdeal.ResidueField q.asIdeal.ResidueField := inferInstance intro z obtain ⟨a, ha⟩ := @@ -135,19 +135,19 @@ theorem finiteExtensionInfinityPlace_constantResidue_surjective (P : FiniteExtensionInfinityPlace K L) : Function.Surjective (algebraMap K P.1.ResidueField) := by let p := (ratFuncInfinityPlace K).asIdeal - letI hLocalAlg := + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance - letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := + let : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance - letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance - letI : Algebra.IsIntegral p.ResidueField P.1.ResidueField := + let : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + let : Algebra.IsIntegral p.ResidueField P.1.ResidueField := Algebra.IsIntegral.of_finite _ _ let e := ratFuncInfinityPlaceResidueEquiv K - letI : IsAlgClosed p.ResidueField := + let : IsAlgClosed p.ResidueField := IsAlgClosed.of_ringEquiv K p.ResidueField e.symm.toRingEquiv - letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + let : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance intro z obtain ⟨a, ha⟩ := (IsAlgClosed.algebraMap_bijective_of_isIntegral diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean index 04efbb1aa8..b462c05ea4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean @@ -144,7 +144,7 @@ theorem finiteFunctionField_finrank_frobeniusFieldRange_eq_card : apply congrArg (· * x) simp only [e, F0] exact Algebra.algHom_apply k k⟮X⟯ L c) - letI : FiniteDimensional F0 L := b0.finiteDimensional_of_finite + let : FiniteDimensional F0 L := b0.finiteDimensional_of_finite have hF0TopPos : 0 < IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) := by rw [IntermediateField.relfinrank_top_right] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean index 2e41f69864..847498e406 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean @@ -88,8 +88,8 @@ theorem adjoin_frobeniusSubfield_eq_top IntermediateField.adjoin (frobeniusSubfield L p) {z} = ⊤ := by let F : Subfield L := frobeniusSubfield L p let E : IntermediateField F L := IntermediateField.adjoin F {z} - letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p - letI : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L + let : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + let : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L have hbij : Function.Bijective (algebraMap E L) := IsPurelyInseparable.bijective_algebraMap_of_isSeparable E L change E = ⊤ @@ -137,8 +137,8 @@ theorem finrank_frobeniusSubfield_eq_char have hfinE : Module.finrank F E = p := by rw [IntermediateField.adjoin.finrank hzint, hminpoly, Polynomial.natDegree_X_pow_sub_C] - letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p - letI : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L + let : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + let : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L have hbij : Function.Bijective (algebraMap E L) := IsPurelyInseparable.bijective_algebraMap_of_isSeparable E L let e : E ≃ₐ[F] L := @@ -185,8 +185,8 @@ theorem exists_derivation_with_exact_frobenius_constants have hzint : IsIntegral F z := ⟨_, hmonic, hroot⟩ have hminpoly : minpoly F z = Polynomial.X ^ p - Polynomial.C zp := (minpoly.eq_of_irreducible_of_monic hirr hroot hmonic).symm - letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p - letI : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L + let : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + let : IsPurelyInseparable E L := IsPurelyInseparable.tower_top F E L have hbij : Function.Bijective (algebraMap E L) := IsPurelyInseparable.bijective_algebraMap_of_isSeparable E L have hEtop : E = ⊤ := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean index 42e2be1034..ea07fd6568 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean @@ -67,7 +67,7 @@ theorem globalWronskianInequality_of_placewiseBounds by_cases hiS : i ∈ S · by_cases hvi : 0 < ordV i · have hLocal := hCaseIII i hiS hvi - simp only [lower, hiS, if_pos, hvi] + simp only [lower, hiS, ite_eq_left, hvi] dsimp [base] norm_num at hLocal ⊢ linarith @@ -153,11 +153,11 @@ theorem globalWronskianInequality_of_placewiseBounds congr 1 · apply Finset.sum_congr rfl intro i hi - simp only [lower, hi, if_pos] + simp only [lower, hi, ite_eq_left] · apply Finset.sum_congr rfl intro i hi have hiS : i ∉ S := (Finset.mem_filter.1 hi).2 - simp only [lower, hiS, if_false] + simp only [lower, hiS, ite_false] _ = (∑ i ∈ S, base i) + (∑ i ∈ S, (if 0 < ordV i then ((h * k : ℕ) : ℤ) * ordV i else 0)) + diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean index e8b7733250..031897744d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean @@ -33,7 +33,7 @@ noncomputable def ratFuncInfinityConstantRingHom : (RatFunc.C : K →+* RatFunc K).codRestrict (RatFuncInfinityIntegers K) (fun c => by by_cases hc : c = 0 · simp [hc] - · show RatFunc.inftyValuation K (RatFunc.C c) ≤ 1 + · change RatFunc.inftyValuation K (RatFunc.C c) ≤ 1 rw [RatFunc.inftyValuation.C (F := K) hc]) local instance ratFuncInfinityConstantAlgebra : @@ -103,7 +103,7 @@ theorem ratFuncInfinityIntegers_exists_constant_mod_maximalIdeal rw [Polynomial.leadingCoeff_mul, Polynomial.leadingCoeff_C] exact (div_mul_cancel₀ f.num.leadingCoeff hlcdenom).symm have hdegreeP : P.degree < f.num.degree := by - exact Polynomial.degree_sub_lt hdegreeEq hnum hleadingCoeff + exact Polynomial.degree_sub_lt_left hdegreeEq hnum hleadingCoeff have hrepr : f - RatFunc.C c = algebraMap K[X] (RatFunc K) P / algebraMap K[X] (RatFunc K) f.denom := by @@ -206,24 +206,24 @@ theorem finiteExtensionInfinityPlace_inertiaDeg_eq_one (P : (ratFuncInfinityPlace K).asIdeal.primesOver (RatFuncInfinityIntegralClosure K L)) : P.1.inertiaDeg (RatFuncInfinityIntegers K) = 1 := by - letI hLocalAlg := + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver (ratFuncInfinityPlace K).asIdeal P.1 let : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime (ratFuncInfinityPlace K).asIdeal) (Localization.AtPrime P.1) := inferInstance - letI : IsAlgClosed (ratFuncInfinityPlace K).asIdeal.ResidueField := + let : IsAlgClosed (ratFuncInfinityPlace K).asIdeal.ResidueField := IsAlgClosed.of_ringEquiv K (ratFuncInfinityPlace K).asIdeal.ResidueField (ratFuncInfinityPlaceResidueEquiv K).symm.toRingEquiv - letI : Algebra (ratFuncInfinityPlace K).asIdeal.ResidueField + let : Algebra (ratFuncInfinityPlace K).asIdeal.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra - letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := + let : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance - letI : Module.Finite + let : Module.Finite (ratFuncInfinityPlace K).asIdeal.ResidueField P.1.ResidueField := inferInstance - letI : Algebra.IsIntegral + let : Algebra.IsIntegral (ratFuncInfinityPlace K).asIdeal.ResidueField P.1.ResidueField := Algebra.IsIntegral.of_finite _ _ rw [Ideal.inertiaDeg_eq (ratFuncInfinityPlace K).asIdeal P.1, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean index 440bc3c17f..caf2e30b2c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean @@ -58,7 +58,7 @@ def ratFuncInfinityPlace : HeightOneSpectrum (RatFuncInfinityIntegers K) := /-- `X⁻¹` as an element of the infinity valuation ring. -/ def ratFuncInfinityUniformizer : RatFuncInfinityIntegers K := ⟨1 / RatFunc.X, by - show RatFunc.inftyValuation K (1 / RatFunc.X) ≤ 1 + change RatFunc.inftyValuation K (1 / RatFunc.X) ≤ 1 rw [RatFunc.inftyValuation.X_inv] rw [← WithZero.exp_zero, WithZero.exp_le_exp] omega⟩ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean index 1f6411dd88..2221b874f5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean @@ -150,7 +150,7 @@ theorem coeff_subfield_smul_parameter_pow {q : ℕ} (hq : 0 < q) change (HahnSeries.embDomain (R := K) (Γ := ℤ) (Γ' := ℤ) _ (laurentUndilate K hq a)).coeff ((q : ℤ) * n + (i : ℤ) - (j : ℤ)) = 0 - exact HahnSeries.embDomain_notin_range + exact HahnSeries.embDomain_of_notMem_range (dilation_notin_wrong_residue hq i j hij n) /-- The residue classes of exponents prove that diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean index 78b2f551a3..f877b6963c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean @@ -99,7 +99,7 @@ theorem sum_residueScalar_smul_parameter_pow {q : ℕ} (hq : 0 < q) simp only [HahnSeries.coeff_sum, coeff_subfield_smul_parameter_pow K hq] rw [Finset.sum_ite_eq Finset.univ i₀] - simp only [Finset.mem_univ, if_true] + simp only [Finset.mem_univ, ite_true] rw [laurentUndilate_residueScalar, coeff_laurentResidueComponent, hm] /-- The powers `1,z,...,z^(q-1)` span `K((z))` over `K((z^q))`. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean index d54a601977..3a3a13bda8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean @@ -341,9 +341,9 @@ theorem orderTop_indexedWronskian_det_lower_bound_of_poles ((((LaurentSeries.derivative K)^[epsilonOrder (σ i)]) (g i)).orderTop) := by gcongr with i by_cases hi : i ∈ poles - · simp only [hi, if_true] + · simp only [hi, ite_true] exact order_sub_le_orderTop_derivative_iterate (epsilonOrder (σ i)) (g i) - · simp only [hi, if_false] + · simp only [hi, ite_false] exact orderTop_derivative_iterate_nonnegative_of_order_nonnegative (epsilonOrder (σ i)) (g i) (hregular i hi) _ = (∏ i, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean index b6e7b9bc78..ab70dba65f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean @@ -84,27 +84,27 @@ lemma maximalIdeal_eq_sup_of_etale_quotient q ⊔ Ideal.map (algebraMap R S) (IsLocalRing.maximalIdeal R) := by set p := q.comap (algebraMap R S) set φ₀ : R ⧸ p →+* S ⧸ q := Ideal.quotientMap q (algebraMap R S) le_rfl - letI : Algebra (R ⧸ p) (S ⧸ q) := φ₀.toAlgebra + let : Algebra (R ⧸ p) (S ⧸ q) := φ₀.toAlgebra have hφ₀_eq : algebraMap (R ⧸ p) (S ⧸ q) = φ₀ := RingHom.algebraMap_toAlgebra φ₀ - haveI hp : p.IsPrime := Ideal.IsPrime.comap (algebraMap R S) - haveI : IsLocalRing (R ⧸ p) := .of_surjective' _ Ideal.Quotient.mk_surjective - haveI : IsLocalRing (S ⧸ q) := .of_surjective' _ Ideal.Quotient.mk_surjective - haveI : Algebra.FormallyUnramified (R ⧸ p) (S ⧸ q) := by + have hp : p.IsPrime := Ideal.IsPrime.comap (algebraMap R S) + have : IsLocalRing (R ⧸ p) := .of_surjective' _ Ideal.Quotient.mk_surjective + have : IsLocalRing (S ⧸ q) := .of_surjective' _ Ideal.Quotient.mk_surjective + have : Algebra.FormallyUnramified (R ⧸ p) (S ⧸ q) := by have := ((RingHom.etale_iff_formallyUnramified_and_smooth φ₀).mp hétale).1 rwa [← hφ₀_eq] at this - haveI : IsScalarTower R (R ⧸ p) (S ⧸ q) := .of_algebraMap_eq' rfl - haveI : Module.Finite (R ⧸ p) (S ⧸ q) := Module.Finite.of_restrictScalars_finite R _ _ - haveI : IsLocalHom (algebraMap (R ⧸ p) (S ⧸ q)) := by + have : IsScalarTower R (R ⧸ p) (S ⧸ q) := .of_algebraMap_eq' rfl + have : Module.Finite (R ⧸ p) (S ⧸ q) := Module.Finite.of_restrictScalars_finite R _ _ + have : IsLocalHom (algebraMap (R ⧸ p) (S ⧸ q)) := by rw [hφ₀_eq]; exact RingHom.IsIntegral.isLocalHom (.of_finite (RingHom.finite_algebraMap.mpr ‹_›)) Ideal.quotientMap_injective have mk_max_R : (IsLocalRing.maximalIdeal R).map (Ideal.Quotient.mk p) = IsLocalRing.maximalIdeal (R ⧸ p) := by - haveI := IsLocalHom.of_surjective (Ideal.Quotient.mk p) Ideal.Quotient.mk_surjective + have := IsLocalHom.of_surjective (Ideal.Quotient.mk p) Ideal.Quotient.mk_surjective ext x; obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective x simp [sup_eq_left.mpr (IsLocalRing.le_maximalIdeal hp.ne_top)] have mk_max_S : (IsLocalRing.maximalIdeal S).map (Ideal.Quotient.mk q) = IsLocalRing.maximalIdeal (S ⧸ q) := by - haveI := IsLocalHom.of_surjective (Ideal.Quotient.mk q) Ideal.Quotient.mk_surjective + have := IsLocalHom.of_surjective (Ideal.Quotient.mk q) Ideal.Quotient.mk_surjective ext x; obtain ⟨x, rfl⟩ := Ideal.Quotient.mk_surjective x simp [sup_eq_left.mpr (IsLocalRing.le_maximalIdeal hq_prime.ne_top)] have key : (IsLocalRing.maximalIdeal S).map (Ideal.Quotient.mk q) = @@ -227,9 +227,9 @@ lemma adjoin_eq_top_of_quotient [Algebra R S] [IsLocalRing R] [IsLocalRing S] set mR := IsLocalRing.maximalIdeal R set mS := IsLocalRing.maximalIdeal S set mR_S := Ideal.map (algebraMap R S) mR - haveI : IsArtinianRing (S ⧸ mR_S) := by - letI := Ideal.Quotient.field mR - haveI := Module.Finite.of_restrictScalars_finite R (R ⧸ mR) (S ⧸ mR_S) + have : IsArtinianRing (S ⧸ mR_S) := by + let := Ideal.Quotient.field mR + have := Module.Finite.of_restrictScalars_finite R (R ⧸ mR) (S ⧸ mR_S) exact IsArtinianRing.of_finite (R ⧸ mR) (S ⧸ mR_S) obtain ⟨n, hn⟩ := IsLocalRing.exists_maximalIdeal_pow_le_of_isArtinianRing_quotient mR_S have h_lift := exists_adjoin_sub_mem β q h_gen @@ -314,14 +314,14 @@ theorem exists_isAdjoinRootMonic_of_quotientMap_etale ∃ f : R[X], Nonempty (IsAdjoinRootMonic S f) := by by_cases hφ_etale : Algebra.Etale R S · obtain ⟨β, adj⟩ := exists_adjoin_eq_top (R := R) (S := S) - haveI : Module.Free R S := Module.free_of_flat_of_isLocalRing + have : Module.Free R S := Module.free_of_flat_of_isLocalRing exact ⟨minpoly R β, ⟨IsAdjoinRootMonic.mkOfAdjoinEqTop' adj⟩⟩ set p := q.comap (algebraMap R S) set φ₀ := Ideal.quotientMap q (algebraMap R S) (le_refl p) - haveI : IsLocalRing (R ⧸ p) := .of_surjective' _ Ideal.Quotient.mk_surjective - haveI : IsLocalRing (S ⧸ q) := .of_surjective' _ Ideal.Quotient.mk_surjective - haveI : Module.Finite (R ⧸ p) (S ⧸ q) := Module.Finite.of_restrictScalars_finite R _ _ - haveI : Algebra.Etale (R ⧸ p) (S ⧸ q) := RingHom.etale_algebraMap.mp hétale + have : IsLocalRing (R ⧸ p) := .of_surjective' _ Ideal.Quotient.mk_surjective + have : IsLocalRing (S ⧸ q) := .of_surjective' _ Ideal.Quotient.mk_surjective + have : Module.Finite (R ⧸ p) (S ⧸ q) := Module.Finite.of_restrictScalars_finite R _ _ + have : Algebra.Etale (R ⧸ p) (S ⧸ q) := RingHom.etale_algebraMap.mp hétale obtain ⟨B₀, adj⟩ := exists_adjoin_eq_top (R := R ⧸ p) (S := S ⧸ q) obtain ⟨B, hB⟩ := Ideal.Quotient.mk_surjective B₀ obtain ⟨f₁, hf₁_map, hf₁_monic⟩ : @@ -356,7 +356,7 @@ theorem exists_isAdjoinRootMonic_of_quotientMap_etale rw [hq₀] at h_f₁B_in_q; exact Ideal.mem_span_singleton.mp h_f₁B_in_q have h_deriv_not_in_ms : f₁.derivative.aeval B ∉ ms := by intro h_in_ms - haveI : IsLocalHom (Ideal.Quotient.mk q) := + have : IsLocalHom (Ideal.Quotient.mk q) := IsLocalHom.of_surjective _ Ideal.Quotient.mk_surjective refine (IsLocalRing.mem_maximalIdeal _).mp h_in_ms (isUnit_of_map_unit (Ideal.Quotient.mk q) _ ?_) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean index 640ca325a2..eecdf70921 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean @@ -77,7 +77,7 @@ theorem sylvester_reflect (f g : R[X]) (m n : ℕ) : split_ifs <;> simp_all [revAt] <;> try omega congr 1 change revAtFun n ((i : ℕ) - j) = _ - rw [revAtFun, if_pos (by omega)] + rw [revAtFun, ite_eq_left (by omega)] exact (reflected_row_sub_reflected_shift m n i j i.isLt j.isLt (by omega) (by omega)).symm | right j => @@ -89,7 +89,7 @@ theorem sylvester_reflect (f g : R[X]) (m n : ℕ) : split_ifs <;> simp_all [revAt] <;> try omega congr 1 change revAtFun m ((i : ℕ) - j) = _ - rw [revAtFun, if_pos (by omega)] + rw [revAtFun, ite_eq_left (by omega)] simpa [Nat.add_comm] using (reflected_row_sub_reflected_shift n m i j (by omega) j.isLt (by omega) (by omega)).symm @@ -515,7 +515,7 @@ theorem aeval_reciprocalTranslate_inv_sub_eq_zero aeval ((v - algebraMap A L c)⁻¹) (reciprocalTranslate f c) = 0 := by let x : L := v - algebraMap A L c have hx : x ≠ 0 := sub_ne_zero.mpr hvc - letI : Invertible x := invertibleOfNonzero hx + let : Invertible x := invertibleOfNonzero hx have htaylor : eval₂ (algebraMap A L) x (f.taylor c) = 0 := by rw [taylor_apply, eval₂_comp] simpa [x, aeval_def] using hv diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean index ab0b8cc122..a0ff24ecdf 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean @@ -161,8 +161,8 @@ theorem finiteExtensionFinitePlaceLocalIsFractionRing (q : PlaneCurveExtensionFinitePlace K L) : letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q IsFractionRing (FiniteExtensionFinitePlaceLocalRing K L q) L := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI : IsScalarTower (FunctionField.ringOfIntegers K L) + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let : IsScalarTower (FunctionField.ringOfIntegers K L) (FiniteExtensionFinitePlaceLocalRing K L q) L := by apply IsScalarTower.of_algebraMap_eq' exact (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap @@ -209,14 +209,14 @@ theorem finiteExtensionFinitePlaceLocalOrder_eq_globalOrder (q : PlaneCurveExtensionFinitePlace K L) (x : L) : finiteExtensionFinitePlaceLocalOrder (K := K) (L := L) q x = finitePlaceOrder q x := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot (FiniteExtensionFinitePlaceLocalRing K L q) - letI : IsScalarTower (FunctionField.ringOfIntegers K L) + let : IsScalarTower (FunctionField.ringOfIntegers K L) (FiniteExtensionFinitePlaceLocalRing K L q) L := by apply IsScalarTower.of_algebraMap_eq' exact (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap @@ -233,9 +233,9 @@ theorem finiteExtensionFinitePlaceLocalOrderTop_eq_globalOrder (q : PlaneCurveExtensionFinitePlace K L) (x : L) (hx : x ≠ 0) : finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q x = (finitePlaceOrder q x : WithTop ℤ) := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot @@ -293,9 +293,9 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot @@ -338,9 +338,9 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_ finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot @@ -570,15 +570,15 @@ theorem planeCurve_minpoly_reciprocal_local_normalization_at_finiteExtensionPlac ((planeCurveFunction f 1 - algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c))⁻¹) = (unitNormalizedReciprocalTranslate G c u).map ι := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond exact fun q => planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_fintypeCard diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean index c6574c08f5..b9cc3dcb7d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean @@ -65,9 +65,9 @@ theorem finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative ∃ x₀ : FiniteExtensionFinitePlaceLocalRing K L q, x = finiteExtensionFinitePlaceLocalizationToField (K := K) (L := L) q x₀ := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot @@ -106,11 +106,11 @@ theorem ratFuncFinitePlace_residueField_finite [Fintype K] p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl - letI : Module.Finite K + let : Module.Finite K (HasQuotient.Quotient K[X] p.asIdeal) := by rw [hp] exact hrmonic.finite_quotient - letI : Finite (HasQuotient.Quotient K[X] p.asIdeal) := + let : Finite (HasQuotient.Quotient K[X] p.asIdeal) := Module.finite_of_finite K infer_instance @@ -119,15 +119,15 @@ theorem finiteExtensionFinitePlace_residueField_finite [Fintype K] (q : PlaneCurveExtensionFinitePlace K L) : Finite q.asIdeal.ResidueField := by let p := HeightOneSpectrum.under K[X] q - letI : Finite p.asIdeal.ResidueField := + let : Finite p.asIdeal.ResidueField := ratFuncFinitePlace_residueField_finite p - letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime q.asIdeal) := inferInstance - letI : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance - letI : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := + let : Algebra.QuasiFiniteAt K[X] q.asIdeal := inferInstance + let : Module.Finite p.asIdeal.ResidueField q.asIdeal.ResidueField := inferInstance exact Module.finite_of_finite p.asIdeal.ResidueField @@ -142,23 +142,23 @@ theorem finiteExtensionFinitePlaceLocal_residueField_perfect [Fintype K] PerfectField (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := by - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := finiteExtensionFinitePlace_residueField_finite q - letI : Finite (HasQuotient.Quotient + let : Finite (HasQuotient.Quotient (FunctionField.ringOfIntegers K L) q.asIdeal) := Finite.of_injective (algebraMap (HasQuotient.Quotient (FunctionField.ringOfIntegers K L) q.asIdeal) q.asIdeal.ResidueField) q.asIdeal.injective_algebraMap_quotient_residueField - letI : IsDiscreteValuationRing + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot (FiniteExtensionFinitePlaceLocalRing K L q) let e := IsLocalization.AtPrime.equivQuotMaximalIdeal q.asIdeal (FiniteExtensionFinitePlaceLocalRing K L q) - letI : Finite (HasQuotient.Quotient + let : Finite (HasQuotient.Quotient (FiniteExtensionFinitePlaceLocalRing K L q) (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal) := @@ -167,7 +167,7 @@ theorem finiteExtensionFinitePlaceLocal_residueField_perfect [Fintype K] (FiniteExtensionFinitePlaceLocalRing K L q) (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal - letI : Finite + let : Finite (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := IsLocalization.finite Rq (nonZeroDivisors Rq) @@ -196,9 +196,9 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseII_nonnegative_of_preserv finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (indexedDedekindLocalWronskian D epsilon (auxiliaryFamily u v h k)).det := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot @@ -296,14 +296,14 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseI_q_wronskian_bound_of_sc finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (indexedDedekindLocalWronskian D epsilonOrder (auxiliaryFamily u v h k)).det := by - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsDiscreteValuationRing + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain (FunctionField.ringOfIntegers K L) q.ne_bot (FiniteExtensionFinitePlaceLocalRing K L q) - letI : CharP (FiniteExtensionFinitePlaceLocalRing K L q) p := ⟨by + let : CharP (FiniteExtensionFinitePlaceLocalRing K L q) p := ⟨by intro n rw [← map_eq_zero_iff (finiteExtensionFinitePlaceLocalizationToField @@ -314,7 +314,7 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseI_q_wronskian_bound_of_sc exact IsFractionRing.injective (FiniteExtensionFinitePlaceLocalRing K L q) L), map_natCast, CharP.cast_eq_zero_iff L p]⟩ - letI : PerfectField + let : PerfectField (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := finiteExtensionFinitePlaceLocal_residueField_perfect q diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean index d5083a9a48..d9baf90c9b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean @@ -135,7 +135,7 @@ theorem bivariateEquiv_symm_natDegree_eq_degreeOf_one MvPolynomial.degreeOf 1 f := by let remaining := {i : Fin 2 // i ≠ 1} let i0 : remaining := ⟨0, by decide⟩ - letI : Unique remaining := + let : Unique remaining := { default := i0 uniq := by intro i @@ -271,10 +271,10 @@ theorem isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin Algebra.IsSeparable (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L := by let F := frobeniusSubfield L p - letI : Algebra K F := + let : Algebra K F := (perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p)).toAlgebra - letI : IsScalarTower K F L := by + let : IsScalarTower K F L := by apply IsScalarTower.of_algebraMap_eq' ext c exact (coe_perfectConstantsToFrobeniusSubfield @@ -287,8 +287,8 @@ theorem isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin rw [Set.mem_singleton_iff] at hx subst x exact IntermediateField.subset_adjoin F {z} (Set.mem_singleton z) - letI : Algebra A E := (IntermediateField.inclusion hAE).toAlgebra - letI : IsScalarTower A E L := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra A E := (IntermediateField.inclusion hAE).toAlgebra + let : IsScalarTower A E L := IsScalarTower.of_algebraMap_eq' rfl exact Algebra.isSeparable_tower_top_of_isSeparable A E L /-- A separating element has minimal polynomial of exact degree `p` over the @@ -299,7 +299,7 @@ theorem minpoly_natDegree_over_frobeniusSubfield_eq_char (IntermediateField.adjoin (frobeniusSubfield L p) {z}) L] : (minpoly (frobeniusSubfield L p) z).natDegree = p := by let F := frobeniusSubfield L p - letI : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p + let : IsPurelyInseparable F L := frobeniusSubfield_isPurelyInseparable p have hzIntegral : IsIntegral F z := IsPurelyInseparable.isIntegral' F z calc (minpoly F z).natDegree = @@ -356,9 +356,9 @@ theorem planeCurve_auxiliaryFamily_linearIndependent LinearIndependent (frobeniusSubfield (PlaneCurveFunctionField f) p) (auxiliaryFamily (planeCurveFunction f 0) (planeCurveFunction f 1) h k) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p intro a b h k ha hh hk hbaseChange hdegreeFirst hdegreeSecond @@ -371,9 +371,9 @@ theorem planeCurve_auxiliaryFamily_linearIndependent planeCurveFrobeniusRelation (K := K) (L := L) (p := p) f have hseparableOverSecond := finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst - letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := + let : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hseparableOverSecond.2 - letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := by + let : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := by exact isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) y have hminpoly : (minpoly F y).natDegree = p := @@ -432,9 +432,9 @@ theorem planeCurve_auxiliaryFamily_linearIndependent_of_nonzero_partials LinearIndependent (frobeniusSubfield (PlaneCurveFunctionField f) p) (auxiliaryFamily (planeCurveFunction f 0) (planeCurveFunction f 1) h k) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p intro a b h k ha hh hk hbaseChange hdegreeFirst hdegreeSecond @@ -480,9 +480,9 @@ theorem planeCurve_auxiliaryFamily_linearIndependent_of_absoluteIrreducible simpa only [MvPolynomial.map_id] using irreducible_map_of_irreducible_map_algebraicClosure (RingHom.id K) f habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p dsimp only @@ -528,9 +528,9 @@ theorem planeCurve_auxiliaryFamily_linearIndependent_of_absoluteIrreducible_coor simpa only [MvPolynomial.map_id] using irreducible_map_of_irreducible_map_algebraicClosure (RingHom.id K) f habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p dsimp only diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean index 8ac9e132c9..b6faf6fa03 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean @@ -69,7 +69,7 @@ theorem finrank_over_firstCoordinate_le_of_hasBidegreeAtMost Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ secondDegree := by let hf := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible hf hpartialSecond).le.trans @@ -88,7 +88,7 @@ theorem finrank_over_secondCoordinate_le_of_hasBidegreeAtMost Module.finrank (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ firstDegree := by let hf := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible hf hpartialFirst).le.trans diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean index aeedb26b59..59132319d2 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -474,9 +474,9 @@ private theorem probe_ratFuncFinitePlaceDegree_eq_finrank_residue rw [← show (normalizedPrimeFinitePlace (K := K) r).asIdeal = p.asIdeal by exact congrArg HeightOneSpectrum.asIdeal hp] rfl - letI : (Ideal.span {(r : K[X])}).IsPrime := + let : (Ideal.span {(r : K[X])}).IsPrime := (normalizedPrimeFinitePlace (K := K) r).isPrime - letI : (Ideal.span {(r : K[X])}).IsMaximal := + let : (Ideal.span {(r : K[X])}).IsMaximal := (inferInstance : (Ideal.span {(r : K[X])}).IsPrime).isMaximal (by simpa only [ne_eq, Ideal.span_singleton_eq_bot] using r.property.1.ne_zero) let ep := residueFieldAlgEquivOfIdealEq (K := K) hpIdeal @@ -503,8 +503,8 @@ private theorem probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue finiteExtensionPlaceDegree K L (.inl q) = Module.finrank K q.asIdeal.ResidueField := by let p := HeightOneSpectrum.under K[X] q - letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime q.asIdeal) := inferInstance @@ -517,12 +517,12 @@ private theorem probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue finiteExtensionPlaceDegree K L (.inr P) = Module.finrank K P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal - letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance - letI : Algebra p.ResidueField P.1.ResidueField := + let : Algebra p.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra - letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + let : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p P.1] have hbase : Module.finrank K p.ResidueField = 1 := by simpa [p] using diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean index 4064abcf20..1fe1f8410e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean @@ -73,15 +73,15 @@ theorem planeCurve_finiteDifferentDegree_le_bidegreeDiscriminantBudget (PlaneCurveFunctionField f)) ≤ (2 * MvPolynomial.degreeOf 1 f - 2) * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond exact (planeCurve_finiteDifferentDegree_le_discrNatDegree hf hpartialSecond hcardK).trans diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean index da0dfec2f2..7901adc900 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean @@ -51,15 +51,15 @@ theorem planeCurve_canonicalDifferent_add_propositionTwoExceptional_weightedDegr ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n), finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℤ) ≤ (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f : ℕ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hcanonical := planeCurve_canonicalDifferentDivisor_degree_le hf hpartialSecond hcardK diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean index d875c233bf..f716502b59 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean @@ -71,21 +71,21 @@ theorem finiteExtensionGcdBound_planeCurvePowers_of_auxiliaryFamily_linearIndepe (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * ((m * MvPolynomial.degreeOf 1 f : ℕ) : ℝ) + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 let y : L := planeCurveFunction f 1 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p dsimp only intro hLI hEuler @@ -119,8 +119,8 @@ theorem finiteExtensionGcdBound_planeCurvePowers_of_auxiliaryFamily_linearIndepe have hsepX := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX - letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + let : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX + let : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) x have hxNot : x ∉ F := @@ -220,21 +220,21 @@ theorem finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_line (k : ℝ) / ((h * k + h + k : ℕ) : ℝ) * ((n * MvPolynomial.degreeOf 0 f : ℕ) : ℝ) + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * (chi : ℝ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 let y : L := planeCurveFunction f 1 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p dsimp only intro hLI hEuler @@ -268,8 +268,8 @@ theorem finiteExtensionGcdBound_planeCurvePowers_swapped_of_auxiliaryFamily_line have hsepX := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX - letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + let : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX + let : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) x have hxNot : x ∉ F := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean index ba7b1c1bde..738d9082ba 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean @@ -40,15 +40,15 @@ theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow_sub_one finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) ((planeCurveFunction f 0) ^ m - 1) = MvPolynomial.degreeOf 1 f * m := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond classical let P : Polynomial K := Polynomial.X ^ m - 1 @@ -91,16 +91,16 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_sub_one finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) ((planeCurveFunction f 1) ^ n - 1) = MvPolynomial.degreeOf 0 f * n := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hy := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveSecondCoordinateRatFuncAlgebra f hy - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_secondRatFunc hf hpartialFirst classical let P : Polynomial K := Polynomial.X ^ n - 1 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean index 63ae009ad7..68a3e94d2f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean @@ -143,7 +143,7 @@ theorem planeCurveSupportCharacterStabilizer_of_diagonalScale_eval_zero ∀ r ∈ f.support, ∀ s ∈ f.support, z.1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * z.2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hquotient : planeCurveQuotientMap f (diagonalScale z f) = 0 := by apply IsFractionRing.injective diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean index 7716fd1fff..1bed7c833c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean @@ -64,7 +64,7 @@ theorem natDegree_sylvesterDeriv_apply_bottom (F : Polynomial (Polynomial K)) (hF : 0 < F.natDegree) (j : Fin (F.natDegree - 1 + F.natDegree)) : (F.sylvesterDeriv ⟨2 * F.natDegree - 2, by omega⟩ j).natDegree = 0 := by - rw [Polynomial.sylvesterDeriv, dif_neg hF.ne'] + rw [Polynomial.sylvesterDeriv, dite_eq_right hF.ne'] rw [Matrix.updateRow_self] split_ifs <;> simp diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean index a6cf57f213..26ac2dbdb3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean @@ -182,15 +182,15 @@ theorem planeCurvePolynomialInSecondCoordinate_discr_ne_zero (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) : (planeCurvePolynomialInSecondCoordinate f).discr ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let F : (RatFunc K)[X] := (planeCurvePolynomialInSecondCoordinate f).map @@ -332,7 +332,7 @@ theorem finiteExtensionFiniteDifferentDivisorBelow_apply (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) := by classical let e := finitePlaceFiberEquivPrimesOver K L p - letI : Fintype {q : FiniteExtensionFinitePlace K L // + let : Fintype {q : FiniteExtensionFinitePlace K L // HeightOneSpectrum.under K[X] q = p} := Fintype.ofEquiv (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) e.symm let P₀ : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := @@ -641,17 +641,17 @@ theorem planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder (PlaneCurveFunctionField f)) p : ℤ) ≤ ratFuncFiniteOrder p (algebraMap K[X] (RatFunc K) (planeCurvePolynomialInSecondCoordinate f).discr) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let algRL : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := algRL - letI : FiniteDimensional (RatFunc K) L := + let : Algebra (RatFunc K) L := algRL + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let A := Localization.AtPrime p.asIdeal let ι := localizationAtPrimeToRatFunc p @@ -666,29 +666,29 @@ theorem planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder let algAR : Algebra A (RatFunc K) := ι.toAlgebra let algPL : Algebra K[X] L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K[X] (RatFunc K))) - letI : Algebra K[X] A := algRA - letI : Algebra K[X] (RatFunc K) := algRR - letI : Algebra A (RatFunc K) := algAR - letI : Algebra K[X] L := algPL - letI : SMul K[X] A := algRA.toSMul - letI : SMul K[X] (RatFunc K) := algRR.toSMul - letI : SMul A (RatFunc K) := algAR.toSMul - letI : SMul K[X] L := algPL.toSMul - letI : IsScalarTower K[X] A (RatFunc K) := by + let : Algebra K[X] A := algRA + let : Algebra K[X] (RatFunc K) := algRR + let : Algebra A (RatFunc K) := algAR + let : Algebra K[X] L := algPL + let : SMul K[X] A := algRA.toSMul + let : SMul K[X] (RatFunc K) := algRR.toSMul + let : SMul A (RatFunc K) := algAR.toSMul + let : SMul K[X] L := algPL.toSMul + let : IsScalarTower K[X] A (RatFunc K) := by apply IsScalarTower.of_algebraMap_eq' exact (localizationAtPrimeToRatFunc_comp_algebraMap p).symm - letI : IsFractionRing A (RatFunc K) := + let : IsFractionRing A (RatFunc K) := IsFractionRing.isFractionRing_of_isDomain_of_isLocalization p.asIdeal.primeCompl A (RatFunc K) let algAL : Algebra A L := ((algebraMap (RatFunc K) L).comp ι).toAlgebra - letI : SMul (RatFunc K) L := algRL.toSMul - letI : Algebra A L := algAL - letI : SMul A L := algAL.toSMul - letI : IsScalarTower A (RatFunc K) L := by + let : SMul (RatFunc K) L := algRL.toSMul + let : Algebra A L := algAL + let : SMul A L := algAL.toSMul + let : IsScalarTower A (RatFunc K) L := by apply IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K[X] A L := by + let : IsScalarTower K[X] A L := by apply IsScalarTower.of_algebraMap_eq' apply DFunLike.ext _ _ intro r @@ -697,7 +697,7 @@ theorem planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder exact (congrArg (algebraMap (RatFunc K) L) (DFunLike.congr_fun (localizationAtPrimeToRatFunc_comp_algebraMap p) r)).symm - letI : IsDiscreteValuationRing A := + let : IsDiscreteValuationRing A := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain K[X] p.ne_bot A let v : L := planeCurveFunction f 1 @@ -786,15 +786,15 @@ theorem planeCurve_finiteDifferentDegree_le_discrNatDegree (finiteExtensionFiniteDifferentIdeal_ne_bot K (PlaneCurveFunctionField f)) ≤ (planeCurvePolynomialInSecondCoordinate f).discr.natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond apply finiteExtensionFiniteDifferentDegree_le_polynomialDegree_of_localBounds K (PlaneCurveFunctionField f) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean index d87302046e..f91786a7e4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean @@ -148,7 +148,7 @@ theorem adjoin_planeCurveFunctions_eq_top_of_irreducible {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : letI := planeCurveCoordinateRing_isDomain hf IntermediateField.adjoin K (Set.range (planeCurveFunction f)) = ⊤ := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact adjoin_planeCurveFunctions_eq_top /-- Embed a univariate polynomial in the first coordinate of the affine plane. -/ @@ -218,7 +218,7 @@ theorem firstCoordinate_transcendental (hsecond : 0 < MvPolynomial.degreeOf 1 f) : letI := planeCurveCoordinateRing_isDomain hf Transcendental K (planeCurveFunction f 0) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [transcendental_iff] intro P hPzero by_contra hP @@ -308,11 +308,11 @@ theorem firstCoordinateCoefficientEval_injective (hsecond : 0 < MvPolynomial.degreeOf 1 f) : letI := planeCurveCoordinateRing_isDomain hf Function.Injective (firstCoordinateCoefficientEval f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let remaining := {i : Fin 2 // i ≠ 1} have remaining_value_zero (i : remaining) : i.1 = 0 := by omega - letI : Subsingleton remaining := + let : Subsingleton remaining := ⟨fun i j ↦ Subtype.ext ((remaining_value_zero i).trans (remaining_value_zero j).symm)⟩ let i0 : remaining := ⟨0, by decide⟩ have hIndependent : AlgebraicIndependent K @@ -367,7 +367,7 @@ theorem polynomialOverFirstCoordinate_ne_zero_of_irreducible (hsecond : 0 < MvPolynomial.degreeOf 1 f) : letI := planeCurveCoordinateRing_isDomain hf polynomialOverFirstCoordinate f ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate] exact (Polynomial.map_ne_zero_iff (firstCoordinateCoefficientEval_injective hf hsecond)).mpr @@ -465,10 +465,10 @@ theorem finiteDimensional_over_firstCoordinate (hpoly : polynomialOverFirstCoordinate f ≠ 0) : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := by have halg := secondCoordinate_isAlgebraic_over_first f hpoly - letI : FiniteDimensional (FirstCoordinateSubfield f) + let : FiniteDimensional (FirstCoordinateSubfield f) (IntermediateField.adjoin (FirstCoordinateSubfield f) {planeCurveFunction f 1}) := IntermediateField.adjoin.finiteDimensional halg.isIntegral - letI : FiniteDimensional (FirstCoordinateSubfield f) + let : FiniteDimensional (FirstCoordinateSubfield f) (⊤ : IntermediateField (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)) := by rw [← adjoin_secondCoordinate_over_first_eq_top f] infer_instance @@ -481,7 +481,7 @@ theorem finrank_over_firstCoordinate_le_degreeOf_second (hpoly : polynomialOverFirstCoordinate f ≠ 0) : Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ MvPolynomial.degreeOf 1 f := by - letI : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := + let : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := finiteDimensional_over_firstCoordinate f hpoly have halg := secondCoordinate_isAlgebraic_over_first f hpoly have hroot : Polynomial.aeval (planeCurveFunction f 1) @@ -522,7 +522,7 @@ theorem finiteDimensional_over_firstCoordinate_of_irreducible (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact finiteDimensional_over_firstCoordinate f (polynomialOverFirstCoordinate_ne_zero_of_irreducible hf (degreeOf_second_pos_of_pderiv_ne_zero hderiv)) @@ -535,7 +535,7 @@ theorem finrank_over_firstCoordinate_le_degreeOf_second_of_irreducible letI := planeCurveCoordinateRing_isDomain hf Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ≤ MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact finrank_over_firstCoordinate_le_degreeOf_second f (polynomialOverFirstCoordinate_ne_zero_of_irreducible hf (degreeOf_second_pos_of_pderiv_ne_zero hderiv)) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean index a79dc67900..56da63a8bd 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean @@ -222,7 +222,7 @@ theorem infinityNormalizedIntegralPolynomial_map simp [Polynomial.sum] by_cases hzero : F.coeff i = 0 · simp [hzero, infinityNormalizedPolynomial, coeff_C_mul] - · rw [if_neg hzero] + · rw [ite_eq_right hzero] have hrhs : (infinityNormalizedPolynomial K a F).coeff i = (RatFunc.X⁻¹) ^ a * algebraMap K[X] (RatFunc K) (F.coeff i) := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean index 3decbcd80a..33758776e7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean @@ -18,7 +18,7 @@ theorem discr_powerBasis_eq_minpoly_discr (pb : PowerBasis K L) : Algebra.discr K pb.basis = (minpoly K pb.gen).discr := by let E := AlgebraicClosure L - letI := fun a b : E => Classical.propDecidable (Eq a b) + let := fun a b : E => Classical.propDecidable (Eq a b) let f := minpoly K pb.gen have hfmonic : f.Monic := minpoly.monic pb.isIntegral_gen have hfne : f ≠ 0 := hfmonic.ne_zero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean index 7d63870cc0..6671865260 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean @@ -295,11 +295,11 @@ theorem aeval_planeCurvePolynomialInSecondCoordinate_ratFunc_eq_zero Polynomial.aeval (planeCurveFunction f 1) ((planeCurvePolynomialInSecondCoordinate f).map (algebraMap (Polynomial K) (RatFunc K))) = 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx have hcoeff : (algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp @@ -364,13 +364,13 @@ theorem adjoin_secondCoordinate_over_firstRatFunc_eq_top (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) letI := planeCurveFirstCoordinateRatFuncAlgebra f hx Algebra.adjoin (RatFunc K) {planeCurveFunction f 1} = ⊤ := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond let F : Polynomial (RatFunc K) := (planeCurvePolynomialInSecondCoordinate f).map @@ -437,11 +437,11 @@ theorem planeCurve_local_reciprocal_certificate_of_degreeOf_second_lt_card Algebra.adjoin (RatFunc K) {planeCurveFunction f 1} = ⊤ ∧ G.natDegree = Module.finrank (RatFunc K) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx let A := Localization.AtPrime p.asIdeal let ι := localizationAtPrimeToRatFunc p @@ -556,13 +556,13 @@ theorem planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_ ((planeCurveFunction f 1 - algebraMap (RatFunc K) (PlaneCurveFunctionField f) (ι c))⁻¹) = (unitNormalizedReciprocalTranslate G c u).map ι := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let algRL : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := algRL + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := algRL let A := Localization.AtPrime p.asIdeal let ι := localizationAtPrimeToRatFunc p obtain ⟨a, u, hu, hroot, hvc, hprimitive, hdegree⟩ := @@ -575,27 +575,27 @@ theorem planeCurve_minpoly_reciprocal_local_normalization_of_degreeOf_second_lt_ let algRA : Algebra (Polynomial K) A := inferInstance let algRR : Algebra (Polynomial K) (RatFunc K) := inferInstance let algAR : Algebra A (RatFunc K) := ι.toAlgebra - letI : Algebra (Polynomial K) A := algRA - letI : Algebra (Polynomial K) (RatFunc K) := algRR - letI : Algebra A (RatFunc K) := algAR - letI : SMul (Polynomial K) A := algRA.toSMul - letI : SMul (Polynomial K) (RatFunc K) := algRR.toSMul - letI : SMul A (RatFunc K) := algAR.toSMul - letI : IsScalarTower (Polynomial K) A (RatFunc K) := by + let : Algebra (Polynomial K) A := algRA + let : Algebra (Polynomial K) (RatFunc K) := algRR + let : Algebra A (RatFunc K) := algAR + let : SMul (Polynomial K) A := algRA.toSMul + let : SMul (Polynomial K) (RatFunc K) := algRR.toSMul + let : SMul A (RatFunc K) := algAR.toSMul + let : IsScalarTower (Polynomial K) A (RatFunc K) := by apply IsScalarTower.of_algebraMap_eq' exact (localizationAtPrimeToRatFunc_comp_algebraMap p).symm - letI : IsFractionRing A (RatFunc K) := + let : IsFractionRing A (RatFunc K) := IsFractionRing.isFractionRing_of_isDomain_of_isLocalization p.asIdeal.primeCompl A (RatFunc K) let algAL : Algebra A (PlaneCurveFunctionField f) := ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp ι).toAlgebra - letI : SMul (RatFunc K) (PlaneCurveFunctionField f) := algRL.toSMul - letI : Algebra A (PlaneCurveFunctionField f) := algAL - letI : SMul A (PlaneCurveFunctionField f) := algAL.toSMul - letI : IsScalarTower A (RatFunc K) (PlaneCurveFunctionField f) := by + let : SMul (RatFunc K) (PlaneCurveFunctionField f) := algRL.toSMul + let : Algebra A (PlaneCurveFunctionField f) := algAL + let : SMul A (PlaneCurveFunctionField f) := algAL.toSMul + let : IsScalarTower A (RatFunc K) (PlaneCurveFunctionField f) := by apply IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hroot' : Polynomial.aeval (planeCurveFunction f 1) G = 0 := by simpa [Polynomial.aeval_def, algAL, RingHom.algebraMap_toAlgebra, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean index 637bc80b54..e6a2c7ec61 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean @@ -39,7 +39,7 @@ theorem coeff_planeCurveLogarithmicPDeriv induction f using MvPolynomial.induction_on' with | add p q hp hq => simp only [planeCurveLogarithmicPDeriv, map_add, mul_add, - MvPolynomial.coeff_add] + AddMonoidAlgebra.coeff_add, Finsupp.add_apply] change (planeCurveLogarithmicPDeriv i p).coeff m + (planeCurveLogarithmicPDeriv i q).coeff m = _ rw [hp, hq] @@ -63,7 +63,7 @@ theorem coeff_planeCurveLogarithmicDirection (f : MvPolynomial (Fin 2) K) (m : Fin 2 →₀ ℕ) : (planeCurveLogarithmicDirection a b f).coeff m = (a * (m 0 : K) + b * (m 1 : K)) * f.coeff m := by - simp only [planeCurveLogarithmicDirection, MvPolynomial.coeff_add, + simp only [planeCurveLogarithmicDirection, AddMonoidAlgebra.coeff_add, Finsupp.add_apply, MvPolynomial.coeff_C_mul, coeff_planeCurveLogarithmicPDeriv] ring @@ -164,7 +164,7 @@ private theorem logWeights_eq_of_logarithmicPDeriv_eq (m 0 : K) - c * (m 1 : K) = d := by intro m hm have hcoeff := congrArg (fun p ↦ p.coeff m) hrelation - simp only [MvPolynomial.coeff_add, MvPolynomial.coeff_C_mul, + simp only [AddMonoidAlgebra.coeff_add, Finsupp.add_apply, MvPolynomial.coeff_C_mul, coeff_planeCurveLogarithmicPDeriv] at hcoeff have hm0 : f.coeff m ≠ 0 := MvPolynomial.mem_support_iff.mp hm @@ -228,7 +228,7 @@ theorem eval_planeCurveLogarithmicDirection_ne_zero_of_supportRankTwo MvPolynomial.eval₂ (algebraMap K (PlaneCurveFunctionField f)) (planeCurveFunction f) (planeCurveLogarithmicDirection 1 (-c) f) ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let Q := planeCurveLogarithmicDirection 1 (-c) f have hno := no_logarithmicPDeriv_scalar_relation_of_supportRankTwo diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean index f7cb265185..5d285083ad 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean @@ -42,7 +42,7 @@ theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) ((planeCurveFunction f 0) ^ m) = m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -54,11 +54,11 @@ theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow apply hx rw [h] exact isAlgebraic_zero - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change finiteExtensionPositiveDegree K L (x ^ m) = m * MvPolynomial.degreeOf 1 f @@ -93,7 +93,7 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_le finiteExtensionPositiveDegree K (PlaneCurveFunctionField f) ((planeCurveFunction f 1) ^ n) ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -107,11 +107,11 @@ theorem finiteExtensionPositiveDegree_planeCurveSecondCoordinate_pow_le apply hyTrans rw [h] exact isAlgebraic_zero - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change finiteExtensionPositiveDegree K L (y ^ n) ≤ n * MvPolynomial.degreeOf 0 f @@ -138,7 +138,7 @@ theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_le (1 - (planeCurveFunction f 0) ^ m) (1 - (planeCurveFunction f 1) ^ n) ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -169,11 +169,11 @@ theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_le apply hyTrans.pow hn rw [h] exact isAlgebraic_one - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change finiteExtensionGcdWeightedDegree K L (1 - x ^ m) (1 - y ^ n) ≤ n * MvPolynomial.degreeOf 0 f @@ -243,9 +243,9 @@ theorem planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub finiteExtensionGcdWeightedDegree K (PlaneCurveFunctionField f) (1 - (planeCurveFunction f 0) ^ m) (1 - (planeCurveFunction f 1) ^ n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f @@ -267,11 +267,11 @@ theorem planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub apply hyTrans.pow hn rw [← h] exact isAlgebraic_one - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond dsimp only [planeCurveExhaustiveTorsionGcdWeightedDegree] change finiteExtensionGcdWeightedDegree K L (x ^ m - 1) (y ^ n - 1) = @@ -299,7 +299,7 @@ theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_swapped_le (1 - (planeCurveFunction f 1) ^ n) (1 - (planeCurveFunction f 0) ^ m) ≤ m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -330,11 +330,11 @@ theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_swapped_le apply hyTrans.pow hn rw [h] exact isAlgebraic_one - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change finiteExtensionGcdWeightedDegree K L (1 - y ^ n) (1 - x ^ m) ≤ m * MvPolynomial.degreeOf 1 f diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean index 5b2452c00a..6805cb42cf 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean @@ -36,7 +36,7 @@ theorem poweredCoordinateImageRelation_transpose_natDegree_mul_commonIndex Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) = n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let a := (transposeBivariate (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree @@ -65,7 +65,7 @@ theorem poweredCoordinateImageRelation_natDegree_mul_commonIndex Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) = m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf calc (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree * diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean index 6e0706e285..c9489f92d3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean @@ -89,16 +89,16 @@ theorem planeCurvePropositionTwo_natural_of_auxiliaryBounds (m * MvPolynomial.degreeOf 1 f) p Chi (planeCurveExhaustiveTorsionGcdWeightedDegree hf hpartialSecond m n : ℝ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let a := (transposeBivariate (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree @@ -197,16 +197,16 @@ theorem planeCurvePropositionTwo_swapped_of_auxiliaryBounds (n * MvPolynomial.degreeOf 0 f) p Chi (planeCurveExhaustiveTorsionGcdWeightedDegree hf hpartialSecond m n : ℝ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let a := (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree let b := (transposeBivariate diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean index 2214cb0782..386e61498d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean @@ -223,7 +223,7 @@ theorem generalPlaneCurvePropositionTwoCertificatesAboveElementaryRange_of_actua hfirstPrimeToChar hsecondPrimeToChar hlarge let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure hcurve.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hnonzero : planeCurveFunction f 0 ^ firstOrder - 1 ≠ 0 ∧ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean index 5780a53504..61fd341ab9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean @@ -49,7 +49,7 @@ first coordinate of the plane curve. -/ letI := planeCurveFirstCoordinateRatFuncAlgebra f hx algebraMap (RatFunc K) (PlaneCurveFunctionField f) RatFunc.X = planeCurveFunction f 0 := by - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFirstCoordinateRatFuncAlgebra f hx change ratFuncSpecialization (planeCurveFunction f 0) hx RatFunc.X = _ simp [ratFuncSpecialization, RatFunc.algEquivOfTranscendental_X] @@ -63,7 +63,7 @@ private theorem planeCurve_firstCoordinate_changeBase_commutes (RingEquiv.refl (PlaneCurveFunctionField f)).toRingHom.comp (algebraMap (FirstCoordinateSubfield f) (PlaneCurveFunctionField f)) := by - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFirstCoordinateRatFuncAlgebra f hx ext z simp [ratFuncSpecialization] @@ -77,13 +77,13 @@ theorem finiteDimensional_planeCurveFunctionField_over_ratFunc (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) letI := planeCurveFirstCoordinateRatFuncAlgebra f hx FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (FirstCoordinateSubfield f) + let : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).1 @@ -102,13 +102,13 @@ theorem separable_planeCurveFunctionField_over_ratFunc (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) letI := planeCurveFirstCoordinateRatFuncAlgebra f hx Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) + let : Algebra.IsSeparable (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 @@ -129,11 +129,11 @@ theorem finrank_planeCurveFunctionField_over_ratFunc_eq_degreeOf_second letI := planeCurveFirstCoordinateRatFuncAlgebra f hx Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx calc Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = @@ -164,7 +164,7 @@ second coordinate of the plane curve. -/ letI := planeCurveSecondCoordinateRatFuncAlgebra f hy algebraMap (RatFunc K) (PlaneCurveFunctionField f) RatFunc.X = planeCurveFunction f 1 := by - letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + let := planeCurveSecondCoordinateRatFuncAlgebra f hy change ratFuncSpecialization (planeCurveFunction f 1) hy RatFunc.X = _ simp [ratFuncSpecialization, RatFunc.algEquivOfTranscendental_X] @@ -178,7 +178,7 @@ private theorem planeCurve_secondCoordinate_changeBase_commutes (RingEquiv.refl (PlaneCurveFunctionField f)).toRingHom.comp (algebraMap (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)) := by - letI := planeCurveSecondCoordinateRatFuncAlgebra f hy + let := planeCurveSecondCoordinateRatFuncAlgebra f hy ext z change ratFuncSpecialization (planeCurveFunction f 1) hy ((RatFunc.algEquivOfTranscendental @@ -198,13 +198,13 @@ theorem finiteDimensional_planeCurveFunctionField_over_secondRatFunc (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) letI := planeCurveSecondCoordinateRatFuncAlgebra f hy FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hy := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveSecondCoordinateRatFuncAlgebra f hy - letI : FiniteDimensional (SecondCoordinateSubfield f) + let : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).1 @@ -223,13 +223,13 @@ theorem separable_planeCurveFunctionField_over_secondRatFunc (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) letI := planeCurveSecondCoordinateRatFuncAlgebra f hy Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hy := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveSecondCoordinateRatFuncAlgebra f hy - letI : Algebra.IsSeparable (SecondCoordinateSubfield f) + let : Algebra.IsSeparable (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).2 @@ -250,11 +250,11 @@ theorem finrank_planeCurveFunctionField_over_secondRatFunc_eq_degreeOf_first letI := planeCurveSecondCoordinateRatFuncAlgebra f hy Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hy := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveSecondCoordinateRatFuncAlgebra f hy calc Module.finrank (RatFunc K) (PlaneCurveFunctionField f) = diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean index e27414cc63..f46b042cd5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean @@ -126,7 +126,7 @@ theorem polynomialOverFirstCoordinate_irreducible (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf Irreducible (polynomialOverFirstCoordinate f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let R := MvPolynomial {i : Fin 2 // i ≠ 1} K let F := FractionRing R let p := polynomialInSecondCoordinate f @@ -161,7 +161,7 @@ theorem derivative_polynomialOverFirstCoordinate_ne_zero (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf (polynomialOverFirstCoordinate f).derivative ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate, Polynomial.derivative_map] exact (Polynomial.map_ne_zero_iff @@ -175,7 +175,7 @@ theorem polynomialOverFirstCoordinate_separable (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf (polynomialOverFirstCoordinate f).Separable := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (Polynomial.separable_iff_derivative_ne_zero (polynomialOverFirstCoordinate_irreducible hf hderiv)).mpr (derivative_polynomialOverFirstCoordinate_ne_zero hf hderiv) @@ -187,7 +187,7 @@ theorem secondCoordinate_isSeparable_over_first (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf IsSeparable (FirstCoordinateSubfield f) (planeCurveFunction f 1) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hroot : Polynomial.aeval (planeCurveFunction f 1) (polynomialOverFirstCoordinate f) = 0 := by simpa [Polynomial.aeval_def] using eval₂_polynomialOverFirstCoordinate_eq_zero f @@ -202,7 +202,7 @@ theorem finiteSeparable_over_firstCoordinate_of_irreducible letI := planeCurveCoordinateRing_isDomain hf FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) ∧ Algebra.IsSeparable (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf constructor · exact finiteDimensional_over_firstCoordinate_of_irreducible hf hderiv · have hAdjoin : Algebra.IsSeparable (FirstCoordinateSubfield f) @@ -226,7 +226,7 @@ theorem natDegree_polynomialOverFirstCoordinate_eq_degreeOf_second (hderiv : MvPolynomial.pderiv 1 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf (polynomialOverFirstCoordinate f).natDegree = MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [polynomialOverFirstCoordinate_eq_map_polynomialInSecondCoordinate, Polynomial.natDegree_map_eq_of_injective (firstCoordinateCoefficientEval_injective hf @@ -241,7 +241,7 @@ theorem natDegree_minpoly_secondCoordinate_eq_degreeOf_second letI := planeCurveCoordinateRing_isDomain hf (minpoly (FirstCoordinateSubfield f) (planeCurveFunction f 1)).natDegree = MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let p := polynomialOverFirstCoordinate f have hpIrreducible : Irreducible p := polynomialOverFirstCoordinate_irreducible hf hderiv @@ -264,8 +264,8 @@ theorem finrank_over_firstCoordinate_eq_degreeOf_second_of_irreducible letI := planeCurveCoordinateRing_isDomain hf Module.finrank (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) = MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := finiteDimensional_over_firstCoordinate_of_irreducible hf hderiv have halg := secondCoordinate_isAlgebraic_over_first f (polynomialOverFirstCoordinate_ne_zero_of_irreducible hf @@ -350,7 +350,7 @@ theorem secondCoordinate_transcendental (hfirst : 0 < MvPolynomial.degreeOf 0 f) : letI := planeCurveCoordinateRing_isDomain hf Transcendental K (planeCurveFunction f 1) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [transcendental_iff] intro P hPzero by_contra hP @@ -434,10 +434,10 @@ theorem secondCoordinateCoefficientEval_injective (hfirst : 0 < MvPolynomial.degreeOf 0 f) : letI := planeCurveCoordinateRing_isDomain hf Function.Injective (secondCoordinateCoefficientEval f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let remaining := {i : Fin 2 // i ≠ 0} have remaining_value_one (i : remaining) : i.1 = 1 := by omega - letI : Subsingleton remaining := + let : Subsingleton remaining := ⟨fun i j => Subtype.ext ((remaining_value_one i).trans (remaining_value_one j).symm)⟩ let i1 : remaining := ⟨1, by decide⟩ have hIndependent : AlgebraicIndependent K @@ -521,7 +521,7 @@ theorem polynomialOverSecondCoordinate_ne_zero_of_irreducible (hfirst : 0 < MvPolynomial.degreeOf 0 f) : letI := planeCurveCoordinateRing_isDomain hf polynomialOverSecondCoordinate f ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation] exact (Polynomial.map_ne_zero_iff (secondCoordinateCoefficientEval_injective hf hfirst)).mpr @@ -599,10 +599,10 @@ theorem finiteDimensional_over_secondCoordinate (hpoly : polynomialOverSecondCoordinate f ≠ 0) : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := by have halg := firstCoordinate_isAlgebraic_over_second f hpoly - letI : FiniteDimensional (SecondCoordinateSubfield f) + let : FiniteDimensional (SecondCoordinateSubfield f) (IntermediateField.adjoin (SecondCoordinateSubfield f) {planeCurveFunction f 0}) := IntermediateField.adjoin.finiteDimensional halg.isIntegral - letI : FiniteDimensional (SecondCoordinateSubfield f) + let : FiniteDimensional (SecondCoordinateSubfield f) (⊤ : IntermediateField (SecondCoordinateSubfield f) (PlaneCurveFunctionField f)) := by rw [← adjoin_firstCoordinate_over_second_eq_top f] infer_instance @@ -667,7 +667,7 @@ theorem polynomialOverSecondCoordinate_irreducible (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf Irreducible (polynomialOverSecondCoordinate f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let R := MvPolynomial {i : Fin 2 // i ≠ 0} K let F := FractionRing R let p := polynomialInFirstVariablePresentation f @@ -700,7 +700,7 @@ theorem derivative_polynomialOverSecondCoordinate_ne_zero (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf (polynomialOverSecondCoordinate f).derivative ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation, Polynomial.derivative_map] exact (Polynomial.map_ne_zero_iff @@ -713,7 +713,7 @@ theorem polynomialOverSecondCoordinate_separable (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf (polynomialOverSecondCoordinate f).Separable := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (Polynomial.separable_iff_derivative_ne_zero (polynomialOverSecondCoordinate_irreducible hf hderiv)).mpr (derivative_polynomialOverSecondCoordinate_ne_zero hf hderiv) @@ -724,7 +724,7 @@ theorem firstCoordinate_isSeparable_over_second (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf IsSeparable (SecondCoordinateSubfield f) (planeCurveFunction f 0) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hroot : Polynomial.aeval (planeCurveFunction f 0) (polynomialOverSecondCoordinate f) = 0 := by simpa [Polynomial.aeval_def] using eval₂_polynomialOverSecondCoordinate_eq_zero f @@ -739,7 +739,7 @@ theorem finiteSeparable_over_secondCoordinate_of_irreducible letI := planeCurveCoordinateRing_isDomain hf FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) ∧ Algebra.IsSeparable (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hpoly : polynomialOverSecondCoordinate f ≠ 0 := polynomialOverSecondCoordinate_ne_zero_of_irreducible hf (degreeOf_first_pos_of_pderiv_ne_zero hderiv) @@ -764,7 +764,7 @@ theorem natDegree_polynomialOverSecondCoordinate_eq_degreeOf_first (hderiv : MvPolynomial.pderiv 0 f ≠ 0) : letI := planeCurveCoordinateRing_isDomain hf (polynomialOverSecondCoordinate f).natDegree = MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [polynomialOverSecondCoordinate_eq_map_polynomialInFirstVariablePresentation, Polynomial.natDegree_map_eq_of_injective (secondCoordinateCoefficientEval_injective hf @@ -777,7 +777,7 @@ theorem natDegree_minpoly_firstCoordinate_eq_degreeOf_first letI := planeCurveCoordinateRing_isDomain hf (minpoly (SecondCoordinateSubfield f) (planeCurveFunction f 0)).natDegree = MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let p := polynomialOverSecondCoordinate f have hpIrreducible : Irreducible p := polynomialOverSecondCoordinate_irreducible hf hderiv have hroot : Polynomial.aeval (planeCurveFunction f 0) p = 0 := by @@ -799,11 +799,11 @@ theorem finrank_over_secondCoordinate_eq_degreeOf_first_of_irreducible letI := planeCurveCoordinateRing_isDomain hf Module.finrank (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) = MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hpoly : polynomialOverSecondCoordinate f ≠ 0 := polynomialOverSecondCoordinate_ne_zero_of_irreducible hf (degreeOf_first_pos_of_pderiv_ne_zero hderiv) - letI : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := + let : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := finiteDimensional_over_secondCoordinate f hpoly have halg := firstCoordinate_isAlgebraic_over_second f hpoly calc diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean index e004b6f26e..7a979625ce 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean @@ -86,7 +86,7 @@ theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_add_one_le finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w) + 1 ≤ 2 * (MvPolynomial.degreeOf 0 f + MvPolynomial.degreeOf 1 f) := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 @@ -107,18 +107,18 @@ theorem planeCurve_propositionTwoExceptionalPlaces_weightedDegree_add_one_le apply hyTrans rw [h] exact isAlgebraic_zero - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hxTrans - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra (Polynomial K) L := + let : Algebra (Polynomial K) L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) L := + let : IsScalarTower (Polynomial K) (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl let q : FiniteExtensionFinitePlace K L := BGS.HasseWeil.affinePointExhaustiveFinitePlace @@ -232,16 +232,16 @@ theorem planeCurve_canonicalDifferent_add_propositionTwoExceptional_add_one_le finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) w : ℤ) + 1 ≤ (2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f : ℕ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hcanonical := planeCurve_canonicalDifferentDivisor_degree_le diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean index 0598c88a17..0a6ccf860e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean @@ -37,13 +37,13 @@ private def integerVectorLine (d : Fin 2 → ℤ) : AddSubgroup (Fin 2 → ℤ) zero_mem' := by simp [integerVectorDet] add_mem' := by intro u v hu hv - simp only [Set.mem_setOf_eq] at hu hv ⊢ + simp only [Set.mem_ofPred_eq] at hu hv ⊢ simp only [integerVectorDet] at hu hv simp only [integerVectorDet, Pi.add_apply] linear_combination hu + hv neg_mem' := by intro u hu - simp only [Set.mem_setOf_eq] at hu ⊢ + simp only [Set.mem_ofPred_eq] at hu ⊢ simp only [integerVectorDet] at hu simp only [integerVectorDet, Pi.neg_apply] linear_combination -hu @@ -249,7 +249,7 @@ private theorem directionalHomogenization_monomial rw [directionalHomogenization, Polynomial.homogenize_monomial hkn] rw [MvPolynomial.eval₂Hom_monomial] simp [Finsupp.prod_fintype, Fin.prod_univ_two, - MvPolynomial.monomial_pow, MvPolynomial.monomial_mul, + MvPolynomial.monomial_pow, MvPolynomial.monomial_mul_monomial, MvPolynomial.C_mul_monomial] private theorem directionalHomogenization_mul @@ -408,7 +408,7 @@ private theorem exists_directionalPolynomial_representation have parameter_spec : ∀ s ∈ F.support, planeExponentDifference r s = parameter s • v := by intro s hs - simp only [parameter, dif_pos hs] + simp only [parameter, dite_eq_left hs] exact Classical.choose_spec (hparam s hs) have parameter_inj : ∀ {s t}, s ∈ F.support → t ∈ F.support → parameter s = parameter t → s = t := by @@ -492,7 +492,7 @@ private theorem exists_directionalPolynomial_representation simpa [q] using coeff_finset_sum (index s) F.support (fun t => Polynomial.monomial (index t) (F.coeff t))] rw [Finset.sum_eq_single s] - · rw [Polynomial.coeff_monomial, if_pos rfl] + · rw [Polynomial.coeff_monomial, ite_eq_left rfl] · intro t ht hts rw [Polynomial.coeff_monomial] simp only [ite_eq_right_iff] @@ -606,7 +606,7 @@ private theorem exists_directionalPolynomial_representation apply Finset.sum_congr rfl intro s hs rw [directionalHomogenization_monomial v (index_le s hs)] - rw [MvPolynomial.monomial_mul] + rw [MvPolynomial.monomial_mul_monomial] simp only [one_mul] apply congrArg (fun e => MvPolynomial.monomial e (F.coeff s)) simpa [add_assoc] using exponent_eq s hs diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean index 23d0d8b947..2a9a2f2413 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean @@ -187,10 +187,10 @@ theorem secondPoweredCoordinateFrobeniusPowerBasis_dim charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p (secondPoweredCoordinateFrobeniusPowerBasis hf hpartialFirst n hn).dim = p := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p rw [secondPoweredCoordinateFrobeniusPowerBasis, PowerBasis.ofAdjoinEqTop_dim] @@ -230,9 +230,9 @@ theorem poweredCoordinateExpansionPolynomial_natDegree_lt_char charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree < p := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p calc @@ -255,9 +255,9 @@ theorem poweredCoordinateExpansionPolynomial_aeval (planeCurveFunction f 0) ^ m = Polynomial.aeval ((planeCurveFunction f 1) ^ n) (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p rw [← secondPoweredCoordinateFrobeniusPowerBasis_gen @@ -299,9 +299,9 @@ theorem poweredCoordinateEliminationRelation_irreducible (algebraMap K (PlaneCurveFunctionField f)).injective p Irreducible (poweredCoordinateEliminationRelation hf hpartialFirst m n hn) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p exact powerBasisEliminationRelation_irreducible _ _ @@ -317,9 +317,9 @@ theorem poweredCoordinateEliminationRelation_natDegree charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p (poweredCoordinateEliminationRelation hf hpartialFirst m n hn).natDegree = 1 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p exact powerBasisEliminationRelation_natDegree _ _ @@ -337,9 +337,9 @@ theorem transpose_poweredCoordinateEliminationRelation_natDegree (transposeBivariate (poweredCoordinateEliminationRelation hf hpartialFirst m n hn)).natDegree = (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p exact transpose_powerBasisEliminationRelation_natDegree _ _ @@ -356,9 +356,9 @@ theorem poweredCoordinateEliminationRelation_coeff_natDegree_le (algebraMap K (PlaneCurveFunctionField f)).injective p ((poweredCoordinateEliminationRelation hf hpartialFirst m n hn).coeff i).natDegree ≤ (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p exact powerBasisEliminationRelation_coeff_natDegree_le _ _ i @@ -376,9 +376,9 @@ theorem evalBivariate_poweredCoordinateEliminationRelation evalBivariate ((planeCurveFunction f 1) ^ n) ((planeCurveFunction f 0) ^ m) (poweredCoordinateEliminationRelation hf hpartialFirst m n hn) = 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p rw [← secondPoweredCoordinateFrobeniusPowerBasis_gen @@ -400,17 +400,17 @@ theorem poweredCoordinateExpansionPolynomial_natDegree_pos (algebraMap K (PlaneCurveFunctionField f)).injective p 0 < (poweredCoordinateExpansionPolynomial hf hpartialFirst m n hn).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let x : L := planeCurveFunction f 0 have hsep := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep - letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + let : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep + let : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) x have hxTrans : Transcendental K x := firstCoordinate_transcendental hf @@ -455,9 +455,9 @@ theorem poweredCoordinates_auxiliaryFamily_linearIndependent_of_elimination (frobeniusSubfield (PlaneCurveFunctionField f) p) (auxiliaryFamily ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) h k) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : CharP (PlaneCurveFunctionField f) p := + let : CharP (PlaneCurveFunctionField f) p := charP_of_injective_algebraMap (algebraMap K (PlaneCurveFunctionField f)).injective p exact poweredCoordinates_auxiliaryFamily_linearIndependent_of_relation diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean index 1c099a9bf4..33ca81519e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean @@ -178,7 +178,7 @@ theorem frobeniusPower_minpoly_natDegree_eq_char have htop : IntermediateField.adjoin F ({z ^ m} : Set L) = ⊤ := adjoin_frobeniusSubfield_pow_eq_top z hz m hm let E : IntermediateField F L := IntermediateField.adjoin F {z ^ m} - letI : Algebra.IsSeparable E L := by + let : Algebra.IsSeparable E L := by change Algebra.IsSeparable (IntermediateField.adjoin F ({z ^ m} : Set L)) L rw [htop] @@ -200,7 +200,7 @@ theorem firstCoordinatePow_transcendental {m : ℕ} (hm : 0 < m) : letI := planeCurveCoordinateRing_isDomain hf Transcendental K ((planeCurveFunction f 0) ^ m) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond)).pow hm @@ -214,7 +214,7 @@ theorem secondCoordinatePow_transcendental {n : ℕ} (hn : 0 < n) : letI := planeCurveCoordinateRing_isDomain hf Transcendental K ((planeCurveFunction f 1) ^ n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst)).pow hn @@ -234,17 +234,17 @@ theorem adjoin_frobeniusSubfield_firstCoordinatePow_eq_top IntermediateField.adjoin (frobeniusSubfield (PlaneCurveFunctionField f) p) ({(planeCurveFunction f 0) ^ m} : Set (PlaneCurveFunctionField f)) = ⊤ := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let x : L := planeCurveFunction f 0 have hsep := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep - letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + let : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep + let : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) x have hxTrans : Transcendental K x := firstCoordinate_transcendental hf @@ -271,17 +271,17 @@ theorem adjoin_frobeniusSubfield_secondCoordinatePow_eq_top IntermediateField.adjoin (frobeniusSubfield (PlaneCurveFunctionField f) p) ({(planeCurveFunction f 1) ^ n} : Set (PlaneCurveFunctionField f)) = ⊤ := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let y : L := planeCurveFunction f 1 have hsep := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).2 - letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsep - letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := + let : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsep + let : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) y have hyTrans : Transcendental K y := secondCoordinate_transcendental hf @@ -306,17 +306,17 @@ theorem minpoly_firstCoordinatePow_natDegree_eq_char (algebraMap K (PlaneCurveFunctionField f)).injective p (minpoly (frobeniusSubfield (PlaneCurveFunctionField f) p) ((planeCurveFunction f 0) ^ m)).natDegree = p := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let x : L := planeCurveFunction f 0 have hsep := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep - letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + let : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsep + let : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) x have hxTrans : Transcendental K x := firstCoordinate_transcendental hf @@ -343,17 +343,17 @@ theorem minpoly_secondCoordinatePow_natDegree_eq_char (algebraMap K (PlaneCurveFunctionField f)).injective p (minpoly (frobeniusSubfield (PlaneCurveFunctionField f) p) ((planeCurveFunction f 1) ^ n)).natDegree = p := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let y : L := planeCurveFunction f 1 have hsep := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).2 - letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsep - letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := + let : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsep + let : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) y have hyTrans : Transcendental K y := secondCoordinate_transcendental hf @@ -390,24 +390,24 @@ theorem exists_derivation_coordinatePowers_ne_zero ∃ c : frobeniusSubfield (PlaneCurveFunctionField f) p, algebraMap (frobeniusSubfield (PlaneCurveFunctionField f) p) (PlaneCurveFunctionField f) c = z := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let x : L := planeCurveFunction f 0 let y : L := planeCurveFunction f 1 have hsepX := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX - letI : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := + let : Algebra.IsSeparable (FirstCoordinateSubfield f) L := hsepX + let : Algebra.IsSeparable (IntermediateField.adjoin F {x}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) x have hsepY := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).2 - letI : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsepY - letI : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := + let : Algebra.IsSeparable (SecondCoordinateSubfield f) L := hsepY + let : Algebra.IsSeparable (IntermediateField.adjoin F {y}) L := isSeparable_over_frobeniusAdjoin_of_isSeparable_over_constantAdjoin (K := K) (L := L) (p := p) y have hxTrans : Transcendental K x := firstCoordinate_transcendental hf @@ -470,10 +470,10 @@ theorem poweredCoordinates_auxiliaryFamily_linearIndependent_of_relation (frobeniusSubfield (PlaneCurveFunctionField f) p) (auxiliaryFamily ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) h k) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let x : L := planeCurveFunction f 0 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean index 5746cba885..a4885bb68c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean @@ -96,10 +96,10 @@ theorem evalBivariate_poweredCoordinateImageRelation_map_eq_zero ((planeCurveFunction fE 0) ^ m) ((planeCurveFunction fE 1) ^ n) (g.map (Polynomial.mapRingHom (algebraMap K E))) = 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let fE := MvPolynomial.map (algebraMap K E) f - letI : IsDomain (PlaneCurveCoordinateRing fE) := + let : IsDomain (PlaneCurveCoordinateRing fE) := planeCurveCoordinateRing_isDomain hfE let g := poweredCoordinateImageRelation hf hpartialSecond m hm n let A := PlaneCurveCoordinateRing f @@ -179,13 +179,13 @@ theorem poweredCoordinateImageRelation_map_associated_baseChange (poweredCoordinateImageRelation hfE hpartialSecondE m hm n) ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map (Polynomial.mapRingHom (algebraMap K E))) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let fE := MvPolynomial.map (algebraMap K E) f - letI : IsDomain (PlaneCurveCoordinateRing fE) := + let : IsDomain (PlaneCurveCoordinateRing fE) := planeCurveCoordinateRing_isDomain hfE let LE := PlaneCurveFunctionField fE - letI : FiniteDimensional (FirstPoweredCoordinateSubfield fE m) LE := + let : FiniteDimensional (FirstPoweredCoordinateSubfield fE m) LE := finiteDimensional_over_firstPoweredCoordinate hfE hpartialSecondE m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield fE m) ((planeCurveFunction fE 1) ^ n) := IsIntegral.of_finite _ _ @@ -267,9 +267,9 @@ theorem finrank_poweredCoordinateImageField_eq_baseChange let hfE : Irreducible fE := irreducible_map_of_irreducible_map_algebraicClosure (algebraMap K E) f habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing fE) := + let : IsDomain (PlaneCurveCoordinateRing fE) := planeCurveCoordinateRing_isDomain hfE have hpartialSecondE : MvPolynomial.pderiv 1 fE ≠ 0 := by rw [MvPolynomial.pderiv_map] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean index 48083fcec3..11340cb7b1 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean @@ -85,9 +85,9 @@ theorem finiteDimensional_over_adjoin_pow have hqMonic : q.Monic := Polynomial.monic_X_pow_sub_C c hm.ne' have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ - letI : FiniteDimensional E0 A := + let : FiniteDimensional E0 A := IntermediateField.adjoin.finiteDimensional hzIntegral - letI : FiniteDimensional A L := by + let : FiniteDimensional A L := by change FiniteDimensional AK L rw [hA] infer_instance @@ -110,9 +110,9 @@ theorem finrank_over_adjoin_pow_le_mul have hqMonic : q.Monic := Polynomial.monic_X_pow_sub_C c hm.ne' have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ - letI : FiniteDimensional E0 A := + let : FiniteDimensional E0 A := IntermediateField.adjoin.finiteDimensional hzIntegral - letI : FiniteDimensional A L := by + let : FiniteDimensional A L := by change FiniteDimensional AK L rw [hA] infer_instance @@ -178,7 +178,7 @@ theorem integerClearedMinpoly_ne_zero theorem primitiveClearedMinpolyRelation_ne_zero (u : L) (hu : Transcendental K u) (v : L) : primitiveClearedMinpolyRelation u hu v ≠ 0 := by - letI := Classical.arbitrary (NormalizedGCDMonoid K) + let := Classical.arbitrary (NormalizedGCDMonoid K) exact (integerClearedMinpoly u hu v).primPart_ne_zero theorem primitiveClearedMinpolyRelation_natDegree @@ -186,7 +186,7 @@ theorem primitiveClearedMinpolyRelation_natDegree (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : (primitiveClearedMinpolyRelation u hu v).natDegree = (minpoly (IntermediateField.adjoin K {u}) v).natDegree := by - letI := Classical.arbitrary (NormalizedGCDMonoid K) + let := Classical.arbitrary (NormalizedGCDMonoid K) let q := ratFuncMinpoly u hu v let N := integerClearedMinpoly u hu v obtain ⟨b, hb, hmap⟩ := @@ -225,7 +225,7 @@ theorem map_primitiveClearedMinpolyRelation_eq_C_mul (primitiveClearedMinpolyRelation u hu v).map (algebraMap (Polynomial K) (RatFunc K)) = Polynomial.C c * ratFuncMinpoly u hu v := by - letI := Classical.arbitrary (NormalizedGCDMonoid K) + let := Classical.arbitrary (NormalizedGCDMonoid K) let q := ratFuncMinpoly u hu v let N := integerClearedMinpoly u hu v let g := primitiveClearedMinpolyRelation u hu v @@ -279,7 +279,7 @@ theorem primitiveClearedMinpolyRelation_irreducible (u : L) (hu : Transcendental K u) (v : L) (hv : IsIntegral (IntermediateField.adjoin K {u}) v) : Irreducible (primitiveClearedMinpolyRelation u hu v) := by - letI := Classical.arbitrary (NormalizedGCDMonoid K) + let := Classical.arbitrary (NormalizedGCDMonoid K) let q := ratFuncMinpoly u hu v let g := primitiveClearedMinpolyRelation u hu v obtain ⟨c, hc0, hmap⟩ := @@ -418,7 +418,7 @@ theorem transposeBivariate_natDegree_eq_minpoly (hzero : evalBivariate u v P = 0) : (transposeBivariate P).natDegree = (minpoly (IntermediateField.adjoin K {v}) u).natDegree := by - letI := Classical.arbitrary (NormalizedGCDMonoid K) + let := Classical.arbitrary (NormalizedGCDMonoid K) let Q := transposeBivariate P let e := RatFunc.algEquivOfTranscendental v hvTrans let qRat : Polynomial (RatFunc K) := @@ -507,7 +507,7 @@ theorem firstPoweredCoordinate_transcendental (m : ℕ) (hm : 0 < m) : letI := planeCurveCoordinateRing_isDomain hf Transcendental K ((planeCurveFunction f 0) ^ m) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond)).pow hm @@ -519,7 +519,7 @@ theorem secondPoweredCoordinate_transcendental (n : ℕ) (hn : 0 < n) : letI := planeCurveCoordinateRing_isDomain hf Transcendental K ((planeCurveFunction f 1) ^ n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst)).pow hn @@ -547,9 +547,9 @@ theorem finiteDimensional_over_firstPoweredCoordinate letI := planeCurveCoordinateRing_isDomain hf FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstCoordinateSubfield f) + let : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := finiteDimensional_over_firstCoordinate_of_irreducible hf hpartialSecond exact finiteDimensional_over_adjoin_pow @@ -564,9 +564,9 @@ theorem finrank_over_firstPoweredCoordinate_le letI := planeCurveCoordinateRing_isDomain hf Module.finrank (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) ≤ m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstCoordinateSubfield f) + let : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := finiteDimensional_over_firstCoordinate_of_irreducible hf hpartialSecond exact finrank_over_adjoin_pow_le_mul @@ -583,9 +583,9 @@ theorem finiteDimensional_over_secondPoweredCoordinate letI := planeCurveCoordinateRing_isDomain hf FiniteDimensional (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (SecondCoordinateSubfield f) + let : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).1 @@ -601,9 +601,9 @@ theorem finrank_over_secondPoweredCoordinate_le letI := planeCurveCoordinateRing_isDomain hf Module.finrank (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (SecondCoordinateSubfield f) + let : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).1 @@ -662,9 +662,9 @@ theorem finrank_poweredImageOverFirst_le Module.finrank (FirstPoweredCoordinateSubfield f m) (PoweredImageOverFirst f m n) ≤ m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm exact (PoweredImageOverFirst f m n).toSubalgebra.toSubmodule.finrank_le.trans @@ -680,9 +680,9 @@ theorem finrank_poweredImageOverSecond_le Module.finrank (SecondPoweredCoordinateSubfield f n) (PoweredImageOverSecond f m n) ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + let : FiniteDimensional (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn exact (PoweredImageOverSecond f m n).toSubalgebra.toSubmodule.finrank_le.trans @@ -694,9 +694,9 @@ theorem poweredCoordinateImageRelation_irreducible (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : ℕ) (hm : 0 < m) (n : ℕ) : Irreducible (poweredCoordinateImageRelation hf hpartialSecond m hm n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) @@ -716,9 +716,9 @@ theorem evalBivariate_poweredCoordinateImageRelation_eq_zero evalBivariate ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) (poweredCoordinateImageRelation hf hpartialSecond m hm n) = 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) @@ -741,9 +741,9 @@ theorem poweredCoordinateImageRelation_natDegree_eq_finrank (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree = Module.finrank (FirstPoweredCoordinateSubfield f m) (PoweredImageOverFirst f m n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) @@ -774,9 +774,9 @@ theorem poweredCoordinateImageRelation_transpose_natDegree_eq_finrank (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree = Module.finrank (SecondPoweredCoordinateSubfield f n) (PoweredImageOverSecond f m n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + let : FiniteDimensional (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn have hu : IsIntegral (SecondPoweredCoordinateSubfield f n) @@ -811,7 +811,7 @@ theorem poweredCoordinateImageRelation_bidegree_le (transposeBivariate (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf constructor · rw [poweredCoordinateImageRelation_natDegree_eq_finrank @@ -847,9 +847,9 @@ theorem poweredCoordinateImageRelation_natDegree_pos (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) (m : ℕ) (hm : 0 < m) (n : ℕ) : 0 < (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) @@ -868,7 +868,7 @@ theorem poweredCoordinateImageRelation_transpose_natDegree_pos (m : ℕ) (hm : 0 < m) (n : ℕ) (hn : 0 < n) : 0 < (transposeBivariate (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf apply Nat.pos_of_ne_zero exact transposeBivariate_natDegree_ne_zero_of_eval_eq_zero @@ -898,7 +898,7 @@ theorem poweredCoordinateImageRelation_spec g.natDegree ≤ m * MvPolynomial.degreeOf 1 f ∧ (transposeBivariate g).natDegree ≤ n * MvPolynomial.degreeOf 0 f ∧ ∀ i, (g.coeff i).natDegree ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let g := poweredCoordinateImageRelation hf hpartialSecond m hm n have hbidegree := poweredCoordinateImageRelation_bidegree_le diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean index 0943fc7436..8b4b9cab41 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean @@ -37,16 +37,16 @@ theorem finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed Module.finrank (PoweredCoordinateImageField f m n) (PlaneCurveFunctionField f) ≤ (planeCurveSupportDifferenceDet r s t).natAbs := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n let x : L := planeCurveFunction f 0 let y : L := planeCurveFunction f 1 - letI : FiniteDimensional B L := + let : FiniteDimensional B L := finiteDimensional_poweredCoordinateImageField hf hpartialSecond m n hm - letI : IsGalois B L := + let : IsGalois B L := isGalois_over_poweredCoordinateImageField hf hpartialFirst hpartialSecond m n hm hn hmF hnF have hbasic := @@ -64,7 +64,7 @@ theorem finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed let d : ℤ := (t 1 : ℤ) - (r 1 : ℤ) have hdet' : a * d - b * c ≠ 0 := by simpa [a, b, c, d, planeCurveSupportDifferenceDet] using hdet - letI : Finite (torusCharacterKernel F a b c d) := + let : Finite (torusCharacterKernel F a b c d) := finite_torusCharacterKernel_of_det_ne_zero a b c d hdet' let supportToKernel : planeCurveSupportCharacterStabilizer F f → torusCharacterKernel F a b c d := fun z => @@ -75,7 +75,7 @@ theorem finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed apply Subtype.ext exact congrArg (fun u : torusCharacterKernel F a b c d => u.1) hzw - letI : Finite (planeCurveSupportCharacterStabilizer F f) := + let : Finite (planeCurveSupportCharacterStabilizer F f) := Finite.of_injective supportToKernel supportToKernel_injective have hscale (σ : L ≃ₐ[B] L) := exists_support_stabilizer_scaling_of_poweredImage_aut @@ -134,7 +134,7 @@ theorem finrank_poweredImageOverFirst_le_supportDet_isAlgClosed Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ (planeCurveSupportDifferenceDet r s t).natAbs := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [finrank_poweredImageOverFirst_eq_imageField] exact finrank_poweredCoordinateImageField_le_supportDet_isAlgClosed @@ -166,9 +166,9 @@ theorem finrank_poweredImageOverFirst_le_supportDet_of_nonzero_natCast let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute have hfA : Irreducible fA := habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing fA) := + let : IsDomain (PlaneCurveCoordinateRing fA) := planeCurveCoordinateRing_isDomain hfA have hpartialFirstA : MvPolynomial.pderiv 0 fA ≠ 0 := by rw [MvPolynomial.pderiv_map] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean index cdabbad3ec..63fa36f2b1 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean @@ -90,7 +90,7 @@ theorem primitiveClearedMinpolyRelation_dvd_of_evalBivariate_eq_zero (P : Polynomial (Polynomial K)) (hP : evalBivariate u v P = 0) : primitiveClearedMinpolyRelation u hu v ∣ P := by - letI := Classical.arbitrary (NormalizedGCDMonoid K) + let := Classical.arbitrary (NormalizedGCDMonoid K) let e := RatFunc.algEquivOfTranscendental u hu let P_rat : Polynomial (RatFunc K) := P.map (algebraMap (Polynomial K) (RatFunc K)) @@ -166,7 +166,7 @@ theorem poweredCoordinateImageRelation_quotient_embeds_source ∃ F : (Polynomial (Polynomial K) ⧸ Ideal.span {g}) →ₐ[K] PlaneCurveCoordinateRing f, Function.Injective F := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let A := PlaneCurveCoordinateRing f @@ -182,7 +182,7 @@ theorem poweredCoordinateImageRelation_quotient_embeds_source have hcomp : ι.comp φA = φL := by simpa [φA, φL, xA, xL, yA, yL, ι, planeCurveFunction] using (bivariateEvalAlgHom_comp (K := K) ι xA yA) - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) L := + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) L := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hv : IsIntegral (FirstPoweredCoordinateSubfield f m) yL := IsIntegral.of_finite _ _ @@ -293,7 +293,7 @@ theorem tensorProduct_isDomain_of_embedding let Φ := Algebra.TensorProduct.map (AlgHom.id E E) F have hΦ : Function.Injective Φ := tensorProduct_map_id_injective E F hF - letI : IsDomain (E ⊗[K] B) := hdom + let : IsDomain (E ⊗[K] B) := hdom apply (isDomain_iff_noZeroDivisors_and_nontrivial _).mpr constructor · exact hΦ.noZeroDivisors Φ (map_zero Φ) (map_mul Φ) @@ -333,7 +333,7 @@ theorem planeCurveCoordinateRingBaseChange_isDomain (f : MvPolynomial (Fin 2) K) (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := by - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE exact (planeCurveCoordinateRingBaseChangeEquiv E f).toMulEquiv.isDomain_iff.mpr @@ -345,14 +345,14 @@ theorem irreducible_mvPolynomial_map_of_tensorQuotient_isDomain (hdom : IsDomain (E ⊗[K] PlaneCurveCoordinateRing G)) : Irreducible (MvPolynomial.map (algebraMap K E) G) := by - letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing G) := hdom + let : IsDomain (E ⊗[K] PlaneCurveCoordinateRing G) := hdom let e := planeCurveCoordinateRingBaseChangeEquiv E G - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) G)) := by have hsource := (isDomain_iff_noZeroDivisors_and_nontrivial (E ⊗[K] PlaneCurveCoordinateRing G)).mp hdom - letI : NoZeroDivisors (E ⊗[K] PlaneCurveCoordinateRing G) := hsource.1 - letI : Nontrivial (E ⊗[K] PlaneCurveCoordinateRing G) := hsource.2 + let : NoZeroDivisors (E ⊗[K] PlaneCurveCoordinateRing G) := hsource.1 + let : Nontrivial (E ⊗[K] PlaneCurveCoordinateRing G) := hsource.2 apply (isDomain_iff_noZeroDivisors_and_nontrivial _).mpr constructor · exact e.symm.injective.noZeroDivisors e.symm @@ -380,7 +380,7 @@ theorem poweredCoordinateImageRelation_irreducible_map Irreducible ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map (Polynomial.mapRingHom (algebraMap K E))) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let g := poweredCoordinateImageRelation hf hpartialSecond m hm n let G := Polynomial.Bivariate.equivMvPolynomial K g @@ -486,10 +486,10 @@ theorem poweredCoordinateFrobeniusImageRelation_natDegree (p := p) hf hpartialSecond m hm n).natDegree = (transposeBivariate (poweredCoordinateImageRelation hf hpartialSecond m hm n)).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := @@ -517,10 +517,10 @@ theorem transposeBivariate_poweredCoordinateFrobeniusImageRelation_natDegree (poweredCoordinateFrobeniusImageRelation (p := p) hf hpartialSecond m hm n)).natDegree = (poweredCoordinateImageRelation hf hpartialSecond m hm n).natDegree := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := @@ -549,16 +549,16 @@ theorem evalBivariate_poweredCoordinateFrobeniusImageRelation_eq_zero ((planeCurveFunction f 0) ^ m) (poweredCoordinateFrobeniusImageRelation (p := p) hf hpartialSecond m hm n) = 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) - letI : Algebra K F := ι.toAlgebra - letI : IsScalarTower K F L := by + let : Algebra K F := ι.toAlgebra + let : IsScalarTower K F L := by apply IsScalarTower.of_algebraMap_eq' ext c exact (coe_perfectConstantsToFrobeniusSubfield @@ -586,10 +586,10 @@ theorem poweredCoordinateFrobeniusImageRelation_irreducible Irreducible (poweredCoordinateFrobeniusImageRelation (p := p) hf hpartialSecond m hm n) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := @@ -597,7 +597,7 @@ theorem poweredCoordinateFrobeniusImageRelation_irreducible have hbase : Irreducible ((poweredCoordinateImageRelation hf hpartialSecond m hm n).map (Polynomial.mapRingHom ι)) := by - letI : Algebra K F := ι.toAlgebra + let : Algebra K F := ι.toAlgebra exact poweredCoordinateImageRelation_irreducible_map (E := F) habsolute hf hpartialSecond m hm n exact irreducible_transposeBivariate hbase @@ -635,16 +635,16 @@ theorem poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent (frobeniusSubfield (PlaneCurveFunctionField f) p) (auxiliaryFamily ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) h k) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) - letI : Algebra K F := ι.toAlgebra - letI : IsScalarTower K F L := by + let : Algebra K F := ι.toAlgebra + let : IsScalarTower K F L := by apply IsScalarTower.of_algebraMap_eq' ext c exact (coe_perfectConstantsToFrobeniusSubfield diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean index 131982e67a..d3ae65e981 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean @@ -71,16 +71,16 @@ theorem poweredCoordinateFrobeniusImage_auxiliaryFamily_linearIndependent_swappe (frobeniusSubfield (PlaneCurveFunctionField f) p) (auxiliaryFamily ((planeCurveFunction f 1) ^ n) ((planeCurveFunction f 0) ^ m) h k) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := frobeniusSubfield L p let ι : K →+* F := perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) - letI : Algebra K F := ι.toAlgebra - letI : IsScalarTower K F L := by + let : Algebra K F := ι.toAlgebra + let : IsScalarTower K F L := by apply IsScalarTower.of_algebraMap_eq' ext c exact (coe_perfectConstantsToFrobeniusSubfield diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean index 4d0f3d9a1b..95ae7e7847 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean @@ -66,7 +66,7 @@ theorem poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero IntermediateField.adjoin B ({planeCurveFunction f 0, planeCurveFunction f 1} : Set L) = ⊤ ∧ planeCurveFunction f 0 ≠ 0 ∧ planeCurveFunction f 1 ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n @@ -133,7 +133,7 @@ theorem firstCoordinate_isSeparable_over_poweredCoordinateImageField letI := planeCurveCoordinateRing_isDomain hf IsSeparable (PoweredCoordinateImageField f m n) (planeCurveFunction f 0) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n @@ -180,7 +180,7 @@ theorem firstCoordinate_minpoly_splits_over_poweredCoordinateImageField (PlaneCurveFunctionField f)) (minpoly (PoweredCoordinateImageField f m n) (planeCurveFunction f 0))).Splits := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n @@ -195,8 +195,8 @@ theorem firstCoordinate_minpoly_splits_over_poweredCoordinateImageField rw [IntermediateField.algebraMap_apply] simp [bx] have hdvd : minpoly B x ∣ P := minpoly.dvd B x hP - letI : NeZero m := ⟨Nat.ne_of_gt hm⟩ - letI : NeZero (m : F) := ⟨hmF⟩ + let : NeZero m := ⟨Nat.ne_of_gt hm⟩ + let : NeZero (m : F) := ⟨hmF⟩ obtain ⟨ζ, hζ⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F m have hζL : IsPrimitiveRoot (algebraMap F L ζ) m := hζ.map_of_injective (algebraMap F L).injective @@ -220,7 +220,7 @@ theorem secondCoordinate_isSeparable_over_poweredCoordinateImageField letI := planeCurveCoordinateRing_isDomain hf IsSeparable (PoweredCoordinateImageField f m n) (planeCurveFunction f 1) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n @@ -267,7 +267,7 @@ theorem secondCoordinate_minpoly_splits_over_poweredCoordinateImageField (PlaneCurveFunctionField f)) (minpoly (PoweredCoordinateImageField f m n) (planeCurveFunction f 1))).Splits := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n @@ -282,8 +282,8 @@ theorem secondCoordinate_minpoly_splits_over_poweredCoordinateImageField rw [IntermediateField.algebraMap_apply] simp [by'] have hdvd : minpoly B y ∣ P := minpoly.dvd B y hP - letI : NeZero n := ⟨Nat.ne_of_gt hn⟩ - letI : NeZero (n : F) := ⟨hnF⟩ + let : NeZero n := ⟨Nat.ne_of_gt hn⟩ + let : NeZero (n : F) := ⟨hnF⟩ obtain ⟨η, hη⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F n have hηL : IsPrimitiveRoot (algebraMap F L η) n := hη.map_of_injective (algebraMap F L).injective @@ -310,12 +310,12 @@ theorem isGalois_over_poweredCoordinateImageField letI := planeCurveCoordinateRing_isDomain hf IsGalois (PoweredCoordinateImageField f m n) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n let E0 := FirstPoweredCoordinateSubfield f m - letI : FiniteDimensional E0 L := + let : FiniteDimensional E0 L := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hE0B : E0 ≤ B := by apply IntermediateField.adjoin.mono F @@ -323,13 +323,13 @@ theorem isGalois_over_poweredCoordinateImageField simp only [Set.mem_singleton_iff] at hz simp only [Set.mem_insert_iff, Set.mem_singleton_iff] exact Or.inl hz - letI : Algebra E0 B := + let : Algebra E0 B := (IntermediateField.inclusion hE0B).toRingHom.toAlgebra - letI : IsScalarTower E0 B L := by + let : IsScalarTower E0 B L := by apply IsScalarTower.of_algebraMap_eq' ext z rfl - letI : FiniteDimensional B L := + let : FiniteDimensional B L := Module.Finite.of_restrictScalars_finite E0 B L let x : L := planeCurveFunction f 0 let y : L := planeCurveFunction f 1 @@ -340,8 +340,8 @@ theorem isGalois_over_poweredCoordinateImageField firstCoordinate_isSeparable_over_poweredCoordinateImageField hf hpartialSecond m n hmF have hysep : IsSeparable B y := secondCoordinate_isSeparable_over_poweredCoordinateImageField hf hpartialFirst m n hnF - letI : Algebra.IsSeparable B L := ⟨fun z => by - letI : Algebra.IsSeparable B (IntermediateField.adjoin B ({x, y} : Set L)) := + let : Algebra.IsSeparable B L := ⟨fun z => by + let : Algebra.IsSeparable B (IntermediateField.adjoin B ({x, y} : Set L)) := IntermediateField.isSeparable_adjoin_pair_of_isSeparable B L hxsep hysep have hz : z ∈ IntermediateField.adjoin B ({x, y} : Set L) := by rw [hgen] @@ -353,7 +353,7 @@ theorem isGalois_over_poweredCoordinateImageField have hysplits : (Polynomial.map (algebraMap B L) (minpoly B y)).Splits := secondCoordinate_minpoly_splits_over_poweredCoordinateImageField hf m n hn hnF - letI : Normal B L := normal_iff.mpr fun z => by + let : Normal B L := normal_iff.mpr fun z => by refine ⟨Algebra.IsIntegral.isIntegral z, ?_⟩ have hz : z ∈ IntermediateField.adjoin B ({x, y} : Set L) := by rw [hgen] @@ -387,7 +387,7 @@ theorem exists_support_stabilizer_scaling_of_poweredImage_aut (∀ r ∈ f.support, ∀ s ∈ f.support, z.1 ^ ((s 0 : ℤ) - (r 0 : ℤ)) * z.2 ^ ((s 1 : ℤ) - (r 1 : ℤ)) = 1) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n @@ -415,10 +415,10 @@ theorem exists_support_stabilizer_scaling_of_poweredImage_aut autUnitRatio_pow_eq_one σ x hx0 m hfixx have huy : autUnitRatio σ y hy0 ^ n = 1 := autUnitRatio_pow_eq_one σ y hy0 n hfixy - letI : NeZero m := ⟨Nat.ne_of_gt hm⟩ - letI : NeZero n := ⟨Nat.ne_of_gt hn⟩ - letI : NeZero (m : F) := ⟨hmF⟩ - letI : NeZero (n : F) := ⟨hnF⟩ + let : NeZero m := ⟨Nat.ne_of_gt hm⟩ + let : NeZero n := ⟨Nat.ne_of_gt hn⟩ + let : NeZero (m : F) := ⟨hmF⟩ + let : NeZero (n : F) := ⟨hnF⟩ obtain ⟨ζ, hζ⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F m obtain ⟨η, hη⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot F n have hμm : (primitiveRoots m F).Nonempty := @@ -481,15 +481,15 @@ theorem finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed Module.finrank (PoweredCoordinateImageField f m n) (PlaneCurveFunctionField f) ≤ 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f let B := PoweredCoordinateImageField f m n let x : L := planeCurveFunction f 0 let y : L := planeCurveFunction f 1 - letI : FiniteDimensional B L := + let : FiniteDimensional B L := finiteDimensional_poweredCoordinateImageField hf hpartialSecond m n hm - letI : IsGalois B L := + let : IsGalois B L := isGalois_over_poweredCoordinateImageField hf hpartialFirst hpartialSecond m n hm hn hmF hnF have hbasic := poweredCoordinateImageField_adjoin_coordinates_eq_top_and_ne_zero hf hpartialFirst hpartialSecond m n @@ -506,7 +506,7 @@ theorem finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed let d : ℤ := (t₀ 1 : ℤ) - (r₀ 1 : ℤ) have hdet' : a * d - b * c ≠ 0 := by simpa [a, b, c, d, planeCurveSupportDifferenceDet] using hdet₀ - letI : Finite (torusCharacterKernel F a b c d) := + let : Finite (torusCharacterKernel F a b c d) := finite_torusCharacterKernel_of_det_ne_zero a b c d hdet' let supportToKernel : planeCurveSupportCharacterStabilizer F f → torusCharacterKernel F a b c d := fun z => @@ -515,7 +515,7 @@ theorem finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed intro z w hzw apply Subtype.ext exact congrArg (fun u : torusCharacterKernel F a b c d => u.1) hzw - letI : Finite (planeCurveSupportCharacterStabilizer F f) := + let : Finite (planeCurveSupportCharacterStabilizer F f) := Finite.of_injective supportToKernel supportToKernel_injective have hscale (σ : L ≃ₐ[B] L) := exists_support_stabilizer_scaling_of_poweredImage_aut hf hpartialFirst hpartialSecond @@ -571,7 +571,7 @@ theorem finrank_poweredImageOverFirst_le_twice_bidegree_isAlgClosed Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ 2 * MvPolynomial.degreeOf 0 f * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf rw [finrank_poweredImageOverFirst_eq_imageField] exact finrank_poweredCoordinateImageField_le_twice_bidegree_isAlgClosed diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean index ace15795a8..23a7573915 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean @@ -32,9 +32,9 @@ theorem poweredCoordinateImageRelation_natDegree_mul_imageIndex (PlaneCurveFunctionField f) = Module.finrank (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm rw [poweredCoordinateImageRelation_natDegree_eq_finrank @@ -64,9 +64,9 @@ theorem poweredCoordinateImageRelation_transpose_natDegree_mul_imageIndex (PlaneCurveFunctionField f) = Module.finrank (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + let : FiniteDimensional (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn rw [poweredCoordinateImageRelation_transpose_natDegree_eq_finrank diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean index c7d8cacdf5..19cb78b420 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean @@ -102,9 +102,9 @@ theorem finrank_poweredImageOverFirst_le_firstProjectionPowerDegree Module.finrank (PoweredImageOverFirst f m n) (PlaneCurveFunctionField f) ≤ m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have : Module.Free (FirstPoweredCoordinateSubfield f m) @@ -144,9 +144,9 @@ theorem finrank_poweredImageOverSecond_le_secondProjectionPowerDegree Module.finrank (PoweredImageOverSecond f m n) (PlaneCurveFunctionField f) ≤ n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : FiniteDimensional (SecondPoweredCoordinateSubfield f n) + let : FiniteDimensional (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) := finiteDimensional_over_secondPoweredCoordinate hf hpartialFirst n hn have : Module.Free (SecondPoweredCoordinateSubfield f n) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean index 9dfac3994c..0352f6c8a1 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean @@ -46,9 +46,9 @@ theorem finrank_poweredImageOverFirst_le_twice_bidegree_of_nonzero_natCast let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute have hfA : Irreducible fA := habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing fA) := + let : IsDomain (PlaneCurveCoordinateRing fA) := planeCurveCoordinateRing_isDomain hfA have hpartialFirstA : MvPolynomial.pderiv 0 fA ≠ 0 := by rw [MvPolynomial.pderiv_map] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean index 5a7843b7a0..e8b3024d66 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean @@ -66,7 +66,7 @@ theorem firstCoordinateInSubfield_not_pow letI := planeCurveCoordinateRing_isDomain hf ¬ ∃ z : FirstCoordinateSubfield f, z ^ p = firstCoordinateInSubfield f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let remaining := {i : Fin 2 // i ≠ 1} let i0 : remaining := ⟨0, by decide⟩ @@ -92,7 +92,7 @@ theorem secondCoordinateInSubfield_not_pow letI := planeCurveCoordinateRing_isDomain hf ¬ ∃ z : SecondCoordinateSubfield f, z ^ p = secondCoordinateInSubfield f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let remaining := {i : Fin 2 // i ≠ 0} let i1 : remaining := ⟨1, by decide⟩ @@ -122,28 +122,28 @@ theorem firstCoordinate_not_mem_frobeniusSubfield (algebraMap K (PlaneCurveFunctionField f)).injective p planeCurveFunction f 0 ∉ frobeniusSubfield (PlaneCurveFunctionField f) p := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := FirstCoordinateSubfield f have hseparable := (finiteSeparable_over_firstCoordinate_of_irreducible hf hpartialSecond).2 - letI : Algebra.IsSeparable F L := hseparable + let : Algebra.IsSeparable F L := hseparable intro hx rcases hx with ⟨y, hy⟩ have hypow : y ^ p = planeCurveFunction f 0 := by simpa [frobenius_def] using hy let E : IntermediateField F L := IntermediateField.adjoin F {y} - letI : IsPurelyInseparable F E := + let : IsPurelyInseparable F E := (IntermediateField.isPurelyInseparable_adjoin_simple_iff_pow_mem F L p).2 (by refine ⟨1, ?_⟩ rw [pow_one] refine ⟨firstCoordinateInSubfield f, ?_⟩ change planeCurveFunction f 0 = y ^ p exact hypow.symm) - letI : Algebra.IsSeparable F E := + let : Algebra.IsSeparable F E := (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable F L).2 (Algebra.IsSeparable.isSeparable F y) have hE : E = ⊥ := @@ -175,28 +175,28 @@ theorem secondCoordinate_not_mem_frobeniusSubfield (algebraMap K (PlaneCurveFunctionField f)).injective p planeCurveFunction f 1 ∉ frobeniusSubfield (PlaneCurveFunctionField f) p := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let L := PlaneCurveFunctionField f - letI : CharP L p := charP_of_injective_algebraMap + let : CharP L p := charP_of_injective_algebraMap (algebraMap K L).injective p let F := SecondCoordinateSubfield f have hseparable := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).2 - letI : Algebra.IsSeparable F L := hseparable + let : Algebra.IsSeparable F L := hseparable intro hx rcases hx with ⟨y, hy⟩ have hypow : y ^ p = planeCurveFunction f 1 := by simpa [frobenius_def] using hy let E : IntermediateField F L := IntermediateField.adjoin F {y} - letI : IsPurelyInseparable F E := + let : IsPurelyInseparable F E := (IntermediateField.isPurelyInseparable_adjoin_simple_iff_pow_mem F L p).2 (by refine ⟨1, ?_⟩ rw [pow_one] refine ⟨secondCoordinateInSubfield f, ?_⟩ change planeCurveFunction f 1 = y ^ p exact hypow.symm) - letI : Algebra.IsSeparable F E := + let : Algebra.IsSeparable F E := (IntermediateField.isSeparable_adjoin_simple_iff_isSeparable F L).2 (Algebra.IsSeparable.isSeparable F y) have hE : E = ⊥ := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean index cbc33f1614..e6bd9f9fa3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean @@ -162,8 +162,8 @@ theorem torusCurveTorsionIntersection_card_le_firstOrder_mul_of_degreeOf_second_ classical let S := BGS.External.torusCurveTorsionIntersection K f firstOrder secondOrder - letI : NeZero firstOrder := ⟨hfirstOrder.ne'⟩ - letI : Fintype (rootsOfUnity firstOrder K) := Fintype.ofFinite _ + let : NeZero firstOrder := ⟨hfirstOrder.ne'⟩ + let : Fintype (rootsOfUnity firstOrder K) := Fintype.ofFinite _ let T := fun x : rootsOfUnity firstOrder K => {y : K // (secondCoordinateSpecialization f (x.1 : K)).eval y = 0} let embedding : {z // z ∈ S} ↪ Sigma T := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index 969ae1c724..fee577d08b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -167,7 +167,7 @@ theorem integralClosure_le_dominatingValuationSubring (integralClosure P L).toSubring ≤ (dominatingValuationSubring (A := A) (L := L) m).toSubring := by let V := dominatingValuationSubring (A := A) (L := L) m - letI : IsIntegrallyClosedIn V.toSubring L := + let : IsIntegrallyClosedIn V.toSubring L := inferInstanceAs (IsIntegrallyClosedIn V L) rw [Subring.integralClosure_le_iff] intro p @@ -456,13 +456,13 @@ theorem polynomial_algebraMap_mem_planeCurveCoordinateRing_range algebraMap (Polynomial K) (PlaneCurveFunctionField f) P ∈ (algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)).range := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) @@ -692,22 +692,22 @@ theorem torsionPointExhaustiveFinitePlace_injective Function.Injective (torsionPointExhaustiveFinitePlace hf hpartialSecond firstOrder secondOrder hfirstNonzero hsecondNonzero) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change Function.Injective (torsionPointExhaustiveFinitePlace hf hpartialSecond @@ -772,25 +772,25 @@ theorem torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree planeCurveExhaustiveTorsionGcdWeightedDegree hf hpartialSecond firstOrder secondOrder := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) + let : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (FiniteExtensionPlace K (PlaneCurveFunctionField f)) := + let : DecidableEq (FiniteExtensionPlace K (PlaneCurveFunctionField f)) := Classical.decEq _ let x : PlaneCurveFunctionField f := planeCurveFunction f 0 ^ firstOrder - 1 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean index 4bb93426f9..9bc8898cbd 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean @@ -78,12 +78,12 @@ theorem liftedTorsionPointNormalizationBranch_injective intro z w hzw apply torsionPointMaximalIdeal_injective f firstOrder secondOrder apply MaximalSpectrum.ext - letI hz : + let hz : (liftedTorsionPointNormalizationBranch (f := f) (B := B) firstOrder secondOrder z).asIdeal.LiesOver (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := liftedTorsionPointNormalizationBranch_liesOver (f := f) firstOrder secondOrder z - letI hw : + let hw : (liftedTorsionPointNormalizationBranch (f := f) (B := B) firstOrder secondOrder w).asIdeal.LiesOver (torsionPointMaximalIdeal f firstOrder secondOrder w).asIdeal := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean index d2d7d85c66..6391992c8f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean @@ -216,9 +216,9 @@ theorem planeCurveNormalizationBranch_injective Function.Injective (planeCurveNormalizationBranch f) := by intro m n hmn apply MaximalSpectrum.ext - letI hm : (planeCurveNormalizationBranch f m).asIdeal.LiesOver m.asIdeal := + let hm : (planeCurveNormalizationBranch f m).asIdeal.LiesOver m.asIdeal := planeCurveNormalizationBranch_liesOver f m - letI hn : (planeCurveNormalizationBranch f n).asIdeal.LiesOver n.asIdeal := + let hn : (planeCurveNormalizationBranch f n).asIdeal.LiesOver n.asIdeal := planeCurveNormalizationBranch_liesOver f n calc m.asIdeal = (planeCurveNormalizationBranch f m).asIdeal.under @@ -259,7 +259,7 @@ theorem first_torsionFunction_mem_normalizationBranch algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveNormalization f) (planeCurveCoordinate f 0 ^ firstOrder - 1) ∈ (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal := by - letI : + let : (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal.LiesOver (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := planeCurveNormalizationBranch_liesOver f @@ -279,7 +279,7 @@ theorem second_torsionFunction_mem_normalizationBranch algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveNormalization f) (planeCurveCoordinate f 1 ^ secondOrder - 1) ∈ (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal := by - letI : + let : (torsionPointNormalizationBranch f firstOrder secondOrder z).asIdeal.LiesOver (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := planeCurveNormalizationBranch_liesOver f @@ -299,7 +299,7 @@ private noncomputable instance planeCurveIntegralClosureIsFractionRing [IsScalarTower (PlaneCurveCoordinateRing f) B (PlaneCurveFunctionField f)] [IsIntegralClosure B (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f)] : IsFractionRing B (PlaneCurveFunctionField f) := by - letI : Algebra.IsAlgebraic (PlaneCurveCoordinateRing f) + let : Algebra.IsAlgebraic (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) := (IsFractionRing.comap_isAlgebraic_iff (A := PlaneCurveCoordinateRing f) @@ -382,7 +382,7 @@ theorem liftedNormalizationBranch_torsion_orders_positive intro hzero apply hsecondNonzero rw [← hsecondMap, hzero, map_zero] - letI : branch.asIdeal.LiesOver + let : branch.asIdeal.LiesOver (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal := hbranch have hfirstMem : firstRegular ∈ branch.asIdeal := by exact (Ideal.mem_of_liesOver diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean index 685ff01052..e166bf32ae 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean @@ -62,10 +62,10 @@ theorem natCard_unitPowerFiber_le {F : Type*} [Field F] have hval := congrArg (fun u : rootsOfUnity g F => (u.1 : Fˣ)) hzw dsimp only [e] at hval exact mul_right_cancel hval - haveI : NeZero g := ⟨hg.ne'⟩ + have : NeZero g := ⟨hg.ne'⟩ exact (Nat.card_le_card_of_injective e he).trans (card_rootsOfUnity F g) - · letI : IsEmpty (unitPowerFiber g c) := ⟨fun z => h ⟨z⟩⟩ + · let : IsEmpty (unitPowerFiber g c) := ⟨fun z => h ⟨z⟩⟩ simp /-- The common kernel of two integer characters of a two-dimensional @@ -133,7 +133,7 @@ theorem finite_torusCharacterKernel_of_det_ne_zero _ = (z.1.1 ^ a * z.1.2 ^ b) ^ (-c) * (z.1.1 ^ c * z.1.2 ^ d) ^ a := hprod.symm _ = 1 := by rw [h₁, h₂]; simp - haveI : NeZero D.natAbs := ⟨hDpos.ne'⟩ + have : NeZero D.natAbs := ⟨hDpos.ne'⟩ let e : torusCharacterKernel F a b c d → rootsOfUnity D.natAbs F × rootsOfUnity D.natAbs F := fun z => ⟨⟨z.1.1, by @@ -245,10 +245,10 @@ theorem natCard_torusCharacterKernel_le_det apply Prod.ext · exact congrArg (fun s : Sigma fiber => s.2.1) hzw · exact congrArg (fun s : Sigma fiber => s.1.1) hzw - haveI : NeZero q.natAbs := ⟨hqpos.ne'⟩ - haveI : NeZero g := ⟨hg.ne'⟩ - letI : Fintype base := Fintype.ofFinite base - letI (η : base) : Finite (fiber η) := unitPowerFiber_finite g _ + have : NeZero q.natAbs := ⟨hqpos.ne'⟩ + have : NeZero g := ⟨hg.ne'⟩ + let : Fintype base := Fintype.ofFinite base + let (η : base) : Finite (fiber η) := unitPowerFiber_finite g _ have hbase : Nat.card base ≤ q.natAbs := card_rootsOfUnity F q.natAbs have hfiber : ∀ η : base, Nat.card (fiber η) ≤ g := by intro η @@ -289,7 +289,7 @@ theorem natCard_planeCurveSupportCharacterStabilizer_le_supportDet let d : ℤ := (t 1 : ℤ) - (r 1 : ℤ) have hdet' : a * d - b * c ≠ 0 := by simpa [a, b, c, d, planeCurveSupportDifferenceDet] using hdet - letI : Finite (torusCharacterKernel F a b c d) := + let : Finite (torusCharacterKernel F a b c d) := finite_torusCharacterKernel_of_det_ne_zero a b c d hdet' let e : planeCurveSupportCharacterStabilizer F f → torusCharacterKernel F a b c d := fun z => diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean index 6303180658..7dbf7f2493 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean @@ -57,7 +57,7 @@ private theorem polynomial_X_pow_sub_C_X_irreducible exact P.neg_mem (Ideal.subset_span (Set.mem_singleton _)) · have him : i ≠ m := ne_of_lt hi simp only [q, Polynomial.coeff_sub, Polynomial.coeff_X_pow, - Polynomial.coeff_C, if_neg him, if_neg hi0, sub_zero] + Polynomial.coeff_C, ite_eq_right him, ite_eq_right hi0, sub_zero] exact P.zero_mem · have hcoeff : q.coeff 0 = -(Polynomial.X : R) := by simp [q, Ne.symm hm.ne'] @@ -163,9 +163,9 @@ theorem finrank_over_adjoin_pow_eq_mul Polynomial.monic_X_pow_sub_C c hm.ne' have hqRoot : Polynomial.aeval z q = 0 := by simp [q, c] have hzIntegral : IsIntegral E0 z := ⟨q, hqMonic, hqRoot⟩ - letI : FiniteDimensional E0 A := + let : FiniteDimensional E0 A := IntermediateField.adjoin.finiteDimensional hzIntegral - letI : FiniteDimensional A L := by + let : FiniteDimensional A L := by change FiniteDimensional AK L rw [hAK] infer_instance @@ -190,13 +190,13 @@ theorem finrank_over_firstPoweredCoordinate_eq Module.finrank (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) = m * MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let x := planeCurveFunction f 0 have hx : Transcendental K x := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : FiniteDimensional (FirstCoordinateSubfield f) + let : FiniteDimensional (FirstCoordinateSubfield f) (PlaneCurveFunctionField f) := finiteDimensional_over_firstCoordinate_of_irreducible hf hpartialSecond rw [finrank_over_adjoin_pow_eq_mul x hx m hm, @@ -212,13 +212,13 @@ theorem finrank_over_secondPoweredCoordinate_eq Module.finrank (SecondPoweredCoordinateSubfield f n) (PlaneCurveFunctionField f) = n * MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let y := planeCurveFunction f 1 have hy : Transcendental K y := secondCoordinate_transcendental hf (degreeOf_first_pos_of_pderiv_ne_zero hpartialFirst) - letI : FiniteDimensional (SecondCoordinateSubfield f) + let : FiniteDimensional (SecondCoordinateSubfield f) (PlaneCurveFunctionField f) := (finiteSeparable_over_secondCoordinate_of_irreducible hf hpartialFirst).1 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean index c6b1b606a7..5ec2e96752 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean @@ -168,7 +168,7 @@ private lemma changeParameterMatrix_lowerTriangular private lemma changeParameterMatrix_det (E : Derivation C L L) (a : L) (n : ℕ) : (changeParameterMatrix E a n).det = a ^ n.choose 2 := by - rw [Matrix.det_of_lowerTriangular _ (changeParameterMatrix_lowerTriangular E a n)] + rw [Matrix.det_of_isLowerTriangular _ (changeParameterMatrix_lowerTriangular E a n)] simp only [changeParameterMatrix, changeParameterCoeff_diag] calc ∏ i : Fin n, a ^ (i : ℕ) = a ^ ∑ i : Fin n, (i : ℕ) := by diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean b/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean index 957fb55fbf..45e505c9b6 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean @@ -112,7 +112,7 @@ theorem legendreWeierstrassCurve_point_card_eq_card_add_one_add_characterSum (Nat.card (legendreWeierstrassCurve u v).toAffine.Point : ℤ) = Fintype.card F + 1 + ellipticCubicCharacterSum u v := by let W := legendreWeierstrassCurve u v - letI : W.IsElliptic := legendreWeierstrassCurveIsElliptic hF hu hv huv + let : W.IsElliptic := legendreWeierstrassCurveIsElliptic hF hu hv huv calc (Nat.card W.toAffine.Point : ℤ) = Nat.card (WithZero {xy : F × F // W.toAffine.Equation xy.1 xy.2}) := by diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean index d12b236183..3bafb62b3c 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean @@ -23,7 +23,7 @@ theorem sum_comp_sq_eq_sum_quadraticChar_add_one intro x _ have hcard : ((#{y ∈ (univ : Finset F) | y ^ 2 = x} : ℕ) : ℤ) = quadraticChar F x + 1 := by - simpa [Set.toFinset_setOf] using quadraticChar_card_sqrts hF x + simpa [Set.toFinset_ofPred] using quadraticChar_card_sqrts hF x calc ∑ y ∈ (univ : Finset F) with y ^ 2 = x, f (y ^ 2) = ∑ _y ∈ (univ : Finset F) with _y ^ 2 = x, f x := by @@ -131,7 +131,7 @@ theorem exists_quadratic_conic_point_away_from_three have hrootCount (y : F) : rootCount y = quadraticChar F (A * y ^ 2 - C) + 1 := by dsimp [rootCount, roots] - simpa [Set.toFinset_setOf] using + simpa [Set.toFinset_ofPred] using quadraticChar_card_sqrts hF (A * y ^ 2 - C) have hsum : ∑ y : F, rootCount y = (Fintype.card F : ℤ) - quadraticChar F A := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean index 6388bde155..4e9f2f5347 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean @@ -64,7 +64,7 @@ theorem firstCoordinate_sub_affinePoint_ne_zero letI := planeCurveCoordinateRing_isDomain hf planeCurveFunction f 0 - algebraMap K (PlaneCurveFunctionField f) z.1.1 ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have htrans : Transcendental K (planeCurveFunction f 0) := firstCoordinate_transcendental hf @@ -83,7 +83,7 @@ theorem secondCoordinate_sub_affinePoint_ne_zero letI := planeCurveCoordinateRing_isDomain hf planeCurveFunction f 1 - algebraMap K (PlaneCurveFunctionField f) z.1.2 ≠ 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have htrans : Transcendental K (planeCurveFunction f 1) := secondCoordinate_transcendental hf @@ -294,22 +294,22 @@ theorem affinePointExhaustiveFinitePlace_injective Function.Injective (affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change Function.Injective (affinePointExhaustiveFinitePlace hf hpartialFirst hpartialSecond) @@ -369,22 +369,22 @@ theorem finitePlaceOrder_affinePointExhaustiveFinitePlace_pos_of_mem hf hpartialFirst hpartialSecond z) (algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) r) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let E := PlaneCurveFunctionField f let q := affinePointExhaustiveFinitePlace @@ -451,23 +451,23 @@ theorem affinePointFamily_card_le_finiteExtensionGcdWeightedDegree (algebraMap (PlaneCurveCoordinateRing f) (PlaneCurveFunctionField f) s) := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) + let : DecidableEq (RatFunc K) := Classical.decEq (RatFunc K) let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let E := PlaneCurveFunctionField f let x : E := algebraMap (PlaneCurveCoordinateRing f) E r diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean index c04d7e9b88..9369d8bb04 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean @@ -222,8 +222,8 @@ private theorem weightedMarkedEffectiveDivisor_card @Fintype.card (WeightedMarkedEffectiveDivisor w n) (weightedMarkedEffectiveDivisorFintype w hw n) = weightedEffectiveDivisorCount w hw n * n := by - letI := weightedEffectiveDivisorFintype w hw n - letI := weightedMarkedEffectiveDivisorFintype w hw n + let := weightedEffectiveDivisorFintype w hw n + let := weightedMarkedEffectiveDivisorFintype w hw n rw [Fintype.card_congr (weightedMarkedEffectiveDivisorEquivSigma w n)] rw [Fintype.card_sigma] simp only [Fintype.card_sigma, Fintype.card_prod, Fintype.card_fin] @@ -282,8 +282,8 @@ private theorem weightedEulerDecomposition_card ∑ ij ∈ Finset.HasAntidiagonal.antidiagonal n, weightedEffectiveDivisorCount w hw ij.1 * weightedClosedPlaceExtensionCount w (ij.2 + 1) := by - letI (m : ℕ) := weightedEffectiveDivisorFintype w hw m - letI := weightedEulerDecompositionFintype w hw n + let (m : ℕ) := weightedEffectiveDivisorFintype w hw m + let := weightedEulerDecompositionFintype w hw n rw [Fintype.card_congr (weightedEulerDecompositionEquivSigma w n)] rw [Fintype.card_sigma] simp only [Fintype.card_prod, Fintype.card_sigma, Fintype.card_fin] @@ -317,9 +317,9 @@ theorem weightedEffectiveDivisorPointCountRecurrence (weightedEffectiveDivisorCount w (fun i => (hw i).ne')) (weightedClosedPlaceExtensionCount w) := by intro n - letI := weightedMarkedEffectiveDivisorFintype w + let := weightedMarkedEffectiveDivisorFintype w (fun i => (hw i).ne') (n + 1) - letI := weightedEulerDecompositionFintype w + let := weightedEulerDecompositionFintype w (fun i => (hw i).ne') n calc weightedEffectiveDivisorCount w (fun i => (hw i).ne') (n + 1) * @@ -458,8 +458,8 @@ private theorem weightedEffectiveDivisorCount_degreeLE_eq_finiteExtensionCount finiteExtensionPlaceDegree K L P.1) (fun P => (finiteExtensionPlaceDegree_pos K L P.1).ne') n = finiteExtensionEffectiveDivisorCount K L n := by - letI := finiteExtensionPlaceDegreeLEFintype K L bound - letI := weightedEffectiveDivisorFintype + let := finiteExtensionPlaceDegreeLEFintype K L bound + let := weightedEffectiveDivisorFintype (fun P : {P : FiniteExtensionPlace K L // finiteExtensionPlaceDegree K L P ≤ bound} => finiteExtensionPlaceDegree K L P.1) @@ -486,7 +486,7 @@ theorem finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd finiteExtensionPlaceDegree K L P ≤ r} // finiteExtensionPlaceDegree K L P.1 ∣ r}, finiteExtensionPlaceDegree K L P.1.1 := by - letI := finiteExtensionPlaceDegreeLEFintype K L r + let := finiteExtensionPlaceDegreeLEFintype K L r let PlaceLE := {P : FiniteExtensionPlace K L // finiteExtensionPlaceDegree K L P ≤ r} let PlaceDvd := {P : PlaceLE // @@ -522,8 +522,8 @@ private theorem weightedClosedPlaceExtensionCount_degreeLE_eq_finiteExtensionCou finiteExtensionPlaceDegree K L P ≤ bound} => finiteExtensionPlaceDegree K L P.1) r = finiteExtensionClosedPlaceExtensionCount K L r := by - letI := finiteExtensionPlaceDegreeLEFintype K L bound - letI := finiteExtensionPlaceDegreeLEFintype K L r + let := finiteExtensionPlaceDegreeLEFintype K L bound + let := finiteExtensionPlaceDegreeLEFintype K L r let Big := {P : FiniteExtensionPlace K L // finiteExtensionPlaceDegree K L P ≤ bound} let Small := {P : FiniteExtensionPlace K L // @@ -576,7 +576,7 @@ theorem finiteExtensionEffectiveDivisorPointCountRecurrence : let PlaceLE := {P : FiniteExtensionPlace K L // finiteExtensionPlaceDegree K L P ≤ n + 1} let w : PlaceLE → ℕ := fun P => finiteExtensionPlaceDegree K L P.1 - letI := finiteExtensionPlaceDegreeLEFintype K L (n + 1) + let := finiteExtensionPlaceDegreeLEFintype K L (n + 1) have hw : ∀ P : PlaceLE, 0 < w P := fun P => finiteExtensionPlaceDegree_pos K L P.1 have hlocal := weightedEffectiveDivisorPointCountRecurrence w hw n diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean index b322536ad0..160de51a9a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean @@ -98,7 +98,7 @@ theorem sum_degree_eq_sum_degree_of_div_gcd_and_fiber_card Nat.gcd extensionDegree (baseDegree P)) : (∑ Q, upDegree Q) = ∑ P, baseDegree P := by classical - letI : DecidableEq Base := Classical.decEq Base + let : DecidableEq Base := Classical.decEq Base calc (∑ Q, upDegree Q) = ∑ z : Σ P, {Q : Up // down Q = P}, upDegree z.2.1 := by @@ -306,9 +306,9 @@ theorem exactConstantExtensionPresentedPlace_degree_eq_div_gcd (finiteExtensionPlaceDegree C N (exactConstantExtensionPresentedDownstairsPlace C S N hExact q)) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact cases q with | inl q => @@ -331,9 +331,9 @@ theorem exactConstantExtensionPresentedPlace_degree_eq_one_iff_dvd finiteExtensionPlaceDegree C N (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) ∣ Module.finrank C S := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact rw [exactConstantExtensionPresentedPlace_degree_eq_div_gcd] exact div_gcd_eq_one_iff_dvd @@ -384,9 +384,9 @@ theorem exactConstantExtensionPresentedPlace_closedContribution_eq then finiteExtensionPlaceDegree C N (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) else 0) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact by_cases hrat : finiteExtensionPlaceDegree S (ExactConstantExtension C N S) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean index 4827edbd41..1520a75a47 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean @@ -95,11 +95,11 @@ theorem exactConstantExtensionPresentedUpstairsFinitePlaceEquiv_apply exactConstantExtensionPresentedUpstairsFinitePlaceEquiv C S N hExact q = exactConstantExtensionUpstairsFinitePlace C S N hExact q := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact change IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv (ratFuncFiniteIntegralClosureRingEquiv C S @@ -123,22 +123,22 @@ theorem exactConstantExtensionPresentedFinitePlaceFiber_natCard_eq_gcd_of_downst Nat.gcd (Module.finrank C S) (finiteExtensionPlaceDegree C N (.inl P)) := by let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : SMul N E := Algebra.toSMul - letI : Module N E := Algebra.toModule - letI : IsScalarTower (RatFunc C) N E := + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := exactConstantExtensionBaseTower C (RatFunc C) N S obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective C N E P let Q₀ : FinitePlaceUnderFiber C N E P := ⟨Q, hQ⟩ @@ -164,7 +164,7 @@ private theorem splittingFormulaReciprocalPolynomialAlgebra_map algebraMap K[X] L p = algebraMap (RatFunc K) L (((reciprocalPolynomialRingHom K p : RatFuncInfinityIntegers K) : RatFunc K)) := by - letI : Algebra K[X] L := + let : Algebra K[X] L := ratFuncExtensionReciprocalPolynomialAlgebra K L change algebraMap (RatFuncInfinityIntegers K) L (reciprocalPolynomialRingHom K p) = _ @@ -357,8 +357,8 @@ theorem exactConstantExtensionPresentedUpstairsInfinityPlaceEquiv_apply exactConstantExtensionUpstairsInfinityPlace C S N hExact q.1 q.2 := by let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact apply Subtype.ext rfl @@ -383,30 +383,30 @@ theorem exactConstantExtensionPresentedInfinityPlaceFiber_natCard_eq_gcd_of_down C S N q.1 q.2 = P} = Nat.gcd (Module.finrank C S) (finiteExtensionPlaceDegree C N (.inr P)) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S intro P let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : SMul N E := Algebra.toSMul - letI : Module N E := Algebra.toModule - letI : IsScalarTower (RatFunc C) N E := + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := exactConstantExtensionBaseTower C (RatFunc C) N S obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective C N E P let Q₀ : InfinityPlaceUnderFiber C N E P := ⟨Q, hQ⟩ @@ -484,11 +484,11 @@ theorem exactConstantExtensionPresentedUpstairsPlaceEquiv_apply ratFuncExactConstantExtensionAlgebra C S N hExact exactConstantExtensionPresentedUpstairsPlaceEquiv C S N hExact q = exactConstantExtensionPresentedUpstairsPlace C S N hExact q := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact cases q with | inl q => @@ -531,11 +531,11 @@ theorem exactConstantExtensionPresentedPlaceFiber_natCard_eq_gcd_of_downstairs : C S N hExact q = P} = Nat.gcd (Module.finrank C S) (finiteExtensionPlaceDegree C N P) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S intro P cases P with @@ -659,31 +659,31 @@ theorem exactConstantExtensionClosedPlaceExtensionCount_eq (ExactConstantExtension C N S) level = finiteExtensionClosedPlaceExtensionCount C N (Module.finrank C S * level) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Fintype S := Fintype.ofFinite S + let : Fintype S := Fintype.ofFinite S let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : FiniteDimensional (RatFunc S) E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact by_cases hlevel : level = 0 · subst level @@ -704,14 +704,14 @@ theorem exactConstantExtensionClosedPlaceExtensionCount_eq let UpLE := {q : Up // upDegree q ≤ level} let ActualLE := {Q : Actual // finiteExtensionPlaceDegree S E Q ≤ level} - letI : Fintype BaseLE := + let : Fintype BaseLE := finiteExtensionPlaceDegreeLEFintype C N (Module.finrank C S * level) - letI : Fintype ActualLE := + let : Fintype ActualLE := finiteExtensionPlaceDegreeLEFintype S E level let eLE : UpLE ≃ ActualLE := Equiv.subtypeEquiv e (fun _ => Iff.rfl) - letI : Fintype UpLE := Fintype.ofEquiv ActualLE eLE.symm + let : Fintype UpLE := Fintype.ofEquiv ActualLE eLE.symm let UpDvd := {q : UpLE // upDegree q.1 ∣ level} let ActualDvd := {Q : ActualLE // finiteExtensionPlaceDegree S E Q.1 ∣ level} diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean index 31c67800a0..11d3888fd7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean @@ -124,27 +124,27 @@ theorem exactConstantExtensionUpstairsResidueField_finite (q : IsDedekindDomain.HeightOneSpectrum (integralClosure S[X] (ExactConstantExtension C N S))) : Finite q.asIdeal.ResidueField := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Fintype S := Fintype.ofFinite S + let : Fintype S := Fintype.ofFinite S let qTensor := exactConstantExtensionTensorNormalizationHeightOne C S N q let e₂ := exactConstantExtensionNormalizationAlgEquiv C S N hExact let Q : FiniteExtensionFinitePlace S (ExactConstantExtension C N S) := IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e₂.toRingEquiv qTensor - letI : Finite Q.asIdeal.ResidueField := + let : Finite Q.asIdeal.ResidueField := finiteExtensionFinitePlaceResidueField_finite S (ExactConstantExtension C N S) Q let e₁ := finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N @@ -159,9 +159,9 @@ theorem exactConstantExtensionUpstairsIdeal_isMaximal (q : IsDedekindDomain.HeightOneSpectrum (integralClosure S[X] (ExactConstantExtension C N S))) : q.asIdeal.IsMaximal := by - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := exactConstantExtensionUpstairsResidueField_finite C S N hExact q - letI : Finite + let : Finite (integralClosure S[X] (ExactConstantExtension C N S) ⧸ q.asIdeal) := Finite.of_injective (algebraMap @@ -228,49 +228,49 @@ theorem exactConstantExtensionFinitePlace_degree_eq_div_gcd Nat.gcd (Module.finrank C S) (finiteExtensionPlaceDegree C N (.inl (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := exactConstantExtensionUpstairsResidueField_finite C S N hExact q - letI : q.asIdeal.IsMaximal := + let : q.asIdeal.IsMaximal := exactConstantExtensionUpstairsIdeal_isMaximal C S N hExact q let A := S ⊗[C] integralClosure C[X] N let T := ExactConstantExtension C N S - letI : Algebra S[X] A := + let : Algebra S[X] A := bridgeTensorNormalizationPolynomialAlgebra C S N - letI : Algebra S A := Algebra.TensorProduct.leftAlgebra - letI : Algebra S (RatFuncFiniteIntegralClosure S T) := + let : Algebra S A := Algebra.TensorProduct.leftAlgebra + let : Algebra S (RatFuncFiniteIntegralClosure S T) := RingHom.toAlgebra ((algebraMap S[X] (RatFuncFiniteIntegralClosure S T)).comp (algebraMap S S[X])) - letI : SMul S A := Algebra.toSMul - letI : SMul S (RatFuncFiniteIntegralClosure S T) := Algebra.toSMul - letI : SMul S[X] (RatFuncFiniteIntegralClosure S T) := Algebra.toSMul - letI : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S T) := + let : SMul S A := Algebra.toSMul + let : SMul S (RatFuncFiniteIntegralClosure S T) := Algebra.toSMul + let : SMul S[X] (RatFuncFiniteIntegralClosure S T) := Algebra.toSMul + let : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S T) := IsScalarTower.of_algebraMap_eq' rfl let qTensor := exactConstantExtensionTensorNormalizationHeightOne C S N q let Q := exactConstantExtensionUpstairsFinitePlace C S N hExact q let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q - letI : (finiteFieldConstantExtensionTensorIdeal + let : (finiteFieldConstantExtensionTensorIdeal C S N q.asIdeal).IsPrime := by change qTensor.asIdeal.IsPrime exact qTensor.isPrime let p := finiteFieldConstantExtensionDownstairsIdeal C S N q.asIdeal - letI : p.IsMaximal := + let : p.IsMaximal := finiteFieldConstantExtensionDownstairsIdeal_isMaximal C S N q.asIdeal - letI : p.IsPrime := Ideal.IsMaximal.isPrime + let : p.IsPrime := Ideal.IsMaximal.isPrime (show p.IsMaximal from inferInstance) let e₂ := exactConstantExtensionNormalizationAlgEquiv C S N hExact let e₂S : A ≃ₐ[S] RatFuncFiniteIntegralClosure S T := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean index 5072ef6dc6..e664b56381 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean @@ -41,7 +41,7 @@ omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem canonicalRatFuncPolynomialFractionRing : letI := canonicalRatFuncPolynomialAlgebra K IsFractionRing K[X] (RatFunc K) := by - letI := canonicalRatFuncPolynomialAlgebra K + let := canonicalRatFuncPolynomialAlgebra K infer_instance omit [DecidableEq K] [DecidableEq (RatFunc K)] in @@ -49,7 +49,7 @@ private theorem canonicalRatFuncPolynomialAlgebraMap_injective : Function.Injective (@algebraMap K[X] (RatFunc K) _ _ (canonicalRatFuncPolynomialAlgebra K)) := by - letI := canonicalRatFuncPolynomialAlgebra K + let := canonicalRatFuncPolynomialAlgebra K exact RatFunc.algebraMap_injective K omit [DecidableEq K] [DecidableEq (RatFunc K)] in @@ -59,8 +59,8 @@ private theorem canonicalRatFunc_div_surjective (z : RatFunc K) : (canonicalRatFuncPolynomialAlgebra K) p / @algebraMap K[X] (RatFunc K) _ _ (canonicalRatFuncPolynomialAlgebra K) q := by - letI := canonicalRatFuncPolynomialAlgebra K - letI : IsFractionRing K[X] (RatFunc K) := + let := canonicalRatFuncPolynomialAlgebra K + let : IsFractionRing K[X] (RatFunc K) := canonicalRatFuncPolynomialFractionRing K obtain ⟨p, q, hq, h⟩ := IsFractionRing.div_surjective K[X] z exact ⟨p, q, nonZeroDivisors.ne_zero hq, h.symm⟩ @@ -234,8 +234,8 @@ private theorem finrank_eq_of_finite_ringEquiv [Field E] [Field F] [Algebra K E] [Algebra K F] [Finite E] [Finite F] (e : E ≃+* F) : Module.finrank K E = Module.finrank K F := by - letI : Fintype E := Fintype.ofFinite E - letI : Fintype F := Fintype.ofFinite F + let : Fintype E := Fintype.ofFinite E + let : Fintype F := Fintype.ofFinite F have hcard : Fintype.card E = Fintype.card F := Fintype.card_congr e.toEquiv rw [Module.card_eq_pow_finrank (K := K) (V := E), @@ -251,27 +251,27 @@ private theorem actualInfinityPlaceResidueField_finite [Algebra.IsSeparable (RatFunc K) L] (P : FiniteExtensionInfinityPlace K L) : Finite P.1.ResidueField := by - letI : Algebra K (RatFuncInfinityIntegers K) := + let : Algebra K (RatFuncInfinityIntegers K) := (ratFuncInfinityConstantRingHom K).toAlgebra - letI : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + let : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := IsScalarTower.of_algebraMap_eq' rfl - letI : Module.Finite (RatFuncInfinityIntegers K) + let : Module.Finite (RatFuncInfinityIntegers K) (RatFuncInfinityIntegralClosure K L) := IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L (RatFuncInfinityIntegralClosure K L) let p := (ratFuncInfinityPlace K).asIdeal - letI : Finite p.ResidueField := + let : Finite p.ResidueField := Finite.of_injective (ratFuncInfinityPlaceResidueEquiv K) (ratFuncInfinityPlaceResidueEquiv K).injective - letI : P.1.LiesOver p := by + let : P.1.LiesOver p := by simpa [p] using Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P - letI := Localization.AtPrime.algebraOfLiesOver p P.1 + let := Localization.AtPrime.algebraOfLiesOver p P.1 let _ : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance - letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := + let : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance - letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + let : Module.Finite p.ResidueField P.1.ResidueField := inferInstance exact Module.finite_of_finite p.ResidueField end LocalizationHelpers @@ -285,7 +285,7 @@ theorem coefficientPolynomial_under_span_X letI : Algebra C[X] S[X] := Polynomial.algebra C S (Ideal.span ({Polynomial.X} : Set S[X])).under C[X] = Ideal.span ({Polynomial.X} : Set C[X]) := by - letI : Algebra C[X] S[X] := Polynomial.algebra C S + let : Algebra C[X] S[X] := Polynomial.algebra C S ext p change algebraMap C[X] S[X] p ∈ Ideal.span ({Polynomial.X} : Set S[X]) ↔ @@ -306,8 +306,8 @@ theorem polynomialTensorCancel_algebraMap_coefficient polynomialTensorCancelTargetPolynomialExtensionAlgebra C S A algebraMap S[X] (S ⊗[C] A) (algebraMap C[X] S[X] p) = (1 : S) ⊗ₜ[C] algebraMap C[X] A p := by - letI : Algebra C[X] S[X] := Polynomial.algebra C S - letI : Algebra S[X] (S ⊗[C] A) := + let : Algebra C[X] S[X] := Polynomial.algebra C S + let : Algebra S[X] (S ⊗[C] A) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S A let e := polynomialTensorCancelOverCoefficientPolynomial C S A have hsource : @@ -415,7 +415,7 @@ theorem exactConstantExtensionInfinityDownstairsIdeal_under let p := exactConstantExtensionInfinityDownstairsIdeal C S N q let oS := Ideal.span ({Polynomial.X} : Set S[X]) let oC := Ideal.span ({Polynomial.X} : Set C[X]) - letI : Algebra C[X] S[X] := Polynomial.algebra C S + let : Algebra C[X] S[X] := Polynomial.algebra C S ext r change (1 : S) ⊗ₜ[C] @@ -518,7 +518,7 @@ noncomputable def exactConstantExtensionDownstairsInfinityPlace have hpUnder : p.under C[X] = o := exactConstantExtensionInfinityDownstairsIdeal_under C S N q hqOrigin have hdisj : Disjoint (M : Set A) (p : Set A) := by - letI : o.IsPrime := infinityBridgeBaseOriginPrime C + let : o.IsPrime := infinityBridgeBaseOriginPrime C exact mappedPrimeCompl_disjoint_of_under_eq C[X] A o p hpUnder let P := Ideal.map (algebraMap A B) p letI : p.IsPrime := hpPrime @@ -731,19 +731,19 @@ theorem exactConstantExtensionUpstairsInfinityResidueField_finite ratFuncExactConstantExtensionAlgebra C S N hExact Finite (exactConstantExtensionUpstairsInfinityPlace C S N hExact q hqOrigin).1.ResidueField := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Fintype S := Fintype.ofFinite S + let : Fintype S := Fintype.ofFinite S exact actualInfinityPlaceResidueField_finite S (ExactConstantExtension C N S) (exactConstantExtensionUpstairsInfinityPlace @@ -757,11 +757,11 @@ theorem exactConstantExtensionInfinityTensorResidueField_finite (hqOrigin : q.asIdeal.under S[X] = Ideal.span ({Polynomial.X} : Set S[X])) : Finite q.asIdeal.ResidueField := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Finite + let : Finite (exactConstantExtensionUpstairsInfinityPlace C S N hExact q hqOrigin).1.ResidueField := exactConstantExtensionUpstairsInfinityResidueField_finite @@ -777,10 +777,10 @@ theorem exactConstantExtensionInfinityTensorIdeal_isMaximal (hqOrigin : q.asIdeal.under S[X] = Ideal.span ({Polynomial.X} : Set S[X])) : q.asIdeal.IsMaximal := by - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := exactConstantExtensionInfinityTensorResidueField_finite C S N hExact q hqOrigin - letI : Finite + let : Finite (HasQuotient.Quotient (S ⊗[C] integralClosure C[X] N) q.asIdeal) := Finite.of_injective @@ -808,9 +808,9 @@ theorem exactConstantExtensionInfinityDownstairsResidueField_finite let p := exactConstantExtensionInfinityDownstairsIdeal C S N q let i := (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom - letI : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) + let : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) let P := exactConstantExtensionDownstairsInfinityPlace C S N q hqOrigin - letI : Finite P.1.ResidueField := + let : Finite P.1.ResidueField := actualInfinityPlaceResidueField_finite C N P let e := exactConstantExtensionDownstairsResidueFieldAlgEquiv C S N q hqOrigin @@ -879,45 +879,45 @@ theorem exactConstantExtensionInfinityPlace_degree_eq_div_gcd (finiteExtensionPlaceDegree C N (.inr (exactConstantExtensionDownstairsInfinityPlace C S N q hqOrigin))) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Fintype S := Fintype.ofFinite S + let : Fintype S := Fintype.ofFinite S let p := exactConstantExtensionInfinityDownstairsIdeal C S N q let i := (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom - letI : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) - letI : Finite p.ResidueField := + let : p.IsPrime := Ideal.comap_isPrime (f := i) (K := q.asIdeal) + let : Finite p.ResidueField := exactConstantExtensionInfinityDownstairsResidueField_finite C S N q hqOrigin - letI : Finite + let : Finite (q.asIdeal.comap (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom).ResidueField := by change Finite p.ResidueField infer_instance - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := exactConstantExtensionInfinityTensorResidueField_finite C S N hExact q hqOrigin - letI : q.asIdeal.IsMaximal := + let : q.asIdeal.IsMaximal := exactConstantExtensionInfinityTensorIdeal_isMaximal C S N hExact q hqOrigin let Q := exactConstantExtensionUpstairsInfinityPlace C S N hExact q hqOrigin let P := exactConstantExtensionDownstairsInfinityPlace C S N q hqOrigin - letI : Finite Q.1.ResidueField := + let : Finite Q.1.ResidueField := exactConstantExtensionUpstairsInfinityResidueField_finite C S N hExact q hqOrigin - letI : Finite P.1.ResidueField := + let : Finite P.1.ResidueField := actualInfinityPlaceResidueField_finite C N P have hUp : Module.finrank S q.asIdeal.ResidueField = Module.finrank S Q.1.ResidueField := @@ -960,16 +960,16 @@ theorem exactConstantExtensionInfinityPlace_degree_eq_one_of_dvd finiteExtensionPlaceDegree S (ExactConstantExtension C N S) (.inr (exactConstantExtensionUpstairsInfinityPlace C S N hExact q hqOrigin)) = 1 := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact rw [exactConstantExtensionInfinityPlace_degree_eq_div_gcd C S N hExact q hqOrigin] rw [Nat.gcd_eq_right_iff_dvd.mpr hdiv] let P := exactConstantExtensionDownstairsInfinityPlace C S N q hqOrigin - letI : Finite P.1.ResidueField := + let : Finite P.1.ResidueField := actualInfinityPlaceResidueField_finite C N P let _ : DistribMulAction (RatFuncInfinityIntegralClosure C N) (RatFuncInfinityIntegralClosure C N) := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean index 56a9c07b0c..aafa2e644b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean @@ -32,8 +32,8 @@ private theorem finrank_eq_of_finite_ringEquiv [Field E] [Field F] [Algebra K E] [Algebra K F] [Finite E] [Finite F] (e : E ≃+* F) : Module.finrank K E = Module.finrank K F := by - letI : Fintype E := Fintype.ofFinite E - letI : Fintype F := Fintype.ofFinite F + let : Fintype E := Fintype.ofFinite E + let : Fintype F := Fintype.ofFinite F have hcard : Fintype.card E = Fintype.card F := Fintype.card_congr e.toEquiv rw [Module.card_eq_pow_finrank (K := K) (V := E), @@ -133,44 +133,44 @@ theorem exactConstantExtensionPresentedInfinityPlace_degree_baseChange finiteExtensionPlaceDegree S (ExactConstantExtension C N S) (.inr (exactConstantExtensionUpstairsInfinityPlace C S N hExact q.1 q.2)) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Fintype S := Fintype.ofFinite S - letI : Finite q.1.asIdeal.ResidueField := + let : Fintype S := Fintype.ofFinite S + let : Finite q.1.asIdeal.ResidueField := exactConstantExtensionInfinityTensorResidueField_finite C S N hExact q.1 q.2 - letI : q.1.asIdeal.IsMaximal := + let : q.1.asIdeal.IsMaximal := exactConstantExtensionInfinityTensorIdeal_isMaximal C S N hExact q.1 q.2 let QC := exactConstantExtensionPresentedInfinityPlaceEquiv @@ -181,19 +181,19 @@ theorem exactConstantExtensionPresentedInfinityPlace_degree_baseChange (ExactConstantExtension C N S) let BS := RatFuncInfinityIntegralClosure S (ExactConstantExtension C N S) - letI : Algebra C BC := + let : Algebra C BC := onePointInfinityClosureConstantAlgebra C (ExactConstantExtension C N S) - letI : Algebra S BS := + let : Algebra S BS := onePointInfinityClosureConstantAlgebra S (ExactConstantExtension C N S) - letI : Algebra C QC.1.ResidueField := by infer_instance - letI : Algebra S QS.1.ResidueField := by infer_instance + let : Algebra C QC.1.ResidueField := by infer_instance + let : Algebra S QS.1.ResidueField := by infer_instance let eC := exactConstantExtensionPresentedInfinityResidueFieldRingEquiv C S N hExact q - letI : Finite QC.1.ResidueField := + let : Finite QC.1.ResidueField := Finite.of_injective eC.symm eC.symm.injective - letI : Finite QS.1.ResidueField := + let : Finite QS.1.ResidueField := exactConstantExtensionUpstairsInfinityResidueField_finite C S N hExact q.1 q.2 have hC : Module.finrank C q.1.asIdeal.ResidueField = @@ -252,44 +252,44 @@ theorem exactConstantExtensionPresentedInfinityPlace_relativeInertiaDeg_eq_div_g (finiteExtensionPlaceDegree C N (.inr (exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2))) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S let P := exactConstantExtensionDownstairsInfinityPlace @@ -362,35 +362,35 @@ theorem exactConstantExtensionInfinityPlace_fiber_card_eq_gcd (finiteExtensionPlaceDegree C N (.inr (exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2))) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact let P := exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 @@ -530,35 +530,35 @@ theorem exactConstantExtensionPresentedInfinityPlaceFiber_natCard_eq_gcd (finiteExtensionPlaceDegree C N (.inr (exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2))) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact let P := exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean index 52b73d8ab3..2732adf781 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -261,7 +261,7 @@ private theorem ratFuncExtensionReciprocalPolynomialAlgebra_map algebraMap K[X] L p = algebraMap (RatFunc K) L (((reciprocalPolynomialRingHom K p : RatFuncInfinityIntegers K) : RatFunc K)) := by - letI : Algebra K[X] L := + let : Algebra K[X] L := ratFuncExtensionReciprocalPolynomialAlgebra K L change algebraMap (RatFuncInfinityIntegers K) L (reciprocalPolynomialRingHom K p) = _ @@ -278,9 +278,9 @@ private theorem exactConstantExtensionSReciprocalPolynomialAlgebra_eq : polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N = ratFuncExtensionReciprocalPolynomialAlgebra S (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact apply Algebra.algebra_ext intro p @@ -316,27 +316,27 @@ private theorem exactConstantExtensionCReciprocalPolynomialAlgebra_eq : exactConstantExtensionCReciprocalPolynomialAlgebra C S N = ratFuncExtensionReciprocalPolynomialAlgebra C (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra C[X] (ExactConstantExtension C N S) := + let : Algebra C[X] (ExactConstantExtension C N S) := exactConstantExtensionCReciprocalPolynomialAlgebra C S N - letI : Algebra S[X] (ExactConstantExtension C N S) := + let : Algebra S[X] (ExactConstantExtension C N S) := infinitySplittingExactSPolynomialAlgebra C S N - letI : SMul C[X] (ExactConstantExtension C N S) := + let : SMul C[X] (ExactConstantExtension C N S) := infinitySplittingExactCPolynomialSMul C S N - letI : SMul S[X] (ExactConstantExtension C N S) := + let : SMul S[X] (ExactConstantExtension C N S) := infinitySplittingExactSPolynomialSMul C S N - letI : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := + let : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := exactConstantExtensionReciprocalPolynomialTower C S N apply Algebra.algebra_ext intro p @@ -587,7 +587,7 @@ private theorem (algebraMap C[X] (S ⊗[C] integralClosure C[X] N) p) = algebraMap C[X] (integralClosure C[X] (ExactConstantExtension C N S)) p := by - letI : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := + let : IsScalarTower C[X] S[X] (ExactConstantExtension C N S) := exactConstantExtensionReciprocalPolynomialTower C S N let eS := finiteFieldReciprocalNormalizationAlgEquiv C S N let eC := exactConstantExtensionReciprocalIntegralClosureTowerEquiv C S N @@ -670,8 +670,8 @@ private noncomputable def C S N q] exact hq let p := q.asIdeal.under S[X] - letI : q.asIdeal.IsPrime := q.isPrime - letI : p.IsPrime := inferInstance + let : q.asIdeal.IsPrime := q.isPrime + let : p.IsPrime := inferInstance apply primeUnderReciprocalOrigin_eq_origin C S p calc p.under C[X] = q.asIdeal.under C[X] := Ideal.under_under q.asIdeal @@ -692,8 +692,8 @@ private noncomputable def invFun := fun P => by let oC := Ideal.span ({Polynomial.X} : Set C[X]) have hNX : algebraMap C[X] N (Polynomial.X : C[X]) ≠ 0 := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C have hNX' : @algebraMap C[X] N _ _ (ratFuncExtensionReciprocalPolynomialAlgebra C N) @@ -784,7 +784,7 @@ private theorem let e := exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv C S N let f := exactConstantExtensionOldToCReciprocalNormalizationMap C S N - letI : Algebra (integralClosure C[X] N) + let : Algebra (integralClosure C[X] N) (integralClosure C[X] (ExactConstantExtension C N S)) := f.toAlgebra ext x @@ -901,36 +901,36 @@ theorem exactConstantExtensionPresentedInfinityPlaceEquiv_under (exactConstantExtensionPresentedInfinityPlaceEquiv C S N hExact q) = exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S apply Subtype.ext rw [infinityPlaceUnder_asIdeal, exactConstantExtensionDownstairsInfinityPlace_asIdeal] let E := ExactConstantExtension C N S - letI : Algebra C[X] E := + let : Algebra C[X] E := ratFuncExtensionReciprocalPolynomialAlgebra C E let A₀ := integralClosure C[X] N let B₀ := RatFuncInfinityIntegralClosure C N @@ -946,18 +946,18 @@ theorem exactConstantExtensionPresentedInfinityPlaceEquiv_under exactConstantExtensionCReciprocalPolynomialAlgebra_eq C S N hExact let f₀ := exactConstantExtensionOldToCReciprocalNormalizationMap C S N let g := integralClosureAlgHomOfAlgebraEq C[X] E A₀ a b h f₀ - letI : Algebra A B := + let : Algebra A B := ratFuncInfinityReciprocalIntegralClosureAlgebra C E - letI : SMul A B := Algebra.toSMul - letI : Algebra A₀ B₀ := + let : SMul A B := Algebra.toSMul + let : Algebra A₀ B₀ := ratFuncInfinityReciprocalIntegralClosureAlgebra C N - letI : SMul A₀ B₀ := Algebra.toSMul - letI : Algebra A₀ A := + let : SMul A₀ B₀ := Algebra.toSMul + let : Algebra A₀ A := g.toAlgebra - letI : SMul A₀ A := Algebra.toSMul - letI : Algebra B₀ B := + let : SMul A₀ A := Algebra.toSMul + let : Algebra B₀ B := (infinityIntegralClosureMap C N E).toAlgebra - letI : SMul B₀ B := Algebra.toSMul + let : SMul B₀ B := Algebra.toSMul change (Ideal.map (algebraMap A B) P.1).under B₀ = Ideal.map @@ -976,13 +976,13 @@ theorem exactConstantExtensionPresentedInfinityPlaceEquiv_under exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes_under_old C S N q exact hTransport.trans hOld - letI : Algebra A₀ B := + let : Algebra A₀ B := RingHom.toAlgebra ((algebraMap B₀ B).comp (algebraMap A₀ B₀)) - letI : SMul A₀ B := Algebra.toSMul - letI : IsScalarTower A₀ B₀ B := + let : SMul A₀ B := Algebra.toSMul + let : IsScalarTower A₀ B₀ B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower A₀ A B := + let : IsScalarTower A₀ A B := IsScalarTower.of_algebraMap_eq fun x => by apply Subtype.ext rfl @@ -1109,9 +1109,9 @@ private theorem letI : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C N N S g = 1 := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C N N S have hker : g ∈ (exactConstantExtensionConstantQuotient C N N S hExact).ker := @@ -1201,40 +1201,40 @@ theorem exactConstantExtensionConstantQuotient_action_on_infinityNormalization : algebraMap S (RatFuncInfinityIntegralClosure C (ExactConstantExtension C N S)) (exactConstantExtensionConstantQuotient C N N S hExact g s) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact - letI : Algebra (RatFuncInfinityIntegers C) + let : Algebra (RatFuncInfinityIntegers C) (ExactConstantExtension C N S) := RingHom.toAlgebra ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) - letI : SMul (RatFuncInfinityIntegers C) + let : SMul (RatFuncInfinityIntegers C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers C) + let : Module (RatFuncInfinityIntegers C) (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) + let : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) (ExactConstantExtension C N S) := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra S (RatFuncInfinityIntegralClosure C + let : Algebra S (RatFuncInfinityIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionInfinityIntegralClosureConstantAlgebra C S N hExact - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[N] ExactConstantExtension C N S) (RatFuncInfinityIntegralClosure C @@ -1298,46 +1298,46 @@ theorem exactConstantExtensionInfinityPlace_ramificationIdx_eq_one exactConstantExtensionBaseTower C (RatFunc C) N S infinityPlaceRelativeRamificationIdx C N (ExactConstantExtension C N S) Q = 1 := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact - letI : Algebra (RatFuncInfinityIntegers C) + let : Algebra (RatFuncInfinityIntegers C) (ExactConstantExtension C N S) := RingHom.toAlgebra ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap (RatFuncInfinityIntegers C) (RatFunc C))) - letI : SMul (RatFuncInfinityIntegers C) + let : SMul (RatFuncInfinityIntegers C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFuncInfinityIntegers C) + let : Module (RatFuncInfinityIntegers C) (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) + let : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) (ExactConstantExtension C N S) := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra S (RatFuncInfinityIntegralClosure C + let : Algebra S (RatFuncInfinityIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionInfinityIntegralClosureConstantAlgebra C S N hExact - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[N] ExactConstantExtension C N S) (RatFuncInfinityIntegralClosure C @@ -1363,7 +1363,7 @@ theorem exactConstantExtensionInfinityPlace_ramificationIdx_eq_one (ExactConstantExtension C N S)) s) rw [exactConstantExtensionConstantQuotient_action_on_infinityNormalization C S N hExact] at hinertia - letI : Q.1.IsPrime := Q.2.1 + let : Q.1.IsPrime := Q.2.1 exact infinitySplitting_eq_of_algebraMap_sub_mem_prime S (RatFuncInfinityIntegralClosure C (ExactConstantExtension C N S)) Q.1 _ _ hinertia @@ -1372,7 +1372,7 @@ theorem exactConstantExtensionInfinityPlace_ramificationIdx_eq_one have hgOne := inertiaElement_eq_one g have hhOne := inertiaElement_eq_one h exact hgOne.trans hhOne.symm - letI := hsubsingleton + let := hsubsingleton exact Nat.card_unique end InfinityRamification diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean index 7f91f865e9..48dc6fff84 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean @@ -68,9 +68,9 @@ private theorem exactConstantExtensionConstantQuotient_eq_one_imp_eq_one letI : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C N N S g = 1 := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C N N S have hker : g ∈ (exactConstantExtensionConstantQuotient C N N S hExact).ker := @@ -168,37 +168,37 @@ theorem exactConstantExtensionFinitePlace_ramificationIdx_eq_one exactConstantExtensionBaseTower C (RatFunc C) N S finitePlaceRelativeRamificationIdx C N (ExactConstantExtension C N S) Q = 1 := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := + let : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact - letI : Algebra S (RatFuncFiniteIntegralClosure C + let : Algebra S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[N] ExactConstantExtension C N S) (RatFuncFiniteIntegralClosure C @@ -234,7 +234,7 @@ theorem exactConstantExtensionFinitePlace_ramificationIdx_eq_one have hgOne := inertiaElement_eq_one g have hhOne := inertiaElement_eq_one h exact hgOne.trans hhOne.symm - letI := hsubsingleton + let := hsubsingleton exact Nat.card_unique /-- A downstairs finite place of degree `d` has exactly @@ -292,43 +292,43 @@ theorem exactConstantExtensionFinitePlace_fiber_card_eq_gcd (finiteExtensionPlaceDegree C N (.inl (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := + let : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q @@ -541,30 +541,30 @@ theorem exactConstantExtensionPresentedFinitePlaceFiber_natCard_eq_gcd (finiteExtensionPlaceDegree C N (.inl (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := + let : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean index 457bf9b4fe..6298db84f7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean @@ -94,9 +94,9 @@ theorem exactConstantExtensionUpstairsFinitePlace_degree_eq_one_of_under_degree_ ratFuncExactConstantExtensionAlgebra C S N hExact finiteExtensionPlaceDegree S (ExactConstantExtension C N S) (.inl (exactConstantExtensionUpstairsFinitePlace C S N hExact q)) = 1 := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q have hPdiv : finiteExtensionPlaceDegree C N (.inl P) ∣ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean index 21f374b459..290397a43a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean @@ -168,7 +168,7 @@ noncomputable def planeCurveConstantAutHom : theorem planeCurveConstantAutHom_injective : Function.Injective (planeCurveConstantAutHom K E f hf hfE) := by - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE intro σ τ h @@ -229,12 +229,12 @@ theorem planeCurveFunctionFieldBaseChange_finrank : Module.finrank (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) = Module.finrank K E := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE - letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE calc Module.finrank (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) = @@ -283,7 +283,7 @@ noncomputable def planeCurveConstantAutOverBaseHom : theorem planeCurveConstantAutOverBaseHom_injective : letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE Function.Injective (planeCurveConstantAutOverBaseHom K E f hf hfE) := by - letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE intro σ τ h apply planeCurveConstantAutHom_injective K E f hf hfE apply AlgEquiv.ext @@ -300,17 +300,17 @@ theorem planeCurveFunctionFieldBaseChange_isGalois letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE IsGalois (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE - letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE - letI : Module.Finite (PlaneCurveFunctionField f) + let : Module.Finite (PlaneCurveFunctionField f) ((PlaneCurveFunctionField f) ⊗[K] E) := Module.Finite.base_change K (PlaneCurveFunctionField f) E - letI : Module.Finite (PlaneCurveFunctionField f) + let : Module.Finite (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := Module.Finite.equiv e apply IsGalois.of_card_aut_eq_finrank diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean index cd90ca4605..93f11c20b8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean @@ -71,14 +71,14 @@ theorem planeCurveFunctionFieldBaseChangeAlgHom_function planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE (planeCurveFunction f i) = planeCurveFunction (MvPolynomial.map (algebraMap K E) f) i := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := + let : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := planeCurveCoordinateRingBaseChange_isDomain K E f hfE - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE - letI : IsFractionRing + let : IsFractionRing (E ⊗[K] PlaneCurveCoordinateRing f) (E ⊗[K] PlaneCurveFunctionField f) := tensorFraction_isFractionRing K E (PlaneCurveCoordinateRing f) @@ -135,17 +135,17 @@ theorem planeCurveFunctionFieldBaseChange_ratFunc_commutes apply MvPolynomial.map_injective (algebraMap K E) (algebraMap K E).injective simpa using hz - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing fE) := + let : IsDomain (PlaneCurveCoordinateRing fE) := planeCurveCoordinateRing_isDomain hfE let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let hxE := firstCoordinate_transcendental hfE (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE - letI : Algebra K[X] E[X] := + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + let : Algebra K[X] E[X] := (Polynomial.mapRingHom (algebraMap K E)).toAlgebra change ∀ z : RatFunc K, planeCurveFunctionFieldBaseChangeAlgHom K E f hf hfE @@ -253,16 +253,16 @@ theorem planeCurveFunctionFieldBaseChangeRatFunc_isScalarTower IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE - letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx exact IsScalarTower.of_algebraMap_eq' rfl theorem planeCurveFunctionFieldBaseChangeCoefficientRatFunc_isScalarTower @@ -299,18 +299,18 @@ theorem planeCurveFunctionFieldBaseChangeCoefficientRatFunc_isScalarTower apply MvPolynomial.map_injective (algebraMap K E) (algebraMap K E).injective simpa using hz - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing fE) := + let : IsDomain (PlaneCurveCoordinateRing fE) := planeCurveCoordinateRing_isDomain hfE let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let hxE := firstCoordinate_transcendental hfE (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondE) - letI := ratFuncCoefficientAlgebra K E - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := planeCurveFirstCoordinateRatFuncAlgebra fE hxE - letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + let := ratFuncCoefficientAlgebra K E + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFirstCoordinateRatFuncAlgebra fE hxE + let := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx apply IsScalarTower.of_algebraMap_eq' ext z exact (planeCurveFunctionFieldBaseChange_ratFunc_commutes @@ -332,28 +332,28 @@ theorem finiteDimensional_planeCurveFunctionFieldBaseChange_over_ratFunc FiniteDimensional (RatFunc K) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE - letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx - letI : IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + let : IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := planeCurveFunctionFieldBaseChangeRatFunc_isScalarTower K E f hf hfE hpartialSecond - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE - letI : Module.Finite (PlaneCurveFunctionField f) + let : Module.Finite (PlaneCurveFunctionField f) ((PlaneCurveFunctionField f) ⊗[K] E) := Module.Finite.base_change K (PlaneCurveFunctionField f) E - letI : Module.Finite (PlaneCurveFunctionField f) + let : Module.Finite (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := Module.Finite.equiv e exact FiniteDimensional.trans (RatFunc K) (PlaneCurveFunctionField f) @@ -375,33 +375,33 @@ theorem separable_planeCurveFunctionFieldBaseChange_over_ratFunc Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE - letI := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx - letI : IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) + let := planeCurveFirstCoordinateRatFuncAlgebra f hx + let := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE + let := planeCurveFunctionFieldBaseChangeRatFuncAlgebra K E f hf hfE hx + let : IsScalarTower (RatFunc K) (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := planeCurveFunctionFieldBaseChangeRatFunc_isScalarTower K E f hf hfE hpartialSecond - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let e := planeCurveFunctionFieldBaseChangeLinearEquiv K E f hf hfE - letI : Module.Finite (PlaneCurveFunctionField f) + let : Module.Finite (PlaneCurveFunctionField f) ((PlaneCurveFunctionField f) ⊗[K] E) := Module.Finite.base_change K (PlaneCurveFunctionField f) E - letI : Module.Finite (PlaneCurveFunctionField f) + let : Module.Finite (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := Module.Finite.equiv e - letI : IsGalois (PlaneCurveFunctionField f) + let : IsGalois (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := planeCurveFunctionFieldBaseChange_isGalois K E f hf hfE exact Algebra.IsSeparable.trans (RatFunc K) (PlaneCurveFunctionField f) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 971b05d4cf..73610850b8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -184,13 +184,13 @@ theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L ((differentIdeal A B : Ideal B) : FractionalIdeal B⁰ L) = 0 := by by_contra hne exact hq (by - rw [Set.mem_union, Set.mem_setOf_eq, Set.mem_setOf_eq] + rw [Set.mem_union, Set.mem_ofPred_eq, Set.mem_ofPred_eq] exact Or.inl hne) have hqy : FractionalIdeal.count L q (FractionalIdeal.spanSingleton B⁰ y) = 0 := by by_contra hne exact hq (by - rw [Set.mem_union, Set.mem_setOf_eq, Set.mem_setOf_eq] + rw [Set.mem_union, Set.mem_ofPred_eq, Set.mem_ofPred_eq] exact Or.inr hne) apply hbad rw [← FractionalIdeal.count_coeIdeal_eq_multiplicity diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean index 2df0c4ba11..e847dcfbd8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean @@ -40,7 +40,7 @@ private theorem linearDisjoint_of_inf_eq_bot_of_sup_eq_top (hsup : A ⊔ B = ⊤) (hinf : A ⊓ B = ⊥) : A.LinearDisjoint B := by let ι := Module.Free.ChooseBasisIndex F A let a : Module.Basis ι F A := Module.Free.chooseBasis F A - letI : Fintype ι := Fintype.ofFinite ι + let : Fintype ι := Fintype.ofFinite ι have hAspan : A.toSubalgebra.toSubmodule = Submodule.span F (Set.range (A.val ∘ a)) := by calc @@ -68,13 +68,13 @@ private theorem linearDisjoint_of_inf_eq_bot_of_sup_eq_top simpa only [IntermediateField.coe_toSubalgebra] using hAdjoin rw [← A.toSubalgebra.adjoin_eq_span_of_eq_span B hAspan, hAdjoin'] rfl - letI : FiniteDimensional B E := by + let : FiniteDimensional B E := by have hfinite : Module.Finite B (Submodule.span B (Set.range (A.val ∘ a))) := Module.Finite.span_of_finite B (Set.toFinite _) rw [hspan] at hfinite exact Module.Finite.equiv (Submodule.topEquiv (R := B) (M := E)) - letI : IsGalois B E := IsGalois.sup_right A B hsup + let : IsGalois B E := IsGalois.sup_right A B hsup have hfinrank : Module.finrank B E = Module.finrank F A := by rw [← IsGalois.card_aut_eq_finrank, ← IsGalois.card_aut_eq_finrank] exact Nat.card_congr <| Equiv.ofBijective @@ -112,9 +112,9 @@ theorem linearDisjoint_of_inf_eq_bot_of_finite_galois_left rw [← IntermediateField.lift_inj, IntermediateField.lift_bot, IntermediateField.lift_inf, IntermediateField.lift_restrict le_sup_left, IntermediateField.lift_restrict le_sup_right, hinf] - let eA : A ≃ₐ[F] A' := IntermediateField.restrict_algEquiv .. - letI : FiniteDimensional F A' := Module.Finite.equiv eA.toLinearEquiv - haveI : IsGalois F A' := IsGalois.of_algEquiv eA + let eA : A ≃ₐ[F] A' := IntermediateField.restrictAlgEquiv .. + let : FiniteDimensional F A' := Module.Finite.equiv eA.toLinearEquiv + have : IsGalois F A' := IsGalois.of_algEquiv eA exact linearDisjoint_of_inf_eq_bot_of_sup_eq_top A' B' hsup hinf' end LinearDisjoint @@ -136,8 +136,8 @@ theorem exactConstantExtensionImages_linearDisjoint (IsScalarTower.toAlgHom C N Ω).fieldRange := by let Ω := AlgebraicClosure N let fS : S →ₐ[C] Ω := IsAlgClosed.lift - letI : Algebra S Ω := fS.toAlgebra - letI : IsScalarTower C S Ω := IsScalarTower.of_algebraMap_eq' (by + let : Algebra S Ω := fS.toAlgebra + let : IsScalarTower C S Ω := IsScalarTower.of_algebraMap_eq' (by ext c exact (fS.commutes c).symm) let A := fS.fieldRange @@ -166,8 +166,8 @@ theorem exactConstantExtensionImages_linearDisjoint rw [← hn, ← hc] rfl let eA : S ≃ₐ[C] A := AlgEquiv.ofInjectiveField fS - letI : FiniteDimensional C A := Module.Finite.equiv eA.toLinearEquiv - haveI : IsGalois C A := IsGalois.of_algEquiv eA + let : FiniteDimensional C A := Module.Finite.equiv eA.toLinearEquiv + have : IsGalois C A := IsGalois.of_algEquiv eA exact linearDisjoint_of_inf_eq_bot_of_finite_galois_left A B hInf /-- If `C` is the exact constant field of `N`, adjoining any finite Galois @@ -217,7 +217,7 @@ field. -/ theorem exactConstantExtension_finrank : letI := exactConstantExtensionAlgebra C N S Module.finrank N (S ⊗[C] N) = Module.finrank C S := by - letI := exactConstantExtensionAlgebra C N S + let := exactConstantExtensionAlgebra C N S calc Module.finrank N (S ⊗[C] N) = Module.finrank N (N ⊗[C] S) := (exactConstantExtensionLinearEquiv C N S).finrank_eq.symm diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean index 5deec59623..8a24b51f86 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean @@ -62,8 +62,8 @@ theorem exactConstantExtensionBaseTower : letI := exactConstantExtensionBaseAlgebra C L N S letI := exactConstantExtensionAlgebra C N S IsScalarTower L N (ExactConstantExtension C N S) := by - letI := exactConstantExtensionBaseAlgebra C L N S - letI := exactConstantExtensionAlgebra C N S + let := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionAlgebra C N S exact IsScalarTower.of_algebraMap_eq' rfl end Algebra @@ -165,7 +165,7 @@ theorem exactConstantExtension_constant_function_commute Commute (exactConstantExtensionConstantAutHom C L N S σ) (exactConstantExtensionFunctionAutHom C L N S g) := by - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionBaseAlgebra C L N S rw [Commute] apply AlgEquiv.ext intro z @@ -194,7 +194,7 @@ noncomputable def exactConstantExtensionCombinedAutHom : theorem exactConstantExtensionCombinedAutHom_injective : letI := exactConstantExtensionBaseAlgebra C L N S Function.Injective (exactConstantExtensionCombinedAutHom C L N S) := by - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionBaseAlgebra C L N S intro p q hpq apply Prod.ext · ext s @@ -245,9 +245,9 @@ theorem exactConstantExtension_finrank_over_base : letI := exactConstantExtensionBaseAlgebra C L N S Module.finrank L (ExactConstantExtension C N S) = Module.finrank L N * Module.finrank C S := by - letI := exactConstantExtensionBaseAlgebra C L N S - letI := exactConstantExtensionAlgebra C N S - letI := exactConstantExtensionBaseTower C L N S + let := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionAlgebra C N S + let := exactConstantExtensionBaseTower C L N S change Module.finrank L (S ⊗[C] N) = Module.finrank L N * Module.finrank C S rw [← Module.finrank_mul_finrank L N (ExactConstantExtension C N S), @@ -259,14 +259,14 @@ theorem exactConstantExtension_isGalois letI := exactConstantExtensionField C N S hExact letI := exactConstantExtensionBaseAlgebra C L N S IsGalois L (ExactConstantExtension C N S) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI := exactConstantExtensionAlgebra C N S - letI := exactConstantExtensionBaseTower C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionAlgebra C N S + let := exactConstantExtensionBaseTower C L N S let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite L (ExactConstantExtension C N S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e + let : Module.Finite L (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) apply IsGalois.of_card_aut_eq_finrank apply Nat.le_antisymm diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean index c3eb1e9e42..48cb6bad7b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean @@ -47,32 +47,32 @@ theorem exactConstantExtension_algebraicClosure_eq_bot Algebra.TensorProduct.leftAlgebra algebraicClosure S (ExactConstantExtension C N S) = (⊥ : IntermediateField S (ExactConstantExtension C N S)) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra C (ExactConstantExtension C N S) := + let : Algebra C (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C C N S - letI : SMul C (ExactConstantExtension C N S) := Algebra.toSMul - letI : Algebra N (ExactConstantExtension C N S) := + let : SMul C (ExactConstantExtension C N S) := Algebra.toSMul + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - haveI : IsScalarTower C N (ExactConstantExtension C N S) := by + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + have : IsScalarTower C N (ExactConstantExtension C N S) := by exact exactConstantExtensionBaseTower C C N S - letI : Algebra S (ExactConstantExtension C N S) := + let : Algebra S (ExactConstantExtension C N S) := Algebra.TensorProduct.leftAlgebra - letI : SMul S (ExactConstantExtension C N S) := Algebra.toSMul + let : SMul S (ExactConstantExtension C N S) := Algebra.toSMul have hSN : algebraMap C (ExactConstantExtension C N S) = (algebraMap S (ExactConstantExtension C N S)).comp (algebraMap C S) := by ext c change (1 : S) ⊗ₜ algebraMap C N c = algebraMap C S c ⊗ₜ (1 : N) exact (Algebra.TensorProduct.tmul_one_eq_one_tmul c).symm - letI : IsScalarTower C S (ExactConstantExtension C N S) := + let : IsScalarTower C S (ExactConstantExtension C N S) := IsScalarTower.of_algebraMap_eq' hSN let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - haveI : IsGalois N (ExactConstantExtension C N S) := by + have : IsGalois N (ExactConstantExtension C N S) := by exact exactConstantExtension_isGalois C N N S hExact apply eq_bot_iff.mpr intro z hz @@ -80,13 +80,13 @@ theorem exactConstantExtension_algebraicClosure_eq_bot have hzInt : IsIntegral C z := isIntegral_trans z hzS.isIntegral let K : IntermediateField C (ExactConstantExtension C N S) := IntermediateField.adjoin C {z} - letI : FiniteDimensional C K := by + let : FiniteDimensional C K := by dsimp [K] exact IntermediateField.adjoin.finiteDimensional hzInt - letI : Finite K := Module.finite_of_finite C - letI : Fintype K := Fintype.ofFinite K - letI : Algebra.IsAlgebraic C K := Algebra.IsAlgebraic.of_finite C K - haveI : IsGalois C K := inferInstance + let : Finite K := Module.finite_of_finite C + let : Fintype K := Fintype.ofFinite K + let : Algebra.IsAlgebraic C K := Algebra.IsAlgebraic.of_finite C K + have : IsGalois C K := inferInstance let iN : N →ₐ[C] ExactConstantExtension C N S := IsScalarTower.toAlgHom C N (ExactConstantExtension C N S) let N' : IntermediateField C (ExactConstantExtension C N S) := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean index 6fe0e3570a..e62e1537d3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean @@ -79,7 +79,7 @@ private theorem exactConstantDifferentCoefficientCanonicalFractionRing (R : Type*) [CommRing R] [IsDomain R] : letI := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R IsFractionRing R (FractionRing R) := by - letI := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R + let := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra R infer_instance private theorem integralClosureAlgEquivRatFuncFiniteOfEq_coe @@ -205,26 +205,26 @@ theorem exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one q.asIdeal.ramificationIdx R2 = 1 := by dsimp only let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : Algebra S[X] E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : Algebra S[X] E := constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] E := Algebra.toSMul - letI : Module S[X] E := Algebra.toModule - letI : Algebra S[X] (RatFunc S) := inferInstance - letI : IsFractionRing S[X] (RatFunc S) := inferInstance - letI : IsScalarTower S[X] (RatFunc S) E := + let : SMul S[X] E := Algebra.toSMul + let : Module S[X] E := Algebra.toModule + let : Algebra S[X] (RatFunc S) := inferInstance + let : IsFractionRing S[X] (RatFunc S) := inferInstance + let : IsScalarTower S[X] (RatFunc S) E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -233,55 +233,55 @@ theorem exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact let R2 := RatFuncFiniteIntegralClosure C N let B := integralClosure S[X] E let CC := RatFuncFiniteIntegralClosure C E let CS := RatFuncFiniteIntegralClosure S E - letI : Algebra C[X] (RatFunc C) := inferInstance - letI : IsFractionRing C[X] (RatFunc C) := inferInstance - letI : IsScalarTower C[X] (RatFunc C) N := + let : Algebra C[X] (RatFunc C) := inferInstance + let : IsFractionRing C[X] (RatFunc C) := inferInstance + let : IsScalarTower C[X] (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower C C[X] N := + let : IsScalarTower C C[X] N := IsScalarTower.of_algebraMap_eq' rfl - letI : IsDedekindDomain R2 := + let : IsDedekindDomain R2 := IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R2 - letI : Module.IsTorsionFree C[X] N := by + let : Module.IsTorsionFree C[X] N := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective ((algebraMap (RatFunc C) N).comp (algebraMap C[X] (RatFunc C))) exact (algebraMap (RatFunc C) N).injective.comp (RatFunc.algebraMap_injective C) - letI : Module.IsTorsionFree C[X] R2 := + let : Module.IsTorsionFree C[X] R2 := IsIntegralClosure.isTorsionFree C[X] N - letI : Algebra C R2 := + let : Algebra C R2 := RingHom.toAlgebra ((algebraMap C[X] R2).comp (algebraMap C C[X])) - letI : SMul C R2 := Algebra.toSMul - letI : Module C R2 := Algebra.toModule - letI : IsDedekindDomain B := + let : SMul C R2 := Algebra.toSMul + let : Module C R2 := Algebra.toModule + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E B - letI : Algebra R2 B := + let : Algebra R2 B := exactConstantExtensionFiniteNormalizationAlgebra C S N - letI : SMul R2 B := Algebra.toSMul - letI : Module R2 B := Algebra.toModule - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : SMul N E := Algebra.toSMul - letI : Module N E := Algebra.toModule - letI : IsScalarTower (RatFunc C) N E := + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra C[X] E := + let : Algebra C[X] E := RingHom.toAlgebra ((algebraMap (RatFunc C) E).comp (algebraMap C[X] (RatFunc C))) - letI : SMul C[X] E := Algebra.toSMul - letI : Module C[X] E := Algebra.toModule - letI : IsScalarTower C[X] (RatFunc C) E := + let : SMul C[X] E := Algebra.toSMul + let : Module C[X] E := Algebra.toModule + let : IsScalarTower C[X] (RatFunc C) E := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra C[X] S[X] := Polynomial.algebra C S - letI : IsScalarTower C[X] S[X] E := + let : Algebra C[X] S[X] := Polynomial.algebra C S + let : IsScalarTower C[X] S[X] E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -292,14 +292,14 @@ theorem exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one rw [rationalBase_algebraMap_eq C S N hExact] apply congrArg (algebraMap (RatFunc S) E) exact ratFuncCoefficientAlgHom_algebraMap C S p) - letI : Algebra R2 CC := (finiteIntegralClosureMap C N E).toAlgebra - letI : SMul R2 CC := Algebra.toSMul - letI : Module R2 CC := Algebra.toModule - letI : IsDedekindDomain CC := + let : Algebra R2 CC := (finiteIntegralClosureMap C N E).toAlgebra + let : SMul R2 CC := Algebra.toSMul + let : Module R2 CC := Algebra.toModule + let : IsDedekindDomain CC := IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) E CC - letI : Algebra S CC := + let : Algebra S CC := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : Algebra S CS := + let : Algebra S CS := RingHom.toAlgebra ((algebraMap S[X] CS).comp (algebraMap S S[X])) let eS := integralClosureAlgEquivRatFuncFiniteOfAlgebraMap @@ -345,10 +345,10 @@ theorem exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one apply Subtype.ext apply (algebraMap N E).injective exact congrArg Subtype.val hxy - letI : Module.IsTorsionFree R2 CC := by + let : Module.IsTorsionFree R2 CC := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact hTargetInjective - letI : Module.IsTorsionFree R2 B := by + let : Module.IsTorsionFree R2 B := by rw [Module.isTorsionFree_iff_algebraMap_injective] intro x y hxy apply hTargetInjective @@ -371,10 +371,10 @@ theorem exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one (exactConstantExtensionCompatibleBaseFinitePlace_baseChange C S N hExact q).symm let q' := heightOneSpectrumEquivOfAlgEquiv e q - letI : q.asIdeal.LiesOver P.asIdeal := ⟨by + let : q.asIdeal.LiesOver P.asIdeal := ⟨by change P.asIdeal = q.asIdeal.comap (algebraMap R2 B) rfl⟩ - letI : q'.asIdeal.LiesOver P.asIdeal := ⟨by + let : q'.asIdeal.LiesOver P.asIdeal := ⟨by change P.asIdeal = q'.asIdeal.comap (algebraMap R2 CC) rw [show q' = Q by exact hQ] exact congrArg HeightOneSpectrum.asIdeal @@ -412,103 +412,103 @@ theorem exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one let A := RatFuncInfinityIntegers C let R1 := RatFuncInfinityIntegers S let R2 := RatFuncInfinityIntegralClosure C N - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : SMul N E := Algebra.toSMul - letI : Module N E := Algebra.toModule - letI : IsScalarTower (RatFunc C) N E := + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : DistribMulAction (RatFunc S) E := Module.toDistribMulAction - letI : MulAction (RatFunc S) E := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc S) E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : DistribMulAction (RatFunc S) E := Module.toDistribMulAction + let : MulAction (RatFunc S) E := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact let B := RatFuncInfinityIntegralClosure S E let CC := RatFuncInfinityIntegralClosure C E - letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring A - letI : SMul A (RatFunc C) := Algebra.toSMul - letI : Module A (RatFunc C) := Algebra.toModule - letI : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 - letI : SMul R1 (RatFunc S) := Algebra.toSMul - letI : Module R1 (RatFunc S) := Algebra.toModule - letI : IsFractionRing A (RatFunc C) := + let : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + let : SMul A (RatFunc C) := Algebra.toSMul + let : Module A (RatFunc C) := Algebra.toModule + let : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 + let : SMul R1 (RatFunc S) := Algebra.toSMul + let : Module R1 (RatFunc S) := Algebra.toModule + let : IsFractionRing A (RatFunc C) := IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) - letI : IsFractionRing R1 (RatFunc S) := + let : IsFractionRing R1 (RatFunc S) := IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) - letI : Algebra A N := Algebra.ofSubsemiring A - letI : SMul A N := Algebra.toSMul - letI : Module A N := Algebra.toModule - letI : IsScalarTower A (RatFunc C) N := + let : Algebra A N := Algebra.ofSubsemiring A + let : SMul A N := Algebra.toSMul + let : Module A N := Algebra.toModule + let : IsScalarTower A (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra A E := Algebra.ofSubsemiring A - letI : SMul A E := Algebra.toSMul - letI : Module A E := Algebra.toModule - letI : Module.IsTorsionFree A E := by + let : Algebra A E := Algebra.ofSubsemiring A + let : SMul A E := Algebra.toSMul + let : Module A E := Algebra.toModule + let : Module.IsTorsionFree A E := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact (algebraMap (RatFunc C) E).injective.comp (IsFractionRing.injective A (RatFunc C)) - letI : IsScalarTower A (RatFunc C) E := + let : IsScalarTower A (RatFunc C) E := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra R1 E := Algebra.ofSubsemiring R1 - letI : SMul R1 E := Algebra.toSMul - letI : Module R1 E := Algebra.toModule - letI : Algebra A R1 := + let : Algebra R1 E := Algebra.ofSubsemiring R1 + let : SMul R1 E := Algebra.toSMul + let : Module R1 E := Algebra.toModule + let : Algebra A R1 := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : SMul A R1 := Algebra.toSMul - letI : Module A R1 := Algebra.toModule - letI : Module.Finite A R1 := + let : SMul A R1 := Algebra.toSMul + let : Module A R1 := Algebra.toModule + let : Module.Finite A R1 := ratFuncInfinityIntegers_coefficient_moduleFinite C S - letI : Algebra.IsIntegral A R1 := by infer_instance - letI : IsScalarTower A R1 E := + let : Algebra.IsIntegral A R1 := by infer_instance + let : IsScalarTower A R1 E := IsScalarTower.of_algebraMap_eq' (by ext z change algebraMap (RatFunc C) E z.1 = algebraMap (RatFunc S) E (ratFuncCoefficientAlgHom C S z.1) exact DFunLike.congr_fun (rationalBase_algebraMap_eq C S N hExact) z.1) - letI : IsDedekindDomain R2 := + let : IsDedekindDomain R2 := integralClosure.isDedekindDomain A (RatFunc C) N - letI : IsDedekindDomain B := + let : IsDedekindDomain B := integralClosure.isDedekindDomain R1 (RatFunc S) E - letI : IsDedekindDomain CC := + let : IsDedekindDomain CC := integralClosure.isDedekindDomain A (RatFunc C) E - letI : Algebra A R2 := inferInstance - letI : SMul A R2 := Algebra.toSMul - letI : Module A R2 := Algebra.toModule - letI : Module.IsTorsionFree A R2 := + let : Algebra A R2 := inferInstance + let : SMul A R2 := Algebra.toSMul + let : Module A R2 := Algebra.toModule + let : Module.IsTorsionFree A R2 := IsIntegralClosure.isTorsionFree A N - letI : Algebra A CC := inferInstance - letI : SMul A CC := Algebra.toSMul - letI : Module A CC := Algebra.toModule - letI : Module.IsTorsionFree A CC := + let : Algebra A CC := inferInstance + let : SMul A CC := Algebra.toSMul + let : Module A CC := Algebra.toModule + let : Module.IsTorsionFree A CC := IsIntegralClosure.isTorsionFree A E - letI : Module.IsTorsionFree R1 E := by + let : Module.IsTorsionFree R1 E := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact (algebraMap (RatFunc S) E).injective.comp (IsFractionRing.injective R1 (RatFunc S)) - letI : Module.IsTorsionFree R1 B := + let : Module.IsTorsionFree R1 B := IsIntegralClosure.isTorsionFree R1 E - letI : Algebra R2 B := + let : Algebra R2 B := exactConstantExtensionInfinityNormalizationAlgebra C S N hExact - letI : SMul R2 B := Algebra.toSMul - letI : Module R2 B := Algebra.toModule - letI : Algebra R2 CC := (infinityIntegralClosureMap C N E).toAlgebra - letI : SMul R2 CC := Algebra.toSMul - letI : Module R2 CC := Algebra.toModule - letI : IsScalarTower A R2 CC := + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : Algebra R2 CC := (infinityIntegralClosureMap C N E).toAlgebra + let : SMul R2 CC := Algebra.toSMul + let : Module R2 CC := Algebra.toModule + let : IsScalarTower A R2 CC := IsScalarTower.of_algebraMap_eq' (by ext z rfl) @@ -531,10 +531,10 @@ theorem exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one apply Subtype.ext apply (algebraMap N E).injective exact congrArg Subtype.val hxy - letI : Module.IsTorsionFree R2 CC := by + let : Module.IsTorsionFree R2 CC := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact hTargetInjective - letI : Module.IsTorsionFree R2 B := by + let : Module.IsTorsionFree R2 B := by rw [Module.isTorsionFree_iff_algebraMap_injective] intro x y hxy apply hTargetInjective @@ -591,11 +591,11 @@ theorem exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one exact Ideal.comap_of_equiv eRing.symm let P := infinityPlaceUnder C N E Q let pH := primeOverHeightOne (ratFuncInfinityPlace C) P - letI : qH.asIdeal.LiesOver pH.asIdeal := ⟨by + let : qH.asIdeal.LiesOver pH.asIdeal := ⟨by dsimp only [qH, pH, primeOverHeightOne] change P.1 = Q.1.comap (algebraMap R2 CC) exact infinityPlaceUnder_asIdeal C N E Q⟩ - letI : (heightOneSpectrumEquivOfAlgEquiv e qH).asIdeal.LiesOver + let : (heightOneSpectrumEquivOfAlgEquiv e qH).asIdeal.LiesOver pH.asIdeal := ⟨by rw [hCompat] dsimp only [wH, pH, primeOverHeightOne] @@ -715,45 +715,45 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq model10 model11 model12 model13 model14 model15 cases q with | inl q => - letI : Algebra S[X] (RatFunc S) := + let : Algebra S[X] (RatFunc S) := inferInstance - letI : IsFractionRing S[X] (RatFunc S) := + let : IsFractionRing S[X] (RatFunc S) := inferInstance - letI : Module.IsTorsionFree S[X] E := + let : Module.IsTorsionFree S[X] E := Module.IsTorsionFree.trans_faithfulSMul S[X] (RatFunc S) E - letI : IsDedekindDomain (integralClosure S[X] E) := + let : IsDedekindDomain (integralClosure S[X] E) := IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E (integralClosure S[X] E) - letI : Module.IsTorsionFree S[X] (integralClosure S[X] E) := + let : Module.IsTorsionFree S[X] (integralClosure S[X] E) := IsIntegralClosure.isTorsionFree S[X] E let R2 := RatFuncFiniteIntegralClosure C N let B := integralClosure S[X] E - letI : Algebra C[X] (RatFunc C) := inferInstance - letI : IsFractionRing C[X] (RatFunc C) := inferInstance - letI : IsScalarTower C[X] (RatFunc C) N := + let : Algebra C[X] (RatFunc C) := inferInstance + let : IsFractionRing C[X] (RatFunc C) := inferInstance + let : IsScalarTower C[X] (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : IsDedekindDomain R2 := + let : IsDedekindDomain R2 := IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R2 - letI : Module.IsTorsionFree C[X] N := by + let : Module.IsTorsionFree C[X] N := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective ((algebraMap (RatFunc C) N).comp (algebraMap C[X] (RatFunc C))) exact (algebraMap (RatFunc C) N).injective.comp (RatFunc.algebraMap_injective C) - letI : Module.IsTorsionFree C[X] R2 := + let : Module.IsTorsionFree C[X] R2 := IsIntegralClosure.isTorsionFree C[X] N - letI : Algebra R2 B := + let : Algebra R2 B := exactConstantExtensionFiniteNormalizationAlgebra C S N - letI : SMul R2 B := Algebra.toSMul - letI : Module R2 B := Algebra.toModule - letI : SMul C R2 := Algebra.toSMul - letI : Module C R2 := Algebra.toModule - letI : Module.Free C R2 := Module.Free.of_divisionRing C R2 - letI : Module.Flat C R2 := Module.Flat.of_free + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : SMul C R2 := Algebra.toSMul + let : Module C R2 := Algebra.toModule + let : Module.Free C R2 := Module.Free.of_divisionRing C R2 + let : Module.Flat C R2 := Module.Flat.of_free let eNorm : S ⊗[C] R2 ≃+* B := finiteFieldConstantExtensionIntegralClosureRingEquiv C S N - letI : Module.IsTorsionFree R2 B := by + let : Module.IsTorsionFree R2 B := by rw [Module.isTorsionFree_iff_algebraMap_injective] change Function.Injective (eNorm.toRingHom.comp @@ -792,7 +792,7 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq (differentIdeal S[X] (integralClosure S[X] E))] rw [exactConstantExtension_finiteDifferent_eq_map C S N hExact] let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q - letI : q.asIdeal.LiesOver P.asIdeal := ⟨by + let : q.asIdeal.LiesOver P.asIdeal := ⟨by change P.asIdeal = q.asIdeal.comap (algebraMap R2 B) rfl⟩ have hDifferentBase : @@ -822,69 +822,69 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq let R1 := RatFuncInfinityIntegers S let R2 := RatFuncInfinityIntegralClosure C N let B := RatFuncInfinityIntegralClosure S E - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : SMul N E := Algebra.toSMul - letI : Module N E := Algebra.toModule - letI : IsScalarTower (RatFunc C) N E := + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra A (RatFunc C) := Algebra.ofSubsemiring A - letI : SMul A (RatFunc C) := Algebra.toSMul - letI : Module A (RatFunc C) := Algebra.toModule - letI : IsFractionRing A (RatFunc C) := + let : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + let : SMul A (RatFunc C) := Algebra.toSMul + let : Module A (RatFunc C) := Algebra.toModule + let : IsFractionRing A (RatFunc C) := IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) - letI : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 - letI : SMul R1 (RatFunc S) := Algebra.toSMul - letI : Module R1 (RatFunc S) := Algebra.toModule - letI : IsFractionRing R1 (RatFunc S) := + let : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 + let : SMul R1 (RatFunc S) := Algebra.toSMul + let : Module R1 (RatFunc S) := Algebra.toModule + let : IsFractionRing R1 (RatFunc S) := IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) - letI : Algebra A N := Algebra.ofSubsemiring A - letI : SMul A N := Algebra.toSMul - letI : Module A N := Algebra.toModule - letI : IsScalarTower A (RatFunc C) N := + let : Algebra A N := Algebra.ofSubsemiring A + let : SMul A N := Algebra.toSMul + let : Module A N := Algebra.toModule + let : IsScalarTower A (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra R1 E := Algebra.ofSubsemiring R1 - letI : SMul R1 E := Algebra.toSMul - letI : Module R1 E := Algebra.toModule - letI : IsScalarTower R1 (RatFunc S) E := + let : Algebra R1 E := Algebra.ofSubsemiring R1 + let : SMul R1 E := Algebra.toSMul + let : Module R1 E := Algebra.toModule + let : IsScalarTower R1 (RatFunc S) E := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra A R1 := + let : Algebra A R1 := RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - letI : SMul A R1 := Algebra.toSMul - letI : Module A R1 := Algebra.toModule - letI : IsDedekindDomain R2 := + let : SMul A R1 := Algebra.toSMul + let : Module A R1 := Algebra.toModule + let : IsDedekindDomain R2 := integralClosure.isDedekindDomain A (RatFunc C) N - letI : IsDedekindDomain B := + let : IsDedekindDomain B := integralClosure.isDedekindDomain R1 (RatFunc S) E - letI : Algebra A R2 := inferInstance - letI : SMul A R2 := Algebra.toSMul - letI : Module A R2 := Algebra.toModule - letI : Algebra R2 N := Algebra.ofSubsemiring R2 - letI : SMul R2 N := Algebra.toSMul - letI : Module R2 N := Algebra.toModule - letI : IsScalarTower A R2 N := + let : Algebra A R2 := inferInstance + let : SMul A R2 := Algebra.toSMul + let : Module A R2 := Algebra.toModule + let : Algebra R2 N := Algebra.ofSubsemiring R2 + let : SMul R2 N := Algebra.toSMul + let : Module R2 N := Algebra.toModule + let : IsScalarTower A R2 N := IsScalarTower.of_algebraMap_eq' (by ext z; rfl) - letI : IsIntegralClosure R2 A N := + let : IsIntegralClosure R2 A N := integralClosure.isIntegralClosure A N - letI : Module.Finite A R2 := + let : Module.Finite A R2 := IsIntegralClosure.finite A (RatFunc C) N R2 - letI : Module.IsTorsionFree A R2 := + let : Module.IsTorsionFree A R2 := IsIntegralClosure.isTorsionFree A N - letI : Module.IsTorsionFree R1 E := by + let : Module.IsTorsionFree R1 E := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact (algebraMap (RatFunc S) E).injective.comp (IsFractionRing.injective R1 (RatFunc S)) - letI : Module.IsTorsionFree R1 B := + let : Module.IsTorsionFree R1 B := IsIntegralClosure.isTorsionFree R1 E - letI : Algebra R2 B := + let : Algebra R2 B := exactConstantExtensionInfinityNormalizationAlgebra C S N hExact - letI : SMul R2 B := Algebra.toSMul - letI : Module R2 B := Algebra.toModule - letI : Module.IsTorsionFree R2 B := by + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : Module.IsTorsionFree R2 B := by rw [Module.isTorsionFree_iff_algebraMap_injective] exact normalization_map_injective Subtype.val Subtype.val Subtype.val_injective (exactConstantExtensionInfinityNormalizationAlgebra_coe C S N hExact) - letI : IsFractionRing R2 N := + let : IsFractionRing R2 N := IsIntegralClosure.isFractionRing_of_finite_extension A (RatFunc C) N R2 rw [exactConstantExtension_infinityDifferent_eq_map C S N hExact] @@ -893,7 +893,7 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq let wH := primeOverHeightOne (ratFuncInfinityPlace S) w let P := exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 let pH := primeOverHeightOne (ratFuncInfinityPlace C) P - letI : wH.asIdeal.LiesOver pH.asIdeal := ⟨by + let : wH.asIdeal.LiesOver pH.asIdeal := ⟨by change P.1 = w.1.comap (algebraMap R2 B) exact (exactConstantExtensionUpstairsInfinityPlace_under C S N hExact q).symm⟩ @@ -933,23 +933,23 @@ theorem exactConstantExtension_genus_eq FunctionField.genus S E = FunctionField.genus C N := by dsimp only let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : FiniteDimensional (RatFunc S) E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact let extendedConstantAlgebra : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp @@ -979,12 +979,12 @@ theorem exactConstantExtension_genus_eq (polynomialTensorCancelEvaluationPoint C S N) (Polynomial.C s) simp - letI : Algebra S E := extendedConstantAlgebra - letI : SMul S E := Algebra.toSMul - letI : Algebra S[X] E := + let : Algebra S E := extendedConstantAlgebra + let : SMul S E := Algebra.toSMul + let : Algebra S[X] E := constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] E := Algebra.toSMul - letI : IsScalarTower S[X] (RatFunc S) E := + let : SMul S[X] E := Algebra.toSMul + let : IsScalarTower S[X] (RatFunc S) E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -993,15 +993,15 @@ theorem exactConstantExtension_genus_eq (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : IsScalarTower S S[X] E := + let : IsScalarTower S S[X] E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro s exact (hconstantMap s).trans (htensorPolynomialMap s)) - letI : FunctionField.IsFullConstantField C N := + let : FunctionField.IsFullConstantField C N := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C N).2 hExact - letI : FunctionField.IsFullConstantField S E := + let : FunctionField.IsFullConstantField S E := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot S E).2 (by simpa only [E] using diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean index 0b17ca3431..9622f100a5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean @@ -34,7 +34,7 @@ private theorem finiteDifferentCanonicalRatFuncPolynomialFractionRing (K : Type*) [Field K] : letI := finiteDifferentCanonicalRatFuncPolynomialAlgebra K IsFractionRing K[X] (RatFunc K) := by - letI := finiteDifferentCanonicalRatFuncPolynomialAlgebra K + let := finiteDifferentCanonicalRatFuncPolynomialAlgebra K infer_instance @[reducible] private noncomputable def @@ -46,7 +46,7 @@ private theorem finiteDifferentCanonicalFractionRing (R : Type*) [CommRing R] [IsDomain R] : letI := finiteDifferentCanonicalFractionRingAlgebra R IsFractionRing R (FractionRing R) := by - letI := finiteDifferentCanonicalFractionRingAlgebra R + let := finiteDifferentCanonicalFractionRingAlgebra R infer_instance private theorem different_eq_map_of_disjoint_fields @@ -192,33 +192,33 @@ theorem exactConstantExtension_rationalFunctionRanges_linearDisjoint : let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange F₁.LinearDisjoint F₂ ∧ F₁ ⊔ F₂ = ⊤ := by let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) L := Algebra.toSMul - letI : Module (RatFunc C) L := Algebra.toModule - letI : DistribMulAction (RatFunc C) L := Module.toDistribMulAction - letI : MulAction (RatFunc C) L := DistribMulAction.toMulAction - letI : Algebra N L := exactConstantExtensionAlgebra C N S - letI : SMul N L := Algebra.toSMul - letI : Module N L := Algebra.toModule - letI : IsScalarTower (RatFunc C) N L := + let : SMul (RatFunc C) L := Algebra.toSMul + let : Module (RatFunc C) L := Algebra.toModule + let : DistribMulAction (RatFunc C) L := Module.toDistribMulAction + let : MulAction (RatFunc C) L := DistribMulAction.toMulAction + let : Algebra N L := exactConstantExtensionAlgebra C N S + let : SMul N L := Algebra.toSMul + let : Module N L := Algebra.toModule + let : IsScalarTower (RatFunc C) N L := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule - letI : Algebra (RatFunc S) L := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : Module (RatFunc C) (RatFunc S) := Algebra.toModule + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc S) L := Algebra.toModule - letI : IsScalarTower (RatFunc C) (RatFunc S) L := + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc S) L := Algebra.toModule + let : IsScalarTower (RatFunc C) (RatFunc S) L := rationalBase_scalarTower C S N hExact let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N L := Module.Finite.equiv e - letI : FiniteDimensional (RatFunc C) L := + let : Module.Finite N L := Module.Finite.equiv e + let : FiniteDimensional (RatFunc C) L := Module.Finite.trans N L let f₁ : RatFunc S →ₐ[RatFunc C] L := IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L @@ -244,11 +244,11 @@ theorem exactConstantExtension_rationalFunctionRanges_linearDisjoint : exact (F₁ ⊔ F₂).add_mem (hx (by simp)) (hy (by simp)) let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange - letI : FiniteDimensional (RatFunc C) F₁ := by - letI : Module.Finite (RatFunc C) (RatFunc S) := + let : FiniteDimensional (RatFunc C) F₁ := by + let : Module.Finite (RatFunc C) (RatFunc S) := ratFuncCoefficient_moduleFinite C S exact Module.Finite.equiv e₁.toLinearEquiv - letI : FiniteDimensional (RatFunc C) F₂ := + let : FiniteDimensional (RatFunc C) F₂ := Module.Finite.equiv e₂.toLinearEquiv have hfinL : Module.finrank (RatFunc C) L = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean index 063a6d40f0..5a3d61941c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean @@ -45,9 +45,9 @@ private theorem exactConstantExtension_polynomialTower : ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap C[X] (RatFunc C))) IsScalarTower C C[X] (ExactConstantExtension C N S) := by - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra C[X] (ExactConstantExtension C N S) := + let : Algebra C[X] (ExactConstantExtension C N S) := RingHom.toAlgebra ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap C[X] (RatFunc C))) @@ -141,9 +141,9 @@ private theorem exactConstantExtension_ratFuncBaseTower : letI : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S apply IsScalarTower.of_algebraMap_eq' ext x @@ -180,43 +180,43 @@ theorem exactConstantExtensionConstantQuotient_action_on_finiteNormalization algebraMap S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) (exactConstantExtensionConstantQuotient C L N S hExact g s) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := exactConstantExtension_ratFuncBaseTower C N S L - letI : Algebra C[X] L := + let : Algebra C[X] L := RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C[X] (RatFunc C) L := + let : IsScalarTower C[X] (RatFunc C) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra C[X] (ExactConstantExtension C N S) := + let : Algebra C[X] (ExactConstantExtension C N S) := RingHom.toAlgebra ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C[X] (RatFunc C) + let : IsScalarTower C[X] (RatFunc C) (ExactConstantExtension C N S) := IsScalarTower.of_algebraMap_eq' rfl - letI : IsGalois L (ExactConstantExtension C N S) := + let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact - letI : Algebra S (RatFuncFiniteIntegralClosure C + let : Algebra S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) - letI : Algebra (RatFuncFiniteIntegralClosure C L) + let : Algebra (RatFuncFiniteIntegralClosure C L) (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := (finiteIntegralClosureMap C L (ExactConstantExtension C N S)).toAlgebra - letI : IsScalarTower (RatFuncFiniteIntegralClosure C L) L + let : IsScalarTower (RatFuncFiniteIntegralClosure C L) L (ExactConstantExtension C N S) := inferInstance - letI : Algebra.IsIntegral C[X] (RatFuncFiniteIntegralClosure C L) := + let : Algebra.IsIntegral C[X] (RatFuncFiniteIntegralClosure C L) := IsIntegralClosure.isIntegral_algebra C[X] L - letI : IsScalarTower C[X] (RatFuncFiniteIntegralClosure C L) + let : IsScalarTower C[X] (RatFuncFiniteIntegralClosure C L) (ExactConstantExtension C N S) := by apply IsScalarTower.of_algebraMap_eq intro x @@ -226,7 +226,7 @@ theorem exactConstantExtensionConstantQuotient_action_on_finiteNormalization (algebraMap (RatFunc C) L (algebraMap C[X] (RatFunc C) x)) exact IsScalarTower.algebraMap_apply (RatFunc C) L (ExactConstantExtension C N S) _ - letI : IsScalarTower (RatFuncFiniteIntegralClosure C L) + let : IsScalarTower (RatFuncFiniteIntegralClosure C L) (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) (ExactConstantExtension C N S) := ⟨fun r t x => by @@ -240,7 +240,7 @@ theorem exactConstantExtensionConstantQuotient_action_on_finiteNormalization algebraMap (RatFuncFiniteIntegralClosure C L) (ExactConstantExtension C N S) r by rfl] ring⟩ - letI : IsIntegralClosure + let : IsIntegralClosure (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) (RatFuncFiniteIntegralClosure C L) (ExactConstantExtension C N S) := @@ -306,52 +306,52 @@ theorem exactConstantExtensionFinitePlace_stabilizerRestriction_ker_eq_inertia (MulAction.stabilizer (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) Q.asIdeal) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := exactConstantExtension_ratFuncBaseTower C N S L - letI : IsGalois L (ExactConstantExtension C N S) := + let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact - letI : Algebra S (RatFuncFiniteIntegralClosure C + let : Algebra S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Module.Finite (RatFunc C) N := Module.Finite.trans L N + let : Module.Finite (RatFunc C) N := Module.Finite.trans L N let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := + let : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) - letI : Algebra C[X] (ExactConstantExtension C N S) := + let : Algebra C[X] (ExactConstantExtension C N S) := RingHom.toAlgebra ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C[X] (RatFunc C) + let : IsScalarTower C[X] (RatFunc C) (ExactConstantExtension C N S) := IsScalarTower.of_algebraMap_eq' rfl intro Q hdegree - letI : Algebra.IsSeparable L (ExactConstantExtension C N S) := + let : Algebra.IsSeparable L (ExactConstantExtension C N S) := IsGalois.to_isSeparable - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := Algebra.IsSeparable.trans (RatFunc C) L (ExactConstantExtension C N S) - letI : IsDedekindDomain (RatFuncFiniteIntegralClosure C + let : IsDedekindDomain (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := inferInstance - letI : Q.asIdeal.IsMaximal := Q.isMaximal + let : Q.asIdeal.IsMaximal := Q.isMaximal exact stabilizerRestriction_ker_eq_inertia_of_residue_finrank_one Q.asIdeal (exactConstantExtensionConstantQuotient C L N S hExact) (exactConstantExtensionConstantQuotient_action_on_finiteNormalization @@ -396,38 +396,38 @@ theorem exactConstantExtensionFinitePlace_decompositionGroup_card (finitePlaceDecompositionGroup C L (ExactConstantExtension C N S) Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := exactConstantExtension_ratFuncBaseTower C N S L - letI : IsGalois L (ExactConstantExtension C N S) := + let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact - letI : Algebra S (RatFuncFiniteIntegralClosure C + let : Algebra S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Module.Finite (RatFunc C) N := Module.Finite.trans L N + let : Module.Finite (RatFunc C) N := Module.Finite.trans L N let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := + let : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) - letI : Algebra.IsSeparable L (ExactConstantExtension C N S) := + let : Algebra.IsSeparable L (ExactConstantExtension C N S) := IsGalois.to_isSeparable - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := Algebra.IsSeparable.trans (RatFunc C) L (ExactConstantExtension C N S) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index 11f41e0c9b..3e5f93d757 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -127,26 +127,26 @@ theorem finiteDimensional_exactConstantExtension_over_baseRatFunc : letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := + let : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e exact Module.Finite.trans N (ExactConstantExtension C N S) @@ -164,11 +164,11 @@ theorem exactConstantExtension_ratFunc_polynomialCompatibility (algebraMap C[X] (RatFunc C) p) = algebraMap (RatFunc S) (ExactConstantExtension C N S) (algebraMap S[X] (RatFunc S) (algebraMap C[X] S[X] p)) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact rw [rationalBase_algebraMap_eq C S N hExact] apply congrArg (algebraMap (RatFunc S) (ExactConstantExtension C N S)) @@ -217,11 +217,11 @@ theorem exactConstantExtensionCompatibleBaseFinitePlace_baseChange C S N hExact)) (exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q) = exactConstantExtensionUpstairsFinitePlace C S N hExact q := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact exact Equiv.apply_symm_apply _ _ @@ -306,10 +306,10 @@ theorem exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTran exactConstantExtensionUpstairsFinitePlace C S N hExact q = heightOneSpectrumEquivOfAlgEquiv e q := by let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact let e := integralClosureAlgEquivRatFuncFiniteOfAlgebraMap S E (constantExtensionTensorPolynomialAlgebra C S N) @@ -439,16 +439,16 @@ theorem exactConstantExtensionCompatibleResidueField_finrank_eq (exactConstantExtensionUpstairsFinitePlace C S N hExact q).asIdeal.ResidueField := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra S (RatFuncFiniteIntegralClosure C + let : Algebra S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : Algebra S (RatFuncFiniteIntegralClosure S + let : Algebra S (RatFuncFiniteIntegralClosure S (ExactConstantExtension C N S)) := RingHom.toAlgebra ((algebraMap S[X] (RatFuncFiniteIntegralClosure S @@ -496,30 +496,30 @@ theorem exactConstantExtensionCompatibleBaseFinitePlace_degree_eq finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl (exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q)) = Module.finrank C S := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact intro hRational @@ -566,29 +566,29 @@ theorem exactConstantExtensionCompatibleBaseFinitePlace_under_original (exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q) = exactConstantExtensionDownstairsFinitePlace C S N hExact q := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := + let : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S apply IsDedekindDomain.HeightOneSpectrum.ext @@ -735,18 +735,18 @@ private theorem exactConstantExtensionCompatibility_ratFuncBaseTower : letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul letI : Module L (ExactConstantExtension C N S) := Algebra.toModule IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule apply IsScalarTower.of_algebraMap_eq' ext x change (1 : S) ⊗ₜ[C] algebraMap (RatFunc C) N x = @@ -792,59 +792,59 @@ theorem exactConstantExtensionFinitePlace_decompositionGroup_card_of_rational_ba (finitePlaceDecompositionGroup C L (ExactConstantExtension C N S) Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) L + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := exactConstantExtensionCompatibility_ratFuncBaseTower C S N hExact L - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsScalarTower L N (ExactConstantExtension C N S) := + let : IsScalarTower L N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C L N S - letI : IsGalois L (ExactConstantExtension C N S) := + let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc S) + let : FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) + let : Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := isSeparable_over_extendedRatFunc C S N hExact - letI : Algebra S (RatFuncFiniteIntegralClosure C + let : Algebra S (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : Algebra S (RatFuncFiniteIntegralClosure S + let : Algebra S (RatFuncFiniteIntegralClosure S (ExactConstantExtension C N S)) := RingHom.toAlgebra ((algebraMap S[X] (RatFuncFiniteIntegralClosure S (ExactConstantExtension C N S))).comp (algebraMap S S[X])) - letI : MulSemiringAction + let : MulSemiringAction (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) (RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S)) := finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) @@ -902,18 +902,18 @@ theorem exactConstantExtensionFinitePlace_decompositionGroup_card_of_rational_ba let R₀ := RatFuncFiniteIntegralClosure C L let R₁ := RatFuncFiniteIntegralClosure C N let R₂ := RatFuncFiniteIntegralClosure C (ExactConstantExtension C N S) - letI : Algebra R₀ R₁ := (finiteIntegralClosureMap C L N).toAlgebra - letI : Algebra R₁ R₂ := + let : Algebra R₀ R₁ := (finiteIntegralClosureMap C L N).toAlgebra + let : Algebra R₁ R₂ := (finiteIntegralClosureMap C N (ExactConstantExtension C N S)).toAlgebra - letI : Algebra R₀ R₂ := + let : Algebra R₀ R₂ := (finiteIntegralClosureMap C L (ExactConstantExtension C N S)).toAlgebra - letI : SMul R₀ R₁ := Algebra.toSMul - letI : Module R₀ R₁ := Algebra.toModule - letI : SMul R₁ R₂ := Algebra.toSMul - letI : Module R₁ R₂ := Algebra.toModule - letI : SMul R₀ R₂ := Algebra.toSMul - letI : Module R₀ R₂ := Algebra.toModule - letI : IsScalarTower R₀ R₁ R₂ := by + let : SMul R₀ R₁ := Algebra.toSMul + let : Module R₀ R₁ := Algebra.toModule + let : SMul R₁ R₂ := Algebra.toSMul + let : Module R₁ R₂ := Algebra.toModule + let : SMul R₀ R₂ := Algebra.toSMul + let : Module R₀ R₂ := Algebra.toModule + let : IsScalarTower R₀ R₁ R₂ := by apply IsScalarTower.of_algebraMap_eq' ext x change algebraMap L (ExactConstantExtension C N S) (x : L) = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean index a75199cd6c..0046809bc3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean @@ -37,7 +37,7 @@ theorem MonoidHom.stabilizer_surjective_of_isPretransitive_of_isCyclic (pi.comp (MulAction.stabilizer G x₀).subtype)) : ∀ x : X, Function.Surjective (pi.comp (MulAction.stabilizer G x).subtype) := by - letI : CommGroup A := IsCyclic.commGroup + let : CommGroup A := IsCyclic.commGroup intro x c obtain ⟨g, hg⟩ := MulAction.exists_smul_eq G x₀ x obtain ⟨h, hh⟩ := h₀ c @@ -107,18 +107,18 @@ private theorem exactConstantExtensionFrobeniusAverage_ratFuncBaseTower : letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul letI : Module L (ExactConstantExtension C N S) := Algebra.toModule IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule apply IsScalarTower.of_algebraMap_eq' ext x change (1 : S) ⊗ₜ[C] algebraMap (RatFunc C) N x = @@ -137,23 +137,23 @@ private theorem finiteDimensional_exactConstantExtension_over_intermediate letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul letI : Module L (ExactConstantExtension C N S) := Algebra.toModule FiniteDimensional L (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule - letI : Algebra N (ExactConstantExtension C N S) := + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower L N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower L N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C L N S let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite L (ExactConstantExtension C N S) := + let : Module.Finite L (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) infer_instance @@ -217,64 +217,64 @@ theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum Nat.card (MulAction.fixedBy (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) g.1)) = Nat.card (N ≃ₐ[L] N) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) L + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := exactConstantExtensionFrobeniusAverage_ratFuncBaseTower C S N L - letI : IsScalarTower (RatFunc C) N + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsScalarTower L N (ExactConstantExtension C N S) := + let : IsScalarTower L N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C L N S - letI : IsGalois L (ExactConstantExtension C N S) := + let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_intermediate (C := C) (S := S) (N := N) (L := L) hExact - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let Q := exactConstantExtensionCompatibleBaseFinitePlace C S N hExact q let P := finitePlaceUnder C L (ExactConstantExtension C N S) Q let pi := exactConstantExtensionConstantQuotient C L N S hExact - letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ - letI : Fintype + let : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + let : Fintype (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) := Fintype.ofFinite _ - letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ - letI : Fintype + let : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + let : Fintype (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ - letI := finiteIntegralClosureGalAction C L + let := finiteIntegralClosureGalAction C L (ExactConstantExtension C N S) - letI := finitePlaceUnderFiberGalAction C L + let := finitePlaceUnderFiberGalAction C L (ExactConstantExtension C N S) P - letI : MulAction.IsPretransitive + let : MulAction.IsPretransitive (ExactConstantExtension C N S ≃ₐ[L] ExactConstantExtension C N S) (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) := finitePlaceUnderFiberGalAction_isPretransitive C L (ExactConstantExtension C N S) P let Q₀ : FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P := ⟨Q, rfl⟩ - letI : Nonempty (FinitePlaceUnderFiber C L + let : Nonempty (FinitePlaceUnderFiber C L (ExactConstantExtension C N S) P) := ⟨Q₀⟩ have hdecomp := exactConstantExtensionFinitePlace_decompositionGroup_card_of_rational_base diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean index a9b50f2b52..624163fe88 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean @@ -107,14 +107,14 @@ private theorem finiteDimensional_exactConstantExtension_over_base letI := exactConstantExtensionField C N S hExact letI := exactConstantExtensionBaseAlgebra C L N S FiniteDimensional L (ExactConstantExtension C N S) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI := exactConstantExtensionAlgebra C N S - letI := exactConstantExtensionBaseTower C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionAlgebra C N S + let := exactConstantExtensionBaseTower C L N S let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite L (ExactConstantExtension C N S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e + let : Module.Finite L (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) infer_instance @@ -129,8 +129,8 @@ theorem orderOf_exactConstantExtensionFrobeniusTwist letI := exactConstantExtensionBaseAlgebra C L N S orderOf (exactConstantExtensionFrobeniusTwist C L N S hExact g) = Module.finrank C S := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S change orderOf (exactConstantExtensionCombinedAutHom C L N S (FiniteField.frobeniusAlgEquivOfAlgebraic C S, g)) = _ rw [orderOf_injective (exactConstantExtensionCombinedAutHom C L N S) @@ -151,8 +151,8 @@ theorem natCard_exactConstantExtensionFrobeniusTwistSubgroup Nat.card (exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g) = Module.finrank C S := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S rw [show exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g = Subgroup.zpowers (exactConstantExtensionFrobeniusTwist C L N S hExact g) by rfl, @@ -169,8 +169,8 @@ theorem exactConstantExtensionFrobeniusTwistSubgroup_inf_quotientKer letI := exactConstantExtensionBaseAlgebra C L N S exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g ⊓ (exactConstantExtensionConstantQuotient C L N S hExact).ker = ⊥ := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S apply le_antisymm · intro x hx rw [Subgroup.mem_bot] @@ -203,8 +203,8 @@ theorem exactConstantExtensionFrobeniusTwistSubgroup_inf_functionRange letI := exactConstantExtensionBaseAlgebra C L N S exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g ⊓ (exactConstantExtensionFunctionAutHom C L N S).range = ⊥ := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S rw [← exactConstantExtensionConstantQuotient_ker C L N S hExact] exact exactConstantExtensionFrobeniusTwistSubgroup_inf_quotientKer C L N S hExact g hdiv @@ -220,11 +220,11 @@ theorem frobeniusTwistField_sup_extendedBaseField_eq_top letI := exactConstantExtensionBaseAlgebra C L N S exactConstantExtensionFrobeniusTwistField C L N S hExact g ⊔ exactConstantExtensionExtendedBaseField C L N S hExact = ⊤ := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_base C L N S hExact - letI : IsGalois L (ExactConstantExtension C N S) := + let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g let B := exactConstantExtensionExtendedBaseField C L N S hExact @@ -261,9 +261,9 @@ theorem finrank_exactConstantExtension_over_frobeniusTwistField Module.finrank (exactConstantExtensionFrobeniusTwistField C L N S hExact g) (ExactConstantExtension C N S) = Module.finrank C S := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_base C L N S hExact rw [show exactConstantExtensionFrobeniusTwistField C L N S hExact g = IntermediateField.fixedField @@ -284,9 +284,9 @@ theorem finiteDimensional_exactConstantExtension_over_frobeniusTwistField FiniteDimensional (exactConstantExtensionFrobeniusTwistField C L N S hExact g) (ExactConstantExtension C N S) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_base C L N S hExact infer_instance @@ -302,9 +302,9 @@ theorem isGalois_exactConstantExtension_over_frobeniusTwistField IsGalois (exactConstantExtensionFrobeniusTwistField C L N S hExact g) (ExactConstantExtension C N S) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_base C L N S hExact let H := exactConstantExtensionFrobeniusTwistSubgroup C L N S hExact g change IsGalois (IntermediateField.fixedField H) @@ -323,9 +323,9 @@ theorem finrank_frobeniusTwistField_over_base Module.finrank L (exactConstantExtensionFrobeniusTwistField C L N S hExact g) = Module.finrank L N := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_base C L N S hExact let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g have hmul := Module.finrank_mul_finrank L F @@ -347,11 +347,11 @@ theorem natCard_aut_exactConstantExtension_over_frobeniusTwistField (ExactConstantExtension C N S ≃ₐ[ exactConstantExtensionFrobeniusTwistField C L N S hExact g] ExactConstantExtension C N S) = Module.finrank C S := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S - letI : FiniteDimensional L (ExactConstantExtension C N S) := + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S + let : FiniteDimensional L (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_base C L N S hExact - letI : IsGalois + let : IsGalois (exactConstantExtensionFrobeniusTwistField C L N S hExact g) (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean index e712a14f18..4b63e7dbce 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean @@ -52,16 +52,16 @@ theorem exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot letI : Algebra C F := Algebra.restrictScalars C L F algebraicClosure C F = (⊥ : IntermediateField C F) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra C T := Algebra.restrictScalars C L T - letI : SMul C T := Algebra.toSMul - letI : IsScalarTower C L T := IsScalarTower.of_algebraMap_eq' rfl + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : Algebra C T := Algebra.restrictScalars C L T + let : SMul C T := Algebra.toSMul + let : IsScalarTower C L T := IsScalarTower.of_algebraMap_eq' rfl let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra C F := Algebra.restrictScalars C L F - letI : IsScalarTower C L F := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra S T := Algebra.TensorProduct.leftAlgebra - letI : SMul S T := Algebra.toSMul + let : Algebra C F := Algebra.restrictScalars C L F + let : IsScalarTower C L F := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra S T := Algebra.TensorProduct.leftAlgebra + let : SMul S T := Algebra.toSMul have hCS : algebraMap C T = (algebraMap S T).comp (algebraMap C S) := by ext c @@ -69,7 +69,7 @@ theorem exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot algebraMap C S c ⊗ₜ (1 : N) rw [← IsScalarTower.algebraMap_apply C L N] exact (Algebra.TensorProduct.tmul_one_eq_one_tmul c).symm - letI : IsScalarTower C S T := IsScalarTower.of_algebraMap_eq' hCS + let : IsScalarTower C S T := IsScalarTower.of_algebraMap_eq' hCS have hTopExact : algebraicClosure S T = (⊥ : IntermediateField S T) := exactConstantExtension_algebraicClosure_eq_bot C N S hExact diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean index 653c513c9a..99c037b112 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean @@ -61,13 +61,13 @@ theorem rationalInfinityPlace_card_frobeniusTwistField_le_original_finrank C (RatFunc C) N S hExact g Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ Module.finrank (RatFunc C) N := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C (RatFunc C) N S let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : FiniteDimensional (RatFunc C) F := + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g calc Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean index 7521835fb4..419cab1213 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -46,22 +46,22 @@ theorem finitePlaceUnder_ratFunc_under (Q : FiniteExtensionFinitePlace K L) : finitePlaceUnder K (RatFunc K) M (finitePlaceUnder K M L Q) = finitePlaceUnder K (RatFunc K) L Q := by - letI : Algebra (RatFuncFiniteIntegralClosure K (RatFunc K)) + let : Algebra (RatFuncFiniteIntegralClosure K (RatFunc K)) (RatFuncFiniteIntegralClosure K M) := (finiteIntegralClosureMap K (RatFunc K) M).toAlgebra - letI : Algebra (RatFuncFiniteIntegralClosure K M) + let : Algebra (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) := (finiteIntegralClosureMap K M L).toAlgebra - letI : Algebra (RatFuncFiniteIntegralClosure K (RatFunc K)) + let : Algebra (RatFuncFiniteIntegralClosure K (RatFunc K)) (RatFuncFiniteIntegralClosure K L) := (finiteIntegralClosureMap K (RatFunc K) L).toAlgebra - letI : SMul (RatFuncFiniteIntegralClosure K (RatFunc K)) + let : SMul (RatFuncFiniteIntegralClosure K (RatFunc K)) (RatFuncFiniteIntegralClosure K M) := Algebra.toSMul - letI : SMul (RatFuncFiniteIntegralClosure K M) + let : SMul (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) := Algebra.toSMul - letI : SMul (RatFuncFiniteIntegralClosure K (RatFunc K)) + let : SMul (RatFuncFiniteIntegralClosure K (RatFunc K)) (RatFuncFiniteIntegralClosure K L) := Algebra.toSMul - letI : IsScalarTower (RatFuncFiniteIntegralClosure K (RatFunc K)) + let : IsScalarTower (RatFuncFiniteIntegralClosure K (RatFunc K)) (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) := IsScalarTower.of_algebraMap_eq fun x => by @@ -151,8 +151,8 @@ private theorem finiteExtensionPlaceDegree_inl_eq_finrank_residueField_ratFunc finiteExtensionPlaceDegree C (RatFunc C) (.inl Q) = Module.finrank C Q.asIdeal.ResidueField := by let P := IsDedekindDomain.HeightOneSpectrum.under C[X] Q - letI : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver P.asIdeal Q.asIdeal let : IsScalarTower C[X] (Localization.AtPrime P.asIdeal) (Localization.AtPrime Q.asIdeal) := inferInstance @@ -225,23 +225,23 @@ private theorem exists_presentedFinitePlace_of_under_rational : (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) T := + let : Algebra (RatFunc S) T := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S intro Q hBase let e := exactConstantExtensionPresentedFinitePlaceEquiv C S N hExact @@ -302,29 +302,29 @@ theorem exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_rational finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = Module.finrank C S := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) T := + let : Algebra (RatFunc S) T := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) T := Algebra.toSMul - letI : Module (RatFunc S) T := Algebra.toModule - letI : FiniteDimensional (RatFunc S) T := + let : SMul (RatFunc S) T := Algebra.toSMul + let : Module (RatFunc S) T := Algebra.toModule + let : FiniteDimensional (RatFunc S) T := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) T := + let : Algebra.IsSeparable (RatFunc S) T := isSeparable_over_extendedRatFunc C S N hExact - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S intro Q hBase obtain ⟨q, heq, hBaseQ⟩ := @@ -389,25 +389,25 @@ theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under (ExactConstantExtension C N S) P) g.1)) = Nat.card (N ≃ₐ[RatFunc C] N) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra (RatFunc S) T := + let : Algebra (RatFunc S) T := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S intro Q hBase obtain ⟨q, heq, hBaseQ⟩ := @@ -429,9 +429,9 @@ theorem exactConstantExtensionFrobeniusFiberEquiv_apply_val C (RatFunc C) N S hExact) g).1 = exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S rfl @@ -473,28 +473,28 @@ theorem sum_card_finitePlaceUnderFiber_fixedBy_frobeniusTwist_eq_card_galois C (RatFunc C) N S hExact g))) = Nat.card (N ≃ₐ[RatFunc C] N) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact let P₀ := ratFuncRationalFinitePlaceEquivFiniteExtension C P - letI := finiteIntegralClosureGalAction C (RatFunc C) T - letI := finitePlaceUnderFiberGalAction C (RatFunc C) T P₀.1 + let := finiteIntegralClosureGalAction C (RatFunc C) T + let := finitePlaceUnderFiberGalAction C (RatFunc C) T P₀.1 let pi := exactConstantExtensionConstantQuotient C (RatFunc C) N S hExact - letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ - letI : Fintype (T ≃ₐ[RatFunc C] T) := Fintype.ofFinite _ - letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ - letI : Fintype + let : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + let : Fintype (T ≃ₐ[RatFunc C] T) := Fintype.ofFinite _ + let : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + let : Fintype (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective C (RatFunc C) T P₀.1 @@ -768,37 +768,37 @@ theorem frobeniusTwistFieldRationalFinitePlaceCount_eq_sum_fiberFixedBy Nat.card (FrobeniusTwistFinitePlaceFiberFixedBy C S N hExact g P) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g change Nat.card (FiniteExtensionRationalFinitePlace C F) = _ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean index 925c9b0eef..74db45b20f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean @@ -115,8 +115,8 @@ theorem finitePlaceGalSmul_eq_self_over_rationalFinitePlace_of_finrank_dvd_degre (hQ : finitePlaceUnder K M T Q = P.1) (sigma : T ≃ₐ[M] T) : finitePlaceGalSmul K M T sigma Q = Q := by - letI := finiteIntegralClosureGalAction K M T - letI := finitePlaceUnderFiberGalAction K M T P.1 + let := finiteIntegralClosureGalAction K M T + let := finitePlaceUnderFiberGalAction K M T P.1 have hcard := rationalFinitePlace_fiber_card_eq_one_of_finrank_dvd_degree K M T hdegree P @@ -150,22 +150,22 @@ theorem exactConstantExtensionFinitePlace_finrank_constants_dvd_degree Module.finrank C S ∣ finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) T := + let : Algebra (RatFunc S) T := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : SMul (RatFunc S) T := Algebra.toSMul - letI : Module (RatFunc S) T := Algebra.toModule - letI : FiniteDimensional (RatFunc S) T := + let : SMul (RatFunc S) T := Algebra.toSMul + let : Module (RatFunc S) T := Algebra.toModule + let : FiniteDimensional (RatFunc S) T := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) T := + let : Algebra.IsSeparable (RatFunc S) T := isSeparable_over_extendedRatFunc C S N hExact rw [finiteExtensionFinitePlace_degree_baseChange C S T (exactConstantExtension_ratFunc_polynomialCompatibility C S N hExact) @@ -217,8 +217,8 @@ theorem exactConstantExtensionFrobeniusTwistOverFixedField_apply exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g x := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S change (exactConstantExtensionFrobeniusTwist @@ -274,33 +274,33 @@ theorem frobeniusTwistField_rationalFinitePlace_fiber_card_eq_one Fintype.card (FinitePlaceUnderFiber C F (ExactConstantExtension C N S) P.1) = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only @@ -363,33 +363,33 @@ theorem frobeniusTwistField_rationalFinitePlace_lift_fixed (exactConstantExtensionFrobeniusTwistOverFixedField C N S hExact g) Q = Q := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean index 671575f640..ef3e696fc0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean @@ -55,31 +55,31 @@ theorem genus_frobeniusTwistField_eq_original letI : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra FunctionField.genus C F = FunctionField.genus C N := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F - letI : IsScalarTower C (RatFunc C) F := + let : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + let : IsScalarTower C (RatFunc C) F := IsScalarTower.of_algebraMap_eq' rfl have hExactF : algebraicClosure C F = (⊥ : IntermediateField C F) := exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot C (RatFunc C) N S hExact g let U := ExactConstantExtension C F S - letI : Field U := exactConstantExtensionField C F S hExactF - letI : Algebra S U := Algebra.TensorProduct.leftAlgebra - letI : Algebra S T := Algebra.TensorProduct.leftAlgebra + let : Field U := exactConstantExtensionField C F S hExactF + let : Algebra S U := Algebra.TensorProduct.leftAlgebra + let : Algebra S T := Algebra.TensorProduct.leftAlgebra let e : U ≃ₐ[S] T := exactConstantExtensionFrobeniusTwistMultiplicationAlgEquivOverConstants C (RatFunc C) N S hExact g hdiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean index fad02d49d2..d39c8c441a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean @@ -92,8 +92,8 @@ theorem infinityPlaceGalSmul_eq_self_over_rationalInfinityPlace_of_finrank_dvd_d (hQ : infinityPlaceUnder K M T Q = P.1) (sigma : T ≃ₐ[M] T) : infinityPlaceGalSmul K M T sigma Q = Q := by - letI := infinityIntegralClosureGalAction K M T - letI := infinityPlaceUnderFiberGalAction K M T P.1 + let := infinityIntegralClosureGalAction K M T + let := infinityPlaceUnderFiberGalAction K M T P.1 have hcard := rationalInfinityPlace_fiber_card_eq_one_of_finrank_dvd_degree K M T hdegree P @@ -158,7 +158,7 @@ theorem infinityPlaceUnder_degree_eq_one_of_generator_fixed (.inr (infinityPlaceUnder K M T Q)) = 1 := by let P := infinityPlaceUnder K M T Q let Q₀ : InfinityPlaceUnderFiber K M T P := ⟨Q, rfl⟩ - letI := infinityPlaceGalAction K M T + let := infinityPlaceGalAction K M T have hsigma : sigma ∈ MulAction.stabilizer (T ≃ₐ[M] T) Q := by rw [MulAction.mem_stabilizer_iff] @@ -175,8 +175,8 @@ theorem infinityPlaceUnder_degree_eq_one_of_generator_fixed have hfix := MulAction.mem_stabilizer_iff.mp htau change infinityPlaceGalSmul K M T tau Q = Q at hfix exact hfix - letI := infinityPlaceUnderFiberGalAction K M T P - letI : MulAction.IsPretransitive (T ≃ₐ[M] T) + let := infinityPlaceUnderFiberGalAction K M T P + let : MulAction.IsPretransitive (T ≃ₐ[M] T) (InfinityPlaceUnderFiber K M T P) := infinityPlaceUnderFiberGalAction_isPretransitive K M T P have hcard : Fintype.card (InfinityPlaceUnderFiber K M T P) = 1 := by @@ -316,59 +316,59 @@ theorem infinityPlaceGalSmul_eq_of_apply_eq let A := RatFuncInfinityIntegralClosure K T let A₁ := RatFuncInfinityIntegralClosure K M₁ let A₂ := RatFuncInfinityIntegralClosure K M₂ - letI : Algebra V (RatFunc K) := + let : Algebra V (RatFunc K) := RingHom.toAlgebra (SubringClass.subtype ((RatFunc.inftyValuation K).integer)) - letI : SMul V (RatFunc K) := Algebra.toSMul - letI : Module V (RatFunc K) := Algebra.toModule - letI : IsFractionRing V (RatFunc K) := + let : SMul V (RatFunc K) := Algebra.toSMul + let : Module V (RatFunc K) := Algebra.toModule + let : IsFractionRing V (RatFunc K) := (Valuation.integer.integers (RatFunc.inftyValuation K)).isFractionRing - letI : Algebra V M₁ := + let : Algebra V M₁ := RingHom.toAlgebra ((algebraMap (RatFunc K) M₁).comp (algebraMap V (RatFunc K))) - letI : SMul V M₁ := Algebra.toSMul - letI : Module V M₁ := Algebra.toModule - letI : IsScalarTower V (RatFunc K) M₁ := + let : SMul V M₁ := Algebra.toSMul + let : Module V M₁ := Algebra.toModule + let : IsScalarTower V (RatFunc K) M₁ := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra V M₂ := + let : Algebra V M₂ := RingHom.toAlgebra ((algebraMap (RatFunc K) M₂).comp (algebraMap V (RatFunc K))) - letI : SMul V M₂ := Algebra.toSMul - letI : Module V M₂ := Algebra.toModule - letI : IsScalarTower V (RatFunc K) M₂ := + let : SMul V M₂ := Algebra.toSMul + let : Module V M₂ := Algebra.toModule + let : IsScalarTower V (RatFunc K) M₂ := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra V T := + let : Algebra V T := RingHom.toAlgebra ((algebraMap (RatFunc K) T).comp (algebraMap V (RatFunc K))) - letI : SMul V T := Algebra.toSMul - letI : Module V T := Algebra.toModule - letI : IsScalarTower V (RatFunc K) T := + let : SMul V T := Algebra.toSMul + let : Module V T := Algebra.toModule + let : IsScalarTower V (RatFunc K) T := IsScalarTower.of_algebraMap_eq' rfl - letI : IsIntegralClosure A₁ V M₁ := + let : IsIntegralClosure A₁ V M₁ := integralClosure.isIntegralClosure V M₁ - letI : IsScalarTower V A₁ M₁ := + let : IsScalarTower V A₁ M₁ := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing A₁ M₁ := + let : IsFractionRing A₁ M₁ := IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc K) M₁ A₁ - letI : IsIntegralClosure A₂ V M₂ := + let : IsIntegralClosure A₂ V M₂ := integralClosure.isIntegralClosure V M₂ - letI : IsScalarTower V A₂ M₂ := + let : IsScalarTower V A₂ M₂ := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing A₂ M₂ := + let : IsFractionRing A₂ M₂ := IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc K) M₂ A₂ - letI : IsIntegralClosure A V T := + let : IsIntegralClosure A V T := integralClosure.isIntegralClosure V T - letI : IsScalarTower V A T := + let : IsScalarTower V A T := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing A T := + let : IsFractionRing A T := IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc K) T A - letI : Algebra A₁ A := (infinityIntegralClosureMap K M₁ T).toAlgebra - letI : SMul A₁ A := Algebra.toSMul - letI : Module A₁ A := Algebra.toModule - letI : IsScalarTower A₁ M₁ T := inferInstance - letI : Algebra.IsIntegral V A₁ := + let : Algebra A₁ A := (infinityIntegralClosureMap K M₁ T).toAlgebra + let : SMul A₁ A := Algebra.toSMul + let : Module A₁ A := Algebra.toModule + let : IsScalarTower A₁ M₁ T := inferInstance + let : Algebra.IsIntegral V A₁ := IsIntegralClosure.isIntegral_algebra V M₁ - letI : IsScalarTower V A₁ T := by + let : IsScalarTower V A₁ T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc K) T @@ -377,21 +377,21 @@ theorem infinityPlaceGalSmul_eq_of_apply_eq (algebraMap (RatFunc K) M₁ (algebraMap V (RatFunc K) x)) exact IsScalarTower.algebraMap_apply (RatFunc K) M₁ T _ - letI : IsScalarTower A₁ A T := + let : IsScalarTower A₁ A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap A₁ A r) = algebraMap A₁ T r by rfl] ring⟩ - letI : IsIntegralClosure A A₁ T := + let : IsIntegralClosure A A₁ T := IsIntegralClosure.tower_top (R := V) - letI : Algebra A₂ A := (infinityIntegralClosureMap K M₂ T).toAlgebra - letI : SMul A₂ A := Algebra.toSMul - letI : Module A₂ A := Algebra.toModule - letI : IsScalarTower A₂ M₂ T := inferInstance - letI : Algebra.IsIntegral V A₂ := + let : Algebra A₂ A := (infinityIntegralClosureMap K M₂ T).toAlgebra + let : SMul A₂ A := Algebra.toSMul + let : Module A₂ A := Algebra.toModule + let : IsScalarTower A₂ M₂ T := inferInstance + let : Algebra.IsIntegral V A₂ := IsIntegralClosure.isIntegral_algebra V M₂ - letI : IsScalarTower V A₂ T := by + let : IsScalarTower V A₂ T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc K) T @@ -400,17 +400,17 @@ theorem infinityPlaceGalSmul_eq_of_apply_eq (algebraMap (RatFunc K) M₂ (algebraMap V (RatFunc K) x)) exact IsScalarTower.algebraMap_apply (RatFunc K) M₂ T _ - letI : IsScalarTower A₂ A T := + let : IsScalarTower A₂ A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap A₂ A r) = algebraMap A₂ T r by rfl] ring⟩ - letI : IsIntegralClosure A A₂ T := + let : IsIntegralClosure A A₂ T := IsIntegralClosure.tower_top (R := V) - letI : MulSemiringAction (T ≃ₐ[M₁] T) A := + let : MulSemiringAction (T ≃ₐ[M₁] T) A := infinityIntegralClosureGalAction K M₁ T - letI : MulSemiringAction (T ≃ₐ[M₂] T) A := + let : MulSemiringAction (T ≃ₐ[M₂] T) A := infinityIntegralClosureGalAction K M₂ T have hsmul (a₁ : T ≃ₐ[M₁] T) (a₂ : T ≃ₐ[M₂] T) (ha : ∀ x : T, a₁ x = a₂ x) (x : A) : a₁ • x = a₂ • x := by @@ -487,29 +487,29 @@ theorem exactConstantExtensionInfinityPlace_finrank_constants_dvd_degree exactConstantExtensionBaseAlgebra C (RatFunc C) N S Module.finrank C S ∣ finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inr Q) := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) T := + let : Algebra (RatFunc S) T := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) T := Algebra.toSMul - letI : Module (RatFunc S) T := Algebra.toModule - letI : FiniteDimensional (RatFunc S) T := + let : SMul (RatFunc S) T := Algebra.toSMul + let : Module (RatFunc S) T := Algebra.toModule + let : FiniteDimensional (RatFunc S) T := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) T := + let : Algebra.IsSeparable (RatFunc S) T := isSeparable_over_extendedRatFunc C S N hExact let e := exactConstantExtensionPresentedInfinityPlaceEquiv C S N hExact @@ -543,9 +543,9 @@ private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft_infinity Algebra.TensorProduct.includeLeft (R := C) (S := C) (A := S) (B := N) (((FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k) s) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S change ((exactConstantExtensionCombinedAutHom C (RatFunc C) N S @@ -608,73 +608,73 @@ theorem frobeniusTwistField_infinityPlace_ramificationIdx_eq_one infinityPlaceRelativeRamificationIdx C F (ExactConstantExtension C N S) Q = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g let V := RatFuncInfinityIntegers C - letI : Algebra V (RatFunc C) := + let : Algebra V (RatFunc C) := RingHom.toAlgebra (SubringClass.subtype ((RatFunc.inftyValuation C).integer)) - letI : SMul V (RatFunc C) := Algebra.toSMul - letI : Module V (RatFunc C) := Algebra.toModule - letI : IsFractionRing V (RatFunc C) := + let : SMul V (RatFunc C) := Algebra.toSMul + let : Module V (RatFunc C) := Algebra.toModule + let : IsFractionRing V (RatFunc C) := (Valuation.integer.integers (RatFunc.inftyValuation C)).isFractionRing - letI : Algebra V T := + let : Algebra V T := RingHom.toAlgebra ((algebraMap (RatFunc C) T).comp (algebraMap V (RatFunc C))) - letI : SMul V T := Algebra.toSMul - letI : Module V T := Algebra.toModule - letI : IsScalarTower V (RatFunc C) T := + let : SMul V T := Algebra.toSMul + let : Module V T := Algebra.toModule + let : IsScalarTower V (RatFunc C) T := IsScalarTower.of_algebraMap_eq' rfl let A := RatFuncInfinityIntegralClosure C T let AF := RatFuncInfinityIntegralClosure C F - letI : IsIntegralClosure AF V F := + let : IsIntegralClosure AF V F := integralClosure.isIntegralClosure V F - letI : IsScalarTower V AF F := + let : IsScalarTower V AF F := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing AF F := + let : IsFractionRing AF F := IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc C) F AF - letI : IsIntegralClosure A V T := + let : IsIntegralClosure A V T := integralClosure.isIntegralClosure V T - letI : IsScalarTower V A T := + let : IsScalarTower V A T := IsScalarTower.of_algebraMap_eq' rfl - letI : IsFractionRing A T := + let : IsFractionRing A T := IsIntegralClosure.isFractionRing_of_finite_extension V (RatFunc C) T A - letI : Algebra AF A := (infinityIntegralClosureMap C F T).toAlgebra - letI : SMul AF A := Algebra.toSMul - letI : Module AF A := Algebra.toModule - letI : Algebra S A := + let : Algebra AF A := (infinityIntegralClosureMap C F T).toAlgebra + let : SMul AF A := Algebra.toSMul + let : Module AF A := Algebra.toModule + let : Algebra S A := exactConstantExtensionInfinityIntegralClosureConstantAlgebra C S N hExact - letI : IsScalarTower AF F T := inferInstance - letI : Algebra.IsIntegral V AF := + let : IsScalarTower AF F T := inferInstance + let : Algebra.IsIntegral V AF := IsIntegralClosure.isIntegral_algebra V F - letI : IsScalarTower V AF T := by + let : IsScalarTower V AF T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc C) T @@ -683,17 +683,17 @@ theorem frobeniusTwistField_infinityPlace_ramificationIdx_eq_one (algebraMap (RatFunc C) F (algebraMap V (RatFunc C) x)) exact IsScalarTower.algebraMap_apply (RatFunc C) F T _ - letI : IsScalarTower AF A T := + let : IsScalarTower AF A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap AF A r) = algebraMap AF T r by rfl] ring⟩ - letI : IsIntegralClosure A AF T := + let : IsIntegralClosure A AF T := IsIntegralClosure.tower_top (R := V) - letI : IsDedekindDomain A := + let : IsDedekindDomain A := IsIntegralClosure.isDedekindDomain V (RatFunc C) T A - letI : MulSemiringAction (T ≃ₐ[F] T) A := + let : MulSemiringAction (T ≃ₐ[F] T) A := infinityIntegralClosureGalAction C F T dsimp only intro Q diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean index 073e173045..a21feb28cb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean @@ -112,46 +112,46 @@ theorem frobeniusTwistField_fixed_infinityPlace_under_degree_eq_one finiteExtensionPlaceDegree C F (.inr (infinityPlaceUnder C F (ExactConstantExtension C N S) Q)) = 1 := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + let : MulAction (RatFunc C) F := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : DistribMulAction F T := Module.toDistribMulAction - letI : MulAction F T := DistribMulAction.toMulAction - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : DistribMulAction F T := Module.toDistribMulAction + let : MulAction F T := DistribMulAction.toMulAction + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only @@ -237,48 +237,48 @@ theorem exactConstantExtensionFrobeniusTwist_infinityPlaceGalSmul_eq_overFixedFi infinityPlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) (exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) Q := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + let : MulAction (RatFunc C) F := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : DistribMulAction F T := Module.toDistribMulAction - letI : MulAction F T := DistribMulAction.toMulAction - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : DistribMulAction F T := Module.toDistribMulAction + let : MulAction F T := DistribMulAction.toMulAction + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only @@ -358,48 +358,48 @@ theorem frobeniusTwistField_ambientFixed_infinityPlace_under_degree_eq_one finiteExtensionPlaceDegree C F (.inr (infinityPlaceUnder C F (ExactConstantExtension C N S) Q)) = 1 := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + let : MulAction (RatFunc C) F := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : DistribMulAction F T := Module.toDistribMulAction - letI : MulAction F T := DistribMulAction.toMulAction - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : DistribMulAction F T := Module.toDistribMulAction + let : MulAction F T := DistribMulAction.toMulAction + let : IsScalarTower (RatFunc C) F T := inferInstance + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g dsimp only diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean index 883d67d84d..7044f202d7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean @@ -52,16 +52,16 @@ theorem finiteDimensional_frobeniusTwistField_over_ratFunc C (RatFunc C) N S hExact g FiniteDimensional (RatFunc C) F := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S let tensorEquiv := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N T := Module.Finite.equiv tensorEquiv - letI : Module.Finite (RatFunc C) T := Module.Finite.trans N T + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N T := Module.Finite.equiv tensorEquiv + let : Module.Finite (RatFunc C) T := Module.Finite.trans N T let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g exact Module.Finite.left (RatFunc C) F T @@ -80,21 +80,21 @@ theorem isSeparable_frobeniusTwistField_over_ratFunc C (RatFunc C) N S hExact g Algebra.IsSeparable (RatFunc C) F := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N T := + let : IsGalois N T := exactConstantExtension_isGalois C N N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := Algebra.IsSeparable.trans (RatFunc C) N T exact Algebra.isSeparable_tower_bot_of_isSeparable (RatFunc C) F T @@ -119,13 +119,13 @@ private theorem exists_frobeniusTwistField_finitePlace_riemann_lower_budget Module.finrank C (finiteExtensionOnePointRiemannSpace C F (.inl q) poleOrder) + budget := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C (RatFunc C) N S let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : FiniteDimensional (RatFunc C) F := + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g exact exists_finitePlace_riemann_lower_budget C F @@ -151,8 +151,8 @@ theorem exists_common_frobeniusTwistField_finitePlace_riemann_lower_budget Module.finrank C (finiteExtensionOnePointRiemannSpace C F (.inl q) poleOrder) + budget := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C (RatFunc C) N S choose twistBudget htwistBudget using fun g : N ≃ₐ[RatFunc C] N => exists_frobeniusTwistField_finitePlace_riemann_lower_budget C N S hExact g @@ -189,8 +189,8 @@ theorem exists_common_frobeniusTwistField_exactConstants_and_riemann_budget Module.finrank C (finiteExtensionOnePointRiemannSpace C F (.inl q) poleOrder) + budget := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C (RatFunc C) N S obtain ⟨budget, hbudget⟩ := exists_common_frobeniusTwistField_finitePlace_riemann_lower_budget C N S hExact diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean index 2ee8b00ac4..8beb7b0f72 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean @@ -147,8 +147,8 @@ theorem exactConstantExtension_extended_algebraicClosure_eq_bot (algebraMap S (RatFunc S))) algebraicClosure S L = (⊥ : IntermediateField S L) := by let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) L := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact let extendedConstantAlgebra : Algebra S L := RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp @@ -178,7 +178,7 @@ theorem exactConstantExtension_extended_algebraicClosure_eq_bot have hTensorRange (z : L) (hz : @IsAlgebraic S L _ _ tensorConstantAlgebra z) : z ∈ Set.range (@algebraMap S L _ _ tensorConstantAlgebra) := by - letI : Algebra S L := tensorConstantAlgebra + let : Algebra S L := tensorConstantAlgebra have hTensorExact : algebraicClosure S L = (⊥ : IntermediateField S L) := exactConstantExtension_algebraicClosure_eq_bot C N S hExact @@ -188,7 +188,7 @@ theorem exactConstantExtension_extended_algebraicClosure_eq_bot rw [← hTensorExact] exact hzClosure exact hzBot - letI : Algebra S L := extendedConstantAlgebra + let : Algebra S L := extendedConstantAlgebra apply eq_bot_iff.mpr intro z hz have hzExtended : @IsAlgebraic S L _ _ extendedConstantAlgebra z := @@ -226,22 +226,22 @@ theorem exactConstantExtension_finrank_over_extendedRatFunc_eq letI : Module (RatFunc S) L := Algebra.toModule Module.finrank (RatFunc S) L = Module.finrank (RatFunc C) N := by let L := ExactConstantExtension C N S - letI : Field L := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (RatFunc S) := + let : Field L := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc C) L := + let : Algebra (RatFunc C) L := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) L := + let : Algebra (RatFunc S) L := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : SMul (RatFunc C) L := Algebra.toSMul - letI : SMul (RatFunc S) L := Algebra.toSMul - letI : Module (RatFunc C) (RatFunc S) := Algebra.toModule - letI : Module (RatFunc C) L := Algebra.toModule - letI : Module (RatFunc S) L := Algebra.toModule - letI : IsScalarTower (RatFunc C) (RatFunc S) L := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : SMul (RatFunc C) L := Algebra.toSMul + let : SMul (RatFunc S) L := Algebra.toSMul + let : Module (RatFunc C) (RatFunc S) := Algebra.toModule + let : Module (RatFunc C) L := Algebra.toModule + let : Module (RatFunc S) L := Algebra.toModule + let : IsScalarTower (RatFunc C) (RatFunc S) L := rationalBase_scalarTower C S N hExact - letI : FiniteDimensional (RatFunc S) L := + let : FiniteDimensional (RatFunc S) L := finiteDimensional_over_extendedRatFunc C S N hExact have hdegree : Module.finrank (RatFunc C) (RatFunc S) * diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean index d157ccaa6c..1a7bdaec45 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean @@ -141,25 +141,25 @@ theorem exactConstantExtension_chart_genus_eq_of_presentedMultiplicity FunctionField.Chart.genus S E = FunctionField.Chart.genus C N := by dsimp only let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (RatFunc S) := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc C) E := + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : FiniteDimensional (RatFunc S) E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact let extendedConstantAlgebra : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp @@ -180,12 +180,12 @@ theorem exactConstantExtension_chart_genus_eq_of_presentedMultiplicity (polynomialTensorCancelEvaluationPoint C S N) (Polynomial.C s) simp - letI : Algebra S E := extendedConstantAlgebra - letI : SMul S E := Algebra.toSMul - letI : Algebra S[X] E := + let : Algebra S E := extendedConstantAlgebra + let : SMul S E := Algebra.toSMul + let : Algebra S[X] E := constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] E := Algebra.toSMul - letI : IsScalarTower S[X] (RatFunc S) E := + let : SMul S[X] E := Algebra.toSMul + let : IsScalarTower S[X] (RatFunc S) E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -194,19 +194,19 @@ theorem exactConstantExtension_chart_genus_eq_of_presentedMultiplicity (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : IsScalarTower S S[X] E := + let : IsScalarTower S S[X] E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro s exact (hconstantMap s).trans (htensorPolynomialMap s)) intro hPresentedMultiplicity - letI : FunctionField.IsFullConstantField C N := + let : FunctionField.IsFullConstantField C N := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C N).2 hExact have hExtendedExact : algebraicClosure S E = (⊥ : IntermediateField S E) := exactConstantExtension_extended_algebraicClosure_eq_bot C S N hExact - letI : FunctionField.IsFullConstantField S E := + let : FunctionField.IsFullConstantField S E := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot S E).2 hExtendedExact have hTotalNat := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean index 8cf9022cc7..6cc4b06be4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean @@ -85,9 +85,9 @@ extension of the reciprocal coordinate on `N`. -/ theorem ratFuncToExactConstantExtension_reciprocal_X : ratFuncToExactConstantExtension C S N hExact (1 / RatFunc.X) = polynomialTensorCancelEvaluationPoint C S N := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact rw [one_div] have hrecip : polynomialTensorCancelEvaluationPoint C S N = @@ -117,9 +117,9 @@ theorem exactConstantExtensionReciprocalPolynomialAlgebra_eq : polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N = ratFuncExtensionReciprocalPolynomialAlgebra S (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact apply Algebra.algebra_ext intro p @@ -226,15 +226,15 @@ theorem exactConstantExtensionInfinityAffineNormalization_map_primeCompl : Algebra.algebraMapSubmonoid (integralClosure S[X] (ExactConstantExtension C N S)) (Ideal.span ({Polynomial.X} : Set S[X])).primeCompl := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra S[X] + let : Algebra S[X] (S ⊗[C] integralClosure C[X] N) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S (integralClosure C[X] N) - letI : Algebra S[X] (ExactConstantExtension C N S) := + let : Algebra S[X] (ExactConstantExtension C N S) := ratFuncExtensionReciprocalPolynomialAlgebra S (ExactConstantExtension C N S) let e := exactConstantExtensionInfinityAffineNormalizationAlgEquiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean index e2faee5847..b594c8762e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean @@ -114,14 +114,14 @@ private theorem (R := C) (A := S) (B := integralClosure C[X] N) x) : E) = Algebra.TensorProduct.includeRight (R := C) (A := S) (B := N) x.1 := by let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra S[X] + let : Algebra S[X] (S ⊗[C] integralClosure C[X] N) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S (integralClosure C[X] N) - letI : Algebra S[X] E := + let : Algebra S[X] E := ratFuncExtensionReciprocalPolynomialAlgebra S E let a := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S N let b := ratFuncExtensionReciprocalPolynomialAlgebra S E @@ -199,25 +199,25 @@ private theorem exactConstantExtensionInfinityAffineLocalizationSquare_coe let E := ExactConstantExtension C N S let R0 := integralClosure C[X] N let R2 := RatFuncInfinityIntegralClosure C N - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : Algebra (RatFunc S) E := + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra S[X] E := + let : Algebra S[X] E := ratFuncExtensionReciprocalPolynomialAlgebra S E let AS := integralClosure S[X] E - letI : Algebra S[X] (S ⊗[C] R0) := + let : Algebra S[X] (S ⊗[C] R0) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 let B := RatFuncInfinityIntegralClosure S E let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv C S N hExact - letI : Algebra R0 R2 := + let : Algebra R0 R2 := ratFuncInfinityReciprocalIntegralClosureAlgebra C N - letI : Algebra AS B := + let : Algebra AS B := ratFuncInfinityReciprocalIntegralClosureAlgebra S E - letI : Algebra R2 B := + let : Algebra R2 B := exactConstantExtensionInfinityNormalizationAlgebra C S N hExact calc (((algebraMap R2 B) ((algebraMap R0 R2) x) : B) : E) = @@ -268,13 +268,13 @@ private theorem exactConstantExtensionInfinityAffinePrime_under dsimp only let E := ExactConstantExtension C N S let R0 := integralClosure C[X] N - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : Algebra S[X] E := + let : Algebra S[X] E := ratFuncExtensionReciprocalPolynomialAlgebra S E let AS := integralClosure S[X] E - letI : Algebra S[X] (S ⊗[C] R0) := + let : Algebra S[X] (S ⊗[C] R0) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv C S N hExact @@ -284,7 +284,7 @@ private theorem exactConstantExtensionInfinityAffinePrime_under eAff.toRingEquiv.toRingHom.comp (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := R0)).toRingHom - letI : Algebra R0 AS := oldToAffine.toAlgebra + let : Algebra R0 AS := oldToAffine.toAlgebra ext x change eAff (Algebra.TensorProduct.includeRight @@ -337,32 +337,32 @@ theorem exactConstantExtensionUpstairsInfinityPlace_under let E := ExactConstantExtension C N S let R0 := integralClosure C[X] N let R2 := RatFuncInfinityIntegralClosure C N - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra N E := exactConstantExtensionAlgebra C N S - letI : SMul N E := Algebra.toSMul - letI : Module N E := Algebra.toModule - letI : IsScalarTower (RatFunc C) N E := + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : Algebra S[X] E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : Algebra S[X] E := ratFuncExtensionReciprocalPolynomialAlgebra S E - letI : SMul S[X] E := Algebra.toSMul - letI : Module S[X] E := Algebra.toModule + let : SMul S[X] E := Algebra.toSMul + let : Module S[X] E := Algebra.toModule let AS := integralClosure S[X] E - letI : Algebra S[X] (S ⊗[C] R0) := + let : Algebra S[X] (S ⊗[C] R0) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S R0 - letI : SMul S[X] (S ⊗[C] R0) := Algebra.toSMul + let : SMul S[X] (S ⊗[C] R0) := Algebra.toSMul let B := RatFuncInfinityIntegralClosure S E let eAff := exactConstantExtensionInfinityAffineNormalizationAlgEquiv C S N hExact @@ -373,25 +373,25 @@ theorem exactConstantExtensionUpstairsInfinityPlace_under eAff.toRingEquiv.toRingHom.comp (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := R0)).toRingHom - letI : Algebra R0 AS := oldToAffine.toAlgebra - letI : SMul R0 AS := Algebra.toSMul - letI : Algebra R0 R2 := + let : Algebra R0 AS := oldToAffine.toAlgebra + let : SMul R0 AS := Algebra.toSMul + let : Algebra R0 R2 := ratFuncInfinityReciprocalIntegralClosureAlgebra C N - letI : SMul R0 R2 := Algebra.toSMul - letI : Algebra AS B := + let : SMul R0 R2 := Algebra.toSMul + let : Algebra AS B := ratFuncInfinityReciprocalIntegralClosureAlgebra S E - letI : SMul AS B := Algebra.toSMul - letI : Algebra R2 B := + let : SMul AS B := Algebra.toSMul + let : Algebra R2 B := exactConstantExtensionInfinityNormalizationAlgebra C S N hExact - letI : SMul R2 B := Algebra.toSMul - letI : Module R2 B := Algebra.toModule - letI : Algebra R0 B := + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : Algebra R0 B := RingHom.toAlgebra ((algebraMap R2 B).comp (algebraMap R0 R2)) - letI : SMul R0 B := Algebra.toSMul - letI : IsScalarTower R0 R2 B := + let : SMul R0 B := Algebra.toSMul + let : IsScalarTower R0 R2 B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower R0 AS B := + let : IsScalarTower R0 AS B := IsScalarTower.of_algebraMap_eq' (by ext x change diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 1bcf716c93..9ccdd45886 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -84,19 +84,19 @@ private theorem finiteDimensional_exactConstantExtension_over_intermediateBase letI : Module L (ExactConstantExtension C N S) := Algebra.toModule FiniteDimensional L (ExactConstantExtension C N S) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower L N T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S let tensorEquiv := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N T := Module.Finite.equiv tensorEquiv - letI : Module.Finite L T := Module.Finite.trans N T + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S + let : Module.Finite N T := Module.Finite.equiv tensorEquiv + let : Module.Finite L T := Module.Finite.trans N T infer_instance /-- Compatibility of the rational-function and intermediate-base algebra @@ -114,14 +114,14 @@ private theorem exactConstantExtensionIntermediate_ratFuncBaseTower : letI : Module L (ExactConstantExtension C N S) := Algebra.toModule IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by let T := ExactConstantExtension C N S - letI : Algebra (RatFunc C) T := + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule apply IsScalarTower.of_algebraMap_eq' ext x change (1 : S) ⊗ₜ algebraMap (RatFunc C) N x = @@ -175,26 +175,26 @@ private theorem intermediateFrobeniusTwistField_ratFunc_tower letI : Module F (ExactConstantExtension C N S) := Algebra.toModule IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra F T := F.toAlgebra + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl apply IsScalarTower.of_algebraMap_eq' ext x calc @@ -228,24 +228,24 @@ theorem finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc letI : Module (RatFunc C) F := Algebra.toModule FiniteDimensional (RatFunc C) F := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : FiniteDimensional (RatFunc C) T := + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact let : Module.IsTorsionFree F T := by rw [Module.isTorsionFree_iff_algebraMap_injective] @@ -269,24 +269,24 @@ theorem isSeparable_intermediateFrobeniusTwistField_over_ratFunc letI : Module (RatFunc C) F := Algebra.toModule Algebra.IsSeparable (RatFunc C) F := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact exact Algebra.isSeparable_tower_bot_of_isSeparable (RatFunc C) F T @@ -324,8 +324,8 @@ theorem intermediateFrobeniusTwistOverFixedField_apply intermediateFrobeniusTwistOverFixedField C S N hExact L g x = exactConstantExtensionFrobeniusTwist C L N S hExact g x := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S change (exactConstantExtensionFrobeniusTwist C L N S hExact g).toEquiv x = _ rfl @@ -341,11 +341,11 @@ theorem intermediateFrobeniusTwistOverFixedField_zpowers_eq_top Subgroup.zpowers (intermediateFrobeniusTwistOverFixedField C S N hExact L g) = ⊤ := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : FiniteDimensional L T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : FiniteDimensional L T := finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact let sigma := exactConstantExtensionFrobeniusTwist C L N S hExact g @@ -383,9 +383,9 @@ private theorem intermediateFrobeniusTwist_zpow_includeLeft Algebra.TensorProduct.includeLeft (R := C) (S := C) (A := S) (B := N) (((FiniteField.frobeniusAlgEquivOfAlgebraic C S) ^ k) s) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S change ((exactConstantExtensionCombinedAutHom C L N S @@ -448,65 +448,65 @@ theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one finitePlaceRelativeRamificationIdx C F (ExactConstantExtension C N S) Q = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : FiniteDimensional L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : FiniteDimensional L T := finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : FiniteDimensional F T := + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C L N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C L N S hExact g - letI : Algebra C[X] F := + let : Algebra C[X] F := RingHom.toAlgebra ((algebraMap (RatFunc C) F).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C[X] (RatFunc C) F := + let : IsScalarTower C[X] (RatFunc C) F := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra C[X] T := + let : Algebra C[X] T := RingHom.toAlgebra ((algebraMap (RatFunc C) T).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C[X] (RatFunc C) T := + let : IsScalarTower C[X] (RatFunc C) T := IsScalarTower.of_algebraMap_eq' rfl let A := RatFuncFiniteIntegralClosure C T let AF := RatFuncFiniteIntegralClosure C F - letI : Algebra AF A := (finiteIntegralClosureMap C F T).toAlgebra - letI : SMul AF A := Algebra.toSMul - letI : Module AF A := Algebra.toModule - letI : Algebra S A := + let : Algebra AF A := (finiteIntegralClosureMap C F T).toAlgebra + let : SMul AF A := Algebra.toSMul + let : Module AF A := Algebra.toModule + let : Algebra S A := exactConstantExtensionFiniteIntegralClosureConstantAlgebra C N S hExact - letI : IsScalarTower AF F T := inferInstance - letI : Algebra.IsIntegral C[X] AF := + let : IsScalarTower AF F T := inferInstance + let : Algebra.IsIntegral C[X] AF := IsIntegralClosure.isIntegral_algebra C[X] F - letI : IsScalarTower C[X] AF T := by + let : IsScalarTower C[X] AF T := by apply IsScalarTower.of_algebraMap_eq intro x change algebraMap (RatFunc C) T @@ -514,20 +514,20 @@ theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one algebraMap F T (algebraMap (RatFunc C) F (algebraMap C[X] (RatFunc C) x)) exact IsScalarTower.algebraMap_apply (RatFunc C) F T _ - letI : IsScalarTower AF A T := + let : IsScalarTower AF A T := ⟨fun r t x => by simp only [Algebra.smul_def, map_mul] rw [show algebraMap A T (algebraMap AF A r) = algebraMap AF T r by rfl] ring⟩ - letI : IsIntegralClosure A AF T := + let : IsIntegralClosure A AF T := IsIntegralClosure.tower_top (R := C[X]) - letI : IsDedekindDomain A := inferInstance - letI : MulSemiringAction (T ≃ₐ[F] T) A := + let : IsDedekindDomain A := inferInstance + let : MulSemiringAction (T ≃ₐ[F] T) A := finiteIntegralClosureGalAction C F T dsimp only intro Q - letI : Q.asIdeal.IsMaximal := Q.isMaximal + let : Q.asIdeal.IsMaximal := Q.isMaximal rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C F T Q] have hInertia : finitePlaceInertiaGroup C F T Q = ⊥ := by ext tau @@ -656,40 +656,40 @@ private theorem finitePlaceUnder_intermediate_original (finitePlaceUnder C N (ExactConstantExtension C N S) Q) = finitePlaceUnder C L (ExactConstantExtension C N S) Q := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsScalarTower L N T := + let : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S let R₀ := RatFuncFiniteIntegralClosure C L let R₁ := RatFuncFiniteIntegralClosure C N let R₂ := RatFuncFiniteIntegralClosure C T - letI : Algebra R₀ R₁ := (finiteIntegralClosureMap C L N).toAlgebra - letI : Algebra R₁ R₂ := (finiteIntegralClosureMap C N T).toAlgebra - letI : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra - letI : SMul R₀ R₁ := Algebra.toSMul - letI : Module R₀ R₁ := Algebra.toModule - letI : SMul R₁ R₂ := Algebra.toSMul - letI : Module R₁ R₂ := Algebra.toModule - letI : SMul R₀ R₂ := Algebra.toSMul - letI : Module R₀ R₂ := Algebra.toModule - letI : IsScalarTower R₀ R₁ R₂ := by + let : Algebra R₀ R₁ := (finiteIntegralClosureMap C L N).toAlgebra + let : Algebra R₁ R₂ := (finiteIntegralClosureMap C N T).toAlgebra + let : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra + let : SMul R₀ R₁ := Algebra.toSMul + let : Module R₀ R₁ := Algebra.toModule + let : SMul R₁ R₂ := Algebra.toSMul + let : Module R₁ R₂ := Algebra.toModule + let : SMul R₀ R₂ := Algebra.toSMul + let : Module R₀ R₂ := Algebra.toModule + let : IsScalarTower R₀ R₁ R₂ := by apply IsScalarTower.of_algebraMap_eq' ext x change algebraMap L T (x : L) = @@ -734,24 +734,24 @@ private theorem exists_presentedFinitePlace_of_under_intermediate_rational : (exactConstantExtensionDownstairsFinitePlace C S N hExact q))) = 1 := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S intro Q hBase let e := exactConstantExtensionPresentedFinitePlaceEquiv C S N hExact @@ -809,33 +809,33 @@ theorem exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_intermediat finiteExtensionPlaceDegree C (ExactConstantExtension C N S) (.inl Q) = Module.finrank C S := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul N T := Algebra.toSMul - letI : Module N T := Algebra.toModule - letI : IsScalarTower (RatFunc C) N T := + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul N T := Algebra.toSMul + let : Module N T := Algebra.toModule + let : IsScalarTower (RatFunc C) N T := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S - letI : Algebra (RatFunc S) T := + let : IsScalarTower L N T := exactConstantExtensionBaseTower C L N S + let : Algebra (RatFunc S) T := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) T := Algebra.toSMul - letI : Module (RatFunc S) T := Algebra.toModule - letI : FiniteDimensional (RatFunc S) T := + let : SMul (RatFunc S) T := Algebra.toSMul + let : Module (RatFunc S) T := Algebra.toModule + let : FiniteDimensional (RatFunc S) T := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) T := + let : Algebra.IsSeparable (RatFunc S) T := isSeparable_over_extendedRatFunc C S N hExact intro Q hBase obtain ⟨q, heq, hBaseQ⟩ := @@ -928,24 +928,24 @@ theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under g.1)) = Nat.card (N ≃ₐ[L] N) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : FiniteDimensional L T := + let : FiniteDimensional L T := finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact - letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let : IsGalois L T := exactConstantExtension_isGalois C L N S hExact intro Q hBase obtain ⟨q, heq, hBaseQ⟩ := exists_presentedFinitePlace_of_under_intermediate_rational @@ -966,9 +966,9 @@ theorem intermediate_exactConstantExtensionFrobeniusFiberEquiv_apply_val ((exactConstantExtensionFrobeniusFiberEquiv C L N S hExact) g).1 = exactConstantExtensionFrobeniusTwist C L N S hExact g := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S rfl @@ -1008,31 +1008,31 @@ theorem sum_card_finitePlaceUnderFiber_fixedBy_intermediateFrobeniusTwist_eq_car Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy C S N hExact L g P)) = Nat.card (N ≃ₐ[L] N) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : FiniteDimensional L T := + let : FiniteDimensional L T := finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact - letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact - letI : Fintype (T ≃ₐ[L] T) := Fintype.ofFinite _ - letI := finiteIntegralClosureGalAction C L T - letI := finitePlaceUnderFiberGalAction C L T P.1 + let : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let : Fintype (T ≃ₐ[L] T) := Fintype.ofFinite _ + let := finiteIntegralClosureGalAction C L T + let := finitePlaceUnderFiberGalAction C L T P.1 let pi := exactConstantExtensionConstantQuotient C L N S hExact - letI : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ - letI : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ - letI : Fintype + let : DecidableEq (S ≃ₐ[C] S) := Classical.decEq _ + let : Fintype (S ≃ₐ[C] S) := Fintype.ofFinite _ + let : Fintype (pi ⁻¹' ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : Set (S ≃ₐ[C] S))) := Fintype.ofFinite _ obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective C L T P.1 @@ -1244,55 +1244,55 @@ private theorem finitePlaceUnder_intermediateFrobeniusTwist_under finitePlaceUnder C L F (finitePlaceUnder C F T Q) = finitePlaceUnder C L T Q := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul L F := Algebra.toSMul - letI : Module L F := Algebra.toModule - letI : IsScalarTower (RatFunc C) L F := + let : SMul L F := Algebra.toSMul + let : Module L F := Algebra.toModule + let : IsScalarTower (RatFunc C) L F := IsScalarTower.of_algebraMap_eq' rfl - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl let R₀ := RatFuncFiniteIntegralClosure C L let R₁ := RatFuncFiniteIntegralClosure C F let R₂ := RatFuncFiniteIntegralClosure C T - letI : Algebra R₀ R₁ := (finiteIntegralClosureMap C L F).toAlgebra - letI : Algebra R₁ R₂ := (finiteIntegralClosureMap C F T).toAlgebra - letI : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra - letI : SMul R₀ R₁ := Algebra.toSMul - letI : Module R₀ R₁ := Algebra.toModule - letI : SMul R₁ R₂ := Algebra.toSMul - letI : Module R₁ R₂ := Algebra.toModule - letI : SMul R₀ R₂ := Algebra.toSMul - letI : Module R₀ R₂ := Algebra.toModule - letI : IsScalarTower R₀ R₁ R₂ := by + let : Algebra R₀ R₁ := (finiteIntegralClosureMap C L F).toAlgebra + let : Algebra R₁ R₂ := (finiteIntegralClosureMap C F T).toAlgebra + let : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra + let : SMul R₀ R₁ := Algebra.toSMul + let : Module R₀ R₁ := Algebra.toModule + let : SMul R₁ R₂ := Algebra.toSMul + let : Module R₁ R₂ := Algebra.toModule + let : SMul R₀ R₂ := Algebra.toSMul + let : Module R₀ R₂ := Algebra.toModule + let : IsScalarTower R₀ R₁ R₂ := by apply IsScalarTower.of_algebraMap_eq' ext x change algebraMap L T (x : L) = @@ -1521,45 +1521,45 @@ theorem intermediateFrobeniusTwistFieldRationalFinitePlaceCount_eq_sum_fiberFixe Nat.card (IntermediateFrobeniusTwistFinitePlaceFiberFixedBy C S N hExact L g P) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : FiniteDimensional L T := + let : FiniteDimensional L T := finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact - letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let : IsGalois L T := exactConstantExtension_isGalois C L N S hExact let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : FiniteDimensional F T := + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C L N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C L N S hExact g change Nat.card (FiniteExtensionRationalFinitePlace C F) = _ @@ -1624,16 +1624,16 @@ theorem exactConstantExtensionFrobeniusTwist_restrictScalars_apply exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) x = exactConstantExtensionFrobeniusTwist C L N S hExact g x := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Algebra L (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule induction x using TensorProduct.induction_on with | zero => simp | tmul s n => @@ -1664,17 +1664,17 @@ theorem exactConstantExtensionFrobeniusTwist_restrictScalars (RatFunc C) = exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : SMul L (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module L (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule + let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul + let : Module L (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L ext x exact (exactConstantExtensionFrobeniusTwist_restrictScalars_apply diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean index f79ad362d7..6ef3a31018 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -113,7 +113,7 @@ theorem functionFieldNormalClosure_isGalois_over_constantRatFunc : let N := FunctionFieldNormalClosure K F let e : RatFunc C ≃ₐ[RatFunc C] B := functionFieldNormalClosureConstantBaseRatFuncSelfAlgEquiv K F - letI : IsGalois B N := + let : IsGalois B N := functionFieldNormalClosure_isGalois_over_constantBase K F refine IsGalois.of_equiv_equiv (F := B) (E := N) (f := e.symm.toRingEquiv) (g := RingEquiv.refl N) ?_ @@ -141,7 +141,7 @@ theorem functionFieldNormalClosureConstantField_isExact_for_constantRatFunc : have hfresh : fresh = old := by apply Algebra.algebra_ext intro c - letI : Algebra C N := old + let : Algebra C N := old change algebraMap B N (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K F (algebraMap C (RatFunc C) c)) = algebraMap C N c @@ -154,7 +154,7 @@ theorem functionFieldNormalClosureConstantField_isExact_for_constantRatFunc : functionFieldNormalClosureConstantField_isExact K F have hFresh : exactFor fresh := Eq.mp (congrArg exactFor hfresh).symm hOld - letI : Algebra C N := fresh + let : Algebra C N := fresh exact hFresh section OriginalCompositum @@ -255,7 +255,7 @@ theorem let C := FunctionFieldNormalClosureConstantField K F let B := FunctionFieldNormalClosureConstantBase K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact let old : Algebra C M := @@ -265,8 +265,8 @@ theorem have hfresh : fresh = old := by apply Algebra.algebra_ext intro c - letI : Algebra C M := old - letI : Algebra B M := + let : Algebra C M := old + let : Algebra B M := functionFieldNormalClosureConstantBaseOriginalCompositumAlgebra K F hExact change algebraMap B M @@ -282,7 +282,7 @@ theorem K F hExact have hFresh : exactFor fresh := Eq.mp (congrArg exactFor hfresh).symm hOld - letI : Algebra C M := fresh + let : Algebra C M := fresh exact hFresh /-- The original compositum remains separable over the canonical rational @@ -295,16 +295,16 @@ noncomputable instance (RatFunc (FunctionFieldNormalClosureConstantField K F)) (FunctionFieldNormalClosureOriginalCompositum K F hExact) := by let N := FunctionFieldNormalClosure K F - letI : Algebra K N := functionFieldNormalClosureConstantAlgebra K F + let : Algebra K N := functionFieldNormalClosureConstantAlgebra K F let C := FunctionFieldNormalClosureConstantField K F - letI : Algebra K C := + let : Algebra K C := SubalgebraClass.toAlgebra (algebraicClosure K N) let E := ExactConstantExtension K F C let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Field E := exactConstantExtensionField K F C hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField K F C hExact + let : Algebra (RatFunc C) E := ratFuncExactConstantExtensionAlgebra K C F hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_over_extendedRatFunc K C F hExact let e : E ≃ₐ[RatFunc C] M := exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv @@ -515,35 +515,35 @@ theorem functionFieldNormalClosureConstantExtension_ratFuncScalarTower let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact let N := FunctionFieldNormalClosure K F - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra (RatFunc C) N := + let : Algebra (RatFunc C) N := functionFieldNormalClosureConstantRatFuncAlgebra K F - letI : IsScalarTower (RatFunc C) M N := + let : IsScalarTower (RatFunc C) M N := functionFieldNormalClosureOriginalCompositumConstantRatFuncTower K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N let E_M := ExactConstantExtension C M S let E_N := ExactConstantExtension C N S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Field E_N := + let : Field E_N := functionFieldNormalClosureConstantExtensionFieldForTower K F S - letI : Algebra (RatFunc S) E_M := + let : Algebra (RatFunc S) E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra K F S hExact - letI : Algebra (RatFunc S) E_N := + let : Algebra (RatFunc S) E_N := functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower K F S - letI : Algebra E_M E_N := + let : Algebra E_M E_N := functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact - letI : SMul (RatFunc S) E_M := Algebra.toSMul - letI : SMul (RatFunc S) E_N := Algebra.toSMul - letI : SMul E_M E_N := Algebra.toSMul + let : SMul (RatFunc S) E_M := Algebra.toSMul + let : SMul (RatFunc S) E_N := Algebra.toSMul + let : SMul E_M E_N := Algebra.toSMul exact exactConstantExtensionTower_ratFuncScalarTower C M N S (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) @@ -573,37 +573,37 @@ theorem let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact let N := FunctionFieldNormalClosure K F - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra (RatFunc C) N := + let : Algebra (RatFunc C) N := functionFieldNormalClosureConstantRatFuncAlgebra K F - letI : IsScalarTower (RatFunc C) M N := + let : IsScalarTower (RatFunc C) M N := functionFieldNormalClosureOriginalCompositumConstantRatFuncTower K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N - letI : SMul C M := Algebra.toSMul - letI : SMul C N := Algebra.toSMul - letI : SMul M N := Algebra.toSMul - letI : IsScalarTower C M N := + let : SMul C M := Algebra.toSMul + let : SMul C N := Algebra.toSMul + let : SMul M N := Algebra.toSMul + let : IsScalarTower C M N := exactConstantExtensionTowerCanonicalConstantScalarTower C M N let E_M := ExactConstantExtension C M S let E_N := ExactConstantExtension C N S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Field E_N := + let : Field E_N := functionFieldNormalClosureConstantExtensionFieldForTower K F S - letI : Algebra E_M E_N := + let : Algebra E_M E_N := functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact - letI : Module E_M E_N := Algebra.toModule - letI : FiniteDimensional M N := + let : Module E_M E_N := Algebra.toModule + let : FiniteDimensional M N := functionFieldNormalClosure_finiteDimensional_over_originalCompositum K F hExact - letI : IsGalois M N := + let : IsGalois M N := functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact exact exactConstantExtensionTower_finiteDimensional C M N S (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) @@ -632,36 +632,36 @@ theorem functionFieldNormalClosureConstantExtension_isGalois let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact let N := FunctionFieldNormalClosure K F - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra (RatFunc C) N := + let : Algebra (RatFunc C) N := functionFieldNormalClosureConstantRatFuncAlgebra K F - letI : IsScalarTower (RatFunc C) M N := + let : IsScalarTower (RatFunc C) M N := functionFieldNormalClosureOriginalCompositumConstantRatFuncTower K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N - letI : SMul C M := Algebra.toSMul - letI : SMul C N := Algebra.toSMul - letI : SMul M N := Algebra.toSMul - letI : IsScalarTower C M N := + let : SMul C M := Algebra.toSMul + let : SMul C N := Algebra.toSMul + let : SMul M N := Algebra.toSMul + let : IsScalarTower C M N := exactConstantExtensionTowerCanonicalConstantScalarTower C M N let E_M := ExactConstantExtension C M S let E_N := ExactConstantExtension C N S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Field E_N := + let : Field E_N := functionFieldNormalClosureConstantExtensionFieldForTower K F S - letI : Algebra E_M E_N := + let : Algebra E_M E_N := functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact - letI : FiniteDimensional M N := + let : FiniteDimensional M N := functionFieldNormalClosure_finiteDimensional_over_originalCompositum K F hExact - letI : IsGalois M N := + let : IsGalois M N := functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact exact exactConstantExtensionTower_isGalois C M N S (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) @@ -694,40 +694,40 @@ theorem functionFieldNormalClosureConstantExtension_finrank let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact let N := FunctionFieldNormalClosure K F - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra (RatFunc C) N := + let : Algebra (RatFunc C) N := functionFieldNormalClosureConstantRatFuncAlgebra K F - letI : IsScalarTower (RatFunc C) M N := + let : IsScalarTower (RatFunc C) M N := functionFieldNormalClosureOriginalCompositumConstantRatFuncTower K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N - letI : SMul C M := Algebra.toSMul - letI : SMul C N := Algebra.toSMul - letI : SMul M N := Algebra.toSMul - letI : IsScalarTower C M N := + let : SMul C M := Algebra.toSMul + let : SMul C N := Algebra.toSMul + let : SMul M N := Algebra.toSMul + let : IsScalarTower C M N := exactConstantExtensionTowerCanonicalConstantScalarTower C M N let E_M := ExactConstantExtension C M S let E_N := ExactConstantExtension C N S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Field E_N := + let : Field E_N := functionFieldNormalClosureConstantExtensionFieldForTower K F S - letI : Algebra E_M E_N := + let : Algebra E_M E_N := functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact - letI : Module E_M E_N := Algebra.toModule - letI : Module.Finite E_M E_N := + let : Module E_M E_N := Algebra.toModule + let : Module.Finite E_M E_N := functionFieldNormalClosureConstantExtension_finiteDimensional K F S hExact - letI : FiniteDimensional M N := + let : FiniteDimensional M N := functionFieldNormalClosure_finiteDimensional_over_originalCompositum K F hExact - letI : IsGalois M N := + let : IsGalois M N := functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact exact exactConstantExtensionTower_finrank C M N S (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) @@ -762,42 +762,42 @@ theorem functionFieldNormalClosureConstantExtension_card_aut_eq let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact let N := FunctionFieldNormalClosure K F - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra (RatFunc C) N := + let : Algebra (RatFunc C) N := functionFieldNormalClosureConstantRatFuncAlgebra K F - letI : IsScalarTower (RatFunc C) M N := + let : IsScalarTower (RatFunc C) M N := functionFieldNormalClosureOriginalCompositumConstantRatFuncTower K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N - letI : SMul C M := Algebra.toSMul - letI : SMul C N := Algebra.toSMul - letI : SMul M N := Algebra.toSMul - letI : IsScalarTower C M N := + let : SMul C M := Algebra.toSMul + let : SMul C N := Algebra.toSMul + let : SMul M N := Algebra.toSMul + let : IsScalarTower C M N := exactConstantExtensionTowerCanonicalConstantScalarTower C M N let E_M := ExactConstantExtension C M S let E_N := ExactConstantExtension C N S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Field E_N := + let : Field E_N := functionFieldNormalClosureConstantExtensionFieldForTower K F S - letI : Algebra E_M E_N := + let : Algebra E_M E_N := functionFieldNormalClosureConstantExtensionTowerAlgebra K F S hExact - letI : Module E_M E_N := Algebra.toModule - letI : Module.Finite E_M E_N := + let : Module E_M E_N := Algebra.toModule + let : Module.Finite E_M E_N := functionFieldNormalClosureConstantExtension_finiteDimensional K F S hExact - letI : IsGalois E_M E_N := + let : IsGalois E_M E_N := functionFieldNormalClosureConstantExtension_isGalois K F S hExact - letI : FiniteDimensional M N := + let : FiniteDimensional M N := functionFieldNormalClosure_finiteDimensional_over_originalCompositum K F hExact - letI : IsGalois M N := + let : IsGalois M N := functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact exact exactConstantExtensionTower_card_aut_eq C M N S (functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F) @@ -841,34 +841,34 @@ theorem exactConstantExtensionClosedPlaceExtensionCount C S M hExactM 1 := by let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M let hExactM := functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc K F hExact let E_M := ExactConstantExtension C M S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Algebra (RatFunc S) E_M := + let : Algebra (RatFunc S) E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra K F S hExact - letI : Module (RatFunc S) E_M := Algebra.toModule - letI : Module.Finite (RatFunc S) E_M := + let : Module (RatFunc S) E_M := Algebra.toModule + let : Module.Finite (RatFunc S) E_M := finiteDimensional_over_extendedRatFunc C S M hExactM - letI : Algebra.IsSeparable (RatFunc S) E_M := + let : Algebra.IsSeparable (RatFunc S) E_M := isSeparable_over_extendedRatFunc C S M hExactM - letI : Fintype C := Fintype.ofFinite C - letI : Finite S := Module.finite_of_finite C - letI : Fintype S := + let : Fintype C := Fintype.ofFinite C + let : Finite S := Module.finite_of_finite C + let : Fintype S := Fintype.ofFinite S - letI : DecidableEq C := Classical.decEq C - letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) - letI : DecidableEq S := Classical.decEq S - letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + let : DecidableEq C := Classical.decEq C + let : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + let : DecidableEq S := Classical.decEq S + let : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) exact (exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount C S M hExactM).symm @@ -922,24 +922,24 @@ theorem K C F hExact (Module.finrank C S) := by classical let N := FunctionFieldNormalClosure K F - letI : Algebra K N := functionFieldNormalClosureConstantAlgebra K F + let : Algebra K N := functionFieldNormalClosureConstantAlgebra K F let C := FunctionFieldNormalClosureConstantField K F - letI : Algebra K C := + let : Algebra K C := SubalgebraClass.toAlgebra (algebraicClosure K N) - letI : Module.Finite K C := + let : Module.Finite K C := functionFieldConstantField_finiteDimensional K N - letI : IsGalois K C := functionFieldConstantField_isGalois K N + let : IsGalois K C := functionFieldConstantField_isGalois K N let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M let hExactM := functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc K F hExact let E_M := ExactConstantExtension C M S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact letI : Algebra (RatFunc S) E_M := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean index 2b04a1f57a..823ba3fcb5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean @@ -47,8 +47,8 @@ theorem exactConstantExtensionConstantQuotient_combined letI := exactConstantExtensionBaseAlgebra C L N S exactConstantExtensionConstantQuotient C L N S hExact (exactConstantExtensionCombinedAutHom C L N S (σ, g)) = σ := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S let e := exactConstantExtensionAutMulEquiv C L N S hExact change (e.symm (e (σ, g))).1 = σ rw [e.symm_apply_apply] @@ -68,8 +68,8 @@ theorem exactConstantExtensionConstantQuotient_action_on_constants Algebra.TensorProduct.includeLeft (R := C) (S := C) (A := S) (B := N) (exactConstantExtensionConstantQuotient C L N S hExact g s) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S let e := exactConstantExtensionAutMulEquiv C L N S hExact let p := e.symm g have hgp : e p = g := e.apply_symm_apply g @@ -98,8 +98,8 @@ theorem exactConstantExtensionConstantQuotient_surjective letI := exactConstantExtensionBaseAlgebra C L N S Function.Surjective (exactConstantExtensionConstantQuotient C L N S hExact) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S intro σ refine ⟨exactConstantExtensionCombinedAutHom C L N S (σ, (1 : N ≃ₐ[L] N)), ?_⟩ @@ -115,8 +115,8 @@ theorem exactConstantExtensionConstantQuotient_ker : (exactConstantExtensionConstantQuotient C L N S hExact).ker = (exactConstantExtensionFunctionAutHom C L N S).range := by intro hExact - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S ext x constructor · intro hx @@ -151,7 +151,7 @@ omit [FiniteDimensional C S] [IsGalois C S] theorem exactConstantExtensionConstantAutHom_injective : letI := exactConstantExtensionBaseAlgebra C L N S Function.Injective (exactConstantExtensionConstantAutHom C L N S) := by - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionBaseAlgebra C L N S intro σ τ h have hpair := exactConstantExtensionCombinedAutHom_injective C L N S (show exactConstantExtensionCombinedAutHom C L N S @@ -179,7 +179,7 @@ theorem orderOf_exactConstantExtensionFrobenius : letI := exactConstantExtensionBaseAlgebra C L N S orderOf (exactConstantExtensionFrobenius C L N S) = Module.finrank C S := by - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionBaseAlgebra C L N S change orderOf ((exactConstantExtensionConstantAutHom C L N S) (FiniteField.frobeniusAlgEquivOfAlgebraic C S)) = _ rw [orderOf_injective (exactConstantExtensionConstantAutHom C L N S) @@ -196,8 +196,8 @@ theorem exactConstantExtensionConstantQuotient_frobenius exactConstantExtensionConstantQuotient C L N S hExact (exactConstantExtensionFrobenius C L N S) = FiniteField.frobeniusAlgEquivOfAlgebraic C S := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S have h := exactConstantExtensionConstantQuotient_combined C L N S hExact (FiniteField.frobeniusAlgEquivOfAlgebraic C S) (1 : N ≃ₐ[L] N) @@ -247,8 +247,8 @@ theorem natCard_exactConstantExtensionFrobeniusFiber ({FiniteField.frobeniusAlgEquivOfAlgebraic C S} : Set (S ≃ₐ[C] S))) = Nat.card (N ≃ₐ[L] N) := by - letI := exactConstantExtensionField C N S hExact - letI := exactConstantExtensionBaseAlgebra C L N S + let := exactConstantExtensionField C N S hExact + let := exactConstantExtensionBaseAlgebra C L N S exact Nat.card_congr (exactConstantExtensionFrobeniusFiberEquiv C L N S hExact).symm diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean index 26824d15eb..8861a9c316 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean @@ -57,14 +57,14 @@ theorem exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCoun exact finiteExtensionRationalPlaceCount S E) := by classical let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : FiniteDimensional (RatFunc S) E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact change exactConstantExtensionClosedPlaceExtensionCount C S N hExact 1 = finiteExtensionRationalPlaceCount S E diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean index fea0ac4586..eb12cfca35 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean @@ -117,25 +117,25 @@ theorem exactConstantExtension_totalDifferentDegree_eq_of_presentedMultiplicity infinityDifferentDegree C N := by dsimp only let E := ExactConstantExtension C N S - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) E := Algebra.toSMul - letI : Module (RatFunc C) E := Algebra.toModule - letI : FiniteDimensional (RatFunc C) E := + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : Algebra S[X] E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : Algebra S[X] E := constantExtensionTensorPolynomialAlgebra C S N - letI : SMul S[X] E := Algebra.toSMul - letI : Module S[X] E := Algebra.toModule - letI : IsScalarTower S[X] (RatFunc S) E := + let : SMul S[X] E := Algebra.toSMul + let : Module S[X] E := Algebra.toModule + let : IsScalarTower S[X] (RatFunc S) E := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ intro p @@ -144,9 +144,9 @@ theorem exactConstantExtension_totalDifferentDegree_eq_of_presentedMultiplicity (algebraMap S[X] (RatFunc S) p) exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact intro hPresentedMultiplicity let Base := FiniteExtensionPlace C N diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean index aafa15f8ee..b46ac7f5ff 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean @@ -81,11 +81,11 @@ theorem exactConstantExtensionTower_leftScalarTower : exactConstantExtensionTowerAlgebra C M N S IsScalarTower S (ExactConstantExtension C M S) (ExactConstantExtension C N S) := by - letI : Algebra S (ExactConstantExtension C M S) := + let : Algebra S (ExactConstantExtension C M S) := Algebra.TensorProduct.leftAlgebra - letI : Algebra S (ExactConstantExtension C N S) := + let : Algebra S (ExactConstantExtension C N S) := Algebra.TensorProduct.leftAlgebra - letI : Algebra (ExactConstantExtension C M S) + let : Algebra (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTowerAlgebra C M N S apply IsScalarTower.of_algebraMap_eq' @@ -112,15 +112,15 @@ theorem exactConstantExtensionTower_rightScalarTower IsScalarTower M (ExactConstantExtension C M S) (ExactConstantExtension C N S) := by let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN - letI : Field (ExactConstantExtension C M S) := + let : Field (ExactConstantExtension C M S) := exactConstantExtensionField C M S hExactM - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExactN - letI : Algebra M (ExactConstantExtension C M S) := + let : Algebra M (ExactConstantExtension C M S) := exactConstantExtensionAlgebra C M S - letI : Algebra M (ExactConstantExtension C N S) := + let : Algebra M (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C M N S - letI : Algebra (ExactConstantExtension C M S) + let : Algebra (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTowerAlgebra C M N S apply IsScalarTower.of_algebraMap_eq' @@ -152,30 +152,30 @@ theorem exactConstantExtensionTower_finiteDimensional FiniteDimensional (ExactConstantExtension C M S) (ExactConstantExtension C N S) := by let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN - letI : Field (ExactConstantExtension C M S) := + let : Field (ExactConstantExtension C M S) := exactConstantExtensionField C M S hExactM - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExactN - letI : Algebra M (ExactConstantExtension C M S) := + let : Algebra M (ExactConstantExtension C M S) := exactConstantExtensionAlgebra C M S - letI : Algebra M (ExactConstantExtension C N S) := + let : Algebra M (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C M N S - letI : Algebra (ExactConstantExtension C M S) + let : Algebra (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTowerAlgebra C M N S - letI : IsScalarTower M (ExactConstantExtension C M S) + let : IsScalarTower M (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTower_rightScalarTower C M N S hExactN - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : IsScalarTower M N (ExactConstantExtension C N S) := + let : IsScalarTower M N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C M N S let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite M (ExactConstantExtension C N S) := + let : Module.Finite M (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) exact Module.Finite.of_restrictScalars_finite M (ExactConstantExtension C M S) (ExactConstantExtension C N S) @@ -198,21 +198,21 @@ theorem exactConstantExtensionTower_isGalois IsGalois (ExactConstantExtension C M S) (ExactConstantExtension C N S) := by let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN - letI : Field (ExactConstantExtension C M S) := + let : Field (ExactConstantExtension C M S) := exactConstantExtensionField C M S hExactM - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExactN - letI : Algebra M (ExactConstantExtension C M S) := + let : Algebra M (ExactConstantExtension C M S) := exactConstantExtensionAlgebra C M S - letI : Algebra M (ExactConstantExtension C N S) := + let : Algebra M (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C M N S - letI : Algebra (ExactConstantExtension C M S) + let : Algebra (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTowerAlgebra C M N S - letI : IsScalarTower M (ExactConstantExtension C M S) + let : IsScalarTower M (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTower_rightScalarTower C M N S hExactN - letI : IsGalois M (ExactConstantExtension C N S) := + let : IsGalois M (ExactConstantExtension C N S) := exactConstantExtension_isGalois C M N S hExactN exact IsGalois.tower_top_of_isGalois M (ExactConstantExtension C M S) (ExactConstantExtension C N S) @@ -238,21 +238,21 @@ theorem exactConstantExtensionTower_finrank Module.finrank (ExactConstantExtension C M S) (ExactConstantExtension C N S) = Module.finrank M N := by let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN - letI : Field (ExactConstantExtension C M S) := + let : Field (ExactConstantExtension C M S) := exactConstantExtensionField C M S hExactM - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExactN - letI : Algebra M (ExactConstantExtension C M S) := + let : Algebra M (ExactConstantExtension C M S) := exactConstantExtensionAlgebra C M S - letI : Algebra M (ExactConstantExtension C N S) := + let : Algebra M (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C M N S - letI : Algebra (ExactConstantExtension C M S) + let : Algebra (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTowerAlgebra C M N S - letI : IsScalarTower M (ExactConstantExtension C M S) + let : IsScalarTower M (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTower_rightScalarTower C M N S hExactN - letI : FiniteDimensional (ExactConstantExtension C M S) + let : FiniteDimensional (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTower_finiteDimensional C M N S hExactN apply Nat.eq_of_mul_eq_mul_left (Module.finrank_pos (R := C) (M := S)) @@ -296,21 +296,21 @@ theorem exactConstantExtensionTower_card_aut_eq ExactConstantExtension C M S] ExactConstantExtension C N S) = Nat.card (N ≃ₐ[M] N) := by let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN - letI : Field (ExactConstantExtension C M S) := + let : Field (ExactConstantExtension C M S) := exactConstantExtensionField C M S hExactM - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExactN - letI : Algebra M (ExactConstantExtension C M S) := + let : Algebra M (ExactConstantExtension C M S) := exactConstantExtensionAlgebra C M S - letI : Algebra M (ExactConstantExtension C N S) := + let : Algebra M (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C M N S - letI : Algebra (ExactConstantExtension C M S) + let : Algebra (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTowerAlgebra C M N S - letI : FiniteDimensional (ExactConstantExtension C M S) + let : FiniteDimensional (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTower_finiteDimensional C M N S hExactN - letI : IsGalois (ExactConstantExtension C M S) + let : IsGalois (ExactConstantExtension C M S) (ExactConstantExtension C N S) := exactConstantExtensionTower_isGalois C M N S hExactN rw [IsGalois.card_aut_eq_finrank, IsGalois.card_aut_eq_finrank, @@ -348,9 +348,9 @@ theorem exactConstantExtensionTowerCanonicalConstantScalarTower : letI : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N IsScalarTower C M N := by - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N apply IsScalarTower.of_algebraMap_eq' ext c @@ -508,24 +508,24 @@ theorem exactConstantExtensionTower_ratFuncScalarTower letI : Algebra E_M E_N := exactConstantExtensionTowerRatFuncAlgebra C M N S IsScalarTower (RatFunc S) E_M E_N := by - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : Algebra C N := + let : Algebra C N := exactConstantExtensionTowerCanonicalConstantAlgebra C N - letI : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by + let : IsScalarTower C M N := IsScalarTower.of_algebraMap_eq' (by ext c exact IsScalarTower.algebraMap_apply (RatFunc C) M N (algebraMap C (RatFunc C) c)) let hExactM := algebraicClosure_eq_bot_of_tower C M N hExactN let E_M := ExactConstantExtension C M S let E_N := ExactConstantExtension C N S - letI : Field E_M := exactConstantExtensionField C M S hExactM - letI : Field E_N := exactConstantExtensionField C N S hExactN - letI : Algebra (RatFunc S) E_M := + let : Field E_M := exactConstantExtensionField C M S hExactM + let : Field E_N := exactConstantExtensionField C N S hExactN + let : Algebra (RatFunc S) E_M := ratFuncExactConstantExtensionAlgebra C S M hExactM - letI : Algebra (RatFunc S) E_N := + let : Algebra (RatFunc S) E_N := ratFuncExactConstantExtensionAlgebra C S N hExactN - letI : Algebra E_M E_N := + let : Algebra E_M E_N := exactConstantExtensionTowerRatFuncAlgebra C M N S apply IsScalarTower.of_algebraMap_eq' ext r diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean index 9a3163448c..296ee5ca08 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean @@ -80,11 +80,11 @@ theorem finrank_evenExtension_over_halfExtension : let E := FiniteField.Extension K p n let S := FiniteField.Extension K p (2 * n) let ι : E →ₐ[K] S := halfExtensionToEvenExtensionAlgHom K p n - letI : Algebra E S := ι.toAlgebra - letI : IsScalarTower K E S := IsScalarTower.of_algebraMap_eq' (by + let : Algebra E S := ι.toAlgebra + let : IsScalarTower K E S := IsScalarTower.of_algebraMap_eq' (by ext c exact (ι.commutes c).symm) - letI : Module.Finite E S := Module.Finite.of_finite + let : Module.Finite E S := Module.Finite.of_finite have hmul : Module.finrank K E * Module.finrank E S = Module.finrank K S := Module.finrank_mul_finrank K E S rw [FiniteField.finrank_extension K p n, @@ -123,13 +123,13 @@ theorem extensionAffinePointCount_two_mul_le_stepanov let E := FiniteField.Extension K p n let S := FiniteField.Extension K p (2 * n) let ι : E →ₐ[K] S := halfExtensionToEvenExtensionAlgHom K p n - letI : Algebra E S := ι.toAlgebra - letI : IsScalarTower K E S := IsScalarTower.of_algebraMap_eq' (by + let : Algebra E S := ι.toAlgebra + let : IsScalarTower K E S := IsScalarTower.of_algebraMap_eq' (by ext c exact (ι.commutes c).symm) - letI : Module.Finite E S := Module.Finite.of_finite - letI : Fintype E := Fintype.ofFinite E - letI : Fintype S := Fintype.ofFinite S + let : Module.Finite E S := Module.Finite.of_finite + let : Fintype E := Fintype.ofFinite E + let : Fintype S := Fintype.ofFinite S let fS : MvPolynomial (Fin 2) S := extensionPlaneCurvePolynomial K p (2 * n) f have hfinrank : Module.finrank E S = 2 := @@ -167,12 +167,12 @@ theorem extensionAffinePointCount_two_mul_le_stepanov (MvPolynomial.map (algebraMap S (AlgebraicClosure S)) fS) := by exact extensionPlaneCurvePolynomial_absolutelyIrreducible K p (2 * n) f habsolute - letI : IsDomain (PlaneCurveCoordinateRing fS) := + let : IsDomain (PlaneCurveCoordinateRing fS) := planeCurveCoordinateRing_isDomain hfS let hx := firstCoordinate_transcendental hfS (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecondS) let L := PlaneCurveFunctionField fS - letI : Algebra (RatFunc S) L := + let : Algebra (RatFunc S) L := planeCurveFirstCoordinateRatFuncAlgebra fS hx let canonicalAlg : Algebra S L := inferInstance let constantAlg : Algebra S L := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean index 128fcfc8e2..394c4d2abc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean @@ -79,11 +79,11 @@ theorem onePointFiltration_moduleFinite_and_finrank_le | zero => exact ⟨inferInstance, by simp⟩ | succ n ih => - letI : Module.Finite K (R n) := ih.1 + let : Module.Finite K (R n) := ih.1 have hfinite : Module.Finite K (R (n + 1)) := moduleFinite_of_exists_sub_smul_mem (hnested n) (hpivot n) (hmod n) - letI : Module.Finite K (R (n + 1)) := hfinite + let : Module.Finite K (R (n + 1)) := hfinite refine ⟨hfinite, ?_⟩ calc Module.finrank K (R (n + 1)) ≤ Module.finrank K (R n) + 1 := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean index 2a2decd6ef..e5fac973e9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean @@ -222,7 +222,7 @@ local instance branchFiniteFractionRingSeparable : Algebra.IsSeparable (FractionRing (RatFuncFiniteIntegralClosure K M)) (FractionRing (RatFuncFiniteIntegralClosure K L)) := by - letI : Algebra.IsSeparable M L := + let : Algebra.IsSeparable M L := Algebra.isSeparable_tower_top_of_isSeparable (RatFunc K) M L refine Algebra.IsSeparable.of_equiv_equiv (FractionRing.algEquiv (RatFuncFiniteIntegralClosure K M) M).symm.toRingEquiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean index 1e814dc83a..2c0564cf6e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean @@ -51,9 +51,9 @@ theorem ratFuncPolynomial_hasFiniteQuotients : have hspan : Ideal.span ({g} : Set K[X]) ≤ I := by rw [Ideal.span_le, Set.singleton_subset_iff] exact hgI - letI : Module.Finite K (K[X] ⧸ Ideal.span ({g} : Set K[X])) := + let : Module.Finite K (K[X] ⧸ Ideal.span ({g} : Set K[X])) := hgmonic.finite_quotient - letI : Finite (K[X] ⧸ Ideal.span ({g} : Set K[X])) := + let : Finite (K[X] ⧸ Ideal.span ({g} : Set K[X])) := Module.finite_of_finite K exact Finite.of_surjective (Ideal.Quotient.factor hspan) (Ideal.Quotient.factor_surjective hspan) @@ -88,7 +88,7 @@ local instance affineIdealClosureConstantTower : finite quotients. -/ theorem ratFuncFiniteIntegralClosure_hasFiniteQuotients : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := by - letI : Ring.HasFiniteQuotients K[X] := + let : Ring.HasFiniteQuotients K[X] := ratFuncPolynomial_hasFiniteQuotients K exact Ring.HasFiniteQuotients.of_module_finite K[X] (RatFuncFiniteIntegralClosure K L) @@ -97,7 +97,7 @@ theorem ratFuncFiniteIntegralClosure_hasFiniteQuotients : number theorem from Mathlib, stated at the normalization used by BGS. -/ theorem finiteExtensionAffineClassGroup_finite : Finite (ClassGroup (RatFuncFiniteIntegralClosure K L)) := by - letI : Fintype (ClassGroup (RatFuncFiniteIntegralClosure K L)) := + let : Fintype (ClassGroup (RatFuncFiniteIntegralClosure K L)) := inferInstance exact Fintype.finite inferInstance @@ -128,15 +128,15 @@ theorem finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree (I : FiniteExtensionAffineIdeal K L) : (I : Ideal (RatFuncFiniteIntegralClosure K L)).cardQuot = Fintype.card K ^ finiteExtensionAffineIdealDegree K L I := by - letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + let : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := ratFuncFiniteIntegralClosure_hasFiniteQuotients K L have hI : (I : Ideal (RatFuncFiniteIntegralClosure K L)) ≠ ⊥ := by rw [← Ideal.zero_eq_bot] exact mem_nonZeroDivisors_iff_ne_zero.mp I.property - letI : Finite (RatFuncFiniteIntegralClosure K L ⧸ + let : Finite (RatFuncFiniteIntegralClosure K L ⧸ (I : Ideal (RatFuncFiniteIntegralClosure K L))) := Ring.HasFiniteQuotients.finiteQuotient hI - letI : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ + let : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ (I : Ideal (RatFuncFiniteIntegralClosure K L))) := Module.Finite.of_finite rw [Submodule.cardQuot_apply, finiteExtensionAffineIdealDegree, @@ -154,15 +154,15 @@ theorem finiteExtensionAffineIdealDegree_eq_zero_iff rw [finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree K L I, hdegree, pow_zero] · intro hI - letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + let : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := ratFuncFiniteIntegralClosure_hasFiniteQuotients K L have hne : (I : Ideal (RatFuncFiniteIntegralClosure K L)) ≠ ⊥ := by rw [← Ideal.zero_eq_bot] exact mem_nonZeroDivisors_iff_ne_zero.mp I.property - letI : Finite (RatFuncFiniteIntegralClosure K L ⧸ + let : Finite (RatFuncFiniteIntegralClosure K L ⧸ (I : Ideal (RatFuncFiniteIntegralClosure K L))) := Ring.HasFiniteQuotients.finiteQuotient hne - letI : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ + let : Module.Finite K (RatFuncFiniteIntegralClosure K L ⧸ (I : Ideal (RatFuncFiniteIntegralClosure K L))) := Module.Finite.of_finite rw [finiteExtensionAffineIdealDegree, hI] @@ -173,7 +173,7 @@ degree. -/ theorem finite_setOf_finiteExtensionAffineIdealDegree_eq (n : ℕ) : {I : FiniteExtensionAffineIdeal K L | finiteExtensionAffineIdealDegree K L I = n}.Finite := by - letI : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := + let : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := ratFuncFiniteIntegralClosure_hasFiniteQuotients K L apply Set.Finite.of_injOn (f := fun I : FiniteExtensionAffineIdeal K L => @@ -181,7 +181,7 @@ theorem finite_setOf_finiteExtensionAffineIdealDegree_eq (n : ℕ) : (t := {J : Ideal (RatFuncFiniteIntegralClosure K L) | J.cardQuot ≤ Fintype.card K ^ n}) · intro I hI - simp only [Set.mem_setOf_eq] at hI ⊢ + simp only [Set.mem_ofPred_eq] at hI ⊢ rw [finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree K L I, hI] · intro I _ J _ hIJ exact Subtype.ext hIJ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean index 4c05a6ab41..330719b510 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean @@ -305,10 +305,10 @@ theorem finiteExtensionFinitePlace_cardQuot_eq_card_pow_degree (v : FiniteExtensionFinitePlace K L) : v.asIdeal.cardQuot = Fintype.card K ^ Module.finrank K v.asIdeal.ResidueField := by - letI : DecidableEq K := Classical.decEq K - letI : Finite v.asIdeal.ResidueField := + let : DecidableEq K := Classical.decEq K + let : Finite v.asIdeal.ResidueField := finiteExtensionFinitePlaceResidueField_finite K L v - letI : Module.Finite K v.asIdeal.ResidueField := + let : Module.Finite K v.asIdeal.ResidueField := Module.Finite.of_finite calc v.asIdeal.cardQuot = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean index 1d794ab995..a4e78003d6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean @@ -402,7 +402,7 @@ theorem finiteExtensionUnderPlace_finite_preimage_singleton · have hfiber : Set.Finite {q : FiniteExtensionFinitePlace K L | q.under K[X] = p} := by rw [← Set.finite_coe_iff] - letI : Finite + let : Finite (p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := Set.finite_coe_iff.mpr (IsDedekindDomain.primesOver_finite p.asIdeal @@ -420,7 +420,7 @@ theorem finiteExtensionUnderPlace_finite_preimage_singleton finiteExtensionUnderPlace, Sum.inl.injEq] using hq · simp only [Set.mem_preimage, Set.mem_singleton_iff, finiteExtensionUnderPlace, Sum.inr.injEq, reduceCtorEq] at hq - · letI : Finite (FiniteExtensionInfinityPlace K L) := + · let : Finite (FiniteExtensionInfinityPlace K L) := Set.finite_coe_iff.mpr (IsDedekindDomain.primesOver_finite (ratFuncInfinityPlace K).asIdeal @@ -463,7 +463,7 @@ theorem finiteExtensionUnderPlaceChart_surjective : properties. -/ theorem finiteExtensionUnderPlaceChart_tendstoCofinite : Filter.TendstoCofinite (finiteExtensionUnderPlaceChart K L) := by - letI : Filter.TendstoCofinite (finiteExtensionUnderPlace K L) := + let : Filter.TendstoCofinite (finiteExtensionUnderPlace K L) := finiteExtensionUnderPlace_tendstoCofinite K L change Filter.TendstoCofinite ((ratFuncExhaustivePlaceEquivChart K) ∘ @@ -1009,7 +1009,7 @@ theorem finiteExtensionFiberTrace_infinite_valuation_le_exp_neg_two (FractionalIdeal.spanSingleton (RatFuncInfinityIntegralClosure K L)⁰ z) := by intro q hqUnder - letI : q.asIdeal.LiesOver pInf.asIdeal := ⟨by + let : q.asIdeal.LiesOver pInf.asIdeal := ⟨by have hideal := congrArg HeightOneSpectrum.asIdeal hqUnder exact hideal.symm⟩ let P : FiniteExtensionInfinityPlace K L := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean index 74f8ef374a..cfd0608dfb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean @@ -115,15 +115,15 @@ theorem planeCurve_canonicalDifferentDivisor_degree_le_two_genusBudget_sub_two (finiteExtensionFiniteDifferentIdeal_ne_bot K (PlaneCurveFunctionField f))) ≤ 2 * (planeCurveBidegreeGenusBudget f : ℤ) - 2 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hcanonical := planeCurve_canonicalDifferentDivisor_degree_le diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean index dd214decdd..3a598214f7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean @@ -572,7 +572,7 @@ theorem finiteExtensionFiberCotrace_detects_infinity_excess have hqHUnder : qH.under (RatFuncInfinityIntegers K) = pInf := by apply HeightOneSpectrum.ext exact (Ideal.over_def P.1 pInf.asIdeal).symm - letI : qH.asIdeal.LiesOver pInf.asIdeal := ⟨by + let : qH.asIdeal.LiesOver pInf.asIdeal := ⟨by have hideal := congrArg HeightOneSpectrum.asIdeal hqHUnder exact hideal.symm⟩ have hqCount := hz₀Count qH hqHUnder diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean index c66288acc8..abb56e9b69 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean @@ -66,8 +66,8 @@ theorem finiteExtensionClosedPlaceExtensionCount_eq_of_algEquiv (e : L ≃ₐ[RatFunc K] M) (r : ℕ) : finiteExtensionClosedPlaceExtensionCount K L r = finiteExtensionClosedPlaceExtensionCount K M r := by - letI := finiteExtensionPlaceDegreeLEFintype K L r - letI := finiteExtensionPlaceDegreeLEFintype K M r + let := finiteExtensionPlaceDegreeLEFintype K L r + let := finiteExtensionPlaceDegreeLEFintype K M r rw [finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd, finiteExtensionClosedPlaceExtensionCount_eq_sum_degree_dvd] apply Fintype.sum_equiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean index c6a97d148e..9005d99dba 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean @@ -264,13 +264,13 @@ theorem finiteExtensionEffectiveDivisorClassOfDegree_surjective_of_uniformRieman have hRdegree : finiteExtensionDivisorDegree K L R = (n : ℤ) := finiteExtensionDivisorClassRepresentative_degree K L c have hdata := hRiemann.2 R n hn hRdegree - letI : Module.Finite K (finiteExtensionRiemannSpace K L R) := hdata.1 + let : Module.Finite K (finiteExtensionRiemannSpace K L R) := hdata.1 have hpositive : 0 < Module.finrank K (finiteExtensionRiemannSpace K L R) := by rw [hdata.2] have hg := hRiemann.1 omega - letI : Nontrivial (finiteExtensionRiemannSpace K L R) := + let : Nontrivial (finiteExtensionRiemannSpace K L R) := Module.finrank_pos_iff.mp hpositive obtain ⟨x, hx⟩ := exists_ne (0 : finiteExtensionRiemannSpace K L R) let E : EffectiveDivisorInPrincipalClass K L R := @@ -305,8 +305,8 @@ theorem finiteExtensionEffectiveDivisorClassFiber_finite_of_uniformRiemann have hRdegree : finiteExtensionDivisorDegree K L R = (n : ℤ) := finiteExtensionDivisorClassRepresentative_degree K L c have hdata := hRiemann.2 R n hn hRdegree - letI : Module.Finite K (finiteExtensionRiemannSpace K L R) := hdata.1 - letI : Finite (finiteExtensionRiemannSpace K L R) := + let : Module.Finite K (finiteExtensionRiemannSpace K L R) := hdata.1 + let : Finite (finiteExtensionRiemannSpace K L R) := Module.finite_of_finite K exact Finite.of_equiv (Projectivization K (finiteExtensionRiemannSpace K L R)) @@ -344,12 +344,12 @@ theorem finiteExtensionEffectiveDivisorCount_eq_classCount_mul_geomSum_of_unifor finiteExtensionEffectiveDivisorCount K L n = Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) * ∑ i ∈ Finset.range (n + 1 - genus), Nat.card K ^ i := by - letI : Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + let : Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := finiteExtensionDivisorClassOfDegree_finite_of_uniformRiemann K L genus threshold n hRiemann hn - letI : Fintype (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + let : Fintype (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := Fintype.ofFinite _ - letI (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) : + let (c : FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) : Finite (FiniteExtensionEffectiveDivisorClassFiber K L n c) := finiteExtensionEffectiveDivisorClassFiber_finite_of_uniformRiemann K L genus threshold n hconstants hRiemann hn c diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean index 4d15adeddf..ccd5b14f18 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean @@ -60,7 +60,7 @@ theorem genus_le_budget_of_uniformRiemann_onePoint rw [finiteExtensionDivisorDegree_single] norm_num have hdata := hRiemann.2 D (threshold * d) hthreshold hdegree - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := hdata.1 + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := hdata.1 have hspace : finiteExtensionRiemannSpace K L D = finiteExtensionOnePointRiemannSpace K L P threshold := by rfl diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean index 4dce0b8b80..94030fd282 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean @@ -120,9 +120,9 @@ theorem finiteExtensionClosedPlaceEvenError_isBigO_of_exactConstantExtension_bou fun n : ℕ ↦ (Nat.card C : ℝ) ^ n := by apply evenExtensionError_isBigO_of_pointwise_bound intro n hn - letI : NeZero (2 * n) := ⟨by omega⟩ + let : NeZero (2 * n) := ⟨by omega⟩ let S := FiniteField.Extension C p (2 * n) - letI : Fintype S := Fintype.ofFinite S + let : Fintype S := Fintype.ofFinite S have hcount : exactConstantExtensionClosedPlaceExtensionCount C S N hExact 1 = finiteExtensionClosedPlaceExtensionCount C N (2 * n) := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean index b6567fd0cb..944eeed874 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean @@ -47,7 +47,7 @@ theorem finiteExtensionEffectiveDivisorCount_zero : refine ⟨⟨0, by simp [finiteExtensionEffectiveDivisorDegree]⟩, ?_⟩ intro D apply Subtype.ext - letI : Finsupp.NonTorsionWeight ℕ + let : Finsupp.NonTorsionWeight ℕ (fun P : FiniteExtensionPlace K L => finiteExtensionPlaceDegree K L P) := Finsupp.nonTorsionWeight_of ℕ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean index c8ffb648b9..f97fbc2802 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean @@ -61,7 +61,7 @@ theorem exists_finiteExtensionClosedPlaceZeta_indexed_rational_of_constants (formalPointCountZeta (finiteExtensionClosedPlaceExtensionCount K L)) (Nat.card K) (finiteExtensionDivisorDegreeIndex K L) P := by - letI : FunctionField.IsFullConstantField K L := + let : FunctionField.IsFullConstantField K L := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 hconstants exact exists_finiteExtensionClosedPlaceZeta_indexed_rational diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean index a115b858b8..c99700947e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean @@ -97,14 +97,14 @@ theorem finiteExtensionLocalPoleSpace_inl_step_finrank finiteExtensionPlaceDegree K L (.inl q) := by let A := RatFuncFiniteIntegralClosure K L let R := FiniteExtensionFinitePlaceLocalRing K L q - letI : Algebra A A := Algebra.id A + let : Algebra A A := Algebra.id A let localA : Algebra A R := OreLocalization.instAlgebra - letI := localA - letI : SMul A R := localA.toSMul - letI : Algebra K R := OreLocalization.instAlgebra - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsScalarTower K R L := by + let := localA + let : SMul A R := localA.toSMul + let : Algebra K R := OreLocalization.instAlgebra + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext c symm @@ -118,7 +118,7 @@ theorem finiteExtensionLocalPoleSpace_inl_step_finrank (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap (K := K) (L := L) q) (algebraMap K A c)] rfl - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A q.ne_bot R obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R @@ -138,10 +138,10 @@ theorem finiteExtensionLocalPoleSpace_inl_step_finrank (K := K) (L := L) q x)) rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, ← finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] - letI : Finite (IsLocalRing.ResidueField R) := by + let : Finite (IsLocalRing.ResidueField R) := by simpa [R] using finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q - letI : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite + let : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite rw [hspace (n + 1), hspace n] calc Module.finrank K @@ -167,14 +167,14 @@ theorem finiteExtensionLocalPoleSpace_inl_cumulative_finrank n * finiteExtensionPlaceDegree K L (.inl q) := by let A := RatFuncFiniteIntegralClosure K L let R := FiniteExtensionFinitePlaceLocalRing K L q - letI : Algebra A A := Algebra.id A + let : Algebra A A := Algebra.id A let localA : Algebra A R := OreLocalization.instAlgebra - letI := localA - letI : SMul A R := localA.toSMul - letI : Algebra K R := OreLocalization.instAlgebra - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsScalarTower K R L := by + let := localA + let : SMul A R := localA.toSMul + let : Algebra K R := OreLocalization.instAlgebra + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext c symm @@ -188,7 +188,7 @@ theorem finiteExtensionLocalPoleSpace_inl_cumulative_finrank (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap (K := K) (L := L) q) (algebraMap K A c)] rfl - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A q.ne_bot R obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R @@ -208,7 +208,7 @@ theorem finiteExtensionLocalPoleSpace_inl_cumulative_finrank (K := K) (L := L) q x)) rw [finiteExtensionFinitePlaceLocalOrder_eq_globalOrder, ← finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] - letI : Finite (IsLocalRing.ResidueField R) := by + let : Finite (IsLocalRing.ResidueField R) := by simpa [R] using finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q rw [hspace n, hspace 0] @@ -312,14 +312,14 @@ theorem finiteExtensionLocalPoleSpace_inr_step_finrank finiteExtensionPlaceDegree K L (.inr P) := by let A := RatFuncInfinityIntegralClosure K L let R := FiniteExtensionInfinityPlaceLocalRing K L P - letI : Algebra A A := Algebra.id A + let : Algebra A A := Algebra.id A let localA : Algebra A R := OreLocalization.instAlgebra - letI := localA - letI : SMul A R := localA.toSMul - letI : Algebra K R := OreLocalization.instAlgebra - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsScalarTower K R L := by + let := localA + let : SMul A R := localA.toSMul + let : Algebra K R := OreLocalization.instAlgebra + let := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext c symm @@ -333,7 +333,7 @@ theorem finiteExtensionLocalPoleSpace_inr_step_finrank (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap (K := K) (L := L) P) (algebraMap K A c)] exact (IsScalarTower.algebraMap_apply K A L c).symm - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot R obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R @@ -353,15 +353,15 @@ theorem finiteExtensionLocalPoleSpace_inr_step_finrank (K := K) (L := L) P x)) rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] - letI : Finite (IsLocalRing.ResidueField R) := by - letI : Finite P.1.ResidueField := + let : Finite (IsLocalRing.ResidueField R) := by + let : Finite P.1.ResidueField := finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P change Finite (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField exact Finite.of_injective (localQuotientInfinityResidueFieldAlgEquiv K L P) (localQuotientInfinityResidueFieldAlgEquiv K L P).injective - letI : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite + let : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite rw [hspace (n + 1), hspace n] calc Module.finrank K @@ -394,14 +394,14 @@ theorem finiteExtensionLocalPoleSpace_inr_cumulative_finrank n * finiteExtensionPlaceDegree K L (.inr P) := by let A := RatFuncInfinityIntegralClosure K L let R := FiniteExtensionInfinityPlaceLocalRing K L P - letI : Algebra A A := Algebra.id A + let : Algebra A A := Algebra.id A let localA : Algebra A R := OreLocalization.instAlgebra - letI := localA - letI : SMul A R := localA.toSMul - letI : Algebra K R := OreLocalization.instAlgebra - letI := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P - letI := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P - letI : IsScalarTower K R L := by + let := localA + let : SMul A R := localA.toSMul + let : Algebra K R := OreLocalization.instAlgebra + let := finiteExtensionInfinityPlaceLocalAlgebra (K := K) (L := L) P + let := finiteExtensionInfinityPlaceLocalIsFractionRing (K := K) (L := L) P + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext c symm @@ -415,7 +415,7 @@ theorem finiteExtensionLocalPoleSpace_inr_cumulative_finrank (finiteExtensionInfinityPlaceLocalizationToField_comp_algebraMap (K := K) (L := L) P) (algebraMap K A c)] exact (IsScalarTower.algebraMap_apply K A L c).symm - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A (primeOverHeightOne (ratFuncInfinityPlace K) P).ne_bot R obtain ⟨π, hπ⟩ := IsDiscreteValuationRing.exists_irreducible R @@ -435,8 +435,8 @@ theorem finiteExtensionLocalPoleSpace_inr_cumulative_finrank (K := K) (L := L) P x)) rw [finiteExtensionInfinityPlaceLocalOrder_eq_globalOrder, ← finiteExtensionPrincipalDivisor_inr_eq_infinityPlaceOrder] - letI : Finite (IsLocalRing.ResidueField R) := by - letI : Finite P.1.ResidueField := + let : Finite (IsLocalRing.ResidueField R) := by + let : Finite P.1.ResidueField := finiteExtensionInfinityPlace_residueField_finite (K := K) (L := L) P change Finite (primeOverHeightOne (ratFuncInfinityPlace K) P).asIdeal.ResidueField diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean index 5f5a3eb2aa..4d91b511f5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean @@ -95,12 +95,12 @@ def finiteExtensionAwayRegularSpace rintro x y (hx0 | ⟨hx0, hx⟩) (hy0 | ⟨hy0, hy⟩) · exact Or.inl (by simp [hx0, hy0]) · subst x - simpa only [zero_add, Set.mem_setOf_eq] using + simpa only [zero_add, Set.mem_ofPred_eq] using (Or.inr ⟨hy0, hy⟩ : y = 0 ∨ (y ≠ 0 ∧ ∀ v, v ≠ P → 0 ≤ finiteExtensionPrincipalDivisor K L y v)) · subst y - simpa only [add_zero, Set.mem_setOf_eq] using + simpa only [add_zero, Set.mem_ofPred_eq] using (Or.inr ⟨hx0, hx⟩ : x = 0 ∨ (x ≠ 0 ∧ ∀ v, v ≠ P → 0 ≤ finiteExtensionPrincipalDivisor K L x v)) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean index d982c90b7c..9a324d9f13 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean @@ -278,8 +278,8 @@ theorem finiteExtensionFinitePlace_degree_eq_residue_finrank finiteExtensionPlaceDegree K L (.inl Q) = Module.finrank K Q.asIdeal.ResidueField := by let P := HeightOneSpectrum.under K[X] Q - letI : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : Q.asIdeal.LiesOver P.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver P.asIdeal Q.asIdeal let _ : IsScalarTower K[X] (Localization.AtPrime P.asIdeal) (Localization.AtPrime Q.asIdeal) := inferInstance @@ -296,14 +296,14 @@ theorem finiteExtensionInfinityPlace_degree_eq_residue_finrank finiteExtensionPlaceDegree K L (.inr P) = Module.finrank K P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal - letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 let _ : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance let _ : Module.Free p.ResidueField P.1.ResidueField := Module.Free.of_divisionRing p.ResidueField P.1.ResidueField - letI : Algebra p.ResidueField P.1.ResidueField := + let : Algebra p.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra - letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + let : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p P.1] have hbase : Module.finrank K p.ResidueField = 1 := by simpa [p] using diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean index e85f411f95..3599fd088a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean @@ -72,26 +72,26 @@ theorem finiteExtensionFinitePlace_degree_le_finite (n : ℕ) : Finite {q : FiniteExtensionFinitePlace K L // finiteExtensionPlaceDegree K L (.inl q) ≤ n} := by - letI : Algebra K[X] L := + let : Algebra K[X] L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) L := + let : IsScalarTower K[X] (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + let : Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) - letI : Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + let : Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isIntegral_algebra K[X] L - letI : Module.IsTorsionFree K[X] L := + let : Module.IsTorsionFree K[X] L := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L - letI : Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := + let : Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isTorsionFree K[X] L let Base := {p : IsDedekindDomain.HeightOneSpectrum K[X] // ratFuncFinitePlaceDegree p ≤ n} let Fiber : Base → Type _ := fun p => p.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) - letI : Finite Base := ratFuncFinitePlace_degree_le_finite K n - letI : Fintype Base := Fintype.ofFinite Base - letI (p : Base) : Fintype (Fiber p) := by + let : Finite Base := ratFuncFinitePlace_degree_le_finite K n + let : Fintype Base := Fintype.ofFinite Base + let (p : Base) : Fintype (Fiber p) := by dsimp only [Fiber] exact Set.Finite.fintype (IsDedekindDomain.primesOver_finite p.1.asIdeal @@ -124,22 +124,22 @@ theorem finiteExtensionPlace_degree_le_finite finiteExtensionPlaceDegree K L P ≤ n} := by let FinitePart := {q : FiniteExtensionFinitePlace K L // finiteExtensionPlaceDegree K L (.inl q) ≤ n} - letI : Finite FinitePart := + let : Finite FinitePart := finiteExtensionFinitePlace_degree_le_finite K L n - letI : Module.Finite (RatFuncInfinityIntegers K) + let : Module.Finite (RatFuncInfinityIntegers K) (RatFuncInfinityIntegralClosure K L) := IsIntegralClosure.finite (RatFuncInfinityIntegers K) (RatFunc K) L (RatFuncInfinityIntegralClosure K L) - letI : Algebra.IsIntegral (RatFuncInfinityIntegers K) + let : Algebra.IsIntegral (RatFuncInfinityIntegers K) (RatFuncInfinityIntegralClosure K L) := IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L - letI : Module.IsTorsionFree (RatFuncInfinityIntegers K) + let : Module.IsTorsionFree (RatFuncInfinityIntegers K) (RatFuncInfinityIntegralClosure K L) := IsIntegralClosure.isTorsionFree (RatFuncInfinityIntegers K) L - letI : IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := + let : IsDedekindDomain (RatFuncInfinityIntegralClosure K L) := IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L (RatFuncInfinityIntegralClosure K L) - letI : Fintype (FiniteExtensionInfinityPlace K L) := + let : Fintype (FiniteExtensionInfinityPlace K L) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite (ratFuncInfinityPlace K).asIdeal diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index 554a700383..0a7fab3da3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -330,10 +330,10 @@ def infinityPlaceUnder refine ⟨wM.asIdeal, wM.isPrime, ?_⟩ have hwM : wM.asIdeal = wL.asIdeal.under (RatFuncInfinityIntegralClosure K M) := rfl - letI : wL.asIdeal.LiesOver wM.asIdeal := by + let : wL.asIdeal.LiesOver wM.asIdeal := by rw [hwM] infer_instance - letI : wL.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by + let : wL.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by change P.1.LiesOver (ratFuncInfinityPlace K).asIdeal infer_instance exact Ideal.LiesOver.tower_bot wL.asIdeal wM.asIdeal @@ -368,7 +368,7 @@ theorem finitePlaceUnder_surjective : intro P let Q : P.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := Classical.choice inferInstance - letI : Q.1.LiesOver P.asIdeal := Q.2.2 + let : Q.1.LiesOver P.asIdeal := Q.2.2 have hQ0 : Q.1 ≠ ⊥ := Ideal.ne_bot_of_mem_primesOver P.ne_bot Q.2 let q : FiniteExtensionFinitePlace K L := ⟨Q.1, Q.2.1, hQ0⟩ @@ -383,9 +383,9 @@ theorem infinityPlaceUnder_surjective : intro P let Q : P.1.primesOver (RatFuncInfinityIntegralClosure K L) := Classical.choice inferInstance - letI : Q.1.LiesOver P.1 := Q.2.2 - letI : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 - letI : Q.1.LiesOver (ratFuncInfinityPlace K).asIdeal := + let : Q.1.LiesOver P.1 := Q.2.2 + let : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 + let : Q.1.LiesOver (ratFuncInfinityPlace K).asIdeal := Ideal.LiesOver.trans Q.1 P.1 (ratFuncInfinityPlace K).asIdeal let q : FiniteExtensionInfinityPlace K L := ⟨Q.1, Q.2.1, inferInstance⟩ @@ -482,7 +482,7 @@ theorem finiteIntegralClosure_relative_finrank_eq_field_finrank : Module.finrank (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) = Module.finrank M L := by - exact (Algebra.IsAlgebraic.finrank_of_isFractionRing + exact (IsFractionRing.finrank_eq (RatFuncFiniteIntegralClosure K M) M (RatFuncFiniteIntegralClosure K L) L).symm @@ -492,7 +492,7 @@ theorem infinityIntegralClosure_relative_finrank_eq_field_finrank : Module.finrank (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) = Module.finrank M L := by - exact (Algebra.IsAlgebraic.finrank_of_isFractionRing + exact (IsFractionRing.finrank_eq (RatFuncInfinityIntegralClosure K M) M (RatFuncInfinityIntegralClosure K L) L).symm @@ -559,7 +559,7 @@ theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_finrank Module.finrank (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) := by classical - letI : P.1.IsPrime := P.2.1 + let : P.1.IsPrime := P.2.1 let e := infinityPlaceUnderFiberEquivPrimesOver K M L P calc _ = ∑ Q : P.1.primesOver (RatFuncInfinityIntegralClosure K L), @@ -591,7 +591,7 @@ theorem finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg (.inl (finitePlaceUnder K M L Q)) * finitePlaceRelativeInertiaDeg K M L Q := by let P := finitePlaceUnder K M L Q - letI : Q.asIdeal.LiesOver P.asIdeal := + let : Q.asIdeal.LiesOver P.asIdeal := ⟨finitePlaceUnder_asIdeal K M L Q⟩ rw [finiteExtensionPlaceDegree, finiteExtensionPlaceDegree, finitePlaceRelativeInertiaDeg] @@ -607,7 +607,7 @@ theorem finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg (.inr (infinityPlaceUnder K M L Q)) * infinityPlaceRelativeInertiaDeg K M L Q := by let P := infinityPlaceUnder K M L Q - letI : Q.1.LiesOver P.1 := + let : Q.1.LiesOver P.1 := ⟨infinityPlaceUnder_asIdeal K M L Q⟩ rw [finiteExtensionPlaceDegree, finiteExtensionPlaceDegree, infinityPlaceRelativeInertiaDeg] @@ -647,7 +647,7 @@ theorem finiteIntegralClosureGalSmulComm : letI := finiteIntegralClosureGalAction K M L SMulCommClass Gal(L/M) (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) := by - letI := finiteIntegralClosureGalAction K M L + let := finiteIntegralClosureGalAction K M L constructor intro g r s change galRestrict (RatFuncFiniteIntegralClosure K M) M L @@ -696,8 +696,8 @@ theorem finitePlaceUnder_finitePlaceGalSmul (g : Gal(L/M)) (P : FiniteExtensionFinitePlace K L) : finitePlaceUnder K M L (finitePlaceGalSmul K M L g P) = finitePlaceUnder K M L P := by - letI := finiteIntegralClosureGalAction K M L - letI := finiteIntegralClosureGalSmulComm K M L + let := finiteIntegralClosureGalAction K M L + let := finiteIntegralClosureGalSmulComm K M L apply HeightOneSpectrum.ext change (g • P.asIdeal).under (RatFuncFiniteIntegralClosure K M) = P.asIdeal.under (RatFuncFiniteIntegralClosure K M) @@ -735,18 +735,18 @@ theorem exists_gal_smul_finitePlace_asIdeal_of_same_under (P Q : FiniteExtensionFinitePlace K L) (hPQ : finitePlaceUnder K M L P = finitePlaceUnder K M L Q) : FinitePlacesGaloisConjugate K M L P Q := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := finiteIntegralClosureGalAction K M L + let := finiteIntegralClosureGalAction K M L change ∃ g : Gal(L/M), Q.asIdeal = g • P.asIdeal - letI := finiteIntegralClosureGalSmulComm K M L - letI : Algebra.IsInvariant (RatFuncFiniteIntegralClosure K M) + let := finiteIntegralClosureGalSmulComm K M L + let : Algebra.IsInvariant (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) Gal(L/M) := Algebra.isInvariant_of_isGalois (RatFuncFiniteIntegralClosure K M) M L (RatFuncFiniteIntegralClosure K L) - letI : P.asIdeal.IsPrime := P.isPrime - letI : Q.asIdeal.IsPrime := Q.isPrime + let : P.asIdeal.IsPrime := P.isPrime + let : Q.asIdeal.IsPrime := Q.isPrime apply Algebra.IsInvariant.exists_smul_of_under_eq (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) Gal(L/M) @@ -759,8 +759,8 @@ theorem finitePlaceUnderFiberGalAction_isPretransitive (P : FiniteExtensionFinitePlace K M) : letI := finitePlaceUnderFiberGalAction K M L P MulAction.IsPretransitive Gal(L/M) (FinitePlaceUnderFiber K M L P) := by - letI := finiteIntegralClosureGalAction K M L - letI := finitePlaceUnderFiberGalAction K M L P + let := finiteIntegralClosureGalAction K M L + let := finitePlaceUnderFiberGalAction K M L P constructor intro Q R obtain ⟨g, hg⟩ := @@ -787,13 +787,13 @@ theorem sum_card_finitePlaceUnderFiberFixedBy_eq_card_galoisGroup Module.Finite.of_restrictScalars_finite (RatFunc K) M L (∑ g : Gal(L/M), Nat.card (finitePlaceUnderFiberFixedBy K M L P g)) = Nat.card Gal(L/M) := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := finitePlaceUnderFiberGalAction K M L P - letI : MulAction.IsPretransitive Gal(L/M) + let := finitePlaceUnderFiberGalAction K M L P + let : MulAction.IsPretransitive Gal(L/M) (FinitePlaceUnderFiber K M L P) := finitePlaceUnderFiberGalAction_isPretransitive K M L P - letI : Nonempty (FinitePlaceUnderFiber K M L P) := by + let : Nonempty (FinitePlaceUnderFiber K M L P) := by obtain ⟨Q, hQ⟩ := finitePlaceUnder_surjective K M L P exact ⟨⟨Q, hQ⟩⟩ change (∑ g : Gal(L/M), @@ -816,7 +816,7 @@ theorem infinityIntegralClosureGalSmulComm : letI := infinityIntegralClosureGalAction K M L SMulCommClass Gal(L/M) (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) := by - letI := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalAction K M L constructor intro g r s change galRestrict (RatFuncInfinityIntegralClosure K M) M L @@ -835,8 +835,8 @@ theorem ratFuncInfinityIntegersGalSmulComm : letI := infinityIntegralClosureGalAction K M L SMulCommClass Gal(L/M) (RatFuncInfinityIntegers K) (RatFuncInfinityIntegralClosure K L) := by - letI := infinityIntegralClosureGalAction K M L - letI := infinityIntegralClosureGalSmulComm K M L + let := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalSmulComm K M L constructor intro g r s calc @@ -892,8 +892,8 @@ theorem infinityPlaceUnder_infinityPlaceGalSmul (g : Gal(L/M)) (P : FiniteExtensionInfinityPlace K L) : infinityPlaceUnder K M L (infinityPlaceGalSmul K M L g P) = infinityPlaceUnder K M L P := by - letI := infinityIntegralClosureGalAction K M L - letI := infinityIntegralClosureGalSmulComm K M L + let := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalSmulComm K M L apply Subtype.ext change (g • P.1).under (RatFuncInfinityIntegralClosure K M) = P.1.under (RatFuncInfinityIntegralClosure K M) @@ -932,18 +932,18 @@ theorem exists_gal_smul_infinityPlace_asIdeal_of_same_under (P Q : FiniteExtensionInfinityPlace K L) (hPQ : infinityPlaceUnder K M L P = infinityPlaceUnder K M L Q) : InfinityPlacesGaloisConjugate K M L P Q := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalAction K M L change ∃ g : Gal(L/M), Q.1 = g • P.1 - letI := infinityIntegralClosureGalSmulComm K M L - letI : Algebra.IsInvariant (RatFuncInfinityIntegralClosure K M) + let := infinityIntegralClosureGalSmulComm K M L + let : Algebra.IsInvariant (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) Gal(L/M) := Algebra.isInvariant_of_isGalois (RatFuncInfinityIntegralClosure K M) M L (RatFuncInfinityIntegralClosure K L) - letI : P.1.IsPrime := P.2.1 - letI : Q.1.IsPrime := Q.2.1 + let : P.1.IsPrime := P.2.1 + let : Q.1.IsPrime := Q.2.1 apply Algebra.IsInvariant.exists_smul_of_under_eq (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) Gal(L/M) @@ -956,8 +956,8 @@ theorem infinityPlaceUnderFiberGalAction_isPretransitive (P : FiniteExtensionInfinityPlace K M) : letI := infinityPlaceUnderFiberGalAction K M L P MulAction.IsPretransitive Gal(L/M) (InfinityPlaceUnderFiber K M L P) := by - letI := infinityIntegralClosureGalAction K M L - letI := infinityPlaceUnderFiberGalAction K M L P + let := infinityIntegralClosureGalAction K M L + let := infinityPlaceUnderFiberGalAction K M L P constructor intro Q R obtain ⟨g, hg⟩ := @@ -984,13 +984,13 @@ theorem sum_card_infinityPlaceUnderFiberFixedBy_eq_card_galoisGroup Module.Finite.of_restrictScalars_finite (RatFunc K) M L (∑ g : Gal(L/M), Nat.card (infinityPlaceUnderFiberFixedBy K M L P g)) = Nat.card Gal(L/M) := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := infinityPlaceUnderFiberGalAction K M L P - letI : MulAction.IsPretransitive Gal(L/M) + let := infinityPlaceUnderFiberGalAction K M L P + let : MulAction.IsPretransitive Gal(L/M) (InfinityPlaceUnderFiber K M L P) := infinityPlaceUnderFiberGalAction_isPretransitive K M L P - letI : Nonempty (InfinityPlaceUnderFiber K M L P) := by + let : Nonempty (InfinityPlaceUnderFiber K M L P) := by obtain ⟨Q, hQ⟩ := infinityPlaceUnder_surjective K M L P exact ⟨⟨Q, hQ⟩⟩ change (∑ g : Gal(L/M), @@ -1007,10 +1007,10 @@ theorem finitePlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under finitePlaceRelativeRamificationIdx K M L Q ∧ finitePlaceRelativeInertiaDeg K M L P = finitePlaceRelativeInertiaDeg K M L Q := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := finiteIntegralClosureGalAction K M L - letI := finiteIntegralClosureGalSmulComm K M L + let := finiteIntegralClosureGalAction K M L + let := finiteIntegralClosureGalSmulComm K M L obtain ⟨g, hg⟩ := exists_gal_smul_finitePlace_asIdeal_of_same_under K M L P Q hPQ constructor @@ -1028,10 +1028,10 @@ theorem infinityPlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under infinityPlaceRelativeRamificationIdx K M L Q ∧ infinityPlaceRelativeInertiaDeg K M L P = infinityPlaceRelativeInertiaDeg K M L Q := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := infinityIntegralClosureGalAction K M L - letI := infinityIntegralClosureGalSmulComm K M L + let := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalSmulComm K M L obtain ⟨g, hg⟩ := exists_gal_smul_infinityPlace_asIdeal_of_same_under K M L P Q hPQ constructor @@ -1133,44 +1133,44 @@ private theorem ratFuncFinitePlaceResidueField_finite p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl - letI : Module.Finite K (K[X] ⧸ p.asIdeal) := by + let : Module.Finite K (K[X] ⧸ p.asIdeal) := by rw [hp] exact hrmonic.finite_quotient - letI : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K + let : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K infer_instance private theorem finitePlaceResidueField_finite (P : FiniteExtensionFinitePlace K M) : Finite P.asIdeal.ResidueField := by let p := HeightOneSpectrum.under K[X] P - letI : Finite p.asIdeal.ResidueField := + let : Finite p.asIdeal.ResidueField := ratFuncFinitePlaceResidueField_finite K p - letI : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal + let : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime P.asIdeal) := inferInstance - letI : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance - letI : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := + let : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance + let : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := inferInstance exact Module.finite_of_finite p.asIdeal.ResidueField private theorem infinityPlaceResidueField_finite (P : FiniteExtensionInfinityPlace K M) : Finite P.1.ResidueField := by - letI : Algebra K (RatFuncInfinityIntegers K) := + let : Algebra K (RatFuncInfinityIntegers K) := (ratFuncInfinityConstantRingHom K).toAlgebra - letI : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := + let : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := .of_algebraMap_eq' rfl let p := (ratFuncInfinityPlace K).asIdeal - letI : Finite p.ResidueField := + let : Finite p.ResidueField := Finite.of_injective (ratFuncInfinityPlaceResidueEquiv K) (ratFuncInfinityPlaceResidueEquiv K).injective - letI : P.1.LiesOver p := by + let : P.1.LiesOver p := by simpa [p] using Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P - letI := Localization.AtPrime.algebraOfLiesOver p P.1 + let := Localization.AtPrime.algebraOfLiesOver p P.1 have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance - letI : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance - letI : Module.Finite p.ResidueField P.1.ResidueField := inferInstance + let : Algebra.QuasiFiniteAt (RatFuncInfinityIntegers K) P.1 := inferInstance + let : Module.Finite p.ResidueField P.1.ResidueField := inferInstance exact Module.finite_of_finite p.ResidueField /-- The inertia-group cardinality is the ramification index at a finite @@ -1179,18 +1179,18 @@ theorem finitePlaceInertiaGroup_card_eq_ramificationIdx (P : FiniteExtensionFinitePlace K L) : Nat.card (finitePlaceInertiaGroup K M L P) = finitePlaceRelativeRamificationIdx K M L P := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := finiteIntegralClosureGalAction K M L - letI := finiteIntegralClosureGalSmulComm K M L - letI : IsGaloisGroup Gal(L/M) (RatFuncFiniteIntegralClosure K M) + let := finiteIntegralClosureGalAction K M L + let := finiteIntegralClosureGalSmulComm K M L + let : IsGaloisGroup Gal(L/M) (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) := IsGaloisGroup.of_isFractionRing _ _ _ M L let p := finitePlaceUnder K M L P - letI : P.asIdeal.LiesOver p.asIdeal := ⟨finitePlaceUnder_asIdeal K M L P⟩ - letI : Finite p.asIdeal.ResidueField := + let : P.asIdeal.LiesOver p.asIdeal := ⟨finitePlaceUnder_asIdeal K M L P⟩ + let : Finite p.asIdeal.ResidueField := finitePlaceResidueField_finite K M p - letI : PerfectField p.asIdeal.ResidueField := inferInstance + let : PerfectField p.asIdeal.ResidueField := inferInstance change Nat.card (P.asIdeal.inertia Gal(L/M)) = P.asIdeal.ramificationIdx (RatFuncFiniteIntegralClosure K M) rw [Ideal.card_inertia_eq_ramificationIdxIn p.asIdeal P.asIdeal] @@ -1203,18 +1203,18 @@ theorem finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg Nat.card (finitePlaceDecompositionGroup K M L P) = finitePlaceRelativeRamificationIdx K M L P * finitePlaceRelativeInertiaDeg K M L P := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := finiteIntegralClosureGalAction K M L - letI := finiteIntegralClosureGalSmulComm K M L - letI : IsGaloisGroup Gal(L/M) (RatFuncFiniteIntegralClosure K M) + let := finiteIntegralClosureGalAction K M L + let := finiteIntegralClosureGalSmulComm K M L + let : IsGaloisGroup Gal(L/M) (RatFuncFiniteIntegralClosure K M) (RatFuncFiniteIntegralClosure K L) := IsGaloisGroup.of_isFractionRing _ _ _ M L let p := finitePlaceUnder K M L P - letI : P.asIdeal.LiesOver p.asIdeal := ⟨finitePlaceUnder_asIdeal K M L P⟩ - letI : Finite p.asIdeal.ResidueField := + let : P.asIdeal.LiesOver p.asIdeal := ⟨finitePlaceUnder_asIdeal K M L P⟩ + let : Finite p.asIdeal.ResidueField := finitePlaceResidueField_finite K M p - letI : PerfectField p.asIdeal.ResidueField := inferInstance + let : PerfectField p.asIdeal.ResidueField := inferInstance change Nat.card (MulAction.stabilizer Gal(L/M) P.asIdeal) = P.asIdeal.ramificationIdx (RatFuncFiniteIntegralClosure K M) * P.asIdeal.inertiaDeg (RatFuncFiniteIntegralClosure K M) @@ -1227,18 +1227,18 @@ theorem infinityPlaceInertiaGroup_card_eq_ramificationIdx (P : FiniteExtensionInfinityPlace K L) : Nat.card (infinityPlaceInertiaGroup K M L P) = infinityPlaceRelativeRamificationIdx K M L P := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := infinityIntegralClosureGalAction K M L - letI := infinityIntegralClosureGalSmulComm K M L - letI : IsGaloisGroup Gal(L/M) (RatFuncInfinityIntegralClosure K M) + let := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalSmulComm K M L + let : IsGaloisGroup Gal(L/M) (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) := IsGaloisGroup.of_isFractionRing _ _ _ M L let p := infinityPlaceUnder K M L P - letI : P.1.LiesOver p.1 := ⟨infinityPlaceUnder_asIdeal K M L P⟩ - letI : Finite p.1.ResidueField := + let : P.1.LiesOver p.1 := ⟨infinityPlaceUnder_asIdeal K M L P⟩ + let : Finite p.1.ResidueField := infinityPlaceResidueField_finite K M p - letI : PerfectField p.1.ResidueField := inferInstance + let : PerfectField p.1.ResidueField := inferInstance change Nat.card (P.1.inertia Gal(L/M)) = P.1.ramificationIdx (RatFuncInfinityIntegralClosure K M) rw [Ideal.card_inertia_eq_ramificationIdxIn p.1 P.1] @@ -1251,18 +1251,18 @@ theorem infinityPlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg Nat.card (infinityPlaceDecompositionGroup K M L P) = infinityPlaceRelativeRamificationIdx K M L P * infinityPlaceRelativeInertiaDeg K M L P := by - letI : Module.Finite M L := + let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L - letI := infinityIntegralClosureGalAction K M L - letI := infinityIntegralClosureGalSmulComm K M L - letI : IsGaloisGroup Gal(L/M) (RatFuncInfinityIntegralClosure K M) + let := infinityIntegralClosureGalAction K M L + let := infinityIntegralClosureGalSmulComm K M L + let : IsGaloisGroup Gal(L/M) (RatFuncInfinityIntegralClosure K M) (RatFuncInfinityIntegralClosure K L) := IsGaloisGroup.of_isFractionRing _ _ _ M L let p := infinityPlaceUnder K M L P - letI : P.1.LiesOver p.1 := ⟨infinityPlaceUnder_asIdeal K M L P⟩ - letI : Finite p.1.ResidueField := + let : P.1.LiesOver p.1 := ⟨infinityPlaceUnder_asIdeal K M L P⟩ + let : Finite p.1.ResidueField := infinityPlaceResidueField_finite K M p - letI : PerfectField p.1.ResidueField := inferInstance + let : PerfectField p.1.ResidueField := inferInstance change Nat.card (MulAction.stabilizer Gal(L/M) P.1) = P.1.ramificationIdx (RatFuncInfinityIntegralClosure K M) * P.1.inertiaDeg (RatFuncInfinityIntegralClosure K M) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean index b9b2f51f2d..8e5b66b104 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean @@ -94,7 +94,7 @@ theorem finiteExtensionPrincipalPartAt_moduleFinite theorem finiteExtensionPrincipalPartsSpace_moduleFinite (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := by - letI (P : ↥D.support) : Module.Finite K + let (P : ↥D.support) : Module.Finite K (finiteExtensionPrincipalPartAt K L D P) := finiteExtensionPrincipalPartAt_moduleFinite K L D hD P exact Module.Finite.pi @@ -105,10 +105,10 @@ theorem finiteExtensionPrincipalPartsSpace_finrank (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : Module.finrank K (finiteExtensionPrincipalPartsSpace K L D) = finiteExtensionEffectiveDivisorNatDegree K L D := by - letI (P : ↥D.support) : Module.Finite K + let (P : ↥D.support) : Module.Finite K (finiteExtensionPrincipalPartAt K L D P) := finiteExtensionPrincipalPartAt_moduleFinite K L D hD P - letI (P : ↥D.support) : Module.Free K + let (P : ↥D.support) : Module.Free K (finiteExtensionPrincipalPartAt K L D P) := Module.Free.of_divisionRing K (finiteExtensionPrincipalPartAt K L D P) rw [Module.finrank_pi_fintype] @@ -262,9 +262,9 @@ theorem finiteExtensionRiemannPrincipalPartsQuotientMap_injective (D : FiniteExtensionDivisor K L) (hD : ∀ P, 0 ≤ D P) : Function.Injective (finiteExtensionRiemannPrincipalPartsQuotientMap K L D hD) := by - letI localPrincipalPartModule (P : ↥D.support) : Module K + let localPrincipalPartModule (P : ↥D.support) : Module K (finiteExtensionPrincipalPartAt K L D P) := inferInstance - letI finitePrincipalPartsModule : Module K + let finitePrincipalPartsModule : Module K (finiteExtensionPrincipalPartsSpace K L D) := Pi.module ↥D.support (fun P => finiteExtensionPrincipalPartAt K L D P) K @@ -293,16 +293,16 @@ theorem finiteExtensionRiemannSpace_quotient_zero_moduleFinite relativeSubmodule (finiteExtensionRiemannSpace K L 0) (finiteExtensionRiemannSpace K L D)) := by - letI localPrincipalPartModule (P : ↥D.support) : Module K + let localPrincipalPartModule (P : ↥D.support) : Module K (finiteExtensionPrincipalPartAt K L D P) := inferInstance - letI finitePrincipalPartsModule : Module K + let finitePrincipalPartsModule : Module K (finiteExtensionPrincipalPartsSpace K L D) := Pi.module ↥D.support (fun P => finiteExtensionPrincipalPartAt K L D P) K - letI (P : ↥D.support) : Module.Finite K + let (P : ↥D.support) : Module.Finite K (finiteExtensionPrincipalPartAt K L D P) := finiteExtensionPrincipalPartAt_moduleFinite K L D hD P - letI : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := + let : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := Module.Finite.pi let f : finiteExtensionRiemannSpace K L D →ₗ[K] finiteExtensionPrincipalPartsSpace K L D := @@ -340,16 +340,16 @@ theorem finiteExtensionRiemannSpace_quotient_zero_finrank_le (finiteExtensionRiemannSpace K L 0) (finiteExtensionRiemannSpace K L D)) ≤ finiteExtensionEffectiveDivisorNatDegree K L D := by - letI localPrincipalPartModule (P : ↥D.support) : Module K + let localPrincipalPartModule (P : ↥D.support) : Module K (finiteExtensionPrincipalPartAt K L D P) := inferInstance - letI finitePrincipalPartsModule : Module K + let finitePrincipalPartsModule : Module K (finiteExtensionPrincipalPartsSpace K L D) := Pi.module ↥D.support (fun P => finiteExtensionPrincipalPartAt K L D P) K - letI (P : ↥D.support) : Module.Finite K + let (P : ↥D.support) : Module.Finite K (finiteExtensionPrincipalPartAt K L D P) := finiteExtensionPrincipalPartAt_moduleFinite K L D hD P - letI : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := + let : Module.Finite K (finiteExtensionPrincipalPartsSpace K L D) := Module.Finite.pi let f : finiteExtensionRiemannSpace K L D →ₗ[K] finiteExtensionPrincipalPartsSpace K L D := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean index bb40448105..03c4c240be 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean @@ -64,7 +64,7 @@ theorem finiteExtensionOnePointRiemannSurplus_antitone_of_lower · subst v simp [D] · simp [D, Finsupp.single_eq_of_ne hv] - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD have hinc := finiteExtensionRiemannSpace_place_increment K L D hD P have hdivisor : D + Finsupp.single P 1 = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean index 7c1c93de9e..bd0412e128 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean @@ -208,7 +208,7 @@ def finiteExtensionInfinityPrimesOverEquivHeightOne : toFun P := primeOverHeightOne (ratFuncInfinityPlace K) P invFun q := ⟨q.asIdeal, q.isPrime, ⟨by let A := RatFuncInfinityIntegers K - letI : q.asIdeal.IsMaximal := q.isPrime.isMaximal q.ne_bot + let : q.asIdeal.IsMaximal := q.isPrime.isMaximal q.ne_bot have hq : q.asIdeal.under A = IsLocalRing.maximalIdeal A := IsLocalRing.eq_maximalIdeal (Ideal.IsMaximal.under A q.asIdeal) have hp : (ratFuncInfinityPlace K).asIdeal = @@ -609,7 +609,7 @@ theorem exists_hasFiniteExtensionUniformEventualRiemannFormula_of_constants ∃ genus threshold, HasFiniteExtensionUniformEventualRiemannFormula K L genus threshold := by - letI : FunctionField.IsFullConstantField K L := + let : FunctionField.IsFullConstantField K L := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 hconstants exact ⟨FunctionField.Chart.genus K L, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean index e7ead233a5..23a966cf5a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean @@ -79,7 +79,7 @@ theorem finiteExtensionShiftedRiemannSurplus_antitone_of_lower add_nonneg (hD P) hn · simpa [E, finiteExtensionRiemannShiftDivisor, Finsupp.single_eq_of_ne hv] using hD v - letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := + let : Module.Finite K (finiteExtensionRiemannSpace K L E) := finiteExtensionRiemannSpace_effective_moduleFinite K L E hE have hinc := finiteExtensionRiemannSpace_place_increment K L E hE P have hdivisor : E + Finsupp.single P 1 = @@ -256,11 +256,11 @@ theorem finiteExtensionRiemannSpace_shift_eventually_cardinality_formula add_nonneg (hD P) hNmnonneg · simpa [finiteExtensionRiemannShiftDivisor, Finsupp.single_eq_of_ne hv] using hD v - letI : Module.Finite K + let : Module.Finite K (finiteExtensionRiemannSpace K L (finiteExtensionRiemannShiftDivisor K L D P N)) := finiteExtensionRiemannSpace_effective_moduleFinite K L _ hDN - letI : Module.Finite K + let : Module.Finite K (finiteExtensionRiemannSpace K L (finiteExtensionRiemannShiftDivisor K L D P (N + m))) := finiteExtensionRiemannSpace_effective_moduleFinite K L _ hDNm diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean index c3d71d7c75..0cdb2bc9bf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean @@ -124,11 +124,11 @@ def finiteExtensionRiemannSpace (D : FiniteExtensionDivisor K L) : rintro x y (hx0 | ⟨hx0, hx⟩) (hy0 | ⟨hy0, hy⟩) · exact Or.inl (by simp [hx0, hy0]) · subst x - simpa only [zero_add, Set.mem_setOf_eq] using + simpa only [zero_add, Set.mem_ofPred_eq] using (Or.inr ⟨hy0, hy⟩ : y = 0 ∨ (y ≠ 0 ∧ ∀ v, 0 ≤ finiteExtensionPrincipalDivisor K L y v + D v)) · subst y - simpa only [add_zero, Set.mem_setOf_eq] using + simpa only [add_zero, Set.mem_ofPred_eq] using (Or.inr ⟨hx0, hx⟩ : x = 0 ∨ (x ≠ 0 ∧ ∀ v, 0 ≤ finiteExtensionPrincipalDivisor K L x v + D v)) · by_cases hxy : x + y = 0 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean index 330b3eb96d..045267c5c7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean @@ -288,9 +288,9 @@ theorem effectiveRiemannSpace_nonzeroScalarOrbitQuotient_finite (Quotient (MulAction.orbitRel Kˣ {x : finiteExtensionRiemannSpace K L D // x ≠ 0})) := by - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD - letI : Finite (finiteExtensionRiemannSpace K L D) := + let : Finite (finiteExtensionRiemannSpace K L D) := Module.finite_of_finite K exact Finite.of_equiv (Projectivization K (finiteExtensionRiemannSpace K L D)) @@ -307,7 +307,7 @@ theorem effectiveRiemannSpace_nonzeroScalarOrbitQuotient_card_eq_div (Nat.card K ^ Module.finrank K (finiteExtensionRiemannSpace K L D) - 1) / (Nat.card K - 1) := by - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD exact finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_div K (finiteExtensionRiemannSpace K L D) @@ -318,9 +318,9 @@ theorem effectiveDivisorInPrincipalClass_finite (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) (hconstants : algebraicClosure K L = ⊥) : Finite (EffectiveDivisorInPrincipalClass K L D) := by - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD - letI : Finite (finiteExtensionRiemannSpace K L D) := + let : Finite (finiteExtensionRiemannSpace K L D) := Module.finite_of_finite K exact Finite.of_equiv (Projectivization K (finiteExtensionRiemannSpace K L D)) @@ -350,7 +350,7 @@ theorem effectiveDivisorInPrincipalClass_card_eq_div (Nat.card K ^ Module.finrank K (finiteExtensionRiemannSpace K L D) - 1) / (Nat.card K - 1) := by - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD rw [Nat.card_congr (projectiveRiemannSectionEquivEffectiveDivisorInPrincipalClass diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean index 6fc1eea221..14b9a05a65 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean @@ -121,7 +121,7 @@ theorem exists_finiteExtensionClosedPlaceZeta_rational_with_genus_degree_bound (formalPointCountZeta (finiteExtensionClosedPlaceExtensionCount K L)) (Nat.card K) P := by - letI : FunctionField.IsFullConstantField K L := + let : FunctionField.IsFullConstantField K L := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 hconstants simpa only [FunctionField.genus_eq_genusChart K L] using diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean index d22042ea95..7f2ff5849f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean @@ -138,17 +138,17 @@ theorem finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstantExtension_close finiteExtensionDivisorDegreeIndex C N = 1 := by let E := ExactConstantExtension C N S let d := finiteExtensionDivisorDegreeIndex C N - letI : Field E := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) E := + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) E := Algebra.toSMul - letI : Module (RatFunc S) E := Algebra.toModule - letI : FiniteDimensional (RatFunc S) E := + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : FiniteDimensional (RatFunc S) E := finiteDimensional_over_extendedRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := isSeparable_over_extendedRatFunc C S N hExact - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := closedPlaceRatFuncConstantsDecidableEq S let extendedConstantAlgebra : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp @@ -178,7 +178,7 @@ theorem finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstantExtension_close have hTensorRange (z : E) (hz : @IsAlgebraic S E _ _ tensorConstantAlgebra z) : z ∈ Set.range (@algebraMap S E _ _ tensorConstantAlgebra) := by - letI : Algebra S E := tensorConstantAlgebra + let : Algebra S E := tensorConstantAlgebra have hTensorExact : algebraicClosure S E = (⊥ : IntermediateField S E) := exactConstantExtension_algebraicClosure_eq_bot C N S hExact @@ -188,7 +188,7 @@ theorem finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstantExtension_close rw [← hTensorExact] exact hzClosure exact hzBot - letI : Algebra S E := extendedConstantAlgebra + let : Algebra S E := extendedConstantAlgebra have hExtendedExact : algebraicClosure S E = (⊥ : IntermediateField S E) := by apply eq_bot_iff.mpr diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean index cd32376cf4..2ddbb801ce 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean @@ -53,9 +53,9 @@ theorem finiteExtensionDivisorDegreeIndex_eq_one_of_all_exactConstantExtension_c let d := finiteExtensionDivisorDegreeIndex C N have hd : 0 < d := finiteExtensionDivisorDegreeIndex_pos C N let p := ringChar C - letI : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ - letI : NeZero d := ⟨hd.ne'⟩ - letI : Fintype (FiniteField.Extension C p d) := + let : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ + let : NeZero d := ⟨hd.ne'⟩ + let : Fintype (FiniteField.Extension C p d) := Fintype.ofFinite (FiniteField.Extension C p d) apply finiteExtensionDivisorDegreeIndex_eq_one_of_exactConstantExtension_closedPlaceCount C (FiniteField.Extension C p d) N hExact diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean index 4d23d528ba..d494d6f319 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean @@ -83,10 +83,10 @@ theorem finiteExtensionEffectiveDivisorCount_pow_mul_lt_add_index_of_uniformRiem have hd : 0 < d := finiteExtensionDivisorDegreeIndex_pos K L have hn1 : threshold ≤ n + d := by omega have hgenus : genus ≤ n := hRiemann.1.trans hn - letI : Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + let : Finite (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := finiteExtensionDivisorClassOfDegree_finite_of_uniformRiemann K L genus threshold n hRiemann hn - letI : Nonempty (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := + let : Nonempty (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) := hclass have hh : 0 < h := by exact Nat.card_pos diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean index aea9c6f767..a7f98494ca 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean @@ -41,10 +41,10 @@ theorem finiteField_finrank_eq_lcm_of_tensorLift_surjective (hsurj : Function.Surjective (Algebra.TensorProduct.lift f g hfg)) : Module.finrank C T = Nat.lcm (Module.finrank C S) (Module.finrank C K) := by - letI : Fintype C := Fintype.ofFinite C - letI : Fintype S := Fintype.ofFinite S - letI : Fintype K := Fintype.ofFinite K - letI : Fintype T := Fintype.ofFinite T + let : Fintype C := Fintype.ofFinite C + let : Fintype S := Fintype.ofFinite S + let : Fintype K := Fintype.ofFinite K + let : Fintype T := Fintype.ofFinite T let m := Module.finrank C S let n := Module.finrank C K let l := Nat.lcm m n diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean index 747e2ce411..469051cafd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean @@ -189,11 +189,11 @@ theorem finiteFieldConstantExtensionDownstairsIdeal_isMaximal [Finite q.ResidueField] : (finiteFieldConstantExtensionDownstairsIdeal C S N q).IsMaximal := by let p := finiteFieldConstantExtensionDownstairsIdeal C S N q - letI : Finite p.ResidueField := by + let : Finite p.ResidueField := by change Finite (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField infer_instance - letI : Finite (integralClosure C[X] N ⧸ p) := + let : Finite (integralClosure C[X] N ⧸ p) := Finite.of_injective (algebraMap (integralClosure C[X] N ⧸ p) p.ResidueField) p.injective_algebraMap_quotient_residueField @@ -210,12 +210,12 @@ theorem finiteFieldConstantExtensionResidue_finrank_eq_lcm (Module.finrank C (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField) := by let q₀ := finiteFieldConstantExtensionTensorIdeal C S N q - letI : q₀.IsMaximal := + let : q₀.IsMaximal := finiteFieldConstantExtensionTensorIdeal_isMaximal C S N q let eS := finiteFieldConstantExtensionResidueFieldAlgEquiv C S N q let p := q₀.comap (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := integralClosure C[X] N)).toRingHom - letI : Finite p.ResidueField := by + let : Finite p.ResidueField := by change Finite (finiteFieldConstantExtensionDownstairsIdeal C S N q).ResidueField infer_instance diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean index 8ea1b638a8..b2dbb15351 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean @@ -49,7 +49,7 @@ theorem finiteFieldExtension_isScalarTower_of_dvd (h : a ∣ b) : finiteFieldExtensionAlgebraOfDvd K p a b h IsScalarTower K (FiniteField.Extension K p a) (FiniteField.Extension K p b) := by - letI : Algebra (FiniteField.Extension K p a) + let : Algebra (FiniteField.Extension K p a) (FiniteField.Extension K p b) := finiteFieldExtensionAlgebraOfDvd K p a b h apply IsScalarTower.of_algebraMap_eq' @@ -66,10 +66,10 @@ theorem finrank_finiteFieldExtension_of_dvd (h : a ∣ b) : (FiniteField.Extension K p b) = b / a := by let E := FiniteField.Extension K p a let L := FiniteField.Extension K p b - letI : Algebra E L := finiteFieldExtensionAlgebraOfDvd K p a b h - letI : IsScalarTower K E L := + let : Algebra E L := finiteFieldExtensionAlgebraOfDvd K p a b h + let : IsScalarTower K E L := finiteFieldExtension_isScalarTower_of_dvd K p a b h - letI : Module.Finite E L := Module.Finite.of_finite + let : Module.Finite E L := Module.Finite.of_finite have hmul : Module.finrank K E * Module.finrank E L = Module.finrank K L := Module.finrank_mul_finrank K E L rw [FiniteField.finrank_extension K p a, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean index be252e9f22..02166da65d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean @@ -237,7 +237,7 @@ local instance finiteFieldInfinityDifferentBasePolynomialCoefficientTower : local instance finiteFieldInfinityDifferentCoefficientPolynomialModuleFinite : Module.Finite C[X] S[X] := by - letI : Module.Finite C[X] (C[X] ⊗[C] S) := + let : Module.Finite C[X] (C[X] ⊗[C] S) := Module.Finite.base_change C C[X] S exact Module.Finite.equiv (Algebra.IsPushout.equiv C C[X] S S[X]).toLinearEquiv @@ -246,11 +246,11 @@ local instance finiteFieldInfinityDifferentCoefficientPolynomialModuleFinite : theorem ratFuncInfinityIntegers_coefficient_moduleFinite : Module.Finite (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := by - letI : IsLocalization + let : IsLocalization (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl (RatFuncInfinityIntegers C) := ratFuncInfinityIntegers_isLocalization_reciprocal C - letI : IsLocalization + let : IsLocalization (Algebra.algebraMapSubmonoid S[X] (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) (RatFuncInfinityIntegers S) := @@ -274,22 +274,22 @@ unramified. -/ theorem ratFuncInfinityIntegers_coefficient_formallyUnramified : Algebra.FormallyUnramified (RatFuncInfinityIntegers C) (RatFuncInfinityIntegers S) := by - letI : IsLocalization + let : IsLocalization (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl (RatFuncInfinityIntegers C) := ratFuncInfinityIntegers_isLocalization_reciprocal C - letI : IsLocalization + let : IsLocalization (Algebra.algebraMapSubmonoid S[X] (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) (RatFuncInfinityIntegers S) := ratFuncInfinityIntegers_isLocalization_coefficientPrimeCompl C S - letI : IsLocalization + let : IsLocalization (Submonoid.map (algebraMap C[X] S[X]) (Ideal.span ({Polynomial.X} : Set C[X])).primeCompl) (RatFuncInfinityIntegers S) := by simpa only [Algebra.algebraMapSubmonoid] using ratFuncInfinityIntegers_isLocalization_coefficientPrimeCompl C S - letI : Algebra.FormallyUnramified C[X] S[X] := + let : Algebra.FormallyUnramified C[X] S[X] := coefficientPolynomial_formallyUnramified C S exact Algebra.FormallyUnramified.localization_map (R := C[X]) (S := S[X]) @@ -304,31 +304,31 @@ theorem ratFuncInfinityIntegers_coefficient_differentIdeal_eq_top : (RatFuncInfinityIntegers S) = ⊤ := by let A := RatFuncInfinityIntegers C let B := RatFuncInfinityIntegers S - letI : Algebra.FormallyUnramified A B := + let : Algebra.FormallyUnramified A B := ratFuncInfinityIntegers_coefficient_formallyUnramified C S - letI : IsIntegralClosure B A (FractionRing B) := + let : IsIntegralClosure B A (FractionRing B) := IsIntegralClosure.of_isIntegrallyClosed B A (FractionRing B) - letI : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := + let : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := isAlgebraic_of_isFractionRing A B .. - letI : IsLocalization + let : IsLocalization (Algebra.algebraMapSubmonoid B A⁰) (FractionRing B) := IsIntegralClosure.isLocalization A (FractionRing A) (FractionRing B) B - letI : FiniteDimensional (FractionRing A) (FractionRing B) := + let : FiniteDimensional (FractionRing A) (FractionRing B) := Module.Finite.of_isLocalization A B A⁰ - letI : Algebra.FormallyUnramified B (FractionRing B) := + let : Algebra.FormallyUnramified B (FractionRing B) := Algebra.FormallyUnramified.of_isLocalization B⁰ - letI : Algebra.FormallyUnramified A (FractionRing B) := + let : Algebra.FormallyUnramified A (FractionRing B) := Algebra.FormallyUnramified.comp A B (FractionRing B) - letI : Algebra.FormallyUnramified (FractionRing A) (FractionRing B) := + let : Algebra.FormallyUnramified (FractionRing A) (FractionRing B) := Algebra.FormallyUnramified.localization_base A⁰ - letI : Algebra.IsSeparable (FractionRing A) (FractionRing B) := + let : Algebra.IsSeparable (FractionRing A) (FractionRing B) := Algebra.FormallyUnramified.isSeparable (FractionRing A) (FractionRing B) by_contra htop obtain ⟨P, hPmax, hdiffP⟩ := Ideal.exists_le_maximal (differentIdeal A B) htop - letI : P.IsPrime := hPmax.isPrime + let : P.IsPrime := hPmax.isPrime have hunram : Algebra.IsUnramifiedAt A P := by exact Algebra.formallyUnramified_iff_forall.mp (show Algebra.FormallyUnramified A B from inferInstance) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean index af60bb460b..9411cb4e99 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean @@ -50,16 +50,16 @@ local instance differentConstantPolynomialTower : IsScalarTower C S S[X] := attribute [local instance] FractionRing.liftAlgebra local instance differentCoefficientPolynomialModuleFinite : Module.Finite C[X] S[X] := by - letI : Module.Finite C[X] (C[X] ⊗[C] S) := + let : Module.Finite C[X] (C[X] ⊗[C] S) := Module.Finite.base_change C C[X] S exact Module.Finite.equiv (Algebra.IsPushout.equiv C C[X] S S[X]).toLinearEquiv local instance differentCoefficientPolynomialFormallyUnramified : Algebra.FormallyUnramified C[X] S[X] := by - letI : Algebra.FormallyUnramified C S := + let : Algebra.FormallyUnramified C S := Algebra.FormallyUnramified.of_isSeparable C S - letI : Algebra.FormallyUnramified C[X] (C[X] ⊗[C] S) := + let : Algebra.FormallyUnramified C[X] (C[X] ⊗[C] S) := Algebra.FormallyUnramified.base_change C[X] exact Algebra.FormallyUnramified.of_equiv (Algebra.IsPushout.equiv C C[X] S S[X]) @@ -86,7 +86,7 @@ local instance differentCoefficientRationalFunctionFiniteDimensional : local instance differentCoefficientRationalFunctionFormallyUnramified : Algebra.FormallyUnramified (FractionRing C[X]) (FractionRing S[X]) := by - letI : Algebra.FormallyUnramified C[X] (FractionRing S[X]) := inferInstance + let : Algebra.FormallyUnramified C[X] (FractionRing S[X]) := inferInstance exact Algebra.FormallyUnramified.localization_base (nonZeroDivisors C[X]) local instance differentCoefficientRationalFunctionSeparable : @@ -114,7 +114,7 @@ theorem coefficientPolynomial_differentIdeal_eq_top : by_contra htop obtain ⟨P, hPmax, hdiffP⟩ := Ideal.exists_le_maximal (differentIdeal C[X] S[X]) htop - letI : P.IsPrime := hPmax.isPrime + let : P.IsPrime := hPmax.isPrime have hunram : Algebra.IsUnramifiedAt C[X] P := by exact Algebra.formallyUnramified_iff_forall.mp diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean index 6544960798..622b2dd2c6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean @@ -37,10 +37,10 @@ theorem finiteField_fieldRange_le_of_finrank_dvd (f : A →ₐ[C] Ω) (g : B →ₐ[C] Ω) (hdiv : Module.finrank C A ∣ Module.finrank C B) : f.fieldRange ≤ g.fieldRange := by - letI : Fintype C := Fintype.ofFinite C - letI : Fintype A := Fintype.ofFinite A - letI : Fintype B := Fintype.ofFinite B - letI : Fintype Ω := Fintype.ofFinite Ω + let : Fintype C := Fintype.ofFinite C + let : Fintype A := Fintype.ofFinite A + let : Fintype B := Fintype.ofFinite B + let : Fintype Ω := Fintype.ofFinite Ω classical let p : Ω[X] := X ^ Fintype.card B - X have hcardB : 1 < Fintype.card B := Fintype.one_lt_card diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean index 2d55750832..44fdfb4102 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean @@ -40,7 +40,7 @@ theorem moduleFinite_and_finrank_le_of_finite_linearIndependent_card_le have hιFinite : Finite ι := by rw [← not_infinite_iff_finite] intro hιInfinite - letI : Infinite ι := hιInfinite + let : Infinite ι := hιInfinite obtain ⟨s, hs⟩ := Infinite.exists_subset_card_eq ι (g + 1) let v : s → V := fun i ↦ b i.1 have hv : LinearIndependent K v := @@ -49,10 +49,10 @@ theorem moduleFinite_and_finrank_le_of_finite_linearIndependent_card_le have hcard : Fintype.card s = g + 1 := by simpa only [Fintype.card_coe] using hs omega - letI : Finite ι := hιFinite - letI : Fintype ι := Fintype.ofFinite ι + let : Finite ι := hιFinite + let : Fintype ι := Fintype.ofFinite ι let hfinite : Module.Finite K V := Module.Finite.of_basis b - letI : Module.Finite K V := hfinite + let : Module.Finite K V := hfinite refine ⟨hfinite, ?_⟩ rw [Module.finrank_eq_card_basis b] exact hbound ι b b.linearIndependent diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean index 9b1f16480b..433bd3562f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean @@ -189,8 +189,8 @@ theorem finitePlaceUnderFiber_stabilizer_eq_decompositionGroup letI := finitePlaceUnderFiberGalAction K M L P MulAction.stabilizer Gal(L/M) Q = finitePlaceDecompositionGroup K M L Q.1 := by - letI := finiteIntegralClosureGalAction K M L - letI := finitePlaceUnderFiberGalAction K M L P + let := finiteIntegralClosureGalAction K M L + let := finitePlaceUnderFiberGalAction K M L P ext g change (g • Q = Q) ↔ g • Q.1.asIdeal = Q.1.asIdeal constructor @@ -211,8 +211,8 @@ theorem infinityPlaceUnderFiber_stabilizer_eq_decompositionGroup letI := infinityPlaceUnderFiberGalAction K M L P MulAction.stabilizer Gal(L/M) Q = infinityPlaceDecompositionGroup K M L Q.1 := by - letI := infinityIntegralClosureGalAction K M L - letI := infinityPlaceUnderFiberGalAction K M L P + let := infinityIntegralClosureGalAction K M L + let := infinityPlaceUnderFiberGalAction K M L P ext g change (g • Q = Q) ↔ g • Q.1.1 = Q.1.1 constructor diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean index 2371a2f204..44ac167393 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean @@ -159,18 +159,18 @@ theorem localPrincipalPartSpace_finite infer_instance | succ n ih => let f := localPrincipalPartLayerMap (K := K) (L := L) π n - letI : Module.Finite K (localPrincipalPartLayer (K := K) (L := L) π n) := + let : Module.Finite K (localPrincipalPartLayer (K := K) (L := L) π n) := Module.Finite.equiv (localPoleQuotientEquivResidueField (K := K) (L := L) π hπ hπIdeal n).symm - letI : Module.Finite K f.ker := by + let : Module.Finite K f.ker := by rw [show f.ker = LinearMap.range (localPrincipalPartInclusion (K := K) (L := L) π n) by exact (range_localPrincipalPartInclusion_eq_ker_layerMap (K := K) (L := L) π n).symm] infer_instance - letI : Module.Finite K f.range := inferInstance - letI : Module.Finite K + let : Module.Finite K f.range := inferInstance + let : Module.Finite K (localPrincipalPartSpace (K := K) (L := L) π (n + 1) ⧸ f.ker) := Module.Finite.equiv f.quotKerEquivRange.symm exact Module.Finite.of_submodule_quotient f.ker @@ -204,9 +204,9 @@ theorem localPrincipalPartSpace_finrank (⊤ : Submodule K (localPoleSpace (K := K) (L := L) π 0)))) | succ n ih => - letI := localPrincipalPartSpace_finite + let := localPrincipalPartSpace_finite (K := K) (L := L) π hπ hπIdeal n - letI := localPrincipalPartSpace_finite + let := localPrincipalPartSpace_finite (K := K) (L := L) π hπ hπIdeal (n + 1) let f := localPrincipalPartLayerMap (K := K) (L := L) π n have hsurj : Function.Surjective f := by @@ -296,18 +296,18 @@ theorem finitePrincipalPartsSpace_finrank [∀ i, Module.Finite K (IsLocalRing.ResidueField (R i))] : Module.finrank K (finitePrincipalPartsSpace (K := K) (L := L) π n) = finitePrincipalPartsDegree (K := K) (R := R) n := by - letI localPrincipalPartModule (i : I) : Module K + let localPrincipalPartModule (i : I) : Module K (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := inferInstance - letI finitePrincipalPartsModule : Module K + let finitePrincipalPartsModule : Module K (finitePrincipalPartsSpace (K := K) (L := L) π n) := Pi.module I (fun i => localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) K - letI (i : I) : Module.Finite K + let (i : I) : Module.Finite K (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := localPrincipalPartSpace_finite (K := K) (L := L) (π i) (hπ i) (hπIdeal i) (n i) - letI (i : I) : Module.Free K + let (i : I) : Module.Free K (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := Module.Free.of_divisionRing K (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) @@ -380,18 +380,18 @@ theorem finrank_quotient_regularAtFiniteFamily_le_degree Module.finrank K (S ⧸ regularAtFiniteFamily (K := K) (L := L) π S) ≤ finitePrincipalPartsDegree (K := K) (R := R) n := by - letI localPrincipalPartModule (i : I) : Module K + let localPrincipalPartModule (i : I) : Module K (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := inferInstance - letI finitePrincipalPartsModule : Module K + let finitePrincipalPartsModule : Module K (finitePrincipalPartsSpace (K := K) (L := L) π n) := Pi.module I (fun i => localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) K - letI (i : I) : Module.Finite K + let (i : I) : Module.Finite K (localPrincipalPartSpace (K := K) (L := L) (π i) (n i)) := localPrincipalPartSpace_finite (K := K) (L := L) (π i) (hπ i) (hπIdeal i) (n i) - letI : Module.Finite K + let : Module.Finite K (finitePrincipalPartsSpace (K := K) (L := L) π n) := inferInstance let f : S →ₗ[K] finitePrincipalPartsSpace (K := K) (L := L) π n := finitePrincipalPartsDiagonalMap (K := K) (L := L) π n S hS diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean index 0fd064c050..d5c62297a7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean @@ -57,7 +57,7 @@ theorem sum_mul_degree_eq_of_div_gcd_fibers change Q ∈ upMultiplicity.support rw [Finsupp.mem_support_iff, hmultiplicity Q, hQP] exact Finsupp.mem_support_iff.mp hP - letI : Fintype {Q : Up // down Q = P} := + let : Fintype {Q : Up // down Q = P} := (upMultiplicity.support.finite_toSet.subset hfiber_subset).fintype let fiberSupport := upMultiplicity.support.filter (fun Q ↦ down Q = P) let fiberEquiv : {Q : Up // Q ∈ fiberSupport} ≃ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean index 3ba091e683..3fa4e1592c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean @@ -25,9 +25,9 @@ theorem sum_card_fixedBy_eq_card_group_of_isPretransitive (G X : Type*) [Group G] [Fintype G] [MulAction G X] [Fintype X] [MulAction.IsPretransitive G X] [Nonempty X] : (∑ g : G, Nat.card (MulAction.fixedBy X g)) = Nat.card G := by - letI (g : G) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ + let (g : G) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ let Ω := MulAction.orbitRel.Quotient G X - letI : Fintype Ω := Fintype.ofFinite Ω + let : Fintype Ω := Fintype.ofFinite Ω have hΩ : Fintype.card Ω = 1 := Fintype.card_eq_one_iff_nonempty_unique.mpr ((MulAction.pretransitive_iff_unique_quotient_of_nonempty G X).mp inferInstance) @@ -137,15 +137,15 @@ theorem sum_card_fixedBy_quotientFiber_eq_card_ker letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ (∑ g : π ⁻¹' ({c} : Set C), Nat.card (MulAction.fixedBy X g.1)) = Nat.card π.ker := by - letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ - letI (x : X) : Fintype + let : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + let (x : X) : Fintype ((π.comp (MulAction.stabilizer G x).subtype) ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ - letI : MulAction.IsPretransitive π.ker X := + let : MulAction.IsPretransitive π.ker X := MonoidHom.ker_isPretransitive_of_stabilizer_surjective π hstab - letI (g : π ⁻¹' ({c} : Set C)) : + let (g : π ⁻¹' ({c} : Set C)) : Fintype (MulAction.fixedBy X g.1) := Fintype.ofFinite _ - letI (g : π.ker) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ + let (g : π.ker) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ let e₁ := MonoidHom.sigmaFiberFixedByEquivSigmaStabilizerFiber (X := X) π c let e₂ : @@ -190,7 +190,7 @@ theorem sum_card_fixedBy_quotientFiber_fibers_eq_card_mul_card_ker ∑ i : ι, Nat.card (MulAction.fixedBy (X i) g.1)) = Nat.card ι * Nat.card π.ker := by classical - letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ + let : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ rw [Finset.sum_comm] calc (∑ i : ι, ∑ g : π ⁻¹' ({c} : Set C), diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean index 57f96cf77b..3a890381e8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean @@ -127,8 +127,8 @@ theorem coeff_mul_indexedCurveZetaDenominator (Z * PowerSeries.X ^ (2 * d)) by ring] rw [map_add, map_sub, map_sub] simp only [PowerSeries.coeff_C_mul, PowerSeries.coeff_mul_X_pow'] - rw [if_pos (by omega : d ≤ n + 2 * d), - if_pos (by omega : 2 * d ≤ n + 2 * d)] + rw [ite_eq_left (by omega : d ≤ n + 2 * d), + ite_eq_left (by omega : 2 * d ≤ n + 2 * d)] simp only [show n + 2 * d - d = n + d by omega, show n + 2 * d - 2 * d = n by omega] ring diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean index 24d351d8c8..35a02cb04b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -38,15 +38,15 @@ theorem linearPowerSeriesFactor_inv (a : ℂ) : theorem derivative_linearPowerSeriesFactor (a : ℂ) : PowerSeries.derivative (R := ℂ) (linearPowerSeriesFactor a) = -PowerSeries.C a := by - change PowerSeries.derivativeFun (linearPowerSeriesFactor a) = -PowerSeries.C a + change PowerSeries.derivative (linearPowerSeriesFactor a) = -PowerSeries.C a rw [linearPowerSeriesFactor, sub_eq_add_neg] rw [show -(PowerSeries.C a * PowerSeries.X) = (-1 : ℂ) • (PowerSeries.C a * PowerSeries.X) by simp] rw [PowerSeries.derivativeFun_add, PowerSeries.derivativeFun_one, PowerSeries.derivativeFun_smul, PowerSeries.derivativeFun_mul] - have hX : PowerSeries.derivativeFun (PowerSeries.X : PowerSeries ℂ) = 1 := + have hX : PowerSeries.derivative (PowerSeries.X : PowerSeries ℂ) = 1 := PowerSeries.derivative_X - have hC : PowerSeries.derivativeFun (PowerSeries.C a) = 0 := + have hC : PowerSeries.derivative (PowerSeries.C a) = 0 := PowerSeries.derivative_C rw [hX, hC] simp @@ -80,19 +80,19 @@ theorem negativeXLogDerivative_mul negativeXLogDerivative (f * g) = negativeXLogDerivative f + negativeXLogDerivative g := by unfold negativeXLogDerivative - change -PowerSeries.X * PowerSeries.derivativeFun (f * g) * (f * g)⁻¹ = - -PowerSeries.X * PowerSeries.derivativeFun f * f⁻¹ + - -PowerSeries.X * PowerSeries.derivativeFun g * g⁻¹ + change -PowerSeries.X * PowerSeries.derivative (f * g) * (f * g)⁻¹ = + -PowerSeries.X * PowerSeries.derivative f * f⁻¹ + + -PowerSeries.X * PowerSeries.derivative g * g⁻¹ rw [PowerSeries.derivativeFun_mul, inverse_mul_of_constantCoeff_ne_zero f g hf hg] simp only [smul_eq_mul] calc - -PowerSeries.X * (f * PowerSeries.derivativeFun g + - g * PowerSeries.derivativeFun f) * (f⁻¹ * g⁻¹) = - (-PowerSeries.X * PowerSeries.derivativeFun g * g⁻¹) * (f * f⁻¹) + - (-PowerSeries.X * PowerSeries.derivativeFun f * f⁻¹) * (g * g⁻¹) := by ring - _ = -PowerSeries.X * PowerSeries.derivativeFun f * f⁻¹ + - -PowerSeries.X * PowerSeries.derivativeFun g * g⁻¹ := by + -PowerSeries.X * (f * PowerSeries.derivative g + + g * PowerSeries.derivative f) * (f⁻¹ * g⁻¹) = + (-PowerSeries.X * PowerSeries.derivative g * g⁻¹) * (f * f⁻¹) + + (-PowerSeries.X * PowerSeries.derivative f * f⁻¹) * (g * g⁻¹) := by ring + _ = -PowerSeries.X * PowerSeries.derivative f * f⁻¹ + + -PowerSeries.X * PowerSeries.derivative g * g⁻¹ := by rw [PowerSeries.mul_inv_cancel f hf, PowerSeries.mul_inv_cancel g hg] ring diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean index d1d54dc463..7a5ffcf660 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean @@ -65,7 +65,7 @@ theorem finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constant Nat.card (π.comp (finitePlaceDecompositionGroup C M L Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by - letI := finiteIntegralClosureGalAction C M L + let := finiteIntegralClosureGalAction C M L have hrelative : finitePlaceRelativeInertiaDeg C M L Q = Module.finrank C S := by have hdegree := @@ -109,7 +109,7 @@ theorem infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_consta Nat.card (π.comp (infinityPlaceDecompositionGroup C M L Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by - letI := infinityIntegralClosureGalAction C M L + let := infinityIntegralClosureGalAction C M L have hrelative : infinityPlaceRelativeInertiaDeg C M L Q = Module.finrank C S := by have hdegree := @@ -157,8 +157,8 @@ theorem finitePlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_const Nat.card (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by - letI := finiteIntegralClosureGalAction C M L - letI := finitePlaceUnderFiberGalAction C M L P + let := finiteIntegralClosureGalAction C M L + let := finitePlaceUnderFiberGalAction C M L P have hBase' : finiteExtensionPlaceDegree C M (.inl (finitePlaceUnder C M L Q.1)) = 1 := by rw [Q.2] @@ -187,8 +187,8 @@ theorem infinityPlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_con Nat.card (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by - letI := infinityIntegralClosureGalAction C M L - letI := infinityPlaceUnderFiberGalAction C M L P + let := infinityIntegralClosureGalAction C M L + let := infinityPlaceUnderFiberGalAction C M L P have hBase' : finiteExtensionPlaceDegree C M (.inr (infinityPlaceUnder C M L Q.1)) = 1 := by rw [Q.2] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean index f6730516a6..bfcdbf4323 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean @@ -173,13 +173,13 @@ theorem finiteExtensionPoleDivisor_powCardLinearMap ((Fintype.card K ^ n : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L x v < 0 := mul_neg_of_pos_of_neg hs hv - rw [if_pos hscaled, if_pos hv] + rw [ite_eq_left hscaled, ite_eq_left hv] ring · have hscaled : ¬ ((Fintype.card K ^ n : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L x v < 0 := not_lt_of_ge (mul_nonneg hs.le (le_of_not_gt hv)) - rw [if_neg hscaled, if_neg hv, mul_zero] + rw [ite_eq_right hscaled, ite_eq_right hv, mul_zero] /-- Iterated Frobenius sends `L(D)` into `L((#K)^n D)`. -/ theorem powCardLinearMap_mem_scaledRiemannSpace diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean index abcec379d1..929b825011 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean @@ -105,7 +105,7 @@ theorem tensorFractionLocalizationEquiv_algebraMap (z : TensorBase K E A) : | add x y hx hy => simp only [map_add, hx, hy] local instance tensorFractionIsDomain : IsDomain (TensorFraction K E A) := by - letI : IsDomain (TensorBaseLocalization K E A) := + let : IsDomain (TensorBaseLocalization K E A) := IsLocalization.isDomain_localization (tensorBase_nonZero_map K E A) exact (tensorFractionLocalizationEquiv K E A).toMulEquiv.isDomain_iff.mpr inferInstance @@ -202,7 +202,7 @@ coordinate ring is a domain. -/ theorem planeCurveCoordinateRingBaseChange_isDomain (hfE : Irreducible (MvPolynomial.map (algebraMap K E) f)) : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := by - letI : IsDomain (PlaneCurveCoordinateRing + let : IsDomain (PlaneCurveCoordinateRing (MvPolynomial.map (algebraMap K E) f)) := planeCurveCoordinateRing_isDomain hfE exact (planeCurveCoordinateRingBaseChangeAlgEquiv K E f).toMulEquiv.isDomain_iff.mpr @@ -241,11 +241,11 @@ theorem planeCurveFunctionFieldBaseChangeAlgEquiv_tmul_one (e : E) : algebraMap E (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) e := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf - letI : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := + let : IsDomain (E ⊗[K] PlaneCurveCoordinateRing f) := planeCurveCoordinateRingBaseChange_isDomain K E f hfE - letI : IsFractionRing + let : IsFractionRing (E ⊗[K] PlaneCurveCoordinateRing f) (E ⊗[K] PlaneCurveFunctionField f) := tensorFraction_isFractionRing K E (PlaneCurveCoordinateRing f) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean index 41743ec70f..d7d56a749b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean @@ -139,10 +139,10 @@ theorem ratFuncFinitePlaceResidueField_finite [Fintype K] p.asIdeal = (normalizedPrimeFinitePlace (K := K) r).asIdeal := by rw [normalizedPrimeFinitePlace_finitePlaceNormalizedPrime] _ = Ideal.span ({(r : K[X])} : Set K[X]) := rfl - letI : Module.Finite K (K[X] ⧸ p.asIdeal) := by + let : Module.Finite K (K[X] ⧸ p.asIdeal) := by rw [hp] exact hrmonic.finite_quotient - letI : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K + let : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K infer_instance omit [DecidableEq (RatFunc K)] in @@ -151,14 +151,14 @@ finite over a finite constant field. -/ theorem finiteExtensionFinitePlaceResidueField_finite [Fintype K] (P : FiniteExtensionFinitePlace K N) : Finite P.asIdeal.ResidueField := by let p := HeightOneSpectrum.under K[X] P - letI : Finite p.asIdeal.ResidueField := + let : Finite p.asIdeal.ResidueField := ratFuncFinitePlaceResidueField_finite K p - letI : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal + let : P.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let := Localization.AtPrime.algebraOfLiesOver p.asIdeal P.asIdeal let _ : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime P.asIdeal) := inferInstance - letI : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance - letI : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := + let : Algebra.QuasiFiniteAt K[X] P.asIdeal := inferInstance + let : Module.Finite p.asIdeal.ResidueField P.asIdeal.ResidueField := inferInstance exact Module.finite_of_finite p.asIdeal.ResidueField @@ -182,14 +182,14 @@ noncomputable instance functionFieldConstantField_finiteDimensional [Fintype K] let P : p.asIdeal.primesOver (RatFuncFiniteIntegralClosure K N) := ⟨Q, hQprime, ⟨hQcomap.symm⟩⟩ let q : FiniteExtensionFinitePlace K N := primeOverHeightOne p P - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := finiteExtensionFinitePlaceResidueField_finite K N q - letI : Finite (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) := + let : Finite (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) := Finite.of_injective (algebraMap (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) q.asIdeal.ResidueField) (Ideal.injective_algebraMap_quotient_residueField q.asIdeal) - letI : Module.Finite K + let : Module.Finite K (RatFuncFiniteIntegralClosure K N ⧸ q.asIdeal) := Module.Finite.of_finite exact FiniteDimensional.of_injective diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean index ec8d1aed66..e7fc2ea09a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean @@ -61,7 +61,7 @@ variable [FiniteDimensional (RatFunc K) L] /-- The chosen normal closure remains finite over `K(t)`. -/ noncomputable instance functionFieldNormalClosure_finiteDimensional : FiniteDimensional (RatFunc K) (FunctionFieldNormalClosure K L) := by - letI : FiniteDimensional (RatFunc K) + let : FiniteDimensional (RatFunc K) (functionFieldSeparableClosureEmbedding K L).fieldRange := (functionFieldSeparableClosureEmbedding K L).toLinearMap.finiteDimensional_range change FiniteDimensional (RatFunc K) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index 9cef36b979..7fe6d29dda 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -111,7 +111,7 @@ theorem functionFieldNormalClosureConstant_mem_originalCompositum (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) (c : FunctionFieldNormalClosureConstantField K F) : c.1 ∈ FunctionFieldNormalClosureOriginalCompositum K F hExact := by - letI : Field (ExactConstantExtension K F + let : Field (ExactConstantExtension K F (FunctionFieldNormalClosureConstantField K F)) := exactConstantExtensionField K F (FunctionFieldNormalClosureConstantField K F) hExact @@ -123,7 +123,7 @@ theorem functionFieldNormalClosureRatFunc_mem_originalCompositum (r : RatFunc K) : algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) r ∈ FunctionFieldNormalClosureOriginalCompositum K F hExact := by - letI : Field (ExactConstantExtension K F + let : Field (ExactConstantExtension K F (FunctionFieldNormalClosureConstantField K F)) := exactConstantExtensionField K F (FunctionFieldNormalClosureConstantField K F) hExact @@ -333,7 +333,7 @@ noncomputable instance FiniteDimensional (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) := by - letI : Module.Finite + let : Module.Finite (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) := Module.Finite.of_restrictScalars_finite (RatFunc K) @@ -411,7 +411,7 @@ private theorem originalMultiplicationCanonicalRatFunc_X : algebraMap (RatFunc K) (FunctionFieldNormalClosure K F) RatFunc.X := by intro model1 model2 hExact let C := FunctionFieldNormalClosureConstantField K F - letI : Algebra K[X] F := + let : Algebra K[X] F := RingHom.toAlgebra ((algebraMap (RatFunc K) F).comp (algebraMap K[X] (RatFunc K))) rw [ratFuncToExactConstantExtension_X] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean index 0f41cc86ab..3a5690bfbc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean @@ -5,7 +5,10 @@ Authors: Yuma Mizuno -/ import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage -import Mathlib +import Mathlib.Algebra.CharP.Defs +import Mathlib.Algebra.Order.Star.Real +import Mathlib.Analysis.Asymptotics.Defs +import Mathlib.Tactic /-! # The finite averaging step in the Corvaja--Zannier Hasse--Weil argument diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean index 37fcec3539..5ea516847e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean @@ -98,7 +98,7 @@ theorem infinitySupported_riemann_lower_of_monomial have hsplit : E + A = D := by dsimp only [A] abel - letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := + let : Module.Finite K (finiteExtensionRiemannSpace K L E) := finiteExtensionRiemannSpace_effective_moduleFinite K L E hE have hstrip := finiteExtensionRiemannSpace_add_effective K L E A hE hA @@ -269,7 +269,7 @@ theorem finitePlace_riemann_lower_of_primitive · subst v simp [Dq] · simp [Dq, Finsupp.single_eq_of_ne hv] - letI : Module.Finite K (finiteExtensionRiemannSpace K L Dq) := + let : Module.Finite K (finiteExtensionRiemannSpace K L Dq) := finiteExtensionRiemannSpace_effective_moduleFinite K L Dq hDq have hstrip := finiteExtensionRiemannSpace_add_effective K L Dq E hDq hE diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean index b23ad08769..2c23fcfcae 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean @@ -75,7 +75,7 @@ degree. -/ theorem rationalInfinityPlace_card_le_finrank : Nat.card (FiniteExtensionRationalInfinityPlace S L) ≤ Module.finrank (RatFunc S) L := by - letI : Fintype (FiniteExtensionInfinityPlace S L) := + let : Fintype (FiniteExtensionInfinityPlace S L) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite (ratFuncInfinityPlace S).asIdeal (RatFuncInfinityIntegralClosure S L)) @@ -141,7 +141,7 @@ theorem finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceR let p : FiniteExtensionRationalFinitePlace S L → Prop := fun Q => (Sum.inl Q.1 : FiniteExtensionPlace S L) = P let Away := {Q : FiniteExtensionRationalFinitePlace S L // ¬ p Q} - letI : Fintype Away := Fintype.ofFinite _ + let : Fintype Away := Fintype.ofFinite _ let place : Away → FiniteExtensionFinitePlace S L := fun Q => Q.1.1 have hplaceInjective : Function.Injective place := by intro Q R hQR @@ -171,7 +171,7 @@ theorem finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceR exact Sum.inl.inj (Q.2.trans R.2.symm) have hpCard : Nat.card {Q : FiniteExtensionRationalFinitePlace S L // p Q} ≤ 1 := by - letI := hpSubsingleton + let := hpSubsingleton simpa using Nat.card_le_card_of_injective (fun _ : {Q : FiniteExtensionRationalFinitePlace S L // p Q} => (Unit.unit : Unit)) @@ -196,7 +196,7 @@ theorem finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceR Nat.add_le_add hfinite (rationalInfinityPlace_card_le_finrank S L) _ = Fintype.card S + (2 * g + 1) * Fintype.card K + Module.finrank (RatFunc S) L := by rw [hbudget] - · letI : IsEmpty (FiniteExtensionRationalFinitePlace S L) := + · let : IsEmpty (FiniteExtensionRationalFinitePlace S L) := ⟨fun Q => hnonempty ⟨Q⟩⟩ rw [finiteExtensionRationalPlaceCount, Nat.card_sum] simp only [Nat.card_of_isEmpty, zero_add] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean index ccfbf52d1a..cf1b5c5734 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean @@ -48,7 +48,7 @@ theorem multiplicity_map_eq_ramificationIdx_mul_under multiplicity w.asIdeal (I.map (algebraMap R S)) = w.asIdeal.ramificationIdx R * multiplicity (w.under R).asIdeal I := by - letI : w.asIdeal.LiesOver (w.under R).asIdeal := ⟨rfl⟩ + let : w.asIdeal.LiesOver (w.under R).asIdeal := ⟨rfl⟩ simpa using multiplicity_map_eq_ramificationIdx_mul (R := R) (S := S) (w.under R) w I hI diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean index f6484c7d61..54516965b0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean @@ -164,10 +164,10 @@ theorem localPoleCumulativeQuotient_finrank (localPoleSpace (K := K) (L := L) π 0)) = n * Module.finrank K (IsLocalRing.ResidueField R) := by let I := IsLocalRing.maximalIdeal R ^ n - letI : Finite (R ⧸ I) := + let : Finite (R ⧸ I) := IsLocalRing.finite_quotient_iff.mpr ⟨n, le_rfl⟩ - letI : Module.Finite K (R ⧸ I) := Module.Finite.of_finite - letI : Module.Finite K (IsLocalRing.ResidueField R) := + let : Module.Finite K (R ⧸ I) := Module.Finite.of_finite + let : Module.Finite K (IsLocalRing.ResidueField R) := Module.Finite.of_finite have hlocalLength : Module.length R (R ⧸ I) = n := by exact IsDiscreteValuationRing.length_quotient_pow_maximalIdeal R n diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean index 5fb072e776..ce879e8f6c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean @@ -67,7 +67,7 @@ theorem finiteExtensionOnePointRiemannSpace_increment change Module.Finite K (finiteExtensionOnePointRiemannSpace K L (.inl q) n) infer_instance - letI := hbase + let := hbase have h := finiteExtensionRiemannSpace_finitePlace_increment K L (Finsupp.single (.inl q) (n : ℤ)) hD q have hdivisor : @@ -87,7 +87,7 @@ theorem finiteExtensionOnePointRiemannSpace_increment change Module.Finite K (finiteExtensionOnePointRiemannSpace K L (.inr q) n) infer_instance - letI := hbase + let := hbase have h := finiteExtensionRiemannSpace_infinityPlace_increment K L (Finsupp.single (.inr q) (n : ℤ)) hD q have hdivisor : @@ -112,7 +112,7 @@ theorem finiteExtensionOnePointRiemannSpace_moduleFinite | zero => exact finiteExtensionOnePointRiemannSpace_zero_moduleFinite K L P | succ n ih => - letI : Module.Finite K + let : Module.Finite K (finiteExtensionOnePointRiemannSpace K L P n) := ih exact (finiteExtensionOnePointRiemannSpace_increment K L P n).1 @@ -124,7 +124,7 @@ theorem finiteExtensionOnePointRiemannSpace_finrank_succ_le Module.finrank K (finiteExtensionOnePointRiemannSpace K L P n) + finiteExtensionPlaceDegree K L P := by - letI : Module.Finite K + let : Module.Finite K (finiteExtensionOnePointRiemannSpace K L P n) := finiteExtensionOnePointRiemannSpace_moduleFinite K L P n exact (finiteExtensionOnePointRiemannSpace_increment K L P n).2 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean index 78d03a09b1..3fef123e15 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean @@ -59,8 +59,8 @@ theorem localizationAtPrime_constantResidue_surjective (IsLocalRing.maximalIdeal S).ResidueField) := by intro z let m := IsLocalRing.maximalIdeal S - letI : q.asIdeal.IsMaximal := q.isMaximal - letI : m.IsMaximal := by + let : q.asIdeal.IsMaximal := q.isMaximal + let : m.IsMaximal := by simpa [m] using (IsLocalRing.maximalIdeal.isMaximal S) obtain ⟨s, hs⟩ := m.algebraMap_residueField_surjective z let e := IsLocalization.AtPrime.equivQuotMaximalIdeal q.asIdeal S @@ -161,9 +161,9 @@ theorem ratFuncFinitePlaceDegree_eq_finrank_residueField rw [← show (normalizedPrimeFinitePlace (K := K) r).asIdeal = p.asIdeal by exact congrArg HeightOneSpectrum.asIdeal hp] rfl - letI : (Ideal.span {(r : K[X])}).IsPrime := + let : (Ideal.span {(r : K[X])}).IsPrime := (normalizedPrimeFinitePlace (K := K) r).isPrime - letI : (Ideal.span {(r : K[X])}).IsMaximal := + let : (Ideal.span {(r : K[X])}).IsMaximal := (inferInstance : (Ideal.span {(r : K[X])}).IsPrime).isMaximal (by simpa only [ne_eq, Ideal.span_singleton_eq_bot] using r.property.1.ne_zero) @@ -196,8 +196,8 @@ theorem finiteExtensionFinitePlace_degree_eq_finrank_residueField finiteExtensionPlaceDegree K L (.inl q) = Module.finrank K q.asIdeal.ResidueField := by let p := HeightOneSpectrum.under K[X] q - letI : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ - letI hLocalAlg := + let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p.asIdeal q.asIdeal have : IsScalarTower K[X] (Localization.AtPrime p.asIdeal) (Localization.AtPrime q.asIdeal) := inferInstance @@ -214,12 +214,12 @@ theorem finiteExtensionInfinityPlace_degree_eq_finrank_residueField finiteExtensionPlaceDegree K L (.inr P) = Module.finrank K P.1.ResidueField := by let p := (ratFuncInfinityPlace K).asIdeal - letI hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 + let hLocalAlg := Localization.AtPrime.algebraOfLiesOver p P.1 have : IsScalarTower (RatFuncInfinityIntegers K) (Localization.AtPrime p) (Localization.AtPrime P.1) := inferInstance - letI : Algebra p.ResidueField P.1.ResidueField := + let : Algebra p.ResidueField P.1.ResidueField := IsLocalRing.ResidueField.instAlgebra - letI : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance + let : IsScalarTower K p.ResidueField P.1.ResidueField := inferInstance rw [finiteExtensionPlaceDegree, Ideal.inertiaDeg_eq p P.1] have hbase : Module.finrank K p.ResidueField = 1 := by simpa [p] using @@ -278,26 +278,26 @@ theorem exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt_of_residue finitePlaceOrder q x < finitePlaceOrder q (x - algebraMap C L c * y) := by let S := Localization.AtPrime q.asIdeal - letI : Algebra C S := + let : Algebra C S := Algebra.ofModule smul_mul_assoc mul_smul_comm - letI : IsScalarTower C R S := inferInstance + let : IsScalarTower C R S := inferInstance let toField : S →+* L := IsLocalization.lift (S := S) (M := q.asIdeal.primeCompl) (g := algebraMap R L) fun d => IsLocalization.map_units L ⟨d.1, q.asIdeal.primeCompl_le_nonZeroDivisors d.2⟩ - letI : Algebra S L := toField.toAlgebra - letI : IsScalarTower R S L := by + let : Algebra S L := toField.toAlgebra + let : IsScalarTower R S L := by apply IsScalarTower.of_algebraMap_eq' exact (IsLocalization.lift_comp _).symm - letI : IsFractionRing S L := + let : IsFractionRing S L := IsFractionRing.isFractionRing_of_isDomain_of_isLocalization q.asIdeal.primeCompl S L - letI : IsDiscreteValuationRing S := + let : IsDiscreteValuationRing S := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain R q.ne_bot S - letI : IsScalarTower C S L := by + let : IsScalarTower C S L := by apply IsScalarTower.of_algebraMap_eq' ext c simp only [RingHom.comp_apply, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean index a9142fab9c..df8788c6d8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean @@ -103,7 +103,7 @@ private theorem one_add_card_positive_members_eq_card_members | zero => change 1 = ((Finset.range 1).filter (fun i => i ∈ H)).card simp only [Finset.range_one, Finset.filter_singleton] - rw [if_pos H.zero_mem] + rw [ite_eq_left H.zero_mem] simp | succ n ih => by_cases hn : n + 1 ∈ H @@ -111,7 +111,7 @@ private theorem one_add_card_positive_members_eq_card_members (addSubmonoidPositiveMembersBelow H (n + 1)).card = (addSubmonoidPositiveMembersBelow H n).card + 1 := by rw [addSubmonoidPositiveMembersBelow, Finset.range_add_one, - Finset.filter_insert, if_pos hn, Finset.card_insert_of_notMem] + Finset.filter_insert, ite_eq_left hn, Finset.card_insert_of_notMem] · rfl · simp have hmembers : @@ -119,7 +119,7 @@ private theorem one_add_card_positive_members_eq_card_members (addSubmonoidMembersBelowOrAt H n).card + 1 := by rw [addSubmonoidMembersBelowOrAt] rw [show n + 1 + 1 = (n + 1) + 1 by omega, - Finset.range_add_one, Finset.filter_insert, if_pos hn, + Finset.range_add_one, Finset.filter_insert, ite_eq_left hn, Finset.card_insert_of_notMem] · rfl · simp @@ -129,14 +129,14 @@ private theorem one_add_card_positive_members_eq_card_members (addSubmonoidPositiveMembersBelow H (n + 1)).card = (addSubmonoidPositiveMembersBelow H n).card := by rw [addSubmonoidPositiveMembersBelow, Finset.range_add_one, - Finset.filter_insert, if_neg hn, + Finset.filter_insert, ite_eq_right hn, addSubmonoidPositiveMembersBelow] have hmembers : (addSubmonoidMembersBelowOrAt H (n + 1)).card = (addSubmonoidMembersBelowOrAt H n).card := by rw [addSubmonoidMembersBelowOrAt] rw [show n + 1 + 1 = (n + 1) + 1 by omega, - Finset.range_add_one, Finset.filter_insert, if_neg hn, + Finset.range_add_one, Finset.filter_insert, ite_eq_right hn, addSubmonoidMembersBelowOrAt] rw [hpositive, hmembers] exact ih diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean index 09e9c025d4..ec9b04fbc9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean @@ -189,7 +189,7 @@ theorem exists_onePointStepanovBasisAuxiliary_of_degree_le_two obtain ⟨u, du, huMem, huNe, huOrder, hduInjective, hduLe, huLI⟩ := exists_onePointSectionsWithConstant_of_le_card_strictLevels K L P ell (ell - g) hstrict - letI : Module.Finite K V := + let : Module.Finite K V := finiteExtensionOnePointRiemannSpace_moduleFinite K L P m let b := Module.finBasis K V let v : Fin (Module.finrank K V) → L := fun j => (b j : V) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean index 6f412a16c4..6b13001a37 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean @@ -45,7 +45,7 @@ theorem strictFiltrationLevels_succ_card_of_lt (strictFiltrationLevels R n).card + 1 := by classical simp only [strictFiltrationLevels, Finset.range_add_one, Finset.filter_insert] - rw [if_pos h, Finset.card_insert_of_notMem] + rw [ite_eq_left h, Finset.card_insert_of_notMem] simp theorem strictFiltrationLevels_succ_card_of_not_lt @@ -54,7 +54,7 @@ theorem strictFiltrationLevels_succ_card_of_not_lt (strictFiltrationLevels R n).card := by classical simp only [strictFiltrationLevels, Finset.range_add_one, Finset.filter_insert] - rw [if_neg h] + rw [ite_eq_right h] /-- If every nontrivial step of a nested filtration has dimension increase at most `d`, then the total dimension is bounded by `d` times the number of diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean index 3792885add..dad1fb37bf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean @@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib +import Mathlib.Algebra.Order.Star.Real +import Mathlib.Tactic /-! # Numerical transfer from normalization counts to affine counts diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean index b9847d6dfa..9d3ffd4eb4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean @@ -70,7 +70,7 @@ theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_evenErr classical let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -78,14 +78,14 @@ theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_evenErr let canonicalAlg : Algebra K L := inferInstance let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule - letI : FiniteDimensional (RatFunc K) L := + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let inducedAlg : Algebra K L := bridgeBaseConstantAlgebra K L have hinducedAlg : inducedAlg = canonicalAlg := by apply Algebra.algebra_ext @@ -98,7 +98,7 @@ theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_evenErr K L _ _ canonicalAlg (planeCurveFunction f 0) hx) (Polynomial.C c) simpa using h - letI : Algebra K L := inducedAlg + let : Algebra K L := inducedAlg dsimp only intro herror let budget := (firstDegree - 1) * (secondDegree - 1) @@ -205,7 +205,7 @@ theorem classical let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -213,14 +213,14 @@ theorem let canonicalAlg : Algebra K L := inferInstance let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule - letI : FiniteDimensional (RatFunc K) L := + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let inducedAlg : Algebra K L := bridgeBaseConstantAlgebra K L have hinducedAlg : inducedAlg = canonicalAlg := by apply Algebra.algebra_ext @@ -233,7 +233,7 @@ theorem K L _ _ canonicalAlg (planeCurveFunction f 0) hx) (Polynomial.C c) simpa using h - letI : Algebra K L := inducedAlg + let : Algebra K L := inducedAlg dsimp only intro herror let budget := (firstDegree - 1) * (secondDegree - 1) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean index c63cae273d..57ed558f29 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean @@ -47,7 +47,7 @@ theorem finiteExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount : finiteExtensionClosedPlaceExtensionCount K L 1 = finiteExtensionRationalPlaceCount K L := by classical - letI := finiteExtensionPlaceDegreeLEFintype K L 1 + let := finiteExtensionPlaceDegreeLEFintype K L 1 rw [finiteExtensionClosedPlaceExtensionCount] have hdegree : ∀ P : {P : FiniteExtensionPlace K L // finiteExtensionPlaceDegree K L P ≤ 1}, @@ -352,21 +352,21 @@ theorem abs_affinePlaneCurveZeros_card_sub_card_le_eight_mul_bidegree_of_standar classical let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule - letI : FiniteDimensional (RatFunc K) L := + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only intro hPform herror have hhasse := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean index 7c86fcb92a..bc9a58c2ef 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean @@ -102,24 +102,24 @@ theorem affineSecondCoordinateRegularPointToRationalFinitePlace_injective Function.Injective (affineSecondCoordinateRegularPointToRationalFinitePlace hf hpartialFirst hpartialSecond) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only intro z w hzw apply Subtype.ext @@ -153,24 +153,24 @@ theorem affineSecondCoordinateRegularPoint_card_le_rationalFinitePlace Nat.card (FiniteExtensionRationalFinitePlace K (PlaneCurveFunctionField f)) := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only let toPlace := affineSecondCoordinateRegularPointToRationalFinitePlace hf hpartialFirst hpartialSecond @@ -204,24 +204,24 @@ theorem affineSecondCoordinateRegularPoint_card_le_rationalPlaceCount Fintype.card (AffineSecondCoordinateRegularPoint f) ≤ finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only calc Fintype.card (AffineSecondCoordinateRegularPoint f) ≤ @@ -267,24 +267,24 @@ theorem affinePlaneCurvePoint_card_le_rationalPlaceCount_add_critical finiteExtensionRationalPlaceCount K (PlaneCurveFunctionField f) + (affineSecondCoordinateCriticalPoints K f).card := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only rw [affinePlaneCurvePoint_card_eq_regular_add_critical f] exact Nat.add_le_add_right diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean index 6c796af190..c42794d9b7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean @@ -46,17 +46,17 @@ theorem finiteExtensionHeight_planeCurveFirstCoordinate finiteExtensionHeight K (PlaneCurveFunctionField f) (planeCurveFunction f 0) = MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hx0 : x ≠ 0 := by change planeCurveFunction f 0 ≠ 0 @@ -90,17 +90,17 @@ theorem finiteExtensionDivisorDegree_planeCurveFirstCoordinate_poleDivisor (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0)) = (MvPolynomial.degreeOf 1 f : ℤ) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change finiteExtensionDivisorDegree K L (finiteExtensionPoleDivisor K L x) = @@ -148,17 +148,17 @@ theorem planeCurveFirstCoordinate_poleDivisor_support_nonempty letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0)).support.Nonempty := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change (finiteExtensionPoleDivisor K L x).support.Nonempty apply Finsupp.support_nonempty_iff.mpr @@ -194,17 +194,17 @@ theorem exists_planeCurveFirstCoordinate_polePlace 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) P ∧ finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) P ≤ MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond obtain ⟨P, hPsupport⟩ := planeCurveFirstCoordinate_poleDivisor_support_nonempty diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean index 5c2f302cdc..2260b6e45c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean @@ -197,17 +197,17 @@ theorem finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegativ ∀ q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f), 0 ≤ finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (.inl q) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change ∀ q : FiniteExtensionFinitePlace K L, 0 ≤ finiteExtensionPrincipalDivisor K L x (.inl q) @@ -231,23 +231,23 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero ∀ q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f), finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (.inl q) = 0 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change ∀ q : FiniteExtensionFinitePlace K L, finiteExtensionPoleDivisor K L x (.inl q) = 0 intro q rw [finiteExtensionPoleDivisor_apply] - rw [if_neg (not_lt_of_ge + rw [ite_eq_right (not_lt_of_ge (finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegative hf hpartialSecond q))] @@ -266,17 +266,17 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive ∀ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (.inr P) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change ∀ P : FiniteExtensionInfinityPlace K L, 0 < finiteExtensionPoleDivisor K L x (.inr P) @@ -287,7 +287,7 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx rw [← hmapX] exact finiteExtensionPrincipalDivisor_algebraMap_X_inr_negative K L P - rw [finiteExtensionPoleDivisor_apply, if_pos hnegative] + rw [finiteExtensionPoleDivisor_apply, ite_eq_left hnegative] omega /-- The controlled pole place for the first plane coordinate lies above the @@ -309,17 +309,17 @@ theorem exists_planeCurveFirstCoordinate_infinityPolePlace 0 < finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inr P) ∧ finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inr P) ≤ MvPolynomial.degreeOf 1 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let x : L := planeCurveFunction f 0 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change ∃ P : FiniteExtensionInfinityPlace K L, 0 < finiteExtensionPoleDivisor K L x (.inr P) ∧ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean index 19ed99a3c5..d0ba87d7b1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean @@ -398,7 +398,7 @@ theorem pderiv_zero_ne_zero_or_pderiv_one_ne_zero_of_absolutelyIrreducible (map (algebraMap K (AlgebraicClosure K)) f)) : pderiv 0 f ≠ 0 ∨ pderiv 1 f ≠ 0 := by let p := ringChar K - letI : Fact p.Prime := ⟨CharP.char_is_prime K p⟩ + let : Fact p.Prime := ⟨CharP.char_is_prime K p⟩ by_contra h rw [not_or] at h have hzero : pderiv 0 f = 0 := not_ne_iff.mp h.1 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean index 3c466bcbc1..11404867f2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean @@ -98,21 +98,21 @@ theorem planeCurve_genus_le_bidegreeGenusBudget planeCurveBidegreeGenusBudget f := by let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let canonicalAlg : Algebra K L := inferInstance - letI : Algebra K L := canonicalAlg + let : Algebra K L := canonicalAlg let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule - letI : FiniteDimensional (RatFunc K) L := + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let inducedAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp @@ -128,12 +128,12 @@ theorem planeCurve_genus_le_bidegreeGenusBudget K L _ _ canonicalAlg (planeCurveFunction f 0) hx) (Polynomial.C c) simpa using h - letI : Algebra K L := inducedAlg - letI : SMul K L := inducedAlg.toSMul - letI : Module K L := inducedAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := inducedAlg + let : SMul K L := inducedAlg.toSMul + let : Module K L := inducedAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K K[X] L := + let : IsScalarTower K K[X] L := IsScalarTower.of_algebraMap_eq' rfl have hconstantsCanonical : @algebraicClosure K L _ _ canonicalAlg = ⊥ := by @@ -144,7 +144,7 @@ theorem planeCurve_genus_le_bidegreeGenusBudget change @algebraicClosure K L _ _ inducedAlg = ⊥ rw [hinducedAlg] exact hconstantsCanonical - letI : FunctionField.IsFullConstantField K L := + let : FunctionField.IsFullConstantField K L := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 hconstants let q : FiniteExtensionFinitePlace K L := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean index d709e2f1f9..d179763198 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean @@ -72,7 +72,7 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace planeCurveBidegreeGenusBudget f := by let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -80,21 +80,21 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace let canonicalAlg : Algebra K L := inferInstance let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule let polynomialAlg : Algebra K[X] L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K[X] (RatFunc K))) - letI : Algebra K[X] L := polynomialAlg - letI : SMul K[X] L := polynomialAlg.toSMul - letI : Module K[X] L := polynomialAlg.toModule - letI : IsScalarTower K[X] (RatFunc K) L := + let : Algebra K[X] L := polynomialAlg + let : SMul K[X] L := polynomialAlg.toSMul + let : Module K[X] L := polynomialAlg.toModule + let : IsScalarTower K[X] (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let inducedAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp @@ -110,12 +110,12 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace K L _ _ canonicalAlg (planeCurveFunction f 0) hx) (Polynomial.C c) simpa using h - letI : Algebra K L := inducedAlg - letI : SMul K L := inducedAlg.toSMul - letI : Module K L := inducedAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := inducedAlg + let : SMul K L := inducedAlg.toSMul + let : Module K L := inducedAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K K[X] L := + let : IsScalarTower K K[X] L := IsScalarTower.of_algebraMap_eq' rfl have hconstantsCanonical : @algebraicClosure K L _ _ canonicalAlg = ⊥ := by @@ -126,7 +126,7 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace change @algebraicClosure K L _ _ inducedAlg = ⊥ rw [hinducedAlg] exact hconstantsCanonical - letI : FunctionField.IsFullConstantField K L := + let : FunctionField.IsFullConstantField K L := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 hconstants have hcardK' : MvPolynomial.degreeOf 1 f < Fintype.card K := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean index bb2483a3ad..47a5fadc79 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean @@ -80,7 +80,7 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace_degree_eq planeCurveBidegreeGenusBudget f := by let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -88,21 +88,21 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace_degree_eq let canonicalAlg : Algebra K L := inferInstance let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule let polynomialAlg : Algebra K[X] L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K[X] (RatFunc K))) - letI : Algebra K[X] L := polynomialAlg - letI : SMul K[X] L := polynomialAlg.toSMul - letI : Module K[X] L := polynomialAlg.toModule - letI : IsScalarTower K[X] (RatFunc K) L := + let : Algebra K[X] L := polynomialAlg + let : SMul K[X] L := polynomialAlg.toSMul + let : Module K[X] L := polynomialAlg.toModule + let : IsScalarTower K[X] (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let inducedAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp @@ -118,12 +118,12 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace_degree_eq K L _ _ canonicalAlg (planeCurveFunction f 0) hx) (Polynomial.C c) simpa using h - letI : Algebra K L := inducedAlg - letI : SMul K L := inducedAlg.toSMul - letI : Module K L := inducedAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := inducedAlg + let : SMul K L := inducedAlg.toSMul + let : Module K L := inducedAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K K[X] L := + let : IsScalarTower K K[X] L := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro hdegreeEq @@ -136,7 +136,7 @@ theorem planeCurve_genus_le_bidegreeGenusBudget_of_cotrace_degree_eq change @algebraicClosure K L _ _ inducedAlg = ⊥ rw [hinducedAlg] exact hconstantsCanonical - letI : FunctionField.IsFullConstantField K L := + let : FunctionField.IsFullConstantField K L := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot K L).2 hconstants have hdegreeEqChart : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean index 41265347c3..49cb209679 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean @@ -124,7 +124,7 @@ theorem exists_global_finitePrincipalPart_representative finiteExtensionLocalPoleSpace K L (.inl q) 0 := by apply mem_finiteExtensionLocalPoleSpace_zero_of_valuation_le_one K L have h := happrox q (by simp [selected]) - simpa only [target, if_pos rfl, CharP.cast_eq_zero, neg_zero, + simpa only [target, ite_eq_left rfl, CharP.cast_eq_zero, neg_zero, WithZero.exp_zero] using h have hzMem : z ∈ finiteExtensionLocalPoleSpace K L (.inl q) N := by have hxMem : (x : L) ∈ finiteExtensionLocalPoleSpace K L (.inl q) N := x.2 @@ -192,7 +192,7 @@ theorem exists_infinityDivisor_finitePlacePrincipalParts_rank N * finiteExtensionPlaceDegree K L (.inl q) := by simpa only [A, A0, PP] using finiteExtensionLocalPoleSpace_inl_cumulative_finrank K L q N - letI : Module.Finite K PP := by + let : Module.Finite K PP := by apply Module.finite_of_finrank_pos rw [hPPfinrank] exact Nat.mul_pos hN (finiteExtensionPlaceDegree_pos K L (.inl q)) @@ -270,11 +270,11 @@ theorem exists_infinityDivisor_finitePlacePrincipalParts_rank rw [finiteExtensionPoleDivisor_apply] by_cases hneg : finiteExtensionPrincipalDivisor K L (z i : L) (.inl q) < 0 - · rw [if_pos hneg] + · rw [ite_eq_left hneg] simp only [D, Finsupp.add_apply, Finsupp.single_eq_same, hEfinite q, add_zero] omega - · rw [if_neg hneg] + · rw [ite_eq_right hneg] exact hD (.inl q) · have hzreg := hzregular i q' hq' rw [mem_finiteExtensionLocalPoleSpace_iff] at hzreg @@ -283,7 +283,7 @@ theorem exists_infinityDivisor_finitePlacePrincipalParts_rank rcases hzreg with hzero | ⟨_, horder⟩ · exact (hzNe i hzero).elim · simpa using horder - rw [finiteExtensionPoleDivisor_apply, if_neg (not_lt_of_ge hzOrder)] + rw [finiteExtensionPoleDivisor_apply, ite_eq_right (not_lt_of_ge hzOrder)] exact hD (.inl q') · simp only [D, Finsupp.add_apply, Finsupp.single_eq_of_ne (by simp : @@ -342,7 +342,7 @@ theorem exists_infinityDivisor_finitePlacePrincipalParts_rank intro x y hxy apply Subtype.ext exact congrArg (fun w : φ.ker => ((w : finiteExtensionRiemannSpace K L D) : L)) hxy - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD have hkerLower : Module.finrank K (finiteExtensionRiemannSpace K L E) ≤ Module.finrank K φ.ker := @@ -385,25 +385,25 @@ theorem planeCurve_finitePlace_riemann_lower Module.finrank K (finiteExtensionOnePointRiemannSpace K (PlaneCurveFunctionField f) (.inl q) N) + planeCurveBidegreeGenusBudget f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let g := planeCurveBidegreeGenusBudget f - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : Algebra K L := constantAlg - letI : SMul K L := constantAlg.toSMul - letI : Module K L := constantAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := constantAlg + let : SMul K L := constantAlg.toSMul + let : Module K L := constantAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro q N @@ -439,7 +439,7 @@ theorem planeCurve_finitePlace_riemann_lower · subst v simp [Dq] · simp [Dq, Finsupp.single_eq_of_ne hv] - letI : Module.Finite K (finiteExtensionRiemannSpace K L Dq) := + let : Module.Finite K (finiteExtensionRiemannSpace K L Dq) := finiteExtensionRiemannSpace_effective_moduleFinite K L Dq hDq have hstrip := finiteExtensionRiemannSpace_add_effective K L Dq E hDq hE diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean index 0825f4995f..0cfb3456ff 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean @@ -330,7 +330,7 @@ theorem exists_planeFirstFrobeniusDeflationStep (BGS.External.affinePlaneCurveZeros K g).card = (BGS.External.affinePlaneCurveZeros K f).card := by let p := ringChar K - letI : Fact p.Prime := ⟨CharP.char_is_prime K p⟩ + let : Fact p.Prime := ⟨CharP.char_is_prime K p⟩ let g := planeFirstDeflate K p f have hfg : planeFirstInflateHom K p g = f := planeFirstInflateHom_planeFirstDeflate p diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean index a4cbc9cf53..717012d6cc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean @@ -79,7 +79,7 @@ theorem degreeOf_one_eq_natDegree_secondPolynomialOfFirstDegreeZero by_contra hmzero have hz : (MvPolynomial.finSuccEquiv R 1 f).coeff (m 0) = 0 := by rw [hC] - rw [Polynomial.coeff_C, if_neg hmzero] + rw [Polynomial.coeff_C, ite_eq_right hmzero] rw [hz] at htail simpa using htail have htailq : m.tail ∈ q.support := by @@ -124,7 +124,7 @@ theorem degreeOf_one_eq_one_of_absolutelyIrreducible_degreeOf_zero have hCIrr : Irreducible (Polynomial.C qF) := by rw [← hC] exact hfinIrr - letI : IsLocalHom + let : IsLocalHom (Polynomial.C : MvPolynomial (Fin 1) F →+* Polynomial (MvPolynomial (Fin 1) F)) := ⟨fun _ hunit => Polynomial.isUnit_C.mp hunit⟩ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean index e8b3fa1d2b..086389d933 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean @@ -94,7 +94,7 @@ theorem planeCurve_infinitySupported_riemann_lower Module.finrank K (finiteExtensionRiemannSpace K (PlaneCurveFunctionField f) E) + planeCurveBidegreeGenusBudget f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -104,19 +104,19 @@ theorem planeCurve_infinitySupported_riemann_lower let a := MvPolynomial.degreeOf 0 f let b := MvPolynomial.degreeOf 1 f let g := planeCurveBidegreeGenusBudget f - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : Algebra K L := constantAlg - letI : SMul K L := constantAlg.toSMul - letI : Module K L := constantAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := constantAlg + let : SMul K L := constantAlg.toSMul + let : Module K L := constantAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro E hE hEfinite @@ -155,7 +155,7 @@ theorem planeCurve_infinitySupported_riemann_lower have hsplit : E + A = D := by dsimp only [A] abel - letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := + let : Module.Finite K (finiteExtensionRiemannSpace K L E) := finiteExtensionRiemannSpace_effective_moduleFinite K L E hE have hstrip := finiteExtensionRiemannSpace_add_effective K L E A hE hA diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean index 2a7264de41..d256a1759c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean @@ -147,7 +147,7 @@ theorem planeCurve_monomialGrid_linearIndependent LinearIndependent K (planeMonomialGrid (planeCurveFunction f 0) (planeCurveFunction f 1) a b) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let xF : FirstCoordinateSubfield f := firstCoordinateInSubfield f have hxL : Transcendental K (planeCurveFunction f 0) := @@ -188,7 +188,7 @@ theorem finrank_planeCurve_monomialSpace_eq_mul Module.finrank K (planeMonomialSpace K (planeCurveFunction f 0) (planeCurveFunction f 1) a b) = a * b := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact finrank_planeMonomialSpace_eq_mul (planeCurveFunction f 0) (planeCurveFunction f 1) a b @@ -287,7 +287,7 @@ theorem planeCurve_twistedMonomialGrid_linearIndependent LinearIndependent K (twistedPlaneMonomialGrid (planeCurveFunction f 0) (planeCurveFunction f 1) s a b a' b') := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hgrid := planeCurve_monomialGrid_linearIndependent hf hpartialSecond (a + s * a') (b + s * b') hdegree @@ -315,7 +315,7 @@ theorem planeCurve_twistedMonomialGrid_injective Function.Injective (twistedPlaneMonomialGrid (planeCurveFunction f 0) (planeCurveFunction f 1) s a b a' b') := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf exact (planeCurve_twistedMonomialGrid_linearIndependent hf hpartialSecond s a b a' b' ha hb hdegree).injective @@ -363,13 +363,13 @@ theorem planeCurve_poweredMonomialGrid_linearIndependent LinearIndependent K (planeMonomialGrid ((planeCurveFunction f 0) ^ m) ((planeCurveFunction f 1) ^ n) a b) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let xm : FirstPoweredCoordinateSubfield f m := ⟨(planeCurveFunction f 0) ^ m, IntermediateField.mem_adjoin_simple_self K ((planeCurveFunction f 0) ^ m)⟩ - letI : FiniteDimensional (FirstPoweredCoordinateSubfield f m) + let : FiniteDimensional (FirstPoweredCoordinateSubfield f m) (PlaneCurveFunctionField f) := finiteDimensional_over_firstPoweredCoordinate hf hpartialSecond m hm have hxmL : Transcendental K ((planeCurveFunction f 0) ^ m) := @@ -473,7 +473,7 @@ theorem add_one_mul_le_finrank_poleDivisorBudget (finiteExtensionRiemannSpace K L (n • finiteExtensionPoleDivisor K L x + (b - 1) • finiteExtensionPoleDivisor K L y)) := by - letI : Module.Finite K + let : Module.Finite K (finiteExtensionRiemannSpace K L (n • finiteExtensionPoleDivisor K L x + (b - 1) • finiteExtensionPoleDivisor K L y)) := hfinite diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean index 558e477914..93aac3827e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean @@ -95,7 +95,7 @@ theorem planeCurveSecondCoordinate_height_le_degreeOf_first letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond finiteExtensionHeight K (PlaneCurveFunctionField f) (planeCurveFunction f 1) ≤ MvPolynomial.degreeOf 0 f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -109,11 +109,11 @@ theorem planeCurveSecondCoordinate_height_le_degreeOf_first apply hyTrans rw [hy] exact isAlgebraic_zero - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond change finiteExtensionHeight K L y ≤ MvPolynomial.degreeOf 0 f rw [← finiteExtensionPositiveDegree_eq_height K L y hy0] @@ -142,25 +142,25 @@ private theorem planeCurve_monomialGrid_linearIndependent_firstRatFunc LinearIndependent K (planeMonomialGrid (planeCurveFunction f 0) (planeCurveFunction f 1) a b) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let L := PlaneCurveFunctionField f let y : L := planeCurveFunction f 1 - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : Algebra K L := constantAlg - letI : SMul K L := constantAlg.toSMul - letI : Module K L := constantAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := constantAlg + let : SMul K L := constantAlg.toSMul + let : Module K L := constantAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl let F : Polynomial (RatFunc K) := (planeCurvePolynomialInSecondCoordinate f).map @@ -214,7 +214,7 @@ theorem planeCurveMonomialPoleBudget_finrank_lower (planeMonomialPoleBudget K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (planeCurveFunction f 1) n (MvPolynomial.degreeOf 1 f))) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -236,19 +236,19 @@ theorem planeCurveMonomialPoleBudget_finrank_lower apply hyTrans rw [h] exact isAlgebraic_zero - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : Algebra K L := constantAlg - letI : SMul K L := constantAlg.toSMul - letI : Module K L := constantAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := constantAlg + let : SMul K L := constantAlg.toSMul + let : Module K L := constantAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl have hD : ∀ v, 0 ≤ (n • finiteExtensionPoleDivisor K L x + @@ -308,7 +308,7 @@ private theorem exists_planeCurve_onePointRiemannSpace_progression_lower_bound_i Module.finrank K (finiteExtensionOnePointRiemannSpace K (PlaneCurveFunctionField f) Q m) + planeCurveBidegreeGenusBudget f := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -318,19 +318,19 @@ private theorem exists_planeCurve_onePointRiemannSpace_progression_lower_bound_i let a := MvPolynomial.degreeOf 0 f let b := MvPolynomial.degreeOf 1 f let g := planeCurveBidegreeGenusBudget f - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : Algebra K L := constantAlg - letI : SMul K L := constantAlg.toSMul - letI : Module K L := constantAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := constantAlg + let : SMul K L := constantAlg.toSMul + let : Module K L := constantAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl obtain ⟨P, hPpole, hPdegreePositive, hPdegreeBound⟩ := exists_planeCurveFirstCoordinate_infinityPolePlace hf hpartialSecond @@ -364,7 +364,7 @@ private theorem exists_planeCurve_onePointRiemannSpace_progression_lower_bound_i · subst v simp · simp [Finsupp.single_eq_of_ne hv] - letI : Module.Finite K + let : Module.Finite K (finiteExtensionOnePointRiemannSpace K L Q m) := hfiniteOne have hfullLower : (n + 1) * b ≤ Module.finrank K (finiteExtensionRiemannSpace K L D) := by @@ -535,7 +535,7 @@ theorem exists_planeCurve_onePointRiemannSpace_progression_strictLevels_lower_bo (PlaneCurveFunctionField f) Q k) m).card := by let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -544,11 +544,11 @@ theorem exists_planeCurve_onePointRiemannSpace_progression_strictLevels_lower_bo let y : L := planeCurveFunction f 1 let b := MvPolynomial.degreeOf 1 f let g := planeCurveBidegreeGenusBudget f - letI : Algebra (RatFunc K) L := + let : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) L := + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let canonicalAlg : Algebra K L := inferInstance let constantAlg : Algebra K L := @@ -564,10 +564,10 @@ theorem exists_planeCurve_onePointRiemannSpace_progression_strictLevels_lower_bo K L _ _ canonicalAlg x hx) (Polynomial.C c) simpa using h - letI : Algebra K L := constantAlg - letI : SMul K L := constantAlg.toSMul - letI : Module K L := constantAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := constantAlg + let : SMul K L := constantAlg.toSMul + let : Module K L := constantAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl obtain ⟨P, hPpole, hPdegreePositive, hPdegreeBound, hprogress⟩ := exists_planeCurve_onePointRiemannSpace_progression_lower_bound @@ -613,7 +613,7 @@ theorem exists_planeCurve_onePointRiemannSpace_progression_strictLevels_lower_bo have hfiniteK : Module.Finite K (finiteExtensionRiemannSpace K L Dk) := finiteExtensionRiemannSpace_effective_moduleFinite K L Dk hDk - letI : Module.Finite K + let : Module.Finite K (finiteExtensionRiemannSpace K L Dk) := hfiniteK have hstep := finiteExtensionRiemannSpace_place_increment K L Dk hDk Q have hdivisor : Dk + Finsupp.single Q 1 = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean index bab5a1bdad..ea8dfdc1f6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean @@ -255,7 +255,7 @@ theorem rationalBasePlace_primesOver_card_le_finrank Fintype.card (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) ≤ Module.finrank (RatFunc K) L := by - letI : Fintype + let : Fintype (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.asIdeal (RatFuncFiniteIntegralClosure K L)) @@ -297,10 +297,10 @@ theorem rationalFinitePlaceOverPolynomialZeros_card_le Module.finrank (RatFunc K) L := by let baseZero := {P : RatFuncRationalFinitePlace K // R.eval (ratFuncRationalFinitePlaceEquiv K P) = 0} - letI : Fintype (RationalFinitePlaceOverPolynomialZeros K L R) := + let : Fintype (RationalFinitePlaceOverPolynomialZeros K L R) := Fintype.ofFinite _ - letI : Fintype baseZero := Fintype.ofFinite baseZero - letI (P : baseZero) : + let : Fintype baseZero := Fintype.ofFinite baseZero + let (P : baseZero) : Fintype (P.1.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.1.asIdeal @@ -408,7 +408,7 @@ theorem rationalFinitePlacePolynomial_isUnit_of_eval_baseCoordinate_ne_zero IsUnit (algebraMap K[X] V R) := by let B := RatFuncFiniteIntegralClosure K L let V := IsDedekindDomain.HeightOneSpectrum.valuationSubringAtPrime L Q.1 - letI : Algebra K[X] V := RingHom.toAlgebra + let : Algebra K[X] V := RingHom.toAlgebra ((algebraMap (RatFuncFiniteIntegralClosure K L) V).comp (algebraMap K[X] (RatFuncFiniteIntegralClosure K L))) dsimp only @@ -453,11 +453,11 @@ theorem rationalFinitePlaceBaseCoordinate_residue algebraMap V m.ResidueField (algebraMap K[X] V Polynomial.X) := by let B := RatFuncFiniteIntegralClosure K L let V := HeightOneSpectrum.valuationSubringAtPrime L Q.1 - letI : Algebra K[X] V := RingHom.toAlgebra + let : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) - letI : Algebra K V := RingHom.toAlgebra + let : Algebra K V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K B)) - letI : IsScalarTower K K[X] V := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K K[X] V := IsScalarTower.of_algebraMap_eq' rfl let m := IsLocalRing.maximalIdeal V dsimp only let P : RatFuncRationalFinitePlace K := @@ -874,36 +874,36 @@ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue intro model1 hx model3 model4 model5 model6 model7 model8 classical let E := PlaneCurveFunctionField f - letI : Field E := inferInstance - letI : AddCommMonoid E := inferInstance - letI : SMul (RatFunc K) E := Algebra.toSMul - letI : Module (RatFunc K) E := Algebra.toModule - letI : SMul K[X] E := Algebra.toSMul - letI : Module K[X] E := Algebra.toModule + let : Field E := inferInstance + let : AddCommMonoid E := inferInstance + let : SMul (RatFunc K) E := Algebra.toSMul + let : Module (RatFunc K) E := Algebra.toModule + let : SMul K[X] E := Algebra.toSMul + let : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E - letI : CommRing B := inferInstance - letI : AddCommMonoid B := inferInstance - letI : SMul K[X] B := Algebra.toSMul - letI : Module K[X] B := Algebra.toModule - letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B - letI : Module.IsTorsionFree K[X] E := + let : CommRing B := inferInstance + let : AddCommMonoid B := inferInstance + let : SMul K[X] B := Algebra.toSMul + let : Module K[X] B := Algebra.toModule + let : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + let : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E - letI : Module.IsTorsionFree K[X] B := + let : Module.IsTorsionFree K[X] B := IsIntegralClosure.isTorsionFree K[X] E - letI : NoZeroSMulDivisors K[X] B := + let : NoZeroSMulDivisors K[X] B := { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B - letI : IsFractionRing B E := + let : IsFractionRing B E := IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B - letI : Algebra K B := RingHom.toAlgebra + let : Algebra K B := RingHom.toAlgebra ((algebraMap K[X] B).comp (algebraMap K K[X])) - letI : SMul K B := Algebra.toSMul - letI : Module K B := Algebra.toModule - letI : SMul K E := Algebra.toSMul - letI : Module K E := Algebra.toModule - letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K (RatFunc K) E := + let : SMul K B := Algebra.toSMul + let : Module K B := Algebra.toModule + let : SMul K E := Algebra.toSMul + let : Module K E := Algebra.toModule + let : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by ext c have h := congrArg @@ -911,34 +911,34 @@ theorem planeCurveGoodRationalFinitePlaceCenter_secondCoordinate_residue (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) - letI : IsScalarTower K K[X] E := + let : IsScalarTower K K[X] E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, IsScalarTower.algebraMap_apply K K[X] (RatFunc K)] rfl) - letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + let : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K K[X] E] rfl) dsimp only intro Q let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 - letI : Algebra B V := inferInstance - letI : SMul B V := Algebra.toSMul - letI : Module B V := Algebra.toModule - letI : Algebra V E := Algebra.ofSubsemiring V - letI : SMul V E := Algebra.toSMul - letI : Module V E := Algebra.toModule - letI : Algebra K[X] V := RingHom.toAlgebra + let : Algebra B V := inferInstance + let : SMul B V := Algebra.toSMul + let : Module B V := Algebra.toModule + let : Algebra V E := Algebra.ofSubsemiring V + let : SMul V E := Algebra.toSMul + let : Module V E := Algebra.toModule + let : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) - letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K V := RingHom.toAlgebra + let : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra K V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K B)) - letI : SMul K V := Algebra.toSMul - letI : Module K V := Algebra.toModule - letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by + let : SMul K V := Algebra.toSMul + let : Module K V := Algebra.toModule + let : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K B E] rfl) @@ -1080,36 +1080,36 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom classical let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f - letI : Field E := inferInstance - letI : AddCommMonoid E := inferInstance - letI : SMul (RatFunc K) E := Algebra.toSMul - letI : Module (RatFunc K) E := Algebra.toModule - letI : SMul K[X] E := Algebra.toSMul - letI : Module K[X] E := Algebra.toModule + let : Field E := inferInstance + let : AddCommMonoid E := inferInstance + let : SMul (RatFunc K) E := Algebra.toSMul + let : Module (RatFunc K) E := Algebra.toModule + let : SMul K[X] E := Algebra.toSMul + let : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E - letI : CommRing B := inferInstance - letI : AddCommMonoid B := inferInstance - letI : SMul K[X] B := Algebra.toSMul - letI : Module K[X] B := Algebra.toModule - letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B - letI : Module.IsTorsionFree K[X] E := + let : CommRing B := inferInstance + let : AddCommMonoid B := inferInstance + let : SMul K[X] B := Algebra.toSMul + let : Module K[X] B := Algebra.toModule + let : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + let : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E - letI : Module.IsTorsionFree K[X] B := + let : Module.IsTorsionFree K[X] B := IsIntegralClosure.isTorsionFree K[X] E - letI : NoZeroSMulDivisors K[X] B := + let : NoZeroSMulDivisors K[X] B := { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B - letI : IsFractionRing B E := + let : IsFractionRing B E := IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B - letI : Algebra K B := RingHom.toAlgebra + let : Algebra K B := RingHom.toAlgebra ((algebraMap K[X] B).comp (algebraMap K K[X])) - letI : SMul K B := Algebra.toSMul - letI : Module K B := Algebra.toModule - letI : SMul K E := Algebra.toSMul - letI : Module K E := Algebra.toModule - letI : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K (RatFunc K) E := + let : SMul K B := Algebra.toSMul + let : Module K B := Algebra.toModule + let : SMul K E := Algebra.toSMul + let : Module K E := Algebra.toModule + let : IsScalarTower K K[X] B := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K (RatFunc K) E := IsScalarTower.of_algebraMap_eq' (by ext c have h := congrArg @@ -1117,34 +1117,34 @@ theorem exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom (ratFuncSpecialization_comp_polynomial_algebraMap (planeCurveFunction f 0) hx) simpa [E, planeCurveFirstCoordinateRatFuncAlgebra] using h.symm) - letI : IsScalarTower K K[X] E := + let : IsScalarTower K K[X] E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K (RatFunc K) E, IsScalarTower.algebraMap_apply K K[X] (RatFunc K)] rfl) - letI : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by + let : IsScalarTower K B E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K K[X] E] rfl) dsimp only intro Q let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 - letI : Algebra B V := inferInstance - letI : SMul B V := Algebra.toSMul - letI : Module B V := Algebra.toModule - letI : Algebra V E := Algebra.ofSubsemiring V - letI : SMul V E := Algebra.toSMul - letI : Module V E := Algebra.toModule - letI : Algebra K[X] V := RingHom.toAlgebra + let : Algebra B V := inferInstance + let : SMul B V := Algebra.toSMul + let : Module B V := Algebra.toModule + let : Algebra V E := Algebra.ofSubsemiring V + let : SMul V E := Algebra.toSMul + let : Module V E := Algebra.toModule + let : Algebra K[X] V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K[X] B)) - letI : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K V := RingHom.toAlgebra + let : IsScalarTower K[X] V E := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra K V := RingHom.toAlgebra ((algebraMap B V).comp (algebraMap K B)) - letI : SMul K V := Algebra.toSMul - letI : Module K V := Algebra.toModule - letI : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by + let : SMul K V := Algebra.toSMul + let : Module K V := Algebra.toModule + let : IsScalarTower K B V := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower K V E := IsScalarTower.of_algebraMap_eq' (by ext c rw [IsScalarTower.algebraMap_apply K B E] rfl) @@ -1221,24 +1221,24 @@ theorem planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q).1.2] (MvPolynomial.pderiv 1 f) ≠ 0 := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only intro Q hzero let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q @@ -1390,44 +1390,44 @@ theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating classical let A := PlaneCurveCoordinateRing f let E := PlaneCurveFunctionField f - letI : Field E := inferInstance - letI : AddCommMonoid E := inferInstance - letI : SMul (RatFunc K) E := Algebra.toSMul - letI : Module (RatFunc K) E := Algebra.toModule - letI : SMul K[X] E := Algebra.toSMul - letI : Module K[X] E := Algebra.toModule + let : Field E := inferInstance + let : AddCommMonoid E := inferInstance + let : SMul (RatFunc K) E := Algebra.toSMul + let : Module (RatFunc K) E := Algebra.toModule + let : SMul K[X] E := Algebra.toSMul + let : Module K[X] E := Algebra.toModule let B := RatFuncFiniteIntegralClosure K E - letI : CommRing B := inferInstance - letI : AddCommMonoid B := inferInstance - letI : SMul K[X] B := Algebra.toSMul - letI : Module K[X] B := Algebra.toModule - letI : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B - letI : Module.IsTorsionFree K[X] E := + let : CommRing B := inferInstance + let : AddCommMonoid B := inferInstance + let : SMul K[X] B := Algebra.toSMul + let : Module K[X] B := Algebra.toModule + let : Module.Finite K[X] B := Module.IsNoetherian.finite K[X] B + let : Module.IsTorsionFree K[X] E := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) E - letI : Module.IsTorsionFree K[X] B := + let : Module.IsTorsionFree K[X] B := IsIntegralClosure.isTorsionFree K[X] E - letI : NoZeroSMulDivisors K[X] B := + let : NoZeroSMulDivisors K[X] B := { eq_zero_or_eq_zero_of_smul_eq_zero := fun h => smul_eq_zero.mp h } - letI : IsDedekindDomain B := + let : IsDedekindDomain B := IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) E B - letI : IsFractionRing B E := + let : IsFractionRing B E := IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) E B intro Q let z := planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond Q let m := affinePlaneCurvePointMaximalIdeal f z let V := HeightOneSpectrum.valuationSubringAtPrime E Q.1.1 - letI : Algebra B V := inferInstance - letI : SMul B V := Algebra.toSMul - letI : Module B V := Algebra.toModule - letI : Algebra V E := Algebra.ofSubsemiring V - letI : SMul V E := Algebra.toSMul - letI : Module V E := Algebra.toModule + let : Algebra B V := inferInstance + let : SMul B V := Algebra.toSMul + let : Module B V := Algebra.toModule + let : Algebra V E := Algebra.ofSubsemiring V + let : SMul V E := Algebra.toSMul + let : Module V E := Algebra.toModule let D := dominatingValuationSubring (A := A) (L := E) m obtain ⟨φ, hφE, hcenter⟩ := exists_planeCurveGoodRationalFinitePlace_centeredCoordinateRingHom hf hpartialSecond Q let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z - letI : Finite m.asIdeal.ResidueField := + let : Finite m.asIdeal.ResidueField := Finite.of_injective eCenter eCenter.injective let r0 : A := planeCurveCoordinate f 0 - algebraMap K A z.1.1 have hr0mem : r0 ∈ m.asIdeal := @@ -1453,7 +1453,7 @@ theorem planeCurveGoodRationalFinitePlace_valuationSubring_eq_dominating (MvPolynomial.pderiv 1 f) ≠ 0 exact planeCurveGoodRationalFinitePlaceCenter_partialY_ne_zero hf hpartialSecond Q - letI : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := + let : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := planeCurveClosedPoint_localization_isDiscreteValuationRing K hf m hm0 hsmooth have hV : V ≠ ⊤ := by @@ -1488,22 +1488,22 @@ theorem planeCurveGoodRationalFinitePlaceCenter_injective Function.Injective (planeCurveGoodRationalFinitePlaceCenter hf hpartialSecond) := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc K) E := + let : Algebra (RatFunc K) E := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra K[X] E := RingHom.toAlgebra + let : Algebra K[X] E := RingHom.toAlgebra ((algebraMap (RatFunc K) E).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) E := + let : IsScalarTower K[X] (RatFunc K) E := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) E := + let : FiniteDimensional (RatFunc K) E := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) E := + let : Algebra.IsSeparable (RatFunc K) E := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only intro Q R hcenter apply Subtype.ext @@ -1558,24 +1558,24 @@ theorem planeCurveExceptionalRationalFinitePlace_card_le (firstDegree + (2 * secondDegree - 1) * firstDegree) * secondDegree := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only calc Nat.card (RationalFinitePlaceOverPolynomialZeros K @@ -1632,24 +1632,24 @@ theorem finiteExtensionRationalPlaceCount_le_affine_add_exceptional_of_away_inje (firstDegree + (2 * secondDegree - 1) * firstDegree) * secondDegree + secondDegree := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only intro center hcenter have hgeneric := @@ -1696,23 +1696,23 @@ theorem finiteExtensionRationalPlaceCount_le_affine_add_exceptional (firstDegree + (2 * secondDegree - 1) * firstDegree) * secondDegree + secondDegree := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ dsimp only exact finiteExtensionRationalPlaceCount_le_affine_add_exceptional_of_away_injective hdegree hf hpartialSecond diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean index 1398dbfb2d..11b05719af 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean @@ -170,7 +170,7 @@ theorem squareExtensionClosedPoint_residue_squareFrobenius let wf : SquareExtensionClosedPointFiber K p f m := ⟨w, Subtype.ext hw⟩ let ι := squareExtensionFiberResidueAlgHom K p f m wf - letI : Fintype (SquareExtension K p) := Fintype.ofFinite _ + let : Fintype (SquareExtension K p) := Fintype.ofFinite _ have hcard : Fintype.card (SquareExtension K p) = (Fintype.card K) ^ 2 := by rw [Fintype.card_eq_nat_card, FiniteField.natCard_extension K p 2, @@ -208,7 +208,7 @@ theorem squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : letI := planeCurveCoordinateRing_isDomain hf m.1.asIdeal ≠ ⊥ := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let A := PlaneCurveCoordinateRing f obtain ⟨z, hz⟩ := m.2 @@ -250,7 +250,7 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing (hsmooth : planeCurvePartialY f ∉ m.asIdeal) : letI := planeCurveCoordinateRing_isDomain hf IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let A := PlaneCurveCoordinateRing f let d : A := planeCurvePartialY f @@ -261,44 +261,44 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing change d ∈ m.asIdeal rw [hd] exact m.asIdeal.zero_mem - letI : IsDomain Ad := IsLocalization.Away.isDomain Ad hd0 + let : IsDomain Ad := IsLocalization.Away.isDomain Ad hd0 have hdisj : Disjoint ((Submonoid.powers d : Submonoid A) : Set A) (m.asIdeal : Set A) := by rw [Ideal.disjoint_powers_iff_notMem_of_isPrime] exact hsmooth let q : Ideal Ad := Ideal.map (algebraMap A Ad) m.asIdeal - letI hqPrime : q.IsPrime := + let hqPrime : q.IsPrime := IsLocalization.isPrime_of_isPrime_disjoint (Submonoid.powers d) Ad m.asIdeal m.isMaximal.isPrime hdisj have hunder : q.comap (algebraMap A Ad) = m.asIdeal := by exact IsLocalization.under_map_of_isPrime_disjoint (Submonoid.powers d) Ad m.isMaximal.isPrime hdisj - letI hunderMax : (q.comap (algebraMap A Ad)).IsMaximal := by + let hunderMax : (q.comap (algebraMap A Ad)).IsMaximal := by rw [hunder] exact m.isMaximal - letI hqMax : q.IsMaximal := by - exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) Ad q + let hqMax : q.IsMaximal := by + exact IsLocalization.isMaximal_of_isMaximal_under (Submonoid.powers d) Ad q let S := Localization.AtPrime q - letI : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q - letI : IsDomain S := IsLocalization.isDomain_of_atPrime S q - letI : Algebra A S := inferInstance - letI : IsScalarTower A Ad S := inferInstance - letI hSatPrime : IsLocalization.AtPrime S m.asIdeal := by + let : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q + let : IsDomain S := IsLocalization.isDomain_of_atPrime S q + let : Algebra A S := inferInstance + let : IsScalarTower A Ad S := inferInstance + let hSatPrime : IsLocalization.AtPrime S m.asIdeal := by have hlocal : IsLocalization.AtPrime S (q.comap (algebraMap A Ad)) := IsLocalization.isLocalization_isLocalization_atPrime_isLocalization (Submonoid.powers d) S q refine ⟨?_⟩ simpa only [hunder] using hlocal.toIsLocalizationMap - letI : Algebra K S := inferInstance - letI : IsScalarTower K A S := inferInstance - letI : IsScalarTower K Ad S := inferInstance - letI : Algebra.IsStandardSmooth K Ad := + let : Algebra K S := inferInstance + let : IsScalarTower K A S := inferInstance + let : IsScalarTower K Ad S := inferInstance + let : Algebra.IsStandardSmooth K Ad := planeCurvePartialYLocalization_isStandardSmooth f - letI : Algebra.FormallySmooth K Ad := inferInstance - letI : Algebra.FormallySmooth Ad S := + let : Algebra.FormallySmooth K Ad := inferInstance + let : Algebra.FormallySmooth Ad S := Algebra.FormallySmooth.of_isLocalization q.primeCompl - letI : Algebra.FormallySmooth K S := + let : Algebra.FormallySmooth K S := Algebra.FormallySmooth.comp K Ad S let P := planeCurvePartialYSubmersivePresentation f @@ -319,9 +319,9 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing exact planeCurvePartialYSubmersivePresentation_dimension f let eResidue := atPrimeResidueAlgEquiv K A S m.asIdeal - letI : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective - letI : Algebra.IsSeparable K k := inferInstance - letI : Algebra.FormallyEtale K k := + let : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective + let : Algebra.IsSeparable K k := inferInstance + let : Algebra.FormallyEtale K k := Algebra.FormallyEtale.of_isSeparable K k have hraw : Function.Injective (KaehlerDifferential.kerCotangentToTensor K S k) := by @@ -356,7 +356,7 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing IsLocalRing.finrank_cotangentSpace_le_one_iff.mp hcotangent have hSDvr : IsDiscreteValuationRing S := ((IsDiscreteValuationRing.TFAE S hnotField).out 5 1).mp hprincipal - letI : IsDiscreteValuationRing S := hSDvr + let : IsDiscreteValuationRing S := hSDvr exact IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing (IsLocalization.algEquiv m.asIdeal.primeCompl S (Localization.AtPrime m.asIdeal)).toRingEquiv @@ -372,7 +372,7 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing (hsmooth : planeCurvePartialY f ∉ m.1.asIdeal) : letI := planeCurveCoordinateRing_isDomain hf IsDiscreteValuationRing (Localization.AtPrime m.1.asIdeal) := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let A := PlaneCurveCoordinateRing f let d : A := planeCurvePartialY f @@ -383,44 +383,44 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing change d ∈ m.1.asIdeal rw [hd] exact m.1.asIdeal.zero_mem - letI : IsDomain Ad := IsLocalization.Away.isDomain Ad hd0 + let : IsDomain Ad := IsLocalization.Away.isDomain Ad hd0 have hdisj : Disjoint ((Submonoid.powers d : Submonoid A) : Set A) (m.1.asIdeal : Set A) := by rw [Ideal.disjoint_powers_iff_notMem_of_isPrime] exact hsmooth let q : Ideal Ad := Ideal.map (algebraMap A Ad) m.1.asIdeal - letI hqPrime : q.IsPrime := + let hqPrime : q.IsPrime := IsLocalization.isPrime_of_isPrime_disjoint (Submonoid.powers d) Ad m.1.asIdeal m.1.isMaximal.isPrime hdisj have hunder : q.comap (algebraMap A Ad) = m.1.asIdeal := by exact IsLocalization.under_map_of_isPrime_disjoint (Submonoid.powers d) Ad m.1.isMaximal.isPrime hdisj - letI hunderMax : (q.comap (algebraMap A Ad)).IsMaximal := by + let hunderMax : (q.comap (algebraMap A Ad)).IsMaximal := by rw [hunder] exact m.1.isMaximal - letI hqMax : q.IsMaximal := by - exact Ideal.IsMaximal.of_isLocalization_of_disjoint (Submonoid.powers d) Ad q + let hqMax : q.IsMaximal := by + exact IsLocalization.isMaximal_of_isMaximal_under (Submonoid.powers d) Ad q let S := Localization.AtPrime q - letI : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q - letI : IsDomain S := IsLocalization.isDomain_of_atPrime S q - letI : Algebra A S := inferInstance - letI : IsScalarTower A Ad S := inferInstance - letI hSatPrime : IsLocalization.AtPrime S m.1.asIdeal := by + let : IsLocalRing S := IsLocalization.AtPrime.isLocalRing S q + let : IsDomain S := IsLocalization.isDomain_of_atPrime S q + let : Algebra A S := inferInstance + let : IsScalarTower A Ad S := inferInstance + let hSatPrime : IsLocalization.AtPrime S m.1.asIdeal := by have hlocal : IsLocalization.AtPrime S (q.comap (algebraMap A Ad)) := IsLocalization.isLocalization_isLocalization_atPrime_isLocalization (Submonoid.powers d) S q refine ⟨?_⟩ simpa only [hunder] using hlocal.toIsLocalizationMap - letI : Algebra K S := inferInstance - letI : IsScalarTower K A S := inferInstance - letI : IsScalarTower K Ad S := inferInstance - letI : Algebra.IsStandardSmooth K Ad := + let : Algebra K S := inferInstance + let : IsScalarTower K A S := inferInstance + let : IsScalarTower K Ad S := inferInstance + let : Algebra.IsStandardSmooth K Ad := planeCurvePartialYLocalization_isStandardSmooth f - letI : Algebra.FormallySmooth K Ad := inferInstance - letI : Algebra.FormallySmooth Ad S := + let : Algebra.FormallySmooth K Ad := inferInstance + let : Algebra.FormallySmooth Ad S := Algebra.FormallySmooth.of_isLocalization q.primeCompl - letI : Algebra.FormallySmooth K S := + let : Algebra.FormallySmooth K S := Algebra.FormallySmooth.comp K Ad S let P := planeCurvePartialYSubmersivePresentation f @@ -444,11 +444,11 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing let zf : SquareExtensionClosedPointFiber K p f m := ⟨z, Subtype.ext hz⟩ let ι := squareExtensionFiberResidueAlgHom K p f m zf - letI : Finite m.1.asIdeal.ResidueField := Finite.of_injective ι ι.injective + let : Finite m.1.asIdeal.ResidueField := Finite.of_injective ι ι.injective let eResidue := atPrimeResidueAlgEquiv K A S m.1.asIdeal - letI : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective - letI : Algebra.IsSeparable K k := inferInstance - letI : Algebra.FormallyEtale K k := + let : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective + let : Algebra.IsSeparable K k := inferInstance + let : Algebra.FormallyEtale K k := Algebra.FormallyEtale.of_isSeparable K k have hraw : Function.Injective (KaehlerDifferential.kerCotangentToTensor K S k) := by @@ -486,7 +486,7 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing IsLocalRing.finrank_cotangentSpace_le_one_iff.mp hcotangent have hSDvr : IsDiscreteValuationRing S := ((IsDiscreteValuationRing.TFAE S hnotField).out 5 1).mp hprincipal - letI : IsDiscreteValuationRing S := hSDvr + let : IsDiscreteValuationRing S := hSDvr exact IsDiscreteValuationRing.RingEquivClass.isDiscreteValuationRing (IsLocalization.algEquiv m.1.asIdeal.primeCompl S (Localization.AtPrime m.1.asIdeal)).toRingEquiv @@ -771,10 +771,10 @@ theorem finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_le_two have hdegree' : Module.finrank K q.asIdeal.ResidueField ≤ 2 := by rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K L q] at hdegree exact hdegree - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := finiteExtensionFinitePlace_residueField_finite (K := K) (L := L) q - letI : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ - letI : Module.Finite K q.asIdeal.ResidueField := by + let : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ + let : Module.Finite K q.asIdeal.ResidueField := by rw [Module.finite_def] exact ⟨Finset.univ, by simp⟩ have hpositive : 0 < Module.finrank K q.asIdeal.ResidueField := Module.finrank_pos @@ -818,24 +818,24 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_le_two_of_pa finiteExtensionPlaceDegree K (PlaneCurveFunctionField f) (.inl (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m)) ≤ 2 := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ rw [squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_eq_residueDegree_of_partialY K p hf hpartialSecond m hsmooth] exact squareExtensionClosedPoint_residueDegree_le_two K p f m @@ -867,24 +867,24 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_residue_squareFrobenius_ ∀ z : (squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m).asIdeal.ResidueField, z ^ (Fintype.card K) ^ 2 = z := by - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : Algebra (Polynomial K) (PlaneCurveFunctionField f) := + let : Algebra (Polynomial K) (PlaneCurveFunctionField f) := RingHom.toAlgebra ((algebraMap (RatFunc K) (PlaneCurveFunctionField f)).comp (algebraMap (Polynomial K) (RatFunc K))) - letI : IsScalarTower (Polynomial K) (RatFunc K) + let : IsScalarTower (Polynomial K) (RatFunc K) (PlaneCurveFunctionField f) := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : DecidableEq (RatFunc K) := Classical.decEq _ + let : DecidableEq (RatFunc K) := Classical.decEq _ let q := squareExtensionClosedPointExhaustiveFinitePlace K p hf hpartialSecond m apply finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_le_two diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean index 37be95a9f8..3303a3854d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean @@ -84,24 +84,24 @@ theorem planeCurve_affinePoint_card_le_of_regularPlace_degree_one (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + (affineSecondCoordinateCriticalPoints S f).card := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp (algebraMap S (RatFunc S))) - letI : Algebra S E := constantAlg - letI : SMul S E := constantAlg.toSMul - letI : Module S E := constantAlg.toModule - letI : IsScalarTower S (RatFunc S) E := + let : Algebra S E := constantAlg + let : SMul S E := constantAlg.toSMul + let : Module S E := constantAlg.toModule + let : IsScalarTower S (RatFunc S) E := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro hconstants hregularDegree @@ -241,24 +241,24 @@ theorem planeCurve_affinePoint_card_le_bidegree_of_regularPlace_degree_one (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp (algebraMap S (RatFunc S))) - letI : Algebra S E := constantAlg - letI : SMul S E := constantAlg.toSMul - letI : Module S E := constantAlg.toModule - letI : IsScalarTower S (RatFunc S) E := + let : Algebra S E := constantAlg + let : SMul S E := constantAlg.toSMul + let : Module S E := constantAlg.toModule + let : IsScalarTower S (RatFunc S) E := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro hconstants hregularDegree diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean index 849d435236..1a2486adfd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean @@ -66,24 +66,24 @@ theorem planeCurve_affinePoint_card_le_squareField (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + (affineSecondCoordinateCriticalPoints S f).card := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp (algebraMap S (RatFunc S))) - letI : Algebra S E := constantAlg - letI : SMul S E := constantAlg.toSMul - letI : Module S E := constantAlg.toModule - letI : IsScalarTower S (RatFunc S) E := + let : Algebra S E := constantAlg + let : SMul S E := constantAlg.toSMul + let : Module S E := constantAlg.toModule + let : IsScalarTower S (RatFunc S) E := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro hconstants @@ -129,24 +129,24 @@ theorem planeCurve_affinePoint_card_le_squareField_bidegree (2 * planeCurveBidegreeGenusBudget f + 1) * Fintype.card K + ((2 * secondDegree - 1) * firstDegree) * secondDegree := by classical - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) let E := PlaneCurveFunctionField f - letI : Algebra (RatFunc S) E := + let : Algebra (RatFunc S) E := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc S) E := + let : FiniteDimensional (RatFunc S) E := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc S) E := + let : Algebra.IsSeparable (RatFunc S) E := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond let constantAlg : Algebra S E := RingHom.toAlgebra ((algebraMap (RatFunc S) E).comp (algebraMap S (RatFunc S))) - letI : Algebra S E := constantAlg - letI : SMul S E := constantAlg.toSMul - letI : Module S E := constantAlg.toModule - letI : IsScalarTower S (RatFunc S) E := + let : Algebra S E := constantAlg + let : SMul S E := constantAlg.toSMul + let : Module S E := constantAlg.toModule + let : IsScalarTower S (RatFunc S) E := IsScalarTower.of_algebraMap_eq' rfl dsimp only intro hconstants diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean index 449b4b7b4e..1f8bd1cd7b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean @@ -90,7 +90,7 @@ private theorem finiteExtensionOnePointRiemannSpace_finrank_le_add_gap · subst v simp [D] · simp [D, Finsupp.single_eq_of_ne hv] - letI : Module.Finite K (finiteExtensionRiemannSpace K L D) := + let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD have hinc := finiteExtensionRiemannSpace_natPlace_increment K L D hD P (M - N) @@ -184,7 +184,7 @@ theorem exists_planeCurve_onePointStepanovAuxiliary_of_degree_one u v s c) := by let hF : Irreducible F := irreducible_of_irreducible_map_algebraicClosure habsolute - letI : IsDomain (PlaneCurveCoordinateRing F) := + let : IsDomain (PlaneCurveCoordinateRing F) := planeCurveCoordinateRing_isDomain hF let hx := firstCoordinate_transcendental hF (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) @@ -197,15 +197,15 @@ theorem exists_planeCurve_onePointStepanovAuxiliary_of_degree_one let ell := stepanovEll s let m := stepanovM genusBudget s let canonicalAlg : Algebra K L := inferInstance - letI : Algebra K L := canonicalAlg + let : Algebra K L := canonicalAlg let ratAlg : Algebra (RatFunc K) L := planeCurveFirstCoordinateRatFuncAlgebra F hx - letI : Algebra (RatFunc K) L := ratAlg - letI : SMul (RatFunc K) L := ratAlg.toSMul - letI : Module (RatFunc K) L := ratAlg.toModule - letI : FiniteDimensional (RatFunc K) L := + let : Algebra (RatFunc K) L := ratAlg + let : SMul (RatFunc K) L := ratAlg.toSMul + let : Module (RatFunc K) L := ratAlg.toModule + let : FiniteDimensional (RatFunc K) L := finiteDimensional_planeCurveFunctionField_over_ratFunc hF hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) L := + let : Algebra.IsSeparable (RatFunc K) L := separable_planeCurveFunctionField_over_ratFunc hF hpartialSecond let inducedAlg : Algebra K L := planeStepanovConstantAlgebra K L have hinducedAlg : inducedAlg = canonicalAlg := by @@ -218,10 +218,10 @@ theorem exists_planeCurve_onePointStepanovAuxiliary_of_degree_one K L _ _ canonicalAlg x hx) (Polynomial.C c) simpa using h - letI : Algebra K L := inducedAlg - letI : SMul K L := inducedAlg.toSMul - letI : Module K L := inducedAlg.toModule - letI : IsScalarTower K (RatFunc K) L := + let : Algebra K L := inducedAlg + let : SMul K L := inducedAlg.toSMul + let : Module K L := inducedAlg.toModule + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl have hconstantsCanonical : @algebraicClosure K L _ _ canonicalAlg = ⊥ := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean index 463e8bbb46..7837026494 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean @@ -104,7 +104,7 @@ theorem finiteExtensionDivisorDegree_poleDivisor rw [← Finset.sum_neg_distrib] apply Finset.sum_congr rfl intro a ha - rw [if_pos (Finset.mem_filter.mp ha).2] + rw [ite_eq_left (Finset.mem_filter.mp ha).2] ring _ = (finiteExtensionHeight K L x : ℤ) := by omega diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean index f24bd3259b..e60670b234 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean @@ -5,7 +5,7 @@ Authors: Yuma Mizuno -/ import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace -import Mathlib.FieldTheory.IsAlgClosed.Basic +import Mathlib.Analysis.Complex.Polynomial.Basic /-! # Spectral parameters from a zeta numerator diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean index 4f154d9a41..96250d3da4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean @@ -4,7 +4,11 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib +import Mathlib.Algebra.Order.Ring.Star +import Mathlib.Algebra.Polynomial.Eval.Defs +import Mathlib.Analysis.CStarAlgebra.Classes +import Mathlib.Analysis.SpecificLimits.Normed +import Mathlib.Tactic /-! # Growth of finite weighted power sums diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean index a0eb5940f7..42c55619b0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean @@ -73,16 +73,16 @@ theorem ratFuncIdentityInfinityPlace_degree_eq_one : change P.1.inertiaDeg (RatFuncInfinityIntegers K) = 1 have hpos : 0 < P.1.inertiaDeg (RatFuncInfinityIntegers K) := Ideal.inertiaDeg_pos P.1 (RatFuncInfinityIntegers K) - letI : P.1.IsPrime := P.2.1 - letI : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 - letI : (ratFuncInfinityPlace K).asIdeal.IsMaximal := + let : P.1.IsPrime := P.2.1 + let : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 + let : (ratFuncInfinityPlace K).asIdeal.IsMaximal := (ratFuncInfinityPlace K).isPrime.isMaximal (ratFuncInfinityPlace K).ne_bot have hle : (ratFuncInfinityPlace K).asIdeal.inertiaDeg' P.1 ≤ Module.finrank (RatFunc K) (RatFunc K) := by exact Ideal.inertiaDeg_le_finrank (RatFuncInfinityIntegralClosure K (RatFunc K)) (RatFunc K) (RatFunc K) P.1 (ratFuncInfinityPlace K).ne_bot - rw [Ideal.inertiaDeg'_eq_inertiaDeg, Module.finrank_self] at hle + rw [inertiaDeg_eq_of_isMaximal, Module.finrank_self] at hle omega /-- The chosen infinity place in the Riemann--Roch two-chart place model. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean index 35e72c752d..0d9bff8309 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean @@ -131,7 +131,7 @@ private noncomputable def polynomialModuleEquivPolynomial : local instance polynomialCoefficientModuleFinite [FiniteDimensional K S] : Module.Finite K[X] S[X] := by - letI : Module.Finite K[X] (TensorProduct K K[X] S) := + let : Module.Finite K[X] (TensorProduct K K[X] S) := Module.Finite.base_change K K[X] S exact Module.Finite.equiv ((PolynomialModule.polynomialTensorProductLEquivPolynomialModule K S).trans diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean index 703c24a4f9..095f4a7096 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean @@ -50,7 +50,7 @@ local instance constantAlgebra : Algebra C N := private theorem canonicalRatFuncFractionRing : letI := canonicalRatFuncPolynomialAlgebra C IsFractionRing C[X] (RatFunc C) := by - letI := canonicalRatFuncPolynomialAlgebra C + let := canonicalRatFuncPolynomialAlgebra C infer_instance local instance polynomialAlgebra : Algebra C[X] N := @@ -64,7 +64,7 @@ local instance coefficientPolynomialModule : Module C[X] S[X] := Algebra.toModule local instance coefficientPolynomialFlat : Module.Flat C[X] S[X] := by - letI : Module.Flat C[X] (TensorProduct C C[X] S) := inferInstance + let : Module.Flat C[X] (TensorProduct C C[X] S) := inferInstance exact Module.Flat.of_linearEquiv (Algebra.IsPushout.equiv C C[X] S S[X]).symm.toLinearEquiv @@ -149,7 +149,7 @@ noncomputable def ratFuncToExactConstantExtension : theorem ratFuncToExactConstantExtension_injective : Function.Injective (ratFuncToExactConstantExtension C S N hExact) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact let hpoly := targetPolynomialAlgebraMap_injective C S N exact RatFunc.liftAlgHom_injective @@ -161,7 +161,7 @@ theorem ratFuncToExactConstantExtension_algebraMap (p : S[X]) : (algebraMap S[X] (RatFunc S) p) = Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S N) p := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact change RatFunc.liftAlgHom _ _ (algebraMap S[X] (RatFunc S) p) = _ exact RatFunc.liftRingHom_algebraMap _ _ p @@ -169,7 +169,7 @@ theorem ratFuncToExactConstantExtension_algebraMap (p : S[X]) : theorem ratFuncToExactConstantExtension_X : ratFuncToExactConstantExtension C S N hExact RatFunc.X = polynomialTensorCancelEvaluationPoint C S N := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact calc ratFuncToExactConstantExtension C S N hExact RatFunc.X = @@ -202,15 +202,15 @@ theorem rationalBase_algebraMap_eq : algebraMap (RatFunc C) (ExactConstantExtension C N S) = (algebraMap (RatFunc S) (ExactConstantExtension C N S)).comp (algebraMap (RatFunc C) (RatFunc S)) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra C[X] (RatFunc C) := canonicalRatFuncPolynomialAlgebra C - letI : IsFractionRing C[X] (RatFunc C) := canonicalRatFuncFractionRing C - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra C[X] (RatFunc C) := canonicalRatFuncPolynomialAlgebra C + let : IsFractionRing C[X] (RatFunc C) := canonicalRatFuncFractionRing C + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact apply IsFractionRing.ringHom_ext (A := C[X]) intro p @@ -257,20 +257,20 @@ theorem rationalBase_scalarTower : Algebra.toModule IsScalarTower (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule exact IsScalarTower.of_algebraMap_eq' (rationalBase_algebraMap_eq C S N hExact) @@ -296,36 +296,36 @@ theorem finiteDimensional_over_extendedRatFunc : letI : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule FiniteDimensional (RatFunc S) (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Module (RatFunc S) (ExactConstantExtension C N S) := + let : Module (RatFunc S) (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) (RatFunc S) + let : IsScalarTower (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) := rationalBase_scalarTower C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S let e := exactConstantExtensionLinearEquiv C N S - letI : Module.Finite N (N ⊗[C] S) := + let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S - letI : Module.Finite N (ExactConstantExtension C N S) := + let : Module.Finite N (ExactConstantExtension C N S) := Module.Finite.equiv e - letI : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := + let : Module.Finite (RatFunc C) (ExactConstantExtension C N S) := Module.Finite.trans N (ExactConstantExtension C N S) exact Module.Finite.of_restrictScalars_finite (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) @@ -344,24 +344,24 @@ theorem isSeparable_exactConstantExtension_over_baseRatFunc : letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : IsScalarTower C (RatFunc C) N := + let : IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact exact Algebra.IsSeparable.trans (RatFunc C) N (ExactConstantExtension C N S) @@ -381,32 +381,32 @@ theorem isSeparable_over_extendedRatFunc : letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul Algebra.IsSeparable (RatFunc S) (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : IsScalarTower C (RatFunc C) N := + let : IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra (RatFunc C) (RatFunc S) := + let : Algebra (RatFunc C) (RatFunc S) := ratFuncCoefficientAlgebra C S - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul - letI : IsScalarTower (RatFunc C) (RatFunc S) + let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul + let : IsScalarTower (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) := rationalBase_scalarTower C S N hExact - letI : Algebra N (ExactConstantExtension C N S) := + let : Algebra N (ExactConstantExtension C N S) := exactConstantExtensionAlgebra C N S - letI : SMul N (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module N (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) N + let : SMul N (ExactConstantExtension C N S) := Algebra.toSMul + let : Module N (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) N (ExactConstantExtension C N S) := exactConstantExtensionBaseTower C (RatFunc C) N S - letI : IsGalois N (ExactConstantExtension C N S) := + let : IsGalois N (ExactConstantExtension C N S) := exactConstantExtension_isGalois C N N S hExact - letI : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact exact Algebra.isSeparable_tower_top_of_isSeparable (RatFunc C) (RatFunc S) (ExactConstantExtension C N S) @@ -425,11 +425,11 @@ theorem scalarTower_constant_ratFunc_exactConstantExtension : letI : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul IsScalarTower S (RatFunc S) (ExactConstantExtension C N S) := by - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc S) (ExactConstantExtension C N S) := + let : Algebra (RatFunc S) (ExactConstantExtension C N S) := ratFuncExactConstantExtensionAlgebra C S N hExact - letI : SMul (RatFunc S) (ExactConstantExtension C N S) := + let : SMul (RatFunc S) (ExactConstantExtension C N S) := Algebra.toSMul apply IsScalarTower.of_algebraMap_eq' ext s diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean index 648834718c..e54a513cf8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean @@ -157,7 +157,7 @@ theorem eval_reciprocal_reverse_mul_X_pow (p : K[X]) : Polynomial.eval₂ RatFunc.C (1 / RatFunc.X) p.reverse * RatFunc.X ^ p.natDegree = algebraMap K[X] (RatFunc K) p := by - letI : Invertible (RatFunc.X : RatFunc K) := + let : Invertible (RatFunc.X : RatFunc K) := invertibleOfNonzero RatFunc.X_ne_zero simpa [invOf_eq_inv, one_div] using (Polynomial.eval₂_reverse_mul_pow RatFunc.C @@ -429,7 +429,7 @@ theorem ratFuncInfinityIntegralClosure_isLocalization_reciprocal : (Algebra.algebraMapSubmonoid (integralClosure K[X] N) (Ideal.span ({Polynomial.X} : Set K[X])).primeCompl) (RatFuncInfinityIntegralClosure K N) := by - letI : IsScalarTower K[X] (integralClosure K[X] N) + let : IsScalarTower K[X] (integralClosure K[X] N) (RatFuncInfinityIntegralClosure K N) := reciprocalPolynomialIntegralClosuresTower K N exact @IsLocalization.integralClosure diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean index ea247a6f23..a5d1610587 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean @@ -147,7 +147,7 @@ theorem finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx -(P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by let q := primeOverHeightOne (ratFuncInfinityPlace K) P let pi := ratFuncInfinityUniformizer K - letI : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by + let : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by simpa [q] using (Ideal.primesOver.liesOver (ratFuncInfinityPlace K).asIdeal P) have hpi0 : pi ≠ 0 := by @@ -187,7 +187,7 @@ theorem finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero (algebraMap (RatFunc K) L RatFunc.X) (.inl q) = 0 := by simp only [finiteExtensionPoleDivisor, Finsupp.neg_apply, Finsupp.filter_apply] - rw [if_neg (not_lt_of_ge + rw [ite_eq_right (not_lt_of_ge (finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative K L q))] simp @@ -204,7 +204,7 @@ theorem finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx Finsupp.filter_apply, finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx, neg_lt_zero] - rw [if_pos (by exact_mod_cast he)] + rw [ite_eq_left (by exact_mod_cast he)] simp /-- Pointwise description of the complete pole divisor of the rational diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean index e4267a3ceb..3f8a74e215 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean @@ -60,8 +60,8 @@ theorem ratFuncRationalFinitePlaceToDegreeLT_injective : finite. -/ noncomputable instance ratFuncRationalFinitePlace_finite [Finite K] : Finite (RatFuncRationalFinitePlace K) := by - letI : Finite (Fin 2 → K) := Pi.finite - letI : Finite (Polynomial.degreeLT K 2) := + let : Finite (Fin 2 → K) := Pi.finite + let : Finite (Polynomial.degreeLT K 2) := Finite.of_equiv (Fin 2 → K) (Polynomial.degreeLTEquiv K 2).toEquiv.symm exact Finite.of_injective (ratFuncRationalFinitePlaceToDegreeLT K) (ratFuncRationalFinitePlaceToDegreeLT_injective K) @@ -196,8 +196,8 @@ theorem rationalFinitePlaceToBaseFiber_injective : finite constant field. -/ noncomputable instance finiteExtensionRationalFinitePlace_finite [Finite K] : Finite (FiniteExtensionRationalFinitePlace K L) := by - letI : Fintype (RatFuncRationalFinitePlace K) := Fintype.ofFinite _ - letI (P : RatFuncRationalFinitePlace K) : + let : Fintype (RatFuncRationalFinitePlace K) := Fintype.ofFinite _ + let (P : RatFuncRationalFinitePlace K) : Fintype (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.asIdeal (RatFuncFiniteIntegralClosure K L)) @@ -207,7 +207,7 @@ noncomputable instance finiteExtensionRationalFinitePlace_finite [Finite K] : /-- The degree-one places above infinity are finite. -/ noncomputable instance finiteExtensionRationalInfinityPlace_finite : Finite (FiniteExtensionRationalInfinityPlace K L) := by - letI : Fintype (FiniteExtensionInfinityPlace K L) := + let : Fintype (FiniteExtensionInfinityPlace K L) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite (ratFuncInfinityPlace K).asIdeal (RatFuncInfinityIntegralClosure K L)) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean index 2ff02d9c97..56135c9d4f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean @@ -104,7 +104,7 @@ theorem finiteExtensionRiemannSpace_zero_moduleFinite : /-- The everywhere-regular subalgebra is finite-dimensional. -/ theorem finiteExtensionRegularSubalgebra_moduleFinite : Module.Finite K (finiteExtensionRegularSubalgebra K L) := by - letI : Module.Finite K (finiteExtensionRiemannSpace K L 0) := + let : Module.Finite K (finiteExtensionRiemannSpace K L 0) := finiteExtensionRiemannSpace_zero_moduleFinite K L exact Module.Finite.equiv (finiteExtensionRegularSubalgebraEquiv K L).symm @@ -115,7 +115,7 @@ theorem finiteExtensionRiemannSpace_zero_eq_range LinearMap.range (Algebra.linearMap K L) := by apply le_antisymm · intro x hx - letI : Module.Finite K (finiteExtensionRegularSubalgebra K L) := + let : Module.Finite K (finiteExtensionRegularSubalgebra K L) := finiteExtensionRegularSubalgebra_moduleFinite K L let x' : finiteExtensionRegularSubalgebra K L := ⟨x, hx⟩ have hxAlg' : IsAlgebraic K x' := IsAlgebraic.of_finite K x' diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean index 9961172a80..36d556af4f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean @@ -91,7 +91,7 @@ theorem finiteExtensionRiemannSpace_natPlace_increment simp only [Finsupp.add_apply, Finsupp.single_eq_same] exact add_nonneg (hD P) (by positivity) · simpa [E, Finsupp.single_eq_of_ne hv] using hD v - letI : Module.Finite K (finiteExtensionRiemannSpace K L E) := ih.1 + let : Module.Finite K (finiteExtensionRiemannSpace K L E) := ih.1 have hstep := finiteExtensionRiemannSpace_place_increment K L E hE P have hdivisor : D + Finsupp.single P ((n + 1 : ℕ) : ℤ) = @@ -159,7 +159,7 @@ theorem finiteExtensionRiemannSpace_add_effective · have h := hsingleAdd v simpa [Finsupp.single_eq_of_ne hv] using h have hih := ih hEeffective - letI : Module.Finite K + let : Module.Finite K (finiteExtensionRiemannSpace K L (D + E)) := hih.1 have hDEeffective : ∀ v, 0 ≤ (D + E) v := by intro v @@ -210,7 +210,7 @@ theorem finiteExtensionRiemannSpace_effective_moduleFinite (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) : Module.Finite K (finiteExtensionRiemannSpace K L D) := by - letI : Module.Finite K + let : Module.Finite K (finiteExtensionRiemannSpace K L (0 : FiniteExtensionDivisor K L)) := finiteExtensionRiemannSpace_zero_moduleFinite K L have h := finiteExtensionRiemannSpace_add_effective K L @@ -239,7 +239,7 @@ theorem finiteExtensionRiemannSpace_finrank_le_onePoint_add_degreeAway · simp [A, Finsupp.single_eq_of_ne hv] have hB : ∀ v, 0 ≤ B v := by exact finiteExtensionDivisorAway_effective K L D P hD - letI : Module.Finite K (finiteExtensionRiemannSpace K L A) := + let : Module.Finite K (finiteExtensionRiemannSpace K L A) := finiteExtensionRiemannSpace_effective_moduleFinite K L A hA have hbound := finiteExtensionRiemannSpace_add_effective K L A B hA hB have hsplit : A + B = D := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean index 1e9148c527..4371f1b836 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean @@ -57,10 +57,10 @@ theorem finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_one (hdegree : finiteExtensionPlaceDegree S L (.inl q) = 1) : ∀ z : q.asIdeal.ResidueField, z ^ (Fintype.card K) ^ 2 = z := by - letI : Finite q.asIdeal.ResidueField := + let : Finite q.asIdeal.ResidueField := finiteExtensionFinitePlace_residueField_finite (K := S) (L := L) q - letI : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ - letI : Module.Finite S q.asIdeal.ResidueField := by + let : Fintype q.asIdeal.ResidueField := Fintype.ofFinite _ + let : Module.Finite S q.asIdeal.ResidueField := by rw [Module.finite_def] exact ⟨Finset.univ, by simp⟩ have hfinrank : Module.finrank S q.asIdeal.ResidueField = 1 := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean index ccb8f52421..9b7d49697b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean @@ -284,52 +284,52 @@ theorem squareFieldStepanovFirstRestriction_eq_zero_or_principalDivisor_pos_at_f (squareFieldStepanovFirstRestriction K S L f g c) (.inl q) := by let A := RatFuncFiniteIntegralClosure S L let R := FiniteExtensionFinitePlaceLocalRing S L q - letI : Algebra S L := + let : Algebra S L := RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp (algebraMap S (RatFunc S))) - letI : IsScalarTower S (RatFunc S) L := + let : IsScalarTower S (RatFunc S) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra S[X] L := + let : Algebra S[X] L := RingHom.toAlgebra ((algebraMap (RatFunc S) L).comp (algebraMap S[X] (RatFunc S))) - letI : IsScalarTower S[X] (RatFunc S) L := + let : IsScalarTower S[X] (RatFunc S) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra S (RatFuncFiniteIntegralClosure S L) := + let : Algebra S (RatFuncFiniteIntegralClosure S L) := RingHom.toAlgebra ((algebraMap S[X] (RatFuncFiniteIntegralClosure S L)).comp (algebraMap S S[X])) - letI : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S L) := + let : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S L) := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra.IsIntegral S[X] (RatFuncFiniteIntegralClosure S L) := + let : Algebra.IsIntegral S[X] (RatFuncFiniteIntegralClosure S L) := IsIntegralClosure.isIntegral_algebra S[X] L - letI : Module.Finite S[X] (RatFuncFiniteIntegralClosure S L) := + let : Module.Finite S[X] (RatFuncFiniteIntegralClosure S L) := Module.IsNoetherian.finite S[X] (RatFuncFiniteIntegralClosure S L) - letI : Module.IsTorsionFree S[X] L := + let : Module.IsTorsionFree S[X] L := Module.IsTorsionFree.trans_faithfulSMul S[X] (RatFunc S) L - letI : Module.IsTorsionFree S[X] + let : Module.IsTorsionFree S[X] (RatFuncFiniteIntegralClosure S L) := IsIntegralClosure.isTorsionFree S[X] L - letI : IsDedekindDomain (RatFuncFiniteIntegralClosure S L) := + let : IsDedekindDomain (RatFuncFiniteIntegralClosure S L) := IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) L (RatFuncFiniteIntegralClosure S L) - letI : IsFractionRing (RatFuncFiniteIntegralClosure S L) L := + let : IsFractionRing (RatFuncFiniteIntegralClosure S L) L := IsIntegralClosure.isFractionRing_of_finite_extension S[X] (RatFunc S) L (RatFuncFiniteIntegralClosure S L) - letI : Algebra (RatFuncFiniteIntegralClosure S L) + let : Algebra (RatFuncFiniteIntegralClosure S L) (RatFuncFiniteIntegralClosure S L) := Algebra.id (RatFuncFiniteIntegralClosure S L) let localAlgebra : Algebra (RatFuncFiniteIntegralClosure S L) (FiniteExtensionFinitePlaceLocalRing S L q) := OreLocalization.instAlgebra - letI := localAlgebra - letI : SMul (RatFuncFiniteIntegralClosure S L) + let := localAlgebra + let : SMul (RatFuncFiniteIntegralClosure S L) (FiniteExtensionFinitePlaceLocalRing S L q) := localAlgebra.toSMul - letI : Algebra S (FiniteExtensionFinitePlaceLocalRing S L q) := + let : Algebra S (FiniteExtensionFinitePlaceLocalRing S L q) := OreLocalization.instAlgebra - letI := finiteExtensionFinitePlaceLocalAlgebra (K := S) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := S) (L := L) q - letI : IsScalarTower S R L := by + let := finiteExtensionFinitePlaceLocalAlgebra (K := S) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := S) (L := L) q + let : IsScalarTower S R L := by apply IsScalarTower.of_algebraMap_eq' ext x symm @@ -344,10 +344,10 @@ theorem squareFieldStepanovFirstRestriction_eq_zero_or_principalDivisor_pos_at_f (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap (K := S) (L := L) q) (algebraMap S A x)] rfl - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A q.ne_bot R - letI : Algebra K R := RingHom.toAlgebra + let : Algebra K R := RingHom.toAlgebra ((algebraMap S R).comp (algebraMap K S)) let eResidue : (RatFuncFiniteIntegralClosure S L ⧸ q.asIdeal) ≃+* diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean index 8a9cb9ad33..688b09dac4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean @@ -4,7 +4,13 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib +import Mathlib.Algebra.Order.Ring.Star +import Mathlib.Data.Int.Star +import Mathlib.Tactic +import Mathlib.Tactic.Linarith.Lemmas +import Mathlib.Tactic.NormNum.Ineq +import Mathlib.Tactic.Ring.Basic +import Mathlib.Tactic.Zify /-! # Numerical parameters for the Bombieri--Stepanov argument diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean index 222e11abef..d9d14fd414 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean @@ -300,7 +300,7 @@ theorem exists_onePointStepanovAuxiliary_of_target_finrank_upper c ≠ 0 ∧ onePointStepanovSecondCodRestrictionMap K L P f g ell m s hf hg c = 0 ∧ onePointStepanovFirstRestrictionMap K L f g s c ≠ 0 := by - letI : Module.Finite K + let : Module.Finite K (finiteExtensionOnePointRiemannSpace K L P (s * ell + m)) := finiteExtensionOnePointRiemannSpace_moduleFinite K L P _ apply exists_auxiliary_of_finrank_lt diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean index 4d42cf4635..8f51a018c5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean @@ -197,52 +197,52 @@ theorem onePointStepanovFirstRestrictionMap_eq_zero_or_principalDivisor_pos_at_f (Fintype.card K) c) (.inl q) := by let A := RatFuncFiniteIntegralClosure K L let R := FiniteExtensionFinitePlaceLocalRing K L q - letI : Algebra K L := + let : Algebra K L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K (RatFunc K))) - letI : IsScalarTower K (RatFunc K) L := + let : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K[X] L := + let : Algebra K[X] L := RingHom.toAlgebra ((algebraMap (RatFunc K) L).comp (algebraMap K[X] (RatFunc K))) - letI : IsScalarTower K[X] (RatFunc K) L := + let : IsScalarTower K[X] (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra K (RatFuncFiniteIntegralClosure K L) := + let : Algebra K (RatFuncFiniteIntegralClosure K L) := RingHom.toAlgebra ((algebraMap K[X] (RatFuncFiniteIntegralClosure K L)).comp (algebraMap K K[X])) - letI : IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := + let : IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := + let : Algebra.IsIntegral K[X] (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isIntegral_algebra K[X] L - letI : Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := + let : Module.Finite K[X] (RatFuncFiniteIntegralClosure K L) := Module.IsNoetherian.finite K[X] (RatFuncFiniteIntegralClosure K L) - letI : Module.IsTorsionFree K[X] L := + let : Module.IsTorsionFree K[X] L := Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L - letI : Module.IsTorsionFree K[X] + let : Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isTorsionFree K[X] L - letI : IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := + let : IsDedekindDomain (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) - letI : IsFractionRing (RatFuncFiniteIntegralClosure K L) L := + let : IsFractionRing (RatFuncFiniteIntegralClosure K L) L := IsIntegralClosure.isFractionRing_of_finite_extension K[X] (RatFunc K) L (RatFuncFiniteIntegralClosure K L) - letI : Algebra (RatFuncFiniteIntegralClosure K L) + let : Algebra (RatFuncFiniteIntegralClosure K L) (RatFuncFiniteIntegralClosure K L) := Algebra.id (RatFuncFiniteIntegralClosure K L) let localAlgebra : Algebra (RatFuncFiniteIntegralClosure K L) (FiniteExtensionFinitePlaceLocalRing K L q) := OreLocalization.instAlgebra - letI := localAlgebra - letI : SMul (RatFuncFiniteIntegralClosure K L) + let := localAlgebra + let : SMul (RatFuncFiniteIntegralClosure K L) (FiniteExtensionFinitePlaceLocalRing K L q) := localAlgebra.toSMul - letI : Algebra K (FiniteExtensionFinitePlaceLocalRing K L q) := + let : Algebra K (FiniteExtensionFinitePlaceLocalRing K L q) := OreLocalization.instAlgebra - letI := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q - letI := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q - letI : IsScalarTower K R L := by + let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q + let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q + let : IsScalarTower K R L := by apply IsScalarTower.of_algebraMap_eq' ext x symm @@ -257,7 +257,7 @@ theorem onePointStepanovFirstRestrictionMap_eq_zero_or_principalDivisor_pos_at_f (finiteExtensionFinitePlaceLocalizationToField_comp_algebraMap (K := K) (L := L) q) (algebraMap K A x)] rfl - letI : IsDiscreteValuationRing R := + let : IsDiscreteValuationRing R := IsLocalization.AtPrime.isDiscreteValuationRing_of_dedekind_domain A q.ne_bot R let eResidue : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean index 334fffbc45..60c1407335 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean @@ -124,7 +124,7 @@ theorem moduleFinite_range_tensorProductMap [Module.Finite K R] [Module.Finite K S] (f : R ⊗[K] S →ₗ[K] U) : Module.Finite K (LinearMap.range f) := by - letI : Module.Finite K (R ⊗[K] S) := + let : Module.Finite K (R ⊗[K] S) := moduleFinite_tensorProduct exact Module.Finite.range f @@ -136,7 +136,7 @@ theorem finrank_range_tensorProductMap_le (f : R ⊗[K] S →ₗ[K] U) : Module.finrank K (LinearMap.range f) ≤ Module.finrank K R * Module.finrank K S := by - letI : Module.Finite K (R ⊗[K] S) := + let : Module.Finite K (R ⊗[K] S) := moduleFinite_tensorProduct calc Module.finrank K (LinearMap.range f) ≤ @@ -151,7 +151,7 @@ theorem moduleFinite_of_surjective_tensorProductMap [Module.Finite K R] [Module.Finite K S] (f : R ⊗[K] S →ₗ[K] U) (hf : Function.Surjective f) : Module.Finite K U := by - letI : Module.Finite K (R ⊗[K] S) := + let : Module.Finite K (R ⊗[K] S) := moduleFinite_tensorProduct exact Module.Finite.of_surjective f hf @@ -162,7 +162,7 @@ theorem finrank_le_mul_of_surjective_tensorProductMap [Module.Finite K R] [Module.Finite K S] (f : R ⊗[K] S →ₗ[K] U) (hf : Function.Surjective f) : Module.finrank K U ≤ Module.finrank K R * Module.finrank K S := by - letI : Module.Finite K (R ⊗[K] S) := + let : Module.Finite K (R ⊗[K] S) := moduleFinite_tensorProduct calc Module.finrank K U ≤ Module.finrank K (R ⊗[K] S) := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean index 530912e896..9579f654dc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean @@ -4,7 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib +import Mathlib.Analysis.CStarAlgebra.Classes +import Mathlib.Tactic /-! # From zeta-function spectral data to the Hasse--Weil estimate diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean index 4827dfc987..a6ada6fcf4 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean @@ -61,7 +61,7 @@ theorem exists_orbitComplementCard_lt_prime_of_hasGiantOrbitAt (hgiant : HasGiantOrbitAt p hp epsilon) : letI : Fact p.Prime := ⟨hp⟩ ∃ x : PuncturedMarkoffSurface (ZMod p), orbitComplementCard x < p := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ obtain ⟨x, hx⟩ := hgiant refine ⟨x, ?_⟩ have hpReal : (1 : ℝ) < (p : ℝ) := by exact_mod_cast hp.one_lt @@ -80,7 +80,7 @@ theorem puncturedMarkoffTransitiveAt_of_hasGiantOrbitAt_and_orbitCard_dvd ∀ y : PuncturedMarkoffSurface (ZMod p), p ∣ (puncturedGammaOrbit y).ncard) : PuncturedMarkoffTransitiveAt p hp := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ obtain ⟨x, hx⟩ := exists_orbitComplementCard_lt_prime_of_hasGiantOrbitAt p hp epsilon hepsilon hgiant @@ -116,7 +116,7 @@ theorem eventually_puncturedMarkoffTransitiveAt_of_giantOrbit apply eventually_puncturedMarkoffTransitiveAt_of_giantOrbit_and_orbitCard_dvd epsilon hepsilon hgiant intro p hp hpThree - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ intro y exact prime_dvd_puncturedGammaOrbit_ncard p hpThree y diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean index 0dcb7a080d..3704380350 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Algebra.Polynomial.Degree.IsMonicOfDegree import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic import Mathlib.GroupTheory.SpecificGroups.Cyclic @@ -173,7 +174,7 @@ theorem elementsOfOrderLessThan_card_le_pred_mul_card_divisors [IsCyclic G] (bou apply Finset.sum_le_sum intro d hd by_cases hdvd : d ∣ Fintype.card G - · rw [if_pos hdvd] + · rw [ite_eq_left hdvd] have hfiber : (Finset.univ.filter fun g : G => orderOf g < bound).filter (fun g => orderOf g = d) = @@ -186,7 +187,7 @@ theorem elementsOfOrderLessThan_card_le_pred_mul_card_divisors [IsCyclic G] (bou exact ⟨h ▸ Finset.mem_range.mp hd, h⟩ rw [hfiber, IsCyclic.card_orderOf_eq_totient hdvd] exact (Nat.totient_le d).trans (Nat.le_sub_one_of_lt (Finset.mem_range.mp hd)) - · rw [if_neg hdvd] + · rw [ite_eq_right hdvd] have hempty : Finset.univ.filter (fun g : G => orderOf g = d) = ∅ := by ext g simp only [Finset.mem_filter, Finset.mem_univ, true_and, diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean index 862cabac40..635a67f34a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean @@ -70,7 +70,7 @@ theorem PuncturedMarkoffTransitiveAt p Fact.out := by classical have hpTwo : p ≠ 2 := by omega - letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), SamePuncturedComponent c x := by intro x diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean index 5e89e0d0d0..809ae57aa8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean @@ -136,7 +136,7 @@ theorem evenSignOrbitFinset_card_eq_four (x : PuncturedMarkoffSurface F) : (evenSignOrbitFinset x).card = 4 := by classical - letI : IsCancelSMul EvenSign (PuncturedMarkoffSurface F) := + let : IsCancelSMul EvenSign (PuncturedMarkoffSurface F) := evenSign_isCancelSMul_punctured htwo have hinjective : Function.Injective (fun s : EvenSign => s • x) := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean index b61df1380e..dc416a4c22 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean @@ -47,7 +47,7 @@ theorem exists_exactOrderRootSum_obstruction_of_not_samePuncturedComponent 8 * p ≤ (combinedTruncatedOrderTotientSum p d) ^ 2 := by classical have hpTwo : p ≠ 2 := by omega - letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ let bad := puncturedComponentComplementFinset p c have hxBad : x ∈ bad := by simpa [bad] using hcx diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean index 1f2d9302c8..0cf26422a0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean @@ -66,7 +66,7 @@ theorem d ≤ 189 * (middleGameMaximalOrders p d).card ^ 3 := by classical have hpTwo : p ≠ 2 := by omega - letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ let bad := puncturedComponentComplementFinset p c have hxBad : x ∈ bad := by simpa [bad] using hcx diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean index 0af8b339e7..0bb835eac9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean @@ -196,7 +196,7 @@ theorem eventually_hasGiantOrbit_of_specializedEstimates refine ⟨max (max (max middleThreshold cageThreshold) boundThreshold) (max countThreshold 7), ?_⟩ intro p hpPrime hp - letI : Fact p.Prime := ⟨hpPrime⟩ + let : Fact p.Prime := ⟨hpPrime⟩ have hpMiddle : middleThreshold ≤ p := by omega have hpCage : cageThreshold ≤ p := by omega have hpBound : boundThreshold ≤ p := by omega @@ -204,9 +204,9 @@ theorem eventually_hasGiantOrbit_of_specializedEstimates have hpSeven : 7 ≤ p := by omega have hpTwo : p ≠ 2 := by omega have hpThree : p ≠ 3 := by omega - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) - letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ obtain ⟨cNormalized, hcNormalizedCage⟩ := exists_normalizedPunctured_splitCagePoint p hpSeven let c : PuncturedMarkoffSurface (ZMod p) := diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean index 6d66c4d2ec..924935be93 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean @@ -281,10 +281,10 @@ theorem exists_threshold_middleGame_reaches_endgame obtain ⟨fourThreshold, hfourThreshold⟩ := eventually_atTop.mp hfourEventually refine ⟨max (max sizeThreshold fourThreshold) 7, ?_⟩ intro p hp _ hpThree - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) - letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ intro x hxLower have hpSize : sizeThreshold ≤ p := (le_max_left sizeThreshold fourThreshold).trans @@ -350,7 +350,7 @@ theorem exists_threshold_middleGame_to_splitCage nonsplitCoefficient hNonsplitWeil hδ refine ⟨max middleThreshold endgameThreshold, ?_⟩ intro p hp _ hpThree - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hxLarge have hpMiddle : middleThreshold ≤ p := (le_max_left _ _).trans hp diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean index de750a7af8..bb582b3326 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean @@ -196,7 +196,7 @@ theorem PuncturedMarkoffTransitiveAt p Fact.out := by classical have hpTwo : p ≠ 2 := by omega - letI : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ + let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ have hAll : ∀ x : PuncturedMarkoffSurface (ZMod p), SamePuncturedComponent c x := by intro x diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean index fdb08019b2..e77cf2fa68 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean @@ -58,13 +58,13 @@ theorem two_mul_card_image_le_card_add_two_of_inv_invariant intro y hy obtain ⟨x, hx, hxy⟩ := Finset.mem_image.mp hy by_cases hyfixed : y ∈ fixed.image f - · rw [if_pos hyfixed] + · rw [ite_eq_left hyfixed] have hxFiber : x ∈ s.filter fun z => f z = y := Finset.mem_filter.mpr ⟨hx, hxy⟩ have hpositive : 1 ≤ (s.filter fun z => f z = y).card := Finset.one_le_card.mpr ⟨x, hxFiber⟩ omega - · rw [if_neg hyfixed] + · rw [ite_eq_right hyfixed] have hfix : x⁻¹ ≠ x := by intro h apply hyfixed diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean index 4fdceda950..07d7d0a2c5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean @@ -74,7 +74,7 @@ theorem half_card_sub_one_le_orderOf_neg_of_fullOrder (p - 1) / 2 ≤ orderOf (-u) := by have hnegOneOrder : orderOf (-1 : (ZMod p)ˣ) = 2 := by rw [← orderOf_units, Units.coe_neg_one, orderOf_neg_one, - ringChar.eq (ZMod p) p, if_neg hpTwo] + ringChar.eq (ZMod p) p, ite_eq_right hpTwo] have huEq : u = (-1 : (ZMod p)ˣ) * (-u) := by simp have hdvd : p - 1 ∣ 2 * orderOf (-u) := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean index 79238d2663..e7ef8e387c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean @@ -230,7 +230,7 @@ theorem surfaceRoot_ne_surfaceOrigin (R : Type*) [CommRing R] [Nontrivial R] : theorem markoffReduction_surjective_of_puncturedMarkoffTransitiveAt (p : ℕ) (hp : p.Prime) (htransitive : PuncturedMarkoffTransitiveAt p hp) : Function.Surjective (markoffReduction p) := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ change ∀ x y : PuncturedMarkoffSurface (ZMod p), ∃ g : Gamma (ZMod p), g • x = y at htransitive intro y @@ -260,7 +260,7 @@ connectivity of nonzero natural Markoff solutions is the essential input in this theorem puncturedMarkoffTransitiveAt_of_markoffReduction_surjective (p : ℕ) (hp : p.Prime) (hsurjective : Function.Surjective (markoffReduction p)) : PuncturedMarkoffTransitiveAt p hp := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ change ∀ x y : PuncturedMarkoffSurface (ZMod p), ∃ g : Gamma (ZMod p), g • x = y intro x y diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean index 268ea50dd5..99f8bac4dc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Algebra.Polynomial.Degree.IsMonicOfDegree import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing /-! @@ -97,7 +98,7 @@ theorem biquadraticPrimitiveQuartic_irreducible let qf : F[X] := adjoinSquarePolynomial f have hqfIrreducible : Irreducible qf := by simpa [qf] using adjoinSquarePolynomial_irreducible_of_not_isSquare hf - letI : Fact (Irreducible qf) := ⟨hqfIrreducible⟩ + let : Fact (Irreducible qf) := ⟨hqfIrreducible⟩ let E := AdjoinRoot qf let gE : E := algebraMap F E g have hgE : ¬ IsSquare gE := by @@ -105,7 +106,7 @@ theorem biquadraticPrimitiveQuartic_irreducible let qg : E[X] := adjoinSquarePolynomial gE have hqgIrreducible : Irreducible qg := by simpa [qg] using adjoinSquarePolynomial_irreducible_of_not_isSquare hgE - letI : Fact (Irreducible qg) := ⟨hqgIrreducible⟩ + let : Fact (Irreducible qg) := ⟨hqgIrreducible⟩ let L := AdjoinRoot qg let a : L := algebraMap E L (AdjoinRoot.root qf) let b : L := AdjoinRoot.root qg diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean index 11f942ffb2..bc834368a7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean @@ -189,7 +189,7 @@ theorem exists_threshold_splitCage_connected exists_threshold_splitMaximalFiberBridge coefficient hHasse refine ⟨max bridgeThreshold 7, ?_⟩ intro p hp _ hpThree - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x y hxCage hyCage rcases hxCage with ⟨axis, hxi⟩ @@ -245,7 +245,7 @@ theorem exists_threshold_largeOrder_to_splitCage splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ refine ⟨threshold, ?_⟩ intro p hp _ hpThree - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hlarge obtain ⟨y, hxy, hyOrder⟩ := hendgame p hp hpThree x hlarge diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean index e489aa764b..72e230db2a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean @@ -149,7 +149,7 @@ theorem exists_primitive_cageMiddleUnit_of_explicitInequality divisorsError_lt_primitiveTraceMoebiusMainTerm_of_explicitInequality (Nat.card (ZMod p)ˣ) p 1 coefficient Nat.card_pos (by norm_num) (by simpa using hexplicit) - letI : Finite (CageMiddleWitnessPair p axis other xi eta) := + let : Finite (CageMiddleWitnessPair p axis other xi eta) := Finite.of_injective Subtype.val Subtype.val_injective obtain ⟨z, hz⟩ := BGS.rightTraceExactOrderSolutions_nonempty_of_divisorsError_lt_moebiusMain diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean index 91606352db..3b6bf5876d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean @@ -35,7 +35,7 @@ private lemma natCard_eval_eq_zero_le_natDegree intro x y h apply Subtype.ext exact congrArg (fun z : f.roots.toFinset => (z : K)) h } - letI : Fintype {x : K // f.eval x = 0} := Fintype.ofFinite _ + let : Fintype {x : K // f.eval x = 0} := Fintype.ofFinite _ calc Nat.card {x : K // f.eval x = 0} <= f.roots.toFinset.card := by simpa only [Nat.card_eq_fintype_card, Fintype.card_coe] using @@ -183,7 +183,7 @@ def badDiagonalTaggedPointEmbedding intro x y hxy by_cases hx : x.1.1.1.2 = 0 · by_cases hy : y.1.1.1.2 = 0 - · simp only [hx, hy, if_pos] at hxy + · simp only [hx, hy, ite_eq_left] at hxy have hpayload := Sum.inl.inj hxy apply Subtype.ext apply Prod.ext @@ -197,7 +197,7 @@ def badDiagonalTaggedPointEmbedding · simp [hx, hy] at hxy · by_cases hy : y.1.1.1.2 = 0 · simp [hx, hy] at hxy - · simp only [hx, hy, if_neg] at hxy + · simp only [hx, hy, ite_eq_right] at hxy have hpayload := Sum.inr.inj hxy have hparameter : x.1.1.1.2 = y.1.1.1.2 := congrArg Subtype.val hpayload @@ -342,7 +342,7 @@ theorem cagePulledRootPair_diagonal_card_comparison 2 * (BGS.External.affinePlaneCurveZeros (ZMod p) (cageDiagonalPlanePolynomial xi d)).card = -(Nat.card bad : Int)) - rw [hid, abs_neg, abs_of_nonneg (Int.ofNat_nonneg _)] + rw [hid, abs_neg, abs_of_nonneg (Int.natCast_nonneg _)] exact_mod_cast hbad abbrev CageOffDiagonalPlanePoint (p : Nat) [Fact p.Prime] @@ -460,7 +460,7 @@ private lemma rootCount_le_natDegree intro x y h apply Subtype.ext exact congrArg (fun z : f.roots.toFinset => (z : K)) h } - letI : Fintype {x : K // f.eval x = 0} := Fintype.ofFinite _ + let : Fintype {x : K // f.eval x = 0} := Fintype.ofFinite _ calc Nat.card {x : K // f.eval x = 0} ≤ f.roots.toFinset.card := by simpa only [Nat.card_eq_fintype_card, Fintype.card_coe] using @@ -650,7 +650,7 @@ def badOffDiagonalPlaneEmbedding intro x y hxy by_cases hx : x.1.1.2 = 0 · by_cases hy : y.1.1.2 = 0 - · simp only [hx, hy, if_pos] at hxy + · simp only [hx, hy, ite_eq_left] at hxy have hpayload := Sum.inl.inj hxy apply Subtype.ext apply Subtype.ext @@ -658,7 +658,7 @@ def badOffDiagonalPlaneEmbedding · simp [hx, hy] at hxy · by_cases hy : y.1.1.2 = 0 · simp [hx, hy] at hxy - · simp only [hx, hy, if_neg] at hxy + · simp only [hx, hy, ite_eq_right] at hxy have hpayload := Sum.inr.inj hxy have hparameter : x.1.1.2 = y.1.1.2 := congrArg Subtype.val hpayload have hxsum : x.1.1.1 = 0 := by @@ -697,7 +697,7 @@ theorem cagePulledRootPair_offDiagonal_card_comparison (BGS.External.affinePlaneCurveZeros (ZMod p) (cageOffDiagonalPlanePolynomial xi eta d)).card| ≤ 6 * d + 4 := by classical - letI : Finite (CagePulledRootPair p xi eta d) := + let : Finite (CagePulledRootPair p xi eta d) := Finite.of_injective (fun z => (z.parameter, z.firstRoot, z.secondRoot)) (by intro x y h diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean index dcd27df818..8c01bcdeea 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean @@ -253,7 +253,7 @@ theorem natCard_cagePulledRootPair_eq_mul_canonicalPowerRange have hdCard : d ∣ Nat.card (ZMod p)ˣ := by rw [hcard] exact hd - letI : Finite (CageMiddleWitnessPair p .first .second xi eta) := + let : Finite (CageMiddleWitnessPair p .first .second xi eta) := Finite.of_injective Subtype.val Subtype.val_injective calc Nat.card (CagePulledRootPair p xi eta d) = diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean index 03f5cda68c..dd6074ac67 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean @@ -155,8 +155,8 @@ lemma cagePulledRadicand_coeff_four_mul rw [cagePulledRadicand_expanded] rw [coeff_add, coeff_sub, coeff_C_mul_X_pow, coeff_C_mul_X_pow, coeff_C] - simp only [if_true, if_neg (show 4 * d ≠ 2 * d by omega), - if_neg (show 4 * d ≠ 0 by omega), sub_zero, add_zero] + simp only [ite_true, ite_eq_right (show 4 * d ≠ 2 * d by omega), + ite_eq_right (show 4 * d ≠ 0 by omega), sub_zero, add_zero] /-- A nonparabolic pulled radicand is not a polynomial unit. -/ lemma cagePulledRadicand_not_isUnit diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean index 1c44af9c4e..22f98a21c8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean @@ -213,7 +213,7 @@ theorem incidenceBiquadraticTraceBranch_not_isSquare apply h2 apply FaithfulSMul.algebraMap_injective K (RatFunc K) simpa only [map_ofNat, map_zero] using hzero - letI : Fact + let : Fact (Irreducible (adjoinSquarePolynomial (algebraMap K[X] (RatFunc K) (incidenceBranchPolynomial a)))) := @@ -301,7 +301,7 @@ theorem incidenceBiquadraticTraceRootPolynomial_irreducible (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) (hab : a ^ 2 ≠ b ^ 2) : Irreducible (incidenceBiquadraticTraceRootPolynomial a b) := by - letI : IsDomain (IncidenceBiquadraticRatFuncRing K a b) := + let : IsDomain (IncidenceBiquadraticRatFuncRing K a b) := incidenceBiquadraticRatFuncRing_isDomain K h2 ha hb hA hB hab change Irreducible (traceRootPolynomial (incidenceBiquadraticNormalizedTrace a b)) apply traceRootPolynomial_irreducible_of_discriminant_not_isSquare diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean index c949f7c484..945cd7f4bc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib +import Mathlib.Data.Fintype.Sigma +import Mathlib.Tactic +import Mathlib.Tactic.Ring.Basic /-! # The elementary Markoff surface diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean index 749bd0a002..be8792230e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean @@ -28,7 +28,7 @@ namespace BGS def Markoff : CommSemiRingCat ⥤ Type where obj R := {⟨x, y, z⟩ : R × R × R | x ^ 2 + y ^ 2 + z ^ 2 = 3 * x * y * z} map f := ↾fun ⟨⟨x, y, z⟩, h⟩ ↦ ⟨⟨f.hom x, f.hom y, f.hom z⟩, by - simpa only [Set.mem_setOf_eq, map_add, map_pow, map_mul, map_ofNat] using congrArg f.hom h⟩ + simpa only [Set.mem_ofPred_eq, map_add, map_pow, map_mul, map_ofNat] using congrArg f.hom h⟩ end BGS diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean index 5990a40770..67c0ed01be 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean @@ -50,7 +50,7 @@ theorem hasGiantOrbitAt_of_complement_subset_finset (hbad : Set.univ \ puncturedGammaOrbit x ⊆ (bad : Set _)) (hcard : (bad.card : ℝ) ≤ Real.rpow p epsilon) : HasGiantOrbitAt p hp epsilon := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ refine ⟨x, ?_⟩ have hnat := orbitComplementCard_le_finset_of_subset x bad hbad have hreal : (orbitComplementCard x : ℝ) ≤ bad.card := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean index d35b397b7f..951ba2c7dc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean @@ -31,7 +31,7 @@ private theorem quadraticFiniteField_natCard : theorem isSquare_algebraMap_quadraticFiniteField (hpTwo : p ≠ 2) (a : ZMod p) : IsSquare (algebraMap (ZMod p) (quadraticFiniteField p) a) := by let E := quadraticFiniteField p - letI : Fintype E := Fintype.ofFinite _ + let : Fintype E := Fintype.ofFinite _ change IsSquare (algebraMap (ZMod p) E a) by_cases ha : a = 0 · subst a @@ -143,7 +143,7 @@ theorem exists_split_or_quadraticNormOneTrace ring exact Or.inl ⟨w, htrace, nonparabolic_split_eigenvalue p t ht w htrace⟩ · let E := quadraticFiniteField p - letI : Fintype E := Fintype.ofFinite _ + let : Fintype E := Fintype.ofFinite _ obtain ⟨s, hs⟩ := isSquare_algebraMap_quadraticFiniteField p hpTwo d have hsDiscBase : s ^ 2 = algebraMap (ZMod p) E d := by simpa [pow_two] using hs.symm diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean index 155598b3ae..b765f226d8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean @@ -72,10 +72,10 @@ theorem primewisePuncturedFirstCoordinateZeroExactlyOn_card_eq_of_mod_four_eq_on apply Finset.prod_congr rfl intro i _ by_cases hi : i ∈ R - · simp only [hi, if_true] + · simp only [hi, ite_true] exact puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one (a i) (hmod i) - · simp only [hi, if_false] + · simp only [hi, ite_false] exact puncturedMarkoffFirstCoordinateNonzero_zmod_card_eq_of_mod_four_eq_one (a i) (hmod i) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean index a815d950c1..7c8ced8462 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean @@ -82,7 +82,7 @@ private lemma markoffDiscriminant_inner_sum rw [sum_quadraticChar_neg_four_mul_sq hF hneg] have hzeroFour : (0 : F) ^ 2 ≠ 4 := by simpa using hfour.symm - simp only [if_true, if_neg hzeroFour] + simp only [ite_true, ite_eq_right hzeroFour] rw [show quadraticChar F ((0 : F) ^ 2 - 4) = 1 by simpa using quadraticChar_neg_four_eq_one hF hneg] ring @@ -91,12 +91,12 @@ private lemma markoffDiscriminant_inner_sum rw [hspecial] ring simp_rw [hconstant, quadraticChar_neg_sixteen_eq_one hF hneg] - rw [if_neg hy, if_pos hspecial] + rw [ite_eq_right hy, ite_eq_left hspecial] simp [hspecial] · have hA : y ^ 2 - 4 ≠ 0 := sub_ne_zero.mpr hspecial have hC : (4 : F) * y ^ 2 ≠ 0 := mul_ne_zero hfour (pow_ne_zero 2 hy) rw [BGS.FiniteField.sum_quadraticChar_mul_sq_sub hF hA hC] - rw [if_neg hy, if_neg hspecial] + rw [ite_eq_right hy, ite_eq_right hspecial] ring private lemma markoffDiscriminant_double_sum @@ -121,7 +121,7 @@ private lemma markoffDiscriminant_double_sum have hrootCard : (univ.filter fun y : F ↦ y ^ 2 = 4).card = 2 := by have hroots := quadraticChar_card_sqrts hF (4 : F) rw [hchiFour] at hroots - norm_num [Set.toFinset_setOf] at hroots + norm_num [Set.toFinset_ofPred] at hroots exact_mod_cast hroots have hspecialIndicator : ∑ y : F, (if y ^ 2 = 4 then (Fintype.card F : ℤ) else 0) = @@ -204,7 +204,7 @@ theorem normalizedSurface_card_eq_of_quadraticChar_neg_one_eq_one Nat.card ↑(normalizedSurface F) = Fintype.card F ^ 2 + 3 * Fintype.card F + 1 := by classical - letI := Fintype.ofFinite ↑(normalizedSurface F) + let := Fintype.ofFinite ↑(normalizedSurface F) rw [Nat.card_eq_fintype_card] rw [Fintype.card_congr (normalizedSurfaceEquivDiscriminantRoots hF)] rw [Fintype.card_sigma] @@ -247,7 +247,7 @@ theorem normalizedPuncturedSurface_zmod_card_eq_of_mod_four_eq_one have hchar : ringChar (ZMod p) ≠ 2 := (ZMod.ringChar_zmod_n p).substr hpTwo have hneg : quadraticChar (ZMod p) (-1) = 1 := by rw [quadraticChar_neg_one hchar, ZMod.χ₄_nat_eq_if_mod_four, ZMod.card p, hpModFour] - simp only [if_true] + simp only [ite_true] have hpOdd : p % 2 = 1 := by omega rw [hpOdd] norm_num @@ -283,7 +283,7 @@ theorem normalizedFiber1_zero_card_eq_of_quadraticChar_neg_one_eq_one (hF : ringChar F ≠ 2) (hneg : quadraticChar F (-1) = 1) : Nat.card ↑(normalizedFiber1 (0 : F)) = 2 * Fintype.card F - 1 := by classical - letI := Fintype.ofFinite ↑(normalizedFiber1 (0 : F)) + let := Fintype.ofFinite ↑(normalizedFiber1 (0 : F)) rw [Nat.card_eq_fintype_card] rw [Fintype.card_congr normalizedFiber1ZeroEquivSquareRoots] rw [Fintype.card_sigma] @@ -331,7 +331,7 @@ theorem normalizedPuncturedFiber1_zero_zmod_card_eq_of_mod_four_eq_one have hchar : ringChar (ZMod p) ≠ 2 := (ZMod.ringChar_zmod_n p).substr hpTwo have hneg : quadraticChar (ZMod p) (-1) = 1 := by rw [quadraticChar_neg_one hchar, ZMod.χ₄_nat_eq_if_mod_four, ZMod.card p, hpModFour] - simp only [if_true] + simp only [ite_true] have hpOdd : p % 2 = 1 := by omega rw [hpOdd] norm_num @@ -435,7 +435,7 @@ theorem puncturedMarkoffSurface_zmod_card_eq_of_mod_four_eq_one have hpTwo : 2 ≤ p := hp.two_le have hpCases : p = 2 ∨ p = 3 := by omega rcases hpCases with rfl | rfl <;> norm_num at hpModFour - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (by intro hzero have hdvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero @@ -475,7 +475,7 @@ theorem puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one have hpTwo : 2 ≤ p := hp.two_le have hpCases : p = 2 ∨ p = 3 := by omega rcases hpCases with rfl | rfl <;> norm_num at hpModFour - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (by intro hzero have hdvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero @@ -484,7 +484,7 @@ theorem puncturedMarkoffFirstCoordinateZero_zmod_card_eq_of_mod_four_eq_one have hchar : ringChar (ZMod p) ≠ 2 := (ZMod.ringChar_zmod_n p).substr hpTwo have hneg : quadraticChar (ZMod p) (-1) = 1 := by rw [quadraticChar_neg_one hchar, ZMod.χ₄_nat_eq_if_mod_four, ZMod.card p, hpModFour] - simp only [if_true] + simp only [ite_true] have hpOdd : p % 2 = 1 := by omega rw [hpOdd] norm_num diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean index 7458684064..64d2649463 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean @@ -211,7 +211,7 @@ theorem exists_naivePunctured_not_primewisePunctured {ι : Type*} [Fintype ι] ∃ x : PuncturedMarkoffSurface (ZMod (∏ k, a k)), ¬ IsPrimewisePunctured a coprime x.1 := by classical - haveI : Nontrivial (ZMod (a j)) := ZMod.nontrivial_iff.mpr hj + have : Nontrivial (ZMod (a j)) := ZMod.nontrivial_iff.mpr hj let localPoints : ∀ k, MarkoffSurface (ZMod (a k)) := fun k => if k = i then surfaceOrigin (ZMod (a k)) else unitMarkoffPoint (ZMod (a k)) let globalPoint := (markoffSurfaceCRTEquiv a coprime).symm localPoints @@ -220,7 +220,7 @@ theorem exists_naivePunctured_not_primewisePunctured {ι : Type*} [Fintype ι] refine ⟨j, ?_⟩ rw [show markoffSurfaceCRTEquiv a coprime globalPoint j = localPoints j by exact congrFun ((markoffSurfaceCRTEquiv a coprime).apply_symm_apply localPoints) j] - simp only [localPoints, if_neg hij.symm] + simp only [localPoints, ite_eq_right hij.symm] exact unitMarkoffPoint_ne_surfaceOrigin refine ⟨⟨globalPoint, hglobal⟩, ?_⟩ intro hprimewise diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean index ea55378452..5d5b58f264 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean @@ -46,7 +46,7 @@ theorem exists_threshold_sameComponent_maximalRotation_of_large_firstCoordinate splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ refine ⟨max threshold 5, ?_⟩ intro p hp _ hpThree - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hlarge have hpThreshold : threshold ≤ p := (le_max_left threshold 5).trans hp @@ -80,7 +80,7 @@ theorem exists_threshold_sameComponent_maximalRotation_of_some_largeCoordinate splitCoefficient hSplitWeil nonsplitCoefficient hNonsplitWeil hδ refine ⟨threshold, ?_⟩ intro p hp _ hpThree - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hlarge rcases hlarge with hfirstLarge | hsecondLarge | hthirdLarge diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean index 1e5562767b..19d2fa4b4e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean @@ -99,8 +99,8 @@ theorem finTwoToIteratedPolynomial_splitTraceCoverPolynomial_general_natDegree (monomial (2 * e) (-(X ^ d)) + monomial e (C alpha * X ^ (2 * d) + C beta) + C (-(X ^ d))).coeff (2 * e) = -(X ^ d) := by - rw [coeff_add, coeff_add, coeff_monomial, if_pos rfl, - coeff_monomial, if_neg heTwoNe, coeff_C_ne_zero htwoZero] + rw [coeff_add, coeff_add, coeff_monomial, ite_eq_left rfl, + coeff_monomial, ite_eq_right heTwoNe, Polynomial.coeff_C_of_ne_zero htwoZero] simp have hnonzero : -(X ^ d : Polynomial K) ≠ 0 := neg_ne_zero.mpr (pow_ne_zero d X_ne_zero) apply le_antisymm @@ -125,8 +125,8 @@ theorem descendedIteratedPolynomial_isPrimitive_of_isCoprime simp [coeff_add, coeff_monomial, heNe] have hcoeffE : (monomial (2 * e) (-Q) + monomial e N + C (-Q)).coeff e = N := by - rw [coeff_add, coeff_add, coeff_monomial, if_neg htwoNe, - coeff_monomial, if_pos rfl, coeff_C_ne_zero heNe] + rw [coeff_add, coeff_add, coeff_monomial, ite_eq_right htwoNe, + coeff_monomial, ite_eq_left rfl, Polynomial.coeff_C_of_ne_zero heNe] simp have hgQ : g ∣ Q := by have : g ∣ -Q := hcoeffZero ▸ hall 0 diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean index 13e1f475d4..030dcf28fb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean @@ -46,13 +46,13 @@ theorem quadraticCoefficientTracePolynomial_coeff (P : Polynomial (E p)) (n : · rw [Finset.sum_eq_single n] · simp · intro b hb hbn - rw [Polynomial.coeff_monomial, if_neg hbn] + rw [Polynomial.coeff_monomial, ite_eq_right hbn] · exact fun h => (h hn).elim · rw [Finset.sum_eq_zero] · rw [Polynomial.notMem_support_iff.mp hn, map_zero] · intro b hb rw [Polynomial.coeff_monomial] - exact if_neg (fun h : b = n => hn (h ▸ hb)) + exact ite_eq_right (fun h : b = n => hn (h ▸ hb)) /-- After scalar extension, coefficientwise trace is `P + Frobenius(P)`. -/ theorem quadraticCoefficientTracePolynomial_map (P : Polynomial (E p)) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean index b9f5b3a248..3e389e5097 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean @@ -79,13 +79,13 @@ theorem natCard_powerTraceCoverSolutions Nat.card (powMonoidHom d : G →* G).ker * Nat.card (powMonoidHom e : H →* H).ker * Nat.card (powerTraceRangeSolutions leftTrace rightTrace d e) := by - letI : Finite (powMonoidHom d : G →* G).range := + let : Finite (powMonoidHom d : G →* G).range := Finite.of_injective Subtype.val Subtype.val_injective - letI : Finite (powMonoidHom e : H →* H).range := + let : Finite (powMonoidHom e : H →* H).range := Finite.of_injective Subtype.val Subtype.val_injective - letI : Finite (powerTraceRangeSolutions leftTrace rightTrace d e) := + let : Finite (powerTraceRangeSolutions leftTrace rightTrace d e) := Finite.of_injective Subtype.val Subtype.val_injective - letI := Fintype.ofFinite (powerTraceRangeSolutions leftTrace rightTrace d e) + let := Fintype.ofFinite (powerTraceRangeSolutions leftTrace rightTrace d e) rw [Nat.card_congr (powerTraceCoverEquivSigmaFibers leftTrace rightTrace d e), Nat.card_sigma] simp_rw [Nat.card_prod, natCard_powerMapFiber_eq_ker] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean index 0a26352a0f..b76348faee 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean @@ -32,7 +32,7 @@ theorem powMonoidHom_range_eq_ker_complementaryExponent [Finite H] [IsCyclic H] (d : ℕ) (hdvd : d ∣ Nat.card H) : (powMonoidHom d : H →* H).range = (powMonoidHom (Nat.card H / d) : H →* H).ker := by - letI := Fintype.ofFinite H + let := Fintype.ofFinite H apply Subgroup.eq_of_le_of_card_ge · rintro y ⟨x, rfl⟩ change (x ^ d) ^ (Nat.card H / d) = 1 diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean index 0bd5436b18..cb12cfbfa6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean @@ -121,7 +121,7 @@ lemma not_isSquare_algebraMap_adjoinSquare_of_independent let q : Polynomial F := adjoinSquarePolynomial f have hqIrreducible : Irreducible q := adjoinSquarePolynomial_irreducible_of_not_isSquare hf - letI : Fact (Irreducible q) := ⟨hqIrreducible⟩ + let : Fact (Irreducible q) := ⟨hqIrreducible⟩ change ¬ IsSquare (algebraMap F (AdjoinRoot q) g) have hqMonic : q.Monic := by simpa [q] using adjoinSquarePolynomial_monic f have hqNatDegree : q.natDegree = 2 := by @@ -341,7 +341,7 @@ theorem incidenceBiquadraticRatFuncRing_isDomain apply h2 apply FaithfulSMul.algebraMap_injective L (RatFunc L) simpa only [map_ofNat, map_zero] using hzero - letI : Fact + let : Fact (Irreducible (adjoinSquarePolynomial (algebraMap (Polynomial L) (RatFunc L) (incidenceBranchPolynomial a)))) := @@ -354,9 +354,9 @@ theorem incidenceBiquadraticRatFuncRing_isDomain rw [incidenceFirstQuadraticToRatFunc_algebraMap] apply not_isSquare_algebraMap_adjoinSquare_of_independent h2RatFunc hf hg simpa only [map_mul] using hfg - letI : Fact (Irreducible (incidenceSecondQuadraticRatFuncPolynomial L a b)) := + let : Fact (Irreducible (incidenceSecondQuadraticRatFuncPolynomial L a b)) := ⟨adjoinSquarePolynomial_irreducible_of_not_isSquare hsecondNotSquare⟩ - letI : Field (IncidenceBiquadraticRatFuncRing L a b) := AdjoinRoot.instField + let : Field (IncidenceBiquadraticRatFuncRing L a b) := AdjoinRoot.instField infer_instance /-- The rank-four algebra over `L[y]` is a domain because it injects into the preceding @@ -367,7 +367,7 @@ theorem incidenceBiquadraticRing_isDomain (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) (hab : a ^ 2 ≠ b ^ 2) : IsDomain (IncidenceBiquadraticRing L a b) := by - letI : IsDomain (IncidenceBiquadraticRatFuncRing L a b) := + let : IsDomain (IncidenceBiquadraticRatFuncRing L a b) := incidenceBiquadraticRatFuncRing_isDomain L h2 ha hb hA hB hab exact (incidenceBiquadraticToRatFunc_injective L a b).isDomain (incidenceBiquadraticToRatFunc L a b) @@ -791,7 +791,7 @@ theorem incidenceAuxCoordinateRing_isDomain (hA : 9 * a ^ 2 - 4 ≠ 0) (hB : 9 * b ^ 2 - 4 ≠ 0) (hab : a ^ 2 ≠ b ^ 2) : IsDomain (IncidenceAuxCoordinateRing L a b) := by - letI : IsDomain (IncidenceBiquadraticRing L a b) := + let : IsDomain (IncidenceBiquadraticRing L a b) := incidenceBiquadraticRing_isDomain L h2 ha hb hA hB hab exact (incidenceAuxCoordinateRingEquivBiquadratic L a b).injective.isDomain (incidenceAuxCoordinateRingEquivBiquadratic L a b).toRingEquiv.toRingHom @@ -823,7 +823,7 @@ theorem incidenceAuxGeometricallyIntegral_of_nondegenerate apply hab apply FaithfulSMul.algebraMap_injective K L simpa only [map_pow] using heq - letI : IsDomain + let : IsDomain (IncidenceAuxCoordinateRing L (algebraMap K L a) (algebraMap K L b)) := incidenceAuxCoordinateRing_isDomain L h2L haL hbL hAL hBL habL exact (incidenceAuxCoordinateRingBaseChangeExplicitEquiv K L a b).injective.isDomain @@ -836,7 +836,7 @@ theorem incidenceAux_offDiagonal_geometricallyIntegral : IncidenceAuxOffDiagonalGeometryAt p hp := by refine ⟨3, ?_⟩ intro p hp hpLarge - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ intro a b ha hb hab apply incidenceAuxGeometricallyIntegral_of_nondegenerate · exact two_ne_zero_zmod (by omega) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean index 063b8bf979..614b5a3bfe 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean @@ -257,7 +257,7 @@ theorem incidenceAux_diagonal_point : (9 * a ^ 2 - 4) * y ^ 2 - lambda ^ 2 = 4 * a ^ 2 := by refine ⟨11, ?_⟩ intro p hp hpLarge a ha - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ have h3lt : 3 < p := by omega have h4lt : 4 < p := by omega have h3 : (3 : ZMod p) ≠ 0 := @@ -322,7 +322,7 @@ theorem incidenceAux_offDiagonal_point IncidenceAuxOffDiagonalPointAt p _hp := by refine ⟨29, ?_⟩ intro p hp hpLarge a b ha hb hab - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ have h3lt : 3 < p := by omega have h4lt : 4 < p := by omega have h16lt : 16 < p := by omega @@ -383,7 +383,7 @@ theorem incidenceAuxPoint_eventually obtain ⟨pOff, hOff⟩ := incidenceAux_offDiagonal_point hHasse refine ⟨pDiag + pOff, ?_⟩ intro p hp hpLarge - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ exact auxPointExists_of_diagonal_offDiagonal (hDiag p hp (by omega)) (hOff p hp (by omega)) @@ -395,7 +395,7 @@ theorem two_ne_zero_zmod {p : ℕ} (hp : 2 < p) : (2 : ZMod p) ≠ 0 := by theorem incidenceBridgeAt_of_auxPoint (p : ℕ) (hp : p.Prime) (h2 : (2 : ZMod p) ≠ 0) (haux : IncidenceAuxPointAt p hp) : IncidenceBridgeAt p hp := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ intro a b ha hb exact incidenceAux_exists_implies_common_fiber_with h2 (haux a b ha hb) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean index d8d5cc54d9..4c552997cb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean @@ -203,7 +203,7 @@ equivalence. -/ theorem normalizedAdmissibleBridgeAt_of_incidenceBridgeAt (p : ℕ) (hp : p.Prime) [Invertible (3 : ZMod p)] (hbridge : IncidenceBridgeAt p hp) : NormalizedAdmissibleBridgeAt p hp := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ intro u v hu hv let a := unscaleNormalizedCoordinate u let b := unscaleNormalizedCoordinate v @@ -227,14 +227,14 @@ theorem normalizedAdmissibleBridge_mod_one obtain ⟨p0, hbridge⟩ := incidenceBridge_mod_one_admissible hHasse refine ⟨p0, ?_⟩ intro p hp hpLarge hmod - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ have hpThree : 3 < p := by by_contra h have hpLe : p ≤ 3 := by omega have hpTwo : 2 ≤ p := hp.two_le have hpCases : p = 2 ∨ p = 3 := by omega rcases hpCases with rfl | rfl <;> norm_num at hmod - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (natCast_ne_zero_zmod_of_pos_of_lt (by norm_num) hpThree) exact normalizedAdmissibleBridgeAt_of_incidenceBridgeAt p hp (hbridge p hp hpLarge hmod) @@ -256,7 +256,7 @@ theorem normalizedAdmissibleGraphBridgeAt_of_fixedAxes {p : ℕ} {hp : p.Prime} (hbridge : NormalizedAdmissibleBridgeAt p hp) : NormalizedAdmissibleGraphBridgeAt p hp := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ intro axis other u v hu hv rcases axis with _ | _ | _ <;> rcases other with _ | _ | _ · obtain ⟨w, hw, h13, h23⟩ := hbridge u v hu hv @@ -681,7 +681,7 @@ theorem normalizedFullSurfaceFiberBridge_mod_one obtain ⟨p0, hadmissible⟩ := normalizedAdmissibleGraphBridge_mod_one hHasse refine ⟨p0, ?_⟩ intro p hp hpLarge hmod - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ obtain ⟨i, hi, _, _⟩ := exists_parabolic_line_decomposition_of_mod_four_eq_one p hmod have hgood := hadmissible p hp hpLarge hmod intro axis other u v huNonempty hvNonempty diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean index 51a7b88daa..b103ee5086 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean @@ -28,7 +28,7 @@ def squareRootCount (t : F) : ℤ := theorem squareRootCount_eq_quadraticChar_add_one (hF : ringChar F ≠ 2) (t : F) : squareRootCount t = quadraticChar F t + 1 := by - simpa [squareRootCount, Set.toFinset_setOf] using quadraticChar_card_sqrts hF t + simpa [squareRootCount, Set.toFinset_ofPred] using quadraticChar_card_sqrts hF t /-- The generic quadratic branch value occurring in each auxiliary equation. -/ def branchValue (A C y : F) : F := diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean index 4699f6d60c..52ccdb0410 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean @@ -25,7 +25,7 @@ theorem weightedTraceTorusClosurePolynomial_pderiv_first_ne_zero (alpha beta : K) (hbeta : beta ≠ 0) : MvPolynomial.pderiv 0 (weightedTraceTorusClosurePolynomial alpha beta) ≠ 0 := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] intro hzero have heval := congrArg (MvPolynomial.eval ![(0 : K), (0 : K)]) hzero @@ -36,7 +36,7 @@ theorem weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero (alpha beta : K) (hbeta : beta ≠ 0) : MvPolynomial.pderiv 1 (weightedTraceTorusClosurePolynomial alpha beta) ≠ 0 := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] intro hzero have heval := congrArg (MvPolynomial.eval ![(0 : K), (0 : K)]) hzero @@ -60,7 +60,7 @@ theorem weightedTraceTorusClosurePolynomial_hasBidegreeAtMost (alpha beta : K) (hbeta : beta ≠ 0) : BGS.External.HasBidegreeAtMost (weightedTraceTorusClosurePolynomial alpha beta) 2 2 := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] simpa using splitTraceCoverPolynomial_hasBidegreeAtMost alpha beta 1 1 theorem weightedTraceCurve_isGeneralCorvajaZannierPlaneCurve diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean index 4665c1e14e..744b74e4bf 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean @@ -57,14 +57,14 @@ theorem eval_weightedTraceTorusClosurePolynomial_eq_zero_iff weightedSplitTorusTrace alpha beta h = splitTorusTrace k := by by_cases hbeta : beta = 0 · subst beta - simp only [weightedTraceTorusClosurePolynomial, if_pos, map_sub, map_mul, + simp only [weightedTraceTorusClosurePolynomial, ite_eq_left, map_sub, map_mul, MvPolynomial.eval_C, MvPolynomial.eval_X, Matrix.cons_val_zero, Matrix.cons_val_one, map_pow, map_one, weightedSplitTorusTrace, splitTorusTrace, zero_mul, add_zero, Units.val_inv_eq_inv_val] have hk : (k : K) ≠ 0 := Units.ne_zero k field_simp [hk] constructor <;> intro heq <;> linear_combination heq - · rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + · rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] simpa [SplitTraceCurveEquation] using eval_splitTraceCoverPolynomial_eq_zero_iff alpha beta 1 1 k h @@ -158,8 +158,8 @@ theorem weightedTraceSubgroupSolutionToCurvePoint_mem_torsionIntersection (hz : z ∈ weightedTraceEquationSolutions alpha beta H₁ H₂) : weightedTraceSubgroupSolutionToCurvePoint H₁ H₂ z ∈ weightedTraceCurveTorsionIntersection alpha beta (Nat.card H₁) (Nat.card H₂) := by - letI := Fintype.ofFinite H₁ - letI := Fintype.ofFinite H₂ + let := Fintype.ofFinite H₁ + let := Fintype.ofFinite H₂ rw [mem_weightedTraceCurveTorsionIntersection_iff] refine ⟨mem_weightedTraceEquationSolutions_iff.mp hz, ?_, ?_⟩ · have hpow : z.1 ^ Fintype.card H₁ = 1 := pow_card_eq_one diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean index d0d7ba868d..e5b78db7db 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean @@ -64,11 +64,11 @@ theorem middleGameRightSubgroup_natCard (hd : d ∈ middleGameCandidateOrders p currentOrder) : Nat.card (middleGameRightSubgroup p d) = d := by let E := quadraticFiniteField p - letI : Fintype E := Fintype.ofFinite E + let : Fintype E := Fintype.ofFinite E have hdvd : d ∣ Nat.card Eˣ := middleGameCandidateOrder_dvd_quadraticUnitsCard p currentOrder d hd have hdpos : 0 < d := Nat.pos_of_dvd_of_pos hdvd Nat.card_pos - letI : NeZero d := ⟨hdpos.ne'⟩ + let : NeZero d := ⟨hdpos.ne'⟩ obtain ⟨g, hg⟩ := IsCyclic.exists_ofOrder_eq_natCard (α := Eˣ) let zeta : Eˣ := g ^ (orderOf g / d) have horder : orderOf zeta = d := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean index b13e642ccf..bbc5374382 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean @@ -67,7 +67,7 @@ def weightedTraceTorusClosureOrigin AffinePlaneCurvePoint (weightedTraceTorusClosurePolynomial alpha beta) := ⟨(0, 0), by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] exact splitTraceCoverPolynomial_origin_zero alpha beta 1 1 (by norm_num) (by norm_num)⟩ @@ -122,17 +122,17 @@ theorem weightedTraceTorusClosure_canonicalExceptionalDegree_le_seven MvPolynomial.pderiv 1 f ≠ 0 := weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero alpha beta hbeta - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) - letI : DecidableEq (RatFunc K) := Classical.decEq _ - letI : Algebra (RatFunc K) (PlaneCurveFunctionField f) := + let : DecidableEq (RatFunc K) := Classical.decEq _ + let : Algebra (RatFunc K) (PlaneCurveFunctionField f) := planeCurveFirstCoordinateRatFuncAlgebra f hx - letI : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := + let : FiniteDimensional (RatFunc K) (PlaneCurveFunctionField f) := finiteDimensional_planeCurveFunctionField_over_ratFunc hf hpartialSecond - letI : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := + let : Algebra.IsSeparable (RatFunc K) (PlaneCurveFunctionField f) := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond have hdegreeFirst : MvPolynomial.degreeOf 0 f = 2 := diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean index a3f448fead..ee901db6cd 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean @@ -44,7 +44,7 @@ theorem weightedTraceTorsionIntersection_card_cast_le_eulerSeven_of_largeChar let hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0 := weightedTraceTorusClosurePolynomial_pderiv_second_ne_zero alpha beta hadmissible.2.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let card : ℕ := (BGS.External.torusCurveTorsionIntersection K f m n).card diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean index 79520f91f3..b01b921ca1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean @@ -63,7 +63,7 @@ private theorem weightedTraceSupportRightConstant_mem (alpha beta : K) (hbeta : beta ≠ 0) : weightedTraceSupportRightConstant ∈ (weightedTraceTorusClosurePolynomial alpha beta).support := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] rw [splitTraceCoverPolynomial_one_one_eq_monomials] rw [MvPolynomial.mem_support_iff] simp [weightedTraceSupportAlpha, weightedTraceSupportRightConstant, @@ -74,7 +74,7 @@ private theorem weightedTraceSupportMixed_mem (alpha beta : K) (hbeta : beta ≠ 0) : weightedTraceSupportMixed ∈ (weightedTraceTorusClosurePolynomial alpha beta).support := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] rw [splitTraceCoverPolynomial_one_one_eq_monomials] rw [MvPolynomial.mem_support_iff] simp [weightedTraceSupportAlpha, weightedTraceSupportRightConstant, @@ -85,7 +85,7 @@ private theorem weightedTraceSupportLeftConstant_mem (alpha beta : K) (hbeta : beta ≠ 0) : weightedTraceSupportLeftConstant ∈ (weightedTraceTorusClosurePolynomial alpha beta).support := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] rw [splitTraceCoverPolynomial_one_one_eq_monomials] rw [MvPolynomial.mem_support_iff] simp [weightedTraceSupportAlpha, weightedTraceSupportRightConstant, @@ -120,7 +120,7 @@ theorem weightedTraceTorusClosure_poweredImageIndex_le_two let hf : Irreducible f := irreducible_of_irreducible_map_algebraicClosure hadmissible.2.2.2.1 - letI : IsDomain (PlaneCurveCoordinateRing f) := + let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf have hindex := finrank_poweredImageOverFirst_le_supportDet diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean index f936d4b32e..c2e80b0032 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean @@ -16,7 +16,7 @@ theorem exists_common_primitiveRoot_powers (n : ℕ) [NeZero n] ∃ ζ : K, ∃ a₁ a₂ a₃ : ℕ, IsPrimitiveRoot ζ n ∧ a₁ < n ∧ a₂ < n ∧ a₃ < n ∧ ζ ^ a₁ = w₁ ∧ ζ ^ a₂ = w₂ ∧ ζ ^ a₃ = w₃ := by - haveI : NeZero (n : K) := ⟨by exact_mod_cast (NeZero.ne n)⟩ + have : NeZero (n : K) := ⟨by exact_mod_cast (NeZero.ne n)⟩ obtain ⟨ζ, hζ⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot K n obtain ⟨a₁, ha₁n, ha₁⟩ := hζ.eq_pow_of_pow_eq_one hw₁ obtain ⟨a₂, ha₂n, ha₂⟩ := hζ.eq_pow_of_pow_eq_one hw₂ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean index 407fa07247..46ca8b406d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean @@ -226,8 +226,8 @@ theorem modulus_le_twenty_pow_totient_of_compatible_residue_traces (h₃ : x.u3 = cyclotomicTrace (ω ^ a₃)) (hxne : x ≠ normalizedOrigin) : p ≤ 20 ^ n.totient := by - letI : NeZero (n : ℚ) := ⟨by exact_mod_cast (NeZero.ne n)⟩ - letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + let : NeZero (n : ℚ) := ⟨by exact_mod_cast (NeZero.ne n)⟩ + let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ let z₁ := openingCyclotomicRoot n ^ a₁ let z₂ := openingCyclotomicRoot n ^ a₂ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean index 04e424c2d4..faab52f785 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean @@ -60,7 +60,7 @@ theorem exists_residue_common_primitiveRoot_powers ∃ ω : OpeningResidueClosure p, ∃ a₁ a₂ a₃ : ℕ, IsPrimitiveRoot ω n ∧ a₁ < n ∧ a₂ < n ∧ a₃ < n ∧ ω ^ a₁ = w₁ ∧ ω ^ a₂ = w₂ ∧ ω ^ a₃ = w₃ := by - letI : NeZero (n : OpeningResidueClosure p) := + let : NeZero (n : OpeningResidueClosure p) := ⟨residueClosure_natCast_ne_zero_of_coprime p n hcoprime⟩ obtain ⟨ω, hω⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot (OpeningResidueClosure p) n obtain ⟨a₁, ha₁lt, ha₁⟩ := hω.eq_pow_of_pow_eq_one hw₁ @@ -78,8 +78,8 @@ noncomputable def openingCyclotomicRoot (n : ℕ) [NeZero n] : OpeningCyclotomic /-- The canonical characteristic-zero root has exact order `n`. -/ theorem openingCyclotomicRoot_isPrimitive (n : ℕ) [NeZero n] : IsPrimitiveRoot (openingCyclotomicRoot n) n := by - letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ - letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + let : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ exact IsCyclotomicExtension.zeta_spec n ℚ (OpeningCyclotomicField n) @@ -99,8 +99,8 @@ noncomputable def openingCyclotomicIntegralPowerBasis (n : ℕ) [NeZero n] : @[simp] theorem openingCyclotomicIntegralPowerBasis_gen (n : ℕ) [NeZero n] : (openingCyclotomicIntegralPowerBasis n).gen = openingCyclotomicIntegerRoot n := by - letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ - letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + let : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ exact (openingCyclotomicRoot_isPrimitive n).integralPowerBasis_gen @@ -108,13 +108,13 @@ private theorem primitiveRoot_isRoot_integralPowerBasis_minpoly (p n : ℕ) [Fact p.Prime] [NeZero n] (_hcoprime : Nat.Coprime p n) (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : aeval ω (minpoly ℤ (openingCyclotomicIntegralPowerBasis n).gen) = 0 := by - letI : NeZero (n : OpeningResidueClosure p) := + let : NeZero (n : OpeningResidueClosure p) := ⟨residueClosure_natCast_ne_zero_of_coprime p n _hcoprime⟩ have hrootCyclotomic : aeval ω (cyclotomic n ℤ) = 0 := by rw [aeval_def, ← eval_map, map_cyclotomic] exact hω.isRoot_cyclotomic (NeZero.pos n) - letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ - letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := + let : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ rw [openingCyclotomicIntegralPowerBasis_gen] rw [← NumberField.RingOfIntegers.minpoly_coe] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean index af07b2ce04..73e8ae6ba7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean @@ -114,7 +114,7 @@ the absolute constant `1 / 3`. -/ theorem everyOrbitLargeAt_one_third (p : ℕ) (hp : p.Prime) (hpFive : 5 ≤ p) : EveryOrbitLargeAt p hp (1 / 3 : ℝ) := by - letI : Fact p.Prime := ⟨hp⟩ + let : Fact p.Prime := ⟨hp⟩ intro x exact one_third_mul_log_rpow_le_of_prime_le_twenty_pow_cube p (puncturedGammaOrbit x).ncard hp diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean index 6c2f2436ac..6139244691 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean @@ -269,7 +269,7 @@ theorem prime_le_twenty_pow_normalizedGammaOrbit_ncard_cube p ≤ 20 ^ (letI : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) normalizedGammaOrbit x).ncard ^ 3 := by - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) obtain ⟨W₁, W₂, W₃, htrace₁, htrace₂, htrace₃, _hfin₁, _hfin₂, _hfin₃, _hcoprime₁, _hcoprime₂, _hcoprime₃, hpBound⟩ := @@ -351,7 +351,7 @@ theorem prime_le_twenty_pow_gammaOrbit_ncard_cube (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hpThree : p ≠ 3) (x : MarkoffSurface (ZMod p)) (hxne : x.1 ≠ origin) : p ≤ 20 ^ (gammaOrbit x).ncard ^ 3 := by - letI : Invertible (3 : ZMod p) := + let : Invertible (3 : ZMod p) := invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) let xn := normalizationSurfaceEquiv (ZMod p) x have hxnNe : xn.1 ≠ normalizedOrigin := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean index cd2a1127b1..dcf203fcfa 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean @@ -138,7 +138,7 @@ theorem exists_exact_eigenvalue_orders_with_cyclotomic_bound have hl₂ : 0 < l₂ := hfin₂.orderOf_pos have hl₃ : 0 < l₃ := hfin₃.orderOf_pos have hn : 0 < n := Nat.lcm_pos hl₁ (Nat.lcm_pos hl₂ hl₃) - letI : NeZero n := ⟨hn.ne'⟩ + let : NeZero n := ⟨hn.ne'⟩ have hcoprimeN : Nat.Coprime p n := by apply (Fact.out : p.Prime).coprime_iff_not_dvd.2 exact (Fact.out : p.Prime).not_dvd_lcm diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean index f15e70468a..6928be7b89 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean @@ -85,7 +85,7 @@ instance weightedSplitTraceAffineNormalization_isIntegral (alpha beta : K) (d e : ℕ) (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : IsIntegral (weightedSplitTraceAffineNormalization alpha beta d e h) := by - letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h dsimp [weightedSplitTraceAffineNormalization] infer_instance @@ -94,7 +94,7 @@ instance weightedSplitTraceAffineNormalization_isReduced (alpha beta : K) (d e : ℕ) (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : IsReduced (weightedSplitTraceAffineNormalization alpha beta d e h) := by - letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h dsimp [weightedSplitTraceAffineNormalization] infer_instance diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean index 182f5ba10c..7ca49b741b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean @@ -344,8 +344,8 @@ theorem exists_splitTraceCornerInitialPolynomial_gcd_factorization (MvPolynomial.C a * MvPolynomial.X 0 ^ (d / q) - MvPolynomial.C (zeta ^ i) * MvPolynomial.X 1 ^ (e / q)) have hq : 0 < q := Nat.gcd_pos_of_pos_left e hd - letI : NeZero q := ⟨hq.ne'⟩ - letI : NeZero (q : K) := ⟨by simpa [q] using hgChar⟩ + let : NeZero q := ⟨hq.ne'⟩ + let : NeZero (q : K) := ⟨by simpa [q] using hgChar⟩ obtain ⟨a, ha⟩ := IsAlgClosed.exists_pow_nat_eq gamma hq obtain ⟨zeta, hzeta⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot K q have hqd : q ∣ d := Nat.gcd_dvd_left d e diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean index 685d124afb..b06c8637c6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean @@ -46,7 +46,7 @@ private lemma splitTraceBaseUV_not_square ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ c ^ 2 ≠ splitTraceBaseU sigma * splitTraceBaseV sigma := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let baseField := SplitTraceBaseFunctionField K sigma let U : baseField := splitTraceBaseU sigma let V : baseField := splitTraceBaseV sigma @@ -63,7 +63,7 @@ private lemma splitTraceBaseUV_not_square intro hc apply hUV simpa [hc] using hpow.symm - letI : Module.Finite (RatFunc K) baseField := + let : Module.Finite (RatFunc K) baseField := (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot have hnorm := congrArg (Algebra.norm (RatFunc K)) hpow rw [map_pow] at hnorm @@ -94,10 +94,10 @@ theorem splitTraceXiRadicand_not_primePower_of_commonPrime sigma hsigma i hi e he⟩ z ^ q ≠ splitTraceXiRadicand sigma e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let baseField := SplitTraceBaseFunctionField K sigma let etaField := SplitTraceEtaFunctionField K sigma e let U : baseField := splitTraceBaseU sigma @@ -234,10 +234,10 @@ theorem splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot sigma hsigma i hi e he⟩ Irreducible (splitTraceXiKummerPolynomial sigma e d) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [splitTraceXiKummerPolynomial] apply X_pow_sub_C_irreducible_of_sqrt_neg_one (algebraMap K (SplitTraceEtaFunctionField K sigma e) i) @@ -268,13 +268,13 @@ theorem generalSplitTraceKummerTower_cover_maps_to_zero_of_primitiveRoot generalSplitTracePolynomialToKummerTop sigma e d (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot sigma hsigma hnondegenerate i hi e d he hd zeta hzeta - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ let baseToXi : SplitTraceBaseFunctionField K sigma →+* SplitTraceXiFunctionField K sigma e d := (algebraMap (SplitTraceEtaFunctionField K sigma e) @@ -359,14 +359,14 @@ theorem splitTraceCoverPolynomial_irreducible_of_primitiveRoot (zeta : K) (hzeta : IsPrimitiveRoot zeta e) : Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_primitiveRoot sigma hsigma hnondegenerate i hi e d he hd zeta hzeta - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ - letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : IsDomain (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.isDomain_of_prime hXiIrred.prime let f : MvPolynomial (Fin 2) K →+* SplitTraceXiFunctionField K sigma e d := (generalSplitTracePolynomialToKummerTop sigma e d).toRingHom @@ -396,7 +396,7 @@ theorem splitTraceCoverPolynomial_irreducible_of_primitiveRoot Ideal.Quotient.lift I f hI_le have hInjective : Function.Injective quotientToTop := RingHom.lift_injective_of_ker_le_ideal I hI_le hker_le - letI : IsDomain (MvPolynomial (Fin 2) K ⧸ I) := + let : IsDomain (MvPolynomial (Fin 2) K ⧸ I) := hInjective.isDomain quotientToTop have hprimeIdeal : I.IsPrime := (Ideal.Quotient.isDomain_iff_prime I).mp inferInstance diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean index 9c8a9e896e..ee788de3b2 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean @@ -180,7 +180,7 @@ lemma norm_splitTraceBaseRoot (AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma)) = -splitTraceRadicand sigma := by let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ let pb := AdjoinRoot.powerBasis hIrred.ne_zero have hdim : pb.dim = 2 := by change (splitTraceBaseKummerPolynomial sigma).natDegree = 2 @@ -198,7 +198,7 @@ theorem splitTraceBaseRoot_not_primePower (z : AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) : z ^ q ≠ AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) := by let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ intro hpow have hnorm := congrArg (Algebra.norm (RatFunc K)) hpow rw [map_pow, norm_splitTraceBaseRoot sigma hsigma] at hnorm @@ -222,7 +222,7 @@ theorem splitTraceEtaKummerPolynomial_irreducible Irreducible (X ^ e - C (AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma))) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ apply X_pow_sub_C_irreducible_of_odd heOdd intro q hq _ z exact splitTraceBaseRoot_not_primePower sigma hsigma q hq z @@ -247,7 +247,7 @@ lemma splitTraceBaseU_V_equation algebraMap (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) (RatFunc.C sigma) * splitTraceBaseU sigma - 1 = 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ have hRootSquare : splitTraceBaseV sigma ^ 2 = algebraMap (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) (splitTraceRadicand sigma) := by @@ -272,7 +272,7 @@ lemma splitTraceBaseFunctionField_finrank Module.finrank (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) = 2 := by let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hIrred.ne_zero)] change (splitTraceBaseKummerPolynomial sigma).natDegree = 2 simp [splitTraceBaseKummerPolynomial] @@ -285,7 +285,7 @@ lemma norm_splitTraceBaseU_mul_V_intDegree ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ (Algebra.norm (RatFunc K) (splitTraceBaseU sigma * splitTraceBaseV sigma)).intDegree = 1 := by let hIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hIrred⟩ have hNorm : Algebra.norm (RatFunc K) (splitTraceBaseU sigma * splitTraceBaseV sigma) = RatFunc.X ^ 2 * (-splitTraceRadicand sigma) := by rw [map_mul] @@ -322,9 +322,9 @@ lemma splitTraceEtaFunctionField_finrank Module.finrank (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) = e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hEtaIrred.ne_zero)] change (splitTraceEtaKummerPolynomial sigma e).natDegree = e simp [splitTraceEtaKummerPolynomial] @@ -344,16 +344,16 @@ theorem splitTraceXiRadicand_not_primePower (z : AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) : z ^ q ≠ splitTraceXiRadicand sigma e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ - letI : Module.Finite (RatFunc K) + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Module.Finite (RatFunc K) (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot have he : e ≠ 0 := by rintro rfl simp at heOdd - letI : Module.Finite (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) + let : Module.Finite (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := (monic_X_pow_sub_C _ he).finite_adjoinRoot have hBaseV : splitTraceBaseV sigma ≠ 0 := by @@ -444,9 +444,9 @@ theorem splitTraceXiKummerPolynomial_irreducible ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ Irreducible (splitTraceXiKummerPolynomial sigma e d) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [splitTraceXiKummerPolynomial] apply X_pow_sub_C_irreducible_of_odd hdOdd intro q hq hqd z @@ -472,12 +472,12 @@ theorem splitTraceKummerTower_roots_on_cover (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma) (RatFunc.C sigma))) d e) = 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ let baseToXi : SplitTraceBaseFunctionField K sigma →+* SplitTraceXiFunctionField K sigma e d := (algebraMap (SplitTraceEtaFunctionField K sigma e) @@ -536,12 +536,12 @@ lemma splitTraceXiFunctionField_finrank Module.finrank (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) = d := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hXiIrred.ne_zero)] change (splitTraceXiKummerPolynomial sigma e d).natDegree = d simp [splitTraceXiKummerPolynomial] @@ -559,12 +559,12 @@ theorem splitTraceOddCoprimeKummerTower_isDomain ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ IsDomain (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ exact AdjoinRoot.isDomain_of_prime hXiIrred.prime /-- Reconstructing the same explicit Kummer tower after an arbitrary extension of the constant diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean index f0e2fa8a50..912082a135 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean @@ -44,7 +44,7 @@ theorem splitTraceRadicand_not_constant (sigma : K) (hsigma : sigma ≠ 0) : theorem splitTraceBaseV_transcendental (sigma : K) (hsigma : sigma ≠ 0) : Transcendental K (splitTraceBaseV sigma) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ have hradicand : Transcendental K (splitTraceRadicand sigma) := RatFunc.transcendental_of_ne_C _ (splitTraceRadicand_not_constant sigma hsigma) @@ -66,12 +66,12 @@ theorem splitTraceEtaRootInXiField_transcendental (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : Transcendental K (splitTraceEtaRootInXiField sigma e d) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ have hBaseV : Transcendental K (splitTraceBaseV sigma) := splitTraceBaseV_transcendental sigma hsigma have hBaseVTop : Transcendental K @@ -194,12 +194,12 @@ private theorem splitTraceEtaRatFuncEvaluation_algebraMap (algebraMap K[X] (RatFunc K) q) = splitTraceEtaPolynomialEvaluation sigma e d q := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ exact RatFunc.liftRingHom_algebraMap _ _ q /-- Mapping an iterated polynomial to `K(y)[x]` and then specializing the transcendental @@ -216,12 +216,12 @@ theorem splitTraceIteratedFractionEvaluation MvPolynomial.aeval ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] p := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ rw [Polynomial.eval₂_map] have hcomp : (splitTraceEtaRatFuncEvaluation sigma hsigma e d heOdd hdOdd hde).toRingHom.comp @@ -248,13 +248,13 @@ theorem splitTracePolynomial_mem_span_of_cover_irreducible_and_maps_to_zero sigma hsigma e d heOdd hdOdd hde p = 0) : p ∈ Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ - letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : IsDomain (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.isDomain_of_prime hXiIrred.prime have hd : d ≠ 0 := by rintro rfl @@ -281,7 +281,7 @@ theorem splitTracePolynomial_mem_span_of_cover_irreducible_and_maps_to_zero simpa [splitTracePolynomialToKummerTop, MvPolynomial.aeval_def] using hp let phi : RatFunc K →ₐ[K] SplitTraceXiFunctionField K sigma e d := splitTraceEtaRatFuncEvaluation sigma hsigma e d heOdd hdOdd hde - letI : Algebra (RatFunc K) (SplitTraceXiFunctionField K sigma e d) := + let : Algebra (RatFunc K) (SplitTraceXiFunctionField K sigma e d) := phi.toRingHom.toAlgebra have hqRoot : Polynomial.aeval (splitTraceXiRoot sigma e d) (q.map (algebraMap K[X] (RatFunc K))) = 0 := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean index 0e9218efa1..d42a94f464 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean @@ -304,7 +304,7 @@ theorem weightedSplitTraceLaurentCoordinateRing_isDomain (alpha beta : K) (d e : ℕ) (hd : 0 < d) (he : 0 < e) (hbeta : beta ≠ 0) (h : Irreducible (splitTraceCoverPolynomial alpha beta d e)) : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := by - letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h exact IsLocalization.Away.isDomain (S := WeightedSplitTraceLaurentCoordinateRing alpha beta d e) @@ -401,9 +401,9 @@ theorem weightedSplitTraceLaurentNormalizationInversions_commute_of_irreducible (weightedSplitTraceLeftInversionLaurentNormalizationEquiv alpha beta d e) = (weightedSplitTraceLeftInversionLaurentNormalizationEquiv beta alpha d e).trans (weightedSplitTraceRightInversionLaurentNormalizationEquiv alpha beta d e) := by - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap exact weightedSplitTraceLaurentNormalizationInversions_commute alpha beta d e diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean index e07df6b67b..932f84a731 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean @@ -223,7 +223,7 @@ theorem weightedSplitTracePartialXLocalization_isStandardSmooth theorem weightedSplitTracePartialXLocalization_smooth (alpha beta : K) (d e : ℕ) : Algebra.Smooth K (WeightedSplitTracePartialXLocalization alpha beta d e) := by - letI : Algebra.IsStandardSmooth K + let : Algebra.IsStandardSmooth K (WeightedSplitTracePartialXLocalization alpha beta d e) := weightedSplitTracePartialXLocalization_isStandardSmooth alpha beta d e infer_instance @@ -361,7 +361,7 @@ theorem weightedSplitTracePartialYLocalization_isStandardSmooth theorem weightedSplitTracePartialYLocalization_smooth (alpha beta : K) (d e : ℕ) : Algebra.Smooth K (WeightedSplitTracePartialYLocalization alpha beta d e) := by - letI : Algebra.IsStandardSmooth K + let : Algebra.IsStandardSmooth K (WeightedSplitTracePartialYLocalization alpha beta d e) := weightedSplitTracePartialYLocalization_isStandardSmooth alpha beta d e infer_instance diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean index dc1ad0fe45..3889c0dfe6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean @@ -63,12 +63,12 @@ lemma splitTracePolynomialToKummerTop_relation : splitTracePolynomialToKummerTop sigma hsigma e d heOdd hdOdd hde (splitTraceCoverPolynomial 1 sigma d e) = 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ have hCover := splitTraceKummerTower_roots_on_cover sigma hsigma e d heOdd hdOdd hde have hsigmaMap : @@ -117,12 +117,12 @@ lemma splitTraceAffineToKummerTop_coordinate (i : Fin 2) : (Ideal.Quotient.mk _ (MvPolynomial.X i)) = ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] i := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ change MvPolynomial.aeval ![splitTraceXiRoot sigma e d, splitTraceEtaRootInXiField sigma e d] (MvPolynomial.X i) = _ simp @@ -165,14 +165,14 @@ lemma splitTraceXiRoot_pow : lemma splitTraceBaseV_ne_zero (hsigma : sigma ≠ 0) : splitTraceBaseV sigma ≠ 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ change AdjoinRoot.root (splitTraceBaseKummerPolynomial sigma) ≠ 0 exact (root_X_pow_sub_C_ne_zero_iff hBaseIrred).mpr (splitTraceRadicand_ne_zero sigma hsigma) lemma splitTraceBaseU_ne_zero (hsigma : sigma ≠ 0) : splitTraceBaseU sigma ≠ 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ exact (map_ne_zero_iff _ (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)).injective).mpr RatFunc.X_ne_zero @@ -181,12 +181,12 @@ lemma splitTraceEtaRootInXiField_ne_zero (hsigma : sigma ≠ 0) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : splitTraceEtaRootInXiField sigma e d ≠ 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ apply (map_ne_zero_iff _ (algebraMap (SplitTraceEtaFunctionField K sigma e) (SplitTraceXiFunctionField K sigma e d)).injective).mpr @@ -199,12 +199,12 @@ lemma splitTraceXiRoot_ne_zero (hsigma : sigma ≠ 0) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : splitTraceXiRoot sigma e d ≠ 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ have hRadicand : splitTraceXiRadicand sigma e ≠ 0 := by apply (map_ne_zero_iff _ (algebraMap (SplitTraceBaseFunctionField K sigma) @@ -225,12 +225,12 @@ lemma splitTraceAffineCoordinateProduct_maps_to_nonzero : splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde (splitTraceAffineCoordinateProduct sigma d e) ≠ 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ change splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde (Ideal.Quotient.mk _ (MvPolynomial.X 0 * MvPolynomial.X 1)) ≠ 0 simp only [map_mul] @@ -248,12 +248,12 @@ lemma splitTraceAffineCoordinateProduct_maps_to_isUnit : IsUnit (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde (splitTraceAffineCoordinateProduct sigma d e)) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ have hBaseUUnit : IsUnit (splitTraceBaseU sigma) := (isUnit_iff_ne_zero.mpr RatFunc.X_ne_zero).map (algebraMap (RatFunc K) (SplitTraceBaseFunctionField K sigma)) @@ -335,12 +335,12 @@ theorem splitTraceLaurentToKummerTop_algebraMap_apply (SplitTraceLaurentCoordinateRing K sigma d e) a) = splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ simp only [splitTraceLaurentToKummerTop, IsLocalization.Away.liftAlgHom_apply] apply IsLocalization.Away.lift_eq @@ -359,12 +359,12 @@ theorem splitTraceLaurentToKummerTop_injective_of_affine_injective Function.Injective (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ apply (IsLocalization.injective_iff_map_algebraMap_eq (Submonoid.powers (splitTraceAffineCoordinateProduct sigma d e)) (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom).2 diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean index 9a075cab39..c979d9ac8b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean @@ -75,11 +75,11 @@ theorem splitTraceEtaXiNormalMonomials_linearIndependent Fin (splitTraceXiKummerPolynomial sigma e d).natDegree ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) := by - letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + let : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + let : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + let : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ simpa [splitTraceEtaRootInXiField, splitTraceXiRoot] using adjoinRootTower_normalMonomials_linearIndependent @@ -103,11 +103,11 @@ theorem splitTraceEtaXiNormalMonomials_linearIndependent_of_oddCoprime Fin (splitTraceXiKummerPolynomial sigma e d).natDegree ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) := by - letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + let : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + let : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + let : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ have he : e ≠ 0 := by rintro rfl @@ -137,11 +137,11 @@ theorem splitTraceEtaXiNormalForm_evaluation_eq_zero_iff splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * splitTraceXiRoot sigma e d ^ (ji.2 : ℕ)) c = 0 ↔ c = 0 := by - letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + let : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + let : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + let : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ constructor · intro hc diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean index d4c3221b60..660bd28fc9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean @@ -227,7 +227,7 @@ theorem splitTraceBaseCoordinates_mixedPower_ne_oddPrimePower (splitTraceBaseU sigma * splitTraceBaseV sigma) ^ a * splitTraceBaseV sigma ^ b := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let baseField := SplitTraceBaseFunctionField K sigma let U : baseField := splitTraceBaseU sigma let V : baseField := splitTraceBaseV sigma @@ -247,7 +247,7 @@ theorem splitTraceBaseCoordinates_mixedPower_ne_oddPrimePower intro hz apply hrightNonzero simpa [hz, hq.ne_zero] using hpow.symm - letI : Module.Finite (RatFunc K) baseField := + let : Module.Finite (RatFunc K) baseField := (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot have hnorm := congrArg (Algebra.norm (RatFunc K)) hpow rw [map_pow, map_mul, map_pow, map_pow] at hnorm diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean index 7dc409509d..73768e929a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean @@ -265,13 +265,13 @@ theorem splitTracePolynomialToKummerTop_one_one_eq_baseResidueEvaluation (SplitTraceXiFunctionField K sigma 1 1) (splitTraceBaseResidueEvaluation sigma q) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma 1 (by decide) - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma 1)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma 1)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma 1 1 (by decide) (by decide) (by decide) - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma 1 1)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma 1 1)) := ⟨hXiIrred⟩ let lhs : MvPolynomial (Fin 2) K →ₐ[K] SplitTraceXiFunctionField K sigma 1 1 := splitTracePolynomialToKummerTop sigma hsigma 1 1 diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean index 2445ca4ef6..b061ba1631 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean @@ -54,7 +54,7 @@ theorem X_pow_sub_C_irreducible_of_sqrt_neg_one intro E _ _ x hx have hxIntegral : IsIntegral K x := not_not.mp fun h => by simpa only [degree_zero, degree_X_pow_sub_C hp.pos, - WithBot.natCast_ne_bot] using congr_arg degree (hx.symm.trans (dif_neg h)) + WithBot.natCast_ne_bot] using congr_arg degree (hx.symm.trans (dite_eq_right h)) let iE : ↥(IntermediateField.adjoin K {x}) := algebraMap K (↥(IntermediateField.adjoin K {x})) i have hiE : iE ^ 2 = -1 := by @@ -85,7 +85,7 @@ theorem splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ Irreducible (splitTraceEtaKummerPolynomial sigma e) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ apply X_pow_sub_C_irreducible_of_sqrt_neg_one (algebraMap K (SplitTraceBaseFunctionField K sigma) i) · rw [← map_pow, hi, map_neg, map_one] @@ -104,10 +104,10 @@ lemma splitTraceEtaFunctionField_finrank_of_sqrt_neg_one Module.finrank (SplitTraceBaseFunctionField K sigma) (SplitTraceEtaFunctionField K sigma e) = e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [PowerBasis.finrank (AdjoinRoot.powerBasis hEtaIrred.ne_zero)] change (splitTraceEtaKummerPolynomial sigma e).natDegree = e simp [splitTraceEtaKummerPolynomial] @@ -130,13 +130,13 @@ theorem splitTraceXiRadicand_not_primePower_of_sqrt_neg_one sigma hsigma i hi e he⟩ z ^ q ≠ splitTraceXiRadicand sigma e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ - letI : Module.Finite (RatFunc K) (SplitTraceBaseFunctionField K sigma) := + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Module.Finite (RatFunc K) (SplitTraceBaseFunctionField K sigma) := (monic_X_pow_sub_C _ (by norm_num : (2 : ℕ) ≠ 0)).finite_adjoinRoot - letI : Module.Finite (SplitTraceBaseFunctionField K sigma) + let : Module.Finite (SplitTraceBaseFunctionField K sigma) (SplitTraceEtaFunctionField K sigma e) := (monic_X_pow_sub_C _ he.ne').finite_adjoinRoot have hBaseV : splitTraceBaseV sigma ≠ 0 := by @@ -194,10 +194,10 @@ theorem splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime sigma hsigma i hi e he⟩ Irreducible (splitTraceXiKummerPolynomial sigma e d) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ rw [splitTraceXiKummerPolynomial] apply X_pow_sub_C_irreducible_of_sqrt_neg_one (algebraMap K (SplitTraceEtaFunctionField K sigma e) i) @@ -219,7 +219,7 @@ private theorem generalSplitTraceEtaKummerPolynomial_natDegree ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ (splitTraceEtaKummerPolynomial sigma e).natDegree = e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ change (X ^ e - C (splitTraceBaseV sigma)).natDegree = e exact natDegree_X_pow_sub_C @@ -233,10 +233,10 @@ private theorem generalSplitTraceXiKummerPolynomial_natDegree sigma hsigma i hi e he⟩ (splitTraceXiKummerPolynomial sigma e d).natDegree = d := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ change (X ^ d - C (splitTraceXiRadicand sigma e)).natDegree = d exact natDegree_X_pow_sub_C @@ -328,9 +328,9 @@ theorem generalSplitTracePolynomialSyntacticNormalForm_evaluation | monomial ex c => rw [generalSplitTracePolynomialSyntacticNormalForm_monomial, splitTraceExplicitNormalFormEvaluation] - letI : CommRing (SplitTraceBaseFunctionField K sigma) := AdjoinRoot.instCommRing _ - letI : CommRing (SplitTraceEtaFunctionField K sigma e) := AdjoinRoot.instCommRing _ - letI : CommRing (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.instCommRing _ + let : CommRing (SplitTraceBaseFunctionField K sigma) := AdjoinRoot.instCommRing _ + let : CommRing (SplitTraceEtaFunctionField K sigma e) := AdjoinRoot.instCommRing _ + let : CommRing (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.instCommRing _ rw [Finsupp.linearCombination_single] simp only [Algebra.smul_def, generalSplitTraceMonomialNormalIndex_fst_val, generalSplitTraceMonomialNormalIndex_snd_val, map_mul] @@ -388,9 +388,9 @@ theorem generalSplitTracePolynomialSyntacticNormalForm_eq_zero_iff generalSplitTracePolynomialToKummerTop sigma e d p = 0 := by rw [← generalSplitTracePolynomialSyntacticNormalForm_evaluation sigma hsigma i hi e d he hd p] - letI : CommRing (SplitTraceBaseFunctionField K sigma) := AdjoinRoot.instCommRing _ - letI : CommRing (SplitTraceEtaFunctionField K sigma e) := AdjoinRoot.instCommRing _ - letI : CommRing (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.instCommRing _ + let : CommRing (SplitTraceBaseFunctionField K sigma) := AdjoinRoot.instCommRing _ + let : CommRing (SplitTraceEtaFunctionField K sigma e) := AdjoinRoot.instCommRing _ + let : CommRing (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.instCommRing _ change generalSplitTracePolynomialSyntacticNormalForm sigma hsigma i hi e d he hd p = 0 ↔ Finsupp.linearCombination (SplitTraceBaseFunctionField K sigma) @@ -546,13 +546,13 @@ theorem generalSplitTraceKummerTower_cover_maps_to_zero : generalSplitTracePolynomialToKummerTop sigma e d (splitTraceCoverPolynomial (1 : K) sigma d e) = 0 := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime sigma hsigma i hi e d he hd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ let baseToXi : SplitTraceBaseFunctionField K sigma →+* SplitTraceXiFunctionField K sigma e d := (algebraMap (SplitTraceEtaFunctionField K sigma e) @@ -636,14 +636,14 @@ theorem splitTraceCoverPolynomial_irreducible_of_sqrt_neg_one_coprime (hnondegenerate : sigma ≠ 1) : Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible_of_sqrt_neg_one sigma hsigma i hi e he - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible_of_sqrt_neg_one_coprime sigma hsigma i hi e d he hd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ - letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : IsDomain (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.isDomain_of_prime hXiIrred.prime let f : MvPolynomial (Fin 2) K →+* SplitTraceXiFunctionField K sigma e d := (generalSplitTracePolynomialToKummerTop sigma e d).toRingHom @@ -673,7 +673,7 @@ theorem splitTraceCoverPolynomial_irreducible_of_sqrt_neg_one_coprime Ideal.Quotient.lift I f hI_le have hInjective : Function.Injective quotientToTop := RingHom.lift_injective_of_ker_le_ideal I hI_le hker_le - letI : IsDomain (MvPolynomial (Fin 2) K ⧸ I) := + let : IsDomain (MvPolynomial (Fin 2) K ⧸ I) := hInjective.isDomain quotientToTop have hprimeIdeal : I.IsPrime := (Ideal.Quotient.isDomain_iff_prime I).mp inferInstance diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean index cc8ce60fdb..97f9bfaf06 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean @@ -94,7 +94,7 @@ theorem weightedSplitTraceAffineNormalizationRingSquare alpha beta d e hd he hbeta h).comp ((weightedSplitTraceLaurentNormalizationRingHom alpha beta d e).comp (weightedSplitTraceAffineLaurentRingHom alpha beta d e)) := by - letI : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceAffineCoordinateRing alpha beta d e) := weightedSplitTraceAffineCoordinateRing_isDomain alpha beta d e h let E := weightedSplitTraceAffineNormalizationLaurentOpenEquiv_of_irreducible alpha beta d e hd he hbeta h @@ -263,9 +263,9 @@ theorem weightedSplitTraceFirstInvertedNormalizationSquare weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ (weightedSplitTraceLeftInversionLaurentCurveSchemeIso alpha beta d e).inv ≫ weightedSplitTraceLaurentCurveOpenImmersion alpha beta d e := by - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap calc _ = (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible @@ -292,9 +292,9 @@ theorem weightedSplitTraceSecondInvertedNormalizationSquare weightedSplitTraceLaurentNormalizationToCurve alpha beta d e ≫ (weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e).hom ≫ weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e := by - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap calc _ = (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible @@ -322,9 +322,9 @@ theorem weightedSplitTraceBothInvertedNormalizationSquare ((weightedSplitTraceRightInversionLaurentCurveSchemeIso alpha beta d e).symm.trans (weightedSplitTraceLeftInversionLaurentCurveSchemeIso alpha beta d e)).inv ≫ weightedSplitTraceLaurentCurveOpenImmersion beta alpha d e := by - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing alpha beta d e) := weightedSplitTraceLaurentCoordinateRing_isDomain alpha beta d e hd he hbeta h - letI : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := + let : IsDomain (WeightedSplitTraceLaurentCoordinateRing beta alpha d e) := weightedSplitTraceLaurentCoordinateRing_isDomain beta alpha d e hd he halpha hswap calc _ = (weightedSplitTraceAffineNormalizationLaurentOpenSchemeIso_of_irreducible diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean index 00bc412fa3..b978f72df7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean @@ -205,12 +205,12 @@ theorem splitTraceLaurentSemanticNormalForm_evaluation (splitTraceLaurentSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a) = splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ exact adjoinRootTowerSemanticNormalForm_evaluation _ _ _ _ _ /-- Laurent comparison-map injectivity is equivalent to injectivity of its semantic coefficient @@ -228,12 +228,12 @@ theorem splitTraceLaurentSemanticNormalForm_injective_iff : Function.Injective (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ let f := splitTraceEtaKummerPolynomial sigma e let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) let g := splitTraceXiKummerPolynomial sigma e d diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean index fb5fe67f20..7772cff1ca 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean @@ -171,19 +171,19 @@ theorem splitTraceCoverPolynomial_irreducible_of_laurentInjective (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde)) : Irreducible (splitTraceCoverPolynomial (1 : K) sigma d e) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ - letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : IsDomain (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.isDomain_of_prime hXiIrred.prime let I : Ideal (MvPolynomial (Fin 2) K) := Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} have hAffine := splitTraceAffineToKummerTop_injective_of_laurentInjective sigma hsigma e d heOdd hdOdd hde hLaurent - letI : IsDomain (SplitTraceAffineCoordinateRing K sigma d e) := + let : IsDomain (SplitTraceAffineCoordinateRing K sigma d e) := hAffine.isDomain (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde).toRingHom have hprimeIdeal : I.IsPrime := by @@ -205,13 +205,13 @@ theorem splitTracePolynomialSyntacticNormalForm_division_iff_laurentInjective Function.Injective (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ - letI : IsDomain (SplitTraceXiFunctionField K sigma e d) := + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : IsDomain (SplitTraceXiFunctionField K sigma e d) := AdjoinRoot.isDomain_of_prime hXiIrred.prime constructor · intro hdivision diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean index eb641877cc..ee8909f8e7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean @@ -58,7 +58,7 @@ theorem splitTraceEtaKummerPolynomial_natDegree ⟨splitTraceBaseKummerPolynomial_irreducible sigma hsigma⟩ (splitTraceEtaKummerPolynomial sigma e).natDegree = e := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ change (X ^ e - C (splitTraceBaseV sigma)).natDegree = e exact natDegree_X_pow_sub_C @@ -70,9 +70,9 @@ theorem splitTraceXiKummerPolynomial_natDegree ⟨splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd⟩ (splitTraceXiKummerPolynomial sigma e d).natDegree = d := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ change (X ^ d - C (splitTraceXiRadicand sigma e)).natDegree = d exact natDegree_X_pow_sub_C @@ -201,11 +201,11 @@ theorem splitTraceExplicitNormalFormEvaluation_single_monomial (i j : ℕ) : (splitTraceMonomialNormalIndex sigma hsigma e d heOdd hdOdd i j) (splitTraceMonomialNormalCoefficient sigma e d i j)) = splitTraceXiRoot sigma e d ^ i * splitTraceEtaRootInXiField sigma e d ^ j := by - letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + let : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + let : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + let : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ rw [splitTraceExplicitNormalFormEvaluation, Finsupp.linearCombination_single] simp only [Algebra.smul_def, splitTraceMonomialNormalIndex_fst_val, @@ -228,11 +228,11 @@ theorem splitTraceExplicitNormalFormEvaluation_single_scaled_monomial splitTraceMonomialNormalCoefficient sigma e d i j)) = algebraMap K (SplitTraceXiFunctionField K sigma e d) c * (splitTraceXiRoot sigma e d ^ i * splitTraceEtaRootInXiField sigma e d ^ j) := by - letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + let : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + let : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + let : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ rw [splitTraceExplicitNormalFormEvaluation, Finsupp.linearCombination_single] simp only [Algebra.smul_def, splitTraceMonomialNormalIndex_fst_val, @@ -306,11 +306,11 @@ theorem splitTraceExplicitNormalFormEvaluation_eq_zero_iff letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ splitTraceExplicitNormalFormEvaluation sigma e d c = 0 ↔ c = 0 := by - letI : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := + let : CommRing (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := + let : CommRing (AdjoinRoot (splitTraceEtaKummerPolynomial sigma e)) := AdjoinRoot.instCommRing _ - letI : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := + let : CommRing (AdjoinRoot (splitTraceXiKummerPolynomial sigma e d)) := AdjoinRoot.instCommRing _ change Finsupp.linearCombination (AdjoinRoot (splitTraceBaseKummerPolynomial sigma)) (fun ji ↦ splitTraceEtaRootInXiField sigma e d ^ (ji.1 : ℕ) * @@ -344,12 +344,12 @@ theorem splitTraceAffineToKummerTop_injective_of_syntacticNormalForm_division Function.Injective (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde) := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma - letI : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ + let : Fact (Irreducible (splitTraceBaseKummerPolynomial sigma)) := ⟨hBaseIrred⟩ let hEtaIrred := splitTraceEtaKummerPolynomial_irreducible' sigma hsigma e heOdd - letI : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ + let : Fact (Irreducible (splitTraceEtaKummerPolynomial sigma e)) := ⟨hEtaIrred⟩ let hXiIrred := splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde - letI : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ + let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ let I : Ideal (MvPolynomial (Fin 2) K) := Ideal.span {splitTraceCoverPolynomial (1 : K) sigma d e} let f : MvPolynomial (Fin 2) K →+* diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean index 845814e226..9d0a1b6a00 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean @@ -122,7 +122,7 @@ theorem finTwoToIteratedPolynomial_weightedTraceTorusClosurePolynomial finTwoToIteratedPolynomial (K := K) (weightedTraceTorusClosurePolynomial alpha beta) = weightedTraceIteratedPolynomial alpha beta := by - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta] simp [splitTraceCoverPolynomial, weightedTraceIteratedPolynomial, ← Polynomial.C_mul_X_pow_eq_monomial] ring @@ -291,8 +291,8 @@ theorem map_weightedTraceTorusClosurePolynomial_of_beta_ne_zero MvPolynomial.map phi (weightedTraceTorusClosurePolynomial alpha beta) = weightedTraceTorusClosurePolynomial (phi alpha) (phi beta) := by have hMapBeta : phi beta ≠ 0 := (map_ne_zero_iff phi phi.injective).mpr hbeta - rw [weightedTraceTorusClosurePolynomial, if_neg hbeta, - weightedTraceTorusClosurePolynomial, if_neg hMapBeta] + rw [weightedTraceTorusClosurePolynomial, ite_eq_right hbeta, + weightedTraceTorusClosurePolynomial, ite_eq_right hMapBeta] simp [splitTraceCoverPolynomial] /-- Irreducibility over the ground field, obtained from the iterated-polynomial proof by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean index d7e0fa6696..fc4525c75b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean @@ -109,8 +109,8 @@ theorem splitTraceCoverPolynomial_absolutelyIrreducible_of_positiveExponents have heCharL : (e : AlgebraicClosure K) ≠ 0 := by change phi (e : K) ≠ 0 exact (map_ne_zero_iff phi phi.injective).mpr heChar - letI : NeZero e := ⟨he.ne'⟩ - letI : NeZero (e : AlgebraicClosure K) := ⟨heCharL⟩ + let : NeZero e := ⟨he.ne'⟩ + let : NeZero (e : AlgebraicClosure K) := ⟨heCharL⟩ obtain ⟨zeta, hzeta⟩ := HasEnoughRootsOfUnity.exists_primitiveRoot (AlgebraicClosure K) e obtain ⟨sqrtNegOne, hsqrtNegOne⟩ := diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean index 01ac56542d..08cb77c7d8 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean @@ -64,10 +64,10 @@ private lemma exists_card_divisors_pow_le_constant_mul (k : ℕ) : have haPos : 0 < n.factorization p := hpPrime.factorization_pos_of_dvd hn (Nat.dvd_of_mem_primeFactors hp) by_cases hpSmall : p < 2 ^ k - · rw [if_pos hpSmall] + · rw [ite_eq_left hpSmall] exact (hDpow (n.factorization p)).trans <| Nat.mul_le_mul_left D (Nat.pow_le_pow_left hpTwo _) - · rw [if_neg hpSmall, one_mul] + · rw [ite_eq_right hpSmall, one_mul] have hsucc : n.factorization p + 1 ≤ 2 ^ n.factorization p := Nat.succ_le_of_lt (n.factorization p).lt_two_pow_self calc diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean index 4c51e4e1ba..f1cff22232 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean @@ -53,10 +53,10 @@ theorem card_divisors_pow_le_explicit_constant_mul have haPos : 0 < n.factorization p := hpPrime.factorization_pos_of_dvd hn (Nat.dvd_of_mem_primeFactors hp) by_cases hpSmall : p < 2 ^ k - · rw [if_pos hpSmall] + · rw [ite_eq_left hpSmall] exact (pow_succ_le_self_pow_mul_two_pow k hk (n.factorization p)).trans <| Nat.mul_le_mul_left D (Nat.pow_le_pow_left hpTwo _) - · rw [if_neg hpSmall, one_mul] + · rw [ite_eq_right hpSmall, one_mul] have hsucc : n.factorization p + 1 ≤ 2 ^ n.factorization p := Nat.succ_le_of_lt (n.factorization p).lt_two_pow_self calc diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean index b0c698beeb..546ebfb579 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean @@ -46,14 +46,14 @@ The slightly looser `(n + 1)^2` form avoids any hidden square-root rounding. -/ theorem publishedTerminalJointProductEnvelope_certificate : 2 ^ 457 * (publishedTerminalReducedInteger + 1) ^ 2 ≤ publishedTerminalJointProductEnvelope ^ 10 := by - native_decide + decide +kernel /-- The new envelope makes the paper's first-interval obstruction empty at the exact reduced integer that caused the published algorithm to stop. -/ theorem publishedTerminalJointSquareEnvelope_succeeds : 3 ^ 8 * publishedTerminalJointSquareEnvelope ^ 4 ≤ 32 * (publishedTerminalReducedInteger + 2) := by - native_decide + decide +kernel /-- In contrast, the paper's independent envelope `4C^2` fails at this same integer. This records that the improvement is structural, not a re-rounding @@ -61,6 +61,6 @@ of the published computation. -/ theorem publishedTerminalIndependentSquareEnvelope_fails : 32 * (publishedTerminalReducedInteger + 2) < 3 ^ 8 * (4 * publishedTerminalCentralCoefficient ^ 2) ^ 4 := by - native_decide + decide +kernel end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean index 2c48bb5d72..283f3dfae3 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean @@ -89,11 +89,11 @@ theorem natCard_rightPowerTraceCoverSolutions Nat.card (rightPowerTraceCoverSolutions leftTrace rightTrace exponent) = Nat.card (powMonoidHom exponent : H →* H).ker * Nat.card (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) := by - letI : Finite (powMonoidHom exponent : H →* H).range := + let : Finite (powMonoidHom exponent : H →* H).range := Finite.of_injective Subtype.val Subtype.val_injective - letI : Finite (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) := + let : Finite (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) := Finite.of_injective Subtype.val Subtype.val_injective - letI := Fintype.ofFinite + let := Fintype.ofFinite (rightPowerTraceRangeSolutions leftTrace rightTrace exponent) rw [Nat.card_congr (rightPowerTraceCoverEquivSigmaFiber leftTrace rightTrace exponent), diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean index 164e050794..04bb13dd80 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean @@ -221,108 +221,108 @@ private theorem factorization_succ_pow_ten_le 2 ^ preliminaryPrimePenalty p * p ^ a := by have hpTwo : 2 ≤ p := hpPrime.two_le by_cases hp3 : p < 3 - · simp only [preliminaryPrimePenalty, if_pos hp3] + · simp only [preliminaryPrimePenalty, ite_eq_left hp3] exact (pow_ten_le_base_two a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpTwo a) · by_cases hp5 : p < 5 · have hpLower : 3 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_pos hp5] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_left hp5] exact (pow_ten_le_base_three a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp7 : p < 7 · have hpLower : 5 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, if_pos hp7] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, ite_eq_left hp7] exact (pow_ten_le_base_five a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp11 : p < 11 · have hpLower : 7 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_pos hp11] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_left hp11] exact (pow_ten_le_base_seven a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp13 : p < 13 · have hpLower : 11 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_pos hp13] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_left hp13] exact (pow_ten_le_base_eleven a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp17 : p < 17 · have hpLower : 13 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_pos hp17] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_left hp17] exact (pow_ten_le_base_thirteen a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp23 : p < 23 · have hpLower : 17 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_pos hp23] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_left hp23] exact (pow_ten_le_base_seventeen a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp31 : p < 31 · have hpLower : 23 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp23, if_pos hp31] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp23, ite_eq_left hp31] exact (pow_ten_le_base_twentyThree a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp43 : p < 43 · have hpLower : 31 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp23, if_neg hp31, if_pos hp43] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp23, ite_eq_right hp31, ite_eq_left hp43] exact (pow_ten_le_base_thirtyOne a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp67 : p < 67 · have hpLower : 43 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp23, if_neg hp31, if_neg hp43, if_pos hp67] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp23, ite_eq_right hp31, ite_eq_right hp43, ite_eq_left hp67] exact (pow_ten_le_base_fortyThree a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp131 : p < 131 · have hpLower : 67 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, - if_neg hp67, if_pos hp131] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp23, ite_eq_right hp31, ite_eq_right hp43, + ite_eq_right hp67, ite_eq_left hp131] exact (pow_ten_le_base_sixtySeven a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp257 : p < 257 · have hpLower : 131 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, - if_neg hp67, if_neg hp131, if_pos hp257] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp23, ite_eq_right hp31, ite_eq_right hp43, + ite_eq_right hp67, ite_eq_right hp131, ite_eq_left hp257] exact (pow_ten_le_base_oneHundredThirtyOne a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp521 : p < 521 · have hpLower : 257 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, - if_neg hp67, if_neg hp131, if_neg hp257, - if_pos hp521] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp23, ite_eq_right hp31, ite_eq_right hp43, + ite_eq_right hp67, ite_eq_right hp131, ite_eq_right hp257, + ite_eq_left hp521] exact (pow_ten_le_base_twoHundredFiftySeven a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · by_cases hp1024 : p < 1024 · have hpLower : 521 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, - if_neg hp67, if_neg hp131, if_neg hp257, - if_neg hp521, if_pos hp1024] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp23, ite_eq_right hp31, ite_eq_right hp43, + ite_eq_right hp67, ite_eq_right hp131, ite_eq_right hp257, + ite_eq_right hp521, ite_eq_left hp1024] exact (pow_ten_le_base_fiveHundredTwentyOne a).trans <| Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hpLower a) · have hpLower : 1024 ≤ p := by omega - simp only [preliminaryPrimePenalty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp23, if_neg hp31, if_neg hp43, - if_neg hp67, if_neg hp131, if_neg hp257, - if_neg hp521, if_neg hp1024, pow_zero, one_mul] + simp only [preliminaryPrimePenalty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp23, ite_eq_right hp31, ite_eq_right hp43, + ite_eq_right hp67, ite_eq_right hp131, ite_eq_right hp257, + ite_eq_right hp521, ite_eq_right hp1024, pow_zero, one_mul] exact (pow_ten_le_base_oneThousandTwentyFour a).trans <| Nat.pow_le_pow_left hpLower a diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean index 2191d9cf6a..5e5ddbe758 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean @@ -4,7 +4,9 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ -import Mathlib +import Mathlib.Algebra.BigOperators.Group.Finset.Defs +import Mathlib.Data.Nat.Prime.Defs +import Mathlib.Tactic /-! # Prime-power factorization data diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean index 6fab3b2843..a950e666ee 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean @@ -80,12 +80,12 @@ theorem actualNeighborExponent_pos · exact Nat.prime_of_mem_primeFactors hminus · exact Nat.prime_of_mem_primeFactors hplus by_cases hminus : prime ∈ (p - 1).primeFactors - · simp only [actualNeighborExponent, if_pos hminus] + · simp only [actualNeighborExponent, ite_eq_left hminus] exact hprimePrime.factorization_pos_of_dvd (by omega) (Nat.dvd_of_mem_primeFactors hminus) · have hplus : prime ∈ (p + 1).primeFactors := hdata.2.resolve_left hminus - simp only [actualNeighborExponent, if_neg hminus] + simp only [actualNeighborExponent, ite_eq_right hminus] exact hprimePrime.factorization_pos_of_dvd (by omega) (Nat.dvd_of_mem_primeFactors hplus) diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean index 0cef23b712..820d25d3d6 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean @@ -46,7 +46,7 @@ def rankinCutoff1248CapTable : RankinPositionalCapTable where theorem rankinCutoff1248CapTable_check : rankinCutoff1248CapTable.check = true := by - native_decide + decide +kernel theorem rankinCutoff1248CapTable_valid : rankinCutoff1248CapTable.Valid := @@ -56,11 +56,11 @@ theorem rankinCutoff1248CapTable_valid : theorem rankinCutoff1248CapTable_product : 2 ^ (2 * 1248) < rankinCutoff1248CapTable.oddPrimeFloors.prod := by - native_decide + decide +kernel theorem rankinCutoff1248CapTable_length : rankinCutoff1248CapTable.oddPrimeFloors.length = 275 := by - native_decide + decide +kernel /-- Uniform support-size coverage for the proposed new cutoff. -/ theorem jointOddPrimeList_length_lt_275_of_lt_two_pow_1248 diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean index e773582923..3f48ac47bf 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean @@ -75,7 +75,7 @@ theorem nthPrime_succ_idxOf_le_of_pairwise calc Nat.nth Nat.Prime (values.idxOf q + 1) ≤ Nat.nth Nat.Prime q.primeCounting' := - Nat.nth_monotone Nat.infinite_setOf_prime hindexCard + Nat.nth_monotone Nat.infinite_setOfPred_prime hindexCard _ = q := by simpa [Nat.primeCounting'] using Nat.nth_count hqPrime @@ -257,7 +257,7 @@ theorem jointOddPrimeList_pairwise_positionalCapFloor_lt (List.idxOf_lt_length_of_mem hright).trans_le hlength rw [table.oddCapAt_lowerPrime_eq_nthPrime hvalid hleftIndex, table.oddCapAt_lowerPrime_eq_nthPrime hvalid hrightIndex] - apply Nat.nth_strictMono Nat.infinite_setOf_prime + apply Nat.nth_strictMono Nat.infinite_setOfPred_prime exact Nat.add_lt_add_right (idxOf_lt_idxOf_of_pairwise_lt (jointOddPrimeList p) (jointOddPrimeList_pairwise_lt p) hleft hright hlr) 1 diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean index 6b2606a14f..864d09d815 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean @@ -100,7 +100,7 @@ theorem capTable_oddPrimeFloors_prod_le_jointOddPrimeList_prod exact (List.getElem_take' hactualIndex hfloorIndex).symm rw [htakeEq] exact hcapEq.le.trans hbound - have hprefix := hpointwise.prod_le_prod' + have hprefix := hpointwise.List.Forall₂.prod_le_prod have htakeSublist : List.Sublist (actual.take table.oddPrimeFloors.length) actual := List.take_sublist _ _ @@ -109,7 +109,7 @@ theorem capTable_oddPrimeFloors_prod_le_jointOddPrimeList_prod rcases (mem_jointOddPrimeList.mp hprime).2 with hminus | hplus · exact (Nat.prime_of_mem_primeFactors hminus).one_le · exact (Nat.prime_of_mem_primeFactors hplus).one_le - exact hprefix.trans (htakeSublist.prod_le_prod' hactualOne) + exact hprefix.trans (htakeSublist.List.Sublist.prod_le_prod hactualOne) theorem jointOddPrimeList_length_lt_of_capTable_prod_gt {p : ℕ} {table : RankinPositionalCapTable} diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean index 8841e04a1d..2c7f345b8c 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean @@ -134,7 +134,7 @@ theorem assignedPrimeWeight_power (assignedPrimeWeight p profile assignment prime) ^ 12 := by by_cases htwo : prime = 2 · subst prime - simp only [assignedPrimeWeight, if_pos] + simp only [assignedPrimeWeight, ite_eq_left] apply profile.twoWeightCap.one_le_prime_mul_weight_pow_twelve hprofile.2.1 rw [hprofile.2.2.1] @@ -367,7 +367,7 @@ private theorem oddLowerNeighborProduct_map_assignment_le List.prod_cons] rw [hhead.1, hhead.2.1] by_cases hside : actualNeighborSide p prime = side - · simp only [hside, if_pos] + · simp only [hside, ite_eq_left] exact Nat.mul_le_mul (Nat.pow_le_pow_left hhead.2.2 _) (ih htail) @@ -706,7 +706,7 @@ theorem RankinNeighborProfile.factorizationCoarse_eq_coarseEulerProduct (fun prime => coarseRankinPrimePowerFactor ((p - 1).factorization prime) (assignedPrimeWeight p profile assignment prime)) htwoMinus] - simp only [assignedPrimeWeight, if_pos, + simp only [assignedPrimeWeight, ite_eq_left, RankinNeighborProfile.coarseEulerProduct, RankinNeighborProfile.twoExponent, hminusTwo, hlist] rw [oddCoarseEulerProduct_map_assignment p .minus @@ -721,7 +721,7 @@ theorem RankinNeighborProfile.factorizationCoarse_eq_coarseEulerProduct (fun prime => coarseRankinPrimePowerFactor ((p + 1).factorization prime) (assignedPrimeWeight p profile assignment prime)) htwoPlus] - simp only [assignedPrimeWeight, if_pos, + simp only [assignedPrimeWeight, ite_eq_left, RankinNeighborProfile.coarseEulerProduct, RankinNeighborProfile.twoExponent, hplusTwo, hlist] rw [oddCoarseEulerProduct_map_assignment p .plus diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean index ecaa73c370..ab5f47aa64 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean @@ -129,7 +129,7 @@ private theorem weightedTotientRatio_primePowerSum intro index hindex simp only [weightedTotientRatio_apply_ne_zero _ (pow_ne_zero _ hprime.ne_zero), factorizationWeight, - pow_ne_zero _ hprime.ne_zero, if_false, hprime.factorization_pow] + pow_ne_zero _ hprime.ne_zero, ite_false, hprime.factorization_pow] rw [Finsupp.prod_single_index] rw [Nat.totient_prime_pow_succ hprime] push_cast diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean index d97db4f526..c8e80b2ab9 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean @@ -325,221 +325,244 @@ private theorem pow_twenty_le_of_base_le h.trans (Nat.mul_le_mul_left _ (Nat.pow_le_pow_left hbase _)) /-- Factorwise twentieth-moment estimate for the doubled number weight. -/ +private theorem factorization_succ_pow_twenty_le_large + {p a : ℕ} (hp257 : ¬p < 257) : + (a + 1) ^ 20 ≤ + 2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * a) := by + have hp3 : ¬p < 3 := by omega + have hp5 : ¬p < 5 := by omega + have hp7 : ¬p < 7 := by omega + have hp11 : ¬p < 11 := by omega + have hp13 : ¬p < 13 := by omega + have hp17 : ¬p < 17 := by omega + have hp19 : ¬p < 19 := by omega + have hp23 : ¬p < 23 := by omega + have hp29 : ¬p < 29 := by omega + have hp31 : ¬p < 31 := by omega + have hp37 : ¬p < 37 := by omega + have hp43 : ¬p < 43 := by omega + have hp53 : ¬p < 53 := by omega + have hp67 : ¬p < 67 := by omega + have hp97 : ¬p < 97 := by omega + have hp131 : ¬p < 131 := by omega + have hp191 : ¬p < 191 := by omega + by_cases hp367 : p < 367 + · have hpLower : 257 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, + ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, + ite_eq_right hp131, ite_eq_right hp191, + ite_eq_right hp257, ite_eq_left hp367] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_twoHundredFiftySeven a) + hpLower + · by_cases hp521 : p < 521 + · have hpLower : 367 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, + ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, + ite_eq_right hp131, ite_eq_right hp191, + ite_eq_right hp257, ite_eq_right hp367, + ite_eq_left hp521] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_threeHundredSixtySeven a) + hpLower + · by_cases hp727 : p < 727 + · have hpLower : 521 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, + ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp19, + ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, + ite_eq_right hp43, ite_eq_right hp53, + ite_eq_right hp67, ite_eq_right hp97, + ite_eq_right hp131, ite_eq_right hp191, + ite_eq_right hp257, ite_eq_right hp367, + ite_eq_right hp521, ite_eq_left hp727] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_fiveHundredTwentyOne a) + hpLower + · by_cases hp1024 : p < 1024 + · have hpLower : 727 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, + ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, + ite_eq_right hp29, ite_eq_right hp31, + ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, + ite_eq_right hp97, ite_eq_right hp131, + ite_eq_right hp191, ite_eq_right hp257, + ite_eq_right hp367, ite_eq_right hp521, + ite_eq_right hp727, ite_eq_left hp1024] + exact pow_twenty_le_of_base_le + (pow_twenty_le_base_sevenHundredTwentySeven a) + hpLower + · have hpLower : 1024 ≤ p := by omega + simp only [weightedPrimePenaltyTwenty, + ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, + ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, + ite_eq_right hp29, ite_eq_right hp31, + ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, + ite_eq_right hp97, ite_eq_right hp131, + ite_eq_right hp191, ite_eq_right hp257, + ite_eq_right hp367, ite_eq_right hp521, + ite_eq_right hp727, ite_eq_right hp1024, + pow_zero, one_mul] + simpa only [pow_zero, one_mul] using + (pow_twenty_le_of_base_le (c := 0) + (by simpa only [pow_zero, one_mul] using + pow_twenty_le_base_oneThousandTwentyFour a) + hpLower) + private theorem factorization_succ_pow_twenty_le {p a : ℕ} (hpPrime : p.Prime) : (a + 1) ^ 20 ≤ 2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * a) := by have hpTwo : 2 ≤ p := hpPrime.two_le by_cases hp3 : p < 3 - · simp only [weightedPrimePenaltyTwenty, if_pos hp3] + · simp only [weightedPrimePenaltyTwenty, ite_eq_left hp3] exact pow_twenty_le_of_base_le (pow_twenty_le_base_two a) hpTwo · by_cases hp5 : p < 5 · have hpLower : 3 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_pos hp5] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_left hp5] exact pow_twenty_le_of_base_le (pow_twenty_le_base_three a) hpLower · by_cases hp7 : p < 7 · have hpLower : 5 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, if_pos hp7] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, ite_eq_left hp7] exact pow_twenty_le_of_base_le (pow_twenty_le_base_five a) hpLower · by_cases hp11 : p < 11 · have hpLower : 7 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_pos hp11] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_left hp11] exact pow_twenty_le_of_base_le (pow_twenty_le_base_seven a) hpLower · by_cases hp13 : p < 13 · have hpLower : 11 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_pos hp13] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_left hp13] exact pow_twenty_le_of_base_le (pow_twenty_le_base_eleven a) hpLower · by_cases hp17 : p < 17 · have hpLower : 13 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_pos hp17] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_left hp17] exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirteen a) hpLower · by_cases hp19 : p < 19 · have hpLower : 17 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, if_pos hp19] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, ite_eq_left hp19] exact pow_twenty_le_of_base_le (pow_twenty_le_base_seventeen a) hpLower · by_cases hp23 : p < 23 · have hpLower : 19 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_pos hp23] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_left hp23] exact pow_twenty_le_of_base_le (pow_twenty_le_base_nineteen a) hpLower · by_cases hp29 : p < 29 · have hpLower : 23 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_pos hp29] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_left hp29] exact pow_twenty_le_of_base_le (pow_twenty_le_base_twentyThree a) hpLower · by_cases hp31 : p < 31 · have hpLower : 29 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_neg hp29, if_pos hp31] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, + ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, ite_eq_left hp31] exact pow_twenty_le_of_base_le (pow_twenty_le_base_twentyNine a) hpLower · by_cases hp37 : p < 37 · have hpLower : 31 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_pos hp37] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_left hp37] exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirtyOne a) hpLower · by_cases hp43 : p < 43 · have hpLower : 37 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_pos hp43] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_left hp43] exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirtySeven a) hpLower · by_cases hp53 : p < 53 · have hpLower : 43 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, if_pos hp53] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, ite_eq_left hp53] exact pow_twenty_le_of_base_le (pow_twenty_le_base_fortyThree a) hpLower · by_cases hp67 : p < 67 · have hpLower : 53 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, if_neg hp53, - if_pos hp67] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, + ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, ite_eq_right hp53, + ite_eq_left hp67] exact pow_twenty_le_of_base_le (pow_twenty_le_base_fiftyThree a) hpLower · by_cases hp97 : p < 97 · have hpLower : 67 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, if_neg hp3, - if_neg hp5, if_neg hp7, if_neg hp11, - if_neg hp13, if_neg hp17, if_neg hp19, - if_neg hp23, if_neg hp29, if_neg hp31, - if_neg hp37, if_neg hp43, if_neg hp53, - if_neg hp67, if_pos hp97] + simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, + ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, + ite_eq_right hp13, ite_eq_right hp17, ite_eq_right hp19, + ite_eq_right hp23, ite_eq_right hp29, ite_eq_right hp31, + ite_eq_right hp37, ite_eq_right hp43, ite_eq_right hp53, + ite_eq_right hp67, ite_eq_left hp97] exact pow_twenty_le_of_base_le (pow_twenty_le_base_sixtySeven a) hpLower · by_cases hp131 : p < 131 · have hpLower : 97 ≤ p := by omega simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, if_neg hp7, - if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, if_neg hp97, - if_pos hp131] + ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, + ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, + ite_eq_left hp131] exact pow_twenty_le_of_base_le (pow_twenty_le_base_ninetySeven a) hpLower · by_cases hp191 : p < 191 · have hpLower : 131 ≤ p := by omega simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, if_neg hp7, - if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, if_neg hp97, - if_neg hp131, if_pos hp191] + ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, + ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, + ite_eq_right hp131, ite_eq_left hp191] exact pow_twenty_le_of_base_le (pow_twenty_le_base_oneHundredThirtyOne a) hpLower · by_cases hp257 : p < 257 · have hpLower : 191 ≤ p := by omega simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, if_neg hp7, - if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, if_neg hp97, - if_neg hp131, if_neg hp191, if_pos hp257] + ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, + ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, + ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, + ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, + ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, + ite_eq_right hp131, ite_eq_right hp191, ite_eq_left hp257] exact pow_twenty_le_of_base_le (pow_twenty_le_base_oneHundredNinetyOne a) hpLower - · by_cases hp367 : p < 367 - · have hpLower : 257 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, if_neg hp7, - if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, if_neg hp97, - if_neg hp131, if_neg hp191, - if_neg hp257, if_pos hp367] - exact pow_twenty_le_of_base_le - (pow_twenty_le_base_twoHundredFiftySeven a) - hpLower - · by_cases hp521 : p < 521 - · have hpLower : 367 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, if_neg hp7, - if_neg hp11, if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, if_neg hp97, - if_neg hp131, if_neg hp191, - if_neg hp257, if_neg hp367, - if_pos hp521] - exact pow_twenty_le_of_base_le - (pow_twenty_le_base_threeHundredSixtySeven a) - hpLower - · by_cases hp727 : p < 727 - · have hpLower : 521 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, if_neg hp7, - if_neg hp11, if_neg hp13, - if_neg hp17, if_neg hp19, - if_neg hp23, if_neg hp29, - if_neg hp31, if_neg hp37, - if_neg hp43, if_neg hp53, - if_neg hp67, if_neg hp97, - if_neg hp131, if_neg hp191, - if_neg hp257, if_neg hp367, - if_neg hp521, if_pos hp727] - exact pow_twenty_le_of_base_le - (pow_twenty_le_base_fiveHundredTwentyOne a) - hpLower - · by_cases hp1024 : p < 1024 - · have hpLower : 727 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, - if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, - if_neg hp29, if_neg hp31, - if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, - if_neg hp97, if_neg hp131, - if_neg hp191, if_neg hp257, - if_neg hp367, if_neg hp521, - if_neg hp727, if_pos hp1024] - exact pow_twenty_le_of_base_le - (pow_twenty_le_base_sevenHundredTwentySeven a) - hpLower - · have hpLower : 1024 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, - if_neg hp3, if_neg hp5, - if_neg hp7, if_neg hp11, - if_neg hp13, if_neg hp17, - if_neg hp19, if_neg hp23, - if_neg hp29, if_neg hp31, - if_neg hp37, if_neg hp43, - if_neg hp53, if_neg hp67, - if_neg hp97, if_neg hp131, - if_neg hp191, if_neg hp257, - if_neg hp367, if_neg hp521, - if_neg hp727, if_neg hp1024, - pow_zero, one_mul] - simpa only [pow_zero, one_mul] using - (pow_twenty_le_of_base_le (c := 0) - (by simpa only [pow_zero, one_mul] using - pow_twenty_le_base_oneThousandTwentyFour a) - hpLower) + · exact factorization_succ_pow_twenty_le_large hp257 -- Separate closed computations keep each kernel check within the default limit. private def weightedPrimePenaltyTwentyBlock (k : ℕ) : ℕ := diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean index 5e326e868b..c36d7145d0 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/Basic.lean @@ -201,23 +201,23 @@ theorem adeleFilt_sup_eq_add {D₁ D₂ : DivisorA k K} : let a₁ : AdeleSpace k K := ⟨fun v => if D₂ v ≤ D₁ v then a.val v else 0, by simpa [adeleSubmodule] using haevent.mono fun v hv => by by_cases h : D₂ v ≤ D₁ v - · rw [if_pos h] + · rw [ite_eq_left h] exact hv - · rw [if_neg h] + · rw [ite_eq_right h] exact zero_mem _⟩ let a₂ : AdeleSpace k K := ⟨fun v => if D₂ v ≤ D₁ v then 0 else a.val v, by simpa [adeleSubmodule] using haevent.mono fun v hv => by by_cases h : D₂ v ≤ D₁ v - · rw [if_pos h] + · rw [ite_eq_left h] exact zero_mem _ - · rw [if_neg h] + · rw [ite_eq_right h] exact hv⟩ have ha₁ : a₁ ∈ adeleFilt k K D₁ := by change memAdeleFilt k K D₁ a₁ intro v by_cases h : D₂ v ≤ D₁ v · change placeValuation k K v (if D₂ v ≤ D₁ v then a.val v else 0) ≤ _ - rw [if_pos h] + rw [ite_eq_left h] simpa [Finsupp.sup_apply, sup_eq_left.mpr h] using ha v · simp [a₁, h] have ha₂ : a₂ ∈ adeleFilt k K D₂ := by @@ -227,7 +227,7 @@ theorem adeleFilt_sup_eq_add {D₁ D₂ : DivisorA k K} : · simp [a₂, h] · have hv : D₁ v ≤ D₂ v := le_of_not_ge h change placeValuation k K v (if D₂ v ≤ D₁ v then 0 else a.val v) ≤ _ - rw [if_neg h] + rw [ite_eq_right h] simpa [Finsupp.sup_apply, sup_eq_right.mpr hv] using ha v refine Submodule.mem_sup.mpr ⟨a₁, ha₁, a₂, ha₂, ?_⟩ ext v diff --git a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean index 4bddfc03eb..49afe05142 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/AdeleSpace/FilterChain.lean @@ -188,7 +188,7 @@ theorem finiteAdeleLocalResidueMap_surjective (D : DivisorA k K) (v.valuation K) (a₀.val (Sum.inl v)) ≤ WithZero.exp (D (Sum.inl v) + 1) := by have hmul' : (v.valuation K) (a₀.val (Sum.inl v)) = (v.valuation K) (π ^ (-n)) * (v.valuation K) (z : K) := by - show (v.valuation K) + change (v.valuation K) (Function.update (0 : PlaceA k K → K) (Sum.inl v) xK (Sum.inl v)) = _ simp only [Function.update_self, xK] exact Valuation.map_mul (v.valuation K) _ _ @@ -241,7 +241,7 @@ theorem finrankAdeleFiltDiff_single_finite (D : DivisorA k K) ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional have hker := finiteAdeleLocalResidueMap_ker k K D v have hsurj := finiteAdeleLocalResidueMap_surjective k K D v rw [finrankAdeleFiltDiff, ← hker, f.quotKerEquivRange.finrank_eq] @@ -390,7 +390,7 @@ theorem infiniteAdeleLocalResidueMap_surjective (D : DivisorA k K) (v.valuation K) (a₀.val (Sum.inr v)) ≤ WithZero.exp (D (Sum.inr v) + 1) := by have hmul' : (v.valuation K) (a₀.val (Sum.inr v)) = (v.valuation K) (π ^ (-n)) * (v.valuation K) (z : K) := by - show (v.valuation K) + change (v.valuation K) (Function.update (0 : PlaceA k K → K) (Sum.inr v) xK (Sum.inr v)) = _ simp only [Function.update_self, xK] exact Valuation.map_mul (v.valuation K) _ _ @@ -443,7 +443,7 @@ theorem finrankAdeleFiltDiff_single_infinite (D : DivisorA k K) ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional have hker := infiniteAdeleLocalResidueMap_ker k K D v have hsurj := infiniteAdeleLocalResidueMap_surjective k K D v rw [finrankAdeleFiltDiff, ← hker, f.quotKerEquivRange.finrank_eq] @@ -465,38 +465,38 @@ theorem finiteAdeleFiltDiff_quotient_single (D : DivisorA k K) (v : PlaceA k K) Submodule.comap (adeleFilt k K (D + Finsupp.single v 1)).subtype (adeleFilt k K D)) := by classical rcases v with v | v - · letI : AddCommGroup (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) := + · let : AddCommGroup (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) := Submodule.addCommGroup _ - letI : Module k (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) := Submodule.module _ + let : Module k (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)) := Submodule.module _ let f := finiteAdeleLocalResidueMap k K D v let e : (ringOfIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := LinearEquiv.ofBijective ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional let p := Submodule.comap (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1)).subtype (adeleFilt k K D) - haveI : Module.Finite k f.range := inferInstance - haveI : Module.Finite k + have : Module.Finite k f.range := inferInstance + have : Module.Finite k (adeleFilt k K (D + Finsupp.single (Sum.inl v) 1) ⧸ f.ker) := Module.Finite.equiv f.quotKerEquivRange.symm exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p (finiteAdeleLocalResidueMap_ker k K D v)) - · letI : AddCommGroup (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) := + · let : AddCommGroup (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) := Submodule.addCommGroup _ - letI : Module k (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) := Submodule.module _ + let : Module k (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)) := Submodule.module _ let f := infiniteAdeleLocalResidueMap k K D v let e : (infiniteIntegers k K ⧸ v.asIdeal) ≃ₗ[k] v.asIdeal.ResidueField := LinearEquiv.ofBijective ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional let p := Submodule.comap (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1)).subtype (adeleFilt k K D) - haveI : Module.Finite k f.range := inferInstance - haveI : Module.Finite k + have : Module.Finite k f.range := inferInstance + have : Module.Finite k (adeleFilt k K (D + Finsupp.single (Sum.inr v) 1) ⧸ f.ker) := Module.Finite.equiv f.quotKerEquivRange.symm exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p @@ -530,7 +530,7 @@ theorem finiteAdeleFiltDiff_quotient_mono_add {D M N : DivisorA k K} rw [Submodule.map_equiv_eq_comap_symm eR.symm qM] rfl have eMq : (pM ⧸ qM) ≃ₗ[k] (r ⧸ qInR) := Submodule.Quotient.equiv qM qInR eR.symm hqmap - haveI : Module.Finite k (r ⧸ qInR) := Module.Finite.equiv eMq + have : Module.Finite k (r ⧸ qInR) := Module.Finite.equiv eMq have hker : (q.mkQ.comp (r.subtype : r →ₗ[k] p)).ker = qInR := by rw [LinearMap.ker_comp, Submodule.ker_mkQ] have hrange : (q.mkQ.comp (r.subtype : r →ₗ[k] p)).range = r.map q.mkQ := by @@ -538,10 +538,10 @@ theorem finiteAdeleFiltDiff_quotient_mono_add {D M N : DivisorA k K} have eQuot : (r ⧸ qInR) ≃ₗ[k] r.map q.mkQ := by rw [← hker, ← hrange] exact LinearMap.quotKerEquivRange (q.mkQ.comp (r.subtype : r →ₗ[k] p)) - haveI : Module.Finite k (r.map q.mkQ) := Module.Finite.equiv eQuot + have : Module.Finite k (r.map q.mkQ) := Module.Finite.equiv eQuot have eThird := Submodule.quotientQuotientEquivQuotient q r hqr - haveI : Module.Finite k (p ⧸ r) := by dsimp only [p, r]; infer_instance - haveI : Module.Finite k ((p ⧸ q) ⧸ Submodule.map q.mkQ r) := Module.Finite.equiv eThird.symm + have : Module.Finite k (p ⧸ r) := by dsimp only [p, r]; infer_instance + have : Module.Finite k ((p ⧸ q) ⧸ Submodule.map q.mkQ r) := Module.Finite.equiv eThird.symm exact Module.Finite.of_submodule_quotient (Submodule.map q.mkQ r) theorem finiteAdeleFiltDiff_quotient_single_nat (D : DivisorA k K) (v : PlaceA k K) (n : ℕ) : @@ -572,8 +572,8 @@ theorem finiteAdeleFiltDiff_quotient_single_nat (D : DivisorA k K) (v : PlaceA k exact le_add_of_nonneg_right (by simp only [Finsupp.single_apply] split <;> omega) - letI := ih - haveI := finiteAdeleFiltDiff_quotient_single k K (D + Finsupp.single v (n : ℤ)) v + let := ih + have := finiteAdeleFiltDiff_quotient_single k K (D + Finsupp.single v (n : ℤ)) v rw [heq] exact finiteAdeleFiltDiff_quotient_mono_add k K hDM hMN @@ -596,8 +596,8 @@ theorem finiteAdeleFiltDiff_quotient_add_effective (D E : DivisorA k K) · simpa [Finsupp.single_apply, hw] using hE w have hb0 : 0 ≤ b := by simpa [Finsupp.single_apply, hfa] using hE a - letI := ih D hff - haveI := finiteAdeleFiltDiff_quotient_single_nat k K (D + f) a b.toNat + let := ih D hff + have := finiteAdeleFiltDiff_quotient_single_nat k K (D + f) a b.toNat have hbcast : (b.toNat : ℤ) = b := Int.toNat_of_nonneg hb0 have heq : D + (Finsupp.single a b + f) = (D + f) + Finsupp.single a (b.toNat : ℤ) := by @@ -635,9 +635,9 @@ theorem finrankAdeleFiltDiff_mono_add {D M N : DivisorA k K} have hEN := (le_iff_sub_effective k K).mp hMN have hND : D + (N - D) = N := by ext w; simp [sub_eq_add_neg] have hNM : M + (N - M) = N := by ext w; simp [sub_eq_add_neg] - haveI : Module.Finite k (p ⧸ q) := + have : Module.Finite k (p ⧸ q) := finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hND.symm hE - haveI : Module.Finite k (p ⧸ r) := + have : Module.Finite k (p ⧸ r) := finiteAdeleFiltDiff_quotient_add_eq k K (M := M) hNM.symm hEN dsimp only [finrankAdeleFiltDiff] have e := Submodule.quotientQuotientEquivQuotient q r hqr @@ -811,10 +811,10 @@ theorem finrank_map_comap_mkQ_eq_quotient {D' : DivisorA k K} let qt := Submodule.comap p.subtype t let st := Submodule.comap t.subtype s let qpInQt := Submodule.comap qt.subtype qp - letI : AddCommGroup ↥t := Submodule.addCommGroup _ - letI : Module k ↥t := Submodule.module _ - letI : AddCommGroup ↥qt := Submodule.addCommGroup _ - letI : Module k ↥qt := Submodule.module _ + let : AddCommGroup ↥t := Submodule.addCommGroup _ + let : Module k ↥t := Submodule.module _ + let : AddCommGroup ↥qt := Submodule.addCommGroup _ + let : Module k ↥qt := Submodule.module _ let eT := Submodule.comapSubtypeEquivOfLe ht have hmap : st.map (eT.symm : ↥t →ₗ[k] ↥qt) = qpInQt := by ext x @@ -863,10 +863,10 @@ theorem sandwich {D D' : DivisorA k K} (h : D ≤ D') : calc p ⊓ (s + r) = s + (p ⊓ r) := hmod _ = s + l := by rw [hpr] _ = t := by simp [t, Submodule.add_eq_sup, sup_comm] - letI : AddCommGroup ↥p := Submodule.addCommGroup _ - letI : Module k ↥p := Submodule.module _ - letI : AddCommGroup ↥(p + r) := Submodule.addCommGroup _ - letI : Module k ↥(p + r) := Submodule.module _ + let : AddCommGroup ↥p := Submodule.addCommGroup _ + let : Module k ↥p := Submodule.module _ + let : AddCommGroup ↥(p + r) := Submodule.addCommGroup _ + let : Module k ↥(p + r) := Submodule.module _ let qp := Submodule.comap p.subtype s let qt := Submodule.comap p.subtype t have hqp : qp ≤ qt := Submodule.comap_mono hst @@ -878,8 +878,8 @@ theorem sandwich {D D' : DivisorA k K} (h : D ≤ D') : rcases Submodule.mem_sup.mp hx with ⟨a, ha, b, hb, rfl⟩ have hb' : b ∈ s + r := Submodule.mem_sup_right hb exact Submodule.add_mem _ (Submodule.mem_sup_left ha) (Submodule.mem_sup_right hb') - haveI : AddCommGroup ↥(p ⊔ (s + r)) := Submodule.addCommGroup _ - haveI : Module k ↥(p ⊔ (s + r)) := Submodule.module _ + have : AddCommGroup ↥(p ⊔ (s + r)) := Submodule.addCommGroup _ + have : Module k ↥(p ⊔ (s + r)) := Submodule.module _ have e1 := LinearMap.quotientInfEquivSupQuotient p (s + r) have hsand : Module.finrank k (↥(p + r) ⧸ Submodule.comap (p + r).subtype (s + r)) = @@ -893,7 +893,7 @@ theorem sandwich {D D' : DivisorA k K} (h : D ≤ D') : have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp h have e2 := Submodule.quotientQuotientEquivQuotient qp qt hqp have hdiv : D + (D' - D) = D' := by ext w; simp [sub_eq_add_neg] - haveI : Module.Finite k (↥p ⧸ qp) := + have : Module.Finite k (↥p ⧸ qp) := finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hdiv.symm hE have hsecond : Module.finrank k (Submodule.map qp.mkQ qt) = finrankRRspaceDiff k K D D' := by have hld : l ⊓ s = Submodule.map (diagonal k K) (RRspace k K D) := by @@ -909,8 +909,8 @@ theorem sandwich {D D' : DivisorA k K} (h : D ≤ D') : have hfin_map := finrank_map_comap_mkQ_eq_quotient k K hs_le_p htp hst let st := Submodule.comap t.subtype s let qpInQt := Submodule.comap qt.subtype qp - letI : AddCommGroup ↥t := Submodule.addCommGroup _ - letI : Module k ↥t := Submodule.module _ + let : AddCommGroup ↥t := Submodule.addCommGroup _ + let : Module k ↥t := Submodule.module _ let eT := Submodule.comapSubtypeEquivOfLe htp have hmap : st.map (eT.symm : ↥t →ₗ[k] ↥qt) = qpInQt := by ext x @@ -918,10 +918,10 @@ theorem sandwich {D D' : DivisorA k K} (h : D ≤ D') : have eTS : ((↥t) ⧸ st) ≃ₗ[k] ((↥qt) ⧸ qpInQt) := Submodule.Quotient.equiv st qpInQt eT.symm hmap have e3 := LinearMap.quotientInfEquivSupQuotient l s - letI : AddCommGroup ↥(l ⊔ s) := Submodule.addCommGroup _ - letI : Module k ↥(l ⊔ s) := Submodule.module _ - letI : AddCommGroup ↥l := Submodule.addCommGroup _ - letI : Module k ↥l := Submodule.module _ + let : AddCommGroup ↥(l ⊔ s) := Submodule.addCommGroup _ + let : Module k ↥(l ⊔ s) := Submodule.module _ + let : AddCommGroup ↥l := Submodule.addCommGroup _ + let : Module k ↥l := Submodule.module _ dsimp [finrankRRspaceDiff] calc Module.finrank k (Submodule.map qp.mkQ qt) @@ -1050,7 +1050,7 @@ theorem sandwichDiagonalSubmodule_eq_of_rank_zero {D D' : DivisorA k K} (hle : D have hqp_le : qp ≤ qt := Submodule.comap_mono le_sup_right have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp hle have hdiv : D + (D' - D) = D' := by abel - haveI : Module.Finite k (↥p ⧸ qp) := + have : Module.Finite k (↥p ⧸ qp) := finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hdiv.symm hE have htp : t ≤ p := by rintro x hx @@ -1059,12 +1059,12 @@ theorem sandwichDiagonalSubmodule_eq_of_rank_zero {D D' : DivisorA k K} (hle : D exact Submodule.add_mem p (by simpa [adeleFilt, memAdeleFilt, memRRspace, RRspace, diagonal, p] using hf) (adeleFilt_mono k K hle hz) - letI : AddCommGroup ↥p := Submodule.addCommGroup _ - letI : Module k ↥p := Submodule.module _ - letI : AddCommGroup ↥(p + r) := Submodule.addCommGroup _ - letI : Module k ↥(p + r) := Submodule.module _ - letI : AddCommGroup ↥(adeleFilt k K D' + diagonalSubmodule k K) := Submodule.addCommGroup _ - letI : Module k ↥(adeleFilt k K D' + diagonalSubmodule k K) := Submodule.module _ + let : AddCommGroup ↥p := Submodule.addCommGroup _ + let : Module k ↥p := Submodule.module _ + let : AddCommGroup ↥(p + r) := Submodule.addCommGroup _ + let : Module k ↥(p + r) := Submodule.module _ + let : AddCommGroup ↥(adeleFilt k K D' + diagonalSubmodule k K) := Submodule.addCommGroup _ + let : Module k ↥(adeleFilt k K D' + diagonalSubmodule k K) := Submodule.module _ have hfin_qt : Module.finrank k (↥p ⧸ qt) = 0 := by have hfin_sandwich : Module.finrank k @@ -1087,7 +1087,7 @@ theorem sandwichDiagonalSubmodule_eq_of_rank_zero {D D' : DivisorA k K} (hle : D (LinearMap.quotientInfEquivSupQuotient p (s + r)).symm.finrank_eq rw [hpsum, hinfl] at hsand exact hsand.symm.trans hfin_sandwich - haveI : Module.Finite k (↥p ⧸ qt) := + have : Module.Finite k (↥p ⧸ qt) := Module.Finite.equiv (Submodule.quotientQuotientEquivQuotient qp qt hqp_le) have hrk : Module.rank k (↥p ⧸ qt) = 0 := by rw [← Module.finrank_eq_rank, hfin_qt, Nat.cast_zero] diff --git a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean index c53e4f4b18..fc78ce4a53 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/CoordinateFree/AlgEquiv.lean @@ -118,8 +118,8 @@ theorem mapAlgEquiv_valuation_eq_comap (e : K ≃ₐ[k] L) (v : Place k K) : refine ⟨e x, ?_, ?_⟩ · simpa [q] using hx0 · simpa [q] using hx1 - letI : q.IsNontrivial := hqnontrivial - letI : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q + let : q.IsNontrivial := hqnontrivial + let : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q let V := q.valuationSubring let h := Valuation.isEquiv_valuation_valuationSubring q let ε : ValueGroup₀ (.ofClass V.valuation) ≃*o diff --git a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean index 780afae8a5..a4ff46275b 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/FunctionField/Divisor.lean @@ -69,22 +69,22 @@ theorem placeDegree_infinite_eq_inertiaDeg let A := inftyValuationSubring k let S := infiniteIntegers k K let p : Ideal A := v.asIdeal.under A - letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - letI : p.IsMaximal := Ideal.IsMaximal.under A v.asIdeal - letI : v.asIdeal.LiesOver p := ⟨rfl⟩ - letI : Field (A ⧸ p) := Ideal.Quotient.field p - letI : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal - letI : Algebra (A ⧸ p) (S ⧸ v.asIdeal) := + let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + let : p.IsMaximal := Ideal.IsMaximal.under A v.asIdeal + let : v.asIdeal.LiesOver p := ⟨rfl⟩ + let : Field (A ⧸ p) := Ideal.Quotient.field p + let : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + let : Algebra (A ⧸ p) (S ⧸ v.asIdeal) := Ideal.Quotient.algebraQuotientOfLEComap (Ideal.over_def v.asIdeal p).ge have hp : p = IsLocalRing.maximalIdeal A := IsLocalRing.eq_maximalIdeal inferInstance - letI : FiniteDimensional k (A ⧸ p) := by + let : FiniteDimensional k (A ⧸ p) := by rw [hp] exact inftyValuationSubring.finiteDimensionalResidueField k - letI : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := by + let : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := by have hfin := Ideal.inertiaDeg_pos v.asIdeal A rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] at hfin exact FiniteDimensional.of_finrank_pos hfin - letI : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := + let : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := IsScalarTower.of_algebraMap_eq fun _ => rfl change Module.finrank k (S ⧸ v.asIdeal) = v.asIdeal.inertiaDeg A rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] @@ -104,20 +104,20 @@ theorem placeDegree_finite_eq_base_mul_inertiaDeg v.asIdeal.inertiaDeg k[X] := by let S := ringOfIntegers k K let p : Ideal k[X] := v.asIdeal.under k[X] - letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - letI : p.IsMaximal := Ideal.IsMaximal.under k[X] v.asIdeal - letI : v.asIdeal.LiesOver p := ⟨rfl⟩ - letI : Field (k[X] ⧸ p) := Ideal.Quotient.field p - letI : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal - letI : Algebra (k[X] ⧸ p) (S ⧸ v.asIdeal) := + let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + let : p.IsMaximal := Ideal.IsMaximal.under k[X] v.asIdeal + let : v.asIdeal.LiesOver p := ⟨rfl⟩ + let : Field (k[X] ⧸ p) := Ideal.Quotient.field p + let : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + let : Algebra (k[X] ⧸ p) (S ⧸ v.asIdeal) := Ideal.Quotient.algebraQuotientOfLEComap (Ideal.over_def v.asIdeal p).ge - letI : FiniteDimensional k (k[X] ⧸ p) := + let : FiniteDimensional k (k[X] ⧸ p) := finite_of_finite_type_of_isJacobsonRing k _ - letI : FiniteDimensional (k[X] ⧸ p) (S ⧸ v.asIdeal) := by + let : FiniteDimensional (k[X] ⧸ p) (S ⧸ v.asIdeal) := by have hfin := Ideal.inertiaDeg_pos v.asIdeal k[X] rw [Ideal.inertiaDeg_eq_of_isMaximal p v.asIdeal] at hfin exact FiniteDimensional.of_finrank_pos hfin - letI : IsScalarTower k (k[X] ⧸ p) (S ⧸ v.asIdeal) := + let : IsScalarTower k (k[X] ⧸ p) (S ⧸ v.asIdeal) := IsScalarTower.of_algebraMap_eq fun _ => rfl change Module.finrank k (S ⧸ v.asIdeal) = Module.finrank k (k[X] ⧸ p) * v.asIdeal.inertiaDeg k[X] @@ -132,13 +132,13 @@ theorem relNorm_asIdeal_finite Ideal.relNorm k[X] v.asIdeal = (v.asIdeal.under k[X]) ^ v.asIdeal.inertiaDeg k[X] := by let S := ringOfIntegers k K - letI : Algebra k[X] (FractionRing S) := inferInstance - letI : FaithfulSMul k[X] (FractionRing S) := inferInstance - letI : Algebra (FractionRing k[X]) (FractionRing S) := + let : Algebra k[X] (FractionRing S) := inferInstance + let : FaithfulSMul k[X] (FractionRing S) := inferInstance + let : Algebra (FractionRing k[X]) (FractionRing S) := FractionRing.liftAlgebra k[X] (FractionRing S) - letI : IsScalarTower k[X] (FractionRing k[X]) (FractionRing S) := + let : IsScalarTower k[X] (FractionRing k[X]) (FractionRing S) := FractionRing.isScalarTower_liftAlgebra k[X] (FractionRing S) - letI : Algebra.IsSeparable (FractionRing k[X]) (FractionRing S) := by + let : Algebra.IsSeparable (FractionRing k[X]) (FractionRing S) := by refine Algebra.IsSeparable.of_equiv_equiv (FractionRing.algEquiv k[X] k⟮X⟯).symm.toRingEquiv (FractionRing.algEquiv S K).symm.toRingEquiv ?_ @@ -146,8 +146,8 @@ theorem relNorm_asIdeal_finite exact IsFractionRing.algEquiv_commutes (FractionRing.algEquiv k[X] k⟮X⟯).symm (FractionRing.algEquiv S K).symm x - letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - letI : (v.asIdeal.under k[X]).IsMaximal := Ideal.IsMaximal.under k[X] v.asIdeal + let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + let : (v.asIdeal.under k[X]).IsMaximal := Ideal.IsMaximal.under k[X] v.asIdeal exact Ideal.relNorm_eq_pow_of_isMaximal_of_isSeparable v.asIdeal (v.asIdeal.under k[X]) @@ -160,13 +160,13 @@ theorem relNorm_asIdeal_infinite v.asIdeal.inertiaDeg (inftyValuationSubring k) := by let A := inftyValuationSubring k let S := infiniteIntegers k K - letI : Algebra A (FractionRing S) := inferInstance - letI : FaithfulSMul A (FractionRing S) := inferInstance - letI : Algebra (FractionRing A) (FractionRing S) := + let : Algebra A (FractionRing S) := inferInstance + let : FaithfulSMul A (FractionRing S) := inferInstance + let : Algebra (FractionRing A) (FractionRing S) := FractionRing.liftAlgebra A (FractionRing S) - letI : IsScalarTower A (FractionRing A) (FractionRing S) := + let : IsScalarTower A (FractionRing A) (FractionRing S) := FractionRing.isScalarTower_liftAlgebra A (FractionRing S) - letI : Algebra.IsSeparable (FractionRing A) (FractionRing S) := by + let : Algebra.IsSeparable (FractionRing A) (FractionRing S) := by refine Algebra.IsSeparable.of_equiv_equiv (FractionRing.algEquiv A k⟮X⟯).symm.toRingEquiv (FractionRing.algEquiv S K).symm.toRingEquiv ?_ @@ -174,8 +174,8 @@ theorem relNorm_asIdeal_infinite exact IsFractionRing.algEquiv_commutes (FractionRing.algEquiv A k⟮X⟯).symm (FractionRing.algEquiv S K).symm x - letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - letI : (v.asIdeal.under A).IsMaximal := Ideal.IsMaximal.under A v.asIdeal + let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + let : (v.asIdeal.under A).IsMaximal := Ideal.IsMaximal.under A v.asIdeal exact Ideal.relNorm_eq_pow_of_isMaximal_of_isSeparable v.asIdeal (v.asIdeal.under A) @@ -186,13 +186,13 @@ theorem finite_factorDegree_eq_relNorm (I : Ideal (ringOfIntegers k K)) (hI : I ((UniqueFactorizationMonoid.normalizedFactors (Ideal.relNorm k[X] I)).map fun p => Module.finrank k (k[X] ⧸ p)).sum := by let S := ringOfIntegers k K - letI : Algebra k[X] (FractionRing S) := inferInstance - letI : FaithfulSMul k[X] (FractionRing S) := inferInstance - letI : Algebra (FractionRing k[X]) (FractionRing S) := + let : Algebra k[X] (FractionRing S) := inferInstance + let : FaithfulSMul k[X] (FractionRing S) := inferInstance + let : Algebra (FractionRing k[X]) (FractionRing S) := FractionRing.liftAlgebra k[X] (FractionRing S) - letI : IsScalarTower k[X] (FractionRing k[X]) (FractionRing S) := + let : IsScalarTower k[X] (FractionRing k[X]) (FractionRing S) := FractionRing.isScalarTower_liftAlgebra k[X] (FractionRing S) - letI : Algebra.IsSeparable (FractionRing k[X]) (FractionRing S) := by + let : Algebra.IsSeparable (FractionRing k[X]) (FractionRing S) := by refine Algebra.IsSeparable.of_equiv_equiv (FractionRing.algEquiv k[X] k⟮X⟯).symm.toRingEquiv (FractionRing.algEquiv S K).symm.toRingEquiv ?_ @@ -215,13 +215,13 @@ theorem infinite_factorDegree_eq_relNorm (Ideal.relNorm (inftyValuationSubring k) I)).map fun _ => 1).sum := by let A := inftyValuationSubring k let S := infiniteIntegers k K - letI : Algebra A (FractionRing S) := inferInstance - letI : FaithfulSMul A (FractionRing S) := inferInstance - letI : Algebra (FractionRing A) (FractionRing S) := + let : Algebra A (FractionRing S) := inferInstance + let : FaithfulSMul A (FractionRing S) := inferInstance + let : Algebra (FractionRing A) (FractionRing S) := FractionRing.liftAlgebra A (FractionRing S) - letI : IsScalarTower A (FractionRing A) (FractionRing S) := + let : IsScalarTower A (FractionRing A) (FractionRing S) := FractionRing.isScalarTower_liftAlgebra A (FractionRing S) - letI : Algebra.IsSeparable (FractionRing A) (FractionRing S) := by + let : Algebra.IsSeparable (FractionRing A) (FractionRing S) := by refine Algebra.IsSeparable.of_equiv_equiv (FractionRing.algEquiv A k⟮X⟯).symm.toRingEquiv (FractionRing.algEquiv S K).symm.toRingEquiv ?_ diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean index 6ca4fe544a..5c4eeefb39 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/AdeleQuotient.lean @@ -79,8 +79,8 @@ theorem mem_adeleFilt_divisorOfAdele (α : AdeleSpace k K) : WithZero.exp (if 1 < placeValuation k K v (α.val v) then WithZero.log (placeValuation k K v (α.val v)) else 0) by_cases hlt : 1 < placeValuation k K v (α.val v) - · rw [if_pos hlt, WithZero.exp_log (ne_of_gt (zero_lt_one.trans hlt))] - · simpa only [if_neg hlt, WithZero.exp_zero] using le_of_not_gt hlt + · rw [ite_eq_left hlt, WithZero.exp_log (ne_of_gt (zero_lt_one.trans hlt))] + · simpa only [ite_eq_right hlt, WithZero.exp_zero] using le_of_not_gt hlt omit [IsFullConstantField k K] in theorem exists_adeleFilt_mem (α : AdeleSpace k K) : @@ -134,8 +134,8 @@ theorem finrankAdeleQuotient_eq_sandwichRank {D D' : DivisorA k K} (hle : D ≤ classical let ssum := adeleFilt k K D + diagonalSubmodule k K let topMod := topAdeleSubmodule k K - letI : AddCommGroup ↥topMod := Submodule.addCommGroup _ - letI : Module k ↥topMod := Submodule.module _ + let : AddCommGroup ↥topMod := Submodule.addCommGroup _ + let : Module k ↥topMod := Submodule.module _ let p := Submodule.comap topMod.subtype ssum let e : ↥topMod ≃ₗ[k] AdeleSpace k K := Submodule.topEquiv (R := k) (M := AdeleSpace k K) diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean index 79d59ff9a7..d68b6cdf48 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean @@ -58,7 +58,7 @@ theorem linearIndependent_fin_pow_of_transcendental {x : L} (hx : Transcendental classical dsimp only [p] rw [finsetSum_coeff, Finset.sum_eq_single j] - · rw [coeff_C_mul_X_pow, if_pos rfl] + · rw [coeff_C_mul_X_pow, ite_eq_left rfl] · intro b _ ne rw [coeff_C_mul_X_pow] split_ifs with h @@ -117,7 +117,7 @@ theorem polarDivisor_eq_zero_of_algebraic {x : K} (hx : IsAlgebraic k x) : rw [hmap, principalDivisorA_algebraMap k K (Units.mk0 c hc0)] ext v unfold polarDivisor - simp only [dif_neg hx0, hdiv, neg_zero, Finsupp.sup_apply, max_self] + simp only [dite_eq_right hx0, hdiv, neg_zero, Finsupp.sup_apply, max_self] omit [IsFullConstantField k K] in theorem exists_placeValuation_gt_one_of_not_algebraic {x : K} (_hx : x ≠ 0) @@ -157,9 +157,9 @@ theorem polarDivisor_pos {x : K} (hx : x ≠ 0) (hnt : ¬IsAlgebraic k x) : intro w by_cases hw : w = v · subst hw - simp only [Finsupp.single_apply, if_pos] + simp only [Finsupp.single_apply, ite_eq_left] exact le_rfl - · rw [Finsupp.single_apply, if_neg (Ne.symm hw)] + · rw [Finsupp.single_apply, ite_eq_right (Ne.symm hw)] exact polarDivisor_nonneg k K x w have hle : (placeDegree k K v : ℤ) * (polarDivisor k K x v) ≤ deg k K (polarDivisor k K x) := by @@ -236,7 +236,7 @@ omit [Algebra k K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] theorem nsmul_le_nsmul_polar {D : DivisorA k K} (hD : 0 ≤ D) {j r : ℕ} (hjr : j ≤ r) : j • D ≤ r • D := by intro v - show (j : ℤ) * D v ≤ (r : ℤ) * D v + change (j : ℤ) * D v ≤ (r : ℤ) * D v exact mul_le_mul_of_nonneg_right (Nat.cast_le.mpr hjr) (hD v) /-- A uniform pole bound for a finite family of functions. -/ @@ -523,7 +523,7 @@ theorem finrank_eq_finrank_rationalSubfield_XK : (RatFunc.algEquivOfTranscendental (XK k K) (transcendental_XK k K)).toRingEquiv (RingEquiv.refl K) ?_ ext c - show algebraMap (IntermediateField.adjoin k {XK k K}) K + change algebraMap (IntermediateField.adjoin k {XK k K}) K (RatFunc.algEquivOfTranscendental (XK k K) (transcendental_XK k K) c) = algebraMap k⟮X⟯ K c rw [IntermediateField.algebraMap_apply] @@ -585,7 +585,7 @@ theorem finiteDimensional_rationalSubfield {x : K} (hx : Transcendental k x) : set F := rationalSubfield k K x with hF set t := XK k K with ht have htF : IsIntegral F t := (isAlgebraic_rationalSubfield_XK k K hx).isIntegral - haveI hFN : FiniteDimensional F (IntermediateField.adjoin F {t}) := + have hFN : FiniteDimensional F (IntermediateField.adjoin F {t}) := IntermediateField.adjoin.finiteDimensional htF set N := IntermediateField.adjoin F {t} with hN -- every polynomial evaluation at t lies in N @@ -646,12 +646,12 @@ theorem finiteDimensional_rationalSubfield {x : K} (hx : Transcendental k x) : have := IntermediateField.algebraMap_mem (IntermediateField.adjoin N (Set.range ⇑b)) (⟨algebraMap k⟮X⟯ K (b.repr z i), hmem⟩ : N) rwa [IntermediateField.algebraMap_apply] at this - haveI hfin : Finite (Set.range ⇑b) := (Set.finite_range ⇑b).to_subtype - haveI hNtop : FiniteDimensional N (IntermediateField.adjoin N (Set.range ⇑b)) := + have hfin : Finite (Set.range ⇑b) := (Set.finite_range ⇑b).to_subtype + have hNtop : FiniteDimensional N (IntermediateField.adjoin N (Set.range ⇑b)) := IntermediateField.finiteDimensional_adjoin fun z hz => by obtain ⟨i, rfl⟩ := hz exact hbN i - haveI hNK : FiniteDimensional N K := by + have hNK : FiniteDimensional N K := by rw [htop] at hNtop exact (IntermediateField.topEquiv (F := N) (E := K)).toLinearEquiv.finiteDimensional exact Module.Finite.trans N K @@ -664,7 +664,7 @@ theorem finrankAdjoin_le_deg_polar {x : K} (hx : ¬IsAlgebraic k x) : by_cases hx0 : x = 0 · subst hx0 exact absurd isAlgebraic_zero hx - haveI := finiteDimensional_rationalSubfield (k := k) (K := K) hxT + have := finiteDimensional_rationalSubfield (k := k) (K := K) hxT let F := rationalSubfield k K x let n := Module.finrank F K let b := Module.finBasis F K diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean index ac85c540d5..897a1d7750 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean @@ -156,7 +156,7 @@ theorem polarDivisor_XK_zero_at_finite simpa [ha] using principalDivisorA_nonneg_at_finite_of_mem_ringOfIntegers (k := k) (K := K) ha0 w unfold polarDivisor - simp only [dif_neg hx0, Finsupp.sup_apply] + simp only [dite_eq_right hx0, Finsupp.sup_apply] exact max_eq_right (neg_nonpos.mpr hprincipal) omit [Algebra k K] [Algebra k[X] K] [IsScalarTower k k[X] K] [IsScalarTower k[X] k⟮X⟯ K] @@ -277,7 +277,7 @@ theorem polarDivisor_XK_at_infinite (ramIdxInfty k K v.asIdeal : ℤ) := by simpa using congrArg Neg.neg hprincipal unfold polarDivisor - simp only [dif_neg hx0, Finsupp.sup_apply, hneg] + simp only [dite_eq_right hx0, Finsupp.sup_apply, hneg] exact max_eq_left (le_of_lt hpos) /-- The height-one ideal above `∞` corresponding to an infinite place. -/ @@ -353,11 +353,11 @@ theorem deg_polarDivisor_XK_eq_primesOverFinset_sum : · simp at hv · have hpw : v.asIdeal.under A = p := IsLocalRing.eq_maximalIdeal (Ideal.IsMaximal.under A v.asIdeal) - letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - letI : p.IsMaximal := by + let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + let : p.IsMaximal := by rw [← hpw] exact Ideal.IsMaximal.under A v.asIdeal - letI : v.asIdeal.LiesOver p := ⟨hpw.symm⟩ + let : v.asIdeal.LiesOver p := ⟨hpw.symm⟩ have hinertia : Ideal.inertiaDeg' p v.asIdeal = v.asIdeal.inertiaDeg A := Ideal.inertiaDeg'_eq_inertiaDeg (p := p) (P := v.asIdeal) @@ -375,7 +375,7 @@ theorem deg_polarX_le_finrank : have hp : p ≠ ⊥ := Ring.ne_bot_of_isMaximal_of_not_isField (IsLocalRing.maximalIdeal.isMaximal A) (IsDiscreteValuationRing.not_isField A) - letI : p.IsMaximal := IsLocalRing.maximalIdeal.isMaximal A + let : p.IsMaximal := IsLocalRing.maximalIdeal.isMaximal A have hsum := Ideal.sum_ramification_inertia (R := A) (S := S) (K := k⟮X⟯) (L := K) hp have heq : (∑ P ∈ IsDedekindDomain.primesOverFinset p S, diff --git a/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean b/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean index 39f44ec086..40e3ea535a 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/LinearKneser.lean @@ -155,15 +155,15 @@ theorem normalized_mul_finrank (A B : Submodule k K) have hAdim : 1 < Module.finrank k A := hn.symm ▸ hngt obtain ⟨A', B', hA'1, hB'1, hA'lt, hA'fg, hB'fg, hdim, hprod⟩ := dyson_step k K A B hA1 hB1 hAdim - letI : FiniteDimensional k A' := Module.Finite.of_fg hA'fg - letI : FiniteDimensional k B' := Module.Finite.of_fg hB'fg + let : FiniteDimensional k A' := Module.Finite.of_fg hA'fg + let : FiniteDimensional k B' := Module.Finite.of_fg hB'fg have hsmall : Module.finrank k A' < n := by rw [← hn] exact Submodule.finrank_lt_finrank_of_lt hA'lt have hih := ih (Module.finrank k A') hsmall A' B' hA'1 hB'1 rfl have hAfg : A.FG := (Submodule.fg_top A).mp Module.Finite.fg_top have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top - letI : FiniteDimensional k (A * B) := Module.Finite.of_fg (hAfg.mul hBfg) + let : FiniteDimensional k (A * B) := Module.Finite.of_fg (hAfg.mul hBfg) have hmono : Module.finrank k (A' * B') ≤ Module.finrank k (A * B) := Submodule.finrank_mono hprod omega @@ -200,8 +200,8 @@ theorem mul_finrank (A B : Submodule k K) have hBfin : B'.FG := by have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top exact hBfg.map (εb : K →ₗ[k] K) - letI : FiniteDimensional k A' := Module.Finite.of_fg hAfin - letI : FiniteDimensional k B' := Module.Finite.of_fg hBfin + let : FiniteDimensional k A' := Module.Finite.of_fg hAfin + let : FiniteDimensional k B' := Module.Finite.of_fg hBfin have hnorm := normalized_mul_finrank k K A' B' hA'1 hB'1 have hprod : A' * B' ≤ Submodule.comap (εab : K →ₗ[k] K) (A * B) := by apply Submodule.mul_le.mpr @@ -216,7 +216,7 @@ theorem mul_finrank (A B : Submodule k K) (Submodule.map_le_iff_le_comap).mpr hprod have hAfg : A.FG := (Submodule.fg_top A).mp Module.Finite.fg_top have hBfg : B.FG := (Submodule.fg_top B).mp Module.Finite.fg_top - letI : FiniteDimensional k (A * B) := Module.Finite.of_fg (hAfg.mul hBfg) + let : FiniteDimensional k (A * B) := Module.Finite.of_fg (hAfg.mul hBfg) have hmono : Module.finrank k (A' * B') ≤ Module.finrank k (A * B) := by rw [← LinearEquiv.finrank_map_eq εab (A' * B')] exact Submodule.finrank_mono hmap diff --git a/LeanPool/MarkoffModP/RiemannRoch/Place.lean b/LeanPool/MarkoffModP/RiemannRoch/Place.lean index 29c6608e2d..18e40cad1d 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Place.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Place.lean @@ -120,7 +120,7 @@ theorem exists_sub_C_intDegree_neg (z : k⟮X⟯) (hzdeg : z.intDegree ≤ 0) : dsimp only [c] field_simp have hpdeg : p.degree < z.num.degree := by - simpa only [p] using Polynomial.degree_sub_lt hdegree hnum0 hlc + simpa only [p] using Polynomial.degree_sub_lt_left hdegree hnum0 hlc have hpnat : p.natDegree < z.denom.natDegree := by rw [Polynomial.natDegree_lt_iff_degree_lt hp] rw [← hnumdeg] @@ -425,7 +425,7 @@ namespace ringOfIntegers instance isTorsionFreeOverPolynomial : Module.IsTorsionFree k[X] (ringOfIntegers k K) := by - letI : FaithfulSMul k[X] K := + let : FaithfulSMul k[X] K := (faithfulSMul_iff_algebraMap_injective k[X] K).2 (FunctionField.algebraMap_injective k K) exact IsIntegralClosure.isTorsionFree k[X] K @@ -464,7 +464,7 @@ field. -/ instance finiteDimensionalResidueFieldFinite (v : IsDedekindDomain.HeightOneSpectrum (ringOfIntegers k K)) : FiniteDimensional k (ringOfIntegers k K ⧸ v.asIdeal) := by - letI : Field (ringOfIntegers k K ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + let : Field (ringOfIntegers k K ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal exact finite_of_finite_type_of_isJacobsonRing k _ /-- The residue field at an infinite coordinate place is finite-dimensional over the constant @@ -475,19 +475,19 @@ instance finiteDimensionalResidueFieldInfinite let A := inftyValuationSubring k let S := infiniteIntegers k K let p : Ideal A := v.asIdeal.under A - letI : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - letI : p.IsMaximal := Ideal.IsMaximal.under A v.asIdeal - letI : v.asIdeal.LiesOver p := ⟨rfl⟩ - letI : Field (A ⧸ p) := Ideal.Quotient.field p - letI : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal - letI : Algebra (A ⧸ p) (S ⧸ v.asIdeal) := + let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot + let : p.IsMaximal := Ideal.IsMaximal.under A v.asIdeal + let : v.asIdeal.LiesOver p := ⟨rfl⟩ + let : Field (A ⧸ p) := Ideal.Quotient.field p + let : Field (S ⧸ v.asIdeal) := Ideal.Quotient.field v.asIdeal + let : Algebra (A ⧸ p) (S ⧸ v.asIdeal) := Ideal.Quotient.algebraQuotientOfLEComap (Ideal.over_def v.asIdeal p).ge have hp : p = IsLocalRing.maximalIdeal A := IsLocalRing.eq_maximalIdeal inferInstance - letI : FiniteDimensional k (A ⧸ p) := by + let : FiniteDimensional k (A ⧸ p) := by rw [hp] exact inftyValuationSubring.finiteDimensionalResidueField k - letI : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := inferInstance - letI : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := + let : FiniteDimensional (A ⧸ p) (S ⧸ v.asIdeal) := inferInstance + let : IsScalarTower k (A ⧸ p) (S ⧸ v.asIdeal) := IsScalarTower.of_algebraMap_eq fun _ => rfl exact FiniteDimensional.trans k (A ⧸ p) (S ⧸ v.asIdeal) @@ -518,7 +518,7 @@ theorem principalDivisorA_apply_finite (x : Additive Kˣ) (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x) (Sum.inl v) = _ rw [Finsupp.mapDomain_apply_of_injective Sum.inl_injective] - rw [Finsupp.mapDomain_notin_range] + rw [Finsupp.mapDomain_of_notMem_range] · simp · rintro ⟨w, h⟩ cases h @@ -536,7 +536,7 @@ theorem principalDivisorA_apply_infinite (x : Additive Kˣ) (FractionalIdeal.principalDivisor (R := infiniteIntegers k K) (K := K) x) (Sum.inr v) = _ rw [Finsupp.mapDomain_apply_of_injective Sum.inr_injective] - rw [Finsupp.mapDomain_notin_range] + rw [Finsupp.mapDomain_of_notMem_range] · simp · rintro ⟨w, h⟩ cases h @@ -580,10 +580,10 @@ instance infiniteIntegers.isScalarTowerConstantsFractions : theorem placeValuation_algebraMap_le_one (v : PlaceA k K) (c : k) : placeValuation k K v (algebraMap k K c) ≤ 1 := by obtain w | w := v - · show w.valuation K (algebraMap k K c) ≤ 1 + · change w.valuation K (algebraMap k K c) ≤ 1 rw [IsScalarTower.algebraMap_apply k (ringOfIntegers k K) K] exact w.valuation_le_one _ - · show w.valuation K (algebraMap k K c) ≤ 1 + · change w.valuation K (algebraMap k K c) ≤ 1 rw [IsScalarTower.algebraMap_apply k (infiniteIntegers k K) K] exact w.valuation_le_one _ diff --git a/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean b/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean index 0b07b82481..a52ddbebb4 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/PlaceEquiv.lean @@ -66,7 +66,7 @@ noncomputable def Place.ofChart (w : PlaceA k K) : Place k K := by rw [Valuation.mem_valuationSubring_iff] exact placeValuation_algebraMap_le_one k K w c isDiscrete := ?_ } - letI : q.IsRankOneDiscrete := hqdisc + let : q.IsRankOneDiscrete := hqdisc let h := Valuation.isEquiv_valuation_valuationSubring q exact ⟨h.orderMonoidIso.symm.trans (Valuation.IsRankOneDiscrete.valueGroup₀_equiv_withZeroMulInt q)⟩ @@ -90,7 +90,7 @@ theorem Place.ofChart_valuation_eq (w : PlaceA k K) : let V := q.valuationSubring have hqdisc : q.IsRankOneDiscrete := by rcases w with w | w <;> dsimp [q, placeValuation] <;> infer_instance - letI : q.IsRankOneDiscrete := hqdisc + let : q.IsRankOneDiscrete := hqdisc let h := Valuation.isEquiv_valuation_valuationSubring q let e : ValueGroup₀ (.ofClass V.valuation) ≃*o ℤᵐ⁰ := h.orderMonoidIso.symm.trans @@ -228,7 +228,7 @@ theorem restrict_isNontrivial (v : Place k K) : (restrict k K v).IsNontrivial := by let q := restrict k K v by_contra hq - letI : v.valuation.IsTrivialOn k⟮X⟯ := + let : v.valuation.IsTrivialOn k⟮X⟯ := { eq_one := fun a ha => by change q a = 1 by_contra hne @@ -247,8 +247,8 @@ theorem restrict_classification (v : Place k K) : (∃! u : IsDedekindDomain.HeightOneSpectrum k[X], (restrict k K v).IsEquiv (u.valuation k⟮X⟯)) := by let q := restrict k K v - letI : q.IsNontrivial := restrict_isNontrivial k K v - letI : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q + let : q.IsNontrivial := restrict_isNontrivial k K v + let : q.IsRankOneDiscrete := Valuation.IsRankOneDiscrete.mk' q exact RatFunc.valuation_isEquiv_infty_or_adic (v := q) omit [IsScalarTower k k[X] K] [FunctionField k K] [Algebra.IsSeparable k⟮X⟯ K] in @@ -262,7 +262,7 @@ theorem finiteRing_le (v : Place k K) rw [← v.valuationSubring_valuation, Valuation.mem_valuationSubring_iff] rw [IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K] exact h.le_one_iff_le_one.mpr (u.valuation_le_one p) - letI : IsIntegrallyClosedIn v.toValuationSubring.toSubring K := + let : IsIntegrallyClosedIn v.toValuationSubring.toSubring K := Subring.isIntegrallyClosedIn_iff.mpr fun {_x} hx => LocalSubring.mem_of_isMax_of_isIntegral v.toValuationSubring.isMax_toLocalSubring hx @@ -313,7 +313,7 @@ theorem infiniteRing_le (v : Place k K) rw [← v.valuationSubring_valuation, Valuation.mem_valuationSubring_iff] rw [IsScalarTower.algebraMap_apply (inftyValuationSubring k) k⟮X⟯ K] exact h.le_one_iff_le_one.mpr a.property - letI : IsIntegrallyClosedIn v.toValuationSubring.toSubring K := + let : IsIntegrallyClosedIn v.toValuationSubring.toSubring K := Subring.isIntegrallyClosedIn_iff.mpr fun {_x} hx => LocalSubring.mem_of_isMax_of_isIntegral v.toValuationSubring.isMax_toLocalSubring hx @@ -362,7 +362,7 @@ theorem infinite_X_gt_one let u := IsDiscreteValuationRing.maximalIdeal A have hund : w.asIdeal.under A = u.asIdeal := by exact IsLocalRing.eq_maximalIdeal inferInstance - letI : w.asIdeal.LiesOver u.asIdeal := ⟨hund.symm⟩ + let : w.asIdeal.LiesOver u.asIdeal := ⟨hund.symm⟩ have hbase : (u.valuation k⟮X⟯).IsEquiv (RatFunc.inftyValuation k) := by rw [Valuation.isEquiv_iff_valuationSubring] apply ValuationSubring.toSubring_injective diff --git a/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean index 2e91ad4012..c4e55935b7 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/RRspace/Basic.lean @@ -51,7 +51,7 @@ local instance instDecidableEqRatFuncRRspace : DecidableEq k⟮X⟯ := Classical omit [Algebra k K] [IsScalarTower k k[X] K] in theorem nonempty_placeA : Nonempty (PlaceA k K) := by let P : Ideal k[X] := Ideal.span {Polynomial.X} - letI : P.IsMaximal := + let : P.IsMaximal := PrincipalIdealRing.isMaximal_of_irreducible Polynomial.irreducible_X obtain ⟨Q, hQprime, hQunder⟩ := P.exists_ideal_over_prime_of_isIntegral_of_isDomain @@ -95,7 +95,7 @@ theorem smul_mem (c : k) {f : K} (hf : memRRspace k K D f) : omit [Algebra k K] [IsScalarTower k k[X] K] in theorem one_mem : memRRspace k K 0 1 := fun v => by rw [Valuation.map_one (placeValuation k K v)] - show (1 : WithZero (Multiplicative ℤ)) ≤ WithZero.exp ((0 : DivisorA k K) v) + change (1 : WithZero (Multiplicative ℤ)) ≤ WithZero.exp ((0 : DivisorA k K) v) rw [Finsupp.zero_apply, ← WithZero.exp_zero] omit [Algebra k K] [IsScalarTower k k[X] K] in @@ -327,7 +327,7 @@ theorem finrankRRspaceDiff_single_finite_le (D : DivisorA k K) ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional have hker := finiteLocalResidueMap_ker k K D v rw [finrankRRspaceDiff, ← hker, f.quotKerEquivRange.finrank_eq] calc @@ -445,7 +445,7 @@ theorem finrankRRspaceDiff_single_infinite_le (D : DivisorA k K) ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional have hker := infiniteLocalResidueMap_ker k K D v rw [finrankRRspaceDiff, ← hker, f.quotKerEquivRange.finrank_eq] calc @@ -468,7 +468,7 @@ theorem finiteDimensional_add_single_one (D : DivisorA k K) (v : PlaceA k K) split <;> omega) let p := Submodule.comap (RRspace k K (D + Finsupp.single v 1)).subtype (RRspace k K D) - letI : Module.Finite k p := + let : Module.Finite k p := Module.Finite.equiv (Submodule.comapSubtypeEquivOfLe hle).symm rcases v with v | v · let f := finiteLocalResidueMap k K D v @@ -477,12 +477,12 @@ theorem finiteDimensional_add_single_one (D : DivisorA k K) (v : PlaceA k K) ((Algebra.linearMap (ringOfIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional - letI : Module.Finite k f.range := inferInstance - haveI hqker : Module.Finite k + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : Module.Finite k f.range := inferInstance + have hqker : Module.Finite k (RRspace k K (D + Finsupp.single (Sum.inl v) 1) ⧸ f.ker) := Module.Finite.equiv f.quotKerEquivRange.symm - haveI hqp : Module.Finite k + have hqp : Module.Finite k (RRspace k K (D + Finsupp.single (Sum.inl v) 1) ⧸ p) := by exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p (finiteLocalResidueMap_ker k K D v)) @@ -493,12 +493,12 @@ theorem finiteDimensional_add_single_one (D : DivisorA k K) (v : PlaceA k K) ((Algebra.linearMap (infiniteIntegers k K ⧸ v.asIdeal) v.asIdeal.ResidueField).restrictScalars k) (Ideal.bijective_algebraMap_quotient_residueField v.asIdeal) - letI : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional - letI : Module.Finite k f.range := inferInstance - haveI hqker : Module.Finite k + let : FiniteDimensional k v.asIdeal.ResidueField := e.finiteDimensional + let : Module.Finite k f.range := inferInstance + have hqker : Module.Finite k (RRspace k K (D + Finsupp.single (Sum.inr v) 1) ⧸ f.ker) := Module.Finite.equiv f.quotKerEquivRange.symm - haveI hqp : Module.Finite k + have hqp : Module.Finite k (RRspace k K (D + Finsupp.single (Sum.inr v) 1) ⧸ p) := by exact Module.Finite.equiv (Submodule.quotEquivOfEq f.ker p (infiniteLocalResidueMap_ker k K D v)) @@ -513,7 +513,7 @@ theorem finiteDimensional_add_single_nat (D : DivisorA k K) (v : PlaceA k K) rw [heq] infer_instance | succ n ih => - letI : FiniteDimensional k + let : FiniteDimensional k (RRspace k K (D + Finsupp.single v (n : ℤ))) := ih have hfin := finiteDimensional_add_single_one k K (D + Finsupp.single v (n : ℤ)) v @@ -530,8 +530,8 @@ theorem finrankRRspaceDiff_add_finrank_of_finite {D D' : DivisorA k K} (h : D ≤ D') [FiniteDimensional k (RRspace k K D')] : finrankRRspaceDiff k K D D' + Module.finrank k (RRspace k K D) = Module.finrank k (RRspace k K D') := by - letI : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ - letI : Module k (RRspace k K D') := Submodule.module _ + let : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ + let : Module k (RRspace k K D') := Submodule.module _ rw [finrankRRspaceDiff, ← (Submodule.comapSubtypeEquivOfLe (RRspace_mono k K h)).finrank_eq] exact Submodule.finrank_quotient_add_finrank _ @@ -561,9 +561,9 @@ theorem finrankRRspaceDiff_single_nat_le (D : DivisorA k K) (v : PlaceA k K) | succ n ih => let M := D + Finsupp.single v (n : ℤ) let N := M + Finsupp.single v 1 - letI : FiniteDimensional k (RRspace k K M) := + let : FiniteDimensional k (RRspace k K M) := finiteDimensional_add_single_nat k K D v n - letI : FiniteDimensional k (RRspace k K N) := + let : FiniteDimensional k (RRspace k K N) := finiteDimensional_add_single_one k K M v have hDM : D ≤ M := by intro w @@ -618,7 +618,7 @@ theorem finiteDimensional_add_effective (D E : DivisorA k K) have hb0 : 0 ≤ b := by have haE := hE a simpa [Finsupp.single_apply, hfa] using haE - letI : FiniteDimensional k (RRspace k K (D + f)) := ih D hff + let : FiniteDimensional k (RRspace k K (D + f)) := ih D hff have hsingle := finiteDimensional_add_single_nat k K (D + f) a b.toNat have hbcast : (b.toNat : ℤ) = b := Int.toNat_of_nonneg hb0 have heq : D + (Finsupp.single a b + f) = @@ -657,9 +657,9 @@ theorem finrankRRspaceDiff_add_effective_le (D E : DivisorA k K) simpa [Finsupp.single_apply, hfa] using haE let M := D + f let N := M + Finsupp.single a (b.toNat : ℤ) - letI : FiniteDimensional k (RRspace k K M) := + let : FiniteDimensional k (RRspace k K M) := finiteDimensional_add_effective k K D f hff - letI : FiniteDimensional k (RRspace k K N) := + let : FiniteDimensional k (RRspace k K N) := finiteDimensional_add_single_nat k K M a b.toNat have hDM : D ≤ M := by intro w @@ -737,7 +737,7 @@ theorem RRspace_neg_deg {D : DivisorA k K} (h : deg k K D < 0) : · exact bot_le theorem RRspace_neg_deg_ell {D : DivisorA k K} (h : deg k K D < 0) : ell k K D = 0 := by - show Module.finrank k (RRspace k K D) = 0 + change Module.finrank k (RRspace k K D) = 0 rw [RRspace_neg_deg k K h] exact finrank_bot k K @@ -775,7 +775,7 @@ theorem finiteDimensional_RRspace_aux (D : DivisorA k K) : rw [deg_sub, hdegSingle] omega have hbot := RRspace_neg_deg k K hD₀neg - letI : FiniteDimensional k (RRspace k K D₀) := by + let : FiniteDimensional k (RRspace k K D₀) := by rw [hbot] infer_instance have hfin := finiteDimensional_add_single_nat k K D₀ v n @@ -788,7 +788,7 @@ theorem finiteDimensional_RRspace_aux (D : DivisorA k K) : /-- The local residue-field estimate for an increment of Riemann–Roch spaces. -/ theorem finrank_RRspace_quotient_le {D D' : DivisorA k K} (h : D ≤ D') : finrankRRspaceDiff k K D D' ≤ (deg k K (D' - D)).toNat := by - letI : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D + let : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp h have hrank := finrankRRspaceDiff_add_effective_le k K D (D' - D) hE have heq : D + (D' - D) = D' := by abel @@ -895,8 +895,8 @@ instance finiteDimensional_RRspace (D : DivisorA k K) : /-- Rank-nullity for an inclusion of Riemann–Roch spaces. -/ theorem finrankRRspaceDiff_add_ell {D D' : DivisorA k K} (h : D ≤ D') : finrankRRspaceDiff k K D D' + ell k K D = ell k K D' := by - letI : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ - letI : Module k (RRspace k K D') := Submodule.module _ + let : AddCommGroup (RRspace k K D') := Submodule.addCommGroup _ + let : Module k (RRspace k K D') := Submodule.module _ rw [finrankRRspaceDiff, ell, ell, ← (Submodule.comapSubtypeEquivOfLe (RRspace_mono k K h)).finrank_eq] exact Submodule.finrank_quotient_add_finrank _ diff --git a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean index 287b43e504..7e5183c9e9 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/RiemannRochTheorem/Corollaries.lean @@ -86,7 +86,7 @@ theorem exists_effective_add_principal_of_ell_pos (D : DivisorA k K) (hD : 0 < ell k K D) : ∃ x : Kˣ, IsEffective k K (D + principalDivisorA k K (Additive.ofMul x)) := by - letI : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D + let : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D obtain ⟨f, hf⟩ := (Module.finrank_pos_iff_exists_ne_zero (R := k) (M := RRspace k K D)).mp hD have hfval : (f : K) ≠ 0 := by @@ -133,8 +133,8 @@ omit [IsFullConstantField k K] in /-- Riemann–Roch dimension is submodular on the divisor lattice. -/ theorem ell_submodular (D E : DivisorA k K) : ell k K D + ell k K E ≤ ell k K (D ⊔ E) + ell k K (D ⊓ E) := by - letI : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D - letI : FiniteDimensional k (RRspace k K E) := finiteDimensional_RRspace_aux k K E + let : FiniteDimensional k (RRspace k K D) := finiteDimensional_RRspace_aux k K D + let : FiniteDimensional k (RRspace k K E) := finiteDimensional_RRspace_aux k K E have hsup : Module.finrank k ↑(RRspace k K D ⊔ RRspace k K E) ≤ Module.finrank k (RRspace k K (D ⊔ E)) := Submodule.finrank_mono (RRspace_sup_le k K D E) @@ -171,7 +171,7 @@ theorem exists_minimal_RRspace (A : DivisorA k K) (hA : 0 < ell k K A) : rw [lt_iff_le_and_ne] refine ⟨hell_le, ?_⟩ intro hell_eq - haveI : FiniteDimensional k (RRspace k K D₀) := finiteDimensional_RRspace_aux k K D₀ + have : FiniteDimensional k (RRspace k K D₀) := finiteDimensional_RRspace_aux k K D₀ have hspace_sub : RRspace k K (D₀ - Finsupp.single v 1) = RRspace k K D₀ := Submodule.eq_of_le_of_finrank_eq (RRspace_mono k K hle) hell_eq have hdegsub_nonneg : 0 ≤ deg k K (D₀ - Finsupp.single v 1) := by @@ -386,8 +386,8 @@ theorem ell_add_ell_le_of_effective_minimal [Infinite k] have hfinP : Module.finrank k P = ell k K D₀ := by rw [← Submodule.finrank_map_subtype_eq T P, hmapP] rfl - letI : FiniteDimensional k (RRspace k K B) := finiteDimensional_RRspace_aux k K B - letI : FiniteDimensional k T := finiteDimensional_RRspace_aux k K (D₀ + B) + let : FiniteDimensional k (RRspace k K B) := finiteDimensional_RRspace_aux k K B + let : FiniteDimensional k T := finiteDimensional_RRspace_aux k K (D₀ + B) have hranknull := φ.finrank_range_add_finrank_ker have hrange : Module.finrank k φ.range ≤ Module.finrank k (T ⧸ P) := by simpa only [finrank_top] using @@ -446,8 +446,8 @@ Riemann–Roch-space specialization of `mul_finrank`. -/ theorem ell_add_ell_le (A B : DivisorA k K) (hA : 0 < ell k K A) (hB : 0 < ell k K B) : ell k K A + ell k K B ≤ 1 + ell k K (A + B) := by - letI : FiniteDimensional k (RRspace k K A) := finiteDimensional_RRspace_aux k K A - letI : FiniteDimensional k (RRspace k K B) := finiteDimensional_RRspace_aux k K B + let : FiniteDimensional k (RRspace k K A) := finiteDimensional_RRspace_aux k K A + let : FiniteDimensional k (RRspace k K B) := finiteDimensional_RRspace_aux k K B have hAne : RRspace k K A ≠ ⊥ := by intro hzero dsimp only [ell] at hA @@ -462,7 +462,7 @@ theorem ell_add_ell_le (A B : DivisorA k K) (hA : 0 < ell k K A) (Submodule.fg_top (RRspace k K A)).mp Module.Finite.fg_top have hBfg : (RRspace k K B).FG := (Submodule.fg_top (RRspace k K B)).mp Module.Finite.fg_top - letI : FiniteDimensional k (RRspace k K A * RRspace k K B) := + let : FiniteDimensional k (RRspace k K A * RRspace k K B) := Module.Finite.of_fg (hAfg.mul hBfg) have hproduct := mul_finrank k K (RRspace k K A) (RRspace k K B) hAne hBne have hmul : RRspace k K A * RRspace k K B ≤ RRspace k K (A + B) := by diff --git a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean index beed2d243d..9aabd67be3 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/SeparableRelNorm.lean @@ -41,71 +41,71 @@ theorem relNorm_eq_pow_of_isMaximal_of_isSeparable relNorm R P = p ^ P.inertiaDeg R := by let K := FractionRing R let L := FractionRing S - letI : Algebra K L := FractionRing.liftAlgebra R L + let : Algebra K L := FractionRing.liftAlgebra R L let E := IntermediateField.normalClosure K L (AlgebraicClosure L) - letI : Algebra S E := ((algebraMap L E).comp (algebraMap S L)).toAlgebra - letI : IsScalarTower S L E := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra S E := ((algebraMap L E).comp (algebraMap S L)).toAlgebra + let : IsScalarTower S L E := IsScalarTower.of_algebraMap_eq' rfl let T : Type _ := integralClosure S E - letI : Algebra S T := inferInstance - letI : Algebra T E := inferInstance - letI : IsScalarTower S T E := inferInstance - letI : Algebra R T := ((algebraMap S T).comp (algebraMap R S)).toAlgebra - letI : IsScalarTower R S T := IsScalarTower.of_algebraMap_eq' rfl - letI : Algebra R E := ((algebraMap S E).comp (algebraMap R S)).toAlgebra - letI : IsScalarTower R S E := IsScalarTower.of_algebraMap_eq' rfl - letI : IsScalarTower R T E := IsScalarTower.to₁₃₄ R S T E - letI : FaithfulSMul R E := (faithfulSMul_iff_algebraMap_injective R E).2 <| by + let : Algebra S T := inferInstance + let : Algebra T E := inferInstance + let : IsScalarTower S T E := inferInstance + let : Algebra R T := ((algebraMap S T).comp (algebraMap R S)).toAlgebra + let : IsScalarTower R S T := IsScalarTower.of_algebraMap_eq' rfl + let : Algebra R E := ((algebraMap S E).comp (algebraMap R S)).toAlgebra + let : IsScalarTower R S E := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower R T E := IsScalarTower.to₁₃₄ R S T E + let : FaithfulSMul R E := (faithfulSMul_iff_algebraMap_injective R E).2 <| by rw [IsScalarTower.algebraMap_eq R S E] exact (algebraMap L E).injective.comp (IsFractionRing.injective S L) |>.comp (FaithfulSMul.algebraMap_injective R S) - letI : IsScalarTower R S L := inferInstance - letI : FaithfulSMul R L := inferInstance - letI : IsScalarTower R L E := IsScalarTower.to₁₃₄ R S L E - letI : IsScalarTower R K L := FractionRing.isScalarTower_liftAlgebra R L - letI : IsScalarTower R K E := IsScalarTower.to₁₂₄ R K L E - letI : IsIntegralClosure T S E := integralClosure.isIntegralClosure S E - letI : FaithfulSMul S T := (faithfulSMul_iff_algebraMap_injective S T).2 <| by + let : IsScalarTower R S L := inferInstance + let : FaithfulSMul R L := inferInstance + let : IsScalarTower R L E := IsScalarTower.to₁₃₄ R S L E + let : IsScalarTower R K L := FractionRing.isScalarTower_liftAlgebra R L + let : IsScalarTower R K E := IsScalarTower.to₁₂₄ R K L E + let : IsIntegralClosure T S E := integralClosure.isIntegralClosure S E + let : FaithfulSMul S T := (faithfulSMul_iff_algebraMap_injective S T).2 <| by intro x y hxy apply (algebraMap L E).injective.comp (IsFractionRing.injective S L) exact congrArg (fun z : T => (algebraMap T E) z) hxy - letI : FaithfulSMul R T := (faithfulSMul_iff_algebraMap_injective R T).2 <| by + let : FaithfulSMul R T := (faithfulSMul_iff_algebraMap_injective R T).2 <| by rw [IsScalarTower.algebraMap_eq R S T] exact (FaithfulSMul.algebraMap_injective S T).comp (FaithfulSMul.algebraMap_injective R S) - letI : FiniteDimensional K E := + let : FiniteDimensional K E := normalClosure.is_finiteDimensional K L (AlgebraicClosure L) - letI : Algebra.IsSeparable K E := by + let : Algebra.IsSeparable K E := by rw [← le_separableClosure_iff] apply normalClosure_le_iff.mpr intro i - haveI : Algebra.IsSeparable K i.fieldRange := + have : Algebra.IsSeparable K i.fieldRange := AlgEquiv.Algebra.isSeparable (AlgEquiv.ofInjectiveField i) exact le_separableClosure K (AlgebraicClosure L) i.fieldRange - letI : Algebra.IsSeparable L E := + let : Algebra.IsSeparable L E := Algebra.isSeparable_tower_top_of_isSeparable K L E - letI : FiniteDimensional L E := Module.Finite.right K L E - letI : IsFractionRing T E := + let : FiniteDimensional L E := Module.Finite.right K L E + let : IsFractionRing T E := IsIntegralClosure.isFractionRing_of_finite_extension S L E T - letI : Module.Finite S T := IsIntegralClosure.finite S L E T - letI : Module.Finite R T := Module.Finite.trans S T - letI : IsDedekindDomain T := integralClosure.isDedekindDomain S L E + let : Module.Finite S T := IsIntegralClosure.finite S L E T + let : Module.Finite R T := Module.Finite.trans S T + let : IsDedekindDomain T := integralClosure.isDedekindDomain S L E have : IsTorsionFree S T := FaithfulSMul.to_isTorsionFree S T - letI : IsGalois K E := { + let : IsGalois K E := { to_isSeparable := inferInstance to_normal := normalClosure.normal K L (AlgebraicClosure L) } let algT : Algebra T (FractionRing T) := inferInstance - letI : Algebra T (FractionRing T) := algT - letI : Algebra R (FractionRing T) := inferInstance - letI : Algebra S (FractionRing T) := inferInstance - letI : FaithfulSMul R (FractionRing T) := inferInstance - letI : FaithfulSMul S (FractionRing T) := inferInstance - letI : Algebra K (FractionRing T) := FractionRing.liftAlgebra R (FractionRing T) - letI : Algebra L (FractionRing T) := FractionRing.liftAlgebra S (FractionRing T) - letI : IsScalarTower R K (FractionRing T) := + let : Algebra T (FractionRing T) := algT + let : Algebra R (FractionRing T) := inferInstance + let : Algebra S (FractionRing T) := inferInstance + let : FaithfulSMul R (FractionRing T) := inferInstance + let : FaithfulSMul S (FractionRing T) := inferInstance + let : Algebra K (FractionRing T) := FractionRing.liftAlgebra R (FractionRing T) + let : Algebra L (FractionRing T) := FractionRing.liftAlgebra S (FractionRing T) + let : IsScalarTower R K (FractionRing T) := FractionRing.isScalarTower_liftAlgebra R (FractionRing T) - letI : IsScalarTower S L (FractionRing T) := + let : IsScalarTower S L (FractionRing T) := FractionRing.isScalarTower_liftAlgebra S (FractionRing T) - letI : IsGalois K (FractionRing T) := by + let : IsGalois K (FractionRing T) := by refine IsGalois.of_equiv_equiv (F := K) (E := E) (f := (FractionRing.algEquiv R K).symm.toRingEquiv) (g := (FractionRing.algEquiv T E).symm.toRingEquiv) ?_ @@ -114,11 +114,11 @@ theorem relNorm_eq_pow_of_isMaximal_of_isSeparable (FractionRing.algEquiv T E).symm _ obtain ⟨Q, hQ₁, hQ₂⟩ : ∃ Q : Ideal T, Q.IsMaximal ∧ Q.LiesOver P := exists_maximal_ideal_liesOver_of_isIntegral P - letI : Q.IsMaximal := hQ₁ - letI : Q.LiesOver P := hQ₂ - letI : Q.LiesOver p := LiesOver.trans Q P p + let : Q.IsMaximal := hQ₁ + let : Q.LiesOver P := hQ₂ + let : Q.LiesOver p := LiesOver.trans Q P p have h := relNorm_eq_pow_of_isPrime_isGalois Q p - letI : IsGalois (FractionRing S) (FractionRing T) := + let : IsGalois (FractionRing S) (FractionRing T) := IsGalois.tower_top_of_isGalois (FractionRing R) (FractionRing S) (FractionRing T) rwa [← relNorm_relNorm R S, relNorm_eq_pow_of_isPrime_isGalois Q P, map_pow, inertiaDeg_tower (R := R) P Q, pow_mul, @@ -134,7 +134,7 @@ theorem sum_normalizedFactors_relNorm_of_isSeparable ((normalizedFactors I).map fun P => P.inertiaDeg R * w (P.under R)).sum := by classical - letI : Algebra (FractionRing R) (FractionRing S) := + let : Algebra (FractionRing R) (FractionRing S) := FractionRing.liftAlgebra R (FractionRing S) have aux : ∀ s : Multiset (Ideal S), (∀ P ∈ s, Prime P) → ((normalizedFactors (relNorm R s.prod)).map w).sum = @@ -151,12 +151,12 @@ theorem sum_normalizedFactors_relNorm_of_isSeparable have hs0 : s.prod ≠ ⊥ := Multiset.prod_ne_zero fun h => (hs' ⊥ h).ne_zero rfl let p : Ideal R := P.under R - letI : P.IsMaximal := (Ideal.isPrime_of_prime hP).isMaximal hP0 - letI : p.IsMaximal := Ideal.IsMaximal.under R P - letI : P.LiesOver p := ⟨rfl⟩ + let : P.IsMaximal := (Ideal.isPrime_of_prime hP).isMaximal hP0 + let : p.IsMaximal := Ideal.IsMaximal.under R P + let : P.LiesOver p := ⟨rfl⟩ have hp0 : p ≠ ⊥ := by intro hp - haveI : P.LiesOver (⊥ : Ideal R) := hp ▸ (inferInstance : P.LiesOver p) + have : P.LiesOver (⊥ : Ideal R) := hp ▸ (inferInstance : P.LiesOver p) exact hP0 (Ideal.eq_bot_of_liesOver_bot R P) have hnorm : relNorm R P = p ^ P.inertiaDeg R := relNorm_eq_pow_of_isMaximal_of_isSeparable P p diff --git a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean index 4245ccd5be..50c0e51cf0 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/WeilDifferential/Basic.lean @@ -64,7 +64,7 @@ theorem finite_adeleFilt_sub_quotient {D D' : DivisorA k K} (hle : D ≤ D') : (adeleFilt k K D + diagonalSubmodule k K)) := by have hE : IsEffective k K (D' - D) := (le_iff_sub_effective k K).mp hle have hdiv : D + (D' - D) = D' := by abel - haveI : Module.Finite k ((adeleFilt k K D') ⧸ + have : Module.Finite k ((adeleFilt k K D') ⧸ Submodule.comap (adeleFilt k K D').subtype (adeleFilt k K D)) := finiteAdeleFiltDiff_quotient_add_eq k K (M := D) hdiv.symm hE exact Module.Finite.equiv (Submodule.quotientQuotientEquivQuotient @@ -85,7 +85,7 @@ instance finiteDimensional_adeleQuotient (D : DivisorA k K) : adeleFilt k K (D ⊔ D₁) + diagonalSubmodule k K := adeleSubmodule_top_eq_adeleFilt_add_diagonal (k := k) (K := K) (defect_eq_genus_of_ge (k := k) (K := K) le_sup_right hD₁) - haveI := finite_adeleFilt_sub_quotient (k := k) (K := K) hle + have := finite_adeleFilt_sub_quotient (k := k) (K := K) hle have hker : Submodule.comap (adeleFilt k K (D ⊔ D₁)).subtype (adeleFilt k K D + diagonalSubmodule k K) ≤ LinearMap.ker (((adeleFilt k K D + diagonalSubmodule k K).mkQ).comp @@ -104,7 +104,7 @@ instance finiteDimensional_adeleQuotient (D : DivisorA k K) : rcases Submodule.mem_sup.mp hx with ⟨a, ha, b, hb, rfl⟩ refine ⟨Submodule.Quotient.mk ⟨a, ha⟩, ?_⟩ rw [Submodule.liftQ_apply] - show (adeleFilt k K D + diagonalSubmodule k K).mkQ a = + change (adeleFilt k K D + diagonalSubmodule k K).mkQ a = (adeleFilt k K D + diagonalSubmodule k K).mkQ (a + b) have hb0 : (adeleFilt k K D + diagonalSubmodule k K).mkQ b = 0 := by rw [Submodule.mkQ_apply] @@ -162,7 +162,7 @@ theorem finrank_differentialSpace (D : DivisorA k K) : theorem exists_nontrivial_omega : ∃ D : DivisorA k K, differentialSpace D ≠ ⊥ := by - letI : IsScalarTower k k⟮X⟯ K := + let : IsScalarTower k k⟮X⟯ K := IsScalarTower.of_algebraMap_eq fun c => by rw [IsScalarTower.algebraMap_apply k k[X] K, IsScalarTower.algebraMap_apply k[X] k⟮X⟯ K, @@ -343,7 +343,7 @@ theorem smulWeil_eq_zero_iff (x : K) (hx : x ≠ 0) (ω : WeilDifferential k K) _ = 0 := smul_zero x⁻¹ · intro hω subst hω - show x • (0 : WeilDifferential k K) = 0 + change x • (0 : WeilDifferential k K) = 0 exact smul_zero x omit [IsFullConstantField k K] in @@ -391,7 +391,7 @@ theorem smulWeil_toFun_mem_differentialSpace (ω : WeilDifferential k K) {D₀ : (h : D₀ ∈ vanishingDivisors ω) {E : DivisorA k K} (f : RRspace k K E) : (smulWeil (f : K) ω).toFun ∈ differentialSpace (k := k) (K := K) (D₀ - E) := by have hvan : ∀ α ∈ adeleFilt k K D₀ + diagonalSubmodule k K, ω.toFun α = 0 := h - show ∀ a ∈ adeleFilt k K (D₀ - E) + diagonalSubmodule k K, + change ∀ a ∈ adeleFilt k K (D₀ - E) + diagonalSubmodule k K, (smulWeil (f : K) ω).toFun a = 0 intro a ha rw [smulWeil_toFun_apply] @@ -835,7 +835,7 @@ theorem duality {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) : have hfr : Module.finrank k (RRspace k K (W - D)) = Module.finrank k (differentialSpace (k := k) (K := K) (W - (W - D))) := (LinearEquiv.ofBijective μ ⟨hμinj, hμsurj⟩).finrank_eq - show Module.finrank k (RRspace k K (W - D)) = indexOfSpecialty k K D + change Module.finrank k (RRspace k K (W - D)) = indexOfSpecialty k K D rw [hfr, hWD, finrank_differentialSpace] theorem indexOfSpecialty_eq_ell_sub {W : DivisorA k K} (hW : IsCanonical k K W) (D : DivisorA k K) : From 8d28b4e611e23ca4b828bfdf6d4588b10ad8b402 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:05:58 +0000 Subject: [PATCH 24/37] Declare downstream geometric and spectral imports explicitly --- .../BGS/External/GeneralCurveTheorems.lean | 1 + .../BGS/HasseWeil/FormalZetaTrace.lean | 17 ++++------------- .../Cage/ShiftedTraceCurveIrreducibility.lean | 1 + .../BGS/Markoff/Opening/FiniteOrbit.lean | 1 + .../Markoff/TraceCurve/BiprojectiveClosure.lean | 2 ++ .../TraceCurve/IrreducibilityObstructions.lean | 1 + 6 files changed, 10 insertions(+), 13 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean b/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean index 099518ec8a..cb26f1e9a6 100644 --- a/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean +++ b/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Algebra.MvPolynomial.PDeriv import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound import Mathlib.FieldTheory.IsAlgClosed.Basic import Mathlib.RingTheory.MvPolynomial.Basic diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean index 35a02cb04b..dc3f0f0a06 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -38,18 +38,9 @@ theorem linearPowerSeriesFactor_inv (a : ℂ) : theorem derivative_linearPowerSeriesFactor (a : ℂ) : PowerSeries.derivative (R := ℂ) (linearPowerSeriesFactor a) = -PowerSeries.C a := by - change PowerSeries.derivative (linearPowerSeriesFactor a) = -PowerSeries.C a - rw [linearPowerSeriesFactor, sub_eq_add_neg] - rw [show -(PowerSeries.C a * PowerSeries.X) = - (-1 : ℂ) • (PowerSeries.C a * PowerSeries.X) by simp] - rw [PowerSeries.derivativeFun_add, PowerSeries.derivativeFun_one, - PowerSeries.derivativeFun_smul, PowerSeries.derivativeFun_mul] - have hX : PowerSeries.derivative (PowerSeries.X : PowerSeries ℂ) = 1 := - PowerSeries.derivative_X - have hC : PowerSeries.derivative (PowerSeries.C a) = 0 := - PowerSeries.derivative_C - rw [hX, hC] - simp + simp only [linearPowerSeriesFactor, map_sub, PowerSeries.derivative_one, + Derivation.leibniz, PowerSeries.derivative_X, PowerSeries.derivative_C, + smul_eq_mul, mul_one, mul_zero, add_zero, zero_sub] @[simp] theorem coeff_negativeXLogDerivative_linearPowerSeriesFactor (a : ℂ) (n : ℕ) : @@ -83,7 +74,7 @@ theorem negativeXLogDerivative_mul change -PowerSeries.X * PowerSeries.derivative (f * g) * (f * g)⁻¹ = -PowerSeries.X * PowerSeries.derivative f * f⁻¹ + -PowerSeries.X * PowerSeries.derivative g * g⁻¹ - rw [PowerSeries.derivativeFun_mul, + rw [Derivation.leibniz, inverse_mul_of_constantCoeff_ne_zero f g hf hg] simp only [smul_eq_mul] calc diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean index 22f98a21c8..3f17ea06cd 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Algebra.Polynomial.SpecificDegree import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry /-! diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean index 53f99f5c15..482595f9d5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Analysis.Complex.Polynomial.Basic import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean index 7ca49b741b..802da336c2 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Algebra.MvPolynomial.PDeriv +import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary import Mathlib.FieldTheory.KummerExtension diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean index 261a4299d1..4b496188f1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Algebra.MvPolynomial.Nilpotent import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic import Mathlib.FieldTheory.Perfect From 35ab82180c9cd886a2b09ed568feb9f2806d9eb7 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Tue, 22 Sep 2026 02:48:31 +0000 Subject: [PATCH 25/37] Port Markoff ramification and split local dimension proofs --- .../AuxiliaryFamilyIndexing.lean | 7 + .../DedekindLocalDerivationExtension.lean | 15 +- .../CorvajaZannier/DedekindPlaceOrder.lean | 7 + .../DedekindRamifiedDerivationScaling.lean | 3 +- ...xtensionCanonicalAuxiliaryFinitePlace.lean | 7 + .../FiniteExtensionCanonicalGcdBound.lean | 6 + ...ionCanonicalGlobalNormalizedAutomatic.lean | 7 + .../FiniteExtensionCanonicalPlaceSum.lean | 7 + .../FiniteExtensionOneSubGcdHeight.lean | 7 + .../CorvajaZannier/ParameterizedBound.lean | 277 ++++---- .../PlaneCurveAuxiliaryFinitePlace.lean | 2 +- .../PlaneCurveDiagonalStabilizer.lean | 7 + .../PlaneCurveInfinityDifferentDegree.lean | 7 + .../CorvajaZannier/PlaneCurveSupportRank.lean | 15 +- .../TorsionPointNormalization.lean | 7 + .../BGS/Dynamics/StrictMeasureEscape.lean | 7 + .../BGS/FiniteField/QuadraticCharacter.lean | 7 + ...ionInfinityPlaceSplittingMultiplicity.lean | 1 + .../HasseWeil/ConstantFieldAutomorphism.lean | 9 +- .../BGS/HasseWeil/ConstantTensorResidue.lean | 5 +- .../DedekindDifferentLocalTrace.lean | 7 + .../BGS/HasseWeil/ExactConstantExtension.lean | 4 +- .../ExactConstantExtensionAutomorphism.lean | 15 +- ...ConstantExtensionDifferentCoefficient.lean | 621 ++++++++++-------- ...ExactConstantExtensionFiniteDifferent.lean | 3 +- ...tantExtensionFinitePlaceCompatibility.lean | 3 +- ...diateFrobeniusTwistFinitePlaceAverage.lean | 3 +- ...ateFrobeniusTwistRationalPlaceAverage.lean | 14 +- .../BGS/HasseWeil/FiniteFieldCompositum.lean | 3 +- .../BGS/HasseWeil/FormalZetaTrace.lean | 7 + .../FunctionFieldConstantExtension.lean | 3 +- .../HasseWeil/OnePointLeadingCoefficient.lean | 7 + .../BGS/HasseWeil/PlaneStepanovAuxiliary.lean | 6 +- .../BGS/HasseWeil/PolynomialTensorCancel.lean | 3 +- .../RatFuncCanonicalInfinityDivisor.lean | 38 +- .../RiemannSpaceFinitePlaceIncrement.lean | 98 ++- .../RiemannSpaceInfinityPlaceIncrement.lean | 71 +- .../Assembly/ExceptionalPrimeCount.lean | 1 + .../BGS/Markoff/MiddleGame/DivisorRange.lean | 7 + .../BGS/Markoff/Opening/CompatibleRoots.lean | 7 + .../BGS/Markoff/Opening/FiniteOrbit.lean | 7 + .../BGS/Markoff/Opening/OrderArithmetic.lean | 7 + .../Markoff/Opening/RotationOrbitCard.lean | 7 + .../BGS/Markoff/Opening/TraceOrderBound.lean | 1 + .../RankinPositionalSupportBound.lean | 4 +- .../RankinProfileCertificate.lean | 7 + ...ncatedOrderTotientRankinFactorization.lean | 7 + .../RiemannRoch/Genus/Ramification.lean | 50 +- 48 files changed, 840 insertions(+), 581 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean index 59cd944f6a..d878e3ed87 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean @@ -9,6 +9,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily import Mathlib.Tactic +/-! +# Indexing the auxiliary Wronskian family + +Enumerate the auxiliary family and its derivative orders, then transport determinant +nonvanishing through that indexing. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean index 49faba865a..2fc94cc4ef 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean @@ -9,6 +9,13 @@ import Mathlib.RingTheory.DedekindDomain.Different import Mathlib.RingTheory.Flat.TorsionFree import Mathlib.RingTheory.Smooth.Fiber +/-! +# Extending derivations through local Dedekind rings + +Lift derivations uniquely through formally etale maps and apply this to unramified localizations +and primes away from the different. +-/ + namespace BGS.CorvajaZannier noncomputable section @@ -155,7 +162,7 @@ theorem dedekindLocal_formallyEtale_of_isUnramifiedAt [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] - [Localization.AtPrime.IsLiesOverAlgebra p Q] + [IsScalarTower A (Localization.AtPrime p) (Localization.AtPrime Q)] [Algebra.IsUnramifiedAt A Q] : Algebra.FormallyEtale (Localization.AtPrime p) (Localization.AtPrime Q) := by @@ -175,7 +182,7 @@ theorem dedekindLocal_formallyEtale_of_not_dvd_different [Algebra.IsSeparable (FractionRing A) (FractionRing B)] (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] - [Localization.AtPrime.IsLiesOverAlgebra p Q] + [IsScalarTower A (Localization.AtPrime p) (Localization.AtPrime Q)] (hQ : ¬ Q ∣ differentIdeal A B) : Algebra.FormallyEtale (Localization.AtPrime p) (Localization.AtPrime Q) := by @@ -192,7 +199,7 @@ theorem dedekindLocal_derivation_preserves_of_isUnramifiedAt [Algebra A B] [Module.IsTorsionFree A B] [Module.Finite A B] (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] - [Localization.AtPrime.IsLiesOverAlgebra p Q] + [IsScalarTower A (Localization.AtPrime p) (Localization.AtPrime Q)] [Algebra C (Localization.AtPrime p)] [Algebra C (Localization.AtPrime Q)] [Algebra C U] @@ -231,7 +238,7 @@ theorem dedekindLocal_derivation_preserves_of_not_dvd_different [Algebra.IsSeparable (FractionRing A) (FractionRing B)] (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] - [Localization.AtPrime.IsLiesOverAlgebra p Q] + [IsScalarTower A (Localization.AtPrime p) (Localization.AtPrime Q)] [Algebra C (Localization.AtPrime p)] [Algebra C (Localization.AtPrime Q)] [Algebra C U] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean index 8c9b7654f7..bf7023dfc9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean @@ -9,6 +9,13 @@ import Mathlib.RingTheory.DiscreteValuationRing.Basic import Mathlib.RingTheory.Derivation.Basic import Mathlib.Tactic +/-! +# Orders at Dedekind places + +Extend local orders to zero using a top value and prove their arithmetic and derivation +estimates through uniformizers. +-/ + open scoped nonZeroDivisors open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean index 8f2aa327a2..e81921e052 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean @@ -67,8 +67,7 @@ theorem kaehler_baseChange_evaluation_naturality E.liftKaehlerDifferential (KaehlerDifferential.map C C T U (KaehlerDifferential.mapBaseChange C S T z)) := by - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul t ω => rw [LinearMap.liftBaseChange_tmul, KaehlerDifferential.mapBaseChange_tmul] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean index cb2297c676..68b3682166 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean @@ -11,6 +11,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound import Mathlib.Tactic +/-! +# Finite-place cases for the canonical auxiliary family + +Prove the local auxiliary-family inequalities at finite places, including the grid-order and +derivative-order sums. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean index 2fbe548b80..29654eb29f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean @@ -8,6 +8,12 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation import Mathlib.Tactic +/-! +# A gcd bound from the canonical Wronskian inequality + +Deduce the finite-extension gcd estimate from the residue-weighted canonical Wronskian bound. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean index fb8e9461aa..0edf32e543 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean @@ -10,6 +10,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants import Mathlib.Tactic +/-! +# Normalized global derivations for the canonical argument + +Construct the rational-function derivations and reciprocal-chart estimates used to normalize the +global canonical Wronskian argument. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean index c119c0b5fd..f0e0075d3e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean @@ -8,6 +8,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian import Mathlib.Tactic +/-! +# Canonical Wronskian sums over all places + +Sum the local Wronskian inequalities with residue-degree weights, separating exceptional places +from the outside pole height. +-/ + open scoped BigOperators namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean index 46bd725a2f..fc7127d997 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean @@ -8,6 +8,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport import Mathlib.Tactic +/-! +# The gcd height of a function and its complement + +Control the common divisor of a function and one minus that function using local orders, +exceptional places, and outside height. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean index 87e447b2f9..70d8217a56 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean @@ -135,6 +135,156 @@ private theorem degree_le_theoremFour_bound_of_sq_le_cube mul_le_mul_of_nonneg_left hsqrtTCoefficient hroot _ = (4 / t + t ^ 2 / 2) * root := mul_comm _ _ +private theorem propositionTwo_numerical_bound + {a b chi : ℕ} {t G : ℝ} + (ha : 0 < a) (hb : 0 < b) (hchi : 0 < chi) (ht : 0 < t) : + let A : ℝ := a + let B : ℝ := b + let C : ℝ := chi + let base : ℝ := A * B * C + let baseRoot : ℝ := base ^ ((1 : ℝ) / 3) + let hScale : ℝ := (B ^ 2 / (A * C)) ^ ((1 : ℝ) / 3) + let kScale : ℝ := (A ^ 2 / (B * C)) ^ ((1 : ℝ) / 3) + let xH : ℝ := t * hScale + let xK : ℝ := t * kScale + let h : ℕ := ⌊xH⌋₊ - 1 + let k : ℕ := ⌊xK⌋₊ - 1 + + 0 < k → k ≤ h → + G ≤ (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * A + + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * B + + ((((h * k + h + k : ℕ) : ℝ) - 1) / 2) * C → + G ≤ (4 / t + t ^ 2 / 2) * baseRoot := by + intro A B C base baseRoot hScale kScale xH xK h k hkPos hkh hNumerical + have hAPos : 0 < A := by dsimp [A]; exact_mod_cast ha + have hBPos : 0 < B := by + dsimp [B] + exact_mod_cast hb + have hCPos : 0 < C := by dsimp [C]; exact_mod_cast hchi + have hbasePos : 0 < base := by dsimp [base]; positivity + have hbaseRootPos : 0 < baseRoot := by dsimp [baseRoot]; positivity + have hbaseRootCube : baseRoot ^ 3 = base := by + simpa [baseRoot] using rpow_one_third_cube hbasePos.le + have hhRadicandPos : 0 < B ^ 2 / (A * C) := by positivity + have hkRadicandPos : 0 < A ^ 2 / (B * C) := by positivity + have hhScalePos : 0 < hScale := by dsimp [hScale]; positivity + have hkScalePos : 0 < kScale := by dsimp [kScale]; positivity + have hhScaleCube : hScale ^ 3 = B ^ 2 / (A * C) := by + simpa [hScale] using rpow_one_third_cube hhRadicandPos.le + have hkScaleCube : kScale ^ 3 = A ^ 2 / (B * C) := by + simpa [kScale] using rpow_one_third_cube hkRadicandPos.le + have hxHPos : 0 < xH := by dsimp [xH]; positivity + have hxKPos : 0 < xK := by dsimp [xK]; positivity + + have hAdivKScale : A / kScale = baseRoot := by + apply (pow_left_inj₀ (by positivity) hbaseRootPos.le + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [div_pow, hkScaleCube, hbaseRootCube] + dsimp [base] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + have hBdivHScale : B / hScale = baseRoot := by + apply (pow_left_inj₀ (by positivity) hbaseRootPos.le + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [div_pow, hhScaleCube, hbaseRootCube] + dsimp [base] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + have hscaleProduct : hScale * kScale * C = baseRoot := by + apply (pow_left_inj₀ (by positivity) hbaseRootPos.le + (by norm_num : (3 : ℕ) ≠ 0)).mp + rw [mul_pow, mul_pow, hhScaleCube, hkScaleCube, hbaseRootCube] + dsimp [base] + field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] + + have hhPos : 0 < h := lt_of_lt_of_le hkPos hkh + have hkFloorOne : 1 ≤ ⌊xK⌋₊ := by + dsimp [k] at hkPos + omega + have hhFloorOne : 1 ≤ ⌊xH⌋₊ := by + dsimp [h] at hhPos + omega + have hkFloorUpper : ((k : ℝ) + 1) ≤ xK := by + simpa [k] using natFloor_sub_one_add_one_le hxKPos.le hkFloorOne + have hhFloorUpper : ((h : ℝ) + 1) ≤ xH := by + simpa [h] using natFloor_sub_one_add_one_le hxHPos.le hhFloorOne + have hnPos : 0 < h * k + h + k := by omega + let H : ℝ := h + let K : ℝ := k + let N : ℝ := h * k + h + k + have hKPos : 0 < K := by dsimp [K]; exact_mod_cast hkPos + have hKLeH : K ≤ H := by dsimp [K, H]; exact_mod_cast hkh + have hNPos : 0 < N := by dsimp [N]; exact_mod_cast hnPos + have hFirstCoefficient : (H + 2 * K) / N ≤ 3 / (K + 2) := by + simpa [H, K, N, Nat.cast_add, Nat.cast_mul] using + propositionTwo_first_coefficient_le hKPos hKLeH + have hSecondCoefficient : K / N ≤ 1 / (H + 2) := by + simpa [H, K, N, Nat.cast_add, Nat.cast_mul] using + propositionTwo_second_coefficient_le hKPos hKLeH + have hxKDenominator : xK ≤ K + 2 := by + simpa [K, k] using (lt_natFloor_sub_one_add_two xK).le + have hxHDenominator : xH ≤ H + 2 := by + simpa [H, h] using (lt_natFloor_sub_one_add_two xH).le + have hADiv : A / (K + 2) ≤ baseRoot / t := by + calc + A / (K + 2) ≤ A / xK := + div_le_div_of_nonneg_left hAPos.le hxKPos hxKDenominator + _ = baseRoot / t := by + dsimp [xK] + rw [show A / (t * kScale) = (A / kScale) / t by + field_simp [ht.ne', hkScalePos.ne']] + rw [hAdivKScale] + have hBDiv : B / (H + 2) ≤ baseRoot / t := by + calc + B / (H + 2) ≤ B / xH := + div_le_div_of_nonneg_left hBPos.le hxHPos hxHDenominator + _ = baseRoot / t := by + dsimp [xH] + rw [show B / (t * hScale) = (B / hScale) / t by + field_simp [ht.ne', hhScalePos.ne']] + rw [hBdivHScale] + have hFirstTerm : ((H + 2 * K) / N) * A ≤ (3 / t) * baseRoot := by + calc + ((H + 2 * K) / N) * A ≤ (3 / (K + 2)) * A := + mul_le_mul_of_nonneg_right hFirstCoefficient hAPos.le + _ = 3 * (A / (K + 2)) := by ring + _ ≤ 3 * (baseRoot / t) := + mul_le_mul_of_nonneg_left hADiv (by norm_num) + _ = (3 / t) * baseRoot := by ring + have hSecondTerm : (K / N) * B ≤ (1 / t) * baseRoot := by + calc + (K / N) * B ≤ (1 / (H + 2)) * B := + mul_le_mul_of_nonneg_right hSecondCoefficient hBPos.le + _ = B / (H + 2) := by ring + _ ≤ baseRoot / t := hBDiv + _ = (1 / t) * baseRoot := by ring + have hFloorProduct : (H + 1) * (K + 1) ≤ xH * xK := by + have hhFloorUpper' : H + 1 ≤ xH := by simpa [H] using hhFloorUpper + have hkFloorUpper' : K + 1 ≤ xK := by simpa [K] using hkFloorUpper + exact mul_le_mul hhFloorUpper' hkFloorUpper' (by positivity) (by positivity) + have hThirdNumerator : N - 1 ≤ (H + 1) * (K + 1) := by + dsimp [N, H, K] + ring_nf + norm_num + have hThirdTerm : ((N - 1) / 2) * C ≤ (t ^ 2 / 2) * baseRoot := by + calc + ((N - 1) / 2) * C ≤ (((H + 1) * (K + 1)) / 2) * C := by + gcongr + _ ≤ ((xH * xK) / 2) * C := by + gcongr + _ = (t ^ 2 / 2) * baseRoot := by + dsimp [xH, xK] + rw [← hscaleProduct] + ring + have hNumerical' : + G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := by + simpa only [H, K, N, A, B, C, Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hNumerical + calc + G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := + hNumerical' + _ ≤ (3 / t) * baseRoot + (1 / t) * baseRoot + + (t ^ 2 / 2) * baseRoot := + add_le_add (add_le_add hFirstTerm hSecondTerm) hThirdTerm + _ = (4 / t + t ^ 2 / 2) * baseRoot := by ring + /-- The floor-parameter optimization in Corvaja--Zannier Theorem 4. The hypothesis `hPropositionTwo` is exactly the numerical alternative of @@ -175,9 +325,8 @@ theorem theoremFour_parameterizedBound_of_propositionTwo have hPPos : 0 < P := by dsimp [P]; exact_mod_cast hp have hAB : A ≤ B := by dsimp [A, B]; exact_mod_cast hab have hCOne : 1 ≤ C := by - have hchiOne : 1 ≤ chi := by omega dsimp [C] - exact_mod_cast hchiOne + exact_mod_cast (show 1 ≤ chi by omega) have hbasePos : 0 < base := by dsimp [base]; positivity have hbaseRootPos : 0 < baseRoot := by dsimp [baseRoot]; positivity have hbaseRootCube : baseRoot ^ 3 = base := by @@ -200,25 +349,12 @@ theorem theoremFour_parameterizedBound_of_propositionTwo have hAhScaleCube : (A * hScale) ^ 3 = (A * B) ^ 2 / C := by rw [mul_pow, hhScaleCube] field_simp [hAPos.ne', hCPos.ne'] - have hAdivKScale : A / kScale = baseRoot := by - apply (pow_left_inj₀ (by positivity) hbaseRootPos.le - (by norm_num : (3 : ℕ) ≠ 0)).mp - rw [div_pow, hkScaleCube, hbaseRootCube] - dsimp [base] - field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] have hBdivHScale : B / hScale = baseRoot := by apply (pow_left_inj₀ (by positivity) hbaseRootPos.le (by norm_num : (3 : ℕ) ≠ 0)).mp rw [div_pow, hhScaleCube, hbaseRootCube] dsimp [base] field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] - have hscaleProduct : hScale * kScale * C = baseRoot := by - apply (pow_left_inj₀ (by positivity) hbaseRootPos.le - (by norm_num : (3 : ℕ) ≠ 0)).mp - rw [mul_pow, mul_pow, hhScaleCube, hkScaleCube, hbaseRootCube] - dsimp [base] - field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] - have hkScaleLeHScale : kScale ≤ hScale := by apply le_of_pow_le_pow_left₀ (by norm_num : (3 : ℕ) ≠ 0) hhScalePos.le rw [hkScaleCube, hhScaleCube] @@ -226,9 +362,8 @@ theorem theoremFour_parameterizedBound_of_propositionTwo (by positivity : 0 < A * C)).2 nlinarith [mul_nonneg (sub_nonneg.mpr hAB) (by positivity : 0 ≤ A ^ 2 + A * B + B ^ 2)] - have hxKLeXH : xK ≤ xH := by - dsimp [xK, xH] - exact mul_le_mul_of_nonneg_left hkScaleLeHScale ht.le + have hxKLeXH : xK ≤ xH := + mul_le_mul_of_nonneg_left hkScaleLeHScale ht.le have hkh : k ≤ h := by dsimp [h, k] exact Nat.sub_le_sub_right (Nat.floor_mono hxKLeXH) 1 @@ -248,8 +383,8 @@ theorem theoremFour_parameterizedBound_of_propositionTwo norm_num ring _ < (P + A + B) ^ 3 := hdiv - have hCommonLt : 2 * t * (A * hScale) < P + A + B := by - exact lt_of_pow_lt_pow_left₀ 3 (by positivity) hCommonCubeLt + have hCommonLt : 2 * t * (A * hScale) < P + A + B := + lt_of_pow_lt_pow_left₀ 3 (by positivity) hCommonCubeLt by_cases hkSmall : k < 1 · have hkZero : k = 0 := by omega @@ -347,19 +482,15 @@ theorem theoremFour_parameterizedBound_of_propositionTwo apply (div_lt_iff₀ hhScalePos).2 simpa [xH, mul_comm] using hBLtXH have hASqLeBase : A ^ 2 ≤ base := by - have hAASq : A ^ 2 ≤ A * B := by - rw [pow_two] - exact mul_le_mul_of_nonneg_left hAB hAPos.le - have hABNonneg : 0 ≤ A * B := by positivity - have hABLe : A * B ≤ A * B * C := by - calc - A * B = (A * B) * 1 := (mul_one _).symm - _ ≤ (A * B) * C := mul_le_mul_of_nonneg_left hCOne hABNonneg - exact hAASq.trans hABLe - have hASqLeRootCube : A ^ 2 ≤ baseRoot ^ 3 := by + dsimp [base] calc - A ^ 2 ≤ base := hASqLeBase - _ = baseRoot ^ 3 := hbaseRootCube.symm + A ^ 2 ≤ A * B := by + rw [pow_two] + exact mul_le_mul_of_nonneg_left hAB hAPos.le + _ = A * B * 1 := (mul_one _).symm + _ ≤ A * B * C := mul_le_mul_of_nonneg_left hCOne (by positivity) + have hASqLeRootCube : A ^ 2 ≤ baseRoot ^ 3 := + hASqLeBase.trans_eq hbaseRootCube.symm have hADegreeBound : A ≤ (4 / t + t ^ 2 / 2) * baseRoot := degree_le_theoremFour_bound_of_sq_le_cube (degree := A) (root := baseRoot) (t := t) @@ -370,86 +501,8 @@ theorem theoremFour_parameterizedBound_of_propositionTwo _ = (4 / t + t ^ 2 / 2) * ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by rfl - · let H : ℝ := h - let K : ℝ := k - let N : ℝ := h * k + h + k - have hKPos : 0 < K := by dsimp [K]; exact_mod_cast hkPos - have hKLeH : K ≤ H := by dsimp [K, H]; exact_mod_cast hkh - have hNPos : 0 < N := by dsimp [N]; exact_mod_cast hnPos - have hFirstCoefficient : (H + 2 * K) / N ≤ 3 / (K + 2) := by - simpa [H, K, N, Nat.cast_add, Nat.cast_mul] using - propositionTwo_first_coefficient_le hKPos hKLeH - have hSecondCoefficient : K / N ≤ 1 / (H + 2) := by - simpa [H, K, N, Nat.cast_add, Nat.cast_mul] using - propositionTwo_second_coefficient_le hKPos hKLeH - have hxKDenominator : xK ≤ K + 2 := by - simpa [K, k] using (lt_natFloor_sub_one_add_two xK).le - have hxHDenominator : xH ≤ H + 2 := by - simpa [H, h] using (lt_natFloor_sub_one_add_two xH).le - have hADiv : A / (K + 2) ≤ baseRoot / t := by - calc - A / (K + 2) ≤ A / xK := - div_le_div_of_nonneg_left hAPos.le hxKPos hxKDenominator - _ = baseRoot / t := by - dsimp [xK] - rw [show A / (t * kScale) = (A / kScale) / t by - field_simp [ht.ne', hkScalePos.ne']] - rw [hAdivKScale] - have hBDiv : B / (H + 2) ≤ baseRoot / t := by - calc - B / (H + 2) ≤ B / xH := - div_le_div_of_nonneg_left hBPos.le hxHPos hxHDenominator - _ = baseRoot / t := by - dsimp [xH] - rw [show B / (t * hScale) = (B / hScale) / t by - field_simp [ht.ne', hhScalePos.ne']] - rw [hBdivHScale] - have hFirstTerm : ((H + 2 * K) / N) * A ≤ (3 / t) * baseRoot := by - calc - ((H + 2 * K) / N) * A ≤ (3 / (K + 2)) * A := - mul_le_mul_of_nonneg_right hFirstCoefficient hAPos.le - _ = 3 * (A / (K + 2)) := by ring - _ ≤ 3 * (baseRoot / t) := - mul_le_mul_of_nonneg_left hADiv (by norm_num) - _ = (3 / t) * baseRoot := by ring - have hSecondTerm : (K / N) * B ≤ (1 / t) * baseRoot := by - calc - (K / N) * B ≤ (1 / (H + 2)) * B := - mul_le_mul_of_nonneg_right hSecondCoefficient hBPos.le - _ = B / (H + 2) := by ring - _ ≤ baseRoot / t := hBDiv - _ = (1 / t) * baseRoot := by ring - have hFloorProduct : (H + 1) * (K + 1) ≤ xH * xK := by - have hhFloorUpper' : H + 1 ≤ xH := by simpa [H] using hhFloorUpper - have hkFloorUpper' : K + 1 ≤ xK := by simpa [K] using hkFloorUpper - exact mul_le_mul hhFloorUpper' hkFloorUpper' (by positivity) (by positivity) - have hThirdNumerator : N - 1 ≤ (H + 1) * (K + 1) := by - dsimp [N, H, K] - ring_nf - norm_num - have hThirdTerm : ((N - 1) / 2) * C ≤ (t ^ 2 / 2) * baseRoot := by - calc - ((N - 1) / 2) * C ≤ (((H + 1) * (K + 1)) / 2) * C := by - gcongr - _ ≤ ((xH * xK) / 2) * C := by - gcongr - _ = (t ^ 2 / 2) * baseRoot := by - dsimp [xH, xK] - rw [← hscaleProduct] - ring - have hNumerical' : - G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := by - simpa only [H, K, N, A, B, C, Nat.cast_add, Nat.cast_mul, Nat.cast_ofNat] using hNumerical - calc - G ≤ ((H + 2 * K) / N) * A + (K / N) * B + ((N - 1) / 2) * C := - hNumerical' - _ ≤ (3 / t) * baseRoot + (1 / t) * baseRoot + - (t ^ 2 / 2) * baseRoot := - add_le_add (add_le_add hFirstTerm hSecondTerm) hThirdTerm - _ = (4 / t + t ^ 2 / 2) * baseRoot := by ring - _ = (4 / t + t ^ 2 / 2) * - ((a : ℝ) * (b : ℝ) * (chi : ℝ)) ^ ((1 : ℝ) / 3) := by - simp [baseRoot, base, A, B, C] + · exact propositionTwo_numerical_bound ha (lt_of_lt_of_le ha hab) hchi ht + hkPos hkh hNumerical end diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean index a0ff24ecdf..2a168dcbbb 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean @@ -46,7 +46,7 @@ theorem dedekindLocal_ambientDerivation_preserves_of_not_dvd_different [Algebra.IsSeparable (FractionRing A) (FractionRing B)] (p : Ideal A) (Q : Ideal B) [p.IsPrime] [Q.IsPrime] [Q.LiesOver p] [Algebra (Localization.AtPrime p) (Localization.AtPrime Q)] - [Localization.AtPrime.IsLiesOverAlgebra p Q] + [IsScalarTower A (Localization.AtPrime p) (Localization.AtPrime Q)] [Algebra C (Localization.AtPrime p)] [Algebra C (Localization.AtPrime Q)] [Algebra C U] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean index 68a3e94d2f..1776c3f63c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean @@ -8,6 +8,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss import Mathlib.Tactic +/-! +# Diagonal stabilizers of plane curves + +Describe diagonal scaling through polynomial coefficients and relate curve stabilizers to +characters of the support. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean index 33758776e7..43f187ae9f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean @@ -6,6 +6,13 @@ Authors: Yuma Mizuno import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound +/-! +# The degree of the different at infinity + +Bound the different at infinity using a primitive element, its discriminant, and the normalized +reciprocal polynomial. +-/ + open Polynomial namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean index 0a6ccf860e..daee870ef4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean @@ -479,10 +479,8 @@ private theorem exists_directionalPolynomial_representation ∑ s ∈ F.support, Polynomial.monomial (index s) (F.coeff s) have coeff_finset_sum (n : ℕ) (S : Finset (Fin 2 →₀ ℕ)) (g : (Fin 2 →₀ ℕ) → Polynomial A) : - (∑ s ∈ S, g s).coeff n = ∑ s ∈ S, (g s).coeff n := by - induction S using Finset.induction_on with - | empty => simp - | @insert a S ha ih => simp [ha, ih, Polynomial.coeff_add] + (∑ s ∈ S, g s).coeff n = ∑ s ∈ S, (g s).coeff n := + Polynomial.finsetSum_coeff S g n have coeff_q_index : ∀ s ∈ F.support, q.coeff (index s) = F.coeff s := by intro s hs @@ -543,13 +541,6 @@ private theorem exists_directionalPolynomial_representation ((s i : ℤ) - (r i : ℤ)) - ((slo i : ℤ) - (r i : ℤ)) := by ring _ = parameter s * v i - lo * v i := by rw [hs_eq, hlo_eq] _ = (parameter s - lo) * v i := by ring - have positive_sub_negative (i : Fin 2) : - (intVectorPositive v i : ℤ) - (intVectorNegative v i : ℤ) = v i := by - simp only [intVectorPositive_apply, intVectorNegative_apply] - rw [Int.ofNat_toNat, Int.ofNat_toNat] - rcases le_total 0 (v i) with hvi | hvi - · simp [hvi, neg_nonpos.mpr hvi] - · simp [hvi] have negative_le_slo (i : Fin 2) : N * intVectorNegative v i ≤ slo i := by by_cases hvi : 0 ≤ v i @@ -587,7 +578,7 @@ private theorem exists_directionalPolynomial_representation push_cast rfl have hcoord := support_coordinate s hs i - have hpn := positive_sub_negative i + have hpn := intVectorPositive_sub_negative v i have hcast : (s i : ℤ) = (w i : ℤ) + (index s : ℤ) * (intVectorPositive v i : ℤ) + ((N - index s : ℕ) : ℤ) * (intVectorNegative v i : ℤ) := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean index 6391992c8f..580c9cd28c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean @@ -10,6 +10,13 @@ import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems import Mathlib.RingTheory.Ideal.GoingUp import Mathlib.RingTheory.Localization.Integral +/-! +# Affine centers and normalization of torsion points + +Construct coordinate-ring evaluations and their maximal ideals, and compare affine torsion +points with normalization places. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean b/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean index 4bac71feef..9ac9f13686 100644 --- a/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean @@ -8,6 +8,13 @@ import Mathlib.Logic.Relation import Mathlib.Data.Nat.Order.Lemmas import Mathlib.Tactic +/-! +# Escape by a strictly increasing measure + +Iterate admissible transitions to reach a prescribed lower bound for a strictly increasing +measure. +-/ + namespace BGS universe u diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean index 3bafb62b3c..41eaaa146d 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean @@ -7,6 +7,13 @@ Authors: Yuma Mizuno import Mathlib.NumberTheory.JacobiSum.Basic import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic +/-! +# Quadratic character sums and conic points + +Evaluate quadratic character sums and use them to find conic points avoiding a prescribed small +exceptional set. +-/ + namespace BGS.FiniteField open Finset diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean index 2732adf781..7d80b078ef 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.RingTheory.Localization.AtPrime.Extension import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity /-! diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean index 290397a43a..2283c15ea9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean @@ -58,15 +58,13 @@ noncomputable def tensorConstantAutHom : map_one' := by apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul e x => simp | add x y hx hy => simp [hx, hy] map_mul' σ τ := by apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul e x => simp | add x y hx hy => simp [hx, hy] @@ -210,8 +208,7 @@ noncomputable def planeCurveFunctionFieldBaseChangeLinearEquiv : map_add' := map_add ψ map_smul' := by intro x z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul y e => change φ (e ⊗ₜ[K] (x * y)) = φ (1 ⊗ₜ[K] x) * φ (e ⊗ₜ[K] y) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean index 10f34d7f0d..cbbf7fb02e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean @@ -77,10 +77,7 @@ theorem constantTensorResidueAlgHom_surjective (R := C) (A := S) (B := R)).toRingHom intro z obtain ⟨a, rfl⟩ := q.algebraMap_residueField_surjective z - induction a using TensorProduct.induction_on with - | zero => - refine ⟨0, ?_⟩ - rw [map_zero, map_zero] + induction a using TensorProduct.inductionOn with | tmul s r => refine ⟨s ⊗ₜ[C] algebraMap R p.ResidueField r, ?_⟩ simp only [constantTensorResidueAlgHom, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 73610850b8..9fd9b688b4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -8,6 +8,13 @@ import Mathlib.RingTheory.DedekindDomain.Different import Mathlib.RingTheory.DedekindDomain.Factorization import Mathlib.RingTheory.DedekindDomain.AdicValuation +/-! +# Local traces and the different + +Relate different multiplicities to the trace-dual lattice and clear the finitely many bad +valuation bounds by a base multiplier. +-/ + open scoped nonZeroDivisors open Set Function UniqueFactorizationMonoid IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean index e847dcfbd8..47df6ed6d7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean @@ -198,8 +198,8 @@ noncomputable def exactConstantExtensionLinearEquiv : map_add' := map_add e map_smul' := by intro x z - refine TensorProduct.induction_on (motive := fun z ↦ e (x • z) = x • e z) z - (by rw [smul_zero, map_zero, smul_zero]) (fun y s => ?_) + refine TensorProduct.inductionOn (motive := fun z ↦ e (x • z) = x • e z) z + (fun y s => ?_) (fun z w hz hw => ?_) · change e ((x * y) ⊗ₜ[C] s) = e (x ⊗ₜ[C] (1 : S)) * e (y ⊗ₜ[C] s) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean index 8a24b51f86..4280a6871c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean @@ -119,16 +119,14 @@ noncomputable def exactConstantExtensionConstantAutHom : map_one' := by apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul s n => simp [exactConstantExtensionConstantAlgEquivOverBase] | add x y hx hy => simp [hx, hy] map_mul' := by intro σ τ apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul s n => simp [exactConstantExtensionConstantAlgEquivOverBase] | add x y hx hy => simp [hx, hy] } @@ -144,16 +142,14 @@ noncomputable def exactConstantExtensionFunctionAutHom : map_one' := by apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul s n => simp [exactConstantExtensionFunctionAlgEquivOverBase] | add x y hx hy => simp [hx, hy] map_mul' := by intro g h apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul s n => simp [exactConstantExtensionFunctionAlgEquivOverBase] | add x y hx hy => simp [hx, hy] } @@ -169,8 +165,7 @@ theorem exactConstantExtension_constant_function_commute rw [Commute] apply AlgEquiv.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul s n => simp [exactConstantExtensionConstantAutHom, exactConstantExtensionFunctionAutHom, exactConstantExtensionConstantAlgEquivOverBase, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean index e62e1537d3..7fef09193e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean @@ -24,6 +24,32 @@ open scoped Polynomial TensorProduct namespace BGS.HasseWeil +private theorem normalization_map_injective + {R B N E : Type*} [CommRing R] [CommRing B] [Field N] [Field E] + [Algebra R B] [Algebra N E] + (i : R → N) (j : B → E) (hi : Function.Injective i) + (hcompat : ∀ x, j (algebraMap R B x) = algebraMap N E (i x)) : + Function.Injective (algebraMap R B) := by + intro x y hxy + apply hi + apply (algebraMap N E).injective + exact (hcompat x).symm.trans ((congrArg j hxy).trans (hcompat y)) + + +private theorem comap_liesOver_of_commutes + {A R B C : Type*} [CommRing A] [CommRing R] [CommRing B] [CommRing C] + [Algebra A C] [Algebra R B] + (e : C →+* B) (f : A →+* R) + (hcomp : e.comp (algebraMap A C) = (algebraMap R B).comp f) + (p : Ideal A) (r : Ideal R) (q : Ideal B) [q.LiesOver r] + (hbase : r.comap f = p) : (q.comap e).LiesOver p := by + constructor + change p = Ideal.comap (algebraMap A C) (q.comap e) + rw [Ideal.comap_comap, hcomp, ← Ideal.comap_comap] + change p = Ideal.comap f (q.under R) + rw [← (inferInstance : q.LiesOver r).over, hbase] + + noncomputable section open BGS.CorvajaZannier IsDedekindDomain @@ -526,60 +552,36 @@ theorem exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one _ = ((algebraMap R2 B) x : B) := (exactConstantExtensionInfinityNormalizationAlgebra_coe C S N hExact x).symm } - have hTargetInjective : Function.Injective (algebraMap R2 CC) := by - intro x y hxy - apply Subtype.ext - apply (algebraMap N E).injective - exact congrArg Subtype.val hxy - let : Module.IsTorsionFree R2 CC := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - exact hTargetInjective - let : Module.IsTorsionFree R2 B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - intro x y hxy - apply hTargetInjective - rw [← e.commutes x, ← e.commutes y] at hxy - exact e.injective hxy + have hTargetInjective : Function.Injective (algebraMap R2 CC) := + normalization_map_injective Subtype.val Subtype.val Subtype.val_injective (fun _ => rfl) + let : Module.IsTorsionFree R2 CC := + (Module.isTorsionFree_iff_algebraMap_injective).2 hTargetInjective + let : Module.IsTorsionFree R2 B := + Function.Injective.moduleIsTorsionFree e.symm e.symm.injective (map_smul e.symm.toLinearEquiv) let w := exactConstantExtensionUpstairsInfinityPlace C S N hExact q.1 q.2 let QI : Ideal CC := Ideal.comap eRing.toRingHom w.1 - have hQIPrime : QI.IsPrime := by - dsimp only [QI] - exact Ideal.comap_isPrime (f := eRing.toRingHom) (K := w.1) - have hQIOver : QI.LiesOver (ratFuncInfinityPlace C).asIdeal := ⟨by - ext x - change x ∈ (ratFuncInfinityPlace C).asIdeal ↔ - eRing (algebraMap A CC x) ∈ w.1 - have heMap : eRing (algebraMap A CC x) = - algebraMap R1 B (ratFuncInfinityIntegersRingHom C S x) := by - apply Subtype.ext - calc - ((eRing (algebraMap A CC x) : B) : E) = - ((algebraMap A CC x : CC) : E) := - integralClosureRingEquivOfIntegralTower_coe A R1 E _ - _ = algebraMap (RatFunc C) E x.1 := rfl - _ = algebraMap (RatFunc S) E - (ratFuncCoefficientAlgHom C S x.1) := - DFunLike.congr_fun - (rationalBase_algebraMap_eq C S N hExact) x.1 - _ = ((algebraMap R1 B - (ratFuncInfinityIntegersRingHom C S x) : B) : E) := rfl - rw [heMap] - have hCoeff := congrArg - (fun I : Ideal A => x ∈ I) + have hQIPrime : QI.IsPrime := Ideal.comap_isPrime (f := eRing.toRingHom) (K := w.1) + have heMap : eRing.toRingHom.comp (algebraMap A CC) = + (algebraMap R1 B).comp (ratFuncInfinityIntegersRingHom C S) := by + apply RingHom.ext + intro x + apply Subtype.ext + calc + ((eRing (algebraMap A CC x) : B) : E) = + ((algebraMap A CC x : CC) : E) := + integralClosureRingEquivOfIntegralTower_coe A R1 E _ + _ = algebraMap (RatFunc C) E x.1 := rfl + _ = algebraMap (RatFunc S) E + (ratFuncCoefficientAlgHom C S x.1) := + DFunLike.congr_fun + (rationalBase_algebraMap_eq C S N hExact) x.1 + _ = ((algebraMap R1 B + (ratFuncInfinityIntegersRingHom C S x) : B) : E) := rfl + have hQIOver : QI.LiesOver (ratFuncInfinityPlace C).asIdeal := + comap_liesOver_of_commutes eRing.toRingHom + (ratFuncInfinityIntegersRingHom C S) heMap + (ratFuncInfinityPlace C).asIdeal (ratFuncInfinityPlace S).asIdeal w.1 (ratFuncInfinityIntegersRingHom_comap_infinityPlace C S) - have hCoeffMem : x ∈ (ratFuncInfinityPlace C).asIdeal ↔ - ratFuncInfinityIntegersRingHom C S x ∈ - (ratFuncInfinityPlace S).asIdeal := by - change x ∈ (ratFuncInfinityPlace C).asIdeal ↔ - x ∈ Ideal.comap (ratFuncInfinityIntegersRingHom C S) - (ratFuncInfinityPlace S).asIdeal - exact iff_of_eq hCoeff.symm - have hWMem := congrArg - (fun I : Ideal R1 => ratFuncInfinityIntegersRingHom C S x ∈ I) - w.2.2.over - change x ∈ (ratFuncInfinityPlace C).asIdeal ↔ - ratFuncInfinityIntegersRingHom C S x ∈ Ideal.under R1 w.1 - exact hCoeffMem.trans (iff_of_eq hWMem)⟩ let Q : FiniteExtensionInfinityPlace C E := ⟨QI, hQIPrime, hQIOver⟩ let qH := primeOverHeightOne (ratFuncInfinityPlace C) Q @@ -656,16 +658,303 @@ private theorem different_ne_bot_of_fraction_fields (FractionRing.algEquiv A K).symm (FractionRing.algEquiv B L).symm z exact differentIdeal_ne_bot -private theorem normalization_map_injective - {R B N E : Type*} [CommRing R] [CommRing B] [Field N] [Field E] - [Algebra R B] [Algebra N E] - (i : R → N) (j : B → E) (hi : Function.Injective i) - (hcompat : ∀ x, j (algebraMap R B x) = algebraMap N E (i x)) : - Function.Injective (algebraMap R B) := by - intro x y hxy - apply hi - apply (algebraMap N E).injective - exact (hcompat x).symm.trans ((congrArg j hxy).trans (hcompat y)) + +private theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq_finite + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : HeightOneSpectrum + (integralClosure S[X] (ExactConstantExtension C N S))) : + let E := ExactConstantExtension C N S + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + let : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + let : SMul S[X] E := Algebra.toSMul + let : Module S[X] E := Algebra.toModule + let : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + let : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + let : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + finiteExtensionTotalDifferentEffectiveDivisor S E + (exactConstantExtensionPresentedUpstairsPlaceEquiv + C S N hExact (.inl q)) = + finiteExtensionTotalDifferentEffectiveDivisor C N + (exactConstantExtensionPresentedDownstairsPlace + C S N hExact (.inl q)) := by + intro E model1 model2 model3 model4 model5 model6 model7 model8 model9 + model10 model11 model12 model13 model14 model15 + let : Algebra S[X] (RatFunc S) := + inferInstance + let : IsFractionRing S[X] (RatFunc S) := + inferInstance + let : Module.IsTorsionFree S[X] E := + Module.IsTorsionFree.trans_faithfulSMul S[X] (RatFunc S) E + let : IsDedekindDomain (integralClosure S[X] E) := + IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E + (integralClosure S[X] E) + let : Module.IsTorsionFree S[X] (integralClosure S[X] E) := + IsIntegralClosure.isTorsionFree S[X] E + let R2 := RatFuncFiniteIntegralClosure C N + let B := integralClosure S[X] E + let : Algebra C[X] (RatFunc C) := inferInstance + let : IsFractionRing C[X] (RatFunc C) := inferInstance + let : IsScalarTower C[X] (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + let : IsDedekindDomain R2 := + IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R2 + let : Module.IsTorsionFree C[X] N := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + ((algebraMap (RatFunc C) N).comp + (algebraMap C[X] (RatFunc C))) + exact (algebraMap (RatFunc C) N).injective.comp + (RatFunc.algebraMap_injective C) + let : Module.IsTorsionFree C[X] R2 := + IsIntegralClosure.isTorsionFree C[X] N + let : Algebra R2 B := + exactConstantExtensionFiniteNormalizationAlgebra C S N + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : SMul C R2 := Algebra.toSMul + let : Module C R2 := Algebra.toModule + let : Module.Free C R2 := Module.Free.of_divisionRing C R2 + let : Module.Flat C R2 := Module.Flat.of_free + let eNorm : S ⊗[C] R2 ≃+* B := + finiteFieldConstantExtensionIntegralClosureRingEquiv C S N + let : Module.IsTorsionFree R2 B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + change Function.Injective + (eNorm.toRingHom.comp + (Algebra.TensorProduct.includeRight + (R := C) (A := S) (B := R2)).toRingHom) + exact eNorm.injective.comp + (Algebra.TensorProduct.includeRight_injective + (R := C) (A := S) (B := R2) (algebraMap C S).injective) + let a : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + have hAlgebra : ratFuncInducedPolynomialAlgebra S E = a := + ratFuncInducedPolynomialAlgebra_eq S E a + (ratFuncToExactConstantExtension_algebraMap C S N hExact) + let e := integralClosureAlgEquivRatFuncFiniteOfEq + S E a hAlgebra + have hDifferent : + differentIdeal S[X] (RatFuncFiniteIntegralClosure S E) = + Ideal.map e + (differentIdeal S[X] (integralClosure S[X] E)) := + finiteNormalization_differentIdeal_eq_map + a hAlgebra inferInstance inferInstance + have hUpstairs : + exactConstantExtensionUpstairsFinitePlace C S N hExact q = + heightOneSpectrumEquivOfAlgEquiv e q := by + simpa [e, a, hAlgebra, + integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] using + (exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTransport + C S N hExact q) + rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] + simp only [exactConstantExtensionPresentedUpstairsPlace, + exactConstantExtensionPresentedDownstairsPlace, + finiteExtensionTotalDifferentEffectiveDivisor_inl] + rw [hUpstairs, hDifferent] + rw [finiteNormalization_multiplicity_map_eq + a hAlgebra q + (differentIdeal S[X] (integralClosure S[X] E))] + rw [exactConstantExtension_finiteDifferent_eq_map C S N hExact] + let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q + let : q.asIdeal.LiesOver P.asIdeal := ⟨by + change P.asIdeal = q.asIdeal.comap (algebraMap R2 B) + rfl⟩ + have hDifferentBase : + differentIdeal C[X] R2 ≠ ⊥ := + finiteExtensionFiniteDifferentIdeal_ne_bot C N + calc + multiplicity q.asIdeal + (Ideal.map (algebraMap R2 B) + (differentIdeal C[X] R2)) = + q.asIdeal.ramificationIdx R2 * + multiplicity P.asIdeal (differentIdeal C[X] R2) := + multiplicity_map_eq_ramificationIdx_mul + (R := R2) (S := B) P q + (differentIdeal C[X] R2) hDifferentBase + _ = multiplicity P.asIdeal (differentIdeal C[X] R2) := by + have hRam : q.asIdeal.ramificationIdx R2 = 1 := by + exact exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one + C S N hExact q + rw [hRam] + simpa only [one_mul] + + +private theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq_infinity + (hExact : algebraicClosure C N = + (⊥ : IntermediateField C N)) + (q : ExactConstantExtensionPresentedInfinityPlace C S N) : + let E := ExactConstantExtension C N S + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) E := + exactConstantExtensionBaseAlgebra C (RatFunc C) N S + let : SMul (RatFunc C) E := Algebra.toSMul + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := + finiteDimensional_exactConstantExtension_over_baseRatFunc + C S N hExact + let : Algebra.IsSeparable (RatFunc C) E := + isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact + let : Algebra (RatFunc S) E := + ratFuncExactConstantExtensionAlgebra C S N hExact + let : SMul (RatFunc S) E := Algebra.toSMul + let : Module (RatFunc S) E := Algebra.toModule + let : Algebra S[X] E := + constantExtensionTensorPolynomialAlgebra C S N + let : SMul S[X] E := Algebra.toSMul + let : Module S[X] E := Algebra.toModule + let : IsScalarTower S[X] (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' (by + apply DFunLike.ext _ _ + intro p + change algebraMap S[X] E p = + ratFuncToExactConstantExtension C S N hExact + (algebraMap S[X] (RatFunc S) p) + exact + (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) + let : FiniteDimensional (RatFunc S) E := + finiteDimensional_over_extendedRatFunc C S N hExact + let : Algebra.IsSeparable (RatFunc S) E := + isSeparable_over_extendedRatFunc C S N hExact + finiteExtensionTotalDifferentEffectiveDivisor S E + (exactConstantExtensionPresentedUpstairsPlaceEquiv + C S N hExact (.inr q)) = + finiteExtensionTotalDifferentEffectiveDivisor C N + (exactConstantExtensionPresentedDownstairsPlace + C S N hExact (.inr q)) := by + intro E model1 model2 model3 model4 model5 model6 model7 model8 model9 + model10 model11 model12 model13 model14 model15 + rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] + simp only [exactConstantExtensionPresentedUpstairsPlace, + exactConstantExtensionPresentedDownstairsPlace, + finiteExtensionTotalDifferentEffectiveDivisor_inr] + let A := RatFuncInfinityIntegers C + let R1 := RatFuncInfinityIntegers S + let R2 := RatFuncInfinityIntegralClosure C N + let B := RatFuncInfinityIntegralClosure S E + let : Algebra N E := exactConstantExtensionAlgebra C N S + let : SMul N E := Algebra.toSMul + let : Module N E := Algebra.toModule + let : IsScalarTower (RatFunc C) N E := + exactConstantExtensionBaseTower C (RatFunc C) N S + let : Algebra A (RatFunc C) := Algebra.ofSubsemiring A + let : SMul A (RatFunc C) := Algebra.toSMul + let : Module A (RatFunc C) := Algebra.toModule + let : IsFractionRing A (RatFunc C) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) + let : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 + let : SMul R1 (RatFunc S) := Algebra.toSMul + let : Module R1 (RatFunc S) := Algebra.toModule + let : IsFractionRing R1 (RatFunc S) := + IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) + let : Algebra A N := Algebra.ofSubsemiring A + let : SMul A N := Algebra.toSMul + let : Module A N := Algebra.toModule + let : IsScalarTower A (RatFunc C) N := + IsScalarTower.of_algebraMap_eq' rfl + let : Algebra R1 E := Algebra.ofSubsemiring R1 + let : SMul R1 E := Algebra.toSMul + let : Module R1 E := Algebra.toModule + let : IsScalarTower R1 (RatFunc S) E := + IsScalarTower.of_algebraMap_eq' rfl + let : Algebra A R1 := + RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) + let : SMul A R1 := Algebra.toSMul + let : Module A R1 := Algebra.toModule + let : IsDedekindDomain R2 := + integralClosure.isDedekindDomain A (RatFunc C) N + let : IsDedekindDomain B := + integralClosure.isDedekindDomain R1 (RatFunc S) E + let : Algebra A R2 := inferInstance + let : SMul A R2 := Algebra.toSMul + let : Module A R2 := Algebra.toModule + let : Algebra R2 N := Algebra.ofSubsemiring R2 + let : SMul R2 N := Algebra.toSMul + let : Module R2 N := Algebra.toModule + let : IsScalarTower A R2 N := + IsScalarTower.of_algebraMap_eq' (by ext z; rfl) + let : IsIntegralClosure R2 A N := + integralClosure.isIntegralClosure A N + let : Module.Finite A R2 := + IsIntegralClosure.finite A (RatFunc C) N R2 + let : Module.IsTorsionFree A R2 := + IsIntegralClosure.isTorsionFree A N + let : Module.IsTorsionFree R1 E := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap (RatFunc S) E).injective.comp + (IsFractionRing.injective R1 (RatFunc S)) + let : Module.IsTorsionFree R1 B := + IsIntegralClosure.isTorsionFree R1 E + let : Algebra R2 B := + exactConstantExtensionInfinityNormalizationAlgebra C S N hExact + let : SMul R2 B := Algebra.toSMul + let : Module R2 B := Algebra.toModule + let : Module.IsTorsionFree R2 B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact normalization_map_injective Subtype.val Subtype.val + Subtype.val_injective + (exactConstantExtensionInfinityNormalizationAlgebra_coe C S N hExact) + let : IsFractionRing R2 N := + IsIntegralClosure.isFractionRing_of_finite_extension + A (RatFunc C) N R2 + rw [exactConstantExtension_infinityDifferent_eq_map C S N hExact] + let w := exactConstantExtensionUpstairsInfinityPlace + C S N hExact q.1 q.2 + let wH := primeOverHeightOne (ratFuncInfinityPlace S) w + let P := exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 + let pH := primeOverHeightOne (ratFuncInfinityPlace C) P + let : wH.asIdeal.LiesOver pH.asIdeal := ⟨by + change P.1 = w.1.comap (algebraMap R2 B) + exact (exactConstantExtensionUpstairsInfinityPlace_under + C S N hExact q).symm⟩ + have hDifferentBase : + differentIdeal (RatFuncInfinityIntegers C) R2 ≠ ⊥ := + different_ne_bot_of_fraction_fields A R2 (RatFunc C) N + calc + multiplicity w.1 + (Ideal.map (algebraMap R2 B) + (differentIdeal (RatFuncInfinityIntegers C) R2)) = + w.1.ramificationIdx R2 * + multiplicity pH.asIdeal + (differentIdeal (RatFuncInfinityIntegers C) R2) := by + exact multiplicity_map_eq_ramificationIdx_mul + (R := R2) (S := B) pH wH + (differentIdeal (RatFuncInfinityIntegers C) R2) hDifferentBase + _ = multiplicity P.1 + (differentIdeal (RatFuncInfinityIntegers C) R2) := by + change w.1.ramificationIdx R2 * + multiplicity P.1 (differentIdeal A R2) = + multiplicity P.1 (differentIdeal A R2) + have hRam : w.1.ramificationIdx R2 = 1 := + exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one + C S N hExact q + rw [hRam] + simpa only [one_mul] + /-- Exact constant extension preserves the total-different coefficient at every presented finite or infinity place. -/ @@ -711,215 +1000,9 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq finiteExtensionTotalDifferentEffectiveDivisor C N (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) := by - intro E model1 model2 model3 model4 model5 model6 model7 model8 model9 - model10 model11 model12 model13 model14 model15 cases q with - | inl q => - let : Algebra S[X] (RatFunc S) := - inferInstance - let : IsFractionRing S[X] (RatFunc S) := - inferInstance - let : Module.IsTorsionFree S[X] E := - Module.IsTorsionFree.trans_faithfulSMul S[X] (RatFunc S) E - let : IsDedekindDomain (integralClosure S[X] E) := - IsIntegralClosure.isDedekindDomain S[X] (RatFunc S) E - (integralClosure S[X] E) - let : Module.IsTorsionFree S[X] (integralClosure S[X] E) := - IsIntegralClosure.isTorsionFree S[X] E - let R2 := RatFuncFiniteIntegralClosure C N - let B := integralClosure S[X] E - let : Algebra C[X] (RatFunc C) := inferInstance - let : IsFractionRing C[X] (RatFunc C) := inferInstance - let : IsScalarTower C[X] (RatFunc C) N := - IsScalarTower.of_algebraMap_eq' rfl - let : IsDedekindDomain R2 := - IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R2 - let : Module.IsTorsionFree C[X] N := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - change Function.Injective - ((algebraMap (RatFunc C) N).comp - (algebraMap C[X] (RatFunc C))) - exact (algebraMap (RatFunc C) N).injective.comp - (RatFunc.algebraMap_injective C) - let : Module.IsTorsionFree C[X] R2 := - IsIntegralClosure.isTorsionFree C[X] N - let : Algebra R2 B := - exactConstantExtensionFiniteNormalizationAlgebra C S N - let : SMul R2 B := Algebra.toSMul - let : Module R2 B := Algebra.toModule - let : SMul C R2 := Algebra.toSMul - let : Module C R2 := Algebra.toModule - let : Module.Free C R2 := Module.Free.of_divisionRing C R2 - let : Module.Flat C R2 := Module.Flat.of_free - let eNorm : S ⊗[C] R2 ≃+* B := - finiteFieldConstantExtensionIntegralClosureRingEquiv C S N - let : Module.IsTorsionFree R2 B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - change Function.Injective - (eNorm.toRingHom.comp - (Algebra.TensorProduct.includeRight - (R := C) (A := S) (B := R2)).toRingHom) - exact eNorm.injective.comp - (Algebra.TensorProduct.includeRight_injective - (R := C) (A := S) (B := R2) (algebraMap C S).injective) - let a : Algebra S[X] E := - constantExtensionTensorPolynomialAlgebra C S N - have hAlgebra : ratFuncInducedPolynomialAlgebra S E = a := - ratFuncInducedPolynomialAlgebra_eq S E a - (ratFuncToExactConstantExtension_algebraMap C S N hExact) - let e := integralClosureAlgEquivRatFuncFiniteOfEq - S E a hAlgebra - have hDifferent : - differentIdeal S[X] (RatFuncFiniteIntegralClosure S E) = - Ideal.map e - (differentIdeal S[X] (integralClosure S[X] E)) := - finiteNormalization_differentIdeal_eq_map - a hAlgebra inferInstance inferInstance - have hUpstairs : - exactConstantExtensionUpstairsFinitePlace C S N hExact q = - heightOneSpectrumEquivOfAlgEquiv e q := by - simpa [e, a, hAlgebra, - integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] using - (exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTransport - C S N hExact q) - rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] - simp only [exactConstantExtensionPresentedUpstairsPlace, - exactConstantExtensionPresentedDownstairsPlace, - finiteExtensionTotalDifferentEffectiveDivisor_inl] - rw [hUpstairs, hDifferent] - rw [finiteNormalization_multiplicity_map_eq - a hAlgebra q - (differentIdeal S[X] (integralClosure S[X] E))] - rw [exactConstantExtension_finiteDifferent_eq_map C S N hExact] - let P := exactConstantExtensionDownstairsFinitePlace C S N hExact q - let : q.asIdeal.LiesOver P.asIdeal := ⟨by - change P.asIdeal = q.asIdeal.comap (algebraMap R2 B) - rfl⟩ - have hDifferentBase : - differentIdeal C[X] R2 ≠ ⊥ := - finiteExtensionFiniteDifferentIdeal_ne_bot C N - calc - multiplicity q.asIdeal - (Ideal.map (algebraMap R2 B) - (differentIdeal C[X] R2)) = - q.asIdeal.ramificationIdx R2 * - multiplicity P.asIdeal (differentIdeal C[X] R2) := - multiplicity_map_eq_ramificationIdx_mul - (R := R2) (S := B) P q - (differentIdeal C[X] R2) hDifferentBase - _ = multiplicity P.asIdeal (differentIdeal C[X] R2) := by - have hRam : q.asIdeal.ramificationIdx R2 = 1 := by - exact exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one - C S N hExact q - rw [hRam] - simpa only [one_mul] - | inr q => - rw [exactConstantExtensionPresentedUpstairsPlaceEquiv_apply] - simp only [exactConstantExtensionPresentedUpstairsPlace, - exactConstantExtensionPresentedDownstairsPlace, - finiteExtensionTotalDifferentEffectiveDivisor_inr] - let A := RatFuncInfinityIntegers C - let R1 := RatFuncInfinityIntegers S - let R2 := RatFuncInfinityIntegralClosure C N - let B := RatFuncInfinityIntegralClosure S E - let : Algebra N E := exactConstantExtensionAlgebra C N S - let : SMul N E := Algebra.toSMul - let : Module N E := Algebra.toModule - let : IsScalarTower (RatFunc C) N E := - exactConstantExtensionBaseTower C (RatFunc C) N S - let : Algebra A (RatFunc C) := Algebra.ofSubsemiring A - let : SMul A (RatFunc C) := Algebra.toSMul - let : Module A (RatFunc C) := Algebra.toModule - let : IsFractionRing A (RatFunc C) := - IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv C) - let : Algebra R1 (RatFunc S) := Algebra.ofSubsemiring R1 - let : SMul R1 (RatFunc S) := Algebra.toSMul - let : Module R1 (RatFunc S) := Algebra.toModule - let : IsFractionRing R1 (RatFunc S) := - IsFractionRing.of_algEquiv (ratFuncInfinityFractionRingEquiv S) - let : Algebra A N := Algebra.ofSubsemiring A - let : SMul A N := Algebra.toSMul - let : Module A N := Algebra.toModule - let : IsScalarTower A (RatFunc C) N := - IsScalarTower.of_algebraMap_eq' rfl - let : Algebra R1 E := Algebra.ofSubsemiring R1 - let : SMul R1 E := Algebra.toSMul - let : Module R1 E := Algebra.toModule - let : IsScalarTower R1 (RatFunc S) E := - IsScalarTower.of_algebraMap_eq' rfl - let : Algebra A R1 := - RingHom.toAlgebra (ratFuncInfinityIntegersRingHom C S) - let : SMul A R1 := Algebra.toSMul - let : Module A R1 := Algebra.toModule - let : IsDedekindDomain R2 := - integralClosure.isDedekindDomain A (RatFunc C) N - let : IsDedekindDomain B := - integralClosure.isDedekindDomain R1 (RatFunc S) E - let : Algebra A R2 := inferInstance - let : SMul A R2 := Algebra.toSMul - let : Module A R2 := Algebra.toModule - let : Algebra R2 N := Algebra.ofSubsemiring R2 - let : SMul R2 N := Algebra.toSMul - let : Module R2 N := Algebra.toModule - let : IsScalarTower A R2 N := - IsScalarTower.of_algebraMap_eq' (by ext z; rfl) - let : IsIntegralClosure R2 A N := - integralClosure.isIntegralClosure A N - let : Module.Finite A R2 := - IsIntegralClosure.finite A (RatFunc C) N R2 - let : Module.IsTorsionFree A R2 := - IsIntegralClosure.isTorsionFree A N - let : Module.IsTorsionFree R1 E := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - exact (algebraMap (RatFunc S) E).injective.comp - (IsFractionRing.injective R1 (RatFunc S)) - let : Module.IsTorsionFree R1 B := - IsIntegralClosure.isTorsionFree R1 E - let : Algebra R2 B := - exactConstantExtensionInfinityNormalizationAlgebra C S N hExact - let : SMul R2 B := Algebra.toSMul - let : Module R2 B := Algebra.toModule - let : Module.IsTorsionFree R2 B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - exact normalization_map_injective Subtype.val Subtype.val - Subtype.val_injective - (exactConstantExtensionInfinityNormalizationAlgebra_coe C S N hExact) - let : IsFractionRing R2 N := - IsIntegralClosure.isFractionRing_of_finite_extension - A (RatFunc C) N R2 - rw [exactConstantExtension_infinityDifferent_eq_map C S N hExact] - let w := exactConstantExtensionUpstairsInfinityPlace - C S N hExact q.1 q.2 - let wH := primeOverHeightOne (ratFuncInfinityPlace S) w - let P := exactConstantExtensionDownstairsInfinityPlace C S N q.1 q.2 - let pH := primeOverHeightOne (ratFuncInfinityPlace C) P - let : wH.asIdeal.LiesOver pH.asIdeal := ⟨by - change P.1 = w.1.comap (algebraMap R2 B) - exact (exactConstantExtensionUpstairsInfinityPlace_under - C S N hExact q).symm⟩ - have hDifferentBase : - differentIdeal (RatFuncInfinityIntegers C) R2 ≠ ⊥ := - different_ne_bot_of_fraction_fields A R2 (RatFunc C) N - calc - multiplicity w.1 - (Ideal.map (algebraMap R2 B) - (differentIdeal (RatFuncInfinityIntegers C) R2)) = - w.1.ramificationIdx R2 * - multiplicity pH.asIdeal - (differentIdeal (RatFuncInfinityIntegers C) R2) := by - exact multiplicity_map_eq_ramificationIdx_mul - (R := R2) (S := B) pH wH - (differentIdeal (RatFuncInfinityIntegers C) R2) hDifferentBase - _ = multiplicity P.1 - (differentIdeal (RatFuncInfinityIntegers C) R2) := by - change w.1.ramificationIdx R2 * - multiplicity P.1 (differentIdeal A R2) = - multiplicity P.1 (differentIdeal A R2) - have hRam : w.1.ramificationIdx R2 = 1 := - exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one - C S N hExact q - rw [hRam] - simpa only [one_mul] + | inl q => exact exactConstantExtension_presented_totalDifferentMultiplicity_eq_finite C S N hExact q + | inr q => exact exactConstantExtension_presented_totalDifferentMultiplicity_eq_infinity C S N hExact q /-- Exact finite extension of the full constant field preserves intrinsic function-field genus. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean index 9622f100a5..745debf4c7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean @@ -229,8 +229,7 @@ theorem exactConstantExtension_rationalFunctionRanges_linearDisjoint : have hsup : F₁ ⊔ F₂ = ⊤ := by apply top_unique intro z _ - induction z using TensorProduct.induction_on with - | zero => exact (F₁ ⊔ F₂).zero_mem + induction z using TensorProduct.inductionOn with | tmul s n => rw [show s ⊗ₜ[C] n = (s ⊗ₜ[C] 1) * (1 ⊗ₜ[C] n) by simp] apply (F₁ ⊔ F₂).mul_mem diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index 3e5f93d757..5d7ac35303 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -91,8 +91,7 @@ private theorem finiteFieldConstantExtensionIntegralClosureAlgEquiv_apply_eq_pol (z : S ⊗[C] integralClosure C[X] N) : finiteFieldConstantExtensionIntegralClosureAlgEquiv C S N z = finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N z := by - induction z using TensorProduct.induction_on with - | zero => exact map_zero _ + induction z using TensorProduct.inductionOn with | tmul s a => apply Subtype.ext rw [finiteFieldConstantExtensionIntegralClosureAlgEquiv_tmul, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 9ccdd45886..91a66a1439 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -1634,8 +1634,7 @@ theorem exactConstantExtensionFrobeniusTwist_restrictScalars_apply exactConstantExtensionBaseAlgebra C L N S let : SMul L (ExactConstantExtension C N S) := Algebra.toSMul let : Module L (ExactConstantExtension C N S) := Algebra.toModule - induction x using TensorProduct.induction_on with - | zero => simp + induction x using TensorProduct.inductionOn with | tmul s n => simp [exactConstantExtensionFrobeniusTwist, exactConstantExtensionCombinedAutHom, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean index fc438ef90a..194b2d8ef0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean @@ -18,6 +18,12 @@ uniform aggregate error independent of the auxiliary constant extension. namespace BGS.HasseWeil +private theorem finrank_mul_finrank_of_fields + (K F E : Type*) [Field K] [Field F] [Field E] + [Algebra K F] [Algebra K E] [Algebra F E] [IsScalarTower K F E] : + Module.finrank K F * Module.finrank F E = Module.finrank K E := + Module.finrank_mul_finrank K F E + noncomputable section open BGS.CorvajaZannier @@ -205,11 +211,11 @@ theorem intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le_original_fi Module.finrank (RatFunc C) Fₗ := rationalInfinityPlace_card_le_finrank C Fₗ _ = Module.finrank (RatFunc C) L * Module.finrank L Fₗ := - (Module.finrank_mul_finrank (RatFunc C) L Fₗ).symm + (finrank_mul_finrank_of_fields (RatFunc C) L Fₗ).symm _ = Module.finrank (RatFunc C) L * Module.finrank L N := by rw [finrank_frobeniusTwistField_over_base C L N S hExact g hdivL] _ = Module.finrank (RatFunc C) N := - Module.finrank_mul_finrank (RatFunc C) L N + finrank_mul_finrank_of_fields (RatFunc C) L N /-- Rational infinity places of the intermediate field itself are bounded by the original degree. -/ @@ -221,7 +227,7 @@ theorem intermediateBaseRationalInfinityPlaceCount_le_original_finrank : Module.finrank (RatFunc C) L := rationalInfinityPlace_card_le_finrank C L _ ≤ Module.finrank (RatFunc C) N := by apply Nat.le_of_dvd Module.finrank_pos - rw [← Module.finrank_mul_finrank (RatFunc C) L N] + rw [← finrank_mul_finrank_of_fields (RatFunc C) L N] exact dvd_mul_right _ _ /-- The total infinity contribution of the twists is bounded by the group @@ -306,7 +312,7 @@ theorem abs_sum_intermediateFrobeniusTwistFieldRationalPlaceCount_sub_card_mul_b dsimp only [G, D] rw [IsGalois.card_aut_eq_finrank] apply Nat.le_of_dvd Module.finrank_pos - rw [← Module.finrank_mul_finrank (RatFunc C) L N] + rw [← finrank_mul_finrank_of_fields (RatFunc C) L N] exact dvd_mul_left _ _ rw [herr] have hIₗ' : (Iₗ : ℝ) ≤ (G : ℝ) * D := by exact_mod_cast hIₗ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean index a7f98494ca..4bd7fb4c27 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean @@ -72,8 +72,7 @@ theorem finiteField_finrank_eq_lcm_of_tensorLift_surjective have hTensor (y : S ⊗[C] K) : φ (Algebra.TensorProduct.lift f g hfg y) = Algebra.TensorProduct.lift f g hfg y := by - induction y using TensorProduct.induction_on with - | zero => simp + induction y using TensorProduct.inductionOn with | tmul s k => rw [Algebra.TensorProduct.lift_tmul, map_mul, hφ, hφ] have hs : (f s) ^ (q ^ l) = f s := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean index dc3f0f0a06..82ce7d285b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -11,6 +11,13 @@ import Mathlib.RingTheory.PowerSeries.Inverse import Mathlib.RingTheory.PowerSeries.Substitution import Mathlib.RingTheory.PowerSeries.WellKnown +/-! +# Formal logarithmic derivatives of zeta functions + +Recover point-count coefficients from logarithmic derivatives of formal zeta series and their +linear factors. +-/ + namespace BGS.HasseWeil open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean index 929b825011..a8bfc764b1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean @@ -97,8 +97,7 @@ theorem tensorFractionLocalizationEquiv_algebraMap (z : TensorBase K E A) : tensorFractionLocalizationEquiv K E A (algebraMap (TensorBase K E A) (TensorFraction K E A) z) = algebraMap (TensorBase K E A) (TensorBaseLocalization K E A) z := by - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | tmul e a => exact IsLocalization.tensorProductEquivOfMapIncludeRight_tmul A A⁰ (FractionRing A) (TensorBaseLocalization K E A) e a diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean index 3fef123e15..f2bd505bdf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean @@ -11,6 +11,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity import Mathlib.FieldTheory.Finiteness +/-! +# Leading coefficients at a single place + +Compare residue-field degrees and lift constant residues through the local rings of finite and +infinite places. +-/ + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean index 1f8bd1cd7b..21ad5e3891 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean @@ -252,11 +252,7 @@ theorem exists_planeCurve_onePointStepanovAuxiliary_of_degree_one have hPoleNat : 0 < (finiteExtensionPoleDivisor K L x Q).toNat := by have hPole : 0 < finiteExtensionPoleDivisor K L x Q := by simpa only [L, x, Q] using hPpole - have hcast : (0 : ℤ) < - (((finiteExtensionPoleDivisor K L x Q).toNat : ℕ) : ℤ) := by - rw [Int.toNat_of_nonneg hPole.le] - exact hPole - exact_mod_cast hcast + omega have hNM : N ≤ M := by rw [hMformula'] have hbase : N ≤ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean index 34e0c7c339..0b5cfaf1de 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean @@ -232,8 +232,7 @@ private theorem constantTensorToPolynomialTensor_leftInverse : AlgHom.id S (PolynomialTensor C S A) := by apply AlgHom.ext intro z - induction z using TensorProduct.induction_on with - | zero => simp + induction z using TensorProduct.inductionOn with | add x y hx hy => simp only [map_add, hx, hy] | tmul p a => change constantTensorToPolynomialTensor C S A diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean index 42c55619b0..69bd894e26 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean @@ -4,6 +4,8 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.RingTheory.RamificationInertia.Basic +import Mathlib.LinearAlgebra.Dimension.Localization import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch /-! @@ -64,6 +66,27 @@ noncomputable def ratFuncIdentityInfinityPlace : FiniteExtensionInfinityPlace K (RatFunc K) := Classical.choice inferInstance +private theorem inertiaDegree_le_fractionField_finrank + (R S K L : Type*) [CommRing R] [IsDomain R] [CommRing S] + [Field K] [Field L] [Algebra R S] [Module.Finite R S] [Module.Flat R S] + [Algebra R K] [Algebra S L] [Algebra R L] [Algebra K L] + [IsScalarTower R K L] [IsScalarTower R S L] + [IsFractionRing R K] [IsFractionRing S L] + (p : Ideal R) [p.IsPrime] [Finite (p.primesOver S)] + (q : Ideal S) [q.IsPrime] [q.LiesOver p] : + q.inertiaDeg R ≤ Module.finrank K L := by + let : Fintype (p.primesOver S) := Fintype.ofFinite _ + let Q : p.primesOver S := ⟨q, inferInstance, inferInstance⟩ + calc + q.inertiaDeg R ≤ q.ramificationIdx R * q.inertiaDeg R := + Nat.le_mul_of_pos_left _ (Ideal.ramificationIdx_pos q R) + _ ≤ ∑ Q : p.primesOver S, Q.1.ramificationIdx R * Q.1.inertiaDeg R := + Finset.single_le_sum + (f := fun Q : p.primesOver S => Q.1.ramificationIdx R * Q.1.inertiaDeg R) + (fun _ _ => Nat.zero_le _) (Finset.mem_univ Q) + _ = Module.finrank R S := Ideal.sum_ramification_inertia_eq_finrank p S + _ = Module.finrank K L := (IsFractionRing.finrank_eq R K S L).symm + omit [Fintype K] in /-- The chosen identity-extension infinity place has residue degree one. -/ theorem ratFuncIdentityInfinityPlace_degree_eq_one : @@ -75,14 +98,13 @@ theorem ratFuncIdentityInfinityPlace_degree_eq_one : Ideal.inertiaDeg_pos P.1 (RatFuncInfinityIntegers K) let : P.1.IsPrime := P.2.1 let : P.1.LiesOver (ratFuncInfinityPlace K).asIdeal := P.2.2 - let : (ratFuncInfinityPlace K).asIdeal.IsMaximal := - (ratFuncInfinityPlace K).isPrime.isMaximal (ratFuncInfinityPlace K).ne_bot - have hle : (ratFuncInfinityPlace K).asIdeal.inertiaDeg' P.1 ≤ - Module.finrank (RatFunc K) (RatFunc K) := by - exact Ideal.inertiaDeg_le_finrank - (RatFuncInfinityIntegralClosure K (RatFunc K)) - (RatFunc K) (RatFunc K) P.1 (ratFuncInfinityPlace K).ne_bot - rw [inertiaDeg_eq_of_isMaximal, Module.finrank_self] at hle + let : Fintype (FiniteExtensionInfinityPlace K (RatFunc K)) := + Set.Finite.fintype (IsDedekindDomain.primesOver_finite + (ratFuncInfinityPlace K).asIdeal (RatFuncInfinityIntegralClosure K (RatFunc K))) + have hle := inertiaDegree_le_fractionField_finrank + (RatFuncInfinityIntegers K) (RatFuncInfinityIntegralClosure K (RatFunc K)) + (RatFunc K) (RatFunc K) (ratFuncInfinityPlace K).asIdeal P.1 + rw [Module.finrank_self] at hle omega /-- The chosen infinity place in the Riemann--Roch two-chart place model. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean index 50d6274eba..07fe5fcbf4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean @@ -11,6 +11,13 @@ import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePri import Mathlib.RingTheory.Finiteness.Finsupp import Mathlib.Tactic +/-! +# Riemann-space increments at finite places + +Use a normalized local lift and its leading residue to bound the dimension increase when one +finite place is added to a divisor. +-/ + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -93,6 +100,35 @@ theorem mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap end LocalLift +/-- A normalized lift has zero residue exactly when its local order is positive. -/ +theorem localNormalizedLift_mem_maximalIdeal_iff + {K R L : Type*} [Field K] [CommRing R] + [IsDedekindDomain R] [IsDiscreteValuationRing R] + [Field L] [Algebra K R] [Algebra R L] [Algebra K L] + [IsScalarTower K R L] [IsFractionRing R L] + (T : Submodule K L) (a : L) + (hregular : ∀ x : T, ∃ r : R, a * x.1 = algebraMap R L r) (x : T) : + localNormalizedLift T a hregular x ∈ IsLocalRing.maximalIdeal R ↔ + (1 : WithTop ℤ) ≤ finitePlaceOrderTop + (IsDiscreteValuationRing.maximalIdeal R) (a * x.1) := by + rw [localNormalizedLift_spec (R := R) T a hregular x] + let r := localNormalizedLift (R := R) T a hregular x + by_cases hr : r = 0 + · simp only [show localNormalizedLift T a hregular x = 0 from hr, + map_zero, Submodule.zero_mem, true_iff] + simp [finitePlaceOrderTop] + · have hrMap : algebraMap R L r ≠ 0 := + by simpa using (IsFractionRing.injective R L).ne hr + rw [finitePlaceOrderTop_eq_coe _ _ hrMap] + constructor + · intro hmem + exact_mod_cast one_le_finitePlaceOrder_algebraMap_of_mem (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) r hmem hr + · intro horder + exact mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap (R := R) (L := L) + (IsDiscreteValuationRing.maximalIdeal R) r (by exact_mod_cast horder) + + section PlaceDegree variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] @@ -208,9 +244,6 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ let πL : L := algebraMap R L π - have hπLNe : πL ≠ 0 := by - dsimp [πL] - simpa using (IsFractionRing.injective R L).ne hπ.ne_zero have hπOrder : finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q πL = (1 : WithTop ℤ) := by @@ -265,39 +298,15 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment by_cases hv : v = Q <;> simp [hv] have hkerPoint (x : T) : f x = 0 ↔ x.1 ∈ S := by rw [localLeadingResidueLinearMap_eq_zero_iff - (K := K) (R := R) (L := L) T a hregular] + (K := K) (R := R) (L := L) T a hregular, + localNormalizedLift_mem_maximalIdeal_iff] constructor - · intro hrMem + · intro haxOrder + change (1 : WithTop ℤ) ≤ + finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (a * x.1) at haxOrder by_cases hx0 : x.1 = 0 · simpa [hx0] using S.zero_mem - · have hrNe : localNormalizedLift (R := R) T a hregular x ≠ 0 := by - intro hr0 - have hax0 : a * x.1 = 0 := by - rw [localNormalizedLift_spec (R := R) T a hregular x, - hr0, map_zero] - exact hx0 ((mul_eq_zero.mp hax0).resolve_left (pow_ne_zero _ hπLNe)) - have hrOrder : - (1 : ℤ) ≤ finitePlaceOrder - (IsDiscreteValuationRing.maximalIdeal R) - (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) := - one_le_finitePlaceOrder_algebraMap_of_mem - (R := R) (L := L) - (IsDiscreteValuationRing.maximalIdeal R) - (localNormalizedLift (R := R) T a hregular x) hrMem hrNe - have hrMapNe : - algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := - by simpa using (IsFractionRing.injective R L).ne hrNe - have haxOrder : - (1 : WithTop ℤ) ≤ - finiteExtensionFinitePlaceLocalOrderTop - (K := K) (L := L) q (a * x.1) := by - rw [localNormalizedLift_spec (R := R) T a hregular x] - change (1 : WithTop ℤ) ≤ finitePlaceOrderTop - (IsDiscreteValuationRing.maximalIdeal R) - (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) - rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] - exact_mod_cast hrOrder - have hxQ : + · have hxQ : 0 ≤ finiteExtensionPrincipalDivisor K L x.1 Q + D Q := by rw [finiteExtensionFinitePlaceLocalOrderTop_mul, show a = πL ^ (m + 1) by rfl, @@ -327,12 +336,7 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment simpa using hxv · intro hxS by_cases hx0 : x.1 = 0 - · have hlift0 : localNormalizedLift (R := R) T a hregular x = 0 := by - apply IsFractionRing.injective R L - rw [map_zero, - ← localNormalizedLift_spec (R := R) T a hregular x] - simp [hx0] - simpa [hlift0] + · simp [hx0, finitePlaceOrderTop] · have hxmem := (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp hxS rcases hxmem with hxmem | ⟨_, hxorders⟩ @@ -354,21 +358,7 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment finiteExtensionPrincipalDivisor K L x.1 Q by rw [hm] omega) - rw [localNormalizedLift_spec (R := R) T a hregular x] at haxOrder - by_cases hr0 : localNormalizedLift (R := R) T a hregular x = 0 - · simpa [hr0] - · apply mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap - (R := R) (L := L) - (IsDiscreteValuationRing.maximalIdeal R) - (localNormalizedLift (R := R) T a hregular x) - have hrMapNe : - algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := - by simpa using (IsFractionRing.injective R L).ne hr0 - change (1 : WithTop ℤ) ≤ finitePlaceOrderTop - (IsDiscreteValuationRing.maximalIdeal R) - (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) at haxOrder - rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] at haxOrder - exact_mod_cast haxOrder + exact haxOrder have hker : f.ker = Submodule.comap T.subtype S := by ext x rw [LinearMap.mem_ker, Submodule.mem_comap] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean index a247ef8825..337f4e4097 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean @@ -6,6 +6,13 @@ Authors: Yuma Mizuno import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +/-! +# Riemann-space increments at infinity + +Identify the kernel of the leading-residue map and bound the dimension increase by the degree of +an infinite place. +-/ + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -183,9 +190,6 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment (IsDiscreteValuationRing.maximalIdeal R).asIdeal = Ideal.span {π} := (IsDiscreteValuationRing.irreducible_iff_uniformizer π).mp hπ let πL : L := algebraMap R L π - have hπLNe : πL ≠ 0 := by - dsimp [πL] - simpa using (IsFractionRing.injective R L).ne hπ.ne_zero have hπOrder : finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P πL = (1 : WithTop ℤ) := by @@ -245,39 +249,15 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment by_cases hv : v = Q <;> simp [hv] have hkerPoint (x : T) : f x = 0 ↔ x.1 ∈ S := by rw [localLeadingResidueLinearMap_eq_zero_iff - (K := K) (R := R) (L := L) T a hregular] + (K := K) (R := R) (L := L) T a hregular, + localNormalizedLift_mem_maximalIdeal_iff] constructor - · intro hrMem + · intro haxOrder + change (1 : WithTop ℤ) ≤ + finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (a * x.1) at haxOrder by_cases hx0 : x.1 = 0 · simpa [hx0] using S.zero_mem - · have hrNe : localNormalizedLift (R := R) T a hregular x ≠ 0 := by - intro hr0 - have hax0 : a * x.1 = 0 := by - rw [localNormalizedLift_spec (R := R) T a hregular x, - hr0, map_zero] - exact hx0 ((mul_eq_zero.mp hax0).resolve_left (pow_ne_zero _ hπLNe)) - have hrOrder : - (1 : ℤ) ≤ finitePlaceOrder - (IsDiscreteValuationRing.maximalIdeal R) - (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) := - one_le_finitePlaceOrder_algebraMap_of_mem - (R := R) (L := L) - (IsDiscreteValuationRing.maximalIdeal R) - (localNormalizedLift (R := R) T a hregular x) hrMem hrNe - have hrMapNe : - algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := - by simpa using (IsFractionRing.injective R L).ne hrNe - have haxOrder : - (1 : WithTop ℤ) ≤ - finiteExtensionInfinityPlaceLocalOrderTop - (K := K) (L := L) P (a * x.1) := by - rw [localNormalizedLift_spec (R := R) T a hregular x] - change (1 : WithTop ℤ) ≤ finitePlaceOrderTop - (IsDiscreteValuationRing.maximalIdeal R) - (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) - rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] - exact_mod_cast hrOrder - have hxQ : + · have hxQ : 0 ≤ finiteExtensionPrincipalDivisor K L x.1 Q + D Q := by rw [finiteExtensionInfinityPlaceLocalOrderTop_mul, show a = πL ^ (m + 1) by rfl, @@ -308,13 +288,7 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment simpa using hxv · intro hxS by_cases hx0 : x.1 = 0 - · have hlift0 : localNormalizedLift (R := R) T a hregular x = 0 := by - apply IsFractionRing.injective R L - rw [map_zero, - ← localNormalizedLift_spec (R := R) T a hregular x] - simp [hx0] - rw [hlift0] - exact (IsLocalRing.maximalIdeal R).zero_mem + · simp [hx0, finitePlaceOrderTop] · have hxmem := (mem_finiteExtensionRiemannSpace (K := K) (L := L)).mp hxS rcases hxmem with hxmem | ⟨_, hxorders⟩ @@ -337,22 +311,7 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment finiteExtensionPrincipalDivisor K L x.1 Q by rw [hm] omega) - rw [localNormalizedLift_spec (R := R) T a hregular x] at haxOrder - by_cases hr0 : localNormalizedLift (R := R) T a hregular x = 0 - · rw [hr0] - exact (IsLocalRing.maximalIdeal R).zero_mem - · apply mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap - (R := R) (L := L) - (IsDiscreteValuationRing.maximalIdeal R) - (localNormalizedLift (R := R) T a hregular x) - have hrMapNe : - algebraMap R L (localNormalizedLift (R := R) T a hregular x) ≠ 0 := - by simpa using (IsFractionRing.injective R L).ne hr0 - change (1 : WithTop ℤ) ≤ finitePlaceOrderTop - (IsDiscreteValuationRing.maximalIdeal R) - (algebraMap R L (localNormalizedLift (R := R) T a hregular x)) at haxOrder - rw [finitePlaceOrderTop_eq_coe _ _ hrMapNe] at haxOrder - exact_mod_cast haxOrder + exact haxOrder have hker : f.ker = Submodule.comap T.subtype S := by ext x rw [LinearMap.mem_ker, Submodule.mem_comap] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean index ac098b3454..b18d1b699b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Order.Interval.Set.Nat import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean index 24e8d810d5..324e296247 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean @@ -6,6 +6,13 @@ Authors: Yuma Mizuno import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +/-! +# Divisor estimates in the middle-game range + +Choose eventual thresholds where divisor counts satisfy the real-power bounds required by the +middle-game argument. +-/ + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean index c2e80b0032..a4f5e9d5bd 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean @@ -6,6 +6,13 @@ Authors: Yuma Mizuno import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed +/-! +# Compatible powers of a common primitive root + +Represent several torsion elements as powers of one primitive root under the required order +divisibility conditions. +-/ + namespace BGS.Markoff variable {K : Type*} [Field K] [IsAlgClosed K] [CharZero K] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean index 482595f9d5..2e28589491 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean @@ -11,6 +11,13 @@ import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +/-! +# Torsion traces forced by finite Markoff orbits + +Use returns of coordinate rotations to obtain torsion traces and rule out finite complex orbits +away from the origin. +-/ + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean index fb0cc51e48..5463f70aca 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean @@ -7,6 +7,13 @@ Authors: Yuma Mizuno import Mathlib.Data.Nat.Totient import Mathlib.Data.Nat.GCD.Basic +/-! +# Arithmetic bounds for three torsion orders + +Bound the least common multiple of three orders by the cube of their maximum and transfer the +resulting modulus estimate. +-/ + namespace BGS.Markoff /-- The totient exponent is no larger than the conductor exponent. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean index 2c68b3945b..4af591d991 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean @@ -7,6 +7,13 @@ Authors: Yuma Mizuno import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +/-! +# Cardinality of coordinate-rotation orbits + +Embed coordinate-rotation cycles in the full normalized Markoff orbit and compare their +cardinalities. +-/ + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean index dcf203fcfa..3a26630607 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean @@ -4,6 +4,7 @@ Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +import Mathlib.Data.Nat.GCD.Prime import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean index 864d09d815..74d70e5b61 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean @@ -100,7 +100,7 @@ theorem capTable_oddPrimeFloors_prod_le_jointOddPrimeList_prod exact (List.getElem_take' hactualIndex hfloorIndex).symm rw [htakeEq] exact hcapEq.le.trans hbound - have hprefix := hpointwise.List.Forall₂.prod_le_prod + have hprefix := hpointwise.prod_le_prod have htakeSublist : List.Sublist (actual.take table.oddPrimeFloors.length) actual := List.take_sublist _ _ @@ -109,7 +109,7 @@ theorem capTable_oddPrimeFloors_prod_le_jointOddPrimeList_prod rcases (mem_jointOddPrimeList.mp hprime).2 with hminus | hplus · exact (Nat.prime_of_mem_primeFactors hminus).one_le · exact (Nat.prime_of_mem_primeFactors hplus).one_le - exact hprefix.trans (htakeSublist.List.Sublist.prod_le_prod hactualOne) + exact hprefix.trans (htakeSublist.prod_le_prod hactualOne) theorem jointOddPrimeList_length_lt_of_capTable_prod_gt {p : ℕ} {table : RankinPositionalCapTable} diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean index 06b7153660..fb7effda35 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean @@ -6,6 +6,13 @@ Authors: Yuma Mizuno import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization +/-! +# Certificates for neighboring Rankin profiles + +Define rational weight caps and finite profile checks, and connect the Boolean checks with their +mathematical validity predicates. +-/ + namespace BGS.NumberTheory structure RationalPrimeWeightCap where diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean index ab5f47aa64..0491ca5e22 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean @@ -10,6 +10,13 @@ import Mathlib.NumberTheory.ArithmeticFunction.Misc import Mathlib.Data.Nat.Factorization.Basic import Mathlib.Tactic +/-! +# Rankin factorization of weighted totient sums + +Express the multiplicative weighted totient sum as a product over prime powers and bound its +local Rankin factors. +-/ + namespace BGS.NumberTheory open ArithmeticFunction diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean index 897a1d7750..ab3902dbe3 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Ramification.lean @@ -7,7 +7,8 @@ Authors: Guanghao Li module public import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar -public import Mathlib.NumberTheory.RamificationInertia.Basic +public import Mathlib.RingTheory.RamificationInertia.Basic +public import Mathlib.LinearAlgebra.Dimension.Localization public import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas public import Mathlib.RingTheory.Valuation.Discrete.Basic public import Mathlib.RingTheory.IntegralClosure.Algebra.Basic @@ -29,6 +30,30 @@ noncomputable section namespace FunctionField.Chart +private theorem ramificationSum_eq_fractionField_finrank + (R S K L : Type*) [CommRing R] [IsDomain R] [CommRing S] + [IsDedekindDomain S] [Field K] [Field L] + [Algebra R S] [Module.Finite R S] [Module.Flat R S] [Module.IsTorsionFree R S] + [Algebra R K] [Algebra S L] [Algebra R L] [Algebra K L] + [IsScalarTower R K L] [IsScalarTower R S L] + [IsFractionRing R K] [IsFractionRing S L] + (p : Ideal R) [p.IsMaximal] (hp : p ≠ ⊥) : + (∑ q ∈ IsDedekindDomain.primesOverFinset p S, + p.ramificationIdx' q * q.inertiaDeg R) = Module.finrank K L := by + classical + rw [Finset.sum_subtype _ (fun q => IsDedekindDomain.mem_primesOverFinset_iff hp S)] + calc + (∑ q : p.primesOver S, p.ramificationIdx' q.1 * q.1.inertiaDeg R) = + ∑ q : p.primesOver S, q.1.ramificationIdx R * q.1.inertiaDeg R := by + apply Finset.sum_congr rfl + intro q _ + let : q.1.IsPrime := q.2.1 + let : q.1.LiesOver p := q.2.2 + rw [Ideal.ramificationIdx'_eq_ramificationIdx p q.1 hp] + _ = Module.finrank R S := Ideal.sum_ramification_inertia_eq_finrank p S + _ = Module.finrank K L := (IsFractionRing.finrank_eq R K S L).symm + + variable (k K : Type*) [Field k] [Field K] variable [Algebra k K] [Algebra k[X] K] [Algebra k⟮X⟯ K] [IsScalarTower k k[X] K] @@ -292,8 +317,7 @@ theorem deg_polarDivisor_XK_eq_primesOverFinset_sum : ∑ P ∈ IsDedekindDomain.primesOverFinset (IsLocalRing.maximalIdeal (inftyValuationSubring k)) (infiniteIntegers k K), (ramIdxInfty k K P : ℤ) * - (Ideal.inertiaDeg' - (IsLocalRing.maximalIdeal (inftyValuationSubring k)) P : ℤ) := by + (P.inertiaDeg (inftyValuationSubring k) : ℤ) := by classical rw [deg, Finsupp.sum] let A := inftyValuationSubring k @@ -351,18 +375,8 @@ theorem deg_polarDivisor_XK_eq_primesOverFinset_sum : simp only [Finset.mem_filter, pred, inftyIdealOfPlace] at hv ⊢ rcases v with v | v · simp at hv - · have hpw : v.asIdeal.under A = p := - IsLocalRing.eq_maximalIdeal (Ideal.IsMaximal.under A v.asIdeal) - let : v.asIdeal.IsMaximal := v.isPrime.isMaximal v.ne_bot - let : p.IsMaximal := by - rw [← hpw] - exact Ideal.IsMaximal.under A v.asIdeal - let : v.asIdeal.LiesOver p := ⟨hpw.symm⟩ - have hinertia : - Ideal.inertiaDeg' p v.asIdeal = v.asIdeal.inertiaDeg A := - Ideal.inertiaDeg'_eq_inertiaDeg (p := p) (P := v.asIdeal) - rw [polarDivisor_XK_at_infinite k K v, ramIdxInfty, - placeDegree_infinite_eq_inertiaDeg, ← hinertia] + · rw [polarDivisor_XK_at_infinite k K v, ramIdxInfty, + placeDegree_infinite_eq_inertiaDeg] omit [IsFullConstantField k K] in /-- Stichtenoth 1.4.11 ramification half for the chart variable: `deg (X_K)_∞ ≤ [K : k(X)]`. -/ @@ -376,13 +390,13 @@ theorem deg_polarX_le_finrank : Ring.ne_bot_of_isMaximal_of_not_isField (IsLocalRing.maximalIdeal.isMaximal A) (IsDiscreteValuationRing.not_isField A) let : p.IsMaximal := IsLocalRing.maximalIdeal.isMaximal A - have hsum := Ideal.sum_ramification_inertia (R := A) (S := S) (K := k⟮X⟯) (L := K) hp + have hsum := ramificationSum_eq_fractionField_finrank A S k⟮X⟯ K p hp have heq : (∑ P ∈ IsDedekindDomain.primesOverFinset p S, - (ramIdxInfty k K P : ℤ) * (Ideal.inertiaDeg' p P : ℤ)) = + (ramIdxInfty k K P : ℤ) * (P.inertiaDeg A : ℤ)) = Module.finrank k⟮X⟯ K := by dsimp [ramIdxInfty] - norm_cast + exact_mod_cast hsum exact le_of_eq heq end FunctionField.Chart From f5e9723969f1f4442600bf8aa6f1e3c676769736 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 08:02:00 +0000 Subject: [PATCH 26/37] Repair Markoff normal-closure counts and refactor place averaging --- ...nsionFrobeniusTwistFinitePlaceAverage.lean | 109 +++--- ...onFrobeniusTwistFinitePlaceUnramified.lean | 68 +--- ...ionFrobeniusTwistInfinityPlaceDescent.lean | 66 ++-- ...robeniusTwistInfinityPlaceEquivalence.lean | 206 ++++------- ...diateFrobeniusTwistFinitePlaceAverage.lean | 322 +++++++----------- ...ctConstantExtensionNormalClosureTower.lean | 210 +++++++----- 6 files changed, 361 insertions(+), 620 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean index 419cab1213..700777033a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -567,6 +567,19 @@ abbrev FrobeniusTwistFinitePlaceFiberFixedBy (exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) +private theorem sigma_value_injective + {I A B : Type*} {V : I → Type*} + (index : I → A) (hindex : Function.Injective index) + (value : ∀ i, V i → B) (under : B → A) + (hunder : ∀ i x, under (value i x) = index i) + (hvalue : ∀ i, Function.Injective (value i)) : + Function.Injective (fun x : Sigma V => value x.1 x.2) := by + rintro ⟨i, x⟩ ⟨j, y⟩ h + have hij : i = j := hindex ((hunder i x).symm.trans ((congrArg under h).trans + (hunder j y))) + subst j + exact congrArg (Sigma.mk i) (hvalue i h) + /-- Rational finite places of one Frobenius-twist field are the disjoint union, over rational finite places of `C(X)`, of the ambient fixed top places in the corresponding restriction fiber. -/ @@ -574,84 +587,53 @@ noncomputable def frobeniusTwistField_rationalFinitePlace_equiv_sigma_fiberFixedBy (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) (g : N ≃ₐ[RatFunc C] N) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction (RatFunc C) + let : DistribMulAction (RatFunc C) (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + let : MulAction (RatFunc C) (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + let : IsGalois (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g FiniteExtensionRationalFinitePlace C F ≃ Σ P : RatFuncRationalFinitePlace C, FrobeniusTwistFinitePlaceFiberFixedBy C S N hExact g P := by + intro model0 model1 model2 model3 model4 model5 model6 model7 model8 F model10 model11 model12 + model13 model14 model15 model16 model17 model18 model19 model20 let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := - exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let F := exactConstantExtensionFrobeniusTwistField - C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := - SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := - finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := - isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - letI : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g let sigma := exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g let baseEquiv := ratFuncRationalFinitePlaceEquivFiniteExtension C @@ -676,20 +658,13 @@ noncomputable def C S N hExact hDegreeDiv Q hBase, ?_⟩ exact congrArg Subtype.val x.2.2 have hInjective : Function.Injective toAmbient := by - rintro ⟨P, x⟩ ⟨R, y⟩ hxy - have hQ : x.1.1 = y.1.1 := congrArg Subtype.val hxy - have hBase : (baseEquiv P).1 = (baseEquiv R).1 := by - calc - (baseEquiv P).1 = finitePlaceUnder C (RatFunc C) T x.1.1 := x.1.2.symm - _ = finitePlaceUnder C (RatFunc C) T y.1.1 := congrArg _ hQ - _ = (baseEquiv R).1 := y.1.2 - have hP : P = R := baseEquiv.injective (Subtype.ext hBase) - subst R - apply Sigma.ext (by rfl) - apply heq_of_eq - apply Subtype.ext - apply Subtype.ext - exact hQ + intro x y hxy + apply sigma_value_injective (fun P => (baseEquiv P).1) + (fun _ _ h => baseEquiv.injective (Subtype.ext h)) + (fun _ x => x.1.1) (finitePlaceUnder C (RatFunc C) T) + (fun _ x => x.1.2) + (fun _ _ _ h => Subtype.ext (Subtype.ext h)) + exact congrArg Subtype.val hxy have hSurjective : Function.Surjective toAmbient := by intro z let Q := z.1 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean index bea2df13d3..741f8e1b53 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean @@ -464,36 +464,9 @@ theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), finitePlaceRelativeRamificationIdx C F (ExactConstantExtension C N S) Q = 1 := by + intro model0 model1 model2 model3 model4 model5 F model7 model8 + model9 model10 model11 model12 model13 model14 model15 model16 model17 let T := ExactConstantExtension C N S - let : Field T := exactConstantExtensionField C N S hExact - let : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - let : SMul (RatFunc C) T := Algebra.toSMul - let : Module (RatFunc C) T := Algebra.toModule - let : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let F := exactConstantExtensionFrobeniusTwistField - C (RatFunc C) N S hExact g - let : Algebra (RatFunc C) F := - SubalgebraClass.toAlgebra F.toSubalgebra - let : SMul (RatFunc C) F := Algebra.toSMul - let : Module (RatFunc C) F := Algebra.toModule - let : FiniteDimensional (RatFunc C) F := - finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra.IsSeparable (RatFunc C) F := - isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra F T := F.toAlgebra - let : SMul F T := Algebra.toSMul - let : Module F T := Algebra.toModule - let : IsScalarTower (RatFunc C) F T := inferInstance - let : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - let : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g let : Algebra C[X] T := RingHom.toAlgebra ((algebraMap (RatFunc C) T).comp (algebraMap C[X] (RatFunc C))) @@ -529,7 +502,6 @@ theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one let : IsDedekindDomain A := inferInstance let : MulSemiringAction (T ≃ₐ[F] T) A := finiteIntegralClosureGalAction C F T - dsimp only intro Q let : Q.asIdeal.IsMaximal := Q.isMaximal rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C F T Q] @@ -883,41 +855,9 @@ theorem frobeniusTwistField_ambientFixed_finitePlace_under_degree_eq_one finiteExtensionPlaceDegree C F (.inl (finitePlaceUnder C F (ExactConstantExtension C N S) Q)) = 1 := by + intro model0 model1 model2 model3 model4 model5 model6 model7 model8 + F model10 model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 let T := ExactConstantExtension C N S - let : Field T := exactConstantExtensionField C N S hExact - let : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - let : SMul (RatFunc C) T := Algebra.toSMul - let : Module (RatFunc C) T := Algebra.toModule - let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - let : MulAction (RatFunc C) T := DistribMulAction.toMulAction - let : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let : IsGalois (RatFunc C) T := - exactConstantExtension_isGalois C (RatFunc C) N S hExact - let F := exactConstantExtensionFrobeniusTwistField - C (RatFunc C) N S hExact g - let : Algebra (RatFunc C) F := - SubalgebraClass.toAlgebra F.toSubalgebra - let : SMul (RatFunc C) F := Algebra.toSMul - let : Module (RatFunc C) F := Algebra.toModule - let : FiniteDimensional (RatFunc C) F := - finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra.IsSeparable (RatFunc C) F := - isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra F T := F.toAlgebra - let : SMul F T := Algebra.toSMul - let : Module F T := Algebra.toModule - let : IsScalarTower (RatFunc C) F T := inferInstance - let : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - let : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - dsimp only intro Q hdegree hfixed apply frobeniusTwistField_fixed_finitePlace_under_degree_eq_one C N S hExact g hdiv Q hdegree diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean index d39c8c441a..7b8fad05b8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean @@ -568,75 +568,48 @@ theorem frobeniusTwistField_infinityPlace_ramificationIdx_eq_one (⊥ : IntermediateField C N)) (g : N ≃ₐ[RatFunc C] N) (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g ∀ Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S), infinityPlaceRelativeRamificationIdx C F (ExactConstantExtension C N S) Q = 1 := by + intro model0 model1 model2 model3 model4 model5 F model7 model8 model9 model10 model11 model12 + model13 model14 model15 model16 model17 let T := ExactConstantExtension C N S - let : Field T := exactConstantExtensionField C N S hExact - let : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - let : SMul (RatFunc C) T := Algebra.toSMul - let : Module (RatFunc C) T := Algebra.toModule - let : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let F := exactConstantExtensionFrobeniusTwistField - C (RatFunc C) N S hExact g - let : Algebra (RatFunc C) F := - SubalgebraClass.toAlgebra F.toSubalgebra - let : SMul (RatFunc C) F := Algebra.toSMul - let : Module (RatFunc C) F := Algebra.toModule - let : FiniteDimensional (RatFunc C) F := - finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra.IsSeparable (RatFunc C) F := - isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra F T := F.toAlgebra - let : SMul F T := Algebra.toSMul - let : Module F T := Algebra.toModule - let : IsScalarTower (RatFunc C) F T := inferInstance - let : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - let : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g let V := RatFuncInfinityIntegers C let : Algebra V (RatFunc C) := RingHom.toAlgebra @@ -695,7 +668,6 @@ theorem frobeniusTwistField_infinityPlace_ramificationIdx_eq_one IsIntegralClosure.isDedekindDomain V (RatFunc C) T A let : MulSemiringAction (T ≃ₐ[F] T) A := infinityIntegralClosureGalAction C F T - dsimp only intro Q rw [← infinityPlaceInertiaGroup_card_eq_ramificationIdx C F T Q] have hInertia : infinityPlaceInertiaGroup C F T Q = ⊥ := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean index a21feb28cb..399919e3b7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean @@ -295,58 +295,58 @@ condition needed for infinity-place descent. -/ theorem frobeniusTwistField_ambientFixed_infinityPlace_under_degree_eq_one [IsGalois (RatFunc C) N] (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction (RatFunc C) + let : DistribMulAction (RatFunc C) (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + let : MulAction (RatFunc C) (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + let : IsGalois (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtension_isGalois C (RatFunc C) N S hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + let : MulAction (RatFunc C) F := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction F (ExactConstantExtension C N S) := + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : DistribMulAction F (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction F (ExactConstantExtension C N S) := + let : MulAction F (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : IsScalarTower (RatFunc C) F + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g ∀ (Q : FiniteExtensionInfinityPlace C (ExactConstantExtension C N S)), @@ -358,51 +358,10 @@ theorem frobeniusTwistField_ambientFixed_infinityPlace_under_degree_eq_one finiteExtensionPlaceDegree C F (.inr (infinityPlaceUnder C F (ExactConstantExtension C N S) Q)) = 1 := by - let : DecidableEq C := infinityBridgeDecidableEqConstants C - let : DecidableEq (RatFunc C) := - infinityBridgeDecidableEqRatFuncConstants C - let : DecidableEq S := infinityBridgeDecidableEqConstants S - let : DecidableEq (RatFunc S) := - infinityBridgeDecidableEqRatFuncConstants S + intro model0 model1 model2 model3 model4 model5 model6 model7 model8 model9 model10 model11 + model12 F model14 model15 model16 model17 model18 model19 model20 model21 model22 model23 + model24 model25 model26 model27 model28 let T := ExactConstantExtension C N S - let : Field T := exactConstantExtensionField C N S hExact - let : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - let : SMul (RatFunc C) T := Algebra.toSMul - let : Module (RatFunc C) T := Algebra.toModule - let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - let : MulAction (RatFunc C) T := DistribMulAction.toMulAction - let : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let : IsGalois (RatFunc C) T := - exactConstantExtension_isGalois C (RatFunc C) N S hExact - let F := exactConstantExtensionFrobeniusTwistField - C (RatFunc C) N S hExact g - let : Algebra (RatFunc C) F := - SubalgebraClass.toAlgebra F.toSubalgebra - let : SMul (RatFunc C) F := Algebra.toSMul - let : Module (RatFunc C) F := Algebra.toModule - let : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - let : MulAction (RatFunc C) F := DistribMulAction.toMulAction - let : FiniteDimensional (RatFunc C) F := - finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra.IsSeparable (RatFunc C) F := - isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - let : Algebra F T := F.toAlgebra - let : SMul F T := Algebra.toSMul - let : Module F T := Algebra.toModule - let : DistribMulAction F T := Module.toDistribMulAction - let : MulAction F T := DistribMulAction.toMulAction - let : IsScalarTower (RatFunc C) F T := inferInstance - let : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - let : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - dsimp only intro Q hdegree hfixed apply frobeniusTwistField_fixed_infinityPlace_under_degree_eq_one C N S hExact g hdiv Q hdegree @@ -416,58 +375,58 @@ noncomputable def frobeniusTwistField_rationalInfinityPlace_equiv_ambientFixedInfinityPlace [IsGalois (RatFunc C) N] (hdiv : Nat.card (N ≃ₐ[RatFunc C] N) ∣ Module.finrank C S) : - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := + let : DecidableEq C := infinityBridgeDecidableEqConstants C + let : DecidableEq (RatFunc C) := infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := + let : DecidableEq S := infinityBridgeDecidableEqConstants S + let : DecidableEq (RatFunc S) := infinityBridgeDecidableEqRatFuncConstants S - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction (RatFunc C) + let : DistribMulAction (RatFunc C) (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction (RatFunc C) (ExactConstantExtension C N S) := + let : MulAction (RatFunc C) (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) (ExactConstantExtension C N S) := + let : IsGalois (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtension_isGalois C (RatFunc C) N S hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : DistribMulAction (RatFunc C) F := Module.toDistribMulAction + let : MulAction (RatFunc C) F := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : DistribMulAction F (ExactConstantExtension C N S) := + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : DistribMulAction F (ExactConstantExtension C N S) := Module.toDistribMulAction - letI : MulAction F (ExactConstantExtension C N S) := + let : MulAction F (ExactConstantExtension C N S) := DistribMulAction.toMulAction - letI : IsScalarTower (RatFunc C) F + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := inferInstance - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g FiniteExtensionRationalInfinityPlace C F ≃ @@ -477,51 +436,10 @@ noncomputable def infinityPlaceGalSmul C (RatFunc C) (ExactConstantExtension C N S) (exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) Q = Q} := by - letI : DecidableEq C := infinityBridgeDecidableEqConstants C - letI : DecidableEq (RatFunc C) := - infinityBridgeDecidableEqRatFuncConstants C - letI : DecidableEq S := infinityBridgeDecidableEqConstants S - letI : DecidableEq (RatFunc S) := - infinityBridgeDecidableEqRatFuncConstants S + intro model0 model1 model2 model3 model4 model5 model6 model7 model8 model9 model10 model11 + model12 F model14 model15 model16 model17 model18 model19 model20 model21 model22 model23 + model24 model25 model26 model27 model28 let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := - exactConstantExtension_isGalois C (RatFunc C) N S hExact - let F := exactConstantExtensionFrobeniusTwistField - C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := - SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : DistribMulAction (RatFunc C) F := Module.toDistribMulAction - letI : MulAction (RatFunc C) F := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) F := - finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := - isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : DistribMulAction F T := Module.toDistribMulAction - letI : MulAction F T := DistribMulAction.toMulAction - letI : IsScalarTower (RatFunc C) F T := inferInstance - letI : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - letI : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C (RatFunc C) N S hExact g - dsimp only have hfinrank : Module.finrank F T = Module.finrank C S := finrank_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g hdiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 91a66a1439..46c2a4dd26 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -20,6 +20,42 @@ open scoped BigOperators Pointwise Polynomial TensorProduct namespace BGS.HasseWeil +open BGS.CorvajaZannier + +private theorem finitePlaceUnder_trans_of_fields + (C L F T : Type*) [Field C] [Field L] [Field F] [Field T] + [DecidableEq C] [DecidableEq (RatFunc C)] + [Algebra (RatFunc C) L] [Algebra (RatFunc C) F] [Algebra (RatFunc C) T] + [FiniteDimensional (RatFunc C) L] [FiniteDimensional (RatFunc C) F] + [FiniteDimensional (RatFunc C) T] + [Algebra.IsSeparable (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) F] + [Algebra.IsSeparable (RatFunc C) T] + [Algebra L F] [Algebra F T] [Algebra L T] + [IsScalarTower (RatFunc C) L F] [IsScalarTower (RatFunc C) L T] + [IsScalarTower (RatFunc C) F T] [IsScalarTower L F T] + (Q : FiniteExtensionFinitePlace C T) : + finitePlaceUnder C L F (finitePlaceUnder C F T Q) = finitePlaceUnder C L T Q := by + let R₀ := RatFuncFiniteIntegralClosure C L + let R₁ := RatFuncFiniteIntegralClosure C F + let R₂ := RatFuncFiniteIntegralClosure C T + let : Algebra R₀ R₁ := (finiteIntegralClosureMap C L F).toAlgebra + let : Algebra R₁ R₂ := (finiteIntegralClosureMap C F T).toAlgebra + let : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra + let : SMul R₀ R₁ := Algebra.toSMul + let : Module R₀ R₁ := Algebra.toModule + let : SMul R₁ R₂ := Algebra.toSMul + let : Module R₁ R₂ := Algebra.toModule + let : SMul R₀ R₂ := Algebra.toSMul + let : Module R₀ R₂ := Algebra.toModule + let : IsScalarTower R₀ R₁ R₂ := by + apply IsScalarTower.of_algebraMap_eq' + ext x + change algebraMap L T (x : L) = + algebraMap F T (algebraMap L F (x : L)) + exact IsScalarTower.algebraMap_apply L F T _ + apply IsDedekindDomain.HeightOneSpectrum.ext + exact Ideal.under_under Q.asIdeal + noncomputable section open BGS.CorvajaZannier @@ -405,87 +441,56 @@ intermediate-base Frobenius-twist fixed field. -/ theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one (g : N ≃ₐ[L] N) (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) : - letI : Field (ExactConstantExtension C N S) := + let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := + let : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) (ExactConstantExtension C N S) := + let : SMul (RatFunc C) (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module (RatFunc C) (ExactConstantExtension C N S) := + let : Module (RatFunc C) (ExactConstantExtension C N S) := Algebra.toModule - letI : FiniteDimensional (RatFunc C) + let : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) + let : Algebra.IsSeparable (RatFunc C) (ExactConstantExtension C N S) := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L (ExactConstantExtension C N S) := + let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra F (ExactConstantExtension C N S) := F.toAlgebra - letI : SMul F (ExactConstantExtension C N S) := Algebra.toSMul - letI : Module F (ExactConstantExtension C N S) := Algebra.toModule - letI : IsScalarTower (RatFunc C) F + let : Algebra F (ExactConstantExtension C N S) := F.toAlgebra + let : SMul F (ExactConstantExtension C N S) := Algebra.toSMul + let : Module F (ExactConstantExtension C N S) := Algebra.toModule + let : IsScalarTower (RatFunc C) F (ExactConstantExtension C N S) := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : FiniteDimensional F (ExactConstantExtension C N S) := + let : FiniteDimensional F (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C L N S hExact g - letI : IsGalois F (ExactConstantExtension C N S) := + let : IsGalois F (ExactConstantExtension C N S) := isGalois_exactConstantExtension_over_frobeniusTwistField C L N S hExact g ∀ Q : FiniteExtensionFinitePlace C (ExactConstantExtension C N S), finitePlaceRelativeRamificationIdx C F (ExactConstantExtension C N S) Q = 1 := by + intro model0 model1 model2 model3 model4 model5 model6 F model8 model9 model10 model11 model12 + model13 model14 model15 model16 model17 model18 let T := ExactConstantExtension C N S - let : Field T := exactConstantExtensionField C N S hExact - let : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - let : SMul (RatFunc C) T := Algebra.toSMul - let : Module (RatFunc C) T := Algebra.toModule - let : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S let : SMul L T := Algebra.toSMul let : Module L T := Algebra.toModule let : FiniteDimensional L T := - finiteDimensional_exactConstantExtension_over_intermediateBase - C S N L hExact - let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g + finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - let : Algebra (RatFunc C) F := - intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - let : SMul (RatFunc C) F := Algebra.toSMul - let : Module (RatFunc C) F := Algebra.toModule - let : FiniteDimensional (RatFunc C) F := - finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc - C S N hExact L g - let : Algebra.IsSeparable (RatFunc C) F := - isSeparable_intermediateFrobeniusTwistField_over_ratFunc - C S N hExact L g - let : Algebra F T := F.toAlgebra - let : SMul F T := Algebra.toSMul - let : Module F T := Algebra.toModule - let : IsScalarTower (RatFunc C) F T := - intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - let : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C L N S hExact g - let : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C L N S hExact g let : Algebra C[X] F := RingHom.toAlgebra ((algebraMap (RatFunc C) F).comp (algebraMap C[X] (RatFunc C))) @@ -525,7 +530,6 @@ theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one let : IsDedekindDomain A := inferInstance let : MulSemiringAction (T ≃ₐ[F] T) A := finiteIntegralClosureGalAction C F T - dsimp only intro Q let : Q.asIdeal.IsMaximal := Q.isMaximal rw [← finitePlaceInertiaGroup_card_eq_ramificationIdx C F T Q] @@ -1205,103 +1209,48 @@ direct restriction to `L`. -/ private theorem finitePlaceUnder_intermediateFrobeniusTwist_under (g : N ≃ₐ[L] N) : let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul L F := Algebra.toSMul - letI : Module L F := Algebra.toModule - letI : IsScalarTower (RatFunc C) L F := + let : SMul L F := Algebra.toSMul + let : Module L F := Algebra.toModule + let : IsScalarTower (RatFunc C) L F := IsScalarTower.of_algebraMap_eq' rfl - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g ∀ Q : FiniteExtensionFinitePlace C T, finitePlaceUnder C L F (finitePlaceUnder C F T Q) = finitePlaceUnder C L T Q := by - let T := ExactConstantExtension C N S - let : Field T := exactConstantExtensionField C N S hExact - let : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - let : SMul (RatFunc C) T := Algebra.toSMul - let : Module (RatFunc C) T := Algebra.toModule - let : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - let : SMul L T := Algebra.toSMul - let : Module L T := Algebra.toModule - let : IsScalarTower (RatFunc C) L T := - exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - let : Algebra (RatFunc C) F := - intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - let : SMul L F := Algebra.toSMul - let : Module L F := Algebra.toModule - let : IsScalarTower (RatFunc C) L F := - IsScalarTower.of_algebraMap_eq' rfl - let : SMul (RatFunc C) F := Algebra.toSMul - let : Module (RatFunc C) F := Algebra.toModule - let : FiniteDimensional (RatFunc C) F := - finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc - C S N hExact L g - let : Algebra.IsSeparable (RatFunc C) F := - isSeparable_intermediateFrobeniusTwistField_over_ratFunc - C S N hExact L g - let : Algebra F T := F.toAlgebra - let : SMul F T := Algebra.toSMul - let : Module F T := Algebra.toModule - let : IsScalarTower (RatFunc C) F T := - intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g + intro T model1 model2 model3 model4 model5 model6 model7 model8 model9 model10 F model12 model13 + model14 model15 model16 model17 model18 model19 model20 model21 model22 model23 model24 let : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl - let R₀ := RatFuncFiniteIntegralClosure C L - let R₁ := RatFuncFiniteIntegralClosure C F - let R₂ := RatFuncFiniteIntegralClosure C T - let : Algebra R₀ R₁ := (finiteIntegralClosureMap C L F).toAlgebra - let : Algebra R₁ R₂ := (finiteIntegralClosureMap C F T).toAlgebra - let : Algebra R₀ R₂ := (finiteIntegralClosureMap C L T).toAlgebra - let : SMul R₀ R₁ := Algebra.toSMul - let : Module R₀ R₁ := Algebra.toModule - let : SMul R₁ R₂ := Algebra.toSMul - let : Module R₁ R₂ := Algebra.toModule - let : SMul R₀ R₂ := Algebra.toSMul - let : Module R₀ R₂ := Algebra.toModule - let : IsScalarTower R₀ R₁ R₂ := by - apply IsScalarTower.of_algebraMap_eq' - ext x - change algebraMap L T (x : L) = - algebraMap F T (algebraMap L F (x : L)) - exact IsScalarTower.algebraMap_apply L F T _ - dsimp only - intro Q - apply IsDedekindDomain.HeightOneSpectrum.ext - exact Ideal.under_under Q.asIdeal + exact finitePlaceUnder_trans_of_fields C L F T /-- Rational finite places of one intermediate-base twist field are the disjoint union, over rational finite places of `L`, of fixed top places in @@ -1311,102 +1260,59 @@ noncomputable def (hdiv : Nat.card (N ≃ₐ[L] N) ∣ Module.finrank C S) (g : N ≃ₐ[L] N) : let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : FiniteDimensional L T := + let : FiniteDimensional L T := finiteDimensional_exactConstantExtension_over_intermediateBase C S N L hExact - letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact + let : IsGalois L T := exactConstantExtension_isGalois C L N S hExact let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul L F := Algebra.toSMul - letI : Module L F := Algebra.toModule - letI : IsScalarTower (RatFunc C) L F := + let : SMul L F := Algebra.toSMul + let : Module L F := Algebra.toModule + let : IsScalarTower (RatFunc C) L F := IsScalarTower.of_algebraMap_eq' rfl - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := + let : Algebra F T := F.toAlgebra + let : SMul F T := Algebra.toSMul + let : Module F T := Algebra.toModule + let : IsScalarTower (RatFunc C) F T := intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : FiniteDimensional F T := + let : FiniteDimensional F T := finiteDimensional_exactConstantExtension_over_frobeniusTwistField C L N S hExact g - letI : IsGalois F T := + let : IsGalois F T := isGalois_exactConstantExtension_over_frobeniusTwistField C L N S hExact g FiniteExtensionRationalFinitePlace C F ≃ Σ P : FiniteExtensionRationalFinitePlace C L, IntermediateFrobeniusTwistFinitePlaceFiberFixedBy C S N hExact L g P := by - let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := - exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : FiniteDimensional (RatFunc C) T := - finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra.IsSeparable (RatFunc C) T := - isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := - exactConstantExtensionIntermediate_ratFuncBaseTower C S N L - letI : FiniteDimensional L T := - finiteDimensional_exactConstantExtension_over_intermediateBase - C S N L hExact - letI : IsGalois L T := exactConstantExtension_isGalois C L N S hExact - let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := - intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul L F := Algebra.toSMul - letI : Module L F := Algebra.toModule - letI : IsScalarTower (RatFunc C) L F := - IsScalarTower.of_algebraMap_eq' rfl - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := - finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc - C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := - isSeparable_intermediateFrobeniusTwistField_over_ratFunc - C S N hExact L g - letI : Algebra F T := F.toAlgebra - letI : SMul F T := Algebra.toSMul - letI : Module F T := Algebra.toModule - letI : IsScalarTower (RatFunc C) F T := - intermediateFrobeniusTwistField_ratFunc_tower C S N hExact L g - letI : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl - letI : FiniteDimensional F T := - finiteDimensional_exactConstantExtension_over_frobeniusTwistField - C L N S hExact g - letI : IsGalois F T := - isGalois_exactConstantExtension_over_frobeniusTwistField - C L N S hExact g + intro T model1 model2 model3 model4 model5 model6 model7 model8 model9 model10 model11 model12 F + model14 model15 model16 model17 model18 model19 model20 model21 model22 model23 model24 + model25 model26 model27 model28 + let : IsScalarTower L F T := IsScalarTower.of_algebraMap_eq' rfl have hDegreeDiv : Module.finrank L N ∣ Module.finrank C S := by rw [← IsGalois.card_aut_eq_finrank] exact hdiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean index 6ef3a31018..ff7b2184f8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -33,6 +33,70 @@ open scoped Polynomial TensorProduct namespace BGS.HasseWeil +noncomputable section CountOneBridge +open BGS.CorvajaZannier +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] +local instance : Algebra C N := bridgeBaseConstantAlgebra C N +local instance : IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl + +private theorem exactConstantExtensionClosedPlaceExtensionCount_one_eq_baseCount + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let : Fintype S := Fintype.ofFinite S + let : DecidableEq C := Classical.decEq C + let : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + exactConstantExtensionClosedPlaceExtensionCount C S N hExact 1 = + finiteExtensionClosedPlaceExtensionCount C N (Module.finrank C S) := by + intro finiteS decideC decideRatFuncC + classical + rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + have h := exactConstantExtensionClosedPlaceExtensionCount_eq C S N hExact 1 + simpa using h + +private theorem rationalExactConstantCount_eq_of_algEquiv + (E : Type*) [Field E] [Algebra (RatFunc C) E] + [FiniteDimensional (RatFunc C) E] [Algebra.IsSeparable (RatFunc C) E] + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) + (e : E ≃ₐ[RatFunc C] N) : + let : Fintype S := Fintype.ofFinite S + let : DecidableEq C := Classical.decEq C + let : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + let : DecidableEq S := Classical.decEq S + let : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + let EM := ExactConstantExtension C N S + let : Field EM := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) EM := ratFuncExactConstantExtensionAlgebra C S N hExact + let : SMul (RatFunc S) EM := Algebra.toSMul + let : Module (RatFunc S) EM := Algebra.toModule + let : FiniteDimensional (RatFunc S) EM := + finiteDimensional_over_extendedRatFunc C S N hExact + let : Algebra.IsSeparable (RatFunc S) EM := + isSeparable_over_extendedRatFunc C S N hExact + finiteExtensionRationalPlaceCount S EM = + finiteExtensionClosedPlaceExtensionCount C E (Module.finrank C S) := by + intro finiteS decideC decideRatFuncC decideS decideRatFuncS EM + fieldEM algebraEM smulEM moduleEM finiteEM separableEM + classical + have hFirst := exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount + C S N hExact + have hMiddle := exactConstantExtensionClosedPlaceExtensionCount_one_eq_baseCount C S N hExact + have hLast := finiteExtensionClosedPlaceExtensionCount_eq_of_algEquiv C E N e + (Module.finrank C S) + exact hFirst.symm.trans (hMiddle.trans hLast.symm) + +end CountOneBridge + +private theorem finite_of_injective_field_tower + (B M N : Type*) [Field B] [Field M] [Field N] + [Algebra B M] [Algebra B N] [Algebra M N] [IsScalarTower B M N] + [Module.Finite B N] : Module.Finite B M := + Module.Finite.of_injective (IsScalarTower.toAlgHom B M N).toLinearMap + (IsScalarTower.toAlgHom B M N).injective + + noncomputable section @@ -170,6 +234,16 @@ variable (hExact : algebraicClosure K F = (functionFieldNormalClosureConstantBaseToOriginalCompositum K F hExact).toAlgebra +local instance constantBaseOriginalCompositumSmul : + SMul (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + (functionFieldNormalClosureConstantBaseOriginalCompositumAlgebra K F hExact).toSMul + +local instance constantBaseOriginalCompositumModule : + Module (FunctionFieldNormalClosureConstantBase K F) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + (functionFieldNormalClosureConstantBaseOriginalCompositumAlgebra K F hExact).toModule + /-- The embeddings of the constant base into `CF` and then into the normal closure agree with its direct inclusion. -/ noncomputable instance @@ -214,10 +288,7 @@ noncomputable instance let B := FunctionFieldNormalClosureConstantBase K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact let N := FunctionFieldNormalClosure K F - letI : Module.Finite B M := - Module.Finite.of_injective - (IsScalarTower.toAlgHom B M N).toLinearMap - (IsScalarTower.toAlgHom B M N).injective + let : Module.Finite B M := finite_of_injective_field_tower B M N exact Module.Finite.trans B M end OriginalCompositum @@ -288,8 +359,7 @@ theorem /-- The original compositum remains separable over the canonical rational function field of the full constant field. This is transported from the original function field after exact extension of constants. -/ -noncomputable instance - functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc +private theorem originalCompositum_separable_constantRatFunc (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : Algebra.IsSeparable (RatFunc (FunctionFieldNormalClosureConstantField K F)) @@ -317,6 +387,14 @@ noncomputable instance (AlgEquiv.isSeparable_iff e).mpr hx simpa using hex +noncomputable instance + functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc + (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : + Algebra.IsSeparable + (RatFunc (FunctionFieldNormalClosureConstantField K F)) + (FunctionFieldNormalClosureOriginalCompositum K F hExact) := + originalCompositum_separable_constantRatFunc K F hExact + section ConstantExtension variable (S : Type*) [Field S] @@ -881,115 +959,67 @@ theorem functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_originalExactConstantExtensionCount (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : let N := FunctionFieldNormalClosure K F - letI : Algebra K N := functionFieldNormalClosureConstantAlgebra K F + let : Algebra K N := functionFieldNormalClosureConstantAlgebra K F let C := FunctionFieldNormalClosureConstantField K F - letI : Algebra K C := + let : Algebra K C := SubalgebraClass.toAlgebra (algebraicClosure K N) - letI : Module.Finite K C := + let : Module.Finite K C := functionFieldConstantField_finiteDimensional K N - letI : IsGalois K C := functionFieldConstantField_isGalois K N + let : IsGalois K C := functionFieldConstantField_isGalois K N let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Algebra (RatFunc C) M := + let : Algebra (RatFunc C) M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra K F hExact - letI : Algebra C M := + let : Algebra C M := exactConstantExtensionTowerCanonicalConstantAlgebra C M let hExactM := functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc K F hExact let E_M := ExactConstantExtension C M S - letI : Field E_M := + let : Field E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionField K F S hExact - letI : Algebra (RatFunc S) E_M := + let : Algebra (RatFunc S) E_M := functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra K F S hExact - letI : Module (RatFunc S) E_M := Algebra.toModule - letI : Module.Finite (RatFunc S) E_M := + let : Module (RatFunc S) E_M := Algebra.toModule + let : Module.Finite (RatFunc S) E_M := finiteDimensional_over_extendedRatFunc C S M hExactM - letI : Algebra.IsSeparable (RatFunc S) E_M := + let : Algebra.IsSeparable (RatFunc S) E_M := isSeparable_over_extendedRatFunc C S M hExactM - letI : Finite C := functionFieldConstantField_finite K N - letI : Fintype C := Fintype.ofFinite C - letI : Finite S := Module.finite_of_finite C - letI : Fintype S := Fintype.ofFinite S - letI : DecidableEq C := Classical.decEq C - letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) - letI : DecidableEq S := Classical.decEq S - letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + let : Finite C := functionFieldConstantField_finite K N + let : Fintype C := Fintype.ofFinite C + let : Finite S := Module.finite_of_finite C + let : Fintype S := Fintype.ofFinite S + let : DecidableEq C := Classical.decEq C + let : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) + let : DecidableEq S := Classical.decEq S + let : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) finiteExtensionRationalPlaceCount S E_M = exactConstantExtensionClosedPlaceExtensionCount K C F hExact (Module.finrank C S) := by + intro N model1 C model3 model4 model5 M model7 model8 hExactM E_M + model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 model21 model22 model23 classical - let N := FunctionFieldNormalClosure K F - let : Algebra K N := functionFieldNormalClosureConstantAlgebra K F - let C := FunctionFieldNormalClosureConstantField K F - let : Algebra K C := - SubalgebraClass.toAlgebra (algebraicClosure K N) - let : Module.Finite K C := - functionFieldConstantField_finiteDimensional K N - let : IsGalois K C := functionFieldConstantField_isGalois K N - let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - let : Algebra (RatFunc C) M := - functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra - K F hExact - let : Algebra C M := - exactConstantExtensionTowerCanonicalConstantAlgebra C M - let hExactM := - functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc - K F hExact - let E_M := ExactConstantExtension C M S - let : Field E_M := - functionFieldNormalClosureOriginalCompositumConstantExtensionField - K F S hExact - letI : Algebra (RatFunc S) E_M := - functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra - K F S hExact - letI : Module (RatFunc S) E_M := Algebra.toModule - letI : Module.Finite (RatFunc S) E_M := - finiteDimensional_over_extendedRatFunc C S M hExactM - letI : Algebra.IsSeparable (RatFunc S) E_M := - isSeparable_over_extendedRatFunc C S M hExactM - letI : Finite C := functionFieldConstantField_finite K N - letI : Fintype C := Fintype.ofFinite C - letI : Finite S := Module.finite_of_finite C - letI : Fintype S := Fintype.ofFinite S - letI : DecidableEq C := Classical.decEq C - letI : DecidableEq (RatFunc C) := Classical.decEq (RatFunc C) - letI : DecidableEq S := Classical.decEq S - letI : DecidableEq (RatFunc S) := Classical.decEq (RatFunc S) + let : Module (RatFunc C) M := model7.toModule + let : FiniteDimensional (RatFunc C) M := + functionFieldNormalClosureOriginalCompositum_finiteDimensional_over_constantRatFunc K F hExact + let : Algebra.IsSeparable (RatFunc C) M := + functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc K F hExact let E := ExactConstantExtension K F C - letI : Field E := exactConstantExtensionField K F C hExact - letI : Algebra (RatFunc C) E := - ratFuncExactConstantExtensionAlgebra K C F hExact - letI : Module (RatFunc C) E := Algebra.toModule - letI : Module.Finite (RatFunc C) E := + let : Field E := exactConstantExtensionField K F C hExact + let : Algebra (RatFunc C) E := ratFuncExactConstantExtensionAlgebra K C F hExact + let : Module (RatFunc C) E := Algebra.toModule + let : FiniteDimensional (RatFunc C) E := finiteDimensional_over_extendedRatFunc K C F hExact - letI : Algebra.IsSeparable (RatFunc C) E := + let : Algebra.IsSeparable (RatFunc C) E := isSeparable_over_extendedRatFunc K C F hExact let e : E ≃ₐ[RatFunc C] M := - exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv - K F hExact - calc - finiteExtensionRationalPlaceCount S E_M = - exactConstantExtensionClosedPlaceExtensionCount - C S M hExactM 1 := - functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_exactConstantExtensionCount - K F S hExact - _ = finiteExtensionClosedPlaceExtensionCount C M - (Module.finrank C S) := by - rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] - have h := exactConstantExtensionClosedPlaceExtensionCount_eq - C S M hExactM 1 - simpa using h - _ = finiteExtensionClosedPlaceExtensionCount C E - (Module.finrank C S) := by - symm - exact finiteExtensionClosedPlaceExtensionCount_eq_of_algEquiv - C E M e (Module.finrank C S) - _ = exactConstantExtensionClosedPlaceExtensionCount - K C F hExact (Module.finrank C S) := by - rw [exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq] + exactConstantExtensionOriginalCompositumCanonicalRatFuncAlgEquiv K F hExact + have hRational := rationalExactConstantCount_eq_of_algEquiv C S M E hExactM e + have hLast := exactConstantExtensionClosedPlaceExtensionCount_eq_classical_decidableEq + K C F hExact (Module.finrank C S) + exact hRational.trans hLast.symm end ConstantExtension From 7a51d36cb494030d822ae54bf42aea257675b90b Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 19:24:11 +0000 Subject: [PATCH 27/37] Migrate Markoff modules and factor constant-extension proofs --- LeanPool/MarkoffModP.lean | 1220 +++++++++-------- LeanPool/MarkoffModP/BGS.lean | 304 ++-- .../ClearedLinearFractionalSubstitution.lean | 6 +- .../BGS/Algebra/DifferentialWronskian.lean | 12 +- .../Algebra/KummerEigencharacterDescent.lean | 6 +- .../Algebra/RatFuncLinearFractionalEquiv.lean | 6 +- .../ConstantOpenGlueData.lean | 14 +- .../BGS/AlgebraicGeometry/SpecRingEquiv.lean | 6 +- .../DivisorExponentCoefficient.lean | 6 +- .../DivisorExponentSpernerBridge.lean | 6 +- .../Combinatorics/ProductOfChainsGrid.lean | 22 +- .../Combinatorics/ProductOfChainsSperner.lean | 8 +- .../Combinatorics/SymmetricChainBasic.lean | 26 +- .../Combinatorics/SymmetricChainProduct.lean | 11 +- .../SymmetricChainRectangle.lean | 16 +- LeanPool/MarkoffModP/BGS/CorvajaZannier.lean | 184 +-- .../AbsoluteIrreducibilityBaseChange.lean | 16 +- .../BGS/CorvajaZannier/AuxiliaryFamily.lean | 14 +- .../AuxiliaryFamilyIndexing.lean | 16 +- .../BGS/CorvajaZannier/BivariateGauss.lean | 8 +- .../CorvajaZannier/BivariateResultant.lean | 14 +- .../CompletionLinearDisjointness.lean | 8 +- .../DedekindAuxiliaryCaseI.lean | 16 +- .../DedekindAuxiliaryLocalCases.lean | 6 +- .../DedekindAuxiliaryWronskian.lean | 8 +- .../DedekindCanonicalDifferentScaling.lean | 8 +- .../DedekindDifferentDivisor.lean | 12 +- .../DedekindDifferentKaehler.lean | 12 +- .../DedekindLeadingTermCancellation.lean | 10 +- .../DedekindLocalDerivationExtension.lean | 12 +- .../DedekindLocalWronskian.lean | 10 +- ...indLocalizationDerivationPreservation.lean | 14 +- .../DedekindLocalizationOrder.lean | 14 +- .../DedekindPerfectResidueCaseI.lean | 10 +- .../CorvajaZannier/DedekindPlaceOrder.lean | 12 +- .../DedekindRamifiedDerivationScaling.lean | 12 +- .../ElementaryFiniteFieldBound.lean | 10 +- .../CorvajaZannier/EndpointComposition.lean | 16 +- ...xtensionCanonicalAuxiliaryFinitePlace.lean | 16 +- ...nonicalAuxiliaryFinitePlaceNormalized.lean | 8 +- ...ensionCanonicalAuxiliaryInfinityPlace.lean | 22 +- ...iteExtensionCanonicalDifferentDivisor.lean | 10 +- .../FiniteExtensionCanonicalGcdBound.lean | 10 +- ...initeExtensionCanonicalGlobalGcdBound.lean | 14 +- ...iteExtensionCanonicalGlobalNormalized.lean | 8 +- ...ionCanonicalGlobalNormalizedAutomatic.lean | 17 +- .../FiniteExtensionCanonicalPlaceSum.lean | 10 +- ...iteExtensionCanonicalPlacewiseScaling.lean | 16 +- .../FiniteExtensionCanonicalWronskian.lean | 14 +- ...FiniteExtensionExceptionalPlaceBounds.lean | 10 +- .../FiniteExtensionExceptionalSupport.lean | 11 +- ...niteExtensionExhaustiveProductFormula.lean | 10 +- .../FiniteExtensionGcdOutsideHeight.lean | 11 +- .../FiniteExtensionOneSubGcdHeight.lean | 10 +- .../FiniteExtensionPolynomialHeight.lean | 10 +- .../FiniteExtensionPositiveDegreePower.lean | 8 +- .../FiniteExtensionPrincipalDivisor.lean | 18 +- .../FiniteExtensionProductFormula.lean | 8 +- .../FiniteExtensionResidueSurjectivity.lean | 6 +- .../FiniteFunctionFieldDegree.lean | 20 +- .../CorvajaZannier/FinitePlaceCompletion.lean | 8 +- .../BGS/CorvajaZannier/FrobeniusSubfield.lean | 22 +- .../CorvajaZannier/FrobeniusWronskian.lean | 8 +- .../FunctionFieldProductFormula.lean | 14 +- .../CorvajaZannier/GeneralCorvajaZannier.lean | 10 +- .../GlobalWronskianPlaceSum.lean | 8 +- .../GlobalWronskianSummation.lean | 6 +- .../GlobalWronskianWeightedPlaceSum.lean | 8 +- .../CorvajaZannier/InfinityInertiaDegree.lean | 8 +- .../BGS/CorvajaZannier/InfinityPlace.lean | 16 +- .../CorvajaZannier/LaurentFrobeniusBasis.lean | 8 +- .../LaurentFrobeniusPowerBasis.lean | 10 +- .../CorvajaZannier/LocalAuxiliaryCaseI.lean | 10 +- .../LocalAuxiliaryWronskian.lean | 10 +- .../BGS/CorvajaZannier/LocalDerivative.lean | 6 +- .../BGS/CorvajaZannier/LocalMonogenicity.lean | 10 +- .../LocalReciprocalDiscriminant.lean | 13 +- .../BGS/CorvajaZannier/LocalWronskian.lean | 10 +- .../CorvajaZannier/NumericalCorollary.lean | 8 +- .../CorvajaZannier/NumericalOptimization.lean | 16 +- .../CorvajaZannier/ParameterizedBound.lean | 15 +- .../BGS/CorvajaZannier/PerfectConstants.lean | 8 +- .../PlaneCurveAuxiliaryFinitePlace.lean | 14 +- .../PlaneCurveAuxiliaryFinitePlaceCases.lean | 10 +- ...eAuxiliaryFinitePlacePrincipalDivisor.lean | 8 +- .../PlaneCurveAuxiliaryIndependence.lean | 14 +- .../PlaneCurveBidegreeBridge.lean | 10 +- .../PlaneCurveBoundarySupport.lean | 27 +- .../PlaneCurveCanonicalDegreeBound.lean | 10 +- .../PlaneCurveCanonicalEulerBound.lean | 10 +- .../PlaneCurveCanonicalGcdBound.lean | 12 +- .../PlaneCurveCharacteristicCardinality.lean | 10 +- .../PlaneCurveCoordinatePowerHeight.lean | 8 +- .../PlaneCurveDiagonalStabilizer.lean | 14 +- .../PlaneCurveDiscriminantBound.lean | 8 +- .../PlaneCurveExhaustiveGcdEndpoint.lean | 8 +- .../PlaneCurveFiniteDifferentBound.lean | 19 +- .../PlaneCurveFunctionField.lean | 20 +- .../PlaneCurveInfinityComplement.lean | 6 +- .../PlaneCurveInfinityDifferentBound.lean | 16 +- .../PlaneCurveInfinityDifferentDegree.lean | 6 +- ...PlaneCurveLocalReciprocalDiscriminant.lean | 16 +- .../PlaneCurveLogarithmicGauss.lean | 8 +- .../PlaneCurvePoweredHeightBounds.lean | 16 +- .../PlaneCurvePoweredImageDegreeBudget.lean | 10 +- .../PlaneCurvePropositionTwoAssembly.lean | 12 +- .../PlaneCurvePropositionTwoDegreeBridge.lean | 12 +- .../PlaneCurvePropositionTwoGeometric.lean | 18 +- .../PlaneCurveRatFuncModel.lean | 8 +- .../PlaneCurveSeparability.lean | 14 +- .../PlaneCurveSharedOriginBoundary.lean | 10 +- .../PlaneCurveSupportDeterminant.lean | 8 +- .../CorvajaZannier/PlaneCurveSupportRank.lean | 31 +- .../PoweredCoordinateRelation.lean | 8 +- .../CorvajaZannier/PoweredCoordinates.lean | 10 +- .../PoweredImageBaseChange.lean | 15 +- .../BGS/CorvajaZannier/PoweredImageCurve.lean | 13 +- .../PoweredImageExactSupportIndexBound.lean | 6 +- .../PoweredImageFrobeniusRelation.lean | 14 +- .../PoweredImageFrobeniusRelationSwapped.lean | 10 +- .../PoweredImageGaloisBound.lean | 16 +- .../PoweredImageHeightFactor.lean | 6 +- .../BGS/CorvajaZannier/PoweredImageIndex.lean | 8 +- .../PoweredImageIndexBound.lean | 14 +- .../PropositionTwoDegreeMonotonicity.lean | 8 +- .../RatFuncExhaustiveProductFormula.lean | 8 +- .../SeparatingCoordinateNotFrobenius.lean | 10 +- .../CorvajaZannier/TorsionBidegreeCount.lean | 10 +- .../TorsionExhaustiveGcdDivisorBound.lean | 24 +- .../TorsionGcdDivisorBound.lean | 7 +- .../TorsionPointNormalization.lean | 16 +- .../TorusCharacterKernelBound.lean | 14 +- .../TranscendentalPowerDegree.lean | 10 +- .../WronskianChangeParameter.lean | 8 +- .../BGS/Dynamics/FiniteForwardOrbit.lean | 8 +- .../BGS/Dynamics/StrictMeasureEscape.lean | 10 +- .../BGS/External/GeneralCurveTheorems.lean | 12 +- .../BGS/FiniteField/EllipticCharacterSum.lean | 10 +- .../BGS/FiniteField/HasseFrobenius.lean | 12 +- .../BGS/FiniteField/QuadraticCharacter.lean | 8 +- .../BGS/HasseWeil/AffinePointPlace.lean | 6 +- .../HasseWeil/CechRiemannLinearAlgebra.lean | 8 +- .../HasseWeil/ClosedPlaceEulerRecurrence.lean | 12 +- .../ConstantExtensionClosedPlaceCount.lean | 10 +- ...tExtensionClosedPlaceSplittingFormula.lean | 6 +- .../ConstantExtensionFinitePlaceBridge.lean | 12 +- .../ConstantExtensionInfinityPlaceBridge.lean | 25 +- ...tantExtensionInfinityPlaceDegreeTower.lean | 10 +- ...ionInfinityPlaceSplittingMultiplicity.lean | 22 +- ...ntExtensionPlaceSplittingMultiplicity.lean | 8 +- .../ConstantExtensionRationalPlace.lean | 6 +- .../HasseWeil/ConstantFieldAutomorphism.lean | 10 +- .../HasseWeil/ConstantFieldFinitePlace.lean | 10 +- .../ConstantFieldFinitePlaceDegree.lean | 8 +- .../HasseWeil/ConstantFieldInfinityBase.lean | 6 +- .../ConstantFieldRatFuncCompatibility.lean | 15 +- .../BGS/HasseWeil/ConstantTensorResidue.lean | 8 +- .../BGS/HasseWeil/DVRLocalPoleOrder.lean | 8 +- .../DedekindDifferentLocalTrace.lean | 15 +- .../BGS/HasseWeil/ExactConstantExtension.lean | 8 +- .../ExactConstantExtensionAutomorphism.lean | 10 +- .../ExactConstantExtensionConstants.lean | 8 +- ...ConstantExtensionDifferentCoefficient.lean | 14 +- ...ExactConstantExtensionFiniteDifferent.lean | 339 +++-- .../ExactConstantExtensionFinitePlace.lean | 36 +- ...tantExtensionFinitePlaceCompatibility.lean | 12 +- ...tExtensionFinitePlaceFrobeniusAverage.lean | 16 +- .../ExactConstantExtensionFrobeniusTwist.lean | 8 +- ...ntExtensionFrobeniusTwistBoundedError.lean | 6 +- ...stantExtensionFrobeniusTwistConstants.lean | 8 +- ...ConstantExtensionFrobeniusTwistDegree.lean | 8 +- ...nsionFrobeniusTwistFinitePlaceAverage.lean | 22 +- ...ensionFrobeniusTwistFinitePlaceBridge.lean | 8 +- ...onFrobeniusTwistFinitePlaceUnramified.lean | 6 +- ...tConstantExtensionFrobeniusTwistGenus.lean | 11 +- ...ionFrobeniusTwistInfinityPlaceDescent.lean | 12 +- ...robeniusTwistInfinityPlaceEquivalence.lean | 6 +- ...ExtensionFrobeniusTwistMultiplication.lean | 8 +- ...ionFrobeniusTwistRationalPlaceAverage.lean | 12 +- ...ntExtensionFrobeniusTwistRiemannLower.lean | 8 +- ...tExtensionFrobeniusTwistStepanovUpper.lean | 15 +- .../ExactConstantExtensionGenusDegree.lean | 10 +- ...ExactConstantExtensionGenusInvariance.lean | 8 +- ...actConstantExtensionInfinityDifferent.lean | 199 +-- ...onstantExtensionInfinityNormalization.lean | 8 +- ...ntExtensionInfinityPlaceCompatibility.lean | 12 +- ...diateFrobeniusTwistFinitePlaceAverage.lean | 32 +- ...nIntermediateFrobeniusTwistHasseBound.lean | 12 +- ...ateFrobeniusTwistRationalPlaceAverage.lean | 8 +- ...ctConstantExtensionNormalClosureTower.lean | 22 +- .../ExactConstantExtensionQuotient.lean | 6 +- ...ctConstantExtensionRationalPlaceCount.lean | 9 +- .../ExactConstantExtensionRegularity.lean | 11 +- ...ConstantExtensionTotalDifferentDegree.lean | 10 +- .../ExactConstantExtensionTower.lean | 10 +- .../ExtensionEvenDegreeStepanovBound.lean | 10 +- .../BGS/HasseWeil/ExtensionPointCount.lean | 10 +- .../BGS/HasseWeil/FilteredDimension.lean | 6 +- .../BGS/HasseWeil/FiniteBranchLocus.lean | 11 +- .../FiniteExtensionAffineIdealDegree.lean | 10 +- .../FiniteExtensionAffineIdealDivisor.lean | 17 +- ...nonicalDifferentCanonicalityCriterion.lean | 6 +- ...iteExtensionCanonicalDifferentCotrace.lean | 18 +- ...CanonicalDifferentCotraceCanonicality.lean | 8 +- ...ExtensionCanonicalDifferentGenusBound.lean | 10 +- ...sionCanonicalDifferentLocalMaximality.lean | 8 +- .../FiniteExtensionClosedPlaceAlgEquiv.lean | 8 +- ...FiniteExtensionCotraceLocalTraceImage.lean | 11 +- ...tensionDivisibleErrorFromConstantBase.lean | 8 +- ...FiniteExtensionDivisorClassRecurrence.lean | 13 +- .../FiniteExtensionDivisorDegreeIndex.lean | 15 +- .../FiniteExtensionEffectiveDivisorSplit.lean | 19 +- .../HasseWeil/FiniteExtensionGenusBound.lean | 6 +- ...nHasseBoundFromEvenConstantExtensions.lean | 8 +- .../HasseWeil/FiniteExtensionHasseWeil.lean | 92 +- ...FiniteExtensionIndexedZetaRationality.lean | 10 +- ...ensionIndexedZetaRationalityAutomatic.lean | 10 +- .../FiniteExtensionLocalPoleQuotient.lean | 12 +- .../FiniteExtensionLocalPoleSpace.lean | 6 +- .../FiniteExtensionPlaceAlgEquiv.lean | 10 +- .../FiniteExtensionPlaceDegreeFiniteness.lean | 6 +- .../HasseWeil/FiniteExtensionPlaceTower.lean | 18 +- .../FiniteExtensionPrincipalParts.lean | 10 +- .../FiniteExtensionRiemannEventualGrowth.lean | 10 +- .../FiniteExtensionRiemannLowerFromGenus.lean | 8 +- .../HasseWeil/FiniteExtensionRiemannRoch.lean | 12 +- ...ExtensionRiemannShiftedEventualGrowth.lean | 8 +- .../FiniteExtensionRiemannSpace.lean | 11 +- ...ExtensionRiemannSpaceProjectivization.lean | 8 +- ...initeExtensionStandardZetaRationality.lean | 12 +- ...tensionTotalDifferentEffectiveDivisor.lean | 8 +- .../FiniteExtensionZeroCounting.lean | 8 +- ...eExtensionZetaDegreeExtensionIdentity.lean | 10 +- .../FiniteExtensionZetaDegreeIndexOne.lean | 18 +- ...eExtensionZetaDegreeIndexOneAutomatic.lean | 10 +- ...ensionZetaDegreeIndexOneFromAllCounts.lean | 8 +- ...ExtensionZetaNumeratorNoncancellation.lean | 12 +- .../FiniteExtensionZetaSimplePole.lean | 6 +- .../BGS/HasseWeil/FiniteFieldCompositum.lean | 6 +- ...teFieldConstantExtensionNormalization.lean | 15 +- .../FiniteFieldConstantExtensionResidue.lean | 8 +- .../FiniteFieldDivisibleExtension.lean | 6 +- .../FiniteFieldInfinityDifferent.lean | 16 +- .../FiniteFieldPolynomialDifferent.lean | 10 +- .../FiniteFieldPolynomialNormalization.lean | 10 +- .../BGS/HasseWeil/FiniteFieldSubfield.lean | 6 +- .../FiniteLinearIndependenceBound.lean | 10 +- .../HasseWeil/FinitePlaceApproximation.lean | 12 +- .../HasseWeil/FinitePlaceFrobeniusFiber.lean | 6 +- .../FinitePlaceNormalizationTransport.lean | 6 +- .../BGS/HasseWeil/FinitePrincipalParts.lean | 10 +- .../BGS/HasseWeil/FinsuppWeightedFiber.lean | 6 +- .../BGS/HasseWeil/FixedPointAverage.lean | 10 +- .../FormalZetaConstantExtensionIdentity.lean | 8 +- .../HasseWeil/FormalZetaDegreeIndexOne.lean | 8 +- .../FormalZetaDegreeIndexOneIndexed.lean | 6 +- .../BGS/HasseWeil/FormalZetaEuler.lean | 8 +- .../BGS/HasseWeil/FormalZetaEulerDegree.lean | 8 +- .../BGS/HasseWeil/FormalZetaHasseBound.lean | 6 +- .../BGS/HasseWeil/FormalZetaRationality.lean | 8 +- .../FormalZetaRationalityDegree.lean | 6 +- .../BGS/HasseWeil/FormalZetaTrace.lean | 16 +- .../BGS/HasseWeil/FormalZetaUniqueness.lean | 6 +- .../HasseWeil/FrobeniusPlaceCardinality.lean | 6 +- .../BGS/HasseWeil/FrobeniusRestriction.lean | 12 +- .../BGS/HasseWeil/FrobeniusTwistGroup.lean | 6 +- .../FunctionFieldConstantExtension.lean | 16 +- .../HasseWeil/FunctionFieldConstantField.lean | 10 +- .../HasseWeil/FunctionFieldNormalClosure.lean | 10 +- ...unctionFieldNormalClosureConstantBase.lean | 9 +- .../FunctionFieldNormalClosureConstants.lean | 8 +- ...nFieldNormalClosureOriginalCompositum.lean | 12 +- ...nctionFieldNormalClosureOriginalField.lean | 11 +- ...FunctionFieldNormalClosureRatFuncBase.lean | 12 +- ...unctionFieldNormalClosureRatFuncEquiv.lean | 16 +- .../BGS/HasseWeil/GaloisAverage.lean | 16 +- .../HasseWeil/GaloisTowerFactorialDegree.lean | 6 +- .../GeneralBivariateAffineHasseWeil.lean | 14 +- .../GeneralFiniteExtensionRiemannLower.lean | 14 +- .../GeneralSquareFieldStepanovCount.lean | 14 +- ...eralSquareFieldStepanovCountAutomatic.lean | 8 +- .../BGS/HasseWeil/IdealMultiplicityMap.lean | 6 +- .../BGS/HasseWeil/LinearFunctionalGluing.lean | 8 +- .../LocalPoleCumulativeQuotient.lean | 10 +- .../BGS/HasseWeil/LocalPoleFiltration.lean | 10 +- .../BGS/HasseWeil/OnePointBase.lean | 10 +- .../BGS/HasseWeil/OnePointDivisorSplit.lean | 15 +- .../BGS/HasseWeil/OnePointHeight.lean | 8 +- .../BGS/HasseWeil/OnePointIncrement.lean | 10 +- .../HasseWeil/OnePointLeadingCoefficient.lean | 18 +- .../BGS/HasseWeil/OnePointPoleSemigroup.lean | 8 +- .../HasseWeil/OnePointSectionSelection.lean | 12 +- .../HasseWeil/OnePointStepanovBasisGrid.lean | 10 +- .../OnePointStepanovDegreeTwoAuxiliary.lean | 14 +- .../BGS/HasseWeil/OnePointStepanovGrid.lean | 11 +- .../BGS/HasseWeil/OnePointStrictLevels.lean | 8 +- .../HasseWeil/PlaneAffineCountTransfer.lean | 8 +- .../BGS/HasseWeil/PlaneAffineFiberBound.lean | 12 +- .../PlaneAffineHasseWeilFromEvenError.lean | 12 +- .../PlaneAffineHasseWeilFromZeta.lean | 18 +- .../PlaneAffineRationalPlaceComparison.lean | 12 +- .../BGS/HasseWeil/PlaneConstantField.lean | 10 +- .../BGS/HasseWeil/PlaneCoordinatePole.lean | 13 +- .../PlaneCoordinatePoleAtInfinity.lean | 6 +- .../BGS/HasseWeil/PlaneCoordinateShear.lean | 12 +- .../PlaneCurveGenusBoundAutomatic.lean | 13 +- .../PlaneCurveGenusBoundFromCotrace.lean | 8 +- ...PlaneCurveGenusBoundFromCotraceDegree.lean | 10 +- .../PlaneFinitePlaceRiemannLower.lean | 14 +- .../HasseWeil/PlaneFrobeniusDeflation.lean | 13 +- .../HasseWeil/PlaneFrobeniusDegenerate.lean | 6 +- .../HasseWeil/PlaneFrobeniusReduction.lean | 10 +- .../HasseWeil/PlaneInfinityRiemannLower.lean | 10 +- .../BGS/HasseWeil/PlaneMonomialSpace.lean | 18 +- .../HasseWeil/PlaneOnePointRiemannLower.lean | 14 +- .../PlaneRationalPlaceAffineComparison.lean | 41 +- .../BGS/HasseWeil/PlaneRegularPointCount.lean | 10 +- .../HasseWeil/PlaneSingularPointBound.lean | 12 +- .../PlaneSmoothPointNormalization.lean | 20 +- .../PlaneSquareFieldStepanovCount.lean | 16 +- ...laneSquareFieldStepanovCountAutomatic.lean | 10 +- .../BGS/HasseWeil/PlaneStepanovAuxiliary.lean | 12 +- .../BGS/HasseWeil/PoleDivisor.lean | 8 +- .../BGS/HasseWeil/PolynomialSpectral.lean | 8 +- .../BGS/HasseWeil/PolynomialTensorCancel.lean | 136 +- .../MarkoffModP/BGS/HasseWeil/PowerSum.lean | 14 +- .../RatFuncCanonicalInfinityDivisor.lean | 10 +- .../HasseWeil/RatFuncConstantExtension.lean | 33 +- .../RatFuncExactConstantExtension.lean | 25 +- .../RatFuncInfinityLocalization.lean | 12 +- .../BGS/HasseWeil/RatFuncParameterPole.lean | 12 +- .../BGS/HasseWeil/RationalPlace.lean | 12 +- .../BGS/HasseWeil/RationalPlaceTower.lean | 8 +- .../BGS/HasseWeil/RiemannSpaceConstants.lean | 8 +- .../RiemannSpaceEffectiveIncrement.lean | 12 +- .../RiemannSpaceFinitePlaceIncrement.lean | 18 +- .../RiemannSpaceInfinityPlaceIncrement.lean | 6 +- .../BGS/HasseWeil/SpectralFromAsymptotic.lean | 8 +- .../SquareExtensionAffinePlaces.lean | 16 +- .../BGS/HasseWeil/SquareFieldResidue.lean | 11 +- .../SquareFieldStepanovAuxiliary.lean | 12 +- .../SquareFieldStepanovRestriction.lean | 8 +- .../SquareFieldStepanovZeroCount.lean | 10 +- .../BGS/HasseWeil/StepanovLinearAlgebra.lean | 10 +- .../BGS/HasseWeil/StepanovParameters.lean | 18 +- .../HasseWeil/StepanovRestrictionMaps.lean | 21 +- .../HasseWeil/StepanovSquareVanishing.lean | 16 +- .../BGS/HasseWeil/TensorRestriction.lean | 14 +- .../BGS/HasseWeil/ZetaExtensionTrace.lean | 6 +- .../BGS/HasseWeil/ZetaNumeratorSpectral.lean | 6 +- .../MarkoffModP/BGS/HasseWeil/ZetaTrace.lean | 8 +- .../MarkoffModP/BGS/Markoff/Assembly.lean | 30 +- .../BGS/Markoff/Assembly/Asymptotics.lean | 6 +- .../BGS/Markoff/Assembly/CoarseEndgame.lean | 6 +- .../Markoff/Assembly/CoarseLinearTail.lean | 8 +- .../Assembly/CoarseSupportSurjectivity.lean | 10 +- .../Markoff/Assembly/CoarseSupportTail.lean | 8 +- .../Assembly/DivisibleOrbitTransitivity.lean | 8 +- .../Markoff/Assembly/ElementaryCounts.lean | 10 +- .../EulerSevenCoarseSupportFrontier.lean | 8 +- ...erSevenNonparabolicComplementFrontier.lean | 8 +- ...erSevenPairedMaximalDivisorMiddleGame.lean | 8 +- .../EulerSevenSplitCageCoarseLinearTail.lean | 8 +- ...litCageNonparabolicComplementFrontier.lean | 8 +- ...rSevenSplitCageSquareEnvelopeFrontier.lean | 10 +- ...enSplitCageSquareEnvelopeSurjectivity.lean | 8 +- .../EvenSignBaseStableComplement.lean | 6 +- .../EvenSignComplementDivisibility.lean | 8 +- .../Assembly/EvenSignOrbitDivisibility.lean | 10 +- .../ExactOrderComplementObstruction.lean | 8 +- ...tOrderEulerSevenComplementObstruction.lean | 8 +- .../ExactOrderPuncturedSmallOrderCount.lean | 8 +- .../Assembly/ExactOrderRankinEnvelope.lean | 14 +- .../Assembly/ExactOrderTraceBudget.lean | 9 +- .../Assembly/ExceptionalPrimeCount.lean | 12 +- .../ExplicitPuncturedTransitivity.lean | 14 +- ...ixedPointFreeMaximalDivisorTraceCount.lean | 8 +- .../BGS/Markoff/Assembly/GiantOrbit.lean | 18 +- .../Assembly/JointMaximalDivisorFrontier.lean | 8 +- .../Assembly/MaximalDivisorLowOrderCount.lean | 8 +- .../Assembly/MaximalDivisorMiddleGame.lean | 8 +- .../MaximalDivisorPuncturedTransitivity.lean | 10 +- .../Assembly/MiddleGameThenEndgame.lean | 10 +- .../Assembly/NonparabolicBadComponent.lean | 8 +- .../NonparabolicComplementFrontier.lean | 14 +- ...nparabolicMaximalDivisorConcreteCount.lean | 6 +- .../NonparabolicPuncturedSmallOrderCount.lean | 8 +- .../Markoff/Assembly/NormalizationCount.lean | 8 +- .../Assembly/NormalizedSmallOrderCount.lean | 8 +- .../Markoff/Assembly/OrbitDivisibility.lean | 16 +- .../PairedMaximalDivisorLowOrderCount.lean | 6 +- .../PairedMaximalDivisorMiddleGame.lean | 8 +- .../PairedMaximalDivisorTraceCount.lean | 6 +- .../Assembly/PuncturedSmallOrderCount.lean | 8 +- .../Assembly/RankinJointAntichainSperner.lean | 8 +- .../Assembly/RankinJointAntichainWidth.lean | 8 +- .../Markoff/Assembly/RankinWidthEnvelope.lean | 6 +- .../Assembly/ReductionSurjectivity.lean | 10 +- .../Assembly/SplitCageEvenSignBase.lean | 8 +- ...litCageNonparabolicComplementFrontier.lean | 10 +- .../Assembly/TransitivitySurjectivity.lean | 8 +- .../BGS/Markoff/Assembly/Unconditional.lean | 8 +- .../WeightedCoarseSupportSurjectivity.lean | 8 +- LeanPool/MarkoffModP/BGS/Markoff/Cage.lean | 30 +- .../BGS/Markoff/Cage/AxisEquivalence.lean | 6 +- .../Cage/BiquadraticPrimitiveQuartic.lean | 8 +- .../BGS/Markoff/Cage/Connectivity.lean | 8 +- .../BGS/Markoff/Cage/EstimateFromPlane.lean | 10 +- .../BGS/Markoff/Cage/HasseWeilAssumption.lean | 8 +- .../BGS/Markoff/Cage/IncidenceGeometry.lean | 10 +- .../Markoff/Cage/PlaneCountComparison.lean | 6 +- .../BGS/Markoff/Cage/PlaneHasseWeil.lean | 8 +- .../BGS/Markoff/Cage/PlaneModels.lean | 12 +- .../BGS/Markoff/Cage/PowerCover.lean | 8 +- .../BGS/Markoff/Cage/PulledRadicand.lean | 8 +- .../Cage/ShiftedTraceCurveIrreducibility.lean | 8 +- .../BGS/Markoff/Cage/SmallPrime.lean | 6 +- .../BGS/Markoff/Cage/WitnessEquations.lean | 6 +- LeanPool/MarkoffModP/BGS/Markoff/Core.lean | 30 +- .../MarkoffModP/BGS/Markoff/Core/Action.lean | 6 +- .../MarkoffModP/BGS/Markoff/Core/Basic.lean | 10 +- .../Markoff/Core/ConicParametrization.lean | 11 +- .../BGS/Markoff/Core/EvenSignAction.lean | 6 +- .../Core/FiniteRotationEigenvalues.lean | 8 +- .../BGS/Markoff/Core/NatConnectivity.lean | 6 +- .../BGS/Markoff/Core/Normalization.lean | 6 +- .../BGS/Markoff/Core/NormalizedOrbit.lean | 8 +- .../BGS/Markoff/Core/ParabolicFibers.lean | 10 +- .../Markoff/Core/PuncturedNormalization.lean | 8 +- .../BGS/Markoff/Core/Rotation.lean | 12 +- .../BGS/Markoff/Core/RotationTorus.lean | 10 +- .../BGS/Markoff/Core/SemiringFunctor.lean | 6 +- .../BGS/Markoff/Core/Statements.lean | 6 +- .../BGS/Markoff/Core/TraceClassification.lean | 8 +- .../MarkoffModP/BGS/Markoff/Diophantine.lean | 10 +- .../Diophantine/CoordinateCoprimeProduct.lean | 6 +- .../CoordinateZeroPatternCounts.lean | 6 +- .../BGS/Markoff/Diophantine/LocalCounts.lean | 10 +- .../BGS/Markoff/Diophantine/PrimewiseCRT.lean | 8 +- LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean | 20 +- .../Markoff/Endgame/LargeOrderToMaximal.lean | 8 +- .../BGS/Markoff/Endgame/Nonsplit.lean | 12 +- .../Nonsplit/CayleyParametrization.lean | 193 +-- .../Nonsplit/DescendedIrreducibility.lean | 8 +- .../Endgame/Nonsplit/DescendedTraceCurve.lean | 14 +- .../Endgame/Nonsplit/HasseFromGeneral.lean | 8 +- .../Markoff/Endgame/Nonsplit/SeededCover.lean | 10 +- .../BGS/Markoff/Endgame/Parabolic.lean | 10 +- .../Markoff/Endgame/PowerCoverCounting.lean | 8 +- .../Endgame/PrimitiveInclusionExclusion.lean | 10 +- .../Markoff/Endgame/PrimitiveOrbitWiring.lean | 8 +- .../Markoff/Endgame/PrimitiveTraceCount.lean | 8 +- .../Markoff/Endgame/WeilBoundAssumption.lean | 12 +- .../Markoff/Endgame/WeilFromGeneralHasse.lean | 10 +- .../BGS/Markoff/ExplicitEndgame.lean | 12 +- .../BGS/Markoff/ExplicitEstimates.lean | 14 +- .../Markoff/ExplicitNumericCertificates.lean | 6 +- .../BGS/Markoff/ExplicitNumerics.lean | 10 +- .../MarkoffModP/BGS/Markoff/Incidence.lean | 14 +- .../BGS/Markoff/Incidence/CoordinateRing.lean | 12 +- .../Markoff/Incidence/Counterexamples.lean | 6 +- .../BGS/Markoff/Incidence/Fibers.lean | 12 +- .../BGS/Markoff/Incidence/Geometry.lean | 6 +- .../Markoff/Incidence/NormalizedGraph.lean | 8 +- .../BGS/Markoff/Incidence/PointCount.lean | 10 +- .../MarkoffModP/BGS/Markoff/MiddleGame.lean | 38 +- .../MiddleGame/CorvajaZannierEscape.lean | 10 +- .../MiddleGame/CorvajaZannierFromGeneral.lean | 16 +- .../MiddleGame/CorvajaZannierGeometry.lean | 8 +- .../CorvajaZannierSeparability.lean | 10 +- .../MiddleGame/CorvajaZannierSourceBound.lean | 6 +- .../MiddleGame/CorvajaZannierStep.lean | 6 +- .../MiddleGame/CosetTraceEquation.lean | 6 +- .../Markoff/MiddleGame/Diagonalization.lean | 6 +- .../BGS/Markoff/MiddleGame/DivisorRange.lean | 6 +- .../EulerSevenPairedCorvajaZannierBound.lean | 10 +- ...redMaximalDivisorCorvajaZannierEscape.lean | 10 +- ...airedMaximalDivisorCorvajaZannierStep.lean | 12 +- ...rSevenPairedMaximalDivisorOrderEscape.lean | 8 +- .../MaximalDivisorCorvajaZannierEscape.lean | 12 +- .../MaximalDivisorCorvajaZannierStep.lean | 6 +- .../MaximalDivisorNonparabolicOrderCover.lean | 6 +- .../MiddleGame/MaximalDivisorOrderCover.lean | 8 +- .../MiddleGame/MaximalDivisorOrderEscape.lean | 6 +- .../BGS/Markoff/MiddleGame/MoveWiring.lean | 10 +- .../MiddleGame/NonparabolicUnionBound.lean | 6 +- .../BGS/Markoff/MiddleGame/OrderEscape.lean | 12 +- .../MiddleGame/PairedCorvajaZannierBound.lean | 8 +- ...redMaximalDivisorCorvajaZannierEscape.lean | 10 +- ...airedMaximalDivisorCorvajaZannierStep.lean | 10 +- .../PairedMaximalDivisorOrderEscape.lean | 8 +- .../Markoff/MiddleGame/ParabolicEscape.lean | 8 +- .../MiddleGame/RightInversionPairing.lean | 6 +- .../Markoff/MiddleGame/RightSubgroups.lean | 10 +- .../Markoff/MiddleGame/TraceCurveWeights.lean | 10 +- .../BGS/Markoff/MiddleGame/TraceEquation.lean | 6 +- .../BGS/Markoff/MiddleGame/UnionBound.lean | 8 +- .../MiddleGame/WeightedTraceBound.lean | 8 +- .../MiddleGame/WeightedTraceEquation.lean | 8 +- .../MiddleGame/WeightedTraceEulerSeven.lean | 16 +- .../WeightedTraceEulerSevenBound.lean | 10 +- .../WeightedTraceEulerSevenLargeBound.lean | 12 +- ...WeightedTraceEulerSevenPropositionTwo.lean | 12 +- .../WeightedTracePoweredImageIndexTwo.lean | 10 +- LeanPool/MarkoffModP/BGS/Markoff/Opening.lean | 34 +- .../Opening/AlgebraicClosureTransport.lean | 8 +- .../BGS/Markoff/Opening/CompatibleRoots.lean | 6 +- .../BGS/Markoff/Opening/CyclotomicBound.lean | 6 +- .../BGS/Markoff/Opening/CyclotomicDefect.lean | 10 +- .../BGS/Markoff/Opening/CyclotomicNorm.lean | 10 +- .../Markoff/Opening/CyclotomicReduction.lean | 26 +- .../BGS/Markoff/Opening/EveryOrbitLarge.lean | 8 +- .../BGS/Markoff/Opening/FiniteOrbit.lean | 16 +- .../BGS/Markoff/Opening/OrbitCardBound.lean | 14 +- .../BGS/Markoff/Opening/OrderArithmetic.lean | 8 +- .../Markoff/Opening/ParabolicPeriodicity.lean | 6 +- .../Markoff/Opening/PeriodicSemisimple.lean | 8 +- .../Markoff/Opening/RotationOrbitCard.lean | 8 +- .../BGS/Markoff/Opening/TorsionTraces.lean | 8 +- .../BGS/Markoff/Opening/TraceOrderBound.lean | 14 +- .../BGS/Markoff/Opening/UnitCircle.lean | 6 +- .../BGS/Markoff/PreliminaryEndgame.lean | 8 +- .../BGS/Markoff/PreliminaryNumerics.lean | 8 +- .../MarkoffModP/BGS/Markoff/TraceCurve.lean | 68 +- .../TraceCurve/AffineNormalization.lean | 8 +- .../TraceCurve/BiprojectiveClosure.lean | 12 +- .../TraceCurve/BiprojectiveScheme.lean | 14 +- .../BGS/Markoff/TraceCurve/Boundary.lean | 6 +- .../Markoff/TraceCurve/Characteristic.lean | 8 +- .../Markoff/TraceCurve/ChartLocalization.lean | 8 +- .../TraceCurve/CommonKummerIndependence.lean | 8 +- .../TraceCurve/CommonPrimeKummerTower.lean | 10 +- .../BGS/Markoff/TraceCurve/Geometry.lean | 10 +- .../IrreducibilityObstructions.lean | 10 +- .../BGS/Markoff/TraceCurve/Kummer.lean | 14 +- .../LaurentComparisonInjectivity.lean | 21 +- .../Markoff/TraceCurve/LaurentJacobian.lean | 6 +- .../TraceCurve/LaurentNormalization.lean | 10 +- .../BGS/Markoff/TraceCurve/LaurentSmooth.lean | 12 +- .../BGS/Markoff/TraceCurve/Localization.lean | 8 +- .../BGS/Markoff/TraceCurve/NormalForm.lean | 6 +- .../OddCommonPrimeIndependence.lean | 6 +- .../TraceCurve/OddCoprimeIrreducibility.lean | 6 +- .../PositiveCoprimeIrreducibility.lean | 6 +- .../Markoff/TraceCurve/ProjectiveChart.lean | 4 + .../ProjectiveNormalizationCharts.lean | 12 +- .../ProjectiveNormalizationMorphism.lean | 8 +- .../TraceCurve/ProjectivePointEstimate.lean | 8 +- .../TraceCurve/SemanticNormalForm.lean | 34 +- .../SyntacticDivisionCriterion.lean | 8 +- .../SyntacticDivisionObstruction.lean | 6 +- .../TraceCurve/SyntacticNormalForm.lean | 8 +- .../Markoff/TraceCurve/WeightedBidegree.lean | 6 +- .../TraceCurve/WeightedEllipticModel.lean | 8 +- .../TraceCurve/WeightedIrreducibility.lean | 12 +- .../TraceCurve/WeightedNotSubtorus.lean | 6 +- .../WeightedOddCoprimeIrreducibility.lean | 10 +- .../BGS/NumberTheory/DivisorBound.lean | 12 +- .../NumberTheory/ExplicitDivisorBound.lean | 6 +- .../JointMaximalDivisorCertificate.lean | 6 +- .../JointMaximalDivisorCriterion.lean | 6 +- .../JointNeighborDivisorBound.lean | 8 +- .../NumberTheory/MaximalDivisorBounds.lean | 10 +- .../NonparabolicComplementCriterion.lean | 6 +- .../OneSidedPrimitiveWitness.lean | 8 +- .../NumberTheory/PreliminaryDivisorBound.lean | 16 +- .../NumberTheory/PrimePowerFactorization.lean | 10 +- .../NumberTheory/RankinCanonicalProfile.lean | 8 +- .../NumberTheory/RankinCutoff1248Data.lean | 6 +- .../NumberTheory/RankinCutoff1248Profile.lean | 8 +- .../RankinCutoff1248Skeleton.lean | 6 +- .../RankinJointEnvelopeCertificate.lean | 6 +- .../RankinJointEnvelopeCoverage.lean | 6 +- .../RankinJointEnvelopeSummaryCoverage.lean | 6 +- .../RankinPositionalCoverage.lean | 10 +- .../NumberTheory/RankinPositionalProfile.lean | 16 +- .../RankinPositionalSupportBound.lean | 8 +- .../RankinProfileCertificate.lean | 6 +- .../NumberTheory/RankinProfileMatching.lean | 12 +- .../NumberTheory/TruncatedOrderTotient.lean | 8 +- .../TruncatedOrderTotientRankin.lean | 8 +- ...ncatedOrderTotientRankinFactorization.lean | 16 +- .../NumberTheory/WeightedDivisorMoment.lean | 271 ++-- .../WeightedNeighborDivisorBound.lean | 8 +- LeanPool/MarkoffModP/Comparator/Solution.lean | 6 +- .../MarkoffModP/RiemannRoch/AxiomCheck.lean | 4 +- 586 files changed, 5730 insertions(+), 3384 deletions(-) diff --git a/LeanPool/MarkoffModP.lean b/LeanPool/MarkoffModP.lean index a9076c74d1..436328786c 100644 --- a/LeanPool/MarkoffModP.lean +++ b/LeanPool/MarkoffModP.lean @@ -3,616 +3,618 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS -import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution -import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian -import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent -import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv -import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData -import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv -import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient -import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentSpernerBridge -import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid -import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle -import LeanPool.MarkoffModP.BGS.CorvajaZannier -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalMonogenicity -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity -import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter -import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit -import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum -import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius -import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter -import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra -import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder -import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRegularity -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower -import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound -import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount -import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteLinearIndependenceBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts -import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber -import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalField -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap -import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing -import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointPoleSemigroup -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary -import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral -import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel -import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing -import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction -import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace -import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral -import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace -import LeanPool.MarkoffModP.BGS.Markoff.Assembly -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Cage -import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence -import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic -import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity -import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane -import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption -import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand -import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime -import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations -import LeanPool.MarkoffModP.BGS.Markoff.Core -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction -import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues -import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization -import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers -import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization -import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation -import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus -import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor -import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements -import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT -import LeanPool.MarkoffModP.BGS.Markoff.Endgame -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics -import LeanPool.MarkoffModP.BGS.Markoff.Incidence -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo -import LeanPool.MarkoffModP.BGS.Markoff.Opening -import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction -import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge -import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound -import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic -import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity -import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple -import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard -import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces -import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound -import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle -import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame -import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility -import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound -import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound -import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate -import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion -import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound -import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds -import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion -import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness -import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound -import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization -import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment -import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound -import LeanPool.MarkoffModP.Comparator.Solution -import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic -import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.FilterChain -import LeanPool.MarkoffModP.RiemannRoch.AxiomCheck -import LeanPool.MarkoffModP.RiemannRoch.Basic -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AdeleSpace -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.Divisor -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.WeilDifferential -import LeanPool.MarkoffModP.RiemannRoch.Divisor -import LeanPool.MarkoffModP.RiemannRoch.FunctionField.Divisor -import LeanPool.MarkoffModP.RiemannRoch.Genus.AdeleQuotient -import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic -import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar -import LeanPool.MarkoffModP.RiemannRoch.Genus.Ramification -import LeanPool.MarkoffModP.RiemannRoch.LinearKneser -import LeanPool.MarkoffModP.RiemannRoch.LocalResidue -import LeanPool.MarkoffModP.RiemannRoch.Place -import LeanPool.MarkoffModP.RiemannRoch.PlaceEquiv -import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic -import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Basic -import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Corollaries -import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm -import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential -import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic + +public import LeanPool.MarkoffModP.BGS +public import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution +public import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +public import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +public import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +public import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient +public import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentSpernerBridge +public import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid +public import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle +public import LeanPool.MarkoffModP.BGS.CorvajaZannier +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalMonogenicity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +public import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit +public import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +public import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius +public import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +public import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder +public import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRegularity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteLinearIndependenceBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalField +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap +public import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointPoleSemigroup +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +public import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing +public import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Cage +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations +public import LeanPool.MarkoffModP.BGS.Markoff.Core +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction +public import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +public import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +public import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +public import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo +public import LeanPool.MarkoffModP.BGS.Markoff.Opening +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds +public import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion +public import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +public import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization +public import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment +public import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound +public import LeanPool.MarkoffModP.Comparator.Solution +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.FilterChain +public import LeanPool.MarkoffModP.RiemannRoch.AxiomCheck +public import LeanPool.MarkoffModP.RiemannRoch.Basic +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AdeleSpace +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.WeilDifferential +public import LeanPool.MarkoffModP.RiemannRoch.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.FunctionField.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.Genus.AdeleQuotient +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Ramification +public import LeanPool.MarkoffModP.RiemannRoch.LinearKneser +public import LeanPool.MarkoffModP.RiemannRoch.LocalResidue +public import LeanPool.MarkoffModP.RiemannRoch.Place +public import LeanPool.MarkoffModP.RiemannRoch.PlaceEquiv +public import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic +public import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Basic +public import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Corollaries +public import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic /-! # Markoff mod p diff --git a/LeanPool/MarkoffModP/BGS.lean b/LeanPool/MarkoffModP/BGS.lean index bd344bd45d..56adb27138 100644 --- a/LeanPool/MarkoffModP/BGS.lean +++ b/LeanPool/MarkoffModP/BGS.lean @@ -3,155 +3,157 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound -import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness -import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent -import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian -import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv -import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution -import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius -import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion -import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality -import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer -import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum -import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance -import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil -import LeanPool.MarkoffModP.BGS.CorvajaZannier -import LeanPool.MarkoffModP.BGS.Markoff.Core -import LeanPool.MarkoffModP.BGS.Markoff.Opening -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve -import LeanPool.MarkoffModP.BGS.Markoff.Endgame -import LeanPool.MarkoffModP.BGS.Markoff.Cage -import LeanPool.MarkoffModP.BGS.Markoff.Incidence -import LeanPool.MarkoffModP.BGS.Markoff.Assembly -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile + +public import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +public import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +public import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +public import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv +public import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution +public import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius +public import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +public import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +public import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +public import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +public import LeanPool.MarkoffModP.BGS.CorvajaZannier +public import LeanPool.MarkoffModP.BGS.Markoff.Core +public import LeanPool.MarkoffModP.BGS.Markoff.Opening +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame +public import LeanPool.MarkoffModP.BGS.Markoff.Cage +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile diff --git a/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean b/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean index 4779464aa0..51fd94ca58 100644 --- a/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean +++ b/LeanPool/MarkoffModP/BGS/Algebra/ClearedLinearFractionalSubstitution.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv + +public import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv /-! # Cleared linear-fractional substitution @@ -16,6 +18,8 @@ The degree assumption in the irreducibility theorem is essential: inversion send linear polynomial `X` to the unit polynomial `1` after clearing its denominator. -/ +@[expose] public section + namespace BGS open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean b/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean index e71b9210bb..8f1e6db632 100644 --- a/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/Algebra/DifferentialWronskian.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.Derivation.Basic -import Mathlib.LinearAlgebra.Matrix.ToLinearEquiv -import Mathlib.LinearAlgebra.Finsupp.LinearCombination -import Mathlib.Tactic.LinearCombination + +public import Mathlib.RingTheory.Derivation.Basic +public import Mathlib.LinearAlgebra.Matrix.ToLinearEquiv +public import Mathlib.LinearAlgebra.Finsupp.LinearCombination +public import Mathlib.Tactic.LinearCombination /-! # Ordinary Wronskians over differential fields @@ -22,6 +24,8 @@ vector, differentiates the resulting row relations, deletes the normalized coord applies induction to the smaller Wronskian. -/ +@[expose] public section + namespace BGS.Algebra noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean b/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean index 066c61b40c..7d678f5fab 100644 --- a/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean +++ b/LeanPool/MarkoffModP/BGS/Algebra/KummerEigencharacterDescent.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.KummerExtension + +public import Mathlib.FieldTheory.KummerExtension /-! # Eigencharacter descent in a cyclic Kummer extension @@ -16,6 +18,8 @@ basis. This is the generic descent needed before applying trace-curve Kummer-cl at primes dividing both cover exponents. -/ +@[expose] public section + open Polynomial AdjoinRoot noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean b/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean index 342b7dc690..e78e4ffd93 100644 --- a/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/Algebra/RatFuncLinearFractionalEquiv.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.RatFunc.IntermediateField + +public import Mathlib.FieldTheory.RatFunc.IntermediateField /-! # Linear-fractional automorphisms of a rational function field @@ -14,6 +16,8 @@ An invertible matrix `((a, b), (c, d))` acts on `K(X)` by sending equivalence and records its action on `X` and on embedded polynomials. -/ +@[expose] public section + namespace BGS.Algebra open IntermediateField Polynomial diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean index bcab7dc4e5..fd0d9ec587 100644 --- a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean @@ -3,8 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.AlgebraicGeometry.Gluing + +public import Mathlib.AlgebraicGeometry.Gluing +public import Mathlib.CategoryTheory.Limits.Shapes.Pullback.Mono /-! # Gluing schemes along one common open per chart @@ -15,6 +18,8 @@ open immersion. Their projections are isomorphisms because open immersions are which makes the required pullback-level cocycle explicit. -/ +@[expose] public section + open CategoryTheory CategoryTheory.Limits namespace BGS @@ -44,8 +49,9 @@ def constantOpenGlueDataAux f_mono := by intros; infer_instance f_hasPullback := by intros; infer_instance t i j _ := t i j - t' i j _ _ _ _ := - pullback.fst (f i) (f i) ≫ t i j ≫ inv (pullback.fst (f j) (f j)) + t' i j _ _ _ _ := by + let : IsIso (pullback.fst (f j) (f j)) := isIso_fst_of_mono (f j) + exact pullback.fst (f i) (f i) ≫ t i j ≫ inv (pullback.fst (f j) (f j)) t_fac i j k _ _ _ := by rw [← fst_eq_snd_of_mono_eq (f j)] simp @@ -138,7 +144,7 @@ def constantOpenGlueDataOfCommonTargetMap CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', constantOpenGlueDataAux] simp only [dite_eq_right hij, dite_eq_right (Ne.symm hij)] - simp + simp only [dite_eq_ite, Category.assoc, eqToHom_trans_assoc, eqToHom_refl, Category.id_comp] congr 1 simp only [← Category.assoc] rw [h i] diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean index 3c46837104..569b1148f6 100644 --- a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/SpecRingEquiv.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.AlgebraicGeometry.GammaSpecAdjunction + +public import Mathlib.AlgebraicGeometry.GammaSpecAdjunction /-! # Concrete `Spec` isomorphisms from ring equivalences @@ -14,6 +16,8 @@ equivalent objects, but mixing them introduces equality transports in later comp module keeps affine scheme isomorphisms in the concrete `Spec` presentation used by the project. -/ +@[expose] public section + namespace BGS open CategoryTheory diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean index 51f33e0bb3..43baecd263 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentCoefficient.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner + +public import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner /-! # Cardinality semantics of divisor-rank coefficients @@ -13,6 +15,8 @@ This identifies the executable coefficient recurrence used by factorization payloads with the actual rank layers of the divisor exponent box. -/ +@[expose] public section + namespace BGS.NumberTheory /-- One rank layer in a divisor exponent box. -/ diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean index b1b1cdac40..461781ea89 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/DivisorExponentSpernerBridge.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient + +public import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient /-! # The divisor-antichain central-coefficient bound @@ -14,6 +16,8 @@ payload: the recomputed central coefficient really bounds every antichain in the represented divisor exponent lattice. -/ +@[expose] public section + namespace BGS.NumberTheory open BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean index 6228f118f1..1269880477 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Tactic + +public import Mathlib.Tactic /-! # Symmetric chains in a rectangle @@ -16,6 +18,8 @@ The decoder is inverse to the encoder, preserves rank, and is monotone along each chain. -/ +@[expose] public section + namespace BGS.Combinatorics /-- Key of the L-shaped symmetric chain containing `(x,y)`. -/ @@ -108,7 +112,7 @@ theorem gridDecodeY_le theorem gridKey_decode {m n k t : ℕ} (hk : k ≤ min m n) - (ht : t ≤ m + n - 2 * k) : + (_ht : t ≤ m + n - 2 * k) : gridKey m n (gridDecodeX m n k t) (gridDecodeY m n k t) = k := by have hkm : k ≤ m := hk.trans (min_le_left _ _) @@ -131,7 +135,7 @@ theorem gridKey_decode theorem gridDecode_rank {m n k t : ℕ} (hk : k ≤ min m n) - (ht : t ≤ m + n - 2 * k) : + (_ht : t ≤ m + n - 2 * k) : gridDecodeX m n k t + gridDecodeY m n k t = k + t := by have hkm : k ≤ m := hk.trans (min_le_left _ _) have hkn : k ≤ n := hk.trans (min_le_right _ _) @@ -169,7 +173,7 @@ theorem gridDecode_encode_x rw [Nat.sub_sub_self hx] omega simp [gridDecodeX, gridPosition, gridKey, hmn, hshort, - min_eq_right hreverse, hdecode, Nat.sub_sub_self hx] + min_eq_right hreverse, Nat.sub_sub_self hx] · by_cases hshort : x ≤ n - y · have hdecode : y ≤ n - x := by omega simp [gridDecodeX, gridPosition, gridKey, hmn, @@ -180,8 +184,8 @@ theorem gridDecode_encode_x rw [Nat.sub_sub_self hy] omega have hsum : ¬x + y ≤ y + (n - y) := by omega - simp [gridDecodeX, gridPosition, gridKey, hmn, hshort, - min_eq_right hreverse, hdecode, hsum, Nat.sub_sub_self hy] + simp [gridDecodeX, gridPosition, gridKey, hmn, + min_eq_right hreverse, hsum, Nat.sub_sub_self hy] omega theorem gridDecode_encode_y @@ -199,7 +203,7 @@ theorem gridDecode_encode_y rw [Nat.sub_sub_self hx] omega simp [gridDecodeY, gridPosition, gridKey, hmn, hshort, - min_eq_right hreverse, hdecode, Nat.sub_sub_self hx] + min_eq_right hreverse, Nat.sub_sub_self hx] omega · by_cases hshort : x ≤ n - y · have hdecode : y ≤ n - x := by omega @@ -210,8 +214,8 @@ theorem gridDecode_encode_y ¬x + y - (n - y) ≤ n - (n - y) := by rw [Nat.sub_sub_self hy] omega - simp [gridDecodeY, gridPosition, gridKey, hmn, hshort, - min_eq_right hreverse, hdecode, Nat.sub_sub_self hy] + simp [gridDecodeY, gridPosition, gridKey, hmn, + min_eq_right hreverse, Nat.sub_sub_self hy] omega theorem gridDecode_mono diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean index 433b6c1ba4..b8583c3931 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsSperner.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct -import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization + +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct +public import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization /-! # Sperner bounds for divisor exponent boxes @@ -16,6 +18,8 @@ every antichain by the central coefficient of `∏ (1 + X + ... + X^e)`. -/ +@[expose] public section + namespace BGS.NumberTheory open BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean index 71b1eac068..4b453f4b36 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Data.Fintype.Card -import Mathlib.Order.Antichain -import Mathlib.Tactic + +public import Mathlib.Data.Fintype.Card +public import Mathlib.Order.Antichain +public import Mathlib.Tactic /-! # Finite symmetric-chain decompositions @@ -20,6 +22,8 @@ each chain at most once, so mapping every point to the central point of its chain injects the antichain into the central rank. -/ +@[expose] public section + namespace BGS.Combinatorics /-- An explicit symmetric-chain decomposition of a ranked partial order. -/ @@ -104,29 +108,29 @@ private theorem key_injective_on_antichain decomposition.decode_mono kx ix iy hxy have hxback : decomposition.equiv.symm ⟨kx, ix⟩ = x.1 := by apply decomposition.equiv.injective - simpa [hxcode] + simp [hxcode] have hyback : decomposition.equiv.symm ⟨kx, iy⟩ = y.1 := by apply decomposition.equiv.injective - simpa [hycode] + simp [hycode] simpa [hxback, hyback] using hdecode by_contra hne exact - (hantichain (by simpa using x.2) - (by simpa using y.2) hne) hle + (hantichain (by simp using x.2) + (by simp using y.2) hne) hle · have hle : y.1 ≤ x.1 := by have hdecode := decomposition.decode_mono kx iy ix hyx have hxback : decomposition.equiv.symm ⟨kx, ix⟩ = x.1 := by apply decomposition.equiv.injective - simpa [hxcode] + simp [hxcode] have hyback : decomposition.equiv.symm ⟨kx, iy⟩ = y.1 := by apply decomposition.equiv.injective - simpa [hycode] + simp [hycode] simpa [hxback, hyback] using hdecode by_contra hne exact - (hantichain (by simpa using y.2) - (by simpa using x.2) (Ne.symm hne)) hle + (hantichain (by simp using y.2) + (by simp using x.2) (Ne.symm hne)) hle /-- Every antichain injects into the central rank of a finite ranked poset equipped with an explicit symmetric-chain decomposition. -/ diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean index 58c9aff939..5144b33142 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainProduct.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle + +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle /-! # Products of symmetric-chain decompositions @@ -15,6 +17,8 @@ equivalences: the old chain code, sigma-product distribution, the explicit rectangle decomposition on each old chain, and sigma associativity. -/ +@[expose] public section + namespace BGS.Combinatorics namespace SymmetricChainDecomposition @@ -45,7 +49,8 @@ def productStart (key : decomposition.productKey a) : ℕ := decomposition.start key.1 + key.2 -private def productEquiv +/-- Reindex a product with a finite chain by its rectangular symmetric chains. -/ +def productEquiv (decomposition : SymmetricChainDecomposition P rank total) (a : ℕ) : P × Fin (a + 1) ≃ diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean index 40d506716f..74b33f2103 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainRectangle.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid + +public import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid /-! # The rectangle symmetric-chain equivalence @@ -14,6 +16,8 @@ finite, self-contained transport boundary separate lets product decompositions be assembled from standard equivalence combinators. -/ +@[expose] public section + namespace BGS.Combinatorics abbrev gridChainKey (m n : ℕ) := @@ -22,7 +26,8 @@ abbrev gridChainKey (m n : ℕ) := abbrev gridChainLength (m n : ℕ) (key : gridChainKey m n) := m + n - 2 * key -private def gridChainEncode (m n : ℕ) +/-- Encode a point of a finite rectangle by its symmetric chain and position. -/ +def gridChainEncode (m n : ℕ) (point : Fin (m + 1) × Fin (n + 1)) : Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1) := by have hx : (point.1 : ℕ) ≤ m := @@ -35,7 +40,8 @@ private def gridChainEncode (m n : ℕ) ⟨⟨key, Nat.lt_succ_iff.mpr (gridKey_le_min hx hy)⟩, ⟨position, Nat.lt_succ_iff.mpr (gridPosition_le hx hy)⟩⟩ -private def gridChainDecode (m n : ℕ) +/-- Recover a point of a finite rectangle from its symmetric chain and position. -/ +def gridChainDecode (m n : ℕ) (point : Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1)) : Fin (m + 1) × Fin (n + 1) := by @@ -87,7 +93,7 @@ def gridChainEquiv (m n : ℕ) : Σ key : gridChainKey m n, Fin (gridChainLength m n key + 1) where toFun := gridChainEncode m n invFun := gridChainDecode m n - left_inv := gridChainDecode_encode m n - right_inv := gridChainEncode_decode m n + left_inv := by exact gridChainDecode_encode m n + right_inv := by exact gridChainEncode_decode m n end BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean index fb24306654..00d1d45345 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier.lean @@ -3,95 +3,97 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis -import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount -import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean index 2ebac88148..a5de614b59 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import Mathlib.Algebra.MvPolynomial.Nilpotent -import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure -import Mathlib.RingTheory.Nullstellensatz + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import Mathlib.Algebra.MvPolynomial.Nilpotent +public import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +public import Mathlib.RingTheory.Nullstellensatz /-! # Base change of absolutely irreducible multivariate polynomials @@ -25,6 +27,8 @@ The final theorem supplies the exact constant-field base-change step used in Corvaja--Zannier's auxiliary-family argument. -/ +@[expose] public section + open scoped BigOperators noncomputable section @@ -214,7 +218,7 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed simpa only [θ, MvPolynomial.eval₂Hom_X'] using hqGE exact left_ne_zero_of_mul_eq_one hprod have hcoeffFormula : gE.coeff mg = x (gVar mg) := by - simp [gE, G, MvPolynomial.coeff_sum, + simp [gE, G, MvPolynomial.coeff_monomial, hmgMem, θ] rw [hcoeffFormula] exact hxG @@ -237,7 +241,7 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed simpa only [θ, MvPolynomial.eval₂Hom_X'] using hqHE exact left_ne_zero_of_mul_eq_one hprod have hcoeffFormula : hE'.coeff mh = x (hVar mh) := by - simp [hE', H, MvPolynomial.coeff_sum, + simp [hE', H, MvPolynomial.coeff_monomial, hmhMem, θ] rw [hcoeffFormula] exact hxH diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean index a47a41b1d5..1fa8cd749b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamily.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Algebra.Basic -import Mathlib.Algebra.Polynomial.OfFn -import Mathlib.Algebra.Polynomial.Eval.Degree -import Mathlib.LinearAlgebra.LinearIndependent.Defs -import Mathlib.Tactic.FieldSimp + +public import Mathlib.Algebra.Algebra.Basic +public import Mathlib.Algebra.Polynomial.OfFn +public import Mathlib.Algebra.Polynomial.Eval.Degree +public import Mathlib.LinearAlgebra.LinearIndependent.Defs +public import Mathlib.Tactic.FieldSimp /-! # The Corvaja--Zannier auxiliary family @@ -34,6 +36,8 @@ Source provenance: published pages 1933--1934; checked semantic reconstruction dependence-to-relation step formalized here is lines 518--545. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean index d878e3ed87..24e1c293d4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +public import Mathlib.Tactic /-! # Indexing the auxiliary Wronskian family @@ -16,6 +18,8 @@ Enumerate the auxiliary family and its derivative orders, then transport determi nonvanishing through that indexing. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -94,9 +98,7 @@ theorem indexedAuxiliaryWronskian_det_eq_derivationWronskian_det Matrix.reindex e.symm e.symm (BGS.Algebra.derivationWronskian D g) := by ext i j - simp [indexedDedekindLocalWronskian, - auxiliaryFamilyDerivativeOrder, BGS.Algebra.derivationWronskian, - Matrix.reindex_apply, Matrix.submatrix, g, e] + simp only [Matrix.reindex_apply, Equiv.symm_symm, Matrix.submatrix_apply] exact (Module.End.pow_apply D.toLinearMap _ (f j)).symm rw [hmatrix, Matrix.det_reindex_self] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean index 34d1aede5e..fdb4e724fd 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateGauss.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant -import Mathlib.RingTheory.Polynomial.GaussLemma + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +public import Mathlib.RingTheory.Polynomial.GaussLemma /-! # Gauss descent for the Corvaja--Zannier bivariate resultant @@ -17,6 +19,8 @@ This descent is what permits reading off *both* coordinate degrees, rather than only the degree in the eliminated variable. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean index b5d5cba813..ab3849b42d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/BivariateResultant.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily -import Mathlib.Algebra.Polynomial.BigOperators -import Mathlib.Algebra.Polynomial.Bivariate -import Mathlib.FieldTheory.Minpoly.Field -import Mathlib.RingTheory.Polynomial.Resultant.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +public import Mathlib.Algebra.Polynomial.BigOperators +public import Mathlib.Algebra.Polynomial.Bivariate +public import Mathlib.FieldTheory.Minpoly.Field +public import Mathlib.RingTheory.Polynomial.Resultant.Basic /-! # Degree bounds for bivariate resultants @@ -26,6 +28,8 @@ every Sylvester column, so the coefficient bounds add with the correct multiplicities. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean index 676e80c37e..a8883f78eb 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/CompletionLinearDisjointness.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis -import Mathlib.FieldTheory.LinearDisjoint + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +public import Mathlib.FieldTheory.LinearDisjoint /-! # The completion linear-disjointness bridge @@ -32,6 +34,8 @@ No assertion here constructs a completion map or proves these compatibility conditions for a plane curve. -/ +@[expose] public section + open HahnSeries open Module diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean index 335feadcda..a030056bd0 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI -import Mathlib.LinearAlgebra.Matrix.Transvection + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +public import Mathlib.LinearAlgebra.Matrix.Transvection /-! # Corvaja--Zannier case (i) at a Dedekind DVR place @@ -27,6 +29,8 @@ Source provenance: published pages 1935--1936; checked semantic reconstruction `Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 640--685. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -48,6 +52,7 @@ def dedekindPoleDepth (v : HeightOneSpectrum R) (x : L) : ℕ := def dedekindPoleWeight {k : ℕ} (v : HeightOneSpectrum R) (f : Fin k → L) : ℕ := ∑ i, dedekindPoleDepth v (f i) +omit [IsDiscreteValuationRing R] in @[simp] theorem dedekindPoleDepth_zero (v : HeightOneSpectrum R) : dedekindPoleDepth (L := L) v 0 = 0 := by @@ -60,6 +65,7 @@ def NegativeFinitePlaceOrdersPairwiseDistinct {ι : Type*} finitePlaceOrderTop v (f j) < 0 → finitePlaceOrderTop v (f i) = finitePlaceOrderTop v (f j) → i = j +omit [IsDiscreteValuationRing R] in @[simp] theorem dedekindPoleDepth_pos_iff (v : HeightOneSpectrum R) (x : L) : 0 < dedekindPoleDepth v x ↔ finitePlaceOrderTop v x < 0 := by @@ -69,6 +75,7 @@ theorem dedekindPoleDepth_pos_iff (v : HeightOneSpectrum R) (x : L) : · rw [finitePlaceOrderTop_eq_coe v x hx] simp [dedekindPoleDepth, hx] +omit [IsDiscreteValuationRing R] in @[simp] theorem dedekindPoleDepth_eq_zero_iff (v : HeightOneSpectrum R) (x : L) : dedekindPoleDepth v x = 0 ↔ 0 ≤ finitePlaceOrderTop v x := by @@ -566,6 +573,7 @@ theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_q_lower_bound mul_le_mul_of_nonpos_right hepsilonQ' hrho _ = rhoOrder * (epsilon + 1 : ℕ) := by push_cast; ring +omit [IsDiscreteValuationRing R] in /-- Pairwise-distinct negative finite-place orders bounded below by a nonpositive integer are no more numerous than its pole depth. -/ theorem card_negativeFinitePlaceOrders_le_neg diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean index d904d26901..94f2e8690f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryLocalCases.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian /-! # Uniformizer-free Dedekind auxiliary cases @@ -15,6 +17,8 @@ is chosen internally. In particular, callers do not need an algebra map from the derivation's constant field into the local DVR. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean index 28439e6353..9d3dc18c9e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryWronskian.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian /-! # Auxiliary-family Wronskian estimates at a Dedekind place @@ -25,6 +27,8 @@ Source provenance: published pages 1935--1936; checked semantic reconstruction `Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 636--732. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean index f378bbb2b7..36907cfcda 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling /-! # Canonical different scalings at Dedekind places @@ -23,6 +25,8 @@ factor. No local power basis or finiteness assertion for a map between two independently localized rings is used. -/ +@[expose] public section + attribute [local instance] FractionRing.liftAlgebra FractionRing.isScalarTower_liftAlgebra diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean index 9ad114da64..537ad20717 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentDivisor.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import Mathlib.RingTheory.Discriminant -import Mathlib.Data.Finsupp.Order + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import Mathlib.RingTheory.Discriminant +public import Mathlib.Data.Finsupp.Order /-! # The different divisor and the primitive-element derivative @@ -27,6 +29,8 @@ controlled by one principal divisor. No canonical-divisor or genus estimate is assumed here. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Polynomial diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean index a381938a4f..7bb679d87d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.DedekindDomain.Different -import Mathlib.RingTheory.Kaehler.Basic -import Mathlib.RingTheory.TensorProduct.Maps -import Mathlib.LinearAlgebra.TensorProduct.Basis + +public import Mathlib.RingTheory.DedekindDomain.Different +public import Mathlib.RingTheory.Kaehler.Basic +public import Mathlib.RingTheory.TensorProduct.Maps +public import Mathlib.LinearAlgebra.TensorProduct.Basis /-! # The trace different annihilates Kähler differentials @@ -28,6 +30,8 @@ multiplication map. It follows that multiplication by `d` sends this kernel into its square, hence kills its cotangent module `I / I² = Ω[B⁄A]`. -/ +@[expose] public section + open scoped BigOperators TensorProduct open Polynomial Module diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean index f8c73c3214..b1480c8a9f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLeadingTermCancellation.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import Mathlib.Tactic /-! # Leading-term cancellation at a Dedekind DVR place @@ -23,6 +25,8 @@ on the residue field, so the theorem can be applied independently of how the constant field is presented. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean index 2fc94cc4ef..966f3b1d5d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalDerivationExtension.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.Etale.Kaehler -import Mathlib.RingTheory.DedekindDomain.Different -import Mathlib.RingTheory.Flat.TorsionFree -import Mathlib.RingTheory.Smooth.Fiber + +public import Mathlib.RingTheory.Etale.Kaehler +public import Mathlib.RingTheory.DedekindDomain.Different +public import Mathlib.RingTheory.Flat.TorsionFree +public import Mathlib.RingTheory.Smooth.Fiber /-! # Extending derivations through local Dedekind rings @@ -16,6 +18,8 @@ Lift derivations uniquely through formally etale maps and apply this to unramifi and primes away from the different. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean index b10dd36ecc..39c6bce418 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter -import Mathlib.LinearAlgebra.Matrix.Determinant.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic /-! # Wronskian order estimates at a Dedekind DVR place @@ -17,6 +19,8 @@ series: the only local input is a DVR-preserving derivation which sends a chosen uniformizer to one. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean index 8a3793874b..ef9f89d999 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.Derivation.Basic -import Mathlib.RingTheory.Localization.Basic -import Mathlib.RingTheory.Localization.FractionRing -import Mathlib.Tactic + +public import Mathlib.RingTheory.Derivation.Basic +public import Mathlib.RingTheory.Localization.Basic +public import Mathlib.RingTheory.Localization.FractionRing +public import Mathlib.Tactic /-! # Derivations preserving localizations @@ -18,6 +20,8 @@ algebra structure from the derivation's constant ring to the localized ring; that structure need not exist in the Frobenius-constant application. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -94,7 +98,7 @@ theorem ambientDerivation_preserves_localizationAtPrime_of_preserves (algebraMap R (Localization.AtPrime q) 1) := by rw [show invD * algebraMap R (Localization.AtPrime q) d = algebraMap R (Localization.AtPrime q) 1 by - simpa [invD, dSub] using hspec] + simp [invD, dSub] using hspec] _ = 1 := by simp refine ⟨z', ?_⟩ apply mul_right_cancel₀ hdU diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean index 699be2d3c0..0adad6147a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing +public import Mathlib.Tactic /-! # Compatibility of global and localized Dedekind orders @@ -17,6 +19,8 @@ normalization. This file proves equality, rather than equivalence up to an unspecified rescaling, and transfers the associated principal-ideal orders. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Multiplicative WithZero @@ -58,13 +62,13 @@ theorem valuation_eq_of_isEquiv_of_surjective rw [← exp_lt_exp, ← hπw] have hvlt : v π < v 1 := by rw [hπv, map_one] - simpa using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) + simp using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) simpa using h.lt_iff_lt.mp hvlt have hb : b < 0 := by rw [← exp_lt_exp, ← hρv] have hwlt : w ρ < w 1 := by rw [hρw, map_one] - simpa using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) + simp using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) simpa using h.lt_iff_lt.mpr hwlt have hwEq : w π = w (ρ ^ (-a)) := by rw [hπw, map_zpow₀, hρw, ← exp_zsmul] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean index 2a3e70f27c..8f8ab1301c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI -import Mathlib.FieldTheory.Perfect + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +public import Mathlib.FieldTheory.Perfect /-! # Corvaja--Zannier case (i) over a perfect residue field @@ -24,6 +26,8 @@ subfield. No algebra structure from the whole Frobenius subfield to the DVR is asserted: such a structure would be false at a nontrivial place. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -69,7 +73,7 @@ theorem exists_frobeniusSubfield_regular_unit_sub_mul_mem_of_perfect_residue rw [map_sub, map_mul, hbMap] dsimp [ratio] rw [← map_mul] - simp + simp only [Units.inv_mul_cancel_right] change algebraMap R κ (u : R) - algebraMap R κ (u : R) = 0 exact sub_self _ have hbFrob : algebraMap R L b ∈ frobeniusSubfield L p := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean index bf7023dfc9..b83e0a872f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPlaceOrder.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion -import Mathlib.RingTheory.DiscreteValuationRing.Basic -import Mathlib.RingTheory.Derivation.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +public import Mathlib.RingTheory.DiscreteValuationRing.Basic +public import Mathlib.RingTheory.Derivation.Basic +public import Mathlib.Tactic /-! # Orders at Dedekind places @@ -16,6 +18,8 @@ Extend local orders to zero using a top value and prove their arithmetic and der estimates through uniformizers. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean index e81921e052..73e1d93f8a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindRamifiedDerivationScaling.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import Mathlib.RingTheory.Conductor -import Mathlib.RingTheory.Derivation.MapCoeffs -import Mathlib.RingTheory.RamificationInertia.Ramification + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import Mathlib.RingTheory.Conductor +public import Mathlib.RingTheory.Derivation.MapCoeffs +public import Mathlib.RingTheory.RamificationInertia.Ramification /-! # Scaling derivations at ramified Dedekind places @@ -24,6 +26,8 @@ as an explicit hypothesis; mathlib does not currently supply it in the needed generality. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean index 5cbc3eec32..72e97665e6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ElementaryFiniteFieldBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import Mathlib.RingTheory.RootsOfUnity.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import Mathlib.RingTheory.RootsOfUnity.Basic +public import Mathlib.Tactic /-! # Elementary finite-field torsion bounds @@ -16,6 +18,8 @@ uses only the fact that a nonzero polynomial has at most its degree many roots. It does not use curve geometry or the Corvaja--Zannier Wronskian argument. -/ +@[expose] public section + namespace BGS.External noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean index 461f685977..5b7675a9b8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/EndpointComposition.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge /-! # Composition of the Corvaja--Zannier plane-curve endpoint @@ -29,6 +31,8 @@ Corvaja--Zannier Proposition 2 alternatives. No axiom or typeclass hides this geometric obligation. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean index 68b3682166..ebab6374a2 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +public import Mathlib.Tactic /-! # Finite-place cases for the canonical auxiliary family @@ -18,6 +20,8 @@ Prove the local auxiliary-family inequalities at finite places, including the gr derivative-order sums. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean index 5c204a90dd..1ba52b8146 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling /-! # Canonical finite-place bounds for a normalized derivation @@ -17,6 +19,8 @@ divisor. These are the four finite-place inputs used by the exhaustive global summation. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean index 0b40089045..93c6b9dba0 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryInfinityPlace.lean @@ -3,16 +3,18 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +public import Mathlib.Tactic /-! # Canonical auxiliary bounds at infinity places @@ -23,6 +25,8 @@ The scaling supplied by the canonical different identifies its local order with the coefficient of `finiteExtensionCanonicalDifferentDivisor` at `.inr P`. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean index bd29ff3060..44457790ed 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree -import Mathlib.RingTheory.RamificationInertia.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +public import Mathlib.RingTheory.RamificationInertia.Basic /-! # The canonical different divisor of a finite function-field extension @@ -18,6 +20,8 @@ above infinity. The weighted degree is therefore the total different degree minus twice the extension degree. -/ +@[expose] public section + open scoped BigOperators nonZeroDivisors Polynomial open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean index 29654eb29f..3c095bafed 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGcdBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +public import Mathlib.Tactic /-! # A gcd bound from the canonical Wronskian inequality @@ -14,6 +16,8 @@ import Mathlib.Tactic Deduce the finite-extension gcd estimate from the residue-weighted canonical Wronskian bound. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean index 324f2fe954..f1731452a8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalGcdBound.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +public import Mathlib.Tactic /-! # Canonical placewise bounds imply the exhaustive gcd estimate @@ -20,6 +22,8 @@ weighted place sum, and then converts the resulting Wronskian inequality into the numerical gcd estimate. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean index c708858bc0..930a871085 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalized.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound /-! # Global canonical bound from a normalized derivation @@ -16,6 +18,8 @@ splitting the exhaustive place type. This module leaves only the four corresponding infinity statements as explicit inputs. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean index 0edf32e543..72f5c23d97 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import Mathlib.Tactic /-! # Normalized global derivations for the canonical argument @@ -17,6 +19,8 @@ Construct the rational-function derivations and reciprocal-chart estimates used global canonical Wronskian argument. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -73,6 +77,7 @@ theorem probeRatFuncDerivation_eq (x : RatFunc K) : rw [map_sub, map_mul, map_mul] simp only [Algebra.smul_def, Algebra.algebraMap_self_apply] +omit [DecidableEq (RatFunc K)] in private theorem natDegree_derivativeNumerator_le (p q : K[X]) (hp : p ≠ 0) (hq : q ≠ 0) (hN : q * p.derivative - p * q.derivative ≠ 0) : @@ -377,6 +382,7 @@ local instance probeFrobeniusConstantTower : IsScalarTower K (frobeniusSubfield L p) L := IsScalarTower.of_algebraMap_eq' rfl +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in theorem probe_normalizedDerivation_comp_ratFunc (D : Derivation (frobeniusSubfield L p) L L) (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) : @@ -462,6 +468,7 @@ theorem probeAmbientReciprocalDerivation_extends (probeRatFuncReciprocalDerivation K (r : RatFunc K)) rw [probeRatFuncReciprocalDerivation_apply, map_mul, map_neg, map_pow] +omit [DecidableEq K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in theorem probeAmbientReciprocalDerivation_changeParameter (D : Derivation (frobeniusSubfield L p) L L) : D.restrictScalars K = diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean index f0e0075d3e..28bacf3383 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlaceSum.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +public import Mathlib.Tactic /-! # Canonical Wronskian sums over all places @@ -15,6 +17,8 @@ Sum the local Wronskian inequalities with residue-degree weights, separating exc from the outside pole height. -/ +@[expose] public section + open scoped BigOperators namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean index 8c7c80dc9e..77f9d0578a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalPlacewiseScaling.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import Mathlib.Tactic /-! # Canonical derivation scalings at finite extension places @@ -22,6 +24,8 @@ shows that the scaled derivation preserves the complete localized DVR used by the finite-place Wronskian estimates. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean index 5ed786a8a2..b320eeb654 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +public import Mathlib.Tactic /-! # The global Wronskian divisor and the finite different degree @@ -35,6 +37,8 @@ plane-curve genus/boundary estimate. Those are the remaining geometric inputs needed to derive the final bound `canonicalDegree + |S| <= 2ab`. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain @@ -202,6 +206,7 @@ theorem finiteDifferentDegree_le_minpolyDerivativeDegree K L d hd] at hcast' simpa only [d] using hcast' +omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem ratFunc_intDegree_neg_one_pow (m : ℕ) : ((-1 : RatFunc K) ^ m).intDegree = 0 := by induction m with @@ -349,6 +354,7 @@ def finiteExtensionLocalWronskianDivisor {n : ℕ} finiteExtensionPrincipalDivisor K L (finiteExtensionGlobalWronskian L D g) +omit [DecidableEq K] in @[simp] theorem finiteExtensionLocalWronskianDivisor_apply {n : ℕ} (D : Derivation C L L) (g : Fin n → L) (canonicalDivisor : FiniteExtensionPlace K L →₀ ℤ) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean index 839fed57ff..ee78ca519a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import Mathlib.Tactic /-! # Direct weighted bounds on exhaustive exceptional places @@ -18,6 +20,8 @@ subset lower bound and specializes it to the one-minus quotient used in Proposition 2. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index 88a057ebcf..c0a0ff2e8f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +public import Mathlib.Tactic /-! # Exceptional-place bookkeeping for Corvaja--Zannier @@ -32,6 +34,8 @@ reconstruction `Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines `Papers/arXiv-math-0512074v3/jag_rivisto2.tex`, lines 618--653. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial BigOperators open IsDedekindDomain @@ -558,7 +562,8 @@ section ExceptionalSet variable {A : Type*} [Fintype A] -private def finiteExtensionFamilyMemberSupportEmbedding +/-- Embed the divisor support of one function into the common support of its family. -/ +def finiteExtensionFamilyMemberSupportEmbedding (f : A → L) (a : A) : {w // w ∈ (finiteExtensionPrincipalDivisor K L (f a)).support} ↪ FiniteExtensionFamilyPlace K L f where diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean index f0fea8614a..337e3b60c6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExhaustiveProductFormula.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula -import Mathlib.NumberTheory.FunctionField + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +public import Mathlib.NumberTheory.FunctionField /-! # Exhaustive product formula in a finite extension of `K(X)` @@ -22,6 +24,8 @@ above every finite place, with the finite-place degree factor, and at every prime above infinity. The total is zero. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean index f115dc5db6..7548732e4f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionGcdOutsideHeight.lean @@ -3,13 +3,17 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +public import Mathlib.Tactic /-! The gcd divisor is controlled by the poles of the one-minus quotient. -/ +@[expose] public section + open scoped BigOperators namespace BGS.CorvajaZannier @@ -23,6 +27,7 @@ variable (L : Type*) [Field L] [Algebra (RatFunc K) L] attribute [local instance] Classical.decEq +omit [DecidableEq K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The local integer identity behind the Corvaja--Zannier comparison between the gcd divisor and the pole height of `(1-u)/(1-v)`. -/ theorem gcdMultiplicity_add_outsidePole_le_secondPositivePart diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean index fc7127d997..0ea2a2fc4c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionOneSubGcdHeight.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import Mathlib.Tactic /-! # The gcd height of a function and its complement @@ -15,6 +17,8 @@ Control the common divisor of a function and one minus that function using local exceptional places, and outside height. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean index 137bb11791..fb18d99a37 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import Mathlib.Tactic /-! # Height of a polynomial in a finite rational-function extension @@ -24,6 +26,8 @@ sum, which is evaluated by the norm and the rational-function product formula. No algebraic-closedness hypothesis on the constant field is needed. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean index 11b8d85b9a..a52a6b9a64 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPositiveDegreePower.lean @@ -3,12 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import Mathlib.Tactic /-! # Positive divisor degree of a power -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean index 492999244b..0559a0d79a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import Mathlib.Tactic /-! # Principal divisors on the exhaustive places of a finite function field @@ -25,6 +27,8 @@ field, all finite and above-infinity residue degrees are proved equal to one, so the ordinary-order specialization has no residual place-degree hypothesis. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain @@ -128,6 +132,7 @@ def finiteExtensionFinitePrincipalDivisor (x : L) : finitePrincipalDivisor ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in @[simp] theorem finiteExtensionFinitePrincipalDivisor_apply (x : L) (q : FiniteExtensionFinitePlace K L) : finiteExtensionFinitePrincipalDivisor K L x q = @@ -141,6 +146,7 @@ def finiteExtensionInfinityPrincipalDivisor (x : L) : finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x)) +omit [DecidableEq K] in @[simp] theorem finiteExtensionInfinityPrincipalDivisor_apply (x : L) (P : FiniteExtensionInfinityPlace K L) : finiteExtensionInfinityPrincipalDivisor K L x P = @@ -491,6 +497,7 @@ def finiteExtensionFamilyWeightedOrder (f : A → L) (a : A) finiteExtensionFamilyOrder K L f a v * (finiteExtensionPlaceDegree K L v.1 : ℤ) +omit [DecidableEq K] in theorem finiteExtensionPrincipalDivisor_support_subset_familySupport (f : A → L) (a : A) : (finiteExtensionPrincipalDivisor K L (f a)).support ⊆ @@ -500,6 +507,7 @@ theorem finiteExtensionPrincipalDivisor_support_subset_familySupport Finset.mem_univ, true_and] exact ⟨a, hv⟩ +omit [DecidableEq K] in theorem finiteExtensionFamilyOrder_eq_zero_of_not_mem_support (f : A → L) (a : A) (v : FiniteExtensionFamilyPlace K L f) (hv : v.1 ∉ (finiteExtensionPrincipalDivisor K L (f a)).support) : @@ -835,6 +843,7 @@ noncomputable def ratFuncFinitePlaceResidueEquiv (p : HeightOneSpectrum K[X]) : p.asIdeal.bijective_algebraMap_quotient_residueField exact eResidue.symm.trans eQuot +omit [DecidableEq (RatFunc K)] in theorem ratFuncFinitePlaceDegree_eq_one (p : HeightOneSpectrum K[X]) : ratFuncFinitePlaceDegree p = 1 := by let r := finitePlaceNormalizedPrime p @@ -843,6 +852,7 @@ theorem ratFuncFinitePlaceDegree_eq_one (p : HeightOneSpectrum K[X]) : rw [ratFuncFinitePlaceDegree] exact Polynomial.natDegree_eq_of_degree_eq_some hrdegree +omit [DecidableEq (RatFunc K)] in theorem finiteExtensionFinitePlace_inertiaDeg_eq_one (q : FiniteExtensionFinitePlace K L) : q.asIdeal.inertiaDeg K[X] = 1 := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean index 191c1544fb..b390f4fced 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionProductFormula.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm -import Mathlib.FieldTheory.IsSepClosed + +public import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm +public import Mathlib.FieldTheory.IsSepClosed /-! # Finite-extension norm and place-count formula @@ -22,6 +24,8 @@ clears a denominator to extend the identity to arbitrary elements of the fraction field. Places at infinity are treated separately. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain UniqueFactorizationMonoid diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean index 82c7e77086..a8194113b6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor /-! # Constants surject onto residue fields of all function-field places @@ -19,6 +21,8 @@ This is the exact coefficient-lifting input used by Corvaja--Zannier case (i): equal negative leading terms can be cancelled by a genuine constant. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean index b462c05ea4..22eddacaf7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteFunctionFieldDegree.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.Finite.Basic -import Mathlib.FieldTheory.RatFunc.IntermediateField -import Mathlib.FieldTheory.Relrank + +public import Mathlib.FieldTheory.Finite.Basic +public import Mathlib.FieldTheory.RatFunc.IntermediateField +public import Mathlib.FieldTheory.Relrank /-! # Frobenius degree of a finite function field @@ -27,6 +29,8 @@ extension `L / k(X)` to the corresponding extension of image fields, while the rational function field contributes the factor `q`. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -83,26 +87,21 @@ theorem finiteFunctionField_finrank_frobeniusFieldRange_eq_card : let F0 : IntermediateField k L := i.fieldRange let Fq0 : IntermediateField k L := φF.fieldRange.map i let Lq : IntermediateField k L := φL.fieldRange - have hcomp : φL.comp i = i.comp φF := by ext x change (i x) ^ Fintype.card k = i (x ^ Fintype.card k) exact (map_pow i x (Fintype.card k)).symm - have hFmap : F0.map φL = Fq0 := by change i.fieldRange.map φL = φF.fieldRange.map i rw [AlgHom.map_fieldRange, AlgHom.map_fieldRange, hcomp] - have hTopMap : (⊤ : IntermediateField k L).map φL = Lq := by exact (AlgHom.fieldRange_eq_map φL).symm - have hRelativeFrobenius : IntermediateField.relfinrank Fq0 Lq = IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) := by have h := IntermediateField.relfinrank_map_map F0 (⊤ : IntermediateField k L) φL rwa [hFmap, hTopMap] at h - have hFq0F0 : Fq0 ≤ F0 := by change φF.fieldRange.map i ≤ i.fieldRange calc @@ -110,11 +109,9 @@ theorem finiteFunctionField_finrank_frobeniusFieldRange_eq_card : (⊤ : IntermediateField k k⟮X⟯).map i := IntermediateField.map_mono i le_top _ = i.fieldRange := (AlgHom.fieldRange_eq_map i).symm - have hFq0Lq : Fq0 ≤ Lq := by rw [← hFmap, ← hTopMap] exact IntermediateField.map_mono φL le_top - have hBaseDegree : IntermediateField.relfinrank Fq0 F0 = Fintype.card k := by have h := IntermediateField.relfinrank_map_map @@ -128,14 +125,12 @@ theorem finiteFunctionField_finrank_frobeniusFieldRange_eq_card : _ = Module.finrank φF.fieldRange k⟮X⟯ := IntermediateField.relfinrank_top_right _ _ = Fintype.card k := ratFunc_finrank_frobeniusFieldRange_eq_card k - have hBaseTower := IntermediateField.relfinrank_mul_relfinrank hFq0F0 (show F0 ≤ (⊤ : IntermediateField k L) from le_top) have hFrobeniusTower := IntermediateField.relfinrank_mul_relfinrank hFq0Lq (show Lq ≤ (⊤ : IntermediateField k L) from le_top) rw [hBaseDegree] at hBaseTower rw [hRelativeFrobenius] at hFrobeniusTower - let e : k⟮X⟯ ≃ₐ[k] F0 := i.equivFieldRange let b := Module.finBasis k⟮X⟯ L let b0 := b.mapCoeffs e.toRingEquiv (by @@ -149,7 +144,6 @@ theorem finiteFunctionField_finrank_frobeniusFieldRange_eq_card : (⊤ : IntermediateField k L) := by rw [IntermediateField.relfinrank_top_right] exact Module.finrank_pos - have hcancel : IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) * Fintype.card k = IntermediateField.relfinrank F0 (⊤ : IntermediateField k L) * diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean index 1b760b5755..f12f82d853 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FinitePlaceCompletion.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.DedekindDomain.AdicValuation -import Mathlib.RingTheory.DedekindDomain.Factorization + +public import Mathlib.RingTheory.DedekindDomain.AdicValuation +public import Mathlib.RingTheory.DedekindDomain.Factorization /-! # Finite places and their adic completions @@ -25,6 +27,8 @@ It does not add the places above infinity, a degree map on divisors, or the canonical-divisor degree formula. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean index 847498e406..e41ffec486 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusSubfield.lean @@ -3,16 +3,18 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.CharP.Frobenius -import Mathlib.Algebra.Field.Subfield.Basic -import Mathlib.Algebra.Polynomial.Derivation -import Mathlib.Algebra.Polynomial.Expand -import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra -import Mathlib.FieldTheory.KummerPolynomial -import Mathlib.FieldTheory.PurelyInseparable.Basic -import Mathlib.RingTheory.Adjoin.PowerBasis -import Mathlib.RingTheory.Derivation.Basic + +public import Mathlib.Algebra.CharP.Frobenius +public import Mathlib.Algebra.Field.Subfield.Basic +public import Mathlib.Algebra.Polynomial.Derivation +public import Mathlib.Algebra.Polynomial.Expand +public import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra +public import Mathlib.FieldTheory.KummerPolynomial +public import Mathlib.FieldTheory.PurelyInseparable.Basic +public import Mathlib.RingTheory.Adjoin.PowerBasis +public import Mathlib.RingTheory.Derivation.Basic /-! # The Frobenius subfield @@ -34,6 +36,8 @@ subfield: the degree-`< p` normal form of an element has zero derivative only when it is constant. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean index 29288f04ae..5357624929 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FrobeniusWronskian.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield + +public import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield /-! # Frobenius constants and ordinary Wronskians @@ -16,6 +18,8 @@ ordinary differential-field Wronskian criterion gives the algebraic Wronskian boundary used in the Corvaja--Zannier argument. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean index 926c38baf2..3d97739614 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FunctionFieldProductFormula.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.NumberTheory.RatFunc.Ostrowski -import Mathlib.RingTheory.DedekindDomain.Factorization -import Mathlib.RingTheory.Ideal.IsPrincipal -import Mathlib.RingTheory.UniqueFactorizationDomain.NormalizedFactors -import Mathlib.Algebra.Polynomial.BigOperators + +public import Mathlib.NumberTheory.RatFunc.Ostrowski +public import Mathlib.RingTheory.DedekindDomain.Factorization +public import Mathlib.RingTheory.Ideal.IsPrincipal +public import Mathlib.RingTheory.UniqueFactorizationDomain.NormalizedFactors +public import Mathlib.Algebra.Polynomial.BigOperators /-! # A normalized-factor product formula for the rational function field @@ -29,6 +31,8 @@ the integral closure, nor the global finite-place identity combining ramification and residue degrees over each base place. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Polynomial UniqueFactorizationMonoid open Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean index 25cb167943..448940cdf2 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GeneralCorvajaZannier.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound /-! # The general Corvaja--Zannier plane-curve theorem @@ -16,6 +18,8 @@ powered-image index input, so that the geometric index theorem can be audited independently; the unconditional endpoint below instantiates that input. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean index ea07fd6568..b50896ceb7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianPlaceSum.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +public import Mathlib.Tactic /-! # Summing the four local Corvaja--Zannier Wronskian cases @@ -18,6 +20,8 @@ boundary: constructing these data from the places of the plane-curve function field. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean index f6b21aecb4..8933da3120 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianSummation.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound /-! # Global Wronskian summation for Corvaja--Zannier Proposition 2 @@ -16,6 +18,8 @@ displayed summed Wronskian inequality; it is not assumed as an axiom or hidden in a typeclass. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean index 8ec08a410d..072b23e685 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/GlobalWronskianWeightedPlaceSum.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +public import Mathlib.Tactic /-! # Degree-weighted Corvaja--Zannier Wronskian summation @@ -19,6 +21,8 @@ This is the finite combinatorial form of the weighted divisor summation in Corvaja--Zannier, Proposition 2 (published reconstruction, pp. 15--16). -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean index 031897744d..8160440816 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +public import Mathlib.Tactic /-! # Residue degree one above the rational-function place at infinity @@ -18,6 +20,8 @@ residue field at every prime above infinity in a finite separable extension of one. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean index caf2e30b2c..8da0190de5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityPlace.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula -import Mathlib.RingTheory.DiscreteValuationRing.TFAE -import Mathlib.RingTheory.Valuation.Archimedean -import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +public import Mathlib.RingTheory.DiscreteValuationRing.TFAE +public import Mathlib.RingTheory.Valuation.Archimedean +public import Mathlib.RingTheory.Valuation.Discrete.IsDiscreteValuationRing /-! # The place at infinity and its primes in finite extensions @@ -27,6 +29,8 @@ base prime, producing the residue-degree-weighted sum over all primes above infinity. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean index 2221b874f5..95242adf91 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusBasis.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.Adjoin.PowerBasis -import Mathlib.RingTheory.LaurentSeries + +public import Mathlib.RingTheory.Adjoin.PowerBasis +public import Mathlib.RingTheory.LaurentSeries /-! # Exponent dilation on Laurent series @@ -14,6 +16,8 @@ This file isolates the *parameter* map `z |-> z^q` on `K((z))`. It is not the coefficientwise Frobenius: coefficients are left unchanged. -/ +@[expose] public section + open HahnSeries noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean index f877b6963c..d1ce57cb75 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LaurentFrobeniusPowerBasis.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis -import Mathlib.LinearAlgebra.Basis.Basic -import Mathlib.LinearAlgebra.Dimension.StrongRankCondition + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +public import Mathlib.LinearAlgebra.Basis.Basic +public import Mathlib.LinearAlgebra.Dimension.StrongRankCondition /-! # The Laurent-series power basis over exponent dilation @@ -17,6 +19,8 @@ Together with the residue-class independence theorem, this proves that extension has degree `q`. -/ +@[expose] public section + open HahnSeries noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean index 3a3a13bda8..8907d86480 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian -import Mathlib.Algebra.Order.Group.Int.Sum -import Mathlib.LinearAlgebra.Matrix.Transvection + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +public import Mathlib.Algebra.Order.Group.Int.Sum +public import Mathlib.LinearAlgebra.Matrix.Transvection /-! # Corvaja--Zannier local case (i) @@ -28,6 +30,8 @@ Source provenance: published pages 1935--1936; checked semantic reconstruction `Papers/CorvajaZannier2013/CorvajaZannier2013.tex`, lines 640--685. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean index 93cbffd5b4..7206f7730f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian -import Mathlib.LinearAlgebra.Matrix.Determinant.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic /-! # Local auxiliary-family Wronskian estimates @@ -32,6 +34,8 @@ Source provenance: published pages 1935--1936; checked semantic reconstruction is lines 689--691, and the case-(iii) column operation is lines 694--719. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean index e30667b042..c077876898 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalDerivative.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.LaurentSeries + +public import Mathlib.RingTheory.LaurentSeries /-! # Local derivative estimates for Corvaja--Zannier @@ -18,6 +20,8 @@ The statements use `HahnSeries.orderTop`, rather than `HahnSeries.order`, so that they remain valid when the derivative vanishes. -/ +@[expose] public section + namespace BGS.CorvajaZannier open HahnSeries LaurentSeries diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean index ab70dba65f..8f753047c9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 University of Washington Math AI Lab. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Bianca Viray, Bryan Boehnke, Grant Yang, George Peykanu, Tianshuo Wang -/ +module -import Mathlib.RingTheory.LocalRing.Etale -import Mathlib.RingTheory.RingHom.Etale -import Mathlib.RingTheory.Ideal.Height + +public import Mathlib.RingTheory.LocalRing.Etale +public import Mathlib.RingTheory.RingHom.Etale +public import Mathlib.RingTheory.Ideal.Height /-! # Monogenicity from étale height-one quotients @@ -39,6 +41,8 @@ closed, `S` a UFD, and there exists a height-one prime `q ⊆ S` such that `R/(q étale, monogenic, local ring, height one, UFD -/ +@[expose] public section + open Polynomial Function RingHom IsLocalRing namespace BGS.CorvajaZannier.LocalMonogenic diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean index eecdf70921..204f703ecd 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalReciprocalDiscriminant.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import Mathlib.Algebra.Polynomial.Reverse -import Mathlib.RingTheory.Polynomial.Resultant.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import Mathlib.Algebra.Polynomial.Reverse +public import Mathlib.RingTheory.Polynomial.Resultant.Basic /-! # Reciprocal normalization at a finite base place @@ -24,6 +26,8 @@ coefficient-reversal discriminant formula needed for a nonmonic relation was not previously available in Mathlib in this form. -/ +@[expose] public section + namespace BGS.CorvajaZannier open IsDedekindDomain Polynomial @@ -32,7 +36,8 @@ noncomputable section variable {R : Type*} [CommRing R] -private def reflectSylvesterEquiv (m n : ℕ) : Fin (n + m) ≃ Fin (m + n) := +/-- Reverse and exchange the two index blocks of a Sylvester matrix. -/ +def reflectSylvesterEquiv (m n : ℕ) : Fin (n + m) ≃ Fin (m + n) := (finCongr (Nat.add_comm n m)).trans Fin.revPerm @[simp] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean index 8e299e6125..0d6a2b2e4d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative -import Mathlib.LinearAlgebra.Matrix.Determinant.Basic -import Mathlib.RingTheory.HahnSeries.Valuation + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +public import Mathlib.LinearAlgebra.Matrix.Determinant.Basic +public import Mathlib.RingTheory.HahnSeries.Valuation /-! # Local Wronskian order estimates @@ -22,6 +24,8 @@ function field in these completions and summing the resulting orders remain separate global geometric obligations. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean index 6804d9c05a..e2bcd56d01 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalCorollary.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization /-! # The numerical Corvaja--Zannier Theorem 2 bound @@ -16,6 +18,8 @@ hypothesis is the ordinary Proposition 2 alternative for every admissible pair of natural parameters. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean index 644344bb26..cc0b57844d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/NumericalOptimization.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Analysis.SpecialFunctions.Pow.Real -import Mathlib.Tactic.FieldSimp -import Mathlib.Tactic.Linarith -import Mathlib.Tactic.NormNum -import Mathlib.Tactic.Positivity -import Mathlib.Tactic.Ring + +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Tactic.FieldSimp +public import Mathlib.Tactic.Linarith +public import Mathlib.Tactic.NormNum +public import Mathlib.Tactic.Positivity +public import Mathlib.Tactic.Ring /-! # Numerical optimization in Corvaja--Zannier Theorem 2 @@ -29,6 +31,8 @@ the parameterized Theorem-4 estimate as an ordinary hypothesis, so it can be applied directly once the curve-theoretic part of Theorem 4 is formalized. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean index 70d8217a56..c2a55c3c61 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/ParameterizedBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Analysis.SpecialFunctions.Pow.Real -import Mathlib.Tactic + +public import Mathlib.Analysis.SpecialFunctions.Pow.Real +public import Mathlib.Tactic /-! # The parameterized numerical bound in Corvaja--Zannier Theorem 4 @@ -24,6 +26,8 @@ The proof below retains that choice and checks the small-`k`, degree- alternative, parameter-admissibility, and numerical-bound cases separately. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -149,7 +153,6 @@ private theorem propositionTwo_numerical_bound let xK : ℝ := t * kScale let h : ℕ := ⌊xH⌋₊ - 1 let k : ℕ := ⌊xK⌋₊ - 1 - 0 < k → k ≤ h → G ≤ (((h + 2 * k : ℕ) : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * A + ((k : ℝ) / ((h * k + h + k : ℕ) : ℝ)) * B + @@ -175,7 +178,6 @@ private theorem propositionTwo_numerical_bound simpa [kScale] using rpow_one_third_cube hkRadicandPos.le have hxHPos : 0 < xH := by dsimp [xH]; positivity have hxKPos : 0 < xK := by dsimp [xK]; positivity - have hAdivKScale : A / kScale = baseRoot := by apply (pow_left_inj₀ (by positivity) hbaseRootPos.le (by norm_num : (3 : ℕ) ≠ 0)).mp @@ -194,7 +196,6 @@ private theorem propositionTwo_numerical_bound rw [mul_pow, mul_pow, hhScaleCube, hkScaleCube, hbaseRootCube] dsimp [base] field_simp [hAPos.ne', hBPos.ne', hCPos.ne'] - have hhPos : 0 < h := lt_of_lt_of_le hkPos hkh have hkFloorOne : 1 ≤ ⌊xK⌋₊ := by dsimp [k] at hkPos @@ -315,7 +316,6 @@ theorem theoremFour_parameterizedBound_of_propositionTwo let xK : ℝ := t * kScale let h : ℕ := ⌊xH⌋₊ - 1 let k : ℕ := ⌊xK⌋₊ - 1 - have hAPos : 0 < A := by dsimp [A]; exact_mod_cast ha have hANonnegFromG : 0 ≤ A := hGNonneg.trans (by simpa [A] using hGTrivial) have hBPos : 0 < B := by @@ -341,7 +341,6 @@ theorem theoremFour_parameterizedBound_of_propositionTwo simpa [kScale] using rpow_one_third_cube hkRadicandPos.le have hxHPos : 0 < xH := by dsimp [xH]; positivity have hxKPos : 0 < xK := by dsimp [xK]; positivity - have hscaledDegrees : A * hScale = B * kScale := by apply (pow_left_inj₀ (by positivity) (by positivity) (by norm_num : (3 : ℕ) ≠ 0)).mp rw [mul_pow, mul_pow, hhScaleCube, hkScaleCube] @@ -367,7 +366,6 @@ theorem theoremFour_parameterizedBound_of_propositionTwo have hkh : k ≤ h := by dsimp [h, k] exact Nat.sub_le_sub_right (Nat.floor_mono hxKLeXH) 1 - have hSizeCross : ((A * B) ^ 2) * (8 * t ^ 3) < (P + A + B) ^ 3 * C := by have hdenPos : 0 < 8 * t ^ 3 := by positivity @@ -385,7 +383,6 @@ theorem theoremFour_parameterizedBound_of_propositionTwo _ < (P + A + B) ^ 3 := hdiv have hCommonLt : 2 * t * (A * hScale) < P + A + B := lt_of_pow_lt_pow_left₀ 3 (by positivity) hCommonCubeLt - by_cases hkSmall : k < 1 · have hkZero : k = 0 := by omega have hxKTwo : xK < 2 := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean index cd893bc04c..a791f464f9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PerfectConstants.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield -import Mathlib.FieldTheory.Perfect + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +public import Mathlib.FieldTheory.Perfect /-! # Perfect constants inside the Frobenius subfield @@ -16,6 +18,8 @@ function field, is a `p`-th power and belongs to the Frobenius subfield. This file records that compatibility without identifying the two fields. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean index 2a168dcbbb..72a07b48f6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant -import Mathlib.NumberTheory.FunctionField + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +public import Mathlib.NumberTheory.FunctionField /-! # Auxiliary Wronskian bounds at finite plane-curve places @@ -21,6 +23,8 @@ restricting scalars from the Frobenius constant field. Thus no algebra map from the Frobenius constant field to a nontrivial DVR is required. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial BigOperators open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean index b9cc3dcb7d..ff125e9190 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI -import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula /-! # Cases I and II at actual finite extension places @@ -16,6 +18,8 @@ bridge, and scaled-derivation forms of the first two local Corvaja--Zannier Wronskian estimates. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial BigOperators open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean index 087880d17f..3c65d867ef 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace /-! # Actual finite-place auxiliary orders in the exhaustive divisor model @@ -15,6 +17,8 @@ exhaustive-place infrastructure, then identifies its normalized order with the coefficient used by the global principal divisor. -/ +@[expose] public section + open scoped Polynomial open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean index d9baf90c9b..1334cae2c4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius /-! # The plane-curve auxiliary family over the Frobenius subfield @@ -31,6 +33,8 @@ specialization with Frobenius exponent `p` and no auxiliary twists is the linear-independence input cited on published page 1940. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean index b6faf6fa03..85a90c02c7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBidegreeBridge.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems /-! # From the public bidegree interface to function-field degrees @@ -18,6 +20,8 @@ projections. This file records the exact, assumption-free bridge between those two presentations. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean index 59132319d2..670399529d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import Mathlib.Tactic /-! # Weighted boundary support for a plane curve @@ -27,6 +29,8 @@ The final theorem is stated directly for the zero/pole boundary `propositionTwoExceptionalPlaces` of positive coordinate powers. -/ +@[expose] public section + open scoped Polynomial open IsDedekindDomain Multiplicative WithZero @@ -106,6 +110,7 @@ private noncomputable def probeFiniteExtensionPlaceValuation | .inl q => q.valuation L | .inr P => (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L +omit [DecidableEq K] in private theorem probeFiniteExtensionPlaceValuation_surjective (w : FiniteExtensionPlace K L) : Function.Surjective (probeFiniteExtensionPlaceValuation K L w) := by @@ -144,6 +149,7 @@ private theorem probeFiniteExtensionPlaceValuation_eq_exp_neg_order exact valuation_eq_exp_neg_finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x hx +omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem probe_finiteExtensionFinitePlace_X_le_one (q : FiniteExtensionFinitePlace K L) : q.valuation L (algebraMap (RatFunc K) L RatFunc.X) ≤ 1 := by @@ -152,6 +158,7 @@ private theorem probe_finiteExtensionFinitePlace_X_le_one (RatFuncFiniteIntegralClosure K L) L] exact q.valuation_le_one _ +omit [DecidableEq K] in private theorem probe_finiteExtensionInfinityPlace_X_gt_one (P : FiniteExtensionInfinityPlace K L) : 1 < (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L @@ -374,12 +381,14 @@ private def valuationCenterIdeal Ideal.comap (integralClosureToValuationSubring (S := S) V hbase) (IsLocalRing.maximalIdeal V) +omit [IsDomain R] [IsDedekindDomain S] [IsFractionRing S F] in private theorem valuationCenterIdeal_isPrime (V : ValuationSubring F) (hbase : ∀ r : R, algebraMap R F r ∈ V) : (valuationCenterIdeal (S := S) V hbase).IsPrime := by exact Ideal.comap_isPrime _ _ +omit [IsDomain R] [IsDedekindDomain S] in private theorem valuationCenterIdeal_ne_bot_of_mem_nonunits (V : ValuationSubring F) (hbase : ∀ r : R, algebraMap R F r ∈ V) @@ -464,6 +473,8 @@ private theorem valuationSubringAt_valuationCenterPlace_eq end ValuationCenter include L in +omit [DecidableEq (RatFunc K)] [Field L] [Algebra (RatFunc K) L] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in private theorem probe_ratFuncFinitePlaceDegree_eq_finrank_residue (p : HeightOneSpectrum K[X]) : Module.finrank K p.asIdeal.ResidueField = ratFuncFinitePlaceDegree p := by @@ -512,6 +523,7 @@ private theorem probe_finiteExtensionPlaceDegree_inl_eq_finrank_residue rw [← probe_ratFuncFinitePlaceDegree_eq_finrank_residue K L p] rw [mul_comm, Module.finrank_mul_finrank] +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in private theorem probe_finiteExtensionPlaceDegree_inr_eq_finrank_residue (P : FiniteExtensionInfinityPlace K L) : finiteExtensionPlaceDegree K L (.inr P) = @@ -573,6 +585,7 @@ private theorem weightedSum_le_of_injective rw [← imageSum] exact Finset.sum_le_sum_of_subset imageSubset +omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem finitePlace_of_valuation_positive [Algebra K L] [IsScalarTower K (RatFunc K) L] (y : L) (hy0 : y ≠ 0) (hpolyX : algebraMap K[X] L Polynomial.X = y) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean index 1fe1f8410e..de0393335e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +public import Mathlib.Tactic /-! # The canonical different degree of a plane function field @@ -21,6 +23,8 @@ The result is the expected first-projection canonical bound No algebraic closure of the constant field is assumed. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors BigOperators open Polynomial IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean index 7901adc900..125006cee6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalEulerBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +public import Mathlib.Tactic /-! # The log-canonical degree budget for a plane curve @@ -16,6 +18,8 @@ zero/pole boundary estimate. It is the exact geometric input `chi = 2ab` used by the exhaustive-place form of Corvaja--Zannier Proposition 2. -/ +@[expose] public section + open scoped Polynomial BigOperators namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean index f716502b59..e07d4c5cb1 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalGcdBound.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +public import Mathlib.Tactic /-! # The canonical Corvaja--Zannier bound for powered plane coordinates @@ -19,6 +21,8 @@ powered-coordinate height theorems replace abstract positive divisor degrees by the actual bidegree budgets. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean index 665b4fcb03..d77dba61a7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCharacteristicCardinality.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import Mathlib.Algebra.CharP.CharAndCard -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import Mathlib.Algebra.CharP.CharAndCard +public import Mathlib.Tactic /-! # Plane-curve degrees versus finite-field cardinality @@ -16,6 +18,8 @@ Corvaja--Zannier argument into the finite-field cardinality bounds required by the local reciprocal-discriminant and canonical Euler estimates. -/ +@[expose] public section + namespace BGS.CorvajaZannier /-- The prime characteristic of a finite field is at most its cardinality. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean index 738d9082ba..8ab49f4bf6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel /-! # Exact heights of powered plane-curve coordinates @@ -16,6 +18,8 @@ those models with the polynomial-height formula computes the positive degree of the principal divisor of `x ^ m - 1` and `y ^ n - 1` exactly. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean index 1776c3f63c..d4f7da8798 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss +public import Mathlib.Tactic /-! # Diagonal stabilizers of plane curves @@ -15,6 +17,8 @@ Describe diagonal scaling through polynomial coefficients and relate curve stabi characters of the support. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -32,11 +36,11 @@ theorem coeff_diagonalScale {F : Type*} [Field F] f.coeff m * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 := by classical by_cases hm : m ∈ f.support - · simp [diagonalScale, MvPolynomial.coeff_sum, + · simp [diagonalScale, MvPolynomial.coeff_monomial, hm] · have hcoeff : f.coeff m = 0 := MvPolynomial.notMem_support_iff.mp hm - simp [diagonalScale, MvPolynomial.coeff_sum, + simp [diagonalScale, MvPolynomial.coeff_monomial, hm, hcoeff] theorem support_diagonalScale {F : Type*} [Field F] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean index 1bed7c833c..76d20a42cc 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiscriminantBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge /-! # A sharp degree bound for a bivariate discriminant @@ -20,6 +22,8 @@ This is the algebraic degree estimate needed in the Corvaja--Zannier canonical/d calculation. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean index 2127b0ca0a..68a945c517 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveExhaustiveGcdEndpoint.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound /-! # Exhaustive gcd divisor at the plane-curve endpoint @@ -17,6 +19,8 @@ the injection of rational torsion points into the exhaustive divisor lets us transfer Proposition 2 downward to the actual torsion-point cardinality. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean index 26ac2dbdb3..8987d727f4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace -import Mathlib.RingTheory.Localization.Integral -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import Mathlib.RingTheory.Localization.Integral +public import Mathlib.Tactic /-! # The sharp finite different bound for a plane curve @@ -19,6 +21,8 @@ base prime; a prime-unit denominator-clearing argument then compares its minimal-polynomial discriminant with the global different. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors BigOperators open Polynomial IsDedekindDomain @@ -76,7 +80,7 @@ theorem powerBasis_discr_smul_eq_diagonal_det_sq_mul (P.map (algebraMap K L)).mulVec (fun i => pbz.basis (e i)) := by funext i rw [show pbx.basis i = pbx.gen ^ (i : ℕ) by - simpa only [PowerBasis.coe_basis] using congrFun (PowerBasis.coe_basis pbx) i] + simp only [PowerBasis.coe_basis] using congrFun (PowerBasis.coe_basis pbx) i] rw [show P.map (algebraMap K L) = Matrix.diagonal (fun i : Fin pbx.dim => algebraMap K L (r ^ (i : ℕ))) by @@ -85,7 +89,7 @@ theorem powerBasis_discr_smul_eq_diagonal_det_sq_mul split <;> simp_all] rw [Matrix.mulVec_diagonal] rw [show pbz.basis (e i) = pbz.gen ^ ((e i : Fin pbz.dim) : ℕ) by - simpa only [PowerBasis.coe_basis] using + simp only [PowerBasis.coe_basis] using congrFun (PowerBasis.coe_basis pbz) (e i)] rw [hgenX, hgenZ] have hei : ((e i : Fin pbz.dim) : ℕ) = (i : ℕ) := by simp [e] @@ -171,7 +175,7 @@ theorem finitePlaceOrder_algebraMap_unit_eq_zero finitePlaceOrder v (algebraMap R F (u : R)) = 0 := by have h := finitePlaceOrderTop_algebraMap_unit (A := R) (K := F) v u have hu : algebraMap R F (u : R) ≠ 0 := - by simpa using (IsFractionRing.injective R F).ne u.ne_zero + by simp using (IsFractionRing.injective R F).ne u.ne_zero rw [finitePlaceOrderTop_eq_coe v _ hu] at h exact_mod_cast h @@ -473,6 +477,7 @@ theorem finiteExtensionFiniteDifferentDegree_le_polynomialDegree_of_localBounds _ = (Δ.natDegree : ℤ) := RatFunc.intDegree_polynomial exact_mod_cast hcast +omit [DecidableEq K] [DecidableEq (RatFunc K)] in theorem finiteExtensionFiniteDifferentDivisorBelow_apply_le_minpolyDiscr_of_localPrimitive (hDifferent : differentIdeal K[X] (RatFuncFiniteIntegralClosure K L) ≠ ⊥) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean index f91786a7e4..c460b2f44c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFunctionField.lean @@ -3,15 +3,17 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.MvPolynomial.Equiv -import Mathlib.Algebra.MvPolynomial.PDeriv -import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra -import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic -import Mathlib.FieldTheory.Minpoly.Field -import Mathlib.RingTheory.Localization.FractionRing -import Mathlib.Algebra.MvPolynomial.NoZeroDivisors -import Mathlib.RingTheory.AlgebraicIndependent.Transcendental + +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Algebra.MvPolynomial.PDeriv +public import Mathlib.FieldTheory.IntermediateField.Adjoin.Algebra +public import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic +public import Mathlib.FieldTheory.Minpoly.Field +public import Mathlib.RingTheory.Localization.FractionRing +public import Mathlib.Algebra.MvPolynomial.NoZeroDivisors +public import Mathlib.RingTheory.AlgebraicIndependent.Transcendental /-! # Function fields of irreducible affine plane curves @@ -22,6 +24,8 @@ defining relation. These are the algebraic objects used in the plane-curve spec Corvaja--Zannier argument. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean index 28e08712c8..53d56fe6b1 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityComplement.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree /-! # The complementary different bound above infinity @@ -18,6 +20,8 @@ Together with the finite-place discriminant bound, this gives the sharp total different budget used in the Corvaja--Zannier plane-curve estimate. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors open Multiplicative WithZero Polynomial IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean index 56da63a8bd..2b544d5c14 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +public import Mathlib.Tactic /-! # The discriminant budget at infinity for a plane curve @@ -37,6 +39,8 @@ polynomial with a primitive element of the plane-curve function field is the remaining local normalization step. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors open Multiplicative WithZero Polynomial IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean index 43f187ae9f..57a6f8ebe0 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentDegree.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound /-! # The degree of the different at infinity @@ -13,6 +15,8 @@ Bound the different at infinity using a primitive element, its discriminant, and reciprocal polynomial. -/ +@[expose] public section + open Polynomial namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean index 6671865260..1e6097224e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLocalReciprocalDiscriminant.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound -import Mathlib.Algebra.Polynomial.Roots -import Mathlib.RingTheory.Localization.LocalizationLocalization -import Mathlib.RingTheory.Polynomial.ContentIdeal + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +public import Mathlib.Algebra.Polynomial.Roots +public import Mathlib.RingTheory.Localization.LocalizationLocalization +public import Mathlib.RingTheory.Polynomial.ContentIdeal /-! # Local reciprocal normalization for an irreducible plane curve @@ -25,6 +27,8 @@ polynomial of the reciprocal local parameter with the unit-normalized reciprocal translate of the localized plane equation. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean index e6a2c7ec61..3978915f9e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveLogarithmicGauss.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +public import Mathlib.Tactic /-! # The logarithmic Gauss direction of a plane curve @@ -22,6 +24,8 @@ curve. This isolates the high-characteristic input needed by the logarithmic-Gauss route to the powered-image index bound. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean index 5d285083ad..5d4d3c5b0c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +public import Mathlib.Tactic /-! # Powered coordinate heights in the first-coordinate place model @@ -17,6 +19,8 @@ This module records the exact first-coordinate height and the transported upper bound for the second-coordinate height, including positive powers. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -26,6 +30,7 @@ open scoped Polynomial variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] +omit [Fintype K] in /-- In the first-coordinate place model, `x^m` has its expected exact positive divisor degree. -/ theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow @@ -187,6 +192,7 @@ theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_le hf hpartialFirst hpartialSecond n omega +omit [Fintype K] in /-- The exhaustive gcd degree is symmetric in its two arguments. -/ theorem finiteExtensionGcdWeightedDegree_comm {L : Type*} [Field L] [Algebra (RatFunc K) L] @@ -202,6 +208,7 @@ theorem finiteExtensionGcdWeightedDegree_comm intro w _hw rw [min_comm] +omit [Fintype K] in /-- Simultaneously changing the signs of the two functions does not change their exhaustive gcd divisor degree. -/ theorem finiteExtensionGcdWeightedDegree_neg_neg @@ -223,6 +230,7 @@ theorem finiteExtensionGcdWeightedDegree_neg_neg finiteExtensionGcdSupport rw [hdivx, hdivy] +omit [DecidableEq (RatFunc K)] in /-- The torsion gcd used by the endpoint is exactly the `1-u`, `1-v` gcd used by the canonical Wronskian estimate. -/ theorem planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean index 6805cb42cf..8e43e6fe47 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredImageDegreeBudget.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree /-! # Exact source-height factorization through the powered image @@ -17,6 +19,8 @@ the powered-image relation and the second is the common source-to-image index. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean index c9489f92d3..179de64f61 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +public import Mathlib.Tactic /-! # Numerical assembly of plane-curve Proposition 2 @@ -18,6 +20,8 @@ index, and trivial-gcd bookkeeping is discharged here in both coordinate orientations. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean index 386e61498d..eb0a331c96 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoDegreeBridge.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +public import Mathlib.Tactic /-! # From actual plane-curve degrees to the public Proposition 2 certificate @@ -19,6 +21,8 @@ degree data without asserting the false monotonicity of Proposition 2's degree alternative. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean index 0252ee1924..153cd74c8a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoGeometric.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality -import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped /-! # Geometric Proposition 2 for a plane curve @@ -21,6 +23,8 @@ explicit premise of the two orientation lemmas; the following endpoint module discharges it from the non-subtorus hypothesis. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean index 61fd341ab9..33b97631f8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveRatFuncModel.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability /-! # A rational-function-field model for a plane curve @@ -21,6 +23,8 @@ formalization: its base is literally `RatFunc K`, and `X` specializes to the first coordinate function. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean index f46b042cd5..9793da472d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSeparability.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField -import Mathlib.FieldTheory.Separable -import Mathlib.FieldTheory.SeparableDegree -import Mathlib.RingTheory.Polynomial.GaussLemma -import Mathlib.RingTheory.AlgebraicIndependent.Adjoin + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +public import Mathlib.FieldTheory.Separable +public import Mathlib.FieldTheory.SeparableDegree +public import Mathlib.RingTheory.Polynomial.GaussLemma +public import Mathlib.RingTheory.AlgebraicIndependent.Adjoin /-! # Separability of a plane-curve coordinate extension @@ -19,6 +21,8 @@ the first coordinate. The proof passes through the iterated-polynomial presentat lemma. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean index 7a979625ce..6833fe5be3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSharedOriginBoundary.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound -import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +public import Mathlib.Tactic /-! # Saving one boundary degree at a shared affine origin @@ -22,6 +24,8 @@ rational point has residue degree one. Positivity of the selected place degree is sufficient for the one-unit saving. -/ +@[expose] public section + open scoped Polynomial BigOperators namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean index 9bea62c763..ff0330b3f5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportDeterminant.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +public import Mathlib.Tactic /-! # Rank-two support certificates for a plane curve @@ -20,6 +22,8 @@ the Corvaja--Zannier endpoint, every nonzero such determinant is automatically nonzero modulo the characteristic. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean index daee870ef4..18a55fe226 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import Mathlib.GroupTheory.Archimedean -import Mathlib.Algebra.Polynomial.Homogenize -import Mathlib.Algebra.MvPolynomial.NoZeroDivisors -import Mathlib.FieldTheory.IsAlgClosed.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import Mathlib.GroupTheory.Archimedean +public import Mathlib.Algebra.Polynomial.Homogenize +public import Mathlib.Algebra.MvPolynomial.NoZeroDivisors +public import Mathlib.FieldTheory.IsAlgClosed.Basic +public import Mathlib.Tactic /-! # Absolute irreducibility forces rank-two torus support @@ -25,6 +27,8 @@ character is constant on the curve. This contradicts the semantic `TorusCurveNotSubtorusTranslate` hypothesis. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -167,7 +171,8 @@ private theorem integerVectorLine_cyclic {d : Fin 2 → ℤ} (hd : d ≠ 0) : simpa [vL] using hk.symm exact congrArg Subtype.val heq -private def planeExponentDifference +/-- The signed coordinate difference between two plane monomial exponents. -/ +def planeExponentDifference (r s : Fin 2 →₀ ℕ) : Fin 2 → ℤ := fun i => (s i : ℤ) - (r i : ℤ) @@ -306,7 +311,7 @@ private theorem directionalHomogenization_not_isUnit (∑ k ∈ S, g k).coeff e = ∑ k ∈ S, (g k).coeff e := by induction S using Finset.induction_on with | empty => simp - | @insert a S ha ih => simp [ha, ih] + | @insert a S ha ih => simp [ha] exact coeff_finset_sum _ _ have htop : q.coeff N ≠ 0 := by rw [← hqdeg] @@ -440,11 +445,11 @@ private theorem exists_directionalPolynomial_representation have index_cast : ∀ s ∈ F.support, (index s : ℤ) = parameter s - lo := by intro s hs rw [show (index s : ℤ) = max (parameter s - lo) 0 by - simpa [index] using Int.ofNat_toNat (parameter s - lo)] + simp [index] using Int.ofNat_toNat (parameter s - lo)] simp [parameter_bounds s hs |>.1] have N_cast : (N : ℤ) = hi - lo := by rw [show (N : ℤ) = max (hi - lo) 0 by - simpa [N] using Int.ofNat_toNat (hi - lo)] + simp [N] using Int.ofNat_toNat (hi - lo)] have hlohi : lo ≤ hi := Finset.min'_le P hi hhi_mem simp [hlohi] have index_le : ∀ s ∈ F.support, index s ≤ N := by @@ -487,7 +492,7 @@ private theorem exists_directionalPolynomial_representation rw [show q.coeff (index s) = ∑ t ∈ F.support, (Polynomial.monomial (index t) (F.coeff t)).coeff (index s) by - simpa [q] using coeff_finset_sum (index s) F.support + simp [q] using coeff_finset_sum (index s) F.support (fun t => Polynomial.monomial (index t) (F.coeff t))] rw [Finset.sum_eq_single s] · rw [Polynomial.coeff_monomial, ite_eq_left rfl] @@ -514,7 +519,7 @@ private theorem exists_directionalPolynomial_representation rw [show q.coeff n = ∑ s ∈ F.support, (Polynomial.monomial (index s) (F.coeff s)).coeff n by - simpa [q] using coeff_finset_sum n F.support + simp [q] using coeff_finset_sum n F.support (fun s => Polynomial.monomial (index s) (F.coeff s))] simp only [Polynomial.coeff_monomial] apply Finset.sum_eq_zero diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean index 2a9a2f2413..cf8ec32173 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinateRelation.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates -import Mathlib.Algebra.Polynomial.RingDivision + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +public import Mathlib.Algebra.Polynomial.RingDivision /-! # An explicit relation between powered plane-curve coordinates @@ -24,6 +26,8 @@ theorem feeds these facts into Proposition 1 without leaving an unspecified relation polynomial as a hypothesis. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean index 33ca81519e..8b3b6637b7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredCoordinates.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import Mathlib.RingTheory.Coprime.Lemmas + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import Mathlib.RingTheory.Coprime.Lemmas /-! # Prime-to-characteristic powers of plane-curve coordinates @@ -26,6 +28,8 @@ its bidegrees, remains a separate algebraic-geometric step; it is not assumed implicitly here. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean index a4885bb68c..692346efc6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageBaseChange.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +public import Mathlib.Tactic /-! # Constant-field base change for the powered-image index @@ -19,6 +21,8 @@ extension of constants. This is the descent bridge from the algebraically closed stabilizer argument to the original constant field. -/ +@[expose] public section + open scoped TensorProduct Polynomial open Polynomial @@ -76,9 +80,6 @@ classes. -/ planeCurveCoordinate (MvPolynomial.map (algebraMap K E) f) i := by simp [planeCurveCoordinateRingMap, planeCurveCoordinate, planeCurveQuotientMap] - change Ideal.Quotient.mk (Ideal.span {MvPolynomial.map (algebraMap K E) f}) - (MvPolynomial.map (algebraMap K E) (MvPolynomial.X i)) = _ - rw [MvPolynomial.map_X] /-- The coefficient base change of the canonical powered-image relation vanishes on the generic powered coordinates of the base-changed curve. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean index 11340cb7b1..5dab33aa7e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation -import Mathlib.FieldTheory.RatFunc.AsPolynomial -import Mathlib.RingTheory.Polynomial.GaussLemma + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +public import Mathlib.FieldTheory.RatFunc.AsPolynomial +public import Mathlib.RingTheory.Polynomial.GaussLemma /-! # The actual powered-coordinate image curve @@ -24,6 +26,8 @@ degree in `x^m` is at most `n * degreeOf 0 f`. This is the source-sensitive elimination input needed for the Corvaja--Zannier middle game. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -311,7 +315,8 @@ theorem ratFuncSpecialization_comp_polynomial_algebraMap Polynomial.eval₂RingHom (algebraMap K L) u := by apply Polynomial.ringHom_ext · intro c - simp [ratFuncSpecialization] + simp only [RingHom.coe_comp, Function.comp_apply, RatFunc.algebraMap_C, Polynomial.coe_eval₂RingHom, + Polynomial.eval₂_C] rw [← RatFunc.algebraMap_eq_C, (RatFunc.algEquivOfTranscendental u hu).commutes] rfl diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean index 8b4b9cab41..02cbb68078 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageExactSupportIndexBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound /-! # Powered-image index from an exact support determinant @@ -15,6 +17,8 @@ its exact determinant. It is useful for sparse curves whose support lattice has much smaller index than the ambient degree box. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean index 63fa36f2b1..4d9b0d962e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelation.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange -import Mathlib.RingTheory.TensorProduct.MvPolynomial -import Mathlib.RingTheory.TensorProduct.Quotient -import Mathlib.RingTheory.Flat.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +public import Mathlib.RingTheory.TensorProduct.MvPolynomial +public import Mathlib.RingTheory.TensorProduct.Quotient +public import Mathlib.RingTheory.Flat.Basic /-! # Powered-image relations over the Frobenius constant field @@ -20,6 +22,8 @@ the relation criterion to obtain the auxiliary-family linear independence used in the Corvaja--Zannier Wronskian argument. -/ +@[expose] public section + open scoped TensorProduct Polynomial namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean index d3ae65e981..9a9ee40ad3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageFrobeniusRelationSwapped.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +public import Mathlib.Tactic /-! # The powered-image auxiliary family with exchanged coordinates @@ -18,6 +20,8 @@ It uses the untransposed powered-image equation and the first-coordinate Frobenius power basis. -/ +@[expose] public section + open scoped Polynomial namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean index 95ae7e7847..ecf7fd7c85 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageGaloisBound.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex -import Mathlib.FieldTheory.Galois.Basic -import Mathlib.FieldTheory.KummerExtension -import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +public import Mathlib.FieldTheory.Galois.Basic +public import Mathlib.FieldTheory.KummerExtension +public import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed +public import Mathlib.Tactic /-! # The source-to-powered-image index over algebraically closed constants @@ -21,6 +23,8 @@ resulting pair of roots of unity lies in the support-character stabilizer, so a rank-two support determinant bounds the extension degree. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean index 23a7573915..8f8ca72544 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageHeightFactor.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve /-! # The source-to-powered-image degree factor @@ -16,6 +18,8 @@ the source curve to its powered image. These tower identities expose that factor explicitly. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean index 19cb78b420..dfa70963b9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndex.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +public import Mathlib.Tactic /-! # The common source-to-powered-image index @@ -21,6 +23,8 @@ The missing exponent-independent bound on the common index is a genuinely additional logarithmic-geometric input. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean index 0352f6c8a1..72e23049cc 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageIndexBound.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound +public import Mathlib.Tactic /-! # The Corvaja--Zannier source-to-powered-image index bound @@ -19,6 +21,8 @@ the powered-image degree invariant under this extension of constants, while the semantic non-subtorus hypothesis supplies the rank-two support determinant. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean index 398b874b13..90917fcade 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PropositionTwoDegreeMonotonicity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +public import Mathlib.Tactic /-! # Enlarging the degree data in Corvaja--Zannier Proposition 2 @@ -21,6 +23,8 @@ This is the exact numerical bridge needed between a Proposition 2 proof at the curve's actual degrees and the public min/max degree convention. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean index 07c7f28f14..9a86075830 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/RatFuncExhaustiveProductFormula.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula -import Mathlib.RingTheory.UniqueFactorizationDomain.Finsupp + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +public import Mathlib.RingTheory.UniqueFactorizationDomain.Finsupp /-! # The exhaustive finite-place product formula for the rational function field @@ -18,6 +20,8 @@ factorization. The resulting exhaustive finite-place sum is `f.intDegree`; after adding Mathlib's order at infinity, the total is zero. -/ +@[expose] public section + open scoped nonZeroDivisors open IsDedekindDomain Polynomial UniqueFactorizationMonoid diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean index e8b3024d66..ea52a94966 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/SeparatingCoordinateNotFrobenius.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import Mathlib.FieldTheory.PurelyInseparable.PerfectClosure + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import Mathlib.FieldTheory.PurelyInseparable.PerfectClosure /-! # Separating coordinates are not Frobenius powers @@ -21,6 +23,8 @@ if `(a / b) ^ p = X`, then `a ^ p = X * b ^ p`, whose degrees would satisfy `p * degree(a) = 1 + p * degree(b)`. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean index e6bd9f9fa3..f85626d643 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionBidegreeCount.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound -import Mathlib.RingTheory.RootsOfUnity.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +public import Mathlib.RingTheory.RootsOfUnity.Basic +public import Mathlib.Tactic /-! # Bidegree bounds for finite torus-curve intersections @@ -22,6 +24,8 @@ a polynomial with a vertical or horizontal component can contain an entire row or column of the torsion grid. -/ +@[expose] public section + open Polynomial namespace BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index fee577d08b..5516c6d24f 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder -import Mathlib.RingTheory.Valuation.LocalSubring + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +public import Mathlib.RingTheory.Valuation.LocalSubring /-! # Torsion points and the exhaustive gcd divisor @@ -27,6 +29,8 @@ exhaustive place type. Each selected place contributes at least one to the degree-weighted positive gcd divisor used by the global Wronskian argument. -/ +@[expose] public section + open IsDedekindDomain open Multiplicative WithZero @@ -40,7 +44,7 @@ variable {A L : Type*} [CommRing A] [IsDomain A] [Field L] [Algebra A L] [IsFractionRing A L] /-- The fraction-field embedding, with codomain restricted to its range. -/ -private noncomputable def fractionEmbeddingRangeEquiv : +noncomputable def fractionEmbeddingRangeEquiv : A ≃+* (algebraMap A L).range := RingEquiv.ofBijective (algebraMap A L).rangeRestrict ⟨fun x y hxy => IsFractionRing.injective A L (congrArg Subtype.val hxy), @@ -49,7 +53,7 @@ private noncomputable def fractionEmbeddingRangeEquiv : exact ⟨x, Subtype.ext hx⟩⟩ /-- The image of a maximal ideal inside the embedded copy of `A` in `L`. -/ -private noncomputable def maximalIdealInFractionEmbeddingRange +noncomputable def maximalIdealInFractionEmbeddingRange (m : MaximalSpectrum A) : Ideal (algebraMap A L).range := m.asIdeal.map (fractionEmbeddingRangeEquiv (A := A) (L := L)).toRingHom @@ -82,14 +86,14 @@ noncomputable def dominatingValuationSubring (m : MaximalSpectrum A) : ValuationSubring L := Classical.choose (Ideal.image_subset_nonunits_valuationSubring (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) - (maximalIdealInFractionEmbeddingRange_ne_top m)) + (by exact maximalIdealInFractionEmbeddingRange_ne_top m)) theorem range_le_dominatingValuationSubring (m : MaximalSpectrum A) : (algebraMap A L).range ≤ (dominatingValuationSubring (A := A) (L := L) m).toSubring := (Classical.choose_spec (Ideal.image_subset_nonunits_valuationSubring (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) - (maximalIdealInFractionEmbeddingRange_ne_top m))).1 + (by exact maximalIdealInFractionEmbeddingRange_ne_top m))).1 theorem algebraMap_mem_dominatingValuationSubring_nonunits_of_mem (m : MaximalSpectrum A) (r : A) (hr : r ∈ m.asIdeal) : @@ -102,7 +106,7 @@ theorem algebraMap_mem_dominatingValuationSubring_nonunits_of_mem have hnonunits := (Classical.choose_spec (Ideal.image_subset_nonunits_valuationSubring (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) - (maximalIdealInFractionEmbeddingRange_ne_top m))).2 + (by exact maximalIdealInFractionEmbeddingRange_ne_top m))).2 apply hnonunits refine ⟨e r, himage, ?_⟩ rfl diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean index 9bc8898cbd..37f804b420 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization /-! # Torsion points contribute to the normalization gcd divisor @@ -17,6 +19,8 @@ therefore the number of torsion points is bounded by the sum of the local gcd multiplicities. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -44,6 +48,7 @@ def liftedTorsionPointNormalizationBranch (S := B) (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal exact ⟨Classical.choose hex, (Classical.choose_spec hex).1⟩ +omit [IsDomain (PlaneCurveCoordinateRing f)] in theorem liftedTorsionPointNormalizationBranch_liesOver {B : Type*} [CommRing B] [IsDedekindDomain B] [Algebra (PlaneCurveCoordinateRing f) B] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean index 580c9cd28c..8374a95097 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionPointNormalization.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import Mathlib.RingTheory.Ideal.GoingUp -import Mathlib.RingTheory.Localization.Integral + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import Mathlib.RingTheory.Ideal.GoingUp +public import Mathlib.RingTheory.Localization.Integral /-! # Affine centers and normalization of torsion points @@ -17,6 +19,8 @@ Construct coordinate-ring evaluations and their maximal ideals, and compare affi points with normalization places. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -299,7 +303,7 @@ theorem second_torsionFunction_mem_normalizationBranch /-- An integral-closure model of the plane-curve function field has that function field as its fraction field. -/ -private noncomputable instance planeCurveIntegralClosureIsFractionRing +noncomputable instance planeCurveIntegralClosureIsFractionRing {B : Type*} [CommRing B] [IsDomain B] [Algebra (PlaneCurveCoordinateRing f) B] [Algebra B (PlaneCurveFunctionField f)] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean index e166bf32ae..c34802b83e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorusCharacterKernelBound.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant -import Mathlib.Data.Int.GCD -import Mathlib.RingTheory.RootsOfUnity.Basic -import Mathlib.SetTheory.Cardinal.Finite -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +public import Mathlib.Data.Int.GCD +public import Mathlib.RingTheory.RootsOfUnity.Basic +public import Mathlib.SetTheory.Cardinal.Finite +public import Mathlib.Tactic /-! # Rank-two character kernels in a two-dimensional torus @@ -24,6 +26,8 @@ diagonal support stabilizer by the corresponding support determinant and hence by twice the product of the two coordinate degrees. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean index 7dbf7f2493..f5508fa8e7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TranscendentalPowerDegree.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import Mathlib.RingTheory.Polynomial.Eisenstein.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import Mathlib.RingTheory.Polynomial.Eisenstein.Basic +public import Mathlib.Tactic /-! # Exact degree of a transcendental power map @@ -15,6 +17,8 @@ For a transcendental element `z`, the extension `K(z)/K(z^m)` has exact degree `m`. The key polynomial is Eisenstein at the rational parameter. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean index 5ec2e96752..ff7bf63558 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/WronskianChangeParameter.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian -import Mathlib.LinearAlgebra.Matrix.Block + +public import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +public import Mathlib.LinearAlgebra.Matrix.Block /-! # Change of parameter for ordinary Wronskians @@ -17,6 +19,8 @@ matrix whose diagonal is `1, a, a^2, ...`. This file records that argument; in particular it does not make the false simplification `(a • E)^i = a^i • E^i`. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean b/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean index c3106efd59..295e748289 100644 --- a/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Dynamics/FiniteForwardOrbit.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Data.Set.Finite.Basic -import Mathlib.Logic.Function.Iterate + +public import Mathlib.Data.Set.Finite.Basic +public import Mathlib.Logic.Function.Iterate /-! # Finite forward orbits of injective maps @@ -14,6 +16,8 @@ An injective self-map cannot have a finite forward orbit with a nonperiodic init injectivity hypothesis is what lets us cancel the transient part of a repeated pair of iterates. -/ +@[expose] public section + namespace BGS universe u diff --git a/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean b/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean index 9ac9f13686..3208012910 100644 --- a/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Dynamics/StrictMeasureEscape.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Logic.Relation -import Mathlib.Data.Nat.Order.Lemmas -import Mathlib.Tactic + +public import Mathlib.Logic.Relation +public import Mathlib.Data.Nat.Order.Lemmas +public import Mathlib.Tactic /-! # Escape by a strictly increasing measure @@ -15,6 +17,8 @@ Iterate admissible transitions to reach a prescribed lower bound for a strictly measure. -/ +@[expose] public section + namespace BGS universe u diff --git a/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean b/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean index cb26f1e9a6..f5a58a3a6d 100644 --- a/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean +++ b/LeanPool/MarkoffModP/BGS/External/GeneralCurveTheorems.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.MvPolynomial.PDeriv -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound -import Mathlib.FieldTheory.IsAlgClosed.Basic -import Mathlib.RingTheory.MvPolynomial.Basic + +public import Mathlib.Algebra.MvPolynomial.PDeriv +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +public import Mathlib.FieldTheory.IsAlgClosed.Basic +public import Mathlib.RingTheory.MvPolynomial.Basic /-! # General curve-theorem interfaces @@ -20,6 +22,8 @@ in-repository inhabitants; keeping the propositions separate makes their Markoff-specific applications explicit. -/ +@[expose] public section + namespace BGS.External noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean b/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean index 45e505c9b6..2377f9fb0b 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/EllipticCharacterSum.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic -import Mathlib.AlgebraicGeometry.EllipticCurve.Affine.Point -import Mathlib.SetTheory.Cardinal.NatCard + +public import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic +public import Mathlib.AlgebraicGeometry.EllipticCurve.Affine.Point +public import Mathlib.SetTheory.Cardinal.NatCard /-! # The explicit elliptic character sum needed by the incidence argument @@ -16,6 +18,8 @@ point-cardinality target. The target is an explicit proposition parameter, not a `sorry` or axiom; the selected Theorem 1 route does not use it. -/ +@[expose] public section + namespace BGS.FiniteField open Finset diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean b/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean index 0e30214956..78ca220970 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/HasseFrobenius.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum -import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure -import Mathlib.FieldTheory.Finite.Basic + +public import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +public import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +public import Mathlib.FieldTheory.Finite.Basic /-! # Frobenius setup for the explicit Hasse bound @@ -17,6 +19,8 @@ to isolate, in Mathlib's actual elliptic-point API, the first geometric degree c still missing. -/ +@[expose] public section + noncomputable section namespace BGS.FiniteField @@ -262,7 +266,7 @@ theorem legendreFrobeniusMinusIdentity_baseChange (u v : F) cases P with | zero => rfl | some x y h => - simp only [legendrePointBaseChange, WeierstrassCurve.Affine.Point.neg_some] + simp only [legendrePointBaseChange] exact WeierstrassCurve.Affine.Point.add_of_Y_eq rfl (WeierstrassCurve.Affine.negY_negY _ _).symm diff --git a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean index 41eaaa146d..6140ed02bd 100644 --- a/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean +++ b/LeanPool/MarkoffModP/BGS/FiniteField/QuadraticCharacter.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.NumberTheory.JacobiSum.Basic -import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic + +public import Mathlib.NumberTheory.JacobiSum.Basic +public import Mathlib.NumberTheory.LegendreSymbol.QuadraticChar.Basic /-! # Quadratic character sums and conic points @@ -14,6 +16,8 @@ Evaluate quadratic character sums and use them to find conic points avoiding a p exceptional set. -/ +@[expose] public section + namespace BGS.FiniteField open Finset diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean index 4e9f2f5347..d57e137d06 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/AffinePointPlace.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound /-! # Finite places centered at affine rational points @@ -19,6 +21,8 @@ subrings. It deliberately makes no residue-degree-one claim: above a singular rational point, a chosen normalization branch need not be rational. -/ +@[expose] public section + open IsDedekindDomain open Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean index c67d14a7dc..ddf6cd6158 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/CechRiemannLinearAlgebra.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas -import Mathlib.LinearAlgebra.Isomorphisms + +public import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas +public import Mathlib.LinearAlgebra.Isomorphisms /-! # The linear-algebra inequality in the Cech proof of Riemann's inequality @@ -28,6 +30,8 @@ be infinite-dimensional. This is the abstract finite-dimensional step used by the Cech proof of Riemann's inequality. -/ +@[expose] public section + namespace BGS.HasseWeil open Submodule diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean index 9369d8bb04..5832029297 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler -import Mathlib.Data.Finsupp.Weight + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +public import Mathlib.Data.Finsupp.Weight /-! # The closed-place Euler recurrence @@ -23,6 +25,8 @@ local finiteness of bounded-degree places to apply the finite combinatorial result to all exhaustive places of a finite extension of `K(X)`. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped BigOperators diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean index 160de51a9a..a6268bf079 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceCount.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge /-! # Closed places and rational places after extension of constants @@ -28,6 +30,8 @@ fiber over a downstairs place of degree `d` must have cardinality finite/infinity bridge APIs, so no global count equality is asserted here. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean index 1520a75a47..28c7faa718 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower /-! # Closed-place splitting formula for an exact extension of constants @@ -17,6 +19,8 @@ transported to actual places. Their exact sum-branch fiber equivalence gives the global gcd splitting law and the closed-place degree-extension identity. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean index 11d3888fd7..dd9c11e733 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension /-! # Finite places in an exact constant extension @@ -24,6 +26,8 @@ constant-extension residue formula as No maximality or residue-finiteness hypothesis is left to downstream users. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean index e664b56381..e1ecdb5726 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient /-! # Infinity places in an exact constant extension @@ -21,6 +23,8 @@ extended function field and the original function field. Their residue degrees satisfy the usual division-by-gcd formula. -/ +@[expose] public section + open scoped Polynomial TensorProduct nonZeroDivisors namespace BGS.HasseWeil @@ -134,7 +138,8 @@ end ReciprocalFractionField section LocalizationHelpers -private noncomputable def heightOneResidueFieldRingEquiv +/-- A ring equivalence transports the residue field of a height-one prime. -/ +noncomputable def heightOneResidueFieldRingEquiv {A B : Type*} [CommRing A] [CommRing B] (e : A ≃+* B) (q : HeightOneSpectrum A) : q.asIdeal.ResidueField ≃+* @@ -145,7 +150,8 @@ private noncomputable def heightOneResidueFieldRingEquiv change q.asIdeal = (q.asIdeal.comap e.symm).comap e exact (Ideal.comap_of_equiv e).symm) -private theorem mappedPrimeCompl_disjoint_of_under_eq +/-- A prime is disjoint from the image of the complement of its contracted prime. -/ +theorem mappedPrimeCompl_disjoint_of_under_eq (R A : Type*) [CommRing R] [CommRing A] [Algebra R A] (p : Ideal R) [p.IsPrime] (q : Ideal A) (hq : q.under R = p) : @@ -157,7 +163,8 @@ private theorem mappedPrimeCompl_disjoint_of_under_eq obtain ⟨r, hr, rfl⟩ := hxM exact hr (hq ▸ hxq) -private theorem localizationMap_liesOver_maximalIdeal +/-- Localizing a prime over the base prime gives a prime over the local maximal ideal. -/ +theorem localizationMap_liesOver_maximalIdeal (R V A B : Type*) [CommRing R] [CommRing V] [CommRing A] [CommRing B] [Algebra R V] [Algebra R A] [Algebra R B] @@ -185,7 +192,8 @@ private theorem localizationMap_liesOver_maximalIdeal (congrArg (Ideal.under R) hQA).symm.trans (Ideal.under_under Q) _ = (Q.under V).under R := Ideal.under_under Q |>.symm -private noncomputable def localizationResidueFieldAlgEquiv +/-- Localizing away from a prime preserves its residue field as an algebra over the base field. -/ +noncomputable def localizationResidueFieldAlgEquiv (K A B : Type*) [Field K] [CommRing A] [CommRing B] [Algebra K A] [Algebra K B] [Algebra A B] @@ -209,7 +217,8 @@ private noncomputable def localizationResidueFieldAlgEquiv exact (RingHom.surjectiveOnStalks_of_isLocalization M B) |>.residueFieldMap_bijective q Q hcomap -private noncomputable def localizationResidueFieldRingEquiv +/-- Localizing away from a prime preserves its residue field as a ring. -/ +noncomputable def localizationResidueFieldRingEquiv (A B : Type*) [CommRing A] [CommRing B] [Algebra A B] (M : Submonoid A) [IsLocalization M B] (q : Ideal A) [q.IsPrime] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean index aafa2e644b..731210f99f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity /-! # Absolute degrees of constant-extension places at infinity @@ -15,6 +17,8 @@ degrees are computed from the same reciprocal-normalization residue field, so the comparison is just the residue-field dimension tower. -/ +@[expose] public section + open scoped Polynomial TensorProduct nonZeroDivisors namespace BGS.HasseWeil @@ -110,6 +114,7 @@ local instance infinityDegreeTowerBaseRatFuncTower : variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- The degree over the original constants of a presented infinity place is the constant-field degree times the degree of its upstairs `S`-place. -/ theorem exactConstantExtensionPresentedInfinityPlace_degree_baseChange @@ -219,6 +224,7 @@ theorem exactConstantExtensionPresentedInfinityPlace_degree_baseChange _ = Module.finrank C S * Module.finrank S QS.1.ResidueField := by rw [hS] +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- The relative residue degree over the original function field is the constant extension degree divided by the same gcd that controls splitting. -/ theorem exactConstantExtensionPresentedInfinityPlace_relativeInertiaDeg_eq_div_gcd @@ -320,6 +326,7 @@ theorem exactConstantExtensionPresentedInfinityPlace_relativeInertiaDeg_eq_div_g exact eq_div_gcd_of_mul_eq_mul_div_gcd r d _ hd (hTower.symm.trans hTop) +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- A downstairs infinity place of degree `d` has exactly `gcd([S : C], d)` places above it in an exact extension of constants. -/ theorem exactConstantExtensionInfinityPlace_fiber_card_eq_gcd @@ -510,6 +517,7 @@ noncomputable def exactConstantExtensionPresentedInfinityPlaceFiberEquiv : include hExact +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- The presented reciprocal infinity fiber itself has the standard gcd cardinality. This is the presentation-level exhaustiveness form of the constant-extension splitting law at infinity. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean index 7d80b078ef..4f87b61709 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.Localization.AtPrime.Extension -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity + +public import Mathlib.RingTheory.Localization.AtPrime.Extension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity /-! # Splitting multiplicity at infinity in an exact extension of constants @@ -19,6 +21,8 @@ compared over `C[X]`, and only then localized to the valuation ring at infinity. -/ +@[expose] public section + open scoped Polynomial TensorProduct nonZeroDivisors namespace BGS.HasseWeil @@ -181,6 +185,9 @@ local instance infinitySplittingPresentedSPolynomialSMul : local instance infinitySplittingPresentedCPolynomialSMul : SMul C[X] (TensorProduct C S (integralClosure C[X] N)) := Algebra.toSMul +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional C S] [IsGalois C S] in /-- The reciprocal polynomial actions on the exact constant extension form the expected scalar tower. -/ theorem exactConstantExtensionReciprocalPolynomialTower : @@ -212,6 +219,7 @@ noncomputable def exactConstantExtensionPresentedToCReciprocalNormalizationRingE let eC := exactConstantExtensionReciprocalIntegralClosureTowerEquiv C S N exact eS.toRingEquiv.trans eC.symm +omit [Fintype C] [Finite S] [FiniteDimensional C S] [IsGalois C S] in /-- Coefficient extension commutes with evaluation in the reciprocal coordinate. -/ private theorem ratFuncCoefficientAlgHom_reciprocalPolynomialRingHom @@ -269,6 +277,8 @@ private theorem ratFuncExtensionReciprocalPolynomialAlgebra_map exact IsScalarTower.algebraMap_apply (RatFuncInfinityIntegers K) (RatFunc K) L _ +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq (RatFunc C)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- Version of reciprocal polynomial compatibility elaborated with the instances used in this file. -/ private theorem exactConstantExtensionSReciprocalPolynomialAlgebra_eq : @@ -500,6 +510,9 @@ noncomputable def exactConstantExtensionCReciprocalPrimesEquivInfinityPlace : (IsLocalRing.maximalIdeal V).primesOver B exact (IsDedekindDomain.primesOverEquivPrimesOver o V B ho).toEquiv +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional C S] [IsGalois C S] in private theorem exactConstantExtensionPresentedReciprocalPolynomialTower : IsScalarTower C[X] S[X] (S ⊗[C] integralClosure C[X] N) := by @@ -555,6 +568,8 @@ private theorem rw [polynomialTensorCancel_tmul] simp +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional C S] [IsGalois C S] in /-- The reciprocal origin is the unique prime of `S[X]` above the reciprocal origin of `C[X]`. -/ private theorem primeUnderReciprocalOrigin_eq_origin @@ -868,6 +883,7 @@ noncomputable def exactConstantExtensionPresentedInfinityPlaceEquiv : (exactConstantExtensionCReciprocalPrimesEquivInfinityPlace C S N hExact)) +omit [DecidableEq C] [DecidableEq (RatFunc C)] in /-- The reciprocal presentation equivalence respects restriction to the original function field. -/ @[simp] @@ -1153,6 +1169,8 @@ local instance infinitySplittingInfinityBaseNTower : IsScalarTower (RatFuncInfinityIntegers C) (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl +omit [Fintype C] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc S)] + [Algebra.IsSeparable (RatFunc C) N] in /-- Galois action on the infinity normalization restricts to the expected constant-field quotient action. -/ theorem exactConstantExtensionConstantQuotient_action_on_infinityNormalization : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean index 48dc6fff84..9698cb8e1f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility /-! # Splitting multiplicity in an exact extension of constants @@ -18,6 +20,8 @@ from the already established absolute degree formula, and applies the Galois fiber identity. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean index 6298db84f7..843df5443d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionRationalPlace.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge /-! # Rational finite places after exact constant extension @@ -19,6 +21,8 @@ This is the numerical-to-geometric bridge used when Stichtenoth chooses the constant-extension degree to be divisible by the Galois-group order. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean index 2283c15ea9..4ec8e23867 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension -import Mathlib.FieldTheory.Finite.Extension -import Mathlib.FieldTheory.Galois.Basic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +public import Mathlib.FieldTheory.Finite.Extension +public import Mathlib.FieldTheory.Galois.Basic /-! # Automorphisms of plane-curve constant extensions @@ -25,6 +27,8 @@ This file does not identify fixed points or rational places; those are the next local-geometric layer. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean index 822bbc453e..e214b77f36 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlace.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower -import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +public import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas /-! # Finite places under constant-field extension @@ -25,6 +27,8 @@ This file concerns only finite places. The valuation rings at infinity and the comparison of place degrees are separate boundaries. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean index f9559a6a3f..41b8a20810 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldFinitePlaceDegree.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient /-! # Finite-place degrees under constant-field extension @@ -22,6 +24,8 @@ This is the arithmetic content missing from a bare equivalence of finite-place types: an `E`-rational place is a place of degree `[E : K]` over `K`. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean index 6889cc5e78..c9d30f61e6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldInfinityBase.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace /-! # The rational-function place at infinity under coefficient extension @@ -19,6 +21,8 @@ This is the base-place comparison. It does not identify the integral closures of these valuation rings inside a further function field. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean index 93f11c20b8..3d0916bc00 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension /-! # Rational-function models under constant extension @@ -30,6 +32,8 @@ applied to `K(C) ⊂ E(C_E)`. No fixed-point or rational-place correspondence is asserted here. -/ +@[expose] public section + open scoped TensorProduct Polynomial namespace BGS.HasseWeil @@ -61,8 +65,7 @@ theorem planeCurveCoordinateRingBaseChangeAlgEquiv_includeRight simp [Φ, planeCurveCoordinateRingBaseChangeAlgEquiv, planeCurveCoordinateRingMap] erw [Ideal.quotientEquivAlg_mk] - simp only [MvPolynomial.algebraTensorAlgEquiv_tmul, one_smul] - rfl + simp only [MvPolynomial.algebraTensorAlgEquiv_tmul, one_smul, MvPolynomial.map_X] theorem planeCurveFunctionFieldBaseChangeAlgHom_function (hf : Irreducible f) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean index cbbf7fb02e..0ac722e5d0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantTensorResidue.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum -import Mathlib.RingTheory.LocalRing.ResidueField.Fiber + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +public import Mathlib.RingTheory.LocalRing.ResidueField.Fiber /-! # Residue fields of constant tensor extensions @@ -22,6 +24,8 @@ constant extension additionally requires identifying the normalization after base change with the corresponding tensor ring. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean index cd45210219..b68910b048 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DVRLocalPoleOrder.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder + +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder /-! # Local pole spaces and valuation order @@ -16,6 +18,8 @@ This is the bridge from the exact DVR quotient to exhaustive function-field places. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 9fd9b688b4..26d3afaf46 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.DedekindDomain.Different -import Mathlib.RingTheory.DedekindDomain.Factorization -import Mathlib.RingTheory.DedekindDomain.AdicValuation + +public import Mathlib.RingTheory.DedekindDomain.Different +public import Mathlib.RingTheory.DedekindDomain.Factorization +public import Mathlib.RingTheory.DedekindDomain.AdicValuation /-! # Local traces and the different @@ -15,6 +17,8 @@ Relate different multiplicities to the trace-dual lattice and clear the finitely valuation bounds by a base multiplier. -/ +@[expose] public section + open scoped nonZeroDivisors open Set Function UniqueFactorizationMonoid IsDedekindDomain @@ -42,7 +46,7 @@ theorem le_iff_count_ge {I J : FractionalIdeal R⁰ K} (hI : I ≠ 0) (hJ : J simpa only [Filter.eventually_cofinite] using finite_factors (K := K) A exact hcount.subset fun v hv hzero ↦ by apply hv - simpa [hzero] + simp [hzero] apply finprod_le_finprod · exact hfinite I · exact hfinite J @@ -83,6 +87,7 @@ variable [Algebra.IsIntegral A B] namespace HeightOneSpectrum +omit [IsIntegrallyClosed A] [Module.IsTorsionFree A B] in theorem algebraMap_mem_pow_of_mem_under_pow (q : HeightOneSpectrum B) (c : A) (n : ℕ) (hc : c ∈ (q.under A).asIdeal ^ n) : @@ -96,6 +101,7 @@ theorem algebraMap_mem_pow_of_mem_under_pow (Ideal.map_le_iff_le_comap.mpr (show (q.under A).asIdeal ≤ q.asIdeal.comap (algebraMap A B) from le_rfl)) n) hmap +omit [IsIntegralClosure B A L] in theorem natCast_le_count_spanSingleton_algebraMap_of_mem_under_pow (q : HeightOneSpectrum B) (c : A) (n : ℕ) (hc0 : c ≠ 0) (hc : c ∈ (q.under A).asIdeal ^ n) : @@ -125,6 +131,7 @@ end HeightOneSpectrum namespace BGS.HasseWeil +omit [Algebra.IsIntegral A B] in theorem count_dual_one_eq_neg_different_multiplicity (q : HeightOneSpectrum B) : FractionalIdeal.count L q diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean index 47df6ed6d7..7bfc2b07f8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtension.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.LinearDisjoint -import Mathlib.LinearAlgebra.Dimension.OrzechProperty + +public import Mathlib.FieldTheory.LinearDisjoint +public import Mathlib.LinearAlgebra.Dimension.OrzechProperty /-! # Exact constants and finite constant extensions @@ -22,6 +24,8 @@ algebraic foundation for the constant-extension twists in Stichtenoth, Proposition 5.2.8. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean index 4280a6871c..afad8c363f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionAutomorphism.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism -import Mathlib.GroupTheory.NoncommCoprod + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +public import Mathlib.GroupTheory.NoncommCoprod /-! # Galois groups of exact constant extensions @@ -25,6 +27,8 @@ group over `L`: This is the direct-product statement used in Stichtenoth, Proposition 5.2.8. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean index 48cb6bad7b..b5b477a45e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionConstants.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism -import Mathlib.FieldTheory.Finite.Extension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import Mathlib.FieldTheory.Finite.Extension /-! # Exact constants after a finite constant extension @@ -22,6 +24,8 @@ into `S`; uniqueness of the roots of `X ^ #K - X` inside the common compositum then shows that the original element already belongs to `S`. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean index 7fef09193e..91fd60895f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance -import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +public import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap /-! # Local different coefficients under exact constant extension @@ -20,6 +22,8 @@ discharges the local hypothesis of the global different-degree and genus transport theorems. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean index 745debf4c7..e0a2b4dd0f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFiniteDifferent.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension -import Mathlib.RingTheory.DedekindDomain.LinearDisjoint + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +public import Mathlib.RingTheory.DedekindDomain.LinearDisjoint /-! # The finite different after exact constant extension @@ -19,6 +21,8 @@ explicit tensor generation and the extension-degree formulas already proved for rational-function and exact constant extensions. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -26,11 +30,13 @@ namespace BGS.HasseWeil noncomputable section -@[reducible] private noncomputable def +/-- The canonical polynomial algebra structure on the rational function field. -/ +@[reducible] noncomputable def finiteDifferentCanonicalRatFuncPolynomialAlgebra (K : Type*) [Field K] : Algebra K[X] (RatFunc K) := inferInstance -private theorem finiteDifferentCanonicalRatFuncPolynomialFractionRing +/-- The rational function field is the fraction field of its canonical polynomial algebra. -/ +theorem finiteDifferentCanonicalRatFuncPolynomialFractionRing (K : Type*) [Field K] : letI := finiteDifferentCanonicalRatFuncPolynomialAlgebra K IsFractionRing K[X] (RatFunc K) := by @@ -110,6 +116,133 @@ private theorem different_eq_map_of_disjoint_fields exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal (K := K) (L := L) (F₁ := F₁) (F₂ := F₂) A B R₁ R₂ hdisjoint hsup hcoprime +private theorem finite_torsionFree_of_integral_base_change + (A R₁ R₂ B K L : Type*) + [CommRing A] [CommRing R₁] [CommRing R₂] [CommRing B] [Field K] [Field L] + [IsDedekindDomain R₂] + [Algebra A R₁] [Algebra A R₂] [Algebra A L] + [Algebra R₁ L] [Algebra R₂ L] [Algebra B L] [Algebra R₂ B] + [Algebra R₂ K] [IsFractionRing R₂ K] [Algebra K L] + [IsScalarTower R₂ K L] [IsScalarTower R₂ B L] [Module.IsTorsionFree R₂ L] + [IsScalarTower A R₁ L] [IsScalarTower A R₂ L] + [Algebra.IsIntegral A R₁] [Algebra.IsIntegral A R₂] + [FiniteDimensional K L] [Algebra.IsSeparable K L] + [IsIntegralClosure B R₁ L] : + Module.Finite R₂ B ∧ Module.IsTorsionFree R₂ B := by + let : IsIntegralClosure B R₂ L := by + refine ⟨IsIntegralClosure.algebraMap_injective B R₁ L, ?_⟩ + intro x + constructor + · intro hx + have hxA : IsIntegral A x := isIntegral_trans (R := A) x hx + exact (IsIntegralClosure.isIntegral_iff (A := B) (R := R₁)).mp hxA.tower_top + · intro hx + have hxR₁ : IsIntegral R₁ x := + (IsIntegralClosure.isIntegral_iff (A := B) (R := R₁)).mpr hx + exact (isIntegral_trans (R := A) x hxR₁).tower_top + exact ⟨IsIntegralClosure.finite R₂ K L B, IsIntegralClosure.isTorsionFree R₂ L⟩ + +/-- Base change preserves the relative different when the fraction-field images are linearly +disjoint, generate the ambient field, and the original differents are coprime. -/ +theorem different_eq_map_of_linearlyDisjoint_fieldRanges + (A R₁ R₂ B K K₁ K₂ L : Type*) + [CommRing A] [IsDomain A] [IsPrincipalIdealRing A] + [CommRing R₁] [IsDedekindDomain R₁] + [CommRing R₂] [IsDedekindDomain R₂] [CommRing B] [IsDedekindDomain B] + [Field K] [Field K₁] [Field K₂] [Field L] + [Algebra A K] [IsFractionRing A K] + [Algebra K K₁] [Algebra K K₂] [Algebra K L] + [Algebra K₁ L] [Algebra K₂ L] [Algebra A K₂] + [IsScalarTower K K₁ L] [IsScalarTower K K₂ L] [IsScalarTower A K K₂] + [Algebra A R₁] [Algebra A R₂] [Algebra A B] [Algebra A L] + [Algebra R₁ K₁] [IsFractionRing R₁ K₁] + [Algebra R₂ K₂] [IsFractionRing R₂ K₂] + [Algebra R₁ B] [Algebra R₂ B] [Algebra R₁ L] [Algebra R₂ L] [Algebra B L] + [IsScalarTower A K L] [IsScalarTower A K₂ L] + [IsScalarTower R₁ K₁ L] [IsScalarTower R₂ K₂ L] + [IsScalarTower A R₂ K₂] [IsScalarTower A R₁ L] [IsScalarTower A R₂ L] + [IsScalarTower A R₁ B] [IsScalarTower A R₂ B] + [IsScalarTower R₁ B L] [IsScalarTower R₂ B L] [IsScalarTower A B L] + [FiniteDimensional K K₂] [FiniteDimensional K L] [Algebra.IsSeparable K L] + [Module.Finite A R₁] [Module.Finite A R₂] [Module.Free A R₂] + [Module.IsTorsionFree A R₁] [Module.IsTorsionFree A R₂] + [Module.IsTorsionFree R₁ L] [Module.IsTorsionFree R₂ L] + [Module.IsTorsionFree R₁ B] + [IsIntegralClosure R₂ A K₂] [IsIntegralClosure B R₁ L] + (hdisjoint : (IsScalarTower.toAlgHom K K₁ L).fieldRange.LinearDisjoint + (IsScalarTower.toAlgHom K K₂ L).fieldRange) + (hsup : (IsScalarTower.toAlgHom K K₁ L).fieldRange ⊔ + (IsScalarTower.toAlgHom K K₂ L).fieldRange = ⊤) + (hcoprime : IsCoprime ((differentIdeal A R₁).map (algebraMap R₁ B)) + ((differentIdeal A R₂).map (algebraMap R₂ B))) : + differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by + let f₁ := IsScalarTower.toAlgHom K K₁ L + let f₂ := IsScalarTower.toAlgHom K K₂ L + let F₁ := f₁.fieldRange + let F₂ := f₂.fieldRange + let e₁ := f₁.equivFieldRange + let e₂ := f₂.equivFieldRange + let : Algebra R₁ F₁ := + RingHom.toAlgebra (e₁.toRingHom.comp (algebraMap R₁ K₁)) + let e₁inf : K₁ ≃ₐ[R₁] F₁ := { e₁.toRingEquiv with commutes' := fun _ => rfl } + let : IsFractionRing R₁ F₁ := IsFractionRing.of_algEquiv e₁inf + let : Module.IsTorsionFree R₁ F₁ := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact IsFractionRing.injective R₁ F₁ + let : IsScalarTower R₁ F₁ L := IsScalarTower.of_algebraMap_eq (fun z => by + change algebraMap R₁ L z = algebraMap K₁ L (algebraMap R₁ K₁ z) + exact IsScalarTower.algebraMap_apply R₁ K₁ L z) + let : Algebra R₂ F₂ := + RingHom.toAlgebra (e₂.toRingHom.comp (algebraMap R₂ K₂)) + let e₂norm : K₂ ≃ₐ[R₂] F₂ := { e₂.toRingEquiv with commutes' := fun _ => rfl } + let : IsFractionRing R₂ F₂ := IsFractionRing.of_algEquiv e₂norm + let : IsScalarTower R₂ F₂ L := IsScalarTower.of_algebraMap_eq (fun z => by + change algebraMap R₂ L z = algebraMap K₂ L (algebraMap R₂ K₂ z) + exact IsScalarTower.algebraMap_apply R₂ K₂ L z) + let : Algebra A F₂ := IntermediateField.algebra' F₂ + let : IsScalarTower A R₂ F₂ := IsScalarTower.of_algebraMap_eq (fun z => by + apply Subtype.ext + change algebraMap A L z = algebraMap K₂ L (algebraMap R₂ K₂ (algebraMap A R₂ z)) + rw [← IsScalarTower.algebraMap_apply A R₂ K₂, + ← IsScalarTower.algebraMap_apply A K₂ L]) + let : IsScalarTower A F₂ L := IsScalarTower.of_algebraMap_eq' rfl + let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) K₂ := + IsIntegralClosure.isLocalization A K K₂ R₂ + let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂ := + IsLocalization.isLocalization_of_algEquiv _ e₂norm + have hnormalization := finite_torsionFree_of_integral_base_change A R₁ R₂ B F₂ L + let : Module.Finite R₂ B := hnormalization.1 + let : Module.IsTorsionFree R₂ B := hnormalization.2 + let : Module.Finite R₁ B := IsIntegralClosure.finite R₁ F₁ L B + let : Module.Finite A B := Module.Finite.trans R₂ B + let : Module.IsTorsionFree A B := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + have hR₂B := Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree R₂ B from inferInstance) + have hAR₂ := Module.isTorsionFree_iff_algebraMap_injective.mp + (show Module.IsTorsionFree A R₂ from inferInstance) + intro x y hxy + apply hAR₂ + apply hR₂B + exact (IsScalarTower.algebraMap_apply A R₂ B x).symm.trans + (hxy.trans (IsScalarTower.algebraMap_apply A R₂ B y)) + let : IsFractionRing B L := + IsIntegralClosure.isFractionRing_of_finite_extension R₁ F₁ L B + exact different_eq_map_of_disjoint_fields A B R₁ R₂ K L F₁ F₂ hdisjoint hsup hcoprime + +private theorem scalarTower_of_injective_algebraMap + (A R B L : Type*) [CommRing A] [CommRing R] [CommRing B] [CommRing L] + [Algebra A R] [Algebra A B] [Algebra A L] + [Algebra R B] [Algebra R L] [Algebra B L] + [IsScalarTower A R L] [IsScalarTower A B L] [IsScalarTower R B L] + (hinjective : Function.Injective (algebraMap B L)) : IsScalarTower A R B := by + apply IsScalarTower.of_algebraMap_eq + intro a + apply hinjective + rw [← IsScalarTower.algebraMap_apply A B L, + ← IsScalarTower.algebraMap_apply R B L, + ← IsScalarTower.algebraMap_apply A R L] + variable (C S N : Type*) [Field C] [Field S] [Field N] [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] @@ -273,6 +406,7 @@ theorem exactConstantExtension_rationalFunctionRanges_linearDisjoint : exact hfinL exact ⟨hdisjoint, hsup⟩ +omit [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in private theorem normalization_finite_and_torsionFree [Fintype C] [Finite S] : let L := ExactConstantExtension C N S @@ -398,7 +532,8 @@ theorem exactConstantExtension_finiteDifferent_eq_map exactConstantExtensionFiniteNormalizationAlgebra C S N differentIdeal S[X] B = Ideal.map (algebraMap R₂ B) (differentIdeal C[X] R₂) := by - intro L R₂ B model0 model1 model2 model3 model4 model5 model6 model7 model8 model9 model10 model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 model21 + intro L R₂ B model0 model1 model2 model3 model4 model5 model6 model7 model8 model9 + model10 model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 model21 let : IsDomain R₂ := inferInstance let : IsDomain B := inferInstance let : Algebra (RatFunc C) L := @@ -416,18 +551,8 @@ theorem exactConstantExtension_finiteDifferent_eq_map ratFuncCoefficientAlgebra C S let : SMul (RatFunc C) (RatFunc S) := Algebra.toSMul let : Module (RatFunc C) (RatFunc S) := Algebra.toModule - let : Algebra (RatFunc S) L := - ratFuncExactConstantExtensionAlgebra C S N hExact - let : SMul (RatFunc S) L := Algebra.toSMul - let : Module (RatFunc S) L := Algebra.toModule let : IsScalarTower (RatFunc C) (RatFunc S) L := rationalBase_scalarTower C S N hExact - let : Algebra C[X] (RatFunc C) := - finiteDifferentCanonicalRatFuncPolynomialAlgebra C - let : IsFractionRing C[X] (RatFunc C) := - finiteDifferentCanonicalRatFuncPolynomialFractionRing C - let : IsScalarTower C[X] (RatFunc C) N := - IsScalarTower.of_algebraMap_eq' rfl let : Algebra C[X] L := RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp @@ -445,18 +570,6 @@ theorem exactConstantExtension_finiteDifferent_eq_map IsScalarTower.of_algebraMap_eq' rfl let : IsScalarTower S[X] B L := IsScalarTower.of_algebraMap_eq' rfl - let : Algebra S[X] (RatFunc S) := - finiteDifferentCanonicalRatFuncPolynomialAlgebra S - let : IsFractionRing S[X] (RatFunc S) := - finiteDifferentCanonicalRatFuncPolynomialFractionRing S - let : IsScalarTower S[X] (RatFunc S) L := - IsScalarTower.of_algebraMap_eq' (by - apply DFunLike.ext _ _ - intro p - change algebraMap S[X] L p = - ratFuncToExactConstantExtension C S N hExact - (algebraMap S[X] (RatFunc S) p) - exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) let : IsScalarTower C[X] S[X] L := IsScalarTower.of_algebraMap_eq' (by apply DFunLike.ext _ _ @@ -488,17 +601,6 @@ theorem exactConstantExtension_finiteDifferent_eq_map exact Polynomial.map_injective (algebraMap C S) (algebraMap C S).injective let : Module.Free C[X] S[X] := Module.free_of_finite_type_torsion_free' - let : Module.IsTorsionFree S[X] L := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - intro p q hpq - apply RatFunc.algebraMap_injective S - apply (algebraMap (RatFunc S) L).injective - simpa only [IsScalarTower.algebraMap_apply S[X] (RatFunc S) L] - using hpq - let : FiniteDimensional (RatFunc S) L := - finiteDimensional_over_extendedRatFunc C S N hExact - let : Algebra.IsSeparable (RatFunc S) L := - isSeparable_over_extendedRatFunc C S N hExact let eNL := exactConstantExtensionLinearEquiv C N S let : Module.Finite N (N ⊗[C] S) := Module.Finite.base_change C N S @@ -507,80 +609,29 @@ theorem exactConstantExtension_finiteDifferent_eq_map Module.Finite.trans N L let : Algebra.IsSeparable (RatFunc C) L := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact - let f₁ : RatFunc S →ₐ[RatFunc C] L := - IsScalarTower.toAlgHom (RatFunc C) (RatFunc S) L - let f₂ : N →ₐ[RatFunc C] L := - IsScalarTower.toAlgHom (RatFunc C) N L - let F₁ : IntermediateField (RatFunc C) L := f₁.fieldRange - let F₂ : IntermediateField (RatFunc C) L := f₂.fieldRange - let e₁ : RatFunc S ≃ₐ[RatFunc C] F₁ := f₁.equivFieldRange - let e₂ : N ≃ₐ[RatFunc C] F₂ := f₂.equivFieldRange - let : Algebra S[X] F₁ := - RingHom.toAlgebra - (e₁.toRingEquiv.toRingHom.comp (algebraMap S[X] (RatFunc S))) - let : SMul S[X] F₁ := Algebra.toSMul - let : Module S[X] F₁ := Algebra.toModule - let e₁poly : RatFunc S ≃ₐ[S[X]] F₁ := - { e₁.toRingEquiv with commutes' := fun _ => rfl } - let : IsFractionRing S[X] F₁ := - IsFractionRing.of_algEquiv e₁poly - let : Module.IsTorsionFree S[X] F₁ := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - exact IsFractionRing.injective S[X] F₁ - let : Algebra R₂ F₂ := - RingHom.toAlgebra - (e₂.toRingEquiv.toRingHom.comp (algebraMap R₂ N)) - let : SMul R₂ F₂ := Algebra.toSMul - let : Module R₂ F₂ := Algebra.toModule - let e₂norm : N ≃ₐ[R₂] F₂ := - { e₂.toRingEquiv with commutes' := fun _ => rfl } let : Algebra R₂ L := - RingHom.toAlgebra - ((algebraMap F₂ L).comp (algebraMap R₂ F₂)) + RingHom.toAlgebra ((algebraMap N L).comp (algebraMap R₂ N)) let : SMul R₂ L := Algebra.toSMul let : Module R₂ L := Algebra.toModule - let : IsScalarTower R₂ F₂ L := - IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower R₂ N L := IsScalarTower.of_algebraMap_eq' rfl let : IsFractionRing R₂ N := - IsIntegralClosure.isFractionRing_of_finite_extension - C[X] (RatFunc C) N R₂ - let : IsFractionRing R₂ F₂ := - IsFractionRing.of_algEquiv e₂norm - let : Algebra C[X] F₂ := IntermediateField.algebra' F₂ - let : SMul C[X] F₂ := Algebra.toSMul - let : IsScalarTower C[X] R₂ F₂ := - IsScalarTower.of_algebraMap_eq' (by - apply DFunLike.ext _ _ - intro p - apply Subtype.ext - change algebraMap (RatFunc C) L - (algebraMap C[X] (RatFunc C) p) = - algebraMap N L (algebraMap C[X] N p) - rw [IsScalarTower.algebraMap_apply C[X] (RatFunc C) N] - exact IsScalarTower.algebraMap_apply (RatFunc C) N L _) - let : IsScalarTower C[X] F₂ L := - IsScalarTower.of_algebraMap_eq' rfl - let : IsScalarTower C[X] R₂ L := - IsScalarTower.of_algebraMap_eq' (by - apply DFunLike.ext _ _ - intro p - change algebraMap C[X] L p = - algebraMap F₂ L - (algebraMap R₂ F₂ (algebraMap C[X] R₂ p)) - rw [← IsScalarTower.algebraMap_apply C[X] R₂ F₂] - exact IsScalarTower.algebraMap_apply C[X] F₂ L p) - let : IsLocalization - (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors C[X])) N := - IsIntegralClosure.isLocalization C[X] (RatFunc C) N R₂ - let : IsLocalization - (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors C[X])) F₂ := - IsLocalization.isLocalization_of_algEquiv _ e₂norm - let : Algebra R₂ B := exactConstantExtensionFiniteNormalizationAlgebra C S N + IsIntegralClosure.isFractionRing_of_finite_extension C[X] (RatFunc C) N R₂ + let : IsScalarTower C[X] R₂ N := IsScalarTower.of_algebraMap_eq' rfl + let : IsScalarTower C[X] N L := IsScalarTower.of_algebraMap_eq (fun p => by + change algebraMap (RatFunc C) L (algebraMap C[X] (RatFunc C) p) = + algebraMap N L (algebraMap C[X] N p) + rw [IsScalarTower.algebraMap_apply C[X] (RatFunc C) N] + exact IsScalarTower.algebraMap_apply (RatFunc C) N L _) + let : IsScalarTower C[X] R₂ L := IsScalarTower.of_algebraMap_eq (fun p => by + change algebraMap C[X] L p = + algebraMap N L (algebraMap R₂ N (algebraMap C[X] R₂ p)) + rw [← IsScalarTower.algebraMap_apply C[X] R₂ N, + ← IsScalarTower.algebraMap_apply C[X] N L]) + let : Module.IsTorsionFree R₂ L := by + rw [Module.isTorsionFree_iff_algebraMap_injective] + exact (algebraMap N L).injective.comp (IsFractionRing.injective R₂ N) let : SMul R₂ B := Algebra.toSMul let : Module R₂ B := Algebra.toModule - have hnormalization := normalization_finite_and_torsionFree C S N hExact - let : Module.Finite R₂ B := hnormalization.1 - let : Module.IsTorsionFree R₂ B := hnormalization.2 have hR₂BL : (algebraMap R₂ L) = (algebraMap B L).comp (algebraMap R₂ B) := by @@ -594,78 +645,14 @@ theorem exactConstantExtension_finiteDifferent_eq_map let : IsScalarTower R₂ B L := IsScalarTower.of_algebraMap_eq' hR₂BL let : IsScalarTower C[X] R₂ B := - IsScalarTower.of_algebraMap_eq' (by - apply DFunLike.ext _ _ - intro p - apply Subtype.ext - calc - algebraMap B L (algebraMap C[X] B p) = - algebraMap B L - (algebraMap S[X] B (algebraMap C[X] S[X] p)) := rfl - _ = algebraMap S[X] L (algebraMap C[X] S[X] p) := - (IsScalarTower.algebraMap_apply S[X] B L _).symm - _ = algebraMap C[X] L p := - (IsScalarTower.algebraMap_apply C[X] S[X] L p).symm - _ = algebraMap R₂ L (algebraMap C[X] R₂ p) := - IsScalarTower.algebraMap_apply C[X] R₂ L p - _ = algebraMap B L - (algebraMap R₂ B (algebraMap C[X] R₂ p)) := - IsScalarTower.algebraMap_apply R₂ B L _) + scalarTower_of_injective_algebraMap C[X] R₂ B L + (fun _ _ h => Subtype.ext h) let : Module.Finite C[X] R₂ := IsIntegralClosure.finite C[X] (RatFunc C) N R₂ - let : Module.IsTorsionFree C[X] N := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - change Function.Injective - ((algebraMap (RatFunc C) N).comp - (algebraMap C[X] (RatFunc C))) - exact (algebraMap (RatFunc C) N).injective.comp - (RatFunc.algebraMap_injective C) - let : Module.IsTorsionFree C[X] R₂ := - IsIntegralClosure.isTorsionFree C[X] N let : Module.Free C[X] R₂ := Module.free_of_finite_type_torsion_free' - let : Module.Finite C[X] B := Module.Finite.trans R₂ B - let : Module.IsTorsionFree C[X] B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - intro p q hpq - have hinj : Function.Injective (algebraMap C[X] L) := by - change Function.Injective - ((algebraMap (RatFunc C) L).comp - (algebraMap C[X] (RatFunc C))) - exact (algebraMap (RatFunc C) L).injective.comp - (RatFunc.algebraMap_injective C) - apply hinj - simpa only [IsScalarTower.algebraMap_apply C[X] B L] - using congrArg (algebraMap B L) hpq - let : FaithfulSMul C[X] B := by - rw [faithfulSMul_iff_algebraMap_injective] - exact Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree C[X] B from inferInstance) - let : IsScalarTower S[X] F₁ L := - IsScalarTower.of_algebraMap_eq' (by - apply DFunLike.ext _ _ - intro p - change algebraMap S[X] L p = f₁ (algebraMap S[X] (RatFunc S) p) - exact (ratFuncToExactConstantExtension_algebraMap C S N hExact p).symm) - let : Algebra.IsSeparable (RatFunc C) F₂ := inferInstance - let : Algebra.IsSeparable F₁ L := inferInstance - let : IsIntegralClosure B S[X] L := inferInstance - let : IsFractionRing B L := - IsIntegralClosure.isFractionRing_of_finite_extension S[X] F₁ L B - let : IsDedekindDomain B := - IsIntegralClosure.isDedekindDomain S[X] F₁ L B - let : IsDedekindDomain R₂ := - IsIntegralClosure.isDedekindDomain C[X] (RatFunc C) N R₂ - let : Module.Finite S[X] B := - IsIntegralClosure.finite S[X] F₁ L B - let : Module.IsTorsionFree S[X] B := - IsIntegralClosure.isTorsionFree S[X] L have hranges := exactConstantExtension_rationalFunctionRanges_linearDisjoint C S N hExact - have hdisjoint : F₁.LinearDisjoint F₂ := by - exact hranges.1 - have hsup : F₁ ⊔ F₂ = ⊤ := by - exact hranges.2 have hcoprime : IsCoprime ((differentIdeal C[X] S[X]).map (algebraMap S[X] B)) @@ -675,10 +662,8 @@ theorem exactConstantExtension_finiteDifferent_eq_map apply Ideal.isCoprime_iff_sup_eq.mpr exact top_sup_eq (Ideal.map (algebraMap R₂ B) (differentIdeal C[X] R₂)) - let : IsScalarTower C[X] F₂ L := - IsScalarTower.of_algebraMap_eq' rfl - exact different_eq_map_of_disjoint_fields C[X] B S[X] R₂ (RatFunc C) L - F₁ F₂ hdisjoint hsup hcoprime + exact different_eq_map_of_linearlyDisjoint_fieldRanges C[X] S[X] R₂ B + (RatFunc C) (RatFunc S) N L hranges.1 hranges.2 hcoprime end diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean index 5a3d61941c..b9d9d574a5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlace.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality /-! # Finite places of an exact constant extension @@ -17,6 +19,8 @@ place whose residue field has degree one over the enlarged constants, the kernel of constant restriction on the decomposition group is exactly inertia. -/ +@[expose] public section + open scoped Pointwise Polynomial TensorProduct namespace BGS.HasseWeil @@ -79,8 +83,8 @@ noncomputable def exactConstantExtensionConstantToFiniteIntegralClosureRingHom : RingHom.toAlgebra ((algebraMap (RatFunc C) (ExactConstantExtension C N S)).comp (algebraMap C[X] (RatFunc C))) - letI : IsScalarTower C C[X] (ExactConstantExtension C N S) := - exactConstantExtension_polynomialTower C N S + letI : IsScalarTower C C[X] (ExactConstantExtension C N S) := by + exact exactConstantExtension_polynomialTower C N S let f : S →ₐ[C] ExactConstantExtension C N S := Algebra.TensorProduct.includeLeft exact @@ -162,8 +166,8 @@ theorem exactConstantExtensionConstantQuotient_action_on_finiteNormalization letI : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S letI : IsScalarTower (RatFunc C) L - (ExactConstantExtension C N S) := - exactConstantExtension_ratFuncBaseTower C N S L + (ExactConstantExtension C N S) := by + exact exactConstantExtension_ratFuncBaseTower C N S L letI : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact letI : Algebra S (RatFuncFiniteIntegralClosure C @@ -186,8 +190,8 @@ theorem exactConstantExtensionConstantQuotient_action_on_finiteNormalization exactConstantExtensionBaseAlgebra C (RatFunc C) N S let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := - exactConstantExtension_ratFuncBaseTower C N S L + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + exact exactConstantExtension_ratFuncBaseTower C N S L let : Algebra C[X] L := RingHom.toAlgebra ((algebraMap (RatFunc C) L).comp (algebraMap C[X] (RatFunc C))) @@ -285,8 +289,8 @@ theorem exactConstantExtensionFinitePlace_stabilizerRestriction_ker_eq_inertia letI : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S letI : IsScalarTower (RatFunc C) L - (ExactConstantExtension C N S) := - exactConstantExtension_ratFuncBaseTower C N S L + (ExactConstantExtension C N S) := by + exact exactConstantExtension_ratFuncBaseTower C N S L letI : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact letI : Algebra S (RatFuncFiniteIntegralClosure C @@ -312,8 +316,8 @@ theorem exactConstantExtensionFinitePlace_stabilizerRestriction_ker_eq_inertia exactConstantExtensionBaseAlgebra C (RatFunc C) N S let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := - exactConstantExtension_ratFuncBaseTower C N S L + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + exact exactConstantExtension_ratFuncBaseTower C N S L let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact let : Algebra S (RatFuncFiniteIntegralClosure C @@ -372,8 +376,8 @@ theorem exactConstantExtensionFinitePlace_decompositionGroup_card letI : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S letI : IsScalarTower (RatFunc C) L - (ExactConstantExtension C N S) := - exactConstantExtension_ratFuncBaseTower C N S L + (ExactConstantExtension C N S) := by + exact exactConstantExtension_ratFuncBaseTower C N S L letI : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact letI : Algebra S (RatFuncFiniteIntegralClosure C @@ -402,8 +406,8 @@ theorem exactConstantExtensionFinitePlace_decompositionGroup_card exactConstantExtensionBaseAlgebra C (RatFunc C) N S let : Algebra L (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C L N S - let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := - exactConstantExtension_ratFuncBaseTower C N S L + let : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by + exact exactConstantExtension_ratFuncBaseTower C N S L let : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact let : Algebra S (RatFuncFiniteIntegralClosure C diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index 5d7ac35303..7406bbffb2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting /-! # Compatibility of the two finite-place models in a constant extension @@ -19,6 +21,8 @@ absolute `C`-degree `[S : C]`, in precisely the model used by the decomposition-group theorem. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -779,7 +783,7 @@ theorem exactConstantExtensionFinitePlace_decompositionGroup_card_of_rational_ba letI : Module L (ExactConstantExtension C N S) := Algebra.toModule letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := - exactConstantExtensionCompatibility_ratFuncBaseTower C S N hExact L + by exact exactConstantExtensionCompatibility_ratFuncBaseTower C S N hExact L letI : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact let Q := exactConstantExtensionCompatibleBaseFinitePlace diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean index 0046809bc3..91bdaf8440 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility /-! # Frobenius-coset averaging at finite places of an exact constant extension @@ -17,6 +19,8 @@ cyclicity of the finite-field Galois group propagate surjectivity of the constant quotient to every stabilizer in the same restriction fiber. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -93,6 +97,11 @@ local instance averageConstantIntermediateTopTower : (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional L N] [IsGalois L N] in /-- The rational-function base, the intermediate field, and the exact constant extension form the tower used by the finite-place action. -/ private theorem exactConstantExtensionFrobeniusAverage_ratFuncBaseTower : @@ -126,6 +135,11 @@ private theorem exactConstantExtensionFrobeniusAverage_ratFuncBaseTower : congr 1 exact IsScalarTower.algebraMap_apply (RatFunc C) L N x +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [Algebra (RatFunc C) L] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [IsScalarTower (RatFunc C) L N] [IsGalois L N] in /-- The exact constant extension is finite-dimensional over the chosen intermediate field. -/ private theorem finiteDimensional_exactConstantExtension_over_intermediate diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean index 624163fe88..98d09f14df 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwist.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup /-! # Fixed fields of Frobenius twists @@ -30,6 +32,8 @@ separable base change; that separate regular-base-change lemma is not assumed here. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean index bac11d38fb..0486c27356 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistBoundedError.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage /-! # Two-sided Frobenius-twist errors from the bounded average @@ -18,6 +20,8 @@ This is the direct function-field specialization of `abs_le_of_uniform_upper_and_abs_sum_le`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean index 4b63e7dbce..eb0a304d66 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistConstants.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist /-! # Exact constants of Frobenius-twist fields @@ -23,6 +25,8 @@ The order calculation for `(Frob, g)` is not needed for this descent, so the result is stronger than the version with the usual divisibility hypothesis. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean index 99c037b112..61f4914469 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistDegree.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount /-! # Degrees of exact-constant Frobenius twists @@ -17,6 +19,8 @@ Hasse--Weil averaging argument and combines it with the general bound on rational places above infinity. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean index 700777033a..b838c5e1c0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -3,15 +3,17 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower /-! # Global finite-place averaging for Frobenius twists @@ -21,6 +23,8 @@ fixed-point identity and assembles the rational finite places of all Frobenius-twist fields without duplication. -/ +@[expose] public section + open scoped Polynomial TensorProduct BigOperators namespace BGS.HasseWeil @@ -416,6 +420,8 @@ theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under exact exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum C S N hExact (RatFunc C) q hBaseQ hDegreeDiv +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] in /-- The Frobenius-fiber parametrization sends `g` to the ambient Frobenius-twist automorphism `(Frob, g)`. -/ @[simp] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean index 74db45b20f..7f78558976 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower /-! # Finite places of Frobenius-twist fields @@ -29,6 +31,8 @@ requires the unramified residue-field descent for the constant extension; that result is not hidden in the interface below. -/ +@[expose] public section + open scoped Pointwise Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean index 741f8e1b53..aa2f377de9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge /-! # Unramified finite places over Frobenius-twist fields @@ -18,6 +20,8 @@ must be the identity. Thus every finite place is unramified in the exact constant extension over a twist field. -/ +@[expose] public section + open scoped Pointwise Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean index ef3e696fc0..76e74f4f09 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistGenus.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv /-! # Genus of Frobenius-twist fixed fields @@ -18,6 +20,8 @@ the original function field. This is Proposition 5.2.8(b) in the form used by the uniform Stepanov estimate. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -38,6 +42,7 @@ local instance twistGenusBaseConstantTower : IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- Every canonical Frobenius-twist fixed field has the genus of the original exact-constant Galois function field. The equality is independent of the auxiliary constant extension. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean index 7b8fad05b8..10007216ca 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified /-! # Infinity places of Frobenius-twist fields @@ -23,6 +25,8 @@ normalization presentation, whose equivalence with the actual infinity-place type is already exhaustive. -/ +@[expose] public section + open scoped Pointwise Polynomial TensorProduct namespace BGS.HasseWeil @@ -203,6 +207,7 @@ theorem infinityPlaceUnder_degree_eq_one_of_generator_fixed apply Nat.eq_of_mul_eq_mul_right (Module.finrank_pos (R := M) (M := T)) simpa only [one_mul] using htower.symm +omit [FiniteDimensional M T] in /-- Every lift of a rational infinity place has top degree equal to the relative field degree under the degree-divisibility hypothesis. -/ theorem rationalInfinityPlace_lift_degree_eq_finrank_of_finrank_dvd_degree @@ -460,6 +465,7 @@ section ExactConstantExtensionInfinityDegree variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) +omit [DecidableEq C] [DecidableEq (RatFunc C)] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- Every infinity place of the exact constant extension, viewed over the original constants `C`, has degree divisible by `[S : C]`. -/ theorem exactConstantExtensionInfinityPlace_finrank_constants_dvd_degree @@ -526,6 +532,8 @@ end ExactConstantExtensionInfinityDegree section FrobeniusTwistInfinityUnramified +omit [DecidableEq C] [DecidableEq (RatFunc C)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- Powers of the ambient twist act on enlarged constants by the corresponding powers of finite-field Frobenius. -/ private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft_infinity diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean index 399919e3b7..bb67df1dc6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent /-! # Exact Frobenius-twist descent for infinity places @@ -15,6 +17,8 @@ Frobenius-twist fixed field with degree-`[S : C]` infinity places upstairs fixed by the ambient Frobenius twist. -/ +@[expose] public section + open scoped Pointwise Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean index f143dd9fea..01e8b1e818 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistMultiplication.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree /-! # Multiplication presentation of Frobenius-twist constant extensions @@ -20,6 +22,8 @@ and Riemann budgets of all twists without identifying the twist fields over `C(X)` themselves. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean index aaf321b6ca..55b5876454 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage /-! # Complete rational-place averaging for Frobenius twists @@ -22,6 +24,8 @@ bound for the centered aggregate error. No branch-locus estimate is needed at this boundary. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -86,6 +90,7 @@ noncomputable def frobeniusTwistFieldRationalPlaceCount frobeniusTwistFieldRationalFinitePlaceCount C S N hExact g + frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g +omit [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- The split definition is the actual complete degree-one place count of the twist field. -/ theorem frobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCount @@ -153,6 +158,7 @@ theorem frobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCou FiniteExtensionRationalInfinityPlace C F) exact Nat.card_sum.symm +omit [DecidableEq S] [DecidableEq (RatFunc S)] in /-- The infinity contribution of each twist is bounded by the degree of the original function field, independently of the auxiliary constant extension. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean index 7044f202d7..12182e98cb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRiemannLower.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower /-! # A common Riemann budget for Frobenius-twist fields @@ -21,6 +23,8 @@ This file also records that the same twist fields have exact constant field Stepanov estimate are available at the same boundary. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean index d3e2774ae3..22398d301d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount /-! # A uniform Stepanov upper bound for exact-constant Frobenius twists @@ -25,6 +27,8 @@ Hasse--Weil. It does not require a separate genus-invariance hypothesis: the common Riemann budget is the exact input consumed by the Stepanov theorem. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -55,6 +59,7 @@ local instance (priority := 10000) twistStepanovFieldDecidableEq local instance (priority := 10001) twistStepanovRatFuncDecidableEq (F : Type*) [Field F] : DecidableEq (RatFunc F) := Classical.decEq _ +omit [IsGalois (RatFunc C) N] in /-- A single Stepanov budget gives the square-field rational-place upper bound for every Frobenius-twist fixed field. The final degree term is uniform: it is the degree of the original function field `N / C(X)`. diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean index 8beb7b0f72..8b48ee2723 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusDegree.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension /-! # Genus and extension degree under exact constant extension @@ -19,6 +21,8 @@ with the Riemann--Hurwitz expression. Second, extending the constants from field. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean index 1a7bdaec45..24bcaa9f79 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionGenusInvariance.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree /-! # Genus invariance under exact constant extension @@ -15,6 +17,8 @@ different degree. Riemann--Hurwitz and preservation of the rational-function extension degree then identify the two chart genera. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean index ac1585b810..f1102e1f98 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent /-! # The infinity different after exact constant extension @@ -18,6 +20,8 @@ rings has unit different. The linear-disjoint different theorem therefore identifies the new infinity different with the extension of the old one. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -41,196 +45,11 @@ local instance exactConstantExtensionInfinityDifferentDecidableEqBaseRatFunc : local instance exactConstantExtensionInfinityDifferentDecidableEqExtendedRatFunc : DecidableEq (RatFunc S) := Classical.decEq _ -@[reducible] private noncomputable def - exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra - (R : Type*) [CommRing R] [IsDomain R] : - Algebra R (FractionRing R) := inferInstance - -private theorem exactConstantExtensionInfinityDifferentCanonicalFractionRing - (R : Type*) [CommRing R] [IsDomain R] : - let := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R - IsFractionRing R (FractionRing R) := by - let := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra R - infer_instance - -private theorem different_eq_map_of_disjoint_fields - (A B R₁ R₂ K L : Type*) - [CommRing A] [IsDomain A] [IsIntegrallyClosed A] - [CommRing B] [IsDedekindDomain B] - [CommRing R₁] [IsDedekindDomain R₁] - [CommRing R₂] [IsDedekindDomain R₂] [Field K] [Field L] - [Algebra A K] [IsFractionRing A K] [Algebra B L] [IsFractionRing B L] - [Algebra A L] [Algebra K L] [FiniteDimensional K L] [Algebra.IsSeparable K L] - [IsScalarTower A K L] [Algebra A B] [IsScalarTower A B L] - [FaithfulSMul A B] [Module.Finite A B] [Module.IsTorsionFree A B] - [Algebra A R₁] [Algebra A R₂] [Algebra R₁ B] [Algebra R₂ B] - [Algebra R₁ L] [Algebra R₂ L] - [IsScalarTower A R₁ L] [IsScalarTower R₁ B L] [IsScalarTower R₂ B L] - [Module.Finite A R₁] [Module.Finite A R₂] [Module.Free A R₂] - [Module.Finite R₁ B] [Module.Finite R₂ B] - [IsScalarTower A R₁ B] [IsScalarTower A R₂ B] - [Module.IsTorsionFree A R₁] [Module.IsTorsionFree A R₂] - [Module.IsTorsionFree R₁ B] [Module.IsTorsionFree R₂ B] - [IsIntegralClosure B R₁ L] - (F₁ F₂ : IntermediateField K L) - [Algebra R₁ F₁] [Algebra R₂ F₂] [Module.IsTorsionFree R₁ F₁] - [IsFractionRing R₁ F₁] [IsFractionRing R₂ F₂] - [IsScalarTower A F₂ L] [IsScalarTower A R₂ F₂] - [IsScalarTower R₁ F₁ L] [IsScalarTower R₂ F₂ L] - [Algebra.IsSeparable K F₂] [Algebra.IsSeparable F₁ L] - [IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂] - (hdisjoint : F₁.LinearDisjoint F₂) (hsup : F₁ ⊔ F₂ = ⊤) - (hcoprime : IsCoprime - ((differentIdeal A R₁).map (algebraMap R₁ B)) - ((differentIdeal A R₂).map (algebraMap R₂ B))) : - differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by - let : Algebra A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra A - let : SMul A (FractionRing A) := Algebra.toSMul - let : IsFractionRing A (FractionRing A) := exactConstantExtensionInfinityDifferentCanonicalFractionRing A - let : Algebra B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRingAlgebra B - let : SMul B (FractionRing B) := Algebra.toSMul - let : IsFractionRing B (FractionRing B) := exactConstantExtensionInfinityDifferentCanonicalFractionRing B - let : Algebra A (FractionRing B) := - RingHom.toAlgebra ((algebraMap B (FractionRing B)).comp (algebraMap A B)) - let : SMul A (FractionRing B) := Algebra.toSMul - let : IsScalarTower A B (FractionRing B) := IsScalarTower.of_algebraMap_eq' rfl - let : FaithfulSMul A (FractionRing B) := by - rw [faithfulSMul_iff_algebraMap_injective] - change Function.Injective - ((algebraMap B (FractionRing B)).comp (algebraMap A B)) - exact (IsFractionRing.injective B (FractionRing B)).comp - (FaithfulSMul.algebraMap_injective A B) - let : Algebra (FractionRing A) (FractionRing B) := FractionRing.liftAlgebra A (FractionRing B) - let : SMul (FractionRing A) (FractionRing B) := Algebra.toSMul - let : IsScalarTower A (FractionRing A) (FractionRing B) := - FractionRing.isScalarTower_liftAlgebra A (FractionRing B) - let : Algebra.IsSeparable (FractionRing A) (FractionRing B) := by - refine Algebra.IsSeparable.of_equiv_equiv - (FractionRing.algEquiv A K).symm.toRingEquiv - (FractionRing.algEquiv B L).symm.toRingEquiv ?_ - ext z - exact IsFractionRing.algEquiv_commutes - (FractionRing.algEquiv A K).symm (FractionRing.algEquiv B L).symm z - exact IsDedekindDomain.differentIdeal_eq_map_differentIdeal - (K := K) (L := L) (F₁ := F₁) (F₂ := F₂) A B R₁ R₂ hdisjoint hsup hcoprime - -private theorem finite_torsionFree_of_integral_base_change - (A R₁ R₂ B K L : Type*) - [CommRing A] [CommRing R₁] [CommRing R₂] [CommRing B] [Field K] [Field L] - [IsDedekindDomain R₂] - [Algebra A R₁] [Algebra A R₂] [Algebra A L] - [Algebra R₁ L] [Algebra R₂ L] [Algebra B L] [Algebra R₂ B] - [Algebra R₂ K] [IsFractionRing R₂ K] [Algebra K L] - [IsScalarTower R₂ K L] [IsScalarTower R₂ B L] [Module.IsTorsionFree R₂ L] - [IsScalarTower A R₁ L] [IsScalarTower A R₂ L] - [Algebra.IsIntegral A R₁] [Algebra.IsIntegral A R₂] - [FiniteDimensional K L] [Algebra.IsSeparable K L] - [IsIntegralClosure B R₁ L] : - Module.Finite R₂ B ∧ Module.IsTorsionFree R₂ B := by - let : IsIntegralClosure B R₂ L := by - refine ⟨IsIntegralClosure.algebraMap_injective B R₁ L, ?_⟩ - intro x - constructor - · intro hx - have hxA : IsIntegral A x := isIntegral_trans (R := A) x hx - exact (IsIntegralClosure.isIntegral_iff (A := B) (R := R₁)).mp hxA.tower_top - · intro hx - have hxR₁ : IsIntegral R₁ x := - (IsIntegralClosure.isIntegral_iff (A := B) (R := R₁)).mpr hx - exact (isIntegral_trans (R := A) x hxR₁).tower_top - exact ⟨IsIntegralClosure.finite R₂ K L B, IsIntegralClosure.isTorsionFree R₂ L⟩ - -private theorem different_eq_map_of_disjoint_ranges - (A R₁ R₂ B K K₁ K₂ L : Type*) - [CommRing A] [IsDomain A] [IsPrincipalIdealRing A] - [CommRing R₁] [IsDedekindDomain R₁] - [CommRing R₂] [IsDedekindDomain R₂] [CommRing B] [IsDedekindDomain B] - [Field K] [Field K₁] [Field K₂] [Field L] - [Algebra A K] [IsFractionRing A K] - [Algebra K K₁] [Algebra K K₂] [Algebra K L] - [Algebra K₁ L] [Algebra K₂ L] [Algebra A K₂] - [IsScalarTower K K₁ L] [IsScalarTower K K₂ L] [IsScalarTower A K K₂] - [Algebra A R₁] [Algebra A R₂] [Algebra A B] [Algebra A L] - [Algebra R₁ K₁] [IsFractionRing R₁ K₁] - [Algebra R₂ K₂] [IsFractionRing R₂ K₂] - [Algebra R₁ B] [Algebra R₂ B] [Algebra R₁ L] [Algebra R₂ L] [Algebra B L] - [IsScalarTower A K L] [IsScalarTower A K₂ L] - [IsScalarTower R₁ K₁ L] [IsScalarTower R₂ K₂ L] - [IsScalarTower A R₂ K₂] [IsScalarTower A R₁ L] [IsScalarTower A R₂ L] - [IsScalarTower A R₁ B] [IsScalarTower A R₂ B] - [IsScalarTower R₁ B L] [IsScalarTower R₂ B L] [IsScalarTower A B L] - [FiniteDimensional K K₂] [FiniteDimensional K L] [Algebra.IsSeparable K L] - [Module.Finite A R₁] [Module.Finite A R₂] [Module.Free A R₂] - [Module.IsTorsionFree A R₁] [Module.IsTorsionFree A R₂] - [Module.IsTorsionFree R₁ L] [Module.IsTorsionFree R₂ L] - [Module.IsTorsionFree R₁ B] - [IsIntegralClosure R₂ A K₂] [IsIntegralClosure B R₁ L] - (hdisjoint : (IsScalarTower.toAlgHom K K₁ L).fieldRange.LinearDisjoint - (IsScalarTower.toAlgHom K K₂ L).fieldRange) - (hsup : (IsScalarTower.toAlgHom K K₁ L).fieldRange ⊔ - (IsScalarTower.toAlgHom K K₂ L).fieldRange = ⊤) - (hcoprime : IsCoprime ((differentIdeal A R₁).map (algebraMap R₁ B)) - ((differentIdeal A R₂).map (algebraMap R₂ B))) : - differentIdeal R₁ B = Ideal.map (algebraMap R₂ B) (differentIdeal A R₂) := by - let f₁ := IsScalarTower.toAlgHom K K₁ L - let f₂ := IsScalarTower.toAlgHom K K₂ L - let F₁ := f₁.fieldRange - let F₂ := f₂.fieldRange - let e₁ := f₁.equivFieldRange - let e₂ := f₂.equivFieldRange - let : Algebra R₁ F₁ := - RingHom.toAlgebra (e₁.toRingHom.comp (algebraMap R₁ K₁)) - let e₁inf : K₁ ≃ₐ[R₁] F₁ := { e₁.toRingEquiv with commutes' := fun _ => rfl } - let : IsFractionRing R₁ F₁ := IsFractionRing.of_algEquiv e₁inf - let : Module.IsTorsionFree R₁ F₁ := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - exact IsFractionRing.injective R₁ F₁ - let : IsScalarTower R₁ F₁ L := IsScalarTower.of_algebraMap_eq (fun z => by - change algebraMap R₁ L z = algebraMap K₁ L (algebraMap R₁ K₁ z) - exact IsScalarTower.algebraMap_apply R₁ K₁ L z) - let : Algebra R₂ F₂ := - RingHom.toAlgebra (e₂.toRingHom.comp (algebraMap R₂ K₂)) - let e₂norm : K₂ ≃ₐ[R₂] F₂ := { e₂.toRingEquiv with commutes' := fun _ => rfl } - let : IsFractionRing R₂ F₂ := IsFractionRing.of_algEquiv e₂norm - let : IsScalarTower R₂ F₂ L := IsScalarTower.of_algebraMap_eq (fun z => by - change algebraMap R₂ L z = algebraMap K₂ L (algebraMap R₂ K₂ z) - exact IsScalarTower.algebraMap_apply R₂ K₂ L z) - let : Algebra A F₂ := IntermediateField.algebra' F₂ - let : IsScalarTower A R₂ F₂ := IsScalarTower.of_algebraMap_eq (fun z => by - apply Subtype.ext - change algebraMap A L z = algebraMap K₂ L (algebraMap R₂ K₂ (algebraMap A R₂ z)) - rw [← IsScalarTower.algebraMap_apply A R₂ K₂, - ← IsScalarTower.algebraMap_apply A K₂ L]) - let : IsScalarTower A F₂ L := IsScalarTower.of_algebraMap_eq' rfl - let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) K₂ := - IsIntegralClosure.isLocalization A K K₂ R₂ - let : IsLocalization (Algebra.algebraMapSubmonoid R₂ (nonZeroDivisors A)) F₂ := - IsLocalization.isLocalization_of_algEquiv _ e₂norm - have hnormalization := finite_torsionFree_of_integral_base_change A R₁ R₂ B F₂ L - let : Module.Finite R₂ B := hnormalization.1 - let : Module.IsTorsionFree R₂ B := hnormalization.2 - let : Module.Finite R₁ B := IsIntegralClosure.finite R₁ F₁ L B - let : Module.Finite A B := Module.Finite.trans R₂ B - let : Module.IsTorsionFree A B := by - rw [Module.isTorsionFree_iff_algebraMap_injective] - have hR₂B := Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree R₂ B from inferInstance) - have hAR₂ := Module.isTorsionFree_iff_algebraMap_injective.mp - (show Module.IsTorsionFree A R₂ from inferInstance) - intro x y hxy - apply hAR₂ - apply hR₂B - exact (IsScalarTower.algebraMap_apply A R₂ B x).symm.trans - (hxy.trans (IsScalarTower.algebraMap_apply A R₂ B y)) - let : IsFractionRing B L := - IsIntegralClosure.isFractionRing_of_finite_extension R₁ F₁ L B - exact different_eq_map_of_disjoint_fields A B R₁ R₂ K L F₁ F₂ hdisjoint hsup hcoprime - variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) -private noncomputable def - exactConstantExtensionInfinityDifferentNormalizationRingHom +/-- The ambient constant-extension embedding restricts to the infinity integral closures. -/ +noncomputable def exactConstantExtensionInfinityDifferentNormalizationRingHom [Fintype C] [Finite S] : let L := ExactConstantExtension C N S let : Field L := exactConstantExtensionField C N S hExact @@ -638,7 +457,7 @@ theorem exactConstantExtension_infinityDifferent_eq_map ((differentIdeal A R₂).map (algebraMap R₂ B)) := by rw [ratFuncInfinityIntegers_coefficient_differentIdeal_eq_top C S, Ideal.map_top] exact Ideal.isCoprime_iff_sup_eq.mpr (top_sup_eq _) - exact different_eq_map_of_disjoint_ranges A R₁ R₂ B (RatFunc C) (RatFunc S) N L + exact different_eq_map_of_linearlyDisjoint_fieldRanges A R₁ R₂ B (RatFunc C) (RatFunc S) N L hranges.1 hranges.2 hcoprime end diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean index 6cc4b06be4..78bc946074 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityNormalization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization + +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization /-! # Normalization at infinity in an exact constant extension @@ -22,6 +24,8 @@ gives a ring equivalence with the actual infinity integral closure. Thus no comparison with the finite-place coordinate is used or assumed. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean index b594c8762e..6aa210a2a0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent /-! # Compatibility of infinity places with exact constant extension @@ -18,6 +20,8 @@ explicit downstairs infinity prime under the canonical algebra on infinity normalizations. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -90,6 +94,7 @@ private theorem subst b rfl +omit [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The reciprocal affine normalization equivalence sends the old normalization embedded in the right tensor factor to the same element of the ambient exact constant extension. -/ @@ -238,6 +243,7 @@ private theorem exactConstantExtensionInfinityAffineLocalizationSquare_coe (eAff (Algebra.TensorProduct.includeRight (R := C) (A := S) (B := R0) x)) : B) : E) := rfl +omit [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The extended reciprocal affine prime contracts to the reciprocal affine prime obtained from the old normalization. -/ private theorem exactConstantExtensionInfinityAffinePrime_under @@ -299,6 +305,8 @@ private theorem exactConstantExtensionInfinityAffinePrime_under (R := C) (A := S) (B := R0) x ∈ q.1.asIdeal rw [eAff.symm_apply_apply] +omit [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] [Fintype C] [Finite S] in private theorem exactConstantExtensionDownstairsInfinityMappedIdeal_isMaximal (q : ExactConstantExtensionPresentedInfinityPlace C S N) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 46c2a4dd26..fb8f9bf94d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower /-! # Finite-place Frobenius-twist averaging over an intermediate base @@ -16,6 +18,8 @@ This file proves the finite-place part of Stichtenoth's Frobenius-twist average for `C(X) \subseteq L \subseteq N`. -/ +@[expose] public section + open scoped BigOperators Pointwise Polynomial TensorProduct namespace BGS.HasseWeil @@ -107,6 +111,11 @@ local instance intermediateAverageConstantTower : IsScalarTower C L N := by local instance intermediateAverageRationalFinitePlaceFintype : Fintype (FiniteExtensionRationalFinitePlace C L) := Fintype.ofFinite _ +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [Algebra (RatFunc C) L] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [IsScalarTower (RatFunc C) L N] [IsGalois L N] in /-- The exact constant extension is finite-dimensional over every intermediate function field `L`. -/ private theorem finiteDimensional_exactConstantExtension_over_intermediateBase @@ -135,6 +144,11 @@ private theorem finiteDimensional_exactConstantExtension_over_intermediateBase let : Module.Finite L T := Module.Finite.trans N T infer_instance +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional L N] [IsGalois L N] in /-- Compatibility of the rational-function and intermediate-base algebra maps on the exact constant extension. -/ private theorem exactConstantExtensionIntermediate_ratFuncBaseTower : @@ -405,6 +419,8 @@ omit [FiniteDimensional (RatFunc C) L] [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional L N] [IsGalois L N] in +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] in /-- A power of the generic intermediate-base twist acts on the enlarged constants by the same power of finite-field Frobenius. -/ private theorem intermediateFrobeniusTwist_zpow_includeLeft @@ -958,6 +974,10 @@ theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under exact exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum C S N hExact L q hBaseQ hDegreeDiv +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] in /-- The Frobenius-fiber parametrization sends `g` to the ambient twist `(Frob, g)` over the intermediate field. -/ @[simp] @@ -1517,6 +1537,10 @@ theorem sum_intermediateFrobeniusTwistFieldRationalFinitePlaceCount_eq_card_galo _ = Nat.card (N ≃ₐ[L] N) * Nat.card (FiniteExtensionRationalFinitePlace C L) := Nat.mul_comm _ _ +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in /-- Viewing an intermediate-base Frobenius twist over `C(X)` does not change its underlying automorphism of the exact constant extension. -/ theorem exactConstantExtensionFrobeniusTwist_restrictScalars_apply diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean index 272ac52a6c..7c3cb1fd47 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree /-! # A fixed-tower Hasse bound from intermediate Frobenius twists @@ -16,6 +18,8 @@ The complete intermediate-base twist average is combined with the uniform square-field Stepanov estimate for the corresponding rational-base twists. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean index 194b2d8ef0..be7d0335a1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage /-! # Complete rational-place averaging over an intermediate base @@ -16,6 +18,8 @@ most the original degree `[N : C(X)]` rational infinity places. This gives a uniform aggregate error independent of the auxiliary constant extension. -/ +@[expose] public section + namespace BGS.HasseWeil private theorem finrank_mul_finrank_of_fields diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean index ff7b2184f8..3c498a2969 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum /-! # The exact constant-extension tower of a function-field normal closure @@ -29,6 +31,8 @@ consumer of the exact constant-extension API; it deliberately does not use the genus-invariance layer. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -883,7 +887,7 @@ theorem functionFieldNormalClosureConstantExtension_card_aut_eq /-- The rational-place count of the extended original compositum is the packaged level-one exact constant-extension count of that compositum. -/ theorem - functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_exactConstantExtensionCount + normalClosureOriginalCompositum_rationalPlaceCount_eq_exactExtensionCount (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : let C := FunctionFieldNormalClosureConstantField K F let M := FunctionFieldNormalClosureOriginalCompositum K F hExact @@ -956,7 +960,7 @@ theorem with the packaged exact-extension count of the original function field at level `[S : C]`. -/ theorem - functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_originalExactConstantExtensionCount + normalClosureOriginalCompositum_rationalPlaceCount_eq_originalExactExtensionCount (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : let N := FunctionFieldNormalClosure K F let : Algebra K N := functionFieldNormalClosureConstantAlgebra K F diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean index 823ba3fcb5..a9afc18c28 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionQuotient.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism /-! # The Frobenius quotient of an exact constant extension @@ -16,6 +18,8 @@ When the constants are finite, the Frobenius fiber is explicitly equivalent to that kernel; these are the twists used in the lower-bound argument. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean index 8861a9c316..ec5ebacbdf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRationalPlaceCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta /-! # Rational-place count of an exact constant extension @@ -16,6 +18,8 @@ This small bridge keeps the instance choices used by the global splitting formula explicit. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -35,6 +39,7 @@ local instance rationalCountBaseConstantTower : IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl +omit [Fintype C] [DecidableEq C] [DecidableEq (RatFunc C)] in /-- The packaged level-one exact-extension count is the complete rational place count of the extended function field. -/ theorem exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean index 4876b6ff0f..983e934866 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionRegularity.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase /-! # Regular constant extensions @@ -22,6 +24,8 @@ they do not assert compatibility with the not-yet-defined compositum `C F` of an arbitrary intermediate function field `F`. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil @@ -116,6 +120,7 @@ variable (K F S : Type*) [Field K] [Field F] [Field S] [FiniteDimensional (FunctionFieldNormalClosureConstantField K F) S] [IsGalois (FunctionFieldNormalClosureConstantField K F) S] +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) F] in /-- A finite Galois extension of the exact constants has field-valued tensor product with the function-field normal closure. -/ theorem functionFieldNormalClosureConstantExtensionTensor_isField : @@ -127,6 +132,9 @@ theorem functionFieldNormalClosureConstantExtensionTensor_isField : (FunctionFieldNormalClosure K F) S (functionFieldNormalClosureConstantField_isExact K F) +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) F] + [FiniteDimensional (↥(FunctionFieldNormalClosureConstantField K F)) S] + [IsGalois (↥(FunctionFieldNormalClosureConstantField K F)) S] in /-- The constant extension has the expected degree over the original normal closure. -/ theorem functionFieldNormalClosureConstantExtension_finrank_over_normalClosure : @@ -148,6 +156,7 @@ theorem functionFieldNormalClosureConstantExtension_finrank_over_normalClosure : (FunctionFieldNormalClosureConstantField K F) (FunctionFieldNormalClosure K F) S +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The normal closure remains Galois over its proved constant base after a finite Galois extension of the exact constants. -/ theorem functionFieldNormalClosureConstantExtension_isGalois_over_constantBase : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean index eb12cfca35..b21fb13013 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTotalDifferentDegree.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula -import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor /-! # Total different degree under exact constant extension @@ -24,6 +26,8 @@ hypothesis is intended to be discharged branchwise by the finite and reciprocal-infinity different-map theorems. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean index b46ac7f5ff..cc85ac88b4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension /-! # Towers of exact constant extensions @@ -22,6 +24,8 @@ top is finite Galois over the extended intermediate field, with the same degree and hence the same Galois-group cardinality as `N / M`. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -56,6 +60,7 @@ noncomputable def exactConstantExtensionTowerAlgHom : Algebra.TensorProduct.map (AlgHom.id C S) (IsScalarTower.toAlgHom C M N) +omit [FiniteDimensional C S] [IsGalois C S] in @[simp] theorem exactConstantExtensionTowerAlgHom_tmul (s : S) (m : M) : exactConstantExtensionTowerAlgHom C M N S (s ⊗ₜ[C] m) = @@ -133,6 +138,7 @@ section Galois variable [FiniteDimensional M N] [IsGalois M N] +omit [IsGalois M N] in /-- The extended top is finite-dimensional over the extended intermediate field. -/ theorem exactConstantExtensionTower_finiteDimensional diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean index 296ee5ca08..1b50c66a2a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionEvenDegreeStepanovBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +public import Mathlib.Tactic /-! # A Stepanov upper bound along the even-degree extension sequence @@ -22,6 +24,8 @@ This is only a one-sided affine estimate. It does not assert the missing lower bound, the sharp Hasse--Weil constant, or a two-sided zeta estimate. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean index 70ae066675..a47e052a59 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExtensionPointCount.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField -import Mathlib.FieldTheory.Finite.Extension -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import Mathlib.FieldTheory.Finite.Extension +public import Mathlib.Tactic /-! # Affine point counts over canonical finite-field extensions @@ -18,6 +20,8 @@ records the cardinality of the extension, compatibility with degree one, and the geometric hypotheses preserved by this base change. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean index 394c4d2abc..cdee11647b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FilteredDimension.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas + +public import Mathlib.LinearAlgebra.FiniteDimensional.Lemmas /-! # Dimension growth in a one-point filtration @@ -16,6 +18,8 @@ one pivot, then adjoining that pivot generates the larger subspace. Hence a single filtration step increases dimension by at most one. -/ +@[expose] public section + namespace BGS.HasseWeil variable {K L : Type*} [Field K] [AddCommGroup L] [Module K L] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean index e5fac973e9..96dd6e288d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteBranchLocus.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower /-! # Finiteness of the branch locus @@ -24,6 +26,8 @@ branch points after constant-field extension still requires an explicit closed-place/geometric-point comparison. -/ +@[expose] public section + open scoped BigOperators open IsDedekindDomain @@ -329,6 +333,7 @@ theorem mem_finiteExtensionBranchLocusSupport_iff P ∈ finiteExtensionBranchLocus K M L := by simp [finiteExtensionBranchLocusSupport] +omit [DecidableEq K] in /-- The support finset represents exactly the finite branch locus. -/ theorem finiteExtensionBranchLocusSupport_coe : (finiteExtensionBranchLocusSupport K M L : @@ -337,6 +342,7 @@ theorem finiteExtensionBranchLocusSupport_coe : ext P simp +omit [DecidableEq K] in /-- In set form, the exact branch support is finite. -/ theorem finiteExtensionBranchLocusSupport_finite : ((finiteExtensionBranchLocusSupport K M L : @@ -356,6 +362,7 @@ def finiteExtensionBranchLocusSelectedSupport classical exact (finiteExtensionBranchLocusSupport K M L).filter isSelected +omit [DecidableEq K] in @[simp] theorem mem_finiteExtensionBranchLocusSelectedSupport_iff (isSelected : FiniteExtensionPlace K M → Prop) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean index 2c0564cf6e..4683e4f9c8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula -import Mathlib.NumberTheory.ClassNumber.FunctionField -import Mathlib.RingTheory.Ideal.Quotient.HasFiniteQuotients + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +public import Mathlib.NumberTheory.ClassNumber.FunctionField +public import Mathlib.RingTheory.Ideal.Quotient.HasFiniteQuotients /-! # Affine ideal degrees in a finite function field @@ -28,6 +30,8 @@ and Mathlib's bounded-quotient-cardinality theorem makes the ideals of each fixed degree into a finite type. No Riemann--Roch or Hasse--Weil input is used. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean index 330719b510..f4d11b75c7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor /-! # Nonzero affine ideals as effective finite divisors @@ -23,6 +25,8 @@ finite places of the function field. The equivalence is purely Dedekind factorization: it does not use Riemann--Roch or a zeta-function argument. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial open IsDedekindDomain @@ -41,11 +45,13 @@ a Dedekind domain. -/ def effectiveDivisorIdeal (D : HeightOneSpectrum R →₀ ℕ) : Ideal R := D.prod fun v e => v.asIdeal ^ e +omit [IsDedekindDomain R] in @[simp] theorem effectiveDivisorIdeal_zero : effectiveDivisorIdeal (0 : HeightOneSpectrum R →₀ ℕ) = ⊤ := by simp [effectiveDivisorIdeal] +omit [IsDedekindDomain R] in @[simp] theorem effectiveDivisorIdeal_single (v : HeightOneSpectrum R) (e : ℕ) : @@ -53,6 +59,7 @@ theorem effectiveDivisorIdeal_single classical simp [effectiveDivisorIdeal, Finsupp.prod_single_index] +omit [IsDedekindDomain R] in theorem effectiveDivisorIdeal_add (D E : HeightOneSpectrum R →₀ ℕ) : effectiveDivisorIdeal (D + E) = @@ -365,6 +372,7 @@ def finiteExtensionAffineIdealEffectiveDivisorEquiv : (FiniteExtensionFinitePlace K L →₀ ℕ) := nonzeroIdealEffectiveDivisorEquiv +omit [Fintype K] in @[simp] theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_apply (I : FiniteExtensionAffineIdeal K L) @@ -375,6 +383,7 @@ theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_apply simpa [finiteExtensionAffineIdealEffectiveDivisorEquiv] using (nonzeroIdealEffectiveDivisorEquiv_apply I v) +omit [Fintype K] in @[simp] theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_symm_coe (D : FiniteExtensionFinitePlace K L →₀ ℕ) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean index 76f16f9501..71b060fa1c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCanonicalityCriterion.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound /-! # Canonicality criterion for the finite-extension different divisor @@ -33,6 +35,8 @@ trace-different/Kähler module, and thereby close the last one-dimensional gap. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean index a4e78003d6..7981ad1925 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion -import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +public import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing /-! # Cotrace construction for the finite-extension canonical different @@ -18,6 +20,8 @@ maximal vanishing divisor contains the explicit finite-extension different. Nothing in this file is an assumption. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -42,6 +46,7 @@ def ratFuncFiniteBaseRingEquivChart : (IsIntegralClosure.equiv K[X] K[X] (RatFunc K) (FunctionField.ringOfIntegers K (RatFunc K))).toRingEquiv +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in @[simp] theorem ratFuncFiniteBaseRingEquivChart_algebraMap (r : K[X]) : @@ -62,6 +67,7 @@ def ratFuncInfinityBaseRingEquivChart : (FunctionField.Chart.inftyValuationSubring K) (RatFunc K) (FunctionField.Chart.infiniteIntegers K (RatFunc K))).toRingEquiv +omit [Fintype K] [DecidableEq K] in @[simp] theorem ratFuncInfinityBaseRingEquivChart_algebraMap (r : RatFuncInfinityIntegers K) : @@ -350,6 +356,7 @@ def finiteExtensionUnderPlace : | .inl q => .inl (q.under K[X]) | .inr _ => .inr (ratFuncInfinityPlace K) +omit [Fintype K] [DecidableEq K] in /-- Every rational-function place has an extension place above it. -/ theorem finiteExtensionUnderPlace_surjective : Function.Surjective (finiteExtensionUnderPlace K L) := by @@ -394,6 +401,7 @@ theorem finiteExtensionUnderPlace_surjective : simp only [finiteExtensionUnderPlace] exact congrArg Sum.inr hpEq.symm +omit [Fintype K] [DecidableEq K] in /-- Every fiber of the exhaustive place map is finite. -/ theorem finiteExtensionUnderPlace_finite_preimage_singleton (p : RatFuncExhaustivePlace K) : @@ -600,6 +608,7 @@ def finiteExtensionAdeleExceptionalSet Set (FunctionField.Chart.PlaceA K L) := {q | a.1 q ∉ FunctionField.Chart.placeValuationSubring K L q} +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in theorem finiteExtensionAdeleExceptionalSet_finite (a : FunctionField.Chart.AdeleSpace K L) : (finiteExtensionAdeleExceptionalSet K L a).Finite := by @@ -673,6 +682,7 @@ theorem finiteExtensionCotraceBadBaseSet_finite (finiteExtensionUnderPlaceChart K L) · exact Set.finite_singleton _ +omit [Fintype K] [DecidableEq K] in /-- The infinity component of the rational-function chart contains only the place transported from the BGS infinity valuation ring. -/ theorem ratFunc_infinite_chart_place_eq diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean index 7d22bf802d..9725a71e7e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotraceCanonicality.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion /-! # Canonicality from cotrace and the different degree @@ -21,6 +23,8 @@ The degree identity remains an explicit premise; it is not derived or hidden here. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean index cfd0608dfb..0d413862d6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower /-! # Canonical-different genus bridge @@ -22,6 +24,8 @@ below takes `FunctionField.Chart.IsCanonical` explicitly, while the plane theorem proves the complete degree estimate available below that boundary. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean index 3a598214f7..24b514f2ec 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion /-! # Local maximality of the canonical different by cotrace @@ -18,6 +20,8 @@ functional, this proves that the trace-different divisor is its exact maximal vanishing divisor, without assuming a Riemann--Hurwitz degree identity. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean index abb56e9b69..bcbf2348c1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionClosedPlaceAlgEquiv.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv /-! # Closed-place counts across function-field equivalences @@ -15,6 +17,8 @@ on absolute place degrees. Hence the degree-preserving place equivalence induced by a `K(X)`-algebra equivalence preserves the entire sequence. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean index 089fded6be..8e6fddc9dd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation /-! # Local trace image for cotrace maximality @@ -17,6 +19,8 @@ shows that any prescribed base element of order `-1` is a trace without losing the required lower bounds at the places over the chosen base place. -/ +@[expose] public section + namespace BGS.HasseWeil open Set Function UniqueFactorizationMonoid IsDedekindDomain @@ -47,6 +51,7 @@ def heightOneOfPrimesOverFinset (p : HeightOneSpectrum A) exact ⟨Q, hQover.1, Ideal.ne_bot_of_mem_primesOver p.ne_bot hQover⟩ +omit [Algebra.IsIntegral A B] in @[simp] theorem heightOneOfPrimesOverFinset_asIdeal (p : HeightOneSpectrum A) (Q : Ideal B) (hQ : Q ∈ IsDedekindDomain.primesOverFinset p.asIdeal B) : @@ -69,6 +74,7 @@ theorem mem_primesOverFinset_iff_under_eq (p : HeightOneSpectrum A) rw [Ideal.liesOver_iff] exact (congrArg HeightOneSpectrum.asIdeal h).symm +omit [Algebra.IsIntegral A B] in /-- Every ideal selected by `primesOverFinset` is prime in the factorization monoid sense required by the weak-approximation theorem. -/ theorem prime_of_mem_primesOverFinset (p : HeightOneSpectrum A) @@ -94,6 +100,7 @@ theorem le_count_spanSingleton_of_valuation_le_exp_neg have := WithZero.exp_le_exp.mp hval omega +omit [Algebra A L] [IsScalarTower A B L] [IsIntegralClosure B A L] in /-- Weak approximation realizes simultaneous lower order bounds over one base prime and realizes a prescribed negative order exactly at one chosen prime. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean index 7e63dbdfdb..084239ccd4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisibleErrorFromConstantBase.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions /-! # Divisible-even errors from one enlarged constant field @@ -18,6 +20,8 @@ the levels `2 H n` is therefore exactly such an estimate for `F` along the fixed divisible-even subsequence `2 (r H) n`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean index 9005d99dba..b685d96b42 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization /-! # Divisor classes and the indexed eventual recurrence @@ -26,6 +28,8 @@ degree, from the uniform formula and the already proved finiteness of the effective divisors of that degree. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -70,6 +74,7 @@ def finiteExtensionDivisorClassMap : FiniteExtensionDivisor K L →+ FiniteExtensionDivisorClass K L := QuotientAddGroup.mk' (finiteExtensionPrincipalDivisorSubgroup K L) +omit [Fintype K] in @[simp] theorem finiteExtensionDivisorClassMap_principal (x : L) (hx : x ≠ 0) : @@ -113,6 +118,7 @@ def finiteExtensionDivisorClassRepresentative (c : FiniteExtensionDivisorClass K L) : FiniteExtensionDivisor K L := Quotient.out c +omit [Fintype K] in @[simp] theorem finiteExtensionDivisorClassMap_representative (c : FiniteExtensionDivisorClass K L) : @@ -383,6 +389,7 @@ def finiteExtensionDivisorIndexRepresentative : FiniteExtensionDivisor K L := Classical.choose (exists_finiteExtensionDivisor_degree_eq_index K L) +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionDivisorIndexRepresentative_degree : finiteExtensionDivisorDegree K L diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean index 57378920f7..829dca1e52 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorDegreeIndex.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting -import Mathlib.GroupTheory.Archimedean + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +public import Mathlib.GroupTheory.Archimedean /-! # The divisor-degree index @@ -29,6 +31,8 @@ make the intended zeta proof circular. The exact missing conclusion is isolated by the degree-one criterion at the end of the file. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -90,9 +94,10 @@ def finiteExtensionDivisorDegreeHom : (FiniteExtensionPlace K L →₀ ℤ) →+ ℤ where toFun := finiteExtensionDivisorDegree K L map_zero' := by simp [finiteExtensionDivisorDegree] - map_add' := finiteExtensionDivisorDegree_add_index K L + map_add' := by exact finiteExtensionDivisorDegree_add_index K L -private noncomputable def finiteExtensionDivisorDegreeGenerator : ℤ := +/-- A cyclic generator of the image of divisor degree in the integers. -/ +noncomputable def finiteExtensionDivisorDegreeGenerator : ℤ := Classical.choose (Int.subgroup_cyclic (finiteExtensionDivisorDegreeHom K L).range) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean index eeb2ac1165..6507a992c6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import Mathlib.Data.Finsupp.Fintype + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import Mathlib.Data.Finsupp.Fintype /-! # Splitting effective exhaustive divisors at infinity @@ -23,6 +25,8 @@ fixed-degree convolution. The finite component is also identified with a nonzero ideal in the normalization of `K[X]`. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial BigOperators namespace BGS.HasseWeil @@ -224,12 +228,13 @@ private local instance effectiveDivisorInfinityClosureDedekind : IsIntegralClosure.isDedekindDomain (RatFuncInfinityIntegers K) (RatFunc K) L (RatFuncInfinityIntegralClosure K L) -private noncomputable local instance effectiveDivisorInfinityPlaceFintype : - Fintype (FiniteExtensionInfinityPlace K L) := - Set.Finite.fintype +local instance effectiveDivisorInfinityPlaceFinite : + Finite (FiniteExtensionInfinityPlace K L) := by + letI := Set.Finite.fintype (IsDedekindDomain.primesOver_finite (ratFuncInfinityPlace K).asIdeal (RatFuncInfinityIntegralClosure K L)) + infer_instance /-- Every infinity coefficient is bounded by the weighted degree. -/ theorem finiteExtensionEffectiveInfinityDivisor_apply_le_degree diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean index ccd5b14f18..7e44ba6136 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionGenusBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence /-! # Bounding the Riemann--Roch genus from a one-point inequality @@ -14,6 +16,8 @@ Riemann inequality bounds its genus parameter. This is the bridge that will turn the existing bidegree monomial budget into a numerator-degree bound. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean index 94030fd282..a2cfe9d607 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound /-! # Hasse bounds from even exact constant-extension estimates @@ -21,6 +23,8 @@ hypothesis. Proving it is the remaining Galois-twist boundary; no one-sided Stepanov estimate can replace it. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean index 29c5b60709..5cb42dadcf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension /-! # Hasse--Weil for finite separable function-field extensions @@ -21,11 +23,42 @@ form. Exact constant-extension splitting and the spectral argument then transport that estimate back to the original function field. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section +section GenusBridge + +variable (C S N : Type*) [Field C] [Field S] [Field N] + [Fintype C] [Finite S] + [Algebra (RatFunc C) N] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] + [Algebra C S] [FiniteDimensional C S] [IsGalois C S] +local instance : Algebra C N := bridgeBaseConstantAlgebra C N +local instance : IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl + +/-- Constant extension preserves genus for the induced rational-function-field algebra. -/ +private theorem exactConstantExtension_genus_eq_for_ratFunc + (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : + let E := ExactConstantExtension C N S + let : Field E := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc S) E := ratFuncExactConstantExtensionAlgebra C S N hExact + @FunctionField.genus S E _ _ (bridgeBaseConstantAlgebra S E) = FunctionField.genus C N := by + intro E fieldStructure rationalAlgebra + have hConstantAlgebra : (Algebra.TensorProduct.leftAlgebra : Algebra S E) = + bridgeBaseConstantAlgebra S E := by + apply Algebra.algebra_ext + intro s + exact (ratFuncToExactConstantExtension C S N hExact).commutes s |>.symm + rw [← hConstantAlgebra] + exact exactConstantExtension_genus_eq C S N hExact + + +end GenusBridge + variable (K F : Type*) [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [Field F] [Algebra (RatFunc K) F] [FiniteDimensional (RatFunc K) F] @@ -188,14 +221,10 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants let g := functionFieldNormalClosureGenus K F let H := functionFieldNormalClosureStepanovThreshold K F let D := functionFieldNormalClosureRatFuncDegree K F - have hH : 0 < H := by - exact functionFieldNormalClosureStepanovThreshold_pos K F - have hD : 0 < D := by - exact functionFieldNormalClosureRatFuncDegree_pos K F + have hH : 0 < H := functionFieldNormalClosureStepanovThreshold_pos K F + have hD : 0 < D := functionFieldNormalClosureRatFuncDegree_pos K F let p := ringChar C - letI : CharP C p := by - dsimp only [p] - exact ringChar.charP C + let : CharP C p := ringChar.charP C letI : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ letI : NeZero (H * n) := ⟨Nat.mul_pos hH hn |>.ne'⟩ letI : NeZero (2 * (H * n)) := ⟨by positivity⟩ @@ -286,33 +315,21 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants exactConstantExtension_isGalois C (RatFunc C) N Cbig hExactN letI : IsGalois (RatFunc Cbig) E_N := IsGalois.tower_top_of_isGalois (RatFunc C) (RatFunc Cbig) E_N - have hConstantAlgebra : - (Algebra.TensorProduct.leftAlgebra : Algebra Cbig E_N) = - bridgeBaseConstantAlgebra Cbig E_N := by - apply Algebra.algebra_ext - intro s - exact (ratFuncToExactConstantExtension C Cbig N hExactN).commutes s |>.symm - have hgenusTensor : - @FunctionField.genus Cbig E_N _ _ - (Algebra.TensorProduct.leftAlgebra : Algebra Cbig E_N) = g := by - simpa only [E_N, g, functionFieldNormalClosureGenus] using - exactConstantExtension_genus_eq C Cbig N hExactN have hExactEN : @algebraicClosure Cbig E_N _ _ (bridgeBaseConstantAlgebra Cbig E_N) = (⊥ : @IntermediateField Cbig E_N _ _ - (bridgeBaseConstantAlgebra Cbig E_N)) := by - exact exactConstantExtension_extended_algebraicClosure_eq_bot + (bridgeBaseConstantAlgebra Cbig E_N)) := + exactConstantExtension_extended_algebraicClosure_eq_bot C Cbig N hExactN have hgenusEN : @FunctionField.genus Cbig E_N _ _ (bridgeBaseConstantAlgebra Cbig E_N) = g := by - rw [← hConstantAlgebra] - exact hgenusTensor - have hdegreeEN : Module.finrank (RatFunc Cbig) E_N = D := by - exact exactConstantExtension_finrank_over_extendedRatFunc_eq + simpa only [E_N, g, functionFieldNormalClosureGenus] using + exactConstantExtension_genus_eq_for_ratFunc C Cbig N hExactN + have hdegreeEN : Module.finrank (RatFunc Cbig) E_N = D := + exactConstantExtension_finrank_over_extendedRatFunc_eq C Cbig N hExactN - have hHg : H = (g + 1) * (g + 2) := by - rfl + have hHg : H = (g + 1) * (g + 2) := rfl have hlarge : (@FunctionField.genus Cbig E_N _ _ (bridgeBaseConstantAlgebra Cbig E_N) + 1) * @@ -334,11 +351,11 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants Module.finrank Cbig U := by rw [hauxDegree, IsGalois.card_aut_eq_finrank, hdegreeEN] exact Nat.dvd_factorial hD le_rfl - have hdivMOriginal : Nat.card (N ≃ₐ[M] N) ∣ D.factorial := by - exact natCard_aut_dvd_finrank_factorial_of_tower (RatFunc C) M N + have hdivMOriginal : Nat.card (N ≃ₐ[M] N) ∣ D.factorial := + natCard_aut_dvd_finrank_factorial_of_tower (RatFunc C) M N have hcardTower : Nat.card (E_N ≃ₐ[E_M] E_N) = - Nat.card (N ≃ₐ[M] N) := by - exact functionFieldNormalClosureConstantExtension_card_aut_eq + Nat.card (N ≃ₐ[M] N) := + functionFieldNormalClosureConstantExtension_card_aut_eq K F Cbig hExact have hdivL : Nat.card (E_N ≃ₐ[E_M] E_N) ∣ Module.finrank Cbig U := by @@ -350,7 +367,7 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants have hcount : finiteExtensionRationalPlaceCount Cbig E_M = exactConstantExtensionClosedPlaceExtensionCount K C F hExact (2 * H * n) := by - rw [functionFieldNormalClosureOriginalCompositumConstantExtension_rationalPlaceCount_eq_originalExactConstantExtensionCount + rw [normalClosureOriginalCompositum_rationalPlaceCount_eq_originalExactExtensionCount K F Cbig hExact] congr 2 simpa only [Cbig, Nat.mul_assoc] using @@ -387,8 +404,7 @@ theorem finiteExtensionClosedPlaceHasseWeil let D := functionFieldNormalClosureRatFuncDegree K F let A : ℝ := 2 * (D : ℝ) ^ 2 + 2 * (D : ℝ) ^ 3 let B : ℝ := (D : ℝ) ^ 2 * (2 * g + 1) - have hH : 0 < H := by - exact functionFieldNormalClosureStepanovThreshold_pos K F + have hH : 0 < H := functionFieldNormalClosureStepanovThreshold_pos K F have hA : 0 ≤ A := by dsimp only [A] positivity diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean index 944eeed874..134d5ed140 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationality.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler /-! # Indexed zeta rationality for an exact-constant function field @@ -18,6 +20,8 @@ uses the divisor-degree index; replacing it by the standard degree-one denominator is a separate constant-field theorem. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean index f97fbc2802..b4773fe7e2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionIndexedZetaRationalityAutomatic.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree /-! # Unconditional indexed zeta rationality from exact constants @@ -16,6 +18,8 @@ composition by transporting the vendored Riemann--Roch theorem to the exhaustive BGS divisor model. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean index c99700947e..0aa4fad566 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleQuotient.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement + +public import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement /-! # Exact local principal-part dimensions at exhaustive places @@ -18,6 +20,8 @@ both the finite and infinity places of a finite separable extension of degree of the corresponding exhaustive place. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean index 4d91b511f5..e406125ac0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionLocalPoleSpace.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace /-! # Local and away-regular subspaces of a function field @@ -15,6 +17,8 @@ functions regular at every place away from `P`. This is the two-open-cover decomposition used by the Cech form of Riemann's inequality. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean index 9a324d9f13..382e3070b9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace /-! # Transporting function-field places across algebra equivalences @@ -17,6 +19,8 @@ particular, rational-place counts depend only on the `K(X)`-algebra up to equivalence, not on its chosen field presentation. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil @@ -289,6 +293,7 @@ theorem finiteExtensionFinitePlace_degree_eq_residue_finrank rw [ratFuncFinitePlaceDegree_eq_finrank_residueField K P] rw [mul_comm, Module.finrank_mul_finrank] +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The absolute degree of an infinity place is the dimension of its residue field over the constant field. -/ theorem finiteExtensionInfinityPlace_degree_eq_residue_finrank @@ -335,6 +340,7 @@ theorem finiteExtensionFinitePlaceEquivOfAlgEquiv_degree _ = finiteExtensionPlaceDegree K L (.inl Q) := (finiteExtensionFinitePlace_degree_eq_residue_finrank K L Q).symm +omit [DecidableEq K] [FiniteDimensional (RatFunc K) L] [FiniteDimensional (RatFunc K) M] in @[simp] theorem finiteExtensionInfinityPlaceEquivOfAlgEquiv_asIdeal (e : L ≃ₐ[RatFunc K] M) (P : FiniteExtensionInfinityPlace K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean index 3599fd088a..279977214b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower /-! # Finiteness of bounded-degree places @@ -21,6 +23,8 @@ place type. These are the local-finiteness inputs needed to define effective divisor counts and Euler products without assuming zeta rationality. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index 0a7fab3da3..e834e326d1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage -import Mathlib.NumberTheory.RamificationInertia.Galois -import Mathlib.RingTheory.Invariant.Galois -import Mathlib.RingTheory.RamificationInertia.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +public import Mathlib.NumberTheory.RamificationInertia.Galois +public import Mathlib.RingTheory.Invariant.Galois +public import Mathlib.RingTheory.RamificationInertia.Basic /-! # Restriction of function-field places in a finite tower @@ -23,6 +25,8 @@ The construction is intrinsic to the field tower. It assumes no point-count bound, zeta theorem, or Hasse--Weil statement. -/ +@[expose] public section + open scoped BigOperators nonZeroDivisors Pointwise Polynomial open IsDedekindDomain @@ -486,6 +490,7 @@ theorem finiteIntegralClosure_relative_finrank_eq_field_finrank : (RatFuncFiniteIntegralClosure K M) M (RatFuncFiniteIntegralClosure K L) L).symm +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) L] in /-- The infinity integral-closure model has the same relative rank, namely the degree of the field extension. -/ theorem infinityIntegralClosure_relative_finrank_eq_field_finrank : @@ -508,6 +513,7 @@ noncomputable def finitePlaceRelativeInertiaDeg (Q : FiniteExtensionFinitePlace K L) : ℕ := Q.asIdeal.inertiaDeg (RatFuncFiniteIntegralClosure K M) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The fundamental equality for the finite-place restriction fiber. -/ theorem sum_finitePlaceUnderFiber_ramification_inertia_eq_finrank (P : FiniteExtensionFinitePlace K M) : @@ -550,6 +556,7 @@ noncomputable def infinityPlaceRelativeInertiaDeg (Q : FiniteExtensionInfinityPlace K L) : ℕ := Q.1.inertiaDeg (RatFuncInfinityIntegralClosure K M) +omit [DecidableEq K] in /-- The fundamental equality for the restriction fiber above infinity. -/ theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_finrank (P : FiniteExtensionInfinityPlace K M) : @@ -1122,6 +1129,7 @@ section FiniteConstants variable [Fintype K] +omit [DecidableEq (RatFunc K)] in private theorem ratFuncFinitePlaceResidueField_finite (p : HeightOneSpectrum K[X]) : Finite p.asIdeal.ResidueField := by let r := finitePlaceNormalizedPrime p diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean index 8e5b66b104..79c0f1326c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPrincipalParts.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants /-! # Principal parts of an effective exhaustive divisor @@ -24,6 +26,8 @@ Consequently `L(D) / L(0)` is finite-dimensional and has dimension at most space of constants. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean index 03c4c240be..4ea30ce80d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannEventualGrowth.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower -import Mathlib.Order.OrderIsoNat -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +public import Mathlib.Order.OrderIsoNat +public import Mathlib.Tactic /-! # Eventual exact growth of one-point Riemann spaces @@ -26,6 +28,8 @@ This is the elementary stabilization input used in the divisor-class proof of zeta rationality; it does not assume Riemann--Roch or a zeta theorem. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean index 9f97ceafa3..5c566f8336 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannLowerFromGenus.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit /-! # One-point Riemann lower bounds from the intrinsic genus @@ -15,6 +17,8 @@ simultaneous budget for every one-point Riemann space. This applies to the exhaustive BGS place type, including both finite and infinity places. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean index bd0412e128..8eef755577 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch /-! # Riemann--Roch for the exhaustive finite-extension place model @@ -23,6 +25,8 @@ We therefore record the identity-on-elements ring equivalence explicitly and transport the integral closure and its height-one primes across it. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -134,6 +138,7 @@ def finiteExtensionInfinityBaseRingEquiv : map_mul' _ _ := rfl map_add' _ _ := rfl +omit [Fintype K] [DecidableEq K] in @[simp] theorem finiteExtensionInfinityBaseRingEquiv_apply_coe (x : RatFuncInfinityIntegers K) : @@ -141,6 +146,8 @@ theorem finiteExtensionInfinityBaseRingEquiv_apply_coe FunctionField.Chart.inftyValuationSubring K) : RatFunc K) = x := rfl +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in private theorem isIntegral_infinityBase_iff (x : L) : IsIntegral (RatFuncInfinityIntegers K) x ↔ IsIntegral (FunctionField.Chart.inftyValuationSubring K) x := by @@ -471,6 +478,7 @@ theorem finiteExtensionDivisorDegree_eq_chart Finsupp.equivMapDomain_single, finiteExtensionPlaceDegree_eq_chart] +omit [Fintype K] in /-- The valuation of a nonzero function is the exponential of the negative coefficient of its exhaustive principal divisor. -/ theorem finiteExtensionPlaceValuation_eq_exp_neg_principalDivisor diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean index 23a966cf5a..088c9bfe0a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannShiftedEventualGrowth.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +public import Mathlib.Tactic /-! # Eventual growth after an effective divisor shift @@ -24,6 +26,8 @@ also gives an exact formula for the cardinalities of the shifted Riemann spaces. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean index 0cdb2bc9bf..dda7a8faa0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight -import Mathlib.FieldTheory.Finite.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import Mathlib.FieldTheory.Finite.Basic /-! # Riemann spaces for finite extensions of a rational function field @@ -38,6 +40,8 @@ the ambient space. Both stages must be proved before `finrank` is used in the Hasse--Weil argument. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -62,6 +66,7 @@ local instance finiteExtensionRiemannSpaceConstantTower : `L / K(X)`. -/ abbrev FiniteExtensionDivisor := FiniteExtensionPlace K L →₀ ℤ +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Divisor degree is additive. -/ theorem finiteExtensionDivisorDegree_add (D E : FiniteExtensionDivisor K L) : @@ -74,6 +79,7 @@ theorem finiteExtensionDivisorDegree_add (h := fun v e ↦ e * (finiteExtensionPlaceDegree K L v : ℤ)) (by simp) (by intros; ring)) +omit [Fintype K] in /-- The product formula says that every nonzero principal divisor has degree zero. -/ theorem finiteExtensionDivisorDegree_principal @@ -82,6 +88,7 @@ theorem finiteExtensionDivisorDegree_principal (finiteExtensionPrincipalDivisor K L x) = 0 := by exact finiteExtensionPrincipalDivisorDegreeSum_eq_zero K L x hx +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- An effective divisor has nonnegative degree. -/ theorem finiteExtensionDivisorDegree_nonnegative_of_effective (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean index 045267c5c7..f72d17dc96 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement -import Mathlib.LinearAlgebra.Projectivization.Cardinality + +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +public import Mathlib.LinearAlgebra.Projectivization.Cardinality /-! # Projectivized Riemann-space counts @@ -23,6 +25,8 @@ The final statements specialize these formulas to every effective exhaustive divisor, using the already proved finite-dimensionality of its Riemann space. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean index 14b9a05a65..1ed04afed3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionStandardZetaRationality.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace /-! # Standard zeta rationality after proving degree index one @@ -19,6 +21,8 @@ automatic indexed zeta rational form becomes the standard curve denominator numerator-degree bound and numerator noncancellation at `T = 1`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean index 02c06e7215..2c5915fd05 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionTotalDifferentEffectiveDivisor.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor /-! # The total effective different divisor @@ -19,6 +21,8 @@ the total different itself: its infinity coefficients do not contain the additional `-2e` correction coming from the pole of `dX`. -/ +@[expose] public section + open scoped BigOperators nonZeroDivisors Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean index 6da11ace0e..259351aaef 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZeroCounting.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import Mathlib.Tactic /-! # Zero counting from principal-divisor height @@ -19,6 +21,8 @@ No point-count estimate is used here. In particular, the genuinely Hasse--Weil input can remain a separate upstream theorem. -/ +@[expose] public section + open scoped nonZeroDivisors Polynomial BigOperators open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean index 2cb040b464..77524574f5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeExtensionIdentity.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex -import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity /-! # Degree support and the constant-extension zeta identity @@ -16,6 +18,8 @@ closed-place point-count sequence. The divisor-degree index itself supplies the required divisibility support. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean index 7f2ff5849f..304257127b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOne.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension /-! # The geometric F. K. Schmidt composition @@ -23,6 +25,8 @@ The only geometric input left explicit is the closed-place count identity for the constant extension whose degree is the original divisor-degree index. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean index b282b66ee8..ba8077fc88 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneAutomatic.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality /-! # Automatic divisor-degree index one @@ -16,6 +18,8 @@ hypothesis of the noncircular F. K. Schmidt argument. Consequently a finite separable function field with exact constants has divisor-degree index one. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean index 2ddbb801ce..5620ef8361 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaDegreeIndexOneFromAllCounts.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne -import Mathlib.FieldTheory.Finite.Extension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +public import Mathlib.FieldTheory.Finite.Extension /-! # Choosing the constant extension of divisor-index degree @@ -18,6 +20,8 @@ if the closed-place splitting identity is available for every finite Galois constant extension, then the divisor-degree index is one. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean index a736526ce3..b3b5f48fc0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaNumeratorNoncancellation.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole -import Mathlib.Algebra.Polynomial.Expand -import Mathlib.RingTheory.PowerSeries.Expand + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +public import Mathlib.Algebra.Polynomial.Expand +public import Mathlib.RingTheory.PowerSeries.Expand /-! # Noncancellation of the indexed zeta numerator @@ -18,6 +20,8 @@ proves the formal coefficient statement and then specializes it to the finite-extension effective-divisor series. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean index d494d6f319..870f17d0e6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionZetaSimplePole.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence /-! # A discrete simple-pole witness for the divisor zeta series @@ -16,6 +18,8 @@ constant-field cardinality. This is the coefficient-level noncancellation behind the simple pole at `T = 1`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean index 4bd7fb4c27..7e4ae19434 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldCompositum.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield /-! # Composita of finite fields @@ -23,6 +25,8 @@ This formulation is designed to apply directly to residue fields after a constant extension. -/ +@[expose] public section + open scoped TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean index b32baf4882..3cdf332e96 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel /-! # Normalization in a finite constant extension @@ -22,6 +24,8 @@ to `S` is retained for residue-field dimension calculations. The values of both equivalences on pure tensors are recorded explicitly. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -130,9 +134,10 @@ noncomputable def finiteFieldConstantExtensionIntegralClosureAlgEquiv (integralClosure C[X] N)).symm.toRingEquiv.trans e with commutes' := fun s => by apply Subtype.ext - simp [e, finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, - polynomialIntegralClosureBaseChangeAlgEquiv, - TensorProduct.toIntegralClosure] + simp only [AlgEquiv.symm_toRingEquiv, RingEquiv.symm_mk, AlgEquiv.toEquiv_eq_coe, + AlgEquiv.symm_toEquiv_eq_symm, RingEquiv.toEquiv_eq_coe, Algebra.TensorProduct.algebraMap_apply, + Algebra.algebraMap_self, RingHom.id_apply, Equiv.toFun_as_coe, EquivLike.coe_coe, RingEquiv.coe_trans, + RingEquiv.coe_mk, Function.comp_apply, polynomialTensorCancel_symm_tmul, SetLike.coe_eq_coe] change s ⊗ₜ[C] (1 : N) = algebraMap S[X] (S ⊗[C] N) (Polynomial.C s) change s ⊗ₜ[C] (1 : N) = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean index 469051cafd..54a8082ec0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionResidue.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization /-! # Residue degrees after finite constant extension @@ -25,6 +27,8 @@ In particular, `q` is rational over `S` whenever the downstairs residue degree divides `[S : C]`. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean index b2dbb15351..094a39b709 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.Finite.Extension + +public import Mathlib.FieldTheory.Finite.Extension /-! # Nested canonical finite-field extensions @@ -15,6 +17,8 @@ one such embedding and records the scalar-tower and degree consequences used by the constant-extension Hasse--Weil argument. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean index 02166da65d..4870cb13ea 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldInfinityDifferent.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent -import Mathlib.Algebra.Polynomial.Eval.Subring -import Mathlib.Algebra.Polynomial.GroupRingAction -import Mathlib.FieldTheory.Galois.Basic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +public import Mathlib.Algebra.Polynomial.Eval.Subring +public import Mathlib.Algebra.Polynomial.GroupRingAction +public import Mathlib.FieldTheory.Galois.Basic /-! # The different of a finite coefficient extension at infinity @@ -24,6 +26,8 @@ unramifiedness from `C[X] → S[X]`. Consequently the local different of the coefficient extension at infinity is the unit ideal. -/ +@[expose] public section + open scoped Polynomial TensorProduct nonZeroDivisors namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean index 9411cb4e99..eb4e30325a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialDifferent.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.DedekindDomain.Different -import Mathlib.RingTheory.PolynomialAlgebra -import Mathlib.RingTheory.Unramified.Field + +public import Mathlib.RingTheory.DedekindDomain.Different +public import Mathlib.RingTheory.PolynomialAlgebra +public import Mathlib.RingTheory.Unramified.Field /-! # The different of a separable coefficient extension @@ -25,6 +27,8 @@ The final corollary specializes this to arbitrary extensions of finite fields; their finiteness and separability are supplied by typeclass inference. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean index eac3b8fe61..d609215679 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldPolynomialNormalization.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.PolynomialAlgebra -import Mathlib.RingTheory.Smooth.Field -import Mathlib.RingTheory.Smooth.IntegralClosure + +public import Mathlib.RingTheory.PolynomialAlgebra +public import Mathlib.RingTheory.Smooth.Field +public import Mathlib.RingTheory.Smooth.IntegralClosure /-! # Normalization after finite constant extension @@ -20,6 +22,8 @@ specializes it to finite fields: finiteness makes `S / C` finite type, while the perfectness of `C` supplies formal smoothness. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean index 622b2dd2c6..6cf98b3f44 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldSubfield.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.Finite.GaloisField + +public import Mathlib.FieldTheory.Finite.GaloisField /-! # Finite subfields in a common overfield @@ -20,6 +22,8 @@ already supplies `#B` roots of `X ^ (#B) - X`; the polynomial has at most of the image of `A` is another root of the same polynomial. -/ +@[expose] public section + open Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean index 44fdfb4102..82ec1a5a2d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteLinearIndependenceBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.LinearAlgebra.Basis.VectorSpace -import Mathlib.LinearAlgebra.Dimension.StrongRankCondition -import Mathlib.LinearAlgebra.FreeModule.Finite.Basic + +public import Mathlib.LinearAlgebra.Basis.VectorSpace +public import Mathlib.LinearAlgebra.Dimension.StrongRankCondition +public import Mathlib.LinearAlgebra.FreeModule.Finite.Basic /-! # Finite-dimensionality from uniform finite independence bounds @@ -18,6 +20,8 @@ generators. The lemma below packages the standard basis argument converting that uniform bound into finite-dimensionality and a `finrank` estimate. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean index 2634cd5952..ce8202564d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceApproximation.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.DedekindDomain.AdicValuation -import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas -import Mathlib.RingTheory.Localization.Integer -import Mathlib.Tactic + +public import Mathlib.RingTheory.DedekindDomain.AdicValuation +public import Mathlib.RingTheory.DedekindDomain.Ideal.Lemmas +public import Mathlib.RingTheory.Localization.Integer +public import Mathlib.Tactic /-! # Weak approximation at finite places @@ -30,6 +32,8 @@ Mathlib's multiplicative adic valuation is `exp (-order)`. Thus least `n`, while `v.valuation L z ≤ 1` means that `z` is regular at `v`. -/ +@[expose] public section + namespace BGS.HasseWeil open IsDedekindDomain UniqueFactorizationMonoid diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean index 433bd3562f..0187f21c6e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower /-! # Local place actions in a Frobenius fiber @@ -23,6 +25,8 @@ restriction fiber, the stabilizer of a point is identified with the existing decomposition group. -/ +@[expose] public section + open scoped Pointwise Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean index 88019c857e..99a509ebe1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceNormalizationTransport.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree /-! # Transporting normalization ideals to finite places @@ -23,6 +25,8 @@ equivalence with `RatFuncFiniteIntegralClosure S T`; it does not assume the two structures are definitionally equal. -/ +@[expose] public section + open scoped Polynomial open IsDedekindDomain diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean index 44ac167393..4599af731f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra -import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration -import Mathlib.LinearAlgebra.Dimension.Constructions + +public import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +public import Mathlib.LinearAlgebra.Dimension.Constructions /-! # Finite principal parts @@ -28,6 +30,8 @@ identifies that regular subspace with the constants, the quotient by constants embeds in this finite-dimensional principal-parts space. -/ +@[expose] public section + namespace BGS.HasseWeil open Submodule diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean index d5c62297a7..6c1c00914f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinsuppWeightedFiber.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount /-! # Weighted degree cancellation over finite-support fibers @@ -15,6 +17,8 @@ nonzero downstairs coefficient forces every point in its fiber into the finite upstairs support, so the relevant fiber can be counted there. -/ +@[expose] public section + namespace Finsupp /-- Weighted form of the constant-extension degree cancellation. Suppose diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean index 3fa4e1592c..9f9deb85c7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.GroupTheory.GroupAction.Quotient -import Mathlib.GroupTheory.Index -import Mathlib.SetTheory.Cardinal.Finite + +public import Mathlib.GroupTheory.GroupAction.Quotient +public import Mathlib.GroupTheory.Index +public import Mathlib.SetTheory.Cardinal.Finite /-! # Fixed-point averaging for finite transitive actions @@ -15,6 +17,8 @@ This file isolates the Burnside-counting identity used in the fixed-field part of the Hasse--Weil argument. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped BigOperators diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean index ae9ca14226..304db8ec48 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaConstantExtensionIdentity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness /-! # Formal zeta identity under a constant extension @@ -25,6 +27,8 @@ derivative series and then applies the already proved uniqueness theorem for normalized formal differential equations. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean index b265e9f60d..3673c5512a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOne.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality -import Mathlib.RingTheory.PowerSeries.Substitution + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +public import Mathlib.RingTheory.PowerSeries.Substitution /-! # An ordinary-extension specialization of the degree-index argument @@ -31,6 +33,8 @@ not used to close the geometric F. K. Schmidt argument. The noncircular indexed-to-indexed theorem is in `FormalZetaDegreeIndexOneIndexed`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean index 23b94181e9..bf5e50488e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaDegreeIndexOneIndexed.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne /-! # The noncircular indexed F. K. Schmidt argument @@ -26,6 +28,8 @@ zero there when `P(1) ≠ 0`. This contradiction proves `d = 1` without assuming the conclusion for the constant extension. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean index 544b186f75..e88b56e6fb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEuler.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness /-! # Euler recurrences for a formal effective-divisor zeta series @@ -21,6 +23,8 @@ turns the two explicit coefficient identities into either the indexed or the standard polynomial zeta numerator. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean index 8ab342d8d6..838df65eb0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree /-! # Euler composition with numerator-degree bounds @@ -15,6 +17,8 @@ degree bounds. It is the degree-aware version of the compositions in `FormalZetaEuler`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean index fa459a508f..e4a3e8e12e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace /-! # The Hasse bound from formal zeta rationality @@ -20,6 +22,8 @@ does not construct the zeta numerator or prove the geometric extension-point estimate. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean index 3a890381e8..d6f49b1e7c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationality.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace -import Mathlib.RingTheory.PowerSeries.Trunc + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace +public import Mathlib.RingTheory.PowerSeries.Trunc /-! # Formal zeta rationality from an eventual coefficient recurrence @@ -19,6 +21,8 @@ therefore an actual polynomial numerator. No geometric or point-count hypothesis is used here. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean index 596e6cc468..48cac779f6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaRationalityDegree.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality /-! # Degree bounds in formal zeta rationality @@ -14,6 +16,8 @@ as a finite truncation. This file exposes the resulting degree bound, which is needed to turn a Riemann--Roch threshold into a uniform Hasse coefficient. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean index 82ce7d285b..de4633380a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral -import Mathlib.RingTheory.PowerSeries.Derivative -import Mathlib.RingTheory.PowerSeries.Exp -import Mathlib.RingTheory.PowerSeries.Inverse -import Mathlib.RingTheory.PowerSeries.Substitution -import Mathlib.RingTheory.PowerSeries.WellKnown + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral +public import Mathlib.RingTheory.PowerSeries.Derivative +public import Mathlib.RingTheory.PowerSeries.Exp +public import Mathlib.RingTheory.PowerSeries.Inverse +public import Mathlib.RingTheory.PowerSeries.Substitution +public import Mathlib.RingTheory.PowerSeries.WellKnown /-! # Formal logarithmic derivatives of zeta functions @@ -18,6 +20,8 @@ Recover point-count coefficients from logarithmic derivatives of formal zeta ser linear factors. -/ +@[expose] public section + namespace BGS.HasseWeil open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean index 73f992d930..ca74fdc1d3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaUniqueness.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace /-! # Uniqueness of a normalized formal point-count zeta series @@ -19,6 +21,8 @@ coefficient identity for an effective-divisor zeta series: that series is the canonical exponential `formalPointCountZeta`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean index 7a5ffcf660..b73471ee6d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber /-! # Cardinalities of Frobenius place stabilizers @@ -29,6 +31,8 @@ decomposition groups and then in the restriction-fiber actions used by `sum_card_fixedBy_quotientFiber_eq_card_ker_of_stabilizer_card`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean index bfcdbf4323..d03725445a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction -import Mathlib.FieldTheory.Finite.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction +public import Mathlib.FieldTheory.Finite.Basic +public import Mathlib.Tactic /-! # Frobenius restriction over a finite constant field @@ -23,6 +25,8 @@ the principal-divisor and pole-budget identities needed by the Stepanov restriction argument. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean index b006625c31..18e85489b7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusTwistGroup.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.GroupTheory.SpecificGroups.Cyclic + +public import Mathlib.GroupTheory.SpecificGroups.Cyclic /-! # Cyclic subgroups generated by Frobenius twists @@ -19,6 +21,8 @@ trivially, and that cyclic subgroup has the expected cardinality. These are the group-theoretic inputs for taking fixed fields of Frobenius twists. -/ +@[expose] public section + namespace BGS.HasseWeil section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean index a8bfc764b1..e91e042856 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantExtension.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField -import Mathlib.FieldTheory.LinearDisjoint -import Mathlib.RingTheory.Flat.Basic -import Mathlib.RingTheory.Localization.BaseChange -import Mathlib.RingTheory.TensorProduct.MvPolynomial -import Mathlib.RingTheory.TensorProduct.Quotient + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +public import Mathlib.FieldTheory.LinearDisjoint +public import Mathlib.RingTheory.Flat.Basic +public import Mathlib.RingTheory.Localization.BaseChange +public import Mathlib.RingTheory.TensorProduct.MvPolynomial +public import Mathlib.RingTheory.TensorProduct.Quotient /-! # Constant extensions of plane-curve function fields @@ -27,6 +29,8 @@ equivalence for the plane-curve coordinate ring. No Galois, Frobenius, place, or point-counting assertion is made here. -/ +@[expose] public section + open scoped TensorProduct nonZeroDivisors namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean index d7d56a749b..795f991155 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import Mathlib.FieldTheory.Finite.GaloisField + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import Mathlib.FieldTheory.Finite.GaloisField /-! # The algebraic constant field of a finite function field @@ -21,6 +23,8 @@ height-one prime is injective on the constant field, because it is a field. Choosing a prime above `(X)` embeds the constants into a finite quotient. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean index e7fc2ea09a..f65647e761 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosure.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower -import Mathlib.FieldTheory.Galois.GaloisClosure -import Mathlib.FieldTheory.IsSepClosed + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +public import Mathlib.FieldTheory.Galois.GaloisClosure +public import Mathlib.FieldTheory.IsSepClosed /-! # A finite Galois closure for a one-variable function field @@ -21,6 +23,8 @@ fixed-field argument. It does not identify the algebraic constant field of the closure or construct any Frobenius complements. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean index 9344b60846..3a4987f82c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstantBase.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient /-! # The constant-base field inside the function-field normal closure @@ -22,6 +24,8 @@ constant-extension and Frobenius-quotient theorems can therefore be applied directly to the normal closure used by the Hasse--Weil proof. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -141,6 +145,7 @@ noncomputable def functionFieldNormalClosureConstantExtensionAutMulEquiv : (FunctionFieldNormalClosure K L) S (functionFieldNormalClosureConstantField_isExact K L) +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The specialized constant quotient is onto. -/ theorem functionFieldNormalClosureConstantExtensionQuotient_surjective : let := exactConstantExtensionBaseAlgebra diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean index 94c05eb90d..84556d8f4c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField /-! # Constants and restriction for the function-field Galois closure @@ -20,6 +22,8 @@ is algebraic over `K`, the exact constant-field theorem for `K(t)` puts it in `K`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index 7fe6d29dda..1ce1a67913 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension /-! # The original function field after enlarging the normal-closure constants @@ -22,6 +24,8 @@ two structural facts needed downstream: `N / CF` is finite Galois and `C` is the exact constant field of `CF`. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -74,6 +78,7 @@ noncomputable def functionFieldNormalClosureOriginalMultiplication : ((functionFieldToNormalClosure K F).restrictScalars K) (fun _ _ => Commute.all _ _) +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) F] in @[simp] theorem functionFieldNormalClosureOriginalMultiplication_tmul (c : FunctionFieldNormalClosureConstantField K F) (x : F) : @@ -117,6 +122,7 @@ theorem functionFieldNormalClosureConstant_mem_originalCompositum (FunctionFieldNormalClosureConstantField K F) hExact exact ⟨c ⊗ₜ[K] (1 : F), by simp⟩ +omit [DecidableEq (RatFunc K)] in /-- The original rational-function field belongs to `CF`. -/ theorem functionFieldNormalClosureRatFunc_mem_originalCompositum (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean index 4daad20b99..819c64340d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalField.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure /-! # The original field inside its chosen normal closure @@ -17,6 +19,8 @@ the tautological algebra equivalence with the original presentation, and transports exact constants and rational-place counts across it. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -74,6 +78,7 @@ local instance originalFieldImageConstantTower : (R := K) (S := RatFunc K) (A := FunctionFieldNormalClosureOriginalField K F) rfl +omit [FiniteDimensional (RatFunc K) F] in /-- Exactness of the constant field is unchanged when the original function field is replaced by its embedded image in the normal closure. -/ theorem functionFieldNormalClosureOriginalField_algebraicClosure_eq_bot diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean index a1637daa60..6d0ae552c2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension -import Mathlib.FieldTheory.RatFunc.AsPolynomial + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +public import Mathlib.FieldTheory.RatFunc.AsPolynomial /-! # The rational-function constant base of the normal closure @@ -18,6 +20,8 @@ This is the Galois-theoretic identification of that fixed field with the constant extension `C(t)`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -48,6 +52,7 @@ def functionFieldNormalClosureConstantCompositum : IntermediateField.adjoin (RatFunc K) (Set.range (fun c : FunctionFieldNormalClosureConstantField K L => c.1)) +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) L] in /-- The subgroup fixing the constant compositum is precisely the kernel of restriction to the algebraic constant field. -/ theorem functionFieldNormalClosureConstantCompositum_fixingSubgroup : @@ -101,6 +106,7 @@ noncomputable instance functionFieldNormalClosureConstantBase_constantTower : ext k rfl +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) L] in /-- The original parameter remains transcendental after adjoining all algebraic constants of the normal closure. -/ theorem functionFieldNormalClosureConstantBaseX_transcendental : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean index 8ea194a763..829934e347 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase /-! # The rational-function equivalence for the normal-closure constant base @@ -14,12 +16,15 @@ This file packages the generation theorem from between `C(t)` and the kernel fixed field. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section -private noncomputable def ratFuncEquivOfAdjoinEqTop +/-- A field generated by one transcendental element is a rational function field. -/ +noncomputable def ratFuncEquivOfAdjoinEqTop {C B : Type*} [Field C] [Field B] [Algebra C B] (x : B) (hx : Transcendental C x) (hgen : IntermediateField.adjoin C ({x} : Set B) = ⊤) : @@ -34,10 +39,6 @@ private noncomputable def ratFuncEquivOfAdjoinEqTop ratFuncEquivOfAdjoinEqTop x hx hgen RatFunc.X = x := by simp [ratFuncEquivOfAdjoinEqTop] -@[reducible] private noncomputable def ratFuncSelfAlgebra - (C : Type*) [Field C] : Algebra C (RatFunc C) := - RatFunc.instAlgebraOfPolynomial C C - variable (K L : Type*) [Field K] [Field L] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra (RatFunc K) L] @@ -47,7 +48,8 @@ variable (K L : Type*) [Field K] [Field L] local instance functionFieldNormalClosureConstantFieldRatFuncAlgebra : Algebra (FunctionFieldNormalClosureConstantField K L) (RatFunc (FunctionFieldNormalClosureConstantField K L)) := - ratFuncSelfAlgebra (FunctionFieldNormalClosureConstantField K L) + RatFunc.instAlgebraOfPolynomial (FunctionFieldNormalClosureConstantField K L) + (FunctionFieldNormalClosureConstantField K L) /-- The kernel fixed field is canonically the rational function field over the exact constant field, with the original parameter corresponding to `X`. diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean index 3a5690bfbc..071b2efa13 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage -import Mathlib.Algebra.CharP.Defs -import Mathlib.Algebra.Order.Star.Real -import Mathlib.Analysis.Asymptotics.Defs -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +public import Mathlib.Algebra.CharP.Defs +public import Mathlib.Algebra.Order.Star.Real +public import Mathlib.Analysis.Asymptotics.Defs +public import Mathlib.Tactic /-! # The finite averaging step in the Corvaja--Zannier Hasse--Weil argument @@ -19,6 +21,8 @@ elementary lemma below converts those facts into a two-sided bound for each individual twist. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped BigOperators @@ -118,7 +122,7 @@ when the family cardinality is fixed. -/ theorem abs_base_sub_center_le_of_average_and_pointwise {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] (x : ι → ℝ) (base center A B : ℝ) - (hA : 0 ≤ A) (hB : 0 ≤ B) + (_hA : 0 ≤ A) (_hB : 0 ≤ B) (haverage : |∑ i, x i - (Fintype.card ι : ℝ) * base| ≤ A) (hpointwise : ∀ i, |x i - center| ≤ B) : |base - center| ≤ A + (Fintype.card ι : ℝ) * B := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean index cf869a5a11..9598c56401 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisTowerFactorialDegree.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.FieldTheory.Galois.Basic + +public import Mathlib.FieldTheory.Galois.Basic /-! # A common factorial degree for Galois groups in a field tower @@ -16,6 +18,8 @@ degree that works simultaneously for the rational base and the original compositum in the Frobenius-twist argument. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean index 70bf193c3e..c9953daf8f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralBivariateAffineHasseWeil.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction /-! # The general affine bivariate Hasse--Weil theorem @@ -22,6 +24,8 @@ hypotheses without changing the affine point count or increasing the supplied bidegree bounds. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean index 5ea516847e..da3b2c1ad2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralFiniteExtensionRiemannLower.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole -import Mathlib.FieldTheory.PrimitiveElement -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +public import Mathlib.FieldTheory.PrimitiveElement +public import Mathlib.Tactic /-! # A coarse Riemann inequality for arbitrary function fields @@ -24,6 +26,8 @@ finite-place approximation theorem then transfers this inequality to every one-point divisor at a finite place. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean index 2c23fcfcae..c4ccf7b681 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCount.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import Mathlib.Tactic /-! # A square-field Stepanov bound for arbitrary function fields @@ -25,6 +27,8 @@ function-field extension, by the fundamental ramification-inertia equality. This gives a uniform estimate suitable for the Frobenius fixed-field twists. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean index 8dfd935327..36f0cebd8f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GeneralSquareFieldStepanovCountAutomatic.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount + +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount /-! # Automatic intrinsic Stepanov bounds @@ -17,6 +19,8 @@ leaving only the explicit large-square-field inequality for the constructed budget. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean index cf1b5c5734..97d109f8eb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/IdealMultiplicityMap.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.RamificationInertia.Ramification + +public import Mathlib.RingTheory.RamificationInertia.Ramification /-! # Multiplicity after extending an ideal @@ -15,6 +17,8 @@ exact-constant genus transport, first for a specified pair of height-one places and then with the lower place chosen by `under`. -/ +@[expose] public section + open IsDedekindDomain namespace BGS.HasseWeil diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean index 4220d78fb5..f4ed9dd221 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LinearFunctionalGluing.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.LinearAlgebra.Basis.VectorSpace -import Mathlib.LinearAlgebra.LinearPMap + +public import Mathlib.LinearAlgebra.Basis.VectorSpace +public import Mathlib.LinearAlgebra.LinearPMap /-! # Gluing and extending linear functionals @@ -16,6 +18,8 @@ of a Weil functional. A functional on a subspace `U` which vanishes on functional then extends to the ambient vector space. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean index 54516965b0..26a89241f0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration -import Mathlib.RingTheory.LocalRing.Length -import Mathlib.RingTheory.LocalRing.Quotient + +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +public import Mathlib.RingTheory.LocalRing.Length +public import Mathlib.RingTheory.LocalRing.Quotient /-! # Cumulative local principal parts @@ -17,6 +19,8 @@ of its maximal ideal. Over a finite constant field its dimension is therefore `n` times the residue-field degree. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped nonZeroDivisors diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean index c00ef8227b..d40d2ab441 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement -import Mathlib.LinearAlgebra.Isomorphisms + +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +public import Mathlib.LinearAlgebra.Isomorphisms /-! # The local pole filtration of a discrete valuation ring @@ -20,6 +22,8 @@ Unlike the corresponding global Riemann-space increment, this calculation is an equality: locally every leading residue has a lift. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped nonZeroDivisors @@ -82,7 +86,7 @@ def localPoleLeadingResidueMap (π : R) (n : ℕ) : localLeadingResidueLinearMap (localPoleSpace (K := K) (L := L) π n) (algebraMap R L (π ^ n)) - (localPoleSpace_regular (K := K) (L := L) π n) + (by exact localPoleSpace_regular (K := K) (L := L) π n) private theorem localPoleNormalizedLift_eq (π : R) (n : ℕ) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean index 2c9e514d2c..530ee24427 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointBase.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting /-! # Finiteness of the height-zero one-point Riemann space @@ -22,6 +24,8 @@ The degree-weighted product formula rules this out unless the difference is zero. Thus the height-zero space injects into a finite residue field. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean index 7bb16b2b41..f6eb061c11 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +public import Mathlib.Tactic /-! # Splitting an effective divisor at one place @@ -16,6 +18,8 @@ one. This file records the elementary divisor identities needed for that comparison. The actual codimension estimate is kept separate. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -34,12 +38,16 @@ def finiteExtensionDivisorAway FiniteExtensionDivisor K L := D - Finsupp.single P (D P) +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionDivisorAway_apply_self (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : finiteExtensionDivisorAway K L D P P = 0 := by simp [finiteExtensionDivisorAway] +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionDivisorAway_apply_of_ne (D : FiniteExtensionDivisor K L) (P v : FiniteExtensionPlace K L) @@ -68,6 +76,7 @@ theorem finiteExtensionDivisorAway_effective simp · simpa [finiteExtensionDivisorAway, hv] using hD v +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The degree of a divisor supported at one place. -/ @[simp] theorem finiteExtensionDivisorDegree_single @@ -108,6 +117,8 @@ theorem finiteExtensionDivisorDegree_away rw [finiteExtensionDivisorAway, finiteExtensionDivisorDegree_sub, finiteExtensionDivisorDegree_single] +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- For an effective divisor, its one-place part is coefficientwise below it. -/ theorem single_coeff_le_of_effective (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean index d3d47bbe85..dda6364111 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointHeight.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting /-! # Heights and zero counts in a one-point Riemann space @@ -20,6 +22,8 @@ bound `height(x) ≤ n * deg(P)`. Combining this with the existing positive-ord place count gives the corresponding Tao-style zero-count estimate. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean index ce879e8f6c..d8c4690859 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointIncrement.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement /-! # Successive growth of one-point Riemann spaces @@ -16,6 +18,8 @@ the degree of `P`. Iterating from `L(0)` also supplies finite-dimensionality at every level of the one-point filtration. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean index f2bd505bdf..ada9018174 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity -import Mathlib.FieldTheory.Finiteness + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +public import Mathlib.FieldTheory.Finiteness /-! # Leading coefficients at a single place @@ -18,6 +20,8 @@ Compare residue-field degrees and lift constant residues through the local rings infinite places. -/ +@[expose] public section + namespace BGS.CorvajaZannier noncomputable section @@ -389,7 +393,7 @@ local instance onePointCancellationInfinityIsFractionRing : IsFractionRing (RatFuncInfinityIntegralClosure K L) L := integralClosure.isFractionRing_of_finite_extension (RatFunc K) L -local instance onePointCancellationInfinityCanonicalFractionAlgebra : +private local instance onePointCancellationInfinityCanonicalFractionAlgebra : Algebra (RatFuncInfinityIntegralClosure K L) (FractionRing (RatFuncInfinityIntegralClosure K L)) := canonicalFractionRingAlgebra (RatFuncInfinityIntegralClosure K L) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean index df8788c6d8..c22659f87f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +public import Mathlib.Tactic /-! # One-point pole-order semigroups -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean index a55d725b0a..bd4db4e09e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointSectionSelection.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants -import Mathlib.Data.Fintype.EquivFin + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +public import Mathlib.Data.Fintype.EquivFin /-! # Selecting one-point sections with distinct pole orders @@ -18,6 +20,8 @@ strict level, and adjoining the constant section, produces a linearly independent family with distinct pole-order digits in a prescribed range. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean index 27df79589c..ee3c1c9dcd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +public import Mathlib.Tactic /-! # One-point Stepanov grids from a full Riemann-space basis @@ -26,6 +28,8 @@ The digits `d i < #K` are distinct, so these orders remain distinct modulo then rules out a nontrivial relation. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean index ec9b04fbc9..6f93a259c1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovDegreeTwoAuxiliary.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +public import Mathlib.Tactic /-! # Stepanov auxiliaries at places of degree at most two @@ -25,6 +27,8 @@ the degree-one construction makes the coefficient dimension exceed the second restriction target for every place degree `r ≤ 2`. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean index 9691e06925..24f298cfea 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +public import Mathlib.Tactic /-! # One-point Stepanov grids @@ -18,6 +20,8 @@ mixed-radix encoding gives the one-point Stepanov grid. The distinguished place is not assumed to have degree one. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -53,6 +57,7 @@ theorem finiteExtensionPrincipalDivisor_smul_apply finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc] simp +omit [Fintype K] [DecidableEq K] in /-- If one summand has strictly smaller order than the other, then the sum is nonzero and has the smaller order. -/ theorem finiteExtensionPrincipalDivisor_add_eq_left_of_lt @@ -89,6 +94,7 @@ theorem finiteExtensionPrincipalDivisor_add_eq_left_of_lt rw [min_eq_left hsumLeY] at hreverse exact ⟨hxy, le_antisymm hreverse hlower⟩ +omit [Fintype K] [DecidableEq K] in /-- If every summand has order strictly above `a`, then their finite sum is either zero or also has order strictly above `a`. -/ theorem finiteExtensionPrincipalDivisor_sum_eq_zero_or_gt @@ -236,6 +242,7 @@ theorem onePointStepanovMixedOrder_injective exact Nat.eq_of_mul_eq_mul_left hs hmul exact Prod.ext rfl (he heEq) +omit [Fintype K] in /-- Exact order of a product in the one-point Stepanov grid. -/ theorem onePointStepanovGrid_order {ι κ : Type*} (P : FiniteExtensionPlace K L) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean index 6b13001a37..98dc500a55 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStrictLevels.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace /-! # Strict levels in one-point filtrations @@ -22,6 +24,8 @@ at every strict level gives a pairwise-distinct family of exact pole orders, with no hypothesis on the degree of the distinguished place. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean index dad1fb37bf..8f041c302a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineCountTransfer.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Order.Star.Real -import Mathlib.Tactic + +public import Mathlib.Algebra.Order.Star.Real +public import Mathlib.Tactic /-! # Numerical transfer from normalization counts to affine counts @@ -16,6 +18,8 @@ cardinalities. This file isolates the real absolute-value bookkeeping needed to combine those inequalities with the closed Hasse--Weil bound. -/ +@[expose] public section + namespace BGS.HasseWeil /-- If the affine and normalization counts differ by at most `error` in both diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean index 14c9c2cfbf..7cb768f830 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineFiberBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization /-! # Elementary affine plane-curve fiber bounds @@ -22,6 +24,8 @@ Hasse--Weil theorem, where a trivial fiber count is stronger than carrying normalization error terms. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -106,6 +110,7 @@ def affinePlaneCurvePointEquivSwap (f : MvPolynomial (Fin 2) K) : apply Subtype.ext rfl +omit [Fintype K] [DecidableEq K] in /-- Coordinate swapping preserves irreducibility. -/ theorem irreducible_swapPlaneCurveCoordinates {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) : @@ -114,6 +119,7 @@ theorem irreducible_swapPlaneCurveCoordinates (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1) f) exact hf.map (MvPolynomial.renameEquiv K (Equiv.swap (0 : Fin 2) 1)) +omit [Fintype K] [DecidableEq K] in /-- After swapping, the second-coordinate degree is the original first-coordinate degree. -/ theorem degreeOf_second_swapPlaneCurveCoordinates diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean index 9d3ffd4eb4..8dc54a0048 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromEvenError.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic /-! # Affine plane Hasse bounds from the even-extension error @@ -19,6 +21,8 @@ comparison. The sole remaining premise is therefore the even constant-field extension error used by the spectral argument. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean index 57ed558f29..396f550668 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineHasseWeilFromZeta.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality -import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +public import Mathlib.Tactic /-! # Affine plane Hasse bounds from the standard zeta package @@ -25,6 +27,8 @@ the separating-coordinate restriction without losing the original bidegree scale, remain separate upstream tasks. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean index bc9a58c2ef..96c0383ddb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneAffineRationalPlaceComparison.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +public import Mathlib.Tactic /-! # Affine plane points and rational normalization places @@ -20,6 +22,8 @@ rational finite places, and adding the explicit critical locus compares all affine rational points with the full rational-place count. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean index 6371619eec..da10416f8b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneConstantField.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge -import Mathlib.FieldTheory.RatFunc.Luroth + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +public import Mathlib.FieldTheory.RatFunc.Luroth /-! # Constants in an absolutely irreducible plane-curve function field @@ -20,6 +22,8 @@ of the second coordinate over the first-coordinate rational subfield. No geometric Hasse--Weil statement is assumed here. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean index c42794d9b7..af2b9aed73 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting -import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +public import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +public import Mathlib.Tactic /-! # A controlled pole place for the first plane coordinate @@ -21,6 +23,8 @@ nontrivial) place degree is bounded by that second-variable degree. No rationality assertion is made about the selected place. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -108,6 +112,7 @@ theorem finiteExtensionDivisorDegree_planeCurveFirstCoordinate_poleDivisor rw [finiteExtensionDivisorDegree_poleDivisor, finiteExtensionHeight_planeCurveFirstCoordinate hf hpartialSecond] +omit [Fintype K] in /-- A positive coefficient of an effective divisor contributes at least the degree of its place to the total divisor degree. -/ theorem finiteExtensionPlaceDegree_le_divisorDegree_of_effective_of_pos diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean index 2260b6e45c..56a7fe29d4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole /-! # The first plane coordinate only has poles above infinity @@ -19,6 +21,8 @@ pole place shows that the selected pole may be taken above the rational- function place at infinity, without changing its place-degree bound. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean index d0ba87d7b1..3938df2e92 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinateShear.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import Mathlib.Algebra.MvPolynomial.Monad -import Mathlib.Algebra.MvPolynomial.PDeriv -import Mathlib.RingTheory.MvPolynomial.Expand + +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import Mathlib.Algebra.MvPolynomial.Monad +public import Mathlib.Algebra.MvPolynomial.PDeriv +public import Mathlib.RingTheory.MvPolynomial.Expand /-! # A separating coordinate shear for affine plane curves @@ -24,6 +26,8 @@ argument that an absolutely irreducible nonconstant polynomial cannot be a polynomial in `x^p` and `y^p`. -/ +@[expose] public section + namespace BGS.HasseWeil open MvPolynomial diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean index 11404867f2..359114365f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundAutomatic.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower /-! # Automatic bidegree genus bound for plane curves @@ -24,6 +26,8 @@ The finite place needed by the one-point comparison is constructed above the prime `(X)` of `K[X]`, so it is not an additional hypothesis. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -56,6 +60,7 @@ local instance automaticGenusPolynomialTorsionFree : Module.IsTorsionFree.trans_faithfulSMul K[X] (RatFunc K) L omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in +omit [FiniteDimensional (RatFunc K) L] in /-- A finite separable extension of `K(X)` has an exhaustive finite place. We select a prime of the finite integral closure lying above `(X)`. -/ theorem finiteExtensionFinitePlace_nonempty : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean index d179763198..90b19ce6cb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotrace.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField /-! # Plane-curve genus bound from direct cotrace canonicality @@ -17,6 +19,8 @@ divisor therefore gives the intrinsic genus bound without a separately assumed Riemann--Hurwitz degree identity. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean index 47a5fadc79..37145ae49b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCurveGenusBoundFromCotraceDegree.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField /-! # Plane-curve genus bound from the cotrace divisor @@ -17,6 +19,8 @@ the intrinsic genus bound to the Riemann--Hurwitz degree identity for the canonical-different divisor. The identity remains a visible premise here. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean index 49cb209679..f7221be7fd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFinitePlaceRiemannLower.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts +public import Mathlib.Tactic /-! # Riemann's inequality at finite plane-curve places @@ -24,6 +26,8 @@ increment upper bound then cancel the auxiliary infinity divisor. This gives Riemann's inequality for `L(N q)` at every finite exhaustive place. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean index 0cfb3456ff..502f387a3f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDeflation.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear -import Mathlib.Algebra.MvPolynomial.Equiv -import Mathlib.Algebra.Polynomial.Expand -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Algebra.Polynomial.Expand +public import Mathlib.Tactic /-! # Frobenius deflation for affine plane curves @@ -24,6 +26,8 @@ coordinate degree, and it strictly lowers the actual first coordinate degree whenever that degree is positive. -/ +@[expose] public section + namespace BGS.HasseWeil open MvPolynomial @@ -275,6 +279,7 @@ variable (p : ℕ) [Fact p.Prime] [CharP K p] def planeFirstFrobeniusPointEquiv : K × K ≃ K × K := (frobeniusEquiv K p).toEquiv.prodCongr (Equiv.refl K) +omit [DecidableEq K] in @[simp] theorem planeFirstFrobeniusPointEquiv_apply (z : K × K) : planeFirstFrobeniusPointEquiv K p z = (z.1 ^ p, z.2) := by rcases z with ⟨x, y⟩ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean index 717012d6cc..d62e5ff0e7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusDegenerate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation /-! # The zero-coordinate-degree case of Frobenius reduction @@ -17,6 +19,8 @@ the original field and its affine plane zero set has exactly one point above each value of the absent coordinate. -/ +@[expose] public section + namespace BGS.HasseWeil open MvPolynomial diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean index 5a27bcc02e..9e4ffe171f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate /-! # Closed Frobenius reduction for affine plane curves @@ -17,6 +19,8 @@ same-count equation with both coordinate partial derivatives nonzero and no larger supplied bidegree bounds. -/ +@[expose] public section + namespace BGS.HasseWeil open MvPolynomial @@ -84,11 +88,11 @@ theorem hasBidegreeAtMost_planeSwapAlgEquiv have hd := hdegree n hn have hzero : Finsupp.mapDomain (Equiv.swap (0 : Fin 2) 1) n 0 = n 1 := by - simpa using Finsupp.mapDomain_apply + simp using Finsupp.mapDomain_apply (Equiv.swap (0 : Fin 2) 1).injective n (1 : Fin 2) have hone : Finsupp.mapDomain (Equiv.swap (0 : Fin 2) 1) n 1 = n 0 := by - simpa using Finsupp.mapDomain_apply + simp using Finsupp.mapDomain_apply (Equiv.swap (0 : Fin 2) 1).injective n (0 : Fin 2) simpa [hzero, hone] using And.intro hd.2 hd.1 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean index 086389d933..8ed73f366a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneInfinityRiemannLower.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +public import Mathlib.Tactic /-! # Riemann's inequality for divisors supported above infinity @@ -21,6 +23,8 @@ degree, so the same inequality descends to the original infinity-supported divisor. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -34,6 +38,8 @@ variable (L : Type*) [Field L] [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- An effective divisor supported above infinity is dominated by a natural multiple of any effective divisor that is positive at every infinity place. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean index d256a1759c..feac01abd0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneMonomialSpace.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve -import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor -import Mathlib.Algebra.Polynomial.Basis -import Mathlib.LinearAlgebra.Dimension.Constructions -import Mathlib.RingTheory.AlgebraTower -import Mathlib.RingTheory.Finiteness.Basic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +public import Mathlib.Algebra.Polynomial.Basis +public import Mathlib.LinearAlgebra.Dimension.Constructions +public import Mathlib.RingTheory.AlgebraTower +public import Mathlib.RingTheory.Finiteness.Basic /-! # Plane monomial spaces for the Stepanov construction @@ -32,6 +34,8 @@ are independent over the constant field. No Frobenius endomorphism is introduced or assumed. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean index 93aac3827e..11f357ec9e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels /-! # One-point Riemann-space lower bounds for plane curves @@ -32,6 +34,8 @@ exact constant field to force at least `m - g` strict levels in the one-point Riemann filtration, where `g` is the displayed bidegree budget. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean index ea8dfdc1f6..c885705746 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount -import Mathlib.Algebra.Polynomial.RingDivision -import Mathlib.NumberTheory.RamificationInertia.Basic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +public import Mathlib.Algebra.Polynomial.RingDivision +public import Mathlib.NumberTheory.RamificationInertia.Basic /-! # Rational normalization places and affine exceptional fibers @@ -29,6 +31,8 @@ not detect degree drop after specialization, especially in positive characteristic. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil @@ -39,7 +43,8 @@ open BGS.CorvajaZannier Polynomial variable (K : Type*) [Field K] [DecidableEq K] -private def linearNormalizedPrime (a : K) : NormalizedPrimePolynomial K := +/-- The normalized prime polynomial corresponding to the affine coordinate `a`. -/ +def linearNormalizedPrime (a : K) : NormalizedPrimePolynomial K := ⟨Polynomial.X - Polynomial.C a, Polynomial.prime_X_sub_C a, (Polynomial.monic_X_sub_C a).normalize_eq_self⟩ @@ -787,17 +792,17 @@ noncomputable def planeCurveGoodRationalFinitePlaceCenter have hb : algebraMap K m.ResidueField b = algebraMap V m.ResidueField yv := Classical.choose_spec (hresidue (algebraMap V m.ResidueField yv)) - refine ⟨(a, b), ?_⟩ - apply eval_pair_eq_zero_of_residue V m f xv yv a b ha hb - rw [hxv] - change MvPolynomial.eval₂ (algebraMap K E) - ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 - have hcoordinates : planeCurveFunction f = - ![planeCurveFunction f 0, planeCurveFunction f 1] := by - funext i - fin_cases i <;> rfl - rw [← hcoordinates] - exact eval₂_planeCurveFunction_eq_zero f + exact ⟨(a, b), by + apply eval_pair_eq_zero_of_residue V m f xv yv a b ha hb + rw [hxv] + change MvPolynomial.eval₂ (algebraMap K E) + ![planeCurveFunction f 0, planeCurveFunction f 1] f = 0 + have hcoordinates : planeCurveFunction f = + ![planeCurveFunction f 0, planeCurveFunction f 1] := by + funext i + fin_cases i <;> rfl + rw [← hcoordinates] + exact eval₂_planeCurveFunction_eq_zero f⟩ omit [Fintype K] in /-- The first coordinate of the affine residue center is the base coordinate diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean index 4bdafd794a..2fdde5e4f1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRegularPointCount.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +public import Mathlib.Tactic /-! # Regular affine points in the second-coordinate direction @@ -21,6 +23,8 @@ This file contains only the finite-set bookkeeping. The local normalization statement and the Stepanov zero count are proved in separate modules. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean index 8fe71a1a34..81474b806f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +public import Mathlib.Tactic /-! # A coarse affine singular-point bound for plane curves @@ -26,6 +28,8 @@ root and fiber counts then bound all affine singular points by `((2 * secondDegree - 1) * firstDegree) * secondDegree`. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section @@ -81,7 +85,7 @@ theorem secondCoordinateCriticalResultant_natDegree_le Polynomial.natDegree_mul_le _ ≤ firstDegree + 0 := Nat.add_le_add (hFcoeff (i + 1)) (by - simpa using + simp using (Polynomial.natDegree_natCast (R := K) (i + 1)).le) _ = firstDegree := Nat.add_zero _ have hresultant := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean index 11b05719af..396a56c6b1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean @@ -3,15 +3,17 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import Mathlib.RingTheory.DiscreteValuationRing.TFAE -import Mathlib.RingTheory.Smooth.StandardSmoothCotangent -import Mathlib.RingTheory.Localization.LocalizationLocalization -import Mathlib.LinearAlgebra.TensorProduct.Basis -import Mathlib.RingTheory.Etale.Field -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import Mathlib.RingTheory.DiscreteValuationRing.TFAE +public import Mathlib.RingTheory.Smooth.StandardSmoothCotangent +public import Mathlib.RingTheory.Localization.LocalizationLocalization +public import Mathlib.LinearAlgebra.TensorProduct.Basis +public import Mathlib.RingTheory.Etale.Field +public import Mathlib.Tactic /-! # Smooth affine centres and normalization residue fields @@ -33,6 +35,8 @@ a quadratic-extension point is exactly non-membership of that derivative in the corresponding affine maximal ideal. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean index 3303a3854d..9928dca4b0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCount.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +public import Mathlib.Tactic /-! # A conditional square-field Stepanov bound for plane curves @@ -32,6 +34,8 @@ normalization input that must later be discharged by the local smooth-point theorem; no degree-one assertion is made for arbitrary singular points. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean index 1a2486adfd..f4f4709e19 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSquareFieldStepanovCountAutomatic.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount +public import Mathlib.Tactic /-! # The square-field Stepanov bound on the smooth affine chart @@ -22,6 +24,8 @@ hypotheses. The resulting error term is honestly `(2 * genusBudget + 1) * constant is claimed here. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean index 21ad5e3891..6c9c1799c9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneStepanovAuxiliary.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters /-! # The degree-one plane Stepanov auxiliary @@ -33,6 +35,8 @@ theorem. This module does **not** assert that the controlled infinity place has degree one, and it does not count square-extension points. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean index 7837026494..9f67bce2b4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace /-! # Pole divisors in the exhaustive finite-extension place model @@ -17,6 +19,8 @@ it makes the original function a section, and identifies its divisor degree with the existing height. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -45,6 +49,7 @@ def finiteExtensionPoleDivisor (x : L) : FiniteExtensionDivisor K L := let D := finiteExtensionPrincipalDivisor K L x exact -(D.filter (fun v => D v < 0)) +omit [Fintype K] [DecidableEq K] in @[simp] theorem finiteExtensionPoleDivisor_apply (x : L) (v : FiniteExtensionPlace K L) : @@ -79,6 +84,7 @@ theorem mem_finiteExtensionRiemannSpace_poleDivisor exact Or.inr ⟨hx, finiteExtensionPrincipal_add_poleDivisor_effective K L x⟩ +omit [Fintype K] in /-- The degree of the pole divisor is the previously defined pole height. -/ theorem finiteExtensionDivisorDegree_poleDivisor (x : L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean index e60670b234..ec97e8defd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialSpectral.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace -import Mathlib.Analysis.Complex.Polynomial.Basic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace +public import Mathlib.Analysis.Complex.Polynomial.Basic /-! # Spectral parameters from a zeta numerator @@ -21,6 +23,8 @@ numerator and its logarithmic-derivative point-count identity. No spectral norm estimate is used here. -/ +@[expose] public section + namespace BGS.HasseWeil open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean index 0b5cfaf1de..cfef0de24b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PolynomialTensorCancel.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Polynomial.AlgebraMap -import Mathlib.RingTheory.PolynomialAlgebra -import Mathlib.RingTheory.TensorProduct.Maps + +public import Mathlib.Algebra.Polynomial.AlgebraMap +public import Mathlib.RingTheory.PolynomialAlgebra +public import Mathlib.RingTheory.TensorProduct.Maps /-! # Cancelling a polynomial ring in a tensor product @@ -21,6 +23,8 @@ equivalence and records its values on pure tensors in both directions. -/ +@[expose] public section + open scoped Polynomial TensorProduct namespace BGS.HasseWeil @@ -45,16 +49,15 @@ local instance coefficientPolynomialTower : IsScalarTower C C[X] S[X] := intro c simp [Polynomial.algebraMap_def]) -private abbrev PolynomialTensor := TensorProduct C[X] S[X] A -private abbrev ConstantTensor := TensorProduct C S A /-- The image of the polynomial variable in the constant tensor product. -/ noncomputable def polynomialTensorCancelEvaluationPoint : TensorProduct C S A := Algebra.TensorProduct.includeRight (algebraMap C[X] A Polynomial.X) -private noncomputable def constantTensorPolynomialAlgHom : - C[X] →ₐ[C] ConstantTensor C S A := +/-- Evaluate base polynomials in the constant tensor product. -/ +noncomputable def constantTensorPolynomialAlgHom : + C[X] →ₐ[C] (TensorProduct C S A) := Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S A) /-- The `C[X]`-algebra structure on `S ⊗[C] A` obtained by evaluating `X` @@ -65,7 +68,7 @@ noncomputable def polynomialTensorCancelTargetPolynomialAlgebra : (constantTensorPolynomialAlgHom C S A).toAlgebra local instance constantTensorPolynomialAlgebra : - Algebra C[X] (ConstantTensor C S A) := + Algebra C[X] ((TensorProduct C S A)) := polynomialTensorCancelTargetPolynomialAlgebra C S A /-- The `S[X]`-algebra structure on `S ⊗[C] A` obtained by evaluating `X` @@ -77,11 +80,11 @@ noncomputable def polynomialTensorCancelTargetPolynomialExtensionAlgebra : (polynomialTensorCancelEvaluationPoint C S A)).toAlgebra local instance constantTensorPolynomialExtensionAlgebra : - Algebra S[X] (ConstantTensor C S A) := + Algebra S[X] ((TensorProduct C S A)) := polynomialTensorCancelTargetPolynomialExtensionAlgebra C S A local instance constantTensorPolynomialTower : - IsScalarTower C C[X] (ConstantTensor C S A) := + IsScalarTower C C[X] ((TensorProduct C S A)) := IsScalarTower.of_algebraMap_eq' (by apply RingHom.ext intro c @@ -91,11 +94,11 @@ local instance constantTensorPolynomialTower : private theorem includeRight_algebraMap_polynomial (p : C[X]) : (Algebra.TensorProduct.includeRight : - A →ₐ[C] ConstantTensor C S A) (algebraMap C[X] A p) = + A →ₐ[C] (TensorProduct C S A)) (algebraMap C[X] A p) = constantTensorPolynomialAlgHom C S A p := by have h : (Algebra.TensorProduct.includeRight : - A →ₐ[C] ConstantTensor C S A).comp + A →ₐ[C] (TensorProduct C S A)).comp (IsScalarTower.toAlgHom C C[X] A) = constantTensorPolynomialAlgHom C S A := by ext @@ -104,14 +107,16 @@ private theorem includeRight_algebraMap_polynomial (p : C[X]) : simpa [Polynomial.algebraMap_def, coefficientPolynomialAlgHom] using DFunLike.congr_fun h p -private noncomputable def rightFactorToConstantTensor : - A →ₐ[C[X]] ConstantTensor C S A where +/-- Include the algebra factor in the constant tensor product over the polynomial base. -/ +noncomputable def rightFactorToConstantTensor : + A →ₐ[C[X]] (TensorProduct C S A) where __ := (Algebra.TensorProduct.includeRight : - A →ₐ[C] ConstantTensor C S A).toRingHom - commutes' := includeRight_algebraMap_polynomial C S A + A →ₐ[C] (TensorProduct C S A)).toRingHom + commutes' := by exact includeRight_algebraMap_polynomial C S A -private noncomputable def leftFactorToConstantTensorOverS : - S[X] →ₐ[S] ConstantTensor C S A := +/-- Evaluate coefficient polynomials in the constant tensor product. -/ +noncomputable def leftFactorToConstantTensorOverS : + S[X] →ₐ[S] (TensorProduct C S A) := Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S A) omit [IsScalarTower C C[X] A] in @@ -128,41 +133,47 @@ private theorem leftFactorToConstantTensor_compatible (p : C[X]) : polynomialTensorCancelEvaluationPoint, coefficientPolynomialAlgHom] exact DFunLike.congr_fun h p -private noncomputable def leftFactorToConstantTensor : - S[X] →ₐ[C[X]] ConstantTensor C S A where +/-- Evaluate coefficient polynomials as an algebra map over the polynomial base. -/ +noncomputable def leftFactorToConstantTensor : + S[X] →ₐ[C[X]] (TensorProduct C S A) where __ := (leftFactorToConstantTensorOverS C S A).toRingHom - commutes' := leftFactorToConstantTensor_compatible C S A + commutes' := by exact leftFactorToConstantTensor_compatible C S A -private noncomputable def polynomialTensorToConstantTensorOverPolynomial : - PolynomialTensor C S A →ₐ[C[X]] ConstantTensor C S A := +/-- Cancel polynomial base change as an algebra homomorphism over the base polynomial ring. -/ +noncomputable def polynomialTensorToConstantTensorOverPolynomial : + (TensorProduct C[X] S[X] A) →ₐ[C[X]] (TensorProduct C S A) := Algebra.TensorProduct.lift (leftFactorToConstantTensor C S A) (rightFactorToConstantTensor C S A) (fun _ _ ↦ Commute.all _ _) -private noncomputable def polynomialTensorToConstantTensor : - PolynomialTensor C S A →ₐ[S] ConstantTensor C S A where +/-- Cancel polynomial base change as an algebra homomorphism over the coefficient ring. -/ +noncomputable def polynomialTensorToConstantTensor : + (TensorProduct C[X] S[X] A) →ₐ[S] (TensorProduct C S A) where __ := (polynomialTensorToConstantTensorOverPolynomial C S A).toRingHom commutes' s := by change polynomialTensorToConstantTensorOverPolynomial C S A ((Algebra.TensorProduct.includeLeft : - S[X] →ₐ[S] PolynomialTensor C S A) (Polynomial.C s)) = - algebraMap S (ConstantTensor C S A) s + S[X] →ₐ[S] (TensorProduct C[X] S[X] A)) (Polynomial.C s)) = + algebraMap S ((TensorProduct C S A)) s simp [polynomialTensorToConstantTensorOverPolynomial, leftFactorToConstantTensor, leftFactorToConstantTensorOverS] -private noncomputable def constantsToPolynomialTensor : - S →ₐ[S] PolynomialTensor C S A := +/-- Include coefficient scalars in the polynomial tensor product. -/ +noncomputable def constantsToPolynomialTensor : + S →ₐ[S] (TensorProduct C[X] S[X] A) := (Algebra.TensorProduct.includeLeft : - S[X] →ₐ[S] PolynomialTensor C S A).comp Polynomial.CAlgHom + S[X] →ₐ[S] (TensorProduct C[X] S[X] A)).comp Polynomial.CAlgHom -private noncomputable def rightFactorToPolynomialTensor : - A →ₐ[C] PolynomialTensor C S A := +/-- Include the algebra factor in the polynomial tensor product over the constant base. -/ +noncomputable def rightFactorToPolynomialTensor : + A →ₐ[C] (TensorProduct C[X] S[X] A) := (Algebra.TensorProduct.includeRight : - A →ₐ[C[X]] PolynomialTensor C S A).restrictScalars C + A →ₐ[C[X]] (TensorProduct C[X] S[X] A)).restrictScalars C -private noncomputable def constantTensorToPolynomialTensor : - ConstantTensor C S A →ₐ[S] PolynomialTensor C S A := +/-- Extend constant tensors to the polynomial tensor product. -/ +noncomputable def constantTensorToPolynomialTensor : + (TensorProduct C S A) →ₐ[S] (TensorProduct C[X] S[X] A) := Algebra.TensorProduct.lift (constantsToPolynomialTensor C S A) (rightFactorToPolynomialTensor C S A) @@ -172,7 +183,7 @@ private theorem constantTensorToPolynomialTensor_comp_leftFactor : (constantTensorToPolynomialTensor C S A).comp (leftFactorToConstantTensorOverS C S A) = (Algebra.TensorProduct.includeLeft : - S[X] →ₐ[S] PolynomialTensor C S A) := by + S[X] →ₐ[S] (TensorProduct C[X] S[X] A)) := by ext simp [constantTensorToPolynomialTensor, leftFactorToConstantTensorOverS, @@ -181,9 +192,9 @@ private theorem constantTensorToPolynomialTensor_comp_leftFactor : private theorem constantTensorToPolynomialTensor_commutes_polynomial (p : C[X]) : constantTensorToPolynomialTensor C S A - (algebraMap C[X] (ConstantTensor C S A) p) = - algebraMap C[X] (PolynomialTensor C S A) p := by - rw [show algebraMap C[X] (ConstantTensor C S A) p = + (algebraMap C[X] ((TensorProduct C S A)) p) = + algebraMap C[X] ((TensorProduct C[X] S[X] A)) p := by + rw [show algebraMap C[X] ((TensorProduct C S A)) p = leftFactorToConstantTensorOverS C S A (algebraMap C[X] S[X] p) by exact (leftFactorToConstantTensor_compatible C S A p).symm] @@ -197,25 +208,28 @@ private theorem constantTensorToPolynomialTensor_commutes_polynomial rw [hp] rfl -private noncomputable def constantTensorToPolynomialTensorOverPolynomial : - ConstantTensor C S A →ₐ[C[X]] PolynomialTensor C S A where +/-- Extend constant tensors as an algebra homomorphism over the base polynomial ring. -/ +noncomputable def constantTensorToPolynomialTensorOverPolynomial : + (TensorProduct C S A) →ₐ[C[X]] (TensorProduct C[X] S[X] A) where __ := (constantTensorToPolynomialTensor C S A).toRingHom - commutes' := constantTensorToPolynomialTensor_commutes_polynomial C S A + commutes' := by exact constantTensorToPolynomialTensor_commutes_polynomial C S A -private noncomputable def polynomialTensorToConstantTensorOverCoefficientPolynomial : - PolynomialTensor C S A →ₐ[S[X]] ConstantTensor C S A where +/-- Cancel polynomial tensors over the coefficient polynomial ring. -/ +noncomputable def polynomialTensorToConstantTensorOverCoefficientPolynomial : + (TensorProduct C[X] S[X] A) →ₐ[S[X]] (TensorProduct C S A) where __ := (polynomialTensorToConstantTensor C S A).toRingHom commutes' p := by change polynomialTensorToConstantTensor C S A ((Algebra.TensorProduct.includeLeft : - S[X] →ₐ[S[X]] PolynomialTensor C S A) p) = + S[X] →ₐ[S[X]] (TensorProduct C[X] S[X] A)) p) = leftFactorToConstantTensorOverS C S A p simp [polynomialTensorToConstantTensor, polynomialTensorToConstantTensorOverPolynomial, leftFactorToConstantTensor] -private noncomputable def constantTensorToPolynomialTensorOverCoefficientPolynomial : - ConstantTensor C S A →ₐ[S[X]] PolynomialTensor C S A where +/-- Extend constant tensors over the coefficient polynomial ring. -/ +noncomputable def constantTensorToPolynomialTensorOverCoefficientPolynomial : + (TensorProduct C S A) →ₐ[S[X]] (TensorProduct C[X] S[X] A) where __ := (constantTensorToPolynomialTensor C S A).toRingHom commutes' p := by have hp := AlgHom.congr_fun @@ -223,13 +237,13 @@ private noncomputable def constantTensorToPolynomialTensorOverCoefficientPolynom change constantTensorToPolynomialTensor C S A (leftFactorToConstantTensorOverS C S A p) = (Algebra.TensorProduct.includeLeft : - S[X] →ₐ[S[X]] PolynomialTensor C S A) p + S[X] →ₐ[S[X]] (TensorProduct C[X] S[X] A)) p exact hp private theorem constantTensorToPolynomialTensor_leftInverse : (constantTensorToPolynomialTensor C S A).comp (polynomialTensorToConstantTensor C S A) = - AlgHom.id S (PolynomialTensor C S A) := by + AlgHom.id S ((TensorProduct C[X] S[X] A)) := by apply AlgHom.ext intro z induction z using TensorProduct.inductionOn with @@ -252,7 +266,7 @@ private theorem constantTensorToPolynomialTensor_leftInverse : private theorem constantTensorToPolynomialTensor_rightInverse : (polynomialTensorToConstantTensor C S A).comp (constantTensorToPolynomialTensor C S A) = - AlgHom.id S (ConstantTensor C S A) := by + AlgHom.id S ((TensorProduct C S A)) := by apply Algebra.TensorProduct.ext · apply AlgHom.ext intro s @@ -268,7 +282,7 @@ private theorem constantTensorToPolynomialTensor_rightInverse : private theorem constantTensorToPolynomialTensorOverPolynomial_leftInverse : (constantTensorToPolynomialTensorOverPolynomial C S A).comp (polynomialTensorToConstantTensorOverPolynomial C S A) = - AlgHom.id C[X] (PolynomialTensor C S A) := by + AlgHom.id C[X] ((TensorProduct C[X] S[X] A)) := by apply AlgHom.ext intro z exact DFunLike.congr_fun @@ -277,7 +291,7 @@ private theorem constantTensorToPolynomialTensorOverPolynomial_leftInverse : private theorem constantTensorToPolynomialTensorOverPolynomial_rightInverse : (polynomialTensorToConstantTensorOverPolynomial C S A).comp (constantTensorToPolynomialTensorOverPolynomial C S A) = - AlgHom.id C[X] (ConstantTensor C S A) := by + AlgHom.id C[X] ((TensorProduct C S A)) := by apply AlgHom.ext intro z exact DFunLike.congr_fun @@ -287,7 +301,7 @@ private theorem constantTensorToPolynomialTensorOverCoefficientPolynomial_leftInverse : (constantTensorToPolynomialTensorOverCoefficientPolynomial C S A).comp (polynomialTensorToConstantTensorOverCoefficientPolynomial C S A) = - AlgHom.id S[X] (PolynomialTensor C S A) := by + AlgHom.id S[X] ((TensorProduct C[X] S[X] A)) := by apply AlgHom.ext intro z exact DFunLike.congr_fun @@ -297,7 +311,7 @@ private theorem constantTensorToPolynomialTensorOverCoefficientPolynomial_rightInverse : (polynomialTensorToConstantTensorOverCoefficientPolynomial C S A).comp (constantTensorToPolynomialTensorOverCoefficientPolynomial C S A) = - AlgHom.id S[X] (ConstantTensor C S A) := by + AlgHom.id S[X] ((TensorProduct C S A)) := by apply AlgHom.ext intro z exact DFunLike.congr_fun @@ -310,8 +324,8 @@ noncomputable def polynomialTensorCancelOverPolynomial : AlgEquiv.ofAlgHom (polynomialTensorToConstantTensorOverPolynomial C S A) (constantTensorToPolynomialTensorOverPolynomial C S A) - (constantTensorToPolynomialTensorOverPolynomial_rightInverse C S A) - (constantTensorToPolynomialTensorOverPolynomial_leftInverse C S A) + (by exact constantTensorToPolynomialTensorOverPolynomial_rightInverse C S A) + (by exact constantTensorToPolynomialTensorOverPolynomial_leftInverse C S A) /-- Polynomial tensor cancellation as an `S[X]`-algebra equivalence, where the target uses `polynomialTensorCancelTargetPolynomialExtensionAlgebra`. -/ @@ -320,10 +334,8 @@ noncomputable def polynomialTensorCancelOverCoefficientPolynomial : AlgEquiv.ofAlgHom (polynomialTensorToConstantTensorOverCoefficientPolynomial C S A) (constantTensorToPolynomialTensorOverCoefficientPolynomial C S A) - (constantTensorToPolynomialTensorOverCoefficientPolynomial_rightInverse - C S A) - (constantTensorToPolynomialTensorOverCoefficientPolynomial_leftInverse - C S A) + (by exact constantTensorToPolynomialTensorOverCoefficientPolynomial_rightInverse C S A) + (by exact constantTensorToPolynomialTensorOverCoefficientPolynomial_leftInverse C S A) /-- Cancelling the polynomial base change in a tensor product. -/ noncomputable def polynomialTensorCancel : @@ -331,8 +343,8 @@ noncomputable def polynomialTensorCancel : AlgEquiv.ofAlgHom (polynomialTensorToConstantTensor C S A) (constantTensorToPolynomialTensor C S A) - (constantTensorToPolynomialTensor_rightInverse C S A) - (constantTensorToPolynomialTensor_leftInverse C S A) + (by exact constantTensorToPolynomialTensor_rightInverse C S A) + (by exact constantTensorToPolynomialTensor_leftInverse C S A) @[simp] theorem polynomialTensorCancelOverPolynomial_apply diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean index 96250d3da4..efa8349d4e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PowerSum.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Order.Ring.Star -import Mathlib.Algebra.Polynomial.Eval.Defs -import Mathlib.Analysis.CStarAlgebra.Classes -import Mathlib.Analysis.SpecificLimits.Normed -import Mathlib.Tactic + +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Algebra.Polynomial.Eval.Defs +public import Mathlib.Analysis.CStarAlgebra.Classes +public import Mathlib.Analysis.SpecificLimits.Normed +public import Mathlib.Tactic /-! # Growth of finite weighted power sums @@ -24,6 +26,8 @@ polynomial that vanishes at all the other members of `s` expresses the chosen geometric progression as a fixed linear combination of shifted power sums. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean index 69bd894e26..7dbbec185f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.RamificationInertia.Basic -import Mathlib.LinearAlgebra.Dimension.Localization -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch + +public import Mathlib.RingTheory.RamificationInertia.Basic +public import Mathlib.LinearAlgebra.Dimension.Localization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch /-! # The canonical divisor `-2∞` on the rational function field @@ -18,6 +20,8 @@ the in-repository Riemann--Roch theorem and the proved genus-zero theorem for `RatFunc K`; it does not assume a base canonical divisor. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean index 0d9bff8309..3e33ce2926 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncConstantExtension.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Polynomial.Module.TensorProduct -import Mathlib.FieldTheory.RatFunc.Basic -import Mathlib.LinearAlgebra.Dimension.Localization -import Mathlib.LinearAlgebra.FiniteDimensional.Basic -import Mathlib.RingTheory.DedekindDomain.Instances -import Mathlib.RingTheory.Localization.LocalizationLocalization -import Mathlib.RingTheory.TensorProduct.Finite + +public import Mathlib.Algebra.Polynomial.Module.TensorProduct +public import Mathlib.FieldTheory.RatFunc.Basic +public import Mathlib.LinearAlgebra.Dimension.Localization +public import Mathlib.LinearAlgebra.FiniteDimensional.Basic +public import Mathlib.RingTheory.DedekindDomain.Instances +public import Mathlib.RingTheory.Localization.LocalizationLocalization +public import Mathlib.RingTheory.TensorProduct.Finite /-! # Constant extensions of rational function fields @@ -25,6 +27,8 @@ identify it with `S(X)`. This is the rational-function-field base-change input needed for the later constant extension of a general function field. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors namespace BGS.HasseWeil @@ -60,19 +64,19 @@ private theorem ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors : /-- The canonical coefficient extension `K(X) → S(X)`. -/ noncomputable def ratFuncCoefficientAlgHom : RatFunc K →ₐ[K] RatFunc S := RatFunc.mapAlgHom (ratFuncCoefficientPolynomialAlgHom K S) - (ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) + (by exact ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) theorem ratFuncCoefficientAlgHom_injective : Function.Injective (ratFuncCoefficientAlgHom K S) := RatFunc.map_injective (ratFuncCoefficientPolynomialAlgHom K S) - (ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) + (by exact ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) (ratFuncCoefficientPolynomialAlgHom_injective K S) theorem ratFuncCoefficientAlgHom_algebraMap (p : K[X]) : ratFuncCoefficientAlgHom K S (algebraMap K[X] (RatFunc K) p) = algebraMap S[X] (RatFunc S) (algebraMap K[X] S[X] p) := by change RatFunc.map (ratFuncCoefficientPolynomialAlgHom K S) - (ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) + (by exact ratFuncCoefficientPolynomialAlgHom_nonZeroDivisors K S) (algebraMap K[X] (RatFunc K) p) = _ rw [show algebraMap K[X] (RatFunc K) p = algebraMap K[X] (RatFunc K) p / algebraMap K[X] (RatFunc K) 1 by simp] @@ -158,7 +162,8 @@ private theorem ratFuncConstantLocalizationSubmonoid_le : simpa only [Algebra.algebraMapSubmonoid] using algebraMapSubmonoid_le_nonZeroDivisors_of_faithfulSMul S[X] le_rfl -private noncomputable def ratFuncConstantLocalizationToRatFunc +/-- Map the localization at nonzero base polynomials into the rational function field. -/ +noncomputable def ratFuncConstantLocalizationToRatFunc [FiniteDimensional K S] : RatFuncConstantLocalization K S →+* RatFunc S := IsLocalization.map @@ -185,12 +190,14 @@ private theorem ratFuncConstantLocalizationToRatFunc_algebraMap algebraMap S[X] (RatFunc S) p simpa only [RingHom.comp_apply, RingHom.id_apply] using h -private noncomputable def ratFuncToConstantLocalization +/-- Embed rational functions into the constant-extension localization. -/ +noncomputable def ratFuncToConstantLocalization [FiniteDimensional K S] : RatFunc S →+* RatFuncConstantLocalization K S := IsFractionRing.lift (IsLocalization.injective (RatFuncConstantLocalization K S) - (ratFuncConstantLocalizationSubmonoid_le K S)) + (show Submonoid.map (algebraMap K[X] S[X]) K[X]⁰ ≤ S[X]⁰ from by + exact ratFuncConstantLocalizationSubmonoid_le K S)) private theorem ratFuncToConstantLocalization_algebraMap [FiniteDimensional K S] (p : S[X]) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean index 095f4a7096..de9b09dd63 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncExactConstantExtension.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization -import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport -import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel -import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension -import Mathlib.FieldTheory.RatFunc.AsPolynomial -import Mathlib.RingTheory.Flat.Stability + +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +public import Mathlib.FieldTheory.RatFunc.AsPolynomial +public import Mathlib.RingTheory.Flat.Stability /-! # The rational-function field in an exact constant extension @@ -26,6 +28,8 @@ constant extension with the normalization used by the project's finite-place model. -/ +@[expose] public section + open scoped Polynomial TensorProduct nonZeroDivisors namespace BGS.HasseWeil @@ -140,11 +144,12 @@ noncomputable def ratFuncToExactConstantExtension : RatFunc S →ₐ[S] ExactConstantExtension C N S := by letI : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact - let hpoly := targetPolynomialAlgebraMap_injective C S N exact RatFunc.liftAlgHom (Polynomial.aeval (polynomialTensorCancelEvaluationPoint C S N)) - (nonZeroDivisors_le_comap_nonZeroDivisors_of_injective _ hpoly) + (by + apply nonZeroDivisors_le_comap_nonZeroDivisors_of_injective + exact targetPolynomialAlgebraMap_injective C S N) theorem ratFuncToExactConstantExtension_injective : Function.Injective @@ -336,6 +341,7 @@ variable [Algebra.IsSeparable (RatFunc C) N] include hExact +omit [FiniteDimensional (RatFunc C) N] in /-- For a finite separable `N / C(X)`, the exact constant extension remains separable over the original rational function field `C(X)`. -/ theorem isSeparable_exactConstantExtension_over_baseRatFunc : @@ -366,6 +372,7 @@ theorem isSeparable_exactConstantExtension_over_baseRatFunc : exact Algebra.IsSeparable.trans (RatFunc C) N (ExactConstantExtension C N S) +omit [FiniteDimensional (RatFunc C) N] in /-- For a finite separable `N / C(X)`, the exact constant extension is separable over the enlarged rational function field `S(X)`. -/ theorem isSeparable_over_extendedRatFunc : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean index e54a513cf8..08da39146e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncInfinityLocalization.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree -import Mathlib.Algebra.Polynomial.Reverse -import Mathlib.RingTheory.Localization.AtPrime.Basic -import Mathlib.RingTheory.Localization.Integral + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import Mathlib.Algebra.Polynomial.Reverse +public import Mathlib.RingTheory.Localization.AtPrime.Basic +public import Mathlib.RingTheory.Localization.Integral /-! # The infinity valuation ring as a reciprocal localization @@ -22,6 +24,8 @@ the bridge needed to transport polynomial normalization under finite constant extension to places above infinity. -/ +@[expose] public section + open scoped Polynomial nonZeroDivisors open IsDedekindDomain Multiplicative WithZero diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean index a5d1610587..9b3a83619d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor -import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +public import Mathlib.Tactic /-! # The rational parameter's pole divisor in a finite extension @@ -22,6 +24,8 @@ ramification--inertia degree formula. These statements do not require the constant field `K` to be finite. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean index 3f8a74e215..ff48ac16d5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor -import Mathlib.RingTheory.Polynomial.DegreeLT + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import Mathlib.RingTheory.Polynomial.DegreeLT /-! # Degree-one places of a finite function field @@ -18,6 +20,8 @@ fibers, while the places above infinity already form a finite lying-over fiber. -/ +@[expose] public section + open scoped Polynomial namespace BGS.HasseWeil @@ -156,12 +160,14 @@ def finiteExtensionRationalPlaceEquivSubtype : def finiteExtensionRationalPlaceCount : ℕ := Nat.card (FiniteExtensionRationalPlace K L) +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in theorem finiteExtensionRationalPlaceCount_eq_natCard_subtype : finiteExtensionRationalPlaceCount K L = Nat.card {P : FiniteExtensionPlace K L // finiteExtensionPlaceDegree K L P = 1} := Nat.card_congr (finiteExtensionRationalPlaceEquivSubtype K L) +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in private theorem rationalFinitePlace_baseDegree_eq_one (Q : FiniteExtensionRationalFinitePlace K L) : ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] Q.1) = 1 := by @@ -179,7 +185,7 @@ def rationalFinitePlaceToBaseFiber Σ P : RatFuncRationalFinitePlace K, P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) := ⟨⟨HeightOneSpectrum.under K[X] Q.1, - rationalFinitePlace_baseDegree_eq_one K L Q⟩, + by exact rationalFinitePlace_baseDegree_eq_one K L Q⟩, ⟨Q.1.asIdeal, Q.1.isPrime, ⟨rfl⟩⟩⟩ theorem rationalFinitePlaceToBaseFiber_injective : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean index 9ac95987cd..c2c7c1cdff 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower -import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace /-! # Restriction of rational places in a function-field tower @@ -16,6 +18,8 @@ and its relative residue degree is one. This file packages that consequence for the repository's exhaustive finite/infinity place type. -/ +@[expose] public section + namespace BGS.HasseWeil noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean index 56135c9d4f..5a99483daf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceConstants.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase -import Mathlib.FieldTheory.AlgebraicClosure + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +public import Mathlib.FieldTheory.AlgebraicClosure /-! # The zero-divisor Riemann space and the exact constant field @@ -17,6 +19,8 @@ the constants is trivial, this identifies `L(0)` with the image of the constant field and gives its finrank exactly equal to one. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean index 36d556af4f..4a722e8c67 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceEffectiveIncrement.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +public import Mathlib.Tactic /-! # Effective increments of exhaustive Riemann spaces @@ -22,6 +24,8 @@ are the linear-algebraic codimension estimates needed to pass from a many-pole auxiliary space to a one-point Riemann space. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean index 07fe5fcbf4..6eb56c6f6c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor -import Mathlib.RingTheory.Finiteness.Finsupp -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +public import Mathlib.RingTheory.Finiteness.Finsupp +public import Mathlib.Tactic /-! # Riemann-space increments at finite places @@ -18,6 +20,8 @@ Use a normalized local lift and its leading residue to bound the dimension incre finite place is added to a divisor. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -40,6 +44,8 @@ variable (hregular : ∀ x : T, ∃ r : R, a * x.1 = algebraMap R L r) noncomputable def localNormalizedLift (x : T) : R := Classical.choose (hregular x) +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [Algebra K R] [IsScalarTower K R L] + [IsFractionRing R L] in theorem localNormalizedLift_spec (x : T) : a * x.1 = algebraMap R L (localNormalizedLift T a hregular x) := Classical.choose_spec (hregular x) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean index 337f4e4097..26c04a684a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement + +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement /-! # Riemann-space increments at infinity @@ -13,6 +15,8 @@ Identify the kernel of the leading-residue map and bound the dimension increase an infinite place. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean index 8068bd5688..416b682b7e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SpectralFromAsymptotic.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum -import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace /-! # Spectral bounds from even power-sum asymptotics @@ -20,6 +22,8 @@ from `BGS.HasseWeil.PowerSum` applies without an injectivity assumption on the original family of parameters. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean index b9e9e4887b..697c654c2f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace -import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount -import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import Mathlib.FieldTheory.Finite.GaloisField -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import Mathlib.FieldTheory.Finite.GaloisField +public import Mathlib.Tactic /-! # Quadratic-extension affine points and base-field places @@ -27,6 +29,8 @@ count. The final estimate bounds all quadratic-extension affine points by the positive divisor degree, and by the height for a nonzero function. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean index 4371f1b836..6cfc5e7010 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldResidue.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import Mathlib.Tactic /-! # Degree-one residues over a square constant field @@ -17,6 +19,8 @@ residue therefore satisfies the half-Frobenius square identity used by the semilinear Stepanov restriction. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -49,6 +53,7 @@ local instance squareFieldResidueFiniteConstantTower : IsScalarTower S S[X] (RatFuncFiniteIntegralClosure S L) := IsScalarTower.of_algebraMap_eq' rfl +omit [Field K] in /-- A degree-one finite place over a square constant field has the quadratic half-Frobenius identity in its residue field. -/ theorem finiteExtensionFinitePlace_residue_squareFrobenius_of_degree_one diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean index 71a403704f..a9ccf0a03d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovAuxiliary.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary -import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction +public import Mathlib.Tactic /-! # A sharp one-point Stepanov auxiliary over a square constant field @@ -19,6 +21,8 @@ scale. This keeps both the Riemann-space dimension count and the final pole height sharp. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean index 9b7d49697b..dbb9b87f73 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing +public import Mathlib.Tactic /-! # Stepanov restrictions over a square constant field @@ -21,6 +23,8 @@ This file packages the coefficient transform and proves the local residue identity. It makes no point-count or smoothness assertion. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean index 0cf5b9bf90..7af0a64998 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovZeroCount.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight -import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +public import Mathlib.Tactic /-! # The square-field Stepanov zero count @@ -24,6 +26,8 @@ degree-one one-point height bound controls the cardinality of the family by that same number. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean index 4aa05e0a3d..07d92bc382 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovLinearAlgebra.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight -import Mathlib.LinearAlgebra.Dimension.Finite -import Mathlib.LinearAlgebra.Dimension.Constructions + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +public import Mathlib.LinearAlgebra.Dimension.Finite +public import Mathlib.LinearAlgebra.Dimension.Constructions /-! # Linear-algebra core of the Bombieri--Stepanov argument @@ -20,6 +22,8 @@ one-point Riemann space and to vanish at every rational intersection point, the exhaustive divisor zero count bounds the number of those points. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean index 688b09dac4..7d3a0fb536 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovParameters.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Order.Ring.Star -import Mathlib.Data.Int.Star -import Mathlib.Tactic -import Mathlib.Tactic.Linarith.Lemmas -import Mathlib.Tactic.NormNum.Ineq -import Mathlib.Tactic.Ring.Basic -import Mathlib.Tactic.Zify + +public import Mathlib.Algebra.Order.Ring.Star +public import Mathlib.Data.Int.Star +public import Mathlib.Tactic +public import Mathlib.Tactic.Linarith.Lemmas +public import Mathlib.Tactic.NormNum.Ineq +public import Mathlib.Tactic.Ring.Basic +public import Mathlib.Tactic.Zify /-! # Numerical parameters for the Bombieri--Stepanov argument @@ -26,6 +28,8 @@ These parameters satisfy the three inequalities needed by the one-point Riemann-space argument, and give the same `O(g * s)` error term. -/ +@[expose] public section + namespace BGS.HasseWeil /-- The slightly non-sharp parameters used in the formal Stepanov argument. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean index d9d14fd414..3430c1451b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement -import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra -import Mathlib.LinearAlgebra.Dimension.Constructions -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra +public import Mathlib.LinearAlgebra.Dimension.Constructions +public import Mathlib.Tactic /-! # Stepanov restriction maps on a finite coefficient grid @@ -26,6 +28,8 @@ The final results expose exactly the injectivity and finrank interfaces used by `exists_auxiliary_of_finrank_lt`. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier @@ -64,6 +68,8 @@ def onePointStepanovSecondRestrictionMap Finsupp.linearCombination K (fun ij : α × β => (f ij.1) ^ s * g ij.2) +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem onePointStepanovFirstRestrictionMap_single {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) @@ -73,6 +79,8 @@ theorem onePointStepanovFirstRestrictionMap_single c • (f ij.1 * (g ij.2) ^ s) := by simp [onePointStepanovFirstRestrictionMap] +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem onePointStepanovSecondRestrictionMap_single {α β : Type*} (f : α → L) (g : β → L) (s : ℕ) @@ -211,6 +219,8 @@ theorem onePointStepanovSecondCodRestrictionMap_coe onePointStepanovSecondRestrictionMap K L f g s c := by rfl +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- Linear independence of the first product grid is exactly injectivity of the first restriction map. -/ theorem onePointStepanovFirstRestrictionMap_injective_of_linearIndependent @@ -257,6 +267,7 @@ theorem onePointStepanovFirstCodRestrictionMap_injective_of_linearIndependent K L f g s hLI exact congrArg Subtype.val hcd +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The coefficient space has dimension equal to the cardinality of its finite product index. -/ @[simp] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean index 8f51a018c5..f2dda22ad8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction -import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps -import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +public import Mathlib.Tactic /-! # The quadratic Frobenius vanishing step @@ -30,6 +32,8 @@ this file does not assert that every normalization place above a quadratic extension point has residue degree at most two. -/ +@[expose] public section + namespace BGS.HasseWeil open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean index 60c1407335..c96e172882 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/TensorRestriction.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.LinearAlgebra.Dimension.Constructions -import Mathlib.LinearAlgebra.Dimension.Finite -import Mathlib.LinearAlgebra.FiniteDimensional.Defs -import Mathlib.LinearAlgebra.TensorProduct.Submodule -import Mathlib.RingTheory.TensorProduct.Finite + +public import Mathlib.LinearAlgebra.Dimension.Constructions +public import Mathlib.LinearAlgebra.Dimension.Finite +public import Mathlib.LinearAlgebra.FiniteDimensional.Defs +public import Mathlib.LinearAlgebra.TensorProduct.Submodule +public import Mathlib.RingTheory.TensorProduct.Finite /-! # Tensor restriction maps @@ -24,6 +26,8 @@ are needed when such a tensor restriction map is used as a target map in a rank-nullity argument. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped TensorProduct diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean index c727f03ef7..1921e3bba6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaExtensionTrace.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic + +public import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic /-! # Extension point counts and the zeta spectral formula @@ -15,6 +17,8 @@ Bombieri--Stepanov/Galois-averaging argument. The geometric construction of the zeta function remains a separate preceding stage. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean index da97e231cc..3972a46a90 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaNumeratorSpectral.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral + +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral /-! # From a zeta numerator to a rank-bounded spectral formula @@ -20,6 +22,8 @@ errors. The zeta-function construction must prove that property; it is not an assumed theorem or a replacement for Hasse--Weil. -/ +@[expose] public section + namespace BGS.HasseWeil open Filter Asymptotics diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean index 9579f654dc..a6c31065c8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ZetaTrace.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Analysis.CStarAlgebra.Classes -import Mathlib.Tactic + +public import Mathlib.Analysis.CStarAlgebra.Classes +public import Mathlib.Tactic /-! # From zeta-function spectral data to the Hasse--Weil estimate @@ -20,6 +22,8 @@ separate: they are the substantive preceding stages of the Corvaja--Zannier/Bombieri argument. -/ +@[expose] public section + namespace BGS.HasseWeil open scoped BigOperators diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean index 76fa48127b..5c8d9fd240 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly.lean @@ -3,18 +3,20 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean index 8fc8366854..0d45597c5f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Asymptotics.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount /-! # The elementary asymptotic in the giant-orbit assembly @@ -14,6 +16,8 @@ The concrete small-order count is `2 * (2 + 2 * B^2)^2`. This file proves that claim about the cage complement is used here. -/ +@[expose] public section + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean index d23e6b18f2..10de14e284 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseEndgame.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail /-! # Endgame and cage wrappers at the unified coarse support cutoff @@ -14,6 +16,8 @@ tenth-moment estimates proved in `CoarseSupportTail`, so every non-cubic support condition follows from the single hypothesis `2^756 < p`. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean index 1d605cb8e5..dc6057c627 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseLinearTail.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics /-! # Coarse automatic linear tail @@ -15,6 +17,8 @@ automatic at a cutoff far below the paper scale. No divisor-table tuning is used here. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean index 9ec0fd1cbf..5846e66856 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportSurjectivity.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier -import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics -import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound /-! # Certificate-free coarse-support surjectivity @@ -17,6 +19,8 @@ divisor count and combining this obstruction with the elementary tenth moment gives an unconditional cutoff without a divisor table. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean index 551b5fa03c..bfeb3027a8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame /-! # Coarse support tails below the paper scale @@ -15,6 +17,8 @@ tenth-moment divisor estimate, discharges the non-cubic middle-game, primitive-endgame, cage, and split-sign support inequalities. -/ +@[expose] public section + namespace BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean index a6ada6fcf4..ab4540e171 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/DivisibleOrbitTransitivity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility /-! # From a giant divisible orbit to transitivity @@ -16,6 +18,8 @@ finite-orbit argument and combines it with Chen's component-divisibility theorem later elementary proof. -/ +@[expose] public section + namespace BGS.Markoff /-- If one orbit has complement smaller than `p` and every orbit cardinality is divisible by `p`, diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean index 3704380350..7702761bf9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ElementaryCounts.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Polynomial.Degree.IsMonicOfDegree -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic -import Mathlib.GroupTheory.SpecificGroups.Cyclic + +public import Mathlib.Algebra.Polynomial.Degree.IsMonicOfDegree +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +public import Mathlib.GroupTheory.SpecificGroups.Cyclic /-! # Elementary counts for the giant-orbit assembly @@ -22,6 +24,8 @@ finite groups is false (an elementary abelian `2`-group can have more than two e two). The split and norm-one tori to which this count will eventually be applied are cyclic. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean index 5c4421a359..7b0824f798 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenCoarseSupportFrontier.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail /-! # Euler-seven frontier with all support tails discharged @@ -17,6 +19,8 @@ square envelope for the joint maximal-divisor count together with its exact Euler-seven cubic inequality. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean index 635a67f34a..d515074b02 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame /-! # Euler-seven nonparabolic complement frontier @@ -14,6 +16,8 @@ This is the complement-maximal argument with the exact paired Euler-characteristic middle-game condition `189 * M^3 < d`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean index 92717357ff..9d4d43441c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenPairedMaximalDivisorMiddleGame.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape /-! # Euler-seven paired maximal-divisor middle-game assembly @@ -14,6 +16,8 @@ This lifts the exact `189 * K^3 < d` paired escape from a chosen coordinate to the maximum of the three coordinate rotation orders. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean index bdf82d0179..63c7b29eb9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageCoarseLinearTail.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity /-! # Euler-seven split-cage frontier with automatic linear tail @@ -14,6 +16,8 @@ Above `24^15 * 2^687`, the tenth-moment estimate discharges the full linear middle-game family. Only the square-envelope cube obstruction remains. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean index 84f8850800..dc3f1892f8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageNonparabolicComplementFrontier.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier /-! # Split-cage Euler-seven nonparabolic complement frontier @@ -14,6 +16,8 @@ The split-cage base discharges the even-sign inputs, while the middle game uses the exact paired coefficient `189`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean index ea2efce200..b3fa33f2ed 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeFrontier.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier -import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier +public import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion /-! # Root-free Euler-seven split-cage square-envelope frontier @@ -21,6 +23,8 @@ because `35721 = 189^2`. The linear branch is independently reduced to `24^2 * S * d^2 < p^2`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean index 13720a0700..49ccd6497f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenSplitCageSquareEnvelopeSurjectivity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity /-! # Euler-seven square-envelope reduction surjectivity @@ -14,6 +16,8 @@ This separate façade converts the exact split-cage transitivity endpoint to surjectivity of natural Markoff reduction using the canonical equivalence. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean index 89c5056178..421715fa6d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignBaseStableComplement.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility /-! # From base sign-stability to complement divisibility @@ -14,6 +16,8 @@ four sign changes of one base point back to that base component. Every even sign change then preserves the whole component and its finite complement. -/ +@[expose] public section + namespace BGS.Markoff /-- If all even-sign changes of the base point lie in its `Gamma` component, diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean index 6d41da8a82..e927c74312 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignComplementDivisibility.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier /-! # Even-sign divisibility for component complements @@ -14,6 +16,8 @@ This file specializes the free even-sign action to the finite complement used by the nonparabolic complement frontier. -/ +@[expose] public section + namespace BGS.Markoff /-- An even-sign-invariant component complement has cardinality divisible by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean index 809ae57aa8..6a16562a31 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction /-! # Divisibility from the free even-sign action @@ -14,6 +16,8 @@ on the punctured Markoff surface. Consequently every finite sign-invariant set is a disjoint union of four-element sign orbits. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section @@ -62,7 +66,7 @@ theorem evenSign_eq_one_of_smul_eq eq_zero_of_neg_eq htwo (congrArg Point.x3 fixedPoint) have hsecond : x.1.1.x2 = 0 := by have hmarkoff := x.1.2 - simp [IsMarkoff, markoffPolynomial, hfirst, hthird] at hmarkoff + simp only [ne_eq] at hmarkoff exact hmarkoff exfalso apply x.2 @@ -75,7 +79,7 @@ theorem evenSign_eq_one_of_smul_eq eq_zero_of_neg_eq htwo (congrArg Point.x3 fixedPoint) have hfirst : x.1.1.x1 = 0 := by have hmarkoff := x.1.2 - simp [IsMarkoff, markoffPolynomial, hsecond, hthird] at hmarkoff + simp only [ne_eq] at hmarkoff exact hmarkoff exfalso apply x.2 diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean index dc416a4c22..1477a35ee5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier /-! # Exact-order root obstruction from a nontransitive complement @@ -19,6 +21,8 @@ bound and the factor-four complement divisibility therefore force `8 * p ≤ R^2` whenever the complement survives below the endgame threshold. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean index 0cf26422a0..d5dc10dcec 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame /-! # Exact-order obstruction with the Euler-seven cap @@ -15,6 +17,8 @@ the same maximal bad rotation order. This file keeps that common witness visible instead of composing two unrelated existential statements. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean index 500840645b..4790f6a783 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderPuncturedSmallOrderCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount /-! # Exact-order square bound for punctured small-order points @@ -15,6 +17,8 @@ eigenvalue roots, not traces. Inversion pairing supplies the factor two before the two-coordinate Markoff fiber estimate is squared. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean index 93abb23b99..7f418b89af 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderRankinEnvelope.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization /-! # Exact-order Rankin envelope for the Markoff obstruction @@ -19,6 +21,8 @@ of divisors of `p - 1` and `p + 1`; the already formalized Sperner width can replace this envelope later without changing the Rankin layer. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean index 078ebe1e48..ba1447c58a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderTraceBudget.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient /-! # Exact-order root budgets for nonparabolic traces @@ -15,6 +17,8 @@ worst-case size. Here the cyclic fibers remain disjoint and contribute their exact root counts `φ(e)`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory @@ -47,6 +51,7 @@ section CyclicTrace variable {G T : Type*} [Group G] [Fintype G] [DecidableEq G] [DecidableEq T] [IsCyclic G] +omit [IsCyclic G] in theorem nonTwoTorsionBoundedOrderTraceSet_succ_eq_exactOrderImage (trace : G → T) (bound : ℕ) : nonTwoTorsionBoundedOrderTraceSet trace (bound + 1) = diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean index b18d1b699b..7a29cbf603 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExceptionalPrimeCount.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Order.Interval.Set.Nat -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity + +public import Mathlib.Order.Interval.Set.Nat +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity /-! # Exceptional-prime consequences of Chen orbit divisibility @@ -18,6 +20,8 @@ prime. This file records the resulting finite exceptional-prime set and derives exceptional-prime bound of Theorem 2. -/ +@[expose] public section + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean index 867c06c1ec..aace97d469 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates -import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame /-! # Explicit punctured transitivity @@ -19,6 +21,8 @@ large-order-to-base-component hypothesis; the middle-game step is the proved Corvaja--Zannier escape theorem. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean index 45754785bb..a9944938af 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount /-! # Fixed-point-free maximal-divisor trace pairing @@ -16,6 +18,8 @@ additive exceptional term. Applying this on each maximal-divisor piece gives `2 * |non-two-torsion bounded traces| ≤ (bound - 1) * M`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory @@ -27,6 +31,7 @@ section FixedPointFreeInvolutionImage variable {G T : Type*} [Group G] [Fintype G] [DecidableEq G] [DecidableEq T] [IsCyclic G] +omit [Fintype G] [IsCyclic G] in /-- An inversion-invariant map has at most half as many values as inputs when inversion has no fixed point on the source. -/ theorem two_mul_card_image_le_card_of_inv_invariant_of_no_fixed @@ -75,6 +80,7 @@ theorem two_mul_card_image_le_card_of_inv_invariant_of_no_fixed def nonTwoTorsionElementsWithPowOne (m : ℕ) : Finset G := (elementsWithPowOne G m).filter fun x => x ^ 2 ≠ 1 +omit [IsCyclic G] in @[simp] theorem mem_nonTwoTorsionElementsWithPowOne_iff {m : ℕ} {x : G} : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean index 0bb835eac9..916102818f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean @@ -3,14 +3,16 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics -import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane /-! # Assembly of the giant orbit @@ -23,6 +25,8 @@ the reusable general Hasse--Weil interface. The interface is inhabited in exported by `BGS.Markoff.Assembly.Unconditional`. -/ +@[expose] public section + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean index bb05ec7b1c..2e1c165530 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity -import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion /-! # Root-free joint maximal-divisor frontier @@ -15,6 +17,8 @@ maximal-divisor counts. This module keeps that square envelope intact instead of taking an integer square root and losing information. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean index 57161b29d7..558426a7a0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorLowOrderCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds /-! # Small-order Markoff counts using maximal divisors @@ -14,6 +16,8 @@ This is the counting half of the paper's maximal-divisor improvement, formalized at the finite-set boundary used by the maximal-orbit argument. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean index 821768bcf3..a6805bea8d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorMiddleGame.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape /-! # Maximal-divisor middle-game assembly @@ -14,6 +16,8 @@ This module lifts the maximal-order Corvaja--Zannier escape from a chosen coordinate to the maximum of the three coordinate rotation orders. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean index ddde85e4b4..cf4335498d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame /-! # Punctured transitivity from the maximal-divisor frontier @@ -22,6 +24,8 @@ discharge its two explicit inequalities using the joint `p - 1`, `p + 1` square envelope. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean index 924935be93..c9ffabd134 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape -import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape /-! # Iterating the middle-game escape to the cage -/ +@[expose] public section + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean index 31844f15ae..241eb5e188 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicBadComponent.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape /-! # Nonparabolic coordinates outside the endgame component @@ -16,6 +18,8 @@ threshold is connected to a fixed base point, every point outside the base component has nonparabolic coordinates. -/ +@[expose] public section + namespace BGS.Markoff /-- A point outside a component containing every endgame-large point has diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean index bb582b3326..f70e2f3e14 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame -import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction /-! # Nonparabolic complement frontier @@ -27,6 +29,8 @@ fixed-point-free small-order set. Consequently its maximal order `d` forces with no additive parabolic correction. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean index 8ae8007f09..21f06a2ffb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicMaximalDivisorConcreteCount.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount /-! # Fixed-point-free low-order traces on the two rotation tori @@ -16,6 +18,8 @@ fixed-point-free on both the split and norm-one sources, giving `2 * |nonparabolic low traces| ≤ (bound - 1) * M`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean index ba727ce18a..1cf7c9a1a6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicPuncturedSmallOrderCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount -import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +public import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization /-! # Fixed-point-free small-order counts on the punctured surface @@ -17,6 +19,8 @@ punctured set satisfies `2 * |small nonparabolic points| ≤ ((bound - 1) * M) ^ 2`. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean index 8ed7c6176a..95829a578f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizationCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization /-! # Finite counts in normalized Markoff coordinates @@ -15,6 +17,8 @@ coordinates across `normalizationEquiv`. It then sums that bound over a finite first and second normalized coordinates. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean index 90a5426e70..ddc0c9309d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NormalizedSmallOrderCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization /-! # The elementary small-order point count @@ -15,6 +17,8 @@ the normalized fixed-fiber bound. It is the counting step omitted from the pape assembly; no dynamical assertion about escaping to the cage is assumed here. -/ +@[expose] public section + namespace BGS.Markoff /-- Normalized Markoff points whose first two matrix rotation orders are below `bound`. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean index 5a242692f6..93349baabb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action /-! # Divisibility of Markoff orbit cardinalities @@ -19,6 +21,8 @@ The result is stated only for `3 < p`. This is the range used in Martin's proof at `p = 3` the eight points with all coordinates in `{1, -1}` form one Vieta component. -/ +@[expose] public section + namespace BGS.Markoff universe u @@ -65,7 +69,7 @@ private theorem first_ne_zero_of_third_eq_zero intro hx1 have hx2 : x.1.1.x2 = 0 := by have hmark := x.1.2 - simp [IsMarkoff, markoffPolynomial, hx1, hx3] at hmark + simp only [ne_eq] at hmark exact hmark apply x.2 apply Subtype.ext @@ -77,7 +81,7 @@ private theorem second_ne_zero_of_first_eq_zero intro hx2 have hx3 : x.1.1.x3 = 0 := by have hmark := x.1.2 - simp [IsMarkoff, markoffPolynomial, hx1, hx2] at hmark + simp only [ne_eq] at hmark exact hmark apply x.2 apply Subtype.ext @@ -89,7 +93,7 @@ private theorem second_ne_zero_of_third_eq_zero intro hx2 have hx1 : x.1.1.x1 = 0 := by have hmark := x.1.2 - simp [IsMarkoff, markoffPolynomial, hx2, hx3] at hmark + simp only [ne_eq] at hmark exact hmark apply x.2 apply Subtype.ext @@ -101,7 +105,7 @@ private theorem third_ne_zero_of_first_eq_zero intro hx3 have hx2 : x.1.1.x2 = 0 := by have hmark := x.1.2 - simp [IsMarkoff, markoffPolynomial, hx1, hx3] at hmark + simp only [ne_eq] at hmark exact hmark apply x.2 apply Subtype.ext @@ -113,7 +117,7 @@ private theorem third_ne_zero_of_second_eq_zero intro hx3 have hx1 : x.1.1.x1 = 0 := by have hmark := x.1.2 - simp [IsMarkoff, markoffPolynomial, hx2, hx3] at hmark + simp only [ne_eq] at hmark exact hmark apply x.2 apply Subtype.ext diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean index e77cf2fa68..86104a5382 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorLowOrderCount.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount /-! # Small-order trace counts after inversion pairing @@ -14,6 +16,8 @@ inverse. Applying this before the maximal-divisor union removes the factor two that is lost by counting eigenvalues instead of traces. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean index cf4d7c0b9d..0c596e98df 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorMiddleGame.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape /-! # Paired maximal-divisor middle-game assembly @@ -14,6 +16,8 @@ This module lifts the paired maximal-order escape from a chosen coordinate to the maximum of the three coordinate rotation orders. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean index a8d0e90fc1..bdab544b37 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PairedMaximalDivisorTraceCount.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount /-! # Maximal-divisor trace covers after inversion pairing @@ -16,6 +18,8 @@ division-free: `2 * |trace values| ≤ (bound + 1) * |maximal divisors|`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean index 9002a7d61c..30c060278f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/PuncturedSmallOrderCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount /-! # Small-order counts on the punctured Markoff surface @@ -15,6 +17,8 @@ equivalence. Keeping these finite-set estimates here prevents the core equivale depending on the giant-orbit counting layer. -/ +@[expose] public section + namespace BGS.Markoff /-- The canonical small-order set, restricted to the normalized punctured surface. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean index 0311deff59..4a8727b2fe 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainSperner.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth -import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic /-! # Sperner handoff for the joint maximal-order antichain @@ -17,6 +19,8 @@ way that comparison of encoded points implies divisibility of the original orders. The joint antichain then has cardinality at most the central rank. -/ +@[expose] public section + namespace BGS.Markoff open BGS.Combinatorics diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean index d5d7803e57..895171d30e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinJointAntichainWidth.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope -import Mathlib.Order.Antichain + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +public import Mathlib.Order.Antichain /-! # One joint antichain for the two neighboring tori @@ -19,6 +21,8 @@ This is the arithmetic input that makes the width-sensitive Rankin endpoint strictly sharper than summing two complete divisor counts. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean index 73e8e98793..22387862ca 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/RankinWidthEnvelope.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope /-! # A width-sensitive exact-order Rankin envelope @@ -19,6 +21,8 @@ This is the interface needed for a joint-antichain or symmetric-chain width certificate. It does not assume such a certificate. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean index 240b419976..8aa4be26b9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ReductionSurjectivity.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity /-! # Explicit strong approximation @@ -15,6 +17,8 @@ The explicit punctured-transitivity theorem, together with natural Markoff conne gives surjectivity of reduction from natural-number Markoff solutions. -/ +@[expose] public section + namespace BGS.Markoff /-- **Explicit strong approximation in its source-faithful form.** For every prime above the diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean index 07d7d0a2c5..82756e8e56 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageEvenSignBase.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction /-! # Even-sign stability of a split-cage base component @@ -21,6 +23,8 @@ Consequently, under the usual large-order-to-base hypothesis, all four even sign images of a split-cage base lie in its Gamma orbit. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean index 0bfa507a6b..43d9bf327e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/SplitCageNonparabolicComplementFrontier.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier /-! # Split-cage nonparabolic complement frontier @@ -17,6 +19,8 @@ Gamma component. This module discharges both sign-invariance hypotheses of the nonparabolic complement frontier automatically. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean index e7ef8e387c..b803bdc44e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/TransitivitySurjectivity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity -import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements /-! # Punctured finite-field transitivity and reduction surjectivity @@ -15,6 +17,8 @@ finite-field transitivity statement used by the dynamical proof with the source- arithmetic statement that reduction from natural-number Markoff solutions is surjective. -/ +@[expose] public section + namespace BGS.Markoff /-- Reduction from natural-number solutions, viewed in the existing ring-level surface. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean index 5dba097067..1ca8f1141e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/Unconditional.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount + +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount /-! # Unconditional BGS assembly @@ -15,6 +17,8 @@ plane-curve estimate used by the split, nonsplit, and cage arguments. These short wrappers close the final parameter of the existing BGS assembly. -/ +@[expose] public section + namespace BGS.Markoff /-- **BGS Theorem 1**, with both Corvaja--Zannier and affine Hasse--Weil diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean index e7ee41762c..cafad3b1df 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/WeightedCoarseSupportSurjectivity.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity -import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity +public import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound /-! # Weighted certificate-free coarse-support surjectivity @@ -16,6 +18,8 @@ tenth-moment checkpoint without changing the geometric frontier and without introducing a divisor table or a finite maximal-divisor certificate. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean index 1e6d5ceea9..7095c00a82 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage.lean @@ -3,18 +3,20 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence -import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic -import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity -import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane -import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption -import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand -import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime -import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean index 1abf31b11e..69c3ad3518 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption /-! # Coordinate-axis invariance of cage witnesses @@ -17,6 +19,8 @@ sent to the third coordinate. This file records that symmetry as an actual equivalence, retaining the common trace exactly. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean index 99f8bac4dc..27ec265b07 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/BiquadraticPrimitiveQuartic.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Polynomial.Degree.IsMonicOfDegree -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing + +public import Mathlib.Algebra.Polynomial.Degree.IsMonicOfDegree +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing /-! # A primitive quartic for a biquadratic extension @@ -19,6 +21,8 @@ extension. Its minimal polynomial is This file packages that calculation as a reusable irreducibility theorem. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean index bc834368a7..20fac1b35e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean @@ -3,14 +3,18 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal /-! # Connectivity of the selected split cage -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean index 51a7068e63..666ed27376 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/EstimateFromPlane.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison -import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence -import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime /-! # Transferring plane estimates to the cage witness count @@ -16,6 +18,8 @@ comparison, the exact `d`-fold power-cover multiplicity, and the all-axis equivalence. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean index 72e230db2a..e1bad58084 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/HasseWeilAssumption.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph + +public import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph /-! # Explicit Hasse--Weil interface for the cage @@ -14,6 +16,8 @@ The external input is a point-count estimate on the actual finite set used by th inclusion--exclusion. Connectivity and primitive extraction are not assumed here. -/ +@[expose] public section + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean index 2345bf135e..4150e0a6d7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/IncidenceGeometry.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization /-! # Geometry of the normalized cage incidence curve @@ -23,6 +25,8 @@ integrality of the subsequent power-trace pullback; that is the next Kummer obligation in the cage Hasse--Weil argument. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean index 3b6bf5876d..d80b0fda8c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneCountComparison.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover /-! # Comparing the pulled cage cover with its affine plane models @@ -15,6 +17,8 @@ between the two equal radicand roots. This file isolates those two losses and bounds them by the roots of explicit univariate polynomials. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean index 60549d2217..79af3c7452 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneHasseWeil.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels -import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption /-! # Hasse--Weil estimates for the direct cage plane models @@ -16,6 +18,8 @@ used by the cage are prime to the characteristic; that condition is not left as a specialized assumption. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean index 40e7088beb..fad390b403 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PlaneModels.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand -import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems /-! # Direct affine-plane models for the cage @@ -18,6 +20,8 @@ the defining equations polynomials in the root coordinate with coefficients in the parameter polynomial ring. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean index 8c01bcdeea..766fc20a7c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PowerCover.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil -import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations /-! # The one-sided power cover of the cage witness equations @@ -15,6 +17,8 @@ power-map range with the two pulled radicand equations. Both incidence roots remain part of the data. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean index dd6074ac67..a59f17270a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/PulledRadicand.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility -import Mathlib.FieldTheory.IsAlgClosed.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +public import Mathlib.FieldTheory.IsAlgClosed.Basic /-! # Pulled-back cage radicands @@ -21,6 +23,8 @@ behind a geometric-integrality assumption: the two pulled radicands are proved squarefree and coprime explicitly. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean index 3f17ea06cd..526193b8c7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/ShiftedTraceCurveIrreducibility.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.Polynomial.SpecificDegree -import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry + +public import Mathlib.Algebra.Polynomial.SpecificDegree +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry /-! # The shifted cage trace cover @@ -25,6 +27,8 @@ place-at-infinity statement is the remaining Kummer obstruction for the full shifted Laurent cover. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean index 8b8f27d31e..89bd451550 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/SmallPrime.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover /-! # The small prime in the cage estimate @@ -14,6 +16,8 @@ for `p = 5`; this file handles that one finite field by a transparent ambient cardinality bound, not by applying an inapplicable irreducibility statement. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean index 5008e054e5..7b8a37624c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption + +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption /-! # Witness-preserving equations for the cage fiber product @@ -14,6 +16,8 @@ It deliberately retains the two intersection witnesses. No point-count or irreducibility assertion is made here. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core.lean index 2c4b4a7684..697d79c4a0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core.lean @@ -3,18 +3,20 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization -import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity -import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers -import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization -import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation -import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus -import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor -import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements -import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +public import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +public import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +public import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean index 572301d1bd..cc8034966a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Action.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic /-! # The Markoff group action @@ -18,6 +20,8 @@ The origin is fixed by every generator, hence by all of `Gamma`. Consequently t acts on the punctured surface; this is the action used in finite-field transitivity statements. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean index 945cd7f4bc..ad89eb1487 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Basic.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Data.Fintype.Sigma -import Mathlib.Tactic -import Mathlib.Tactic.Ring.Basic + +public import Mathlib.Data.Fintype.Sigma +public import Mathlib.Tactic +public import Mathlib.Tactic.Ring.Basic /-! # The elementary Markoff surface @@ -17,6 +19,8 @@ trace coordinates obtained by multiplying each coordinate by three; that normalization is deliberately kept separate. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean index d596fe878c..e95dbdbf47 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers -import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification /-! # Explicit parametrizations of normalized Markoff fibers @@ -16,6 +18,8 @@ rotation is semisimple, its conic is singular, so the paper's claimed single-tor parametrization needs the additional hypothesis that the fixed normalized trace is nonzero. -/ +@[expose] public section + namespace BGS.Markoff universe u @@ -94,7 +98,8 @@ theorem splitFiberPoint_mem (w s : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : rw [splitFiberProduct, splitTorusTrace_sq_sub_four] have hdifference := splitEigenvalueDifference_ne_zero w hw field_simp - simp [splitTorusTrace] + simp only [Units.val_inv_eq_inv_val, ne_eq, Units.ne_zero, not_false_eq_true, mul_inv_cancel_right₀, mul_zero, + mul_eq_zero, OfNat.ofNat_ne_zero, pow_eq_zero_iff] right field_simp ring diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean index e3c67fb38d..46dae3e27e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/EvenSignAction.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action /-! # Even sign changes on the Markoff surface @@ -15,6 +17,8 @@ with them, and coordinate transpositions permute them. Thus `Gamma` normalizes the even-sign subgroup. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean index a6cb9a032a..b61648afd3 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/FiniteRotationEigenvalues.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers -import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +public import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus /-! # Finite-order Markoff rotations have torsion eigenvalues @@ -20,6 +22,8 @@ matrix is deliberately not assumed here. It is a separate geometric step, and is delicate at the parabolic traces `2` and `-2`. -/ +@[expose] public section + namespace BGS.Markoff open scoped Matrix diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean index b8e599519c..eac66430a7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/NatConnectivity.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor /-! # Connectivity of natural-number Markoff solutions @@ -21,6 +23,8 @@ Natural subtraction is used only after proving the needed lower bound, so reduct recovers the usual Vieta involution. -/ +@[expose] public section + namespace BGS.Markoff /-- The first Vieta replacement on points with natural-number coordinates. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean index 1af6e646db..67b479f2cd 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Normalization.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic /-! # Normalized coordinates on the Markoff surface @@ -15,6 +17,8 @@ Vieta moves, and proves that coordinatewise scaling by three identifies the two three is invertible. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean index 0ac820202e..b897918607 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/NormalizedOrbit.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization /-! # Markoff components in normalized coordinates @@ -16,6 +18,8 @@ specific group word for the fundamental rotation and proves that every iterate o rotation stays in the same transported component. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean index 967e95b4a7..fff08a28c7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ParabolicFibers.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization -import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation -import Mathlib.NumberTheory.LegendreSymbol.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +public import Mathlib.NumberTheory.LegendreSymbol.Basic /-! # Parabolic fibers of the normalized Markoff surface @@ -17,6 +19,8 @@ so the exceptional values are `2` and `-2`, not the original-coordinate values ` `-2 / 3`. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean index 1af4c6cefd..64815ce682 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/PuncturedNormalization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization /-! # Normalization on the punctured Markoff surface @@ -15,6 +17,8 @@ punctured surface when three is invertible. The assembly-specific small-order s through this equivalence are defined in `BGS.Markoff.Assembly.PuncturedSmallOrderCount`. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean index 5f8f80932e..363b3ff767 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic /-! # The normalized Markoff rotation @@ -14,6 +16,8 @@ rotation. The parameter of `rho` is a normalized trace coordinate. Thus the rota original Markoff coordinate `x.x1` is obtained by specializing the parameter to `3 * x.x1`. -/ +@[expose] public section + namespace BGS.Markoff universe u @@ -83,7 +87,7 @@ def movingCoordinates (x : Point R) : Fin 2 → R := /-- The fundamental rotation is the action of `rho(3 * x.x1)` on the moving coordinates. -/ theorem rho_mulVec_movingCoordinates (x : Point R) : rho (3 * x.x1) *ᵥ movingCoordinates x = movingCoordinates (rotate1 x) := by - simpa [movingCoordinates, rotate1] using rho_mulVec (3 * x.x1) x.x2 x.x3 + simp [movingCoordinates, rotate1] using rho_mulVec (3 * x.x1) x.x2 x.x3 /-- The normalized trace parameter for the fundamental rotation is `3 * x.x1`. -/ theorem rho_trace_fundamentalRotation (x : Point R) : (rho (3 * x.x1)).trace = 3 * x.x1 := by @@ -97,9 +101,9 @@ theorem rotate1_eq_rho (x : Point R) : (rho (3 * x.x1) *ᵥ movingCoordinates x) 1⟩ := by ext · rfl - · simpa [rotate1, movingCoordinates] using + · simp [rotate1, movingCoordinates] using congrFun (rho_mulVec_movingCoordinates x).symm 0 - · simpa [rotate1, movingCoordinates] using + · simp [rotate1, movingCoordinates] using congrFun (rho_mulVec_movingCoordinates x).symm 1 end diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean index 0316388589..15ec90075b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/RotationTorus.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts -import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation -import Mathlib.FieldTheory.Finite.Trace + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +public import Mathlib.FieldTheory.Finite.Trace /-! # Split-torus traces and normalized Markoff rotations @@ -16,6 +18,8 @@ split characteristic polynomial. The two parabolic parameters are excluded by t hypothesis `w ^ 2 ≠ 1`; at those parameters the matrix need not have the same order as `w`. -/ +@[expose] public section + namespace BGS.Markoff open scoped Matrix diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean index be8792230e..0e570686d7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/SemiringFunctor.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action /-! # The Markoff surface on commutative semirings @@ -20,6 +22,8 @@ semiring homomorphisms. It also records the canonical reduction from `ℕ` to ` the semiring definition with the existing ring-level `MarkoffSurface`. -/ +@[expose] public section + open CategoryTheory namespace BGS diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean index 67c0ed01be..a66627f4a5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Statements.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor /-! # Formal statements of the main results @@ -14,6 +16,8 @@ In particular, the threshold in the giant-orbit assertion may depend on `epsilon constant in the lower bound for every orbit is absolute. -/ +@[expose] public section + namespace BGS.Markoff /-- Punctured Markoff transitivity at a prime `p`: the Markoff group has one orbit on the diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean index 951ba2c7dc..094b677925 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/TraceClassification.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus -import Mathlib.FieldTheory.PrimeField + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +public import Mathlib.FieldTheory.PrimeField /-! # Split and nonsplit trace classification @@ -15,6 +17,8 @@ prime field by either the split torus or the concrete norm-one torus in the cano extension. -/ +@[expose] public section + namespace BGS.Markoff open scoped Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean index eb3d7c6968..baf9c44a0d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT + +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean index 45e97da87f..bf7ac736e9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateCoprimeProduct.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts + +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts /-! # Exact first-coordinate product formula @@ -15,6 +17,8 @@ when it is nonzero in every prime factor. The carrier below records that local directly; no real-valued comparison with `exp (-2 * L)` is asserted here. -/ +@[expose] public section + namespace BGS.Markoff open Finset diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean index b765f226d8..671d85a95d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/CoordinateZeroPatternCounts.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct + +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct /-! # Exact coordinate-zero patterns over a squarefree modulus @@ -14,6 +16,8 @@ whose first coordinate vanishes at exactly a prescribed collection of prime fact is an exact finite product; no real asymptotic estimate is used. -/ +@[expose] public section + namespace BGS.Markoff open Finset diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean index 7c8ced8462..8eb0816771 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/LocalCounts.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter -import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT -import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization + +public import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT +public import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization /-! # Elementary local counts on the Markoff surface @@ -17,6 +19,8 @@ character sum, including the exceptional fibers at normalized traces `0`, `2`, a Coordinatewise normalization then transports the results back to the original Markoff surface. -/ +@[expose] public section + namespace BGS.Markoff open Finset diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean index 64d2649463..0f7648b5a9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Diophantine/PrimewiseCRT.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Action -import Mathlib.Data.ZMod.QuotientRing + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +public import Mathlib.Data.ZMod.QuotientRing /-! # Primewise puncturing and the Chinese remainder theorem @@ -23,6 +25,8 @@ This file keeps those carriers distinct and proves that CRT and all five standar respect the primewise carrier. No point-counting result is included here. -/ +@[expose] public section + namespace BGS.Markoff universe u v diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean index 7adc5dc3e2..afffb93a07 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean index 5d5b58f264..b02887704b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic -import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit /-! # Large order in any coordinate reaches a maximal rotation @@ -14,6 +16,8 @@ This packages the first-coordinate endgame with the normalized coordinate permut Markoff-component relation. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean index eaff540f44..f6079c0124 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean index fee67b6147..7faf202238 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/CayleyParametrization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import Mathlib.FieldTheory.IntermediateField.Adjoin.Basic /-! # Cayley coordinates on the nonsplit norm-one torus @@ -21,94 +23,95 @@ explicitly; these are the identities used when the pulled-back trace equation is denominators over the base field. -/ +@[expose] public section + namespace BGS.Markoff section variable (p : ℕ) [Fact p.Prime] -private abbrev F := ZMod p -private abbrev E := quadraticFiniteField p - -noncomputable local instance : Fintype (E p) := Fintype.ofFinite (E p) +noncomputable local instance : Fintype (quadraticFiniteField p) := Fintype.ofFinite (quadraticFiniteField p) noncomputable local instance : Fintype {w : quadraticNormOneTorus p // w ≠ 1} := Fintype.ofFinite _ -private theorem quadraticExtension_finrank : Module.finrank (F p) (E p) = 2 := by - simpa [F, E] using GaloisField.finrank p (n := 2) +private theorem quadraticExtension_finrank : Module.finrank (ZMod p) (quadraticFiniteField p) = 2 := by + simpa using GaloisField.finrank p (n := 2) private theorem exists_quadraticNonbaseElement : - ∃ delta : E p, delta ∉ Set.range (algebraMap (F p) (E p)) := by + ∃ delta : quadraticFiniteField p, delta ∉ Set.range (algebraMap (ZMod p) (quadraticFiniteField p)) := by classical - have hnotSurjective : ¬ Function.Surjective (algebraMap (F p) (E p)) := by + have hnotSurjective : ¬ Function.Surjective (algebraMap (ZMod p) (quadraticFiniteField p)) := by intro hsurjective - have hbijective : Function.Bijective (algebraMap (F p) (E p)) := - ⟨(algebraMap (F p) (E p)).injective, hsurjective⟩ - have hone : Module.finrank (F p) (E p) = 1 := + have hbijective : Function.Bijective (algebraMap (ZMod p) (quadraticFiniteField p)) := + ⟨(algebraMap (ZMod p) (quadraticFiniteField p)).injective, hsurjective⟩ + have hone : Module.finrank (ZMod p) (quadraticFiniteField p) = 1 := Algebra.finrank_eq_one_iff_bijective_algebraMap.mpr hbijective rw [quadraticExtension_finrank p] at hone omega - change ¬ ∀ y, ∃ x, algebraMap (F p) (E p) x = y at hnotSurjective + change ¬ ∀ y, ∃ x, algebraMap (ZMod p) (quadraticFiniteField p) x = y at hnotSurjective exact Classical.not_forall.mp hnotSurjective /-- A chosen element of the quadratic finite field which is not defined over the base field. -/ -noncomputable def quadraticNonbaseElement : E p := - Classical.choose (exists_quadraticNonbaseElement p) +noncomputable def quadraticNonbaseElement : quadraticFiniteField p := + Classical.choose (show ∃ delta : quadraticFiniteField p, + delta ∉ Set.range (algebraMap (ZMod p) (quadraticFiniteField p)) from by + exact exists_quadraticNonbaseElement p) theorem quadraticNonbaseElement_not_mem_range : - quadraticNonbaseElement p ∉ Set.range (algebraMap (F p) (E p)) := by + quadraticNonbaseElement p ∉ Set.range (algebraMap (ZMod p) (quadraticFiniteField p)) := by classical exact Classical.choose_spec (exists_quadraticNonbaseElement p) -private theorem quadraticExtension_card : Fintype.card (E p) = p ^ 2 := by - rw [Module.card_eq_pow_finrank (K := F p), quadraticExtension_finrank p, ZMod.card] +private theorem quadraticExtension_card : Fintype.card (quadraticFiniteField p) = p ^ 2 := by + rw [Module.card_eq_pow_finrank (K := ZMod p), quadraticExtension_finrank p, ZMod.card] theorem quadraticNonbaseElement_frobenius_ne_self : quadraticNonbaseElement p ^ p ≠ quadraticNonbaseElement p := by intro hfixed apply quadraticNonbaseElement_not_mem_range p - have hmem : quadraticNonbaseElement p ∈ (⊥ : Subfield (E p)) := - (Subfield.mem_bot_iff_pow_eq_self (F := E p) (p := p)).mpr hfixed - rw [mem_bot_iff_intCast p (E p)] at hmem + have hmem : quadraticNonbaseElement p ∈ (⊥ : Subfield (quadraticFiniteField p)) := + (Subfield.mem_bot_iff_pow_eq_self (F := quadraticFiniteField p) (p := p)).mpr hfixed + rw [mem_bot_iff_intCast p (quadraticFiniteField p)] at hmem rcases hmem with ⟨n, hn⟩ - refine ⟨(n : F p), ?_⟩ + refine ⟨(n : ZMod p), ?_⟩ simpa using hn theorem quadraticNonbaseElement_frobenius_not_mem_range : - quadraticNonbaseElement p ^ p ∉ Set.range (algebraMap (F p) (E p)) := by + quadraticNonbaseElement p ^ p ∉ Set.range (algebraMap (ZMod p) (quadraticFiniteField p)) := by intro hmem rcases hmem with ⟨z, hz⟩ apply quadraticNonbaseElement_frobenius_ne_self p calc quadraticNonbaseElement p ^ p - = algebraMap (F p) (E p) z := hz.symm - _ = (algebraMap (F p) (E p) z) ^ p := by + = algebraMap (ZMod p) (quadraticFiniteField p) z := hz.symm + _ = (algebraMap (ZMod p) (quadraticFiniteField p) z) ^ p := by symm calc - (algebraMap (F p) (E p) z) ^ p = - algebraMap (F p) (E p) (z ^ p) := (map_pow _ z p).symm - _ = algebraMap (F p) (E p) z := by rw [ZMod.pow_card] + (algebraMap (ZMod p) (quadraticFiniteField p) z) ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) (z ^ p) := (map_pow _ z p).symm + _ = algebraMap (ZMod p) (quadraticFiniteField p) z := by rw [ZMod.pow_card] _ = (quadraticNonbaseElement p ^ p) ^ p := by rw [← hz] _ = quadraticNonbaseElement p := by rw [← pow_mul, ← pow_two, ← quadraticExtension_card p] exact FiniteField.pow_card _ -private theorem algebraMap_sub_nonzero (z : F p) : - algebraMap (F p) (E p) z - quadraticNonbaseElement p ≠ 0 := by +private theorem algebraMap_sub_nonzero (z : ZMod p) : + algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ≠ 0 := by rw [sub_ne_zero] exact fun h => quadraticNonbaseElement_not_mem_range p ⟨z, h⟩ -private theorem algebraMap_sub_frobenius_nonzero (z : F p) : - algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p ≠ 0 := by +private theorem algebraMap_sub_frobenius_nonzero (z : ZMod p) : + algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p ≠ 0 := by rw [sub_ne_zero] exact fun h => quadraticNonbaseElement_frobenius_not_mem_range p ⟨z, h⟩ /-- The Cayley fraction before it is packaged as a norm-one unit. -/ -noncomputable def quadraticCayleyValue (z : F p) : E p := - (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) / - (algebraMap (F p) (E p) z - quadraticNonbaseElement p) +noncomputable def quadraticCayleyValue (z : ZMod p) : quadraticFiniteField p := + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) / + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p) -theorem quadraticCayleyValue_ne_zero (z : F p) : quadraticCayleyValue p z ≠ 0 := by +theorem quadraticCayleyValue_ne_zero (z : ZMod p) : quadraticCayleyValue p z ≠ 0 := by exact div_ne_zero (algebraMap_sub_frobenius_nonzero p z) (algebraMap_sub_nonzero p z) theorem quadraticNonbaseElement_frobenius_frobenius : @@ -116,47 +119,47 @@ theorem quadraticNonbaseElement_frobenius_frobenius : rw [← pow_mul, ← pow_two, ← quadraticExtension_card p] exact FiniteField.pow_card _ -theorem quadraticCayleyValue_frobenius (z : F p) : +theorem quadraticCayleyValue_frobenius (z : ZMod p) : quadraticCayleyValue p z ^ p = (quadraticCayleyValue p z)⁻¹ := by - rw [quadraticCayleyValue, div_pow, sub_pow_char (R := E p), sub_pow_char (R := E p), + rw [quadraticCayleyValue, div_pow, sub_pow_char (R := quadraticFiniteField p), sub_pow_char (R := quadraticFiniteField p), ← map_pow, ZMod.pow_card, quadraticNonbaseElement_frobenius_frobenius p] rw [inv_div] /-- Frobenius exchanges the two linear factors occurring in the Cayley coordinate. -/ -theorem quadraticCayleyBaseFactor_frobenius (z : F p) : - (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ p = - algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p := by - rw [sub_pow_char (R := E p)] +theorem quadraticCayleyBaseFactor_frobenius (z : ZMod p) : + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p) ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p := by + rw [sub_pow_char (R := quadraticFiniteField p)] calc - algebraMap (F p) (E p) z ^ p - quadraticNonbaseElement p ^ p = - algebraMap (F p) (E p) (z ^ p) - quadraticNonbaseElement p ^ p := by + algebraMap (ZMod p) (quadraticFiniteField p) z ^ p - quadraticNonbaseElement p ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) (z ^ p) - quadraticNonbaseElement p ^ p := by rw [map_pow] - _ = algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p := by + _ = algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p := by rw [ZMod.pow_card] /-- Applying Frobenius again returns the other Cayley linear factor. -/ -theorem quadraticCayleyConjugateFactor_frobenius (z : F p) : - (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ p = - algebraMap (F p) (E p) z - quadraticNonbaseElement p := by - rw [sub_pow_char (R := E p)] +theorem quadraticCayleyConjugateFactor_frobenius (z : ZMod p) : + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p := by + rw [sub_pow_char (R := quadraticFiniteField p)] calc - algebraMap (F p) (E p) z ^ p - (quadraticNonbaseElement p ^ p) ^ p = - algebraMap (F p) (E p) (z ^ p) - quadraticNonbaseElement p := by + algebraMap (ZMod p) (quadraticFiniteField p) z ^ p - (quadraticNonbaseElement p ^ p) ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) (z ^ p) - quadraticNonbaseElement p := by rw [map_pow, quadraticNonbaseElement_frobenius_frobenius p] - _ = algebraMap (F p) (E p) z - quadraticNonbaseElement p := by + _ = algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p := by rw [ZMod.pow_card] /-- The product of the conjugate Cayley factors is Frobenius-fixed, hence is a base-field coefficient in the descended equation. -/ -theorem quadraticCayleyFactorProduct_frobenius (z : F p) : - ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * - (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ p = - (algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * - (algebraMap (F p) (E p) z - quadraticNonbaseElement p) := by +theorem quadraticCayleyFactorProduct_frobenius (z : ZMod p) : + ((algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p)) ^ p = + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p) := by rw [mul_pow, quadraticCayleyConjugateFactor_frobenius p, quadraticCayleyBaseFactor_frobenius p, mul_comm] -private theorem div_pow_add_inv_pow (A B : E p) (hA : A ≠ 0) (hB : B ≠ 0) (d : ℕ) : +private theorem div_pow_add_inv_pow (A B : quadraticFiniteField p) (hA : A ≠ 0) (hB : B ≠ 0) (d : ℕ) : (A / B) ^ d + ((A / B) ^ d)⁻¹ = (A ^ (2 * d) + B ^ (2 * d)) / ((A * B) ^ d) := by rw [Nat.mul_comm 2 d, pow_mul, pow_mul, div_pow, inv_div, mul_pow] @@ -164,66 +167,66 @@ private theorem div_pow_add_inv_pow (A B : E p) (hA : A ≠ 0) (hB : B ≠ 0) (d /-- Clearing the Cayley denominator gives the symmetric numerator used for powers of a norm-one parameter. -/ -theorem quadraticCayleyValue_pow_add_inv_pow (z : F p) (d : ℕ) : +theorem quadraticCayleyValue_pow_add_inv_pow (z : ZMod p) (d : ℕ) : quadraticCayleyValue p z ^ d + (quadraticCayleyValue p z ^ d)⁻¹ = - ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + - (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ (2 * d)) / - (((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * - (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ d) := by + ((algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p) ^ (2 * d)) / + (((algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p)) ^ d) := by exact div_pow_add_inv_pow p _ _ (algebraMap_sub_frobenius_nonzero p z) (algebraMap_sub_nonzero p z) d -theorem quadraticCayleyValue_ne_one (z : F p) : quadraticCayleyValue p z ≠ 1 := by +theorem quadraticCayleyValue_ne_one (z : ZMod p) : quadraticCayleyValue p z ≠ 1 := by intro hone have hnumerator : - algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p = - algebraMap (F p) (E p) z - quadraticNonbaseElement p := by + algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p = + algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p := by exact (div_eq_one_iff_eq (algebraMap_sub_nonzero p z)).mp hone exact quadraticNonbaseElement_frobenius_ne_self p (sub_right_inj.mp hnumerator) /-- The Cayley coordinate as a unit of the quadratic finite field. -/ -noncomputable def quadraticCayleyUnit (z : F p) : (E p)ˣ := +noncomputable def quadraticCayleyUnit (z : ZMod p) : (quadraticFiniteField p)ˣ := Units.mk0 (quadraticCayleyValue p z) (quadraticCayleyValue_ne_zero p z) -theorem quadraticCayleyUnit_norm (z : F p) : - Algebra.norm (F p) (quadraticCayleyUnit p z : E p) = 1 := by - apply (algebraMap (F p) (E p)).injective +theorem quadraticCayleyUnit_norm (z : ZMod p) : + Algebra.norm (ZMod p) (quadraticCayleyUnit p z : quadraticFiniteField p) = 1 := by + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective rw [map_one, algebraMap_quadraticNorm p] change quadraticCayleyValue p z * quadraticCayleyValue p z ^ p = 1 rw [quadraticCayleyValue_frobenius p] exact mul_inv_cancel₀ (quadraticCayleyValue_ne_zero p z) /-- The Cayley coordinate, regarded as a point of the norm-one torus. -/ -noncomputable def quadraticCayleyPoint (z : F p) : quadraticNormOneTorus p := +noncomputable def quadraticCayleyPoint (z : ZMod p) : quadraticNormOneTorus p := ⟨quadraticCayleyUnit p z, by - change Units.map (Algebra.norm (F p) (S := E p)) (quadraticCayleyUnit p z) = 1 + change Units.map (Algebra.norm (ZMod p) (S := quadraticFiniteField p)) (quadraticCayleyUnit p z) = 1 apply Units.ext exact quadraticCayleyUnit_norm p z⟩ -theorem quadraticCayleyPoint_ne_one (z : F p) : quadraticCayleyPoint p z ≠ 1 := by +theorem quadraticCayleyPoint_ne_one (z : ZMod p) : quadraticCayleyPoint p z ≠ 1 := by intro h have hval := congrArg (fun w : quadraticNormOneTorus p => - (((w : (E p)ˣ) : E p))) h + (((w : (quadraticFiniteField p)ˣ) : quadraticFiniteField p))) h exact quadraticCayleyValue_ne_one p z (by simpa [quadraticCayleyPoint, quadraticCayleyUnit] using hval) /-- The base-field trace of a powered Cayley point is the cleared symmetric Cayley fraction. -/ theorem algebraMap_quadraticNormOneTrace_quadraticCayleyPoint_pow - (z : F p) (d : ℕ) : - algebraMap (F p) (E p) (quadraticNormOneTrace p (quadraticCayleyPoint p z ^ d)) = - ((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + - (algebraMap (F p) (E p) z - quadraticNonbaseElement p) ^ (2 * d)) / - (((algebraMap (F p) (E p) z - quadraticNonbaseElement p ^ p) * - (algebraMap (F p) (E p) z - quadraticNonbaseElement p)) ^ d) := by + (z : ZMod p) (d : ℕ) : + algebraMap (ZMod p) (quadraticFiniteField p) (quadraticNormOneTrace p (quadraticCayleyPoint p z ^ d)) = + ((algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) ^ (2 * d) + + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p) ^ (2 * d)) / + (((algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p ^ p) * + (algebraMap (ZMod p) (quadraticFiniteField p) z - quadraticNonbaseElement p)) ^ d) := by rw [algebraMap_quadraticNormOneTrace] simpa [splitTorusTrace, quadraticCayleyPoint, quadraticCayleyUnit] using quadraticCayleyValue_pow_add_inv_pow p z d /-- Solving the Cayley fraction for its base-field coordinate gives the expected inverse fraction. -/ -theorem quadraticCayleyInverseFormula_point (z : F p) : +theorem quadraticCayleyInverseFormula_point (z : ZMod p) : ((quadraticCayleyValue p z * quadraticNonbaseElement p - quadraticNonbaseElement p ^ p) / - (quadraticCayleyValue p z - 1)) = algebraMap (F p) (E p) z := by + (quadraticCayleyValue p z - 1)) = algebraMap (ZMod p) (quadraticFiniteField p) z := by have hdelta : quadraticNonbaseElement p - quadraticNonbaseElement p ^ p ≠ 0 := sub_ne_zero.mpr (quadraticNonbaseElement_frobenius_ne_self p).symm rw [quadraticCayleyValue] @@ -232,15 +235,15 @@ theorem quadraticCayleyInverseFormula_point (z : F p) : ring private theorem quadraticCayleyPoint_injective : - Function.Injective (fun z : F p => + Function.Injective (fun z : ZMod p => (⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ : {w : quadraticNormOneTorus p // w ≠ 1})) := by intro z r h have hvalue : quadraticCayleyValue p z = quadraticCayleyValue p r := by have htorus := congrArg Subtype.val h - have hunit := congrArg (fun w : quadraticNormOneTorus p => (w : (E p)ˣ)) htorus + have hunit := congrArg (fun w : quadraticNormOneTorus p => (w : (quadraticFiniteField p)ˣ)) htorus exact congrArg Units.val hunit - apply (algebraMap (F p) (E p)).injective + apply (algebraMap (ZMod p) (quadraticFiniteField p)).injective rw [← quadraticCayleyInverseFormula_point p z, ← quadraticCayleyInverseFormula_point p r, hvalue] @@ -253,7 +256,7 @@ private theorem quadraticCayleyTarget_card : omega private theorem quadraticCayleyPoint_bijective : - Function.Bijective (fun z : F p => + Function.Bijective (fun z : ZMod p => (⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ : {w : quadraticNormOneTorus p // w ≠ 1})) := by rw [Fintype.bijective_iff_injective_and_card] @@ -262,33 +265,33 @@ private theorem quadraticCayleyPoint_bijective : /-- Cayley coordinates identify the affine line with the norm-one torus minus its identity. -/ noncomputable def quadraticCayleyParameterEquiv : - F p ≃ {w : quadraticNormOneTorus p // w ≠ 1} := + ZMod p ≃ {w : quadraticNormOneTorus p // w ≠ 1} := Equiv.ofBijective (fun z => (⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ : {w : quadraticNormOneTorus p // w ≠ 1})) - (quadraticCayleyPoint_bijective p) + (by exact quadraticCayleyPoint_bijective p) @[simp] -theorem quadraticCayleyParameterEquiv_apply (z : F p) : +theorem quadraticCayleyParameterEquiv_apply (z : ZMod p) : quadraticCayleyParameterEquiv p z = ⟨quadraticCayleyPoint p z, quadraticCayleyPoint_ne_one p z⟩ := rfl /-- The inverse coordinate has the explicit fraction used in the descent calculation. -/ theorem algebraMap_quadraticCayleyParameterEquiv_symm (w : {w : quadraticNormOneTorus p // w ≠ 1}) : - algebraMap (F p) (E p) ((quadraticCayleyParameterEquiv p).symm w) = - (((w.1 : (E p)ˣ) : E p) * quadraticNonbaseElement p - + algebraMap (ZMod p) (quadraticFiniteField p) ((quadraticCayleyParameterEquiv p).symm w) = + (((w.1 : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) * quadraticNonbaseElement p - quadraticNonbaseElement p ^ p) / - (((w.1 : (E p)ˣ) : E p) - 1) := by + (((w.1 : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) - 1) := by have happly := (quadraticCayleyParameterEquiv p).apply_symm_apply w have hvalue : quadraticCayleyValue p ((quadraticCayleyParameterEquiv p).symm w) = - ((w.1 : (E p)ˣ) : E p) := by + ((w.1 : (quadraticFiniteField p)ˣ) : quadraticFiniteField p) := by have htorus := congrArg Subtype.val happly change quadraticCayleyPoint p ((quadraticCayleyParameterEquiv p).symm w) = w.1 at htorus have hunit := congrArg Subtype.val htorus change quadraticCayleyUnit p ((quadraticCayleyParameterEquiv p).symm w) = - (w.1 : (E p)ˣ) at hunit + (w.1 : (quadraticFiniteField p)ˣ) at hunit have h := congrArg Units.val hunit exact h rw [← quadraticCayleyInverseFormula_point p] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean index 19d2fa4b4e..707da12c30 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve -import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +public import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution /-! # Absolute irreducibility of the descended nonsplit trace curve @@ -15,6 +17,8 @@ keep `u` as the outer polynomial variable and treat the Cayley change `w = (z-δ an automorphism of the rational function coefficient field. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean index 030dcf28fb..dc9fa2c816 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import Mathlib.Algebra.Polynomial.Eval.Degree + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import Mathlib.Algebra.Polynomial.Eval.Degree /-! # The descended seeded nonsplit trace curve @@ -19,6 +21,8 @@ its bidegree bounds, and compares its base-field solutions exactly with the orig solutions. Absolute irreducibility is deliberately a theorem to be proved, not an assumption. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean index 228cf5a466..ecd87afc86 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/HasseFromGeneral.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption /-! # The nonsplit endgame estimate from the general affine Hasse--Weil theorem @@ -15,6 +17,8 @@ plane curve. The identity point omitted by the Cayley chart is kept visible and separately; it is not folded into a specialized estimate assumption. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean index 20ae9f447a..a3145c10fa 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/SeededCover.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility /-! # The seeded nonsplit endgame cover @@ -16,6 +18,8 @@ nontrivial norm fibre is multiplied by the varying norm-one coordinate. After s the two weights are `s` and `s^p`; their product is `Norm(s)`, not one. -/ +@[expose] public section + namespace BGS.Markoff section GeneralSeed diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean index 49f70ae98f..81d7d14481 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Parabolic.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers /-! # The parabolic branch of the endgame @@ -16,6 +18,8 @@ coordinate run through the whole base field, so in particular through the trace of the split torus. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean index 3e389e5097..3bf9acdfb5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PowerCoverCounting.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.GroupTheory.SpecificGroups.Cyclic -import Mathlib.GroupTheory.Coset.Basic + +public import Mathlib.GroupTheory.SpecificGroups.Cyclic +public import Mathlib.GroupTheory.Coset.Basic /-! # Exact power-cover multiplicities in the endgame @@ -16,6 +18,8 @@ with one point in each power-map fiber, and every such fiber is equivalent to th kernel. No asymptotic or geometric estimate enters this multiplicity identity. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean index b76348faee..5228c243d3 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveInclusionExclusion.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange -import Mathlib.NumberTheory.ArithmeticFunction.Moebius + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +public import Mathlib.NumberTheory.ArithmeticFunction.Moebius /-! # Möbius inclusion--exclusion for primitive endgame traces @@ -17,6 +19,8 @@ element, applies Möbius inversion, and identifies the cumulative order-divisibi corresponding right power-map image. -/ +@[expose] public section + namespace BGS.Markoff open scoped ArithmeticFunction.Moebius BigOperators diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean index 6490643d4b..77154013c1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveOrbitWiring.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring /-! # Transporting primitive trace pairs back to rotation orbits @@ -15,6 +17,8 @@ parametrizations use the cyclic subgroup generated by the rotation eigenvalue. proves the exact transport between those two representations in the split and nonsplit cases. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean index 0b6a815ab0..21e582d8f1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/PrimitiveTraceCount.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting /-! # Endgame point estimates after quotienting by the power maps @@ -20,6 +22,8 @@ actual base-field solution finset on the norm-one torus; it never replaces that quadratic-field points. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean index 46b46442fc..e2c61edd33 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilBoundAssumption.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover -import Mathlib.Analysis.SpecialFunctions.Pow.Real + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +public import Mathlib.Analysis.SpecialFunctions.Pow.Real /-! # The explicit endgame Weil-bound assumption @@ -31,6 +33,8 @@ are intentionally not part of the downstream interface: they belong to a proof o external theorem, not to each use of it. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean index c71ccfe6da..e68f2ead07 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/WeilFromGeneralHasse.lean @@ -3,15 +3,19 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary + +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary /-! # Applying the general affine Hasse--Weil theorem to split trace covers -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean index 610f5c6e48..08cff05f72 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEndgame.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring -import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity + +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity /-! # Explicit endgame and cage connectivity @@ -18,6 +20,8 @@ inequalities at a fixed prime; the final wrappers discharge those inequalities from `explicitStrongApproximationCutoff`. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean index eaacb2496f..f9947c6676 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitEstimates.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane -import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil + +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil /-! # Fixed point-count estimates for explicit strong approximation @@ -18,6 +20,8 @@ The general affine Hasse--Weil theorem in this repository has coefficient four numerical specializations used by the explicit Markoff argument. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean index c255ee77ee..18f9acbcb1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumericCertificates.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics + +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics /-! # Numerical certificates for the explicit strong-approximation cutoff @@ -13,6 +15,8 @@ This file packages the closed real-power and natural-power calculations used by the explicit middle game, endgame, cage, and small-order argument. -/ +@[expose] public section + namespace BGS.Markoff open scoped Topology diff --git a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean index 4fe869c496..ce1db82d09 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/ExplicitNumerics.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion + +public import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion /-! # Closed numerical bounds for explicit strong approximation @@ -15,6 +17,8 @@ All constants in this file are closed natural-number expressions. In particular, no witness is extracted from an eventual or asymptotic theorem. -/ +@[expose] public section + namespace BGS.Markoff open scoped Topology diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean index 68f55b0e04..6ab8db740e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount + +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean index cb12cfbfa6..e3c29e57df 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/CoordinateRing.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers -import Mathlib.FieldTheory.KummerPolynomial -import Mathlib.RingTheory.TensorProduct.MvPolynomial -import Mathlib.RingTheory.TensorProduct.Quotient + +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +public import Mathlib.FieldTheory.KummerPolynomial +public import Mathlib.RingTheory.TensorProduct.MvPolynomial +public import Mathlib.RingTheory.TensorProduct.Quotient /-! # Geometric integrality of the incidence auxiliary coordinate ring @@ -16,6 +18,8 @@ This module proves the missing coordinate-ring algebra by an explicit base chang biquadratic normal form. Every declaration is proved; there are no placeholder axioms. -/ +@[expose] public section + namespace BGS.Markoff open MvPolynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean index 8519133388..a2795970d3 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Counterexamples.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers + +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers /-! # Small-prime counterexamples to the printed incidence threshold @@ -13,6 +15,8 @@ These kernel-checked examples show that the paper's claim for every prime `p > 1 the exact admissible auxiliary-point statement used by its diameter-two argument. -/ +@[expose] public section + namespace BGS.Markoff local instance {p : ℕ} [Fact p.Prime] (a : ZMod p) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean index 614b5a3bfe..e7173a4718 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Fibers.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount + +public import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount /-! # Incidence of Markoff conic fibers @@ -17,6 +19,8 @@ integrality is proved in `BGS.Markoff.IncidenceCoordinateRing`; the independent gap is isolated in `BGS.FiniteField.EllipticCharacterSum`. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean index 3da561422e..a295d1b00b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/Geometry.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic /-! # Square classes for the incidence auxiliary curve @@ -14,6 +16,8 @@ of the off-diagonal incidence curve. The remaining coordinate-ring normal-form stated separately in `BGS.Markoff.Incidence`. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean index 4c552997cb..251ac21490 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/NormalizedGraph.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers -import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers + +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers /-! # The normalized incidence graph and its parabolic vertices @@ -18,6 +20,8 @@ The key fact is stronger than mere connectivity: after choosing `i² = -1`, a fi normalized coordinate is `2` or `-2` meets every fiber on either different coordinate axis. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean index b103ee5086..a3d85901ec 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Incidence/PointCount.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic -import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum -import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +public import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +public import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter /-! # Point-count algebra for the incidence auxiliary curve @@ -15,6 +17,8 @@ This file reduces the off-diagonal auxiliary-curve count to the exact Hasse char in `BGS.FiniteField.EllipticCharacterSum`. -/ +@[expose] public section + namespace BGS.Markoff open Finset diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean index b4f20a3ef9..cb4f7cfa38 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame.lean @@ -3,22 +3,24 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean index 8f4610da69..2ed6f72040 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierEscape.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights /-! # Feeding the geometric Corvaja--Zannier estimate into a Markoff move @@ -20,6 +22,8 @@ neighboring rotation order. No independent weighted-finset estimate remains bet curve theorem and the dynamical conclusion. -/ +@[expose] public section + namespace BGS.Markoff /-- The uniform weighted-trace bound, after Lean verifies every concrete diagonalized Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean index 52ccdb0410..dc2748c1b1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierFromGeneral.lean @@ -3,18 +3,22 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus -import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier + +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier /-! # Applying general Corvaja--Zannier to the weighted trace curve -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean index 744b74e4bf..9912790cb0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierGeometry.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation -import Mathlib.FieldTheory.IsAlgClosed.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +public import Mathlib.FieldTheory.IsAlgClosed.Basic /-! # The geometric Corvaja--Zannier interface for the middle game @@ -27,6 +29,8 @@ gives `48 m₁ m₂ / p`. Accordingly the source-backed envelope in this module `48`; obtaining `20` requires a separate argument. -/ +@[expose] public section + namespace BGS.Markoff section GeometricCurve diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean index 6fb6310c2f..953f1722a9 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSeparability.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry -import Mathlib.FieldTheory.Separable -import Mathlib.RingTheory.Derivation.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +public import Mathlib.FieldTheory.Separable +public import Mathlib.RingTheory.Derivation.Basic /-! # Prime-to-characteristic torsion exponents for Corvaja--Zannier @@ -24,6 +26,8 @@ nonzero differential. Thus inseparability is not part of the remaining Corvaja--Zannier wall. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean index 324c4a1c9c..4ecd54308d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierSourceBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound /-! # The source-faithful Corvaja--Zannier numerical specialization @@ -18,6 +20,8 @@ This is only the numerical specialization. It does not postulate or prove the g torsion-intersection estimate. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean index 25d4c8f6fd..efdf45e15f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CorvajaZannierStep.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound /-! # The Corvaja--Zannier middle-game escape step @@ -21,6 +23,8 @@ The theorem below reduces the paper-specific order-increase step to one visible inequality. It does not postulate the Corvaja--Zannier theorem. -/ +@[expose] public section + namespace BGS.Markoff variable {E : Type*} [Field E] [Fintype E] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean index d8619d621e..b2272b2003 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/CosetTraceEquation.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation /-! # The coset form of the middle-game trace equation @@ -24,6 +26,8 @@ turn the coset into a subgroup. Any Corvaja--Zannier input used for an arbitrar must therefore cover these multiplicative cosets. -/ +@[expose] public section + namespace BGS.Markoff variable {E : Type*} [Field E] [Fintype E] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean index a5fe553fe7..88523ebe87 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/Diagonalization.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape /-! # Diagonalizing an arbitrary nonzero nonparabolic Markoff fiber @@ -18,6 +20,8 @@ The trace-zero fiber is excluded explicitly. Its conic is singular and the exis parametrization is introduced for that branch. -/ +@[expose] public section + namespace BGS.Markoff /-- The singular trace-zero rotation has order at most four. This keeps the trace-zero fiber diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean index 324e296247..66c8ae6c58 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/DivisorRange.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep /-! # Divisor estimates in the middle-game range @@ -13,6 +15,8 @@ Choose eventual thresholds where divisor counts satisfy the real-power bounds re middle-game argument. -/ +@[expose] public section + namespace BGS.Markoff open Filter diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean index 7ea5068683..c5f7e4fc63 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedCorvajaZannierBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing +public import Mathlib.Tactic /-! # Right-inversion pairing with Euler budget seven @@ -20,6 +22,8 @@ support by two. The resulting root coefficient has cube The quotient-by-characteristic coefficient remains exactly `24`. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean index 2f1de113b0..631417a0e2 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierEscape.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights /-! # Unconditional Euler-seven paired maximal-divisor middle-game escape @@ -15,6 +17,8 @@ The exact support-index and Euler-characteristic calculation improves the paired cube condition from `(6 * K)^3 < d` to `189 * K^3 < d`. -/ +@[expose] public section + namespace BGS.Markoff /-- Diagonalize a nonzero nonparabolic fiber and apply the exact diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean index eb3db991e3..6ed9a032dc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorCorvajaZannierStep.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound +public import Mathlib.Tactic /-! # Euler-seven paired escape over maximal candidate orders @@ -21,6 +23,8 @@ Here `K` is the number of divisibility-maximal candidate orders. The first coefficient is exact: it is the cube of the paired χ≤7 root coefficient. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean index a925dda3d8..2e22b8ad96 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/EulerSevenPairedMaximalDivisorOrderEscape.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep /-! # Euler-seven paired nonparabolic order escape @@ -14,6 +16,8 @@ This is the diagonalized-fiber wiring for the exact cube condition `189*K^3 < currentOrder`. -/ +@[expose] public section + namespace BGS.Markoff theorem diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean index 6ca2c473f8..fe1c8d821c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierEscape.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound /-! # Feeding the weighted trace bound into maximal-divisor escape @@ -17,6 +19,8 @@ all finite multiplicative subgroups. This adapter applies it only to the divisibility-maximal right subgroups required by the improved middle game. -/ +@[expose] public section + namespace BGS.Markoff /-- Diagonalize a nonzero nonparabolic fiber and apply the maximal-order diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean index 54ca308a14..57b07bc265 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorCorvajaZannierStep.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover /-! # Corvaja--Zannier escape over maximal candidate orders @@ -19,6 +21,8 @@ Corvaja--Zannier estimate remains an explicit hypothesis about the actual weighted trace-equation solution sets. -/ +@[expose] public section + namespace BGS.Markoff variable {E : Type*} [Field E] [Fintype E] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean index ca35e0750f..7ca9bb8950 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorNonparabolicOrderCover.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover /-! # Nonparabolic witnesses in maximal right-order subgroups @@ -15,6 +17,8 @@ fact needed for inversion pairing: the representing eigenvalue is not fixed by inversion. -/ +@[expose] public section + namespace BGS.Markoff /-- A square-one eigenvalue has parabolic split trace. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean index 82fb598224..27a3c9b1a6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderCover.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape -import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +public import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds /-! # Maximal candidate orders in the Markoff middle game @@ -15,6 +17,8 @@ the canonical roots-of-unity subgroups are monotone under that divisibility. Hence the Corvaja--Zannier union only needs maximal orders. -/ +@[expose] public section + namespace BGS.Markoff open BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean index b605e62d21..2eaba74132 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MaximalDivisorOrderEscape.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep /-! # Nonparabolic order escape using maximal divisors @@ -14,6 +16,8 @@ all the way through. The Corvaja--Zannier hypothesis and both numerical inequalities are required only for divisibility-maximal candidate orders. -/ +@[expose] public section + namespace BGS.Markoff /-- Complete nonparabolic order escape from a diagonalized fiber, with the diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean index 75da7ad713..605d17d6b8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/MoveWiring.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry /-! # Wiring the middle-game trace escape to Markoff moves @@ -23,6 +25,8 @@ states the separate split/nonsplit classification interface that must be constru chosen family of right subgroups. -/ +@[expose] public section + namespace BGS.Markoff variable {E : Type*} [Field E] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean index adcab6b37d..569f81ddbf 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/NonparabolicUnionBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing /-! # Finite unions of nonparabolic trace supports @@ -16,6 +18,8 @@ inserted. In particular, the inversion-pairing factor can be applied to each right subgroup without counting its two fixed points. -/ +@[expose] public section + namespace BGS.Markoff variable {E : Type*} [Field E] [Fintype E] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean index 77ed2c65de..aedbe2c13d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/OrderEscape.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation /-! # The nonparabolic middle-game order-escape step @@ -17,6 +19,8 @@ the split/nonsplit trace classification, and the weighted coset coordinate ident deep input is the weighted Corvaja--Zannier cardinal estimate on the actual solution finsets. -/ +@[expose] public section + namespace BGS.Markoff /-- Scalar extension commutes with every iterate of the normalized rotation. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean index 66d2f58d44..fbe67677a2 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedCorvajaZannierBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing /-! # The sharp Corvaja--Zannier bound after right-inversion pairing @@ -23,6 +25,8 @@ coefficients `6` and `24` for the nonparabolic left support. No genus-one or Euler-characteristic-`3` assertion is used here. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean index 38fb86bb1a..3610e127ac 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierEscape.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights /-! # Unconditional paired maximal-divisor middle-game escape @@ -17,6 +19,8 @@ theorem. Thus the paired maximal-order escape applies with no additional geometric hypothesis. -/ +@[expose] public section + namespace BGS.Markoff /-- Diagonalize a nonzero nonparabolic fiber and apply the unconditional diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean index 0bb5fa81e7..60f58639e5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorCorvajaZannierStep.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound /-! # Paired Corvaja--Zannier escape over maximal candidate orders @@ -23,6 +25,8 @@ where `K` is the number of divisibility-maximal candidate orders. No Euler-characteristic improvement is used in this module. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean index 95f766de2f..814c2ad88d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/PairedMaximalDivisorOrderEscape.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep /-! # Paired nonparabolic order escape using maximal divisors @@ -17,6 +19,8 @@ a maximal candidate subgroup, exactly the kind of witness excluded by the paired finite escape theorem. -/ +@[expose] public section + namespace BGS.Markoff /-- Complete order escape from a diagonalized fiber under the paired diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean index 84fe3be412..6fd2574df4 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/ParabolicEscape.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups /-! # The parabolic middle-game branch @@ -20,6 +22,8 @@ For primes congruent to three modulo four those fibers are empty by the existing `ParabolicFibers`. -/ +@[expose] public section + namespace BGS.Markoff /-- Every endgame power threshold with exponent at most one is bounded by `p`. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean index cfdaddc727..ddd997795a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightInversionPairing.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation /-! # The right-coordinate inversion pairing @@ -16,6 +18,8 @@ factor of two for the nonparabolic left support, while leaving the existing parabolic escape branch responsible for the two fixed points. -/ +@[expose] public section + namespace BGS.Markoff variable {E : Type*} [Field E] [Fintype E] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean index e5b78db7db..f1c35a1a21 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/RightSubgroups.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation -import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification -import Mathlib.RingTheory.RootsOfUnity.PrimitiveRoots + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification +public import Mathlib.RingTheory.RootsOfUnity.PrimitiveRoots /-! # Concrete right subgroups for the middle game @@ -20,6 +22,8 @@ Parabolic traces are deliberately excluded from the representation theorem: thei orders are `p` or `2 * p`, not semisimple torus orders dividing `p - 1` or `p + 1`. -/ +@[expose] public section + namespace BGS.Markoff /-- The canonical right subgroup of order `d` inside the common quadratic extension. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean index 0011179063..ca387fddad 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceCurveWeights.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus /-! # Nondegeneracy of the actual middle-game trace-curve coefficients @@ -17,6 +19,8 @@ that their product is not one. These are the exact coefficient hypotheses used absolute-irreducibility and non-subtorus proofs. -/ +@[expose] public section + namespace BGS.Markoff /-- The explicit nonzero and nondegeneracy conditions imply every geometric diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean index 197802f0ee..b8440f6649 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/TraceEquation.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification /-! # The middle-game trace equation @@ -14,6 +16,8 @@ quadratic-fiber bound used when one subgroup is small. The genuinely deep unifo estimate remains a separate Blueprint input. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean index 6a43de2580..44ea0511e5 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/UnionBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation -import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +public import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound /-! # The middle-game bad-order union @@ -20,6 +22,8 @@ Corvaja--Zannier estimate: the estimate appears below as an ordinary theorem hyp actual trace-equation solution finsets. -/ +@[expose] public section + namespace BGS.Markoff /-- Candidate right rotation orders in the middle game: divisors of `p - 1` or `p + 1` that do diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean index b3871af3bf..484e8dc3fc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound /-! # The weighted-trace torsion-intersection bound @@ -24,6 +26,8 @@ permits the genuine degree-only Euler bound `χ ≤ 8` for a general bidegree-`( unsupported genus-one identification is built into the interface. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean index c12a5f1c8d..de1f8994eb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEquation.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry /-! # The weighted middle-game trace equation @@ -20,6 +22,8 @@ The deep weighted Corvaja--Zannier estimate is an explicit theorem hypothesis; i as an axiom, class, or structure field. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean index bbc5374382..06c577b6db 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSeven.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +public import Mathlib.Tactic /-! # Euler budget seven for the weighted trace curve @@ -24,6 +26,8 @@ This is deliberately weaker than the paper's unsupported value `3`, but it uses only the normalization-place machinery proved in the repository. -/ +@[expose] public section + open scoped Polynomial BigOperators namespace BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean index 952bb6f3a9..e0725e88bf 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound -import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +public import Mathlib.Tactic /-! # The exact Euler-seven weighted trace bound @@ -16,6 +18,8 @@ that range the roots-of-unity count lands directly in the unchanged quotient-by-characteristic branch. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean index ee901db6cd..5ef3295328 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenLargeBound.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint -import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +public import Mathlib.Tactic /-! # The Euler-seven weighted trace bound above the elementary range @@ -16,6 +18,8 @@ This module converts the exact χ≤7 Proposition Two result into its numerical torsion-intersection estimate when `48 < p`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean index 27ffdd8e60..0c1cc5dfbb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTraceEulerSevenPropositionTwo.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +public import Mathlib.Tactic /-! # Proposition Two with Euler budget seven for the weighted trace curve @@ -18,6 +20,8 @@ sparse support determinant bounds the powered-image index by `2`. This module feeds both exact inputs into the natural and swapped Proposition Two proofs. -/ +@[expose] public section + namespace BGS.Markoff open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean index b01b921ca1..536ef82650 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/MiddleGame/WeightedTracePoweredImageIndexTwo.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import Mathlib.Tactic /-! # Powered-image index two for the weighted trace curve @@ -17,6 +19,8 @@ Retaining this exact sparse-support certificate lowers the source-to-powered image index bound from the generic bidegree value `8` to `2`. -/ +@[expose] public section + namespace BGS.Markoff open BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean index 5b8707661a..5a36d3cd00 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening.lean @@ -3,20 +3,22 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction -import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge -import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound -import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic -import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity -import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple -import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard -import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces -import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound -import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean index 90654e12a1..c33648393d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/AlgebraicClosureTransport.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit -import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +public import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure /-! # Transporting the characteristic-zero opening through an algebraic closure @@ -16,6 +18,8 @@ normalized Markoff points coordinatewise and intertwines the five generators. C on `Gamma` then shows that a finite orbit over the source field has finite image orbit over `ℂ`. -/ +@[expose] public section + namespace BGS.Markoff universe u v diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean index a4f5e9d5bd..2429b31fb3 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CompatibleRoots.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed + +public import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed /-! # Compatible powers of a common primitive root @@ -13,6 +15,8 @@ Represent several torsion elements as powers of one primitive root under the req divisibility conditions. -/ +@[expose] public section + namespace BGS.Markoff variable {K : Type*} [Field K] [IsAlgClosed K] [CharZero K] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean index 46ca8b406d..249ff86a4b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction /-! # The concrete cyclotomic opening bound @@ -13,6 +15,8 @@ This file evaluates the integral cyclotomic defect at the compatible residue pri that vanishing to the archimedean norm estimate. -/ +@[expose] public section + open scoped NumberField namespace BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean index 1ad7427665..bf17a1288d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicDefect.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle -import Mathlib.Analysis.Complex.Basic -import Mathlib.Analysis.Complex.Norm + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle +public import Mathlib.Analysis.Complex.Basic +public import Mathlib.Analysis.Complex.Norm /-! # The cyclotomic defect in the opening @@ -17,6 +19,8 @@ is not assumed here: given three complex unit-circle lifts, we define the symmet prove its uniform archimedean bound, and prove that it cannot vanish unless all three traces do. -/ +@[expose] public section + namespace BGS.Markoff /-- The trace associated to a nonzero eigenvalue and its reciprocal. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean index 966232f90d..f0f814f708 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicNorm.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect -import Mathlib.NumberTheory.NumberField.Cyclotomic.Basic -import Mathlib.RingTheory.Ideal.Int + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +public import Mathlib.NumberTheory.NumberField.Cyclotomic.Basic +public import Mathlib.RingTheory.Ideal.Int /-! # The norm and reduction bridge in the cyclotomic opening @@ -21,6 +23,8 @@ finite-field reduction is deliberately not assumed here. Those are the remainin before `prime_dvd_integerNorm_of_quotient_eq_zero` can be applied to the defect. -/ +@[expose] public section + open scoped NumberField namespace BGS.Markoff diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean index faab52f785..86c7b9217d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/CyclotomicReduction.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm -import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure -import Mathlib.NumberTheory.NumberField.Cyclotomic.Basic -import Mathlib.RingTheory.Polynomial.Cyclotomic.Roots + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +public import Mathlib.FieldTheory.IsAlgClosed.AlgebraicClosure +public import Mathlib.NumberTheory.NumberField.Cyclotomic.Basic +public import Mathlib.RingTheory.Polynomial.Cyclotomic.Roots /-! # A compatible prime and reduction for the cyclotomic opening @@ -19,6 +21,8 @@ determines a homomorphism from the ring of integers of `ℚ(ζₙ)`. Its kernel corresponding powers of the prescribed finite-characteristic root. -/ +@[expose] public section + open scoped NumberField open Polynomial @@ -70,7 +74,7 @@ theorem exists_residue_common_primitiveRoot_powers /-- The canonical primitive `n`-th root in the chosen characteristic-zero cyclotomic field. -/ noncomputable def openingCyclotomicRoot (n : ℕ) [NeZero n] : OpeningCyclotomicField n := by - letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : NeZero (n : ℚ) := ⟨by exact neZero_ratCast n⟩ letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ exact IsCyclotomicExtension.zeta n ℚ (OpeningCyclotomicField n) @@ -78,7 +82,7 @@ noncomputable def openingCyclotomicRoot (n : ℕ) [NeZero n] : OpeningCyclotomic /-- The canonical characteristic-zero root has exact order `n`. -/ theorem openingCyclotomicRoot_isPrimitive (n : ℕ) [NeZero n] : IsPrimitiveRoot (openingCyclotomicRoot n) n := by - let : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + let : NeZero (n : ℚ) := ⟨by exact neZero_ratCast n⟩ let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ exact IsCyclotomicExtension.zeta_spec n ℚ (OpeningCyclotomicField n) @@ -91,7 +95,7 @@ noncomputable def openingCyclotomicIntegerRoot (n : ℕ) [NeZero n] : /-- The integral power basis generated by the canonical cyclotomic root. -/ noncomputable def openingCyclotomicIntegralPowerBasis (n : ℕ) [NeZero n] : PowerBasis ℤ (OpeningCyclotomicIntegers n) := by - letI : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + letI : NeZero (n : ℚ) := ⟨by exact neZero_ratCast n⟩ letI : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ exact (openingCyclotomicRoot_isPrimitive n).integralPowerBasis @@ -99,7 +103,7 @@ noncomputable def openingCyclotomicIntegralPowerBasis (n : ℕ) [NeZero n] : @[simp] theorem openingCyclotomicIntegralPowerBasis_gen (n : ℕ) [NeZero n] : (openingCyclotomicIntegralPowerBasis n).gen = openingCyclotomicIntegerRoot n := by - let : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + let : NeZero (n : ℚ) := ⟨by exact neZero_ratCast n⟩ let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ exact (openingCyclotomicRoot_isPrimitive n).integralPowerBasis_gen @@ -113,7 +117,7 @@ private theorem primitiveRoot_isRoot_integralPowerBasis_minpoly have hrootCyclotomic : aeval ω (cyclotomic n ℤ) = 0 := by rw [aeval_def, ← eval_map, map_cyclotomic] exact hω.isRoot_cyclotomic (NeZero.pos n) - let : NeZero (n : ℚ) := ⟨neZero_ratCast n⟩ + let : NeZero (n : ℚ) := ⟨by exact neZero_ratCast n⟩ let : IsCyclotomicExtension {n} ℚ (OpeningCyclotomicField n) := CyclotomicField.isCyclotomicExtension n ℚ rw [openingCyclotomicIntegralPowerBasis_gen] @@ -128,7 +132,7 @@ noncomputable def openingCyclotomicReduction (ω : OpeningResidueClosure p) (hω : IsPrimitiveRoot ω n) : OpeningCyclotomicIntegers n →ₐ[ℤ] OpeningResidueClosure p := (openingCyclotomicIntegralPowerBasis n).lift ω - (primitiveRoot_isRoot_integralPowerBasis_minpoly p n hcoprime ω hω) + (by exact primitiveRoot_isRoot_integralPowerBasis_minpoly p n hcoprime ω hω) /-- The compatible reduction sends the characteristic-zero generator to the prescribed root. -/ @[simp] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean index 73e8ae6ba7..62d56debd6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/EveryOrbitLarge.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound -import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements /-! # The logarithmic lower-bound half of Theorem 1 @@ -15,6 +17,8 @@ The opening proves the exact inequality `p ≤ 20 ^ m ^ 3` for every punctured o with the quantifiers of `EveryOrbitLargeAt` and `TheoremOneStatement`. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean index 2e28589491..badf34daf0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/FiniteOrbit.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Analysis.Complex.Polynomial.Basic -import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity -import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple -import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces + +public import Mathlib.Analysis.Complex.Polynomial.Basic +public import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces /-! # Torsion traces forced by finite Markoff orbits @@ -18,6 +20,8 @@ Use returns of coordinate rotations to obtain torsion traces and rule out finite away from the origin. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean index 6139244691..5e9f6883f8 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrbitCardBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard -import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound /-! # Bounding the opening orders by the full Gamma orbit @@ -15,6 +17,8 @@ parabolic traces are handled explicitly, since the generic parametrizations deli those values. -/ +@[expose] public section + namespace BGS.Markoff private theorem two_ne_zero_zmod_of_prime_ne_two @@ -267,10 +271,10 @@ theorem prime_le_twenty_pow_normalizedGammaOrbit_ncard_cube (p : ℕ) [Fact p.Prime] (hpTwo : p ≠ 2) (hpThree : p ≠ 3) (x : NormalizedMarkoffSurface (ZMod p)) (hxne : x.1 ≠ normalizedOrigin) : p ≤ 20 ^ (letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (by exact three_ne_zero_zmod_of_prime_ne_three p hpThree) normalizedGammaOrbit x).ncard ^ 3 := by let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (by exact three_ne_zero_zmod_of_prime_ne_three p hpThree) obtain ⟨W₁, W₂, W₃, htrace₁, htrace₂, htrace₃, _hfin₁, _hfin₂, _hfin₃, _hcoprime₁, _hcoprime₂, _hcoprime₃, hpBound⟩ := exists_exact_eigenvalue_orders_with_cyclotomic_bound p hpTwo x.1 x.property hxne @@ -352,7 +356,7 @@ theorem prime_le_twenty_pow_gammaOrbit_ncard_cube (x : MarkoffSurface (ZMod p)) (hxne : x.1 ≠ origin) : p ≤ 20 ^ (gammaOrbit x).ncard ^ 3 := by let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (by exact three_ne_zero_zmod_of_prime_ne_three p hpThree) let xn := normalizationSurfaceEquiv (ZMod p) x have hxnNe : xn.1 ≠ normalizedOrigin := by intro hzero diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean index 5463f70aca..f61e0a092f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/OrderArithmetic.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Data.Nat.Totient -import Mathlib.Data.Nat.GCD.Basic + +public import Mathlib.Data.Nat.Totient +public import Mathlib.Data.Nat.GCD.Basic /-! # Arithmetic bounds for three torsion orders @@ -14,6 +16,8 @@ Bound the least common multiple of three orders by the cube of their maximum and resulting modulus estimate. -/ +@[expose] public section + namespace BGS.Markoff /-- The totient exponent is no larger than the conductor exponent. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean index 39a7f9723d..49d8198943 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/ParabolicPeriodicity.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization /-! # Parabolic fibers are aperiodic in characteristic zero @@ -14,6 +16,8 @@ opening therefore needs a point-level argument at normalized traces `2` and `-2` parabolic-line translations give that argument in characteristic zero. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean index 7992a450f1..f32a8341cc 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/PeriodicSemisimple.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues /-! # Periodic points on semisimple fibers @@ -16,6 +18,8 @@ parametrization: on a nonparabolic fiber, rotation multiplies the eigen-coordina matrix eigenvalue, so a positive return forces that eigenvalue to be torsion. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean index 4af591d991..8a964582cd 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/RotationOrbitCard.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization /-! # Cardinality of coordinate-rotation orbits @@ -14,6 +16,8 @@ Embed coordinate-rotation cycles in the full normalized Markoff orbit and compar cardinalities. -/ +@[expose] public section + namespace BGS.Markoff universe u diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean index fc39e6860b..338f40ad31 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TorsionTraces.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect -import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple + +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple /-! # Torsion eigenvalue traces force the complex Markoff origin @@ -15,6 +17,8 @@ coordinate of a complex normalized Markoff point is represented by a torsion eig reciprocal, the unit-circle defect argument forces all three coordinates to vanish. -/ +@[expose] public section + namespace BGS.Markoff /-- A finite-order complex unit has norm one. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean index 3a26630607..2ea255ad85 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/TraceOrderBound.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Data.Nat.GCD.Prime -import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization -import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport -import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound -import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification + +public import Mathlib.Data.Nat.GCD.Prime +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification /-! # From residue traces to the concrete cyclotomic opening bound @@ -17,6 +19,8 @@ This file chooses eigenvalues for arbitrary normalized traces over `ZMod p`, inc parabolic traces, and combines their exact orders by an lcm. -/ +@[expose] public section + namespace BGS.Markoff private theorem prime_coprime_orderOf_splitUnit diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean b/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean index e9a69fbc09..00e962eba1 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Opening/UnitCircle.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization /-! # The real compactness lemma in the opening @@ -14,6 +16,8 @@ normalized trace coordinates in `[-2, 2]`. The elementary real inequality used proved here independently of the later cyclotomic lifting argument. -/ +@[expose] public section + namespace BGS.Markoff /-- A real normalized Markoff point whose first trace coordinate lies in `[-2, 2]` is the diff --git a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean index e4289077fd..2330240b1d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryEndgame.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame -import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics + +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics /-! # Endgame wrappers for the elementary preliminary route @@ -15,6 +17,8 @@ and cage theorems. This file supplies them with the smaller preliminary-route numerical certificates. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean index fe8b8fed77..fd496e69a2 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/PreliminaryNumerics.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates -import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound + +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +public import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound /-! # Elementary numerical certificates for the paper's preliminary route @@ -17,6 +19,8 @@ The resulting cutoff is somewhat larger, but every numerical input is checked inside Lean. -/ +@[expose] public section + namespace BGS.Markoff /-- The simultaneous tenth-moment constant for the divisor counts of `p - 1` diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean index 1d84422776..d6e2a80f86 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve.lean @@ -3,37 +3,39 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean index 6928be7b89..2e168fa561 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/AffineNormalization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility -import Mathlib.AlgebraicGeometry.Normalization + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +public import Mathlib.AlgebraicGeometry.Normalization /-! # Affine normalization of the weighted trace cover @@ -19,6 +21,8 @@ the other three biprojective charts, their gluing into a proper curve, the bound and the genus and Hasse--Weil estimates. -/ +@[expose] public section + namespace BGS.Markoff open CategoryTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean index 802da336c2..663e83118b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveClosure.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.MvPolynomial.PDeriv -import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary -import Mathlib.FieldTheory.KummerExtension + +public import Mathlib.Algebra.MvPolynomial.PDeriv +public import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +public import Mathlib.FieldTheory.KummerExtension /-! # Explicit biprojective closure of the trace cover @@ -17,6 +19,8 @@ It controls the raw closure in `P^1 × P^1`; it does not identify that generally with its normalization. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean index 66f3a07e55..3cb9303c83 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/BiprojectiveScheme.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData -import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart -import Mathlib.AlgebraicGeometry.OpenImmersion + +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +public import Mathlib.AlgebraicGeometry.OpenImmersion /-! # The biprojective trace curve as a glued scheme @@ -18,6 +20,8 @@ affine hypersurface schemes along their common Laurent torus, using the explicit inversions already proved for the chart rings. -/ +@[expose] public section + namespace BGS.Markoff open CategoryTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean index 97eb67d6b6..2b5850a107 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Boundary.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry /-! # Affine boundary of the split trace cover @@ -16,6 +18,8 @@ accounted for explicitly. For positive covering exponents and nonzero second we model adds exactly the origin and no other coordinate-axis point. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean index 0b20556301..eb74216217 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Characteristic.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry -import Mathlib.Algebra.CharP.Lemmas + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import Mathlib.Algebra.CharP.Lemmas /-! # The characteristic restriction in the split trace-cover lemma @@ -19,6 +21,8 @@ separate from the positive Kummer descent: the theorem below is a counterexample hypothesis, not another assumption on which downstream formalization may rely. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean index 5e11a788bc..3686b4b2a7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ChartLocalization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization -import Mathlib.RingTheory.Localization.Away.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +public import Mathlib.RingTheory.Localization.Away.Basic /-! # Localized transition maps for the weighted trace-cover charts @@ -20,6 +22,8 @@ geometric wall is to identify these localizations with overlap opens in the affi and use the maps in a scheme-gluing datum. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean index 4d57483ccd..e340d0599c 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonKummerIndependence.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer -import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing /-! # Kummer-class independence for common cover primes @@ -19,6 +21,8 @@ The odd common-prime classes and the roots-of-unity eigencharacter descent are d assumed here; they remain the next noncoprime wall. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean index b06c8637c6..e04d41dc8a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/CommonPrimeKummerTower.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility + +public import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility /-! # The split trace Kummer tower for arbitrary positive exponents @@ -18,6 +20,8 @@ Consequently the second Kummer polynomial is irreducible without a coprimality a the explicit roots-of-unity hypotheses used by the descent. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial AdjoinRoot diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean index 0828881c98..2e0bc5828d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Geometry.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus -import Mathlib.RingTheory.Polynomial.Eisenstein.Basic -import Mathlib.Algebra.MvPolynomial.NoZeroDivisors + +public import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +public import Mathlib.RingTheory.Polynomial.Eisenstein.Basic +public import Mathlib.Algebra.MvPolynomial.NoZeroDivisors /-! # Split trace curves: an exact polynomial model and the first irreducibility wall @@ -25,6 +27,8 @@ required by the paper is deliberately not encoded in this theorem: irreducibilit curve does not imply irreducibility after adjoining the two power roots. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean index 4b496188f1..653733a485 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/IrreducibilityObstructions.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.MvPolynomial.Nilpotent -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic -import Mathlib.FieldTheory.Perfect + +public import Mathlib.Algebra.MvPolynomial.Nilpotent +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +public import Mathlib.FieldTheory.Perfect /-! # Exact obstructions to the published trace-cover irreducibility statement @@ -19,6 +21,8 @@ multiplying both cover exponents by the characteristic makes the normalized cove power. This remains true when `sigma` is nonzero and different from one. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean index ee788de3b2..b10c4ae011 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Kummer.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry -import Mathlib.FieldTheory.KummerExtension -import Mathlib.FieldTheory.RatFunc.Degree -import Mathlib.RingTheory.Norm.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import Mathlib.FieldTheory.KummerExtension +public import Mathlib.FieldTheory.RatFunc.Degree +public import Mathlib.RingTheory.Norm.Basic /-! # Kummer descent for the split trace power cover @@ -22,6 +24,8 @@ criterion currently covers odd exponents; coprimality of `d` and `e` is used in argument. Neither hypothesis is hidden in a structure field. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial AdjoinRoot @@ -188,7 +192,7 @@ lemma norm_splitTraceBaseRoot change Algebra.norm (RatFunc K) pb.gen = -splitTraceRadicand sigma rw [Algebra.PowerBasis.norm_gen_eq_coeff_zero_minpoly, hdim, AdjoinRoot.minpoly_powerBasis_gen_of_monic] - · simp [pb, splitTraceBaseKummerPolynomial] + · simp [ splitTraceBaseKummerPolynomial] · exact monic_X_pow_sub_C _ (by norm_num) /-- A prime-power root of the base coordinate `v` cannot already lie in the quadratic base diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean index 912082a135..2a86f7d57f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentComparisonInjectivity.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility -import Mathlib.FieldTheory.RatFunc.IntermediateField + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import Mathlib.FieldTheory.RatFunc.IntermediateField /-! # Injectivity of the Laurent comparison from cover irreducibility @@ -19,6 +21,8 @@ minimal polynomial of the `xi` coordinate, so evaluation has exactly the expecte kernel. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial @@ -153,7 +157,8 @@ theorem finTwoToIteratedPolynomial_aeval finTwoToIteratedPolynomial_X_one] exact DFunLike.congr_fun heq p -private def splitTraceEtaPolynomialEvaluation +/-- Evaluate a coefficient polynomial at the transcendental Kummer eta coordinate. -/ +def splitTraceEtaPolynomialEvaluation (sigma : K) (e d : ℕ) : K[X] →ₐ[K] SplitTraceXiFunctionField K sigma e d := Polynomial.aeval (splitTraceEtaRootInXiField sigma e d) @@ -166,7 +171,8 @@ private theorem splitTraceEtaPolynomialEvaluation_injective (splitTraceEtaRootInXiField_transcendental sigma hsigma e d heOdd hdOdd hde) -private def splitTraceEtaRatFuncEvaluation +/-- Specialize rational functions at the transcendental Kummer eta coordinate. -/ +def splitTraceEtaRatFuncEvaluation (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) (heOdd : Odd e) (hdOdd : Odd d) (hde : d.Coprime e) : RatFunc K →ₐ[K] SplitTraceXiFunctionField K sigma e d := by @@ -183,8 +189,9 @@ private def splitTraceEtaRatFuncEvaluation (L := SplitTraceXiFunctionField K sigma e d) (splitTraceEtaPolynomialEvaluation sigma e d) (nonZeroDivisors_le_comap_nonZeroDivisors_of_injective _ - (splitTraceEtaPolynomialEvaluation_injective - sigma hsigma e d heOdd hdOdd hde)) + (by + exact splitTraceEtaPolynomialEvaluation_injective + sigma hsigma e d heOdd hdOdd hde)) private theorem splitTraceEtaRatFuncEvaluation_algebraMap (sigma : K) (hsigma : sigma ≠ 0) (e d : ℕ) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean index 453060fbc7..66a0433df7 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentJacobian.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization /-! # Jacobian control on the Laurent trace cover @@ -18,6 +20,8 @@ The proof exposes the characteristic assumptions and gives an explicit ideal cal not assume smoothness or normality as a structure field. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean index d42a94f464..9e9799d977 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization -import Mathlib.RingTheory.Localization.Integral + +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +public import Mathlib.RingTheory.Localization.Integral /-! # Normalized Laurent overlap transitions @@ -21,6 +23,8 @@ domain hypotheses are precisely the domain instances obtained from the already-p irreducibility of the two affine chart equations. -/ +@[expose] public section + namespace BGS.Markoff open AlgebraicGeometry diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean index 932f84a731..c65bcf2e79 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentSmooth.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian -import Mathlib.RingTheory.Smooth.Locus -import Mathlib.RingTheory.Smooth.StandardSmooth -import Mathlib.RingTheory.Smooth.StandardSmoothCotangent + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +public import Mathlib.RingTheory.Smooth.Locus +public import Mathlib.RingTheory.Smooth.StandardSmooth +public import Mathlib.RingTheory.Smooth.StandardSmoothCotangent /-! # Smoothness of the Laurent trace cover @@ -21,6 +23,8 @@ The construction is explicit: no smoothness or normality assumption is stored in passed as an opaque typeclass premise. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean index 3889c0dfe6..5ea1bfcb93 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/Localization.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer -import Mathlib.RingTheory.Localization.Away.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +public import Mathlib.RingTheory.Localization.Away.Basic /-! # The Laurent split trace cover inside its Kummer function field @@ -16,6 +18,8 @@ odd-coprime Kummer tower. Injectivity is kept as the visible remaining wall; it an axiom or typeclass field. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean index c979d9ac8b..2b9a376ecb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/NormalForm.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization /-! # Normal forms in the split trace-cover Kummer tower @@ -19,6 +21,8 @@ in `TraceCurveKummer`, is needed later to regard the same rings as fields, but i the normal-form interface. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean index 660bd28fc9..bb2142261f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCommonPrimeIndependence.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence /-! # Odd common-prime Kummer classes on the split trace curve @@ -18,6 +20,8 @@ Turning this base-field class calculation into irreducibility for noncoprime cov the roots-of-unity eigencharacter descent in the first Kummer extension. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean index 73768e929a..0da17ba181 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/OddCoprimeIrreducibility.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity /-! # Irreducibility of the odd coprime split trace cover @@ -22,6 +24,8 @@ source-division theorem without assuming the target irreducibility or either com injectivity statement. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean index b061ba1631..2ab1806a6f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/PositiveCoprimeIrreducibility.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility /-! # Irreducibility of positive coprime split trace covers @@ -18,6 +20,8 @@ The coprimality restriction is still real in this proof: common prime divisors r Kummer-class independence argument and are not hidden here. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial AdjoinRoot IntermediateField diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean index 9b68c7902d..1c97da1084 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveChart.lean @@ -3,11 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module + /-! # Standard charts of the biprojective trace curve -/ +@[expose] public section + namespace BGS.Markoff /-- The four standard affine charts of the biprojective trace curve. -/ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean index 9db14b9e41..abab98c1f3 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationCharts.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart -import Mathlib.AlgebraicGeometry.OpenImmersion + +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +public import Mathlib.AlgebraicGeometry.OpenImmersion /-! # Affine normalization charts and their overlap immersions @@ -22,6 +24,8 @@ on pullbacks of triple overlaps. The objects, open immersions, transition isomo ring-level cocycle constructed below are the inputs for that remaining categorical assembly. -/ +@[expose] public section + namespace BGS.Markoff open AlgebraicGeometry diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean index 97f9bfaf06..9275d96f59 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectiveNormalizationMorphism.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts /-! # The normalization morphism on trace-curve charts @@ -16,6 +18,8 @@ with normalization of the Laurent chart. The coordinate inversions are then che with the raw-to-normalized Laurent map. -/ +@[expose] public section + namespace BGS.Markoff open CategoryTheory diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean index 6cc3970431..ffc8dba05a 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/ProjectivePointEstimate.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure -import Mathlib.Analysis.SpecialFunctions.Pow.Real + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +public import Mathlib.Analysis.SpecialFunctions.Pow.Real /-! # The exact projective-to-torus point-count bridge @@ -23,6 +25,8 @@ The conclusion is the desired `O(sqrt (#K) * d * e)` estimate for the actual Laurent trace-solution finset. No target estimate is hidden in a typeclass. -/ +@[expose] public section + namespace BGS.Markoff noncomputable section diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean index b978f72df7..dd2d712f9e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SemanticNormalForm.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm /-! # Semantic normal forms for the split trace cover @@ -18,6 +20,8 @@ This does not identify two source classes with the same semantic normal form. T injectivity statement is the syntactic quotient-division wall and is kept explicit below. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial @@ -102,10 +106,10 @@ def splitTraceAffineSemanticNormalForm adjoinRootTowerSemanticNormalForm (splitTraceEtaKummerPolynomial sigma e) (splitTraceEtaKummerPolynomial_monic sigma e - (etaExponent_ne_zero e heOdd)) + (by exact etaExponent_ne_zero e heOdd)) (splitTraceXiKummerPolynomial sigma e d) (splitTraceXiKummerPolynomial_monic sigma e d - (xiExponent_ne_zero d hdOdd)) + (by exact xiExponent_ne_zero d hdOdd)) (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a) /-- Evaluating the affine semantic normal form recovers the affine comparison-map image. -/ @@ -114,10 +118,10 @@ theorem splitTraceAffineSemanticNormalForm_evaluation adjoinRootTowerSemanticNormalFormEvaluation (splitTraceEtaKummerPolynomial sigma e) (splitTraceEtaKummerPolynomial_monic sigma e - (etaExponent_ne_zero e heOdd)) + (by exact etaExponent_ne_zero e heOdd)) (splitTraceXiKummerPolynomial sigma e d) (splitTraceXiKummerPolynomial_monic sigma e d - (xiExponent_ne_zero d hdOdd)) + (by exact xiExponent_ne_zero d hdOdd)) (splitTraceAffineSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a) = splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a := by exact adjoinRootTowerSemanticNormalForm_evaluation _ _ _ _ _ @@ -128,9 +132,9 @@ theorem splitTraceAffineSemanticNormalForm_eq_zero_iff splitTraceAffineSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a = 0 ↔ splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a = 0 := by let f := splitTraceEtaKummerPolynomial sigma e - let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) + let hf := splitTraceEtaKummerPolynomial_monic sigma e (by exact etaExponent_ne_zero e heOdd) let g := splitTraceXiKummerPolynomial sigma e d - let hg := splitTraceXiKummerPolynomial_monic sigma e d (xiExponent_ne_zero d hdOdd) + let hg := splitTraceXiKummerPolynomial_monic sigma e d (by exact xiExponent_ne_zero d hdOdd) change adjoinRootTowerSemanticNormalForm f hf g hg (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a) = 0 ↔ _ constructor @@ -151,9 +155,9 @@ theorem splitTraceAffineSemanticNormalForm_injective_iff : Function.Injective (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde) := by let f := splitTraceEtaKummerPolynomial sigma e - let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) + let hf := splitTraceEtaKummerPolynomial_monic sigma e (by exact etaExponent_ne_zero e heOdd) let g := splitTraceXiKummerPolynomial sigma e d - let hg := splitTraceXiKummerPolynomial_monic sigma e d (xiExponent_ne_zero d hdOdd) + let hg := splitTraceXiKummerPolynomial_monic sigma e d (by exact xiExponent_ne_zero d hdOdd) change Function.Injective (fun a ↦ adjoinRootTowerSemanticNormalForm f hf g hg (splitTraceAffineToKummerTop sigma hsigma e d heOdd hdOdd hde a)) ↔ _ @@ -180,10 +184,10 @@ def splitTraceLaurentSemanticNormalForm exact adjoinRootTowerSemanticNormalForm (splitTraceEtaKummerPolynomial sigma e) (splitTraceEtaKummerPolynomial_monic sigma e - (etaExponent_ne_zero e heOdd)) + (by exact etaExponent_ne_zero e heOdd)) (splitTraceXiKummerPolynomial sigma e d) (splitTraceXiKummerPolynomial_monic sigma e d - (xiExponent_ne_zero d hdOdd)) + (by exact xiExponent_ne_zero d hdOdd)) (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a) /-- Evaluating the Laurent semantic normal form recovers the Laurent comparison-map image. -/ @@ -198,10 +202,10 @@ theorem splitTraceLaurentSemanticNormalForm_evaluation adjoinRootTowerSemanticNormalFormEvaluation (splitTraceEtaKummerPolynomial sigma e) (splitTraceEtaKummerPolynomial_monic sigma e - (etaExponent_ne_zero e heOdd)) + (by exact etaExponent_ne_zero e heOdd)) (splitTraceXiKummerPolynomial sigma e d) (splitTraceXiKummerPolynomial_monic sigma e d - (xiExponent_ne_zero d hdOdd)) + (by exact xiExponent_ne_zero d hdOdd)) (splitTraceLaurentSemanticNormalForm sigma hsigma e d heOdd hdOdd hde a) = splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a := by let hBaseIrred := splitTraceBaseKummerPolynomial_irreducible sigma hsigma @@ -235,9 +239,9 @@ theorem splitTraceLaurentSemanticNormalForm_injective_iff : splitTraceXiKummerPolynomial_irreducible sigma hsigma e d heOdd hdOdd hde let : Fact (Irreducible (splitTraceXiKummerPolynomial sigma e d)) := ⟨hXiIrred⟩ let f := splitTraceEtaKummerPolynomial sigma e - let hf := splitTraceEtaKummerPolynomial_monic sigma e (etaExponent_ne_zero e heOdd) + let hf := splitTraceEtaKummerPolynomial_monic sigma e (by exact etaExponent_ne_zero e heOdd) let g := splitTraceXiKummerPolynomial sigma e d - let hg := splitTraceXiKummerPolynomial_monic sigma e d (xiExponent_ne_zero d hdOdd) + let hg := splitTraceXiKummerPolynomial_monic sigma e d (by exact xiExponent_ne_zero d hdOdd) change Function.Injective (fun a ↦ adjoinRootTowerSemanticNormalForm f hf g hg (splitTraceLaurentToKummerTop sigma hsigma e d heOdd hdOdd hde a)) ↔ _ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean index 7772cff1ca..ba229f274e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionCriterion.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction -import Mathlib.RingTheory.UniqueFactorizationDomain.Basic + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +public import Mathlib.RingTheory.UniqueFactorizationDomain.Basic /-! # An exact criterion for the remaining split trace-cover division theorem @@ -17,6 +19,8 @@ uses primeness to prove that localization has not killed an affine class. Thus counterexample cannot be hidden by moving to the Laurent model. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean index b591ce615a..4c819272cb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticDivisionObstruction.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm /-! # The degenerate split trace cover has no principal syntactic division theorem @@ -16,6 +18,8 @@ polynomial. This file records that obstruction explicitly: the source-side divi must assume the nondegeneracy condition `sigma != 1`. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean index ee8909f8e7..47252dff84 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/SyntacticNormalForm.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm -import Mathlib.RingTheory.Ideal.Quotient.Operations + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +public import Mathlib.RingTheory.Ideal.Quotient.Operations /-! # Syntactic monomial reduction for the split trace cover @@ -16,6 +18,8 @@ Euclidean division of `i` by `d` and `j` by `e`. Its rectangular basis index is `u^(i / d) * v^(i / d + j / e)`. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean index a779a89caf..60a9784456 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedBidegree.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility /-! # Exact bidegree of the weighted middle-game trace curve @@ -17,6 +19,8 @@ used in the irreducibility proof; swapping the two polynomial variables computes the second coordinate degree. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean index 966a88609d..7d9405e26e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedEllipticModel.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry -import Mathlib.AlgebraicGeometry.EllipticCurve.Weierstrass + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import Mathlib.AlgebraicGeometry.EllipticCurve.Weierstrass /-! # An explicit elliptic model for the weighted trace curve @@ -31,6 +33,8 @@ Weierstrass model to the genus and Euler-characteristic data used by Corvaja--Zannier. -/ +@[expose] public section + namespace BGS.Markoff variable {K : Type*} [Field K] diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean index 9d0a1b6a00..648640ca31 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedIrreducibility.lean @@ -3,11 +3,13 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry -import Mathlib.Algebra.MvPolynomial.Equiv -import Mathlib.Algebra.Polynomial.Bivariate -import Mathlib.RingTheory.Polynomial.GaussLemma + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +public import Mathlib.Algebra.MvPolynomial.Equiv +public import Mathlib.Algebra.Polynomial.Bivariate +public import Mathlib.RingTheory.Polynomial.GaussLemma /-! # Absolute irreducibility of the weighted middle-game trace curve @@ -20,6 +22,8 @@ The resulting polynomial is the Eisenstein polynomial already proved irreducible `TraceCurveGeometry`. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean index c0ca8c664c..304b159998 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedNotSubtorus.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry + +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry /-! # The weighted trace curve is not a subtorus translate @@ -14,6 +16,8 @@ Corvaja--Zannier torsion-point bound. The proof uses the two deck involutions of the weighted trace curve and keeps all degenerate parameters explicit. -/ +@[expose] public section + namespace BGS.Markoff section CharacterPowers diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean index fc4525c75b..322aba1482 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/WeightedOddCoprimeIrreducibility.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower -import Mathlib.FieldTheory.IsAlgClosed.Basic -import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed + +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +public import Mathlib.FieldTheory.IsAlgClosed.Basic +public import Mathlib.RingTheory.RootsOfUnity.AlgebraicallyClosed /-! # Absolute irreducibility of weighted odd-coprime split trace covers @@ -18,6 +20,8 @@ normalized cover with `sigma = alpha * beta` to `alpha` times the weighted cover irreducibility assumption is introduced at the normalization step. -/ +@[expose] public section + namespace BGS.Markoff open Polynomial diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean index 08cb77c7d8..dde7a6d0c0 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Analysis.SpecificLimits.Normed -import Mathlib.Analysis.SpecialFunctions.Pow.Asymptotics -import Mathlib.NumberTheory.ArithmeticFunction.Misc + +public import Mathlib.Analysis.SpecificLimits.Normed +public import Mathlib.Analysis.SpecialFunctions.Pow.Asymptotics +public import Mathlib.NumberTheory.ArithmeticFunction.Misc /-! # Subpolynomial growth of the divisor-counting function @@ -16,6 +18,8 @@ middle- and end-game union bounds. The public target is an eventual real power bound for `Nat.divisors.card`. -/ +@[expose] public section + namespace BGS.NumberTheory open Filter @@ -34,7 +38,7 @@ private lemma exists_pow_succ_le_constant_mul_two_pow (k : ℕ) : by_cases ha : N ≤ a + 1 · have hreal := hN (a + 1) ha simp only [Real.norm_eq_abs, one_mul, abs_pow] at hreal - simp at hreal + simp only [ge_iff_le] at hreal have hnat : (a + 1) ^ k ≤ 2 ^ (a + 1) := by exact_mod_cast hreal calc (a + 1) ^ k ≤ 2 ^ (a + 1) := hnat diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean index f1cff22232..5e646d9332 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/ExplicitDivisorBound.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound + +public import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound /-! # An explicit divisor-counting bound @@ -15,6 +17,8 @@ uses a concrete polynomial-versus-exponential estimate. Its specialization at `k = 32` is the numerical input for explicit strong approximation. -/ +@[expose] public section + namespace BGS.NumberTheory open scoped BigOperators diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean index 546ebfb579..49be0575b6 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCertificate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds + +public import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds /-! # Exact certificate at the paper's terminal obstruction @@ -22,6 +24,8 @@ integer `J` is an exact tenth-root upper certificate. All comparisons below are closed integer computations checked by Lean. -/ +@[expose] public section + namespace BGS.NumberTheory /-- The reduced integer responsible for the published cutoff. -/ diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean index 5316f153f5..bc96ca5122 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointMaximalDivisorCriterion.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate + +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate /-! # Arithmetic core of the joint maximal-divisor algorithm @@ -14,6 +16,8 @@ envelope `M^2 ≤ S`. This removes square roots and division from both the connectivity test and the rank-refinement bound. -/ +@[expose] public section + namespace BGS.NumberTheory /-- A paper-style first-interval witness forces failure of the joint square diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean index 480738372d..97b35b99cf 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/JointNeighborDivisorBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound -import Mathlib.NumberTheory.ArithmeticFunction.Misc + +public import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +public import Mathlib.NumberTheory.ArithmeticFunction.Misc /-! # Joint divisor bounds for neighboring even integers @@ -21,6 +23,8 @@ penalty. This is the arithmetic input for improving the maximal-divisor cutoff. -/ +@[expose] public section + namespace BGS.NumberTheory private theorem card_divisors_two_mul_of_odd {n : ℕ} (hn : Odd n) : diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean index fa60caf031..ecb78ecfd1 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/MaximalDivisorBounds.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound -import Mathlib.GroupTheory.SpecificGroups.Cyclic.Basic + +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +public import Mathlib.GroupTheory.SpecificGroups.Cyclic.Basic /-! # Maximal-divisor bounds @@ -14,6 +16,8 @@ This file proves the finite-poset cover behind the paper's maximal-divisor improvement and combines it with the new joint `p - 1`, `p + 1` estimate. -/ +@[expose] public section + namespace BGS.NumberTheory /-- Divisors of `n` maximal under divisibility among those strictly below @@ -150,7 +154,7 @@ theorem maximalDivisorCounts_product_pow_ten_le Nat.pow_le_pow_left (Nat.mul_le_mul hminus hplus) 10 _ ≤ 2 ^ 456 * (p ^ 2 - 1) := card_divisors_pred_mul_card_divisors_succ_pow_ten_le hp hpTwo - _ ≤ 2 ^ 457 * (p ^ 2 - 1) := by gcongr <;> norm_num + _ ≤ 2 ^ 457 * (p ^ 2 - 1) := by gcongr; norm_num /-- The new square envelope for the sum of the two maximal-divisor counts. -/ theorem maximalDivisorCounts_add_sq_le diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean index 21d9abc6e1..a62c7dfbc5 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/NonparabolicComplementCriterion.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion + +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion /-! # Arithmetic criterion for the nonparabolic complement route @@ -18,6 +20,8 @@ A root-free square envelope `M ^ 2 ≤ S` then gives `8 * p ≤ 35721 * S ^ 4`. -/ +@[expose] public section + namespace BGS.NumberTheory /-- Eliminate the maximal order `d` from the nonparabolic complement count diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean index 283f3dfae3..0a18f2a067 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/OneSidedPrimitiveWitness.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion -import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting + +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting /-! # One-sided primitive extraction with witness multiplicities @@ -15,6 +17,8 @@ and a cyclic multiplicative group on the right. This file performs Möbius inversion without erasing the left witness. -/ +@[expose] public section + namespace BGS open scoped ArithmeticFunction.Moebius BigOperators diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean index 04bb13dd80..0b9a388a03 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PreliminaryDivisorBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound -import Mathlib.Tactic.IntervalCases + +public import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +public import Mathlib.Tactic.IntervalCases /-! # An elementary tenth-moment divisor bound @@ -16,6 +18,8 @@ factor is charged a small power-of-two penalty. The penalties over primes below `1024` sum exactly to `447`; primes at least `1024` need no penalty. -/ +@[expose] public section + namespace BGS.NumberTheory open scoped BigOperators @@ -145,7 +149,7 @@ private theorem pow_ten_le_base_sixtySeven (a : ℕ) : · simpa using pow_ten_le_band_of_threshold 67 4 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a; norm_num private theorem pow_ten_le_base_oneHundredThirtyOne (a : ℕ) : (a + 1) ^ 10 ≤ 2 ^ 3 * 131 ^ a := by @@ -153,7 +157,7 @@ private theorem pow_ten_le_base_oneHundredThirtyOne (a : ℕ) : · simpa using pow_ten_le_band_of_threshold 131 3 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a; norm_num private theorem pow_ten_le_base_twoHundredFiftySeven (a : ℕ) : (a + 1) ^ 10 ≤ 2 ^ 2 * 257 ^ a := by @@ -161,7 +165,7 @@ private theorem pow_ten_le_base_twoHundredFiftySeven (a : ℕ) : · simpa using pow_ten_le_band_of_threshold 257 2 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a; norm_num private theorem pow_ten_le_base_fiveHundredTwentyOne (a : ℕ) : (a + 1) ^ 10 ≤ 2 * 521 ^ a := by @@ -169,7 +173,7 @@ private theorem pow_ten_le_base_fiveHundredTwentyOne (a : ℕ) : · simpa using pow_ten_le_band_of_threshold 521 1 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a; norm_num private theorem pow_ten_le_base_oneThousandTwentyFour (a : ℕ) : (a + 1) ^ 10 ≤ 1024 ^ a := by diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean index 5e5ddbe758..599b7c3c43 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/PrimePowerFactorization.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.Algebra.BigOperators.Group.Finset.Defs -import Mathlib.Data.Nat.Prime.Defs -import Mathlib.Tactic + +public import Mathlib.Algebra.BigOperators.Group.Finset.Defs +public import Mathlib.Data.Nat.Prime.Defs +public import Mathlib.Tactic /-! # Prime-power factorization data @@ -16,6 +18,8 @@ recurrences used to describe a finite prime-power factorization and the ranks of its divisor lattice. -/ +@[expose] public section + namespace BGS.NumberTheory /-- One claimed prime power `prime ^ exponent`. -/ diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean index a950e666ee..2682f7ab68 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCanonicalProfile.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate /-! # Canonical Rankin profile attached to a neighboring factorization @@ -16,6 +18,8 @@ the globally sorted support is sent to its actual side and exponent, while the cap assignment and the twelfth-root cap remain explicit parameters. -/ +@[expose] public section + namespace BGS.NumberTheory private theorem factorization_two_mul_of_odd diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean index 820d25d3d6..cee4417f8a 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Data.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound /-! # Concrete positional data below `2^1248` @@ -16,6 +18,8 @@ a coarse starting choice; later certificate generation may increase it without changing the support argument. -/ +@[expose] public section + namespace BGS.NumberTheory def rankinCutoff1248CapTable : RankinPositionalCapTable where diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean index 371d95328d..17c9391330 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Profile.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage /-! # Certified actual Rankin profiles below `2^1248` @@ -17,6 +19,8 @@ profile is structurally valid, matches `p`, and is dominated by the exact scalar summary of its skeleton representative. -/ +@[expose] public section + namespace BGS.NumberTheory namespace RankinExponentSkeleton diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean index a1723a21ba..e9490d4431 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinCutoff1248Skeleton.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data /-! # Finite exponent skeletons below `2^1248` @@ -16,6 +18,8 @@ target cutoff satisfies it, including the strong global product budget `jointLowerNeighborProduct < 2^2496`. -/ +@[expose] public section + namespace BGS.NumberTheory structure RankinExponentSkeleton where diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean index 840fd02d8d..8cd5227822 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCertificate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate /-! # Side-erased joint Rankin envelopes @@ -20,6 +22,8 @@ This is the proof-facing arithmetic layer for a substantially smaller finite profile search. It contains no generated data and no coverage assumption. -/ +@[expose] public section + namespace BGS.NumberTheory namespace RankinNeighborProfile diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean index 4d7b7a3cee..09e440e52d 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeCoverage.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope /-! # Finite coverage for side-erased Rankin envelopes @@ -21,6 +23,8 @@ profile. Thus generated arithmetic and mathematical exhaustiveness remain distinct proof obligations. -/ +@[expose] public section + namespace BGS.NumberTheory namespace RankinNeighborProfile diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean index eafccdb72d..8019d1cd88 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinJointEnvelopeSummaryCoverage.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage /-! # Scalar summaries for Rankin-envelope coverage @@ -20,6 +22,8 @@ while a separate coverage theorem must prove that an actual profile is dominated by one of the summaries. -/ +@[expose] public section + namespace BGS.NumberTheory /-- The two scalar quantities needed to transport a joint-envelope leaf. -/ diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean index 3f48ac47bf..a9a9e4d10e 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalCoverage.lean @@ -3,10 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile -import Mathlib.Data.List.GetD -import Mathlib.Data.Nat.PrimeFin + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile +public import Mathlib.Data.List.GetD +public import Mathlib.Data.Nat.PrimeFin /-! # Finite positional cap ladders @@ -22,6 +24,8 @@ The remaining global coverage obligation is deliberately visible: one must prove that the actual joint odd support has length at most the stored ladder. -/ +@[expose] public section + namespace BGS.NumberTheory open scoped Nat.Prime diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean index 1099863994..08ca0a738d 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalProfile.lean @@ -3,13 +3,15 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage -import Mathlib.Analysis.SpecialFunctions.Pow.NthRootLemmas -import Mathlib.Algebra.Order.Floor.Div -import Mathlib.NumberTheory.PrimeCounting -import Mathlib.Data.List.Indexes + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage +public import Mathlib.Analysis.SpecialFunctions.Pow.NthRootLemmas +public import Mathlib.Algebra.Order.Floor.Div +public import Mathlib.NumberTheory.PrimeCounting +public import Mathlib.Data.List.Indexes /-! # Positional Rankin profiles @@ -25,6 +27,8 @@ floor `q`, the numerator is one more than the integral twelfth root of immediate and keeps the checker independent of floating-point arithmetic. -/ +@[expose] public section + namespace BGS.NumberTheory /-- Executable numerator for a rational upper approximation to diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean index 74d70e5b61..45cfb1044c 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinPositionalSupportBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage -import Mathlib.Algebra.Order.BigOperators.Group.List + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage +public import Mathlib.Algebra.Order.BigOperators.Group.List /-! # Product bounds for finite positional prime ladders @@ -17,6 +19,8 @@ facts turns one exact primorial comparison into a uniform bound on the number of exponent slots below a power cutoff. -/ +@[expose] public section + open scoped BigOperators namespace BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean index fb7effda35..4693f954c5 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileCertificate.lean @@ -3,8 +3,10 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization + +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization /-! # Certificates for neighboring Rankin profiles @@ -13,6 +15,8 @@ Define rational weight caps and finite profile checks, and connect the Boolean c mathematical validity predicates. -/ +@[expose] public section + namespace BGS.NumberTheory structure RationalPrimeWeightCap where diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean index 2c7f345b8c..60fc7e61cd 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate -import Mathlib.NumberTheory.ArithmeticFunction.Misc + +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +public import Mathlib.NumberTheory.ArithmeticFunction.Misc /-! # Matching an actual neighboring factorization to a Rankin profile @@ -17,6 +19,8 @@ actual prime, its side, exact exponent, and a rational weight cap whose lower prime is no larger than the actual prime. -/ +@[expose] public section + namespace BGS.NumberTheory open scoped BigOperators @@ -186,7 +190,7 @@ private theorem oddDivisorCount_map_assignment simp only [List.map_cons, RankinNeighborProfile.oddDivisorCount, List.prod_cons] rw [ih htail] - simp [RankinOddFactor.Matches] at hhead + simp only [ite_mul, one_mul] at hhead rw [hhead.1, hhead.2.1] private theorem odd_prime_not_mem_both_neighbors @@ -552,7 +556,7 @@ private theorem oddCoarseEulerProduct_map_assignment RankinNeighborProfile.oddCoarseEulerProduct, List.prod_cons] rw [ih htail] - simp [RankinOddFactor.Matches] at hhead + simp only [ite_mul, one_mul] at hhead rw [hhead.1, hhead.2.1] private theorem jointOddPrimeList_coarse_product_minus diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean index e94520ec7f..3e28ce2d95 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotient.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import Mathlib.GroupTheory.SpecificGroups.Cyclic -import Mathlib.Tactic + +public import Mathlib.GroupTheory.SpecificGroups.Cyclic +public import Mathlib.Tactic /-! # Exact truncated order budgets in finite cyclic groups @@ -15,6 +17,8 @@ is `φ(e)` when `e ∣ N`. Summing only the non-two-torsion orders at most a cutoff gives the exact root budget used by the improved Markoff count. -/ +@[expose] public section + namespace BGS.NumberTheory /-- Root count contributed by divisor orders strictly above two and at most diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean index 3cc7b81710..00c40ca163 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankin.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient +public import Mathlib.Tactic /-! # Rational Rankin bounds for truncated exact-order sums @@ -15,6 +17,8 @@ certificate. Rational weights make every later finite certificate exactly checkable. -/ +@[expose] public section + namespace BGS.NumberTheory /-- The weighted divisor sum used by the rational Rankin estimate. -/ diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean index 0491ca5e22..2d61978f32 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/TruncatedOrderTotientRankinFactorization.lean @@ -3,12 +3,14 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin -import Mathlib.NumberTheory.ArithmeticFunction.Zeta -import Mathlib.NumberTheory.ArithmeticFunction.Misc -import Mathlib.Data.Nat.Factorization.Basic -import Mathlib.Tactic + +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin +public import Mathlib.NumberTheory.ArithmeticFunction.Zeta +public import Mathlib.NumberTheory.ArithmeticFunction.Misc +public import Mathlib.Data.Nat.Factorization.Basic +public import Mathlib.Tactic /-! # Rankin factorization of weighted totient sums @@ -17,6 +19,8 @@ Express the multiplicative weighted totient sum as a product over prime powers a local Rankin factors. -/ +@[expose] public section + namespace BGS.NumberTheory open ArithmeticFunction @@ -96,7 +100,7 @@ def coarseRankinPrimePowerFactor 1 + ∑ index ∈ Finset.range exponent, weight ^ (index + 1) theorem rankinPrimePowerFactor_nonneg - {prime exponent : ℕ} (hprime : prime.Prime) + {prime exponent : ℕ} (_hprime : prime.Prime) {weight : ℚ} (hweight : 0 ≤ weight) : 0 ≤ rankinPrimePowerFactor prime exponent weight := by simp only [rankinPrimePowerFactor] diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean index c8e80b2ab9..6c961d508d 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedDivisorMoment.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound -import Mathlib.Tactic.IntervalCases + +public import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +public import Mathlib.Tactic.IntervalCases /-! # A weighted twentieth-moment divisor bound @@ -23,6 +25,8 @@ It does not enumerate integers, factorizations, or neighboring divisor profiles. -/ +@[expose] public section + namespace BGS.NumberTheory open scoped BigOperators @@ -212,7 +216,8 @@ private theorem pow_twenty_le_base_sixtySeven (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 67 8 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_ninetySeven (a : ℕ) : (a + 1) ^ 20 ≤ 2 ^ 7 * 97 ^ (2 * a) := by @@ -220,7 +225,8 @@ private theorem pow_twenty_le_base_ninetySeven (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 97 7 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_oneHundredThirtyOne (a : ℕ) : (a + 1) ^ 20 ≤ 2 ^ 6 * 131 ^ (2 * a) := by @@ -228,7 +234,8 @@ private theorem pow_twenty_le_base_oneHundredThirtyOne (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 131 6 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_oneHundredNinetyOne (a : ℕ) : (a + 1) ^ 20 ≤ 2 ^ 5 * 191 ^ (2 * a) := by @@ -236,7 +243,8 @@ private theorem pow_twenty_le_base_oneHundredNinetyOne (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 191 5 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_twoHundredFiftySeven (a : ℕ) : (a + 1) ^ 20 ≤ 2 ^ 4 * 257 ^ (2 * a) := by @@ -244,7 +252,8 @@ private theorem pow_twenty_le_base_twoHundredFiftySeven (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 257 4 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_threeHundredSixtySeven (a : ℕ) : (a + 1) ^ 20 ≤ 2 ^ 3 * 367 ^ (2 * a) := by @@ -252,7 +261,8 @@ private theorem pow_twenty_le_base_threeHundredSixtySeven (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 367 3 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_fiveHundredTwentyOne (a : ℕ) : (a + 1) ^ 20 ≤ 2 ^ 2 * 521 ^ (2 * a) := by @@ -260,7 +270,8 @@ private theorem pow_twenty_le_base_fiveHundredTwentyOne (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 521 2 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_sevenHundredTwentySeven (a : ℕ) : (a + 1) ^ 20 ≤ 2 * 727 ^ (2 * a) := by @@ -268,7 +279,8 @@ private theorem pow_twenty_le_base_sevenHundredTwentySeven (a : ℕ) : · simpa using pow_twenty_le_band_of_threshold 727 1 1 (by norm_num) (by norm_num) a ha · have ha' : a ≤ 0 := by omega - interval_cases a <;> norm_num + interval_cases a + norm_num private theorem pow_twenty_le_base_oneThousandTwentyFour (a : ℕ) : (a + 1) ^ 20 ≤ 1024 ^ (2 * a) := by @@ -432,133 +444,133 @@ private theorem factorization_succ_pow_twenty_le 2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * a) := by have hpTwo : 2 ≤ p := hpPrime.two_le by_cases hp3 : p < 3 - · simp only [weightedPrimePenaltyTwenty, ite_eq_left hp3] + · simp only [weightedPrimePenaltyTwenty, hp3] exact pow_twenty_le_of_base_le (pow_twenty_le_base_two a) hpTwo · by_cases hp5 : p < 5 · have hpLower : 3 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_left hp5] + simp only [weightedPrimePenaltyTwenty, hp3, hp5] exact pow_twenty_le_of_base_le (pow_twenty_le_base_three a) hpLower · by_cases hp7 : p < 7 · have hpLower : 5 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, ite_eq_left hp7] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, hp7] exact pow_twenty_le_of_base_le (pow_twenty_le_base_five a) hpLower · by_cases hp11 : p < 11 · have hpLower : 7 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_left hp11] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11] exact pow_twenty_le_of_base_le (pow_twenty_le_base_seven a) hpLower · by_cases hp13 : p < 13 · have hpLower : 11 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_right hp11, ite_eq_left hp13] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11, hp13] exact pow_twenty_le_of_base_le (pow_twenty_le_base_eleven a) hpLower · by_cases hp17 : p < 17 · have hpLower : 13 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_left hp17] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11, hp13, hp17] exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirteen a) hpLower · by_cases hp19 : p < 19 · have hpLower : 17 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, ite_eq_left hp19] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11, hp13, hp17, hp19] exact pow_twenty_le_of_base_le (pow_twenty_le_base_seventeen a) hpLower · by_cases hp23 : p < 23 · have hpLower : 19 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, - ite_eq_right hp19, ite_eq_left hp23] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11, hp13, hp17, + hp19, hp23] exact pow_twenty_le_of_base_le (pow_twenty_le_base_nineteen a) hpLower · by_cases hp29 : p < 29 · have hpLower : 23 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, - ite_eq_right hp19, ite_eq_right hp23, ite_eq_left hp29] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11, hp13, hp17, + hp19, hp23, hp29] exact pow_twenty_le_of_base_le (pow_twenty_le_base_twentyThree a) hpLower · by_cases hp31 : p < 31 · have hpLower : 29 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, ite_eq_right hp5, - ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, - ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, ite_eq_left hp31] + simp only [weightedPrimePenaltyTwenty, hp3, hp5, + hp7, hp11, hp13, hp17, + hp19, hp23, hp29, hp31] exact pow_twenty_le_of_base_le (pow_twenty_le_base_twentyNine a) hpLower · by_cases hp37 : p < 37 · have hpLower : 31 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, - ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, - ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_left hp37] + simp only [weightedPrimePenaltyTwenty, hp3, + hp5, hp7, hp11, hp13, + hp17, hp19, hp23, hp29, + hp31, hp37] exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirtyOne a) hpLower · by_cases hp43 : p < 43 · have hpLower : 37 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, - ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, - ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_right hp37, ite_eq_left hp43] + simp only [weightedPrimePenaltyTwenty, hp3, + hp5, hp7, hp11, hp13, + hp17, hp19, hp23, hp29, + hp31, hp37, hp43] exact pow_twenty_le_of_base_le (pow_twenty_le_base_thirtySeven a) hpLower · by_cases hp53 : p < 53 · have hpLower : 43 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, - ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, - ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, ite_eq_left hp53] + simp only [weightedPrimePenaltyTwenty, hp3, + hp5, hp7, hp11, hp13, + hp17, hp19, hp23, hp29, + hp31, hp37, hp43, hp53] exact pow_twenty_le_of_base_le (pow_twenty_le_base_fortyThree a) hpLower · by_cases hp67 : p < 67 · have hpLower : 53 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, - ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, ite_eq_right hp13, - ite_eq_right hp17, ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, ite_eq_right hp53, - ite_eq_left hp67] + simp only [weightedPrimePenaltyTwenty, hp3, + hp5, hp7, hp11, hp13, + hp17, hp19, hp23, hp29, + hp31, hp37, hp43, hp53, + hp67] exact pow_twenty_le_of_base_le (pow_twenty_le_base_fiftyThree a) hpLower · by_cases hp97 : p < 97 · have hpLower : 67 ≤ p := by omega - simp only [weightedPrimePenaltyTwenty, ite_eq_right hp3, - ite_eq_right hp5, ite_eq_right hp7, ite_eq_right hp11, - ite_eq_right hp13, ite_eq_right hp17, ite_eq_right hp19, - ite_eq_right hp23, ite_eq_right hp29, ite_eq_right hp31, - ite_eq_right hp37, ite_eq_right hp43, ite_eq_right hp53, - ite_eq_right hp67, ite_eq_left hp97] + simp only [weightedPrimePenaltyTwenty, hp3, + hp5, hp7, hp11, + hp13, hp17, hp19, + hp23, hp29, hp31, + hp37, hp43, hp53, + hp67, hp97] exact pow_twenty_le_of_base_le (pow_twenty_le_base_sixtySeven a) hpLower · by_cases hp131 : p < 131 · have hpLower : 97 ≤ p := by omega simp only [weightedPrimePenaltyTwenty, - ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, - ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, - ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, - ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, - ite_eq_left hp131] + hp3, hp5, hp7, + hp11, hp13, hp17, + hp19, hp23, hp29, + hp31, hp37, hp43, + hp53, hp67, hp97, + hp131] exact pow_twenty_le_of_base_le (pow_twenty_le_base_ninetySeven a) hpLower · by_cases hp191 : p < 191 · have hpLower : 131 ≤ p := by omega simp only [weightedPrimePenaltyTwenty, - ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, - ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, - ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, - ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, - ite_eq_right hp131, ite_eq_left hp191] + hp3, hp5, hp7, + hp11, hp13, hp17, + hp19, hp23, hp29, + hp31, hp37, hp43, + hp53, hp67, hp97, + hp131, hp191] exact pow_twenty_le_of_base_le (pow_twenty_le_base_oneHundredThirtyOne a) hpLower · by_cases hp257 : p < 257 · have hpLower : 191 ≤ p := by omega simp only [weightedPrimePenaltyTwenty, - ite_eq_right hp3, ite_eq_right hp5, ite_eq_right hp7, - ite_eq_right hp11, ite_eq_right hp13, ite_eq_right hp17, - ite_eq_right hp19, ite_eq_right hp23, ite_eq_right hp29, - ite_eq_right hp31, ite_eq_right hp37, ite_eq_right hp43, - ite_eq_right hp53, ite_eq_right hp67, ite_eq_right hp97, - ite_eq_right hp131, ite_eq_right hp191, ite_eq_left hp257] + hp3, hp5, hp7, + hp11, hp13, hp17, + hp19, hp23, hp29, + hp31, hp37, hp43, + hp53, hp67, hp97, + hp131, hp191, hp257] exact pow_twenty_le_of_base_le (pow_twenty_le_base_oneHundredNinetyOne a) hpLower @@ -566,53 +578,70 @@ private theorem factorization_succ_pow_twenty_le -- Separate closed computations keep each kernel check within the default limit. private def weightedPrimePenaltyTwentyBlock (k : ℕ) : ℕ := - ∑ p ∈ Finset.range 64, if Nat.Prime (k * 64 + p) then weightedPrimePenaltyTwenty (k * 64 + p) else 0 -private theorem weightedPrimePenaltyTwentyBlock_value_0 : weightedPrimePenaltyTwentyBlock 0 = 320 := by + ∑ p ∈ Finset.range 64, + if Nat.Prime (k * 64 + p) then weightedPrimePenaltyTwenty (k * 64 + p) else 0 +private theorem weightedPrimePenaltyTwentyBlock_value_0 : + weightedPrimePenaltyTwentyBlock 0 = 320 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_1 : weightedPrimePenaltyTwentyBlock 1 = 97 := by +private theorem weightedPrimePenaltyTwentyBlock_value_1 : + weightedPrimePenaltyTwentyBlock 1 = 97 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_2 : weightedPrimePenaltyTwentyBlock 2 = 71 := by +private theorem weightedPrimePenaltyTwentyBlock_value_2 : + weightedPrimePenaltyTwentyBlock 2 = 71 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_3 : weightedPrimePenaltyTwentyBlock 3 = 55 := by +private theorem weightedPrimePenaltyTwentyBlock_value_3 : + weightedPrimePenaltyTwentyBlock 3 = 55 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_4 : weightedPrimePenaltyTwentyBlock 4 = 48 := by +private theorem weightedPrimePenaltyTwentyBlock_value_4 : + weightedPrimePenaltyTwentyBlock 4 = 48 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_5 : weightedPrimePenaltyTwentyBlock 5 = 36 := by +private theorem weightedPrimePenaltyTwentyBlock_value_5 : + weightedPrimePenaltyTwentyBlock 5 = 36 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_6 : weightedPrimePenaltyTwentyBlock 6 = 30 := by +private theorem weightedPrimePenaltyTwentyBlock_value_6 : + weightedPrimePenaltyTwentyBlock 6 = 30 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_7 : weightedPrimePenaltyTwentyBlock 7 = 33 := by +private theorem weightedPrimePenaltyTwentyBlock_value_7 : + weightedPrimePenaltyTwentyBlock 7 = 33 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_8 : weightedPrimePenaltyTwentyBlock 8 = 16 := by +private theorem weightedPrimePenaltyTwentyBlock_value_8 : + weightedPrimePenaltyTwentyBlock 8 = 16 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_9 : weightedPrimePenaltyTwentyBlock 9 = 20 := by +private theorem weightedPrimePenaltyTwentyBlock_value_9 : + weightedPrimePenaltyTwentyBlock 9 = 20 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_10 : weightedPrimePenaltyTwentyBlock 10 = 22 := by +private theorem weightedPrimePenaltyTwentyBlock_value_10 : + weightedPrimePenaltyTwentyBlock 10 = 22 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_11 : weightedPrimePenaltyTwentyBlock 11 = 11 := by +private theorem weightedPrimePenaltyTwentyBlock_value_11 : + weightedPrimePenaltyTwentyBlock 11 = 11 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_12 : weightedPrimePenaltyTwentyBlock 12 = 10 := by +private theorem weightedPrimePenaltyTwentyBlock_value_12 : + weightedPrimePenaltyTwentyBlock 12 = 10 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_13 : weightedPrimePenaltyTwentyBlock 13 = 9 := by +private theorem weightedPrimePenaltyTwentyBlock_value_13 : + weightedPrimePenaltyTwentyBlock 13 = 9 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_14 : weightedPrimePenaltyTwentyBlock 14 = 8 := by +private theorem weightedPrimePenaltyTwentyBlock_value_14 : + weightedPrimePenaltyTwentyBlock 14 = 8 := by decide +kernel -private theorem weightedPrimePenaltyTwentyBlock_value_15 : weightedPrimePenaltyTwentyBlock 15 = 10 := by +private theorem weightedPrimePenaltyTwentyBlock_value_15 : + weightedPrimePenaltyTwentyBlock 15 = 10 := by decide +kernel private theorem sum_weightedPrimePenaltyTwenty_blocks (k : ℕ) : @@ -656,7 +685,8 @@ private theorem sum_weightedPrimePenaltyTwenty_le (n : ℕ) : (∑ p ∈ allSmallPrimes, weightedPrimePenaltyTwenty p) ≤ 796 := by apply le_of_eq rw [Finset.sum_filter] - change (∑ p ∈ Finset.range (16 * 64), if Nat.Prime p then weightedPrimePenaltyTwenty p else 0) = _ + change (∑ p ∈ Finset.range (16 * 64), + if Nat.Prime p then weightedPrimePenaltyTwenty p else 0) = _ rw [sum_weightedPrimePenaltyTwenty_blocks] simp only [Finset.sum_range_succ, Finset.sum_range_zero] rw [weightedPrimePenaltyTwentyBlock_value_0, weightedPrimePenaltyTwentyBlock_value_1, @@ -677,36 +707,45 @@ private theorem sum_weightedPrimePenaltyTwenty_le (n : ℕ) : rw [← hsumEq] exact hle.trans htotal +private theorem card_divisors_pow_twenty_le_of_penalty_bound + (n bound : ℕ) (hn : n ≠ 0) + (hbound : (∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) ≤ bound) : + n.divisors.card ^ 20 ≤ 2 ^ bound * n ^ 2 := by + rw [Nat.card_divisors hn, ← Finset.prod_pow] + have hfactor : + (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ 20) ≤ + ∏ p ∈ n.primeFactors, + (2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * n.factorization p)) := + Finset.prod_le_prod + (fun p hp ↦ factorization_succ_pow_twenty_le + (Nat.prime_of_mem_primeFactors hp)) + have hproduct : + (∏ p ∈ n.primeFactors, + (2 ^ weightedPrimePenaltyTwenty p * p ^ (2 * n.factorization p))) = + 2 ^ (∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) * n ^ 2 := by + rw [Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum] + congr 1 + calc + (∏ p ∈ n.primeFactors, p ^ (2 * n.factorization p)) = + ∏ p ∈ n.primeFactors, (p ^ n.factorization p) ^ 2 := by + apply Finset.prod_congr rfl + intro p hp + rw [show 2 * n.factorization p = n.factorization p * 2 by omega, pow_mul] + _ = (∏ p ∈ n.primeFactors, p ^ n.factorization p) ^ 2 := by + exact Finset.prod_pow n.primeFactors 2 (fun p => p ^ n.factorization p) + _ = n ^ 2 := by rw [← Nat.prod_primeFactors_pow_factorization hn] + have hpower : (2 : ℕ) ^ (∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) ≤ + 2 ^ bound := Nat.pow_le_pow_right (n := 2) + (i := ∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) (j := bound) + (by decide) hbound + exact (hfactor.trans_eq hproduct).trans (Nat.mul_le_mul_right (n ^ 2) hpower) + /-- Weighted elementary divisor estimate: `τ(n)^20 ≤ 2^796 n^2`. -/ theorem card_divisors_pow_twenty_le_weighted_constant_mul_sq (n : ℕ) (hn : n ≠ 0) : - n.divisors.card ^ 20 ≤ 2 ^ 796 * n ^ 2 := by - rw [Nat.card_divisors hn, ← Finset.prod_pow] - calc - (∏ p ∈ n.primeFactors, (n.factorization p + 1) ^ 20) ≤ - ∏ p ∈ n.primeFactors, - (2 ^ weightedPrimePenaltyTwenty p * - p ^ (2 * n.factorization p)) := - Finset.prod_le_prod - (fun p hp ↦ factorization_succ_pow_twenty_le - (Nat.prime_of_mem_primeFactors hp)) - _ = 2 ^ (∑ p ∈ n.primeFactors, weightedPrimePenaltyTwenty p) * n ^ 2 := by - rw [Finset.prod_mul_distrib, Finset.prod_pow_eq_pow_sum] - congr 1 - calc - (∏ p ∈ n.primeFactors, p ^ (2 * n.factorization p)) = - ∏ p ∈ n.primeFactors, (p ^ n.factorization p) ^ 2 := by - apply Finset.prod_congr rfl - intro p hp - rw [show 2 * n.factorization p = n.factorization p * 2 by omega, pow_mul] - _ = (∏ p ∈ n.primeFactors, p ^ n.factorization p) ^ 2 := by - exact Finset.prod_pow n.primeFactors 2 - (fun p => p ^ n.factorization p) - _ = n ^ 2 := by rw [← Nat.prod_primeFactors_pow_factorization hn] - _ ≤ 2 ^ 796 * n ^ 2 := - Nat.mul_le_mul_right (n ^ 2) <| - Nat.pow_le_pow_right (by norm_num) - (sum_weightedPrimePenaltyTwenty_le n) + n.divisors.card ^ 20 ≤ 2 ^ 796 * n ^ 2 := + card_divisors_pow_twenty_le_of_penalty_bound n 796 hn + (sum_weightedPrimePenaltyTwenty_le n) end BGS.NumberTheory diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean index 9b98758331..6731181bef 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/WeightedNeighborDivisorBound.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound -import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment + +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment /-! # A weighted joint divisor bound for neighboring integers @@ -18,6 +20,8 @@ and dominant cases then gives a twentieth moment for their sum whose leading constant is still `2^796`. -/ +@[expose] public section + namespace BGS.NumberTheory /-- The product of the two neighboring divisor counts has only one weighted diff --git a/LeanPool/MarkoffModP/Comparator/Solution.lean b/LeanPool/MarkoffModP/Comparator/Solution.lean index f18b825479..28e30870bc 100644 --- a/LeanPool/MarkoffModP/Comparator/Solution.lean +++ b/LeanPool/MarkoffModP/Comparator/Solution.lean @@ -3,8 +3,12 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module -import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity + +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity + +@[expose] public section namespace Challenge diff --git a/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean b/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean index b9b52f5624..26aabca336 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/AxiomCheck.lean @@ -3,9 +3,11 @@ Copyright (c) 2026 Yuma Mizuno. All rights reserved. Released under Apache 2.0 license as described in the file LICENSE. Authors: Yuma Mizuno -/ +module + /- Kernel-level axiom audit for the vendored coordinate-free Riemann--Roch core. -/ -import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch From eeaaeca2c98179e72441b0537c689ead8c12b175 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 19:58:45 +0000 Subject: [PATCH 28/37] docs(MarkoffModP): clarify monogenicity source and supporting authorship --- LeanPool/MarkoffModP.lean | 2 +- .../BGS/CorvajaZannier/LocalMonogenicity.lean | 16 +++++++++++----- LeanPool/projects.yml | 1 + 3 files changed, 13 insertions(+), 6 deletions(-) diff --git a/LeanPool/MarkoffModP.lean b/LeanPool/MarkoffModP.lean index a9076c74d1..af727c3278 100644 --- a/LeanPool/MarkoffModP.lean +++ b/LeanPool/MarkoffModP.lean @@ -618,7 +618,7 @@ import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic # Markoff mod p Source: url:https://github.com/yuma-mizuno/markoff-modp -Authors: Yuma Mizuno +Authors: Yuma Mizuno, Guanghao Li Status: verified Main declarations: `BGS.Markoff.reduction_surjective_of_explicitBound` Tags: markoff-equation, strong-approximation, finite-fields diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean index ab70dba65f..8be31c0747 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalMonogenicity.lean @@ -13,12 +13,14 @@ import Mathlib.RingTheory.Ideal.Height If `R` and `S` are local integral domains with `S` a finite extension of `R`, `R` integrally closed, `S` a UFD, and there exists a height-one prime `q ⊆ S` such that `R/(q ∩ R) → S/q` is -étale, then `S ≅ R[X]/(f)` for some monic `f`. This formalizes Lemma 3.1 of -[arXiv:2503.07846](https://arxiv.org/abs/2503.07846). +étale, then `S ≅ R[X]/(f)` for some monic `f`. This file proves a generalization of Lemma 3.1 +of [Balçık et al.](https://arxiv.org/html/2503.07846v2). The cited lemma assumes that both +rings are regular local; the proof here uses the displayed integral-closedness and UFD +hypotheses instead, while retaining the local-domain and finite-extension assumptions. ## Main results -* `Monogenic.exists_isAdjoinRootMonic_of_quotientMap_etale`: the main theorem (Lemma 3.1). +* `Monogenic.exists_isAdjoinRootMonic_of_quotientMap_etale`: a generalization of Lemma 3.1. ## Auxiliary lemmas @@ -32,7 +34,9 @@ closed, `S` a UFD, and there exists a height-one prime `q ⊆ S` such that `R/(q ## References -* [Balçik et al., *Monogenic generators for étale extensions of local rings*](https://arxiv.org/abs/2503.07846) +* Irmak Balçık, Stephanie Chan, Yuan Liu, and Bianca Viray, + [*Number fields generated by points in linear systems on + curves*](https://arxiv.org/html/2503.07846v2), Lemma 3.1. ## Tags @@ -300,7 +304,9 @@ lemma exists_isAdjoinRootMonic_of_principal_adjust (by rw [h_span_eq]; exact h_ms_eq))⟩⟩ -/-- **Lemma 3.1** of [arXiv:2503.07846](https://arxiv.org/abs/2503.07846). +/-- A generalization of **Lemma 3.1** of +[Balçık et al.](https://arxiv.org/html/2503.07846v2), proved here under weaker hypotheses +than the regular-local assumptions in the source. If `R` and `S` are local integral domains with `R` integrally closed, `S` a UFD, and `R → S` finite and injective, and there exists a height-one prime `q ⊆ S` such that `R/(q ∩ R) → S/q` is étale, then diff --git a/LeanPool/projects.yml b/LeanPool/projects.yml index cbf81e4d8e..3ee467a0cc 100644 --- a/LeanPool/projects.yml +++ b/LeanPool/projects.yml @@ -10118,6 +10118,7 @@ projects: entry_module: LeanPool.MarkoffModP authors: - Yuma Mizuno + - Guanghao Li source: url: https://github.com/yuma-mizuno/markoff-modp github_repo: yuma-mizuno/markoff-modp From daf025173cfaf3b59a620b2f89042081a47d8cba Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:16:16 +0000 Subject: [PATCH 29/37] Repair Markoff module interfaces and remove unused assumptions --- .../ConstantOpenGlueData.lean | 2 +- .../Combinatorics/ProductOfChainsGrid.lean | 4 +- .../Combinatorics/SymmetricChainBasic.lean | 8 +- .../AbsoluteIrreducibilityBaseChange.lean | 4 +- .../AuxiliaryFamilyIndexing.lean | 4 +- ...indLocalizationDerivationPreservation.lean | 2 +- .../DedekindLocalizationOrder.lean | 4 +- .../DedekindPerfectResidueCaseI.lean | 2 +- .../FiniteExtensionCanonicalWronskian.lean | 1 + .../FiniteExtensionExceptionalSupport.lean | 1 + .../FiniteExtensionPrincipalDivisor.lean | 1 + ...eAuxiliaryFinitePlacePrincipalDivisor.lean | 1 + .../PlaneCurveBoundarySupport.lean | 2 + .../PlaneCurveDiagonalStabilizer.lean | 4 +- .../PlaneCurveFiniteDifferentBound.lean | 8 +- .../PlaneCurvePoweredHeightBounds.lean | 2 + .../CorvajaZannier/PlaneCurveSupportRank.lean | 10 +-- .../BGS/CorvajaZannier/PoweredImageCurve.lean | 3 +- .../TorsionExhaustiveGcdDivisorBound.lean | 3 + .../TorsionGcdDivisorBound.lean | 1 + .../HasseWeil/ClosedPlaceEulerRecurrence.lean | 6 +- ...ionInfinityPlaceSplittingMultiplicity.lean | 77 +++++-------------- .../DedekindDifferentLocalTrace.lean | 5 ++ ...tantExtensionFinitePlaceCompatibility.lean | 13 ++++ ...tExtensionFinitePlaceFrobeniusAverage.lean | 7 +- ...nsionFrobeniusTwistFinitePlaceAverage.lean | 4 +- ...actConstantExtensionInfinityDifferent.lean | 1 + ...diateFrobeniusTwistFinitePlaceAverage.lean | 8 +- .../ExactConstantExtensionTower.lean | 2 + ...FiniteExtensionDivisorClassRecurrence.lean | 7 +- .../FiniteExtensionEffectiveDivisorSplit.lean | 13 ++++ .../FiniteExtensionPlaceAlgEquiv.lean | 1 + .../HasseWeil/FiniteExtensionPlaceTower.lean | 39 ++++++++++ .../HasseWeil/FiniteExtensionRiemannRoch.lean | 4 +- ...teFieldConstantExtensionNormalization.lean | 7 +- ...nFieldNormalClosureOriginalCompositum.lean | 26 +++---- ...FunctionFieldNormalClosureRatFuncBase.lean | 1 + ...unctionFieldNormalClosureRatFuncEquiv.lean | 8 +- .../LocalPoleCumulativeQuotient.lean | 2 +- .../BGS/HasseWeil/LocalPoleFiltration.lean | 3 + .../BGS/HasseWeil/OnePointDivisorSplit.lean | 5 ++ .../BGS/HasseWeil/OnePointStepanovGrid.lean | 1 + .../BGS/HasseWeil/PlaneCoordinatePole.lean | 1 + .../PlaneCoordinatePoleAtInfinity.lean | 2 + .../HasseWeil/PlaneFrobeniusReduction.lean | 6 +- .../PlaneRationalPlaceAffineComparison.lean | 1 + .../HasseWeil/PlaneSingularPointBound.lean | 3 +- .../BGS/HasseWeil/PoleDivisor.lean | 3 + .../BGS/HasseWeil/RatFuncParameterPole.lean | 8 +- .../BGS/HasseWeil/RationalPlace.lean | 1 + .../RiemannSpaceFinitePlaceIncrement.lean | 2 + .../Assembly/EvenSignOrbitDivisibility.lean | 4 +- .../Markoff/Assembly/OrbitDivisibility.lean | 10 +-- .../Markoff/Core/ConicParametrization.lean | 3 +- .../BGS/Markoff/Core/Rotation.lean | 8 +- .../BGS/NumberTheory/DivisorBound.lean | 2 +- .../NumberTheory/RankinProfileMatching.lean | 4 +- 57 files changed, 218 insertions(+), 147 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean index fd0d9ec587..5de1bae33c 100644 --- a/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean +++ b/LeanPool/MarkoffModP/BGS/AlgebraicGeometry/ConstantOpenGlueData.lean @@ -144,7 +144,7 @@ def constantOpenGlueDataOfCommonTargetMap CategoryTheory.GlueData.ofGlueData', CategoryTheory.GlueData'.f', constantOpenGlueDataAux] simp only [dite_eq_right hij, dite_eq_right (Ne.symm hij)] - simp only [dite_eq_ite, Category.assoc, eqToHom_trans_assoc, eqToHom_refl, Category.id_comp] + simp congr 1 simp only [← Category.assoc] rw [h i] diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean index 1269880477..c014f3a6b1 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/ProductOfChainsGrid.lean @@ -184,7 +184,7 @@ theorem gridDecode_encode_x rw [Nat.sub_sub_self hy] omega have hsum : ¬x + y ≤ y + (n - y) := by omega - simp [gridDecodeX, gridPosition, gridKey, hmn, + simp [gridDecodeX, gridPosition, gridKey, hmn, min_eq_right hreverse, hsum, Nat.sub_sub_self hy] omega @@ -214,7 +214,7 @@ theorem gridDecode_encode_y ¬x + y - (n - y) ≤ n - (n - y) := by rw [Nat.sub_sub_self hy] omega - simp [gridDecodeY, gridPosition, gridKey, hmn, + simp [gridDecodeY, gridPosition, gridKey, hmn, min_eq_right hreverse, Nat.sub_sub_self hy] omega diff --git a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean index 4b453f4b36..f059c265eb 100644 --- a/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean +++ b/LeanPool/MarkoffModP/BGS/Combinatorics/SymmetricChainBasic.lean @@ -115,8 +115,8 @@ private theorem key_injective_on_antichain simpa [hxback, hyback] using hdecode by_contra hne exact - (hantichain (by simp using x.2) - (by simp using y.2) hne) hle + (hantichain (by simp) + (by simp) hne) hle · have hle : y.1 ≤ x.1 := by have hdecode := decomposition.decode_mono kx iy ix hyx @@ -129,8 +129,8 @@ private theorem key_injective_on_antichain simpa [hxback, hyback] using hdecode by_contra hne exact - (hantichain (by simp using y.2) - (by simp using x.2) (Ne.symm hne)) hle + (hantichain (by simp) + (by simp) (Ne.symm hne)) hle /-- Every antichain injects into the central rank of a finite ranked poset equipped with an explicit symmetric-chain decomposition. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean index a5de614b59..2c7b6862ec 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AbsoluteIrreducibilityBaseChange.lean @@ -218,7 +218,7 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed simpa only [θ, MvPolynomial.eval₂Hom_X'] using hqGE exact left_ne_zero_of_mul_eq_one hprod have hcoeffFormula : gE.coeff mg = x (gVar mg) := by - simp [gE, G, + simp [gE, G, MvPolynomial.coeff_monomial, hmgMem, θ] rw [hcoeffFormula] exact hxG @@ -241,7 +241,7 @@ theorem irreducible_map_of_irreducible_map_isAlgClosed simpa only [θ, MvPolynomial.eval₂Hom_X'] using hqHE exact left_ne_zero_of_mul_eq_one hprod have hcoeffFormula : hE'.coeff mh = x (hVar mh) := by - simp [hE', H, + simp [hE', H, MvPolynomial.coeff_monomial, hmhMem, θ] rw [hcoeffFormula] exact hxH diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean index 24e1c293d4..4373cc8bc4 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean @@ -98,7 +98,9 @@ theorem indexedAuxiliaryWronskian_det_eq_derivationWronskian_det Matrix.reindex e.symm e.symm (BGS.Algebra.derivationWronskian D g) := by ext i j - simp only [Matrix.reindex_apply, Equiv.symm_symm, Matrix.submatrix_apply] + simp [indexedDedekindLocalWronskian, + auxiliaryFamilyDerivativeOrder, BGS.Algebra.derivationWronskian, + Matrix.reindex_apply, Matrix.submatrix, g, e] exact (Module.End.pow_apply D.toLinearMap _ (f j)).symm rw [hmatrix, Matrix.det_reindex_self] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean index ef9f89d999..65c134e97a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationDerivationPreservation.lean @@ -98,7 +98,7 @@ theorem ambientDerivation_preserves_localizationAtPrime_of_preserves (algebraMap R (Localization.AtPrime q) 1) := by rw [show invD * algebraMap R (Localization.AtPrime q) d = algebraMap R (Localization.AtPrime q) 1 by - simp [invD, dSub] using hspec] + simp [invD, dSub]] _ = 1 := by simp refine ⟨z', ?_⟩ apply mul_right_cancel₀ hdU diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean index 0adad6147a..c2ebfd16e0 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalizationOrder.lean @@ -62,13 +62,13 @@ theorem valuation_eq_of_isEquiv_of_surjective rw [← exp_lt_exp, ← hπw] have hvlt : v π < v 1 := by rw [hπv, map_one] - simp using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) + simp simpa using h.lt_iff_lt.mp hvlt have hb : b < 0 := by rw [← exp_lt_exp, ← hρv] have hwlt : w ρ < w 1 := by rw [hρw, map_one] - simp using (WithZero.exp_lt_exp.mpr (show (-1 : ℤ) < 0 by omega)) + simp simpa using h.lt_iff_lt.mpr hwlt have hwEq : w π = w (ρ ^ (-a)) := by rw [hπw, map_zpow₀, hρw, ← exp_zsmul] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean index 8f8ab1301c..287542aa74 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean @@ -73,7 +73,7 @@ theorem exists_frobeniusSubfield_regular_unit_sub_mul_mem_of_perfect_residue rw [map_sub, map_mul, hbMap] dsimp [ratio] rw [← map_mul] - simp only [Units.inv_mul_cancel_right] + simp change algebraMap R κ (u : R) - algebraMap R κ (u : R) = 0 exact sub_self _ have hbFrob : algebraMap R L b ∈ frobeniusSubfield L p := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean index b320eeb654..74c7339746 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean @@ -89,6 +89,7 @@ local instance canonicalWronskianFiniteIntegralClosureIsTorsionFree : /-! ## The finite different and the discriminant degree -/ +omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem finiteExtensionFinitePrincipalDivisor_algebraMap_apply (d : RatFuncFiniteIntegralClosure K L) (hd : d ≠ 0) (q : FiniteExtensionFinitePlace K L) : diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index c0a0ff2e8f..45bf43e6de 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -583,6 +583,7 @@ def finiteExtensionFamilyMemberSupport (f : A → L) (a : A) : exact (finiteExtensionPrincipalDivisor K L (f a)).support.attach.map (finiteExtensionFamilyMemberSupportEmbedding K L f a) +omit [DecidableEq K] in @[simp] theorem mem_finiteExtensionFamilyMemberSupport_iff (f : A → L) (a : A) (w : FiniteExtensionFamilyPlace K L f) : diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean index 0559a0d79a..9c294e8bed 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean @@ -330,6 +330,7 @@ def finiteExtensionInfinityDirectDegreeSum (x : L) : ℤ := (finiteExtensionInfinityPrincipalDivisor K L x).sum (fun P n => n * (P.1.inertiaDeg (RatFuncInfinityIntegers K) : ℤ)) +omit [DecidableEq K] in theorem finiteExtensionInfinityDirectDegreeSum_eq_grouped (x : L) : finiteExtensionInfinityDirectDegreeSum K L x = finiteExtensionInfinityOrderSum K L x := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean index 3c65d867ef..177b25cbb6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean @@ -45,6 +45,7 @@ local instance auxiliaryFinitePlaceBridgeIntegralClosureIsDedekindDomain : IsIntegralClosure.isDedekindDomain K[X] (RatFunc K) L (FunctionField.ringOfIntegers K L) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The actual localized finite-place order is exactly the coefficient in the exhaustive finite principal divisor. -/ theorem finiteExtensionFinitePlaceLocalOrder_eq_principalDivisor diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean index 670399529d..91a779e05b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -198,6 +198,7 @@ private theorem probe_finiteExtensionInfinityPlace_X_gt_one simpa using (algebraMap (RatFunc K) L).injective.ne RatFunc.X_ne_zero)).mpr hxinverse +omit [DecidableEq K] in private theorem probeFiniteExtensionPlaceValuation_injective : Function.Injective (probeFiniteExtensionPlaceValuation K L) := by intro w₁ w₂ h @@ -428,6 +429,7 @@ private noncomputable def valuationCenterPlace ⟨valuationCenterIdeal (S := S) V hbase, valuationCenterIdeal_isPrime (S := S) V hbase, hne⟩ +omit [IsDomain R] in private theorem valuationSubringAt_valuationCenterPlace_le (V : ValuationSubring F) (hbase : ∀ r : R, algebraMap R F r ∈ V) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean index d4f7da8798..d06e1bf29e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveDiagonalStabilizer.lean @@ -36,11 +36,11 @@ theorem coeff_diagonalScale {F : Type*} [Field F] f.coeff m * (z.1 : F) ^ m 0 * (z.2 : F) ^ m 1 := by classical by_cases hm : m ∈ f.support - · simp [diagonalScale, + · simp [diagonalScale, MvPolynomial.coeff_monomial, hm] · have hcoeff : f.coeff m = 0 := MvPolynomial.notMem_support_iff.mp hm - simp [diagonalScale, + simp [diagonalScale, MvPolynomial.coeff_monomial, hm, hcoeff] theorem support_diagonalScale {F : Type*} [Field F] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean index 8987d727f4..339ca3cfbc 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean @@ -80,7 +80,7 @@ theorem powerBasis_discr_smul_eq_diagonal_det_sq_mul (P.map (algebraMap K L)).mulVec (fun i => pbz.basis (e i)) := by funext i rw [show pbx.basis i = pbx.gen ^ (i : ℕ) by - simp only [PowerBasis.coe_basis] using congrFun (PowerBasis.coe_basis pbx) i] + simp only [PowerBasis.coe_basis]] rw [show P.map (algebraMap K L) = Matrix.diagonal (fun i : Fin pbx.dim => algebraMap K L (r ^ (i : ℕ))) by @@ -89,8 +89,7 @@ theorem powerBasis_discr_smul_eq_diagonal_det_sq_mul split <;> simp_all] rw [Matrix.mulVec_diagonal] rw [show pbz.basis (e i) = pbz.gen ^ ((e i : Fin pbz.dim) : ℕ) by - simp only [PowerBasis.coe_basis] using - congrFun (PowerBasis.coe_basis pbz) (e i)] + simp only [PowerBasis.coe_basis]] rw [hgenX, hgenZ] have hei : ((e i : Fin pbz.dim) : ℕ) = (i : ℕ) := by simp [e] rw [hei] @@ -175,7 +174,7 @@ theorem finitePlaceOrder_algebraMap_unit_eq_zero finitePlaceOrder v (algebraMap R F (u : R)) = 0 := by have h := finitePlaceOrderTop_algebraMap_unit (A := R) (K := F) v u have hu : algebraMap R F (u : R) ≠ 0 := - by simp using (IsFractionRing.injective R F).ne u.ne_zero + by simp rw [finitePlaceOrderTop_eq_coe v _ hu] at h exact_mod_cast h @@ -625,6 +624,7 @@ section PlaneCurveFiniteDifferentBound variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- At each finite first-coordinate prime, the residue-weighted different is bounded by the order of the discriminant of the original plane equation. -/ theorem planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean index 5d4d3c5b0c..835573a14e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean @@ -231,6 +231,7 @@ theorem finiteExtensionGcdWeightedDegree_neg_neg rw [hdivx, hdivy] omit [DecidableEq (RatFunc K)] in +omit [Fintype K] in /-- The torsion gcd used by the endpoint is exactly the `1-u`, `1-v` gcd used by the canonical Wronskian estimate. -/ theorem planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub @@ -289,6 +290,7 @@ theorem planeCurveExhaustiveTorsionGcdWeightedDegree_eq_one_sub exact finiteExtensionGcdWeightedDegree_neg_neg (K := K) (L := L) (1 - x ^ m) (1 - y ^ n) hxm hyn +omit [Fintype K] in /-- With the coordinates swapped, the one-minus gcd is bounded by the exact powered height of the first coordinate. -/ theorem finiteExtensionGcdWeightedDegree_one_sub_planeCurvePowers_swapped_le diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean index 18a55fe226..4a7fbd3afb 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveSupportRank.lean @@ -445,11 +445,11 @@ private theorem exists_directionalPolynomial_representation have index_cast : ∀ s ∈ F.support, (index s : ℤ) = parameter s - lo := by intro s hs rw [show (index s : ℤ) = max (parameter s - lo) 0 by - simp [index] using Int.ofNat_toNat (parameter s - lo)] + simp [index]] simp [parameter_bounds s hs |>.1] have N_cast : (N : ℤ) = hi - lo := by rw [show (N : ℤ) = max (hi - lo) 0 by - simp [N] using Int.ofNat_toNat (hi - lo)] + simp [N]] have hlohi : lo ≤ hi := Finset.min'_le P hi hhi_mem simp [hlohi] have index_le : ∀ s ∈ F.support, index s ≤ N := by @@ -492,8 +492,7 @@ private theorem exists_directionalPolynomial_representation rw [show q.coeff (index s) = ∑ t ∈ F.support, (Polynomial.monomial (index t) (F.coeff t)).coeff (index s) by - simp [q] using coeff_finset_sum (index s) F.support - (fun t => Polynomial.monomial (index t) (F.coeff t))] + simp [q]] rw [Finset.sum_eq_single s] · rw [Polynomial.coeff_monomial, ite_eq_left rfl] · intro t ht hts @@ -519,8 +518,7 @@ private theorem exists_directionalPolynomial_representation rw [show q.coeff n = ∑ s ∈ F.support, (Polynomial.monomial (index s) (F.coeff s)).coeff n by - simp [q] using coeff_finset_sum n F.support - (fun s => Polynomial.monomial (index s) (F.coeff s))] + simp [q]] simp only [Polynomial.coeff_monomial] apply Finset.sum_eq_zero intro s hs diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean index 5dab33aa7e..7de25c32e6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean @@ -315,8 +315,7 @@ theorem ratFuncSpecialization_comp_polynomial_algebraMap Polynomial.eval₂RingHom (algebraMap K L) u := by apply Polynomial.ringHom_ext · intro c - simp only [RingHom.coe_comp, Function.comp_apply, RatFunc.algebraMap_C, Polynomial.coe_eval₂RingHom, - Polynomial.eval₂_C] + simp [ratFuncSpecialization] rw [← RatFunc.algebraMap_eq_C, (RatFunc.algEquivOfTranscendental u hu).commutes] rfl diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index 5516c6d24f..3e3bbdfe24 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -57,6 +57,7 @@ noncomputable def maximalIdealInFractionEmbeddingRange (m : MaximalSpectrum A) : Ideal (algebraMap A L).range := m.asIdeal.map (fractionEmbeddingRangeEquiv (A := A) (L := L)).toRingHom +omit [IsDomain A] in private theorem maximalIdealInFractionEmbeddingRange_ne_top (m : MaximalSpectrum A) : maximalIdealInFractionEmbeddingRange (A := A) (L := L) m ≠ ⊤ := by @@ -88,6 +89,7 @@ noncomputable def dominatingValuationSubring (m : MaximalSpectrum A) : (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) (by exact maximalIdealInFractionEmbeddingRange_ne_top m)) +omit [IsDomain A] in theorem range_le_dominatingValuationSubring (m : MaximalSpectrum A) : (algebraMap A L).range ≤ (dominatingValuationSubring (A := A) (L := L) m).toSubring := @@ -95,6 +97,7 @@ theorem range_le_dominatingValuationSubring (m : MaximalSpectrum A) : (maximalIdealInFractionEmbeddingRange (A := A) (L := L) m) (by exact maximalIdealInFractionEmbeddingRange_ne_top m))).1 +omit [IsDomain A] in theorem algebraMap_mem_dominatingValuationSubring_nonunits_of_mem (m : MaximalSpectrum A) (r : A) (hr : r ∈ m.asIdeal) : algebraMap A L r ∈ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean index 37f804b420..ba00281ead 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionGcdDivisorBound.lean @@ -66,6 +66,7 @@ theorem liftedTorsionPointNormalizationBranch_liesOver (S := B) (torsionPointMaximalIdeal f firstOrder secondOrder z).asIdeal exact (Classical.choose_spec hex).2 +omit [IsDomain (PlaneCurveCoordinateRing f)] in /-- Chosen branches above distinct torsion points are distinct because their contractions to the affine coordinate ring are distinct. -/ theorem liftedTorsionPointNormalizationBranch_injective diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean index 5832029297..14f1d4fff9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ClosedPlaceEulerRecurrence.lean @@ -37,10 +37,12 @@ section FiniteWeightedFamily variable {I : Type*} [Fintype I] [DecidableEq I] -private abbrev WeightedEffectiveDivisor (w : I → ℕ) (n : ℕ) := +/-- Natural-valued divisors of a prescribed weighted degree. -/ +abbrev WeightedEffectiveDivisor (w : I → ℕ) (n : ℕ) := {D : I →₀ ℕ // Finsupp.weight w D = n} -@[reducible] private noncomputable def weightedEffectiveDivisorFintype +/-- A finite enumeration of weighted effective divisors when every weight is nonzero. -/ +@[reducible] noncomputable def weightedEffectiveDivisorFintype (w : I → ℕ) (hw : ∀ i, w i ≠ 0) (n : ℕ) : Fintype (WeightedEffectiveDivisor w n) := Set.Finite.fintype (Finsupp.finite_of_nat_weight_eq w hw n) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean index 4f87b61709..0af7930c17 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -7,6 +7,7 @@ module public import Mathlib.RingTheory.Localization.AtPrime.Extension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity /-! @@ -32,50 +33,6 @@ noncomputable section open BGS.CorvajaZannier IsDedekindDomain -private noncomputable def infinitySplittingHeightOneResidueFieldRingEquiv - {A B : Type*} [CommRing A] [CommRing B] - (e : A ≃+* B) (q : IsDedekindDomain.HeightOneSpectrum A) : - q.asIdeal.ResidueField ≃+* - (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q).asIdeal.ResidueField := - Ideal.residueFieldRingEquiv q.asIdeal - (IsDedekindDomain.HeightOneSpectrum.equivOfRingEquiv e q).asIdeal e - (by - change q.asIdeal = (q.asIdeal.comap e.symm).comap e - exact (Ideal.comap_of_equiv e).symm) - -private theorem infinitySplittingMappedPrimeCompl_disjoint_of_under_eq - (R A : Type*) [CommRing R] [CommRing A] [Algebra R A] - (p : Ideal R) [p.IsPrime] (q : Ideal A) - (hq : q.under R = p) : - Disjoint - ((Algebra.algebraMapSubmonoid A p.primeCompl : Submonoid A) : Set A) - (q : Set A) := by - rw [Set.disjoint_left] - intro x hxM hxq - obtain ⟨r, hr, rfl⟩ := hxM - exact hr (hq ▸ hxq) - -private noncomputable def infinitySplittingLocalizationResidueFieldRingEquiv - (A B : Type*) [CommRing A] [CommRing B] [Algebra A B] - (M : Submonoid A) [IsLocalization M B] - (q : Ideal A) [q.IsPrime] - (hdisj : Disjoint (M : Set A) (q : Set A)) : - let Q := Ideal.map (algebraMap A B) q - letI : Q.IsPrime := - IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj - q.ResidueField ≃+* Q.ResidueField := by - let Q := Ideal.map (algebraMap A B) q - letI : Q.IsPrime := - IsLocalization.isPrime_of_isPrime_disjoint M B q inferInstance hdisj - have hcomap : q = Q.under A := - (IsLocalization.under_map_of_isPrime_disjoint - M B inferInstance hdisj).symm - let f : q.ResidueField →+* Q.ResidueField := - Ideal.ResidueField.map q Q (algebraMap A B) hcomap - apply RingEquiv.ofBijective f - exact (RingHom.surjectiveOnStalks_of_isLocalization M B) - |>.residueFieldMap_bijective q Q hcomap - variable (C S N : Type*) [Field C] [Field S] [Field N] [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] @@ -261,7 +218,7 @@ private theorem ratFuncCoefficientAlgHom_reciprocalPolynomialRingHom /-- The reciprocal polynomial algebra map is the composite through the rational-function field. -/ -private theorem ratFuncExtensionReciprocalPolynomialAlgebra_map +theorem ratFuncExtensionReciprocalPolynomialAlgebra_map (K L : Type*) [Field K] [Field L] [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra (RatFunc K) L] (p : K[X]) : @@ -319,7 +276,7 @@ private theorem exactConstantExtensionSReciprocalPolynomialAlgebra_eq : /-- The transported reciprocal `C[X]`-action is the actual action induced by the canonical embedding of `C(X)` into the exact constant extension. -/ -private theorem exactConstantExtensionCReciprocalPolynomialAlgebra_eq : +theorem exactConstantExtensionCReciprocalPolynomialAlgebra_eq : letI : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := @@ -572,7 +529,7 @@ omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFun [DecidableEq (RatFunc S)] [FiniteDimensional C S] [IsGalois C S] in /-- The reciprocal origin is the unique prime of `S[X]` above the reciprocal origin of `C[X]`. -/ -private theorem primeUnderReciprocalOrigin_eq_origin +theorem primeUnderReciprocalOrigin_eq_origin (p : Ideal S[X]) [p.IsPrime] (hunder : p.under C[X] = Ideal.span ({Polynomial.X} : Set C[X])) : @@ -623,7 +580,8 @@ private theorem rw [polynomialTensorCancel_algebraMap_coefficient C S N p] rfl -private noncomputable def +/-- The reciprocal normalization equivalence transports height-one primes. -/ +noncomputable def exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N) ≃ HeightOneSpectrum @@ -631,7 +589,8 @@ private noncomputable def HeightOneSpectrum.equivOfRingEquiv (exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv C S N) -private theorem +/-- The reciprocal normalization equivalence preserves contraction to `C[X]`. -/ +theorem exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv_under (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) : ((exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv @@ -650,7 +609,8 @@ private theorem C S N p] simp only [e, RingEquiv.symm_apply_apply] -private noncomputable def +/-- Presented infinity places correspond to height-one primes above the reciprocal origin. -/ +noncomputable def exactConstantExtensionPresentedInfinityHeightOneEquiv : ExactConstantExtensionPresentedInfinityPlace C S N ≃ {q : HeightOneSpectrum @@ -659,7 +619,7 @@ private noncomputable def Ideal.span ({Polynomial.X} : Set C[X])} := by letI : IsScalarTower C[X] S[X] (S ⊗[C] integralClosure C[X] N) := - exactConstantExtensionPresentedReciprocalPolynomialTower C S N + by exact exactConstantExtensionPresentedReciprocalPolynomialTower C S N let e := exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv C S N @@ -693,7 +653,8 @@ private noncomputable def p.under C[X] = q.asIdeal.under C[X] := Ideal.under_under q.asIdeal _ = Ideal.span ({Polynomial.X} : Set C[X]) := hqC -private noncomputable def +/-- Height-one primes above the reciprocal origin identify with its prime fiber. -/ +noncomputable def exactConstantExtensionCReciprocalHeightOneEquivPrimesOver : {q : HeightOneSpectrum (integralClosure C[X] (ExactConstantExtension C N S)) // @@ -776,7 +737,7 @@ private noncomputable def /-- Presented infinity places, before changing the transported reciprocal action to the actual one, are precisely the affine primes above `(X)`. -/ -private noncomputable def +noncomputable def exactConstantExtensionPresentedInfinityPlaceEquivCReciprocalPrimes : ExactConstantExtensionPresentedInfinityPlace C S N ≃ (Ideal.span ({Polynomial.X} : Set C[X])).primesOver @@ -846,7 +807,9 @@ private theorem primesOverEquivOfAlgebraEq_under subst b rfl -private noncomputable def +/-- The prime fiber over the reciprocal origin is preserved by identifying the two polynomial +actions. -/ +noncomputable def exactConstantExtensionCReciprocalPrimesEquivActual : letI : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact @@ -1055,7 +1018,7 @@ noncomputable def exactConstantExtensionPresentedInfinityResidueFieldRingEquiv rfl let affineResidue : q.1.asIdeal.ResidueField ≃+* qA.asIdeal.ResidueField := - infinitySplittingHeightOneResidueFieldRingEquiv e q.1 + heightOneResidueFieldRingEquiv e q.1 letI : Algebra C[X] E := ratFuncExtensionReciprocalPolynomialAlgebra C E let A := integralClosure C[X] E @@ -1077,13 +1040,13 @@ noncomputable def exactConstantExtensionPresentedInfinityResidueFieldRingEquiv let M := Algebra.algebraMapSubmonoid A o.primeCompl have hPUnder : P.1.under C[X] = o := P.2.2.over.symm have hdisj : Disjoint (M : Set A) (P.1 : Set A) := - infinitySplittingMappedPrimeCompl_disjoint_of_under_eq + mappedPrimeCompl_disjoint_of_under_eq C[X] A o P.1 hPUnder let Q := Ideal.map (algebraMap A B) P.1 letI : Q.IsPrime := IsLocalization.isPrime_of_isPrime_disjoint M B P.1 P.2.1 hdisj let localResidue : P.1.ResidueField ≃+* Q.ResidueField := - infinitySplittingLocalizationResidueFieldRingEquiv A B M P.1 hdisj + localizationResidueFieldRingEquiv A B M P.1 hdisj change q.1.asIdeal.ResidueField ≃+* Q.ResidueField exact affineResidue'.trans localResidue diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 26d3afaf46..adfa0b7b3f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -102,6 +102,7 @@ theorem algebraMap_mem_pow_of_mem_under_pow (q.under A).asIdeal ≤ q.asIdeal.comap (algebraMap A B) from le_rfl)) n) hmap omit [IsIntegralClosure B A L] in +omit [IsIntegrallyClosed A] in theorem natCast_le_count_spanSingleton_algebraMap_of_mem_under_pow (q : HeightOneSpectrum B) (c : A) (n : ℕ) (hc0 : c ≠ 0) (hc : c ∈ (q.under A).asIdeal ^ n) : @@ -150,6 +151,7 @@ theorem count_dual_one_eq_neg_different_multiplicity rw [hdual, FractionalIdeal.count_inv, FractionalIdeal.count_coeIdeal_eq_multiplicity (K := L) _ hdiff] +omit [Algebra.IsIntegral A B] in theorem mem_dual_one_iff_different_multiplicity_le_count {x : L} (hx : x ≠ 0) : x ∈ FractionalIdeal.dual A K₀ (1 : FractionalIdeal B⁰ L) ↔ @@ -176,6 +178,8 @@ theorem trace_mem_algebraMap_range_of_different_multiplicity_le_count (by exact one_ne_zero)).mp hzdual (1 : L) (by simp) simpa [Algebra.traceForm_apply] using htrace +omit [Algebra A L] [IsScalarTower A B L] [IsIntegralClosure B A L] [IsIntegrallyClosed A] + [Algebra.IsIntegral A B] in theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L) : Set.Finite {q : HeightOneSpectrum B | ¬ (-(multiplicity q.asIdeal (differentIdeal A B) : ℤ) ≤ @@ -211,6 +215,7 @@ theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L (K := L) (differentIdeal A B) hdiff, hqdiff, hqy] simp +omit [IsIntegralClosure B A L] in theorem exists_base_multiplier_clearing_different_counts [IsDedekindDomain A] (hdiff : differentIdeal A B ≠ ⊥) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index 7406bbffb2..f10985abd6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -89,6 +89,9 @@ local instance compatibilityOldNormalizationConstantAlgebra : ((algebraMap C[X] (integralClosure C[X] N)).comp (algebraMap C C[X])) +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] in /-- The two normalization equivalences used by the residue and polynomial models have the same underlying map. -/ private theorem finiteFieldConstantExtensionIntegralClosureAlgEquiv_apply_eq_polynomial @@ -117,6 +120,8 @@ variable (hExact : algebraicClosure C N = include hExact +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [Algebra.IsSeparable (RatFunc C) N] in /-- The exact constant extension is finite over the original rational function field. This is the finite-dimensional input needed to compare its `C[X]`- and `S[X]`-normalizations. -/ @@ -153,6 +158,9 @@ theorem finiteDimensional_exactConstantExtension_over_baseRatFunc : Module.Finite.equiv e exact Module.Finite.trans N (ExactConstantExtension C N S) +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] in /-- Polynomial coefficient extension is compatible with the two canonical rational-function embeddings into the exact constant extension. -/ theorem exactConstantExtension_ratFunc_polynomialCompatibility @@ -724,6 +732,11 @@ local instance compatibilityConstantIntermediateTopTower : (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional C S] [IsGalois C S] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional L N] [IsGalois L N] in /-- The rational-function base, an intermediate field, and the exact constant extension form the tower used by the relative Galois action. -/ private theorem exactConstantExtensionCompatibility_ratFuncBaseTower : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean index 91bdaf8440..525251a3bf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceFrobeniusAverage.lean @@ -197,12 +197,13 @@ theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum letI : Module L (ExactConstantExtension C N S) := Algebra.toModule letI : IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := - exactConstantExtensionFrobeniusAverage_ratFuncBaseTower C S N L + by exact exactConstantExtensionFrobeniusAverage_ratFuncBaseTower C S N L letI : IsGalois L (ExactConstantExtension C N S) := exactConstantExtension_isGalois C L N S hExact letI : FiniteDimensional L (ExactConstantExtension C N S) := - finiteDimensional_exactConstantExtension_over_intermediate - (C := C) (S := S) (N := N) (L := L) hExact + by + exact finiteDimensional_exactConstantExtension_over_intermediate + (C := C) (S := S) (N := N) (L := L) hExact letI : FiniteDimensional (RatFunc C) (ExactConstantExtension C N S) := finiteDimensional_exactConstantExtension_over_baseRatFunc diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean index b838c5e1c0..aab125bc80 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -573,7 +573,9 @@ abbrev FrobeniusTwistFinitePlaceFiberFixedBy (exactConstantExtensionFrobeniusTwist C (RatFunc C) N S hExact g) -private theorem sigma_value_injective +/-- A sigma-family value map is injective when fibers are injective and their indices +can be recovered injectively from the values. -/ +theorem sigma_value_injective {I A B : Type*} {V : I → Type*} (index : I → A) (hindex : Function.Injective index) (value : ∀ i, V i → B) (under : B → A) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean index f1102e1f98..a01e1f8bd9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityDifferent.lean @@ -267,6 +267,7 @@ noncomputable def exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv (rationalBase_algebraMap_eq C S N hExact) z.1) exact integralClosureRingEquivOfIntegralTower A R₁ L +omit [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The infinity-normalization base-change equivalence preserves the ambient function-field element. -/ theorem exactConstantExtensionInfinityNormalizationBaseChangeRingEquiv_coe diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index fb8f9bf94d..6fbf66ced3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -118,7 +118,7 @@ omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFun [IsScalarTower (RatFunc C) L N] [IsGalois L N] in /-- The exact constant extension is finite-dimensional over every intermediate function field `L`. -/ -private theorem finiteDimensional_exactConstantExtension_over_intermediateBase +theorem finiteDimensional_exactConstantExtension_over_intermediateBase (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) : letI : Field (ExactConstantExtension C N S) := @@ -151,7 +151,7 @@ omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFun [FiniteDimensional L N] [IsGalois L N] in /-- Compatibility of the rational-function and intermediate-base algebra maps on the exact constant extension. -/ -private theorem exactConstantExtensionIntermediate_ratFuncBaseTower : +theorem exactConstantExtensionIntermediate_ratFuncBaseTower : letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S letI : SMul (RatFunc C) (ExactConstantExtension C N S) := @@ -202,7 +202,7 @@ noncomputable def intermediateFrobeniusTwistFieldRatFuncAlgebra /-- The induced rational-function algebra is compatible with the inclusion of the twist field into the exact constant extension. -/ -private theorem intermediateFrobeniusTwistField_ratFunc_tower +theorem intermediateFrobeniusTwistField_ratFunc_tower (g : N ≃ₐ[L] N) : letI : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact @@ -1226,7 +1226,7 @@ noncomputable def /-- Restriction through an intermediate Frobenius-twist field agrees with direct restriction to `L`. -/ -private theorem finitePlaceUnder_intermediateFrobeniusTwist_under +theorem finitePlaceUnder_intermediateFrobeniusTwist_under (g : N ≃ₐ[L] N) : let T := ExactConstantExtension C N S let : Field T := exactConstantExtensionField C N S hExact diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean index cc85ac88b4..fd34fdc926 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionTower.lean @@ -75,6 +75,7 @@ theorem exactConstantExtensionTowerAlgHom_tmul (s : S) (m : M) : (ExactConstantExtension C N S) := (exactConstantExtensionTowerAlgHom C M N S).toAlgebra +omit [FiniteDimensional C S] [IsGalois C S] in /-- The tensor map preserves the enlarged constants on the left factor. -/ theorem exactConstantExtensionTower_leftScalarTower : letI : Algebra S (ExactConstantExtension C M S) := @@ -223,6 +224,7 @@ theorem exactConstantExtensionTower_isGalois exact IsGalois.tower_top_of_isGalois M (ExactConstantExtension C M S) (ExactConstantExtension C N S) +omit [IsGalois M N] in /-- Finite constant base change preserves the relative extension degree. -/ theorem exactConstantExtensionTower_finrank (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean index b685d96b42..4cf4424053 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean @@ -85,6 +85,7 @@ theorem finiteExtensionDivisorClassMap_principal FiniteExtensionDivisor K L ⧸ finiteExtensionPrincipalDivisorSubgroup K L) = 0 exact QuotientAddGroup.eq_zero_iff _ |>.2 ⟨x, hx, rfl⟩ +omit [Fintype K] in private theorem finiteExtensionPrincipalDivisorSubgroup_le_degreeKernel : finiteExtensionPrincipalDivisorSubgroup K L ≤ (finiteExtensionDivisorDegreeHom K L).ker := by @@ -97,7 +98,7 @@ def finiteExtensionDivisorClassDegree : FiniteExtensionDivisorClass K L →+ ℤ := QuotientAddGroup.lift (finiteExtensionPrincipalDivisorSubgroup K L) (finiteExtensionDivisorDegreeHom K L) - (finiteExtensionPrincipalDivisorSubgroup_le_degreeKernel K L) + (by exact finiteExtensionPrincipalDivisorSubgroup_le_degreeKernel K L) @[simp] theorem finiteExtensionDivisorClassDegree_mk @@ -214,7 +215,9 @@ def finiteExtensionEffectiveDivisorClassFiberEquiv (finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).symm ⟨E.1, E.2.1⟩ have hDcast : finiteExtensionEffectiveDivisorToDivisor K L D = E.1 := - finiteExtensionEffectiveDivisorToDivisor_of_symm K L ⟨E.1, E.2.1⟩ + congrArg Subtype.val + ((finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).apply_symm_apply + ⟨E.1, E.2.1⟩) have hdegreeInt : finiteExtensionDivisorDegree K L E.1 = (n : ℤ) := by obtain ⟨x, hx, hE⟩ := E.2.2 rw [hE, finiteExtensionDivisorDegree_add, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean index 6507a992c6..55e4a4ef8d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean @@ -67,6 +67,8 @@ def finiteExtensionEffectiveDivisorSplitEquiv : FiniteExtensionEffectiveInfinityDivisor K L := Finsupp.sumFinsuppEquivProdFinsupp +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionEffectiveDivisorSplitEquiv_finite_apply (D : FiniteExtensionEffectiveDivisor K L) @@ -74,6 +76,8 @@ theorem finiteExtensionEffectiveDivisorSplitEquiv_finite_apply (finiteExtensionEffectiveDivisorSplitEquiv K L D).1 P = D (.inl P) := rfl +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionEffectiveDivisorSplitEquiv_infinity_apply (D : FiniteExtensionEffectiveDivisor K L) @@ -81,6 +85,8 @@ theorem finiteExtensionEffectiveDivisorSplitEquiv_infinity_apply (finiteExtensionEffectiveDivisorSplitEquiv K L D).2 P = D (.inr P) := rfl +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionEffectiveDivisorSplitEquiv_symm_inl (D : (FiniteExtensionFinitePlace K L →₀ ℕ) × @@ -89,6 +95,8 @@ theorem finiteExtensionEffectiveDivisorSplitEquiv_symm_inl (finiteExtensionEffectiveDivisorSplitEquiv K L).symm D (.inl P) = D.1 P := rfl +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionEffectiveDivisorSplitEquiv_symm_inr (D : (FiniteExtensionFinitePlace K L →₀ ℕ) × @@ -97,6 +105,7 @@ theorem finiteExtensionEffectiveDivisorSplitEquiv_symm_inr (finiteExtensionEffectiveDivisorSplitEquiv K L).symm D (.inr P) = D.2 P := rfl +omit [Fintype K] in /-- The existing finite-divisor degree is the restriction of exhaustive place degree to the finite branch. -/ theorem finiteExtensionEffectiveFiniteDivisorDegree_eq_placeDegree @@ -136,6 +145,8 @@ def finiteExtensionEffectiveDivisorToDivisor (D : FiniteExtensionEffectiveDivisor K L) : FiniteExtensionDivisor K L := D.mapRange (fun n : ℕ => (n : ℤ)) (by simp) +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionEffectiveDivisorToDivisor_apply (D : FiniteExtensionEffectiveDivisor K L) @@ -149,6 +160,7 @@ theorem finiteExtensionEffectiveDivisorToDivisor_effective 0 ≤ finiteExtensionEffectiveDivisorToDivisor K L D P := by simp +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Natural degree casts to the integer degree of the associated exhaustive divisor. -/ theorem finiteExtensionEffectiveDivisorDegree_cast @@ -236,6 +248,7 @@ local instance effectiveDivisorInfinityPlaceFinite : (RatFuncInfinityIntegralClosure K L)) infer_instance +omit [Fintype K] in /-- Every infinity coefficient is bounded by the weighted degree. -/ theorem finiteExtensionEffectiveInfinityDivisor_apply_le_degree (D : FiniteExtensionEffectiveInfinityDivisor K L) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean index 382e3070b9..6c4d89f95f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceAlgEquiv.lean @@ -362,6 +362,7 @@ noncomputable def finiteExtensionInfinityPlaceResidueFieldAlgEquivOfAlgEquiv change P.1 = (P.1.comap eInf.symm).comap eInf exact (Ideal.comap_of_equiv eInf.toRingEquiv).symm) +omit [FiniteDimensional (RatFunc K) L] [FiniteDimensional (RatFunc K) M] in /-- Corresponding infinity places have the same absolute degree. -/ @[simp] theorem finiteExtensionInfinityPlaceEquivOfAlgEquiv_degree diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index e834e326d1..fbf4403efb 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -188,12 +188,18 @@ def finitePlaceUnder FiniteExtensionFinitePlace K M := HeightOneSpectrum.under (RatFuncFiniteIntegralClosure K M) P +omit [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finitePlaceUnder_asIdeal (P : FiniteExtensionFinitePlace K L) : (finitePlaceUnder K M L P).asIdeal = P.asIdeal.under (RatFuncFiniteIntegralClosure K M) := rfl +omit [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- Restricting a finite place through the intermediate field preserves the place below it in the rational function field. -/ @[simp] @@ -343,6 +349,8 @@ def infinityPlaceUnder exact Ideal.LiesOver.tower_bot wL.asIdeal wM.asIdeal (ratFuncInfinityPlace K).asIdeal +omit [DecidableEq K] [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem infinityPlaceUnder_asIdeal (P : FiniteExtensionInfinityPlace K L) : @@ -355,16 +363,23 @@ def placeUnder : FiniteExtensionPlace K L → FiniteExtensionPlace K M | .inl P => .inl (finitePlaceUnder K M L P) | .inr P => .inr (infinityPlaceUnder K M L P) +omit [DecidableEq K] [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem placeUnder_inl (P : FiniteExtensionFinitePlace K L) : placeUnder K M L (.inl P) = .inl (finitePlaceUnder K M L P) := rfl +omit [DecidableEq K] [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem placeUnder_inr (P : FiniteExtensionInfinityPlace K L) : placeUnder K M L (.inr P) = .inr (infinityPlaceUnder K M L P) := rfl +omit [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- Every finite place of the intermediate field has a finite place above it in the top field. This is lying-over for the induced integral-closure map. -/ theorem finitePlaceUnder_surjective : @@ -380,6 +395,8 @@ theorem finitePlaceUnder_surjective : apply HeightOneSpectrum.ext exact (Ideal.over_def Q.1 P.asIdeal).symm +omit [DecidableEq K] [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Every place above infinity in the intermediate field has a place above it in the top field. -/ theorem infinityPlaceUnder_surjective : @@ -397,6 +414,8 @@ theorem infinityPlaceUnder_surjective : apply Subtype.ext exact (Ideal.over_def Q.1 P.1).symm +omit [DecidableEq K] [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Restriction from the top field is surjective on the exhaustive place type. -/ theorem placeUnder_surjective : @@ -480,6 +499,8 @@ noncomputable instance infinityPlaceUnderFiberFintype (P.1.primesOver (RatFuncInfinityIntegralClosure K L)) (infinityPlaceUnderFiberEquivPrimesOver K M L P).symm +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra.IsSeparable (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) L] in /-- The rank of the relative finite integral-closure extension is the field degree of the top function field over the intermediate field. -/ theorem finiteIntegralClosure_relative_finrank_eq_field_finrank : @@ -534,6 +555,7 @@ theorem sum_finitePlaceUnderFiber_ramification_inertia_eq_finrank _ = _ := Ideal.sum_ramification_inertia_eq_finrank P.asIdeal (RatFuncFiniteIntegralClosure K L) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- Field-degree form of the finite-place fundamental equality. -/ theorem sum_finitePlaceUnderFiber_ramification_inertia_eq_field_finrank (P : FiniteExtensionFinitePlace K M) : @@ -578,6 +600,7 @@ theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_finrank _ = _ := Ideal.sum_ramification_inertia_eq_finrank P.1 (RatFuncInfinityIntegralClosure K L) +omit [DecidableEq K] in /-- Field-degree form of the fundamental equality above infinity. -/ theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_field_finrank (P : FiniteExtensionInfinityPlace K M) : @@ -588,6 +611,8 @@ theorem sum_infinityPlaceUnderFiber_ramification_inertia_eq_field_finrank rw [sum_infinityPlaceUnderFiber_ramification_inertia_eq_finrank K M L P, infinityIntegralClosure_relative_finrank_eq_field_finrank K M L] +omit [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Place degree is multiplicative when a finite place is restricted through an intermediate function field. The second factor is the residue-field degree in the relative extension. -/ @@ -606,6 +631,8 @@ theorem finiteExtensionPlaceDegree_inl_eq_mul_relativeInertiaDeg rw [finitePlaceUnder_under] ring +omit [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The analogous degree-tower formula for places above infinity. -/ theorem finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg (Q : FiniteExtensionInfinityPlace K L) : @@ -648,6 +675,8 @@ noncomputable def finiteIntegralClosureGalAction : (RatFuncFiniteIntegralClosure K M) M L (RatFuncFiniteIntegralClosure K L) +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The relative Galois action fixes the intermediate finite integral closure. -/ theorem finiteIntegralClosureGalSmulComm : @@ -697,6 +726,8 @@ noncomputable def finitePlaceGalAction : change (g * h) • P.asIdeal = g • h • P.asIdeal rw [mul_smul] } +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Relative Galois conjugation does not change the restricted finite place. -/ @[simp] theorem finitePlaceUnder_finitePlaceGalSmul @@ -736,6 +767,8 @@ def FinitePlacesGaloisConjugate letI := finiteIntegralClosureGalAction K M L ∃ g : Gal(L/M), Q.asIdeal = g • P.asIdeal +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra.IsSeparable (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) L] in /-- Two finite places above the same intermediate place are conjugate under the relative field Galois group. -/ theorem exists_gal_smul_finitePlace_asIdeal_of_same_under @@ -817,6 +850,8 @@ noncomputable def infinityIntegralClosureGalAction : (RatFuncInfinityIntegralClosure K M) M L (RatFuncInfinityIntegralClosure K L) +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- The relative Galois action fixes the intermediate infinity integral closure. -/ theorem infinityIntegralClosureGalSmulComm : @@ -836,6 +871,8 @@ theorem infinityIntegralClosureGalSmulComm : (RatFuncInfinityIntegralClosure K L) g s rw [map_mul, AlgEquiv.commutes] +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- The relative Galois action also commutes with scalars from the base infinity valuation ring. -/ theorem ratFuncInfinityIntegersGalSmulComm : @@ -933,6 +970,7 @@ def InfinityPlacesGaloisConjugate letI := infinityIntegralClosureGalAction K M L ∃ g : Gal(L/M), Q.1 = g • P.1 +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) L] in /-- Two places above infinity with the same intermediate restriction are conjugate under the relative field Galois group. -/ theorem exists_gal_smul_infinityPlace_asIdeal_of_same_under @@ -1147,6 +1185,7 @@ private theorem ratFuncFinitePlaceResidueField_finite let : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K infer_instance +omit [DecidableEq (RatFunc K)] in private theorem finitePlaceResidueField_finite (P : FiniteExtensionFinitePlace K M) : Finite P.asIdeal.ResidueField := by let p := HeightOneSpectrum.under K[X] P diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean index 8eef755577..c62c29ff95 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean @@ -184,8 +184,8 @@ private theorem isIntegral_infinityBase_iff (x : L) : def finiteExtensionInfinityIntegralClosureRingEquiv : RatFuncInfinityIntegralClosure K L ≃+* FunctionField.Chart.infiniteIntegers K L where - toFun x := ⟨x.1, (isIntegral_infinityBase_iff K L x.1).mp x.2⟩ - invFun x := ⟨x.1, (isIntegral_infinityBase_iff K L x.1).mpr x.2⟩ + toFun x := ⟨x.1, by exact (isIntegral_infinityBase_iff K L x.1).mp x.2⟩ + invFun x := ⟨x.1, by exact (isIntegral_infinityBase_iff K L x.1).mpr x.2⟩ left_inv _ := rfl right_inv _ := rfl map_mul' _ _ := rfl diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean index 3cdf332e96..514fae368c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean @@ -134,10 +134,9 @@ noncomputable def finiteFieldConstantExtensionIntegralClosureAlgEquiv (integralClosure C[X] N)).symm.toRingEquiv.trans e with commutes' := fun s => by apply Subtype.ext - simp only [AlgEquiv.symm_toRingEquiv, RingEquiv.symm_mk, AlgEquiv.toEquiv_eq_coe, - AlgEquiv.symm_toEquiv_eq_symm, RingEquiv.toEquiv_eq_coe, Algebra.TensorProduct.algebraMap_apply, - Algebra.algebraMap_self, RingHom.id_apply, Equiv.toFun_as_coe, EquivLike.coe_coe, RingEquiv.coe_trans, - RingEquiv.coe_mk, Function.comp_apply, polynomialTensorCancel_symm_tmul, SetLike.coe_eq_coe] + simp [e, finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, + TensorProduct.toIntegralClosure] change s ⊗ₜ[C] (1 : N) = algebraMap S[X] (S ⊗[C] N) (Polynomial.C s) change s ⊗ₜ[C] (1 : N) = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index 1ce1a67913..b8d31e43ea 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -268,10 +268,6 @@ noncomputable def functionFieldNormalClosureConstantBaseToOriginalCompositum map_add' _ _ := rfl commutes' _ := rfl -@[reducible] private noncomputable def originalCompositumRatFuncSelfAlgebra - (C : Type*) [Field C] : Algebra C (RatFunc C) := - RatFunc.instAlgebraOfPolynomial C C - private theorem originalCompositum_ratFunc_algHom_ext {C M : Type*} [Field C] [Field M] [Algebra C M] (f g : RatFunc C →ₐ[C] M) (hX : f RatFunc.X = g RatFunc.X) : f = g := by @@ -300,7 +296,7 @@ rational-function equivalence. -/ functionFieldNormalClosureConstantFieldRatFuncAlgebraForOriginalCompositum : Algebra (FunctionFieldNormalClosureConstantField K F) (RatFunc (FunctionFieldNormalClosureConstantField K F)) := - originalCompositumRatFuncSelfAlgebra (FunctionFieldNormalClosureConstantField K F) + ratFuncSelfAlgebra (FunctionFieldNormalClosureConstantField K F) /-- The `C(t)`-algebra structure on `CF`, transported through the canonical equivalence `C(t) ≃ C K(t)` inside the normal closure. -/ @@ -448,7 +444,7 @@ noncomputable def ratFuncExactConstantExtensionAlgebra K C F hExact E ≃ₐ[RatFunc C] M := by intro model1 model2 hExact C E M model3 model4 model5 - letI : Algebra C (RatFunc C) := originalCompositumRatFuncSelfAlgebra C + letI : Algebra C (RatFunc C) := ratFuncSelfAlgebra C letI : Algebra K[X] F := RingHom.toAlgebra ((algebraMap (RatFunc K) F).comp @@ -460,15 +456,15 @@ noncomputable def let g : RatFunc C →ₐ[C] M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgHom K F hExact - have hX : f RatFunc.X = g RatFunc.X := by - apply Subtype.ext - have hfX := originalMultiplicationCanonicalRatFunc_X K F hExact - have hgX := congrArg Subtype.val (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X K F) - exact hfX.trans hgX.symm - have hfg : f = g := originalCompositum_ratFunc_algHom_ext (C := C) (M := M) f g hX - refine { eC with commutes' := ?_ } - intro r - exact DFunLike.congr_fun hfg r + exact { eC with commutes' := by + intro r + have hX : f RatFunc.X = g RatFunc.X := by + apply Subtype.ext + have hfX := originalMultiplicationCanonicalRatFunc_X K F hExact + have hgX := congrArg Subtype.val (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X K F) + exact hfX.trans hgX.symm + have hfg : f = g := originalCompositum_ratFunc_algHom_ext (C := C) (M := M) f g hX + exact DFunLike.congr_fun hfg r } end CanonicalConstantPresentation diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean index 6d0ae552c2..6ba35c8997 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean @@ -75,6 +75,7 @@ theorem functionFieldNormalClosureConstantCompositum_fixingSubgroup : rintro _ ⟨c, rfl⟩ exact (functionFieldNormalClosureConstantToBase K L c).property +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The kernel fixed field is the compositum `K(t)C` inside the normal closure. -/ theorem functionFieldNormalClosureConstantBase_eq_compositum : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean index 829934e347..8f04684847 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean @@ -39,6 +39,11 @@ noncomputable def ratFuncEquivOfAdjoinEqTop ratFuncEquivOfAdjoinEqTop x hx hgen RatFunc.X = x := by simp [ratFuncEquivOfAdjoinEqTop] +/-- The canonical constant-field algebra on its rational function field. -/ +@[reducible] noncomputable def ratFuncSelfAlgebra + (C : Type*) [Field C] : Algebra C (RatFunc C) := + RatFunc.instAlgebraOfPolynomial C C + variable (K L : Type*) [Field K] [Field L] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra (RatFunc K) L] @@ -48,8 +53,7 @@ variable (K L : Type*) [Field K] [Field L] local instance functionFieldNormalClosureConstantFieldRatFuncAlgebra : Algebra (FunctionFieldNormalClosureConstantField K L) (RatFunc (FunctionFieldNormalClosureConstantField K L)) := - RatFunc.instAlgebraOfPolynomial (FunctionFieldNormalClosureConstantField K L) - (FunctionFieldNormalClosureConstantField K L) + ratFuncSelfAlgebra (FunctionFieldNormalClosureConstantField K L) /-- The kernel fixed field is canonically the rational function field over the exact constant field, with the original parameter corresponding to `X`. diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean index 26a89241f0..b0e9aa2d02 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleCumulativeQuotient.lean @@ -48,7 +48,7 @@ def localPolePrincipalPartMap (π : R) (n : ℕ) : (localNormalizedLiftLinearMap (localPoleSpace (K := K) (L := L) π n) (algebraMap R L (π ^ n)) - (cumulativeLocalPoleSpace_regular (K := K) (L := L) π n)) + (by exact cumulativeLocalPoleSpace_regular (K := K) (L := L) π n)) theorem localPolePrincipalPartMap_surjective (π : R) (hπ : π ≠ 0) (n : ℕ) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean index d40d2ab441..df847a45fa 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean @@ -53,11 +53,13 @@ def localPoleSpace (π : R) (n : ℕ) : Submodule K L where rw [← hr] ring +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [IsFractionRing R L] in theorem mem_localPoleSpace_iff (π : R) (n : ℕ) (x : L) : x ∈ localPoleSpace (K := K) (L := L) π n ↔ ∃ r : R, algebraMap R L (π ^ n) * x = algebraMap R L r := Iff.rfl +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [IsFractionRing R L] in /-- Increasing the allowed pole order enlarges the local pole space. -/ theorem localPoleSpace_mono (π : R) (n : ℕ) : localPoleSpace (K := K) (L := L) π n ≤ @@ -72,6 +74,7 @@ theorem localPoleSpace_mono (π : R) (n : ℕ) : _ = algebraMap R L π * algebraMap R L r := congrArg _ hr _ = algebraMap R L (π * r) := by rw [map_mul] +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [IsFractionRing R L] in private theorem localPoleSpace_regular (π : R) (n : ℕ) : ∀ x : localPoleSpace (K := K) (L := L) π n, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean index f6eb061c11..adf57d8f68 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean @@ -55,6 +55,8 @@ theorem finiteExtensionDivisorAway_apply_of_ne finiteExtensionDivisorAway K L D P v = D v := by simp [finiteExtensionDivisorAway, hv] +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- Splitting off the `P` coefficient recovers the original divisor. -/ theorem single_add_finiteExtensionDivisorAway (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : @@ -65,6 +67,8 @@ theorem single_add_finiteExtensionDivisorAway simp · simp [finiteExtensionDivisorAway, hv] +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- Removing one coefficient preserves effectiveness. -/ theorem finiteExtensionDivisorAway_effective (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) @@ -86,6 +90,7 @@ theorem finiteExtensionDivisorDegree_single classical simp [finiteExtensionDivisorDegree] +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Divisor degree changes sign under negation. -/ theorem finiteExtensionDivisorDegree_neg (D : FiniteExtensionDivisor K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean index 24f298cfea..c975ca3e26 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean @@ -126,6 +126,7 @@ theorem finiteExtensionPrincipalDivisor_sum_eq_zero_or_gt K L (f i) (∑ j ∈ S, f j) hi0 hrest0 hsum P exact (lt_min hiOrder hrestOrder).trans_le hlower +omit [Fintype K] [DecidableEq K] in /-- A unique least-order term controls a finite sum. -/ theorem finiteExtensionPrincipalDivisor_sum_eq_of_unique_min {ι : Type*} (P : FiniteExtensionPlace K L) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean index af2b9aed73..fb84688953 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean @@ -35,6 +35,7 @@ noncomputable section variable {K : Type*} [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] +omit [Fintype K] in /-- In the first-coordinate `RatFunc` model, the pole height of the first coordinate is the degree of the plane equation in the second variable. -/ theorem finiteExtensionHeight_planeCurveFirstCoordinate diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean index 56a7fe29d4..e567e6ccd3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean @@ -220,6 +220,7 @@ theorem finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegativ rw [← planeCurveFirstCoordinateRatFuncAlgebra_X f hx] exact principalDivisor_algebraMap_X_inl_nonnegative K L q +omit [Fintype K] in /-- Consequently, the pole divisor of the first plane coordinate vanishes at every finite place. -/ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero @@ -255,6 +256,7 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero (finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegative hf hpartialSecond q))] +omit [Fintype K] in /-- Every place above infinity occurs with positive coefficient in the pole divisor of the first plane coordinate. -/ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean index 9e4ffe171f..880bbbcdde 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneFrobeniusReduction.lean @@ -88,12 +88,10 @@ theorem hasBidegreeAtMost_planeSwapAlgEquiv have hd := hdegree n hn have hzero : Finsupp.mapDomain (Equiv.swap (0 : Fin 2) 1) n 0 = n 1 := by - simp using Finsupp.mapDomain_apply - (Equiv.swap (0 : Fin 2) 1).injective n (1 : Fin 2) + simp have hone : Finsupp.mapDomain (Equiv.swap (0 : Fin 2) 1) n 1 = n 0 := by - simp using Finsupp.mapDomain_apply - (Equiv.swap (0 : Fin 2) 1).injective n (0 : Fin 2) + simp simpa [hzero, hone] using And.intro hd.2 hd.1 theorem map_planeSwapAlgEquiv diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean index c885705746..b180c93d9e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean @@ -1047,6 +1047,7 @@ private theorem exists_centered_coordinate_hom simp [h] +omit [Fintype K] in /-- A good rational finite place admits a coordinate-ring map into its valuation ring. The map is the canonical inclusion in the function field, and the inverse image of the local maximal ideal is exactly the maximal ideal diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean index 81474b806f..54d1837c09 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSingularPointBound.lean @@ -85,8 +85,7 @@ theorem secondCoordinateCriticalResultant_natDegree_le Polynomial.natDegree_mul_le _ ≤ firstDegree + 0 := Nat.add_le_add (hFcoeff (i + 1)) (by - simp using - (Polynomial.natDegree_natCast (R := K) (i + 1)).le) + simp) _ = firstDegree := Nat.add_zero _ have hresultant := BGS.CorvajaZannier.natDegree_resultant_le_of_degree_le diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean index 9f67bce2b4..aad1ab92ff 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean @@ -60,6 +60,7 @@ theorem finiteExtensionPoleDivisor_apply (x : L) Finsupp.filter_apply] split <;> simp_all +omit [Fintype K] [DecidableEq K] in /-- A pole divisor is effective. -/ theorem finiteExtensionPoleDivisor_effective (x : L) : ∀ v, 0 ≤ finiteExtensionPoleDivisor K L x v := by @@ -67,6 +68,7 @@ theorem finiteExtensionPoleDivisor_effective (x : L) : rw [finiteExtensionPoleDivisor_apply] split <;> omega +omit [Fintype K] [DecidableEq K] in /-- Adding the pole divisor to the principal divisor is effective. -/ theorem finiteExtensionPrincipal_add_poleDivisor_effective (x : L) : ∀ v, 0 ≤ finiteExtensionPrincipalDivisor K L x v + @@ -114,6 +116,7 @@ theorem finiteExtensionDivisorDegree_poleDivisor ring _ = (finiteExtensionHeight K L x : ℤ) := by omega +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Divisor degree commutes with natural scaling. -/ theorem finiteExtensionDivisorDegree_nsmul (n : ℕ) (D : FiniteExtensionDivisor K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean index 9b3a83619d..d412a0bf43 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean @@ -238,12 +238,14 @@ theorem finiteExtensionPoleDivisor_ratFuncX_support : classical ext v cases v with - | inl q => simp [finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero] + | inl q => + rw [Finsupp.mem_support_iff, finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero] + simp | inr P => have he : 0 < P.1.ramificationIdx (RatFuncInfinityIntegers K) := P.1.ramificationIdx_pos (RatFuncInfinityIntegers K) - simp [finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx, - Nat.ne_of_gt he] + rw [Finsupp.mem_support_iff, finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx] + simp [Nat.ne_of_gt he] /-- The negative support of the principal divisor of the rational parameter consists exactly of the places above infinity. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean index ff48ac16d5..2551852fc9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlace.lean @@ -188,6 +188,7 @@ def rationalFinitePlaceToBaseFiber by exact rationalFinitePlace_baseDegree_eq_one K L Q⟩, ⟨Q.1.asIdeal, Q.1.isPrime, ⟨rfl⟩⟩⟩ +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in theorem rationalFinitePlaceToBaseFiber_injective : Function.Injective (rationalFinitePlaceToBaseFiber K L) := by intro Q R hQR diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean index 6eb56c6f6c..2d785b6a50 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean @@ -50,6 +50,7 @@ theorem localNormalizedLift_spec (x : T) : a * x.1 = algebraMap R L (localNormalizedLift T a hregular x) := Classical.choose_spec (hregular x) +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [Algebra K R] [IsScalarTower K R L] in theorem localNormalizedLift_add (x y : T) : localNormalizedLift T a hregular (x + y) = localNormalizedLift T a hregular x + localNormalizedLift T a hregular y := by @@ -61,6 +62,7 @@ theorem localNormalizedLift_add (x y : T) : simp only [Submodule.coe_add] ring +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] in theorem localNormalizedLift_smul (c : K) (x : T) : localNormalizedLift T a hregular (c • x) = c • localNormalizedLift T a hregular x := by diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean index 6a16562a31..be20918f5d 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EvenSignOrbitDivisibility.lean @@ -66,7 +66,7 @@ theorem evenSign_eq_one_of_smul_eq eq_zero_of_neg_eq htwo (congrArg Point.x3 fixedPoint) have hsecond : x.1.1.x2 = 0 := by have hmarkoff := x.1.2 - simp only [ne_eq] at hmarkoff + simp [IsMarkoff, markoffPolynomial, hfirst, hthird] at hmarkoff exact hmarkoff exfalso apply x.2 @@ -79,7 +79,7 @@ theorem evenSign_eq_one_of_smul_eq eq_zero_of_neg_eq htwo (congrArg Point.x3 fixedPoint) have hfirst : x.1.1.x1 = 0 := by have hmarkoff := x.1.2 - simp only [ne_eq] at hmarkoff + simp [IsMarkoff, markoffPolynomial, hsecond, hthird] at hmarkoff exact hmarkoff exfalso apply x.2 diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean index 93349baabb..21dac327d0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/OrbitDivisibility.lean @@ -69,7 +69,7 @@ private theorem first_ne_zero_of_third_eq_zero intro hx1 have hx2 : x.1.1.x2 = 0 := by have hmark := x.1.2 - simp only [ne_eq] at hmark + simp [IsMarkoff, markoffPolynomial, hx1, hx3] at hmark exact hmark apply x.2 apply Subtype.ext @@ -81,7 +81,7 @@ private theorem second_ne_zero_of_first_eq_zero intro hx2 have hx3 : x.1.1.x3 = 0 := by have hmark := x.1.2 - simp only [ne_eq] at hmark + simp [IsMarkoff, markoffPolynomial, hx1, hx2] at hmark exact hmark apply x.2 apply Subtype.ext @@ -93,7 +93,7 @@ private theorem second_ne_zero_of_third_eq_zero intro hx2 have hx1 : x.1.1.x1 = 0 := by have hmark := x.1.2 - simp only [ne_eq] at hmark + simp [IsMarkoff, markoffPolynomial, hx2, hx3] at hmark exact hmark apply x.2 apply Subtype.ext @@ -105,7 +105,7 @@ private theorem third_ne_zero_of_first_eq_zero intro hx3 have hx2 : x.1.1.x2 = 0 := by have hmark := x.1.2 - simp only [ne_eq] at hmark + simp [IsMarkoff, markoffPolynomial, hx1, hx3] at hmark exact hmark apply x.2 apply Subtype.ext @@ -117,7 +117,7 @@ private theorem third_ne_zero_of_second_eq_zero intro hx3 have hx1 : x.1.1.x1 = 0 := by have hmark := x.1.2 - simp only [ne_eq] at hmark + simp [IsMarkoff, markoffPolynomial, hx2, hx3] at hmark exact hmark apply x.2 apply Subtype.ext diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean index e95dbdbf47..9477143531 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/ConicParametrization.lean @@ -98,8 +98,7 @@ theorem splitFiberPoint_mem (w s : Fˣ) (hw : (w : F) ^ 2 ≠ 1) : rw [splitFiberProduct, splitTorusTrace_sq_sub_four] have hdifference := splitEigenvalueDifference_ne_zero w hw field_simp - simp only [Units.val_inv_eq_inv_val, ne_eq, Units.ne_zero, not_false_eq_true, mul_inv_cancel_right₀, mul_zero, - mul_eq_zero, OfNat.ofNat_ne_zero, pow_eq_zero_iff] + simp [splitTorusTrace] right field_simp ring diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean b/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean index 363b3ff767..c2503ea1ad 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Core/Rotation.lean @@ -87,7 +87,7 @@ def movingCoordinates (x : Point R) : Fin 2 → R := /-- The fundamental rotation is the action of `rho(3 * x.x1)` on the moving coordinates. -/ theorem rho_mulVec_movingCoordinates (x : Point R) : rho (3 * x.x1) *ᵥ movingCoordinates x = movingCoordinates (rotate1 x) := by - simp [movingCoordinates, rotate1] using rho_mulVec (3 * x.x1) x.x2 x.x3 + simp [movingCoordinates, rotate1] /-- The normalized trace parameter for the fundamental rotation is `3 * x.x1`. -/ theorem rho_trace_fundamentalRotation (x : Point R) : (rho (3 * x.x1)).trace = 3 * x.x1 := by @@ -101,10 +101,8 @@ theorem rotate1_eq_rho (x : Point R) : (rho (3 * x.x1) *ᵥ movingCoordinates x) 1⟩ := by ext · rfl - · simp [rotate1, movingCoordinates] using - congrFun (rho_mulVec_movingCoordinates x).symm 0 - · simp [rotate1, movingCoordinates] using - congrFun (rho_mulVec_movingCoordinates x).symm 1 + · simp [rotate1, movingCoordinates] + · simp [rotate1, movingCoordinates] end diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean index dde7a6d0c0..28854a620f 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean @@ -38,7 +38,7 @@ private lemma exists_pow_succ_le_constant_mul_two_pow (k : ℕ) : by_cases ha : N ≤ a + 1 · have hreal := hN (a + 1) ha simp only [Real.norm_eq_abs, one_mul, abs_pow] at hreal - simp only [ge_iff_le] at hreal + simp at hreal have hnat : (a + 1) ^ k ≤ 2 ^ (a + 1) := by exact_mod_cast hreal calc (a + 1) ^ k ≤ 2 ^ (a + 1) := hnat diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean index 60fc7e61cd..44b14e80ee 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/RankinProfileMatching.lean @@ -190,7 +190,7 @@ private theorem oddDivisorCount_map_assignment simp only [List.map_cons, RankinNeighborProfile.oddDivisorCount, List.prod_cons] rw [ih htail] - simp only [ite_mul, one_mul] at hhead + simp [RankinOddFactor.Matches] at hhead rw [hhead.1, hhead.2.1] private theorem odd_prime_not_mem_both_neighbors @@ -556,7 +556,7 @@ private theorem oddCoarseEulerProduct_map_assignment RankinNeighborProfile.oddCoarseEulerProduct, List.prod_cons] rw [ih htail] - simp only [ite_mul, one_mul] at hhead + simp [RankinOddFactor.Matches] at hhead rw [hhead.1, hhead.2.1] private theorem jointOddPrimeList_coarse_product_minus From 3640b4b31b70c9ff67eeb1f792336dc957a8dfc9 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 20:22:06 +0000 Subject: [PATCH 30/37] Restore generated Markoff imports and generalize finite counting assumptions --- LeanPool.lean | 609 ++++++++++++++++++ .../FiniteExtensionEffectiveDivisorSplit.lean | 6 +- .../FiniteExtensionPlaceDegreeFiniteness.lean | 6 +- .../BGS/HasseWeil/FixedPointAverage.lean | 7 +- 4 files changed, 621 insertions(+), 7 deletions(-) diff --git a/LeanPool.lean b/LeanPool.lean index a51b21e1d1..f284194ea4 100644 --- a/LeanPool.lean +++ b/LeanPool.lean @@ -4438,6 +4438,615 @@ public import LeanPool.MRiscX.Tactics.SplitLastSeq public import LeanPool.MRiscX.Tactics.TacticUtil public import LeanPool.MRiscX.Util.BasicTheorems public import LeanPool.MarkoffModP +public import LeanPool.MarkoffModP.BGS +public import LeanPool.MarkoffModP.BGS.Algebra.ClearedLinearFractionalSubstitution +public import LeanPool.MarkoffModP.BGS.Algebra.DifferentialWronskian +public import LeanPool.MarkoffModP.BGS.Algebra.KummerEigencharacterDescent +public import LeanPool.MarkoffModP.BGS.Algebra.RatFuncLinearFractionalEquiv +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.ConstantOpenGlueData +public import LeanPool.MarkoffModP.BGS.AlgebraicGeometry.SpecRingEquiv +public import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentCoefficient +public import LeanPool.MarkoffModP.BGS.Combinatorics.DivisorExponentSpernerBridge +public import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsGrid +public import LeanPool.MarkoffModP.BGS.Combinatorics.ProductOfChainsSperner +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainBasic +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainProduct +public import LeanPool.MarkoffModP.BGS.Combinatorics.SymmetricChainRectangle +public import LeanPool.MarkoffModP.BGS.CorvajaZannier +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AbsoluteIrreducibilityBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamily +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.AuxiliaryFamilyIndexing +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateGauss +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.BivariateResultant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.CompletionLinearDisjointness +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryLocalCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindCanonicalDifferentScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindDifferentKaehler +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLeadingTermCancellation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalDerivationExtension +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationDerivationPreservation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindLocalizationOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPerfectResidueCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindPlaceOrder +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.DedekindRamifiedDerivationScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ElementaryFiniteFieldBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.EndpointComposition +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalAuxiliaryInfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalDifferentDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalized +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalGlobalNormalizedAutomatic +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalPlacewiseScaling +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionCanonicalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalPlaceBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExceptionalSupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionGcdOutsideHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionOneSubGcdHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPolynomialHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPositiveDegreePower +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionPrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionResidueSurjectivity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteFunctionFieldDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FinitePlaceCompletion +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusSubfield +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FrobeniusWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FunctionFieldProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GeneralCorvajaZannier +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianSummation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.GlobalWronskianWeightedPlaceSum +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityInertiaDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.InfinityPlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusBasis +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LaurentFrobeniusPowerBasis +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryCaseI +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalAuxiliaryWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalDerivative +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalMonogenicity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.LocalWronskian +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalCorollary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.NumericalOptimization +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.ParameterizedBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PerfectConstants +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlace +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlaceCases +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryFinitePlacePrincipalDivisor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveAuxiliaryIndependence +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBidegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveBoundarySupport +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalDegreeBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalEulerBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCanonicalGcdBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCharacteristicCardinality +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveCoordinatePowerHeight +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiagonalStabilizer +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveDiscriminantBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveExhaustiveGcdEndpoint +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFiniteDifferentBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveFunctionField +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityComplement +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveInfinityDifferentDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLocalReciprocalDiscriminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveLogarithmicGauss +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredHeightBounds +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePoweredImageDegreeBudget +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoAssembly +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoDegreeBridge +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurvePropositionTwoGeometric +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveRatFuncModel +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSeparability +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSharedOriginBoundary +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportDeterminant +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PlaneCurveSupportRank +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinateRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredCoordinates +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageBaseChange +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageCurve +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageExactSupportIndexBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelation +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageFrobeniusRelationSwapped +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageGaloisBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageHeightFactor +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndex +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PoweredImageIndexBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.PropositionTwoDegreeMonotonicity +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.RatFuncExhaustiveProductFormula +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.SeparatingCoordinateNotFrobenius +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionBidegreeCount +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionExhaustiveGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionGcdDivisorBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorsionPointNormalization +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TorusCharacterKernelBound +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.TranscendentalPowerDegree +public import LeanPool.MarkoffModP.BGS.CorvajaZannier.WronskianChangeParameter +public import LeanPool.MarkoffModP.BGS.Dynamics.FiniteForwardOrbit +public import LeanPool.MarkoffModP.BGS.Dynamics.StrictMeasureEscape +public import LeanPool.MarkoffModP.BGS.External.GeneralCurveTheorems +public import LeanPool.MarkoffModP.BGS.FiniteField.EllipticCharacterSum +public import LeanPool.MarkoffModP.BGS.FiniteField.HasseFrobenius +public import LeanPool.MarkoffModP.BGS.FiniteField.QuadraticCharacter +public import LeanPool.MarkoffModP.BGS.HasseWeil.AffinePointPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.CechRiemannLinearAlgebra +public import LeanPool.MarkoffModP.BGS.HasseWeil.ClosedPlaceEulerRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionClosedPlaceSplittingFormula +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceDegreeTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionInfinityPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionPlaceSplittingMultiplicity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantExtensionRationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldFinitePlaceDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldInfinityBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantFieldRatFuncCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ConstantTensorResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.DVRLocalPoleOrder +public import LeanPool.MarkoffModP.BGS.HasseWeil.DedekindDifferentLocalTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionAutomorphism +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionDifferentCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFiniteDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFinitePlaceFrobeniusAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwist +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistBoundedError +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceBridge +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistInfinityPlaceEquivalence +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistMultiplication +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRationalPlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionFrobeniusTwistStepanovUpper +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionGenusInvariance +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionInfinityPlaceCompatibility +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionNormalClosureTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRationalPlaceCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionRegularity +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTotalDifferentDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExactConstantExtensionTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionEvenDegreeStepanovBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.ExtensionPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.FilteredDimension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteBranchLocus +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionAffineIdealDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCanonicalityCriterion +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentCotraceCanonicality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCanonicalDifferentLocalMaximality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionClosedPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionCotraceLocalTraceImage +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisibleErrorFromConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorClassRecurrence +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionDivisorDegreeIndex +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionEffectiveDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionGenusBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseBoundFromEvenConstantExtensions +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionHasseWeil +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionIndexedZetaRationalityAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionLocalPoleSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceAlgEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceDegreeFiniteness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionPrincipalParts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannEventualGrowth +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannLowerFromGenus +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannRoch +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannShiftedEventualGrowth +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionRiemannSpaceProjectivization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionStandardZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionTotalDifferentEffectiveDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZeroCounting +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaDegreeIndexOneFromAllCounts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaNumeratorNoncancellation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteExtensionZetaSimplePole +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldCompositum +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldConstantExtensionResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldDivisibleExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldInfinityDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialDifferent +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldPolynomialNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteFieldSubfield +public import LeanPool.MarkoffModP.BGS.HasseWeil.FiniteLinearIndependenceBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceApproximation +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceFrobeniusFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePlaceNormalizationTransport +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinitePrincipalParts +public import LeanPool.MarkoffModP.BGS.HasseWeil.FinsuppWeightedFiber +public import LeanPool.MarkoffModP.BGS.HasseWeil.FixedPointAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaConstantExtensionIdentity +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOne +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaDegreeIndexOneIndexed +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEuler +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaEulerDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaHasseBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaRationalityDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.FormalZetaUniqueness +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusPlaceCardinality +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.FrobeniusTwistGroup +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosure +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstantBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalCompositum +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureOriginalField +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.FunctionFieldNormalClosureRatFuncEquiv +public import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisAverage +public import LeanPool.MarkoffModP.BGS.HasseWeil.GaloisTowerFactorialDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralBivariateAffineHasseWeil +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralFiniteExtensionRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCountAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.IdealMultiplicityMap +public import LeanPool.MarkoffModP.BGS.HasseWeil.LinearFunctionalGluing +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleCumulativeQuotient +public import LeanPool.MarkoffModP.BGS.HasseWeil.LocalPoleFiltration +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointBase +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointDivisorSplit +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointHeight +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointPoleSemigroup +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointSectionSelection +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovBasisGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovDegreeTwoAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStepanovGrid +public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointStrictLevels +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineCountTransfer +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineFiberBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromEvenError +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineHasseWeilFromZeta +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneAffineRationalPlaceComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneConstantField +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePole +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinatePoleAtInfinity +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCoordinateShear +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneCurveGenusBoundFromCotraceDegree +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFinitePlaceRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDeflation +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusDegenerate +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneFrobeniusReduction +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneInfinityRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneMonomialSpace +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneOnePointRiemannLower +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRationalPlaceAffineComparison +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneRegularPointCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSingularPointBound +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSmoothPointNormalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneSquareFieldStepanovCountAutomatic +public import LeanPool.MarkoffModP.BGS.HasseWeil.PlaneStepanovAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.PoleDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialSpectral +public import LeanPool.MarkoffModP.BGS.HasseWeil.PolynomialTensorCancel +public import LeanPool.MarkoffModP.BGS.HasseWeil.PowerSum +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncCanonicalInfinityDivisor +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncExactConstantExtension +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncInfinityLocalization +public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlace +public import LeanPool.MarkoffModP.BGS.HasseWeil.RationalPlaceTower +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceConstants +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceEffectiveIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceFinitePlaceIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.RiemannSpaceInfinityPlaceIncrement +public import LeanPool.MarkoffModP.BGS.HasseWeil.SpectralFromAsymptotic +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareExtensionAffinePlaces +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldResidue +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovAuxiliary +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.SquareFieldStepanovZeroCount +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovLinearAlgebra +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovParameters +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovRestrictionMaps +public import LeanPool.MarkoffModP.BGS.HasseWeil.StepanovSquareVanishing +public import LeanPool.MarkoffModP.BGS.HasseWeil.TensorRestriction +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaExtensionTrace +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaNumeratorSpectral +public import LeanPool.MarkoffModP.BGS.HasseWeil.ZetaTrace +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Asymptotics +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseLinearTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.CoarseSupportTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.DivisibleOrbitTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ElementaryCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenCoarseSupportFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenPairedMaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageCoarseLinearTail +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EulerSevenSplitCageSquareEnvelopeSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignBaseStableComplement +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignComplementDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.EvenSignOrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderComplementObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderEulerSevenComplementObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderPuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderRankinEnvelope +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExactOrderTraceBudget +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExceptionalPrimeCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ExplicitPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.FixedPointFreeMaximalDivisorTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.GiantOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.JointMaximalDivisorFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorLowOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MaximalDivisorPuncturedTransitivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.MiddleGameThenEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicBadComponent +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicMaximalDivisorConcreteCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NonparabolicPuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizationCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.NormalizedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.OrbitDivisibility +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorLowOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorMiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PairedMaximalDivisorTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.PuncturedSmallOrderCount +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainSperner +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinJointAntichainWidth +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.RankinWidthEnvelope +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.ReductionSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageEvenSignBase +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.SplitCageNonparabolicComplementFrontier +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.TransitivitySurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.Unconditional +public import LeanPool.MarkoffModP.BGS.Markoff.Assembly.WeightedCoarseSupportSurjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Cage +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.AxisEquivalence +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.BiquadraticPrimitiveQuartic +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.Connectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.EstimateFromPlane +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.HasseWeilAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.IncidenceGeometry +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneCountComparison +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneHasseWeil +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PlaneModels +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PowerCover +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.PulledRadicand +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.ShiftedTraceCurveIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.SmallPrime +public import LeanPool.MarkoffModP.BGS.Markoff.Cage.WitnessEquations +public import LeanPool.MarkoffModP.BGS.Markoff.Core +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Action +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Basic +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ConicParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.EvenSignAction +public import LeanPool.MarkoffModP.BGS.Markoff.Core.FiniteRotationEigenvalues +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NatConnectivity +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Normalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.NormalizedOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Core.ParabolicFibers +public import LeanPool.MarkoffModP.BGS.Markoff.Core.PuncturedNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Rotation +public import LeanPool.MarkoffModP.BGS.Markoff.Core.RotationTorus +public import LeanPool.MarkoffModP.BGS.Markoff.Core.SemiringFunctor +public import LeanPool.MarkoffModP.BGS.Markoff.Core.Statements +public import LeanPool.MarkoffModP.BGS.Markoff.Core.TraceClassification +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateCoprimeProduct +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.CoordinateZeroPatternCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.LocalCounts +public import LeanPool.MarkoffModP.BGS.Markoff.Diophantine.PrimewiseCRT +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.LargeOrderToMaximal +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.CayleyParametrization +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.DescendedTraceCurve +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.HasseFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Nonsplit.SeededCover +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.Parabolic +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PowerCoverCounting +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveInclusionExclusion +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveOrbitWiring +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.PrimitiveTraceCount +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilBoundAssumption +public import LeanPool.MarkoffModP.BGS.Markoff.Endgame.WeilFromGeneralHasse +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitEstimates +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumericCertificates +public import LeanPool.MarkoffModP.BGS.Markoff.ExplicitNumerics +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.CoordinateRing +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Counterexamples +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Fibers +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.NormalizedGraph +public import LeanPool.MarkoffModP.BGS.Markoff.Incidence.PointCount +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierFromGeneral +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierGeometry +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSeparability +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierSourceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.CosetTraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.Diagonalization +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.DivisorRange +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedCorvajaZannierBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorCorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.EulerSevenPairedMaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorCorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorNonparabolicOrderCover +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderCover +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.MoveWiring +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.NonparabolicUnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.OrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedCorvajaZannierBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorCorvajaZannierStep +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.PairedMaximalDivisorOrderEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.ParabolicEscape +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightInversionPairing +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.RightSubgroups +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceCurveWeights +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.TraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.UnionBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEquation +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSeven +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenLargeBound +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTraceEulerSevenPropositionTwo +public import LeanPool.MarkoffModP.BGS.Markoff.MiddleGame.WeightedTracePoweredImageIndexTwo +public import LeanPool.MarkoffModP.BGS.Markoff.Opening +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.AlgebraicClosureTransport +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CompatibleRoots +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicDefect +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicNorm +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.CyclotomicReduction +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.EveryOrbitLarge +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.FiniteOrbit +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrbitCardBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.OrderArithmetic +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.ParabolicPeriodicity +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.PeriodicSemisimple +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.RotationOrbitCard +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TorsionTraces +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.TraceOrderBound +public import LeanPool.MarkoffModP.BGS.Markoff.Opening.UnitCircle +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryEndgame +public import LeanPool.MarkoffModP.BGS.Markoff.PreliminaryNumerics +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.AffineNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveClosure +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.BiprojectiveScheme +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Boundary +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Characteristic +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ChartLocalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonKummerIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.CommonPrimeKummerTower +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Geometry +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.IrreducibilityObstructions +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Kummer +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentComparisonInjectivity +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentJacobian +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentNormalization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.LaurentSmooth +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.Localization +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.NormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCommonPrimeIndependence +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.OddCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.PositiveCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveChart +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationCharts +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectiveNormalizationMorphism +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.ProjectivePointEstimate +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SemanticNormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionCriterion +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticDivisionObstruction +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.SyntacticNormalForm +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedBidegree +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedEllipticModel +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedIrreducibility +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedNotSubtorus +public import LeanPool.MarkoffModP.BGS.Markoff.TraceCurve.WeightedOddCoprimeIrreducibility +public import LeanPool.MarkoffModP.BGS.NumberTheory.DivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.ExplicitDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointMaximalDivisorCriterion +public import LeanPool.MarkoffModP.BGS.NumberTheory.JointNeighborDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.MaximalDivisorBounds +public import LeanPool.MarkoffModP.BGS.NumberTheory.NonparabolicComplementCriterion +public import LeanPool.MarkoffModP.BGS.NumberTheory.OneSidedPrimitiveWitness +public import LeanPool.MarkoffModP.BGS.NumberTheory.PreliminaryDivisorBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.PrimePowerFactorization +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCanonicalProfile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Data +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Profile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinCutoff1248Skeleton +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeCoverage +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinJointEnvelopeSummaryCoverage +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalCoverage +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalProfile +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinPositionalSupportBound +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileCertificate +public import LeanPool.MarkoffModP.BGS.NumberTheory.RankinProfileMatching +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotient +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankin +public import LeanPool.MarkoffModP.BGS.NumberTheory.TruncatedOrderTotientRankinFactorization +public import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedDivisorMoment +public import LeanPool.MarkoffModP.BGS.NumberTheory.WeightedNeighborDivisorBound +public import LeanPool.MarkoffModP.Comparator.Solution +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.Basic +public import LeanPool.MarkoffModP.RiemannRoch.AdeleSpace.FilterChain +public import LeanPool.MarkoffModP.RiemannRoch.AxiomCheck +public import LeanPool.MarkoffModP.RiemannRoch.Basic +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AdeleSpace +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.AlgEquiv +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.RiemannRoch +public import LeanPool.MarkoffModP.RiemannRoch.CoordinateFree.WeilDifferential +public import LeanPool.MarkoffModP.RiemannRoch.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.FunctionField.Divisor +public import LeanPool.MarkoffModP.RiemannRoch.Genus.AdeleQuotient +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Basic +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Polar +public import LeanPool.MarkoffModP.RiemannRoch.Genus.Ramification +public import LeanPool.MarkoffModP.RiemannRoch.LinearKneser +public import LeanPool.MarkoffModP.RiemannRoch.LocalResidue +public import LeanPool.MarkoffModP.RiemannRoch.Place +public import LeanPool.MarkoffModP.RiemannRoch.PlaceEquiv +public import LeanPool.MarkoffModP.RiemannRoch.RRspace.Basic +public import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Basic +public import LeanPool.MarkoffModP.RiemannRoch.RiemannRochTheorem.Corollaries +public import LeanPool.MarkoffModP.RiemannRoch.SeparableRelNorm +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential +public import LeanPool.MarkoffModP.RiemannRoch.WeilDifferential.Basic public import LeanPool.MassFormula public import LeanPool.MassFormula.Convergence public import LeanPool.MassFormula.Defs diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean index 55e4a4ef8d..033e4476df 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean @@ -116,6 +116,7 @@ theorem finiteExtensionEffectiveFiniteDivisorDegree_eq_placeDegree intro P _ rw [finiteExtensionFinitePlace_degree_eq_finrank_residueField K L P] +omit [Fintype K] in /-- Degree is additive across the finite/infinity split. -/ theorem finiteExtensionEffectiveDivisorDegree_split (D : FiniteExtensionEffectiveDivisor K L) : @@ -154,6 +155,7 @@ theorem finiteExtensionEffectiveDivisorToDivisor_apply finiteExtensionEffectiveDivisorToDivisor K L D P = D P := by simp [finiteExtensionEffectiveDivisorToDivisor] +omit [Fintype K] [DecidableEq K] in /-- The cast divisor is effective. -/ theorem finiteExtensionEffectiveDivisorToDivisor_effective (D : FiniteExtensionEffectiveDivisor K L) (P : FiniteExtensionPlace K L) : @@ -201,15 +203,17 @@ def finiteExtensionEffectiveDivisorAffineInfinityEquiv : ((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm.prodCongr (Equiv.refl _)) +omit [Fintype K] in /-- Under the ideal/infinity equivalence, exhaustive degree is affine ideal degree plus infinity degree. -/ -theorem finiteExtensionEffectiveDivisorDegree_eq_affine_add_infinity +theorem finiteExtensionEffectiveDivisorDegree_eq_affine_add_infinity [Finite K] (D : FiniteExtensionEffectiveDivisor K L) : finiteExtensionEffectiveDivisorDegree K L D = finiteExtensionAffineIdealDegree K L (finiteExtensionEffectiveDivisorAffineInfinityEquiv K L D).1 + finiteExtensionEffectiveInfinityDivisorDegree K L (finiteExtensionEffectiveDivisorAffineInfinityEquiv K L D).2 := by + let : Fintype K := Fintype.ofFinite K rw [finiteExtensionEffectiveDivisorDegree_split] rw [finiteExtensionAffineIdealDegree_eq_divisorDegree] simp [finiteExtensionEffectiveDivisorAffineInfinityEquiv] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean index 279977214b..dbaaa9a046 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceDegreeFiniteness.lean @@ -37,7 +37,7 @@ noncomputable section /-- Finite fields have only finitely many finite rational-function places of degree at most `n`. -/ theorem ratFuncFinitePlace_degree_le_finite - (K : Type*) [Field K] [Fintype K] [DecidableEq K] (n : ℕ) : + (K : Type*) [Field K] [Finite K] [DecidableEq K] (n : ℕ) : Finite {p : IsDedekindDomain.HeightOneSpectrum K[X] // ratFuncFinitePlaceDegree p ≤ n} := by let f : {p : IsDedekindDomain.HeightOneSpectrum K[X] // @@ -70,7 +70,7 @@ theorem ratFuncFinitePlace_degree_le_finite /-- A finite extension of `K(X)` has only finitely many finite places of degree at most `n`. -/ theorem finiteExtensionFinitePlace_degree_le_finite - (K L : Type*) [Field K] [Fintype K] [DecidableEq K] + (K L : Type*) [Field K] [Finite K] [DecidableEq K] [DecidableEq (RatFunc K)] [Field L] [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] (n : ℕ) : @@ -120,7 +120,7 @@ theorem finiteExtensionFinitePlace_degree_le_finite degree at most `n`. The finite branch is the preceding theorem; the branch above the unique base infinity place is finite without a degree restriction. -/ theorem finiteExtensionPlace_degree_le_finite - (K L : Type*) [Field K] [Fintype K] [DecidableEq K] + (K L : Type*) [Field K] [Finite K] [DecidableEq K] [DecidableEq (RatFunc K)] [Field L] [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] (n : ℕ) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean index 9f9deb85c7..743b2c79a0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean @@ -26,9 +26,10 @@ open scoped BigOperators /-- For a nonempty finite transitive `G`-set, the sum over group elements of the number of fixed points is exactly the order of `G`. -/ theorem sum_card_fixedBy_eq_card_group_of_isPretransitive - (G X : Type*) [Group G] [Fintype G] [MulAction G X] [Fintype X] + (G X : Type*) [Group G] [Fintype G] [MulAction G X] [Finite X] [MulAction.IsPretransitive G X] [Nonempty X] : (∑ g : G, Nat.card (MulAction.fixedBy X g)) = Nat.card G := by + let : Fintype X := Fintype.ofFinite X let (g : G) : Fintype (MulAction.fixedBy X g) := Fintype.ofFinite _ let Ω := MulAction.orbitRel.Quotient G X let : Fintype Ω := Fintype.ofFinite Ω @@ -43,7 +44,7 @@ theorem sum_card_fixedBy_eq_card_group_of_isPretransitive points per fiber after summing over all group elements. -/ theorem sum_card_fixedBy_fibers_eq_card_mul_card_group {ι G : Type*} [Fintype ι] [Group G] [Fintype G] - (X : ι → Type*) [∀ i, MulAction G (X i)] [∀ i, Fintype (X i)] + (X : ι → Type*) [∀ i, MulAction G (X i)] [∀ i, Finite (X i)] [∀ i, MulAction.IsPretransitive G (X i)] [∀ i, Nonempty (X i)] : (∑ g : G, ∑ i : ι, Nat.card (MulAction.fixedBy (X i) g)) = Nat.card ι * Nat.card G := by @@ -247,7 +248,7 @@ def fixedByEquivSigmaInvariantFiberFixedBy /-- Cardinal form of the invariant-fiber fixed-point decomposition. -/ theorem natCard_fixedBy_eq_sum_natCard_invariantFiberFixedBy {G X ι : Type*} [Group G] [MulAction G X] - [Fintype X] [Fintype ι] + [Finite X] [Fintype ι] (base : X → ι) (hbase : ∀ (g : G) (x : X), base (g • x) = base x) (g : G) : Nat.card (MulAction.fixedBy X g) = From 9c5c9d95ecd36b025f925441d6f4d39ab67f2201 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 21:11:27 +0000 Subject: [PATCH 31/37] Generalize Markoff finite counting lemmas and clean compiler warnings --- .../DedekindAuxiliaryCaseI.lean | 6 ++-- .../DedekindCanonicalDifferentScaling.lean | 6 ++-- .../DedekindLocalWronskian.lean | 3 +- .../DedekindPerfectResidueCaseI.lean | 14 ++++---- ...iteExtensionCanonicalDifferentDivisor.lean | 2 +- .../FiniteExtensionExceptionalSupport.lean | 14 +++++++- .../FiniteExtensionPolynomialHeight.lean | 4 +++ .../FiniteExtensionPrincipalDivisor.lean | 13 +++++++ .../FiniteExtensionResidueSurjectivity.lean | 2 ++ .../CorvajaZannier/InfinityInertiaDegree.lean | 2 ++ .../PlaneCurveAuxiliaryFinitePlace.lean | 6 ++-- .../PlaneCurveBoundarySupport.lean | 2 +- .../PlaneCurvePoweredHeightBounds.lean | 2 +- .../TorsionExhaustiveGcdDivisorBound.lean | 7 ++++ .../DedekindDifferentLocalTrace.lean | 2 ++ .../FiniteExtensionAffineIdealDegree.lean | 13 ++++--- .../FiniteExtensionAffineIdealDivisor.lean | 6 ++-- ...iteExtensionCanonicalDifferentCotrace.lean | 5 +++ ...sionCanonicalDifferentLocalMaximality.lean | 1 + ...FiniteExtensionCotraceLocalTraceImage.lean | 2 +- .../FiniteExtensionEffectiveDivisorSplit.lean | 2 +- .../HasseWeil/FiniteExtensionPlaceTower.lean | 28 +++++++++++---- .../HasseWeil/FiniteExtensionRiemannRoch.lean | 4 +++ .../FiniteExtensionRiemannSpace.lean | 2 +- .../BGS/HasseWeil/FinitePrincipalParts.lean | 2 ++ .../BGS/HasseWeil/FixedPointAverage.lean | 17 ++++----- .../BGS/HasseWeil/FormalZetaEulerDegree.lean | 3 +- .../BGS/HasseWeil/FormalZetaHasseBound.lean | 2 +- .../BGS/HasseWeil/FormalZetaTrace.lean | 8 ++--- .../HasseWeil/FunctionFieldConstantField.lean | 28 ++++++++++----- .../FunctionFieldNormalClosureConstants.lean | 6 ++-- ...nFieldNormalClosureOriginalCompositum.lean | 22 +++++++----- .../BGS/HasseWeil/LocalPoleFiltration.lean | 1 + .../BGS/HasseWeil/OnePointDivisorSplit.lean | 2 +- .../HasseWeil/OnePointLeadingCoefficient.lean | 2 ++ .../PlaneRationalPlaceAffineComparison.lean | 35 ++++++++++--------- .../PlaneSmoothPointNormalization.lean | 9 ----- .../BGS/HasseWeil/RationalPlaceTower.lean | 4 +++ .../RiemannSpaceFinitePlaceIncrement.lean | 4 +-- .../RiemannSpaceInfinityPlaceIncrement.lean | 2 +- 40 files changed, 193 insertions(+), 102 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean index a030056bd0..7896c30837 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean @@ -402,7 +402,7 @@ theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_of_pol intro hz have hneg := hpole i hi rw [hz] at hneg - simpa using hneg + simp at hneg have hbound := finitePlaceOrderTop_derivation_iterate_ge_sub_nat_of_preserves v π hπ hπIdeal D hDIntegral (epsilonOrder (σ i)) (g i) @@ -463,7 +463,7 @@ theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_caseI_epsilon_plus_one intro i hi hz have hneg := hpole i hi rw [hz] at hneg - simpa using hneg + simp at hneg have horderInj : Set.InjOn (fun i => finitePlaceOrder v (g i)) (poles : Set ι) := by intro i hi j hj hij @@ -592,7 +592,7 @@ theorem card_negativeFinitePlaceOrders_le_neg intro i hi hz have hneg := hpole i hi rw [hz] at hneg - simpa using hneg + simp at hneg let w : ι → ℤ := fun i => finitePlaceOrder v (g i) have hinj : Set.InjOn w (poles : Set ι) := by intro i hi j hj hij diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean index 36907cfcda..6a77c95cd3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindCanonicalDifferentScaling.lean @@ -53,7 +53,8 @@ theorem exists_element_locally_generating_ideal simpa [ha_zero] using ha have hmult := congrArg (multiplicity v.asIdeal) hprod_eq rw [multiplicity_mul v.prime - (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self (FiniteMultiplicity.of_prime_left v.prime v.ne_bot)] at hmult + (FiniteMultiplicity.of_prime_left v.prime hprod), + multiplicity_self (FiniteMultiplicity.of_prime_left v.prime v.ne_bot)] at hmult omega have hspan0 : Ideal.span {a} ≠ ⊥ := by simpa [Ideal.span_singleton_eq_bot] using ha0 @@ -63,7 +64,8 @@ theorem exists_element_locally_generating_ideal exact le_sup_right have hsup := v.multiplicity_sup hprod hspan0 rw [ha, multiplicity_mul v.prime - (FiniteMultiplicity.of_prime_left v.prime hprod), multiplicity_self (FiniteMultiplicity.of_prime_left v.prime v.ne_bot)] at hsup + (FiniteMultiplicity.of_prime_left v.prime hprod), + multiplicity_self (FiniteMultiplicity.of_prime_left v.prime v.ne_bot)] at hsup have hmult : multiplicity v.asIdeal (Ideal.span {a}) = multiplicity v.asIdeal I := by by_cases hle : multiplicity v.asIdeal (Ideal.span {a}) ≤ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean index 39c6bce418..4626a15488 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean @@ -293,7 +293,8 @@ theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_nonnegative_of_int omit [Algebra C R] [IsScalarTower C R L] in /-- The indexed determinant estimate after a determinant-one constant column operation, assuming only that the derivation preserves the DVR. -/ -theorem finitePlaceOrderTop_indexedDedekindLocalWronskian_det_lower_bound_after_columnCombination_of_preserves +theorem + finitePlaceOrderTop_dedekindLocalWronskian_det_lower_bound_after_columnCombination_of_preserves {ι : Type*} [Fintype ι] [DecidableEq ι] (v : HeightOneSpectrum R) (π : R) (hπ : Irreducible π) (hπIdeal : v.asIdeal = Ideal.span {π}) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean index 287542aa74..d3d2cea155 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindPerfectResidueCaseI.lean @@ -280,7 +280,8 @@ subfield by a determinant-one matrix when the residue field is perfect. Unlike the constant-field version, this theorem does not require an algebra map from the coefficient field to the DVR. -/ -theorem exists_det_one_frobeniusSubfield_dedekindColumnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue +theorem + exists_det_one_frobeniusSubfield_columnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue {k : ℕ} (v : HeightOneSpectrum R) [PerfectField v.asIdeal.ResidueField] (a : ℤ) (f : Fin k → L) @@ -370,7 +371,7 @@ theorem exists_frobeniusSubfield_dedekindCaseI_columnMatrix_and_q_wronskian_boun finitePlaceOrderTop v (indexedDedekindLocalWronskian D epsilonOrder f).det := by obtain ⟨A, hAdet, hdistinct, hlower⟩ := - exists_det_one_frobeniusSubfield_dedekindColumnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue + exists_det_one_frobeniusSubfield_columnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue (p := p) v a f hf let g := indexedDedekindLocalColumnCombination f A have hdet : @@ -436,7 +437,7 @@ theorem exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_columnMatrix intro i rw [hfirstOrder i] obtain ⟨A, hAdet, hdistinct, hlower⟩ := - exists_det_one_frobeniusSubfield_dedekindColumnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue + exists_det_one_frobeniusSubfield_columnMatrix_negativeOrdersPairwiseDistinct_of_perfect_residue (p := p) v (finitePlaceOrder v rho) first hfirstLower refine ⟨A, hAdet, ?_, ?_, ?_⟩ · intro x y hx hy hxy @@ -470,7 +471,8 @@ theorem exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_columnMatrix fields supply every leading-term cancellation, the determinant-one column operation preserves the Wronskian, and the exact `q * ord(rho)` lower bound follows. -/ -theorem exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue +theorem + exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue (v : HeightOneSpectrum R) [PerfectField v.asIdeal.ResidueField] (D : Derivation (frobeniusSubfield L p) L L) @@ -583,10 +585,10 @@ theorem exists_frobeniusSubfield_dedekindAuxiliaryFamily_caseI_q_wronskian_bound (auxiliaryFamily u w h k)).det := by simpa only [dedekindCaseITransformedLocalAuxiliaryFamily, dedekindLocalAuxiliaryFamily_div_eq_auxiliaryFamily] using - (exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue + exists_frobeniusSubfield_dedekindLocalAuxiliaryFamily_caseI_q_wronskian_bound_of_perfect_residue (p := p) v D hDIntegral u w ((1 - u) / (1 - w)) h k epsilonOrder epsilon q hrhoNe huOrder hrhoOrder hgridRegular hepsilonInjective - hepsilonMax hk hepsilonQ) + hepsilonMax hk hepsilonQ end diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean index 44457790ed..91ce04cbe8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalDifferentDivisor.lean @@ -305,7 +305,7 @@ theorem finiteExtensionCanonicalDifferentDivisor_degree_of_ramification_sum ring /-- The canonical different divisor has weighted degree equal to the finite -different degree plus the infinity different degree minus twice `[L : K(X)]`.-/ +different degree plus the infinity different degree minus twice `[L : K(X)]`. -/ theorem finiteExtensionCanonicalDifferentDivisor_degree : finiteExtensionDivisorDegree K L (finiteExtensionCanonicalDifferentDivisor K L diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index 45bf43e6de..56d282411c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -100,9 +100,11 @@ private theorem finitePlaceOrder_one rw [finitePlaceOrderTop_eq_coe w (1 : F) one_ne_zero] at h exact_mod_cast h +omit [DecidableEq K] in /-- The exhaustive principal divisor of one is zero. -/ theorem finiteExtensionPrincipalDivisor_one : finiteExtensionPrincipalDivisor K L (1 : L) = 0 := by + classical ext w cases w with | inl q => @@ -115,12 +117,14 @@ theorem finiteExtensionPrincipalDivisor_one : (w := primeOverHeightOne (ratFuncInfinityPlace K) P) (F := FractionRing (RatFuncInfinityIntegralClosure K L)) +omit [DecidableEq K] in /-- Exhaustive principal divisors turn a nonzero product into a sum. -/ theorem finiteExtensionPrincipalDivisor_mul (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : finiteExtensionPrincipalDivisor K L (x * y) = finiteExtensionPrincipalDivisor K L x + finiteExtensionPrincipalDivisor K L y := by + classical ext w cases w with | inl q => @@ -159,33 +163,39 @@ theorem finiteExtensionPrincipalDivisor_mul simpa only [finiteExtensionPrincipalDivisor_inr, map_mul, finitePrincipalDivisor_apply, Finsupp.add_apply] using h +omit [DecidableEq K] in /-- Exhaustive principal divisors turn a nonzero power into a multiple. -/ theorem finiteExtensionPrincipalDivisor_pow (x : L) (hx : x ≠ 0) (m : ℕ) : finiteExtensionPrincipalDivisor K L (x ^ m) = m • finiteExtensionPrincipalDivisor K L x := by + classical induction m with | zero => simp [finiteExtensionPrincipalDivisor_one K L] | succ m ih => rw [pow_succ, finiteExtensionPrincipalDivisor_mul K L (x ^ m) x (pow_ne_zero _ hx) hx, ih, succ_nsmul] +omit [DecidableEq K] in /-- Exhaustive principal divisors turn a nonzero inverse into a negative. -/ theorem finiteExtensionPrincipalDivisor_inv (x : L) (hx : x ≠ 0) : finiteExtensionPrincipalDivisor K L x⁻¹ = -finiteExtensionPrincipalDivisor K L x := by + classical have hmul := finiteExtensionPrincipalDivisor_mul K L x⁻¹ x (inv_ne_zero hx) hx rw [inv_mul_cancel₀ hx, finiteExtensionPrincipalDivisor_one K L] at hmul exact eq_neg_of_add_eq_zero_left hmul.symm +omit [DecidableEq K] in /-- Exhaustive principal divisors turn a quotient into a difference. -/ theorem finiteExtensionPrincipalDivisor_div (x y : L) (hx : x ≠ 0) (hy : y ≠ 0) : finiteExtensionPrincipalDivisor K L (x / y) = finiteExtensionPrincipalDivisor K L x - finiteExtensionPrincipalDivisor K L y := by + classical rw [div_eq_mul_inv, finiteExtensionPrincipalDivisor_mul K L x y⁻¹ hx (inv_ne_zero hy), finiteExtensionPrincipalDivisor_inv K L y hy, sub_eq_add_neg] @@ -194,8 +204,9 @@ the `ordGrid` term in the global Wronskian summation. -/ def finiteExtensionAuxiliaryGridProduct (u v : L) (h k : ℕ) : L := ∏ rs : Fin (k + 1) × Fin h, u ^ (rs.1 : ℕ) * v ^ (rs.2 : ℕ) +omit [DecidableEq K] in private theorem finiteExtensionPrincipalDivisor_finset_prod - {ι : Type*} [DecidableEq ι] (s : Finset ι) (g : ι → L) + {ι : Type*} (s : Finset ι) (g : ι → L) (hg : ∀ i ∈ s, g i ≠ 0) : finiteExtensionPrincipalDivisor K L (∏ i ∈ s, g i) = ∑ i ∈ s, finiteExtensionPrincipalDivisor K L (g i) := by @@ -210,6 +221,7 @@ private theorem finiteExtensionPrincipalDivisor_finset_prod finiteExtensionPrincipalDivisor_mul K L _ _ hga (Finset.prod_ne_zero_iff.mpr hgs), ih hgs] +omit [DecidableEq K] in /-- Exact principal-divisor formula for the auxiliary grid product. -/ theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) (h k : ℕ) : diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean index fb18d99a37..f6722e1e2d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPolynomialHeight.lean @@ -118,11 +118,13 @@ theorem finitePlaceOrder_algebraMap_nonnegative rw [finitePlaceOrderTop_eq_coe v _ hmap] at htop exact_mod_cast htop +omit [DecidableEq K] in private theorem polynomial_lift_finitePlaceOrder_nonnegative (P : K[X]) (hP : P ≠ 0) (q : FiniteExtensionFinitePlace K L) : 0 ≤ finiteExtensionPrincipalDivisor K L (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) P)) (.inl q) := by + classical let S := RatFuncFiniteIntegralClosure K L let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L let s : S := algebraMap K[X] S P @@ -140,11 +142,13 @@ private theorem polynomial_lift_finitePlaceOrder_nonnegative rw [finiteExtensionPrincipalDivisor_inl, hrepr] exact finitePlaceOrder_algebraMap_nonnegative q s hs +omit [DecidableEq K] in private theorem polynomial_lift_infinityPlaceOrder_nonpositive (P : K[X]) (hP : P ≠ 0) (q : FiniteExtensionInfinityPlace K L) : finiteExtensionPrincipalDivisor K L (algebraMap (RatFunc K) L (algebraMap K[X] (RatFunc K) P)) (.inr q) ≤ 0 := by + classical let f : RatFunc K := algebraMap K[X] (RatFunc K) P let x : L := algebraMap (RatFunc K) L f let S := RatFuncInfinityIntegralClosure K L diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean index 9c294e8bed..860b72d32a 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionPrincipalDivisor.lean @@ -159,18 +159,22 @@ def finiteExtensionPrincipalDivisor (x : L) : (finiteExtensionFinitePrincipalDivisor K L x).sumElim (finiteExtensionInfinityPrincipalDivisor K L x) +omit [DecidableEq K] in @[simp] theorem finiteExtensionPrincipalDivisor_inl (x : L) (q : FiniteExtensionFinitePlace K L) : finiteExtensionPrincipalDivisor K L x (.inl q) = finitePlaceOrder q ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) := by + classical simp [finiteExtensionPrincipalDivisor] +omit [DecidableEq K] in @[simp] theorem finiteExtensionPrincipalDivisor_inr (x : L) (P : FiniteExtensionInfinityPlace K L) : finiteExtensionPrincipalDivisor K L x (.inr P) = finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) := by + classical simp [finiteExtensionPrincipalDivisor] def finiteExtensionFiniteResidueWeightedDivisor (x : L) : @@ -178,6 +182,7 @@ def finiteExtensionFiniteResidueWeightedDivisor (x : L) : (finiteExtensionFinitePrincipalDivisor K L x).sum (fun q n => Finsupp.single q ((q.asIdeal.inertiaDeg K[X] : ℤ) * n)) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in @[simp] theorem finiteExtensionFiniteResidueWeightedDivisor_apply (x : L) (q : FiniteExtensionFinitePlace K L) : finiteExtensionFiniteResidueWeightedDivisor K L x q = @@ -210,6 +215,7 @@ def finiteExtensionFiniteDivisorBelow (x : L) : (finiteExtensionFiniteResidueWeightedDivisor K L x).mapDomain (HeightOneSpectrum.under K[X]) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in theorem finiteExtensionFiniteDivisorBelow_apply (x : L) (p : HeightOneSpectrum K[X]) : finiteExtensionFiniteDivisorBelow K L x p = @@ -267,10 +273,12 @@ theorem finiteExtensionFiniteDivisorBelow_apply rw [hplace] rfl +omit [DecidableEq K] [DecidableEq (RatFunc K)] in theorem finiteExtensionFiniteDivisorBelow_eq_normDivisor (x : L) (hx : x ≠ 0) : finiteExtensionFiniteDivisorBelow K L x = ratFuncFiniteDivisor (Algebra.norm (RatFunc K) x) := by + classical ext p rw [finiteExtensionFiniteDivisorBelow_apply K L x p, finitePrimesAbove_weightedOrder_eq_normOrder K L p x hx, @@ -283,6 +291,7 @@ def finiteExtensionFiniteDirectDegreeSum (x : L) : ℤ := n * (q.asIdeal.inertiaDeg K[X] : ℤ) * (ratFuncFinitePlaceDegree (HeightOneSpectrum.under K[X] q) : ℤ)) +omit [DecidableEq (RatFunc K)] in theorem finiteExtensionFiniteDirectDegreeSum_eq_grouped (x : L) (hx : x ≠ 0) : finiteExtensionFiniteDirectDegreeSum K L x = @@ -853,10 +862,12 @@ theorem ratFuncFinitePlaceDegree_eq_one (p : HeightOneSpectrum K[X]) : rw [ratFuncFinitePlaceDegree] exact Polynomial.natDegree_eq_of_degree_eq_some hrdegree +omit [DecidableEq K] in omit [DecidableEq (RatFunc K)] in theorem finiteExtensionFinitePlace_inertiaDeg_eq_one (q : FiniteExtensionFinitePlace K L) : q.asIdeal.inertiaDeg K[X] = 1 := by + classical let p := HeightOneSpectrum.under K[X] q let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ let hLocalAlg := @@ -894,11 +905,13 @@ section AlgebraicallyClosedFamilies variable {A : Type*} [Fintype A] +omit [DecidableEq K] in /-- Ordinary (unweighted) product formula on the common family place type. -/ theorem finiteExtensionFamilyOrder_sum_eq_zero (f : A → L) (a : A) (ha : f a ≠ 0) : ∑ v : FiniteExtensionFamilyPlace K L f, finiteExtensionFamilyOrder K L f a v = 0 := by + classical have hweighted := finiteExtensionFamilyWeightedOrder_sum_eq_zero K L f a ha simpa only [finiteExtensionFamilyWeightedOrder, finiteExtensionPlaceDegree_eq_one K L, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean index a8194113b6..b1571b5530 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionResidueSurjectivity.lean @@ -101,12 +101,14 @@ local instance residueInfinityIntegralClosureConstantTower : variable [IsAlgClosed K] +omit [DecidableEq K] in omit [DecidableEq (RatFunc K)] in /-- Constants surject onto the residue field of every finite place of a finite separable extension of `K(X)`, when `K` is algebraically closed. -/ theorem finiteExtensionFinitePlace_constantResidue_surjective (q : FiniteExtensionFinitePlace K L) : Function.Surjective (algebraMap K q.asIdeal.ResidueField) := by + classical let p := HeightOneSpectrum.under K[X] q let : q.asIdeal.LiesOver p.asIdeal := ⟨rfl⟩ let hLocalAlg := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean index 8160440816..f3206e8408 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/InfinityInertiaDegree.lean @@ -204,12 +204,14 @@ local instance infinityInertiaIntegralClosureIsIntegral : (RatFuncInfinityIntegralClosure K L) := IsIntegralClosure.isIntegral_algebra (RatFuncInfinityIntegers K) L +omit [DecidableEq K] in /-- Over an algebraically closed constant field, every prime above the place at infinity has residue degree (inertia degree) one. -/ theorem finiteExtensionInfinityPlace_inertiaDeg_eq_one (P : (ratFuncInfinityPlace K).asIdeal.primesOver (RatFuncInfinityIntegralClosure K L)) : P.1.inertiaDeg (RatFuncInfinityIntegers K) = 1 := by + classical let hLocalAlg := Localization.AtPrime.algebraOfLiesOver (ratFuncInfinityPlace K).asIdeal P.1 diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean index 72a07b48f6..24507788e6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlace.lean @@ -456,7 +456,8 @@ omit [DecidableEq K] [DecidableEq (RatFunc K)] in application, `C = L^p`). The proof restricts scalars to `K` before invoking the local DVR theorem, while the displayed Wronskian is still the original `C`-derivation Wronskian because restriction does not change its function. -/ -theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_restrictScalars_preserves +theorem + finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of_restrictScalars_preserves (q : PlaneCurveExtensionFinitePlace K L) (D : Derivation C L L) (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, @@ -497,7 +498,8 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIII_source_lower_bound_of omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- Case (iv) after the same honest restriction of constants from `C` to the ground field `K`. -/ -theorem finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_restrictScalars_preserves +theorem + finiteExtensionFinitePlace_auxiliaryFamily_caseIV_source_lower_bound_of_restrictScalars_preserves (q : PlaneCurveExtensionFinitePlace K L) (D : Derivation C L L) (hDIntegral : ∀ r : FiniteExtensionFinitePlaceLocalRing K L q, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean index 91a779e05b..7892329462 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -290,7 +290,7 @@ private noncomputable def valuationSubringRingEquivOfComapEq invFun y := ⟨e.symm y, by rw [← h] change e (e.symm (y : E)) ∈ W - simpa using y.2⟩ + simp⟩ left_inv x := Subtype.ext (e.symm_apply_apply x) right_inv y := Subtype.ext (e.apply_symm_apply y) map_mul' x y := Subtype.ext (map_mul e (x : F) (y : F)) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean index 835573a14e..c500df7349 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePoweredHeightBounds.lean @@ -36,7 +36,7 @@ positive divisor degree. -/ theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) (hpartialSecond : MvPolynomial.pderiv 1 f ≠ 0) - (m : ℕ) (hm : 0 < m) : + (m : ℕ) (_hm : 0 < m) : letI := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf (degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index 3e3bbdfe24..5d597b3fdf 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -390,12 +390,14 @@ def finiteExtensionGcdWeightedDegree (x y : L) : ℕ := finiteExtensionGcdMultiplicity K L x y v * finiteExtensionPlaceDegree K L v +omit [DecidableEq K] in /-- On a finite place, the exhaustive principal-divisor coefficient is the normalized order computed directly in `L`. -/ theorem finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder (x : L) (q : FiniteExtensionFinitePlace K L) : finiteExtensionPrincipalDivisor K L x (.inl q) = finitePlaceOrder q x := by + classical rw [finiteExtensionPrincipalDivisor_inl] have h := fractionRingAlgEquiv_finitePlaceOrder_eq (L := L) q ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) @@ -410,6 +412,7 @@ theorem finiteExtensionPlaceDegree_inl_pos · exact (finitePlaceNormalizedPrime (HeightOneSpectrum.under (Polynomial K) q)).property.1.irreducible.natDegree_pos +omit [DecidableEq K] in theorem inl_mem_finiteExtensionGcdSupport_of_orders_positive (x y : L) (q : FiniteExtensionFinitePlace K L) (hxpos : 0 < finitePlaceOrder q x) : @@ -851,3 +854,7 @@ theorem torsionPoint_card_le_planeCurveExhaustiveTorsionGcdWeightedDegree rfl end PlaneCurveExhaustiveFinitePlaces + +end + +end BGS.CorvajaZannier diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index adfa0b7b3f..26a64b23ee 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -164,6 +164,7 @@ theorem mem_dual_one_iff_different_multiplicity_le_count exact forall_congr' fun q ↦ by rw [count_dual_one_eq_neg_different_multiplicity A K₀ q] +omit [Algebra.IsIntegral A B] in theorem trace_mem_algebraMap_range_of_different_multiplicity_le_count {z : L} (hz : z ≠ 0) (hcount : ∀ q : HeightOneSpectrum B, @@ -216,6 +217,7 @@ theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L simp omit [IsIntegralClosure B A L] in +omit [IsIntegrallyClosed A] in theorem exists_base_multiplier_clearing_different_counts [IsDedekindDomain A] (hdiff : differentIdeal A B ≠ ⊥) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean index 4683e4f9c8..2f2fc6902f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean @@ -8,7 +8,8 @@ module public import LeanPool.MarkoffModP.BGS.CorvajaZannier.FiniteExtensionExhaustiveProductFormula public import Mathlib.NumberTheory.ClassNumber.FunctionField -public import Mathlib.RingTheory.Ideal.Quotient.HasFiniteQuotients +public import Mathlib.RingTheory.Ideal.Quotient.HasFiniteQuotients.Basic +public import Mathlib.RingTheory.Ideal.Quotient.HasFiniteQuotients.Norm /-! # Affine ideal degrees in a finite function field @@ -42,8 +43,9 @@ open BGS.CorvajaZannier variable (K : Type*) [Field K] [Fintype K] +omit [Fintype K] in /-- The polynomial ring over a finite field has finite quotients. -/ -theorem ratFuncPolynomial_hasFiniteQuotients : +theorem ratFuncPolynomial_hasFiniteQuotients [Finite K] : Ring.HasFiniteQuotients K[X] := by constructor intro I hI @@ -88,19 +90,22 @@ local instance affineIdealClosureConstantTower : IsScalarTower K K[X] (RatFuncFiniteIntegralClosure K L) := IsScalarTower.of_algebraMap_eq' rfl +omit [Fintype K] in /-- The normalization of `K[X]` in a finite separable extension of `K(X)` has finite quotients. -/ -theorem ratFuncFiniteIntegralClosure_hasFiniteQuotients : +theorem ratFuncFiniteIntegralClosure_hasFiniteQuotients [Finite K] : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := by let : Ring.HasFiniteQuotients K[X] := ratFuncPolynomial_hasFiniteQuotients K exact Ring.HasFiniteQuotients.of_module_finite K[X] (RatFuncFiniteIntegralClosure K L) +omit [Fintype K] in /-- The affine ideal class group is finite. This is the function-field class number theorem from Mathlib, stated at the normalization used by BGS. -/ -theorem finiteExtensionAffineClassGroup_finite : +theorem finiteExtensionAffineClassGroup_finite [Finite K] : Finite (ClassGroup (RatFuncFiniteIntegralClosure K L)) := by + let : Fintype K := Fintype.ofFinite K let : Fintype (ClassGroup (RatFuncFiniteIntegralClosure K L)) := inferInstance exact Fintype.finite inferInstance diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean index f4d11b75c7..0309f8dacc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean @@ -380,8 +380,7 @@ theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_apply finiteExtensionAffineIdealEffectiveDivisorEquiv K L I v = multiplicity v.asIdeal (I : Ideal (RatFuncFiniteIntegralClosure K L)) := by - simpa [finiteExtensionAffineIdealEffectiveDivisorEquiv] using - (nonzeroIdealEffectiveDivisorEquiv_apply I v) + simp [finiteExtensionAffineIdealEffectiveDivisorEquiv] omit [Fintype K] in @[simp] @@ -391,8 +390,7 @@ theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_symm_coe FiniteExtensionAffineIdeal K L) : Ideal (RatFuncFiniteIntegralClosure K L)) = effectiveDivisorIdeal D := by - simpa [finiteExtensionAffineIdealEffectiveDivisorEquiv] using - (nonzeroIdealEffectiveDivisorEquiv_symm_coe D) + simp [finiteExtensionAffineIdealEffectiveDivisorEquiv] /-- The affine ideal degree of the ideal represented by an effective finite divisor is its residue-degree-weighted divisor degree. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean index 7981ad1925..f5ecd939b2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean @@ -441,6 +441,7 @@ theorem finiteExtensionUnderPlace_finite_preimage_singleton finiteExtensionUnderPlace, Sum.inl.injEq, reduceCtorEq] at hq · exact Set.mem_range_self q +omit [Fintype K] [DecidableEq K] in /-- Pullback along the exhaustive place map preserves cofinite eventual properties. -/ theorem finiteExtensionUnderPlace_tendstoCofinite : @@ -457,6 +458,7 @@ def finiteExtensionUnderPlaceChart (finiteExtensionUnderPlace K L ((finiteExtensionPlaceEquivChart K L).symm q)) +omit [Fintype K] [DecidableEq K] in /-- Every rational-function chart place has an upstairs chart place. -/ theorem finiteExtensionUnderPlaceChart_surjective : Function.Surjective (finiteExtensionUnderPlaceChart K L) := by @@ -626,6 +628,7 @@ def finiteExtensionDifferentExceptionalSet : multiplicity q.asIdeal (differentIdeal K[X] (RatFuncFiniteIntegralClosure K L)) ≠ 0}) +omit [Fintype K] [DecidableEq K] in theorem finiteExtensionDifferentExceptionalSet_finite : (finiteExtensionDifferentExceptionalSet K L).Finite := by have hdiff : differentIdeal K[X] @@ -1162,6 +1165,7 @@ theorem finiteExtensionFiberTrace_infinite_valuation_le_exp_neg_two rw [hpChart] exact hchart +omit [Fintype K] [DecidableEq K] in /-- The infinity place selected for the identity extension is the unique infinity place in the base chart. -/ theorem ratFuncInfinityChartPlace_eq_baseChart : @@ -1205,6 +1209,7 @@ theorem finiteExtensionFiberTrace_mem_ratFuncCanonicalInfinityAdeleFilt rw [hcoeff] exact h +omit [Fintype K] [DecidableEq K] in /-- Principal adeles are fiber-constant. -/ theorem finiteExtension_diagonal_mem_fiberConstant (x : L) : FunctionField.Chart.diagonal K L x ∈ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean index 24b514f2ec..2486b12fe8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentLocalMaximality.lean @@ -33,6 +33,7 @@ noncomputable section variable (K : Type*) [Field K] [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] +omit [Fintype K] [DecidableEq K] in /-- At every base chart place, maximality of the canonical `-2∞` differential supplies a one-component adele at the first filtration step on which the differential is nonzero. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean index 8e6fddc9dd..4797a559b6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCotraceLocalTraceImage.lean @@ -203,7 +203,7 @@ theorem exists_element_with_counts_over_and_exact_at simpa [hprecision, target, hideal] using h have hnle : n q ≤ (Int.toNat (n q) : ℤ) := by by_cases hn : 0 ≤ n q - · simpa [Int.toNat_of_nonneg hn] + · simp [Int.toNat_of_nonneg hn] · rw [Int.toNat_of_nonpos (le_of_not_ge hn)] exact le_of_not_ge hn exact hnle.trans diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean index 033e4476df..c7db6b0682 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionEffectiveDivisorSplit.lean @@ -246,7 +246,7 @@ private local instance effectiveDivisorInfinityClosureDedekind : local instance effectiveDivisorInfinityPlaceFinite : Finite (FiniteExtensionInfinityPlace K L) := by - letI := Set.Finite.fintype + let := Set.Finite.fintype (IsDedekindDomain.primesOver_finite (ratFuncInfinityPlace K).asIdeal (RatFuncInfinityIntegralClosure K L)) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index fbf4403efb..1bc0e54ee7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -1167,9 +1167,11 @@ section FiniteConstants variable [Fintype K] +omit [DecidableEq K] [Fintype K] in omit [DecidableEq (RatFunc K)] in -private theorem ratFuncFinitePlaceResidueField_finite +private theorem ratFuncFinitePlaceResidueField_finite [Finite K] (p : HeightOneSpectrum K[X]) : Finite p.asIdeal.ResidueField := by + classical let r := finitePlaceNormalizedPrime p have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero have hrmonic : (r : K[X]).Monic := @@ -1185,9 +1187,11 @@ private theorem ratFuncFinitePlaceResidueField_finite let : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K infer_instance +omit [DecidableEq K] [Fintype K] in omit [DecidableEq (RatFunc K)] in -private theorem finitePlaceResidueField_finite +private theorem finitePlaceResidueField_finite [Finite K] (P : FiniteExtensionFinitePlace K M) : Finite P.asIdeal.ResidueField := by + classical let p := HeightOneSpectrum.under K[X] P let : Finite p.asIdeal.ResidueField := ratFuncFinitePlaceResidueField_finite K p @@ -1200,8 +1204,10 @@ private theorem finitePlaceResidueField_finite inferInstance exact Module.finite_of_finite p.asIdeal.ResidueField -private theorem infinityPlaceResidueField_finite +omit [DecidableEq K] [Fintype K] in +private theorem infinityPlaceResidueField_finite [Finite K] (P : FiniteExtensionInfinityPlace K M) : Finite P.1.ResidueField := by + classical let : Algebra K (RatFuncInfinityIntegers K) := (ratFuncInfinityConstantRingHom K).toAlgebra let : IsScalarTower K (RatFuncInfinityIntegers K) (RatFunc K) := @@ -1220,12 +1226,14 @@ private theorem infinityPlaceResidueField_finite let : Module.Finite p.ResidueField P.1.ResidueField := inferInstance exact Module.finite_of_finite p.ResidueField +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Fintype K] in /-- The inertia-group cardinality is the ramification index at a finite place. -/ -theorem finitePlaceInertiaGroup_card_eq_ramificationIdx +theorem finitePlaceInertiaGroup_card_eq_ramificationIdx [Finite K] (P : FiniteExtensionFinitePlace K L) : Nat.card (finitePlaceInertiaGroup K M L P) = finitePlaceRelativeRamificationIdx K M L P := by + classical let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L let := finiteIntegralClosureGalAction K M L @@ -1243,13 +1251,15 @@ theorem finitePlaceInertiaGroup_card_eq_ramificationIdx rw [Ideal.card_inertia_eq_ramificationIdxIn p.asIdeal P.asIdeal] exact Ideal.ramificationIdxIn_eq_ramificationIdx p.asIdeal P.asIdeal Gal(L/M) +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Fintype K] in /-- The decomposition-group cardinality is ramification index times inertia degree at a finite place. -/ -theorem finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg +theorem finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg [Finite K] (P : FiniteExtensionFinitePlace K L) : Nat.card (finitePlaceDecompositionGroup K M L P) = finitePlaceRelativeRamificationIdx K M L P * finitePlaceRelativeInertiaDeg K M L P := by + classical let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L let := finiteIntegralClosureGalAction K M L @@ -1269,11 +1279,13 @@ theorem finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg Ideal.ramificationIdxIn_eq_ramificationIdx p.asIdeal P.asIdeal Gal(L/M), Ideal.inertiaDegIn_eq_inertiaDeg p.asIdeal P.asIdeal Gal(L/M)] +omit [DecidableEq K] [Fintype K] in /-- The inertia-group cardinality is the ramification index above infinity. -/ -theorem infinityPlaceInertiaGroup_card_eq_ramificationIdx +theorem infinityPlaceInertiaGroup_card_eq_ramificationIdx [Finite K] (P : FiniteExtensionInfinityPlace K L) : Nat.card (infinityPlaceInertiaGroup K M L P) = infinityPlaceRelativeRamificationIdx K M L P := by + classical let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L let := infinityIntegralClosureGalAction K M L @@ -1291,13 +1303,15 @@ theorem infinityPlaceInertiaGroup_card_eq_ramificationIdx rw [Ideal.card_inertia_eq_ramificationIdxIn p.1 P.1] exact Ideal.ramificationIdxIn_eq_ramificationIdx p.1 P.1 Gal(L/M) +omit [DecidableEq K] [Fintype K] in /-- The decomposition-group cardinality is ramification index times inertia degree above infinity. -/ -theorem infinityPlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg +theorem infinityPlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg [Finite K] (P : FiniteExtensionInfinityPlace K L) : Nat.card (infinityPlaceDecompositionGroup K M L P) = infinityPlaceRelativeRamificationIdx K M L P * infinityPlaceRelativeInertiaDeg K M L P := by + classical let : Module.Finite M L := Module.Finite.of_restrictScalars_finite (RatFunc K) M L let := infinityIntegralClosureGalAction K M L diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean index c62c29ff95..1b9e4b2606 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean @@ -191,6 +191,8 @@ def finiteExtensionInfinityIntegralClosureRingEquiv : map_mul' _ _ := rfl map_add' _ _ := rfl +omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in @[simp] theorem finiteExtensionInfinityIntegralClosureRingEquiv_apply_coe (x : RatFuncInfinityIntegralClosure K L) : @@ -278,6 +280,7 @@ noncomputable def finiteExtensionInfinityResidueAlgEquiv change P.1 = (P.1.comap e.symm).comap e exact (Ideal.comap_of_equiv e.toRingEquiv).symm +omit [Fintype K] in /-- The exhaustive place degree agrees with the Riemann--Roch chart degree. -/ theorem finiteExtensionPlaceDegree_eq_chart (v : FiniteExtensionPlace K L) : @@ -409,6 +412,7 @@ private theorem valuation_eq_of_isEquiv_of_surjective · rw [hformula x hx, hm1, one_mul, WithZero.exp_log ((Valuation.ne_zero_iff v).2 hx)] +omit [Fintype K] [DecidableEq K] in /-- The normalized infinity valuation is unchanged by the identity-on-`L` integral-closure transport. -/ theorem finiteExtensionInfinityPlaceValuation_eq_chart diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean index dda7a8faa0..3ff97ccae4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean @@ -204,7 +204,7 @@ theorem algebraMap_mem_finiteExtensionRiemannSpace_of_effective algebraMap K L c ∈ finiteExtensionRiemannSpace K L D := by by_cases hc : c = 0 · subst c - simpa using (finiteExtensionRiemannSpace K L D).zero_mem + simp · rw [mem_finiteExtensionRiemannSpace] refine Or.inr ⟨?_, ?_⟩ · simpa only [map_zero] using (algebraMap K L).injective.ne hc diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean index 4599af731f..c914f33aee 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean @@ -46,6 +46,7 @@ variable {K R L : Type*} [Field K] [CommRing R] [Field L] [Algebra K R] [Algebra R L] [Algebra K L] [IsScalarTower K R L] [IsFractionRing R L] +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [IsFractionRing R L] in /-- Monotonicity of the local pole filtration for an arbitrary increase in the allowed pole order. -/ theorem localPoleSpace_mono_of_le (π : R) {m n : ℕ} (hmn : m ≤ n) : @@ -103,6 +104,7 @@ def localPrincipalPartLayerMap (π : R) (n : ℕ) : change (x : L) ∈ localPoleSpace (K := K) (L := L) π n exact localPoleSpace_mono_of_le (K := K) (L := L) π (Nat.zero_le n) hx +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [IsFractionRing R L] in theorem localPrincipalPartInclusion_injective (π : R) (n : ℕ) : Function.Injective (localPrincipalPartInclusion (K := K) (L := L) π n) := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean index 743b2c79a0..2c957fb752 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FixedPointAverage.lean @@ -131,9 +131,8 @@ sum of fixed-point counts over any fiber of `π` is exactly `|ker π|`. In Stichtenoth's fixed-field argument, `π` is the constant-field Frobenius quotient and the fiber is a Frobenius coset. -/ theorem sum_card_fixedBy_quotientFiber_eq_card_ker - {G C X : Type*} [Group G] [Group C] [Fintype G] [Fintype C] - [DecidableEq C] - [MulAction G X] [Fintype X] [MulAction.IsPretransitive G X] + {G C X : Type*} [Group G] [Group C] [Finite G] + [MulAction G X] [Finite X] [MulAction.IsPretransitive G X] [Nonempty X] (π : G →* C) (hstab : ∀ x : X, Function.Surjective @@ -142,6 +141,9 @@ theorem sum_card_fixedBy_quotientFiber_eq_card_ker letI : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ (∑ g : π ⁻¹' ({c} : Set C), Nat.card (MulAction.fixedBy X g.1)) = Nat.card π.ker := by + classical + let : Fintype G := Fintype.ofFinite G + let : Fintype X := Fintype.ofFinite X let : Fintype (π ⁻¹' ({c} : Set C)) := Fintype.ofFinite _ let (x : X) : Fintype ((π.comp (MulAction.stabilizer G x).subtype) ⁻¹' ({c} : Set C)) := @@ -183,8 +185,8 @@ For a function-field cover, the family is the finite set of rational base places and `X i` is the corresponding restriction fiber of top places. -/ theorem sum_card_fixedBy_quotientFiber_fibers_eq_card_mul_card_ker {ι G C : Type*} [Fintype ι] [Group G] [Group C] - [Fintype G] [Fintype C] [DecidableEq C] - (X : ι → Type*) [∀ i, MulAction G (X i)] [∀ i, Fintype (X i)] + [Finite G] + (X : ι → Type*) [∀ i, MulAction G (X i)] [∀ i, Finite (X i)] [∀ i, MulAction.IsPretransitive G (X i)] [∀ i, Nonempty (X i)] (π : G →* C) (hstab : ∀ i (x : X i), Function.Surjective @@ -263,9 +265,8 @@ theorem natCard_fixedBy_eq_sum_natCard_invariantFiberFixedBy stabilizer-surjectivity by the exact decomposition-group order identity used in the function-field argument. -/ theorem sum_card_fixedBy_quotientFiber_eq_card_ker_of_stabilizer_card - {G C X : Type*} [Group G] [Group C] [Fintype G] [Fintype C] - [DecidableEq C] - [MulAction G X] [Fintype X] [MulAction.IsPretransitive G X] + {G C X : Type*} [Group G] [Group C] [Finite G] [Finite C] + [MulAction G X] [Finite X] [MulAction.IsPretransitive G X] [Nonempty X] (π : G →* C) (hcard : ∀ x : X, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean index 838df65eb0..ece4c482ff 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaEulerDegree.lean @@ -47,7 +47,8 @@ theorem exists_formalPointCountZeta_rational_with_natDegree_lt_of_effectiveDivis /-- Before proving the divisor index is one, the same composition gives an indexed numerator of degree `< N + 2d`. -/ -theorem exists_formalPointCountZeta_indexed_rational_with_natDegree_lt_of_effectiveDivisor_recurrences +theorem + exists_formalPointCountZeta_indexed_rational_with_natDegree_lt_of_effectiveDivisor_recurrences (A pointCount : ℕ → ℕ) (q d N : ℕ) (hd : 0 < d) (hA0 : A 0 = 1) (hEuler : HasEffectiveDivisorPointCountRecurrence A pointCount) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean index e4a3e8e12e..eebbb210bf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaHasseBound.lean @@ -54,7 +54,7 @@ theorem abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_ along any fixed positive divisible-even subsequence imply the base-field Hasse bound. -/ theorem - abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_divisibleEvenError_isBigO + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_divisibleEvenError_isBigO (q δ : ℕ) (pointCount : ℕ → ℕ) (P : Polynomial ℂ) (hq : 0 < q) (hδ : 0 < δ) (hP0 : P.coeff 0 = 1) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean index de4633380a..73a5263215 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FormalZetaTrace.lean @@ -82,9 +82,6 @@ theorem negativeXLogDerivative_mul negativeXLogDerivative (f * g) = negativeXLogDerivative f + negativeXLogDerivative g := by unfold negativeXLogDerivative - change -PowerSeries.X * PowerSeries.derivative (f * g) * (f * g)⁻¹ = - -PowerSeries.X * PowerSeries.derivative f * f⁻¹ + - -PowerSeries.X * PowerSeries.derivative g * g⁻¹ rw [Derivation.leibniz, inverse_mul_of_constantCoeff_ne_zero f g hf hg] simp only [smul_eq_mul] @@ -99,7 +96,7 @@ theorem negativeXLogDerivative_mul ring theorem negativeXLogDerivative_prod_linearPowerSeriesFactor - {I : Type*} [Fintype I] [DecidableEq I] + {I : Type*} [Fintype I] (a : I → ℂ) : negativeXLogDerivative (∏ i, linearPowerSeriesFactor (a i)) = ∑ i, negativeXLogDerivative (linearPowerSeriesFactor (a i)) := by @@ -114,11 +111,12 @@ theorem negativeXLogDerivative_prod_linearPowerSeriesFactor · simp theorem coeff_negativeXLogDerivative_prod_linearPowerSeriesFactor - {I : Type*} [Fintype I] [DecidableEq I] + {I : Type*} [Fintype I] (a : I → ℂ) (n : ℕ) : PowerSeries.coeff (n + 1) (negativeXLogDerivative (∏ i, linearPowerSeriesFactor (a i))) = ∑ i, a i ^ (n + 1) := by + classical rw [negativeXLogDerivative_prod_linearPowerSeriesFactor] simp diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean index 795f991155..86b7e1c2a1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldConstantField.lean @@ -129,11 +129,13 @@ theorem functionFieldConstantQuotientAlgHom_injective Function.Injective (functionFieldConstantQuotientAlgHom K N Q) := (functionFieldConstantQuotientAlgHom K N Q).injective +omit [DecidableEq K] in omit [DecidableEq (RatFunc K)] in /-- The residue field of a rational-function finite place is finite over a finite constant field. -/ -theorem ratFuncFinitePlaceResidueField_finite [Fintype K] +theorem ratFuncFinitePlaceResidueField_finite [Finite K] (p : HeightOneSpectrum K[X]) : Finite p.asIdeal.ResidueField := by + classical let r := finitePlaceNormalizedPrime p have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero have hrmonic : (r : K[X]).Monic := @@ -149,11 +151,13 @@ theorem ratFuncFinitePlaceResidueField_finite [Fintype K] let : Finite (K[X] ⧸ p.asIdeal) := Module.finite_of_finite K infer_instance +omit [DecidableEq K] in omit [DecidableEq (RatFunc K)] in /-- Every finite-place residue field of a finite separable function field is finite over a finite constant field. -/ -theorem finiteExtensionFinitePlaceResidueField_finite [Fintype K] +theorem finiteExtensionFinitePlaceResidueField_finite [Finite K] (P : FiniteExtensionFinitePlace K N) : Finite P.asIdeal.ResidueField := by + classical let p := HeightOneSpectrum.under K[X] P let : Finite p.asIdeal.ResidueField := ratFuncFinitePlaceResidueField_finite K p @@ -166,10 +170,12 @@ theorem finiteExtensionFinitePlaceResidueField_finite [Fintype K] inferInstance exact Module.finite_of_finite p.asIdeal.ResidueField +omit [DecidableEq K] in /-- Over a finite base field, the algebraic constant field of a finite separable function field is finite-dimensional. -/ -noncomputable instance functionFieldConstantField_finiteDimensional [Fintype K] : +noncomputable instance functionFieldConstantField_finiteDimensional [Finite K] : FiniteDimensional K (FunctionFieldConstantField K N) := by + classical let p : HeightOneSpectrum K[X] := Polynomial.idealX K obtain ⟨Q, hQprime, hQcomap⟩ := Ideal.exists_ideal_over_prime_of_isIntegral_of_isDomain @@ -200,16 +206,20 @@ noncomputable instance functionFieldConstantField_finiteDimensional [Fintype K] (functionFieldConstantQuotientAlgHom K N q).toLinearMap (functionFieldConstantQuotientAlgHom_injective K N q) +omit [DecidableEq K] in /-- The algebraic constant field is a finite type when the original constants are finite. -/ -noncomputable instance functionFieldConstantField_finite [Fintype K] : - Finite (FunctionFieldConstantField K N) := - Module.finite_of_finite K +noncomputable instance functionFieldConstantField_finite [Finite K] : + Finite (FunctionFieldConstantField K N) := by + classical + exact Module.finite_of_finite K +omit [DecidableEq K] in /-- The algebraic constant field is Galois over the finite base field. -/ -noncomputable instance functionFieldConstantField_isGalois [Fintype K] : - IsGalois K (FunctionFieldConstantField K N) := - inferInstance +noncomputable instance functionFieldConstantField_isGalois [Finite K] : + IsGalois K (FunctionFieldConstantField K N) := by + classical + exact inferInstance end diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean index 84556d8f4c..1bccd44d13 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean @@ -51,7 +51,7 @@ abbrev FunctionFieldNormalClosureConstantField := /-- Restriction of a `K(t)`-automorphism of the normal closure to its algebraic constant field. -/ def functionFieldNormalClosureConstantRestriction : - Gal((FunctionFieldNormalClosure K L) / (RatFunc K)) →* + Gal(FunctionFieldNormalClosure K L/RatFunc K) →* Gal((FunctionFieldNormalClosureConstantField K L) / K) where toFun g := (g.restrictScalars K).algebraicClosure map_one' := by @@ -64,7 +64,7 @@ def functionFieldNormalClosureConstantRestriction : omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [FiniteDimensional (RatFunc K) L] in theorem functionFieldNormalClosureConstantRestriction_apply - (g : Gal((FunctionFieldNormalClosure K L) / (RatFunc K))) + (g : Gal(FunctionFieldNormalClosure K L/RatFunc K)) (c : FunctionFieldNormalClosureConstantField K L) : functionFieldNormalClosureConstantRestriction K L g c = ⟨g c.1, by @@ -76,7 +76,7 @@ omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] /-- The kernel consists exactly of automorphisms fixing every algebraic constant. -/ theorem mem_functionFieldNormalClosureConstantRestriction_ker_iff - (g : Gal((FunctionFieldNormalClosure K L) / (RatFunc K))) : + (g : Gal(FunctionFieldNormalClosure K L/RatFunc K)) : g ∈ (functionFieldNormalClosureConstantRestriction K L).ker ↔ ∀ c : FunctionFieldNormalClosureConstantField K L, g c.1 = c.1 := by rw [MonoidHom.mem_ker] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index b8d31e43ea..716dcd90ef 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -456,15 +456,19 @@ noncomputable def let g : RatFunc C →ₐ[C] M := functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgHom K F hExact - exact { eC with commutes' := by - intro r - have hX : f RatFunc.X = g RatFunc.X := by - apply Subtype.ext - have hfX := originalMultiplicationCanonicalRatFunc_X K F hExact - have hgX := congrArg Subtype.val (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X K F) - exact hfX.trans hgX.symm - have hfg : f = g := originalCompositum_ratFunc_algHom_ext (C := C) (M := M) f g hX - exact DFunLike.congr_fun hfg r } + exact + { eC with + commutes' := by + intro r + have hX : f RatFunc.X = g RatFunc.X := by + apply Subtype.ext + have hfX := originalMultiplicationCanonicalRatFunc_X K F hExact + have hgX := congrArg Subtype.val + (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X K F) + exact hfX.trans hgX.symm + have hfg : f = g := + originalCompositum_ratFunc_algHom_ext (C := C) (M := M) f g hX + exact DFunLike.congr_fun hfg r } end CanonicalConstantPresentation diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean index df847a45fa..98d8b71e0e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/LocalPoleFiltration.lean @@ -91,6 +91,7 @@ def localPoleLeadingResidueMap (π : R) (n : ℕ) : (algebraMap R L (π ^ n)) (by exact localPoleSpace_regular (K := K) (L := L) π n) +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] in private theorem localPoleNormalizedLift_eq (π : R) (n : ℕ) (x : localPoleSpace (K := K) (L := L) π n) (r : R) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean index adf57d8f68..61fc06e60c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean @@ -65,7 +65,7 @@ theorem single_add_finiteExtensionDivisorAway by_cases hv : v = P · subst v simp - · simp [finiteExtensionDivisorAway, hv] + · simp [finiteExtensionDivisorAway] omit [Fintype K] [DecidableEq K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean index ada9018174..5d392a6dbe 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointLeadingCoefficient.lean @@ -424,12 +424,14 @@ local instance onePointCancellationInfinityConstantTowerToField : rw [IsScalarTower.algebraMap_apply K (RatFunc K) L] rfl +omit [DecidableEq K] in omit [Fintype K] in private theorem finiteExtensionPrincipalDivisor_inr_eq_finitePlaceOrder (x : L) (P : FiniteExtensionInfinityPlace K L) : finiteExtensionPrincipalDivisor K L x (.inr P) = finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by + classical rw [finiteExtensionPrincipalDivisor_inr] symm simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean index b180c93d9e..3ce823b49b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneRationalPlaceAffineComparison.lean @@ -11,7 +11,8 @@ public import LeanPool.MarkoffModP.BGS.HasseWeil.OnePointLeadingCoefficient public import LeanPool.MarkoffModP.BGS.HasseWeil.RatFuncParameterPole public import LeanPool.MarkoffModP.BGS.HasseWeil.GeneralSquareFieldStepanovCount public import Mathlib.Algebra.Polynomial.RingDivision -public import Mathlib.NumberTheory.RamificationInertia.Basic +public import Mathlib.LinearAlgebra.Dimension.Localization +public import Mathlib.RingTheory.RamificationInertia.Basic /-! # Rational normalization places and affine exceptional fibers @@ -33,7 +34,7 @@ characteristic. @[expose] public section -open scoped Polynomial +open scoped Polynomial BigOperators namespace BGS.HasseWeil @@ -264,22 +265,22 @@ theorem rationalBasePlace_primesOver_card_le_finrank (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) := Set.Finite.fintype (IsDedekindDomain.primesOver_finite P.1.asIdeal (RatFuncFiniteIntegralClosure K L)) - let e : P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L) ≃ - ↥(IsDedekindDomain.primesOverFinset P.1.asIdeal - (RatFuncFiniteIntegralClosure K L)) := - Set.equivOfEq - (IsDedekindDomain.coe_primesOverFinset P.1.ne_bot - (RatFuncFiniteIntegralClosure K L)).symm calc - Fintype.card - (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) = - Fintype.card ↥(IsDedekindDomain.primesOverFinset P.1.asIdeal - (RatFuncFiniteIntegralClosure K L)) := Fintype.card_congr e - _ = (IsDedekindDomain.primesOverFinset P.1.asIdeal - (RatFuncFiniteIntegralClosure K L)).card := Fintype.card_coe _ - _ ≤ Module.finrank (RatFunc K) L := - Ideal.card_primesOverFinset_le_finrank - (RatFuncFiniteIntegralClosure K L) (RatFunc K) L P.1.ne_bot + Fintype.card (P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L)) = + ∑ _Q : P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), 1 := by + simp + _ ≤ ∑ Q : P.1.asIdeal.primesOver (RatFuncFiniteIntegralClosure K L), + Q.1.ramificationIdx K[X] * Q.1.inertiaDeg K[X] := by + apply Finset.sum_le_sum + intro Q _ + exact Nat.one_le_of_lt (Nat.mul_pos + (Ideal.ramificationIdx_pos Q.1 K[X]) (Ideal.inertiaDeg_pos Q.1 K[X])) + _ = Module.finrank K[X] (RatFuncFiniteIntegralClosure K L) := + Ideal.sum_ramification_inertia_eq_finrank P.1.asIdeal + (RatFuncFiniteIntegralClosure K L) + _ = Module.finrank (RatFunc K) L := + (IsFractionRing.finrank_eq K[X] (RatFunc K) + (RatFuncFiniteIntegralClosure K L) L).symm /-- The first-coordinate value of the rational base place below a rational finite extension place. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean index 396a56c6b1..41ceeb6ce2 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneSmoothPointNormalization.lean @@ -304,7 +304,6 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing Algebra.FormallySmooth.of_isLocalization q.primeCompl let : Algebra.FormallySmooth K S := Algebra.FormallySmooth.comp K Ad S - let P := planeCurvePartialYSubmersivePresentation f let I := ((Set.range P.map)ᶜ : Set (Unit ⊕ Fin 2)) let bAd : Basis I Ad Ω[Ad⁄K] := P.basisKaehler @@ -321,7 +320,6 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing (TensorProduct S k (KaehlerDifferential K S)) = 1 := by rw [Module.finrank_eq_card_basis bk, hcardI] exact planeCurvePartialYSubmersivePresentation_dimension f - let eResidue := atPrimeResidueAlgEquiv K A S m.asIdeal let : Finite k := Finite.of_injective eResidue.symm eResidue.symm.injective let : Algebra.IsSeparable K k := inferInstance @@ -353,7 +351,6 @@ theorem planeCurveClosedPoint_localization_isDiscreteValuationRing have hcotangent : Module.finrank k (IsLocalRing.CotangentSpace S) ≤ 1 := by rw [← htarget] exact cotangentMap.finrank_le_finrank_of_injective hcotangentMap - have hnotField : ¬ IsField S := IsLocalization.AtPrime.not_isField A hm0 S have hprincipal : (IsLocalRing.maximalIdeal S).IsPrincipal := @@ -426,7 +423,6 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing Algebra.FormallySmooth.of_isLocalization q.primeCompl let : Algebra.FormallySmooth K S := Algebra.FormallySmooth.comp K Ad S - let P := planeCurvePartialYSubmersivePresentation f let I := ((Set.range P.map)ᶜ : Set (Unit ⊕ Fin 2)) let bAd : Basis I Ad Ω[Ad⁄K] := P.basisKaehler @@ -443,7 +439,6 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing (TensorProduct S k (KaehlerDifferential K S)) = 1 := by rw [Module.finrank_eq_card_basis bk, hcardI] exact planeCurvePartialYSubmersivePresentation_dimension f - obtain ⟨z, hz⟩ := m.2 let zf : SquareExtensionClosedPointFiber K p f m := ⟨z, Subtype.ext hz⟩ @@ -480,7 +475,6 @@ theorem squareExtensionClosedPoint_localization_isDiscreteValuationRing have hcotangent : Module.finrank k (IsLocalRing.CotangentSpace S) ≤ 1 := by rw [← htarget] exact cotangentMap.finrank_le_finrank_of_injective hcotangentMap - have hm0 : m.1.asIdeal ≠ ⊥ := squareExtensionClosedPoint_asIdeal_ne_bot_of_partialY K p hf m hsmooth @@ -727,7 +721,6 @@ theorem squareExtensionClosedPointExhaustiveFinitePlace_placeDegree_eq_residueDe let : Algebra K R := RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) let : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl - let : IsDiscreteValuationRing (Localization.AtPrime m.1.asIdeal) := squareExtensionClosedPoint_localization_isDiscreteValuationRing K p hf m hsmooth have hresidue := residue_finrank_eq_of_regular_dominating_valuation K A B E @@ -981,7 +974,6 @@ theorem affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY let : Algebra K R := RingHom.toAlgebra ((algebraMap B R).comp (algebraMap K B)) let : IsScalarTower K B R := IsScalarTower.of_algebraMap_eq' rfl - let eCenter := affinePlaneCurvePoint_residueAlgEquiv K z let : Finite m.asIdeal.ResidueField := Finite.of_injective eCenter eCenter.injective @@ -1011,7 +1003,6 @@ theorem affinePointExhaustiveFinitePlace_degree_eq_one_of_partialY let : IsDiscreteValuationRing (Localization.AtPrime m.asIdeal) := planeCurveClosedPoint_localization_isDiscreteValuationRing K hf m hm0 hsmooth - have hresidue := residue_finrank_eq_of_regular_dominating_valuation K A B E m q.asIdeal R hm0 (affinePointExhaustiveFinitePlace_spec hf hpartialFirst hpartialSecond z).1 diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean index c2c7c1cdff..058536ac26 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RationalPlaceTower.lean @@ -67,6 +67,8 @@ def rationalPlaceUnder : | .inl Q => .inl (rationalFinitePlaceUnder K M L Q) | .inr Q => .inr (rationalInfinityPlaceUnder K M L Q) +omit [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The relative residue degree of a rational finite place is one. -/ theorem rationalFinitePlace_relativeInertiaDeg_eq_one (Q : FiniteExtensionRationalFinitePlace K L) : @@ -79,6 +81,8 @@ theorem rationalFinitePlace_relativeInertiaDeg_eq_one (.inl (finitePlaceUnder K M L Q.1)), by simpa only [Nat.mul_comm] using hmul⟩ +omit [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- The relative residue degree of a rational place above infinity is one. -/ theorem rationalInfinityPlace_relativeInertiaDeg_eq_one (Q : FiniteExtensionRationalInfinityPlace K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean index 2d785b6a50..91909f3b70 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceFinitePlaceIncrement.lean @@ -96,7 +96,7 @@ theorem mem_heightOneSpectrum_of_one_le_finitePlaceOrder_algebraMap (horder : (1 : ℤ) ≤ finitePlaceOrder v (algebraMap R L r)) : r ∈ v.asIdeal := by by_cases hr : r = 0 - · simpa [hr] + · simp [hr] · have hrMap : algebraMap R L r ≠ 0 := by simpa using (IsFractionRing.injective R L).ne hr have hvaluation := @@ -313,7 +313,7 @@ theorem finiteExtensionRiemannSpace_finitePlace_increment change (1 : WithTop ℤ) ≤ finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (a * x.1) at haxOrder by_cases hx0 : x.1 = 0 - · simpa [hx0] using S.zero_mem + · simp [hx0] · have hxQ : 0 ≤ finiteExtensionPrincipalDivisor K L x.1 Q + D Q := by rw [finiteExtensionFinitePlaceLocalOrderTop_mul, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean index 26c04a684a..0933e64665 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RiemannSpaceInfinityPlaceIncrement.lean @@ -260,7 +260,7 @@ theorem finiteExtensionRiemannSpace_infinityPlace_increment change (1 : WithTop ℤ) ≤ finiteExtensionInfinityPlaceLocalOrderTop (K := K) (L := L) P (a * x.1) at haxOrder by_cases hx0 : x.1 = 0 - · simpa [hx0] using S.zero_mem + · simp [hx0] · have hxQ : 0 ≤ finiteExtensionPrincipalDivisor K L x.1 Q + D Q := by rw [finiteExtensionInfinityPlaceLocalOrderTop_mul, From eff45ff7477b05fb37f5b109baa1a76cb5ee69bb Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Fri, 25 Sep 2026 22:25:20 +0000 Subject: [PATCH 32/37] Factor the Hasse-Weil tower estimate and simplify proof assumptions --- .../AuxiliaryFamilyIndexing.lean | 6 +- .../DedekindAuxiliaryCaseI.lean | 36 +- .../DedekindDifferentKaehler.lean | 2 + .../DedekindLocalWronskian.lean | 12 +- .../FiniteExtensionCanonicalWronskian.lean | 8 + .../FiniteExtensionExceptionalSupport.lean | 8 +- .../CorvajaZannier/LocalAuxiliaryCaseI.lean | 15 +- .../LocalAuxiliaryWronskian.lean | 9 +- .../BGS/CorvajaZannier/LocalWronskian.lean | 6 +- .../PlaneCurveAuxiliaryFinitePlaceCases.lean | 20 +- ...eAuxiliaryFinitePlacePrincipalDivisor.lean | 1 + .../PlaneCurveAuxiliaryIndependence.lean | 3 +- .../PlaneCurveBoundarySupport.lean | 7 +- .../PlaneCurveCoordinatePowerHeight.lean | 3 +- .../PlaneCurveInfinityDifferentBound.lean | 2 +- .../BGS/CorvajaZannier/PoweredImageCurve.lean | 4 +- .../TorsionExhaustiveGcdDivisorBound.lean | 2 + .../ConstantExtensionInfinityPlaceBridge.lean | 13 +- ...tantExtensionInfinityPlaceDegreeTower.lean | 3 +- .../HasseWeil/ConstantFieldAutomorphism.lean | 3 +- .../ConstantFieldRatFuncCompatibility.lean | 7 +- .../DedekindDifferentLocalTrace.lean | 6 +- ...ConstantExtensionDifferentCoefficient.lean | 28 +- ...tantExtensionFinitePlaceCompatibility.lean | 8 +- ...ionFrobeniusTwistRationalPlaceAverage.lean | 60 +-- ...tExtensionFrobeniusTwistStepanovUpper.lean | 52 +-- ...diateFrobeniusTwistFinitePlaceAverage.lean | 3 +- ...nIntermediateFrobeniusTwistHasseBound.lean | 58 +-- ...ateFrobeniusTwistRationalPlaceAverage.lean | 70 ++-- ...ctConstantExtensionNormalClosureTower.lean | 3 +- .../FiniteExtensionAffineIdealDegree.lean | 8 +- .../FiniteExtensionAffineIdealDivisor.lean | 11 +- ...iteExtensionCanonicalDifferentCotrace.lean | 4 +- ...FiniteExtensionDivisorClassRecurrence.lean | 13 +- ...nHasseBoundFromEvenConstantExtensions.lean | 4 +- .../HasseWeil/FiniteExtensionHasseWeil.lean | 364 ++++++++++-------- .../HasseWeil/FiniteExtensionPlaceTower.lean | 7 + .../FiniteExtensionRiemannSpace.lean | 5 +- ...ExtensionRiemannSpaceProjectivization.lean | 24 +- ...teFieldConstantExtensionNormalization.lean | 14 +- .../FiniteFieldDivisibleExtension.lean | 10 +- .../BGS/HasseWeil/FinitePrincipalParts.lean | 1 + .../HasseWeil/FrobeniusPlaceCardinality.lean | 16 +- .../BGS/HasseWeil/FrobeniusRestriction.lean | 5 + ...nFieldNormalClosureOriginalCompositum.lean | 9 +- ...FunctionFieldNormalClosureRatFuncBase.lean | 1 + .../BGS/HasseWeil/GaloisAverage.lean | 12 +- .../BGS/HasseWeil/OnePointDivisorSplit.lean | 2 + .../BGS/HasseWeil/PoleDivisor.lean | 1 + .../RatFuncCanonicalInfinityDivisor.lean | 4 + .../BGS/HasseWeil/RatFuncParameterPole.lean | 14 + .../SquareExtensionAffinePlaces.lean | 1 - .../BGS/NumberTheory/DivisorBound.lean | 2 +- .../MarkoffModP/RiemannRoch/Genus/Polar.lean | 2 +- 54 files changed, 607 insertions(+), 385 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean index 4373cc8bc4..ad93d6efc8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/AuxiliaryFamilyIndexing.lean @@ -98,9 +98,9 @@ theorem indexedAuxiliaryWronskian_det_eq_derivationWronskian_det Matrix.reindex e.symm e.symm (BGS.Algebra.derivationWronskian D g) := by ext i j - simp [indexedDedekindLocalWronskian, - auxiliaryFamilyDerivativeOrder, BGS.Algebra.derivationWronskian, - Matrix.reindex_apply, Matrix.submatrix, g, e] + simp only [indexedDedekindLocalWronskian, auxiliaryFamilyDerivativeOrder, Matrix.reindex_apply, + Matrix.submatrix, Algebra.derivationWronskian, Equiv.symm_symm, Equiv.symm_apply_apply, + Matrix.of_apply, e, g] exact (Module.End.pow_apply D.toLinearMap _ (f j)).symm rw [hmatrix, Matrix.det_reindex_self] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean index 7896c30837..3ef60faae8 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindAuxiliaryCaseI.lean @@ -116,29 +116,29 @@ theorem exists_constant_dedekindPoleDepth_sub_mul_lt exists_constant_finitePlaceOrder_sub_mul_eq_zero_or_lt v hresidue x y hx hy horder' · refine ⟨c, ?_, ?_⟩ - rw [hz] - have hxdepth : 0 < dedekindPoleDepth v x := - (dedekindPoleDepth_pos_iff v x).2 hxneg - simpa only [dedekindPoleDepth_zero] using hxdepth - rw [hz, finitePlaceOrderTop_eq_coe v x hx] - simp - · by_cases hz : x - algebraMap C L c * y = 0 - · refine ⟨c, ?_, ?_⟩ - rw [hz] + · rw [hz] have hxdepth : 0 < dedekindPoleDepth v x := (dedekindPoleDepth_pos_iff v x).2 hxneg simpa only [dedekindPoleDepth_zero] using hxdepth - rw [hz, finitePlaceOrderTop_eq_coe v x hx] + · rw [hz, finitePlaceOrderTop_eq_coe v x hx] simp + · by_cases hz : x - algebraMap C L c * y = 0 + · refine ⟨c, ?_, ?_⟩ + · rw [hz] + have hxdepth : 0 < dedekindPoleDepth v x := + (dedekindPoleDepth_pos_iff v x).2 hxneg + simpa only [dedekindPoleDepth_zero] using hxdepth + · rw [hz, finitePlaceOrderTop_eq_coe v x hx] + simp · refine ⟨c, ?_, ?_⟩ - simp only [dedekindPoleDepth, hx, hz, ite_false] - have hxorderneg : finitePlaceOrder v x < 0 := by - rw [finitePlaceOrderTop_eq_coe v x hx] at hxneg - exact_mod_cast hxneg - omega - rw [finitePlaceOrderTop_eq_coe v x hx, - finitePlaceOrderTop_eq_coe v _ hz] - exact_mod_cast hlt + · simp only [dedekindPoleDepth, hx, hz, ite_false] + have hxorderneg : finitePlaceOrder v x < 0 := by + rw [finitePlaceOrderTop_eq_coe v x hx] at hxneg + exact_mod_cast hxneg + omega + · rw [finitePlaceOrderTop_eq_coe v x hx, + finitePlaceOrderTop_eq_coe v _ hz] + exact_mod_cast hlt private theorem indexedDedekindLocalColumnCombination_transvection_same {k : ℕ} (f : Fin k → L) (i j : Fin k) (c : C) : diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean index 7bb679d87d..5df6291f4c 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindDifferentKaehler.lean @@ -223,9 +223,11 @@ variable {A B κ : Type*} [Algebra.IsSeparable (FractionRing A) (FractionRing B)] [Fintype κ] [DecidableEq κ] +omit [DecidableEq κ] in private theorem mem_kaehlerAnnihilator_of_mem_differentIdeal_of_basis (bA : Basis κ A B) (d : B) (hd : d ∈ differentIdeal A B) : d ∈ Module.annihilator B Ω[B⁄A] := by + classical let : IsIntegralClosure B A (FractionRing B) := IsIntegralClosure.of_isIntegrallyClosed B A (FractionRing B) let : Algebra.IsAlgebraic (FractionRing A) (FractionRing B) := diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean index 4626a15488..668f18e609 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/DedekindLocalWronskian.lean @@ -34,10 +34,11 @@ variable {R L : Type*} [CommRing R] [IsDedekindDomain R] /-- The order of a finite product is the sum of the orders, including zero factors via `WithTop`. -/ theorem finitePlaceOrderTop_finset_prod - {ι : Type*} [DecidableEq ι] (v : HeightOneSpectrum R) + {ι : Type*} (v : HeightOneSpectrum R) (s : Finset ι) (g : ι → L) : finitePlaceOrderTop v (∏ i ∈ s, g i) = ∑ i ∈ s, finitePlaceOrderTop v (g i) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => @@ -48,10 +49,11 @@ theorem finitePlaceOrderTop_finset_prod order at least `b`. This is the cancellation step in the determinant estimate. -/ theorem le_finitePlaceOrderTop_finset_sum_of_forall - {ι : Type*} [DecidableEq ι] (v : HeightOneSpectrum R) + {ι : Type*} (v : HeightOneSpectrum R) (b : WithTop ℤ) (s : Finset ι) (g : ι → L) (h : ∀ i ∈ s, b ≤ finitePlaceOrderTop v (g i)) : b ≤ finitePlaceOrderTop v (∑ i ∈ s, g i) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => @@ -81,9 +83,10 @@ theorem finitePlaceOrderTop_le_intCast_mul add_le_add hz le_rfl private theorem coe_sum_int_finset - {ι : Type*} [DecidableEq ι] (s : Finset ι) (g : ι → ℤ) : + {ι : Type*} (s : Finset ι) (g : ι → ℤ) : (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] @@ -128,13 +131,14 @@ private theorem derivation_iterate_sum_smul /-- Constant column operations commute with the indexed DVR Wronskian. -/ theorem indexedDedekindLocalWronskian_columnCombination - {ι : Type*} [Fintype ι] [DecidableEq ι] + {ι : Type*} [Fintype ι] (D : Derivation C L L) (ε : ι → ℕ) (f : ι → L) (A : Matrix ι ι C) : indexedDedekindLocalWronskian D ε (indexedDedekindLocalColumnCombination f A) = indexedDedekindLocalWronskian D ε f * A.map (algebraMap C L) := by + classical apply Matrix.ext intro i j rw [Matrix.mul_apply] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean index 74c7339746..f1f81e1b59 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean @@ -131,6 +131,7 @@ theorem idealMultiplicityWeightedDegree_eq_finiteExtensionFiniteDirectDegreeSum finiteExtensionFinitePrincipalDivisor_algebraMap_eq_mapRange K L d hd, Finsupp.sum_mapRange_index (fun q => by simp)] +omit [DecidableEq (RatFunc K)] in /-- The finite different degree is bounded by the finite degree of the minimal-polynomial derivative of an integral primitive element. -/ theorem finiteDifferentDegree_le_minpolyDerivativeDegree @@ -146,6 +147,7 @@ theorem finiteDifferentDegree_le_minpolyDerivativeDegree finiteExtensionFiniteDirectDegreeSum K L (algebraMap (RatFuncFiniteIntegralClosure K L) L (Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)))) := by + classical let d : RatFuncFiniteIntegralClosure K L := Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)) have hd : d ≠ 0 := by @@ -216,6 +218,7 @@ private theorem ratFunc_intDegree_neg_one_pow (m : ℕ) : rw [pow_succ, RatFunc.intDegree_mul (pow_ne_zero m (by simp)) (by simp), ih] simp +omit [DecidableEq (RatFunc K)] in /-- The finite degree of the integral minimal-polynomial derivative is exactly the rational-function degree of the associated power-basis discriminant. -/ theorem finiteExtensionMinpolyDerivativeDegree_eq_powerBasisDiscriminantDegree @@ -229,6 +232,7 @@ theorem finiteExtensionMinpolyDerivativeDegree_eq_powerBasisDiscriminantDegree (PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral (algebraMap (RatFuncFiniteIntegralClosure K L) L x)) hx).basis).intDegree := by + classical let d : RatFuncFiniteIntegralClosure K L := Polynomial.aeval x (Polynomial.derivative (minpoly K[X] x)) let y : L := algebraMap (RatFuncFiniteIntegralClosure K L) L d @@ -258,6 +262,7 @@ theorem finiteExtensionMinpolyDerivativeDegree_eq_powerBasisDiscriminantDegree ratFunc_intDegree_neg_one_pow K] at hdegree omega +omit [DecidableEq (RatFunc K)] in /-- The finite different degree is bounded by the power-basis discriminant degree of any integral primitive element. -/ theorem finiteDifferentDegree_le_powerBasisDiscriminantDegree @@ -274,6 +279,7 @@ theorem finiteDifferentDegree_le_powerBasisDiscriminantDegree (PowerBasis.ofAdjoinEqTop' (Algebra.IsIntegral.isIntegral (algebraMap (RatFuncFiniteIntegralClosure K L) L x)) hx).basis).intDegree := by + classical calc _ ≤ finiteExtensionFiniteDirectDegreeSum K L (algebraMap (RatFuncFiniteIntegralClosure K L) L @@ -396,6 +402,7 @@ theorem finiteExtensionLocalWronskianDivisor_degree intro v hv ring +omit [DecidableEq K] in /-- Over algebraically closed constants every place has degree one, so the global canonical identity becomes the ordinary unweighted sum of local Wronskian orders used by Corvaja--Zannier. -/ @@ -407,6 +414,7 @@ theorem finiteExtensionLocalWronskianDivisor_sum (finiteExtensionLocalWronskianDivisor K L D g canonicalDivisor).sum (fun _ e => e) = (n.choose 2 : ℤ) * canonicalDivisor.sum (fun _ e => e) := by + classical have hdegree := finiteExtensionLocalWronskianDivisor_degree K L D g canonicalDivisor hW simpa only [finiteExtensionDivisorDegree, diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index 56d282411c..b3eb38a2b5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -245,7 +245,7 @@ theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct exact mul_ne_zero (pow_ne_zero _ hu) (pow_ne_zero _ hv) private theorem weightedSupportDegree_le_positive_add_negative - {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) : + {ι : Type*} (D : ι →₀ ℤ) (weight : ι → ℕ) : ∑ i ∈ D.support, weight i ≤ (∑ i ∈ D.support.filter (fun i => 0 < D i), (D i).toNat * weight i) + @@ -335,7 +335,7 @@ private theorem finsuppWeightedNegativeDegree_eq_filter _ = _ := by simp private theorem finsuppWeightedPositiveDegree_eq_filter - {ι : Type*} [DecidableEq ι] (D : ι →₀ ℤ) (weight : ι → ℕ) : + {ι : Type*} (D : ι →₀ ℤ) (weight : ι → ℕ) : (∑ i ∈ D.support, (D i).toNat * weight i) = ∑ i ∈ D.support.filter (fun i => 0 < D i), (D i).toNat * weight i := by @@ -637,12 +637,14 @@ def finiteExtensionExceptionalSet (f : A → L) (iU iV : A) : exact finiteExtensionFamilyMemberSupport K L f iU ∪ finiteExtensionFamilyMemberSupport K L f iV +omit [DecidableEq K] in @[simp] theorem mem_finiteExtensionExceptionalSet_iff (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) : w ∈ finiteExtensionExceptionalSet K L f iU iV ↔ w.1 ∈ (finiteExtensionPrincipalDivisor K L (f iU)).support ∨ w.1 ∈ (finiteExtensionPrincipalDivisor K L (f iV)).support := by + classical simp [finiteExtensionExceptionalSet] /-- Residue-degree-weighted boundary bound for the exceptional set. -/ @@ -832,11 +834,13 @@ theorem finiteExtensionFamilyOrder_v_eq_zero_outsideExceptionalSet apply finiteExtensionFamilyOrder_eq_zero_of_not_mem_support K L f iV w exact (not_or.mp ((mem_finiteExtensionExceptionalSet_iff K L f iU iV w).not.mp hw)).2 +omit [DecidableEq K] in /-- Every positive-order place of `v` lies in the exceptional set. -/ theorem finiteExtensionFamilyOrder_v_positive_mem_exceptionalSet (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) (hw : 0 < finiteExtensionFamilyOrder K L f iV w) : w ∈ finiteExtensionExceptionalSet K L f iU iV := by + classical rw [mem_finiteExtensionExceptionalSet_iff] right rw [Finsupp.mem_support_iff] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean index 8907d86480..e7c758aa45 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryCaseI.lean @@ -260,10 +260,11 @@ theorem exists_det_one_columnMatrix_negativeOrdersPairwiseDistinct exact hBlower /-- Sharp lower sum bound for distinct integers bounded below. -/ -theorem sum_range_add_le_sum_of_injOn {ι : Type*} [DecidableEq ι] +theorem sum_range_add_le_sum_of_injOn {ι : Type*} (s : Finset ι) (w : ι → ℤ) (a : ℤ) (hinj : Set.InjOn w (s : Set ι)) (hlower : ∀ i ∈ s, a ≤ w i) : (∑ n ∈ Finset.range s.card, (a + n : ℤ)) ≤ ∑ i ∈ s, w i := by + classical have hcard : (s.image w).card = s.card := Finset.card_image_iff.mpr hinj have hbound := Finset.sum_range_le_sum (s := s.image w) (c := a) (by @@ -275,11 +276,12 @@ theorem sum_range_add_le_sum_of_injOn {ι : Type*} [DecidableEq ι] simpa [Finset.sum_image hinj] using hbound /-- Sharp upper sum bound for distinct natural numbers bounded above. -/ -theorem sum_le_sum_range_sub_of_injOn {ι : Type*} [DecidableEq ι] +theorem sum_le_sum_range_sub_of_injOn {ι : Type*} (s : Finset ι) (e : ι → ℕ) (epsilon : ℕ) (hinj : Set.InjOn e (s : Set ι)) (hupper : ∀ i ∈ s, e i ≤ epsilon) : (∑ i ∈ s, (e i : ℤ)) ≤ ∑ n ∈ Finset.range s.card, ((epsilon : ℤ) - n) := by + classical let w : ι → ℤ := fun i => e i have hinjw : Set.InjOn w (s : Set ι) := by intro i hi j hj hij @@ -295,18 +297,20 @@ theorem sum_le_sum_range_sub_of_injOn {ι : Type*} [DecidableEq ι] rw [hcard] at hbound simpa [w, Finset.sum_image hinjw] using hbound -private theorem caseI_addVal_prod {ι : Type*} [DecidableEq ι] +private theorem caseI_addVal_prod {ι : Type*} (s : Finset ι) (g : ι → LaurentSeries K) : HahnSeries.addVal ℤ K (∏ i ∈ s, g i) = ∑ i ∈ s, HahnSeries.addVal ℤ K (g i) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, AddValuation.map_mul] -private theorem caseI_coe_sum_int_finset {ι : Type*} [DecidableEq ι] +private theorem caseI_coe_sum_int_finset {ι : Type*} (s : Finset ι) (g : ι → ℤ) : (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] @@ -482,11 +486,12 @@ theorem orderTop_indexedWronskian_det_caseI_q_lower_bound /-- Pairwise-distinct negative integers bounded below by a nonpositive integer are no more numerous than its pole depth. -/ theorem card_negativeOrders_le_neg - {ι : Type*} [Fintype ι] [DecidableEq ι] + {ι : Type*} [Fintype ι] (g : ι → LaurentSeries K) (a : ℤ) (ha : a ≤ 0) (hgdistinct : NegativeOrdersPairwiseDistinct g) (hglower : ∀ i, a ≤ (g i).order) : a ≤ -((Finset.univ.filter fun i => (g i).order < 0).card : ℤ) := by + classical let poles : Finset ι := Finset.univ.filter fun i => (g i).order < 0 let w : ι → ℤ := fun i => (g i).order have hinj : Set.InjOn w (poles : Set ι) := by diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean index 7206f7730f..f0c1302ee6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalAuxiliaryWronskian.lean @@ -73,12 +73,13 @@ private theorem indexed_derivative_iterate_sum_smul {ι : Type*} [Fintype ι] /-- Constant column operations commute with the indexed ordinary Wronskian. -/ theorem indexedLaurentSeriesWronskian_columnCombination - {ι : Type*} [Fintype ι] [DecidableEq ι] + {ι : Type*} [Fintype ι] (ε : ι → ℕ) (f : ι → LaurentSeries K) (A : Matrix ι ι K) : indexedLaurentSeriesWronskian ε (indexedLaurentSeriesColumnCombination f A) = indexedLaurentSeriesWronskian ε f * A.map (algebraMap K (LaurentSeries K)) := by + classical apply Matrix.ext intro i j rw [Matrix.mul_apply] @@ -119,18 +120,20 @@ theorem indexedLaurentSeriesWronskian_det_columnCombination_of_det_eq_one _ = 1 := by rw [hA, map_one] rw [hdetmap, mul_one] -private theorem indexed_addVal_prod {ι : Type*} [DecidableEq ι] +private theorem indexed_addVal_prod {ι : Type*} (s : Finset ι) (g : ι → LaurentSeries K) : HahnSeries.addVal ℤ K (∏ i ∈ s, g i) = ∑ i ∈ s, HahnSeries.addVal ℤ K (g i) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, AddValuation.map_mul] -private theorem indexed_coe_sum_int_finset {ι : Type*} [DecidableEq ι] +private theorem indexed_coe_sum_int_finset {ι : Type*} (s : Finset ι) (g : ι → ℤ) : (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean index 0d6a2b2e4d..41c68d74d0 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/LocalWronskian.lean @@ -104,18 +104,20 @@ theorem laurentSeriesWronskian_det_columnCombination_of_det_eq_one {n : ℕ} _ = 1 := by rw [hA, map_one] rw [hdetmap, mul_one] -private theorem addVal_prod {ι : Type*} [DecidableEq ι] +private theorem addVal_prod {ι : Type*} (s : Finset ι) (g : ι → LaurentSeries K) : HahnSeries.addVal ℤ K (∏ i ∈ s, g i) = ∑ i ∈ s, HahnSeries.addVal ℤ K (g i) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, AddValuation.map_mul] -private theorem coe_sum_int_finset {ι : Type*} [DecidableEq ι] +private theorem coe_sum_int_finset {ι : Type*} (s : Finset ι) (g : ι → ℤ) : (((∑ i ∈ s, g i : ℤ) : ℤ) : WithTop ℤ) = ∑ i ∈ s, ((g i : ℤ) : WithTop ℤ) := by + classical induction s using Finset.induction_on with | empty => simp | @insert a s ha ih => simp [ha, ih, WithTop.coe_add] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean index ff125e9190..c3e35c96e9 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlaceCases.lean @@ -97,10 +97,11 @@ theorem finiteExtensionFinitePlace_exists_local_lift_of_orderTop_nonnegative variable {C : Type*} [Field C] [Algebra C L] -omit [DecidableEq (RatFunc K)] in -theorem ratFuncFinitePlace_residueField_finite [Fintype K] +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem ratFuncFinitePlace_residueField_finite [Finite K] (p : HeightOneSpectrum K[X]) : Finite p.asIdeal.ResidueField := by + classical let r := finitePlaceNormalizedPrime p have hr0 : (r : K[X]) ≠ 0 := r.property.1.ne_zero have hrmonic : (r : K[X]).Monic := @@ -118,10 +119,11 @@ theorem ratFuncFinitePlace_residueField_finite [Fintype K] Module.finite_of_finite K infer_instance -omit [DecidableEq (RatFunc K)] in -theorem finiteExtensionFinitePlace_residueField_finite [Fintype K] +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlace_residueField_finite [Finite K] (q : PlaneCurveExtensionFinitePlace K L) : Finite q.asIdeal.ResidueField := by + classical let p := HeightOneSpectrum.under K[X] q let : Finite p.asIdeal.ResidueField := ratFuncFinitePlace_residueField_finite p @@ -135,8 +137,8 @@ theorem finiteExtensionFinitePlace_residueField_finite [Fintype K] inferInstance exact Module.finite_of_finite p.asIdeal.ResidueField -omit [DecidableEq (RatFunc K)] in -theorem finiteExtensionFinitePlaceLocal_residueField_perfect [Fintype K] +omit [DecidableEq K] [DecidableEq (RatFunc K)] in +theorem finiteExtensionFinitePlaceLocal_residueField_perfect [Finite K] (q : PlaneCurveExtensionFinitePlace K L) : letI : IsDiscreteValuationRing (FiniteExtensionFinitePlaceLocalRing K L q) := @@ -146,6 +148,7 @@ theorem finiteExtensionFinitePlaceLocal_residueField_perfect [Fintype K] PerfectField (IsDiscreteValuationRing.maximalIdeal (FiniteExtensionFinitePlaceLocalRing K L q)).asIdeal.ResidueField := by + classical let : Finite q.asIdeal.ResidueField := finiteExtensionFinitePlace_residueField_finite q let : Finite (HasQuotient.Quotient @@ -261,9 +264,9 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseII_nonnegative_of_scaled_ variable {p : ℕ} [Fact p.Prime] [CharP L p] -omit [DecidableEq (RatFunc K)] in +omit [DecidableEq K] [DecidableEq (RatFunc K)] in theorem finiteExtensionFinitePlace_auxiliaryFamily_caseI_q_wronskian_bound_of_scaled_preserves - [Fintype K] + [Finite K] (q : PlaneCurveExtensionFinitePlace K L) (h k : ℕ) {n : ℕ} (e : Sum (Fin k) (Fin (k + 1) × Fin h) ≃ Fin n) @@ -300,6 +303,7 @@ theorem finiteExtensionFinitePlace_auxiliaryFamily_caseI_q_wronskian_bound_of_sc finiteExtensionFinitePlaceLocalOrderTop (K := K) (L := L) q (indexedDedekindLocalWronskian D epsilonOrder (auxiliaryFamily u v h k)).det := by + classical let := finiteExtensionFinitePlaceLocalAlgebra (K := K) (L := L) q let := finiteExtensionFinitePlaceLocalIsFractionRing (K := K) (L := L) q let : IsDiscreteValuationRing diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean index 177b25cbb6..4bcd6a3c9d 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryFinitePlacePrincipalDivisor.lean @@ -59,6 +59,7 @@ theorem finiteExtensionFinitePlaceLocalOrder_eq_principalDivisor ((ratFuncFiniteIntegralClosureFractionRingEquiv K L).symm x) simpa [ratFuncFiniteIntegralClosureFractionRingEquiv] using h +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- For a nonzero element, the `WithTop` order appearing in the local Wronskian inequality is the exhaustive principal-divisor coefficient. -/ theorem finiteExtensionFinitePlaceLocalOrderTop_eq_principalDivisor diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean index 1334cae2c4..7b8507ca2e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveAuxiliaryIndependence.lean @@ -242,7 +242,8 @@ theorem evalBivariate_planeCurveFrobeniusRelation (planeCurveToBivariate F (MvPolynomial.C (ι c))) = rhs (MvPolynomial.C c) rw [planeCurveToBivariate_C] - simp [evalIterated, rhs, ι, F] + simp only [Polynomial.coe_eval₂RingHom, Polynomial.eval₂_C, MvPolynomial.eval₂Hom_C, F, + evalIterated, ι, rhs] change (((perfectConstantsToFrobeniusSubfield (K := K) (L := L) (p := p) c : frobeniusSubfield L p) : L)) = diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean index 7892329462..0d29dd90e5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveBoundarySupport.lean @@ -122,6 +122,7 @@ private theorem probeFiniteExtensionPlaceValuation_surjective exact (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation_surjective L z +omit [DecidableEq K] in private theorem probeFiniteExtensionPlaceValuation_eq_exp_neg_order (w : FiniteExtensionPlace K L) (x : L) (hx : x ≠ 0) : probeFiniteExtensionPlaceValuation K L w x = @@ -323,10 +324,11 @@ private noncomputable def heightOneSpectrumResidueFieldRingEquivOfComapEq end ResidueTransport private theorem finrank_eq_of_ringEquiv_of_finite_base - {k E F : Type*} [Field k] [Fintype k] + {k E F : Type*} [Field k] [Finite k] [Field E] [Field F] [Algebra k E] [Algebra k F] [FiniteDimensional k E] [FiniteDimensional k F] (e : E ≃+* F) : Module.finrank k E = Module.finrank k F := by + let : Fintype k := Fintype.ofFinite k apply Nat.pow_right_injective (a := Nat.card k) (by rw [Nat.card_eq_fintype_card] exact Nat.succ_le_iff.mpr Fintype.one_lt_card) @@ -338,7 +340,7 @@ private theorem finrank_eq_of_ringEquiv_of_finite_base /-- Equal normalized valuations have residue fields of the same degree over a finite base. -/ private theorem residueFinrank_eq_of_valuation_eq - {k R S F : Type*} [Field k] [Fintype k] + {k R S F : Type*} [Field k] [Finite k] [CommRing R] [IsDedekindDomain R] [CommRing S] [IsDedekindDomain S] [Field F] [Algebra R F] [IsFractionRing R F] [Algebra S F] [IsFractionRing S F] @@ -462,6 +464,7 @@ private theorem valuationSubringAt_valuationCenterPlace_le rw [ht] exact t.property +omit [IsDomain R] in private theorem valuationSubringAt_valuationCenterPlace_eq (V : ValuationSubring F) (hbase : ∀ r : R, algebraMap R F r ∈ V) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean index 8ab49f4bf6..857e446a6e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCoordinatePowerHeight.lean @@ -65,7 +65,8 @@ theorem finiteExtensionPositiveDegree_planeCurveFirstCoordinate_pow_sub_one algebraMap (RatFunc K) (PlaneCurveFunctionField f) (algebraMap (Polynomial K) (RatFunc K) P) = (planeCurveFunction f 0) ^ m - 1 := by - simp [P] + simp only [map_sub, map_pow, RatFunc.algebraMap_X, map_one, + planeCurveFirstCoordinateRatFuncAlgebra_algebraMap_apply, Fin.isValue, sub_left_inj, P] rw [show ratFuncSpecialization (planeCurveFunction f 0) hx RatFunc.X = planeCurveFunction f 0 by exact planeCurveFirstCoordinateRatFuncAlgebra_X f hx] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean index 2b544d5c14..fe36cd4599 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveInfinityDifferentBound.lean @@ -223,7 +223,7 @@ theorem infinityNormalizedIntegralPolynomial_map rw [coeff_map] simp only [infinityNormalizedIntegralPolynomial, coeff_sum, coeff_monomial] - simp [Polynomial.sum] + simp only [sum, Finset.sum_ite_eq', mem_support_iff, ne_eq, ite_not] by_cases hzero : F.coeff i = 0 · simp [hzero, infinityNormalizedPolynomial, coeff_C_mul] · rw [ite_eq_right hzero] diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean index 7de25c32e6..7d819bf5d6 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PoweredImageCurve.lean @@ -315,7 +315,9 @@ theorem ratFuncSpecialization_comp_polynomial_algebraMap Polynomial.eval₂RingHom (algebraMap K L) u := by apply Polynomial.ringHom_ext · intro c - simp [ratFuncSpecialization] + simp only [ratFuncSpecialization, RingEquiv.toRingHom_eq_coe, AlgEquiv.toRingEquiv_toRingHom, + RingHom.coe_comp, RingHom.coe_coe, Function.comp_apply, RatFunc.algebraMap_C, + IntermediateField.algebraMap_apply, Polynomial.coe_eval₂RingHom, Polynomial.eval₂_C] rw [← RatFunc.algebraMap_eq_C, (RatFunc.algEquivOfTranscendental u hu).commutes] rfl diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean index 5d597b3fdf..943e5df653 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/TorsionExhaustiveGcdDivisorBound.lean @@ -121,6 +121,7 @@ noncomputable def coordinateRingToDominatingValuationSubring (Subring.inclusion (range_le_dominatingValuationSubring m)).comp (algebraMap A L).rangeRestrict +omit [IsDomain A] in theorem pointIdeal_eq_comap_dominatingValuationSubring_maximalIdeal (m : MaximalSpectrum A) : m.asIdeal = Ideal.comap (coordinateRingToDominatingValuationSubring m) @@ -168,6 +169,7 @@ section IntegralClosure variable {P : Type*} [CommRing P] [Algebra P L] +omit [IsDomain A] in theorem integralClosure_le_dominatingValuationSubring (m : MaximalSpectrum A) (hbase : ∀ p : P, algebraMap P L p ∈ (algebraMap A L).range) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean index e1ecdb5726..f09304e176 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceBridge.lean @@ -239,10 +239,11 @@ noncomputable def localizationResidueFieldRingEquiv |>.residueFieldMap_bijective q Q hcomap private theorem finrank_eq_of_finite_ringEquiv - (K E F : Type*) [Field K] [Fintype K] + (K E F : Type*) [Field K] [Finite K] [Field E] [Field F] [Algebra K E] [Algebra K F] [Finite E] [Finite F] (e : E ≃+* F) : Module.finrank K E = Module.finrank K F := by + let : Fintype K := Fintype.ofFinite K let : Fintype E := Fintype.ofFinite E let : Fintype F := Fintype.ofFinite F have hcard : Fintype.card E = Fintype.card F := @@ -255,7 +256,7 @@ private theorem finrank_eq_of_finite_ringEquiv private theorem actualInfinityPlaceResidueField_finite (K L : Type*) [Field K] [Field L] [DecidableEq K] [DecidableEq (RatFunc K)] - [Fintype K] [Algebra (RatFunc K) L] + [Finite K] [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] (P : FiniteExtensionInfinityPlace K L) : @@ -760,12 +761,14 @@ theorem exactConstantExtensionUpstairsInfinityResidueField_finite include hExact +omit [Fintype C] in /-- The residue field of the reciprocal tensor-normalization prime is finite. -/ -theorem exactConstantExtensionInfinityTensorResidueField_finite +theorem exactConstantExtensionInfinityTensorResidueField_finite [Finite C] (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) (hqOrigin : q.asIdeal.under S[X] = Ideal.span ({Polynomial.X} : Set S[X])) : Finite q.asIdeal.ResidueField := by + let : Fintype C := Fintype.ofFinite C let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact let : Algebra (RatFunc S) (ExactConstantExtension C N S) := @@ -779,13 +782,15 @@ theorem exactConstantExtensionInfinityTensorResidueField_finite C S N hExact q hqOrigin exact Finite.of_injective e e.injective +omit [Fintype C] in /-- A reciprocal tensor-normalization height-one prime above the origin is maximal; no maximality hypothesis is left to the residue calculation. -/ -theorem exactConstantExtensionInfinityTensorIdeal_isMaximal +theorem exactConstantExtensionInfinityTensorIdeal_isMaximal [Finite C] (q : HeightOneSpectrum (S ⊗[C] integralClosure C[X] N)) (hqOrigin : q.asIdeal.under S[X] = Ideal.span ({Polynomial.X} : Set S[X])) : q.asIdeal.IsMaximal := by + let : Fintype C := Fintype.ofFinite C let : Finite q.asIdeal.ResidueField := exactConstantExtensionInfinityTensorResidueField_finite C S N hExact q hqOrigin diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean index 731210f99f..dce1182ec6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceDegreeTower.lean @@ -32,10 +32,11 @@ open BGS.CorvajaZannier IsDedekindDomain preserves their dimensions, even when it is not presented as an algebra equivalence. -/ private theorem finrank_eq_of_finite_ringEquiv - (K E F : Type*) [Field K] [Fintype K] + (K E F : Type*) [Field K] [Finite K] [Field E] [Field F] [Algebra K E] [Algebra K F] [Finite E] [Finite F] (e : E ≃+* F) : Module.finrank K E = Module.finrank K F := by + let : Fintype K := Fintype.ofFinite K let : Fintype E := Fintype.ofFinite E let : Fintype F := Fintype.ofFinite F have hcard : Fintype.card E = Fintype.card F := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean index 4ec8e23867..a7fa93353a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldAutomorphism.lean @@ -292,7 +292,7 @@ theorem planeCurveConstantAutOverBaseHom_injective : exact DFunLike.congr_fun h x theorem planeCurveFunctionFieldBaseChange_isGalois - [Fintype K] [Finite E] : + [Finite K] [Finite E] : letI : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf letI : IsDomain (PlaneCurveCoordinateRing @@ -301,6 +301,7 @@ theorem planeCurveFunctionFieldBaseChange_isGalois letI := planeCurveFunctionFieldBaseChangeAlgebra K E f hf hfE IsGalois (PlaneCurveFunctionField f) (PlaneCurveFunctionField (MvPolynomial.map (algebraMap K E) f)) := by + let : Fintype K := Fintype.ofFinite K let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let : IsDomain (PlaneCurveCoordinateRing diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean index 3d0916bc00..e8c931d603 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantFieldRatFuncCompatibility.lean @@ -62,8 +62,11 @@ theorem planeCurveCoordinateRingBaseChangeAlgEquiv_includeRight apply Ideal.Quotient.algHom_ext K apply MvPolynomial.algHom_ext intro i - simp [Φ, planeCurveCoordinateRingBaseChangeAlgEquiv, - planeCurveCoordinateRingMap] + simp only [planeCurveCoordinateRingBaseChangeAlgEquiv, AlgEquiv.toAlgHom_restrictScalars, + AlgHom.coe_comp, AlgHom.coe_restrictScalars', AlgEquiv.coe_toAlgHom, AlgEquiv.coe_trans, + Ideal.Quotient.mkₐ_eq_mk, Function.comp_apply, Algebra.TensorProduct.includeRight_apply, + Algebra.TensorProduct.tensorQuotientEquiv_apply_tmul, planeCurveCoordinateRingMap, + Ideal.quotient_map_mkₐ, AlgHom.coe_mk, MvPolynomial.map_X, Φ] erw [Ideal.quotientEquivAlg_mk] simp only [MvPolynomial.algebraTensorAlgEquiv_tmul, one_smul, MvPolynomial.map_X] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 26a64b23ee..4785cf4573 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -217,7 +217,7 @@ theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L simp omit [IsIntegralClosure B A L] in -omit [IsIntegrallyClosed A] in +omit [IsIntegrallyClosed A] [IsDomain A] in theorem exists_base_multiplier_clearing_different_counts [IsDedekindDomain A] (hdiff : differentIdeal A B ≠ ⊥) @@ -274,7 +274,8 @@ theorem exists_base_multiplier_clearing_different_counts intro hcP have hone : (1 : A) ∈ p.asIdeal := by have hsub := p.asIdeal.sub_mem hcP hcp - convert hsub using 1 <;> ring + convert hsub using 1 + ring exact p.isPrime.ne_top ((Ideal.eq_top_iff_one p.asIdeal).mpr hone) have hc0 : c ≠ 0 := fun hcZero => hcnot (hcZero.symm ▸ p.asIdeal.zero_mem) refine ⟨c, hcnot, ?_⟩ @@ -336,6 +337,7 @@ theorem exists_base_multiplier_clearing_different_counts (A := A) (B := B) (L := L) q c 0 hc0 (by simp) omega +omit [IsDomain A] [IsIntegrallyClosed A] in theorem valuation_trace_le_one_of_different_count_bounds_over [IsDedekindDomain A] (p : HeightOneSpectrum A) {y : L} (hy : y ≠ 0) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean index 91fd60895f..82a2e61bde 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionDifferentCoefficient.lean @@ -131,8 +131,8 @@ private def idealMapMulEquiv {R T : Type*} [CommSemiring R] [CommSemiring T] (e : R ≃+* T) : Ideal R ≃* Ideal T where toFun I := I.map e invFun I := I.map e.symm - left_inv I := Ideal.map_of_equiv e - right_inv I := Ideal.map_of_equiv e.symm + left_inv _ := Ideal.map_of_equiv e + right_inv _ := Ideal.map_of_equiv e.symm map_mul' I J := Ideal.map_mul e I J private theorem finiteNormalization_multiplicity_map_eq @@ -633,12 +633,16 @@ private theorem different_ne_bot_of_fraction_fields [Algebra A L] [Algebra K L] [Algebra.IsSeparable K L] [IsScalarTower A K L] [Algebra A B] [IsScalarTower A B L] [Module.Finite A B] [Module.IsTorsionFree A B] : differentIdeal A B ≠ ⊥ := by - let : Algebra A (FractionRing A) := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra A + let : Algebra A (FractionRing A) := + exactConstantDifferentCoefficientCanonicalFractionRingAlgebra A let : SMul A (FractionRing A) := Algebra.toSMul - let : IsFractionRing A (FractionRing A) := exactConstantDifferentCoefficientCanonicalFractionRing A - let : Algebra B (FractionRing B) := exactConstantDifferentCoefficientCanonicalFractionRingAlgebra B + let : IsFractionRing A (FractionRing A) := + exactConstantDifferentCoefficientCanonicalFractionRing A + let : Algebra B (FractionRing B) := + exactConstantDifferentCoefficientCanonicalFractionRingAlgebra B let : SMul B (FractionRing B) := Algebra.toSMul - let : IsFractionRing B (FractionRing B) := exactConstantDifferentCoefficientCanonicalFractionRing B + let : IsFractionRing B (FractionRing B) := + exactConstantDifferentCoefficientCanonicalFractionRing B let : Algebra A (FractionRing B) := RingHom.toAlgebra ((algebraMap B (FractionRing B)).comp (algebraMap A B)) let : SMul A (FractionRing B) := Algebra.toSMul @@ -805,7 +809,7 @@ private theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq_f exact exactConstantExtensionPresentedFinitePlace_ramificationIdx_eq_one C S N hExact q rw [hRam] - simpa only [one_mul] + simp only [one_mul] private theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq_infinity @@ -957,7 +961,7 @@ private theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq_i exactConstantExtensionPresentedInfinityPlace_ramificationIdx_eq_one C S N hExact q rw [hRam] - simpa only [one_mul] + simp only [one_mul] /-- Exact constant extension preserves the total-different coefficient at @@ -1005,8 +1009,12 @@ theorem exactConstantExtension_presented_totalDifferentMultiplicity_eq (exactConstantExtensionPresentedDownstairsPlace C S N hExact q) := by cases q with - | inl q => exact exactConstantExtension_presented_totalDifferentMultiplicity_eq_finite C S N hExact q - | inr q => exact exactConstantExtension_presented_totalDifferentMultiplicity_eq_infinity C S N hExact q + | inl q => + exact exactConstantExtension_presented_totalDifferentMultiplicity_eq_finite + C S N hExact q + | inr q => + exact exactConstantExtension_presented_totalDifferentMultiplicity_eq_infinity + C S N hExact q /-- Exact finite extension of the full constant field preserves intrinsic function-field genus. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index f10985abd6..9af9a93e7f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -332,9 +332,9 @@ theorem exactConstantExtensionUpstairsFinitePlace_eq_compatibleNormalizationTran ((eNorm z : RatFuncFiniteIntegralClosure S E) : E) = ((finiteFieldConstantExtensionIntegralClosurePolynomialAlgEquiv C S N z : integralClosure S[X] E) : E) := by - simp [eNorm, exactConstantExtensionNormalizationAlgEquiv, + simp only [exactConstantExtensionNormalizationAlgEquiv, normalizationAlgEquivRatFuncFiniteOfAlgebraMap, - integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] + integralClosureAlgEquivRatFuncFiniteOfAlgebraMap, AlgEquiv.trans_apply, eNorm] rw [integralClosureAlgEquivRatFuncFiniteOfEq_coe] apply IsDedekindDomain.HeightOneSpectrum.ext have hActualIdeal : @@ -643,9 +643,9 @@ theorem exactConstantExtensionCompatibleBaseFinitePlace_under_original C S N z : integralClosure S[X] (ExactConstantExtension C N S)) : ExactConstantExtension C N S) := by - simp [eNorm, exactConstantExtensionNormalizationAlgEquiv, + simp only [exactConstantExtensionNormalizationAlgEquiv, normalizationAlgEquivRatFuncFiniteOfAlgebraMap, - integralClosureAlgEquivRatFuncFiniteOfAlgebraMap] + integralClosureAlgEquivRatFuncFiniteOfAlgebraMap, AlgEquiv.trans_apply, eNorm] rw [integralClosureAlgEquivRatFuncFiniteOfEq_coe] have hNormalizationMapsAgree (z : S ⊗[C] integralClosure C[X] N) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean index 55b5876454..8274e5b0e8 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean @@ -124,31 +124,31 @@ theorem frobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRationalPlaceCou frobeniusTwistFieldRationalPlaceCount C S N hExact g = finiteExtensionRationalPlaceCount C F := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Finite (FiniteExtensionRationalFinitePlace C F) := inferInstance - letI : Finite (FiniteExtensionRationalInfinityPlace C F) := inferInstance + let : Finite (FiniteExtensionRationalFinitePlace C F) := inferInstance + let : Finite (FiniteExtensionRationalInfinityPlace C F) := inferInstance unfold frobeniusTwistFieldRationalPlaceCount rw [frobeniusTwistFieldRationalFinitePlaceCount, frobeniusTwistFieldRationalInfinityPlaceCount] @@ -170,28 +170,28 @@ theorem frobeniusTwistFieldRationalInfinityPlaceCount_le_original_finrank frobeniusTwistFieldRationalInfinityPlaceCount C S N hExact g ≤ Module.finrank (RatFunc C) N := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction - letI : FiniteDimensional (RatFunc C) T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : FiniteDimensional (RatFunc C) T := finiteDimensional_exactConstantExtension_over_baseRatFunc C S N hExact - letI : IsGalois (RatFunc C) T := + let : IsGalois (RatFunc C) T := exactConstantExtension_isGalois C (RatFunc C) N S hExact - letI : Algebra.IsSeparable (RatFunc C) T := + let : Algebra.IsSeparable (RatFunc C) T := isSeparable_exactConstantExtension_over_baseRatFunc C S N hExact let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g change Nat.card (FiniteExtensionRationalInfinityPlace C F) ≤ Module.finrank (RatFunc C) N diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean index 22398d301d..62bf1d5520 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistStepanovUpper.lean @@ -99,13 +99,13 @@ theorem exists_uniform_frobeniusTwistField_squareFieldStepanov_budget Fintype.card C + (2 * budget + 1) * Fintype.card K + Module.finrank (RatFunc C) N := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction obtain ⟨budget, hbudget⟩ := exists_common_frobeniusTwistField_exactConstants_and_riemann_budget C N S hExact @@ -114,17 +114,17 @@ theorem exists_uniform_frobeniusTwistField_squareFieldStepanov_budget dsimp only let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + let : Algebra C F := Algebra.restrictScalars C (RatFunc C) F intro hlarge have hstepanov := finiteExtensionRationalPlaceCount_le_squareFieldStepanov_of_finitePlaceRiemann @@ -159,30 +159,30 @@ theorem frobeniusTwistFieldRationalPlaceCount_le_squareField_of_genus Fintype.card C + (2 * FunctionField.genus C N + 1) * Fintype.card K + Module.finrank (RatFunc C) N := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : DistribMulAction (RatFunc C) T := Module.toDistribMulAction - letI : MulAction (RatFunc C) T := DistribMulAction.toMulAction + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : DistribMulAction (RatFunc C) T := Module.toDistribMulAction + let : MulAction (RatFunc C) T := DistribMulAction.toMulAction let F := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact g - letI : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : Algebra (RatFunc C) F := SubalgebraClass.toAlgebra F.toSubalgebra + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact g - letI : Algebra C F := Algebra.restrictScalars C (RatFunc C) F - letI : IsScalarTower C (RatFunc C) F := + let : Algebra C F := Algebra.restrictScalars C (RatFunc C) F + let : IsScalarTower C (RatFunc C) F := IsScalarTower.of_algebraMap_eq' rfl have hExactF : algebraicClosure C F = (⊥ : IntermediateField C F) := exactConstantExtensionFrobeniusTwistField_algebraicClosure_eq_bot C (RatFunc C) N S hExact g - letI : FunctionField.IsFullConstantField C F := + let : FunctionField.IsFullConstantField C F := (FunctionField.isFullConstantField_iff_algebraicClosure_eq_bot C F).2 hExactF have hgenus : FunctionField.genus C F = FunctionField.genus C N := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 6fbf66ced3..0332623d41 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -896,7 +896,8 @@ theorem exactConstantExtensionFinitePlace_degree_eq_finrank_of_under_intermediat /-- Presentation-free local Frobenius-coset identity over a rational finite place of the intermediate field `L`. -/ -theorem exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under_intermediate_rational +theorem + exactConstantExtensionFinitePlace_frobeniusFiber_fixedPoint_sum_of_under_intermediate_rational (hDegreeDiv : Module.finrank L N ∣ Module.finrank C S) : letI : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean index 7c3cb1fd47..19cab8ad13 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean @@ -76,14 +76,14 @@ private theorem intermediateHasseRatFuncBaseTower : letI : Module L (ExactConstantExtension C N S) := Algebra.toModule IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by let T := ExactConstantExtension C N S - letI : Algebra (RatFunc C) T := + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule apply IsScalarTower.of_algebraMap_eq' ext x change (1 : S) ⊗ₜ algebraMap (RatFunc C) N x = @@ -99,41 +99,41 @@ theorem intermediateFrobeniusTwistFieldRationalPlaceCount_eq_rationalBase frobeniusTwistFieldRationalPlaceCount C S N hExact (g.restrictScalars (RatFunc C)) := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := intermediateHasseRatFuncBaseTower C S N L let Fₗ := exactConstantExtensionFrobeniusTwistField C L N S hExact g let Fᵣ := exactConstantExtensionFrobeniusTwistField C (RatFunc C) N S hExact (g.restrictScalars (RatFunc C)) - letI : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra - letI : SMul L Fₗ := Algebra.toSMul - letI : Module L Fₗ := Algebra.toModule - letI : Algebra (RatFunc C) Fₗ := + let : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra + let : SMul L Fₗ := Algebra.toSMul + let : Module L Fₗ := Algebra.toModule + let : Algebra (RatFunc C) Fₗ := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul (RatFunc C) Fₗ := Algebra.toSMul - letI : Module (RatFunc C) Fₗ := Algebra.toModule - letI : FiniteDimensional (RatFunc C) Fₗ := + let : SMul (RatFunc C) Fₗ := Algebra.toSMul + let : Module (RatFunc C) Fₗ := Algebra.toModule + let : FiniteDimensional (RatFunc C) Fₗ := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) Fₗ := + let : Algebra.IsSeparable (RatFunc C) Fₗ := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra (RatFunc C) Fᵣ := SubalgebraClass.toAlgebra Fᵣ.toSubalgebra - letI : SMul (RatFunc C) Fᵣ := Algebra.toSMul - letI : Module (RatFunc C) Fᵣ := Algebra.toModule + let : Algebra (RatFunc C) Fᵣ := SubalgebraClass.toAlgebra Fᵣ.toSubalgebra + let : SMul (RatFunc C) Fᵣ := Algebra.toSMul + let : Module (RatFunc C) Fᵣ := Algebra.toModule let e := intermediateFrobeniusTwistField_algEquiv_rationalBaseFrobeniusTwistField C S N hExact L g - letI : FiniteDimensional (RatFunc C) Fᵣ := + let : FiniteDimensional (RatFunc C) Fᵣ := Module.Finite.equiv (e.toLinearEquiv : Fₗ ≃ₗ[RatFunc C] Fᵣ) - letI : Algebra.IsSeparable (RatFunc C) Fᵣ := + let : Algebra.IsSeparable (RatFunc C) Fᵣ := isSeparable_frobeniusTwistField_over_ratFunc C N S hExact (g.restrictScalars (RatFunc C)) calc @@ -166,7 +166,7 @@ theorem abs_intermediateBaseRationalPlaceError_le_squareField_of_genus_exact (Nat.card (N ≃ₐ[RatFunc C] N) - 1 : ℕ) * (((2 * FunctionField.genus C N + 1) * Fintype.card K + Module.finrank (RatFunc C) N : ℕ) : ℝ)) := by - letI : DecidableEq (N ≃ₐ[L] N) := Classical.decEq _ + let : DecidableEq (N ≃ₐ[L] N) := Classical.decEq _ let A : ℝ := 2 * (Module.finrank (RatFunc C) N : ℝ) ^ 2 let B : ℝ := (Nat.card (N ≃ₐ[RatFunc C] N) : ℝ) * diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean index be7d0335a1..94464e7875 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean @@ -83,14 +83,14 @@ private theorem intermediateRationalAverageRatFuncBaseTower : letI : Module L (ExactConstantExtension C N S) := Algebra.toModule IsScalarTower (RatFunc C) L (ExactConstantExtension C N S) := by let T := ExactConstantExtension C N S - letI : Algebra (RatFunc C) T := + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : Algebra N T := exactConstantExtensionAlgebra C N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : Algebra N T := exactConstantExtensionAlgebra C N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule apply IsScalarTower.of_algebraMap_eq' ext x change (1 : S) ⊗ₜ algebraMap (RatFunc C) N x = @@ -148,22 +148,22 @@ theorem intermediateFrobeniusTwistFieldRationalPlaceCount_eq_finiteExtensionRati intermediateFrobeniusTwistFieldRationalPlaceCount C S N hExact L g = finiteExtensionRationalPlaceCount C F := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S let F := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra - letI : Algebra (RatFunc C) F := + let : Algebra L F := SubalgebraClass.toAlgebra F.toSubalgebra + let : Algebra (RatFunc C) F := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul (RatFunc C) F := Algebra.toSMul - letI : Module (RatFunc C) F := Algebra.toModule - letI : FiniteDimensional (RatFunc C) F := + let : SMul (RatFunc C) F := Algebra.toSMul + let : Module (RatFunc C) F := Algebra.toModule + let : FiniteDimensional (RatFunc C) F := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) F := + let : Algebra.IsSeparable (RatFunc C) F := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Finite (FiniteExtensionRationalFinitePlace C F) := inferInstance - letI : Finite (FiniteExtensionRationalInfinityPlace C F) := inferInstance + let : Finite (FiniteExtensionRationalFinitePlace C F) := inferInstance + let : Finite (FiniteExtensionRationalInfinityPlace C F) := inferInstance unfold intermediateFrobeniusTwistFieldRationalPlaceCount rw [intermediateFrobeniusTwistFieldRationalFinitePlaceCount, intermediateFrobeniusTwistFieldRationalInfinityPlaceCount] @@ -181,33 +181,33 @@ theorem intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le_original_fi intermediateFrobeniusTwistFieldRationalInfinityPlaceCount C S N hExact L g ≤ Module.finrank (RatFunc C) N := by let T := ExactConstantExtension C N S - letI : Field T := exactConstantExtensionField C N S hExact - letI : Algebra (RatFunc C) T := + let : Field T := exactConstantExtensionField C N S hExact + let : Algebra (RatFunc C) T := exactConstantExtensionBaseAlgebra C (RatFunc C) N S - letI : SMul (RatFunc C) T := Algebra.toSMul - letI : Module (RatFunc C) T := Algebra.toModule - letI : Algebra L T := exactConstantExtensionBaseAlgebra C L N S - letI : SMul L T := Algebra.toSMul - letI : Module L T := Algebra.toModule - letI : IsScalarTower (RatFunc C) L T := + let : SMul (RatFunc C) T := Algebra.toSMul + let : Module (RatFunc C) T := Algebra.toModule + let : Algebra L T := exactConstantExtensionBaseAlgebra C L N S + let : SMul L T := Algebra.toSMul + let : Module L T := Algebra.toModule + let : IsScalarTower (RatFunc C) L T := intermediateRationalAverageRatFuncBaseTower C S N L let Fₗ := exactConstantExtensionFrobeniusTwistField C L N S hExact g - letI : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra - letI : SMul L Fₗ := Algebra.toSMul - letI : Module L Fₗ := Algebra.toModule - letI : Algebra (RatFunc C) Fₗ := + let : Algebra L Fₗ := SubalgebraClass.toAlgebra Fₗ.toSubalgebra + let : SMul L Fₗ := Algebra.toSMul + let : Module L Fₗ := Algebra.toModule + let : Algebra (RatFunc C) Fₗ := intermediateFrobeniusTwistFieldRatFuncAlgebra C S N hExact L g - letI : SMul (RatFunc C) Fₗ := Algebra.toSMul - letI : Module (RatFunc C) Fₗ := Algebra.toModule - letI : FiniteDimensional (RatFunc C) Fₗ := + let : SMul (RatFunc C) Fₗ := Algebra.toSMul + let : Module (RatFunc C) Fₗ := Algebra.toModule + let : FiniteDimensional (RatFunc C) Fₗ := finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : Algebra.IsSeparable (RatFunc C) Fₗ := + let : Algebra.IsSeparable (RatFunc C) Fₗ := isSeparable_intermediateFrobeniusTwistField_over_ratFunc C S N hExact L g - letI : IsScalarTower (RatFunc C) L Fₗ := + let : IsScalarTower (RatFunc C) L Fₗ := IsScalarTower.of_algebraMap_eq' rfl - letI : Module.Finite L Fₗ := + let : Module.Finite L Fₗ := Module.Finite.of_restrictScalars_finite (RatFunc C) L Fₗ change Nat.card (FiniteExtensionRationalInfinityPlace C Fₗ) ≤ _ calc diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean index 3c498a2969..2ae1198df4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -1003,7 +1003,8 @@ theorem exactConstantExtensionClosedPlaceExtensionCount K C F hExact (Module.finrank C S) := by intro N model1 C model3 model4 model5 M model7 model8 hExactM E_M - model11 model12 model13 model14 model15 model16 model17 model18 model19 model20 model21 model22 model23 + model11 model12 model13 model14 model15 model16 model17 model18 model19 + model20 model21 model22 model23 classical let : Module (RatFunc C) M := model7.toModule let : FiniteDimensional (RatFunc C) M := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean index 2f2fc6902f..38bbf5708b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDegree.lean @@ -152,11 +152,13 @@ theorem finiteExtensionAffineIdeal_cardQuot_eq_card_pow_degree ← Nat.card_eq_fintype_card] exact Module.natCard_eq_pow_finrank +omit [Fintype K] in /-- An affine ideal has degree zero exactly when it is the unit ideal. -/ -theorem finiteExtensionAffineIdealDegree_eq_zero_iff +theorem finiteExtensionAffineIdealDegree_eq_zero_iff [Finite K] (I : FiniteExtensionAffineIdeal K L) : finiteExtensionAffineIdealDegree K L I = 0 ↔ (I : Ideal (RatFuncFiniteIntegralClosure K L)) = ⊤ := by + let : Fintype K := Fintype.ofFinite K constructor · intro hdegree apply Submodule.cardQuot_eq_one_iff.mp @@ -177,11 +179,13 @@ theorem finiteExtensionAffineIdealDegree_eq_zero_iff rw [finiteExtensionAffineIdealDegree, hI] exact Module.finrank_zero_of_subsingleton +omit [Fintype K] in /-- There are only finitely many nonzero affine ideals of any prescribed degree. -/ -theorem finite_setOf_finiteExtensionAffineIdealDegree_eq (n : ℕ) : +theorem finite_setOf_finiteExtensionAffineIdealDegree_eq [Finite K] (n : ℕ) : {I : FiniteExtensionAffineIdeal K L | finiteExtensionAffineIdealDegree K L I = n}.Finite := by + let : Fintype K := Fintype.ofFinite K let : Ring.HasFiniteQuotients (RatFuncFiniteIntegralClosure K L) := ratFuncFiniteIntegralClosure_hasFiniteQuotients K L apply Set.Finite.of_injOn diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean index 0309f8dacc..b905e27188 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionAffineIdealDivisor.lean @@ -392,13 +392,16 @@ theorem finiteExtensionAffineIdealEffectiveDivisorEquiv_symm_coe effectiveDivisorIdeal D := by simp [finiteExtensionAffineIdealEffectiveDivisorEquiv] +omit [Fintype K] in /-- The affine ideal degree of the ideal represented by an effective finite divisor is its residue-degree-weighted divisor degree. -/ -theorem finiteExtensionAffineIdealDegree_equiv_symm +theorem finiteExtensionAffineIdealDegree_equiv_symm [Finite K] (D : FiniteExtensionFinitePlace K L →₀ ℕ) : finiteExtensionAffineIdealDegree K L ((finiteExtensionAffineIdealEffectiveDivisorEquiv K L).symm D) = finiteExtensionEffectiveFiniteDivisorDegree K L D := by + classical + let : Fintype K := Fintype.ofFinite K apply Nat.pow_right_injective (by simpa [Nat.succ_le_iff] using Fintype.one_lt_card (α := K)) calc @@ -415,9 +418,10 @@ theorem finiteExtensionAffineIdealDegree_equiv_symm finiteExtensionEffectiveFiniteDivisorDegree K L D := effectiveDivisorIdeal_cardQuot_eq_card_pow_degree K L D +omit [Fintype K] in /-- The degree of a nonzero affine ideal is the residue-degree-weighted sum of its finite-place prime multiplicities. -/ -theorem finiteExtensionAffineIdealDegree_eq_divisorDegree +theorem finiteExtensionAffineIdealDegree_eq_divisorDegree [Finite K] (I : FiniteExtensionAffineIdeal K L) : finiteExtensionAffineIdealDegree K L I = finiteExtensionEffectiveFiniteDivisorDegree K L @@ -425,8 +429,9 @@ theorem finiteExtensionAffineIdealDegree_eq_divisorDegree simpa using finiteExtensionAffineIdealDegree_equiv_symm K L (finiteExtensionAffineIdealEffectiveDivisorEquiv K L I) +omit [Fintype K] in /-- Expanded pointwise form of the affine ideal degree formula. -/ -theorem finiteExtensionAffineIdealDegree_eq_sum_multiplicity_mul_residueDegree +theorem finiteExtensionAffineIdealDegree_eq_sum_multiplicity_mul_residueDegree [Finite K] (I : FiniteExtensionAffineIdeal K L) : finiteExtensionAffineIdealDegree K L I = (finiteExtensionAffineIdealEffectiveDivisorEquiv K L I).sum diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean index f5ecd939b2..f20704498b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean @@ -427,7 +427,7 @@ theorem finiteExtensionUnderPlace_finite_preimage_singleton simpa only [Set.mem_preimage, Set.mem_singleton_iff, finiteExtensionUnderPlace, Sum.inl.injEq] using hq · simp only [Set.mem_preimage, Set.mem_singleton_iff, - finiteExtensionUnderPlace, Sum.inr.injEq, reduceCtorEq] at hq + finiteExtensionUnderPlace, reduceCtorEq] at hq · let : Finite (FiniteExtensionInfinityPlace K L) := Set.finite_coe_iff.mpr (IsDedekindDomain.primesOver_finite @@ -438,7 +438,7 @@ theorem finiteExtensionUnderPlace_finite_preimage_singleton intro q hq rcases q with q | q · simp only [Set.mem_preimage, Set.mem_singleton_iff, - finiteExtensionUnderPlace, Sum.inl.injEq, reduceCtorEq] at hq + finiteExtensionUnderPlace, reduceCtorEq] at hq · exact Set.mem_range_self q omit [Fintype K] [DecidableEq K] in diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean index 4cf4424053..e79426591e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean @@ -100,6 +100,7 @@ def finiteExtensionDivisorClassDegree : (finiteExtensionDivisorDegreeHom K L) (by exact finiteExtensionPrincipalDivisorSubgroup_le_degreeKernel K L) +omit [Fintype K] in @[simp] theorem finiteExtensionDivisorClassDegree_mk (D : FiniteExtensionDivisor K L) : @@ -107,6 +108,7 @@ theorem finiteExtensionDivisorClassDegree_mk (finiteExtensionDivisorClassMap K L D) = finiteExtensionDivisorDegree K L D := by + classical rfl /-- Divisor classes of a prescribed integer degree. -/ @@ -127,10 +129,12 @@ theorem finiteExtensionDivisorClassMap_representative (finiteExtensionDivisorClassRepresentative K L c) = c := Quotient.out_eq c +omit [Fintype K] in theorem finiteExtensionDivisorClassRepresentative_degree {n : ℤ} (c : FiniteExtensionDivisorClassOfDegree K L n) : finiteExtensionDivisorDegree K L (finiteExtensionDivisorClassRepresentative K L c.1) = n := by + classical calc finiteExtensionDivisorDegree K L (finiteExtensionDivisorClassRepresentative K L c.1) = @@ -178,11 +182,13 @@ abbrev FiniteExtensionEffectiveDivisorClassFiber (n : ℕ) finiteExtensionEffectiveDivisorDegree K L D = n} // finiteExtensionEffectiveDivisorClassOfDegree K L n D = c} +omit [Fintype K] [DecidableEq K] in private theorem finiteExtensionEffectiveDivisorToDivisor_of_symm (D : {D : FiniteExtensionDivisor K L // ∀ P, 0 ≤ D P}) : finiteExtensionEffectiveDivisorToDivisor K L ((finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).symm D) = D.1 := by + classical exact congrArg Subtype.val ((finiteExtensionEffectiveDivisorEquivEffectiveIntegralDivisor K L).apply_symm_apply D) @@ -400,25 +406,28 @@ theorem finiteExtensionDivisorIndexRepresentative_degree : (finiteExtensionDivisorDegreeIndex K L : ℤ) := Classical.choose_spec (exists_finiteExtensionDivisor_degree_eq_index K L) +omit [Fintype K] in /-- Translation by the signed index representative preserves the number of classes when the degree is advanced by the index. -/ theorem finiteExtensionDivisorClassOfDegree_natCard_add_index (n : ℕ) : Nat.card (FiniteExtensionDivisorClassOfDegree K L (n : ℤ)) = Nat.card (FiniteExtensionDivisorClassOfDegree K L ((n + finiteExtensionDivisorDegreeIndex K L : ℕ) : ℤ)) := by + classical let e := finiteExtensionDivisorClassOfDegreeTranslateEquiv K L (finiteExtensionDivisorIndexRepresentative K L) (n : ℤ) (finiteExtensionDivisorDegreeIndex K L : ℤ) (finiteExtensionDivisorIndexRepresentative_degree K L) have h := Nat.card_congr e - convert h using 1 <;> norm_num + convert h using 1 + norm_num private theorem geomSum_add (q a b : ℕ) : (∑ i ∈ Finset.range (a + b), q ^ i) = (∑ i ∈ Finset.range a, q ^ i) + q ^ a * ∑ i ∈ Finset.range b, q ^ i := by rw [Finset.sum_range_add, Finset.mul_sum] - apply congrArg₂ (.+.) rfl + apply congrArg₂ (· + ·) rfl apply Finset.sum_congr rfl intro i _ rw [pow_add] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean index a2cfe9d607..3972188ca9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseBoundFromEvenConstantExtensions.lean @@ -122,7 +122,7 @@ theorem finiteExtensionClosedPlaceEvenError_isBigO_of_exactConstantExtension_bou (finiteExtensionClosedPlaceExtensionCount C N (2 * n) : ℂ) - (Nat.card C : ℂ) ^ (2 * n) - 1) =O[atTop] fun n : ℕ ↦ (Nat.card C : ℝ) ^ n := by - apply evenExtensionError_isBigO_of_pointwise_bound + apply evenExtensionError_isBigO_of_pointwise_bound (A := A) intro n hn let : NeZero (2 * n) := ⟨by omega⟩ let S := FiniteField.Extension C p (2 * n) @@ -198,7 +198,7 @@ theorem exists_finiteExtensionClosedPlaceZeta_trace_with_degree_budget_of_exactConstants C N budget hExact hgenus have hbound := - abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_divisibleEvenError_isBigO + abs_pointCount_sub_card_sub_one_le_of_formalPointCountZeta_rational_and_divisibleEvenError_isBigO (Nat.card C) δ (finiteExtensionClosedPlaceExtensionCount C N) P Nat.card_pos hδ hPzero hPrational herror calc diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean index 5cb42dadcf..b3a7d7edc0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean @@ -161,95 +161,82 @@ theorem functionFieldNormalClosureStepanovThreshold_pos : unfold functionFieldNormalClosureStepanovThreshold positivity -/-- The normal-closure constant field gives a uniform square-root-scale bound -for the packaged exact constant extensions of the original function field. - -Here `H = (g + 1)(g + 2)` is the Stepanov threshold for the genus `g` of the -geometric normal closure, while `D` is its degree over the rational function -field of its full constant field. -/ -theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants - (hExact : algebraicClosure K F = - (⊥ : IntermediateField K F)) : - ∀ n, 0 < n → - |(exactConstantExtensionClosedPlaceExtensionCount - K (FunctionFieldNormalClosureConstantField K F) F hExact - (2 * functionFieldNormalClosureStepanovThreshold K F * n) : ℝ) - - (Nat.card (FunctionFieldNormalClosureConstantField K F) : ℝ) ^ - (2 * functionFieldNormalClosureStepanovThreshold K F * n) - 1| ≤ - 2 * (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 2 + - 2 * (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 3 + - (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 2 * - (2 * functionFieldNormalClosureGenus K F + 1) * - (Nat.card (FunctionFieldNormalClosureConstantField K F) : ℝ) ^ - (functionFieldNormalClosureStepanovThreshold K F * n) := by +section GenericGaloisTowerBound + +variable (C M N : Type*) [Field C] [Fintype C] [DecidableEq C] + [DecidableEq (RatFunc C)] [Field M] [Field N] + [Algebra (RatFunc C) M] [Algebra (RatFunc C) N] + [Algebra M N] [IsScalarTower (RatFunc C) M N] + [FiniteDimensional (RatFunc C) M] [FiniteDimensional (RatFunc C) N] + [FiniteDimensional M N] + [IsGalois (RatFunc C) N] [IsGalois M N] + [Algebra.IsSeparable (RatFunc C) M] + +/-- Restrict the intermediate rational-function-field algebra to the constants. -/ +local instance genericGaloisTowerConstantAlgebraM : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + +/-- Restrict the top rational-function-field algebra to the constants. -/ +local instance genericGaloisTowerConstantAlgebraN : Algebra C N := + exactConstantExtensionTowerCanonicalConstantAlgebra C N + +private local instance genericGaloisTowerConstantTower : IsScalarTower C M N := + exactConstantExtensionTowerCanonicalConstantScalarTower C M N + +private local instance genericGaloisTowerRationalConstantTowerM : + IsScalarTower C (RatFunc C) M := IsScalarTower.of_algebraMap_eq' rfl + +private local instance genericGaloisTowerRationalConstantTowerN : + IsScalarTower C (RatFunc C) N := IsScalarTower.of_algebraMap_eq' rfl + +private local instance genericGaloisTowerTopSeparable : Algebra.IsSeparable (RatFunc C) N := + (isGalois_iff.mp (inferInstance : IsGalois (RatFunc C) N)).1 + +omit [DecidableEq C] [DecidableEq (RatFunc C)] in +/-- A finite Galois function-field tower over exact finite constants satisfies the +square-field error bound after a sufficiently divisible even constant extension. -/ +private theorem exactConstantExtensionClosedPlaceError_le_galoisTowerConstants + (hExactM : algebraicClosure C M = (⊥ : IntermediateField C M)) + (hExactN : algebraicClosure C N = (⊥ : IntermediateField C N)) + (n : ℕ) (hn : 0 < n) : + let g := FunctionField.genus C N + let H := (g + 1) * (g + 2) + let D := Module.finrank (RatFunc C) N + let p := ringChar C + let : CharP C p := ringChar.charP C + let : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ + let : NeZero (2 * (H * n)) := ⟨by positivity⟩ + let Cbig := FiniteField.Extension C p (2 * (H * n)) + let : Fintype Cbig := Fintype.ofFinite Cbig + |(exactConstantExtensionClosedPlaceExtensionCount C Cbig M hExactM 1 : ℝ) - + (Nat.card C : ℝ) ^ (2 * H * n) - 1| ≤ + 2 * (D : ℝ) ^ 2 + 2 * (D : ℝ) ^ 3 + + (D : ℝ) ^ 2 * (2 * g + 1) * (Nat.card C : ℝ) ^ (H * n) := by classical - intro n hn - let C := FunctionFieldNormalClosureConstantField K F - letI : Fintype C := - finiteExtensionHasseNormalClosureConstantFintype K F - letI : DecidableEq C := - finiteExtensionHasseNormalClosureConstantDecidableEq K F - letI : DecidableEq (RatFunc C) := - finiteExtensionHasseNormalClosureRatFuncDecidableEq K F - let N := FunctionFieldNormalClosure K F - let M := FunctionFieldNormalClosureOriginalCompositum K F hExact - letI : Algebra (RatFunc C) M := - functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra - K F hExact - letI : SMul (RatFunc C) M := Algebra.toSMul - letI : Module (RatFunc C) M := Algebra.toModule - letI : Algebra C M := - exactConstantExtensionTowerCanonicalConstantAlgebra C M - letI : IsScalarTower (RatFunc C) M N := - functionFieldNormalClosureOriginalCompositumConstantRatFuncTower - K F hExact - letI : FiniteDimensional (RatFunc C) M := - functionFieldNormalClosureOriginalCompositum_finiteDimensional_over_constantRatFunc - K F hExact - letI : FiniteDimensional M N := - functionFieldNormalClosure_finiteDimensional_over_originalCompositum - K F hExact - letI : IsGalois M N := - functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact - letI : Algebra.IsSeparable (RatFunc C) M := - functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc - K F hExact - letI : IsGalois (RatFunc C) N := - functionFieldNormalClosure_isGalois_over_constantRatFunc K F - letI : Algebra.IsSeparable (RatFunc C) N := - Algebra.IsSeparable.trans (RatFunc C) M N - let g := functionFieldNormalClosureGenus K F - let H := functionFieldNormalClosureStepanovThreshold K F - let D := functionFieldNormalClosureRatFuncDegree K F - have hH : 0 < H := functionFieldNormalClosureStepanovThreshold_pos K F - have hD : 0 < D := functionFieldNormalClosureRatFuncDegree_pos K F - let p := ringChar C - let : CharP C p := ringChar.charP C - letI : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ - letI : NeZero (H * n) := ⟨Nat.mul_pos hH hn |>.ne'⟩ - letI : NeZero (2 * (H * n)) := ⟨by positivity⟩ + intro g H D p charP primeP neBig Cbig fintypeBig + have hH : 0 < H := by positivity + have hD : 0 < D := Module.finrank_pos + let : NeZero (H * n) := ⟨Nat.mul_pos hH hn |>.ne'⟩ let Ksmall := FiniteField.Extension C p (H * n) - let Cbig := FiniteField.Extension C p (2 * (H * n)) - letI : Fintype Ksmall := Fintype.ofFinite Ksmall - letI : Fintype Cbig := Fintype.ofFinite Cbig - letI : DecidableEq Cbig := Classical.decEq Cbig - letI : DecidableEq (RatFunc Cbig) := Classical.decEq (RatFunc Cbig) - letI : Algebra C Ksmall := + let : Fintype Ksmall := Fintype.ofFinite Ksmall + let : DecidableEq Cbig := Classical.decEq Cbig + let : DecidableEq (RatFunc Cbig) := Classical.decEq (RatFunc Cbig) + let : Algebra C Ksmall := FiniteField.instAlgebraExtension C p (H * n) - letI : Algebra C Cbig := + let : Algebra C Cbig := FiniteField.instAlgebraExtension C p (2 * (H * n)) - letI : SMul C Ksmall := Algebra.toSMul - letI : Module C Ksmall := Algebra.toModule - letI : SMul C Cbig := Algebra.toSMul - letI : Module C Cbig := Algebra.toModule - letI : CharP Cbig p := + let : SMul C Ksmall := Algebra.toSMul + let : Module C Ksmall := Algebra.toModule + let : SMul C Cbig := Algebra.toSMul + let : Module C Cbig := Algebra.toModule + let : CharP Cbig p := charP_of_injective_algebraMap (algebraMap C Cbig).injective p - letI : Algebra Ksmall Cbig := + let : Algebra Ksmall Cbig := finiteFieldExtensionAlgebraOfDvd C p (H * n) (2 * (H * n)) ⟨2, by omega⟩ - letI : SMul Ksmall Cbig := Algebra.toSMul - letI : Module Ksmall Cbig := Algebra.toModule - letI : IsScalarTower C Ksmall Cbig := + let : SMul Ksmall Cbig := Algebra.toSMul + let : Module Ksmall Cbig := Algebra.toModule + let : IsScalarTower C Ksmall Cbig := finiteFieldExtension_isScalarTower_of_dvd C p (H * n) (2 * (H * n)) ⟨2, by omega⟩ have hcard : Fintype.card Cbig = Fintype.card Ksmall ^ 2 := by @@ -258,62 +245,50 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants have hlargeBase : H ≤ Fintype.card Ksmall := by simpa only [Fintype.card_eq_nat_card] using degree_le_natCard_finiteFieldExtension_mul C p H n hn - have hExactN : algebraicClosure C N = - (⊥ : IntermediateField C N) := - functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F - have hExactM : algebraicClosure C M = - (⊥ : IntermediateField C M) := - functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc - K F hExact let E_N := ExactConstantExtension C N Cbig let E_M := ExactConstantExtension C M Cbig - letI : Field E_N := - functionFieldNormalClosureConstantExtensionFieldForTower K F Cbig - letI : Field E_M := - functionFieldNormalClosureOriginalCompositumConstantExtensionField - K F Cbig hExact - letI : Algebra (RatFunc Cbig) E_N := - functionFieldNormalClosureConstantExtensionRatFuncAlgebraForTower - K F Cbig - letI : Algebra (RatFunc Cbig) E_M := - functionFieldNormalClosureOriginalCompositumConstantExtensionRatFuncAlgebra - K F Cbig hExact - letI : Module (RatFunc Cbig) E_N := Algebra.toModule - letI : Module (RatFunc Cbig) E_M := Algebra.toModule - letI : FiniteDimensional (RatFunc Cbig) E_N := + let : Field E_N := + exactConstantExtensionField C N Cbig hExactN + let : Field E_M := + exactConstantExtensionField C M Cbig hExactM + let : Algebra (RatFunc Cbig) E_N := + ratFuncExactConstantExtensionAlgebra C Cbig N hExactN + let : Algebra (RatFunc Cbig) E_M := + ratFuncExactConstantExtensionAlgebra C Cbig M hExactM + let : Module (RatFunc Cbig) E_N := Algebra.toModule + let : Module (RatFunc Cbig) E_M := Algebra.toModule + let : FiniteDimensional (RatFunc Cbig) E_N := finiteDimensional_over_extendedRatFunc C Cbig N hExactN - letI : FiniteDimensional (RatFunc Cbig) E_M := + let : FiniteDimensional (RatFunc Cbig) E_M := finiteDimensional_over_extendedRatFunc C Cbig M hExactM - letI : Algebra.IsSeparable (RatFunc Cbig) E_N := + let : Algebra.IsSeparable (RatFunc Cbig) E_N := isSeparable_over_extendedRatFunc C Cbig N hExactN - letI : Algebra.IsSeparable (RatFunc Cbig) E_M := + let : Algebra.IsSeparable (RatFunc Cbig) E_M := isSeparable_over_extendedRatFunc C Cbig M hExactM - letI : Algebra E_M E_N := - functionFieldNormalClosureConstantExtensionTowerAlgebra K F Cbig hExact - letI : SMul (RatFunc Cbig) E_M := Algebra.toSMul - letI : SMul (RatFunc Cbig) E_N := Algebra.toSMul - letI : SMul E_M E_N := Algebra.toSMul - letI : Module E_M E_N := Algebra.toModule - letI : IsScalarTower (RatFunc Cbig) E_M E_N := - functionFieldNormalClosureConstantExtension_ratFuncScalarTower - K F Cbig hExact - letI : Module.Finite E_M E_N := - functionFieldNormalClosureConstantExtension_finiteDimensional - K F Cbig hExact - letI : IsGalois E_M E_N := - functionFieldNormalClosureConstantExtension_isGalois K F Cbig hExact - letI : Algebra (RatFunc C) (RatFunc Cbig) := + let : Algebra E_M E_N := + exactConstantExtensionTowerRatFuncAlgebra C M N Cbig + let : SMul (RatFunc Cbig) E_M := Algebra.toSMul + let : SMul (RatFunc Cbig) E_N := Algebra.toSMul + let : SMul E_M E_N := Algebra.toSMul + let : Module E_M E_N := Algebra.toModule + let : IsScalarTower (RatFunc Cbig) E_M E_N := + exactConstantExtensionTower_ratFuncScalarTower C M N Cbig hExactN + let : Module.Finite E_M E_N := + exactConstantExtensionTower_finiteDimensional C M N Cbig hExactN + let : IsGalois E_M E_N := + exactConstantExtensionTower_isGalois C M N Cbig hExactN + let : Algebra (RatFunc C) (RatFunc Cbig) := ratFuncCoefficientAlgebra C Cbig - letI : Algebra (RatFunc C) E_N := + let : Algebra (RatFunc C) E_N := exactConstantExtensionBaseAlgebra C (RatFunc C) N Cbig - letI : SMul (RatFunc C) (RatFunc Cbig) := Algebra.toSMul - letI : SMul (RatFunc C) E_N := Algebra.toSMul - letI : Module (RatFunc C) E_N := Algebra.toModule - letI : IsScalarTower (RatFunc C) (RatFunc Cbig) E_N := + let : SMul (RatFunc C) (RatFunc Cbig) := Algebra.toSMul + let : SMul (RatFunc C) E_N := Algebra.toSMul + let : Module (RatFunc C) E_N := Algebra.toModule + let : IsScalarTower (RatFunc C) (RatFunc Cbig) E_N := rationalBase_scalarTower C Cbig N hExactN - letI : IsGalois (RatFunc C) E_N := + let : IsGalois (RatFunc C) E_N := exactConstantExtension_isGalois C (RatFunc C) N Cbig hExactN - letI : IsGalois (RatFunc Cbig) E_N := + let : IsGalois (RatFunc Cbig) E_N := IsGalois.tower_top_of_isGalois (RatFunc C) (RatFunc Cbig) E_N have hExactEN : @algebraicClosure Cbig E_N _ _ (bridgeBaseConstantAlgebra Cbig E_N) = @@ -324,7 +299,7 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants have hgenusEN : @FunctionField.genus Cbig E_N _ _ (bridgeBaseConstantAlgebra Cbig E_N) = g := by - simpa only [E_N, g, functionFieldNormalClosureGenus] using + simpa only [E_N, g] using exactConstantExtension_genus_eq_for_ratFunc C Cbig N hExactN have hdegreeEN : Module.finrank (RatFunc Cbig) E_N = D := exactConstantExtension_finrank_over_extendedRatFunc_eq @@ -337,14 +312,14 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants (bridgeBaseConstantAlgebra Cbig E_N) + 2) ≤ Fintype.card Ksmall := by simpa only [hgenusEN, hHg] using hlargeBase - letI : NeZero D.factorial := ⟨Nat.factorial_ne_zero D⟩ + let : NeZero D.factorial := ⟨Nat.factorial_ne_zero D⟩ let U := FiniteField.Extension Cbig p D.factorial - letI : DecidableEq U := Classical.decEq U - letI : DecidableEq (RatFunc U) := Classical.decEq (RatFunc U) - letI : Algebra Cbig U := + let : DecidableEq U := Classical.decEq U + let : DecidableEq (RatFunc U) := Classical.decEq (RatFunc U) + let : Algebra Cbig U := FiniteField.instAlgebraExtension Cbig p D.factorial - letI : SMul Cbig U := Algebra.toSMul - letI : Module Cbig U := Algebra.toModule + let : SMul Cbig U := Algebra.toSMul + let : Module Cbig U := Algebra.toModule have hauxDegree : Module.finrank Cbig U = D.factorial := by simpa only [U] using FiniteField.finrank_extension Cbig p D.factorial have hdivBase : Nat.card (E_N ≃ₐ[RatFunc Cbig] E_N) ∣ @@ -355,8 +330,7 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants natCard_aut_dvd_finrank_factorial_of_tower (RatFunc C) M N have hcardTower : Nat.card (E_N ≃ₐ[E_M] E_N) = Nat.card (N ≃ₐ[M] N) := - functionFieldNormalClosureConstantExtension_card_aut_eq - K F Cbig hExact + exactConstantExtensionTower_card_aut_eq C M N Cbig hExactN have hdivL : Nat.card (E_N ≃ₐ[E_M] E_N) ∣ Module.finrank Cbig U := by rw [hauxDegree, hcardTower] @@ -364,23 +338,113 @@ theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants have hfixed := abs_intermediateBaseRationalPlaceError_le_squareField_of_genus Ksmall Cbig U E_N E_M hcard hExactEN hdivL hdivBase hlarge - have hcount : finiteExtensionRationalPlaceCount Cbig E_M = - exactConstantExtensionClosedPlaceExtensionCount - K C F hExact (2 * H * n) := by - rw [normalClosureOriginalCompositum_rationalPlaceCount_eq_originalExactExtensionCount - K F Cbig hExact] - congr 2 - simpa only [Cbig, Nat.mul_assoc] using - FiniteField.finrank_extension C p (2 * (H * n)) + have hcount : exactConstantExtensionClosedPlaceExtensionCount C Cbig M hExactM 1 = + finiteExtensionRationalPlaceCount Cbig E_M := + exactConstantExtensionClosedPlaceExtensionCount_one_eq_rationalPlaceCount + C Cbig M hExactM have hcardBig : Nat.card Cbig = Nat.card C ^ (2 * H * n) := by simpa only [Cbig, Nat.mul_assoc] using FiniteField.natCard_extension C p (2 * (H * n)) have hcardSmall : Fintype.card Ksmall = Nat.card C ^ (H * n) := by rw [Fintype.card_eq_nat_card, FiniteField.natCard_extension C p (H * n)] - rw [hcount, hcardBig, hdegreeEN, hgenusEN, hcardSmall] at hfixed + rw [← hcount, hcardBig, hdegreeEN, hgenusEN, hcardSmall] at hfixed push_cast at hfixed - simpa only [C, g, H, D, mul_assoc] using hfixed + simpa only [mul_assoc] using hfixed + +end GenericGaloisTowerBound + +/-- The normal-closure constant field gives a uniform square-root-scale bound +for the packaged exact constant extensions of the original function field. + +Here `H = (g + 1)(g + 2)` is the Stepanov threshold for the genus `g` of the +geometric normal closure, while `D` is its degree over the rational function +field of its full constant field. -/ +theorem exactConstantExtensionClosedPlaceError_le_normalClosureConstants + (hExact : algebraicClosure K F = + (⊥ : IntermediateField K F)) : + ∀ n, 0 < n → + |(exactConstantExtensionClosedPlaceExtensionCount + K (FunctionFieldNormalClosureConstantField K F) F hExact + (2 * functionFieldNormalClosureStepanovThreshold K F * n) : ℝ) - + (Nat.card (FunctionFieldNormalClosureConstantField K F) : ℝ) ^ + (2 * functionFieldNormalClosureStepanovThreshold K F * n) - 1| ≤ + 2 * (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 2 + + 2 * (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 3 + + (functionFieldNormalClosureRatFuncDegree K F : ℝ) ^ 2 * + (2 * functionFieldNormalClosureGenus K F + 1) * + (Nat.card (FunctionFieldNormalClosureConstantField K F) : ℝ) ^ + (functionFieldNormalClosureStepanovThreshold K F * n) := by + classical + intro n hn + let C := FunctionFieldNormalClosureConstantField K F + let : Fintype C := + finiteExtensionHasseNormalClosureConstantFintype K F + let : DecidableEq C := + finiteExtensionHasseNormalClosureConstantDecidableEq K F + let : DecidableEq (RatFunc C) := + finiteExtensionHasseNormalClosureRatFuncDecidableEq K F + let N := FunctionFieldNormalClosure K F + let M := FunctionFieldNormalClosureOriginalCompositum K F hExact + let : Algebra (RatFunc C) M := + functionFieldNormalClosureOriginalCompositumConstantRatFuncAlgebra + K F hExact + let : SMul (RatFunc C) M := Algebra.toSMul + let : Module (RatFunc C) M := Algebra.toModule + let : Algebra C M := + exactConstantExtensionTowerCanonicalConstantAlgebra C M + let : IsScalarTower (RatFunc C) M N := + functionFieldNormalClosureOriginalCompositumConstantRatFuncTower + K F hExact + let : FiniteDimensional (RatFunc C) M := + functionFieldNormalClosureOriginalCompositum_finiteDimensional_over_constantRatFunc + K F hExact + let : FiniteDimensional M N := + functionFieldNormalClosure_finiteDimensional_over_originalCompositum + K F hExact + let : IsGalois M N := + functionFieldNormalClosure_isGalois_over_originalCompositum K F hExact + let : Algebra.IsSeparable (RatFunc C) M := + functionFieldNormalClosureOriginalCompositum_isSeparable_over_constantRatFunc + K F hExact + let normalClosureGalois : IsGalois (RatFunc C) N := + functionFieldNormalClosure_isGalois_over_constantRatFunc K F + let : Algebra.IsSeparable (RatFunc C) N := + (isGalois_iff.mp normalClosureGalois).1 + let g := functionFieldNormalClosureGenus K F + let H := functionFieldNormalClosureStepanovThreshold K F + let D := functionFieldNormalClosureRatFuncDegree K F + have hH : 0 < H := functionFieldNormalClosureStepanovThreshold_pos K F + have hExactN : algebraicClosure C N = (⊥ : IntermediateField C N) := + functionFieldNormalClosureConstantField_isExact_for_constantRatFunc K F + have hExactM : algebraicClosure C M = (⊥ : IntermediateField C M) := + functionFieldNormalClosureOriginalCompositumConstantField_isExact_for_constantRatFunc + K F hExact + let p := ringChar C + let : CharP C p := ringChar.charP C + let : Fact p.Prime := ⟨CharP.char_is_prime C p⟩ + let : NeZero (2 * (H * n)) := ⟨by positivity⟩ + let Cbig := FiniteField.Extension C p (2 * (H * n)) + let : Fintype Cbig := Fintype.ofFinite Cbig + let : Algebra C Cbig := FiniteField.instAlgebraExtension C p (2 * (H * n)) + have hfixed := exactConstantExtensionClosedPlaceError_le_galoisTowerConstants + C M N hExactM hExactN n hn + have hcount : exactConstantExtensionClosedPlaceExtensionCount C Cbig M hExactM 1 = + exactConstantExtensionClosedPlaceExtensionCount K C F hExact (2 * H * n) := by + have htransport := + (normalClosureOriginalCompositum_rationalPlaceCount_eq_exactExtensionCount + K F Cbig hExact).symm.trans + (normalClosureOriginalCompositum_rationalPlaceCount_eq_originalExactExtensionCount + K F Cbig hExact) + convert htransport using 2 + simpa only [Cbig, Nat.mul_assoc] using + (FiniteField.finrank_extension C p (2 * (H * n))).symm + change |(exactConstantExtensionClosedPlaceExtensionCount C Cbig M hExactM 1 : ℝ) - + (Nat.card C : ℝ) ^ (2 * H * n) - 1| ≤ + 2 * (D : ℝ) ^ 2 + 2 * (D : ℝ) ^ 3 + + (D : ℝ) ^ 2 * (2 * g + 1) * (Nat.card C : ℝ) ^ (H * n) at hfixed + rw [hcount] at hfixed + exact hfixed /-- The closed Hasse--Weil bound for a finite separable extension of `K(X)` with exact constant field `K`. -/ @@ -393,11 +457,11 @@ theorem finiteExtensionClosedPlaceHasseWeil Real.sqrt (Nat.card K) := by classical let C := FunctionFieldNormalClosureConstantField K F - letI : Fintype C := + let : Fintype C := finiteExtensionHasseNormalClosureConstantFintype K F - letI : DecidableEq C := + let : DecidableEq C := finiteExtensionHasseNormalClosureConstantDecidableEq K F - letI : DecidableEq (RatFunc C) := + let : DecidableEq (RatFunc C) := finiteExtensionHasseNormalClosureRatFuncDecidableEq K F let g := functionFieldNormalClosureGenus K F let H := functionFieldNormalClosureStepanovThreshold K F diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index 1bc0e54ee7..180288799c 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -647,6 +647,8 @@ theorem finiteExtensionPlaceDegree_inr_eq_mul_relativeInertiaDeg infinityPlaceRelativeInertiaDeg] exact Ideal.inertiaDeg_tower P.1 Q.1 +omit [FiniteDimensional (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) M] + [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Exhaustive place degree is multiplicative under restriction through an intermediate function field. -/ theorem finiteExtensionPlaceDegree_eq_under_mul_relativeInertiaDeg @@ -929,6 +931,8 @@ noncomputable def infinityPlaceGalAction : change (g * h) • P.1 = g • h • P.1 rw [mul_smul] } +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- Relative Galois conjugation does not change the restricted infinity place. -/ @[simp] @@ -1043,6 +1047,8 @@ theorem sum_card_infinityPlaceUnderFiberFixedBy_eq_card_galoisGroup exact sum_card_fixedBy_eq_card_group_of_isPretransitive Gal(L/M) (InfinityPlaceUnderFiber K M L P) +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra.IsSeparable (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) L] in /-- Ramification index and inertia degree are constant on each finite-place restriction fiber in a Galois tower. -/ theorem finitePlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under @@ -1064,6 +1070,7 @@ theorem finitePlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under · unfold finitePlaceRelativeInertiaDeg rw [hg, Ideal.inertiaDeg_smul] +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) L] in /-- Ramification index and inertia degree are constant on each restriction fiber above infinity in a Galois tower. -/ theorem infinityPlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean index 3ff97ccae4..9cd8c620e0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpace.lean @@ -97,11 +97,14 @@ theorem finiteExtensionDivisorDegree_nonnegative_of_effective intro v exact mul_nonneg (hD v) (by positivity) +omit [Fintype K] [DecidableEq K] in /-- Nonzero elements of the finite constant field have trivial exhaustive principal divisor. -/ -theorem finiteExtensionPrincipalDivisor_algebraMap_constant +theorem finiteExtensionPrincipalDivisor_algebraMap_constant [Finite K] (c : K) (hc : c ≠ 0) : finiteExtensionPrincipalDivisor K L (algebraMap K L c) = 0 := by + classical + let : Fintype K := Fintype.ofFinite K let n := Fintype.card K - 1 have hn : 0 < n := by dsimp [n] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean index f72d17dc96..1904c00555 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannSpaceProjectivization.lean @@ -37,17 +37,19 @@ noncomputable section variable (K : Type*) [Field K] [Fintype K] variable (V : Type*) [AddCommGroup V] [Module K V] +omit [Fintype K] in /-- One-dimensional subspaces of a finite vector space over `K` are counted by the geometric sum in the dimension. -/ -theorem finiteVectorSpace_oneDimensionalSubspace_card_eq_geomSum : +theorem finiteVectorSpace_oneDimensionalSubspace_card_eq_geomSum [Finite K] : Nat.card {W : Submodule K V // Module.finrank K W = 1} = ∑ i ∈ Finset.range (Module.finrank K V), Nat.card K ^ i := by rw [Nat.card_congr (Projectivization.equivSubmodule K V).symm] exact Projectivization.card_of_finrank K V rfl +omit [Fintype K] in /-- The orbit quotient of nonzero vectors by nonzero scalar multiplication is counted by the same geometric sum. -/ -theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_geomSum : +theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_geomSum [Finite K] : Nat.card (Quotient (MulAction.orbitRel Kˣ {v : V // v ≠ 0})) = @@ -57,8 +59,9 @@ theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_geomSum : variable [Module.Finite K V] +omit [Fintype K] in /-- Division form of the projective-space cardinality formula. -/ -theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_div : +theorem finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_div [Finite K] : Nat.card (Quotient (MulAction.orbitRel Kˣ {v : V // v ≠ 0})) = @@ -170,12 +173,15 @@ theorem projectiveRiemannSectionToEffectiveDivisorInPrincipalClass_surjective change finiteExtensionPrincipalDivisor K L x + D = E.1 exact hE.symm +omit [Fintype K] [DecidableEq K] in /-- Under exact constants, a nonzero function has zero exhaustive principal divisor exactly when it is a nonzero base-field constant. -/ -theorem finiteExtensionPrincipalDivisor_eq_zero_iff_isBaseConstant +theorem finiteExtensionPrincipalDivisor_eq_zero_iff_isBaseConstant [Finite K] (hconstants : algebraicClosure K L = ⊥) (x : L) (hx0 : x ≠ 0) : finiteExtensionPrincipalDivisor K L x = 0 ↔ ∃ c : K, c ≠ 0 ∧ algebraMap K L c = x := by + classical + let : Fintype K := Fintype.ofFinite K constructor · intro hx have hxmem : x ∈ finiteExtensionRiemannSpace K L 0 := by @@ -190,14 +196,17 @@ theorem finiteExtensionPrincipalDivisor_eq_zero_iff_isBaseConstant · rintro ⟨c, hc, rfl⟩ exact finiteExtensionPrincipalDivisor_algebraMap_constant K L c hc +omit [Fintype K] [DecidableEq K] in /-- With exact constants, two nonzero functions have the same exhaustive principal divisor exactly when they differ by a base-field scalar. -/ -theorem finiteExtensionPrincipalDivisor_eq_iff_exists_smul +theorem finiteExtensionPrincipalDivisor_eq_iff_exists_smul [Finite K] (hconstants : algebraicClosure K L = ⊥) (x y : L) (hx0 : x ≠ 0) (hy0 : y ≠ 0) : finiteExtensionPrincipalDivisor K L x = finiteExtensionPrincipalDivisor K L y ↔ ∃ c : K, c • y = x := by + classical + let : Fintype K := Fintype.ofFinite K constructor · intro hxy have hquot : finiteExtensionPrincipalDivisor K L (x / y) = 0 := by @@ -316,12 +325,15 @@ theorem effectiveRiemannSpace_nonzeroScalarOrbitQuotient_card_eq_div exact finiteVectorSpace_nonzeroScalarOrbitQuotient_card_eq_div K (finiteExtensionRiemannSpace K L D) +omit [Fintype K] [DecidableEq K] in /-- Under exact constants, an effective divisor class represented by an effective `D` is finite. -/ -theorem effectiveDivisorInPrincipalClass_finite +theorem effectiveDivisorInPrincipalClass_finite [Finite K] (D : FiniteExtensionDivisor K L) (hD : ∀ v, 0 ≤ D v) (hconstants : algebraicClosure K L = ⊥) : Finite (EffectiveDivisorInPrincipalClass K L D) := by + classical + let : Fintype K := Fintype.ofFinite K let : Module.Finite K (finiteExtensionRiemannSpace K L D) := finiteExtensionRiemannSpace_effective_moduleFinite K L D hD let : Finite (finiteExtensionRiemannSpace K L D) := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean index 514fae368c..52c25e6ddc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldConstantExtensionNormalization.lean @@ -134,9 +134,17 @@ noncomputable def finiteFieldConstantExtensionIntegralClosureAlgEquiv (integralClosure C[X] N)).symm.toRingEquiv.trans e with commutes' := fun s => by apply Subtype.ext - simp [e, finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, - polynomialIntegralClosureBaseChangeAlgEquiv, - TensorProduct.toIntegralClosure] + simp only [AlgEquiv.symm_toRingEquiv, RingEquiv.symm_mk, AlgEquiv.toEquiv_eq_coe, + AlgEquiv.symm_toEquiv_eq_symm, finiteFieldPolynomialIntegralClosureBaseChangeAlgEquiv, + polynomialIntegralClosureBaseChangeAlgEquiv, TensorProduct.toIntegralClosure, + RingEquiv.toEquiv_eq_coe, Algebra.TensorProduct.algebraMap_apply, Algebra.algebraMap_self, + RingHom.id_apply, Equiv.toFun_as_coe, EquivLike.coe_coe, RingEquiv.coe_trans, + RingEquiv.coe_mk, AlgEquiv.coe_ofBijective, Function.comp_apply, + polynomialTensorCancel_symm_tmul, AlgEquiv.coe_mapIntegralClosure, AlgHom.coe_codRestrict, + Algebra.TensorProduct.map_tmul, AlgHom.coe_id, id_eq, Subalgebra.coe_val, + OneMemClass.coe_one, polynomialTensorCancelOverCoefficientPolynomial_apply, + polynomialTensorCancel_tmul, Polynomial.aeval_C, Algebra.TensorProduct.tmul_mul_tmul, + mul_one, e] change s ⊗ₜ[C] (1 : N) = algebraMap S[X] (S ⊗[C] N) (Polynomial.C s) change s ⊗ₜ[C] (1 : N) = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean index 094a39b709..62da75aee4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteFieldDivisibleExtension.lean @@ -92,25 +92,25 @@ theorem finrank_double_finiteFieldExtension : rw [finrank_finiteFieldExtension_of_dvd K p a (2 * a) ⟨2, by omega⟩] simpa [Nat.mul_comm] using Nat.mul_div_cancel_left 2 (NeZero.pos a) +omit [Fintype K] in /-- Cardinality of the degree-`2a` extension is the square of the degree-`a` extension's cardinality. -/ -theorem natCard_double_finiteFieldExtension_eq_sq : +theorem natCard_double_finiteFieldExtension_eq_sq [Finite K] : Nat.card (FiniteField.Extension K p (2 * a)) = Nat.card (FiniteField.Extension K p a) ^ 2 := by rw [FiniteField.natCard_extension K p (2 * a), FiniteField.natCard_extension K p a] ring +omit [Fintype K] in /-- A positive multiple of the extension degree is already large enough to dominate that degree. This elementary growth estimate is what makes one fixed multiple work uniformly in the Stepanov construction. -/ -theorem degree_le_natCard_finiteFieldExtension_mul +theorem degree_le_natCard_finiteFieldExtension_mul [Finite K] (d n : ℕ) [NeZero (d * n)] (hn : 0 < n) : d ≤ Nat.card (FiniteField.Extension K p (d * n)) := by rw [FiniteField.natCard_extension K p (d * n)] - have hcard : 1 < Nat.card K := by - simpa only [Nat.card_eq_fintype_card] using - (Fintype.one_lt_card : 1 < Fintype.card K) + have hcard : 1 < Nat.card K := Finite.one_lt_card have hdPow : d ≤ Nat.card K ^ d := (Nat.lt_pow_self hcard).le exact hdPow.trans (Nat.pow_le_pow_right (Nat.card_pos) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean index c914f33aee..4731ee8025 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePrincipalParts.lean @@ -120,6 +120,7 @@ theorem localPrincipalPartInclusion_injective (π : R) (n : ℕ) : rw [Submodule.Quotient.mk_eq_zero, Submodule.Quotient.mk_eq_zero] rfl +omit [IsDedekindDomain R] [IsDiscreteValuationRing R] [IsFractionRing R L] in theorem range_localPrincipalPartInclusion_eq_ker_layerMap (π : R) (n : ℕ) : LinearMap.range diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean index b73471ee6d..68f257b130 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusPlaceCardinality.lean @@ -52,10 +52,11 @@ variable (L : Type*) [Field L] [Algebra (RatFunc C) L] variable (S : Type*) [Field S] [Algebra C S] [FiniteDimensional C S] [IsGalois C S] +omit [Fintype C] in /-- A finite place of degree `[S : C]` above a degree-one place has the decomposition-group cardinality required by Frobenius-coset averaging, once the restricted constant quotient kernel is identified with inertia. -/ -theorem finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut +theorem finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut [Finite C] (π : Gal(L/M) →* (S ≃ₐ[C] S)) (Q : FiniteExtensionFinitePlace C L) (hTop : finiteExtensionPlaceDegree C L (.inl Q) = Module.finrank C S) @@ -69,6 +70,7 @@ theorem finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constant Nat.card (π.comp (finitePlaceDecompositionGroup C M L Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by + let : Fintype C := Fintype.ofFinite C let := finiteIntegralClosureGalAction C M L have hrelative : finitePlaceRelativeInertiaDeg C M L Q = Module.finrank C S := by @@ -97,9 +99,10 @@ theorem finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constant rw [finitePlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg, ← hkernel, hrelative, ← IsGalois.card_aut_eq_finrank C S] +omit [Fintype C] in /-- The corresponding decomposition-group cardinality identity for a place above infinity. -/ -theorem infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut +theorem infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut [Finite C] (π : Gal(L/M) →* (S ≃ₐ[C] S)) (Q : FiniteExtensionInfinityPlace C L) (hTop : finiteExtensionPlaceDegree C L (.inr Q) = Module.finrank C S) @@ -113,6 +116,7 @@ theorem infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_consta Nat.card (π.comp (infinityPlaceDecompositionGroup C M L Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by + let : Fintype C := Fintype.ofFinite C let := infinityIntegralClosureGalAction C M L have hrelative : infinityPlaceRelativeInertiaDeg C M L Q = Module.finrank C S := by @@ -141,10 +145,11 @@ theorem infinityPlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_consta rw [infinityPlaceDecompositionGroup_card_eq_ramificationIdx_mul_inertiaDeg, ← hkernel, hrelative, ← IsGalois.card_aut_eq_finrank C S] +omit [Fintype C] in /-- Restriction-fiber form of the finite-place cardinality identity. Its conclusion is exactly the stabilizer hypothesis consumed by the cardinality form of Frobenius-coset Burnside averaging. -/ -theorem finitePlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_constantAut +theorem finitePlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_constantAut [Finite C] (π : Gal(L/M) →* (S ≃ₐ[C] S)) (P : FiniteExtensionFinitePlace C M) (Q : FinitePlaceUnderFiber C M L P) @@ -161,6 +166,7 @@ theorem finitePlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_const Nat.card (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by + let : Fintype C := Fintype.ofFinite C let := finiteIntegralClosureGalAction C M L let := finitePlaceUnderFiberGalAction C M L P have hBase' : finiteExtensionPlaceDegree C M @@ -173,8 +179,9 @@ theorem finitePlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_const exact finitePlaceDecompositionGroup_card_eq_restrictedKernel_mul_card_constantAut C M L S π Q.1 hTop hBase' hker +omit [Fintype C] in /-- Restriction-fiber form of the infinity-place cardinality identity. -/ -theorem infinityPlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_constantAut +theorem infinityPlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_constantAut [Finite C] (π : Gal(L/M) →* (S ≃ₐ[C] S)) (P : FiniteExtensionInfinityPlace C M) (Q : InfinityPlaceUnderFiber C M L P) @@ -191,6 +198,7 @@ theorem infinityPlaceUnderFiber_stabilizer_card_eq_restrictedKernel_mul_card_con Nat.card (π.comp (MulAction.stabilizer Gal(L/M) Q).subtype).ker * Nat.card (S ≃ₐ[C] S) := by + let : Fintype C := Fintype.ofFinite C let := infinityIntegralClosureGalAction C M L let := infinityPlaceUnderFiberGalAction C M L P have hBase' : finiteExtensionPlaceDegree C M diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean index d03725445a..b1c6eaf73a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FrobeniusRestriction.lean @@ -139,15 +139,18 @@ local instance frobeniusRestrictionConstantTower : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl +omit [DecidableEq K] in /-- Raising to `(#K) ^ n` scales every exhaustive place order by that integer. -/ theorem finiteExtensionPrincipalDivisor_powCardLinearMap (x : L) (hx : x ≠ 0) (n : ℕ) : finiteExtensionPrincipalDivisor K L (powCardLinearMap K L n x) = (Fintype.card K ^ n) • finiteExtensionPrincipalDivisor K L x := by + classical rw [powCardLinearMap_apply, finiteExtensionPrincipalDivisor_pow K L x hx] +omit [DecidableEq K] in /-- Pointwise form of the Frobenius order-scaling identity. -/ theorem finiteExtensionPrincipalDivisor_powCardLinearMap_apply (x : L) (hx : x ≠ 0) (n : ℕ) @@ -155,9 +158,11 @@ theorem finiteExtensionPrincipalDivisor_powCardLinearMap_apply finiteExtensionPrincipalDivisor K L (powCardLinearMap K L n x) v = ((Fintype.card K ^ n : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L x v := by + classical rw [finiteExtensionPrincipalDivisor_powCardLinearMap K L x hx n] simp only [Finsupp.smul_apply, nsmul_eq_mul] +omit [DecidableEq K] in /-- The pole divisor is scaled by the same power of the constant-field cardinality under iterated Frobenius. -/ theorem finiteExtensionPoleDivisor_powCardLinearMap diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index 716dcd90ef..bda47af1cc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -111,6 +111,7 @@ noncomputable def exactConstantExtensionOriginalCompositumAlgEquiv exact AlgEquiv.ofInjectiveField (functionFieldNormalClosureOriginalMultiplication K F) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- Every algebraic constant of the normal closure belongs to `CF`. -/ theorem functionFieldNormalClosureConstant_mem_originalCompositum (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) @@ -122,7 +123,7 @@ theorem functionFieldNormalClosureConstant_mem_originalCompositum (FunctionFieldNormalClosureConstantField K F) hExact exact ⟨c ⊗ₜ[K] (1 : F), by simp⟩ -omit [DecidableEq (RatFunc K)] in +omit [DecidableEq (RatFunc K)] [DecidableEq K] in /-- The original rational-function field belongs to `CF`. -/ theorem functionFieldNormalClosureRatFunc_mem_originalCompositum (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) @@ -228,12 +229,14 @@ noncomputable instance ext r rfl +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The constant base `C(t)` inside `N` is contained in the larger compositum `CF`. -/ theorem functionFieldNormalClosureConstantBase_le_originalCompositum (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) (b : FunctionFieldNormalClosureConstantBase K F) : b.1 ∈ FunctionFieldNormalClosureOriginalCompositum K F hExact := by + classical have hb : b.1 ∈ functionFieldNormalClosureConstantCompositum K F := by rw [← functionFieldNormalClosureConstantBase_eq_compositum K F] exact b.2 @@ -328,6 +331,7 @@ noncomputable instance ext k rfl +omit [DecidableEq K] in /-- The chosen normal closure is finite over the original compositum `CF`. -/ noncomputable instance functionFieldNormalClosure_finiteDimensional_over_originalCompositum @@ -335,6 +339,7 @@ noncomputable instance FiniteDimensional (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) := by + classical let : Module.Finite (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) := @@ -343,12 +348,14 @@ noncomputable instance (FunctionFieldNormalClosure K F) infer_instance +omit [DecidableEq K] in /-- The chosen normal closure remains Galois after enlarging the base from `K(t)` to the intermediate field `CF`. -/ noncomputable instance functionFieldNormalClosure_isGalois_over_originalCompositum (hExact : algebraicClosure K F = (⊥ : IntermediateField K F)) : IsGalois (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) := by + classical exact IsGalois.tower_top_of_isGalois (RatFunc K) (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean index 6ba35c8997..0cbb0559b7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncBase.lean @@ -130,6 +130,7 @@ theorem functionFieldNormalClosureConstantBaseX_transcendental : simpa [functionFieldNormalClosureConstantBaseX] using hxIntegralK exact RatFunc.transcendental_X hxRatFunc.isAlgebraic +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The kernel fixed field is generated over the full constant field by the original rational parameter. -/ theorem functionFieldNormalClosureConstantBase_adjoin_X : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean index 071b2efa13..da540bd409 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/GaloisAverage.lean @@ -32,11 +32,12 @@ open Filter Asymptotics sum has absolute value at most `A`, then every term has a two-sided bound. This is the numerical core of the Galois-twist averaging step. -/ theorem abs_le_of_uniform_upper_and_abs_sum_le - {ι : Type*} [Fintype ι] [DecidableEq ι] + {ι : Type*} [Fintype ι] (E : ι → ℝ) (i : ι) (A B : ℝ) (hB : 0 ≤ B) (hupper : ∀ j, E j ≤ B) (hsum : |∑ j, E j| ≤ A) : |E i| ≤ A + (Fintype.card ι - 1 : ℕ) * B := by + classical have hA : 0 ≤ A := (abs_nonneg _).trans hsum have hcard : 1 ≤ Fintype.card ι := Fintype.card_pos_iff.mpr ⟨i⟩ have heraseCard : (Finset.univ.erase i).card = Fintype.card ι - 1 := by @@ -77,12 +78,13 @@ theorem abs_le_of_uniform_upper_and_abs_sum_le for all twists, together with a bounded total error, gives the same geometric growth rate as a two-sided bound for every twist. -/ theorem abs_twistError_le_geometric_of_uniform_upper_and_abs_sum_le - {ι : Type*} [Fintype ι] [DecidableEq ι] + {ι : Type*} [Fintype ι] (E : ℕ → ι → ℝ) (i : ι) (A B rho : ℝ) (hA : 0 ≤ A) (hB : 0 ≤ B) (hrho : 1 ≤ rho) (hupper : ∀ n j, E n j ≤ B * rho ^ n) (hsum : ∀ n, |∑ j, E n j| ≤ A) (n : ℕ) : |E n i| ≤ (A + (Fintype.card ι - 1 : ℕ) * B) * rho ^ n := by + classical have hrhoPow : 1 ≤ rho ^ n := one_le_pow₀ hrho have hgeometricNonneg : 0 ≤ B * rho ^ n := by positivity have hraw := abs_le_of_uniform_upper_and_abs_sum_le @@ -97,12 +99,13 @@ theorem abs_twistError_le_geometric_of_uniform_upper_and_abs_sum_le /-- The finite averaging estimate gives the geometric `O(rho ^ n)` bound needed by the zeta-function power-sum argument. -/ theorem twistError_isBigO_geometric_of_uniform_upper_and_abs_sum_le - {ι : Type*} [Fintype ι] [DecidableEq ι] + {ι : Type*} [Fintype ι] (E : ℕ → ι → ℝ) (i : ι) (A B rho : ℝ) (hA : 0 ≤ A) (hB : 0 ≤ B) (hrho : 1 ≤ rho) (hupper : ∀ n j, E n j ≤ B * rho ^ n) (hsum : ∀ n, |∑ j, E n j| ≤ A) : (fun n : ℕ ↦ E n i) =O[atTop] fun n : ℕ ↦ rho ^ n := by + classical let C : ℝ := A + ((Fintype.card ι - 1 : ℕ) : ℝ) * B have hC : 0 ≤ C := by dsimp [C] @@ -120,12 +123,13 @@ is close to `card · base`, then `base` is close to `center`. The deliberately division-free bound is convenient for integral point counts and is uniform when the family cardinality is fixed. -/ theorem abs_base_sub_center_le_of_average_and_pointwise - {ι : Type*} [Fintype ι] [DecidableEq ι] [Nonempty ι] + {ι : Type*} [Fintype ι] [Nonempty ι] (x : ι → ℝ) (base center A B : ℝ) (_hA : 0 ≤ A) (_hB : 0 ≤ B) (haverage : |∑ i, x i - (Fintype.card ι : ℝ) * base| ≤ A) (hpointwise : ∀ i, |x i - center| ≤ B) : |base - center| ≤ A + (Fintype.card ι : ℝ) * B := by + classical have hcardNat : 1 ≤ Fintype.card ι := Fintype.card_pos_iff.mpr inferInstance have hcard : (1 : ℝ) ≤ Fintype.card ι := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean index 61fc06e60c..e373f77f7f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointDivisorSplit.lean @@ -103,6 +103,7 @@ theorem finiteExtensionDivisorDegree_neg rw [hzero] at h omega +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Divisor degree respects subtraction. -/ theorem finiteExtensionDivisorDegree_sub (D E : FiniteExtensionDivisor K L) : @@ -113,6 +114,7 @@ theorem finiteExtensionDivisorDegree_sub finiteExtensionDivisorDegree_neg] rfl +omit [Fintype K] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in /-- Degree bookkeeping for the divisor away from the selected place. -/ theorem finiteExtensionDivisorDegree_away (D : FiniteExtensionDivisor K L) (P : FiniteExtensionPlace K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean index aad1ab92ff..85f8c85181 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PoleDivisor.lean @@ -142,6 +142,7 @@ theorem pow_mul_pow_mem_poleDivisor_budget (finiteExtensionRiemannSpace_pow_mem K L (mem_finiteExtensionRiemannSpace_poleDivisor K L y hy) j) +omit [Fintype K] in /-- The degree of the monomial pole budget is the corresponding linear combination of the two coordinate heights. -/ theorem finiteExtensionDivisorDegree_pow_mul_pow_budget diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean index 7dbbec185f..a6b71a512d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncCanonicalInfinityDivisor.lean @@ -122,10 +122,12 @@ noncomputable def ratFuncCanonicalInfinityDivisor : FunctionField.Chart.DivisorA K (RatFunc K) := Finsupp.single (ratFuncInfinityChartPlace K) (-2) +omit [Fintype K] [DecidableEq K] in /-- The explicit divisor `-2∞` has degree `-2`. -/ theorem ratFuncCanonicalInfinityDivisor_degree : FunctionField.Chart.deg K (RatFunc K) (ratFuncCanonicalInfinityDivisor K) = -2 := by + classical rw [ratFuncCanonicalInfinityDivisor, FunctionField.Chart.deg_single] have hdegree := finiteExtensionPlaceDegree_eq_chart K (RatFunc K) (.inr (ratFuncIdentityInfinityPlace K)) @@ -135,10 +137,12 @@ theorem ratFuncCanonicalInfinityDivisor_degree : rw [← hdegree] norm_num +omit [Fintype K] [DecidableEq K] in /-- The explicit divisor `-2∞` is canonical on `K(X)`. -/ theorem ratFuncCanonicalInfinityDivisor_isCanonical : FunctionField.Chart.IsCanonical K (RatFunc K) (ratFuncCanonicalInfinityDivisor K) := by + classical rw [FunctionField.chart_isCanonical_iff_degree_ell] constructor · rw [ratFuncCanonicalInfinityDivisor_degree, diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean index d412a0bf43..741587fbca 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/RatFuncParameterPole.lean @@ -108,11 +108,13 @@ local instance ratFuncParameterInfinityPlaceFintype : (ratFuncInfinityPlace K).asIdeal (RatFuncInfinityIntegralClosure K L)) +omit [DecidableEq K] in /-- The rational parameter `X` is integral at every finite place. -/ theorem finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative (q : FiniteExtensionFinitePlace K L) : 0 ≤ finiteExtensionPrincipalDivisor K L (algebraMap (RatFunc K) L RatFunc.X) (.inl q) := by + classical let S := RatFuncFiniteIntegralClosure K L let e := ratFuncFiniteIntegralClosureFractionRingEquiv K L let s : S := algebraMap K[X] S Polynomial.X @@ -130,10 +132,12 @@ theorem finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative rw [finiteExtensionPrincipalDivisor_inl, hrepr] exact finitePlaceOrder_algebraMap_nonnegative q s hs +omit [DecidableEq K] in private theorem finiteExtensionPrincipalDivisor_inr_eq_order (x : L) (P : FiniteExtensionInfinityPlace K L) : finiteExtensionPrincipalDivisor K L x (.inr P) = finitePlaceOrder (primeOverHeightOne (ratFuncInfinityPlace K) P) x := by + classical rw [finiteExtensionPrincipalDivisor_inr] symm simpa [ratFuncInfinityIntegralClosureFractionRingEquiv] using @@ -142,6 +146,7 @@ private theorem finiteExtensionPrincipalDivisor_inr_eq_order (primeOverHeightOne (ratFuncInfinityPlace K) P) ((ratFuncInfinityIntegralClosureFractionRingEquiv K L).symm x) +omit [DecidableEq K] in /-- At a place `P` above infinity, the rational parameter has order exactly the negative ramification index. -/ theorem finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx @@ -149,6 +154,7 @@ theorem finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx finiteExtensionPrincipalDivisor K L (algebraMap (RatFunc K) L RatFunc.X) (.inr P) = -(P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + classical let q := primeOverHeightOne (ratFuncInfinityPlace K) P let pi := ratFuncInfinityUniformizer K let : q.asIdeal.LiesOver (ratFuncInfinityPlace K).asIdeal := by @@ -184,17 +190,20 @@ theorem finiteExtensionPrincipalDivisor_ratFuncX_inr_eq_neg_ramificationIdx change finitePlaceOrder q (algebraMap (RatFunc K) L RatFunc.X) = _ omega +omit [DecidableEq K] in /-- The pole divisor of the rational parameter vanishes at finite places. -/ theorem finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero (q : FiniteExtensionFinitePlace K L) : finiteExtensionPoleDivisor K L (algebraMap (RatFunc K) L RatFunc.X) (.inl q) = 0 := by + classical simp only [finiteExtensionPoleDivisor, Finsupp.neg_apply, Finsupp.filter_apply] rw [ite_eq_right (not_lt_of_ge (finiteExtensionPrincipalDivisor_ratFuncX_inl_nonnegative K L q))] simp +omit [DecidableEq K] in /-- Above infinity, the pole coefficient of the rational parameter is exactly the ramification index. -/ theorem finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx @@ -202,6 +211,7 @@ theorem finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx finiteExtensionPoleDivisor K L (algebraMap (RatFunc K) L RatFunc.X) (.inr P) = (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + classical have he : 0 < P.1.ramificationIdx (RatFuncInfinityIntegers K) := P.1.ramificationIdx_pos (RatFuncInfinityIntegers K) simp only [finiteExtensionPoleDivisor, Finsupp.neg_apply, @@ -211,6 +221,7 @@ theorem finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx rw [ite_eq_left (by exact_mod_cast he)] simp +omit [DecidableEq K] in /-- Pointwise description of the complete pole divisor of the rational parameter: it is zero at finite places and has coefficient `e(P)` at every place above infinity. -/ @@ -222,11 +233,13 @@ theorem finiteExtensionPoleDivisor_ratFuncX_apply | .inl _ => 0 | .inr P => (P.1.ramificationIdx (RatFuncInfinityIntegers K) : ℤ) := by + classical cases v with | inl q => exact finiteExtensionPoleDivisor_ratFuncX_inl_eq_zero K L q | inr P => exact finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx K L P +omit [DecidableEq K] in /-- The support of the pole divisor of the rational parameter consists exactly of the places above infinity. -/ theorem finiteExtensionPoleDivisor_ratFuncX_support : @@ -247,6 +260,7 @@ theorem finiteExtensionPoleDivisor_ratFuncX_support : rw [Finsupp.mem_support_iff, finiteExtensionPoleDivisor_ratFuncX_inr_eq_ramificationIdx] simp [Nat.ne_of_gt he] +omit [DecidableEq K] in /-- The negative support of the principal divisor of the rational parameter consists exactly of the places above infinity. -/ theorem finiteExtensionPrincipalDivisor_ratFuncX_negativeSupport : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean index 697c654c2f..76d867ab56 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareExtensionAffinePlaces.lean @@ -139,7 +139,6 @@ private theorem residue_finrank_le_of_dominating_valuation apply congrArg (IsLocalRing.residue R) apply Subtype.ext rw [hψcoe] - change algebraMap A E (algebraMap K A c) = (algebraMap K R c : E) rw [← IsScalarTower.algebraMap_apply K A E] exact (hscalar c).symm } have hker : m.asIdeal = RingHom.ker θ := by diff --git a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean index 28854a620f..95dd9491e5 100644 --- a/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean +++ b/LeanPool/MarkoffModP/BGS/NumberTheory/DivisorBound.lean @@ -38,7 +38,7 @@ private lemma exists_pow_succ_le_constant_mul_two_pow (k : ℕ) : by_cases ha : N ≤ a + 1 · have hreal := hN (a + 1) ha simp only [Real.norm_eq_abs, one_mul, abs_pow] at hreal - simp at hreal + simp only [Nat.cast_add, Nat.cast_one, Nat.abs_ofNat] at hreal have hnat : (a + 1) ^ k ≤ 2 ^ (a + 1) := by exact_mod_cast hreal calc (a + 1) ^ k ≤ 2 ^ (a + 1) := hnat diff --git a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean index d68b6cdf48..8b82863f1f 100644 --- a/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean +++ b/LeanPool/MarkoffModP/RiemannRoch/Genus/Polar.lean @@ -257,7 +257,7 @@ theorem basisPoleBound_nonneg {ι : Type*} [Fintype ι] (f : ι → K) : 0 ≤ basisPoleBound k K f := by intro v change 0 ≤ (basisPoleBound k K f) v - simp [basisPoleBound, Finset.sum_apply] + simp only [basisPoleBound, Finsupp.coe_finsetSum, Finset.sum_apply] exact Finset.sum_nonneg fun i _ => polarDivisor_nonneg k K (f i) v omit [Algebra k K] [IsScalarTower k k[X] K] [IsFullConstantField k K] in From c1c17ccb690d583b06ae36483c66094ca2f1cc59 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 03:26:10 +0000 Subject: [PATCH 33/37] Expose required Markoff interfaces and remove redundant section assumptions --- ...xtensionCanonicalAuxiliaryFinitePlace.lean | 3 +++ ...nonicalAuxiliaryFinitePlaceNormalized.lean | 19 ++++++++++--------- .../FiniteExtensionCanonicalWronskian.lean | 1 + ...FiniteExtensionExceptionalPlaceBounds.lean | 1 + .../FiniteExtensionExceptionalSupport.lean | 2 ++ .../PlaneCurveFiniteDifferentBound.lean | 1 + .../PlaneCurvePropositionTwoAssembly.lean | 1 + .../ConstantExtensionFinitePlaceBridge.lean | 13 +++++++------ ...ionInfinityPlaceSplittingMultiplicity.lean | 9 +++++++++ ...ntExtensionPlaceSplittingMultiplicity.lean | 4 ++++ .../DedekindDifferentLocalTrace.lean | 4 ++-- ...tantExtensionFinitePlaceCompatibility.lean | 7 +++++++ ...ensionFrobeniusTwistFinitePlaceBridge.lean | 3 +++ ...onFrobeniusTwistFinitePlaceUnramified.lean | 3 +++ ...ionFrobeniusTwistInfinityPlaceDescent.lean | 1 + ...ntExtensionInfinityPlaceCompatibility.lean | 1 + ...diateFrobeniusTwistFinitePlaceAverage.lean | 19 +++++++++++++++++++ ...ctConstantExtensionNormalClosureTower.lean | 3 +++ ...FiniteExtensionDivisorClassRecurrence.lean | 2 ++ .../HasseWeil/FiniteExtensionPlaceTower.lean | 5 +++++ .../HasseWeil/FiniteExtensionRiemannRoch.lean | 2 ++ .../HasseWeil/FinitePlaceFrobeniusFiber.lean | 3 +++ .../FunctionFieldNormalClosureConstants.lean | 1 + ...nFieldNormalClosureOriginalCompositum.lean | 2 ++ ...unctionFieldNormalClosureRatFuncEquiv.lean | 2 ++ .../BGS/HasseWeil/OnePointPoleSemigroup.lean | 1 + .../HasseWeil/OnePointStepanovBasisGrid.lean | 5 ++++- .../BGS/HasseWeil/OnePointStepanovGrid.lean | 18 ++++++++++++------ .../BGS/HasseWeil/PlaneCoordinatePole.lean | 4 ++++ .../PlaneCoordinatePoleAtInfinity.lean | 14 +++++++++----- .../HasseWeil/PlaneOnePointRiemannLower.lean | 1 + .../SquareFieldStepanovRestriction.lean | 1 + .../HasseWeil/StepanovSquareVanishing.lean | 1 + ...ixedPointFreeMaximalDivisorTraceCount.lean | 1 + .../BGS/Markoff/Cage/AxisEquivalence.lean | 14 ++++++++------ .../BGS/Markoff/Cage/WitnessEquations.lean | 6 ++++-- .../Markoff/Endgame/LargeOrderToMaximal.lean | 11 ++++++----- .../Endgame/Nonsplit/DescendedTraceCurve.lean | 4 ++-- .../TraceCurve/LaurentNormalization.lean | 3 ++- 39 files changed, 151 insertions(+), 45 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean index ebab6374a2..0a1acab277 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean @@ -60,6 +60,7 @@ local instance finiteCanonicalCasesFiniteIntegralClosureIsTorsionFree : Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isTorsionFree K[X] L +omit [DecidableEq K] in private theorem finiteExtensionFinitePlace_gridOrder_sum_eq (q : FiniteExtensionFinitePlace K L) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) (h k : ℕ) : @@ -93,6 +94,7 @@ private theorem auxiliaryFamilyDerivativeOrder_sum_int (h k : ℕ) : ((h * k + h + k).choose 2 : ℤ) := by exact_mod_cast auxiliaryFamilyDerivativeOrder_sum h k +omit [DecidableEq K] in private theorem finitePlaceOrder_gridMonomial_eq_zero (q : FiniteExtensionFinitePlace K L) (u v : L) (hu : u ≠ 0) (hv : v ≠ 0) @@ -197,6 +199,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI simpa only [n, finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hboundInt +omit [DecidableEq K] in /-- Finite-place source case (ii), with every local order converted to the coefficient used by the exhaustive principal divisor. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean index 1ba52b8146..f64fac8f92 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean @@ -59,7 +59,8 @@ local instance normalizedCasesFiniteIntegralClosureIsTorsionFree : Module.IsTorsionFree K[X] (RatFuncFiniteIntegralClosure K L) := IsIntegralClosure.isTorsionFree K[X] L -private abbrev canonicalDifferent : FiniteExtensionPlace K L →₀ ℤ := +/-- The canonical different divisor used by the normalized finite-place estimates. -/ +abbrev normalizedFinitePlaceCanonicalDifferent : FiniteExtensionPlace K L →₀ ℤ := finiteExtensionCanonicalDifferentDivisor K L (finiteExtensionFiniteDifferentIdeal_ne_bot K L) @@ -80,7 +81,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI_of_normalized (auxiliaryFamily u v h k)).det ≠ 0) : ((h * k + h + k : ℕ) : ℤ) * finiteExtensionPrincipalDivisor K L ((1 - u) / (1 - v)) (.inl q) ≤ - ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + ((h * k + h + k).choose 2 : ℤ) * normalizedFinitePlaceCanonicalDifferent K L (.inl q) + finiteExtensionPrincipalDivisor K L (indexedDedekindLocalWronskian D (auxiliaryFamilyDerivativeOrder h k) @@ -91,7 +92,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI_of_normalized have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseI K L q D c hc hIntegral h k hn u v hu hv hu1 hv1 huOrder hvOrder hrhoOrder hW - simpa only [canonicalDifferent, hcOrder] using hcase + simpa only [normalizedFinitePlaceCanonicalDifferent, hcOrder] using hcase /-- Canonical finite-place case (ii), outside the exceptional set without a pole of `(1-u)/(1-v)`. -/ @@ -107,7 +108,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII_of_normalized (hW : (indexedDedekindLocalWronskian D (auxiliaryFamilyDerivativeOrder h k) (auxiliaryFamily u v h k)).det ≠ 0) : - 0 ≤ ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + 0 ≤ ((h * k + h + k).choose 2 : ℤ) * normalizedFinitePlaceCanonicalDifferent K L (.inl q) + finiteExtensionPrincipalDivisor K L (indexedDedekindLocalWronskian D (auxiliaryFamilyDerivativeOrder h k) @@ -118,7 +119,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII_of_normalized have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseII K L q D c hc hIntegral h k u v hu hv hu1 hv1 huOrder hvOrder hrhoOrder hW - simpa only [canonicalDifferent, hcOrder] using hcase + simpa only [normalizedFinitePlaceCanonicalDifferent, hcOrder] using hcase /-- Canonical finite-place case (iii), at a positive-order place of `v`. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII_of_normalized @@ -137,7 +138,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII_of_normalized finiteExtensionPrincipalDivisor K L (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) - ((h * k + h + k).choose 2 : ℤ) ≤ - ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + ((h * k + h + k).choose 2 : ℤ) * normalizedFinitePlaceCanonicalDifferent K L (.inl q) + finiteExtensionPrincipalDivisor K L (indexedDedekindLocalWronskian D (auxiliaryFamilyDerivativeOrder h k) @@ -147,7 +148,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII_of_normalized K L D hDX q have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseIII K L q D c hc hIntegral h k u v hu hv hu1 hv1 hW - simpa only [canonicalDifferent, hcOrder] using hcase + simpa only [normalizedFinitePlaceCanonicalDifferent, hcOrder] using hcase /-- Canonical finite-place case (iv), at a nonpositive-order place of `v`. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIV_of_normalized @@ -165,7 +166,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIV_of_normalized finiteExtensionPrincipalDivisor K L (finiteExtensionAuxiliaryGridProduct L u v h k) (.inl q) - ((h * k + h + k).choose 2 : ℤ) ≤ - ((h * k + h + k).choose 2 : ℤ) * canonicalDifferent K L (.inl q) + + ((h * k + h + k).choose 2 : ℤ) * normalizedFinitePlaceCanonicalDifferent K L (.inl q) + finiteExtensionPrincipalDivisor K L (indexedDedekindLocalWronskian D (auxiliaryFamilyDerivativeOrder h k) @@ -175,7 +176,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIV_of_normalized K L D hDX q have hcase := finiteExtensionFinitePlace_canonicalAuxiliary_caseIV K L q D c hc hIntegral h k u v hu hv hu1 hv1 hW - simpa only [canonicalDifferent, hcOrder] using hcase + simpa only [normalizedFinitePlaceCanonicalDifferent, hcOrder] using hcase end diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean index f1f81e1b59..aa06efa601 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean @@ -106,6 +106,7 @@ private theorem finiteExtensionFinitePrincipalDivisor_algebraMap_apply rw [finiteExtensionFinitePrincipalDivisor_apply, hrepr, finitePlaceOrder_algebraMap_eq_multiplicity q d hd] +omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem finiteExtensionFinitePrincipalDivisor_algebraMap_eq_mapRange (d : RatFuncFiniteIntegralClosure K L) (hd : d ≠ 0) : finiteExtensionFinitePrincipalDivisor K L diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean index ee78ca519a..2cc23c71a0 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalPlaceBounds.lean @@ -71,6 +71,7 @@ theorem mem_propositionTwoExceptionalPlaces_of_v_order_pos rw [propositionTwoExceptionalPlaces] exact Finset.mem_union_right _ (Finsupp.mem_support_iff.mpr (ne_of_gt hP)) +omit [DecidableEq K] in /-- Every auxiliary grid product has order zero away from the direct Proposition 2 exceptional set. -/ theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct_eq_zero_outside_propositionTwoExceptionalPlaces diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index b3eb38a2b5..2fde63db2b 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -818,6 +818,7 @@ theorem finiteExtensionExceptionalSet_oneSubU_div_oneSubV_weightedOrder_lower_bo finiteExtensionExceptionalSet_oneSubV_div_oneSubU_weightedOrder_lower_bound K L f iV iU iRho hv hu hvone huone hRho +omit [DecidableEq K] in /-- Away from the exceptional set, `u` has order zero. -/ theorem finiteExtensionFamilyOrder_u_eq_zero_outsideExceptionalSet (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) @@ -826,6 +827,7 @@ theorem finiteExtensionFamilyOrder_u_eq_zero_outsideExceptionalSet apply finiteExtensionFamilyOrder_eq_zero_of_not_mem_support K L f iU w exact (not_or.mp ((mem_finiteExtensionExceptionalSet_iff K L f iU iV w).not.mp hw)).1 +omit [DecidableEq K] in /-- Away from the exceptional set, `v` has order zero. -/ theorem finiteExtensionFamilyOrder_v_eq_zero_outsideExceptionalSet (f : A → L) (iU iV : A) (w : FiniteExtensionFamilyPlace K L f) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean index 339ca3cfbc..c794a25fc5 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveFiniteDifferentBound.lean @@ -772,6 +772,7 @@ theorem planeCurve_finiteDifferentDivisorBelow_apply_le_discrOrder exact_mod_cast htop exact hbound.trans_eq horderEq +omit [DecidableEq (RatFunc K)] in /-- The sharp finite different contribution for the plane function field is bounded by the discriminant degree of the original second-coordinate equation. -/ diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean index 179de64f61..a77dd6cf95 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurvePropositionTwoAssembly.lean @@ -162,6 +162,7 @@ theorem planeCurvePropositionTwo_natural_of_auxiliaryBounds (by simpa only [A, B] using hadmissible) (by simpa only [a, b] using hdegree) +omit [Fintype K] in /-- Proposition 2 in the swapped orientation `(u,v)=(y^n,x^m)`. -/ theorem planeCurvePropositionTwo_swapped_of_auxiliaryBounds {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean index dd9c11e733..440c67a15d 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean @@ -121,13 +121,14 @@ noncomputable def exactConstantExtensionUpstairsFinitePlace include hExact -omit [DecidableEq C] [DecidableEq (RatFunc C)] - [DecidableEq (RatFunc S)] in +omit [Fintype C] [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- The residue field of an upstairs height-one ideal is finite. -/ -theorem exactConstantExtensionUpstairsResidueField_finite +theorem exactConstantExtensionUpstairsResidueField_finite [Finite C] (q : IsDedekindDomain.HeightOneSpectrum (integralClosure S[X] (ExactConstantExtension C N S))) : Finite q.asIdeal.ResidueField := by + let : Fintype C := Fintype.ofFinite C let : Field (ExactConstantExtension C N S) := exactConstantExtensionField C N S hExact let : Algebra (RatFunc S) (ExactConstantExtension C N S) := @@ -156,10 +157,10 @@ theorem exactConstantExtensionUpstairsResidueField_finite let r₂ := heightOneResidueFieldRingEquiv e₂.toRingEquiv qTensor exact Finite.of_injective (r₂ ∘ r₁) (r₂.injective.comp r₁.injective) -omit [DecidableEq C] [DecidableEq (RatFunc C)] - [DecidableEq (RatFunc S)] in +omit [Fintype C] [DecidableEq C] [DecidableEq S] + [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- Every upstairs height-one ideal is maximal. -/ -theorem exactConstantExtensionUpstairsIdeal_isMaximal +theorem exactConstantExtensionUpstairsIdeal_isMaximal [Finite C] (q : IsDedekindDomain.HeightOneSpectrum (integralClosure S[X] (ExactConstantExtension C N S))) : q.asIdeal.IsMaximal := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean index 0af7930c17..887d1b2cdd 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -274,6 +274,8 @@ private theorem exactConstantExtensionSReciprocalPolynomialAlgebra_eq : (1 / RatFunc.X)) p rw [ratFuncToExactConstantExtension_reciprocal_X C S N hExact] +omit [Fintype C] [Finite S] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] in /-- The transported reciprocal `C[X]`-action is the actual action induced by the canonical embedding of `C(X)` into the exact constant extension. -/ theorem exactConstantExtensionCReciprocalPolynomialAlgebra_eq : @@ -492,6 +494,9 @@ private noncomputable def exactConstantExtensionOldToCReciprocalNormalizationMap exact (IsScalarTower.toAlgHom C[X] N (ExactConstantExtension C N S)).mapIntegralClosure +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] in /-- The normalization equivalence carries the old normalization embedded in the right tensor factor to its canonical map into the exact extension. -/ private theorem @@ -553,6 +558,9 @@ theorem primeUnderReciprocalOrigin_eq_origin exact ((hoPrime.isMaximal hoNeBot).eq_of_le (inferInstance : p.IsPrime).ne_top hle).symm +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] in private theorem exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv_commutes (p : C[X]) : @@ -1256,6 +1264,7 @@ theorem exactConstantExtensionConstantQuotient_action_on_infinityNormalization : (ExactConstantExtension C N S)) : ExactConstantExtension C N S) := rfl +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- Every infinity place is unramified in an exact extension of constants. -/ theorem exactConstantExtensionInfinityPlace_ramificationIdx_eq_one (Q : letI : Field (ExactConstantExtension C N S) := diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean index 9698cb8e1f..4aaf6064b7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionPlaceSplittingMultiplicity.lean @@ -146,6 +146,8 @@ local instance splittingTargetPolynomialAlgebra : variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] in /-- Every finite place is unramified in an exact extension of constants. -/ theorem exactConstantExtensionFinitePlace_ramificationIdx_eq_one (Q : letI : Field (ExactConstantExtension C N S) := @@ -426,6 +428,8 @@ noncomputable def exactConstantExtensionPresentedFinitePlaceEquiv : C S N hExact))).symm exact first.trans (second.trans third) +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in @[simp] theorem exactConstantExtensionPresentedFinitePlaceEquiv_apply (q : IsDedekindDomain.HeightOneSpectrum diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean index 4785cf4573..2622e147b4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/DedekindDifferentLocalTrace.lean @@ -217,7 +217,7 @@ theorem finite_badDifferentCount_set (hdiff : differentIdeal A B ≠ ⊥) (y : L simp omit [IsIntegralClosure B A L] in -omit [IsIntegrallyClosed A] [IsDomain A] in +omit [IsIntegrallyClosed A] in theorem exists_base_multiplier_clearing_different_counts [IsDedekindDomain A] (hdiff : differentIdeal A B ≠ ⊥) @@ -337,7 +337,7 @@ theorem exists_base_multiplier_clearing_different_counts (A := A) (B := B) (L := L) q c 0 hc0 (by simp) omega -omit [IsDomain A] [IsIntegrallyClosed A] in +omit [IsIntegrallyClosed A] in theorem valuation_trace_le_one_of_different_count_bounds_over [IsDedekindDomain A] (p : HeightOneSpectrum A) {y : L} (hy : y ≠ 0) diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean index 9af9a93e7f..c7666217e0 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFinitePlaceCompatibility.lean @@ -211,6 +211,8 @@ noncomputable def exactConstantExtensionCompatibleBaseFinitePlace C S N hExact))).symm (exactConstantExtensionUpstairsFinitePlace C S N hExact q) +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in @[simp] theorem exactConstantExtensionCompatibleBaseFinitePlace_baseChange (q : IsDedekindDomain.HeightOneSpectrum @@ -298,6 +300,8 @@ noncomputable def exactConstantExtensionFiniteClosureBaseChangeAlgEquiv : (algebraMap S (RatFunc S) s) exact (ratFuncToExactConstantExtension C S N hExact).commutes s |>.symm } +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The actual upstairs finite place is exactly the transport of the presented prime along the equality bridge from the compatible polynomial normalization to the canonical rational-function normalization. -/ @@ -423,6 +427,8 @@ noncomputable def exactConstantExtensionCompatibleResidueFieldAlgEquiv (exactConstantExtensionUpstairsFinitePlace C S N hExact q).asIdeal.comap e rfl +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The two representations of the upstairs place have the same residue degree over the enlarged constants. -/ theorem exactConstantExtensionCompatibleResidueField_finrank_eq @@ -541,6 +547,7 @@ theorem exactConstantExtensionCompatibleBaseFinitePlace_degree_eq rw [exactConstantExtensionCompatibleBaseFinitePlace_baseChange, hRational, Nat.mul_one] +omit [DecidableEq C] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in /-- Restricting the compatible `C[X]`-place to the original function field recovers the downstairs place obtained by contracting the explicit constant extension ideal. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean index 7f78558976..04b294a983 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceBridge.lean @@ -134,6 +134,7 @@ theorem finitePlaceGalSmul_eq_self_over_rationalFinitePlace_of_finrank_dvd_degre end GenericUniqueFiber +omit [Fintype C] [Finite S] in /-- Every finite place of the exact constant extension, viewed over the original constants `C`, has degree divisible by `[S : C]`. This is the degree-theoretic expression of the inclusion of `S` in every top residue @@ -206,6 +207,8 @@ noncomputable def exactConstantExtensionFrobeniusTwistOverFixedField exact IntermediateField.subgroupEquivAlgEquiv H ⟨sigma, Subgroup.mem_zpowers sigma⟩ +omit [DecidableEq C] [DecidableEq (RatFunc C)] [Algebra.IsSeparable (RatFunc C) N] [Finite S] + [DecidableEq S] [DecidableEq (RatFunc S)] in @[simp] theorem exactConstantExtensionFrobeniusTwistOverFixedField_apply (hExact : algebraicClosure C N = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean index aa2f377de9..6b71accc3b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean @@ -87,6 +87,8 @@ private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft exactConstantExtensionConstantAlgEquivOverBase, exactConstantExtensionFunctionAlgEquivOverBase] +omit [DecidableEq C] [DecidableEq (RatFunc C)] [Algebra.IsSeparable (RatFunc C) N] [Finite S] + [DecidableEq S] [DecidableEq (RatFunc S)] in /-- The canonical twist generates the full Galois group over its fixed field. This is a direct consequence of defining that fixed field from the cyclic subgroup generated by the ambient twist. -/ @@ -421,6 +423,7 @@ theorem finitePlaceGalSmul_eq_of_apply_eq Ideal.mem_pointwise_smul_iff_inv_smul_mem, hsmul g₁⁻¹ g₂⁻¹ happly_inv x] +omit [DecidableEq C] [DecidableEq (RatFunc C)] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- Every finite place of the exact constant extension is unramified over a Frobenius-twist fixed field, provided the twist has the full constant-extension order. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean index 10007216ca..792eab5379 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistInfinityPlaceDescent.lean @@ -568,6 +568,7 @@ private theorem exactConstantExtensionFrobeniusTwist_zpow_includeLeft_infinity exactConstantExtensionConstantAlgEquivOverBase, exactConstantExtensionFunctionAlgEquivOverBase] +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- Every infinity place of the exact constant extension is unramified over a Frobenius-twist fixed field, provided the twist has the full constant-extension order. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean index 6aa210a2a0..b150a1d0aa 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionInfinityPlaceCompatibility.lean @@ -167,6 +167,7 @@ private theorem hTransport exact hExactTransport.trans hFinite +omit [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The affine-to-infinity localization square commutes on elements of the old reciprocal normalization. -/ private theorem exactConstantExtensionInfinityAffineLocalizationSquare_coe diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 0332623d41..197660c0dc 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -200,6 +200,10 @@ noncomputable def intermediateFrobeniusTwistFieldRatFuncAlgebra ((show L →+* F from algebraMap L F).comp (show RatFunc C →+* L from algebraMap (RatFunc C) L)) +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in /-- The induced rational-function algebra is compatible with the inclusion of the twist field into the exact constant extension. -/ theorem intermediateFrobeniusTwistField_ratFunc_tower @@ -364,6 +368,10 @@ noncomputable def intermediateFrobeniusTwistOverFixedField exact IntermediateField.subgroupEquivAlgEquiv H ⟨sigma, Subgroup.mem_zpowers sigma⟩ +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [IsGalois L N] in @[simp] theorem intermediateFrobeniusTwistOverFixedField_apply (g : N ≃ₐ[L] N) (x : ExactConstantExtension C N S) : @@ -380,6 +388,10 @@ theorem intermediateFrobeniusTwistOverFixedField_apply C L N S hExact g).toEquiv x = _ rfl +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [IsGalois L N] in /-- The twist over its fixed field generates the full relative Galois group. -/ theorem intermediateFrobeniusTwistOverFixedField_zpowers_eq_top @@ -639,6 +651,9 @@ theorem intermediateFrobeniusTwistField_finitePlace_ramificationIdx_eq_one rw [hInertia] exact Nat.card_unique +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in /-- Restriction of an exact-constant-extension finite place through `N` agrees with direct restriction to the intermediate field `L`. -/ private theorem finitePlaceUnder_intermediate_original @@ -1575,6 +1590,10 @@ theorem exactConstantExtensionFrobeniusTwist_restrictScalars_apply exactConstantExtensionFunctionAlgEquivOverBase] | add x y hx hy => simp [hx, hy] +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [Algebra.IsSeparable (RatFunc C) N] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in /-- Equality of the two twists as `C(X)`-automorphisms. -/ theorem exactConstantExtensionFrobeniusTwist_restrictScalars (g : N ≃ₐ[L] N) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean index 2ae1198df4..100aedde3a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -171,6 +171,7 @@ noncomputable instance (FunctionFieldNormalClosure K F) omit [Algebra K F] [IsScalarTower K (RatFunc K) F] in +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The normal closure remains Galois after replacing the constant-base fixed field by its canonical rational-function presentation `C(X)`. -/ theorem functionFieldNormalClosure_isGalois_over_constantRatFunc : @@ -191,6 +192,8 @@ theorem functionFieldNormalClosure_isGalois_over_constantRatFunc : rw [← e.commutes] simp +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra K F] + [IsScalarTower K (RatFunc K) F] in /-- Exactness of the full normal-closure constant field, stated for the constant algebra obtained by restricting the canonical `C(X)` presentation. This is the exact instance expected by the generic tower API. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean index e79426591e..4f902c3735 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionDivisorClassRecurrence.lean @@ -75,6 +75,7 @@ def finiteExtensionDivisorClassMap : QuotientAddGroup.mk' (finiteExtensionPrincipalDivisorSubgroup K L) omit [Fintype K] in +omit [DecidableEq K] in @[simp] theorem finiteExtensionDivisorClassMap_principal (x : L) (hx : x ≠ 0) : @@ -122,6 +123,7 @@ def finiteExtensionDivisorClassRepresentative Quotient.out c omit [Fintype K] in +omit [DecidableEq K] in @[simp] theorem finiteExtensionDivisorClassMap_representative (c : FiniteExtensionDivisorClass K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index 180288799c..15a74c598a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -795,6 +795,8 @@ theorem exists_gal_smul_finitePlace_asIdeal_of_same_under simpa only [finitePlaceUnder_asIdeal] using congrArg HeightOneSpectrum.asIdeal hPQ +omit [DecidableEq K] [DecidableEq (RatFunc K)] [Algebra.IsSeparable (RatFunc K) M] + [Algebra.IsSeparable (RatFunc K) L] in /-- Each finite-place restriction fiber is a transitive relative Galois set. -/ theorem finitePlaceUnderFiberGalAction_isPretransitive @@ -999,6 +1001,7 @@ theorem exists_gal_smul_infinityPlace_asIdeal_of_same_under simpa only [infinityPlaceUnder_asIdeal] using congrArg Subtype.val hPQ +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) L] in /-- Each infinity-place restriction fiber is a transitive relative Galois set. -/ theorem infinityPlaceUnderFiberGalAction_isPretransitive @@ -1092,6 +1095,7 @@ theorem infinityPlaceRelative_ramificationIdx_inertiaDeg_eq_of_same_under · unfold infinityPlaceRelativeInertiaDeg rw [hg, Ideal.inertiaDeg_smul] +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- In a Galois tower, the number of finite places in a restriction fiber times their common ramification index and inertia degree is the relative field degree. -/ @@ -1119,6 +1123,7 @@ theorem finitePlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_f K M L Q.1 Q₀.1 (Q.2.trans Q₀.2.symm) rw [he, hf] +omit [DecidableEq K] in /-- The analogous Galois decomposition formula for a restriction fiber above infinity. -/ theorem infinityPlaceUnderFiber_card_mul_ramificationIdx_mul_inertiaDeg_eq_field_finrank diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean index 1b9e4b2606..05b6e58933 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionRiemannRoch.lean @@ -445,6 +445,7 @@ def finiteExtensionPlaceValuation : | .inr P => (primeOverHeightOne (ratFuncInfinityPlace K) P).valuation L +omit [Fintype K] [DecidableEq K] in /-- Every exhaustive BGS place carries exactly the normalized valuation of its corresponding Riemann--Roch chart place. -/ theorem finiteExtensionPlaceValuation_eq_chart @@ -462,6 +463,7 @@ def finiteExtensionDivisorEquivChart : FunctionField.Chart.DivisorA K L := Finsupp.domCongr (finiteExtensionPlaceEquivChart K L) +omit [Fintype K] in /-- Divisor degree is preserved by the exhaustive-place/chart equivalence. -/ theorem finiteExtensionDivisorDegree_eq_chart (D : FiniteExtensionDivisor K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean index 0187f21c6e..8b368e7876 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean @@ -185,6 +185,9 @@ noncomputable def infinityPlaceOfDegreeGalAction (d : ℕ) : apply Subtype.ext exact mul_smul g h P.1 } +omit [DecidableEq K] [DecidableEq (RatFunc K)] + [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- On a finite-place restriction fiber, the point stabilizer is the usual decomposition group of the underlying place. -/ theorem finitePlaceUnderFiber_stabilizer_eq_decompositionGroup diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean index 1bccd44d13..3064bd1b8a 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureConstants.lean @@ -155,6 +155,7 @@ local instance normalClosureConstantModule : Module K (FunctionFieldNormalClosureConstantField K L) := Algebra.toModule omit [DecidableEq (RatFunc K)] in +omit [DecidableEq K] in /-- Frobenius on the finite algebraic constant field has order equal to its degree over `K`. -/ theorem orderOf_functionFieldNormalClosureConstantFrobenius : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean index bda47af1cc..27a310a63f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureOriginalCompositum.lean @@ -360,6 +360,7 @@ noncomputable instance functionFieldNormalClosure_isGalois_over_originalComposit (FunctionFieldNormalClosureOriginalCompositum K F hExact) (FunctionFieldNormalClosure K F) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- Enlarging the original function field to `CF` introduces exactly the constants `C` and no others. -/ theorem functionFieldNormalClosureOriginalCompositumConstantField_isExact @@ -410,6 +411,7 @@ whose constant algebra is definitionally this restriction. -/ RingHom.toAlgebra ((algebraMap (RatFunc K) F).comp (algebraMap K (RatFunc K))) +omit [DecidableEq K] [DecidableEq (RatFunc K)] in private theorem originalMultiplicationCanonicalRatFunc_X : let : Algebra K F := functionFieldCanonicalConstantAlgebra K F let : IsScalarTower K (RatFunc K) F := IsScalarTower.of_algebraMap_eq' rfl diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean index 8f04684847..9dbe104895 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FunctionFieldNormalClosureRatFuncEquiv.lean @@ -75,6 +75,7 @@ noncomputable def functionFieldNormalClosureConstantBaseRatFuncAlgHom : FunctionFieldNormalClosureConstantBase K L := (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K L).toAlgHom +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The rational-function specialization onto the kernel fixed field is surjective because the parameter generates that field over its constants. -/ theorem functionFieldNormalClosureConstantBaseRatFuncAlgHom_surjective : @@ -82,6 +83,7 @@ theorem functionFieldNormalClosureConstantBaseRatFuncAlgHom_surjective : (functionFieldNormalClosureConstantBaseRatFuncAlgHom K L) := (functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K L).surjective +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in @[simp] theorem functionFieldNormalClosureConstantBaseRatFuncAlgEquiv_X : functionFieldNormalClosureConstantBaseRatFuncAlgEquiv K L RatFunc.X = diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean index c22659f87f..c4e227e33b 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointPoleSemigroup.lean @@ -205,6 +205,7 @@ def onePointPoleOrderSemigroup exact add_nonneg (hxAway v hv) (hyAway v hv) omit [Fintype K] in +omit [DecidableEq K] in @[simp] theorem mem_onePointPoleOrderSemigroup_iff (P : FiniteExtensionPlace K L) (n : ℕ) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean index ee3c1c9dcd..ffe613443e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovBasisGrid.lean @@ -77,11 +77,12 @@ local instance basisGridConstantTower : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl +omit [DecidableEq K] in /-- A bounded distinct first pole-order digit and an arbitrary linearly independent second family produce a linearly independent Frobenius product grid. -/ theorem onePointStepanovBasisGrid_linearIndependent - {α β : Type*} [Fintype α] [Fintype β] + {α β : Type*} [Finite α] [Finite β] (P : FiniteExtensionPlace K L) (u : α → L) (d : α → ℕ) (v : β → L) (hu : ∀ i, u i ≠ 0) @@ -93,6 +94,8 @@ theorem onePointStepanovBasisGrid_linearIndependent LinearIndependent K (fun ij : α × β => u ij.1 * (v ij.2) ^ Fintype.card K) := by classical + let : Fintype α := Fintype.ofFinite α + let : Fintype β := Fintype.ofFinite β rw [Fintype.linearIndependent_iff] intro c hrelation ij by_contra hcZero diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean index c975ca3e26..3f83efdaf7 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/OnePointStepanovGrid.lean @@ -43,13 +43,15 @@ local instance onePointStepanovGridConstantTower : IsScalarTower K (RatFunc K) L := IsScalarTower.of_algebraMap_eq' rfl +omit [Fintype K] [DecidableEq K] in /-- Multiplication by a nonzero constant does not change the order at an exhaustive place. -/ -theorem finiteExtensionPrincipalDivisor_smul_apply +theorem finiteExtensionPrincipalDivisor_smul_apply [Finite K] (P : FiniteExtensionPlace K L) (c : K) (x : L) (hc : c ≠ 0) (hx : x ≠ 0) : finiteExtensionPrincipalDivisor K L (c • x) P = finiteExtensionPrincipalDivisor K L x P := by + classical have hcL : algebraMap K L c ≠ 0 := by simpa only [map_zero] using (algebraMap K L).injective.ne hc rw [Algebra.smul_def, @@ -161,16 +163,18 @@ theorem finiteExtensionPrincipalDivisor_sum_eq_of_unique_min exact finiteExtensionPrincipalDivisor_add_eq_left_of_lt K L P (f i) r (hf i hi) hrest0 hrestOrder +omit [Fintype K] [DecidableEq K] in /-- A finite family of nonzero functions with pairwise distinct orders at one exhaustive place is linearly independent over the constant field. -/ -theorem linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order - {ι : Type*} [Fintype ι] +theorem linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order [Finite K] + {ι : Type*} [Finite ι] (P : FiniteExtensionPlace K L) (f : ι → L) (hf : ∀ i, f i ≠ 0) (horder : Function.Injective (fun i => finiteExtensionPrincipalDivisor K L (f i) P)) : LinearIndependent K f := by classical + let : Fintype ι := Fintype.ofFinite ι rw [Fintype.linearIndependent_iff] intro c hrelation by_contra hnotZero @@ -243,7 +247,7 @@ theorem onePointStepanovMixedOrder_injective exact Nat.eq_of_mul_eq_mul_left hs hmul exact Prod.ext rfl (he heEq) -omit [Fintype K] in +omit [Fintype K] [DecidableEq K] in /-- Exact order of a product in the one-point Stepanov grid. -/ theorem onePointStepanovGrid_order {ι κ : Type*} (P : FiniteExtensionPlace K L) @@ -265,10 +269,11 @@ theorem onePointStepanovGrid_order push_cast ring +omit [Fintype K] [DecidableEq K] in /-- Two strict-level families whose first pole-order digit is below `s` produce a linearly independent Stepanov product grid. -/ -theorem onePointStepanovGrid_linearIndependent - {ι κ : Type*} [Fintype ι] [Fintype κ] +theorem onePointStepanovGrid_linearIndependent [Finite K] + {ι κ : Type*} [Finite ι] [Finite κ] (P : FiniteExtensionPlace K L) (f : ι → L) (g : κ → L) (d : ι → ℕ) (e : κ → ℕ) (s : ℕ) (hf : ∀ i, f i ≠ 0) (hg : ∀ j, g j ≠ 0) @@ -279,6 +284,7 @@ theorem onePointStepanovGrid_linearIndependent (hd : Function.Injective d) (he : Function.Injective e) (hdigit : ∀ i, d i < s) : LinearIndependent K (fun ij : ι × κ => f ij.1 * (g ij.2) ^ s) := by + classical apply linearIndependent_of_injective_finiteExtensionPrincipalDivisor_order K L P · intro ij diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean index fb84688953..e72e6c9492 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePole.lean @@ -79,6 +79,7 @@ theorem finiteExtensionHeight_planeCurveFirstCoordinate hf hpartialSecond 1 (by omega) simpa only [x, pow_one, one_mul] using hpositive +omit [Fintype K] in /-- Equivalently, the effective pole divisor of the first coordinate has degree equal to the degree of the plane equation in the second variable. -/ theorem finiteExtensionDivisorDegree_planeCurveFirstCoordinate_poleDivisor @@ -141,6 +142,7 @@ theorem finiteExtensionPlaceDegree_le_divisorDegree_of_effective_of_pos exact Finset.single_le_sum (fun v _hv => mul_nonneg (hD v) (by positivity)) hPmem +omit [Fintype K] [DecidableEq K] in /-- The first-coordinate pole divisor has nonempty support. -/ theorem planeCurveFirstCoordinate_poleDivisor_support_nonempty {f : MvPolynomial (Fin 2) K} (hf : Irreducible f) @@ -154,6 +156,7 @@ theorem planeCurveFirstCoordinate_poleDivisor_support_nonempty letI := separable_planeCurveFunctionField_over_ratFunc hf hpartialSecond (finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0)).support.Nonempty := by + classical let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf @@ -181,6 +184,7 @@ theorem planeCurveFirstCoordinate_poleDivisor_support_nonempty degreeOf_second_pos_of_pderiv_ne_zero hpartialSecond omega +omit [Fintype K] in /-- There is a pole place for the first coordinate. Its coefficient in the pole divisor is positive, and its (not necessarily one) place degree lies between one and the degree of the plane equation in the second variable. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean index e567e6ccd3..f9261210c5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneCoordinatePoleAtInfinity.lean @@ -98,7 +98,7 @@ local instance coordinatePoleInfinityIntegralClosureIsFractionRing : (RatFuncInfinityIntegers K) (RatFunc K) L (RatFuncInfinityIntegralClosure K L) -omit [Fintype K] in +omit [Fintype K] [DecidableEq K] in private theorem principalDivisor_algebraMap_X_inl_nonnegative (q : FiniteExtensionFinitePlace K L) : 0 ≤ finiteExtensionPrincipalDivisor K L @@ -120,7 +120,7 @@ private theorem principalDivisor_algebraMap_X_inl_nonnegative rw [finiteExtensionPrincipalDivisor_inl, hrepr] exact finitePlaceOrder_algebraMap_nonnegative q s hs -omit [Fintype K] in +omit [Fintype K] [DecidableEq K] in /-- At every place above the rational-function place at infinity, the image of `RatFunc.X` has strictly negative order. This is stronger than merely knowing that some infinity place is a pole: it makes the pole divisor of the @@ -185,7 +185,7 @@ theorem finiteExtensionPrincipalDivisor_algebraMap_X_inr_negative variable {K} -omit [Fintype K] in +omit [Fintype K] [DecidableEq K] in /-- The first plane coordinate has nonnegative principal-divisor order at every finite place in its rational-function model. -/ theorem finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegative @@ -201,6 +201,7 @@ theorem finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegativ ∀ q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f), 0 ≤ finiteExtensionPrincipalDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (.inl q) := by + classical let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf @@ -220,7 +221,7 @@ theorem finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegativ rw [← planeCurveFirstCoordinateRatFuncAlgebra_X f hx] exact principalDivisor_algebraMap_X_inl_nonnegative K L q -omit [Fintype K] in +omit [Fintype K] [DecidableEq K] in /-- Consequently, the pole divisor of the first plane coordinate vanishes at every finite place. -/ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero @@ -236,6 +237,7 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero ∀ q : FiniteExtensionFinitePlace K (PlaneCurveFunctionField f), finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (.inl q) = 0 := by + classical let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf @@ -256,7 +258,7 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inl_eq_zero (finiteExtensionPrincipalDivisor_planeCurveFirstCoordinate_inl_nonnegative hf hpartialSecond q))] -omit [Fintype K] in +omit [Fintype K] [DecidableEq K] in /-- Every place above infinity occurs with positive coefficient in the pole divisor of the first plane coordinate. -/ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive @@ -272,6 +274,7 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive ∀ P : FiniteExtensionInfinityPlace K (PlaneCurveFunctionField f), 0 < finiteExtensionPoleDivisor K (PlaneCurveFunctionField f) (planeCurveFunction f 0) (.inr P) := by + classical let : IsDomain (PlaneCurveCoordinateRing f) := planeCurveCoordinateRing_isDomain hf let hx := firstCoordinate_transcendental hf @@ -296,6 +299,7 @@ theorem finiteExtensionPoleDivisor_planeCurveFirstCoordinate_inr_positive rw [finiteExtensionPoleDivisor_apply, ite_eq_left hnegative] omega +omit [Fintype K] in /-- The controlled pole place for the first plane coordinate lies above the rational-function place at infinity. Its positive pole coefficient and place-degree bound are the same as in `exists_planeCurveFirstCoordinate_polePlace`. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean index 11f357ec9e..f678c56639 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/PlaneOnePointRiemannLower.lean @@ -61,6 +61,7 @@ def planeMonomialPoleLevel (x y : L) (n b : ℕ) (P : FiniteExtensionPlace K L) : ℕ := (planeMonomialPoleBudget K L x y n b P).toNat +omit [Fintype K] [DecidableEq K] in /-- The selected pole level is an explicit arithmetic progression in `n`. -/ theorem planeMonomialPoleLevel_eq (x y : L) (n b : ℕ) (P : FiniteExtensionPlace K L) : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean index dbb9b87f73..1295b83f91 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/SquareFieldStepanovRestriction.lean @@ -268,6 +268,7 @@ variable (L : Type*) [Field L] [Algebra (RatFunc S) L] [FiniteDimensional (RatFunc S) L] [Algebra.IsSeparable (RatFunc S) L] +omit [DecidableEq S] in /-- Finite-place form of semilinear square-field vanishing. The function field and its places are over the full constant field `S`; `K` supplies the half-Frobenius exponent. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean index f2dda22ad8..aa3e206581 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovSquareVanishing.lean @@ -177,6 +177,7 @@ variable (L : Type*) [Field L] [Algebra (RatFunc K) L] [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] +omit [DecidableEq K] in /-- Finite-place form used after the two Stepanov restriction maps. The families are assumed regular at `q`. The residue hypothesis is stated diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean index a9944938af..e1a53b6711 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/FixedPointFreeMaximalDivisorTraceCount.lean @@ -100,6 +100,7 @@ def nonTwoTorsionMaximalDivisorTraceCover (maximalDivisorsBelow (Fintype.card G) bound).biUnion fun m => (nonTwoTorsionElementsWithPowOne (G := G) m).image trace +omit [IsCyclic G] in /-- Every bounded-order non-two-torsion trace lies in the fixed-point-free maximal-divisor cover. -/ theorem nonTwoTorsionBoundedOrderTraceSet_subset_maximalDivisorTraceCover diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean index 69c3ad3518..5109fb4811 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/AxisEquivalence.lean @@ -26,7 +26,7 @@ namespace BGS.Markoff noncomputable section /-- Swapping the first two normalized coordinates as an equivalence. -/ -private def normalizedSwap12Equiv (R : Type*) : +def normalizedSwap12Equiv (R : Type*) : NormalizedPoint R ≃ NormalizedPoint R where toFun := normalizedSwap12 invFun := normalizedSwap12 @@ -34,7 +34,7 @@ private def normalizedSwap12Equiv (R : Type*) : right_inv x := by ext <;> rfl /-- Swapping the last two normalized coordinates as an equivalence. -/ -private def normalizedSwap23Equiv (R : Type*) : +def normalizedSwap23Equiv (R : Type*) : NormalizedPoint R ≃ NormalizedPoint R where toFun := normalizedSwap23 invFun := normalizedSwap23 @@ -43,7 +43,7 @@ private def normalizedSwap23Equiv (R : Type*) : /-- Permute the first incidence point so that its outer coordinate is first and its bridge coordinate is third. -/ -private def cageFirstPointCanonicalEquiv (R : Type*) +def cageFirstPointCanonicalEquiv (R : Type*) (axis other : NormalizedCoordinateAxis) : NormalizedPoint R ≃ NormalizedPoint R := match axis, other with @@ -66,7 +66,7 @@ private def cageFirstPointCanonicalEquiv (R : Type*) /-- Permute the second incidence point so that its outer coordinate is second and its bridge coordinate is third. -/ -private def cageSecondPointCanonicalEquiv (R : Type*) +def cageSecondPointCanonicalEquiv (R : Type*) (axis other : NormalizedCoordinateAxis) : NormalizedPoint R ≃ NormalizedPoint R := match axis, other with @@ -88,7 +88,8 @@ private def cageSecondPointCanonicalEquiv (R : Type*) | .third, .third => (normalizedSwap12Equiv R).trans (normalizedSwap23Equiv R) -private theorem cageFirstPointCanonical_mem +/-- Canonicalizing the first incidence point preserves its outer and bridge coordinates. -/ +theorem cageFirstPointCanonical_mem {R : Type*} [CommRing R] (axis other : NormalizedCoordinateAxis) (xi middle : R) {x : NormalizedPoint R} @@ -113,7 +114,8 @@ private theorem cageFirstPointCanonical_mem exact hSurface · exact hMiddle -private theorem cageSecondPointCanonical_mem +/-- Canonicalizing the second incidence point preserves its outer and bridge coordinates. -/ +theorem cageSecondPointCanonical_mem {R : Type*} [CommRing R] (axis other : NormalizedCoordinateAxis) (eta middle : R) {x : NormalizedPoint R} diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean index 7b8a37624c..64e0c3a28e 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/WitnessEquations.lean @@ -70,7 +70,8 @@ private theorem second_incidence_discriminant_equation simp only [normalizedPolynomial] at hSurface ⊢ linear_combination -4 * hSurface -private theorem normalized_first_third_point_of_discriminant_equation +/-- A first-coordinate discriminant equation reconstructs a normalized Markoff point. -/ +theorem normalized_first_third_point_of_discriminant_equation {K : Type*} [Field K] (hTwo : (2 : K) ≠ 0) (xi middle root : K) (hEquation : @@ -81,7 +82,8 @@ private theorem normalized_first_third_point_of_discriminant_equation field_simp [hTwo] linear_combination -hEquation -private theorem normalized_second_third_point_of_discriminant_equation +/-- A second-coordinate discriminant equation reconstructs a normalized Markoff point. -/ +theorem normalized_second_third_point_of_discriminant_equation {K : Type*} [Field K] (hTwo : (2 : K) ≠ 0) (eta middle root : K) (hEquation : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean index b02887704b..12134b5f1f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/LargeOrderToMaximal.lean @@ -22,7 +22,8 @@ namespace BGS.Markoff noncomputable section -private theorem three_ne_zero_zmod_of_prime_ne_three +/-- Three is nonzero in a prime residue field of characteristic different from three. -/ +theorem endgame_three_ne_zero_zmod_of_prime_ne_three (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by intro hzero have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero @@ -40,7 +41,7 @@ theorem exists_threshold_sameComponent_maximalRotation_of_large_firstCoordinate {δ : ℝ} (hδ : 0 < δ) : ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) ∀ x : NormalizedMarkoffSurface (ZMod p), (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u1 → ∃ y : NormalizedMarkoffSurface (ZMod p), @@ -51,7 +52,7 @@ theorem exists_threshold_sameComponent_maximalRotation_of_large_firstCoordinate refine ⟨max threshold 5, ?_⟩ intro p hp _ hpThree let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hlarge have hpThreshold : threshold ≤ p := (le_max_left threshold 5).trans hp let xf : ↥(normalizedFiber1 x.1.u1) := ⟨x.1, x.property, rfl⟩ @@ -72,7 +73,7 @@ theorem exists_threshold_sameComponent_maximalRotation_of_some_largeCoordinate {δ : ℝ} (hδ : 0 < δ) : ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) ∀ x : NormalizedMarkoffSurface (ZMod p), ((p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u1 ∨ (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u2 ∨ @@ -85,7 +86,7 @@ theorem exists_threshold_sameComponent_maximalRotation_of_some_largeCoordinate refine ⟨threshold, ?_⟩ intro p hp _ hpThree let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hlarge rcases hlarge with hfirstLarge | hsecondLarge | hthirdLarge · exact hfirst p hp hpThree x hfirstLarge diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean index dc9fa2c816..da118adef6 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedTraceCurve.lean @@ -29,8 +29,8 @@ noncomputable section variable (p : ℕ) [Fact p.Prime] -private abbrev F := ZMod p -private abbrev E := quadraticFiniteField p +local notation "F" => ZMod +local notation "E" => quadraticFiniteField noncomputable local instance : Fintype (E p) := Fintype.ofFinite (E p) noncomputable local instance : DecidableEq (quadraticNormOneTorus p) := Classical.decEq _ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean index 9e9799d977..ae30c17c3b 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/TraceCurve/LaurentNormalization.lean @@ -39,7 +39,8 @@ variable [Algebra K A] [Algebra K B] [Algebra K C] variable [IsDomain A] [IsDomain B] [IsDomain C] omit [IsDomain A] [IsDomain B] in -private theorem fractionRingEquiv_maps_integral +/-- The induced fraction-field equivalence preserves elements integral over the base ring. -/ +theorem fractionRingEquiv_maps_integral (e : A ≃ₐ[K] B) (x : integralClosure A (FractionRing A)) : IsIntegral B ((IsFractionRing.algEquivOfAlgEquiv From 795228f8540635fcd01678eba3a12215728abe11 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 03:56:15 +0000 Subject: [PATCH 34/37] Share exported Markoff field proofs and trim unused section hypotheses --- ...teExtensionCanonicalAuxiliaryFinitePlace.lean | 3 +++ ...nCanonicalAuxiliaryFinitePlaceNormalized.lean | 1 + ...ensionCanonicalGlobalNormalizedAutomatic.lean | 1 + .../FiniteExtensionCanonicalWronskian.lean | 1 + .../FiniteExtensionExceptionalSupport.lean | 2 ++ .../PlaneCurveCanonicalDegreeBound.lean | 1 + ...tantExtensionClosedPlaceSplittingFormula.lean | 2 ++ .../ConstantExtensionFinitePlaceBridge.lean | 1 + ...ensionInfinityPlaceSplittingMultiplicity.lean | 3 +++ ...xtensionFrobeniusTwistFinitePlaceAverage.lean | 2 ++ ...nsionFrobeniusTwistFinitePlaceUnramified.lean | 2 ++ ...ensionFrobeniusTwistRationalPlaceAverage.lean | 1 + ...rmediateFrobeniusTwistFinitePlaceAverage.lean | 10 ++++++++++ ...sionIntermediateFrobeniusTwistHasseBound.lean | 4 ++++ ...ediateFrobeniusTwistRationalPlaceAverage.lean | 5 +++++ ...ExactConstantExtensionNormalClosureTower.lean | 2 ++ ...FiniteExtensionCanonicalDifferentCotrace.lean | 4 ++++ ...iteExtensionCanonicalDifferentGenusBound.lean | 1 + .../BGS/HasseWeil/FiniteExtensionHasseWeil.lean | 2 ++ .../BGS/HasseWeil/FiniteExtensionPlaceTower.lean | 2 ++ .../BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean | 4 ++++ .../BGS/HasseWeil/StepanovRestrictionMaps.lean | 1 + .../BGS/Markoff/Assembly/GiantOrbit.lean | 10 +--------- .../Markoff/Assembly/MiddleGameThenEndgame.lean | 16 ++++------------ .../BGS/Markoff/Cage/Connectivity.lean | 16 ++++------------ .../Nonsplit/DescendedIrreducibility.lean | 4 ++-- 26 files changed, 66 insertions(+), 35 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean index 0a1acab277..66f885a99e 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlace.lean @@ -114,6 +114,7 @@ private theorem finitePlaceOrder_gridMonomial_eq_zero rw [hmul, hupow, hvpow, huOrder, hvOrder] simp +omit [DecidableEq K] in /-- Finite-place source case (i), specialized to the consecutive derivative orders on the source auxiliary family. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI @@ -257,6 +258,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII exact_mod_cast hbound simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hboundInt +omit [DecidableEq K] in /-- Finite-place source case (iii), expressed directly with the global principal divisor and the consecutive-order Wronskian. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII @@ -320,6 +322,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIII finiteExtensionFinitePlace_gridOrder_sum_eq K L q u v hu hv h k] at hboundInt simpa only [finiteExtensionPrincipalDivisor_inl_eq_finitePlaceOrder] using hboundInt +omit [DecidableEq K] in /-- Finite-place source case (iv), in the same global-divisor form. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseIV (q : FiniteExtensionFinitePlace K L) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean index f64fac8f92..9edd030653 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalAuxiliaryFinitePlaceNormalized.lean @@ -94,6 +94,7 @@ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseI_of_normalized huOrder hvOrder hrhoOrder hW simpa only [normalizedFinitePlaceCanonicalDifferent, hcOrder] using hcase +omit [DecidableEq K] in /-- Canonical finite-place case (ii), outside the exceptional set without a pole of `(1-u)/(1-v)`. -/ theorem finiteExtensionFinitePlace_canonicalAuxiliary_caseII_of_normalized diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean index 72f5c23d97..ac8b3275c7 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalGlobalNormalizedAutomatic.lean @@ -436,6 +436,7 @@ noncomputable def probeAmbientReciprocalDerivation (-(algebraMap (RatFunc K) L RatFunc.X) ^ 2) • D.restrictScalars K +omit [FiniteDimensional (RatFunc K) L] [Algebra.IsSeparable (RatFunc K) L] in theorem probeAmbientReciprocalDerivation_extends (D : Derivation (frobeniusSubfield L p) L L) (hDX : D (algebraMap (RatFunc K) L RatFunc.X) = 1) diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean index aa06efa601..46f6e4face 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionCanonicalWronskian.lean @@ -118,6 +118,7 @@ private theorem finiteExtensionFinitePrincipalDivisor_algebraMap_eq_mapRange rw [finiteExtensionFinitePrincipalDivisor_algebraMap_apply K L d hd, Finsupp.mapRange_apply, idealMultiplicityDivisor_apply] +omit [DecidableEq (RatFunc K)] in /-- The weighted degree of the principal ideal of an integral element is the finite-place degree sum of that element in the exhaustive `K(X)` model. -/ theorem idealMultiplicityWeightedDegree_eq_finiteExtensionFiniteDirectDegreeSum diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean index 2fde63db2b..60e18d99f3 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/FiniteExtensionExceptionalSupport.lean @@ -848,6 +848,7 @@ theorem finiteExtensionFamilyOrder_v_positive_mem_exceptionalSet rw [Finsupp.mem_support_iff] exact ne_of_gt hw +omit [DecidableEq K] in /-- Every individual grid monomial has order zero away from the exceptional set. -/ theorem finiteExtensionPrincipalDivisor_gridMonomial_eq_zero_outside @@ -868,6 +869,7 @@ theorem finiteExtensionPrincipalDivisor_gridMonomial_eq_zero_outside change finiteExtensionPrincipalDivisor K L (f iV) w.1 = 0 at hv0 simp [hu0, hv0] +omit [DecidableEq K] in /-- The auxiliary grid product has order zero away from the zero and pole places of `u` and `v`. -/ theorem finiteExtensionPrincipalDivisor_auxiliaryGridProduct_eq_zero_outside diff --git a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean index de0393335e..f9d01ce6de 100644 --- a/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean +++ b/LeanPool/MarkoffModP/BGS/CorvajaZannier/PlaneCurveCanonicalDegreeBound.lean @@ -56,6 +56,7 @@ theorem planeCurvePolynomialInSecondCoordinate_discr_natDegree_le_degreeOf variable [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] +omit [DecidableEq (RatFunc K)] in /-- The sharp finite-different estimate implies the usual bidegree-only finite discriminant budget. The canonical theorem below retains the sharper intermediate discriminant so that it cancels against the infinity diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean index 28c7faa718..786d1b5eaf 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionClosedPlaceSplittingFormula.lean @@ -84,6 +84,8 @@ noncomputable def exactConstantExtensionPresentedUpstairsFinitePlaceEquiv : C S N hExact)) exact first.trans second +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] in /-- The exhaustive finite-place equivalence is definitionally the existing upstairs finite-place construction on presented primes. -/ @[simp] diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean index 440c67a15d..1cc7955ea4 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionFinitePlaceBridge.lean @@ -209,6 +209,7 @@ noncomputable def exactConstantExtensionDownstairsFinitePlace omit [DecidableEq C] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] in +omit [DecidableEq S] in @[simp] theorem exactConstantExtensionDownstairsFinitePlace_asIdeal (q : IsDedekindDomain.HeightOneSpectrum diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean index 887d1b2cdd..8b6eb455c9 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ConstantExtensionInfinityPlaceSplittingMultiplicity.lean @@ -597,6 +597,9 @@ noncomputable def HeightOneSpectrum.equivOfRingEquiv (exactConstantExtensionPresentedToCReciprocalNormalizationRingEquiv C S N) +omit [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] [DecidableEq (RatFunc S)] + [FiniteDimensional (RatFunc C) N] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional C S] in /-- The reciprocal normalization equivalence preserves contraction to `C[X]`. -/ theorem exactConstantExtensionPresentedToCReciprocalNormalizationHeightOneEquiv_under diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean index aab125bc80..e21511acde 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceAverage.lean @@ -148,6 +148,7 @@ private theorem finrank_mul_finrank_of_fields Module.finrank K F * Module.finrank F E = Module.finrank K E := Module.finrank_mul_finrank K F E +omit [Fintype C] in /-- A finite-place degree is the dimension of its residue field over the constant field. -/ private theorem finiteExtensionPlaceDegree_inl_eq_finrank_residueField_ratFunc @@ -194,6 +195,7 @@ noncomputable def ratFuncRationalFinitePlaceEquivFiniteExtension : variable (hExact : algebraicClosure C N = (⊥ : IntermediateField C N)) +omit [DecidableEq (RatFunc S)] in /-- Choose the explicit `S[X]` presentation of an actual top finite place, while transporting rationality of its restriction to the downstairs place. This is the only point where the nested integral-closure contraction tower is diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean index 6b71accc3b..a8ef4aaaab 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistFinitePlaceUnramified.lean @@ -608,6 +608,7 @@ theorem frobeniusTwistField_finitePlace_ramificationIdx_eq_one rw [hInertia] exact Nat.card_unique +omit [DecidableEq S] [DecidableEq (RatFunc S)] in /-- A top finite place of degree `[S : C]` fixed by the canonical twist descends to a rational finite place of the Frobenius-twist fixed field. -/ theorem frobeniusTwistField_fixed_finitePlace_under_degree_eq_one @@ -706,6 +707,7 @@ theorem frobeniusTwistField_fixed_finitePlace_under_degree_eq_one (finrank_exactConstantExtension_over_frobeniusTwistField C (RatFunc C) N S hExact g hdiv).symm +omit [Finite S] [DecidableEq S] [DecidableEq (RatFunc S)] in /-- The canonical twist over its fixed field and the ambient twist over `C(X)` induce exactly the same action on finite places. -/ theorem exactConstantExtensionFrobeniusTwist_finitePlaceGalSmul_eq_overFixedField diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean index 8274e5b0e8..adb6b977e6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionFrobeniusTwistRationalPlaceAverage.lean @@ -203,6 +203,7 @@ theorem frobeniusTwistFieldRationalInfinityPlaceCount_le_original_finrank finrank_frobeniusTwistField_over_ratFunc_eq_original C N S hExact g hdiv +omit [DecidableEq S] [DecidableEq (RatFunc S)] in /-- The total infinity contribution of all twists is uniformly bounded by the Galois-group order times the original function-field degree. -/ theorem sum_frobeniusTwistFieldRationalInfinityPlaceCount_le diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean index 197660c0dc..ae01c17e27 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistFinitePlaceAverage.lean @@ -259,6 +259,10 @@ theorem intermediateFrobeniusTwistField_ratFunc_tower IsScalarTower.algebraMap_apply L F T _ _ = algebraMap F T (algebraMap (RatFunc C) F x) := rfl +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [Algebra.IsSeparable (RatFunc C) N] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional L N] [IsGalois L N] in /-- Every intermediate-base Frobenius-twist field is a finite function field over `C(X)`. -/ theorem finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc @@ -306,6 +310,10 @@ theorem finiteDimensional_intermediateFrobeniusTwistField_over_ratFunc exact (algebraMap F T).injective exact Module.Finite.left (RatFunc C) F T +omit [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] + [FiniteDimensional (RatFunc C) L] [Algebra.IsSeparable (RatFunc C) L] + [FiniteDimensional L N] [IsGalois L N] in /-- Separability of the exact constant extension descends to every intermediate-base Frobenius-twist field. -/ theorem isSeparable_intermediateFrobeniusTwistField_over_ratFunc @@ -734,6 +742,8 @@ private theorem finitePlaceUnder_intermediate_original apply IsDedekindDomain.HeightOneSpectrum.ext exact Ideal.under_under Q.asIdeal +omit [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in /-- Choose an `S[X]`-presentation of a top finite place while transporting rationality of its restriction to the intermediate field `L`. -/ private theorem exists_presentedFinitePlace_of_under_intermediate_rational : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean index 19cab8ad13..118fca244f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistHasseBound.lean @@ -65,6 +65,10 @@ local instance intermediateHasseConstantTower : IsScalarTower C L N := by algebraMap L N (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ +omit [Fintype C] [DecidableEq C] [Finite S] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] [IsGalois (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in private theorem intermediateHasseRatFuncBaseTower : letI : Algebra (RatFunc C) (ExactConstantExtension C N S) := exactConstantExtensionBaseAlgebra C (RatFunc C) N S diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean index 94464e7875..1a1dbe1d72 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionIntermediateFrobeniusTwistRationalPlaceAverage.lean @@ -70,6 +70,10 @@ local instance intermediateRationalAverageConstantTower : IsScalarTower C L N := algebraMap L N (algebraMap (RatFunc C) L (algebraMap C (RatFunc C) c)) exact IsScalarTower.algebraMap_apply (RatFunc C) L N _ +omit [Fintype C] [Finite S] [DecidableEq C] [DecidableEq S] [DecidableEq (RatFunc C)] + [DecidableEq (RatFunc S)] [FiniteDimensional (RatFunc C) N] [IsGalois (RatFunc C) N] + [FiniteDimensional C S] [IsGalois C S] [FiniteDimensional (RatFunc C) L] + [Algebra.IsSeparable (RatFunc C) L] [FiniteDimensional L N] [IsGalois L N] in /-- Compatibility of the rational-function and intermediate-base algebra maps on the exact constant extension. -/ private theorem intermediateRationalAverageRatFuncBaseTower : @@ -221,6 +225,7 @@ theorem intermediateFrobeniusTwistFieldRationalInfinityPlaceCount_le_original_fi _ = Module.finrank (RatFunc C) N := finrank_mul_finrank_of_fields (RatFunc C) L N +omit [Fintype C] [FiniteDimensional L N] [IsGalois L N] in /-- Rational infinity places of the intermediate field itself are bounded by the original degree. -/ theorem intermediateBaseRationalInfinityPlaceCount_le_original_finrank : diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean index 100aedde3a..2a8e470d8e 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/ExactConstantExtensionNormalClosureTower.lean @@ -320,6 +320,7 @@ local instance canonicalOriginalConstantTower : IsScalarTower K (RatFunc K) F := IsScalarTower.of_algebraMap_eq' rfl +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- In the canonical `C(X)` presentation, `C` is also the exact constant field of the original compositum `CF`. -/ theorem @@ -363,6 +364,7 @@ theorem let : Algebra C M := fresh exact hFresh +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The original compositum remains separable over the canonical rational function field of the full constant field. This is transported from the original function field after exact extension of constants. -/ diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean index f20704498b..a7adfeff1f 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentCotrace.lean @@ -469,6 +469,7 @@ theorem finiteExtensionUnderPlaceChart_surjective : simp only [finiteExtensionUnderPlaceChart, Equiv.symm_apply_apply, hq, p'] exact (ratFuncExhaustivePlaceEquivChart K).apply_symm_apply p +omit [Fintype K] [DecidableEq K] in /-- Pullback along the chart place map preserves cofinite eventual properties. -/ theorem finiteExtensionUnderPlaceChart_tendstoCofinite : @@ -481,6 +482,7 @@ theorem finiteExtensionUnderPlaceChart_tendstoCofinite : (finiteExtensionPlaceEquivChart K L).symm) infer_instance +omit [Fintype K] [DecidableEq K] in /-- A base element integral at a chart place remains integral at every upstairs chart place above it. -/ theorem finiteExtension_placeValuation_algebraMap_le_one @@ -552,6 +554,7 @@ def finiteExtensionPlaceSectionChart FunctionField.Chart.PlaceA K L := Classical.choose (finiteExtensionUnderPlaceChart_surjective K L p) +omit [Fintype K] [DecidableEq K] in @[simp] theorem finiteExtensionUnderPlaceChart_section (p : FunctionField.Chart.PlaceA K (RatFunc K)) : @@ -676,6 +679,7 @@ def finiteExtensionCotraceBadBaseSet finiteExtensionDifferentExceptionalSet K L) ∪ {ratFuncInfinityPlaceChart K} +omit [Fintype K] [DecidableEq K] in theorem finiteExtensionCotraceBadBaseSet_finite (a : FunctionField.Chart.AdeleSpace K L) : (finiteExtensionCotraceBadBaseSet K L a).Finite := by diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean index 0d413862d6..e5b84ff9e3 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionCanonicalDifferentGenusBound.lean @@ -60,6 +60,7 @@ local instance canonicalGenusConstantPolynomialTower : IsScalarTower K K[X] L := IsScalarTower.of_algebraMap_eq' rfl +omit [Fintype K] in /-- Identifying the explicit different divisor with a canonical divisor turns any upper bound for its degree into a genus bound. -/ theorem finiteExtension_genus_le_budget_of_canonicalDifferent_isCanonical diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean index b3a7d7edc0..dbda7853e1 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionHasseWeil.lean @@ -151,11 +151,13 @@ def functionFieldNormalClosureStepanovThreshold : ℕ := (functionFieldNormalClosureGenus K F + 1) * (functionFieldNormalClosureGenus K F + 2) +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in theorem functionFieldNormalClosureRatFuncDegree_pos : 0 < functionFieldNormalClosureRatFuncDegree K F := by unfold functionFieldNormalClosureRatFuncDegree exact Module.finrank_pos +omit [Fintype K] [DecidableEq K] [DecidableEq (RatFunc K)] in theorem functionFieldNormalClosureStepanovThreshold_pos : 0 < functionFieldNormalClosureStepanovThreshold K F := by unfold functionFieldNormalClosureStepanovThreshold diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean index 15a74c598a..2cda0f7df5 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FiniteExtensionPlaceTower.lean @@ -823,6 +823,7 @@ noncomputable def finitePlaceUnderFiberFixedBy letI := finitePlaceUnderFiberGalAction K M L P MulAction.fixedBy (FinitePlaceUnderFiber K M L P) g +omit [DecidableEq K] [DecidableEq (RatFunc K)] in /-- The exact local fixed-point trace identity for a finite-place restriction fiber. -/ theorem sum_card_finitePlaceUnderFiberFixedBy_eq_card_galoisGroup @@ -1028,6 +1029,7 @@ noncomputable def infinityPlaceUnderFiberFixedBy letI := infinityPlaceUnderFiberGalAction K M L P MulAction.fixedBy (InfinityPlaceUnderFiber K M L P) g +omit [DecidableEq K] in /-- The exact local fixed-point trace identity for an infinity-place restriction fiber. -/ theorem sum_card_infinityPlaceUnderFiberFixedBy_eq_card_galoisGroup diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean index 8b368e7876..9a26b02ae6 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/FinitePlaceFrobeniusFiber.lean @@ -109,6 +109,7 @@ variable (L : Type*) [Field L] [Algebra (RatFunc K) L] [Algebra M L] [IsScalarTower (RatFunc K) M L] [IsGalois M L] +omit [Algebra.IsSeparable (RatFunc K) M] [Algebra.IsSeparable (RatFunc K) L] in /-- Relative Galois conjugation preserves the absolute degree of a finite place. -/ theorem finiteExtensionFinitePlace_degree_finitePlaceGalSmul @@ -125,6 +126,7 @@ theorem finiteExtensionFinitePlace_degree_finitePlaceGalSmul (finitePlaceUnder_finitePlaceGalSmul K M L g P) rw [hlocal.2] +omit [Algebra.IsSeparable (RatFunc K) L] in /-- Relative Galois conjugation preserves the absolute degree of a place above infinity. -/ theorem finiteExtensionInfinityPlace_degree_infinityPlaceGalSmul @@ -210,6 +212,8 @@ theorem finitePlaceUnderFiber_stabilizer_eq_decompositionGroup apply HeightOneSpectrum.ext exact hg +omit [DecidableEq K] [Algebra.IsSeparable (RatFunc K) M] [FiniteDimensional (RatFunc K) L] + [Algebra.IsSeparable (RatFunc K) L] in /-- On an infinity-place restriction fiber, the point stabilizer is the usual decomposition group of the underlying place. -/ theorem infinityPlaceUnderFiber_stabilizer_eq_decompositionGroup diff --git a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean index 3430c1451b..b28ecd0985 100644 --- a/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean +++ b/LeanPool/MarkoffModP/BGS/HasseWeil/StepanovRestrictionMaps.lean @@ -234,6 +234,7 @@ theorem onePointStepanovFirstRestrictionMap_injective_of_linearIndependent change onePointStepanovFirstRestrictionMap K L f g s (c - d) = 0 rw [map_sub, hcd, sub_self] +omit [DecidableEq K] in /-- The mixed-order Stepanov-grid criterion proves injectivity of the first restriction. -/ theorem onePointStepanovFirstRestrictionMap_injective_of_grid diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean index 916102818f..183af6b621 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/GiantOrbit.lean @@ -153,14 +153,6 @@ theorem maximalCoordinateRotationOrder_le_rpow_of_not_same_splitCageComponent exact hnot (sameNormalizedComponent_trans (hconnected y hyCage) (sameNormalizedComponent_symm hxy)) -private theorem three_ne_zero_zmod_of_prime_ne_three - (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by - intro hzero - have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero - rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq - · exact (Fact.out : p.Prime).ne_one hpOne - · exact hpThree hpEq - /-- Intermediate assembly relative to a neutral weighted-trace torsion-intersection bound and three specialized point-count estimates. @@ -209,7 +201,7 @@ theorem eventually_hasGiantOrbit_of_specializedEstimates have hpTwo : p ≠ 2 := by omega have hpThree : p ≠ 3 := by omega let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ obtain ⟨cNormalized, hcNormalizedCage⟩ := exists_normalizedPunctured_splitCagePoint p hpSeven diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean index c9ffabd134..9b5553ab07 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MiddleGameThenEndgame.lean @@ -22,14 +22,6 @@ open Filter noncomputable section -private theorem three_ne_zero_zmod_of_prime_ne_three - (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by - intro hzero - have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero - rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq - · exact (Fact.out : p.Prime).ne_one hpOne - · exact hpThree hpEq - /-- Maximum of the three coordinate rotation orders. -/ def maximalCoordinateRotationOrder {R : Type*} [CommRing R] (x : NormalizedPoint R) : ℕ := @@ -268,7 +260,7 @@ theorem exists_threshold_middleGame_reaches_endgame {δ : ℝ} (hδ : 0 < δ) (hδQuarter : δ ≤ (1 : ℝ) / 4) : ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) ∀ x : NormalizedMarkoffSurface (ZMod p), (p : ℝ) ^ δ < maximalCoordinateRotationOrder x.1 → ∃ y : NormalizedMarkoffSurface (ZMod p), @@ -287,7 +279,7 @@ theorem exists_threshold_middleGame_reaches_endgame intro p hp _ hpThree let : Invertible (3 : ZMod p) := invertibleOfNonzero - (three_ne_zero_zmod_of_prime_ne_three p hpThree) + (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) let : Fintype (quadraticFiniteField p) := Fintype.ofFinite _ intro x hxLower have hpSize : sizeThreshold ≤ p := @@ -342,7 +334,7 @@ theorem exists_threshold_middleGame_to_splitCage {δ : ℝ} (hδ : 0 < δ) (hδQuarter : δ ≤ (1 : ℝ) / 4) : ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) ∀ x : NormalizedMarkoffSurface (ZMod p), (p : ℝ) ^ δ < maximalCoordinateRotationOrder x.1 → ∃ y : NormalizedMarkoffSurface (ZMod p), @@ -355,7 +347,7 @@ theorem exists_threshold_middleGame_to_splitCage refine ⟨max middleThreshold endgameThreshold, ?_⟩ intro p hp _ hpThree let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hxLarge have hpMiddle : middleThreshold ≤ p := (le_max_left _ _).trans hp have hpEndgame : endgameThreshold ≤ p := (le_max_right _ _).trans hp diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean index 20fac1b35e..6ca4d8765f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Cage/Connectivity.lean @@ -172,21 +172,13 @@ theorem sameNormalizedComponent_of_mem_same_splitMaximalFiber (sameNormalizedComponent_trans (sameNormalizedComponent_symm hy12) (sameNormalizedComponent_symm hy23))) -private theorem three_ne_zero_zmod_of_prime_ne_three - (p : ℕ) [Fact p.Prime] (hpThree : p ≠ 3) : (3 : ZMod p) ≠ 0 := by - intro hzero - have hpDvd : p ∣ 3 := (ZMod.natCast_eq_zero_iff 3 p).mp hzero - rcases (Nat.dvd_prime (by norm_num : Nat.Prime 3)).mp hpDvd with hpOne | hpEq - · exact (Fact.out : p.Prime).ne_one hpOne - · exact hpThree hpEq - /-- The selected split cage is connected for all sufficiently large primes, relative only to the explicit cage Hasse--Weil count assumption. -/ theorem exists_threshold_splitCage_connected (coefficient : ℕ) (hHasse : CageWitnessPointEstimate coefficient) : ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) ∀ x y : NormalizedMarkoffSurface (ZMod p), IsInSplitCage p x → IsInSplitCage p y → SameNormalizedComponent x y := by obtain ⟨bridgeThreshold, hbridge⟩ := @@ -194,7 +186,7 @@ theorem exists_threshold_splitCage_connected refine ⟨max bridgeThreshold 7, ?_⟩ intro p hp _ hpThree let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x y hxCage hyCage rcases hxCage with ⟨axis, hxi⟩ rcases hyCage with ⟨other, heta⟩ @@ -237,7 +229,7 @@ theorem exists_threshold_largeOrder_to_splitCage {δ : ℝ} (hδ : 0 < δ) : ∃ threshold : ℕ, ∀ p : ℕ, threshold ≤ p → [Fact p.Prime] → ∀ hpThree : p ≠ 3, letI : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) ∀ x : NormalizedMarkoffSurface (ZMod p), ((p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u1 ∨ (p : ℝ) ^ ((1 : ℝ) / 2 + δ) ≤ rotationOrder x.1.u2 ∨ @@ -250,7 +242,7 @@ theorem exists_threshold_largeOrder_to_splitCage refine ⟨threshold, ?_⟩ intro p hp _ hpThree let : Invertible (3 : ZMod p) := - invertibleOfNonzero (three_ne_zero_zmod_of_prime_ne_three p hpThree) + invertibleOfNonzero (endgame_three_ne_zero_zmod_of_prime_ne_three p hpThree) intro x hlarge obtain ⟨y, hxy, hyOrder⟩ := hendgame p hp hpThree x hlarge refine ⟨y, hxy, .second, ?_⟩ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean index 707da12c30..ad2a2b38f0 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Endgame/Nonsplit/DescendedIrreducibility.lean @@ -142,8 +142,8 @@ section DescendedFormula variable (p : ℕ) [Fact p.Prime] -private abbrev F := ZMod p -private abbrev E := quadraticFiniteField p +local notation "F" => ZMod +local notation "E" => quadraticFiniteField def extendedCayleyNumeratorFactor : Polynomial (E p) := X - C (quadraticNonbaseElement p ^ p) From 88235424dacace8f91484c3bf1cff5d5d1138124 Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 09:12:38 +0000 Subject: [PATCH 35/37] Fix Markoff support bounds and public normalization hypotheses --- .../Markoff/Assembly/CoarseSupportTail.lean | 44 +++++++++---------- .../ExplicitPuncturedTransitivity.lean | 3 +- .../NonparabolicComplementFrontier.lean | 2 +- 3 files changed, 23 insertions(+), 26 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean index bfeb3027a8..0d61be7635 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/CoarseSupportTail.lean @@ -38,33 +38,29 @@ theorem twentyFour_support_margin : theorem sixtyEight_support_margin : 68 ^ 15 * 2 ^ 1374 < 2 ^ 1512 := by - have hbase : 68 < 2 ^ 7 := by norm_num - calc - 68 ^ 15 * 2 ^ 1374 < (2 ^ 7) ^ 15 * 2 ^ 1374 := - Nat.mul_lt_mul_of_pos_right - (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) - (pow_pos (by norm_num) 1374) - _ = 2 ^ 1479 := by - rw [← pow_mul, ← pow_add] - _ = 2 ^ 1479 * 1 := by simp - _ < 2 ^ 1479 * 2 ^ 33 := - Nat.mul_lt_mul_of_pos_left (by norm_num) (pow_pos (by norm_num) 1479) - _ = 2 ^ 1512 := by rw [← pow_add] + have hbase : (68 : ℕ) < 2 ^ 7 := by norm_num + have hproduct : (68 : ℕ) ^ 15 * 2 ^ 1374 < (2 ^ 7) ^ 15 * 2 ^ 1374 := by + exact Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) + (pow_pos (by norm_num) 1374) + have hpower : ((2 : ℕ) ^ 7) ^ 15 * 2 ^ 1374 = 2 ^ 1479 := by + rw [← pow_mul, ← pow_add] + have hmargin : (2 : ℕ) ^ 1479 < 2 ^ 1512 := + pow_lt_pow_right₀ (by norm_num) (by norm_num) + exact lt_trans (lt_of_lt_of_eq hproduct hpower) hmargin theorem cageCoefficient_support_margin : 100522 ^ 10 * 2 ^ 916 < 2 ^ 2268 := by - have hbase : 100522 < 2 ^ 17 := by norm_num - calc - 100522 ^ 10 * 2 ^ 916 < (2 ^ 17) ^ 10 * 2 ^ 916 := - Nat.mul_lt_mul_of_pos_right - (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) - (pow_pos (by norm_num) 916) - _ = 2 ^ 1086 := by - rw [← pow_mul, ← pow_add] - _ = 2 ^ 1086 * 1 := by simp - _ < 2 ^ 1086 * 2 ^ 1182 := - Nat.mul_lt_mul_of_pos_left (by norm_num) (pow_pos (by norm_num) 1086) - _ = 2 ^ 2268 := by rw [← pow_add] + have hbase : (100522 : ℕ) < 2 ^ 17 := by norm_num + have hproduct : (100522 : ℕ) ^ 10 * 2 ^ 916 < (2 ^ 17) ^ 10 * 2 ^ 916 := by + exact Nat.mul_lt_mul_of_pos_right + (pow_lt_pow_left₀ hbase (Nat.zero_le _) (by norm_num)) + (pow_pos (by norm_num) 916) + have hpower : ((2 : ℕ) ^ 17) ^ 10 * 2 ^ 916 = 2 ^ 1086 := by + rw [← pow_mul, ← pow_add] + have hmargin : (2 : ℕ) ^ 1086 < 2 ^ 2268 := + pow_lt_pow_right₀ (by norm_num) (by norm_num) + exact lt_trans (lt_of_lt_of_eq hproduct hpower) hmargin theorem seven_le_of_twoPow756_lt {p : ℕ} (hp : 2 ^ 756 < p) : diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean index aace97d469..88dbc754fb 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExplicitPuncturedTransitivity.lean @@ -68,7 +68,8 @@ theorem puncturedMarkoffTransitiveAt_of_maximalOrbit_frontier ((p - 1).divisors.card + (p + 1).divisors.card) * d < p) (hlarge : ∀ z : NormalizedMarkoffSurface (ZMod p), (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → - SameNormalizedComponent (normalizedPuncturedPoint c) z) : + SameNormalizedComponent + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) : PuncturedMarkoffTransitiveAt p Fact.out := by classical have hpTwo : p ≠ 2 := by omega diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean index f70e2f3e14..d6a160d21f 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/NonparabolicComplementFrontier.lean @@ -191,7 +191,7 @@ theorem (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointNonparabolicComplement c) z) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) (hsign : ∀ (s : EvenSign) (x : PuncturedMarkoffSurface (ZMod p)), s • x ∈ puncturedComponentComplementFinset p c ↔ From 51fb19ac0f57847d6ae960d16934f681018e8e5d Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 09:54:31 +0000 Subject: [PATCH 36/37] Expand private Markoff point aliases in public hypotheses --- .../Assembly/EulerSevenNonparabolicComplementFrontier.lean | 2 +- .../BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean | 4 ++-- .../Assembly/ExactOrderEulerSevenComplementObstruction.lean | 4 ++-- .../Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean | 2 +- 4 files changed, 6 insertions(+), 6 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean index d515074b02..bb7c0b0c86 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/EulerSevenNonparabolicComplementFrontier.lean @@ -65,7 +65,7 @@ theorem (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointEulerSevenComplement c) z) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) (hsign : ∀ (s : EvenSign) (x : PuncturedMarkoffSurface (ZMod p)), s • x ∈ puncturedComponentComplementFinset p c ↔ diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean index 1477a35ee5..4bb5eb1011 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderComplementObstruction.lean @@ -42,7 +42,7 @@ theorem exists_exactOrderRootSum_obstruction_of_not_samePuncturedComponent (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointExactOrderComplement c) z) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) (hcx : ¬ SamePuncturedComponent c x) : ∃ d : ℕ, @@ -171,7 +171,7 @@ theorem exists_exactOrderRootSum_obstruction_of_not_puncturedTransitive (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointExactOrderComplement c) z) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) (hfour : 4 ∣ (puncturedComponentComplementFinset p c).card) (hnotTransitive : ¬ PuncturedMarkoffTransitiveAt p Fact.out) : ∃ d : ℕ, diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean index d5dc10dcec..4b5c454068 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/ExactOrderEulerSevenComplementObstruction.lean @@ -57,7 +57,7 @@ theorem (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointExactOrderEulerSeven c) z) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) (hlinear : ∀ d : ℕ, (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → 24 * (middleGameMaximalOrders p d).card * d < p) @@ -235,7 +235,7 @@ theorem (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointExactOrderEulerSeven c) z) + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) (hlinear : ∀ d : ℕ, (d : ℝ) < (p : ℝ) ^ (5 / 6 : ℝ) → 24 * (middleGameMaximalOrders p d).card * d < p) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean index cf4335498d..52f84aa795 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/MaximalDivisorPuncturedTransitivity.lean @@ -70,7 +70,7 @@ theorem puncturedMarkoffTransitiveAt_of_maximalDivisor_frontier (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (normalizedPuncturedPointMaximalDivisors c) z) : + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) : PuncturedMarkoffTransitiveAt p Fact.out := by classical have hpTwo : p ≠ 2 := by omega From ca3684d188b232efcea5434d8d7d554f626270db Mon Sep 17 00:00:00 2001 From: Vasily Ilin Date: Sat, 26 Sep 2026 10:54:25 +0000 Subject: [PATCH 37/37] Expand joint normalization alias in public frontier statements --- .../BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean index 2e1c165530..e49418c883 100644 --- a/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean +++ b/LeanPool/MarkoffModP/BGS/Markoff/Assembly/JointMaximalDivisorFrontier.lean @@ -97,7 +97,7 @@ theorem puncturedMarkoffTransitiveAt_of_jointSquareEnvelope_frontier (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (jointNormalizedPuncturedPoint c) z) : + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) : PuncturedMarkoffTransitiveAt p Fact.out := by apply puncturedMarkoffTransitiveAt_of_maximalDivisor_frontier p hpThree c @@ -137,7 +137,7 @@ theorem puncturedMarkoffTransitiveAt_of_jointMaximalDivisorBounds (p : ℝ) ^ (5 / 6 : ℝ) ≤ maximalCoordinateRotationOrder z.1 → SameNormalizedComponent - (jointNormalizedPuncturedPoint c) z) : + (normalizedSurfaceOfPunctured (puncturedNormalizationEquiv (ZMod p) c)) z) : PuncturedMarkoffTransitiveAt p Fact.out := by apply puncturedMarkoffTransitiveAt_of_jointSquareEnvelope_frontier p hpThree c (fun d ↦ central d ^ 2 + 3 * productEnvelope d)